MG: fixed parser of end blocks in initialization section added label sections

git-svn-id: trunk@1486 -
This commit is contained in:
lazarus 2002-03-08 16:16:55 +00:00
parent e6ace97606
commit 26eaea13bd
7 changed files with 152 additions and 87 deletions

View File

@ -65,7 +65,8 @@ const
ctnVarSection = 11;
ctnConstSection = 12;
ctnResStrSection = 13;
ctnUsesSection = 14;
ctnLabelSection = 14;
ctnUsesSection = 15;
ctnTypeDefinition = 20;
ctnVarDefinition = 21;
@ -118,7 +119,8 @@ const
AllClassSections =
[ctnClassPublic,ctnClassPublished,ctnClassPrivate,ctnClassProtected];
AllDefinitionSections =
[ctnTypeSection,ctnVarSection,ctnConstSection,ctnResStrSection];
[ctnTypeSection,ctnVarSection,ctnConstSection,ctnResStrSection,
ctnLabelSection];
AllIdentifierDefinitions =
[ctnTypeDefinition,ctnVarDefinition,ctnConstDefinition];
AllPascalTypes =

View File

@ -109,6 +109,7 @@ type
function DoAtom: boolean; virtual;
procedure ReadNextAtom;
procedure UndoReadNextAtom;
procedure ReadPriorAtom;
function AtomIs(const AnAtom: shortstring): boolean;
function UpAtomIs(const AnAtom: shortstring): boolean;
function ReadNextAtomIs(const AnAtom: shortstring): boolean;
@ -138,7 +139,6 @@ type
function CompareSrcIdentifiers(CleanStartPos: integer;
AnIdentifier: PChar): boolean;
function ExtractIdentifier(CleanStartPos: integer): string;
procedure ReadPriorAtom;
procedure CreateChildNode;
procedure EndChildNode;
@ -683,12 +683,16 @@ begin
c2:=Src[CurPos.EndPos];
// test for double char operators :=, +=, -=, /=, *=, <>, <=, >=, **, ><
if ((c2='=') and (IsEqualOperatorStartChar[c1]))
or ((c1='<') and (c2='>'))
or ((c1='<') and (c2='>')) // not equal
or ((c1='>') and (c2='<'))
or ((c1='.') and (c2='.'))
or ((c1='.') and (c2='.')) // subrange
or ((c1='*') and (c2='*'))
or ((c1='@') and (c2='@'))
then inc(CurPos.EndPos);
if ((c1='@') and (c2='@')) then begin
repeat
inc(CurPos.EndPos);
until (CurPos.EndPos>SrcLen) or (not IsIdentChar[Src[CurPos.EndPos]]);
end;
end;
end;
end;
@ -887,6 +891,9 @@ begin
while (CurPos.StartPos>1)
and (IsIdentChar[UpperSrc[CurPos.StartPos-1]]) do
dec(CurPos.StartPos);
if (CurPos.StartPos>2)
and (Src[CurPos.StartPos-1]='@') and (Src[CurPos.StartPos-2]='@') then
dec(CurPos.StartPos,2);
end;
'''':
begin
@ -959,6 +966,17 @@ begin
inc(CurPos.StartPos);
break;
end;
'@':
begin
if (CurPos.StartPos=1) or (Src[CurPos.StartPos-1]<>'@')
or (([ntIdentifier,ntDecimal]*ForbiddenNumberTypes)=[]) then
// atom start found
inc(CurPos.StartPos)
else
// label found
dec(CurPos.StartPos);
break;
end;
else
begin
inc(CurPos.StartPos);

View File

@ -2503,6 +2503,8 @@ begin
'Define makro DELPHI','DELPHI','',da_DefineRecurse));
MainDirTempl.AddChild(TDefineTemplate.Create('Define makro FPC_DELPHI',
'Define makro FPC_DELPHI','FPC_DELPHI','',da_DefineRecurse));
MainDirTempl.AddChild(TDefineTemplate.Create('Define makro VER_130',
'Define makro VER_130','VER_130','',da_DefineRecurse));
MainDirTempl.AddChild(TDefineTemplate.Create(
'Define '+ExternalMacroStart+'Compiler',
'Define '+ExternalMacroStart+'Compiler variable',

View File

@ -1059,6 +1059,7 @@ writeln('[TFindDeclarationTool.FindIdentifierInContext] A Ident=',
case ContextNode.Desc of
ctnTypeSection, ctnVarSection, ctnConstSection, ctnResStrSection,
ctnLabelSection,
ctnInterface, ctnImplementation,
ctnClassPublic, ctnClassPrivate, ctnClassProtected, ctnClassPublished,
ctnClass,
@ -1316,6 +1317,7 @@ writeln('[TFindDeclarationTool.FindIdentifierInContext] Searching in Parent Con
case ContextNode.Desc of
ctnTypeSection, ctnVarSection, ctnConstSection, ctnResStrSection,
ctnLabelSection,
ctnInterface, ctnImplementation,
ctnClassPublished,ctnClassPublic,ctnClassProtected, ctnClassPrivate,
ctnRecordCase, ctnRecordVariant,

View File

@ -84,6 +84,9 @@ var
WordIsTermOperator,
WordIsPropertySpecifier,
WordIsBlockKeyWord,
EndKeyWordFuncList,
PackedTypesKeyWordFuncList,
BlockStatementStartKeyWordFuncList,
WordIsLogicalBlockStart,
WordIsBinaryOperator,
WordIsLvl1Operator, WordIsLvl2Operator, WordIsLvl3Operator, WordIsLvl4Operator,
@ -710,6 +713,34 @@ begin
Add('FINALLY',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('EXCEPT',{$ifdef FPC}@{$endif}AllwaysTrue);
end;
EndKeyWordFuncList:=TKeyWordFunctionList.Create;
KeyWordLists.Add(EndKeyWordFuncList);
with EndKeyWordFuncList do begin
Add('BEGIN',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('ASM',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('CASE',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('TRY',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('RECORD',{$ifdef FPC}@{$endif}AllwaysTrue);
end;
PackedTypesKeyWordFuncList:=TKeyWordFunctionList.Create;
KeyWordLists.Add(PackedTypesKeyWordFuncList);
with PackedTypesKeyWordFuncList do begin
Add('CLASS',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('OBJECT',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('DISPINTERFACE',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('ARRAY',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('SET',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('RECORD',{$ifdef FPC}@{$endif}AllwaysTrue);
end;
BlockStatementStartKeyWordFuncList:=TKeyWordFunctionList.Create;
KeyWordLists.Add(BlockStatementStartKeyWordFuncList);
with BlockStatementStartKeyWordFuncList do begin
Add('BEGIN' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('REPEAT',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('TRY' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('ASM' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('CASE' ,{$ifdef FPC}@{$endif}AllwaysTrue);
end;
UnexpectedKeyWordInBeginBlock:=TKeyWordFunctionList.Create;
KeyWordLists.Add(UnexpectedKeyWordInBeginBlock);
with UnexpectedKeyWordInBeginBlock do begin

View File

@ -101,12 +101,9 @@ type
TPascalParserTool = class(TMultiKeyWordListCodeTool)
private
protected
EndKeyWordFuncList: TKeyWordFunctionList;
TypeKeyWordFuncList: TKeyWordFunctionList;
PackedTypesKeyWordFuncList: TKeyWordFunctionList;
InnerClassKeyWordFuncList: TKeyWordFunctionList;
ClassVarTypeKeyWordFuncList: TKeyWordFunctionList;
BlockStatementStartKeyWordFuncList: TKeyWordFunctionList;
ExtractMemStream: TMemoryStream;
ExtractSearchPos: integer;
ExtractFoundPos: integer;
@ -122,6 +119,7 @@ type
function KeyWordFuncVar: boolean;
function KeyWordFuncConst: boolean;
function KeyWordFuncResourceString: boolean;
function KeyWordFuncLabel: boolean;
// types
function KeyWordFuncClass: boolean;
function KeyWordFuncTypePacked: boolean;
@ -153,12 +151,9 @@ type
function KeyWordFuncClassVarTypeIdent: boolean;
// keyword lists
procedure BuildDefaultKeyWordFunctions; override;
procedure BuildEndKeyWordFunctions; virtual;
procedure BuildTypeKeyWordFunctions; virtual;
procedure BuildPackedTypesKeyWordFunctions; virtual;
procedure BuildInnerClassKeyWordFunctions; virtual;
procedure BuildClassVarTypeKeyWordFunctions; virtual;
procedure BuildBlockStatementStartKeyWordFuncList; virtual;
function UnexpectedKeyWord: boolean;
// read functions
function ReadTilProcedureHeadEnd(IsMethod, IsFunction, IsType, IsOperator,
@ -247,7 +242,7 @@ type
TEndBlockType = (ebtBegin, ebtAsm, ebtTry, ebtCase, ebtRepeat, ebtRecord,
ebtClass, ebtObject);
TTryType = (ttNone, ttFinally, ttExcept);
{ TMultiKeyWordListCodeTool }
@ -313,17 +308,10 @@ end;
constructor TPascalParserTool.Create;
begin
inherited Create;
// KeyWord functions for parsing blocks (e.g. begin..end)
EndKeyWordFuncList:=TKeyWordFunctionList.Create;
BuildEndKeyWordFunctions;
AddKeyWordFuncList(EndKeyWordFuncList);
// keywords for parsing types
TypeKeyWordFuncList:=TKeyWordFunctionList.Create;
BuildTypeKeyWordFunctions;
AddKeyWordFuncList(TypeKeyWordFuncList);
PackedTypesKeyWordFuncList:=TKeyWordFunctionList.Create;
BuildPackedTypesKeyWordFunctions;
AddKeyWordFuncList(PackedTypesKeyWordFuncList);
// KeyWord functions for parsing in a class
InnerClassKeyWordFuncList:=TKeyWordFunctionList.Create;
BuildInnerClassKeyWordFunctions;
@ -331,10 +319,6 @@ begin
ClassVarTypeKeyWordFuncList:=TKeyWordFunctionList.Create;
BuildClassVarTypeKeyWordFunctions;
AddKeyWordFuncList(ClassVarTypeKeyWordFuncList);
// keywords for statements
BlockStatementStartKeyWordFuncList:=TKeyWordFunctionList.Create;
BuildBlockStatementStartKeyWordFuncList;
AddKeyWordFuncList(BlockStatementStartKeyWordFuncList);
end;
destructor TPascalParserTool.Destroy;
@ -364,7 +348,8 @@ begin
Add('VAR',{$ifdef FPC}@{$endif}KeyWordFuncVar);
Add('CONST',{$ifdef FPC}@{$endif}KeyWordFuncConst);
Add('RESOURCESTRING',{$ifdef FPC}@{$endif}KeyWordFuncResourceString);
Add('LABEL',{$ifdef FPC}@{$endif}KeyWordFuncLabel);
Add('PROCEDURE',{$ifdef FPC}@{$endif}KeyWordFuncProc);
Add('FUNCTION',{$ifdef FPC}@{$endif}KeyWordFuncProc);
Add('CONSTRUCTOR',{$ifdef FPC}@{$endif}KeyWordFuncProc);
@ -379,18 +364,6 @@ begin
end;
end;
procedure TPascalParserTool.BuildEndKeyWordFunctions;
// KeyWordFunctions for parsing end - blocks
begin
with EndKeyWordFuncList do begin
Add('BEGIN',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('ASM',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('CASE',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('TRY',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('RECORD',{$ifdef FPC}@{$endif}AllwaysTrue);
end;
end;
procedure TPascalParserTool.BuildTypeKeyWordFunctions;
// KeyWordFunctions for parsing types
begin
@ -414,19 +387,6 @@ begin
end;
end;
procedure TPascalParserTool.BuildPackedTypesKeyWordFunctions;
// KeyWordFunctions for valid packed types
begin
with PackedTypesKeyWordFuncList do begin
Add('CLASS',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('OBJECT',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('DISPINTERFACE',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('ARRAY',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('SET',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('RECORD',{$ifdef FPC}@{$endif}AllwaysTrue);
end;
end;
procedure TPascalParserTool.BuildInnerClassKeyWordFunctions;
// KeyWordFunctions for parsing in a class/object
begin
@ -468,17 +428,6 @@ begin
end;
end;
procedure TPascalParserTool.BuildBlockStatementStartKeyWordFuncList;
begin
with BlockStatementStartKeyWordFuncList do begin
Add('BEGIN' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('REPEAT',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('TRY' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('ASM' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('CASE' ,{$ifdef FPC}@{$endif}AllwaysTrue);
end;
end;
function TPascalParserTool.UnexpectedKeyWord: boolean;
begin
Result:=false;
@ -1142,7 +1091,7 @@ function TPascalParserTool.ReadTilProcedureHeadEnd(
external <id or number> index <id>
[alias: <string constant>]
}
var IsSpecifier, EndSemicolonFound: boolean;
var IsSpecifier: boolean;
Attr: TProcHeadAttributes;
begin
//writeln('[TPascalParserTool.ReadTilProcedureHeadEnd] ',
@ -1198,12 +1147,8 @@ begin
UndoReadNextAtom;
exit;
end;
if AtomIsChar(';') then begin
if AtomIsChar(';') then
ReadNextAtom;
EndSemicolonFound:=true;
end else begin
EndSemicolonFound:=false;
end;
if (CurPos.StartPos>SrcLen) then
RaiseException('semicolon not found');
repeat
@ -1565,6 +1510,10 @@ begin
CreateChildNode;
CurNode.Desc:=ctnFinalization;
CurSection:=CurNode.Desc;
end else if EndKeyWordFuncList.DoItUppercase(UpperSrc,CurPos.StartPos,
CurPos.EndPos-CurPos.StartPos) then
begin
ReadTilBlockEnd(false,false);
end else if UpAtomIs('END') then begin
Result:=KeyWordFuncEndPoint;
break;
@ -1730,6 +1679,7 @@ begin
if (CurPos.StartPos>SrcLen) then begin
RaiseExceptionWithBlockStartHint('"end" not found')
end else if (UpAtomIs('END')) then begin
if BlockType=ebtRepeat then
RaiseExceptionWithBlockStartHint(
'"until" expected, but "'+GetAtom+'" found');
@ -2148,7 +2098,7 @@ function TPascalParserTool.KeyWordFuncType: boolean;
}
begin
if not (CurSection in [ctnProgram,ctnInterface,ctnImplementation]) then
RaiseException('unexpected keyword '+GetAtom+' in type section');
RaiseException('unexpected keyword '+GetAtom);
CreateChildNode;
CurNode.Desc:=ctnTypeSection;
// read all type definitions Name = Type;
@ -2195,7 +2145,7 @@ function TPascalParserTool.KeyWordFuncVar: boolean;
}
begin
if not (CurSection in [ctnProgram,ctnInterface,ctnImplementation]) then
RaiseException('unexpected keyword '+GetAtom+' in var section');
RaiseException('unexpected keyword '+GetAtom);
CreateChildNode;
CurNode.Desc:=ctnVarSection;
// read all variable definitions Name : Type; [cvar;] [public [name '']]
@ -2243,7 +2193,7 @@ function TPascalParserTool.KeyWordFuncConst: boolean;
}
begin
if not (CurSection in [ctnProgram,ctnInterface,ctnImplementation]) then
RaiseException('unexpected keyword '+GetAtom+' in const section');
RaiseException('unexpected keyword '+GetAtom);
CreateChildNode;
CurNode.Desc:=ctnConstSection;
// read all constants Name = <Const>; or Name : type = <Const>;
@ -2297,7 +2247,7 @@ function TPascalParserTool.KeyWordFuncResourceString: boolean;
}
begin
if not (CurSection in [ctnProgram,ctnInterface,ctnImplementation]) then
RaiseException('unexpected keyword '+GetAtom+' in resourcestring section');
RaiseException('unexpected keyword '+GetAtom);
CreateChildNode;
CurNode.Desc:=ctnResStrSection;
// read all string constants Name = 'abc';
@ -2328,6 +2278,38 @@ begin
Result:=true;
end;
function TPascalParserTool.KeyWordFuncLabel: boolean;
{
examples:
label a, 23, b;
}
begin
if not (CurSection in [ctnProgram,ctnInterface,ctnImplementation]) then
RaiseException('unexpected keyword '+GetAtom);
CreateChildNode;
CurNode.Desc:=ctnLabelSection;
// read all constants
repeat
ReadNextAtom; // identifier or number
if not AtomIsIdentifier(false) or AtomIsNumber then begin
RaiseException('identifier expected, but '+GetAtom+' found');
end;
CreateChildNode;
CurNode.Desc:=ctnLabelType;
CurNode.EndPos:=CurPos.EndPos;
EndChildNode;
ReadNextAtom;
if AtomIsChar(';') then begin
break;
end else if not AtomIsChar(',') then begin
RaiseException('; expected, but '+GetAtom+' found');
end;
until false;
CurNode.EndPos:=CurPos.EndPos;
EndChildNode;
Result:=true;
end;
function TPascalParserTool.KeyWordFuncTypePacked: boolean;
begin
ReadNextAtom;

View File

@ -232,10 +232,31 @@ type
TCanvas = class;
{
TGraphic is the mother of all graphic formats like TBitmap, TPixmap and
TIcon. It defines properties and methods for width, height and streaming.
}
{ The TGraphic class is an abstract base class for dealing with graphic images
such as bitmaps, pixmaps, icons, and other image formats.
LoadFromFile - Read the graphic from the file system. The old contents of
the graphic are lost. If the file is not of the right format, an
exception will be generated.
SaveToFile - Writes the graphic to disk in the file provided.
LoadFromStream - Like LoadFromFile except source is a stream (e.g.
TBlobStream).
SaveToStream - stream analogue of SaveToFile.
LoadFromClipboardFormat - Replaces the current image with the data
provided. If the TGraphic does not support that format it will generate
an exception.
SaveToClipboardFormats - Converts the image to a clipboard format. If the
image does not support being translated into a clipboard format it
will generate an exception.
Height - The native, unstretched, height of the graphic.
Palette - Color palette of image. Zero if graphic doesn't need/use palettes.
Transparent - Image does not completely cover its rectangular area
Width - The native, unstretched, width of the graphic.
OnChange - Called whenever the graphic changes
PaletteModified - Indicates in OnChange whether color palette has changed.
Stays true until whoever's responsible for realizing this new palette
(ex: TImage) sets it to False.
OnProgress - Generic progress indicator event. Propagates out to TPicture
and TImage OnProgress events.}
TGraphic = class(TPersistent)
private
FModified: Boolean;
@ -282,7 +303,7 @@ type
{ TPicture is a TGraphic container. It is used in place of a TGraphic if the
graphic can be of any TGraphic class. LoadFromFile and SaveToFile are
polymorphic. For example, if the TPicture is holding an Icon, you can
LoadFromFile a bitmap file, where if the class was TIcon you could only read
LoadFromFile a bitmap file, where if the class is TIcon you could only read
.ICO files.
LoadFromFile - Reads a picture from disk. The TGraphic class created
determined by the file extension of the file. If the file extension is
@ -304,6 +325,8 @@ type
Graphic - The TGraphic object contained by the TPicture
Bitmap - Returns a bitmap. If the contents is not already a bitmap, the
contents are thrown away and a blank bitmap is returned.
Pixmap - Returns a pixmap. If the contents is not already a pixmap, the
contents are thrown away and a blank pixmap is returned.
Icon - Returns an icon. If the contents is not already an icon, the
contents are thrown away and a blank icon is returned.
}
@ -393,7 +416,7 @@ type
public
procedure Arc(x,y,width,height,angle1,angle2 : Integer);
Procedure BrushCopy(Dest : TRect; InternalImages: TBitmap; Src : TRect;
TransparentColor :TColor);
TransparentColor :TColor);
constructor Create;
Procedure CopyRect(const Dest : TRect; Canvas : TCanvas; const Source : TRect);
destructor Destroy; override;
@ -402,26 +425,28 @@ type
procedure Ellipse(const Rect: TRect);
procedure Pie(x,y,width,height,angle1,angle2 : Integer);
procedure Polygon(const Points: array of TPoint;
Winding: Boolean{$IFDEF VER1_1} = False{$ENDIF};
StartIndex: Integer{$IFDEF VER1_1} = 0{$ENDIF};
NumPts: Integer {$IFDEF VER1_1} = -1{$ENDIF});
Winding: Boolean{$IFDEF VER1_1} = False{$ENDIF};
StartIndex: Integer{$IFDEF VER1_1} = 0{$ENDIF};
NumPts: Integer {$IFDEF VER1_1} = -1{$ENDIF});
procedure Polygon(Points: PPoint; NumPts: Integer;
Winding: boolean{$IFDEF VER1_1} = False{$ENDIF});
Winding: boolean{$IFDEF VER1_1} = False{$ENDIF});
procedure Polyline(const Points: array of TPoint;
StartIndex: Integer {$IFDEF VER1_1} = 0{$ENDIF};
NumPts: Integer {$IFDEF VER1_1} = -1{$ENDIF});
StartIndex: Integer {$IFDEF VER1_1} = 0{$ENDIF};
NumPts: Integer {$IFDEF VER1_1} = -1{$ENDIF});
procedure Polyline(Points: PPoint; NumPts: Integer);
Procedure FillRect(const Rect : TRect);
procedure Frame3d(var Rect : TRect; const FrameWidth : integer; const Style : TBevelCut);
procedure FloodFill(X, Y: Integer; FillColor: TColor; FillStyle: TFillStyle);
procedure Frame3d(var Rect : TRect; const FrameWidth : integer;
const Style : TBevelCut);
Procedure Rectangle(X1,Y1,X2,Y2 : Integer);
Procedure Rectangle(const Rect: TRect);
Procedure Line(X1,Y1,X2,Y2 : Integer);
Procedure MoveTo(X1,Y1 : Integer);
Procedure LineTo(X1,Y1 : Integer);
procedure TextOut(X,Y: Integer; const Text: String);
procedure TextRect(Rect: TRect; X, Y: integer; const Text : string);
overload;
procedure TextRect(Rect: TRect; X, Y: integer; const Text : string; const Style : TTextStyle); overload;
procedure TextRect(Rect: TRect; X, Y: integer; const Text : string);// overload;
procedure TextRect(Rect: TRect; X, Y: integer; const Text : string;
const Style : TTextStyle); //overload;
function TextExtent(const Text: string): TSize;
function TextHeight(const Text: string): Integer;
function TextWidth(const Text: string): Integer;
@ -698,6 +723,9 @@ end.
{ =============================================================================
$Log$
Revision 1.24 2002/03/08 16:16:55 lazarus
MG: fixed parser of end blocks in initialization section added label sections
Revision 1.23 2002/03/08 09:30:30 lazarus
MG: nicer parameter names