summaryrefslogtreecommitdiff
path: root/packages
diff options
context:
space:
mode:
Diffstat (limited to 'packages')
-rw-r--r--packages/fcl-passrc/src/pparser.pp61
-rw-r--r--packages/fcl-passrc/tests/tcgenerics.pp22
-rw-r--r--packages/fcl-passrc/tests/tctypeparser.pas10
-rw-r--r--packages/fcl-passrc/tests/tcvarparser.pas12
4 files changed, 83 insertions, 22 deletions
diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp
index 3241b6a21e..a8673776b1 100644
--- a/packages/fcl-passrc/src/pparser.pp
+++ b/packages/fcl-passrc/src/pparser.pp
@@ -1192,29 +1192,40 @@ procedure TPasParser.ChangeToken(tk: TToken);
var
Cur, Last: PTokenRec;
IsLast: Boolean;
+
+ Procedure DoChange(tk1,tk2 : TToken);
+
+ begin
+ // change last token '>>' into two '>'
+ Cur:=@FTokenRing[FTokenRingCur];
+ Cur^.Token:=tk2;
+ Cur^.AsString:=TokenInfos[tk2];
+ Last:=@FTokenRing[FTokenRingEnd];
+ Last^.Token:=tk2;
+ Last^.AsString:=TokenInfos[tk2];
+ if Last^.Comments<>nil then
+ Last^.Comments.Clear;
+ Last^.SourcePos:=Cur^.SourcePos;
+ dec(Cur^.SourcePos.Column);
+ Last^.TokenPos:=Cur^.TokenPos;
+ inc(Last^.TokenPos.Column);
+ FTokenRingEnd:=(FTokenRingEnd+1) mod FTokenRingSize;
+ if FTokenRingStart=FTokenRingEnd then
+ FTokenRingStart:=(FTokenRingStart+1) mod FTokenRingSize;
+ FCurToken:=tk1;
+ FCurTokenString:=TokenInfos[tk1];
+ end;
+
begin
//writeln('TPasParser.ChangeToken FTokenBufferSize=',FTokenRingStart,' FTokenBufferIndex=',FTokenRingCur);
IsLast:=((FTokenRingCur+1) mod FTokenRingSize)=FTokenRingEnd;
- if (CurToken=tkshr) and (tk=tkGreaterThan) and IsLast then
+ if (CurToken=tkGreaterEqualThan) and (tk=tkGreaterThan) and IsLast then
begin
- // change last token '>>' into two '>'
- Cur:=@FTokenRing[FTokenRingCur];
- Cur^.Token:=tkGreaterThan;
- Cur^.AsString:='>';
- Last:=@FTokenRing[FTokenRingEnd];
- Last^.Token:=tkGreaterThan;
- Last^.AsString:='>';
- if Last^.Comments<>nil then
- Last^.Comments.Clear;
- Last^.SourcePos:=Cur^.SourcePos;
- dec(Cur^.SourcePos.Column);
- Last^.TokenPos:=Cur^.TokenPos;
- inc(Last^.TokenPos.Column);
- FTokenRingEnd:=(FTokenRingEnd+1) mod FTokenRingSize;
- if FTokenRingStart=FTokenRingEnd then
- FTokenRingStart:=(FTokenRingStart+1) mod FTokenRingSize;
- FCurToken:=tkGreaterThan;
- FCurTokenString:='>';
+ DoChange(tkGreaterThan,tkEqual);
+ end
+ else if (CurToken=tkshr) and (tk=tkGreaterThan) and IsLast then
+ begin
+ DoChange(tkGreaterThan,tkGreaterThan);
end
else
CheckToken(tk);
@@ -1770,7 +1781,7 @@ begin
Try
// only allowed: ^dottedidentifer
// forbidden: ^^identifier, ^array of word, ^A<B>
- ExpectIdentifier;
+ ExpectTokens([tkIdentifier,tkFile]);
Name:=CurTokenString;
repeat
NextToken;
@@ -4196,8 +4207,12 @@ begin
until CurToken<>tkComma;
Engine.FinishScope(stTypeDef,T);
until not (CurToken in [tkSemicolon,tkComma]);
- if CurToken<>tkGreaterThan then
- ParseExcExpectedAorB(TokenInfos[tkComma], TokenInfos[tkGreaterThan]);
+ if Not (CurToken in [tkGreaterThan,tkGreaterEqualThan]) then
+ ParseExcExpectedAorB(TokenInfos[tkComma], TokenInfos[tkGreaterThan])
+ else if CurToken=tkGreaterEqualThan then
+ begin
+ ChangeToken(tkGreaterThan);
+ end;
end;
{$warn 5043 on}
@@ -4611,6 +4626,8 @@ begin
Result := Result + ' ' + CurTokenText;
LibName:=DoParseExpression(Parent);
end;
+ if CurToken=tkSemiColon then
+ exit;
if not CurTokenIsIdentifier('name') then
ParseExcSyntaxError;
NextToken;
diff --git a/packages/fcl-passrc/tests/tcgenerics.pp b/packages/fcl-passrc/tests/tcgenerics.pp
index 02414f37fb..1d872bc271 100644
--- a/packages/fcl-passrc/tests/tcgenerics.pp
+++ b/packages/fcl-passrc/tests/tcgenerics.pp
@@ -21,6 +21,7 @@ Type
Procedure TestProcTypeGenerics;
Procedure TestDeclarationDelphi;
Procedure TestDeclarationFPC;
+ Procedure TestDeclarationFPCNoSpaces;
Procedure TestMethodImplementation;
// generic constraints
@@ -141,6 +142,27 @@ begin
AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
end;
+procedure TTestGenerics.TestDeclarationFPCNoSpaces;
+Var
+ T : TPasClassType;
+begin
+ Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches;
+ Source.Add('Type');
+ Source.Add(' TSomeClass<T;T2>=Class(TObject)');
+ Source.Add(' b : T;');
+ Source.Add(' b2 : T2;');
+ Source.Add(' end;');
+ ParseDeclarations;
+ AssertNotNull('have generic definition',Declarations.Classes);
+ AssertEquals('have generic definition',1,Declarations.Classes.Count);
+ AssertEquals('Pascal class',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
+ T:=TPasClassType(Declarations.Classes[0]);
+ AssertNotNull('have generic templates',T.GenericTemplateTypes);
+ AssertEquals('2 template types',2,T.GenericTemplateTypes.Count);
+ AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
+ AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
+end;
+
procedure TTestGenerics.TestMethodImplementation;
begin
With source do
diff --git a/packages/fcl-passrc/tests/tctypeparser.pas b/packages/fcl-passrc/tests/tctypeparser.pas
index 1818e85e96..83ecd5b60c 100644
--- a/packages/fcl-passrc/tests/tctypeparser.pas
+++ b/packages/fcl-passrc/tests/tctypeparser.pas
@@ -168,6 +168,7 @@ type
Procedure TestTypeHelperWithParent;
procedure TestPointerReference;
Procedure TestPointerKeyWord;
+ Procedure TestPointerFile;
end;
{ TTestRecordTypeParser }
@@ -3674,6 +3675,15 @@ begin
AssertEquals('object definition count',1,Declarations.Classes.Count);
end;
+procedure TTestTypeParser.TestPointerFile;
+begin
+ Add('type');
+ Add(' pfile = ^file;');
+ ParseDeclarations;
+ AssertEquals('object definition count',1,Declarations.Types.Count);
+end;
+
+
initialization
RegisterTests([TTestTypeParser,TTestRecordTypeParser,TTestProcedureTypeParser]);
diff --git a/packages/fcl-passrc/tests/tcvarparser.pas b/packages/fcl-passrc/tests/tcvarparser.pas
index c3bee4110d..98cebca94f 100644
--- a/packages/fcl-passrc/tests/tcvarparser.pas
+++ b/packages/fcl-passrc/tests/tcvarparser.pas
@@ -49,6 +49,7 @@ Type
Procedure TestVarExternalLib;
Procedure TestVarExternalLibName;
procedure TestVarExternalNoSemiColon;
+ procedure TestVarExternalLibNoName;
Procedure TestVarCVar;
Procedure TestVarCVarExternal;
Procedure TestVarPublic;
@@ -325,6 +326,17 @@ begin
AssertNotNull('Library symbol',TheVar.ExportName);
end;
+
+procedure TTestVarParser.TestVarExternalLibNoName;
+begin
+ // Found in e.g.apache headers
+ ParseVar('integer; external ''mylib''','');
+ AssertEquals('Variable modifiers',[vmexternal],TheVar.VarModifiers);
+ AssertNotNull('Library name',TheVar.LibraryName);
+
+end;
+
+
procedure TTestVarParser.TestVarExternalLibName;
begin
ParseVar('integer; external ''mylib'' name ''de''','');
View Lorry Controller Status