fcl-passrc: updated tests

git-svn-id: trunk@35794 -

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
@@ -233,10 +228,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;
@@ -391,7 +394,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 +442,8 @@ type
     Procedure TestPropertyWriteAccessorProc;
     Procedure TestPropertyTypeless;
     Procedure TestPropertyTypelessNoAncestorFail;
+    Procedure TestPropertyStoredAccessor;
+    Procedure TestPropertyStoredAccessorVarWrongType;
     Procedure TestPropertyStoredAccessorProcNotFunc;
     Procedure TestPropertyStoredAccessorFuncWrongResult;
     Procedure TestPropertyStoredAccessorFuncWrongArgCount;
@@ -520,6 +525,10 @@ type
     Procedure TestProcType_AsArgOtherUnit;
     Procedure TestProcType_Property;
     Procedure TestProcType_PropertyCallWrongArgFail;
+
+    // pointer
+    Procedure TestPointer;
+    Procedure TestPointer_AssignPointerToClassFail;
   end;
 
 function LinesToStr(Args: array of const): string;
@@ -2002,30 +2011,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 +2020,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);
@@ -2947,6 +2864,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 +2903,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);
@@ -5211,8 +5243,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 +5990,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 +6236,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 +6296,8 @@ begin
   Add('  oc: TObjectClass;');
   Add('begin');
   Add('  oc.ProcA;');
-  CheckResolverException(sCannotAccessThisMemberFromAClassReference,
-    PasResolver.nCannotAccessThisMemberFromAClassReference);
+  CheckResolverException(sCannotAccessThisMemberFromAX,
+    PasResolver.nCannotAccessThisMemberFromAX);
 end;
 
 procedure TTestResolver.TestClassOfDotClassProperty;
@@ -6311,8 +6343,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 +6807,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 +7279,15 @@ 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;
 
@@ -8407,6 +8471,47 @@ begin
     nIncompatibleTypeArgNo);
 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('var');
+  Add('  p: TMyPtr;');
+  Add('  Obj: TObject;');
+  Add('  Cl: TClass;');
+  Add('  a: tarrint;');
+  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('  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;
+
 initialization
   RegisterTests([TTestResolver]);
 

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -106,6 +106,8 @@ type
     procedure TestWP_CallInherited;
     procedure TestWP_ProgramPublicDeclarations;
     procedure TestWP_ClassDefaultProperty;
+    procedure TestWP_Published;
+    procedure TestWP_PublishedProperty;
   end;
 
 implementation
@@ -1402,6 +1404,52 @@ 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_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]);