Browse Source

fcl-passrc: fixed parsing as as binary

git-svn-id: trunk@36222 -
Mattias Gaertner 8 years ago
parent
commit
7a5046edca

+ 37 - 48
packages/fcl-passrc/src/pparser.pp

@@ -1899,23 +1899,22 @@ var
   Last,func, Expr: TPasExpr;
   prm     : TParamsExpr;
   b       : TBinaryExpr;
-  optk    : TToken;
   ok: Boolean;
 
 begin
   Result:=nil;
   case CurToken of
     tkString:           Last:=CreatePrimitiveExpr(AParent,pekString,CurTokenString);
-    tkChar:             Last:=CreatePrimitiveExpr(AParent,pekString, CurTokenText);
-    tkNumber:           Last:=CreatePrimitiveExpr(AParent,pekNumber, CurTokenString);
+    tkChar:             Last:=CreatePrimitiveExpr(AParent,pekString,CurTokenText);
+    tkNumber:           Last:=CreatePrimitiveExpr(AParent,pekNumber,CurTokenString);
     tkIdentifier:
       begin
       if CompareText(CurTokenText,'self')=0 then
         begin
         Last:=CreateSelfExpr(AParent);
-        HandleSelf(Last)
+        HandleSelf(Last);
         end
-      Else
+      else
         Last:=CreatePrimitiveExpr(AParent,pekIdent, CurTokenText)
       end;
     tkfalse, tktrue:    Last:=CreateBoolConstExpr(Aparent,pekBoolConst, CurToken=tktrue);
@@ -1978,59 +1977,49 @@ begin
   try
     if Last.Kind in [pekIdent,pekSelf,pekNil] then
       begin
-      while CurToken in [tkDot] do
-        begin
-        NextToken;
-        if CurToken in [tkIdentifier,tktrue,tkfalse] then // true and false are also identifiers
+      repeat
+        case CurToken of
+        tkDot:
           begin
-          expr:=CreatePrimitiveExpr(AParent,pekIdent,CurTokenString);
-          AddToBinaryExprChain(Result,expr,eopSubIdent);
-          func:=expr;
           NextToken;
-          end
-        else
-          begin
-          UngetToken;
-          ParseExcExpectedIdentifier;
-          end;
-        end;
-       repeat
-        case CurToken of
-          tkBraceOpen,tkSquaredBraceOpen:
+          if CurToken in [tkIdentifier,tktrue,tkfalse,tkself] then // true and false are also identifiers
             begin
-            if CurToken=tkBraceOpen then
-              prm:=ParseParams(AParent,pekFuncParams,isWriteOrStr(func))
-            else
-              prm:=ParseParams(AParent,pekArrayParams);
-            if not Assigned(prm) then Exit;
-            AddParamsToBinaryExprChain(Result,prm);
-            end;
-          tkCaret:
-            begin
-            Result:=CreateUnaryExpr(AParent,Result,TokenToExprOp(CurToken));
+            expr:=CreatePrimitiveExpr(AParent,pekIdent,CurTokenString);
+            AddToBinaryExprChain(Result,expr,eopSubIdent);
+            func:=expr;
             NextToken;
+            end
+          else
+            begin
+            UngetToken;
+            ParseExcExpectedIdentifier;
             end;
+          end;
+        tkBraceOpen,tkSquaredBraceOpen:
+          begin
+          if CurToken=tkBraceOpen then
+            prm:=ParseParams(AParent,pekFuncParams,isWriteOrStr(func))
           else
-            break;
+            prm:=ParseParams(AParent,pekArrayParams);
+          if not Assigned(prm) then Exit;
+          AddParamsToBinaryExprChain(Result,prm);
           end;
-      until false;
-      // Needed for TSDOBaseDataObjectClass(Self.ClassType).Create
-      if CurToken in [tkDot,tkas] then
-        begin
-        optk:=CurToken;
-        NextToken;
-        Expr:=ParseExpIdent(AParent);
-        if Expr=nil then
-          ParseExcExpectedIdentifier;
-        if optk=tkDot then
-          AddToBinaryExprChain(Result,Expr,TokenToExprOp(optk))
-        else
+        tkCaret:
           begin
-          // a as b
-          Result:=CreateBinaryExpr(AParent,Result,Expr,TokenToExprOp(tkas));
+          Result:=CreateUnaryExpr(AParent,Result,TokenToExprOp(CurToken));
+          NextToken;
           end;
+        {tkLessThan:
+          begin
+          // could be an inline specialization (e.g. A<T>)
+            scanner.SetForceCaret();
+          end}
+        else
+          break;
+        end;
+      until false;
+      // Needed for TSDOBaseDataObjectClass(Self.ClassType).Create
       end;
-    end;
     ok:=true;
   finally
     if not ok then

+ 3 - 1
packages/fcl-passrc/src/pscanner.pp

@@ -3222,7 +3222,9 @@ begin
     '^':
       begin
       if ForceCaret or PPisSkipping or
-         (PreviousToken in [tkeof,tkTab,tkLineEnding,tkComment,tkIdentifier,tkNil,tkOperator,tkBraceClose,tkSquaredBraceClose,tkCARET,tkWhitespace]) then
+         (PreviousToken in [tkeof,tkTab,tkLineEnding,tkComment,tkIdentifier,
+                   tkNil,tkOperator,tkBraceClose,tkSquaredBraceClose,tkCaret,
+                   tkWhitespace]) then
         begin
         Inc(TokenStr);
         Result := tkCaret;

+ 12 - 3
packages/fcl-passrc/tests/tcgenerics.pp

@@ -20,8 +20,9 @@ Type
     Procedure TestDeclarationDelphi;
     Procedure TestDeclarationDelphiSpecialize;
     Procedure TestMethodImplementation;
-    Procedure TestInlineSpecializationInProcedure;
+    Procedure TestInlineSpecializationInArgument;
     Procedure TestSpecializeNested;
+    Procedure TestInlineSpecializeInStatement;
   end;
 
 implementation
@@ -103,7 +104,6 @@ begin
   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;
@@ -125,7 +125,7 @@ begin
   ParseModule;
 end;
 
-procedure TTestGenerics.TestInlineSpecializationInProcedure;
+procedure TTestGenerics.TestInlineSpecializationInArgument;
 begin
   With source do
     begin
@@ -150,6 +150,15 @@ begin
   ParseDeclarations;
 end;
 
+procedure TTestGenerics.TestInlineSpecializeInStatement;
+begin
+  Add([
+  'begin',
+  '  vec:=TVector<double>.create;',
+  '']);
+  ParseModule;
+end;
+
 initialization
   RegisterTest(TTestGenerics);
 end.