* Patch from Mattias Gaertner with support for

  - class forward declaration
  - alias class, type alias class
  - ancestor, TObject as default
  - virtual, override, abstract
  - property read, write, stored
  - methods
  - self
  - overloaded procs with class as argument

git-svn-id: trunk@34555 -

packages/fcl-passrc/src/pastree.pp

@@ -581,7 +581,7 @@ type
   public
     PackMode: TPackMode;
     ObjKind: TPasObjKind;
-    AncestorType: TPasType;     // TPasClassType or TPasUnresolvedTypeRef
+    AncestorType: TPasType;     // TPasClassType or TPasUnresolvedTypeRef or TPasAliasType or TPasTypeAliasType
     HelperForType: TPasType;     // TPasClassType or TPasUnresolvedTypeRef
     IsForward: Boolean;
     IsShortDefinition: Boolean;//class(anchestor); without end
@@ -752,10 +752,14 @@ type
     procedure ForEachCall(const aMethodCall: TListCallback;
       const Arg: Pointer); override;
   public
-    IndexExpr,
-    DefaultExpr : TPasExpr;
+    IndexExpr: TPasExpr;
+    ReadAccessor: TPasExpr;
+    WriteAccessor: TPasExpr;
+    ImplementsFunc: TPasExpr;
+    StoredAccessor: TPasExpr; // can be nil, if StoredAccessorName is 'True' or 'False'
+    DefaultExpr: TPasExpr;
     Args: TFPList;        // List of TPasArgument objects
-    ReadAccessorName, WriteAccessorName,ImplementsName,
+    ReadAccessorName, WriteAccessorName, ImplementsName,
       StoredAccessorName: string;
     IsClass, IsDefault, IsNodefault: Boolean;
     Function ResolvedType : TPasType;
@@ -2415,9 +2419,13 @@ var
 begin
   for i := 0 to Args.Count - 1 do
     TPasArgument(Args[i]).Release;
-  Args.Free;
-  ReleaseAndNil(TPasElement(DefaultExpr));
+  FreeAndNil(Args);
   ReleaseAndNil(TPasElement(IndexExpr));
+  ReleaseAndNil(TPasElement(ReadAccessor));
+  ReleaseAndNil(TPasElement(WriteAccessor));
+  ReleaseAndNil(TPasElement(ImplementsFunc));
+  ReleaseAndNil(TPasElement(StoredAccessor));
+  ReleaseAndNil(TPasElement(DefaultExpr));
   inherited Destroy;
 end;
 
@@ -3386,6 +3394,14 @@ begin
     IndexExpr.ForEachCall(aMethodCall,Arg);
   for i:=0 to Args.Count-1 do
     TPasElement(Args[i]).ForEachCall(aMethodCall,Arg);
+  if ReadAccessor<>nil then
+    ReadAccessor.ForEachCall(aMethodCall,Arg);
+  if WriteAccessor<>nil then
+    WriteAccessor.ForEachCall(aMethodCall,Arg);
+  if ImplementsFunc<>nil then
+    ImplementsFunc.ForEachCall(aMethodCall,Arg);
+  if StoredAccessor<>nil then
+    StoredAccessor.ForEachCall(aMethodCall,Arg);
   if DefaultExpr<>nil then
     DefaultExpr.ForEachCall(aMethodCall,Arg);
 end;
@@ -3880,6 +3896,7 @@ end;
 procedure TPasImplCaseStatement.AddExpression(const Expr: TPasExpr);
 begin
   Expressions.Add(Expr);
+  Expr.Parent:=Self;
 end;
 
 procedure TPasImplCaseStatement.ForEachCall(

packages/fcl-passrc/src/pparser.pp

@@ -136,10 +136,10 @@ type
     stProcedure, // also method, procedure, constructor, destructor, ...
     stProcedureHeader,
     stExceptOnExpr,
-    stExceptOnStatement
-    //stDeclaration, // e.g. the A in 'type A=B;'
+    stExceptOnStatement,
+    stDeclaration, // e.g. a TPasType, TPasProperty
     //stStatement,
-    //stAncestors // the list of ancestors and interfaces of a class
+    stAncestors // the list of ancestors and interfaces of a class
     );
   TPasScopeTypes = set of TPasScopeType;
 
@@ -278,6 +278,8 @@ type
     function CreateBinaryExpr(AParent : TPasElement; xleft, xright: TPasExpr; AOpCode: TExprOpCode): TBinaryExpr;
     procedure AddToBinaryExprChain(var ChainFirst, ChainLast: TPasExpr;
       Element: TPasExpr; AOpCode: TExprOpCode);
+    procedure AddParamsToBinaryExprChain(var ChainFirst, ChainLast: TPasExpr;
+      Params: TParamsExpr);
     function CreateUnaryExpr(AParent : TPasElement; AOperand: TPasExpr; AOpCode: TExprOpCode): TUnaryExpr;
     function CreateArrayValues(AParent : TPasElement): TArrayValues;
     function CreateFunctionType(const AName, AResultName: String; AParent: TPasElement;
@@ -334,7 +336,7 @@ type
     function ParseEnumType(Parent: TPasElement; Const NamePos: TPasSourcePos; const TypeName: String): TPasEnumType;
     function ParseSetType(Parent: TPasElement; Const NamePos: TPasSourcePos; const TypeName: String ): TPasSetType;
     function ParseSpecializeType(Parent: TPasElement; Const TypeName: String): TPasClassType;
-    Function ParseClassDecl(Parent: TPasElement; Const AClassName: String; AObjKind: TPasObjKind; PackMode : TPackMode= pmNone): TPasType;
+    Function ParseClassDecl(Parent: TPasElement; Const NamePos: TPasSourcePos; Const AClassName: String; AObjKind: TPasObjKind; PackMode : TPackMode= pmNone): TPasType;
     Function ParseProperty(Parent : TPasElement; Const AName : String; AVisibility : TPasMemberVisibility) : TPasProperty;
     function ParseRangeType(AParent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String; Full: Boolean = True): TPasRangeType;
     procedure ParseExportDecl(Parent: TPasElement; List: TFPList);
@@ -1047,16 +1049,19 @@ begin
       K:=stkAlias
     else if (CurToken=tkSquaredBraceOpen) then
       begin
+      // Todo: check via resolver
       if ((LowerCase(Name)='string') or (LowerCase(Name)='ansistring')) then // Type A = String[12];
         K:=stkString
       else
         ParseExcSyntaxError;
       end
-    else // Type A = A..B;
-      K:=stkRange;
+    else if CurToken=tkDotDot then // Type A = A..B;
+      K:=stkRange
+    else
+      ParseExcTokenError(';');
     UnGetToken;
     end
-  else  if (CurToken=tkDotDot) then // Type A = B;
+  else if (CurToken=tkDotDot) then // A: B..C;
     begin
     K:=stkRange;
     UnGetToken;
@@ -1205,6 +1210,7 @@ var
   CH , ok: Boolean; // Check hint ?
 begin
   Result := nil;
+  // NextToken and check pack mode
   Pm:=CheckPackMode;
   if Full then
     CH:=Not (CurToken in NoHintTokens)
@@ -1218,10 +1224,10 @@ begin
   Try
     case CurToken of
       // types only allowed when full
-      tkObject: Result := ParseClassDecl(Parent, TypeName, okObject,PM);
-      tkInterface: Result := ParseClassDecl(Parent, TypeName, okInterface);
+      tkObject: Result := ParseClassDecl(Parent, NamePos, TypeName, okObject,PM);
+      tkInterface: Result := ParseClassDecl(Parent, NamePos, TypeName, okInterface);
       tkSpecialize: Result:=ParseSpecializeType(Parent,TypeName);
-      tkClass: Result := ParseClassDecl(Parent, TypeName, okClass, PM);
+      tkClass: Result := ParseClassDecl(Parent, NamePos, TypeName, okClass, PM);
       tkType: Result:=ParseAliasType(Parent,NamePos,TypeName);
       // Always allowed
       tkIdentifier: Result:=ParseSimpleType(Parent,NamePos,TypeName,Full);
@@ -1238,7 +1244,7 @@ begin
         if (Curtoken=tkHelper) then
           begin
           UnGetToken;
-          Result:=ParseClassDecl(Parent,TypeName,okRecordHelper,PM);
+          Result:=ParseClassDecl(Parent,NamePos,TypeName,okRecordHelper,PM);
           end
         else
           begin
@@ -1246,9 +1252,13 @@ begin
           Result := ParseRecordDecl(Parent,NamePos,TypeName,PM);
           end;
         end;
+      tkNumber,tkMinus:
+        begin
+        UngetToken;
+        Result:=ParseRangeType(Parent,NamePos,TypeName,Full);
+        end;
     else
-      UngetToken;
-      Result:=ParseRangeType(Parent,NamePos,TypeName,Full);
+      ParseExcExpectedIdentifier;
     end;
     if CH then
       CheckHint(Result,True);
@@ -1373,7 +1383,7 @@ begin
     NextToken;
     if not isEndOfExp then begin
       repeat
-        p:=DoParseExpression(AParent);
+        p:=DoParseExpression(params);
         if not Assigned(p) then Exit; // bad param syntax
         params.AddParam(p);
 
@@ -1531,23 +1541,16 @@ begin
           ParseExcExpectedIdentifier;
           end;
         end;
-      while CurToken in [tkBraceOpen, tkSquaredBraceOpen, tkCaret] do
+      repeat
         case CurToken of
-          tkBraceOpen:
-            begin
-            prm:=ParseParams(AParent,pekFuncParams);
-            if not Assigned(prm) then Exit;
-            prm.Value:=Last;
-            Result:=prm;
-            Last:=prm;
-            end;
-          tkSquaredBraceOpen:
+          tkBraceOpen,tkSquaredBraceOpen:
             begin
-            prm:=ParseParams(AParent,pekArrayParams);
+            if CurToken=tkBraceOpen then
+              prm:=ParseParams(AParent,pekFuncParams)
+            else
+              prm:=ParseParams(AParent,pekArrayParams);
             if not Assigned(prm) then Exit;
-            prm.Value:=Last;
-            Result:=prm;
-            Last:=prm;
+            AddParamsToBinaryExprChain(Result,Last,prm);
             end;
           tkCaret:
             begin
@@ -1555,7 +1558,10 @@ begin
             Last:=Result;
             NextToken;
             end;
-        end;
+          else
+            break;
+          end;
+      until false;
       // Needed for TSDOBaseDataObjectClass(Self.ClassType).Create
       if CurToken in [tkdot,tkas] then
         begin
@@ -1725,9 +1731,9 @@ begin
           begin
           tempop:=PopOper;
           x:=popexp;
-          if (tempop=tkMinus) and (X.Kind=pekRange) then
+          if (tempop=tkMinus) and (x.Kind=pekRange) then
             begin
-            TBinaryExpr(x).Left:=CreateUnaryExpr(x, TBinaryExpr(X).left, eopSubtract);
+            TBinaryExpr(x).Left:=CreateUnaryExpr(x, TBinaryExpr(x).left, eopSubtract);
             expstack.Add(x);
             end
           else
@@ -1751,7 +1757,7 @@ begin
         PushOper(CurToken);
         NextToken;
         end;
-     // Writeln('Bin ',NotBinary ,' or EOE ',isEndOfExp, ' Ex ',Assigned(x),' stack ',ExpStack.Count);
+      // Writeln('Bin ',NotBinary ,' or EOE ',isEndOfExp, ' Ex ',Assigned(x),' stack ',ExpStack.Count);
     until NotBinary or isEndOfExp;
 
     if not NotBinary then ParseExcExpectedIdentifier;
@@ -1759,7 +1765,11 @@ begin
     while opstackTop>=0 do PopAndPushOperator;
 
     // only 1 expression should be on the stack, at the end of the correct expression
-    if expstack.Count=1 then Result:=TPasExpr(expstack[0]);
+    if expstack.Count=1 then
+      begin
+      Result:=TPasExpr(expstack[0]);
+      Result.Parent:=AParent;
+      end;
 
   finally
     {if Not Assigned(Result) then
@@ -1792,26 +1802,26 @@ var
   r : TRecordValues;
   a : TArrayValues;
 
-function lastfield:boolean;
+  function lastfield:boolean;
 
-begin
-  result:= CurToken<>tkSemicolon;
-  if not result then
-   begin
-     nexttoken;
-     if curtoken=tkbraceclose then
-       result:=true
-     else
-       ungettoken;
-   end; 
-end;
+  begin
+    result:= CurToken<>tkSemicolon;
+    if not result then
+     begin
+       nexttoken;
+       if curtoken=tkbraceclose then
+         result:=true
+       else
+         ungettoken;
+     end;
+  end;
 
 begin
   if CurToken <> tkBraceOpen then
     Result:=DoParseExpression(AParent)
   else begin
     NextToken;
-    x:=DoParseConstValueExpression(Aparent);
+    x:=DoParseConstValueExpression(AParent);
     case CurToken of
       tkComma: // array of values (a,b,c);
         begin
@@ -1900,7 +1910,10 @@ var
 begin
   With Decs do
     begin
-    OverloadedProc:=CheckOverloadList(Functions,AProc.Name,OldMember);
+    if not (po_nooverloadedprocs in Options) then
+      OverloadedProc:=CheckOverloadList(Functions,AProc.Name,OldMember)
+    else
+      OverloadedProc:=nil;
     If (OverloadedProc<>Nil) then
       begin
       OverLoadedProc.Overloads.Add(AProc);
@@ -1929,7 +1942,7 @@ var
 
 begin
   Result:=AParent;
-  If AParent is TPasClassType then
+  If (not (po_nooverloadedprocs in Options)) and (AParent is TPasClassType) then
     begin
     OverloadedProc:=CheckOverLoadList(TPasClassType(AParent).Members,AName,Member);
     If (OverloadedProc<>Nil) then
@@ -2244,6 +2257,7 @@ begin
             begin
             If LogEvent(pleImplementation) then
               DoLog(mtInfo,nLogStartImplementation,SLogStartImplementation);
+            SetBlock(declNone);
             ParseImplementation;
             end;
           break;
@@ -2252,6 +2266,7 @@ begin
         if (Declarations is TInterfaceSection)
         or ((Declarations is TImplementationSection) and not (Declarations is TProgramSection)) then
           begin
+          SetBlock(declNone);
           ParseInitialization;
           break;
           end;
@@ -2259,6 +2274,7 @@ begin
         if (Declarations is TInterfaceSection)
         or ((Declarations is TImplementationSection) and not (Declarations is TProgramSection)) then
           begin
+          SetBlock(declNone);
           ParseFinalization;
           break;
           end;
@@ -2447,12 +2463,14 @@ begin
         begin
         if Declarations is TProcedureBody then
           begin
+          SetBlock(declNone);
           ParseProcBeginBlock(TProcedureBody(Declarations));
           break;
           end
         else if (Declarations is TInterfaceSection)
         or (Declarations is TImplementationSection) then
           begin
+          SetBlock(declNone);
           ParseInitialization;
           break;
           end
@@ -2461,6 +2479,7 @@ begin
         end;
       tklabel:
         begin
+          SetBlock(declNone);
           if not (Declarations is TInterfaceSection) then
             ParseLabels(Declarations);
         end;
@@ -2468,6 +2487,7 @@ begin
       ParseExcSyntaxError;
     end;
   end;
+  SetBlock(declNone);
 end;
 
 function TPasParser.CheckUseUnit(ASection: TPasSection; AUnitName: string
@@ -3008,6 +3028,7 @@ begin
       else
         ParseExc(nParserExpectedConstVarID,SParserExpectedConstVarID);
       Arg := TPasArgument(CreateElement(TPasArgument, Name, Parent));
+      Arg.Access := Access;
       Args.Add(Arg);
       NextToken;
       if CurToken = tkColon then
@@ -3026,7 +3047,8 @@ begin
     Value:=Nil;
     if not IsUntyped then
       begin
-      ArgType := ParseType(Parent,Scanner.CurSourcePos);
+      Arg := TPasArgument(Args[0]);
+      ArgType := ParseType(Arg,Scanner.CurSourcePos);
       ok:=false;
       try
         NextToken;
@@ -3049,7 +3071,7 @@ begin
         UngetToken;
         ok:=true;
       finally
-        if not ok then
+        if (not ok) and (ArgType<>nil) then
           ArgType.Release;
       end;
       end;
@@ -3057,11 +3079,9 @@ begin
     for i := OldArgCount to Args.Count - 1 do
     begin
       Arg := TPasArgument(Args[i]);
-      Arg.Access := Access;
       Arg.ArgType := ArgType;
       if Assigned(ArgType) then
         begin
-        ArgType.Parent := Arg;
         if (i > OldArgCount) then
           ArgType.AddRef;
         end;
@@ -3105,7 +3125,7 @@ begin
     end;
 end;
 
-procedure TPasParser.HandleProcedureModifier(Parent: TPasElement;pm : TProcedureModifier);
+procedure TPasParser.HandleProcedureModifier(Parent: TPasElement; pm: TProcedureModifier);
 
 Var
   Tok : String;
@@ -3240,7 +3260,7 @@ Var
 begin
   // Element must be non-nil. Removed all checks for not-nil.
   // If it is nil, the following fails anyway.
-  CheckProcedureArgs(Parent,Element.Args,ProcType in [ptOperator,ptClassOperator]);
+  CheckProcedureArgs(Element,Element.Args,ProcType in [ptOperator,ptClassOperator]);
   case ProcType of
     ptFunction,ptClassFunction:
       begin
@@ -3377,35 +3397,46 @@ end;
 function TPasParser.ParseProperty(Parent: TPasElement; const AName: String;
   AVisibility: TPasMemberVisibility): TPasProperty;
 
-  procedure MaybeReadFullyQualifiedIdentifier(Var r : String);
-
-  begin
-    while True do
-      begin
-      NextToken;
-      if CurToken = tkDot then
-        begin
-        ExpectIdentifier;
-        R:=R + '.' + CurTokenString;
-        end
-      else
-        break;
-      end;
-  end;
-
-  function GetAccessorName: String;
+  function GetAccessorName(aParent: TPasElement; out Expr: TPasExpr): String;
+  var
+    Last: TPasExpr;
+    Params: TParamsExpr;
+    Param: TPasExpr;
   begin
     ExpectIdentifier;
     Result := CurTokenString;
-    MaybeReadFullyQualifiedIdentifier(Result);
+    Expr := CreatePrimitiveExpr(aParent,pekIdent,CurTokenString);
+    Last := Expr;
+
+    // read .subident.subident...
+    repeat
+      NextToken;
+      if CurToken <> tkDot then break;
+      ExpectIdentifier;
+      Result := Result + '.' + CurTokenString;
+      AddToBinaryExprChain(Expr,Last,CreatePrimitiveExpr(aParent,pekIdent,CurTokenString),eopSubIdent);
+    until false;
+
+    // read optional array index
     if CurToken <> tkSquaredBraceOpen then
       UnGetToken
     else
       begin
       Result := Result + '[';
+      Params:=TParamsExpr(CreateElement(TParamsExpr,'',aParent));
+      Params.Kind:=pekArrayParams;
+      AddParamsToBinaryExprChain(Expr,Last,Params);
       NextToken;
-      if CurToken in [tkIdentifier, tkNumber] then
-        Result := Result + CurTokenString;
+      case CurToken of
+        tkChar:             Param:=CreatePrimitiveExpr(aParent,pekString, CurTokenText);
+        tkNumber:           Param:=CreatePrimitiveExpr(aParent,pekNumber, CurTokenString);
+        tkIdentifier:       Param:=CreatePrimitiveExpr(aParent,pekIdent, CurTokenText);
+        tkfalse, tktrue:    Param:=CreateBoolConstExpr(aParent,pekBoolConst, CurToken=tktrue);
+      else
+        ParseExcExpectedIdentifier;
+      end;
+      Params.AddParam(Param);
+      Result := Result + CurTokenString;
       ExpectToken(tkSquaredBraceClose);
       Result := Result + ']';
       end;
@@ -3438,17 +3469,17 @@ begin
       end;
     if CurTokenIsIdentifier('READ') then
       begin
-      Result.ReadAccessorName := GetAccessorName;
+      Result.ReadAccessorName := GetAccessorName(Result,Result.ReadAccessor);
       NextToken;
       end;
     if CurTokenIsIdentifier('WRITE') then
       begin
-      Result.WriteAccessorName := GetAccessorName;
+      Result.WriteAccessorName := GetAccessorName(Result,Result.WriteAccessor);
       NextToken;
       end;
     if CurTokenIsIdentifier('IMPLEMENTS') then
       begin
-      Result.ImplementsName := GetAccessorName;
+      Result.ImplementsName := GetAccessorName(Result,Result.ImplementsFunc);
       NextToken;
       end;
     if CurTokenIsIdentifier('STORED') then
@@ -3459,7 +3490,10 @@ begin
       else if CurToken = tkFalse then
         Result.StoredAccessorName := 'False'
       else if CurToken = tkIdentifier then
-        Result.StoredAccessorName := CurTokenString
+        begin
+        UngetToken;
+        Result.StoredAccessorName := GetAccessorName(Result,Result.StoredAccessor);
+        end
       else
         ParseExcSyntaxError;
       NextToken;
@@ -3505,6 +3539,7 @@ begin
     if not ok then
       Result.Release;
   end;
+  Engine.FinishScope(stDeclaration,Result);
 end;
 
 // Starts after the "begin" token
@@ -3809,6 +3844,7 @@ begin
         ExpectToken(tkof);
         El:=TPasImplCaseOf(CreateElement(TPasImplCaseOf,'',CurBlock));
         TPasImplCaseOf(El).CaseExpr:=Left;
+        Left.Parent:=El;
         CreateBlock(TPasImplCaseOf(El));
         repeat
           NextToken;
@@ -3840,7 +3876,7 @@ begin
               end
             else
               repeat
-                Left:=DoParseExpression(Parent);
+                Left:=DoParseExpression(CurBlock);
                 //writeln(i,'CASE value="',Expr,'" Token=',CurTokenText);
                 if CurBlock is TPasImplCaseStatement then
                   TPasImplCaseStatement(CurBlock).Expressions.Add(Left)
@@ -4401,7 +4437,7 @@ var
   Proc: TPasProcedure;
   ProcType: TProcType;
 begin
-  ProcType:=GetProcTypeFromtoken(CurToken,isClass);
+  ProcType:=GetProcTypeFromToken(CurToken,isClass);
   Proc:=ParseProcedureOrFunctionDecl(AType,ProcType,AVisibility);
   if Proc.Parent is TPasOverloadedProc then
     TPasOverloadedProc(Proc.Parent).Overloads.Add(Proc)
@@ -4584,6 +4620,7 @@ begin
     AType.HelperForType:=ParseType(AType,Scanner.CurSourcePos);
     NextToken;
     end;
+  Engine.FinishScope(stAncestors,AType);
   if (AType.IsShortDefinition or AType.IsForward) then
     UngetToken
   else
@@ -4601,23 +4638,19 @@ begin
 end;
 
 function TPasParser.ParseClassDecl(Parent: TPasElement;
-  const AClassName: String; AObjKind: TPasObjKind; PackMode: TPackMode
-  ): TPasType;
+  const NamePos: TPasSourcePos; const AClassName: String;
+  AObjKind: TPasObjKind; PackMode: TPackMode): TPasType;
 
 Var
-  SrcPos: TPasSourcePos;
   ok: Boolean;
 
 begin
-  // Save current parsing position to get it correct in all cases
-  SrcPos := Scanner.CurSourcePos;
-
   NextToken;
 
   if (AObjKind = okClass) and (CurToken = tkOf) then
     begin
     Result := TPasClassOfType(CreateElement(TPasClassOfType, AClassName,
-      Parent, SrcPos));
+      Parent, NamePos));
     ExpectIdentifier;
     UngetToken;                // Only names are allowed as following type
     TPasClassOfType(Result).DestType := ParseType(Result,Scanner.CurSourcePos);
@@ -4632,13 +4665,14 @@ begin
     NextToken;
     end;
   Result := TPasClassType(CreateElement(TPasClassType, AClassName,
-    Parent, SrcPos));
+    Parent, NamePos));
 
   ok:=false;
   try
     TPasClassType(Result).ObjKind := AObjKind;
     TPasClassType(Result).PackMode:=PackMode;
     DoParseClassType(TPasClassType(Result));
+    Engine.FinishScope(stTypeDef,Result);
     ok:=true;
   finally
     if not ok then
@@ -4747,12 +4781,47 @@ begin
     end;
 end;
 
+procedure TPasParser.AddParamsToBinaryExprChain(var ChainFirst,
+  ChainLast: TPasExpr; Params: TParamsExpr);
+// append Params to chain, using the last element as Params.Value
+var
+  Bin: TBinaryExpr;
+begin
+  if Params.Value<>nil then
+    ParseExcSyntaxError;
+  if ChainLast=nil then
+    ParseExcSyntaxError;
+  if ChainLast is TBinaryExpr then
+    begin
+    Bin:=TBinaryExpr(ChainLast);
+    if Bin.left=nil then
+      ParseExcSyntaxError;
+    if Bin.right=nil then
+      ParseExcSyntaxError;
+    Params.Value:=Bin.right;
+    Params.Value.Parent:=Params;
+    Bin.right:=Params;
+    Params.Parent:=Bin;
+    end
+  else
+    begin
+    if ChainFirst<>ChainLast then
+      ParseExcSyntaxError;
+    Params.Value:=ChainFirst;
+    Params.Parent:=ChainFirst.Parent;
+    ChainFirst.Parent:=Params;
+    ChainFirst:=Params;
+    ChainLast:=Params;
+    end;
+end;
+
 function TPasParser.CreateUnaryExpr(AParent: TPasElement; AOperand: TPasExpr;
   AOpCode: TExprOpCode): TUnaryExpr;
 begin
   Result:=TUnaryExpr(CreateElement(TUnaryExpr,'',AParent));
   Result.Kind:=pekUnary;
   Result.Operand:=AOperand;
+  Result.Operand.Parent:=Result;
   Result.OpCode:=AOpCode;
 end;
 

packages/fcl-passrc/src/pscanner.pp

@@ -329,7 +329,8 @@ type
     po_delphi, // Delphi mode: forbid nested comments
     po_cassignments,  // allow C-operators += -= *= /=
     po_resolvestandardtypes, // search for 'longint', 'string', etc., do not use dummies, TPasResolver sets this to use its declarations
-    po_asmwhole  // store whole text between asm..end in TPasImplAsmStatement.Tokens
+    po_asmwhole,  // store whole text between asm..end in TPasImplAsmStatement.Tokens
+    po_nooverloadedprocs  // do not create TPasOverloadedProc for procs with same name
     );
   TPOptions = set of TPOption;
 

packages/fcl-passrc/tests/tcexprparser.pas

@@ -210,13 +210,14 @@ Var
 begin
   DeclareVar('record a : array[1..2] of integer; end ','b');
   ParseExpression('b.a[1]');
-  P:=TParamsExpr(AssertExpression('Simple identifier',theExpr,pekArrayParams,TParamsExpr));
-  B:=AssertExpression('Name of array',P.Value,pekBinary,TBInaryExpr) as TBinaryExpr;
-  AssertEquals('name is Subident',eopSubIdent,B.Opcode);
+  B:=AssertExpression('Binary of record',TheExpr,pekBinary,TBinaryExpr) as TBinaryExpr;
+  AssertEquals('Name is Subident',eopSubIdent,B.Opcode);
   AssertExpression('Name of array',B.Left,pekIdent,'b');
-  AssertExpression('Name of array',B.Right,pekIdent,'a');
-  AssertEquals('One dimension',1,Length(p.params));
-  AssertExpression('Simple identifier',p.params[0],pekNumber,'1');
+  P:=TParamsExpr(AssertExpression('Simple identifier',B.right,pekArrayParams,TParamsExpr));
+  AssertExpression('Name of array',P.Value,pekIdent,'a');
+  TAssert.AssertSame('P.value.parent=P',P,P.Value.Parent);
+  AssertEquals('One dimension',1,Length(P.params));
+  AssertExpression('Simple identifier',P.params[0],pekNumber,'1');
   TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
   TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
 end;

packages/fcl-passrc/tests/tcresolver.pas

@@ -58,6 +58,11 @@ Type
   end;
   PTestResolverReferenceData = ^TTestResolverReferenceData;
 
+  TSystemUnitPart = (
+    supTObject
+    );
+  TSystemUnitParts = set of TSystemUnitPart;
+
   { TTestResolver }
 
   TTestResolver = Class(TTestParser)
@@ -69,6 +74,7 @@ Type
     function GetModules(Index: integer): TTestEnginePasResolver;
     function OnPasResolverFindUnit(const aUnitName: String): TPasModule;
     procedure OnFindReference(Element, FindData: pointer);
+    procedure OnCheckElementParent(data, arg: pointer);
   Protected
     Procedure SetUp; override;
     Procedure TearDown; override;
@@ -82,38 +88,98 @@ Type
     function AddModuleWithSrc(aFilename, Src: string): TTestEnginePasResolver;
     function AddModuleWithIntfImplSrc(aFilename, InterfaceSrc,
       ImplementationSrc: string): TTestEnginePasResolver;
-    procedure AddSystemUnit;
-    procedure StartProgram(NeedSystemUnit: boolean);
+    procedure AddSystemUnit(Parts: TSystemUnitParts = []);
+    procedure StartProgram(NeedSystemUnit: boolean; SystemUnitParts: TSystemUnitParts = []);
     procedure StartUnit(NeedSystemUnit: boolean);
     property Modules[Index: integer]: TTestEnginePasResolver read GetModules;
     property ModuleCount: integer read GetModuleCount;
+    property ResolverEngine: TTestEnginePasResolver read FResolverEngine;
   Published
     Procedure TestEmpty;
+    // alias
     Procedure TestAliasType;
     Procedure TestAlias2Type;
     Procedure TestAliasTypeRefs;
+    // var, const
     Procedure TestVarLongint;
     Procedure TestVarInteger;
     Procedure TestConstInteger;
+    Procedure TestDuplicateVar;
+    // operators
     Procedure TestPrgAssignment;
     Procedure TestPrgProcVar;
     Procedure TestUnitProcVar;
+    // statements
     Procedure TestForLoop;
     Procedure TestStatements;
     Procedure TestCaseStatement;
     Procedure TestTryStatement;
     Procedure TestStatementsRefs;
+    // units
     Procedure TestUnitRef;
+    // procs
     Procedure TestProcParam;
     Procedure TestFunctionResult;
     Procedure TestProcOverload;
-    Procedure TestProcOverloadRefs;
+    Procedure TestProcOverloadWithBaseTypes;
+    Procedure TestProcOverloadWithClassTypes;
+    Procedure TestProcOverloadWithInhClassTypes;
+    Procedure TestProcOverloadWithInhAliasClassTypes;
+    Procedure TestProcDuplicate;
     Procedure TestNestedProc;
-    Procedure TestDuplicateVar;
+    Procedure TestForwardProc;
+    Procedure TestForwardProcUnresolved;
+    Procedure TestNestedForwardProc;
+    Procedure TestNestedForwardProcUnresolved;
+    Procedure TestForwardProcFuncMismatch;
+    Procedure TestForwardFuncResultMismatch;
+    Procedure TestUnitIntfProc;
+    Procedure TestUnitIntfProcUnresolved;
+    Procedure TestUnitIntfMismatchArgName;
+    Procedure TestProcOverloadIsNotFunc;
+    // record
     Procedure TestRecord;
     Procedure TestRecordVariant;
     Procedure TestRecordVariantNested;
-    property ResolverEngine: TTestEnginePasResolver read FResolverEngine;
+    // class
+    Procedure TestClass;
+    Procedure TestClassDefaultInheritance;
+    Procedure TestClassTripleInheritance;
+    Procedure TestClassForward;
+    Procedure TestClassForwardNotResolved;
+    Procedure TestClassMethod;
+    Procedure TestClassMethodUnresolved;
+    Procedure TestClassMethodAbstract;
+    Procedure TestClassMethodAbstractWithoutVirtual;
+    Procedure TestClassMethodAbstractHasBody;
+    Procedure TestClassMethodUnresolvedWithAncestor;
+    Procedure TestClassProcFuncMismatch;
+    Procedure TestClassMethodOverload;
+    Procedure TestClassMethodInvalidOverload;
+    Procedure TestClassOverride;
+    Procedure TestClassMethodScope;
+    Procedure TestClassIdentifierSelf;
+    Procedure TestClassCallInherited;
+    // property
+    Procedure TestProperty1;
+    Procedure TestPropertyAccessorNotInFront;
+    Procedure TestPropertyReadAccessorVarWrongType;
+    Procedure TestPropertyReadAccessorProcNotFunc;
+    Procedure TestPropertyReadAccessorFuncWrongResult;
+    Procedure TestPropertyReadAccessorFuncWrongArgCount;
+    Procedure TestPropertyReadAccessorFunc;
+    Procedure TestPropertyWriteAccessorVarWrongType;
+    Procedure TestPropertyWriteAccessorFuncNotProc;
+    Procedure TestPropertyWriteAccessorProcWrongArgCount;
+    Procedure TestPropertyWriteAccessorProcWrongArg;
+    Procedure TestPropertyWriteAccessorProcWrongArgType;
+    Procedure TestPropertyWriteAccessorProc;
+    Procedure TestPropertyTypeless;
+    Procedure TestPropertyTypelessNoAncestor;
+    Procedure TestPropertyStoredAccessorProcNotFunc;
+    Procedure TestPropertyStoredAccessorFuncWrongResult;
+    Procedure TestPropertyStoredAccessorFuncWrongArgCount;
+    Procedure TestPropertyArgs1;
   end;
 
 function LinesToStr(Args: array of const): string;
@@ -446,7 +512,7 @@ var
   begin
     p:=CommentStartP+2;
     Identifier:=ReadIdentifier(p);
-    //writeln('TTestResolver.CheckReferenceDirectives.AddPointer ',Identifier);
+    //writeln('TTestResolver.CheckReferenceDirectives.AddDirectReference ',Identifier);
     AddMarkerForTokenBehindComment(mkDirectReference,Identifier);
   end;
 
@@ -551,7 +617,7 @@ var
     El, LabelEl: TPasElement;
     Ref: TResolvedReference;
   begin
-    //writeln('CheckReference searching reference: ',aMarker^.Filename,' Line=',aMarker^.LineNumber,' Col=',aMarker^.StartCol,'-',aMarker^.EndCol,' Label="',aMarker^.Identifier,'"');
+    //writeln('CheckResolverReference searching reference: ',aMarker^.Filename,' Line=',aMarker^.LineNumber,' Col=',aMarker^.StartCol,'-',aMarker^.EndCol,' Label="',aMarker^.Identifier,'"');
     aLabel:=FindLabel(aMarker^.Identifier);
     if aLabel=nil then
       RaiseErrorAt('label "'+aMarker^.Identifier+'" not found',aMarker^.Filename,aMarker^.LineNumber,aMarker^.StartCol);
@@ -593,7 +659,7 @@ var
           Ref:=TResolvedReference(El.CustomData);
           write(' Decl=',GetObjName(Ref.Declaration));
           ResolverEngine.UnmangleSourceLineNumber(Ref.Declaration.SourceLinenumber,aLine,aCol);
-          write(Ref.Declaration.SourceFilename,'(',aLine,',',aCol,')');
+          write(',',Ref.Declaration.SourceFilename,'(',aLine,',',aCol,')');
           end
         else
           write(' has no TResolvedReference');
@@ -618,18 +684,23 @@ var
   // check if one element at {=a} is a TPasAliasType pointing to an element labeled {#a}
   var
     aLabel: PMarker;
-    ReferenceElements: TFPList;
-    i, LabelLine, LabelCol: Integer;
-    El: TPasElement;
-    DeclEl: TPasType;
+    ReferenceElements, LabelElements: TFPList;
+    i, LabelLine, LabelCol, j: Integer;
+    El, LabelEl: TPasElement;
+    DeclEl, TypeEl: TPasType;
   begin
-    //writeln('CheckPointer searching pointer: ',aMarker^.Filename,' Line=',aMarker^.LineNumber,' Col=',aMarker^.StartCol,'-',aMarker^.EndCol,' Label="',aMarker^.Identifier,'"');
+    writeln('CheckDirectReference searching pointer: ',aMarker^.Filename,' Line=',aMarker^.LineNumber,' Col=',aMarker^.StartCol,'-',aMarker^.EndCol,' Label="',aMarker^.Identifier,'"');
     aLabel:=FindLabel(aMarker^.Identifier);
     if aLabel=nil then
-      RaiseErrorAt('label "'+aMarker^.Identifier+'" not found',aMarker^.Filename,aMarker^.LineNumber,aMarker^.StartCol);
+      RaiseErrorAt('label "'+aMarker^.Identifier+'" not found',aMarker);
 
+    LabelElements:=nil;
     ReferenceElements:=nil;
     try
+      LabelElements:=FindElementsAt(aLabel^.Filename,aLabel^.LineNumber,aLabel^.StartCol,aLabel^.EndCol);
+      if LabelElements.Count=0 then
+        RaiseErrorAt('label "'+aLabel^.Identifier+'" has no elements',aLabel);
+
       ReferenceElements:=FindElementsAt(aMarker^.Filename,aMarker^.LineNumber,aMarker^.StartCol,aMarker^.EndCol);
       if ReferenceElements.Count=0 then
         RaiseErrorAt('reference "'+aMarker^.Identifier+'" has no elements',aMarker);
@@ -637,7 +708,19 @@ var
       for i:=0 to ReferenceElements.Count-1 do
         begin
         El:=TPasElement(ReferenceElements[i]);
-        if El.ClassType=TPasAliasType then
+        //writeln('CheckDirectReference ',i,'/',ReferenceElements.Count,' ',GetTreeDesc(El,2));
+        if El.ClassType=TPasVariable then
+          begin
+          AssertNotNull('TPasVariable(El='+El.Name+').VarType',TPasVariable(El).VarType);
+          TypeEl:=TPasVariable(El).VarType;
+          for j:=0 to LabelElements.Count-1 do
+            begin
+            LabelEl:=TPasElement(LabelElements[j]);
+            if TypeEl=LabelEl then
+              exit; // success
+            end;
+          end
+        else if El is TPasAliasType then
           begin
           DeclEl:=TPasAliasType(El).DestType;
           ResolverEngine.UnmangleSourceLineNumber(DeclEl.SourceLinenumber,LabelLine,LabelCol);
@@ -646,13 +729,36 @@ var
           and (aLabel^.StartCol<=LabelCol)
           and (aLabel^.EndCol>=LabelCol) then
             exit; // success
-          writeln('CheckDirectReference Decl at ',DeclEl.SourceFilename,'(',LabelLine,',',LabelCol,')');
-          RaiseErrorAt('wrong direct reference "'+aMarker^.Identifier+'"',aMarker);
+          end
+        else if El.ClassType=TPasArgument then
+          begin
+          TypeEl:=TPasArgument(El).ArgType;
+          for j:=0 to LabelElements.Count-1 do
+            begin
+            LabelEl:=TPasElement(LabelElements[j]);
+            if TypeEl=LabelEl then
+              exit; // success
+            end;
           end;
         end;
+      // failed -> show candidates
+      writeln('CheckDirectReference failed: Labels:');
+      for j:=0 to LabelElements.Count-1 do
+        begin
+        LabelEl:=TPasElement(LabelElements[j]);
+        writeln('  Label ',GetObjName(LabelEl),' at ',ResolverEngine.GetElementSourcePosStr(LabelEl));
+        end;
+      writeln('CheckDirectReference failed: References:');
+      for i:=0 to ReferenceElements.Count-1 do
+        begin
+        El:=TPasElement(ReferenceElements[i]);
+        writeln('  Reference ',GetObjName(El),' at ',ResolverEngine.GetElementSourcePosStr(El));
+        end;
+      RaiseErrorAt('wrong direct reference "'+aMarker^.Identifier+'"',aMarker);
     finally
+      LabelElements.Free;
+      ReferenceElements.Free;
     end;
-
   end;
 
 var
@@ -660,6 +766,7 @@ var
   i: Integer;
   SrcLines: TStringList;
 begin
+  Module.ForEachCall(@OnCheckElementParent,nil);
   FirstMarker:=nil;
   LastMarker:=nil;
   FoundRefs:=Default(TTestResolverReferenceData);
@@ -740,37 +847,50 @@ begin
   Result:=AddModuleWithSrc(aFilename,Src);
 end;
 
-procedure TTestResolver.AddSystemUnit;
+procedure TTestResolver.AddSystemUnit(Parts: TSystemUnitParts);
+var
+  Intf, Impl: TStringList;
 begin
-  AddModuleWithIntfImplSrc('system.pp',
-    // interface
-    LinesToStr([
-    'type',
-    '  integer=longint;',
-    '  sizeint=int64;',
+  Intf:=TStringList.Create;
+  // interface
+  Intf.Add('type');
+  Intf.Add('  integer=longint;');
+  Intf.Add('  sizeint=int64;');
     //'const',
     //'  LineEnding = #10;',
     //'  DirectorySeparator = ''/'';',
     //'  DriveSeparator = '''';',
     //'  AllowDirectorySeparators : set of char = [''\'',''/''];',
     //'  AllowDriveSeparators : set of char = [];',
-    'var',
-    '  ExitCode: Longint;',
+  if supTObject in Parts then
+    begin
+    Intf.Add('type');
+    Intf.Add('  TObject = class');
+    Intf.Add('  end;');
+    end;
+  Intf.Add('var');
+  Intf.Add('  ExitCode: Longint;');
     //'Procedure Move(const source;var dest;count:SizeInt);',
-    ''
-    // implementation
-    ]),LinesToStr([
-   // 'Procedure Move(const source;var dest;count:SizeInt);',
-   // 'begin',
-   // 'end;',
-    ''
-    ]));
+
+  // implementation
+  Impl:=TStringList.Create;
+    // 'Procedure Move(const source;var dest;count:SizeInt);',
+    // 'begin',
+    // 'end;',
+
+  try
+    AddModuleWithIntfImplSrc('system.pp',Intf.Text,Impl.Text);
+  finally
+    Intf.Free;
+    Impl.Free;
+  end;
 end;
 
-procedure TTestResolver.StartProgram(NeedSystemUnit: boolean);
+procedure TTestResolver.StartProgram(NeedSystemUnit: boolean;
+  SystemUnitParts: TSystemUnitParts);
 begin
   if NeedSystemUnit then
-    AddSystemUnit
+    AddSystemUnit(SystemUnitParts)
   else
     Parser.ImplicitUses.Clear;
   Add('program '+ExtractFileUnitName(MainFilename)+';');
@@ -846,7 +966,7 @@ var
   Line, Col: integer;
 begin
   ResolverEngine.UnmangleSourceLineNumber(El.SourceLinenumber,Line,Col);
-  //writeln('TTestResolver.OnFindReference ',GetObjName(El),' ',El.SourceFilename,' Line=',Line,',Col=',Col,' SearchFile=',Data^.Filename,',Line=',Data^.Line,',Col=',Data^.StartCol,'-',Data^.EndCol);
+  //writeln('TTestResolver.OnFindReference ',El.SourceFilename,' Line=',Line,',Col=',Col,' ',GetObjName(El),' SearchFile=',Data^.Filename,',Line=',Data^.Line,',Col=',Data^.StartCol,'-',Data^.EndCol);
   if (Data^.Filename=El.SourceFilename)
   and (Data^.Line=Line)
   and (Data^.StartCol<=Col)
@@ -855,6 +975,60 @@ begin
     Data^.Found.Add(El);
 end;
 
+procedure TTestResolver.OnCheckElementParent(data, arg: pointer);
+var
+  SubEl: TPasElement;
+  El: TPasElement absolute Data;
+  i: Integer;
+
+  procedure E(Msg: string);
+  var
+    s: String;
+  begin
+    s:='TTestResolver.OnCheckElementParent El='+GetTreeDesc(El)+' '+
+      ResolverEngine.GetElementSourcePosStr(El)+' '+Msg;
+    writeln('ERROR: ',s);
+    raise Exception.Create(s);
+  end;
+
+begin
+  if arg=nil then ;
+  //writeln('TTestResolver.OnCheckElementParent ',GetObjName(El));
+  if El is TBinaryExpr then
+    begin
+    if (TBinaryExpr(El).left<>nil) and (TBinaryExpr(El).left.Parent<>El) then
+      E('TBinaryExpr(El).left.Parent='+GetObjName(TBinaryExpr(El).left.Parent)+'<>El');
+    if (TBinaryExpr(El).right<>nil) and (TBinaryExpr(El).right.Parent<>El) then
+      E('TBinaryExpr(El).right.Parent='+GetObjName(TBinaryExpr(El).right.Parent)+'<>El');
+    end
+  else if El is TParamsExpr then
+    begin
+    if (TParamsExpr(El).Value<>nil) and (TParamsExpr(El).Value.Parent<>El) then
+      E('TParamsExpr(El).Value.Parent='+GetObjName(TParamsExpr(El).Value.Parent)+'<>El');
+    for i:=0 to length(TParamsExpr(El).Params)-1 do
+      if TParamsExpr(El).Params[i].Parent<>El then
+        E('TParamsExpr(El).Params[i].Parent='+GetObjName(TParamsExpr(El).Params[i].Parent)+'<>El');
+    end
+  else if El is TPasDeclarations then
+    begin
+    for i:=0 to TPasDeclarations(El).Declarations.Count-1 do
+      begin
+      SubEl:=TPasElement(TPasDeclarations(El).Declarations[i]);
+      if SubEl.Parent<>El then
+        E('SubEl=TPasElement(TPasDeclarations(El).Declarations[i])='+GetObjName(SubEl)+' SubEl.Parent='+GetObjName(SubEl.Parent)+'<>El');
+      end;
+    end
+  else if El is TPasImplBlock then
+    begin
+    for i:=0 to TPasImplBlock(El).Elements.Count-1 do
+      begin
+      SubEl:=TPasElement(TPasImplBlock(El).Elements[i]);
+      if SubEl.Parent<>El then
+        E('TPasElement(TPasImplBlock(El).Elements[i]).Parent='+GetObjName(SubEl.Parent)+'<>El');
+      end;
+    end;
+end;
+
 function TTestResolver.GetModules(Index: integer): TTestEnginePasResolver;
 begin
   Result:=TTestEnginePasResolver(FModules[Index]);
@@ -1010,6 +1184,28 @@ begin
   AssertEquals('c1 expr value','3',ExprC1.Value);
 end;
 
+procedure TTestResolver.TestDuplicateVar;
+var
+  ok: Boolean;
+begin
+  StartProgram(false);
+  Add('var a: longint;');
+  Add('var a: string;');
+  Add('begin');
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      begin
+      AssertEquals('Expected duplicate identifier, but got msg number "'+E.Message+'"',
+        PasResolver.nDuplicateIdentifier,E.MsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('duplicate identifier spotted',true,ok);
+end;
+
 procedure TTestResolver.TestPrgAssignment;
 var
   El: TPasElement;
@@ -1373,15 +1569,15 @@ begin
   Add('begin');
   Add('  Func1(3);');
   ParseProgram;
-  AssertEquals('1 declarations',1,PasProgram.ProgramSection.Declarations.Count);
+  AssertEquals('2 declarations',2,PasProgram.ProgramSection.Declarations.Count);
 
   El:=TPasElement(PasProgram.ProgramSection.Declarations[0]);
-  AssertEquals('overloaded proc',TPasOverloadedProc,El.ClassType);
+  AssertEquals('is function',TPasFunction,El.ClassType);
 
   AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
 end;
 
-procedure TTestResolver.TestProcOverloadRefs;
+procedure TTestResolver.TestProcOverloadWithBaseTypes;
 begin
   StartProgram(false);
   Add('function {#A}Func1(i: longint; j: longint = 0): longint; overload;');
@@ -1397,6 +1593,104 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestProcOverloadWithClassTypes;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class end;');
+  Add('  {#TA}TClassA = class end;');
+  Add('  {#TB}TClassB = class end;');
+  Add('procedure {#DoA}DoIt({=TA}p: TClassA); overload;');
+  Add('begin');
+  Add('end;');
+  Add('procedure {#DoB}DoIt({=TB}p: TClassB); overload;');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  {#A}{=TA}A: TClassA;');
+  Add('  {#B}{=TB}B: TClassB;');
+  Add('begin');
+  Add('  {@DoA}DoIt({@A}A)');
+  Add('  {@DoB}DoIt({@B}B)');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcOverloadWithInhClassTypes;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class end;');
+  Add('  {#TA}TClassA = class end;');
+  Add('  {#TB}TClassB = class(TClassA) end;');
+  Add('  {#TC}TClassC = class(TClassB) end;');
+  Add('procedure {#DoA}DoIt({=TA}p: TClassA); overload;');
+  Add('begin');
+  Add('end;');
+  Add('procedure {#DoB}DoIt({=TB}p: TClassB); overload;');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  {#A}{=TA}A: TClassA;');
+  Add('  {#B}{=TB}B: TClassB;');
+  Add('  {#C}{=TC}C: TClassC;');
+  Add('begin');
+  Add('  {@DoA}DoIt({@A}A)');
+  Add('  {@DoB}DoIt({@B}B)');
+  Add('  {@DoB}DoIt({@C}C)');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcOverloadWithInhAliasClassTypes;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class end;');
+  Add('  {#TA}TClassA = class end;');
+  Add('  {#TB}{=TA}TClassB = TClassA;');
+  Add('  {#TC}TClassC = class(TClassB) end;');
+  Add('procedure {#DoA}DoIt({=TA}p: TClassA); overload;');
+  Add('begin');
+  Add('end;');
+  Add('procedure {#DoC}DoIt({=TC}p: TClassC); overload;');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  {#A}{=TA}A: TClassA;');
+  Add('  {#B}{=TB}B: TClassB;');
+  Add('  {#C}{=TC}C: TClassC;');
+  Add('begin');
+  Add('  {@DoA}DoIt({@A}A)');
+  Add('  {@DoA}DoIt({@B}B)');
+  Add('  {@DoC}DoIt({@C}C)');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcDuplicate;
+var
+  ok: Boolean;
+begin
+  StartProgram(false);
+  Add('procedure ProcA(i: longint);');
+  Add('begin');
+  Add('end;');
+  Add('procedure ProcA(i: longint);');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      begin
+      AssertEquals('Expected duplicate identifier, but got msg number "'+E.Message+'"',
+        PasResolver.nDuplicateIdentifier,E.MsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('duplicate identifier spotted',true,ok);
+end;
+
 procedure TTestResolver.TestNestedProc;
 begin
   StartProgram(false);
@@ -1421,13 +1715,29 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.TestDuplicateVar;
+procedure TTestResolver.TestForwardProc;
+begin
+  StartProgram(false);
+  Add('procedure {#A_forward}FuncA(i: longint); forward;');
+  Add('procedure {#B}FuncB(i: longint);');
+  Add('begin');
+  Add('  {@A_forward}FuncA(i);');
+  Add('end;');
+  Add('procedure {#A}FuncA(i: longint);');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  Add('  {@A}FuncA(3);');
+  Add('  {@B}FuncB(3);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestForwardProcUnresolved;
 var
   ok: Boolean;
 begin
   StartProgram(false);
-  Add('var a: longint;');
-  Add('var a: string;');
+  Add('procedure FuncA(i: longint); forward;');
   Add('begin');
   ok:=false;
   try
@@ -1435,70 +1745,1113 @@ begin
   except
     on E: EPasResolve do
       begin
-      AssertEquals('Expected duplicate identifier, but got msg number "'+E.Message+'"',
-        PasResolver.nDuplicateIdentifier,E.MsgNumber);
+      AssertEquals('Expected forward proc not resolved, but got msg number "'+E.Message+'"',
+        PasResolver.nForwardProcNotResolved,E.MsgNumber);
       ok:=true;
       end;
   end;
-  AssertEquals('duplicate identifier spotted',true,ok);
+  AssertEquals('unresolved forward proc raised an error',true,ok);
 end;
 
-procedure TTestResolver.TestRecord;
+procedure TTestResolver.TestNestedForwardProc;
 begin
   StartProgram(false);
-  Add('type');
-  Add('  {#TRec}TRec = record');
-  Add('    {#Size}Size: longint;');
+  Add('procedure {#A}FuncA;');
+  Add('  procedure {#B_forward}ProcB(i: longint); forward;');
+  Add('  procedure {#C}ProcC(i: longint);');
+  Add('  begin');
+  Add('    {@B_forward}ProcB(i);');
+  Add('  end;');
+  Add('  procedure {#B}ProcB(i: longint);');
+  Add('  begin');
   Add('  end;');
-  Add('var');
-  Add('  {#r}{=TRec}r: TRec;');
   Add('begin');
-  Add('  {@r}r.{@Size}Size:=3;');
+  Add('  {@B}ProcB(3);');
+  Add('  {@C}ProcC(3);');
+  Add('end;');
+  Add('begin');
+  Add('  {@A}FuncA;');
   ParseProgram;
 end;
 
-procedure TTestResolver.TestRecordVariant;
+procedure TTestResolver.TestNestedForwardProcUnresolved;
+var
+  ok: Boolean;
 begin
   StartProgram(false);
-  Add('type');
-  Add('  {#TRec}TRec = record');
-  Add('    {#Size}Size: longint;');
-  Add('    case {#vari}vari: longint of');
-  Add('    0: ({#b}b: longint)');
-  Add('  end;');
-  Add('var');
-  Add('  {#r}{=TRec}r: TRec;');
+  Add('procedure FuncA;');
+  Add('  procedure ProcB(i: longint); forward;');
   Add('begin');
-  Add('  {@r}r.{@Size}Size:=3;');
-  Add('  {@r}r.{@vari}vari:=4;');
-  Add('  {@r}r.{@b}b:=5;');
-  ParseProgram;
+  Add('end;');
+  Add('begin');
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      begin
+      AssertEquals('Expected forward proc not resolved, but got msg number "'+E.Message+'"',
+        PasResolver.nForwardProcNotResolved,E.MsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('unresolved forward proc raised an error',true,ok);
 end;
 
-procedure TTestResolver.TestRecordVariantNested;
+procedure TTestResolver.TestForwardProcFuncMismatch;
+var
+  ok: Boolean;
 begin
   StartProgram(false);
-  Add('type');
-  Add('  {#TRec}TRec = record');
-  Add('    {#Size}Size: longint;');
-  Add('    case {#vari}vari: longint of');
-  Add('    0: ({#b}b: longint)');
-  Add('    1: ({#c}c:');
-  Add('          record');
-  Add('            {#d}d: longint;');
-  Add('            case {#e}e: longint of');
-  Add('            0: ({#f}f: longint)');
-  Add('          end)');
-  Add('  end;');
-  Add('var');
-  Add('  {#r}{=TRec}r: TRec;');
+  Add('procedure DoIt; forward;');
+  Add('function DoIt: longint;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      begin
+      AssertEquals('Expected "procedure expected, but function found", but got msg number "'+E.Message+'"',
+        PasResolver.nXExpectedButYFound,E.MsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('proc type mismatch raised an error',true,ok);
+end;
+
+procedure TTestResolver.TestForwardFuncResultMismatch;
+var
+  ok: Boolean;
+begin
+  StartProgram(false);
+  Add('function DoIt: longint; forward;');
+  Add('function DoIt: string;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      begin
+      AssertEquals('Expected "Result type mismatch", but got msg number "'+E.Message+'"',
+        PasResolver.nResultTypeMismatchExpectedButFound,E.MsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('function result type mismatch raised an error',true,ok);
+end;
+
+procedure TTestResolver.TestUnitIntfProc;
+begin
+  StartUnit(false);
+  Add('interface');
+  Add('procedure {#A_forward}FuncA(i: longint);');
+  Add('implementation');
+  Add('procedure {#A}FuncA(i: longint);');
+  Add('begin');
+  Add('end;');
+  Add('initialization');
+  Add('  {@A}FuncA(3);');
+  ParseUnit;
+end;
+
+procedure TTestResolver.TestUnitIntfProcUnresolved;
+var
+  ok: Boolean;
+begin
+  StartUnit(false);
+  Add('interface');
+  Add('procedure {#A_forward}FuncA(i: longint);');
+  Add('implementation');
+  Add('initialization');
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      begin
+      AssertEquals('Expected forward proc not resolved, but got msg number "'+E.Message+'"',
+        PasResolver.nForwardProcNotResolved,E.MsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('unresolved forward proc raised an error',true,ok);
+end;
+
+procedure TTestResolver.TestUnitIntfMismatchArgName;
+var
+  ok: Boolean;
+begin
+  StartUnit(false);
+  Add('interface');
+  Add('procedure {#A_forward}ProcA(i: longint);');
+  Add('implementation');
+  Add('procedure {#A}ProcA(j: longint);');
+  Add('begin');
+  Add('end;');
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      begin
+      AssertEquals('Expected function header "ProcA" doesn''t match forward : var name changes, but got msg number "'+E.Message+'"',
+        PasResolver.nFunctionHeaderMismatchForwardVarName,E.MsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('mismatch proc argument name raised an error',true,ok);
+end;
+
+procedure TTestResolver.TestProcOverloadIsNotFunc;
+var
+  ok: Boolean;
+begin
+  StartUnit(false);
+  Add('interface');
+  Add('var ProcA: longint;');
+  Add('procedure {#A_Decl}ProcA(i: longint);');
+  Add('implementation');
+  Add('procedure {#A_Impl}ProcA(i: longint);');
+  Add('begin');
+  Add('end;');
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      begin
+      AssertEquals('Expected Duplicate identifier, but got msg number "'+E.Message+'"',
+        PasResolver.nDuplicateIdentifier,E.MsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('overload proc/var raised an error',true,ok);
+end;
+
+procedure TTestResolver.TestRecord;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TRec}TRec = record');
+  Add('    {#Size}Size: longint;');
+  Add('  end;');
+  Add('var');
+  Add('  {#r}{=TRec}r: TRec;');
+  Add('begin');
+  Add('  {@r}r.{@Size}Size:=3;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestRecordVariant;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TRec}TRec = record');
+  Add('    {#Size}Size: longint;');
+  Add('    case {#vari}vari: longint of');
+  Add('    0: ({#b}b: longint)');
+  Add('  end;');
+  Add('var');
+  Add('  {#r}{=TRec}r: TRec;');
+  Add('begin');
+  Add('  {@r}r.{@Size}Size:=3;');
+  Add('  {@r}r.{@vari}vari:=4;');
+  Add('  {@r}r.{@b}b:=5;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestRecordVariantNested;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TRec}TRec = record');
+  Add('    {#Size}Size: longint;');
+  Add('    case {#vari}vari: longint of');
+  Add('    0: ({#b}b: longint)');
+  Add('    1: ({#c}c:');
+  Add('          record');
+  Add('            {#d}d: longint;');
+  Add('            case {#e}e: longint of');
+  Add('            0: ({#f}f: longint)');
+  Add('          end)');
+  Add('  end;');
+  Add('var');
+  Add('  {#r}{=TRec}r: TRec;');
+  Add('begin');
+  Add('  {@r}r.{@Size}Size:=3;');
+  Add('  {@r}r.{@vari}vari:=4;');
+  Add('  {@r}r.{@b}b:=5;');
+  Add('  {@r}r.{@c}c.{@d}d:=6;');
+  Add('  {@r}r.{@c}c.{@e}e:=7;');
+  Add('  {@r}r.{@c}c.{@f}f:=8;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClass;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class');
+  Add('    {#B}b: longint;');
+  Add('  end;');
+  Add('var');
+  Add('  {#C}{=TOBJ}c: TObject;');
+  Add('begin');
+  Add('  {@C}c.{@b}b:=3;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassDefaultInheritance;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class');
+  Add('    {#OBJ_a}a: longint;');
+  Add('    {#OBJ_b}b: longint;');
+  Add('  end;');
+  Add('  {#A}TClassA = class');
+  Add('    {#A_a}a: longint;');
+  Add('    {#A_c}c: longint;');
+  Add('  end;');
+  Add('var');
+  Add('  {#V}{=A}v: TClassA;');
+  Add('begin');
+  Add('  {@V}v.{@A_c}c:=2;');
+  Add('  {@V}v.{@OBJ_b}b:=3;');
+  Add('  {@V}v.{@A_a}a:=4;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassTripleInheritance;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class');
+  Add('    {#OBJ_a}a: longint;');
+  Add('    {#OBJ_b}b: longint;');
+  Add('  end;');
+  Add('  {#A}TClassA = class');
+  Add('    {#A_a}a: longint;');
+  Add('    {#A_c}c: longint;');
+  Add('  end;');
+  Add('  {#B}TClassB = class(TClassA)');
+  Add('    {#B_a}a: longint;');
+  Add('    {#B_d}d: longint;');
+  Add('  end;');
+  Add('var');
+  Add('  {#V}{=B}v: TClassB;');
+  Add('begin');
+  Add('  {@V}v.{@B_d}d:=1;');
+  Add('  {@V}v.{@A_c}c:=2;');
+  Add('  {@V}v.{@OBJ_B}b:=3;');
+  Add('  {@V}v.{@B_a}a:=4;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassForward;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('  {#B_forward}TClassB = class;');
+  Add('  {#A}TClassA = class');
+  Add('    {#A_a}a: longint;');
+  Add('    {#A_b}{=B_forward}b: TClassB;');
+  Add('  end;');
+  Add('  {#B}TClassB = class(TClassA)');
+  Add('    {#B_a}a: longint;');
+  Add('    {#B_d}d: longint;');
+  Add('  end;');
+  Add('var');
+  Add('  {#V}{=B}v: TClassB;');
+  Add('begin');
+  Add('  {@V}v.{@B_d}d:=1;');
+  Add('  {@V}v.{@B_a}a:=2;');
+  Add('  {@V}v.{@A_b}b:=nil;');
+  Add('  {@V}v.{@A_b}b.{@B_a}a:=nil;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassForwardNotResolved;
+var
+  ErrorNo: Integer;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('  TClassB = class;');
+  Add('var');
+  Add('  v: TClassB;');
+  Add('begin');
+  ErrorNo:=0;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      ErrorNo:=E.MsgNumber;
+  end;
+  AssertEquals('Forward class not resolved raises correct error',nForwardTypeNotResolved,ErrorNo);
+end;
+
+procedure TTestResolver.TestClassMethod;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('  {#A}TClassA = class');
+  Add('    procedure {#A_ProcA_Decl}ProcA;');
+  Add('  end;');
+  Add('procedure TClassA.ProcA;');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  {#V}{=A}v: TClassA;');
+  Add('begin');
+  Add('  {@V}v.{@A_ProcA_Decl}ProcA;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassMethodUnresolved;
+var
+  ok: Boolean;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('  TClassA = class');
+  Add('    procedure ProcA;');
+  Add('  end;');
+  Add('begin');
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      begin
+      AssertEquals('Expected forward proc not resolved, but got msg number "'+E.Message+'"',
+        PasResolver.nForwardProcNotResolved,E.MsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('unresolved forward proc raised an error',true,ok);
+end;
+
+procedure TTestResolver.TestClassMethodAbstract;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure ProcA; virtual; abstract;');
+  Add('  end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassMethodAbstractWithoutVirtual;
+var
+  ok: Boolean;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure ProcA; abstract;');
+  Add('  end;');
+  Add('begin');
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      begin
+      AssertEquals('Expected abstract without virtual, but got msg number "'+E.Message+'"',
+        PasResolver.nInvalidProcModifiers,E.MsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('abstract method without virtual raised an error',true,ok);
+end;
+
+procedure TTestResolver.TestClassMethodAbstractHasBody;
+var
+  ok: Boolean;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure ProcA; virtual; abstract;');
+  Add('  end;');
+  Add('procedure TObject.ProcA;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      begin
+      AssertEquals('Expected abstract must not have implementation, but got msg number "'+E.Message+'"',
+        PasResolver.nAbstractMethodsMustNotHaveImplementation,E.MsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('abstract method with body raised an error',true,ok);
+end;
+
+procedure TTestResolver.TestClassMethodUnresolvedWithAncestor;
+var
+  ok: Boolean;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure ProcA; virtual; abstract;');
+  Add('  end;');
+  Add('  TClassA = class');
+  Add('    procedure ProcA;');
+  Add('  end;');
+  Add('begin');
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      begin
+      AssertEquals('Expected forward proc not resolved, but got msg number "'+E.Message+'"',
+        PasResolver.nForwardProcNotResolved,E.MsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('unresolved forward proc raised an error',true,ok);
+end;
+
+procedure TTestResolver.TestClassProcFuncMismatch;
+var
+  ok: Boolean;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure DoIt;');
+  Add('  end;');
+  Add('function TObject.DoIt: longint;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      begin
+      AssertEquals('Expected "procedure expected, but function found", but got msg number "'+E.Message+'"',
+        PasResolver.nXExpectedButYFound,E.MsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('proc type mismatch raised an error',true,ok);
+end;
+
+procedure TTestResolver.TestClassMethodOverload;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure DoIt;');
+  Add('    procedure DoIt(i: longint);');
+  Add('    procedure DoIt(s: string);');
+  Add('  end;');
+  Add('procedure TObject.DoIt;');
+  Add('begin');
+  Add('end;');
+  Add('procedure TObject.DoIt(i: longint);');
+  Add('begin');
+  Add('end;');
+  Add('procedure TObject.DoIt(s: string);');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassMethodInvalidOverload;
+var
+  ok: Boolean;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure DoIt(i: longint);');
+  Add('    procedure DoIt(k: longint);');
+  Add('  end;');
+  Add('procedure TObject.DoIt(i: longint);');
+  Add('begin');
+  Add('end;');
+  Add('procedure TObject.DoIt(k: longint);');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      begin
+      AssertEquals('Expected Duplicate identifier, but got msg number "'+E.Message+'"',
+        PasResolver.nDuplicateIdentifier,E.MsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('duplicate method signature raised an error',true,ok);
+end;
+
+procedure TTestResolver.TestClassOverride;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure {#TOBJ_ProcA}ProcA; virtual; abstract;');
+  Add('  end;');
+  Add('  {#A}TClassA = class');
+  Add('    procedure {#A_ProcA}ProcA; override;');
+  Add('  end;');
+  Add('procedure TClassA.ProcA;');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  {#V}{=A}v: TClassA;');
+  Add('begin');
+  Add('  {@V}v.{@A_ProcA}ProcA;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassMethodScope;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('  {#A}TClassA = class');
+  Add('    {#A_A}A: longint;');
+  Add('    procedure {#A_ProcB}ProcB;');
+  Add('  end;');
+  Add('procedure TClassA.ProcB;');
+  Add('begin');
+  Add('  {@A_A}A:=3;');
+  Add('end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassIdentifierSelf;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    {#C}C: longint;');
+  Add('  end;');
+  Add('  {#A}TClassA = class');
+  Add('    {#B}B: longint;');
+  Add('    procedure {#A_ProcB}ProcB;');
+  Add('  end;');
+  Add('procedure TClassA.ProcB;');
+  Add('begin');
+  Add('  {@B}B:=1;');
+  Add('  {@C}C:=2;');
+  Add('  {@A}Self.{@B}B:=3;');
+  Add('end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassCallInherited;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure {#TOBJ_ProcA}ProcA(i: longint);');
+  Add('    procedure {#TOBJ_ProcB}ProcB(j: longint);');
+  Add('  end;');
+  Add('  {#A}TClassA = class');
+  Add('    procedure {#A_ProcA}ProcA(i: longint);');
+  Add('    procedure {#A_ProcB}ProcB(k: longint);');
+  Add('  end;');
+  Add('procedure TObject.ProcA(i: longint);');
+  Add('begin');
+  Add('  inherited; // ignore and do not raise error');
+  Add('end;');
+  Add('procedure TObject.ProcB(j: longint);');
+  Add('begin');
+  Add('end;');
+  Add('procedure TClassA.ProcA({#i1}i: longint);');
+  Add('begin');
+  Add('  {@A_ProcA}ProcA;');
+  Add('  {@TOBJ_ProcA}inherited;');
+  Add('  inherited {@TOBJ_ProcA}ProcA({@i1}i);');
+  Add('  {@A_ProcB}ProcB;');
+  Add('  inherited {@TOBJ_ProcB}ProcB({@i1}i);');
+  Add('end;');
+  Add('procedure TClassA.ProcB(k: longint);');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProperty1;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class');
+  Add('  end;');
+  Add('  {#A}TClassA = class');
+  Add('    {#FB}FB: longint;');
+  Add('    property {#B}B: longint read {@FB}FB write {@FB}FB;');
+  Add('  end;');
+  Add('var');
+  Add('  {#v}{=A}v: TClassA;');
+  Add('begin');
+  Add('  {@v}v.{@b}b:=3;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestPropertyAccessorNotInFront;
+var
+  ok: Boolean;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    property B: longint read FB;');
+  Add('    FB: longint;');
+  Add('  end;');
+  Add('begin');
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      begin
+      AssertEquals('Expected Identifier not found, but got msg number "'+E.Message+'"',
+        PasResolver.nIdentifierNotFound,E.MsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('property accessor not in front raised an error',true,ok);
+end;
+
+procedure TTestResolver.TestPropertyReadAccessorVarWrongType;
+var
+  ok: Boolean;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FB: string;');
+  Add('    property B: longint read FB;');
+  Add('  end;');
+  Add('begin');
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      begin
+      AssertEquals('Expected Longint expected, but String found, but got msg number "'+E.Message+'"',
+        PasResolver.nXExpectedButYFound,E.MsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('property read accessor wrong type raised an error',true,ok);
+end;
+
+procedure TTestResolver.TestPropertyReadAccessorProcNotFunc;
+var
+  ok: Boolean;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure GetB;');
+  Add('    property B: longint read GetB;');
+  Add('  end;');
+  Add('begin');
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      begin
+      AssertEquals('Expected function expected, but procedure found, but got msg number "'+E.Message+'"',
+        PasResolver.nXExpectedButYFound,E.MsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('property read accessor wrong function type raised an error',true,ok);
+end;
+
+procedure TTestResolver.TestPropertyReadAccessorFuncWrongResult;
+var
+  ok: Boolean;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    function GetB: string;');
+  Add('    property B: longint read GetB;');
+  Add('  end;');
+  Add('begin');
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      begin
+      AssertEquals('Expected function result longint expected, but function result string found, but got msg number "'+E.Message+'"',
+        PasResolver.nXExpectedButYFound,E.MsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('property read accessor function wrong result type raised an error',true,ok);
+end;
+
+procedure TTestResolver.TestPropertyReadAccessorFuncWrongArgCount;
+var
+  ok: Boolean;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    function GetB(i: longint): string;');
+  Add('    property B: longint read GetB;');
+  Add('  end;');
+  Add('begin');
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      begin
+      AssertEquals('Expected function arg count 0 expected, but 1 found, but got msg number "'+E.Message+'"',
+        PasResolver.nXExpectedButYFound,E.MsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('property read accessor function wrong arg count raised an error',true,ok);
+end;
+
+procedure TTestResolver.TestPropertyReadAccessorFunc;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class');
+  Add('    function {#GetB}GetB: longint;');
+  Add('    property {#B}B: longint read {@GetB}GetB;');
+  Add('  end;');
+  Add('function TObject.GetB: longint;');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  {#o}{=TOBJ}o: TObject;');
+  Add('begin');
+  Add('  {@o}o.{@B}B:=3;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestPropertyWriteAccessorVarWrongType;
+var
+  ok: Boolean;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FB: string;');
+  Add('    property B: longint write FB;');
+  Add('  end;');
+  Add('begin');
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      begin
+      AssertEquals('Expected Longint expected, but String found, but got msg number "'+E.Message+'"',
+        PasResolver.nXExpectedButYFound,E.MsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('property read accessor wrong type raised an error',true,ok);
+end;
+
+procedure TTestResolver.TestPropertyWriteAccessorFuncNotProc;
+var
+  ok: Boolean;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    function SetB: longint;');
+  Add('    property B: longint write SetB;');
+  Add('  end;');
+  Add('begin');
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      begin
+      AssertEquals('Expected procedure expected, but function found, but got msg number "'+E.Message+'"',
+        PasResolver.nXExpectedButYFound,E.MsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('property write accessor wrong function instead of proc raised an error',true,ok);
+end;
+
+procedure TTestResolver.TestPropertyWriteAccessorProcWrongArgCount;
+var
+  ok: Boolean;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure SetB;');
+  Add('    property B: longint write SetB;');
+  Add('  end;');
+  Add('begin');
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      begin
+      AssertEquals('Expected procedure arg count 1 expected, but 0 found, but got msg number "'+E.Message+'"',
+        PasResolver.nXExpectedButYFound,E.MsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('property write accessor procedure wrong arg count raised an error',true,ok);
+end;
+
+procedure TTestResolver.TestPropertyWriteAccessorProcWrongArg;
+var
+  ok: Boolean;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure SetB(var Value: longint);');
+  Add('    property B: longint write SetB;');
+  Add('  end;');
+  Add('begin');
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      begin
+      AssertEquals('Expected procedure arg longint expected, but var found, but got msg number "'+E.Message+'"',
+        PasResolver.nXExpectedButYFound,E.MsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('property write accessor procedure wrong arg type raised an error',true,ok);
+end;
+
+procedure TTestResolver.TestPropertyWriteAccessorProcWrongArgType;
+var
+  ok: Boolean;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure SetB(Value: string);');
+  Add('    property B: longint write SetB;');
+  Add('  end;');
+  Add('begin');
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      begin
+      AssertEquals('Expected procedure(Value: longint) expected, but procedure(Value: string) found, but got msg number "'+E.Message+'"',
+        PasResolver.nXExpectedButYFound,E.MsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('property write accessor procedure wrong arg type raised an error',true,ok);
+end;
+
+procedure TTestResolver.TestPropertyWriteAccessorProc;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class');
+  Add('    procedure {#SetB}SetB(Value: longint);');
+  Add('    property {#B}B: longint write {@SetB}SetB;');
+  Add('  end;');
+  Add('procedure TObject.SetB(Value: longint);');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  {#o}{=TOBJ}o: TObject;');
+  Add('begin');
+  Add('  {@o}o.{@B}B:=3;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestPropertyTypeless;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class');
+  Add('    {#FB}FB: longint;');
+  Add('    property {#TOBJ_B}B: longint read {@FB}FB;');
+  Add('  end;');
+  Add('  {#TA}TClassA = class');
+  Add('    {#FC}FC: longint;');
+  Add('    property {#TA_B}{@TOBJ_B}B read {@FC}FC;');
+  Add('  end;');
+  Add('var');
+  Add('  {#v}{=TA}v: TClassA;');
+  Add('begin');
+  Add('  {@v}v.{@TA_B}B:=3;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestPropertyTypelessNoAncestor;
+var
+  ok: Boolean;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('  TClassA = class');
+  Add('    property B;');
+  Add('  end;');
+  Add('begin');
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      begin
+      AssertEquals('Expected no property found to override, but got msg number "'+E.Message+'"',
+        PasResolver.nNoPropertyFoundToOverride,E.MsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('property typeless without ancestor property raised an error',true,ok);
+end;
+
+procedure TTestResolver.TestPropertyStoredAccessorProcNotFunc;
+var
+  ok: Boolean;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FB: longint;');
+  Add('    procedure GetB;');
+  Add('    property B: longint read FB stored GetB;');
+  Add('  end;');
+  Add('begin');
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      begin
+      AssertEquals('Expected function expected, but procedure found, but got msg number "'+E.Message+'"',
+        PasResolver.nXExpectedButYFound,E.MsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('property stored accessor wrong function type raised an error',true,ok);
+end;
+
+procedure TTestResolver.TestPropertyStoredAccessorFuncWrongResult;
+var
+  ok: Boolean;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FB: longint;');
+  Add('    function GetB: string;');
+  Add('    property B: longint read FB stored GetB;');
+  Add('  end;');
+  Add('begin');
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      begin
+      AssertEquals('Expected function result longint expected, but function result string found, but got msg number "'+E.Message+'"',
+        PasResolver.nXExpectedButYFound,E.MsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('property stored accessor function wrong result type raised an error',true,ok);
+end;
+
+procedure TTestResolver.TestPropertyStoredAccessorFuncWrongArgCount;
+var
+  ok: Boolean;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FB: longint;');
+  Add('    function GetB(i: longint): boolean;');
+  Add('    property B: longint read FB stored GetB;');
+  Add('  end;');
+  Add('begin');
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      begin
+      AssertEquals('Expected function arg count 0 expected, but 1 found, but got msg number "'+E.Message+'"',
+        PasResolver.nXExpectedButYFound,E.MsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('property stored accessor function wrong arg count raised an error',true,ok);
+end;
+
+procedure TTestResolver.TestPropertyArgs1;
+begin
+  exit;
+
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    function GetB(Index: longint): boolean;');
+  Add('    procedure SetB(Index: longint; Value: longint);');
+  Add('    property B[Index: longint]: longint read GetB write SetB;');
+  Add('  end;');
+  Add('function TObject.GetB(Index: longint): boolean;');
+  Add('begin');
+  Add('end;');
+  Add('procedure TObject.SetB(Index: longint; Value: longint);');
+  Add('begin');
+  Add('end;');
   Add('begin');
-  Add('  {@r}r.{@Size}Size:=3;');
-  Add('  {@r}r.{@vari}vari:=4;');
-  Add('  {@r}r.{@b}b:=5;');
-  Add('  {@r}r.{@c}c.{@d}d:=6;');
-  Add('  {@r}r.{@c}c.{@e}e:=7;');
-  Add('  {@r}r.{@c}c.{@f}f:=8;');
   ParseProgram;
 end;
 

packages/fcl-passrc/tests/tctypeparser.pas

@@ -154,6 +154,7 @@ type
     Procedure TestReferenceFile;
     Procedure TestReferenceArray;
     Procedure TestReferencePointer;
+    Procedure TestInvalidColon;
   end;
 
   { TTestRecordTypeParser }
@@ -3183,6 +3184,19 @@ begin
   AssertSame('Second declaration references first.',Declarations.Types[0],TPasPointerType(Declarations.Types[1]).DestType);
 end;
 
+procedure TTestTypeParser.TestInvalidColon;
+var
+  ok: Boolean;
+begin
+  ok:=false;
+  try
+    ParseType(':1..2',TPasSetType);
+  except
+    on E: EParserError do
+      ok:=true;
+  end;
+  AssertEquals('wrong colon in type raised an error',true,ok);
+end;
 
 initialization
   RegisterTests([TTestTypeParser,TTestRecordTypeParser,TTestProcedureTypeParser]);

packages/pastojs/tests/tcconverter.pp

@@ -333,11 +333,6 @@ begin
   AssertEquals('Correct condition class',TJSUnaryNotExpression,E.Cond.ClassType);
   AssertIdentifier('Conditional expression',TJSUnaryNotExpression(E.Cond).A,'a');
   L:=AssertListStatement('Multiple statements',E.Body);
-  //  writeln('TTestStatementConverter.TestRepeatUntilStatementTwo L.A=',L.A.ClassName);
-  // writeln('  L.B=',L.B.ClassName);
-  // writeln('  L.B.A=',TJSStatementList(L.B).A.ClassName);
-  // writeln('  L.B.B=',TJSStatementList(L.B).B.ClassName);
-
   AssertAssignStatement('First List statement is assignment',L.A,'b','c');
   AssertAssignStatement('Second List statement is assignment',L.B,'d','e');
 end;