merged revs: 35782,35790,35791,35793,35794,35795,35798,35799,35800,35801,35802,35803,35804,35805,35806,35808,35809,35810,35811

git-svn-id: branches/fixes_3_0@35987 -

packages/fcl-passrc/src/pastree.pp

@@ -101,7 +101,10 @@ type
     visPublished, visAutomated,
     visStrictPrivate, visStrictProtected);
 
-  TCallingConvention = (ccDefault,ccRegister,ccPascal,ccCDecl,ccStdCall,ccOldFPCCall,ccSafeCall,ccSysCall);
+  TCallingConvention = (ccDefault,ccRegister,ccPascal,ccCDecl,ccStdCall,
+                        ccOldFPCCall,ccSafeCall,ccSysCall);
+  TProcTypeModifier = (ptmOfObject,ptmIsNested,ptmStatic,ptmVarargs);
+  TProcTypeModifiers = set of TProcTypeModifier;
   TPackMode = (pmNone,pmPacked,pmBitPacked);
 
   TPasMemberVisibilities = set of TPasMemberVisibility;
@@ -648,6 +651,11 @@ type
   { TPasProcedureType }
 
   TPasProcedureType = class(TPasType)
+  private
+    function GetIsNested: Boolean;
+    function GetIsOfObject: Boolean;
+    procedure SetIsNested(const AValue: Boolean);
+    procedure SetIsOfObject(const AValue: Boolean);
   public
     constructor Create(const AName: string; AParent: TPasElement); override;
     destructor Destroy; override;
@@ -659,10 +667,11 @@ type
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
   public
-    IsOfObject: Boolean;
-    IsNested : Boolean;
     Args: TFPList;        // List of TPasArgument objects
     CallingConvention: TCallingConvention;
+    Modifiers: TProcTypeModifiers;
+    property IsOfObject: Boolean read GetIsOfObject write SetIsOfObject;
+    property IsNested : Boolean read GetIsNested write SetIsNested;
   end;
 
   { TPasResultElement }
@@ -828,7 +837,7 @@ type
 
   TProcedureModifier = (pmVirtual, pmDynamic, pmAbstract, pmOverride,
                         pmExport, pmOverload, pmMessage, pmReintroduce,
-                        pmStatic,pmInline,pmAssembler,pmVarargs, pmPublic,
+                        pmInline,pmAssembler, pmPublic,
                         pmCompilerProc,pmExternal,pmForward, pmDispId, 
                         pmNoReturn, pmfar);
   TProcedureModifiers = Set of TProcedureModifier;
@@ -1410,11 +1419,13 @@ const
       ( 'deprecated', 'library', 'platform', 'experimental', 'unimplemented' );
   cCallingConventions : Array[TCallingConvention] of string =
       ( '', 'Register','Pascal','CDecl','StdCall','OldFPCCall','SafeCall','SysCall');
+  ProcTypeModifiers : Array[TProcTypeModifier] of string =
+      ('of Object', 'is nested','static','varargs');
 
   ModifierNames : Array[TProcedureModifier] of string
                 = ('virtual', 'dynamic','abstract', 'override',
                    'export', 'overload', 'message', 'reintroduce',
-                   'static','inline','assembler','varargs', 'public',
+                   'inline','assembler','public',
                    'compilerproc','external','forward','dispid',
                    'noreturn','far');
 
@@ -2447,6 +2458,32 @@ end;
 
 { TPasProcedureType }
 
+function TPasProcedureType.GetIsNested: Boolean;
+begin
+  Result:=ptmIsNested in Modifiers;
+end;
+
+function TPasProcedureType.GetIsOfObject: Boolean;
+begin
+  Result:=ptmOfObject in Modifiers;
+end;
+
+procedure TPasProcedureType.SetIsNested(const AValue: Boolean);
+begin
+  if AValue then
+    Include(Modifiers,ptmIsNested)
+  else
+    Exclude(Modifiers,ptmIsNested);
+end;
+
+procedure TPasProcedureType.SetIsOfObject(const AValue: Boolean);
+begin
+  if AValue then
+    Include(Modifiers,ptmOfObject)
+  else
+    Exclude(Modifiers,ptmOfObject);
+end;
+
 constructor TPasProcedureType.Create(const AName: string; AParent: TPasElement);
 begin
   inherited Create(AName, AParent);
@@ -3690,7 +3727,7 @@ end;
 function TPasProcedure.IsStatic: Boolean;
 
 begin
-  Result:=pmStatic in FModifiers;
+  Result:=ptmStatic in ProcType.Modifiers;
 end;
 
 function TPasProcedure.IsForward: Boolean;

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -147,15 +147,15 @@ type
   end;
 
   TPasAnalyzerOption = (
-    paoKeepPublished, // when a class is used, all its published members are used as well
     paoOnlyExports // default: use all class members accessible from outside (protected, but not private)
     );
   TPasAnalyzerOptions = set of TPasAnalyzerOption;
 
   TPAUseMode = (
-    paumElement, // mark element
-    paumAllPublic, // mark element and descend into children and mark public identifiers
-    paumAllExports // do not mark element and descend into children and mark exports
+    paumElement, // Mark element. Do not descend into children.
+    paumAllPublic, // Mark element and descend into children and mark public identifiers
+    paumAllExports, // Do not mark element. Descend into children and mark exports.
+    paumPublished // Mark element and its type and descend into children and mark published identifiers
     );
   TPAUseModes = set of TPAUseMode;
 
@@ -188,6 +188,7 @@ type
     function ElementVisited(El: TPasElement; Mode: TPAUseMode): boolean;
     procedure UseElement(El: TPasElement; Access: TResolvedRefAccess;
       UseFull: boolean); virtual;
+    procedure UsePublished(El: TPasElement); virtual;
     procedure UseModule(aModule: TPasModule; Mode: TPAUseMode); virtual;
     procedure UseSection(Section: TPasSection; Mode: TPAUseMode); virtual;
     procedure UseImplBlock(Block: TPasImplBlock; Mark: boolean); virtual;
@@ -221,6 +222,7 @@ type
     function FindElement(El: TPasElement): TPAElement;
     // utility
     function IsUsed(El: TPasElement): boolean; // valid after calling Analyze*
+    function IsTypeInfoUsed(El: TPasElement): boolean; // valid after calling Analyze*
     function IsModuleInternal(El: TPasElement): boolean;
     function IsExport(El: TPasElement): boolean;
     function IsIdentifier(El: TPasElement): boolean;
@@ -615,6 +617,82 @@ begin
     RaiseNotSupported(20170307090947,El);
 end;
 
+procedure TPasAnalyzer.UsePublished(El: TPasElement);
+// mark typeinfo, do not
+var
+  C: TClass;
+  Members: TFPList;
+  i: Integer;
+  Member: TPasElement;
+  MemberResolved: TPasResolverResult;
+  Prop: TPasProperty;
+  ProcType: TPasProcedureType;
+begin
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.UsePublished START ',GetObjName(El));
+  {$ENDIF}
+  if ElementVisited(El,paumPublished) then exit;
+  C:=El.ClassType;
+  if C=TPasUnresolvedSymbolRef then
+  else if (C=TPasVariable) or (C=TPasConst) then
+    UsePublished(TPasVariable(El).VarType)
+  else if C=TPasProperty then
+    begin
+    // published property
+    Prop:=TPasProperty(El);
+    for i:=0 to Prop.Args.Count-1 do
+      UsePublished(TPasArgument(Prop.Args[i]).ArgType);
+    UsePublished(Prop.VarType);
+    // Note: read, write and index don't need extra typeinfo
+
+    // stored and defaultvalue are only used when published -> mark as used
+    UseElement(Prop.StoredAccessor,rraRead,false);
+    UseElement(Prop.DefaultExpr,rraRead,false);
+    end
+  else if (C=TPasAliasType) or (C=TPasTypeAliasType) then
+    UsePublished(TPasAliasType(El).DestType)
+  else if C=TPasEnumType then
+  else if C=TPasSetType then
+    UsePublished(TPasSetType(El).EnumType)
+  else if C=TPasArrayType then
+    begin
+    UsePublished(TPasArrayType(El).ElType);
+    for i:=0 to length(TPasArrayType(El).Ranges)-1 do
+      begin
+      Member:=TPasArrayType(El).Ranges[i];
+      Resolver.ComputeElement(Member,MemberResolved,[rcConstant]);
+      UsePublished(MemberResolved.TypeEl);
+      end;
+    end
+  else if C=TPasPointerType then
+    UsePublished(TPasPointerType(El).DestType)
+  else if C=TPasClassType then
+  else if C=TPasClassOfType then
+  else if C=TPasRecordType then
+    begin
+    // published record: use all members
+    Members:=TPasRecordType(El).Members;
+    for i:=0 to Members.Count-1 do
+      begin
+      Member:=TPasElement(Members[i]);
+      UsePublished(Member);
+      UseElement(Member,rraNone,true);
+      end;
+    end
+  else if C.InheritsFrom(TPasProcedure) then
+    UsePublished(TPasProcedure(El).ProcType)
+  else if C.InheritsFrom(TPasProcedureType) then
+    begin
+    ProcType:=TPasProcedureType(El);
+    for i:=0 to ProcType.Args.Count-1 do
+      UsePublished(TPasArgument(ProcType.Args[i]).ArgType);
+    if El is TPasFunctionType then
+      UsePublished(TPasFunctionType(El).ResultEl.ResultType);
+    end
+  else
+    RaiseNotSupported(20170414153904,El);
+end;
+
 procedure TPasAnalyzer.UseModule(aModule: TPasModule; Mode: TPAUseMode);
 
   procedure UseInitFinal(aSection: TPasImplBlock);
@@ -877,18 +955,22 @@ var
   C: TClass;
   Params: TPasExprArray;
   i: Integer;
+  BuiltInProc: TResElDataBuiltInProc;
+  ParamResolved: TPasResolverResult;
+  Decl: TPasElement;
 begin
   if El=nil then exit;
   // expressions are not marked
 
+  Ref:=nil;
   if El.CustomData is TResolvedReference then
     begin
     // this is a reference -> mark target
     Ref:=TResolvedReference(El.CustomData);
-    UseElement(Ref.Declaration,Ref.Access,false);
+    Decl:=Ref.Declaration;
+    UseElement(Decl,Ref.Access,false);
 
-    if (El.ClassType=TSelfExpr)
-        or ((El.ClassType=TPrimitiveExpr) and (TPrimitiveExpr(El).Kind=pekIdent)) then
+    if Resolver.IsNameExpr(El) then
       begin
       if Ref.WithExprScope<>nil then
         begin
@@ -899,12 +981,12 @@ begin
           exit;
           end;
         end;
-      if (Ref.Declaration is TPasVariable)
+      if (Decl is TPasVariable)
           and (El.Parent is TBinaryExpr)
           and (TBinaryExpr(El.Parent).right=El) then
         begin
-        if ((Ref.Declaration.Parent is TPasRecordType)
-              or (Ref.Declaration.Parent is TPasVariant)) then
+        if ((Decl.Parent is TPasRecordType)
+              or (Decl.Parent is TPasVariant)) then
           begin
           // a record member was accessed -> access the record too
           UseExprRef(TBinaryExpr(El.Parent).left,Ref.Access,false);
@@ -912,6 +994,20 @@ begin
         end;
       end;
 
+    if Decl is TPasUnresolvedSymbolRef then
+      begin
+      if Decl.CustomData is TResElDataBuiltInProc then
+        begin
+        BuiltInProc:=TResElDataBuiltInProc(Decl.CustomData);
+        if BuiltInProc.BuiltIn=bfTypeInfo then
+          begin
+          Params:=(El.Parent as TParamsExpr).Params;
+          Resolver.ComputeElement(Params[0],ParamResolved,[]);
+          UsePublished(ParamResolved.IdentEl);
+          end;
+        end;
+      end;
+
     end;
   UseExpr(El.format1);
   UseExpr(El.format2);
@@ -1039,7 +1135,7 @@ begin
   if ImplProc.Body<>nil then
     UseImplBlock(ImplProc.Body.Body,false);
 
-  if ProcScope.OverriddenProc<>nil then
+  if Proc.IsOverride and (ProcScope.OverriddenProc<>nil) then
     AddOverride(ProcScope.OverriddenProc,Proc);
 
   // mark overrides
@@ -1158,7 +1254,7 @@ procedure TPasAnalyzer.UseClassType(El: TPasClassType; Mode: TPAUseMode);
 var
   i: Integer;
   Member: TPasElement;
-  UsePublished, FirstTime: Boolean;
+  AllPublished, FirstTime: Boolean;
   ProcScope: TPasProcedureScope;
   ClassScope: TPasClassScope;
   Ref: TResolvedReference;
@@ -1178,6 +1274,8 @@ begin
     end;
   paumElement:
     if not MarkElementAsUsed(El) then exit;
+  else
+    RaiseInconsistency(20170414152143,IntToStr(ord(Mode)));
   end;
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.UseClassType ',GetElModName(El),' ',Mode,' First=',FirstTime);
@@ -1199,20 +1297,30 @@ begin
       UseType(TPasType(El.Interfaces[i]),paumElement);
     end;
   // members
-  UsePublished:=(Mode<>paumAllExports) and (paoKeepPublished in Options);
+  AllPublished:=(Mode<>paumAllExports);
   for i:=0 to El.Members.Count-1 do
     begin
     Member:=TPasElement(El.Members[i]);
     if FirstTime and (Member is TPasProcedure) then
       begin
       ProcScope:=Member.CustomData as TPasProcedureScope;
-      if ProcScope.OverriddenProc<>nil then
+      if TPasProcedure(Member).IsOverride and (ProcScope.OverriddenProc<>nil) then
+        begin
+        // this is an override
         AddOverride(ProcScope.OverriddenProc,Member);
+        if ScopeModule<>nil then
+          begin
+          // when analyzingf a single module, all overrides are assumed to be called
+          UseElement(Member,rraNone,true);
+          continue;
+          end;
+        end;
       end;
-    if UsePublished and (Member.Visibility=visPublished) then
+    if AllPublished and (Member.Visibility=visPublished) then
       begin
       // include published
       if not FirstTime then continue;
+      UsePublished(Member);
       end
     else if Mode=paumElement then
       continue
@@ -1763,6 +1871,11 @@ begin
   Result:=FindElement(El)<>nil;
 end;
 
+function TPasAnalyzer.IsTypeInfoUsed(El: TPasElement): boolean;
+begin
+  Result:=FChecked[paumPublished].Find(El)<>nil;
+end;
+
 function TPasAnalyzer.IsModuleInternal(El: TPasElement): boolean;
 begin
   if El=nil then
@@ -1772,7 +1885,7 @@ begin
   if IsExport(El) then exit(false);
   case El.Visibility of
   visPrivate,visStrictPrivate: exit(true);
-  visPublished: if paoKeepPublished in Options then exit(false);
+  visPublished: exit(false);
   end;
   Result:=IsModuleInternal(El.Parent);
 end;

packages/fcl-passrc/src/pparser.pp

@@ -245,6 +245,7 @@ type
     function GetVariableModifiers(Parent: TPasElement; Out VarMods: TVariableModifiers; Out LibName, ExportName: TPasExpr; ExternalClass : Boolean): string;
     function GetVariableValueAndLocation(Parent : TPasElement; Out Value : TPasExpr; Out Location: String): Boolean;
     procedure HandleProcedureModifier(Parent: TPasElement; pm : TProcedureModifier);
+    procedure HandleProcedureTypeModifier(ProcType: TPasProcedureType; ptm : TProcTypeModifier);
     procedure ParseClassLocalConsts(AType: TPasClassType; AVisibility: TPasMemberVisibility);
     procedure ParseClassLocalTypes(AType: TPasClassType; AVisibility: TPasMemberVisibility);
     procedure ParseVarList(Parent: TPasElement; VarList: TFPList; AVisibility: TPasMemberVisibility; Full: Boolean);
@@ -299,8 +300,9 @@ type
     function CreateRecordValues(AParent : TPasElement): TRecordValues;
     Function IsCurTokenHint(out AHint : TPasMemberHint) : Boolean; overload;
     Function IsCurTokenHint: Boolean; overload;
-    Function TokenIsCallingConvention(S : String; out CC : TCallingConvention) : Boolean; virtual;
-    Function TokenIsProcedureModifier(Parent : TPasElement; S : String; Out Pm : TProcedureModifier) : Boolean; virtual;
+    Function TokenIsCallingConvention(const S : String; out CC : TCallingConvention) : Boolean; virtual;
+    Function TokenIsProcedureModifier(Parent : TPasElement; const S : String; Out PM : TProcedureModifier) : Boolean; virtual;
+    Function TokenIsProcedureTypeModifier(Parent : TPasElement; const S : String; Out PTM : TProcTypeModifier) : Boolean; virtual;
     Function CheckHint(Element : TPasElement; ExpectSemiColon : Boolean) : TPasMemberHints;
     function ParseParams(AParent : TPasElement;paramskind: TPasExprKind; AllowFormatting : Boolean = False): TParamsExpr;
     function ParseExpIdent(AParent : TPasElement): TPasExpr;
@@ -401,7 +403,7 @@ function ParseSource(AEngine: TPasTreeContainer;
                      const FPCCommandLine, OSTarget, CPUTarget: String;
                      UseStreams  : Boolean = False): TPasModule;
 Function IsHintToken(T : String; Out AHint : TPasMemberHint) : boolean;
-Function IsModifier(S : String; Out Pm : TProcedureModifier) : Boolean;
+Function IsProcModifier(S : String; Out PM : TProcedureModifier) : Boolean;
 Function IsCallingConvention(S : String; out CC : TCallingConvention) : Boolean;
 Function TokenToAssignKind( tk : TToken) : TAssignKind;
 
@@ -459,9 +461,7 @@ begin
     end;
 end;
 
-
-Function IsModifier(S : String; Out Pm : TProcedureModifier) : Boolean;
-
+Function IsProcModifier(S : String; Out PM : TProcedureModifier) : Boolean;
 
 Var
   P : TProcedureModifier;
@@ -924,17 +924,17 @@ begin
   Result:=IsCurTokenHint(dummy);
 end;
 
-function TPasParser.TokenIsCallingConvention(S: String; out
+function TPasParser.TokenIsCallingConvention(const S: String; out
   CC: TCallingConvention): Boolean;
 begin
   Result:=IsCallingConvention(S,CC);
 end;
 
-function TPasParser.TokenIsProcedureModifier(Parent: TPasElement; S: String;
-  out Pm: TProcedureModifier): Boolean;
+function TPasParser.TokenIsProcedureModifier(Parent: TPasElement;
+  const S: String; out PM: TProcedureModifier): Boolean;
 begin
-  Result:=IsModifier(S,PM);
-  if result and (pm in [pmPublic,pmForward]) then
+  Result:=IsProcModifier(S,PM);
+  if Result and (PM in [pmPublic,pmForward]) then
     begin
     While (Parent<>Nil) and Not ((Parent is TPasClassType) or (Parent is TPasRecordType)) do
       Parent:=Parent.Parent;
@@ -942,6 +942,23 @@ begin
     end;
 end;
 
+function TPasParser.TokenIsProcedureTypeModifier(Parent: TPasElement;
+  const S: String; out PTM: TProcTypeModifier): Boolean;
+begin
+  if CompareText(S,ProcTypeModifiers[ptmVarargs])=0 then
+    begin
+    Result:=true;
+    PTM:=ptmVarargs;
+    end
+  else if CompareText(S,ProcTypeModifiers[ptmStatic])=0 then
+    begin
+    Result:=true;
+    PTM:=ptmStatic;
+    end
+  else
+   Result:=false;
+  if Parent=nil then;
+end;
 
 function TPasParser.CheckHint(Element: TPasElement; ExpectSemiColon: Boolean
   ): TPasMemberHints;
@@ -2601,6 +2618,7 @@ begin
                   for i := 0 to List.Count - 1 do
                   begin
                     VarEl := TPasVariable(List[i]);
+                    Engine.FinishScope(stDeclaration,VarEl);
                     Declarations.Declarations.Add(VarEl);
                     Declarations.Variables.Add(VarEl);
                   end;
@@ -3083,7 +3101,8 @@ end;
 
 
 // Full means that a full variable declaration is being parsed.
-procedure TPasParser.ParseVarList(Parent: TPasElement; VarList: TFPList; AVisibility: TPasMemberVisibility; Full : Boolean);
+procedure TPasParser.ParseVarList(Parent: TPasElement; VarList: TFPList;
+  AVisibility: TPasMemberVisibility; Full : Boolean);
 // on Exception the VarList is restored, no need to Release the new elements
 
 var
@@ -3186,8 +3205,6 @@ begin
         aExpName.AddRef;
         end;
       end;
-    for i := OldListCount to VarList.Count - 1 do
-      Engine.FinishScope(stDeclaration,TPasVariable(VarList[i]));
     ok:=true;
   finally
     if aLibName<>nil then aLibName.Release;
@@ -3441,8 +3458,6 @@ Var
   end;
 
 begin
-  if not (Parent is TPasProcedure) then
-    exit;
   P:=TPasProcedure(Parent);
   if pm<>pmPublic then
     AddModifier;
@@ -3541,6 +3556,14 @@ begin
   end; // Case
 end;
 
+procedure TPasParser.HandleProcedureTypeModifier(ProcType: TPasProcedureType;
+  ptm: TProcTypeModifier);
+begin
+  if ptm in ProcType.Modifiers then
+    ParseExcSyntaxError;
+  Include(ProcType.Modifiers,ptm);
+end;
+
 // Next token is expected to be a "(", ";" or for a function ":". The caller
 // will get the token after the final ";" as next token.
 procedure TPasParser.ParseProcedureOrFunctionHeader(Parent: TPasElement;
@@ -3608,12 +3631,16 @@ Var
   PM : TProcedureModifier;
   Done: Boolean;
   ResultEl: TPasResultElement;
-  OK : Boolean;
+  OK,IsProc : Boolean;
+  PTM: TProcTypeModifier;
+  ModCount: Integer;
+  LastToken: TToken;
 
 begin
   // Element must be non-nil. Removed all checks for not-nil.
   // If it is nil, the following fails anyway.
   CheckProcedureArgs(Element,Element.Args,ProcType in [ptOperator,ptClassOperator]);
+  IsProc:=Parent is TPasProcedure;
   case ProcType of
     ptFunction,ptClassFunction:
       begin
@@ -3667,12 +3694,12 @@ begin
   if OfObjectPossible then
     begin
     NextToken;
-    if (curToken =tkOf) then
+    if (CurToken = tkOf) then
       begin
       ExpectToken(tkObject);
       Element.IsOfObject := True;
       end
-    else if (curToken = tkIs) then
+    else if (CurToken = tkIs) then
       begin
       expectToken(tkIdentifier);
       if (lowerCase(CurTokenString)<>'nested') then
@@ -3682,18 +3709,23 @@ begin
     else
       UnGetToken;
     end;
-  NextToken;
-  if CurToken = tkEqual then
-    begin
-    // for example: const p: procedure = nil;
-    UngetToken;
-    exit;
-    end
-  else
-    UngetToken;
+  ModCount:=0;
   Repeat
+    inc(ModCount);
+    LastToken:=CurToken;
     NextToken;
-    If TokenIsCallingConvention(CurTokenString,cc) then
+    if (ModCount=1) and (CurToken = tkEqual) then
+      begin
+      // for example: const p: procedure = nil;
+      UngetToken;
+      exit;
+      end;
+    If CurToken=tkSemicolon then
+      begin
+      if LastToken=tkSemicolon then
+        ParseExcSyntaxError;
+      end
+    else if TokenIsCallingConvention(CurTokenString,cc) then
       begin
       Element.CallingConvention:=Cc;
       if cc = ccSysCall then
@@ -3712,8 +3744,10 @@ begin
       end;
       ExpectToken(tkSemicolon);
       end
-    else if TokenIsProcedureModifier(Parent,CurTokenString,pm) then
-      HandleProcedureModifier(Parent,Pm)
+    else if IsProc and TokenIsProcedureModifier(Parent,CurTokenString,PM) then
+      HandleProcedureModifier(Parent,PM)
+    else if TokenIsProcedureTypeModifier(Parent,CurTokenString,PTM) then
+      HandleProcedureTypeModifier(Element,PTM)
     else if (CurToken=tklibrary) then // library is a token and a directive.
       begin
       Tok:=UpperCase(CurTokenString);
@@ -3743,16 +3777,17 @@ begin
       until CurToken = tkSquaredBraceClose;
       ExpectToken(tkSemicolon);
       end
-    else if CurToken<>tkSemicolon then
+    else
       CheckToken(tkSemicolon);
     Done:=(CurToken=tkSemiColon);
     if Done then
       begin
       NextToken;
       Done:=Not ((Curtoken=tkSquaredBraceOpen) or
-                  TokenIsProcedureModifier(Parent,CurtokenString,Pm) or
-                  IscurtokenHint() or
-                  TokenisCallingConvention(CurTokenString,cc) or
+                  TokenIsProcedureModifier(Parent,CurtokenString,PM) or
+                  TokenIsProcedureTypeModifier(Parent,CurtokenString,PTM) or
+                  IsCurTokenHint() or
+                  TokenIsCallingConvention(CurTokenString,cc) or
                   (CurToken=tkIdentifier) and (CompareText(CurTokenText,'alias')=0));
 //      DumpCurToken('Done '+IntToStr(Ord(Done)));
       UngetToken;
@@ -3852,7 +3887,7 @@ var
 begin
   Result:=TPasProperty(CreateElement(TPasProperty,AName,Parent,AVisibility));
   if IsClassField then
-    Result.VarModifiers:=Result.VarModifiers+[vmClass];
+    Include(Result.VarModifiers,vmClass);
   ok:=false;
   try
     NextToken;
@@ -4103,7 +4138,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
@@ -4760,6 +4795,7 @@ Var
   Cons : TPasConst;
   isClass : Boolean;
   NamePos: TPasSourcePos;
+  OldCount, i: Integer;
 begin
   v:=visDefault;
   isClass:=False;
@@ -4818,7 +4854,10 @@ begin
             NextToken;
             Continue;
             end;
+        OldCount:=ARec.Members.Count;
         ParseInlineVarDecl(ARec, ARec.Members, v, AEndToken=tkBraceClose);
+        for i:=OldCount to ARec.Members.Count-1 do
+          Engine.FinishScope(stDeclaration,TPasVariable(ARec.Members[i]));
         end;
       tkCase :
         begin
@@ -4946,6 +4985,7 @@ Var
   Element: TPasElement;
   I : Integer;
   isStatic : Boolean;
+  VarEl: TPasVariable;
 
 begin
   VarList := TFPList.Create;
@@ -4966,10 +5006,12 @@ begin
       Element.Visibility := AVisibility;
       if (Element is TPasVariable) then
         begin
+        VarEl:=TPasVariable(Element);
         if IsClassField then
-          TPasVariable(Element).VarModifiers:=TPasVariable(Element).VarModifiers+[vmClass];
+          Include(VarEl.VarModifiers,vmClass);
         if isStatic then
-          TPasVariable(Element).VarModifiers:=TPasVariable(Element).VarModifiers+[vmStatic];
+          Include(VarEl.VarModifiers,vmStatic);
+        Engine.FinishScope(stDeclaration,VarEl);
         end;
       AType.Members.Add(Element);
       end;

packages/fcl-passrc/tests/tcbaseparser.pas

@@ -79,6 +79,7 @@ Type
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TPasMemberVisibility); overload;
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TProcedureModifier); overload;
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TProcedureModifiers); overload;
+    Procedure AssertEquals(Const Msg : String; AExpected, AActual: TProcTypeModifiers); overload;
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TAssignKind); overload;
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TProcedureMessageType); overload;
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TOperatorType); overload;
@@ -849,6 +850,27 @@ begin
   AssertEquals(Msg,Sn(AExpected),SN(AActual));
 end;
 
+procedure TTestParser.AssertEquals(const Msg: String; AExpected,
+  AActual: TProcTypeModifiers);
+
+  Function Sn (S : TProcTypeModifiers) : String;
+
+  Var
+    m : TProcTypeModifier;
+  begin
+    Result:='';
+    For M:=Low(TProcTypeModifier) to High(TProcTypeModifier) do
+      If (m in S) then
+        begin
+        If (Result<>'') then
+           Result:=Result+',';
+        Result:=Result+GetEnumName(TypeInfo(TProcTypeModifier),Ord(m))
+        end;
+  end;
+begin
+  AssertEquals(Msg,Sn(AExpected),SN(AActual));
+end;
+
 procedure TTestParser.AssertEquals(const Msg: String; AExpected,
   AActual: TAssignKind);
 begin

packages/fcl-passrc/tests/tcprocfunc.pas

@@ -24,8 +24,8 @@ type
       AValue: String='');
     procedure AssertArrayArg(ProcType: TPasProcedureType; AIndex: Integer;
       AName: String; AAccess: TArgumentAccess; const ElementTypeName: String);
-    procedure AssertFunc(Mods: TProcedureModifiers; CC: TCallingConvention; ArgCount: Integer; P: TPasFunction=nil);
-    procedure AssertProc(Mods: TProcedureModifiers; CC: TCallingConvention; ArgCount: Integer; P: TPasProcedure=nil);
+    procedure AssertFunc(const Mods: TProcedureModifiers; const TypeMods: TProcTypeModifiers; CC: TCallingConvention; ArgCount: Integer; P: TPasFunction=nil);
+    procedure AssertProc(const Mods: TProcedureModifiers; const TypeMods: TProcTypeModifiers; CC: TCallingConvention; ArgCount: Integer; P: TPasProcedure=nil);
     function BaseAssertArg(ProcType: TPasProcedureType; AIndex: Integer;
       AName: String; AAccess: TArgumentAccess; AValue: String=''): TPasArgument;
     procedure CreateForwardTest;
@@ -269,13 +269,16 @@ begin
     CheckHint(TPasMemberHint(Getenumvalue(typeinfo(TPasMemberHint),'h'+Hint)));
 end;
 
-procedure TTestProcedureFunction.AssertProc(Mods : TProcedureModifiers; CC : TCallingConvention; ArgCount : Integer; P : TPasProcedure = Nil);
+procedure TTestProcedureFunction.AssertProc(const Mods: TProcedureModifiers;
+  const TypeMods: TProcTypeModifiers; CC: TCallingConvention; ArgCount: Integer;
+  P: TPasProcedure);
 
 begin
   If P=Nil then
     P:=Proc;
   AssertNotNull('No proc to assert',P);
   AssertEquals('Procedure modifiers',Mods,P.Modifiers);
+  AssertEquals('Procedure type modifiers',TypeMods,P.ProcType.Modifiers);
   AssertEquals('Procedue calling convention',CC,P.CallingConvention);
   AssertEquals('No message name','',p.MessageName);
   AssertEquals('No message type',pmtNone,P.MessageType);
@@ -285,13 +288,16 @@ begin
   AssertEquals('Not is nested',False,P.ProcType.IsNested);
 end;
 
-procedure TTestProcedureFunction.AssertFunc(Mods : TProcedureModifiers; CC : TCallingConvention; ArgCount : Integer; P : TPasFunction = Nil);
+procedure TTestProcedureFunction.AssertFunc(const Mods: TProcedureModifiers;
+  const TypeMods: TProcTypeModifiers; CC: TCallingConvention; ArgCount: Integer;
+  P: TPasFunction);
 
 begin
   If P=Nil then
     P:=Func;
   AssertNotNull('No func to assert',P);
   AssertEquals('Procedure modifiers',Mods,P.Modifiers);
+  AssertEquals('Procedure type modifiers',TypeMods,P.ProcType.Modifiers);
   AssertEquals('Procedue calling convention',CC,P.CallingConvention);
   AssertEquals('No message name','',p.MessageName);
   AssertEquals('No message type',pmtNone,P.MessageType);
@@ -384,7 +390,7 @@ end;
 procedure TTestProcedureFunction.TestEmptyProcedure;
 begin
   ParseProcedure('');
-  AssertProc([],ccDefault,0);
+  AssertProc([],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestEmptyProcedureComment;
@@ -396,7 +402,7 @@ end;
 procedure TTestProcedureFunction.TestEmptyFunction;
 begin
   ParseFunction('');
-  AssertFunc([],ccDefault,0);
+  AssertFunc([],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestEmptyFunctionComment;
@@ -408,50 +414,49 @@ end;
 procedure TTestProcedureFunction.TestEmptyProcedureDeprecated;
 begin
   ParseProcedure('','deprecated');
-  AssertProc([],ccDefault,0);
+  AssertProc([],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestEmptyFunctionDeprecated;
 begin
   ParseFunction('','deprecated');
-  AssertFunc([],ccDefault,0);
+  AssertFunc([],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestEmptyProcedurePlatform;
 begin
   ParseProcedure('','platform');
-  AssertProc([],ccDefault,0);
+  AssertProc([],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestEmptyFunctionPlatform;
 begin
   ParseFunction('','platform');
-  AssertFunc([],ccDefault,0);
+  AssertFunc([],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestEmptyProcedureExperimental;
 begin
   ParseProcedure('','experimental');
-  AssertProc([],ccDefault,0);
+  AssertProc([],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestEmptyFunctionExperimental;
 begin
   ParseFunction('','experimental');
-  AssertFunc([],ccDefault,0);
+  AssertFunc([],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestEmptyProcedureUnimplemented;
 begin
   ParseProcedure('','unimplemented');
-  AssertProc([],ccDefault,0);
+  AssertProc([],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestEmptyFunctionUnimplemented;
 begin
   ParseFunction('','unimplemented');
-  AssertFunc([],ccDefault,0);
-
+  AssertFunc([],[],ccDefault,0);
 end;
 
 
@@ -459,77 +464,77 @@ end;
 procedure TTestProcedureFunction.TestProcedureOneArg;
 begin
   ParseProcedure('(B : Integer)');
-  AssertProc([],ccDefault,1);
+  AssertProc([],[],ccDefault,1);
   AssertArg(ProcType,0,'B',argDefault,'Integer','');
 end;
 
 procedure TTestProcedureFunction.TestFunctionOneArg;
 begin
   ParseFunction('(B : Integer)');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArg(FuncType,0,'B',argDefault,'Integer','');
 end;
 
 procedure TTestProcedureFunction.TestProcedureOneVarArg;
 begin
   ParseProcedure('(Var B : Integer)');
-  AssertProc([],ccDefault,1);
+  AssertProc([],[],ccDefault,1);
   AssertArg(ProcType,0,'B',argVar,'Integer','');
 end;
 
 procedure TTestProcedureFunction.TestFunctionOneVarArg;
 begin
   ParseFunction('(Var B : Integer)');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArg(FuncType,0,'B',argVar,'Integer','');
 end;
 
 procedure TTestProcedureFunction.TestProcedureOneConstArg;
 begin
   ParseProcedure('(Const B : Integer)');
-  AssertProc([],ccDefault,1);
+  AssertProc([],[],ccDefault,1);
   AssertArg(ProcType,0,'B',argConst,'Integer','');
 end;
 
 procedure TTestProcedureFunction.TestFunctionOneConstArg;
 begin
   ParseFunction('(Const B : Integer)');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArg(FuncType,0,'B',argConst,'Integer','');
 end;
 
 procedure TTestProcedureFunction.TestProcedureOneOutArg;
 begin
   ParseProcedure('(Out B : Integer)');
-  AssertProc([],ccDefault,1);
+  AssertProc([],[],ccDefault,1);
   AssertArg(ProcType,0,'B',argOut,'Integer','');
 end;
 
 procedure TTestProcedureFunction.TestFunctionOneOutArg;
 begin
   ParseFunction('(Out B : Integer)');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArg(FuncType,0,'B',argOut,'Integer','');
 end;
 
 procedure TTestProcedureFunction.TestProcedureOneConstRefArg;
 begin
   ParseProcedure('(Constref B : Integer)');
-  AssertProc([],ccDefault,1);
+  AssertProc([],[],ccDefault,1);
   AssertArg(ProcType,0,'B',argConstRef,'Integer','');
 end;
 
 procedure TTestProcedureFunction.TestFunctionOneConstRefArg;
 begin
   ParseFunction('(ConstRef B : Integer)');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArg(FuncType,0,'B',argConstref,'Integer','');
 end;
 
 procedure TTestProcedureFunction.TestProcedureTwoArgs;
 begin
   ParseProcedure('(B,C : Integer)');
-  AssertProc([],ccDefault,2);
+  AssertProc([],[],ccDefault,2);
   AssertArg(ProcType,0,'B',argDefault,'Integer','');
   AssertArg(ProcType,1,'C',argDefault,'Integer','');
 end;
@@ -537,7 +542,7 @@ end;
 procedure TTestProcedureFunction.TestFunctionTwoArgs;
 begin
   ParseFunction('(B,C : Integer)');
-  AssertFunc([],ccDefault,2);
+  AssertFunc([],[],ccDefault,2);
   AssertArg(FuncType,0,'B',argDefault,'Integer','');
   AssertArg(FuncType,1,'C',argDefault,'Integer','');
 end;
@@ -545,7 +550,7 @@ end;
 procedure TTestProcedureFunction.TestProcedureTwoArgsSeparate;
 begin
   ParseProcedure('(B : Integer; C : Integer)');
-  AssertProc([],ccDefault,2);
+  AssertProc([],[],ccDefault,2);
   AssertArg(ProcType,0,'B',argDefault,'Integer','');
   AssertArg(ProcType,1,'C',argDefault,'Integer','');
 end;
@@ -553,7 +558,7 @@ end;
 procedure TTestProcedureFunction.TestFunctionTwoArgsSeparate;
 begin
   ParseFunction('(B : Integer;C : Integer)');
-  AssertFunc([],ccDefault,2);
+  AssertFunc([],[],ccDefault,2);
   AssertArg(FuncType,0,'B',argDefault,'Integer','');
   AssertArg(FuncType,1,'C',argDefault,'Integer','');
 end;
@@ -561,56 +566,56 @@ end;
 procedure TTestProcedureFunction.TestProcedureOneArgDefault;
 begin
   ParseProcedure('(B : Integer = 1)');
-  AssertProc([],ccDefault,1);
+  AssertProc([],[],ccDefault,1);
   AssertArg(ProcType,0,'B',argDefault,'Integer','1');
 end;
 
 procedure TTestProcedureFunction.TestFunctionOneArgDefault;
 begin
   ParseFunction('(B : Integer = 1)');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArg(FuncType,0,'B',argDefault,'Integer','1');
 end;
 
 procedure TTestProcedureFunction.TestFunctionOneArgEnumeratedExplicit;
 begin
   ParseFunction('(B : TSomeEnum = TSomeEnum.False)');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArg(FuncType,0,'B',argDefault,'TSomeEnum','TSomeEnum.False');
 end;
 
 procedure TTestProcedureFunction.TestProcedureOneArgDefaultSet;
 begin
   ParseProcedure('(B : MySet = [1,2])');
-  AssertProc([],ccDefault,1);
+  AssertProc([],[],ccDefault,1);
   AssertArg(ProcType,0,'B',argDefault,'MySet','[1, 2]');
 end;
 
 procedure TTestProcedureFunction.TestFunctionOneArgDefaultSet;
 begin
   ParseFunction('(B : MySet = [1,2])');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArg(FuncType,0,'B',argDefault,'MySet','[1, 2]');
 end;
 
 procedure TTestProcedureFunction.TestProcedureOneArgDefaultExpr;
 begin
   ParseProcedure('(B : Integer = 1 + 2)');
-  AssertProc([],ccDefault,1);
+  AssertProc([],[],ccDefault,1);
   AssertArg(ProcType,0,'B',argDefault,'Integer','1 + 2');
 end;
 
 procedure TTestProcedureFunction.TestFunctionOneArgDefaultExpr;
 begin
   ParseFunction('(B : Integer = 1 + 2)');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArg(FuncType,0,'B',argDefault,'Integer','1 + 2');
 end;
 
 procedure TTestProcedureFunction.TestProcedureTwoArgsDefault;
 begin
   ParseProcedure('(B : Integer = 1; C : Integer = 2)');
-  AssertProc([],ccDefault,2);
+  AssertProc([],[],ccDefault,2);
   AssertArg(ProcType,0,'B',argDefault,'Integer','1');
   AssertArg(ProcType,1,'C',argDefault,'Integer','2');
 end;
@@ -618,7 +623,7 @@ end;
 procedure TTestProcedureFunction.TestFunctionTwoArgsDefault;
 begin
   ParseFunction('(B : Integer = 1; C : Integer = 2)');
-  AssertFunc([],ccDefault,2);
+  AssertFunc([],[],ccDefault,2);
   AssertArg(FuncType,0,'B',argDefault,'Integer','1');
   AssertArg(FuncType,1,'C',argDefault,'Integer','2');
 end;
@@ -626,21 +631,21 @@ end;
 procedure TTestProcedureFunction.TestProcedureOneUntypedVarArg;
 begin
   ParseProcedure('(Var B)');
-  AssertProc([],ccDefault,1);
+  AssertProc([],[],ccDefault,1);
   AssertArg(ProcType,0,'B',argVar,'','');
 end;
 
 procedure TTestProcedureFunction.TestFunctionOneUntypedVarArg;
 begin
   ParseFunction('(Var B)');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArg(FuncType,0,'B',argVar,'','');
 end;
 
 procedure TTestProcedureFunction.TestProcedureTwoUntypedVarArgs;
 begin
   ParseProcedure('(Var B; Var C)');
-  AssertProc([],ccDefault,2);
+  AssertProc([],[],ccDefault,2);
   AssertArg(ProcType,0,'B',argVar,'','');
   AssertArg(ProcType,1,'C',argVar,'','');
 end;
@@ -648,7 +653,7 @@ end;
 procedure TTestProcedureFunction.TestFunctionTwoUntypedVarArgs;
 begin
   ParseFunction('(Var B; Var C)');
-  AssertFunc([],ccDefault,2);
+  AssertFunc([],[],ccDefault,2);
   AssertArg(FuncType,0,'B',argVar,'','');
   AssertArg(FuncType,1,'C',argVar,'','');
 end;
@@ -656,21 +661,21 @@ end;
 procedure TTestProcedureFunction.TestProcedureOneUntypedConstArg;
 begin
   ParseProcedure('(Const B)');
-  AssertProc([],ccDefault,1);
+  AssertProc([],[],ccDefault,1);
   AssertArg(ProcType,0,'B',argConst,'','');
 end;
 
 procedure TTestProcedureFunction.TestFunctionOneUntypedConstArg;
 begin
   ParseFunction('(Const B)');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArg(FuncType,0,'B',argConst,'','');
 end;
 
 procedure TTestProcedureFunction.TestProcedureTwoUntypedConstArgs;
 begin
   ParseProcedure('(Const B; Const C)');
-  AssertProc([],ccDefault,2);
+  AssertProc([],[],ccDefault,2);
   AssertArg(ProcType,0,'B',argConst,'','');
   AssertArg(ProcType,1,'C',argConst,'','');
 end;
@@ -678,7 +683,7 @@ end;
 procedure TTestProcedureFunction.TestFunctionTwoUntypedConstArgs;
 begin
   ParseFunction('(Const B; Const C)');
-  AssertFunc([],ccDefault,2);
+  AssertFunc([],[],ccDefault,2);
   AssertArg(FuncType,0,'B',argConst,'','');
   AssertArg(FuncType,1,'C',argConst,'','');
 end;
@@ -686,21 +691,21 @@ end;
 procedure TTestProcedureFunction.TestProcedureOpenArrayArg;
 begin
   ParseProcedure('(B : Array of Integer)');
-  AssertProc([],ccDefault,1);
+  AssertProc([],[],ccDefault,1);
   AssertArrayArg(ProcType,0,'B',argDefault,'Integer');
 end;
 
 procedure TTestProcedureFunction.TestFunctionOpenArrayArg;
 begin
   ParseFunction('(B : Array of Integer)');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArrayArg(FuncType,0,'B',argDefault,'Integer');
 end;
 
 procedure TTestProcedureFunction.TestProcedureTwoOpenArrayArgs;
 begin
   ParseProcedure('(B : Array of Integer;C : Array of Integer)');
-  AssertProc([],ccDefault,2);
+  AssertProc([],[],ccDefault,2);
   AssertArrayArg(ProcType,0,'B',argDefault,'Integer');
   AssertArrayArg(ProcType,1,'C',argDefault,'Integer');
 end;
@@ -708,7 +713,7 @@ end;
 procedure TTestProcedureFunction.TestFunctionTwoOpenArrayArgs;
 begin
   ParseFunction('(B : Array of Integer;C : Array of Integer)');
-  AssertFunc([],ccDefault,2);
+  AssertFunc([],[],ccDefault,2);
   AssertArrayArg(FuncType,0,'B',argDefault,'Integer');
   AssertArrayArg(FuncType,1,'C',argDefault,'Integer');
 end;
@@ -716,142 +721,142 @@ end;
 procedure TTestProcedureFunction.TestProcedureConstOpenArrayArg;
 begin
   ParseProcedure('(Const B : Array of Integer)');
-  AssertProc([],ccDefault,1);
+  AssertProc([],[],ccDefault,1);
   AssertArrayArg(ProcType,0,'B',argConst,'Integer');
 end;
 
 procedure TTestProcedureFunction.TestFunctionConstOpenArrayArg;
 begin
   ParseFunction('(Const B : Array of Integer)');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArrayArg(FuncType,0,'B',argConst,'Integer');
 end;
 
 procedure TTestProcedureFunction.TestProcedureVarOpenArrayArg;
 begin
   ParseProcedure('(Var B : Array of Integer)');
-  AssertProc([],ccDefault,1);
+  AssertProc([],[],ccDefault,1);
   AssertArrayArg(ProcType,0,'B',argVar,'Integer');
 end;
 
 procedure TTestProcedureFunction.TestFunctionVarOpenArrayArg;
 begin
   ParseFunction('(Var B : Array of Integer)');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArrayArg(FuncType,0,'B',argVar,'Integer');
 end;
 
 procedure TTestProcedureFunction.TestProcedureArrayOfConstArg;
 begin
   ParseProcedure('(B : Array of Const)');
-  AssertProc([],ccDefault,1);
+  AssertProc([],[],ccDefault,1);
   AssertArrayArg(ProcType,0,'B',argDefault,'');
 end;
 
 procedure TTestProcedureFunction.TestFunctionArrayOfConstArg;
 begin
   ParseFunction('(B : Array of Const)');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArrayArg(FuncType,0,'B',argDefault,'');
 end;
 
 procedure TTestProcedureFunction.TestProcedureConstArrayOfConstArg;
 begin
   ParseProcedure('(Const B : Array of Const)');
-  AssertProc([],ccDefault,1);
+  AssertProc([],[],ccDefault,1);
   AssertArrayArg(ProcType,0,'B',argConst,'');
 end;
 
 procedure TTestProcedureFunction.TestFunctionConstArrayOfConstArg;
 begin
   ParseFunction('(Const B : Array of Const)');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArrayArg(FuncType,0,'B',argConst,'');
 end;
 
 procedure TTestProcedureFunction.TestProcedureCdecl;
 begin
   ParseProcedure('; cdecl');
-  AssertProc([],ccCdecl,0);
+  AssertProc([],[],ccCdecl,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionCdecl;
 begin
   ParseFunction('','','',ccCdecl);
-  AssertFunc([],ccCdecl,0);
+  AssertFunc([],[],ccCdecl,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureCdeclDeprecated;
 begin
   ParseProcedure('; cdecl;','deprecated');
-  AssertProc([],ccCdecl,0);
+  AssertProc([],[],ccCdecl,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionCdeclDeprecated;
 begin
   ParseFunction('','','deprecated',ccCdecl);
-  AssertFunc([],ccCdecl,0);
+  AssertFunc([],[],ccCdecl,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureSafeCall;
 begin
   ParseProcedure('; safecall;','');
-  AssertProc([],ccSafeCall,0);
+  AssertProc([],[],ccSafeCall,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionSafeCall;
 begin
   ParseFunction('','','',ccSafecall);
-  AssertFunc([],ccSafecall,0);
+  AssertFunc([],[],ccSafecall,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedurePascal;
 begin
   ParseProcedure('; pascal;','');
-  AssertProc([],ccPascal,0);
+  AssertProc([],[],ccPascal,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionPascal;
 begin
   ParseFunction('','','',ccPascal);
-  AssertFunc([],ccPascal,0);
+  AssertFunc([],[],ccPascal,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureStdCall;
 begin
   ParseProcedure('; stdcall;','');
-  AssertProc([],ccstdcall,0);
+  AssertProc([],[],ccstdcall,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionStdCall;
 begin
   ParseFunction('','','',ccStdCall);
-  AssertFunc([],ccStdCall,0);
+  AssertFunc([],[],ccStdCall,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureOldFPCCall;
 begin
   ParseProcedure('; oldfpccall;','');
-  AssertProc([],ccoldfpccall,0);
+  AssertProc([],[],ccoldfpccall,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionOldFPCCall;
 begin
   ParseFunction('','','',ccOldFPCCall);
-  AssertFunc([],ccOldFPCCall,0);
+  AssertFunc([],[],ccOldFPCCall,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedurePublic;
 begin
   ParseProcedure('; public name ''myfunc'';','');
-  AssertProc([pmPublic],ccDefault,0);
+  AssertProc([pmPublic],[],ccDefault,0);
   AssertExpression('Public name',Proc.PublicName,pekString,'''myfunc''');
 end;
 
 procedure TTestProcedureFunction.TestProcedurePublicIdent;
 begin
   ParseProcedure('; public name exportname;','');
-  AssertProc([pmPublic],ccDefault,0);
+  AssertProc([pmPublic],[],ccDefault,0);
   AssertExpression('Public name',Proc.PublicName,pekIdent,'exportname');
 end;
 
@@ -859,14 +864,14 @@ procedure TTestProcedureFunction.TestFunctionPublic;
 begin
   AddDeclaration('function A : Integer; public name exportname');
   ParseFunction;
-  AssertFunc([pmPublic],ccDefault,0);
+  AssertFunc([pmPublic],[],ccDefault,0);
   AssertExpression('Public name',Func.PublicName,pekIdent,'exportname');
 end;
 
 procedure TTestProcedureFunction.TestProcedureCdeclPublic;
 begin
   ParseProcedure('; cdecl; public name exportname;','');
-  AssertProc([pmPublic],ccCDecl,0);
+  AssertProc([pmPublic],[],ccCDecl,0);
   AssertExpression('Public name',Proc.PublicName,pekIdent,'exportname');
 end;
 
@@ -874,47 +879,47 @@ procedure TTestProcedureFunction.TestFunctionCdeclPublic;
 begin
   AddDeclaration('function A : Integer; cdecl; public name exportname');
   ParseFunction;
-  AssertFunc([pmPublic],ccCDecl,0);
+  AssertFunc([pmPublic],[],ccCDecl,0);
   AssertExpression('Public name',Func.PublicName,pekIdent,'exportname');
 end;
 
 procedure TTestProcedureFunction.TestProcedureOverload;
 begin
   ParseProcedure('; overload;','');
-  AssertProc([pmOverload],ccDefault,0);
+  AssertProc([pmOverload],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionOverload;
 begin
   AddDeclaration('function A : Integer; overload');
   ParseFunction;
-  AssertFunc([pmOverload],ccDefault,0);
+  AssertFunc([pmOverload],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureVarargs;
 begin
   ParseProcedure('; varargs;','');
-  AssertProc([pmVarArgs],ccDefault,0);
+  AssertProc([],[ptmVarArgs],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionVarArgs;
 begin
   AddDeclaration('function A : Integer; varargs');
   ParseFunction;
-  AssertFunc([pmVarArgs],ccDefault,0);
+  AssertFunc([],[ptmVarArgs],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureCDeclVarargs;
 begin
   ParseProcedure(';cdecl; varargs;','');
-  AssertProc([pmVarArgs],ccCDecl,0);
+  AssertProc([],[ptmVarArgs],ccCDecl,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionCDeclVarArgs;
 begin
   AddDeclaration('function A : Integer; cdecl; varargs');
   ParseFunction;
-  AssertFunc([pmVarArgs],ccCdecl,0);
+  AssertFunc([],[ptmVarArgs],ccCdecl,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureForwardInterface;
@@ -934,7 +939,7 @@ begin
   UseImplementation:=True;
   AddDeclaration('procedure A; forward;');
   ParseProcedure;
-  AssertProc([pmforward],ccDefault,0);
+  AssertProc([pmforward],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionForward;
@@ -942,21 +947,21 @@ begin
   UseImplementation:=True;
   AddDeclaration('function A : integer; forward;');
   ParseFunction;
-  AssertFunc([pmforward],ccDefault,0);
+  AssertFunc([pmforward],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureFar;
 begin
   AddDeclaration('procedure A; far;');
   ParseProcedure;
-  AssertProc([pmfar],ccDefault,0);
+  AssertProc([pmfar],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionFar;
 begin
   AddDeclaration('function A : integer; far;');
   ParseFunction;
-  AssertFunc([pmfar],ccDefault,0);
+  AssertFunc([pmfar],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureCdeclForward;
@@ -964,7 +969,7 @@ begin
   UseImplementation:=True;
   AddDeclaration('procedure A; cdecl; forward;');
   ParseProcedure;
-  AssertProc([pmforward],ccCDecl,0);
+  AssertProc([pmforward],[],ccCDecl,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionCDeclForward;
@@ -972,97 +977,97 @@ begin
   UseImplementation:=True;
   AddDeclaration('function A : integer; cdecl; forward;');
   ParseFunction;
-  AssertFunc([pmforward],ccCDecl,0);
+  AssertFunc([pmforward],[],ccCDecl,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureCompilerProc;
 begin
   ParseProcedure(';compilerproc;','');
-  AssertProc([pmCompilerProc],ccDefault,0);
+  AssertProc([pmCompilerProc],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureNoReturn;
 begin
   ParseProcedure(';noreturn;','');
-  AssertProc([pmnoreturn],ccDefault,0);
+  AssertProc([pmnoreturn],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionCompilerProc;
 begin
   AddDeclaration('function A : Integer; compilerproc');
   ParseFunction;
-  AssertFunc([pmCompilerProc],ccDefault,0);
+  AssertFunc([pmCompilerProc],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureCDeclCompilerProc;
 begin
   ParseProcedure(';cdecl;compilerproc;','');
-  AssertProc([pmCompilerProc],ccCDecl,0);
+  AssertProc([pmCompilerProc],[],ccCDecl,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionCDeclCompilerProc;
 begin
   AddDeclaration('function A : Integer; cdecl; compilerproc');
   ParseFunction;
-  AssertFunc([pmCompilerProc],ccCDecl,0);
+  AssertFunc([pmCompilerProc],[],ccCDecl,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureAssembler;
 begin
   ParseProcedure(';assembler;','');
-  AssertProc([pmAssembler],ccDefault,0);
+  AssertProc([pmAssembler],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionAssembler;
 begin
   AddDeclaration('function A : Integer; assembler');
   ParseFunction;
-  AssertFunc([pmAssembler],ccDefault,0);
+  AssertFunc([pmAssembler],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureCDeclAssembler;
 begin
   ParseProcedure(';cdecl;assembler;','');
-  AssertProc([pmAssembler],ccCDecl,0);
+  AssertProc([pmAssembler],[],ccCDecl,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionCDeclAssembler;
 begin
   AddDeclaration('function A : Integer; cdecl; assembler');
   ParseFunction;
-  AssertFunc([pmAssembler],ccCDecl,0);
+  AssertFunc([pmAssembler],[],ccCDecl,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureExport;
 begin
   ParseProcedure(';export;','');
-  AssertProc([pmExport],ccDefault,0);
+  AssertProc([pmExport],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionExport;
 begin
   AddDeclaration('function A : Integer; export');
   ParseFunction;
-  AssertFunc([pmExport],ccDefault,0);
+  AssertFunc([pmExport],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureCDeclExport;
 begin
   ParseProcedure('cdecl;export;','');
-  AssertProc([pmExport],ccCDecl,0);
+  AssertProc([pmExport],[],ccCDecl,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionCDeclExport;
 begin
   AddDeclaration('function A : Integer; cdecl; export');
   ParseFunction;
-  AssertFunc([pmExport],ccCDecl,0);
+  AssertFunc([pmExport],[],ccCDecl,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureExternal;
 begin
   ParseProcedure(';external','');
-  AssertProc([pmExternal],ccDefault,0);
+  AssertProc([pmExternal],[],ccDefault,0);
   AssertNull('No Library name expression',Proc.LibraryExpr);
 end;
 
@@ -1070,7 +1075,7 @@ procedure TTestProcedureFunction.TestFunctionExternal;
 begin
   AddDeclaration('function A : Integer; external');
   ParseFunction;
-  AssertFunc([pmExternal],ccDefault,0);
+  AssertFunc([pmExternal],[],ccDefault,0);
   AssertNull('No Library name expression',Func.LibraryExpr);
 end;
 
@@ -1110,7 +1115,7 @@ end;
 procedure TTestProcedureFunction.TestProcedureExternalLibName;
 begin
   ParseProcedure(';external ''libname''','');
-  AssertProc([pmExternal],ccDefault,0);
+  AssertProc([pmExternal],[],ccDefault,0);
   AssertExpression('Library name expression',Proc.LibraryExpr,pekString,'''libname''');
 end;
 
@@ -1118,14 +1123,14 @@ procedure TTestProcedureFunction.TestFunctionExternalLibName;
 begin
   AddDeclaration('function A : Integer; external ''libname''');
   ParseFunction;
-  AssertFunc([pmExternal],ccDefault,0);
+  AssertFunc([pmExternal],[],ccDefault,0);
   AssertExpression('Library name expression',Func.LibraryExpr,pekString,'''libname''');
 end;
 
 procedure TTestProcedureFunction.TestProcedureExternalLibNameName;
 begin
   ParseProcedure(';external ''libname'' name ''symbolname''','');
-  AssertProc([pmExternal],ccDefault,0);
+  AssertProc([pmExternal],[],ccDefault,0);
   AssertExpression('Library name expression',Proc.LibraryExpr,pekString,'''libname''');
   AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
 end;
@@ -1134,7 +1139,7 @@ procedure TTestProcedureFunction.TestFunctionExternalLibNameName;
 begin
   AddDeclaration('function A : Integer; external ''libname'' name ''symbolname''');
   ParseFunction;
-  AssertFunc([pmExternal],ccDefault,0);
+  AssertFunc([pmExternal],[],ccDefault,0);
   AssertExpression('Library name expression',Func.LibraryExpr,pekString,'''libname''');
   AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
 end;
@@ -1142,7 +1147,7 @@ end;
 procedure TTestProcedureFunction.TestProcedureExternalName;
 begin
   ParseProcedure(';external name ''symbolname''','');
-  AssertProc([pmExternal],ccDefault,0);
+  AssertProc([pmExternal],[],ccDefault,0);
   AssertNull('No Library name expression',Proc.LibraryExpr);
   AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
 end;
@@ -1151,7 +1156,7 @@ procedure TTestProcedureFunction.TestFunctionExternalName;
 begin
   AddDeclaration('function A : Integer; external name ''symbolname''');
   ParseFunction;
-  AssertFunc([pmExternal],ccDefault,0);
+  AssertFunc([pmExternal],[],ccDefault,0);
   AssertNull('No Library name expression',Func.LibraryExpr);
   AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
 end;
@@ -1159,7 +1164,7 @@ end;
 procedure TTestProcedureFunction.TestProcedureCdeclExternal;
 begin
   ParseProcedure('; cdecl; external','');
-  AssertProc([pmExternal],ccCdecl,0);
+  AssertProc([pmExternal],[],ccCdecl,0);
   AssertNull('No Library name expression',Proc.LibraryExpr);
 end;
 
@@ -1167,14 +1172,14 @@ procedure TTestProcedureFunction.TestFunctionCdeclExternal;
 begin
   AddDeclaration('function A : Integer; cdecl; external');
   ParseFunction;
-  AssertFunc([pmExternal],ccCdecl,0);
+  AssertFunc([pmExternal],[],ccCdecl,0);
   AssertNull('No Library name expression',Func.LibraryExpr);
 end;
 
 procedure TTestProcedureFunction.TestProcedureCdeclExternalLibName;
 begin
   ParseProcedure('; cdecl; external ''libname''','');
-  AssertProc([pmExternal],ccCdecl,0);
+  AssertProc([pmExternal],[],ccCdecl,0);
   AssertExpression('Library name expression',Proc.LibraryExpr,pekString,'''libname''');
 end;
 
@@ -1182,14 +1187,14 @@ procedure TTestProcedureFunction.TestFunctionCdeclExternalLibName;
 begin
   AddDeclaration('function A : Integer; cdecl; external ''libname''');
   ParseFunction;
-  AssertFunc([pmExternal],ccCdecl,0);
+  AssertFunc([pmExternal],[],ccCdecl,0);
   AssertExpression('Library name expression',Func.LibraryExpr,pekString,'''libname''');
 end;
 
 procedure TTestProcedureFunction.TestProcedureCdeclExternalLibNameName;
 begin
   ParseProcedure('; cdecl; external ''libname'' name ''symbolname''','');
-  AssertProc([pmExternal],ccCdecl,0);
+  AssertProc([pmExternal],[],ccCdecl,0);
   AssertExpression('Library name expression',Proc.LibraryExpr,pekString,'''libname''');
   AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
 end;
@@ -1198,7 +1203,7 @@ procedure TTestProcedureFunction.TestFunctionCdeclExternalLibNameName;
 begin
   AddDeclaration('function A : Integer; cdecl; external ''libname'' name ''symbolname''');
   ParseFunction;
-  AssertFunc([pmExternal],ccCdecl,0);
+  AssertFunc([pmExternal],[],ccCdecl,0);
   AssertExpression('Library name expression',Func.LibraryExpr,pekString,'''libname''');
   AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
 end;
@@ -1206,7 +1211,7 @@ end;
 procedure TTestProcedureFunction.TestProcedureCdeclExternalName;
 begin
   ParseProcedure('; cdecl; external name ''symbolname''','');
-  AssertProc([pmExternal],ccCdecl,0);
+  AssertProc([pmExternal],[],ccCdecl,0);
   AssertNull('No Library name expression',Proc.LibraryExpr);
   AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
 end;
@@ -1215,7 +1220,7 @@ procedure TTestProcedureFunction.TestFunctionCdeclExternalName;
 begin
   AddDeclaration('function A : Integer; cdecl; external name ''symbolname''');
   ParseFunction;
-  AssertFunc([pmExternal],ccCdecl,0);
+  AssertFunc([pmExternal],[],ccCdecl,0);
   AssertNull('No Library name expression',Func.LibraryExpr);
   AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
 end;
@@ -1224,7 +1229,7 @@ procedure TTestProcedureFunction.TestFunctionAlias;
 begin
   AddDeclaration('function A : Integer; alias: ''myalias''');
   ParseFunction;
-  AssertFunc([],ccDefault,0);
+  AssertFunc([],[],ccDefault,0);
   AssertEquals('Alias name','''myalias''',Func.AliasName);
 end;
 
@@ -1232,7 +1237,7 @@ procedure TTestProcedureFunction.TestProcedureAlias;
 begin
   AddDeclaration('Procedure A; Alias : ''myalias''');
   ParseProcedure;
-  AssertProc([],ccDefault,0);
+  AssertProc([],[],ccDefault,0);
   AssertEquals('Alias name','''myalias''',Proc.AliasName);
 end;
 

packages/fcl-passrc/tests/tcresolver.pas

@@ -179,12 +179,7 @@ type
     Procedure TestTypedConstWrongExprFail;
     Procedure TestVarWrongExprFail;
     Procedure TestArgWrongExprFail;
-    Procedure TestIncDec;
-    Procedure TestIncStringFail;
     Procedure TestVarExternal;
-    Procedure TestStr_BaseTypes;
-    Procedure TestStr_StringFail;
-    Procedure TestStr_CharFail;
     Procedure TestVarNoSemicolonBeginFail;
 
     // strings
@@ -208,8 +203,11 @@ type
     Procedure TestEnumHighLow;
     Procedure TestEnumOrd;
     Procedure TestEnumPredSucc;
+    Procedure TestEnum_EqualNilFail;
     Procedure TestEnum_CastIntegerToEnum;
     Procedure TestEnum_Str;
+    Procedure TestSet_AnonymousEnumtype;
+    Procedure TestSet_AnonymousEnumtypeName;
 
     // operators
     Procedure TestPrgAssignment;
@@ -233,10 +231,18 @@ type
     Procedure TestTypeCastDoubleToIntFail;
     Procedure TestTypeCastDoubleToBoolFail;
     Procedure TestTypeCastBooleanToDoubleFail;
-    Procedure TestHighLow;
     Procedure TestAssign_Access;
     Procedure TestAssignedIntFail;
 
+    // misc built-in functions
+    Procedure TestHighLow;
+    Procedure TestStr_BaseTypes;
+    Procedure TestStr_StringFail;
+    Procedure TestStr_CharFail;
+    Procedure TestIncDec;
+    Procedure TestIncStringFail;
+    Procedure TestTypeInfo;
+
     // statements
     Procedure TestForLoop;
     Procedure TestStatements;
@@ -305,6 +311,7 @@ type
     Procedure TestProc_Varargs;
     Procedure TestProc_ParameterExprAccess;
     Procedure TestProc_FunctionResult_DeclProc;
+    Procedure TestProc_TypeCastFunctionResult;
     // ToDo: fail builtin functions in constant with non const param
 
     // record
@@ -391,7 +398,7 @@ type
     // Todo: Fail to use class.method in constant or type, e.g. const p = @o.doit;
 
     // published
-    Procedure TestClass_PublishedVarFail;
+    Procedure TestClass_PublishedClassVarFail;
     Procedure TestClass_PublishedClassPropertyFail;
     Procedure TestClass_PublishedClassFunctionFail;
     Procedure TestClass_PublishedOverloadFail;
@@ -439,6 +446,8 @@ type
     Procedure TestPropertyWriteAccessorProc;
     Procedure TestPropertyTypeless;
     Procedure TestPropertyTypelessNoAncestorFail;
+    Procedure TestPropertyStoredAccessor;
+    Procedure TestPropertyStoredAccessorVarWrongType;
     Procedure TestPropertyStoredAccessorProcNotFunc;
     Procedure TestPropertyStoredAccessorFuncWrongResult;
     Procedure TestPropertyStoredAccessorFuncWrongArgCount;
@@ -465,6 +474,7 @@ type
     Procedure TestDynArrayOfLongint;
     Procedure TestStaticArray;
     Procedure TestArrayOfArray;
+    Procedure TestArrayOfArray_NameAnonymous;
     Procedure TestFunctionReturningArray;
     Procedure TestArray_LowHigh;
     Procedure TestArray_AssignSameSignatureFail;
@@ -520,6 +530,14 @@ type
     Procedure TestProcType_AsArgOtherUnit;
     Procedure TestProcType_Property;
     Procedure TestProcType_PropertyCallWrongArgFail;
+    Procedure TestProcType_Typecast;
+
+    // pointer
+    Procedure TestPointer;
+    Procedure TestPointer_AssignPointerToClassFail;
+    Procedure TestPointer_TypecastToMethodTypeFail;
+    Procedure TestPointer_TypecastFromMethodTypeFail;
+    Procedure TestPointer_TypecastMethod_proMethodAddrAsPointer;
   end;
 
 function LinesToStr(Args: array of const): string;
@@ -2002,30 +2020,6 @@ begin
     PasResolver.nIncompatibleTypesGotExpected);
 end;
 
-procedure TTestResolver.TestIncDec;
-begin
-  StartProgram(false);
-  Add('var');
-  Add('  i: longint;');
-  Add('begin');
-  Add('  inc({#a_var}i);');
-  Add('  inc({#b_var}i,2);');
-  Add('  dec({#c_var}i);');
-  Add('  dec({#d_var}i,3);');
-  ParseProgram;
-  CheckAccessMarkers;
-end;
-
-procedure TTestResolver.TestIncStringFail;
-begin
-  StartProgram(false);
-  Add('var');
-  Add('  i: string;');
-  Add('begin');
-  Add('  inc(i);');
-  CheckResolverException('Incompatible type arg no. 1: Got "String", expected "integer"',PasResolver.nIncompatibleTypeArgNo);
-end;
-
 procedure TTestResolver.TestVarExternal;
 begin
   StartProgram(false);
@@ -2035,74 +2029,6 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.TestStr_BaseTypes;
-begin
-  StartProgram(false);
-  Add('var');
-  Add('  b: boolean;');
-  Add('  i: longint;');
-  Add('  i64: int64;');
-  Add('  s: single;');
-  Add('  d: double;');
-  Add('  aString: string;');
-  Add('  r: record end;');
-  Add('begin');
-  Add('  Str(b,{#a_var}aString);');
-  Add('  Str(b:1,aString);');
-  Add('  Str(b:i,aString);');
-  Add('  Str(i,aString);');
-  Add('  Str(i:2,aString);');
-  Add('  Str(i:i64,aString);');
-  Add('  Str(i64,aString);');
-  Add('  Str(i64:3,aString);');
-  Add('  Str(i64:i,aString);');
-  Add('  Str(s,aString);');
-  Add('  Str(d,aString);');
-  Add('  Str(d:4,aString);');
-  Add('  Str(d:4:5,aString);');
-  Add('  Str(d:4:i,aString);');
-  Add('  aString:=Str(b);');
-  Add('  aString:=Str(i:3);');
-  Add('  aString:=Str(d:3:4);');
-  Add('  aString:=Str(b,i,d);');
-  Add('  aString:=Str(s,''foo'');');
-  Add('  aString:=Str(i,{#assign_read}aString);');
-  Add('  while true do Str(i,{#whiledo_var}aString);');
-  Add('  repeat Str(i,{#repeat_var}aString); until true;');
-  Add('  if true then Str(i,{#ifthen_var}aString) else Str(i,{#ifelse_var}aString);');
-  Add('  for i:=0 to 0 do Str(i,{#fordo_var}aString);');
-  Add('  with r do Str(i,{#withdo_var}aString);');
-  Add('  case Str(s,''caseexpr'') of');
-  Add('  ''bar'': Str(i,{#casest_var}aString);');
-  Add('  else Str(i,{#caseelse_var}aString);');
-  Add('  end;');
-  ParseProgram;
-  CheckAccessMarkers;
-end;
-
-procedure TTestResolver.TestStr_StringFail;
-begin
-  StartProgram(false);
-  Add('var');
-  Add('  aString: string;');
-  Add('begin');
-  Add('  Str(aString,aString);');
-  CheckResolverException('Incompatible type arg no. 1: Got "String", expected "boolean, integer, enum value"',
-    nIncompatibleTypeArgNo);
-end;
-
-procedure TTestResolver.TestStr_CharFail;
-begin
-  StartProgram(false);
-  Add('var');
-  Add('  c: char;');
-  Add('  aString: string;');
-  Add('begin');
-  Add('  Str(c,aString);');
-  CheckResolverException('Incompatible type arg no. 1: Got "Char", expected "boolean, integer, enum value"',
-    nIncompatibleTypeArgNo);
-end;
-
 procedure TTestResolver.TestVarNoSemicolonBeginFail;
 begin
   StartProgram(false);
@@ -2447,6 +2373,19 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestEnum_EqualNilFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFlag = (red, green);');
+  Add('var');
+  Add('  f: TFlag;');
+  Add('begin');
+  Add('  if f=nil then ;');
+  CheckResolverException('Incompatible types: got "TFlag" expected "Pointer"',
+    nIncompatibleTypesGotExpected);
+end;
+
 procedure TTestResolver.TestEnum_CastIntegerToEnum;
 begin
   StartProgram(false);
@@ -2479,6 +2418,57 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestSet_AnonymousEnumtype;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFlags = set of (red, green);');
+  Add('const');
+  Add('  favorite = red;');
+  Add('var');
+  Add('  f: TFlags;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  Include(f,red);');
+  Add('  Include(f,favorite);');
+  Add('  i:=ord(red);');
+  Add('  i:=ord(favorite);');
+  Add('  i:=ord(low(TFlags));');
+  Add('  i:=ord(low(f));');
+  Add('  i:=ord(low(favorite));');
+  Add('  i:=ord(high(TFlags));');
+  Add('  i:=ord(high(f));');
+  Add('  i:=ord(high(favorite));');
+  Add('  f:=[green,favorite];');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestSet_AnonymousEnumtypeName;
+begin
+  ResolverEngine.AnonymousElTypePostfix:='$enum';
+  StartProgram(false);
+  Add('type');
+  Add('  TFlags = set of (red, green);');
+  Add('const');
+  Add('  favorite = red;');
+  Add('var');
+  Add('  f: TFlags;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  Include(f,red);');
+  Add('  Include(f,favorite);');
+  Add('  i:=ord(red);');
+  Add('  i:=ord(favorite);');
+  Add('  i:=ord(low(TFlags));');
+  Add('  i:=ord(low(f));');
+  Add('  i:=ord(low(favorite));');
+  Add('  i:=ord(high(TFlags));');
+  Add('  i:=ord(high(f));');
+  Add('  i:=ord(high(favorite));');
+  Add('  f:=[green,favorite];');
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestPrgAssignment;
 var
   El: TPasElement;
@@ -2947,6 +2937,31 @@ begin
   CheckResolverException(sIllegalTypeConversionTo,PasResolver.nIllegalTypeConversionTo);
 end;
 
+procedure TTestResolver.TestAssign_Access;
+begin
+  StartProgram(false);
+  Parser.Options:=Parser.Options+[po_cassignments];
+  Scanner.Options:=Scanner.Options+[po_cassignments];
+  Add('var i: longint;');
+  Add('begin');
+  Add('  {#a1_assign}i:={#a2_read}i;');
+  Add('  {#b1_readandassign}i+={#b2_read}i;');
+  Add('  {#c1_readandassign}i-={#c2_read}i;');
+  Add('  {#d1_readandassign}i*={#d2_read}i;');
+  ParseProgram;
+  CheckAccessMarkers;
+end;
+
+procedure TTestResolver.TestAssignedIntFail;
+begin
+  StartProgram(false);
+  Add('var i: longint;');
+  Add('begin');
+  Add('  if Assigned(i) then ;');
+  CheckResolverException('Incompatible type arg no. 1: Got "Longint", expected "class or array"',
+    nIncompatibleTypeArgNo);
+end;
+
 procedure TTestResolver.TestHighLow;
 begin
   StartProgram(false);
@@ -2961,31 +2976,121 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.TestAssign_Access;
+procedure TTestResolver.TestStr_BaseTypes;
 begin
   StartProgram(false);
-  Parser.Options:=Parser.Options+[po_cassignments];
-  Scanner.Options:=Scanner.Options+[po_cassignments];
-  Add('var i: longint;');
+  Add('var');
+  Add('  b: boolean;');
+  Add('  i: longint;');
+  Add('  i64: int64;');
+  Add('  s: single;');
+  Add('  d: double;');
+  Add('  aString: string;');
+  Add('  r: record end;');
   Add('begin');
-  Add('  {#a1_assign}i:={#a2_read}i;');
-  Add('  {#b1_readandassign}i+={#b2_read}i;');
-  Add('  {#c1_readandassign}i-={#c2_read}i;');
-  Add('  {#d1_readandassign}i*={#d2_read}i;');
+  Add('  Str(b,{#a_var}aString);');
+  Add('  Str(b:1,aString);');
+  Add('  Str(b:i,aString);');
+  Add('  Str(i,aString);');
+  Add('  Str(i:2,aString);');
+  Add('  Str(i:i64,aString);');
+  Add('  Str(i64,aString);');
+  Add('  Str(i64:3,aString);');
+  Add('  Str(i64:i,aString);');
+  Add('  Str(s,aString);');
+  Add('  Str(d,aString);');
+  Add('  Str(d:4,aString);');
+  Add('  Str(d:4:5,aString);');
+  Add('  Str(d:4:i,aString);');
+  Add('  aString:=Str(b);');
+  Add('  aString:=Str(i:3);');
+  Add('  aString:=Str(d:3:4);');
+  Add('  aString:=Str(b,i,d);');
+  Add('  aString:=Str(s,''foo'');');
+  Add('  aString:=Str(i,{#assign_read}aString);');
+  Add('  while true do Str(i,{#whiledo_var}aString);');
+  Add('  repeat Str(i,{#repeat_var}aString); until true;');
+  Add('  if true then Str(i,{#ifthen_var}aString) else Str(i,{#ifelse_var}aString);');
+  Add('  for i:=0 to 0 do Str(i,{#fordo_var}aString);');
+  Add('  with r do Str(i,{#withdo_var}aString);');
+  Add('  case Str(s,''caseexpr'') of');
+  Add('  ''bar'': Str(i,{#casest_var}aString);');
+  Add('  else Str(i,{#caseelse_var}aString);');
+  Add('  end;');
   ParseProgram;
   CheckAccessMarkers;
 end;
 
-procedure TTestResolver.TestAssignedIntFail;
+procedure TTestResolver.TestStr_StringFail;
 begin
   StartProgram(false);
-  Add('var i: longint;');
+  Add('var');
+  Add('  aString: string;');
   Add('begin');
-  Add('  if Assigned(i) then ;');
-  CheckResolverException('Incompatible type arg no. 1: Got "Longint", expected "class or array"',
+  Add('  Str(aString,aString);');
+  CheckResolverException('Incompatible type arg no. 1: Got "String", expected "boolean, integer, enum value"',
+    nIncompatibleTypeArgNo);
+end;
+
+procedure TTestResolver.TestStr_CharFail;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  c: char;');
+  Add('  aString: string;');
+  Add('begin');
+  Add('  Str(c,aString);');
+  CheckResolverException('Incompatible type arg no. 1: Got "Char", expected "boolean, integer, enum value"',
     nIncompatibleTypeArgNo);
 end;
 
+procedure TTestResolver.TestIncDec;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  inc({#a_var}i);');
+  Add('  inc({#b_var}i,2);');
+  Add('  dec({#c_var}i);');
+  Add('  dec({#d_var}i,3);');
+  ParseProgram;
+  CheckAccessMarkers;
+end;
+
+procedure TTestResolver.TestIncStringFail;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  i: string;');
+  Add('begin');
+  Add('  inc(i);');
+  CheckResolverException('Incompatible type arg no. 1: Got "String", expected "integer"',PasResolver.nIncompatibleTypeArgNo);
+end;
+
+procedure TTestResolver.TestTypeInfo;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TRec = record');
+  Add('    v: integer;');
+  Add('  end;');
+  Add('var');
+  Add('  i: integer;');
+  Add('  s: string;');
+  Add('  p: pointer;');
+  Add('  r: TRec;');
+  Add('begin');
+  Add('  p:=typeinfo(integer);');
+  Add('  p:=typeinfo(longint);');
+  Add('  p:=typeinfo(i);');
+  Add('  p:=typeinfo(s);');
+  Add('  p:=typeinfo(p);');
+  Add('  p:=typeinfo(r.v);');
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestForLoop;
 begin
   StartProgram(false);
@@ -4162,6 +4267,16 @@ begin
     end;
 end;
 
+procedure TTestResolver.TestProc_TypeCastFunctionResult;
+begin
+  StartProgram(false);
+  Add('function GetIt: longint; begin end;');
+  Add('var s: smallint;');
+  Add('begin');
+  Add('   s:=smallint(GetIt);');
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestRecord;
 begin
   StartProgram(false);
@@ -5211,8 +5326,8 @@ begin
   Add('  end;');
   Add('begin');
   Add('  if TObject.i=7 then ;');
-  CheckResolverException(sCannotAccessThisMemberFromAClassReference,
-    PasResolver.nCannotAccessThisMemberFromAClassReference);
+  CheckResolverException(sCannotAccessThisMemberFromAX,
+    PasResolver.nCannotAccessThisMemberFromAX);
 end;
 
 procedure TTestResolver.TestClass_FuncReturningObjectMember;
@@ -5958,13 +6073,13 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.TestClass_PublishedVarFail;
+procedure TTestResolver.TestClass_PublishedClassVarFail;
 begin
   StartProgram(false);
   Add('type');
   Add('  TObject = class');
   Add('  published');
-  Add('    Id: longint;');
+  Add('    class var Id: longint;');
   Add('  end;');
   Add('begin');
   CheckResolverException(sSymbolCannotBePublished,nSymbolCannotBePublished);
@@ -6204,8 +6319,8 @@ begin
   Add('  oc: TObjectClass;');
   Add('begin');
   Add('  oc.Id:=3;');
-  CheckResolverException(sCannotAccessThisMemberFromAClassReference,
-    PasResolver.nCannotAccessThisMemberFromAClassReference);
+  CheckResolverException(sCannotAccessThisMemberFromAX,
+    PasResolver.nCannotAccessThisMemberFromAX);
 end;
 
 procedure TTestResolver.TestClassOfDotClassProc;
@@ -6264,8 +6379,8 @@ begin
   Add('  oc: TObjectClass;');
   Add('begin');
   Add('  oc.ProcA;');
-  CheckResolverException(sCannotAccessThisMemberFromAClassReference,
-    PasResolver.nCannotAccessThisMemberFromAClassReference);
+  CheckResolverException(sCannotAccessThisMemberFromAX,
+    PasResolver.nCannotAccessThisMemberFromAX);
 end;
 
 procedure TTestResolver.TestClassOfDotClassProperty;
@@ -6311,8 +6426,8 @@ begin
   Add('  oc: TObjectClass;');
   Add('begin');
   Add('  if oc.A=3 then ;');
-  CheckResolverException(sCannotAccessThisMemberFromAClassReference,
-    PasResolver.nCannotAccessThisMemberFromAClassReference);
+  CheckResolverException(sCannotAccessThisMemberFromAX,
+    PasResolver.nCannotAccessThisMemberFromAX);
 end;
 
 procedure TTestResolver.TestClass_ClassProcSelf;
@@ -6775,6 +6890,35 @@ begin
     PasResolver.nNoPropertyFoundToOverride);
 end;
 
+procedure TTestResolver.TestPropertyStoredAccessor;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FBird: longint;');
+  Add('    VStored: boolean;');
+  Add('    function IsBirdStored: boolean; virtual; abstract;');
+  Add('    property Bird: longint read FBird stored VStored;');
+  Add('    property B: longint read FBird stored IsBirdStored;');
+  Add('  end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestPropertyStoredAccessorVarWrongType;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FB: longint;');
+  Add('    BStored: longint;');
+  Add('    property B: longint read FB stored BStored;');
+  Add('  end;');
+  Add('begin');
+  CheckResolverException('Incompatible types: got "Longint" expected "Boolean"',
+    PasResolver.nIncompatibleTypesGotExpected);
+end;
+
 procedure TTestResolver.TestPropertyStoredAccessorProcNotFunc;
 begin
   StartProgram(false);
@@ -7218,12 +7362,31 @@ begin
   Add('type');
   Add('  TArrA = array[byte] of longint;');
   Add('  TArrB = array[smallint] of TArrA;');
+  Add('  TArrC = array of array of longint;');
   Add('var');
   Add('  b: TArrB;');
+  Add('  c: TArrC;');
   Add('begin');
   Add('  b[1][2]:=5;');
   Add('  b[1,2]:=5;');
   Add('  if b[2,1]=b[0,1] then ;');
+  Add('  c[3][4]:=c[5,6];');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestArrayOfArray_NameAnonymous;
+begin
+  ResolverEngine.AnonymousElTypePostfix:='$array';
+  StartProgram(false);
+  Add('type');
+  Add('  TArrA = array of array of longint;');
+  Add('var');
+  Add('  a: TArrA;');
+  Add('begin');
+  Add('  a[1][2]:=5;');
+  Add('  a[1,2]:=5;');
+  Add('  if a[2,1]=a[0,1] then ;');
+  Add('  a[3][4]:=a[5,6];');
   ParseProgram;
 end;
 
@@ -7979,7 +8142,7 @@ begin
   Add('var n: TNotifyEvent;');
   Add('begin');
   Add('  n:=@ProcA;');
-  CheckResolverException('procedure type modifier "of object" mismatch',
+  CheckResolverException('procedure type modifier "of Object" mismatch',
     PasResolver.nXModifierMismatchY);
 end;
 
@@ -7998,7 +8161,7 @@ begin
   Add('  o: TObject;');
   Add('begin');
   Add('  n:[email protected];');
-  CheckResolverException('procedure type modifier "of object" mismatch',
+  CheckResolverException('procedure type modifier "of Object" mismatch',
     PasResolver.nXModifierMismatchY);
 end;
 
@@ -8173,7 +8336,7 @@ begin
   Add('begin');
   Add('  Button1.OnClick := App.BtnClickHandler();');
   CheckResolverException(
-    'Wrong number of parameters specified for call to "procedure BtnClickHandler(TObject) of object"',
+    'Wrong number of parameters specified for call to "procedure BtnClickHandler(TObject) of Object"',
     nWrongNumberOfParametersForCallTo);
 end;
 
@@ -8197,7 +8360,7 @@ begin
   Add('begin');
   Add('  Button1.OnClick := @App.BtnClickHandler();');
   CheckResolverException(
-    'Wrong number of parameters specified for call to "procedure BtnClickHandler(TObject) of object"',
+    'Wrong number of parameters specified for call to "procedure BtnClickHandler(TObject) of Object"',
     nWrongNumberOfParametersForCallTo);
 end;
 
@@ -8407,6 +8570,122 @@ begin
     nIncompatibleTypeArgNo);
 end;
 
+procedure TTestResolver.TestProcType_Typecast;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TNotifyEvent = procedure(Sender: Pointer) of object;');
+  Add('  TEvent = procedure of object;');
+  Add('  TProcA = procedure(i: longint);');
+  Add('  TFuncB = function(i, j: longint): longint;');
+  Add('var');
+  Add('  Notify: TNotifyEvent;');
+  Add('  Event: TEvent;');
+  Add('  ProcA: TProcA;');
+  Add('  FuncB: TFuncB;');
+  Add('  p: pointer;');
+  Add('begin');
+  Add('  Notify:=TNotifyEvent(Event);');
+  Add('  Event:=TEvent(Event);');
+  Add('  Event:=TEvent(Notify);');
+  Add('  ProcA:=TProcA(FuncB);');
+  Add('  FuncB:=TFuncB(FuncB);');
+  Add('  FuncB:=TFuncB(ProcA);');
+  Add('  ProcA:=TProcA(p);');
+  Add('  FuncB:=TFuncB(p);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestPointer;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class end;');
+  Add('  TClass = class of TObject;');
+  Add('  TMyPtr = pointer;');
+  Add('  TArrInt = array of longint;');
+  Add('  TFunc = function: longint;');
+  Add('procedure DoIt; begin end;');
+  Add('var');
+  Add('  p: TMyPtr;');
+  Add('  Obj: TObject;');
+  Add('  Cl: TClass;');
+  Add('  a: tarrint;');
+  Add('  f: TFunc;');
+  Add('begin');
+  Add('  p:=nil;');
+  Add('  if p=nil then;');
+  Add('  if nil=p then;');
+  Add('  if Assigned(p) then;');
+  Add('  p:=obj;');
+  Add('  p:=cl;');
+  Add('  p:=a;');
+  Add('  p:=Pointer(f);');
+  Add('  p:=@DoIt;');
+  Add('  p:=Pointer(@DoIt)');
+  Add('  obj:=TObject(p);');
+  Add('  cl:=TClass(p);');
+  Add('  a:=TArrInt(p);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestPointer_AssignPointerToClassFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class end;');
+  Add('var');
+  Add('  Obj: TObject;');
+  Add('  p: pointer;');
+  Add('begin');
+  Add('  obj:=p;');
+  CheckResolverException('Incompatible types: got "Pointer" expected "TObject"',
+    nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestPointer_TypecastToMethodTypeFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TEvent = procedure of object;');
+  Add('var');
+  Add('  p: pointer;');
+  Add('  e: TEvent;');
+  Add('begin');
+  Add('  e:=TEvent(p);');
+  CheckResolverException('Illegal type conversion: "Pointer" to "procedure type of Object"',
+    nIllegalTypeConversionTo);
+end;
+
+procedure TTestResolver.TestPointer_TypecastFromMethodTypeFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TEvent = procedure of object;');
+  Add('var');
+  Add('  p: pointer;');
+  Add('  e: TEvent;');
+  Add('begin');
+  Add('  p:=Pointer(e);');
+  CheckResolverException('Illegal type conversion: "procedure type of Object" to "Pointer"',
+    nIllegalTypeConversionTo);
+end;
+
+procedure TTestResolver.TestPointer_TypecastMethod_proMethodAddrAsPointer;
+begin
+  ResolverEngine.Options:=ResolverEngine.Options+[proMethodAddrAsPointer];
+  StartProgram(false);
+  Add('type');
+  Add('  TEvent = procedure of object;');
+  Add('var');
+  Add('  p: pointer;');
+  Add('  e: TEvent;');
+  Add('begin');
+  Add('  e:=TEvent(p);');
+  Add('  p:=Pointer(e);');
+  ParseProgram;
+end;
+
 initialization
   RegisterTests([TTestResolver]);
 

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -21,6 +21,7 @@ type
   private
     FAnalyzer: TPasAnalyzer;
     FPAMessages: TFPList; // list of TPAMessage
+    FPAGoodMessages: TFPList;
     function GetPAMessages(Index: integer): TPAMessage;
     procedure OnAnalyzerMessage(Sender: TObject; Msg: TPAMessage);
   protected
@@ -32,8 +33,9 @@ type
     procedure AnalyzeWholeProgram; virtual;
     procedure CheckUsedMarkers; virtual;
     procedure CheckHasHint(MsgType: TMessageType; MsgNumber: integer;
-      const MsgText: string; Has: boolean = true); virtual;
-    procedure CheckUnitUsed(const aFilename: string; Used: boolean);
+      const MsgText: string); virtual;
+    procedure CheckUnexpectedMessages; virtual;
+    procedure CheckUnitUsed(const aFilename: string; Used: boolean); virtual;
   public
     property Analyzer: TPasAnalyzer read FAnalyzer;
     function PAMessageCount: integer;
@@ -77,6 +79,7 @@ type
     procedure TestM_Hint_UnitNotUsed_No_OnlyExternal;
     procedure TestM_Hint_ParameterNotUsed;
     procedure TestM_Hint_ParameterNotUsed_Abstract;
+    procedure TestM_Hint_ParameterNotUsedTypecast;
     procedure TestM_Hint_LocalVariableNotUsed;
     procedure TestM_Hint_InterfaceUnitVariableUsed;
     procedure TestM_Hint_ValueParameterIsAssignedButNeverUsed;
@@ -85,6 +88,7 @@ type
     procedure TestM_Hint_PrivateFieldIsNeverUsed;
     procedure TestM_Hint_PrivateFieldIsAssignedButNeverUsed;
     procedure TestM_Hint_PrivateMethodIsNeverUsed;
+    procedure TestM_Hint_LocalDestructor_No_IsNeverUsed;
     procedure TestM_Hint_PrivateTypeNeverUsed;
     procedure TestM_Hint_PrivateConstNeverUsed;
     procedure TestM_Hint_PrivatePropertyNeverUsed;
@@ -106,6 +110,13 @@ type
     procedure TestWP_CallInherited;
     procedure TestWP_ProgramPublicDeclarations;
     procedure TestWP_ClassDefaultProperty;
+    procedure TestWP_Published;
+    procedure TestWP_PublishedSetType;
+    procedure TestWP_PublishedArrayType;
+    procedure TestWP_PublishedClassOfType;
+    procedure TestWP_PublishedRecordType;
+    procedure TestWP_PublishedProcType;
+    procedure TestWP_PublishedProperty;
   end;
 
 implementation
@@ -128,6 +139,7 @@ procedure TCustomTestUseAnalyzer.SetUp;
 begin
   inherited SetUp;
   FPAMessages:=TFPList.Create;
+  FPAGoodMessages:=TFPList.Create;
   FAnalyzer:=TPasAnalyzer.Create;
   FAnalyzer.Resolver:=ResolverEngine;
   Analyzer.OnMessage:=@OnAnalyzerMessage;
@@ -137,6 +149,7 @@ procedure TCustomTestUseAnalyzer.TearDown;
 var
   i: Integer;
 begin
+  FreeAndNil(FPAGoodMessages);
   for i:=0 to FPAMessages.Count-1 do
     TPAMessage(FPAMessages[i]).Release;
   FreeAndNil(FPAMessages);
@@ -227,7 +240,7 @@ begin
 end;
 
 procedure TCustomTestUseAnalyzer.CheckHasHint(MsgType: TMessageType;
-  MsgNumber: integer; const MsgText: string; Has: boolean);
+  MsgNumber: integer; const MsgText: string);
 var
   i: Integer;
   Msg: TPAMessage;
@@ -239,22 +252,14 @@ begin
     Msg:=PAMessages[i];
     if (Msg.MsgNumber=MsgNumber) then
       begin
-      if Has then
+      if (Msg.MsgType=MsgType) and (Msg.MsgText=MsgText) then
         begin
-        // must have -> message type and text must match exactly
-        if (Msg.MsgType=MsgType) and (Msg.MsgText=MsgText) then
-          exit;
-        end
-      else
-        begin
-        // must not have -> matching number is enough
-        break;
+        FPAGoodMessages.Add(Msg);
+        exit;
         end;
       end;
     dec(i);
     end;
-  if (not Has) and (i<0) then exit;
-
   // mismatch
   writeln('TCustomTestUseAnalyzer.CheckHasHint: ');
   for i:=0 to PAMessageCount-1 do
@@ -264,7 +269,23 @@ begin
     end;
   s:='';
   str(MsgType,s);
-  Fail('Analyzer Message '+BoolToStr(Has,'not ','')+'found: '+s+': ('+IntToStr(MsgNumber)+') {'+MsgText+'}');
+  Fail('Analyzer Message not found: '+s+': ('+IntToStr(MsgNumber)+') {'+MsgText+'}');
+end;
+
+procedure TCustomTestUseAnalyzer.CheckUnexpectedMessages;
+var
+  i: Integer;
+  Msg: TPAMessage;
+  s: String;
+begin
+  for i:=0 to PAMessageCount-1 do
+    begin
+    Msg:=PAMessages[i];
+    if FPAGoodMessages.IndexOf(Msg)>=0 then continue;
+    s:='';
+    str(Msg.MsgType,s);
+    Fail('Analyzer Message found ['+IntToStr(Msg.Id)+'] '+s+': ('+IntToStr(Msg.MsgNumber)+') {'+Msg.MsgText+'}');
+    end;
 end;
 
 procedure TCustomTestUseAnalyzer.CheckUnitUsed(const aFilename: string;
@@ -749,7 +770,7 @@ begin
   Add('  {tmobile_used}TMobile = class(TObject)');
   Add('    constructor {#mob_create_used}Create;');
   Add('    procedure {#mob_doa_used}DoA; override;');
-  Add('    procedure {#mob_dob_notused}DoB; override;');
+  Add('    procedure {#mob_dob_used}DoB; override;');
   Add('  end;');
   Add('constructor TMobile.Create; begin end;');
   Add('procedure TMobile.DoA; begin end;');
@@ -831,6 +852,7 @@ begin
   Add('begin');
   AnalyzeProgram;
   CheckHasHint(mtHint,nPAUnitNotUsed,'Unit "unit2" not used in afile');
+  CheckUnexpectedMessages;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_UnitNotUsed_No_OnlyExternal;
@@ -851,7 +873,7 @@ begin
   AnalyzeProgram;
 
   // unit hints: no hint, even though no code is actually used
-  CheckHasHint(mtHint,nPAUnitNotUsed,'Unit "unit2" not used in afile',false);
+  CheckUnexpectedMessages;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsed;
@@ -863,6 +885,7 @@ begin
   Add('  DoIt(1);');
   AnalyzeProgram;
   CheckHasHint(mtHint,nPAParameterNotUsed,'Parameter "i" not used');
+  CheckUnexpectedMessages;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsed_Abstract;
@@ -875,8 +898,28 @@ begin
   Add('begin');
   Add('  TObject.DoIt(3);');
   AnalyzeProgram;
-  CheckHasHint(mtHint,nPAParameterNotUsed,
-    sPAParameterNotUsed,false);
+  CheckUnexpectedMessages;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsedTypecast;
+begin
+  StartProgram(true);
+  Add('type');
+  Add('  TObject = class end;');
+  Add('  TSortCompare = function(a,b: Pointer): integer;');
+  Add('  TObjCompare = function(a,b: TObject): integer;');
+  Add('procedure Sort(const Compare: TSortCompare);');
+  Add('begin');
+  Add('  Compare(nil,nil);');
+  Add('end;');
+  Add('procedure DoIt(const Compare: TObjCompare);');
+  Add('begin');
+  Add('  Sort(TSortCompare(Compare));');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt(nil);');
+  AnalyzeProgram;
+  CheckUnexpectedMessages;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_LocalVariableNotUsed;
@@ -897,6 +940,7 @@ begin
   CheckHasHint(mtHint,nPALocalXYNotUsed,'Local constant "b" not used');
   CheckHasHint(mtHint,nPALocalVariableNotUsed,'Local variable "c" not used');
   CheckHasHint(mtHint,nPALocalVariableNotUsed,'Local variable "d" not used');
+  CheckUnexpectedMessages;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_InterfaceUnitVariableUsed;
@@ -921,8 +965,14 @@ begin
   Add('  {#ImpTFlags_notused}ImpTFlags = set of TFlag;');
   Add('  {#ImpTArrInt_notused}ImpTArrInt = array of integer;');
   AnalyzeUnit;
-  CheckHasHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
-    'Local variable "a" is assigned but never used',false);
+  CheckHasHint(mtHint,nPALocalXYNotUsed,'Local constant "d" not used');
+  CheckHasHint(mtHint,nPALocalXYNotUsed,'Local constant "e" not used');
+  CheckHasHint(mtHint,nPALocalVariableNotUsed,'Local variable "f" not used');
+  CheckHasHint(mtHint,nPALocalXYNotUsed,'Local alias type "ImpTColor" not used');
+  CheckHasHint(mtHint,nPALocalXYNotUsed,'Local enumeration type "ImpTFlag" not used');
+  CheckHasHint(mtHint,nPALocalXYNotUsed,'Local set type "ImpTFlags" not used');
+  CheckHasHint(mtHint,nPALocalXYNotUsed,'Local array type "ImpTArrInt" not used');
+  CheckUnexpectedMessages;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_ValueParameterIsAssignedButNeverUsed;
@@ -937,6 +987,7 @@ begin
   AnalyzeProgram;
   CheckHasHint(mtHint,nPAValueParameterIsAssignedButNeverUsed,
     'Value parameter "i" is assigned but never used');
+  CheckUnexpectedMessages;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_LocalVariableIsAssignedButNeverUsed;
@@ -962,6 +1013,7 @@ begin
     'Local variable "b" is assigned but never used');
   CheckHasHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
     'Local variable "c" is assigned but never used');
+  CheckUnexpectedMessages;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_LocalXYNotUsed;
@@ -984,6 +1036,7 @@ begin
   CheckHasHint(mtHint,nPALocalXYNotUsed,'Local set type "TFlags" not used');
   CheckHasHint(mtHint,nPALocalXYNotUsed,'Local array type "TArrInt" not used');
   CheckHasHint(mtHint,nPALocalXYNotUsed,'Local procedure "Sub" not used');
+  CheckUnexpectedMessages;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_PrivateFieldIsNeverUsed;
@@ -998,7 +1051,11 @@ begin
   Add('begin');
   Add('  m:=nil;');
   AnalyzeProgram;
-  CheckHasHint(mtHint,nPAPrivateFieldIsNeverUsed,'Private field "TMobile.a" is never used');
+  CheckHasHint(mtHint,nPAPrivateFieldIsNeverUsed,
+    'Private field "TMobile.a" is never used');
+  CheckHasHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
+    'Local variable "m" is assigned but never used');
+  CheckUnexpectedMessages;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_PrivateFieldIsAssignedButNeverUsed;
@@ -1020,6 +1077,7 @@ begin
   AnalyzeProgram;
   CheckHasHint(mtHint,nPAPrivateFieldIsAssignedButNeverUsed,
     'Private field "TMobile.a" is assigned but never used');
+  CheckUnexpectedMessages;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_PrivateMethodIsNeverUsed;
@@ -1040,6 +1098,34 @@ begin
   AnalyzeProgram;
   CheckHasHint(mtHint,nPAPrivateMethodIsNeverUsed,
     'Private method "TMobile.DoSome" is never used');
+  CheckUnexpectedMessages;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_LocalDestructor_No_IsNeverUsed;
+begin
+  StartProgram(true,[supTObject]);
+  Add('type');
+  Add('  TMobile = class');
+  Add('  private');
+  Add('  public');
+  Add('    constructor Create;');
+  Add('    destructor Destroy; override;');
+  Add('  end;');
+  Add('var DestroyCount: longint = 0;');
+  Add('constructor TMobile.Create;');
+  Add('begin');
+  Add('end;');
+  Add('destructor TMobile.Destroy;');
+  Add('begin');
+  Add('  inc(DestroyCount);');
+  Add('  inherited;');
+  Add('end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  o:=TMobile.Create;');
+  Add('  o.Destroy;');
+  AnalyzeProgram;
+  CheckUnexpectedMessages;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_PrivateTypeNeverUsed;
@@ -1060,6 +1146,7 @@ begin
   AnalyzeProgram;
   CheckHasHint(mtHint,nPAPrivateTypeXNeverUsed,
     'Private type "TMobile.t" never used');
+  CheckUnexpectedMessages;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_PrivateConstNeverUsed;
@@ -1080,6 +1167,7 @@ begin
   AnalyzeProgram;
   CheckHasHint(mtHint,nPAPrivateConstXNeverUsed,
     'Private const "TMobile.c" never used');
+  CheckUnexpectedMessages;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_PrivatePropertyNeverUsed;
@@ -1101,6 +1189,9 @@ begin
   AnalyzeProgram;
   CheckHasHint(mtHint,nPAPrivatePropertyXNeverUsed,
     'Private property "TMobile.A" never used');
+  CheckHasHint(mtHint,nPAPrivateFieldIsNeverUsed,
+    'Private field "TMobile.FA" is never used');
+  CheckUnexpectedMessages;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_LocalClassInProgramNotUsed;
@@ -1120,6 +1211,7 @@ begin
   AnalyzeProgram;
   CheckHasHint(mtHint,nPALocalXYNotUsed,'Local class "TMobile" not used');
   CheckHasHint(mtHint,nPALocalVariableNotUsed,'Local variable "m" not used');
+  CheckUnexpectedMessages;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_LocalMethodInProgramNotUsed;
@@ -1139,6 +1231,7 @@ begin
   Add('  if m=nil then ;');
   AnalyzeProgram;
   CheckHasHint(mtHint,nPALocalXYNotUsed,'Local constructor "Create" not used');
+  CheckUnexpectedMessages;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_AssemblerParameterIgnored;
@@ -1161,8 +1254,7 @@ begin
   Add('begin');
   Add('  DoIt(1);');
   AnalyzeProgram;
-  CheckHasHint(mtHint,nPAParameterNotUsed,'Parameter "i" not used',false);
-  AssertEquals('no hints for assembler proc',0,PAMessageCount);
+  CheckUnexpectedMessages;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_FunctionResultDoesNotSeemToBeSet;
@@ -1175,6 +1267,7 @@ begin
   AnalyzeProgram;
   CheckHasHint(mtHint,nPAFunctionResultDoesNotSeemToBeSet,
     sPAFunctionResultDoesNotSeemToBeSet);
+  CheckUnexpectedMessages;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_FunctionResultDoesNotSeemToBeSet_Abstract;
@@ -1187,8 +1280,7 @@ begin
   Add('begin');
   Add('  TObject.DoIt;');
   AnalyzeProgram;
-  CheckHasHint(mtHint,nPAFunctionResultDoesNotSeemToBeSet,
-    sPAFunctionResultDoesNotSeemToBeSet,false);
+  CheckUnexpectedMessages;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_FunctionResultRecord;
@@ -1196,15 +1288,17 @@ begin
   StartProgram(true);
   Add('type');
   Add('  TPoint = record X,Y:longint; end;');
-  Add('function Point(Left,Top: longint): TPoint;');
+  Add('function Point(Left: longint): TPoint;');
   Add('begin');
   Add('  Result.X:=Left;');
   Add('end;');
   Add('begin');
-  Add('  Point(1,2);');
+  Add('  Point(1);');
   AnalyzeProgram;
-  CheckHasHint(mtHint,nPAFunctionResultDoesNotSeemToBeSet,
-    sPAFunctionResultDoesNotSeemToBeSet,false);
+  CheckHasHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
+    'Local variable "X" is assigned but never used');
+  CheckHasHint(mtHint,nPALocalVariableNotUsed,'Local variable "Y" not used');
+  CheckUnexpectedMessages;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_FunctionResultPassRecordElement;
@@ -1216,15 +1310,15 @@ begin
   Add('begin');
   Add('  x:=3;');
   Add('end;');
-  Add('function Point(Left,Top: longint): TPoint;');
+  Add('function Point(): TPoint;');
   Add('begin');
   Add('  Three(Result.X)');
   Add('end;');
   Add('begin');
-  Add('  Point(1,2);');
+  Add('  Point();');
   AnalyzeProgram;
-  CheckHasHint(mtHint,nPAFunctionResultDoesNotSeemToBeSet,
-    sPAFunctionResultDoesNotSeemToBeSet,false);
+  CheckHasHint(mtHint,nPALocalVariableNotUsed,'Local variable "Y" not used');
+  CheckUnexpectedMessages;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_OutParam_No_AssignedButNeverUsed;
@@ -1238,8 +1332,7 @@ begin
   Add('begin');
   Add('  DoIt(i);');
   AnalyzeProgram;
-  CheckHasHint(mtHint,nPAValueParameterIsAssignedButNeverUsed,
-    sPAValueParameterIsAssignedButNeverUsed,false);
+  CheckUnexpectedMessages;
 end;
 
 procedure TTestUseAnalyzer.TestWP_LocalVar;
@@ -1402,6 +1495,145 @@ begin
   AnalyzeWholeProgram;
 end;
 
+procedure TTestUseAnalyzer.TestWP_Published;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#tobject_used}TObject = class');
+  Add('  private');
+  Add('    {#fcol_used}FCol: string;');
+  Add('    {#fbird_notused}FBird: string;');
+  Add('  published');
+  Add('    {#fielda_used}FieldA: longint;');
+  Add('    procedure {#doit_used}ProcA; virtual; abstract;');
+  Add('    property {#col_used}Col: string read FCol;');
+  Add('  end;');
+  Add('var');
+  Add('  {#o_used}o: TObject;');
+  Add('begin');
+  Add('  o:=nil;');
+  AnalyzeWholeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestWP_PublishedSetType;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#tflag_used}TFlag = (red, green);');
+  Add('  {#tflags_used}TFlags = set of TFlag;');
+  Add('  {#tobject_used}TObject = class');
+  Add('  published');
+  Add('    {#fielda_used}FieldA: TFlag;');
+  Add('    {#fieldb_used}FieldB: TFlags;');
+  Add('  end;');
+  Add('var');
+  Add('  {#o_used}o: TObject;');
+  Add('begin');
+  Add('  o:=nil;');
+  AnalyzeWholeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestWP_PublishedArrayType;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#tdynarr_used}TDynArr = array of longint;');
+  Add('  {#tstatarr_used}TStatArr = array[boolean] of longint;');
+  Add('  {#tobject_used}TObject = class');
+  Add('  published');
+  Add('    {#fielda_used}FieldA: TDynArr;');
+  Add('    {#fieldb_used}FieldB: TStatArr;');
+  Add('  end;');
+  Add('var');
+  Add('  {#o_used}o: TObject;');
+  Add('begin');
+  Add('  o:=nil;');
+  AnalyzeWholeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestWP_PublishedClassOfType;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#tobjectclass_used}TObjectClass = class of TObject;');
+  Add('  {#tobject_used}TObject = class');
+  Add('  published');
+  Add('    {#fielda_used}FieldA: TObjectClass;');
+  Add('  end;');
+  Add('  {#tclass_used}TClass = class of TObject;');
+  Add('var');
+  Add('  {#c_used}c: TClass;');
+  Add('begin');
+  Add('  c:=nil;');
+  AnalyzeWholeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestWP_PublishedRecordType;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#trec_used}TRec = record');
+  Add('    {treci_used}i: longint;');
+  Add('  end;');
+  Add('  {#tobject_used}TObject = class');
+  Add('  published');
+  Add('    {#fielda_used}FieldA: TRec;');
+  Add('  end;');
+  Add('var');
+  Add('  {#o_used}o: TObject;');
+  Add('begin');
+  Add('  o:=nil;');
+  AnalyzeWholeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestWP_PublishedProcType;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#ta_used}ta = array of longint;');
+  Add('  {#tb_used}tb = array of longint;');
+  Add('  {#tproca_used}TProcA = procedure;');
+  Add('  {#tfunca_used}TFuncA = function: ta;');
+  Add('  {#tprocb_used}TProcB = procedure(a: tb);');
+  Add('  {#tobject_used}TObject = class');
+  Add('  published');
+  Add('    {#fielda_used}FieldA: TProcA;');
+  Add('    {#fieldb_used}FieldB: TFuncA;');
+  Add('    {#fieldc_used}FieldC: TProcB;');
+  Add('  end;');
+  Add('var');
+  Add('  {#o_used}o: TObject;');
+  Add('begin');
+  Add('  o:=nil;');
+  AnalyzeWholeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestWP_PublishedProperty;
+begin
+  StartProgram(false);
+  Add('const');
+  Add('  {#defcol_used}DefCol = 3;');
+  Add('  {#defsize_notused}DefSize = 43;');
+  Add('type');
+  Add('  {#tobject_used}TObject = class');
+  Add('  private');
+  Add('    {#fcol_used}FCol: longint;');
+  Add('    {#fsize_used}FSize: longint;');
+  Add('    {#fbird_notused}FBird: string;');
+  Add('    {#fcolstored_used}FColStored: boolean;');
+  Add('    {#fsizestored_notused}FSizeStored: boolean;');
+  Add('  public');
+  Add('    property {#size_used}Size: longint read FSize stored FSizeStored default DefSize;');
+  Add('  published');
+  Add('    property {#col_used}Col: longint read FCol stored FColStored default DefCol;');
+  Add('  end;');
+  Add('var');
+  Add('  {#o_used}o: TObject;');
+  Add('begin');
+  Add('  if o.Size=13 then ;');
+  AnalyzeWholeProgram;
+end;
+
 initialization
   RegisterTests([TTestUseAnalyzer]);
 

packages/pastojs/fpmake.pp

@@ -19,7 +19,7 @@ begin
 {$endif ALLPACKAGES}
 
     P.Version:='3.0.3';
-    P.OSes := AllOses-[embedded,msdos,win16];
+    P.OSes := AllOses-[embedded,msdos];
     P.Dependencies.Add('fcl-js');
     P.Dependencies.Add('fcl-passrc');
 

packages/pastojs/tests/tcoptimizations.pas

@@ -38,8 +38,8 @@ type
     FAnalyzerModule: TPasAnalyzer;
     FAnalyzerProgram: TPasAnalyzer;
     FWholeProgramOptimization: boolean;
-    function OnConverterIsElementUsed(Sender: TObject; El: TPasElement
-      ): boolean;
+    function OnConverterIsElementUsed(Sender: TObject; El: TPasElement): boolean;
+    function OnConverterIsTypeInfoUsed(Sender: TObject; El: TPasElement): boolean;
   protected
     procedure SetUp; override;
     procedure TearDown; override;
@@ -78,6 +78,8 @@ type
     procedure TestWPO_CallInherited;
     procedure TestWPO_UseUnit;
     procedure TestWPO_ProgramPublicDeclaration;
+    procedure TestWPO_RTTI_PublishedField;
+    procedure TestWPO_RTTI_TypeInfo;
   end;
 
 implementation
@@ -99,6 +101,21 @@ begin
   {$ENDIF}
 end;
 
+function TCustomTestOptimizations.OnConverterIsTypeInfoUsed(Sender: TObject;
+  El: TPasElement): boolean;
+var
+  A: TPasAnalyzer;
+begin
+  if WholeProgramOptimization then
+    A:=AnalyzerProgram
+  else
+    A:=AnalyzerModule;
+  Result:=A.IsTypeInfoUsed(El);
+  {$IF defined(VerbosePas2JS) or defined(VerbosePasAnalyzer)}
+  writeln('TCustomTestOptimizations.OnConverterIsTypeInfoUsed El=',GetObjName(El),' WPO=',WholeProgramOptimization,' Result=',Result);
+  {$ENDIF}
+end;
+
 procedure TCustomTestOptimizations.SetUp;
 begin
   inherited SetUp;
@@ -108,6 +125,7 @@ begin
   FAnalyzerProgram:=TPasAnalyzer.Create;
   FAnalyzerProgram.Resolver:=Engine;
   Converter.OnIsElementUsed:=@OnConverterIsElementUsed;
+  Converter.OnIsTypeInfoUsed:=@OnConverterIsTypeInfoUsed;
 end;
 
 procedure TCustomTestOptimizations.TearDown;
@@ -756,6 +774,88 @@ begin
   CheckDiff('TestWPO_ProgramPublicDeclaration',ExpectedSrc,ActualSrc);
 end;
 
+procedure TTestOptimizations.TestWPO_RTTI_PublishedField;
+var
+  ActualSrc, ExpectedSrc: String;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(true);
+  Add('type');
+  Add('  TArrA = array of char;');
+  Add('  TArrB = array of string;');
+  Add('  TObject = class');
+  Add('  public');
+  Add('    PublicA: TArrA;');
+  Add('  published');
+  Add('    PublishedB: TArrB;');
+  Add('  end;');
+  Add('var');
+  Add('  C: TObject;');
+  Add('begin');
+  Add('  C.PublicA:=nil;');
+  ConvertProgram;
+  ActualSrc:=JSToStr(JSModule);
+  ExpectedSrc:=LinesToStr([
+    'rtl.module("program", ["system"], function () {',
+    'this.$rtti.$DynArray("TArrB", {',
+    '  eltype: rtl.string',
+    '});',
+    '  rtl.createClass(this, "TObject", null, function () {',
+    '    this.$init = function () {',
+    '      this.PublicA = [];',
+    '      this.PublishedB = [];',
+    '    };',
+    '    this.$final = function () {',
+    '      this.PublicA = undefined;',
+    '      this.PublishedB = undefined;',
+    '    };',
+    '    var $r = this.$rtti;',
+    '    $r.addField("PublishedB", pas.program.$rtti["TArrB"]);',
+    '  });',
+    '  this.C = null;',
+    '  this.$main = function () {',
+    '    this.C.PublicA = [];',
+    '  };',
+    '});',
+    '']);
+  CheckDiff('TestWPO_RTTI_PublishedField',ExpectedSrc,ActualSrc);
+end;
+
+procedure TTestOptimizations.TestWPO_RTTI_TypeInfo;
+var
+  ActualSrc, ExpectedSrc: String;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(true);
+  Add('type');
+  Add('  TArrA = array of char;');
+  Add('  TArrB = array of string;');
+  Add('var');
+  Add('  A: TArrA;');
+  Add('  B: TArrB;');
+  Add('  p: pointer;');
+  Add('begin');
+  Add('  A:=nil;');
+  Add('  p:=typeinfo(B);');
+  ConvertProgram;
+  ActualSrc:=JSToStr(JSModule);
+  ExpectedSrc:=LinesToStr([
+    'rtl.module("program", ["system"], function () {',
+    'this.$rtti.$DynArray("TArrB", {',
+    '  eltype: rtl.string',
+    '});',
+    '  this.A = [];',
+    '  this.B = [];',
+    '  this.p = null;',
+    '  this.$main = function () {',
+    '    this.A = [];',
+    '    this.p = this.$rtti["TArrB"];',
+    '  };',
+    '});',
+    '']);
+  CheckDiff('TestWPO_RTTI_TypeInfo',ExpectedSrc,ActualSrc);
+end;
+
 Initialization
   RegisterTests([TTestOptimizations]);
 end.

utils/fpdoc/dw_xml.pp

@@ -100,7 +100,7 @@ var
       Node['virtual'] := 'true';
     if pmAbstract in ADecl.Modifiers then
       Node['abstract'] := 'true';
-    if pmStatic in ADecl.Modifiers then
+    if assigned(ADecl.ProcType) and (ptmStatic in ADecl.ProcType.Modifiers) then
       Node['static'] := 'true';
     if pmReintroduce in ADecl.Modifiers then
       Node['reintroduce'] := 'true';