fcl-passrc: resolver: fixed error during parsing with-do

git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@41082 3ad0048d-3df7-0310-abae-a5850022a9f2

2 files changed, 78 insertions, 11 deletions

diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp
index 0eff4a9ebe..20a1b07876 100644
--- a/packages/fcl-passrc/src/pparser.pp
+++ b/packages/fcl-passrc/src/pparser.pp
@@ -5625,14 +5625,13 @@ var
 
 var
   SubBlock: TPasImplElement;
-  Left, Right: TPasExpr;
+  Left, Right, Expr: TPasExpr;
   El : TPasImplElement;
   lt : TLoopType;
   SrcPos: TPasSourcePos;
   Name: String;
   TypeEl: TPasType;
   ImplRaise: TPasImplRaise;
-  Expr: TPasExpr;
 
 begin
   NewImplElement:=nil;
@@ -5829,12 +5828,11 @@ begin
           SrcPos:=CurTokenPos;
           NextToken;
           El:=TPasImplWithDo(CreateElement(TPasImplWithDo,'',CurBlock,SrcPos));
-          Left:=DoParseExpression(CurBlock);
+          Expr:=DoParseExpression(CurBlock);
           //writeln(i,'WITH Expr="',Expr,'" Token=',CurTokenText);
-          TPasImplWithDo(El).AddExpression(Left);
-          Left.Parent:=El;
-          Engine.BeginScope(stWithExpr,Left);
-          Left:=nil;
+          TPasImplWithDo(El).AddExpression(Expr);
+          Expr.Parent:=El;
+          Engine.BeginScope(stWithExpr,Expr);
           CreateBlock(TPasImplWithDo(El));
           El:=nil;
           repeat
@@ -5842,11 +5840,10 @@ begin
             if CurToken<>tkComma then
               ParseExcTokenError(TokenInfos[tkdo]);
             NextToken;
-            Left:=DoParseExpression(CurBlock);
+            Expr:=DoParseExpression(CurBlock);
             //writeln(i,'WITH ...,Expr="',Expr,'" Token=',CurTokenText);
-            TPasImplWithDo(CurBlock).AddExpression(Left);
-            Engine.BeginScope(stWithExpr,Left);
-            Left:=nil;
+            TPasImplWithDo(CurBlock).AddExpression(Expr);
+            Engine.BeginScope(stWithExpr,Expr);
           until false;
         end;
       tkcase:
diff --git a/packages/fcl-passrc/tests/tcresolver.pas b/packages/fcl-passrc/tests/tcresolver.pas
index ab051b4e02..3a4ba70ee6 100644
--- a/packages/fcl-passrc/tests/tcresolver.pas
+++ b/packages/fcl-passrc/tests/tcresolver.pas
@@ -256,6 +256,7 @@ type
     // enums and sets
     Procedure TestEnums;
     Procedure TestEnumRangeFail;
+    Procedure TestEnumDotValueFail;
     Procedure TestSets;
     Procedure TestSetOperators;
     Procedure TestEnumParams;
@@ -884,6 +885,7 @@ type
     Procedure TestClassHelper_NestedInheritedParentFail;
     Procedure TestClassHelper_AccessFields;
     Procedure TestClassHelper_CallClassMethodFail;
+    Procedure TestClassHelper_WithHelperFail;
     Procedure TestClassHelper_AsTypeFail;
     Procedure TestClassHelper_Enumerator;
     Procedure TestClassHelper_FromUnitInterface;
@@ -898,6 +900,8 @@ type
     Procedure TestTypeHelper_HelperForProcTypeFail;
     Procedure TestTypeHelper_DefaultPropertyFail;
     Procedure TestTypeHelper_Enum;
+    Procedure TestTypeHelper_EnumDotValueFail;
+    Procedure TestTypeHelper_EnumHelperDotProcFail;
     Procedure TestTypeHelper_Enumerator;
     Procedure TestTypeHelper_Constructor_NewInstance;
 
@@ -3548,6 +3552,17 @@ begin
   CheckParserException('Const ranges are not allowed',nParserNoConstRangeAllowed);
 end;
 
+procedure TTestResolver.TestEnumDotValueFail;
+begin
+  StartProgram(false);
+  Add([
+  'type TFlag = (a,b,c);',
+  'var f: TFlag;',
+  'begin',
+  '  f:=f.a;']);
+  CheckResolverException('illegal qualifier "." after "f:TFlag"',nIllegalQualifierAfter);
+end;
+
 procedure TTestResolver.TestSets;
 begin
   StartProgram(false);
@@ -16102,6 +16117,20 @@ begin
   CheckResolverException(sHelpersCannotBeUsedAsTypes,nHelpersCannotBeUsedAsTypes);
 end;
 
+procedure TTestResolver.TestClassHelper_WithHelperFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  THelper = class helper for TObject',
+  '  end;',
+  'begin',
+  '  with THelper do ;',
+  '']);
+  CheckResolverException(sHelpersCannotBeUsedAsTypes,nHelpersCannotBeUsedAsTypes);
+end;
+
 procedure TTestResolver.TestClassHelper_AsTypeFail;
 begin
   StartProgram(false);
@@ -16559,6 +16588,7 @@ begin
   '  TFlag = (Red, Green, Blue);',
   '  THelper = type helper for TFlag',
   '    function toString: string;',
+  '    class procedure Fly;',
   '  end;',
   'function THelper.toString: string;',
   'begin',
@@ -16566,14 +16596,54 @@ begin
   '  if Self=TFlag.Blue then ;',
   '  Result:=str(Self);',
   'end;',
+  'class procedure THelper.Fly;',
+  'begin',
+  'end;',
   'var',
   '  f: TFlag;',
   'begin',
   '  f.toString;',
+  '  TFlag.Fly;',
   '']);
   ParseProgram;
 end;
 
+procedure TTestResolver.TestTypeHelper_EnumDotValueFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch typehelpers}',
+  'type',
+  '  TFlag = (Red, Green, Blue);',
+  '  THelper = type helper for TFlag',
+  '  end;',
+  'var',
+  '  f: TFlag;',
+  'begin',
+  '  f:=f.red;',
+  '']);
+  CheckResolverException('identifier not found "red"',nIdentifierNotFound);
+end;
+
+procedure TTestResolver.TestTypeHelper_EnumHelperDotProcFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch typehelpers}',
+  'type',
+  '  TFlag = (Red, Green, Blue);',
+  '  THelper = type helper for TFlag',
+  '    procedure Fly;',
+  '  end;',
+  'procedure THelper.Fly;',
+  'begin',
+  'end;',
+  'begin',
+  '  TFlag.Fly;',
+  '']);
+  CheckResolverException('Cannot access this member from a type helper',nCannotAccessThisMemberFromAX);
+end;
+
 procedure TTestResolver.TestTypeHelper_Enumerator;
 begin
   StartProgram(false);