Browse Source

fcl-passrc: fixed parsing inherited name as

git-svn-id: trunk@37720 -
Mattias Gaertner 7 years ago
parent
commit
87d020c07b
2 changed files with 39 additions and 15 deletions
  1. 16 15
      packages/fcl-passrc/src/pparser.pp
  2. 23 0
      packages/fcl-passrc/tests/tcresolver.pas

+ 16 - 15
packages/fcl-passrc/src/pparser.pp

@@ -2046,9 +2046,9 @@ function TPasParser.ParseExpIdent(AParent: TPasElement): TPasExpr;
   end;
   end;
 
 
 var
 var
-  Last,func, Expr: TPasExpr;
-  prm     : TParamsExpr;
-  b       : TBinaryExpr;
+  Last, Func, Expr: TPasExpr;
+  Params: TParamsExpr;
+  Bin: TBinaryExpr;
   ok, CanSpecialize: Boolean;
   ok, CanSpecialize: Boolean;
   aName: String;
   aName: String;
   ISE: TInlineSpecializeExpr;
   ISE: TInlineSpecializeExpr;
@@ -2075,7 +2075,7 @@ begin
       else
       else
         Last:=CreatePrimitiveExpr(AParent,pekIdent,aName);
         Last:=CreatePrimitiveExpr(AParent,pekIdent,aName);
       end;
       end;
-    tkfalse, tktrue:    Last:=CreateBoolConstExpr(Aparent,pekBoolConst, CurToken=tktrue);
+    tkfalse, tktrue:    Last:=CreateBoolConstExpr(AParent,pekBoolConst, CurToken=tktrue);
     tknil:              Last:=CreateNilExpr(AParent);
     tknil:              Last:=CreateNilExpr(AParent);
     tkSquaredBraceOpen: Last:=ParseParams(AParent,pekSet);
     tkSquaredBraceOpen: Last:=ParseParams(AParent,pekSet);
     tkinherited:
     tkinherited:
@@ -2086,13 +2086,14 @@ begin
       if (CurToken=tkIdentifier) then
       if (CurToken=tkIdentifier) then
         begin
         begin
         SrcPos:=CurTokenPos;
         SrcPos:=CurTokenPos;
-        b:=CreateBinaryExpr(AParent,Last, DoParseExpression(AParent), eopNone,SrcPos);
-        if not Assigned(b.right) then
+        Bin:=CreateBinaryExpr(AParent,Last,ParseExpIdent(AParent),eopNone,SrcPos);
+        if not Assigned(Bin.right) then
           begin
           begin
-          b.Release;
+          Bin.Release;
           ParseExcExpectedIdentifier;
           ParseExcExpectedIdentifier;
           end;
           end;
-        Last:=b;
+        Result:=Bin;
+        exit;
         end;
         end;
       UngetToken;
       UngetToken;
       end;
       end;
@@ -2120,12 +2121,12 @@ begin
   end;
   end;
 
 
   Result:=Last;
   Result:=Last;
-  func:=Last;
-  
+
   if Last.Kind<>pekSet then NextToken;
   if Last.Kind<>pekSet then NextToken;
   if not (Last.Kind in [pekNumber,pekString,pekSet,pekIdent,pekSelf,pekNil]) then
   if not (Last.Kind in [pekNumber,pekString,pekSet,pekIdent,pekSelf,pekNil]) then
     exit;
     exit;
 
 
+  Func:=Last;
   ok:=false;
   ok:=false;
   ISE:=nil;
   ISE:=nil;
   try
   try
@@ -2140,7 +2141,7 @@ begin
           aName:=aName+'.'+CurTokenString;
           aName:=aName+'.'+CurTokenString;
           expr:=CreatePrimitiveExpr(AParent,pekIdent,CurTokenString);
           expr:=CreatePrimitiveExpr(AParent,pekIdent,CurTokenString);
           AddToBinaryExprChain(Result,expr,eopSubIdent,ScrPos);
           AddToBinaryExprChain(Result,expr,eopSubIdent,ScrPos);
-          func:=expr;
+          Func:=expr;
           NextToken;
           NextToken;
           end
           end
         else
         else
@@ -2152,11 +2153,11 @@ begin
       tkBraceOpen,tkSquaredBraceOpen:
       tkBraceOpen,tkSquaredBraceOpen:
         begin
         begin
         if CurToken=tkBraceOpen then
         if CurToken=tkBraceOpen then
-          prm:=ParseParams(AParent,pekFuncParams,IsWriteOrStr(func))
+          Params:=ParseParams(AParent,pekFuncParams,IsWriteOrStr(Func))
         else
         else
-          prm:=ParseParams(AParent,pekArrayParams);
-        if not Assigned(prm) then Exit;
-        AddParamsToBinaryExprChain(Result,prm);
+          Params:=ParseParams(AParent,pekArrayParams);
+        if not Assigned(Params) then Exit;
+        AddParamsToBinaryExprChain(Result,Params);
         CanSpecialize:=false;
         CanSpecialize:=false;
         end;
         end;
       tkCaret:
       tkCaret:

+ 23 - 0
packages/fcl-passrc/tests/tcresolver.pas

@@ -434,6 +434,7 @@ type
     Procedure TestClassCallInheritedWithParamsAbstractFail;
     Procedure TestClassCallInheritedWithParamsAbstractFail;
     Procedure TestClassCallInheritedConstructor;
     Procedure TestClassCallInheritedConstructor;
     Procedure TestClassCallInheritedNested;
     Procedure TestClassCallInheritedNested;
+    Procedure TestClassCallInheritedAs;
     Procedure TestClassAssignNil;
     Procedure TestClassAssignNil;
     Procedure TestClassAssign;
     Procedure TestClassAssign;
     Procedure TestClassNilAsParam;
     Procedure TestClassNilAsParam;
@@ -6864,6 +6865,28 @@ begin
   ParseProgram;
   ParseProgram;
 end;
 end;
 
 
+procedure TTestResolver.TestClassCallInheritedAs;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    function GetSome: TObject; virtual;',
+  '  end;',
+  '  TBird = class',
+  '    function GetIt: TBird;',
+  '  end;',
+  'function TObject.GetSome: TObject;',
+  'begin',
+  'end;',
+  'function TBird.GetIt: TBird;',
+  'begin',
+  '  Result:=inherited GetSome as TBird;',
+  'end;',
+  'begin']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestClassAssignNil;
 procedure TTestResolver.TestClassAssignNil;
 begin
 begin
   StartProgram(false);
   StartProgram(false);