fcl-passrc: fixed checking proc arg base type from different units, fixed scanner eof row, fixed fail test messages

git-svn-id: trunk@35728 -

packages/fcl-passrc/src/pasresolver.pp

@@ -125,6 +125,7 @@ Works:
   - Delphi without @
   - FPC equal and not equal
   - "is nested"
+  - bark on arguments access mismatch
 - function without params: mark if call or address, rrfImplicitCallWithoutParams
 - procedure break, procedure continue
 - built-in functions pred, succ for range type and enums
@@ -212,7 +213,7 @@ const
   nCantDetermineWhichOverloadedFunctionToCall = 3013;
   nForwardTypeNotResolved = 3014;
   nForwardProcNotResolved = 3015;
-  nInvalidXModifiersY = 3016;
+  nInvalidXModifierY = 3016;
   nAbstractMethodsMustNotHaveImplementation = 3017;
   nCallingConventionMismatch = 3018;
   nResultTypeMismatchExpectedButFound = 3019;
@@ -249,6 +250,8 @@ const
   nVirtualMethodXHasLowerVisibility = 3050; // FPC 3250
   nExternalClassInstanceCannotAccessStaticX = 3051;
   nXModifierMismatchY = 3052;
+  nSymbolCannotBePublished = 3053;
+  nCannotTypecastAType = 3054;
 
 // resourcestring patterns of messages
 resourcestring
@@ -267,7 +270,7 @@ resourcestring
   sCantDetermineWhichOverloadedFunctionToCall = 'Can''t determine which overloaded function to call';
   sForwardTypeNotResolved = 'Forward type not resolved "%s"';
   sForwardProcNotResolved = 'Forward %s not resolved "%s"';
-  sInvalidXModifiersY = 'Invalid %s modifiers %s';
+  sInvalidXModifierY = 'Invalid %s modifier %s';
   sAbstractMethodsMustNotHaveImplementation = 'Abstract method must not have an implementation.';
   sCallingConventionMismatch = 'Calling convention mismatch';
   sResultTypeMismatchExpectedButFound = 'Result type mismatch, expected %s, but found %s';
@@ -304,6 +307,8 @@ resourcestring
   sVirtualMethodXHasLowerVisibility = 'Virtual method "%s" has a lower visibility (%s) than parent class %s (%s)';
   sExternalClassInstanceCannotAccessStaticX = 'External class instance cannot access static %s';
   sXModifierMismatchY = '%s modifier "%s" mismatch';
+  sSymbolCannotBePublished = 'Symbol cannot be published. Only methods and properties.';
+  sCannotTypecastAType = 'Cannot type cast a type';
 
 type
   TResolverBaseType = (
@@ -581,10 +586,6 @@ type
     pikBuiltInProc,  // e.g. High(), SetLength()
     pikSimple, // simple vars, consts, types, enums
     pikProc // may need parameter list with round brackets
-    {
-    pikIndexedProperty, // may need parameter list with edged brackets
-    pikGeneric, // may need parameter list with angle brackets
-    pikDottedUses // namespace, needs dotted identifierss }
     );
   TPasIdentifierKinds = set of TPasIdentifierKind;
 
@@ -1288,11 +1289,11 @@ type
     procedure RaiseXExpectedButYFound(id: int64; const X,Y: string; El: TPasElement);
     procedure RaiseConstantExprExp(id: int64; ErrorEl: TPasElement);
     procedure RaiseIncompatibleTypeDesc(id: int64; MsgNumber: integer;
-      const Args: array of const; const DescA,DescB: String; ErrorEl: TPasElement);
+      const Args: array of const; const GotDesc, ExpDesc: String; ErrorEl: TPasElement);
     procedure RaiseIncompatibleType(id: int64; MsgNumber: integer;
-      const Args: array of const; TypeA, TypeB: TPasType; ErrorEl: TPasElement);
+      const Args: array of const; GotType, ExpType: TPasType; ErrorEl: TPasElement);
     procedure RaiseIncompatibleTypeRes(id: int64; MsgNumber: integer;
-      const Args: array of const; const TypeA, TypeB: TPasResolverResult;
+      const Args: array of const; const GotType, ExpType: TPasResolverResult;
       ErrorEl: TPasElement);
     procedure WriteScopes;
     // find value and type of an element
@@ -1478,6 +1479,8 @@ function GetTypeDesc(aType: TPasType; AddPath: boolean): string;
     s: String;
   begin
     Result:=aType.Name;
+    if Result='' then
+      Result:=aType.ElementTypeName;
     if AddPath then
       begin
       s:=aType.FullPath;
@@ -1489,7 +1492,7 @@ function GetTypeDesc(aType: TPasType; AddPath: boolean): string;
 var
   C: TClass;
 begin
-  if aType=nil then exit('nil');
+  if aType=nil then exit('untyped');
   C:=aType.ClassType;
   if (C=TPasUnresolvedSymbolRef) then
     begin
@@ -1718,7 +1721,7 @@ begin
       if length(ArrayEl.Ranges)=0 then
         Result:='array of '+ArrayEl.ElType.Name
       else
-        Result:='array[] of '+ArrayEl.ElType.Name;
+        Result:='static array[] of '+ArrayEl.ElType.Name;
       end
     else if T.TypeEl is TPasProcedureType then
       Result:=GetProcDesc(TPasProcedureType(T.TypeEl),false)
@@ -2857,8 +2860,21 @@ var
   Identifier, OlderIdentifier: TPasIdentifier;
   ClassScope: TPasClassScope;
   OlderEl: TPasElement;
+  IsClassScope: Boolean;
 begin
-  if (Kind=pikSimple) and (Scope is TPasClassScope)
+  IsClassScope:=(Scope is TPasClassScope);
+
+  if (El.Visibility=visPublished) then
+    begin
+    if El.ClassType=TPasProperty then
+      // Note: VarModifiers are not yet set
+    else if (El.ClassType=TPasProcedure) or (El.ClassType=TPasFunction) then
+      // ok
+    else
+      RaiseMsg(20170403223024,nSymbolCannotBePublished,sSymbolCannotBePublished,[],El);
+    end;
+
+  if (Kind=pikSimple) and IsClassScope
       and (El.ClassType<>TPasProperty) then
     begin
     // check duplicate in ancestors
@@ -2890,7 +2906,9 @@ begin
   // check duplicate in current scope
   OlderIdentifier:=Identifier.NextSameIdentifier;
   if (OlderIdentifier<>nil) then
-    if (Identifier.Kind=pikSimple) or (OlderIdentifier.Kind=pikSimple) then
+    if (Identifier.Kind=pikSimple)
+        or (OlderIdentifier.Kind=pikSimple)
+        or (El.Visibility=visPublished) then
       begin
       if (OlderIdentifier.Element.ClassType=TPasEnumValue)
           and (OlderIdentifier.Element.Parent.Parent<>Scope.Element) then
@@ -3267,8 +3285,8 @@ begin
                         pmStatic, pmVarargs,
                         pmExternal, pmDispId,
                         pmfar]) then
-          RaiseMsg(20170216151616,nInvalidXModifiersY,
-            sInvalidXModifiersY,[Proc.ElementTypeName,'external, '+ModifierNames[pm]],Proc);
+          RaiseMsg(20170216151616,nInvalidXModifierY,
+            sInvalidXModifierY,[Proc.ElementTypeName,'external, '+ModifierNames[pm]],Proc);
 
     if Proc.Parent is TPasClassType then
       begin
@@ -3276,31 +3294,31 @@ begin
       if Proc.IsAbstract then
         begin
         if not Proc.IsVirtual then
-          RaiseMsg(20170216151623,nInvalidXModifiersY,sInvalidXModifiersY,[Proc.ElementTypeName,'abstract without virtual'],Proc);
+          RaiseMsg(20170216151623,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'abstract without virtual'],Proc);
         if Proc.IsOverride then
-          RaiseMsg(20170216151625,nInvalidXModifiersY,sInvalidXModifiersY,[Proc.ElementTypeName,'abstract, override'],Proc);
+          RaiseMsg(20170216151625,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'abstract, override'],Proc);
         end;
       if Proc.IsVirtual and Proc.IsOverride then
-        RaiseMsg(20170216151627,nInvalidXModifiersY,sInvalidXModifiersY,[Proc.ElementTypeName,'virtual, override'],Proc);
+        RaiseMsg(20170216151627,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'virtual, override'],Proc);
       if Proc.IsForward then
-        RaiseMsg(20170216151629,nInvalidXModifiersY,sInvalidXModifiersY,[Proc.ElementTypeName,'forward'],Proc);
+        RaiseMsg(20170216151629,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'forward'],Proc);
       if Proc.IsStatic then
         if (Proc.ClassType<>TPasClassProcedure) and (Proc.ClassType<>TPasClassFunction) then
-          RaiseMsg(20170216151631,nInvalidXModifiersY,sInvalidXModifiersY,[Proc.ElementTypeName,'static'],Proc);
+          RaiseMsg(20170216151631,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'static'],Proc);
       end
     else
       begin
       // intf proc, forward proc, proc body, method body
       if Proc.IsAbstract then
-        RaiseMsg(20170216151634,nInvalidXModifiersY,sInvalidXModifiersY,[Proc.ElementTypeName,'abstract'],Proc);
+        RaiseMsg(20170216151634,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'abstract'],Proc);
       if Proc.IsVirtual then
-        RaiseMsg(20170216151635,nInvalidXModifiersY,sInvalidXModifiersY,[Proc.ElementTypeName,'virtual'],Proc);
+        RaiseMsg(20170216151635,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'virtual'],Proc);
       if Proc.IsOverride then
-        RaiseMsg(20170216151637,nInvalidXModifiersY,sInvalidXModifiersY,[Proc.ElementTypeName,'override'],Proc);
+        RaiseMsg(20170216151637,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'override'],Proc);
       if Proc.IsMessage then
-        RaiseMsg(20170216151638,nInvalidXModifiersY,sInvalidXModifiersY,[Proc.ElementTypeName,'message'],Proc);
+        RaiseMsg(20170216151638,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'message'],Proc);
       if Proc.IsStatic then
-        RaiseMsg(20170216151640,nInvalidXModifiersY,sInvalidXModifiersY,[Proc.ElementTypeName,'static'],Proc);
+        RaiseMsg(20170216151640,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'static'],Proc);
       end;
 
     if Pos('.',ProcName)>1 then
@@ -3479,9 +3497,9 @@ var
   p: Integer;
 begin
   if ImplProc.IsExternal then
-    RaiseMsg(20170216151715,nInvalidXModifiersY,sInvalidXModifiersY,[ImplProc.ElementTypeName,'external'],ImplProc);
+    RaiseMsg(20170216151715,nInvalidXModifierY,sInvalidXModifierY,[ImplProc.ElementTypeName,'external'],ImplProc);
   if ImplProc.IsExported then
-    RaiseMsg(20170216151717,nInvalidXModifiersY,sInvalidXModifiersY,[ImplProc.ElementTypeName,'export'],ImplProc);
+    RaiseMsg(20170216151717,nInvalidXModifierY,sInvalidXModifierY,[ImplProc.ElementTypeName,'export'],ImplProc);
 
   ProcName:=ImplProc.Name;
   {$IFDEF VerbosePasResolver}
@@ -3587,6 +3605,8 @@ end;
 
 procedure TPasResolver.FinishVariable(El: TPasVariable);
 begin
+  if (El.Visibility=visPublished) then
+    RaiseMsg(20170403223837,nSymbolCannotBePublished,sSymbolCannotBePublished,[],El);
   if El.Expr<>nil then
     begin
     ResolveExpr(El.Expr,rraRead);
@@ -3701,7 +3721,8 @@ var
       // check access: var, const, ...
       if PropArg.Access<>ProcArg.Access then
         RaiseMsg(20170216151808,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
-          [IntToStr(ArgNo),AccessNames[ProcArg.Access],AccessNames[PropArg.Access]],ErrorEl);
+          [IntToStr(ArgNo),AccessDescriptions[ProcArg.Access],
+           AccessDescriptions[PropArg.Access]],ErrorEl);
 
       // check typed
       if PropArg.ArgType=nil then
@@ -3740,10 +3761,17 @@ var
   Arg: TPasArgument;
   PropArgCount: Integer;
   PropTypeResolved, DefaultResolved: TPasResolverResult;
+  m: TVariableModifier;
 begin
   CheckTopScope(TPasPropertyScope);
   PopScope;
 
+  if PropEl.Visibility=visPublished then
+    for m in PropEl.VarModifiers do
+      if not (m in [vmExternal]) then
+        RaiseMsg(20170403224112,nInvalidXModifierY,sInvalidXModifierY,
+          ['published property','"'+VariableModifierNames[m]+'"'],PropEl);
+
   PropType:=nil;
   CurClassType:=PropEl.Parent as TPasClassType;
   ClassScope:=CurClassType.CustomData as TPasClassScope;
@@ -3848,7 +3876,8 @@ begin
       Arg:=TPasArgument(Proc.ProcType.Args[PropArgCount]);
       if not (Arg.Access in [argDefault,argConst]) then
         RaiseMsg(20170216151917,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
-          [IntToStr(PropArgCount+1),AccessNames[Arg.Access],AccessNames[argConst]],PropEl.WriteAccessor);
+          [IntToStr(PropArgCount+1),AccessDescriptions[Arg.Access],
+           AccessDescriptions[argConst]],PropEl.WriteAccessor);
       if Arg.ArgType<>PropType then
         RaiseIncompatibleType(20170216151919,nIncompatibleTypeArgNo,
           [IntToStr(PropArgCount+1)],Arg.ArgType,PropType,PropEl.WriteAccessor);
@@ -8410,6 +8439,7 @@ begin
   E.Id:=Id;
   E.MsgType:=mtError;
   E.MsgNumber:=MsgNumber;
+  E.MsgPattern:=Fmt;
   E.PasElement:=ErrorPosEl;
   E.Args:=FLastMsgArgs;
   raise E;
@@ -8473,7 +8503,7 @@ begin
 end;
 
 procedure TPasResolver.RaiseIncompatibleTypeDesc(id: int64; MsgNumber: integer;
-  const Args: array of const; const DescA, DescB: String; ErrorEl: TPasElement);
+  const Args: array of const; const GotDesc, ExpDesc: String; ErrorEl: TPasElement);
 
   function GetString(ArgNo: integer): string;
   begin
@@ -8487,83 +8517,99 @@ procedure TPasResolver.RaiseIncompatibleTypeDesc(id: int64; MsgNumber: integer;
 begin
   case MsgNumber of
     nIllegalTypeConversionTo:
-      RaiseMsg(id,MsgNumber,sIllegalTypeConversionTo,[DescA,DescB],ErrorEl);
+      RaiseMsg(id,MsgNumber,sIllegalTypeConversionTo,[GotDesc,ExpDesc],ErrorEl);
     nIncompatibleTypesGotExpected:
-      RaiseMsg(id,MsgNumber,sIncompatibleTypesGotExpected,[DescA,DescB],ErrorEl);
+      RaiseMsg(id,MsgNumber,sIncompatibleTypesGotExpected,[GotDesc,ExpDesc],ErrorEl);
     nIncompatibleTypeArgNo:
-      RaiseMsg(id,MsgNumber,sIncompatibleTypeArgNo,[GetString(0),DescA,DescB],ErrorEl);
+      RaiseMsg(id,MsgNumber,sIncompatibleTypeArgNo,[GetString(0),GotDesc,ExpDesc],ErrorEl);
     nIncompatibleTypeArgNoVarParamMustMatchExactly:
       RaiseMsg(id,MsgNumber,sIncompatibleTypeArgNoVarParamMustMatchExactly,
-               [GetString(0),DescA,DescB],ErrorEl);
+               [GetString(0),GotDesc,ExpDesc],ErrorEl);
     nResultTypeMismatchExpectedButFound:
-      RaiseMsg(id,MsgNumber,sResultTypeMismatchExpectedButFound,[DescA,DescB],ErrorEl);
+      RaiseMsg(id,MsgNumber,sResultTypeMismatchExpectedButFound,[GotDesc,ExpDesc],ErrorEl);
     nXExpectedButYFound:
-      RaiseMsg(id,MsgNumber,sXExpectedButYFound,[DescA,DescB],ErrorEl);
+      RaiseMsg(id,MsgNumber,sXExpectedButYFound,[GotDesc,ExpDesc],ErrorEl);
   else
     RaiseInternalError(20170329112911);
   end;
 end;
 
 procedure TPasResolver.RaiseIncompatibleType(id: int64; MsgNumber: integer;
-  const Args: array of const; TypeA, TypeB: TPasType; ErrorEl: TPasElement);
+  const Args: array of const; GotType, ExpType: TPasType; ErrorEl: TPasElement);
 var
   DescA, DescB: String;
 begin
-  DescA:=GetTypeDesc(TypeA);
-  DescB:=GetTypeDesc(TypeB);
+  DescA:=GetTypeDesc(GotType);
+  DescB:=GetTypeDesc(ExpType);
   if DescA=DescB then
     begin
-    DescA:=GetTypeDesc(TypeA,true);
-    DescB:=GetTypeDesc(TypeB,true);
+    DescA:=GetTypeDesc(GotType,true);
+    DescB:=GetTypeDesc(ExpType,true);
     end;
   RaiseIncompatibleTypeDesc(id,MsgNumber,Args,DescA,DescB,ErrorEl);
 end;
 
 procedure TPasResolver.RaiseIncompatibleTypeRes(id: int64; MsgNumber: integer;
-  const Args: array of const; const TypeA, TypeB: TPasResolverResult;
+  const Args: array of const; const GotType, ExpType: TPasResolverResult;
   ErrorEl: TPasElement);
+
+  function GetTypeDsc(const R: TPasResolverResult; AddPath: boolean = false): string;
+  begin
+    Result:=GetTypeDesc(R.TypeEl,AddPath);
+    if R.IdentEl=R.TypeEl then
+      begin
+      if R.TypeEl.ElementTypeName<>'' then
+        Result:=R.TypeEl.ElementTypeName+' '+Result
+      else
+        Result:='type '+Result;
+      end;
+  end;
+
+  function GetBaseDecs(const R: TPasResolverResult; AddPath: boolean = false): string;
+  begin
+    if R.BaseType=btContext then
+      Result:=GetTypeDsc(R,AddPath)
+    else
+      Result:=BaseTypeNames[R.BaseType];
+  end;
+
 var
-  DescA, DescB: String;
+  GotDesc, ExpDesc: String;
 begin
-  if TypeA.BaseType<>TypeB.BaseType then
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.RaiseIncompatibleTypeRes Got={',GetResolverResultDesc(GotType),'} Expected={',GetResolverResultDesc(ExpType),'}');
+  {$ENDIF}
+  if GotType.BaseType<>ExpType.BaseType then
     begin
-    if TypeA.BaseType=btContext then
-      DescA:=GetTypeDesc(TypeA.TypeEl)
-    else
-      DescA:=BaseTypeNames[TypeA.BaseType];
-    if TypeB.BaseType=btContext then
-      DescB:=GetTypeDesc(TypeB.TypeEl)
-    else
-      DescB:=BaseTypeNames[TypeB.BaseType];
-    if DescA=DescB then
+    GotDesc:=GetBaseDecs(GotType);
+    ExpDesc:=GetBaseDecs(ExpType);
+    if GotDesc=ExpDesc then
       begin
-      if TypeA.BaseType=btContext then
-        DescA:=GetTypeDesc(TypeA.TypeEl,true);
-      if TypeB.BaseType=btContext then
-        DescB:=GetTypeDesc(TypeB.TypeEl,true);
+      GotDesc:=GetBaseDecs(GotType,true);
+      ExpDesc:=GetBaseDecs(ExpType,true);
       end;
     end
-  else if (TypeA.TypeEl<>nil) and (TypeB.TypeEl<>nil) then
+  else if (GotType.TypeEl<>nil) and (ExpType.TypeEl<>nil) then
     begin
-    DescA:=GetTypeDesc(TypeA.TypeEl);
-    DescB:=GetTypeDesc(TypeB.TypeEl);
-    if DescA=DescB then
+    GotDesc:=GetTypeDsc(GotType);
+    ExpDesc:=GetTypeDsc(ExpType);
+    if GotDesc=ExpDesc then
       begin
-      DescA:=GetTypeDesc(TypeA.TypeEl,true);
-      DescB:=GetTypeDesc(TypeB.TypeEl,true);
+      GotDesc:=GetTypeDsc(GotType,true);
+      ExpDesc:=GetTypeDsc(ExpType,true);
       end;
     end
   else
     begin
-    DescA:=GetResolverResultDescription(TypeA,true);
-    DescB:=GetResolverResultDescription(TypeA,true);
-    if DescA=DescB then
+    GotDesc:=GetResolverResultDescription(GotType,true);
+    ExpDesc:=GetResolverResultDescription(ExpType,true);
+    if GotDesc=ExpDesc then
       begin
-      DescA:=GetResolverResultDescription(TypeA,false);
-      DescB:=GetResolverResultDescription(TypeA,false);
+      GotDesc:=GetResolverResultDescription(GotType,false);
+      ExpDesc:=GetResolverResultDescription(ExpType,false);
       end;
     end;
-  RaiseIncompatibleTypeDesc(id,MsgNumber,Args,DescA,DescB,ErrorEl);
+  RaiseIncompatibleTypeDesc(id,MsgNumber,Args,GotDesc,ExpDesc,ErrorEl);
 end;
 
 procedure TPasResolver.LogMsg(const id: int64; MsgType: TMessageType;
@@ -8783,6 +8829,7 @@ end;
 function TPasResolver.CheckProcTypeCompatibility(Proc1,
   Proc2: TPasProcedureType; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
   ): boolean;
+// if RaiseOnIncompatible=true, then Expected=Proc1 Actual=Proc2
 
   function ModifierError(const Modifier: string): boolean;
   begin
@@ -8796,12 +8843,13 @@ var
   ProcArgs1, ProcArgs2: TFPList;
   i: Integer;
   Result1Resolved, Result2Resolved: TPasResolverResult;
+  ExpectedArg, ActualArg: TPasArgument;
 begin
   Result:=false;
   if Proc1.ClassType<>Proc2.ClassType then
     begin
     if RaiseOnIncompatible then
-      RaiseXExpectedButYFound(20170402112353,Proc1.TypeName,Proc2.TypeName,ErrorEl);
+      RaiseXExpectedButYFound(20170402112353,Proc1.ElementTypeName,Proc2.ElementTypeName,ErrorEl);
     exit;
     end;
   if Proc1.IsNested<>Proc2.IsNested then
@@ -8830,16 +8878,29 @@ begin
     {$IFDEF VerbosePasResolver}
     writeln('TPasResolver.CheckProcAssignCompatibility ',i,'/',ProcArgs1.Count);
     {$ENDIF}
-    if not CheckProcArgCompatibility(TPasArgument(ProcArgs1[i]),TPasArgument(ProcArgs2[i])) then
+    ExpectedArg:=TPasArgument(ProcArgs1[i]);
+    ActualArg:=TPasArgument(ProcArgs2[i]);
+    if not CheckProcArgCompatibility(ExpectedArg,ActualArg) then
+      begin
+      if RaiseOnIncompatible then
+        begin
+        if ExpectedArg.Access<>ActualArg.Access then
+          RaiseMsg(20170404151541,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
+            [IntToStr(i+1),'access modifier '+AccessDescriptions[ActualArg.Access],
+             AccessDescriptions[ExpectedArg.Access]],
+            ErrorEl);
+        RaiseIncompatibleType(20170404151538,nIncompatibleTypeArgNo,
+          [IntToStr(i+1)],ExpectedArg.ArgType,ActualArg.ArgType,ErrorEl);
+        end;
       exit;
+      end;
     end;
   if Proc1 is TPasFunctionType then
     begin
     ComputeElement(TPasFunctionType(Proc1).ResultEl.ResultType,Result1Resolved,[rcType]);
     ComputeElement(TPasFunctionType(Proc2).ResultEl.ResultType,Result2Resolved,[rcType]);
     if (Result1Resolved.BaseType<>Result2Resolved.BaseType)
-        or (Result1Resolved.TypeEl=nil)
-        or (Result1Resolved.TypeEl<>Result2Resolved.TypeEl) then
+        or not IsSameType(Result1Resolved.TypeEl,Result2Resolved.TypeEl) then
       begin
       if RaiseOnIncompatible then
         RaiseIncompatibleTypeRes(20170402112648,nResultTypeMismatchExpectedButFound,
@@ -8966,6 +9027,9 @@ begin
 
   Handled:=false;
   Result:=CheckAssignCompatibilityCustom(LHS,RHS,ErrorEl,RaiseOnIncompatible,Handled);
+  if Handled and (Result>=cExact) and (Result<cIncompatible) then
+    exit;
+
   if not Handled then
     begin
     if LHS.TypeEl=nil then
@@ -9062,10 +9126,10 @@ begin
     else if (LHS.BaseType=btContext) and (LHS.TypeEl is TPasArrayType) then
       Result:=CheckAssignCompatibilityArrayType(LHS,RHS,ErrorEl,RaiseOnIncompatible);
     end;
+
   {$IFDEF VerbosePasResolver}
   writeln('TPasResolver.CheckAssignResCompatibility incompatible LHS='+GetResolverResultDesc(LHS)+' RHS='+GetResolverResultDesc(RHS));
   {$ENDIF}
-
   if (Result>=0) and (Result<cIncompatible) then
     begin
     // type fits -> check readable
@@ -9467,6 +9531,7 @@ var
   RTypeEl, LTypeEl: TPasType;
   SrcResolved, DstResolved: TPasResolverResult;
   LArray, RArray: TPasArrayType;
+
   function RaiseIncompatType: integer;
   begin
     if not RaiseOnIncompatible then exit(cIncompatible);
@@ -9529,14 +9594,23 @@ begin
   else if LTypeEl is TPasProcedureType then
     begin
     if RHS.BaseType=btNil then
-      Result:=cExact
-    else if (LTypeEl.ClassType=RTypeEl.ClassType)
+      exit(cExact);
+    writeln('TPasResolver.CheckAssignCompatibilityUserType LTypeEl=',GetObjName(LTypeEl),' RHS.BaseType=',BaseTypeNames[RHS.BaseType],' RTypeEl=',GetObjName(RTypeEl),' RHS.IdentEl=',GetObjName(RHS.IdentEl),' RHS.ExprEl=',GetObjName(RHS.ExprEl),' rrfReadable=',rrfReadable in RHS.Flags);
+    if (LTypeEl.ClassType=RTypeEl.ClassType)
         and (rrfReadable in RHS.Flags) then
       begin
       // e.g. ProcVar1:=ProcVar2
+        writeln('AAA2 TPasResolver.CheckAssignCompatibilityUserType ');
       if CheckProcTypeCompatibility(TPasProcedureType(LTypeEl),TPasProcedureType(RTypeEl),
           ErrorEl,RaiseOnIncompatible) then
-        Result:=cExact;
+        exit(cExact);
+      writeln('AAA3 TPasResolver.CheckAssignCompatibilityUserType ');
+      end;
+    if RaiseOnIncompatible then
+      begin
+      if (RTypeEl is TPasProcedureType) and (rrfReadable in RHS.Flags) then
+        RaiseMsg(20170404154738,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
+          [RTypeEl.ElementTypeName,LTypeEl.ElementTypeName],ErrorEl);
       end;
     end
   else if LTypeEl.ClassType=TPasArrayType then
@@ -9927,9 +10001,10 @@ begin
       if FromResolved.BaseType=btNil then
         Result:=cExact
       else if (FromResolved.BaseType=btContext)
-          and (FromResolved.TypeEl.ClassType=TPasClassType)
-          and (not (FromResolved.IdentEl is TPasType)) then
+          and (FromResolved.TypeEl.ClassType=TPasClassType) then
         begin
+        if (FromResolved.IdentEl is TPasType) then
+          RaiseMsg(20170404162606,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
         // type cast upwards or downwards
         Result:=CheckSrcIsADstType(FromResolved,ToResolved,ErrorEl);
         if Result=cIncompatible then
@@ -9943,9 +10018,10 @@ begin
       //writeln('TPasResolver.CheckTypeCast class-of FromRes.TypeEl=',GetObjName(FromResolved.TypeEl),' FromRes.IdentEl=',GetObjName(FromResolved.IdentEl));
       if (FromResolved.BaseType=btContext) then
         begin
-        if (FromResolved.TypeEl.ClassType=TPasClassOfType)
-            and (not (FromResolved.IdentEl is TPasType)) then
+        if (FromResolved.TypeEl.ClassType=TPasClassOfType) then
           begin
+          if (FromResolved.IdentEl is TPasType) then
+            RaiseMsg(20170404162604,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
           // type cast  classof(classof-var)  upwards or downwards
           ToClassType:=TPasClassOfType(ToTypeEl).DestType;
           FromClassType:=TPasClassOfType(FromResolved.TypeEl).DestType;
@@ -9980,6 +10056,12 @@ begin
       ToClassType:=TPasClassOfType(ToTypeEl).DestType;
       FromClassType:=TPasClassType(FromResolved.TypeEl);
       Result:=CheckClassesAreRelated(ToClassType,FromClassType,ErrorEl);
+      if Result<cIncompatible then exit;
+      end;
+    if RaiseOnError then
+      begin
+      if FromResolved.IdentEl is TPasType then
+        RaiseMsg(20170404162610,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
       end;
     end;
 

packages/fcl-passrc/src/pastree.pp

@@ -1350,6 +1350,7 @@ Type
 
 const
   AccessNames: array[TArgumentAccess] of string[9] = ('', 'const ', 'var ', 'out ','constref ');
+  AccessDescriptions: array[TArgumentAccess] of string[9] = ('default', 'const', 'var', 'out','constref');
   AllVisibilities: TPasMemberVisibilities =
      [visDefault, visPrivate, visProtected, visPublic,
       visPublished, visAutomated];
@@ -2320,6 +2321,8 @@ begin
     okSpecialize : Result := SPasTreeSpecializedType;
     okClassHelper : Result:=SPasClassHelperType;
     okRecordHelper : Result:=SPasRecordHelperType;
+  else
+    Result:='ObjKind('+IntToStr(ord(ObjKind))+')';
   end;
 end;
 

packages/fcl-passrc/src/pparser.pp

@@ -715,6 +715,9 @@ end;
 procedure TPasParser.ParseExc(MsgNumber: integer; const Fmt: String;
   Args: array of const);
 begin
+  {$IFDEF VerbosePasParser}
+  writeln('TPasParser.ParseExc Token="',CurTokenText,'"');
+  {$ENDIF}
   SetLastMsg(mtError,MsgNumber,Fmt,Args);
   raise EParserError.Create(SafeFormat(SParserErrorAtToken,
     [FLastMsg, CurTokenName, Scanner.CurFilename, Scanner.CurRow, Scanner.CurColumn])
@@ -1867,7 +1870,7 @@ begin
           if (CurToken<>tkBraceClose) then
             begin
             x.Release;
-            Exit;
+            CheckToken(tkBraceClose);
             end;
           NextToken;
           // for expressions like (ppdouble)^^;
@@ -1888,7 +1891,7 @@ begin
           x:=ParseExpIdent(AParent);
           end;
         if not Assigned(x) then
-          Exit;
+          ParseExcSyntaxError;
         expstack.Add(x);
 
         for i:=1 to pcount do
@@ -1921,7 +1924,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(AllowEqual);
 
     if not NotBinary then ParseExcExpectedIdentifier;
@@ -1929,6 +1932,8 @@ 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
+      ParseExcSyntaxError;
     if expstack.Count=1 then
       begin
       Result:=TPasExpr(expstack[0]);
@@ -4096,7 +4101,7 @@ begin
   while True do
   begin
     NextToken;
-    // WriteLn({$IFDEF VerbosePasParser}i,{$ENDIF}' Token=',CurTokenText);
+     WriteLn({$IFDEF VerbosePasParser}i,{$ENDIF}' Token=',CurTokenText);
     case CurToken of
     tkasm:
       begin
@@ -4488,8 +4493,10 @@ begin
           if CloseBlock then break;
         end else
           ParseExcSyntaxError;
-      end
-    else
+      end;
+    tkEOF:
+      CheckToken(tkend);
+    tkBraceOpen,tkIdentifier,tkNumber,tkSquaredBraceOpen,tkMinus,tkPlus,tkinherited:
       begin
       left:=DoParseExpression(CurBlock);
       case CurToken of
@@ -4536,6 +4543,8 @@ begin
       if not (CmdElem is TPasImplLabelMark) then
         if NewImplElement=nil then NewImplElement:=CmdElem;
       end;
+    else
+      ParseExcSyntaxError;
     end;
   end;
 end;

packages/fcl-passrc/src/pscanner.pp

@@ -2364,8 +2364,12 @@ function TPascalScanner.FetchLine: boolean;
 begin
   if CurSourceFile.IsEOF then
   begin
-    FCurLine := '';
-    TokenStr := nil;
+    if TokenStr<>nil then
+      begin
+      FCurLine := '';
+      TokenStr := nil;
+      inc(FCurRow); // set CurRow to last line+1
+      end;
     Result := false;
   end else
   begin

packages/fcl-passrc/tests/tcresolver.pas

@@ -388,6 +388,12 @@ type
     Procedure TestClass_WarnOverrideLowerVisibility;
     // Todo: Fail to use class.method in constant or type, e.g. const p = @o.doit;
 
+    // published
+    Procedure TestClass_PublishedVarFail;
+    Procedure TestClass_PublishedClassPropertyFail;
+    Procedure TestClass_PublishedClassFunctionFail;
+    Procedure TestClass_PublishedOverloadFail;
+
     // external class
     Procedure TestExternalClass;
     Procedure TestExternalClass_Descendant;
@@ -496,6 +502,7 @@ type
     Procedure TestAssignMethodToProcFail;
     Procedure TestAssignProcToFunctionFail;
     Procedure TestAssignProcWrongArgsFail;
+    Procedure TestAssignProcWrongArgAccessFail;
     Procedure TestProcType_AssignNestedProcFail;
     Procedure TestArrayOfProc;
     Procedure TestProcType_Assigned;
@@ -508,6 +515,7 @@ type
     Procedure TestProcType_IsNested_AssignProcFail;
     Procedure TestProcType_AllowNested;
     Procedure TestProcType_AllowNestedOfObject;
+    Procedure TestProcType_AsArgOtherUnit;
   end;
 
 function LinesToStr(Args: array of const): string;
@@ -1108,6 +1116,14 @@ begin
       begin
       AssertEquals('Expected {'+Msg+'}, but got msg {'+E.Message+'} number',
         MsgNumber,E.MsgNumber);
+      if (Msg<>E.Message) and (Msg<>E.MsgPattern) then
+        begin
+        {$IFDEF VerbosePasResolver}
+        writeln('TCustomTestResolver.CheckResolverException E.MsgPattern={',E.MsgPattern,'}');
+        {$ENDIF}
+        AssertEquals('Expected message ('+IntToStr(MsgNumber)+')',
+          '{'+Msg+'}','{'+E.Message+'}');
+        end;
       ok:=true;
       end;
   end;
@@ -1899,7 +1915,7 @@ begin
   Add('var a: longint;');
   Add('var a: string;');
   Add('begin');
-  CheckResolverException('duplicate identifier',PasResolver.nDuplicateIdentifier);
+  CheckResolverException(sDuplicateIdentifier,PasResolver.nDuplicateIdentifier);
 end;
 
 procedure TTestResolver.TestVarInitConst;
@@ -1984,7 +2000,7 @@ begin
   Add('  i: string;');
   Add('begin');
   Add('  inc(i);');
-  CheckResolverException('Incompatible type arg no. 1: Got "String", expected "Longint"',PasResolver.nIncompatibleTypeArgNo);
+  CheckResolverException('Incompatible type arg no. 1: Got "String", expected "integer"',PasResolver.nIncompatibleTypeArgNo);
 end;
 
 procedure TTestResolver.TestVarExternal;
@@ -2633,7 +2649,7 @@ begin
   Add('  v:longint;');
   Add('begin');
   Add('  v:=''A'';');
-  CheckResolverException('Incompatible types: got "String" expected "Longint"',
+  CheckResolverException('Incompatible types: got "Char" expected "Longint"',
     PasResolver.nIncompatibleTypesGotExpected);
 end;
 
@@ -2839,7 +2855,7 @@ begin
   Add('  i: longint;');
   Add('begin');
   Add('  i:=longint(s);');
-  CheckResolverException('illegal type conversion: string to longint',PasResolver.nIllegalTypeConversionTo);
+  CheckResolverException(sIllegalTypeConversionTo,PasResolver.nIllegalTypeConversionTo);
 end;
 
 procedure TTestResolver.TestTypeCastStrToCharFail;
@@ -2850,7 +2866,7 @@ begin
   Add('  c: char;');
   Add('begin');
   Add('  c:=char(s);');
-  CheckResolverException('illegal type conversion: string to char',PasResolver.nIllegalTypeConversionTo);
+  CheckResolverException(sIllegalTypeConversionTo,PasResolver.nIllegalTypeConversionTo);
 end;
 
 procedure TTestResolver.TestTypeCastIntToStrFail;
@@ -2861,7 +2877,7 @@ begin
   Add('  i: longint;');
   Add('begin');
   Add('  s:=string(i);');
-  CheckResolverException('illegal type conversion: longint to string',PasResolver.nIllegalTypeConversionTo);
+  CheckResolverException(sIllegalTypeConversionTo,PasResolver.nIllegalTypeConversionTo);
 end;
 
 procedure TTestResolver.TestTypeCastDoubleToStrFail;
@@ -2872,7 +2888,7 @@ begin
   Add('  d: double;');
   Add('begin');
   Add('  s:=string(d);');
-  CheckResolverException('illegal type conversion: double to string',PasResolver.nIllegalTypeConversionTo);
+  CheckResolverException(sIllegalTypeConversionTo,PasResolver.nIllegalTypeConversionTo);
 end;
 
 procedure TTestResolver.TestTypeCastDoubleToIntFail;
@@ -2883,7 +2899,7 @@ begin
   Add('  d: double;');
   Add('begin');
   Add('  i:=longint(d);');
-  CheckResolverException('illegal type conversion: double to longint',PasResolver.nIllegalTypeConversionTo);
+  CheckResolverException(sIllegalTypeConversionTo,PasResolver.nIllegalTypeConversionTo);
 end;
 
 procedure TTestResolver.TestTypeCastDoubleToBoolFail;
@@ -2894,7 +2910,7 @@ begin
   Add('  d: double;');
   Add('begin');
   Add('  b:=longint(d);');
-  CheckResolverException('illegal type conversion: double to boolean',PasResolver.nIllegalTypeConversionTo);
+  CheckResolverException(sIllegalTypeConversionTo,PasResolver.nIllegalTypeConversionTo);
 end;
 
 procedure TTestResolver.TestTypeCastBooleanToDoubleFail;
@@ -2905,7 +2921,7 @@ begin
   Add('  d: double;');
   Add('begin');
   Add('  d:=double(b);');
-  CheckResolverException('illegal type conversion: boolean to double',PasResolver.nIllegalTypeConversionTo);
+  CheckResolverException(sIllegalTypeConversionTo,PasResolver.nIllegalTypeConversionTo);
 end;
 
 procedure TTestResolver.TestHighLow;
@@ -3054,7 +3070,7 @@ begin
   Add('  except');
   Add('    on longint do ;');
   Add('  end;');
-  CheckResolverException('class expected but longint found',PasResolver.nXExpectedButYFound);
+  CheckResolverException('class expected, but Longint found',PasResolver.nXExpectedButYFound);
 end;
 
 procedure TTestResolver.TestRaiseNonVarFail;
@@ -3063,7 +3079,7 @@ begin
   Add('type TObject = class end;');
   Add('begin');
   Add('  raise TObject;');
-  CheckResolverException('var expected but type found',PasResolver.nXExpectedButYFound);
+  CheckResolverException('variable expected, but class found',PasResolver.nXExpectedButYFound);
 end;
 
 procedure TTestResolver.TestRaiseNonClassFail;
@@ -3073,7 +3089,7 @@ begin
   Add('  E: longint;');
   Add('begin');
   Add('  raise E;');
-  CheckResolverException('class expected but longint found',PasResolver.nXExpectedButYFound);
+  CheckResolverException('class expected, but Longint found',PasResolver.nXExpectedButYFound);
 end;
 
 procedure TTestResolver.TestRaiseDescendant;
@@ -3158,7 +3174,7 @@ begin
   Add('begin');
   Add('  repeat');
   Add('  until 3;');
-  CheckResolverException('boolean expected but longint found',PasResolver.nXExpectedButYFound);
+  CheckResolverException('Boolean expected, but Longint found',PasResolver.nXExpectedButYFound);
 end;
 
 procedure TTestResolver.TestWhileDoNonBoolFail;
@@ -3166,7 +3182,7 @@ begin
   StartProgram(false);
   Add('begin');
   Add('  while 3 do ;');
-  CheckResolverException('boolean expected but longint found',PasResolver.nXExpectedButYFound);
+  CheckResolverException('Boolean expected, but Longint found',PasResolver.nXExpectedButYFound);
 end;
 
 procedure TTestResolver.TestIfThenNonBoolFail;
@@ -3174,7 +3190,7 @@ begin
   StartProgram(false);
   Add('begin');
   Add('  if 3 then ;');
-  CheckResolverException('boolean expected but longint found',PasResolver.nXExpectedButYFound);
+  CheckResolverException('Boolean expected, but Longint found',PasResolver.nXExpectedButYFound);
 end;
 
 procedure TTestResolver.TestForLoopVarNonVarFail;
@@ -3183,7 +3199,7 @@ begin
   Add('const i = 3;');
   Add('begin');
   Add('  for i:=1 to 2 do ;');
-  CheckResolverException('variable identifier expected',nVariableIdentifierExpected);
+  CheckResolverException(sVariableIdentifierExpected,nVariableIdentifierExpected);
 end;
 
 procedure TTestResolver.TestForLoopStartIncompFail;
@@ -3251,7 +3267,7 @@ begin
   Add('  case longint of');
   Add('  1: ;');
   Add('  end;');
-  CheckResolverException('const expression expected, but Longint found',
+  CheckResolverException('ordinal expression expected, but Longint found',
     nXExpectedButYFound);
 end;
 
@@ -3445,7 +3461,7 @@ begin
   Add('begin');
   Add('  if j1=0 then ;');
   Add('  if i2=0 then ;');
-  CheckResolverException('identifier not found "i"',nIdentifierNotFound);
+  CheckResolverException('identifier not found "i2"',nIdentifierNotFound);
 end;
 
 procedure TTestResolver.TestProcParam;
@@ -3649,7 +3665,7 @@ begin
   Add('begin');
   Add('end;');
   Add('begin');
-  CheckResolverException('duplicate identifier',PasResolver.nDuplicateIdentifier);
+  CheckResolverException(sDuplicateIdentifier,PasResolver.nDuplicateIdentifier);
 end;
 
 procedure TTestResolver.TestNestedProc;
@@ -3698,7 +3714,7 @@ begin
   StartProgram(false);
   Add('procedure FuncA(i: longint); forward;');
   Add('begin');
-  CheckResolverException('forward proc not resolved',PasResolver.nForwardProcNotResolved);
+  CheckResolverException(sForwardProcNotResolved,PasResolver.nForwardProcNotResolved);
 end;
 
 procedure TTestResolver.TestNestedForwardProc;
@@ -3730,7 +3746,7 @@ begin
   Add('begin');
   Add('end;');
   Add('begin');
-  CheckResolverException('forward proc not resolved',PasResolver.nForwardProcNotResolved);
+  CheckResolverException(sForwardProcNotResolved,PasResolver.nForwardProcNotResolved);
 end;
 
 procedure TTestResolver.TestForwardProcFuncMismatch;
@@ -3752,7 +3768,8 @@ begin
   Add('begin');
   Add('end;');
   Add('begin');
-  CheckResolverException('Result type mismatch',PasResolver.nResultTypeMismatchExpectedButFound);
+  CheckResolverException('Result type mismatch, expected Longint, but found String',
+    PasResolver.nResultTypeMismatchExpectedButFound);
 end;
 
 procedure TTestResolver.TestUnitIntfProc;
@@ -3777,7 +3794,7 @@ begin
   Add('procedure {#A_forward}FuncA(i: longint);');
   Add('implementation');
   Add('initialization');
-  CheckResolverException('forward proc not resolved',PasResolver.nForwardProcNotResolved);
+  CheckResolverException(sForwardProcNotResolved,PasResolver.nForwardProcNotResolved);
 end;
 
 procedure TTestResolver.TestUnitIntfMismatchArgName;
@@ -3789,7 +3806,7 @@ begin
   Add('procedure {#A}ProcA(j: longint);');
   Add('begin');
   Add('end;');
-  CheckResolverException('function header "ProcA" doesn''t match forward : var name changes',
+  CheckResolverException('function header "ProcA" doesn''t match forward : var name changes i => j',
     PasResolver.nFunctionHeaderMismatchForwardVarName);
 end;
 
@@ -3803,7 +3820,7 @@ begin
   Add('procedure {#A_Impl}ProcA(i: longint);');
   Add('begin');
   Add('end;');
-  CheckResolverException('Duplicate identifier',PasResolver.nDuplicateIdentifier);
+  CheckResolverException(sDuplicateIdentifier,PasResolver.nDuplicateIdentifier);
 end;
 
 procedure TTestResolver.TestProcCallMissingParams;
@@ -3814,7 +3831,7 @@ begin
   Add('end;');
   Add('begin');
   Add('  Proc1;');
-  CheckResolverException('Wrong number of parameters for call to "Proc1"',
+  CheckResolverException('Wrong number of parameters specified for call to "Proc1"',
     PasResolver.nWrongNumberOfParametersForCallTo);
 end;
 
@@ -3858,7 +3875,7 @@ begin
   StartProgram(false);
   Add('begin');
   Add('  length;');
-  CheckResolverException('Wrong number of parameters for call to "length"',
+  CheckResolverException('Wrong number of parameters specified for call to "function Length(const String or Array): sizeint"',
     PasResolver.nWrongNumberOfParametersForCallTo);
 end;
 
@@ -3889,7 +3906,8 @@ begin
   Add('var {#i}i: longint;');
   Add('begin');
   Add('  {@i}i:={@P}P();');
-  CheckResolverException('{Incompatible types: got "Procedure/Function" expected "Longint"',PasResolver.nIncompatibleTypesGotExpected);
+  CheckResolverException('Incompatible types: got "Procedure/Function" expected "Longint"',
+    PasResolver.nIncompatibleTypesGotExpected);
 end;
 
 procedure TTestResolver.TestFunctionResultInCondition;
@@ -4351,7 +4369,7 @@ begin
   Add('var');
   Add('  v: TClassB;');
   Add('begin');
-  CheckResolverException('Forward class not resolved raises correct error',
+  CheckResolverException(sForwardTypeNotResolved,
     nForwardTypeNotResolved);
 end;
 
@@ -4415,7 +4433,7 @@ begin
   Add('    procedure ProcA;');
   Add('  end;');
   Add('begin');
-  CheckResolverException('forward proc not resolved',PasResolver.nForwardProcNotResolved);
+  CheckResolverException(sForwardProcNotResolved,PasResolver.nForwardProcNotResolved);
 end;
 
 procedure TTestResolver.TestClass_MethodUnresolvedUnit;
@@ -4429,7 +4447,7 @@ begin
   Add('    procedure ProcA;');
   Add('  end;');
   Add('implementation');
-  CheckResolverException('forward proc not resolved',PasResolver.nForwardProcNotResolved);
+  CheckResolverException(sForwardProcNotResolved,PasResolver.nForwardProcNotResolved);
 end;
 
 procedure TTestResolver.TestClass_MethodAbstract;
@@ -4451,7 +4469,7 @@ begin
   Add('    procedure ProcA; abstract;');
   Add('  end;');
   Add('begin');
-  CheckResolverException('abstract without virtual',PasResolver.nInvalidXModifiersY);
+  CheckResolverException('Invalid procedure modifier abstract without virtual',PasResolver.nInvalidXModifierY);
 end;
 
 procedure TTestResolver.TestClass_MethodAbstractHasBodyFail;
@@ -4465,7 +4483,7 @@ begin
   Add('begin');
   Add('end;');
   Add('begin');
-  CheckResolverException('abstract must not have implementation',
+  CheckResolverException(sAbstractMethodsMustNotHaveImplementation,
     PasResolver.nAbstractMethodsMustNotHaveImplementation);
 end;
 
@@ -4480,7 +4498,7 @@ begin
   Add('    procedure ProcA;');
   Add('  end;');
   Add('begin');
-  CheckResolverException('forward proc not resolved',PasResolver.nForwardProcNotResolved);
+  CheckResolverException(sForwardProcNotResolved,PasResolver.nForwardProcNotResolved);
 end;
 
 procedure TTestResolver.TestClass_ProcFuncMismatch;
@@ -4534,7 +4552,7 @@ begin
   Add('begin');
   Add('end;');
   Add('begin');
-  CheckResolverException('Duplicate identifier',PasResolver.nDuplicateIdentifier);
+  CheckResolverException(PasResolver.sDuplicateIdentifier,PasResolver.nDuplicateIdentifier);
 end;
 
 procedure TTestResolver.TestClass_MethodOverride;
@@ -4953,7 +4971,7 @@ begin
   Add('  {#v}{=A}v: TClassA;');
   Add('begin');
   Add('  if {@v}v is {@TObj}TObject then;');
-  CheckResolverException('types are not related',PasResolver.nTypesAreNotRelated);
+  CheckResolverException(sTypesAreNotRelated,PasResolver.nTypesAreNotRelated);
 end;
 
 procedure TTestResolver.TestClass_OperatorIsOnNonTypeFail;
@@ -4969,7 +4987,7 @@ begin
   Add('  {#v}{=A}v: TClassA;');
   Add('begin');
   Add('  if {@o}o is {@v}v then;');
-  CheckResolverException('class type expected, but got variable',
+  CheckResolverException('class type expected, but class found',
     PasResolver.nXExpectedButYFound);
 end;
 
@@ -4986,7 +5004,7 @@ begin
   Add('  {#v}{=A}v: TClassA;');
   Add('begin');
   Add('  {@o}o:={@v}v as {@TObj}TObject;');
-  CheckResolverException('types are not related',PasResolver.nTypesAreNotRelated);
+  CheckResolverException(sTypesAreNotRelated,PasResolver.nTypesAreNotRelated);
 end;
 
 procedure TTestResolver.TestClass_OperatorAsOnNonTypeFail;
@@ -5002,7 +5020,7 @@ begin
   Add('  {#v}{=A}v: TClassA;');
   Add('begin');
   Add('  {@o}o:={@v}v as {@o}o;');
-  CheckResolverException('class expected, but o found" number',
+  CheckResolverException('class expected, but o found',
     PasResolver.nXExpectedButYFound);
 end;
 
@@ -5096,7 +5114,7 @@ begin
   Add('  {#vb}{=B}vb: TClassB;');
   Add('begin');
   Add('  {@vb}vb:=TClassB({@va}va);');
-  CheckResolverException('Illegal type conversion: "class TClassA" to "TClassB"',
+  CheckResolverException('Illegal type conversion: "TClassA" to "class TClassB"',
     PasResolver.nIllegalTypeConversionTo);
 end;
 
@@ -5200,7 +5218,8 @@ begin
   Add('  end;');
   Add('procedure TObject.ProcA; begin end;');
   Add('begin');
-  CheckResolverException('Invalid procedure modifiers static',PasResolver.nInvalidXModifiersY);
+  CheckResolverException('Invalid procedure modifier static',
+    PasResolver.nInvalidXModifierY);
 end;
 
 procedure TTestResolver.TestClass_SelfInStaticFail;
@@ -5813,7 +5832,7 @@ begin
   Add('  TNop = class(TObject)');
   Add('  end;');
   Add('begin');
-  CheckResolverException('Cannot create a decscendant of the sealed class "TObject"',
+  CheckResolverException(sCannotCreateADescendantOfTheSealedClass,
     nCannotCreateADescendantOfTheSealedClass);
 end;
 
@@ -5868,6 +5887,60 @@ begin
     'Virtual method "DoPublished" has a lower visibility (protected) than parent class TObject (published)',true);
 end;
 
+procedure TTestResolver.TestClass_PublishedVarFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  published');
+  Add('    Id: longint;');
+  Add('  end;');
+  Add('begin');
+  CheckResolverException(sSymbolCannotBePublished,nSymbolCannotBePublished);
+end;
+
+procedure TTestResolver.TestClass_PublishedClassPropertyFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    class var FA: longint;');
+  Add('  published');
+  Add('    class property A: longint read FA;');
+  Add('  end;');
+  Add('begin');
+  CheckResolverException('Invalid published property modifier "class"',
+    nInvalidXModifierY);
+end;
+
+procedure TTestResolver.TestClass_PublishedClassFunctionFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  published');
+  Add('    class procedure DoIt;');
+  Add('  end;');
+  Add('class procedure TObject.DoIt; begin end;');
+  Add('begin');
+  CheckResolverException(sSymbolCannotBePublished,nSymbolCannotBePublished);
+end;
+
+procedure TTestResolver.TestClass_PublishedOverloadFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  published');
+  Add('    procedure DoIt;');
+  Add('    procedure DoIt(i: longint);');
+  Add('  end;');
+  Add('procedure TObject.DoIt; begin end;');
+  Add('procedure TObject.DoIt(i: longint); begin end;');
+  Add('begin');
+  CheckResolverException(sDuplicateIdentifier,nDuplicateIdentifier);
+end;
+
 procedure TTestResolver.TestExternalClass;
 begin
   StartProgram(false);
@@ -6207,8 +6280,8 @@ begin
   Add('  if TObject(Self)=nil then ;');
   Add('end;');
   Add('begin');
-  CheckResolverException('Illegal type conversion: "class TObject" to "TObject"',
-    PasResolver.nIllegalTypeConversionTo);
+  CheckResolverException('Cannot type cast a type',
+    PasResolver.nCannotTypecastAType);
 end;
 
 procedure TTestResolver.TestClass_ClassMembers;
@@ -6444,7 +6517,7 @@ begin
   Add('    FB: longint;');
   Add('  end;');
   Add('begin');
-  CheckResolverException('Identifier not found',PasResolver.nIdentifierNotFound);
+  CheckResolverException('identifier not found "FB"',PasResolver.nIdentifierNotFound);
 end;
 
 procedure TTestResolver.TestPropertyReadAccessorVarWrongType;
@@ -6481,7 +6554,8 @@ begin
   Add('    property B: longint read GetB;');
   Add('  end;');
   Add('begin');
-  CheckResolverException('function result longint expected, but function result string found',PasResolver.nXExpectedButYFound);
+  CheckResolverException('function result Longint expected, but String found',
+    PasResolver.nXExpectedButYFound);
 end;
 
 procedure TTestResolver.TestPropertyReadAccessorFuncWrongArgCount;
@@ -6489,11 +6563,12 @@ begin
   StartProgram(false);
   Add('type');
   Add('  TObject = class');
-  Add('    function GetB(i: longint): string;');
+  Add('    function GetB(i: longint): longint;');
   Add('    property B: longint read GetB;');
   Add('  end;');
   Add('begin');
-  CheckResolverException('function arg count 0 expected, but 1 found',PasResolver.nXExpectedButYFound);
+  CheckResolverException('Wrong number of parameters specified for call to "GetB"',
+    PasResolver.nWrongNumberOfParametersForCallTo);
 end;
 
 procedure TTestResolver.TestPropertyReadAccessorFunc;
@@ -6561,7 +6636,7 @@ begin
   Add('    property B: longint write SetB;');
   Add('  end;');
   Add('begin');
-  CheckResolverException('Incompatible type arg no. 1: Got "var ", expected "const "',
+  CheckResolverException('Incompatible type arg no. 1: Got "var", expected "const"',
     PasResolver.nIncompatibleTypeArgNo);
 end;
 
@@ -6625,7 +6700,8 @@ begin
   Add('    property B;');
   Add('  end;');
   Add('begin');
-  CheckResolverException('no property found to override',PasResolver.nNoPropertyFoundToOverride);
+  CheckResolverException(PasResolver.sNoPropertyFoundToOverride,
+    PasResolver.nNoPropertyFoundToOverride);
 end;
 
 procedure TTestResolver.TestPropertyStoredAccessorProcNotFunc;
@@ -6651,7 +6727,8 @@ begin
   Add('    property B: longint read FB stored GetB;');
   Add('  end;');
   Add('begin');
-  CheckResolverException('function result longint expected, but function result string found',PasResolver.nXExpectedButYFound);
+  CheckResolverException('function: boolean expected, but function:String found',
+    PasResolver.nXExpectedButYFound);
 end;
 
 procedure TTestResolver.TestPropertyStoredAccessorFuncWrongArgCount;
@@ -6779,7 +6856,7 @@ begin
   Add('var Obj: tobject;');
   Add('begin');
   Add('  obj.Items[3]:=4;');
-  CheckResolverException('Incompatible type arg no. 1: Got "Longint", expected "Index:String"',
+  CheckResolverException('Incompatible type arg no. 1: Got "Longint", expected "String"',
     PasResolver.nIncompatibleTypeArgNo);
 end;
 
@@ -7293,7 +7370,7 @@ begin
   Add('  a: array[TEnum] of longint;');
   Add('begin');
   Add('  SetLength(a,1);');
-  CheckResolverException('Incompatible type arg no. 1: Got "array[] of Longint", expected "string or dynamic array variable',
+  CheckResolverException('Incompatible type arg no. 1: Got "static array[] of Longint", expected "string or dynamic array variable"',
     nIncompatibleTypeArgNo);
 end;
 
@@ -7306,7 +7383,7 @@ begin
   Add('  a: array[TEnum] of longint;');
   Add('begin');
   Add('  a:=nil;');
-  CheckResolverException('Incompatible types: got "nil" expected "array type"',
+  CheckResolverException('Incompatible types: got "Nil" expected "array type"',
     nIncompatibleTypesGotExpected);
 end;
 
@@ -7425,7 +7502,7 @@ begin
   Add('  B: TArrayStr;');
   Add('begin');
   Add('  A:=Copy(B);');
-  CheckResolverException('Incompatible types: got "array of integer" expected "array of String"',
+  CheckResolverException('Incompatible types: got "TArrayStr" expected "TArrayInt"',
     nIncompatibleTypesGotExpected);
 end;
 
@@ -7864,7 +7941,8 @@ begin
   Add('var p: TFuncInt;');
   Add('begin');
   Add('  p:=@ProcA;');
-  CheckResolverException('Incompatible types: got "procedure(Longint)" expected "p:function(Longint)"',
+  CheckResolverException(
+    'Incompatible types: got "procedure type" expected "function type"',
     PasResolver.nIncompatibleTypesGotExpected);
 end;
 
@@ -7878,8 +7956,22 @@ begin
   Add('var p: TProcInt;');
   Add('begin');
   Add('  p:=@ProcA;');
-  CheckResolverException('Incompatible types: got "procedure(String)" expected "p:procedure(Longint)"',
-    PasResolver.nIncompatibleTypesGotExpected);
+  CheckResolverException('Incompatible type arg no. 1: Got "Longint", expected "String"',
+    PasResolver.nIncompatibleTypeArgNo);
+end;
+
+procedure TTestResolver.TestAssignProcWrongArgAccessFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TProcInt = procedure(i: longint);');
+  Add('procedure ProcA(const i: longint);');
+  Add('begin end;');
+  Add('var p: TProcInt;');
+  Add('begin');
+  Add('  p:=@ProcA;');
+  CheckResolverException('Incompatible type arg no. 1: Got "access modifier const", expected "default"',
+    PasResolver.nIncompatibleTypeArgNo);
 end;
 
 procedure TTestResolver.TestProcType_AssignNestedProcFail;
@@ -7985,7 +8077,8 @@ begin
   Add('  Button1: TButton;');
   Add('begin');
   Add('  Button1.OnClick := App.BtnClickHandler;');
-  CheckResolverException('Wrong number of parameters specified for call to "BtnClickHandler"',
+  CheckResolverException(
+    'Wrong number of parameters specified for call to "BtnClickHandler"',
     nWrongNumberOfParametersForCallTo);
 end;
 
@@ -8008,7 +8101,8 @@ begin
   Add('  Button1: TButton;');
   Add('begin');
   Add('  Button1.OnClick := App.BtnClickHandler();');
-  CheckResolverException('Wrong number of parameters specified for call to "BtnClickHandler"',
+  CheckResolverException(
+    'Wrong number of parameters specified for call to "procedure BtnClickHandler(TObject) of object"',
     nWrongNumberOfParametersForCallTo);
 end;
 
@@ -8031,7 +8125,8 @@ begin
   Add('  Button1: TButton;');
   Add('begin');
   Add('  Button1.OnClick := @App.BtnClickHandler();');
-  CheckResolverException('Wrong number of parameters specified for call to "BtnClickHandler"',
+  CheckResolverException(
+    'Wrong number of parameters specified for call to "procedure BtnClickHandler(TObject) of object"',
     nWrongNumberOfParametersForCallTo);
 end;
 
@@ -8092,7 +8187,7 @@ begin
   Add('var p: TNestedProc;');
   Add('begin');
   Add('  p:=@DoIt;');
-  CheckResolverException('foo',nXModifierMismatchY);
+  CheckResolverException('procedure type modifier "is nested" mismatch',nXModifierMismatchY);
 end;
 
 procedure TTestResolver.TestProcType_AllowNested;
@@ -8170,6 +8265,32 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestProcType_AsArgOtherUnit;
+begin
+  AddModuleWithIntfImplSrc('unit2.pas',
+    LinesToStr([
+    'type',
+    '  JSInteger = longint;',
+    '  TObject = class;',
+    '  TJSArrayCallBack = function (element : JSInteger) : Boolean;',
+    '  TObject = class',
+    '  public',
+    '    procedure forEach(const aCallBack : TJSArrayCallBack); virtual; abstract;',
+    '  end;',
+    '']),
+    '');
+  StartProgram(true);
+  Add('uses unit2;');
+  Add('function showElement(el : JSInteger) : boolean  ;');
+  Add('begin');
+  Add('  result:=true;');
+  Add('end;');
+  Add('var a: TObject;');
+  Add('begin');
+  Add('  a.forEach(@ShowElement);');
+  ParseProgram;
+end;
+
 initialization
   RegisterTests([TTestResolver]);