Explorar o código

* Test cases for types, var, const, resource string. Start of statement tests

git-svn-id: trunk@22005 -
michael %!s(int64=13) %!d(string=hai) anos
pai
achega
b867010691

+ 6 - 0
.gitattributes

@@ -2326,7 +2326,13 @@ packages/fcl-passrc/src/paswrite.pp svneol=native#text/plain
 packages/fcl-passrc/src/pparser.pp svneol=native#text/plain
 packages/fcl-passrc/src/pscanner.pp svneol=native#text/plain
 packages/fcl-passrc/src/readme.txt svneol=native#text/plain
+packages/fcl-passrc/tests/tcbaseparser.pas svneol=native#text/plain
+packages/fcl-passrc/tests/tcmoduleparser.pas svneol=native#text/plain
+packages/fcl-passrc/tests/tconstparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcscanner.pas svneol=native#text/plain
+packages/fcl-passrc/tests/tcstatements.pas svneol=native#text/plain
+packages/fcl-passrc/tests/tctypeparser.pas svneol=native#text/plain
+packages/fcl-passrc/tests/tcvarparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/testpassrc.lpi svneol=native#text/plain
 packages/fcl-passrc/tests/testpassrc.lpr svneol=native#text/plain
 packages/fcl-process/Makefile svneol=native#text/plain

+ 401 - 0
packages/fcl-passrc/tests/tcbaseparser.pas

@@ -0,0 +1,401 @@
+unit tcbaseparser;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils, pastree, pscanner, pparser, testregistry;
+
+Type
+  { TTestEngine }
+
+  TTestEngine = Class(TPasTreeContainer)
+  Private
+    FList : TFPList;
+  public
+    Destructor Destroy; override;
+    function CreateElement(AClass: TPTreeElement; const AName: String;
+      AParent: TPasElement; AVisibility: TPasMemberVisibility;
+      const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
+      override;
+    function FindElement(const AName: String): TPasElement; override;
+  end;
+  TTestPasParser = Class(TPasParser);
+
+  { TTestParser }
+
+  TTestParser= class(TTestCase)
+  Private
+    FDeclarations: TPasDeclarations;
+    FDefinition: TPasElement;
+    FEngine : TTestEngine;
+    FModule: TPasModule;
+    FParseResult: TPasElement;
+    FScanner : TPascalScanner;
+    FResolver : TStreamResolver;
+    FParser : TTestPasParser;
+    FSource: TStrings;
+    FFileName : string;
+    FIsUnit : Boolean;
+    FImplementation : Boolean;
+    FEndSource: Boolean;
+    function GetPL: TPasLibrary;
+    function GetPP: TPasProgram;
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+    Procedure StartUnit(AUnitName : String);
+    Procedure StartProgram(AFileName : String; AIn : String = ''; AOut : String = '');
+    Procedure StartLibrary(AFileName : String);
+    Procedure UsesClause(Units : Array of string);
+    Procedure StartImplementation;
+    Procedure EndSource;
+    Procedure Add(Const ALine : String);
+    Procedure StartParsing;
+    Procedure ParseDeclarations;
+    Procedure ParseModule;
+    Procedure CheckHint(AHint : TPasMemberHint);
+    Function AssertExpression(Const Msg: String; AExpr : TPasExpr; aKind : TPasExprKind; AClass : TClass) : TPasExpr;
+    Function AssertExpression(Const Msg: String; AExpr : TPasExpr; aKind : TPasExprKind; AValue : String) : TPrimitiveExpr;
+    Procedure AssertExportSymbol(Const Msg: String; AIndex : Integer; AName,AExportName : String; AExportIndex : Integer = -1);
+    Procedure AssertEquals(Const Msg : String; AExpected, AActual: TPasExprKind); overload;
+    Procedure AssertEquals(Const Msg : String; AExpected, AActual: TPasMemberHint); overload;
+    Procedure AssertEquals(Const Msg : String; AExpected, AActual: TCallingConvention); overload;
+    Procedure AssertEquals(Const Msg : String; AExpected, AActual: TArgumentAccess); overload;
+    Procedure AssertEquals(Const Msg : String; AExpected, AActual: TVariableModifier); overload;
+    Procedure AssertEquals(Const Msg : String; AExpected, AActual: TVariableModifiers); overload;
+    Procedure HaveHint(AHint : TPasMemberHint; AHints : TPasMemberHints);
+    Property Resolver : TStreamResolver Read FResolver;
+    Property Scanner : TPascalScanner Read FScanner;
+    Property Parser : TTestPasParser read FParser ;
+    Property Source : TStrings Read FSource;
+    Property Module : TPasModule Read FModule;
+    Property PasProgram : TPasProgram Read GetPP;
+    Property PasLibrary : TPasLibrary Read GetPL;
+    Property Declarations : TPasDeclarations read FDeclarations Write FDeclarations;
+    Property Definition : TPasElement Read FDefinition Write FDefinition;
+    // If set, Will be freed in teardown
+    Property ParseResult : TPasElement Read FParseResult Write FParseResult;
+
+  end;
+
+implementation
+
+uses typinfo;
+{ TTestEngine }
+
+destructor TTestEngine.Destroy;
+begin
+  FreeAndNil(FList);
+  inherited Destroy;
+end;
+
+function TTestEngine.CreateElement(AClass: TPTreeElement; const AName: String;
+  AParent: TPasElement; AVisibility: TPasMemberVisibility;
+  const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
+begin
+  Result := AClass.Create(AName, AParent);
+  Result.Visibility := AVisibility;
+  Result.SourceFilename := ASourceFilename;
+  Result.SourceLinenumber := ASourceLinenumber;
+  If not Assigned(FList) then
+    FList:=TFPList.Create;
+  FList.Add(Result);
+end;
+
+function TTestEngine.FindElement(const AName: String): TPasElement;
+
+Var
+  I : Integer;
+
+begin
+  Result:=Nil;
+  if Assigned(FList) then
+    begin
+    I:=FList.Count-1;
+    While (Result=Nil) and (I>=0) do
+      begin
+      if CompareText(TPasElement(FList[I]).Name,AName)=0 then
+        Result:=TPasElement(Flist[i]);
+      Dec(i);
+      end;
+    end;
+end;
+
+function TTestParser.GetPP: TPasProgram;
+begin
+  Result:=Module as TPasProgram;
+end;
+
+function TTestParser.GetPL: TPasLibrary;
+begin
+  Result:=Module as TPasLibrary;
+end;
+
+procedure TTestParser.SetUp;
+begin
+  FResolver:=TStreamResolver.Create;
+  FResolver.OwnsStreams:=True;
+  FScanner:=TPascalScanner.Create(FResolver);
+  FEngine:=TTestEngine.Create;
+  FParser:=TTestPasParser.Create(FScanner,FResolver,FEngine);
+  FSource:=TStringList.Create;
+  FModule:=Nil;
+  FDeclarations:=Nil;
+  FEndSource:=False;
+  FImplementation:=False;
+  FIsUnit:=False;
+end;
+
+procedure TTestParser.TearDown;
+begin
+  if Not Assigned(FModule) then
+    FreeAndNil(FDeclarations)
+  else
+    FDeclarations:=Nil;
+  FImplementation:=False;
+  FEndSource:=False;
+  FIsUnit:=False;
+  FreeAndNil(FModule);
+  FreeAndNil(FSource);
+  FreeAndNil(FParseResult);
+  FreeAndNil(FParser);
+  FreeAndNil(FEngine);
+  FreeAndNil(FScanner);
+  FreeAndNil(FResolver);
+end;
+
+procedure TTestParser.StartUnit(AUnitName: String);
+begin
+  FIsUnit:=True;
+  If (AUnitName='') then
+    AUnitName:='afile';
+  Add('unit '+aUnitName+';');
+  Add('');
+  Add('interface');
+  Add('');
+  FFileName:=AUnitName+'.pp';
+end;
+
+procedure TTestParser.StartProgram(AFileName : String; AIn : String = ''; AOut : String = '');
+begin
+  FIsUnit:=False;
+  If (AFileName='') then
+    AFileName:='proga';
+  FFileName:=AFileName+'.pp';
+  If (AIn<>'') then
+    begin
+    AFileName:=AFileName+'('+AIn;
+    if (AOut<>'') then
+      AFileName:=AFIleName+','+AOut;
+    AFileName:=AFileName+')';
+    end;
+  Add('program '+AFileName+';');
+  FImplementation:=True;
+end;
+
+procedure TTestParser.StartLibrary(AFileName: String);
+begin
+  FIsUnit:=False;
+  If (AFileName='') then
+    AFileName:='liba';
+  FFileName:=AFileName+'.pp';
+  Add('library '+AFileName+';');
+  FImplementation:=True;
+end;
+
+procedure TTestParser.UsesClause(Units: array of string);
+
+Var
+  S : String;
+  I : integer;
+
+begin
+  S:='';
+  For I:=Low(units) to High(units) do
+    begin
+    If (S<>'') then
+        S:=S+', ';
+    S:=S+Units[i];
+    end;
+  Add('uses '+S+';');
+  Add('');
+end;
+
+procedure TTestParser.StartImplementation;
+begin
+  if Not FImplementation then
+    begin
+    Add('');
+    Add('Implementation');
+    Add('');
+    FImplementation:=True;
+    end;
+end;
+
+procedure TTestParser.EndSource;
+begin
+  if Not FEndSource then
+    begin
+    Add('end.');
+    FEndSource:=True;
+    end;
+end;
+
+procedure TTestParser.Add(const ALine: String);
+begin
+  FSource.Add(ALine);
+end;
+
+procedure TTestParser.StartParsing;
+
+begin
+  If FIsUnit then
+    StartImplementation;
+  EndSource;
+  If (FFileName='') then
+    FFileName:='afile.pp';
+  FResolver.AddStream(FFileName,TStringStream.Create(FSource.text));
+  FScanner.OpenFile(FFileName);
+  Writeln('// Test : ',Self.TestName);
+  Writeln(FSource.Text);
+end;
+
+procedure TTestParser.ParseDeclarations;
+begin
+  FSource.Insert(0,'');
+  FSource.Insert(0,'interface');
+  FSource.Insert(0,'');
+  FSource.Insert(0,'unit afile;');
+  StartImplementation;
+  EndSource;
+  ParseModule;
+  FDeclarations:=Module.InterfaceSection;
+end;
+
+procedure TTestParser.ParseModule;
+begin
+  StartParsing;
+  FParser.ParseMain(FModule);
+  AssertNotNull('Module resulted in Module',FModule);
+  AssertEquals('modulename',ChangeFileExt(FFileName,''),Module.Name);
+end;
+
+procedure TTestParser.CheckHint(AHint: TPasMemberHint);
+begin
+  HaveHint(AHint,Definition.Hints);
+end;
+
+function TTestParser.AssertExpression(const Msg: String; AExpr: TPasExpr;
+  aKind: TPasExprKind; AClass: TClass): TPasExpr;
+begin
+  AssertEquals(Msg+': Correct expression kind',aKind,AExpr.Kind);
+  AssertEquals(Msg+': Correct expression class',AClass,AExpr.ClassType);
+  Result:=AExpr;
+end;
+
+function TTestParser.AssertExpression(const Msg: String; AExpr: TPasExpr;
+  aKind: TPasExprKind; AValue: String): TPrimitiveExpr;
+begin
+  Result:=AssertExpression(Msg,AExpr,aKind,TPrimitiveExpr) as TPrimitiveExpr;
+  AssertEquals(Msg+': Primitive expression value',AValue,TPrimitiveExpr(AExpr).Value);
+end;
+
+procedure TTestParser.AssertExportSymbol(const Msg: String; AIndex: Integer;
+  AName, AExportName: String; AExportIndex: Integer);
+
+Var
+  E: TPasExportSymbol;
+
+begin
+  AssertNotNull('Have export symbols list',PasLibrary.LibrarySection.ExportSymbols);
+  if AIndex>=PasLibrary.LibrarySection.ExportSymbols.Count then
+    Fail(Format('%d not a valid export list symbol',[AIndex]));
+  AssertNotNull('Have export symbol',PasLibrary.LibrarySection.ExportSymbols[Aindex]);
+  AssertEquals('Correct export symbol class',TPasExportSymbol,TObject(PasLibrary.LibrarySection.ExportSymbols[Aindex]).ClassType);
+  E:=TPasExportSymbol(PasLibrary.LibrarySection.ExportSymbols[Aindex]);
+  AssertEquals('Correct export symbol name',AName,E.Name);
+  if (AExportName='') then
+    AssertNull('No export name',E.ExportName)
+  else
+    begin
+    AssertNotNull('Export name symbol',E.ExportName);
+    AssertEquals('TPrimitiveExpr',TPrimitiveExpr,E.ExportName.CLassType);
+    AssertEquals('Correct export symbol export name ',''''+AExportName+'''',TPrimitiveExpr(E.ExportName).Value);
+    end;
+  If AExportIndex=-1 then
+    AssertNull('No export name',E.ExportIndex)
+  else
+    begin
+    AssertNotNull('Export name symbol',E.ExportIndex);
+    AssertEquals('TPrimitiveExpr',TPrimitiveExpr,E.ExportIndex.CLassType);
+    AssertEquals('Correct export symbol export index',IntToStr(AExportindex),TPrimitiveExpr(E.ExportIndex).Value);
+    end;
+end;
+
+procedure TTestParser.AssertEquals(const Msg: String; AExpected,
+  AActual: TPasExprKind);
+begin
+  AssertEquals(Msg,GetEnumName(TypeInfo(TPasExprKind),Ord(AExpected)),
+                   GetEnumName(TypeInfo(TPasExprKind),Ord(AActual)));
+end;
+
+procedure TTestParser.AssertEquals(const Msg: String; AExpected,
+  AActual: TPasMemberHint);
+begin
+  AssertEquals(Msg,GetEnumName(TypeInfo(TPasMemberHint),Ord(AExpected)),
+                   GetEnumName(TypeInfo(TPasMemberHint),Ord(AActual)));
+end;
+
+procedure TTestParser.AssertEquals(const Msg: String; AExpected,
+  AActual: TCallingConvention);
+begin
+  AssertEquals(Msg,GetEnumName(TypeInfo(TCallingConvention),Ord(AExpected)),
+                   GetEnumName(TypeInfo(TCallingConvention),Ord(AActual)));
+end;
+
+procedure TTestParser.AssertEquals(const Msg: String; AExpected,
+  AActual: TArgumentAccess);
+begin
+  AssertEquals(Msg,GetEnumName(TypeInfo(TArgumentAccess),Ord(AExpected)),
+                   GetEnumName(TypeInfo(TArgumentAccess),Ord(AActual)));
+end;
+
+procedure TTestParser.AssertEquals(const Msg: String; AExpected,
+  AActual: TVariableModifier);
+begin
+  AssertEquals(Msg,GetEnumName(TypeInfo(TVariableModifier),Ord(AExpected)),
+                   GetEnumName(TypeInfo(TVariableModifier),Ord(AActual)));
+end;
+
+procedure TTestParser.AssertEquals(const Msg: String; AExpected,
+  AActual: TVariableModifiers);
+
+ Function sn (S : TVariableModifiers) : string;
+
+ Var
+   M : TVariableModifier;
+
+ begin
+   For M:=Low(TVariableModifier) to High(TVariableModifier) do
+     if M in S then
+       begin
+       if (Result<>'') then
+         Result:=Result+',';
+       end;
+   Result:='['+Result+']';
+ end;
+
+begin
+  AssertEquals(Msg,Sn(AExpected),Sn(AActual));
+end;
+
+procedure TTestParser.HaveHint(AHint: TPasMemberHint; AHints: TPasMemberHints);
+begin
+  If not (AHint in AHints) then
+    Fail(GetEnumName(TypeInfo(TPasMemberHint),Ord(AHint))+'hint expected.');
+end;
+
+end.
+

+ 377 - 0
packages/fcl-passrc/tests/tcmoduleparser.pas

@@ -0,0 +1,377 @@
+unit tcmoduleparser;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils, pastree, pscanner, pparser,
+  tcbaseparser, testregistry;
+
+Type
+  { TTestModuleParser }
+
+  TTestModuleParser = class(TTestParser)
+  private
+    function GetIf: TInterfaceSection;
+    function GetIm: TImplementationSection;
+    function CheckUnit(AIndex: Integer; const AName: String; AList: TFPList): TPasUnresolvedUnitRef;
+  Protected
+    Procedure ParseUnit;
+    Procedure ParseProgram;
+    Procedure ParseLibrary;
+    Procedure AssertProgramError;
+    Property ImplSection : TImplementationSection Read GetIm;
+    Property IntfSection : TInterfaceSection Read GetIf;
+  Published
+    Procedure TestEmptyUnit;
+    Procedure TestUnitOneUses;
+    Procedure TestUnitTwoUses;
+    Procedure TestUnitOneImplUses;
+    Procedure TestUnitTwoImplUses;
+    Procedure TestEmptyUnitInitialization;
+    Procedure TestEmptyUnitFinalization;
+    Procedure TestEmptyUnitInitializationFinalization;
+    Procedure TestEmptyUnitBegin;
+    Procedure TestEmptyProgram;
+    Procedure TestEmptyProgramInputOUtput;
+    Procedure TestEmptyProgramNoInitialization;
+    Procedure TestEmptyProgramNoFinalization;
+    Procedure TestEmptyProgramMissingBegin;
+    Procedure TestEmptyProgramNoheader;
+    Procedure TestEmptyProgramUses;
+    Procedure TestEmptyProgramUsesTwoUnits;
+    Procedure TestEmptyProgramUsesUnitIn;
+    Procedure TestEmptyLibrary;
+    Procedure TestEmptyLibraryUses;
+    Procedure TestEmptyLibraryExports;
+    Procedure TestEmptyLibraryExportsAlias;
+    Procedure TestEmptyLibraryExportsIndex;
+    Procedure TestEmptyLibraryExportsTwo;
+    Procedure TestEmptyLibraryExportsTwoAlias;
+    Procedure TestEmptyLibraryExportsTwoIndex;
+  end;
+
+implementation
+{ TTestModuleParser }
+
+function TTestModuleParser.GetIf: TInterfaceSection;
+begin
+  Result:=Module.InterfaceSection;
+end;
+
+function TTestModuleParser.GetIm: TImplementationSection;
+begin
+  Result:=Module.ImplementationSection;
+end;
+
+procedure TTestModuleParser.ParseUnit;
+begin
+  EndSource;
+  ParseModule;
+  AssertNotNull('Have interface',Module.InterfaceSection);
+  Declarations:=Module.InterfaceSection;
+  AssertEquals('Interface section',TInterfaceSection,Declarations.ClassType);
+  AssertNotNull('Have implmeentation',Module.ImplementationSection);
+  AssertEquals('implementation section',TImplementationSection,Module.ImplementationSection.ClassType);
+  AssertNotNull('Have interface units',IntfSection.UsesList);
+  AssertNotNull('Have implementation units',ImplSection.UsesList);
+end;
+
+procedure TTestModuleParser.ParseProgram;
+begin
+  EndSource;
+  ParseModule;
+  AssertEquals('Is program',TPasProgram,Module.ClassType);
+end;
+
+procedure TTestModuleParser.ParseLibrary;
+begin
+  EndSource;
+  ParseModule;
+  AssertEquals('Is library',TPasLibrary,Module.ClassType);
+end;
+
+procedure TTestModuleParser.AssertProgramError;
+begin
+  AssertException(EParserError,@ParseProgram)
+end;
+
+function TTestModuleParser.CheckUnit(AIndex: Integer; const AName: String;
+  AList: TFPList) : TPasUnresolvedUnitRef;
+
+Var
+  C : string;
+
+begin
+  C:='Unit '+IntTostr(AIndex)+' ';
+  if (AIndex>=AList.Count) then
+    Fail(Format('Index %d larger than unit list count %d',[AIndex,AList.Count ]));
+  AssertNotNull('Have pascal element',AList[AIndex]);
+  AssertEquals(C+'Correct class',TPasUnresolvedUnitRef,TObject(AList[AIndex]).CLassType);
+  Result:=TPasUnresolvedUnitRef(AList[AIndex]);
+  AssertEquals(C+'Unit name correct',AName,Result.Name);
+end;
+
+procedure TTestModuleParser.TestEmptyUnit;
+begin
+  StartUnit('unit1');
+  StartImplementation;
+  ParseUnit;
+  AssertEquals('No interface units',0,IntfSection.UsesList.Count);
+  AssertEquals('No implementation units',0,ImplSection.UsesList.Count);
+end;
+
+procedure TTestModuleParser.TestUnitOneUses;
+begin
+  StartUnit('unit1');
+  UsesClause(['a']);
+  StartImplementation;
+  ParseUnit;
+  AssertEquals('Two interface units',2,IntfSection.UsesList.Count);
+  CheckUnit(0,'System',IntfSection.UsesList);
+  CheckUnit(1,'a',IntfSection.UsesList);
+  AssertEquals('No implementation units',0,ImplSection.UsesList.Count);
+end;
+
+procedure TTestModuleParser.TestUnitTwoUses;
+begin
+  StartUnit('unit1');
+  UsesClause(['a','b']);
+  StartImplementation;
+  ParseUnit;
+  AssertEquals('Two interface units',3,IntfSection.UsesList.Count);
+  CheckUnit(0,'System',IntfSection.UsesList);
+  CheckUnit(1,'a',IntfSection.UsesList);
+  CheckUnit(2,'b',IntfSection.UsesList);
+  AssertEquals('No implementation units',0,ImplSection.UsesList.Count);
+end;
+
+procedure TTestModuleParser.TestUnitOneImplUses;
+begin
+  StartUnit('unit1');
+  StartImplementation;
+  UsesClause(['a']);
+  ParseUnit;
+  AssertEquals('One implementation units',1,ImplSection.UsesList.Count);
+  CheckUnit(0,'a',ImplSection.UsesList);
+  AssertEquals('No interface units',0,IntfSection.UsesList.Count);
+end;
+
+procedure TTestModuleParser.TestUnitTwoImplUses;
+begin
+  StartUnit('unit1');
+  StartImplementation;
+  UsesClause(['a','b']);
+  ParseUnit;
+  AssertEquals('Two implementation units',2,ImplSection.UsesList.Count);
+  CheckUnit(0,'a',ImplSection.UsesList);
+  CheckUnit(1,'b',ImplSection.UsesList);
+  AssertEquals('No interface units',0,IntfSection.UsesList.Count);
+end;
+
+procedure TTestModuleParser.TestEmptyUnitInitialization;
+begin
+  StartUnit('unit1');
+  StartImplementation;
+  Add('initialization');
+  ParseUnit;
+  AssertNotNull('Have initialization section',Module.InitializationSection);
+  AssertNull('Have no finalization section',Module.FinalizationSection)
+end;
+
+procedure TTestModuleParser.TestEmptyUnitFinalization;
+begin
+  StartUnit('unit1');
+  StartImplementation;
+  Add('finalization');
+  ParseUnit;
+  AssertNull('Have no initalization section',Module.InitializationSection);
+  AssertNotNull('Have finalization section',Module.FinalizationSection)
+end;
+
+procedure TTestModuleParser.TestEmptyUnitInitializationFinalization;
+begin
+  StartUnit('unit1');
+  StartImplementation;
+  Add('initialization');
+  Add('finalization');
+  ParseUnit;
+  AssertNotNull('Have finalization section',Module.InitializationSection);
+  AssertNotNull('Have finalization section',Module.FinalizationSection);
+end;
+
+procedure TTestModuleParser.TestEmptyUnitBegin;
+begin
+  StartUnit('unit1');
+  StartImplementation;
+  Add('begin');
+  ParseUnit;
+  AssertNotNull('Have initialization section',Module.InitializationSection);
+  AssertNull('Have no finalization section',Module.FinalizationSection)
+end;
+
+procedure TTestModuleParser.TestEmptyProgram;
+begin
+  StartProgram('something');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestModuleParser.TestEmptyProgramInputOUtput;
+begin
+  StartProgram('something','input','output');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestModuleParser.TestEmptyProgramNoInitialization;
+begin
+  StartProgram('something','input','output');
+  Add('initialization');
+  AssertProgramError;
+end;
+
+procedure TTestModuleParser.TestEmptyProgramNoFinalization;
+begin
+  StartProgram('something','input','output');
+  Add('finalization');
+  AssertProgramError;
+end;
+
+procedure TTestModuleParser.TestEmptyProgramMissingBegin;
+begin
+  StartProgram('something','input','output');
+  AssertProgramError;
+end;
+
+procedure TTestModuleParser.TestEmptyProgramNoheader;
+begin
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestModuleParser.TestEmptyProgramUses;
+begin
+  UsesClause(['a']);
+  Add('begin');
+  ParseProgram;
+  AssertEquals('Two interface units',2, PasProgram.ProgramSection.UsesList.Count);
+  CheckUnit(0,'System',PasProgram.ProgramSection.UsesList);
+  CheckUnit(1,'a',PasProgram.ProgramSection.UsesList);
+end;
+
+procedure TTestModuleParser.TestEmptyProgramUsesTwoUnits;
+begin
+  UsesClause(['a','b']);
+  Add('begin');
+  ParseProgram;
+  AssertEquals('Three interface units',3, PasProgram.ProgramSection.UsesList.Count);
+  CheckUnit(0,'System',PasProgram.ProgramSection.UsesList);
+  CheckUnit(1,'a',PasProgram.ProgramSection.UsesList);
+  CheckUnit(2,'b',PasProgram.ProgramSection.UsesList);
+end;
+
+procedure TTestModuleParser.TestEmptyProgramUsesUnitIn;
+
+Var
+  U : TPasUnresolvedUnitRef;
+
+begin
+  UsesClause(['a in ''../a.pas''','b']);
+  Add('begin');
+  ParseProgram;
+  AssertEquals('One interface unit',3, PasProgram.ProgramSection.UsesList.Count);
+  CheckUnit(0,'System',PasProgram.ProgramSection.UsesList);
+  U:=CheckUnit(1,'a',PasProgram.ProgramSection.UsesList);
+  AssertEquals('Filename','''../a.pas''',U.FileName);
+  CheckUnit(2,'b',PasProgram.ProgramSection.UsesList);
+end;
+
+procedure TTestModuleParser.TestEmptyLibrary;
+begin
+  StartLibrary('');
+  ParseLibrary;
+  AssertEquals('Correct class',TPasLibrary,Module.ClassType);
+end;
+
+procedure TTestModuleParser.TestEmptyLibraryUses;
+begin
+  StartLibrary('');
+  UsesClause(['a']);
+  ParseLibrary;
+  AssertEquals('Correct class',TPasLibrary,Module.ClassType);
+  AssertEquals('Two interface units',2, PasLibrary.LibrarySection.UsesList.Count);
+  CheckUnit(0,'System',PasLibrary.LibrarySection.UsesList);
+  CheckUnit(1,'a',PasLibrary.LibrarySection.UsesList);
+end;
+
+procedure TTestModuleParser.TestEmptyLibraryExports;
+begin
+  StartLibrary('');
+  UsesClause(['b']);
+  Add('exports A;');
+  ParseLibrary;
+  AssertEquals('1 export symbol',1,PasLibrary.LibrarySection.ExportSymbols.Count);
+  AssertExportSymbol('Export symbol a',0,'A','',-1);
+end;
+
+procedure TTestModuleParser.TestEmptyLibraryExportsAlias;
+begin
+  StartLibrary('');
+  UsesClause(['b']);
+  Add('exports A name ''c'';');
+  ParseLibrary;
+  AssertEquals('1 export symbol',1,PasLibrary.LibrarySection.ExportSymbols.Count);
+  AssertExportSymbol('Export symbol a',0,'A','c',-1);
+end;
+
+procedure TTestModuleParser.TestEmptyLibraryExportsIndex;
+begin
+  StartLibrary('');
+  UsesClause(['b']);
+  Add('exports A index 23;');
+  ParseLibrary;
+  AssertEquals('1 export symbol',1,PasLibrary.LibrarySection.ExportSymbols.Count);
+  AssertExportSymbol('Export symbol a',0,'A','',23);
+end;
+
+procedure TTestModuleParser.TestEmptyLibraryExportsTwo;
+begin
+  StartLibrary('');
+  UsesClause(['b']);
+  Add('exports A , C;');
+  ParseLibrary;
+  AssertEquals('2 export symbol',2,PasLibrary.LibrarySection.ExportSymbols.Count);
+  AssertExportSymbol('Export symbol a',0,'A','',-1);
+  AssertExportSymbol('Export symbol C',1,'C','',-1);
+end;
+
+procedure TTestModuleParser.TestEmptyLibraryExportsTwoAlias;
+begin
+  StartLibrary('');
+  UsesClause(['b']);
+  Add('exports A name ''de'', C;');
+  ParseLibrary;
+  AssertEquals('2 export symbol',2,PasLibrary.LibrarySection.ExportSymbols.Count);
+  AssertExportSymbol('Export symbol a',0,'A','de',-1);
+  AssertExportSymbol('Export symbol C',1,'C','',-1);
+
+end;
+
+procedure TTestModuleParser.TestEmptyLibraryExportsTwoIndex;
+begin
+  StartLibrary('');
+  UsesClause(['b']);
+  Add('exports A index 23, C;');
+  ParseLibrary;
+  AssertEquals('2 export symbol',2,PasLibrary.LibrarySection.ExportSymbols.Count);
+  AssertExportSymbol('Export symbol a',0,'A','',23);
+  AssertExportSymbol('Export symbol C',1,'C','',-1);
+end;
+
+initialization
+  RegisterTests([TTestModuleParser]);
+
+end.
+

+ 632 - 0
packages/fcl-passrc/tests/tconstparser.pas

@@ -0,0 +1,632 @@
+unit tconstparser;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils, pastree, pscanner, pparser,
+  tcbaseparser, testregistry;
+
+Type
+    { TTestConstParser }
+
+  TTestConstParser = Class(TTestParser)
+  private
+    FConst: TPasConst;
+    FExpr: TPasExpr;
+    FHint : string;
+    FTyped: String;
+  Protected
+    Function ParseConst(ASource : String) : TPasConst;
+    Procedure CheckExprNameKindClass(AKind : TPasExprKind; AClass : TClass);
+    Property TheConst : TPasConst Read FConst;
+    Property TheExpr : TPasExpr Read FExpr;
+    Property Hint : string Read FHint Write FHint;
+    Property Typed : String Read FTyped Write FTyped;
+    procedure SetUp; override;
+  Public
+    Procedure DoTestSimpleIntConst;
+    Procedure DoTestSimpleFloatConst;
+    Procedure DoTestSimpleStringConst;
+    Procedure DoTestSimpleNilConst;
+    Procedure DoTestSimpleBoolConst;
+    Procedure DoTestSimpleIdentifierConst;
+    Procedure DoTestSimpleSetConst;
+    Procedure DoTestSimpleExprConst;
+  Published
+    Procedure TestSimpleIntConst;
+    Procedure TestSimpleFloatConst;
+    Procedure TestSimpleStringConst;
+    Procedure TestSimpleNilConst;
+    Procedure TestSimpleBoolConst;
+    Procedure TestSimpleIdentifierConst;
+    Procedure TestSimpleSetConst;
+    Procedure TestSimpleExprConst;
+    Procedure TestSimpleIntConstDeprecatedMsg;
+    Procedure TestSimpleIntConstDeprecated;
+    Procedure TestSimpleFloatConstDeprecated;
+    Procedure TestSimpleStringConstDeprecated;
+    Procedure TestSimpleNilConstDeprecated;
+    Procedure TestSimpleBoolConstDeprecated;
+    Procedure TestSimpleIdentifierConstDeprecated;
+    Procedure TestSimpleSetConstDeprecated;
+    Procedure TestSimpleExprConstDeprecated;
+    Procedure TestSimpleIntConstPlatform;
+    Procedure TestSimpleFloatConstPlatform;
+    Procedure TestSimpleStringConstPlatform;
+    Procedure TestSimpleNilConstPlatform;
+    Procedure TestSimpleBoolConstPlatform;
+    Procedure TestSimpleIdentifierConstPlatform;
+    Procedure TestSimpleSetConstPlatform;
+    Procedure TestSimpleExprConstPlatform;
+    Procedure TestSimpleIntConstExperimental;
+    Procedure TestSimpleFloatConstExperimental;
+    Procedure TestSimpleStringConstExperimental;
+    Procedure TestSimpleNilConstExperimental;
+    Procedure TestSimpleBoolConstExperimental;
+    Procedure TestSimpleIdentifierConstExperimental;
+    Procedure TestSimpleSetConstExperimental;
+    Procedure TestSimpleExprConstExperimental;
+    Procedure TestTypedIntConst;
+    Procedure TestTypedFloatConst;
+    Procedure TestTypedStringConst;
+    Procedure TestTypedNilConst;
+    Procedure TestTypedBoolConst;
+    Procedure TestTypedIdentifierConst;
+    Procedure TestTypedSetConst;
+    Procedure TestTypedExprConst;
+    Procedure TestRecordConst;
+    Procedure TestArrayConst;
+  end;
+
+  { TTestResourcestringParser }
+
+  TTestResourcestringParser = Class(TTestParser)
+  private
+    FExpr: TPasExpr;
+    FHint : string;
+    FTheStr: TPasResString;
+  Protected
+    Function ParseResourcestring(ASource : String) : TPasResString;
+    Procedure CheckExprNameKindClass(AKind : TPasExprKind; AClass : TClass);
+    Property Hint : string Read FHint Write FHint;
+    Property TheStr : TPasResString Read FTheStr;
+    Property TheExpr : TPasExpr Read FExpr;
+  Public
+    Procedure DoTestSimple;
+    Procedure DoTestSum;
+    Procedure DoTestSum2;
+  Published
+    Procedure TestSimple;
+    Procedure TestSimpleDeprecated;
+    Procedure TestSimplePlatform;
+    Procedure TestSum1;
+    Procedure TestSum1Deprecated;
+    Procedure TestSum1Platform;
+    Procedure TestSum2;
+    Procedure TestSum2Deprecated;
+    Procedure TestSum2Platform;
+  end;
+
+
+implementation
+{ TTestConstParser }
+
+function TTestConstParser.ParseConst(ASource: String): TPasConst;
+
+Var
+  D : String;
+begin
+  Add('Const');
+  D:=' A ';
+  If (Typed<>'') then
+    D:=D+' : '+Typed+' ';
+  D:=D+' = '+ASource;
+  If Hint<>'' then
+    D:=D+' '+Hint;
+  Add('  '+D+';');
+  ParseDeclarations;
+  AssertEquals('One constant definition',1,Declarations.Consts.Count);
+  AssertEquals('First declaration is constant definition.',TPasConst,TObject(Declarations.Consts[0]).ClassType);
+  Result:=TPasConst(Declarations.Consts[0]);
+  AssertNotNull(Result.Expr);
+  FExpr:=Result.Expr;
+  FConst:=Result;
+  Definition:=Result;
+end;
+
+
+procedure TTestConstParser.CheckExprNameKindClass(
+  AKind: TPasExprKind; AClass : TClass);
+begin
+  AssertEquals('Correct name','A',TheConst.Name);
+  AssertExpression('Const', TheExpr,aKind,AClass);
+end;
+
+procedure TTestConstParser.SetUp;
+begin
+  inherited SetUp;
+  Hint:='';
+end;
+
+procedure TTestConstParser.DoTestSimpleIntConst;
+
+begin
+  ParseConst('1');
+  AssertExpression('Integer Const',TheExpr,pekNumber,'1');
+end;
+
+procedure TTestConstParser.DoTestSimpleFloatConst;
+begin
+  ParseConst('1.2');
+  AssertExpression('Float const', TheExpr,pekNumber,'1.2');
+end;
+
+procedure TTestConstParser.DoTestSimpleStringConst;
+begin
+  ParseConst('''test''');
+  AssertExpression('String const', TheExpr,pekString,'''test''');
+end;
+
+procedure TTestConstParser.DoTestSimpleNilConst;
+begin
+  ParseConst('Nil');
+  CheckExprNameKindClass(pekNil,TNilExpr);
+end;
+
+procedure TTestConstParser.DoTestSimpleBoolConst;
+begin
+  ParseConst('True');
+  CheckExprNameKindClass(pekBoolConst,TBoolconstExpr);
+  AssertEquals('Correct expression value',True,TBoolconstExpr(TheExpr).Value);
+end;
+
+procedure TTestConstParser.DoTestSimpleIdentifierConst;
+begin
+  ParseConst('taCenter');
+  AssertExpression('Enumeration const', theExpr,pekIdent,'taCenter');
+end;
+
+procedure TTestConstParser.DoTestSimpleSetConst;
+begin
+  ParseConst('[taLeftJustify,taRightJustify]');
+  CheckExprNameKindClass(pekSet,TParamsExpr);
+  AssertEquals('Correct set count',2,Length(TParamsExpr(TheExpr).Params));
+  AssertExpression('Set element 1',TParamsExpr(TheExpr).Params[0],pekIdent,'taLeftJustify');
+  AssertExpression('Set element 2',TParamsExpr(TheExpr).Params[1],pekIdent,'taRightJustify');
+end;
+
+procedure TTestConstParser.DoTestSimpleExprConst;
+
+Var
+  B : TBinaryExpr;
+
+begin
+  ParseConst('1 + 2');
+  CheckExprNameKindClass(pekBinary,TBinaryExpr);
+  B:=TBinaryExpr(TheExpr);
+  AssertExpression('Left expression',B.Left,pekNumber,'1');
+  AssertExpression('Right expression',B.Right,pekNumber,'2');
+end;
+
+procedure TTestConstParser.TestSimpleIntConst;
+begin
+  DoTestSimpleIntConst
+end;
+
+procedure TTestConstParser.TestSimpleFloatConst;
+begin
+  DoTestSimpleFloatConst
+end;
+
+procedure TTestConstParser.TestSimpleStringConst;
+begin
+  DoTestSimpleStringConst
+end;
+
+procedure TTestConstParser.TestSimpleNilConst;
+begin
+  DoTestSimpleNilConst
+end;
+
+procedure TTestConstParser.TestSimpleBoolConst;
+begin
+  DoTestSimpleBoolConst
+end;
+
+procedure TTestConstParser.TestSimpleIdentifierConst;
+begin
+  DoTestSimpleIdentifierConst
+end;
+
+procedure TTestConstParser.TestSimpleSetConst;
+begin
+  DoTestSimpleSetConst
+end;
+
+procedure TTestConstParser.TestSimpleExprConst;
+begin
+  DoTestSimpleExprConst;
+end;
+
+procedure TTestConstParser.TestSimpleIntConstDeprecatedMsg;
+begin
+  Hint:='deprecated ''this is old''' ;
+  DoTestSimpleIntConst;
+  CheckHint(hDeprecated);
+end;
+
+procedure TTestConstParser.TestSimpleIntConstDeprecated;
+begin
+  Hint:='deprecated';
+  DoTestSimpleIntConst;
+  CheckHint(hDeprecated);
+end;
+
+procedure TTestConstParser.TestSimpleFloatConstDeprecated;
+begin
+  Hint:='deprecated';
+  DoTestSimpleIntConst;
+  CheckHint(hDeprecated);
+end;
+
+procedure TTestConstParser.TestSimpleStringConstDeprecated;
+begin
+  Hint:='deprecated';
+  DoTestSimpleStringConst;
+  CheckHint(hDeprecated);
+end;
+
+procedure TTestConstParser.TestSimpleNilConstDeprecated;
+begin
+  Hint:='deprecated';
+  DoTestSimpleNilConst;
+  CheckHint(hDeprecated);
+end;
+
+procedure TTestConstParser.TestSimpleBoolConstDeprecated;
+begin
+  Hint:='deprecated';
+  DoTestSimpleBoolConst;
+  CheckHint(hDeprecated);
+end;
+
+procedure TTestConstParser.TestSimpleIdentifierConstDeprecated;
+begin
+  Hint:='deprecated';
+  DoTestSimpleIdentifierConst;
+  CheckHint(hDeprecated);
+end;
+
+procedure TTestConstParser.TestSimpleSetConstDeprecated;
+begin
+  Hint:='deprecated';
+  DoTestSimpleSetConst;
+  CheckHint(hDeprecated);
+end;
+
+procedure TTestConstParser.TestSimpleExprConstDeprecated;
+begin
+  Hint:='deprecated';
+  DoTestSimpleExprConst;
+  CheckHint(hDeprecated);
+end;
+
+procedure TTestConstParser.TestSimpleIntConstPlatform;
+begin
+  Hint:='Platform';
+  DoTestSimpleIntConst;
+  CheckHint(hPlatform);
+end;
+
+procedure TTestConstParser.TestSimpleFloatConstPlatform;
+begin
+  Hint:='Platform';
+  DoTestSimpleIntConst;
+  CheckHint(hPlatform);
+end;
+
+procedure TTestConstParser.TestSimpleStringConstPlatform;
+begin
+  Hint:='Platform';
+  DoTestSimpleStringConst;
+  CheckHint(hPlatform);
+end;
+
+procedure TTestConstParser.TestSimpleNilConstPlatform;
+begin
+  Hint:='Platform';
+  DoTestSimpleNilConst;
+  CheckHint(hPlatform);
+end;
+
+procedure TTestConstParser.TestSimpleBoolConstPlatform;
+begin
+  Hint:='Platform';
+  DoTestSimpleBoolConst;
+  CheckHint(hPlatform);
+end;
+
+procedure TTestConstParser.TestSimpleIdentifierConstPlatform;
+begin
+  Hint:='Platform';
+  DoTestSimpleIdentifierConst;
+  CheckHint(hPlatform);
+end;
+
+procedure TTestConstParser.TestSimpleExprConstPlatform;
+begin
+  Hint:='Platform';
+  DoTestSimpleExprConst;
+  CheckHint(hPlatform);
+end;
+
+procedure TTestConstParser.TestSimpleSetConstPlatform;
+begin
+  Hint:='Platform';
+  DoTestSimpleSetConst;
+  CheckHint(hPlatform);
+end;
+
+procedure TTestConstParser.TestSimpleIntConstExperimental;
+begin
+  Hint:='Experimental';
+  DoTestSimpleIntConst;
+  CheckHint(hExperimental);
+end;
+
+procedure TTestConstParser.TestSimpleFloatConstExperimental;
+begin
+  Hint:='Experimental';
+  DoTestSimpleIntConst;
+  CheckHint(hExperimental);
+end;
+
+procedure TTestConstParser.TestSimpleStringConstExperimental;
+begin
+  Hint:='Experimental';
+  DoTestSimpleStringConst;
+  CheckHint(hExperimental);
+end;
+
+procedure TTestConstParser.TestSimpleNilConstExperimental;
+begin
+  Hint:='Experimental';
+  DoTestSimpleNilConst;
+  CheckHint(hExperimental);
+end;
+
+procedure TTestConstParser.TestSimpleBoolConstExperimental;
+begin
+  Hint:='Experimental';
+  DoTestSimpleBoolConst;
+  CheckHint(hExperimental);
+end;
+
+procedure TTestConstParser.TestSimpleIdentifierConstExperimental;
+begin
+  Hint:='Experimental';
+  DoTestSimpleIdentifierConst;
+  CheckHint(hExperimental);
+end;
+
+procedure TTestConstParser.TestSimpleSetConstExperimental;
+begin
+  Hint:='Experimental';
+  DoTestSimpleSetConst;
+  CheckHint(hExperimental);
+end;
+
+procedure TTestConstParser.TestSimpleExprConstExperimental;
+begin
+  Hint:='Experimental';
+  DoTestSimpleExprConst;
+  CheckHint(hExperimental);
+end;
+
+procedure TTestConstParser.TestTypedIntConst;
+begin
+  Typed:='Integer';
+  DoTestSimpleIntConst
+end;
+
+procedure TTestConstParser.TestTypedFloatConst;
+begin
+  Typed:='Double';
+  DoTestSimpleFloatConst
+end;
+
+procedure TTestConstParser.TestTypedStringConst;
+begin
+  Typed:='shortstring';
+  DoTestSimpleStringConst
+end;
+
+procedure TTestConstParser.TestTypedNilConst;
+begin
+  Typed:='PChar';
+  DoTestSimpleNilConst
+end;
+
+procedure TTestConstParser.TestTypedBoolConst;
+begin
+  Typed:='Boolean';
+  DoTestSimpleBoolConst
+end;
+
+procedure TTestConstParser.TestTypedIdentifierConst;
+begin
+  Typed:='TAlign';
+  DoTestSimpleIdentifierConst
+end;
+
+procedure TTestConstParser.TestTypedSetConst;
+begin
+  Typed:='TAligns';
+  DoTestSimpleSetConst
+end;
+
+procedure TTestConstParser.TestTypedExprConst;
+begin
+  Typed:='ShortInt';
+  DoTestSimpleExprConst;
+end;
+
+procedure TTestConstParser.TestRecordConst;
+Var
+  R : TRecordValues;
+  Fi : TRecordValuesItem;
+begin
+  Typed := 'TPoint';
+  ParseConst('(x:1;y: 2)');
+  AssertEquals('Record Values',TRecordValues,TheExpr.ClassType);
+  R:=TheExpr as TRecordValues;
+  AssertEquals('Expression list of ',pekListOfExp,TheExpr.Kind);
+  AssertEquals('2 elements',2,Length(R.Fields));
+  FI:=R.Fields[0];
+  AssertEquals('Name field 1','x',Fi.Name);
+  AssertExpression('Field 1 value',Fi.ValueExp,pekNumber,'1');
+  FI:=R.Fields[1];
+  AssertEquals('Name field 2','y',Fi.Name);
+  AssertExpression('Field 2 value',Fi.ValueExp,pekNumber,'2');
+end;
+
+procedure TTestConstParser.TestArrayConst;
+
+Var
+  R : TArrayValues;
+begin
+  Typed := 'TMyArray';
+  ParseConst('(1 , 2)');
+  AssertEquals('Array Values',TArrayValues,TheExpr.ClassType);
+  R:=TheExpr as TArrayValues;
+  AssertEquals('Expression list of ',pekListOfExp,TheExpr.Kind);
+  AssertEquals('2 elements',2,Length(R.Values));
+  AssertExpression('Element 1 value',R.Values[0],pekNumber,'1');
+  AssertExpression('Element 2 value',R.Values[1],pekNumber,'2');
+end;
+
+{ TTestResourcestringParser }
+
+function TTestResourcestringParser.ParseResourcestring(ASource: String
+  ): TPasResString;
+
+Var
+  D : String;
+begin
+  Add('Resourcestring');
+  D:=' A = '+ASource;
+  If Hint<>'' then
+    D:=D+' '+Hint;
+  Add('  '+D+';');
+  Add('end.');
+  //Writeln(source.text);
+  ParseDeclarations;
+  AssertEquals('One resourcestring definition',1,Declarations.ResStrings.Count);
+  AssertEquals('First declaration is constant definition.',TPasResString,TObject(Declarations.ResStrings[0]).ClassType);
+  Result:=TPasResString(Declarations.ResStrings[0]);
+  FTheStr:=Result;
+  FExpr:=Result.Expr;
+  Definition:=Result;
+end;
+
+procedure TTestResourcestringParser.CheckExprNameKindClass(AKind: TPasExprKind;
+  AClass: TClass);
+begin
+  AssertEquals('Correct name','A',TheStr.Name);
+  AssertEquals('Correct expression kind',aKind,TheExpr.Kind);
+  AssertEquals('Correct expression class',AClass,TheExpr.ClassType);
+  // Writeln('Delcaration : ',TheStr.GetDeclaration(True));
+end;
+
+procedure TTestResourcestringParser.DoTestSimple;
+begin
+  ParseResourcestring('''Something''');
+  CheckExprNameKindClass(pekString,TPrimitiveExpr);
+  AssertEquals('Correct expression value','''Something''',TPrimitiveExpr(TheExpr).Value);
+end;
+
+procedure TTestResourcestringParser.DoTestSum;
+begin
+  ParseResourcestring('''Something''+'' else''');
+  CheckExprNameKindClass(pekBinary,TBinaryExpr);
+  AssertEquals('Correct left',TPrimitiveExpr,TBinaryExpr(TheExpr).Left.ClassType);
+  AssertEquals('Correct right',TPrimitiveExpr,TBinaryExpr(TheExpr).Right.ClassType);
+  AssertEquals('Correct left expression value','''Something''',TPrimitiveExpr(TBinaryExpr(TheExpr).Left).Value);
+  AssertEquals('Correct right expression value',''' else''',TPrimitiveExpr(TBinaryExpr(TheExpr).Right).Value);
+end;
+
+procedure TTestResourcestringParser.DoTestSum2;
+begin
+  ParseResourcestring('''Something''+different');
+  CheckExprNameKindClass(pekBinary,TBinaryExpr);
+  AssertEquals('Correct left',TPrimitiveExpr,TBinaryExpr(TheExpr).Left.ClassType);
+  AssertEquals('Correct right',TPrimitiveExpr,TBinaryExpr(TheExpr).Right.ClassType);
+  AssertEquals('Correct left expression value','''Something''',TPrimitiveExpr(TBinaryExpr(TheExpr).Left).Value);
+  AssertEquals('Correct right expression value','different',TPrimitiveExpr(TBinaryExpr(TheExpr).Right).Value);
+
+end;
+
+procedure TTestResourcestringParser.TestSimple;
+begin
+  DoTestSimple;
+end;
+
+procedure TTestResourcestringParser.TestSimpleDeprecated;
+begin
+  Hint:='deprecated';
+  DoTestSimple;
+  CheckHint(hDeprecated);
+end;
+
+procedure TTestResourcestringParser.TestSimplePlatform;
+begin
+  Hint:='platform';
+  DoTestSimple;
+  CheckHint(hPlatform);
+end;
+
+procedure TTestResourcestringParser.TestSum2;
+begin
+  DoTestSum2;
+end;
+
+procedure TTestResourcestringParser.TestSum2Deprecated;
+begin
+  Hint:='deprecated';
+  DoTestSum2;
+  CheckHint(hDeprecated);
+end;
+
+procedure TTestResourcestringParser.TestSum2Platform;
+begin
+  Hint:='platform';
+  DoTestSum2;
+  CheckHint(hplatform);
+end;
+procedure TTestResourcestringParser.TestSum1;
+begin
+  DoTestSum;
+end;
+
+procedure TTestResourcestringParser.TestSum1Deprecated;
+begin
+  Hint:='deprecated';
+  DoTestSum;
+  CheckHint(hDeprecated);
+end;
+
+procedure TTestResourcestringParser.TestSum1Platform;
+begin
+  Hint:='platform';
+  DoTestSum;
+  CheckHint(hplatform);
+end;
+
+initialization
+  RegisterTests([TTestConstParser,TTestResourcestringParser]);
+
+
+end.
+

+ 386 - 0
packages/fcl-passrc/tests/tcstatements.pas

@@ -0,0 +1,386 @@
+unit tcstatements;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils, pastree, pscanner, pparser,
+  tcbaseparser, testregistry;
+
+Type
+  { TTestStatementParser }
+
+  TTestStatementParser = Class(TTestParser)
+  private
+    FStatement: TPasImplBlock;
+    FVariables : TStrings;
+  Protected
+    Procedure SetUp; override;
+    Procedure TearDown; override;
+    procedure AddStatements(ASource : Array of string);
+    Procedure DeclareVar(Const AVarType : String; Const AVarName : String = 'A');
+    function TestStatement(ASource : string) : TPasImplElement;
+    function TestStatement(ASource : Array of string) : TPasImplElement;
+    Procedure ExpectParserError(Const Msg : string);
+    Procedure ExpectParserError(Const Msg : string; ASource : Array of string);
+    Function AssertStatement(Msg : String; AClass : TClass;AIndex : Integer = 0) : TPasImplBlock;
+    Property Statement: TPasImplBlock Read FStatement;
+  Published
+    Procedure TestEmpty;
+    Procedure TestEmptyStatement;
+    Procedure TestEmptyStatements;
+    Procedure TestBlock;
+    Procedure TestAssignment;
+    Procedure TestCall;
+    Procedure TestCallQualified;
+    Procedure TestCallQualified2;
+    Procedure TestCallNoArgs;
+    Procedure TestCallOneArg;
+    Procedure TestIf;
+    Procedure TestIfBlock;
+    Procedure TestIfAssignment;
+    Procedure TestIfElse;
+    Procedure TestIfElseBlock;
+    Procedure TestIfSemiColonElseError;
+    Procedure TestNestedIf;
+    Procedure TestNestedIfElse;
+  end;
+
+implementation
+{ TTestStatementParser }
+
+procedure TTestStatementParser.SetUp;
+begin
+  inherited SetUp;
+  FVariables:=TStringList.Create;
+end;
+
+procedure TTestStatementParser.TearDown;
+begin
+  FreeAndNil(FVariables);
+  inherited TearDown;
+end;
+
+procedure TTestStatementParser.AddStatements(ASource: array of string);
+
+Var
+  I :Integer;
+begin
+  StartProgram('afile');
+  if FVariables.Count>0 then
+    begin
+    Add('Var');
+    For I:=0 to FVariables.Count-1 do
+      Add('  '+Fvariables[I]);
+    end;
+  Add('begin');
+  For I:=Low(ASource) to High(ASource) do
+    Add('  '+ASource[i]);
+end;
+
+procedure TTestStatementParser.DeclareVar(const AVarType: String;
+  const AVarName: String);
+begin
+  FVariables.Add(AVarName+' : '+AVarType+';');
+end;
+
+function TTestStatementParser.TestStatement(ASource: string): TPasImplElement;
+begin
+  Result:=TestStatement([ASource]);
+end;
+
+function TTestStatementParser.TestStatement(ASource: array of string): TPasImplElement;
+
+Var
+  i : Integer;
+
+begin
+  FStatement:=Nil;
+  AddStatements(ASource);
+  ParseModule;
+  AssertEquals('Have program',TPasProgram,Module.ClassType);
+  AssertNotNull('Have program section',PasProgram.ProgramSection);
+  AssertNotNull('Have program section',PasProgram.InitializationSection);
+  if (PasProgram.InitializationSection.Elements.Count>0) then
+    if TObject(PasProgram.InitializationSection.Elements[0]) is TPasImplBlock then
+      FStatement:=TPasImplBlock(PasProgram.InitializationSection.Elements[0]);
+end;
+
+procedure TTestStatementParser.ExpectParserError(Const Msg : string);
+begin
+  AssertException(Msg,EParserError,@ParseModule);
+end;
+
+procedure TTestStatementParser.ExpectParserError(const Msg: string;
+  ASource: array of string);
+begin
+  AddStatements(ASource);
+  ExpectParserError(Msg);
+end;
+
+function TTestStatementParser.AssertStatement(Msg: String; AClass: TClass;
+  AIndex: Integer): TPasImplBlock;
+begin
+  if not (AIndex<PasProgram.InitializationSection.Elements.Count) then
+    Fail(Msg+': No such statement : '+intTostr(AIndex));
+  AssertNotNull(Msg+' Have statement',PasProgram.InitializationSection.Elements[AIndex]);
+  AssertEquals(Msg+' statement class',AClass,TObject(PasProgram.InitializationSection.Elements[AIndex]).ClassType);
+  Result:=TObject(PasProgram.InitializationSection.Elements[AIndex]) as TPasImplBlock;
+end;
+
+procedure TTestStatementParser.TestEmpty;
+begin
+  //TestStatement(';');
+  TestStatement('');
+  AssertEquals('No statements',0,PasProgram.InitializationSection.Elements.Count);
+end;
+
+procedure TTestStatementParser.TestEmptyStatement;
+begin
+  TestStatement(';');
+  AssertEquals('0 statement',0,PasProgram.InitializationSection.Elements.Count);
+end;
+
+procedure TTestStatementParser.TestEmptyStatements;
+begin
+  TestStatement(';;');
+  AssertEquals('0 statement',0,PasProgram.InitializationSection.Elements.Count);
+end;
+
+procedure TTestStatementParser.TestBlock;
+
+Var
+  B : TPasImplBeginBlock;
+
+begin
+  TestStatement(['begin','end']);
+  AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
+  AssertNotNull('Statement assigned',PasProgram.InitializationSection.Elements[0]);
+  AssertEquals('Block statement',TPasImplBeginBlock,Statement.ClassType);
+  B:= Statement as TPasImplBeginBlock;
+  AssertEquals('Empty block',0,B.Elements.Count);
+end;
+
+procedure TTestStatementParser.TestAssignment;
+
+Var
+  A : TPasImplAssign;
+
+begin
+  DeclareVar('integer');
+  TestStatement(['a:=1;']);
+  AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
+  AssertEquals('Assignment statement',TPasImplAssign,Statement.ClassType);
+  A:=Statement as TPasImplAssign;
+  AssertExpression('Right side is constant',A.Right,pekNumber,'1');
+  AssertExpression('Left side is variable',A.Left,pekIdent,'a');
+end;
+
+procedure TTestStatementParser.TestCall;
+
+Var
+  S : TPasImplSimple;
+
+begin
+  TestStatement('Doit;');
+  AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
+  AssertEquals('Simple statement',TPasImplSimple,Statement.ClassType);
+  S:=Statement as TPasImplSimple;
+  AssertExpression('Doit call',S.Expr,pekIdent,'Doit');
+end;
+
+procedure TTestStatementParser.TestCallQualified;
+
+Var
+  S : TPasImplSimple;
+  B : TBinaryExpr;
+
+begin
+  TestStatement('Unita.Doit;');
+  AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
+  AssertEquals('Simple statement',TPasImplSimple,Statement.ClassType);
+  S:=Statement as TPasImplSimple;
+  AssertExpression('Doit call',S.Expr,pekBinary,TBinaryExpr);
+  B:=S.Expr as TBinaryExpr;
+  AssertExpression('Unit name',B.Left,pekIdent,'Unita');
+  AssertExpression('Doit call',B.Right,pekIdent,'Doit');
+
+end;
+
+procedure TTestStatementParser.TestCallQualified2;
+Var
+  S : TPasImplSimple;
+  B : TBinaryExpr;
+
+begin
+  TestStatement('Unita.ClassB.Doit;');
+  AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
+  AssertEquals('Simple statement',TPasImplSimple,Statement.ClassType);
+  S:=Statement as TPasImplSimple;
+  AssertExpression('Doit call',S.Expr,pekBinary,TBinaryExpr);
+  B:=S.Expr as TBinaryExpr;
+  AssertExpression('Unit name',B.Left,pekIdent,'Unita');
+  AssertExpression('Doit call',B.Right,pekBinary,TBinaryExpr);
+  B:=B.Right  as TBinaryExpr;
+  AssertExpression('Unit name',B.Left,pekIdent,'ClassB');
+  AssertExpression('Doit call',B.Right,pekIdent,'Doit');
+end;
+
+procedure TTestStatementParser.TestCallNoArgs;
+
+Var
+  S : TPasImplSimple;
+  P : TParamsExpr;
+
+begin
+  TestStatement('Doit();');
+  AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
+  AssertEquals('Simple statement',TPasImplSimple,Statement.ClassType);
+  S:=Statement as TPasImplSimple;
+  AssertExpression('Doit call',S.Expr,pekFuncParams,TParamsExpr);
+  P:=S.Expr as TParamsExpr;
+  AssertExpression('Correct function call name',P.Value,pekIdent,'Doit');
+  AssertEquals('No params',0,Length(P.Params));
+end;
+
+procedure TTestStatementParser.TestCallOneArg;
+Var
+  S : TPasImplSimple;
+  P : TParamsExpr;
+
+begin
+  TestStatement('Doit(1);');
+  AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
+  AssertEquals('Simple statement',TPasImplSimple,Statement.ClassType);
+  S:=Statement as TPasImplSimple;
+  AssertExpression('Doit call',S.Expr,pekFuncParams,TParamsExpr);
+  P:=S.Expr as TParamsExpr;
+  AssertExpression('Correct function call name',P.Value,pekIdent,'Doit');
+  AssertEquals('One param',1,Length(P.Params));
+  AssertExpression('Parameter is constant',P.Params[0],pekNumber,'1');
+end;
+
+procedure TTestStatementParser.TestIf;
+
+Var
+  I : TPasImplIfElse;
+
+begin
+  DeclareVar('boolean');
+  TestStatement(['if a then',';']);
+  I:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
+  AssertExpression('IF condition',I.ConditionExpr,pekIdent,'a');
+  AssertNull('No else',i.ElseBranch);
+  AssertNull('No if branch',I.IfBranch);
+end;
+
+procedure TTestStatementParser.TestIfBlock;
+
+Var
+  I : TPasImplIfElse;
+
+begin
+  DeclareVar('boolean');
+  TestStatement(['if a then','  begin','  end']);
+  I:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
+  AssertExpression('IF condition',I.ConditionExpr,pekIdent,'a');
+  AssertNull('No else',i.ElseBranch);
+  AssertNotNull('if branch',I.IfBranch);
+  AssertEquals('begin end block',TPasImplBeginBlock,I.ifBranch.ClassType);
+end;
+
+procedure TTestStatementParser.TestIfAssignment;
+
+Var
+  I : TPasImplIfElse;
+
+begin
+  DeclareVar('boolean');
+  TestStatement(['if a then','  a:=False;']);
+  I:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
+  AssertExpression('IF condition',I.ConditionExpr,pekIdent,'a');
+  AssertNull('No else',i.ElseBranch);
+  AssertNotNull('if branch',I.IfBranch);
+  AssertEquals('assignment statement',TPasImplAssign,I.ifBranch.ClassType);
+end;
+
+procedure TTestStatementParser.TestIfElse;
+
+Var
+  I : TPasImplIfElse;
+
+begin
+  DeclareVar('boolean');
+  TestStatement(['if a then','  begin','  end','else',';']);
+  I:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
+  AssertExpression('IF condition',I.ConditionExpr,pekIdent,'a');
+  AssertNull('No else',i.ElseBranch);
+  AssertNotNull('if branch',I.IfBranch);
+  AssertEquals('begin end block',TPasImplBeginBlock,I.ifBranch.ClassType);
+end;
+
+procedure TTestStatementParser.TestIfElseBlock;
+Var
+  I : TPasImplIfElse;
+
+begin
+  DeclareVar('boolean');
+  TestStatement(['if a then','  begin','  end','else','  begin','  end']);
+  I:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
+  AssertExpression('IF condition',I.ConditionExpr,pekIdent,'a');
+  AssertNotNull('if branch',I.IfBranch);
+  AssertEquals('begin end block',TPasImplBeginBlock,I.ifBranch.ClassType);
+  AssertNotNull('Else branch',i.ElseBranch);
+  AssertEquals('begin end block',TPasImplBeginBlock,I.ElseBranch.ClassType);
+end;
+
+procedure TTestStatementParser.TestIfSemiColonElseError;
+
+Var
+  I : TPasImplIfElse;
+
+begin
+  DeclareVar('boolean');
+  ExpectParserError('No semicolon before else',['if a then','  begin','  end;','else','  begin','  end']);
+end;
+
+procedure TTestStatementParser.TestNestedIf;
+Var
+  I,I2 : TPasImplIfElse;
+begin
+  DeclareVar('boolean');
+  DeclareVar('boolean','b');
+  TestStatement(['if a then','  if b then','    begin','    end','else','  begin','  end']);
+  I:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
+  AssertExpression('IF condition',I.ConditionExpr,pekIdent,'a');
+  AssertNotNull('if branch',I.IfBranch);
+  AssertNull('Else branch',i.ElseBranch);
+  AssertEquals('if in if branch',TPasImplIfElse,I.ifBranch.ClassType);
+  I:=I.Ifbranch as TPasImplIfElse;
+  AssertEquals('begin end block',TPasImplBeginBlock,I.ElseBranch.ClassType);
+
+end;
+
+procedure TTestStatementParser.TestNestedIfElse;
+Var
+  I,I2 : TPasImplIfElse;
+begin
+  DeclareVar('boolean');
+  DeclareVar('boolean','b');
+  TestStatement(['if a then','  if b then','    begin','    end','  else','    begin','    end','else','  begin','end']);
+  I:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
+  AssertExpression('IF condition',I.ConditionExpr,pekIdent,'a');
+  AssertNotNull('if branch',I.IfBranch);
+  AssertNotNull('Else branch',i.ElseBranch);
+  AssertEquals('begin end block',TPasImplBeginBlock,I.ElseBranch.ClassType);
+  AssertEquals('if in if branch',TPasImplIfElse,I.ifBranch.ClassType);
+  I:=I.Ifbranch as TPasImplIfElse;
+  AssertEquals('begin end block',TPasImplBeginBlock,I.ElseBranch.ClassType);
+end;
+
+initialization
+  RegisterTests([TTestStatementParser]);
+
+end.
+

+ 2824 - 0
packages/fcl-passrc/tests/tctypeparser.pas

@@ -0,0 +1,2824 @@
+unit tctypeparser;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils, pastree, pscanner, pparser,
+  tcbaseparser, testregistry;
+
+type
+  { TBaseTestTypeParser }
+
+  TBaseTestTypeParser= Class(TTestParser)
+  private
+    FType : TPasType;
+    FHint : string;
+    FErrorSource : String;
+  Protected
+    Function ParseType(ASource : String; ATypeClass : TClass;Const AHint : String = '') : TPasType; virtual; overload;
+    Procedure AssertParseTypeError(ASource : String);
+    Property TheType : TPasType Read FType;
+    Property Hint : string Read FHint Write FHint;
+    procedure SetUp; override;
+    Procedure TearDown; override;
+  end;
+
+  { TTestTypeParser }
+
+  TTestTypeParser = Class(TBaseTestTypeParser)
+  private
+  Protected
+    Procedure DoTestAliasType(Const AnAliasType : String; Const AHint : String);
+    procedure DoTestStringType(const AnAliasType: String; const AHint: String);
+    procedure DoTypeError(Const AMsg,ASource : string);
+    Procedure DoParseError;
+    Procedure DoParsePointer(Const ASource : String; Const AHint : String; ADestType : TClass = Nil);
+    Procedure DoParseArray(Const ASource : String; Const AHint : String; ADestType : TClass = Nil);
+    Procedure DoParseEnumerated(Const ASource : String; Const AHint : String; ACount : integer);
+    Procedure DoTestFileType(Const AType : String; Const AHint : String; ADestType : TClass = Nil);
+    Procedure DoTestRangeType(Const AStart,AStop,AHint : String);
+    Procedure DoParseSimpleSet(Const ASource : String; Const AHint : String);
+    Procedure DoParseComplexSet(Const ASource : String; Const AHint : String);
+    procedure DoParseRangeSet(const ASource: String; const AHint: String);
+    Procedure DoTestComplexSet;
+    Procedure DoTestClassOf(Const AHint : string);
+  Published
+    Procedure TestAliasType;
+    Procedure TestCrossUnitAliasType;
+    Procedure TestAliasTypeDeprecated;
+    Procedure TestAliasTypePlatform;
+    Procedure TestSimpleTypeByte;
+    Procedure TestSimpleTypeByteDeprecated;
+    Procedure TestSimpleTypeBytePlatform;
+    Procedure TestSimpleTypeBoolean;
+    Procedure TestSimpleTypeBooleanDeprecated;
+    Procedure TestSimpleTypeBooleanPlatform;
+    Procedure TestSimpleTypeChar;
+    Procedure TestSimpleTypeCharDeprecated;
+    Procedure TestSimpleTypeCharPlatform;
+    Procedure TestSimpleTypeInteger;
+    Procedure TestSimpleTypeIntegerDeprecated;
+    Procedure TestSimpleTypeIntegerPlatform;
+    Procedure TestSimpleTypeInt64;
+    Procedure TestSimpleTypeInt64Deprecated;
+    Procedure TestSimpleTypeInt64Platform;
+    Procedure TestSimpleTypeLongInt;
+    Procedure TestSimpleTypeLongIntDeprecated;
+    Procedure TestSimpleTypeLongIntPlatform;
+    Procedure TestSimpleTypeLongWord;
+    Procedure TestSimpleTypeLongWordDeprecated;
+    Procedure TestSimpleTypeLongWordPlatform;
+    Procedure TestSimpleTypeDouble;
+    Procedure TestSimpleTypeDoubleDeprecated;
+    Procedure TestSimpleTypeDoublePlatform;
+    Procedure TestSimpleTypeShortInt;
+    Procedure TestSimpleTypeShortIntDeprecated;
+    Procedure TestSimpleTypeShortIntPlatform;
+    Procedure TestSimpleTypeSmallInt;
+    Procedure TestSimpleTypeSmallIntDeprecated;
+    Procedure TestSimpleTypeSmallIntPlatform;
+    Procedure TestSimpleTypeString;
+    Procedure TestSimpleTypeStringDeprecated;
+    Procedure TestSimpleTypeStringPlatform;
+    Procedure TestSimpleTypeStringSize;
+    Procedure TestSimpleTypeStringSizeIncomplete;
+    Procedure TestSimpleTypeStringSizeWrong;
+    Procedure TestSimpleTypeStringSizeDeprecated;
+    Procedure TestSimpleTypeStringSizePlatform;
+    Procedure TestSimpleTypeWord;
+    Procedure TestSimpleTypeWordDeprecated;
+    Procedure TestSimpleTypeWordPlatform;
+    Procedure TestSimpleTypeQWord;
+    Procedure TestSimpleTypeQWordDeprecated;
+    Procedure TestSimpleTypeQWordPlatform;
+    Procedure TestSimpleTypeCardinal;
+    Procedure TestSimpleTypeCardinalDeprecated;
+    Procedure TestSimpleTypeCardinalPlatform;
+    Procedure TestSimpleTypeWideChar;
+    Procedure TestSimpleTypeWideCharDeprecated;
+    Procedure TestSimpleTypeWideCharPlatform;
+    Procedure TestPointerSimple;
+    procedure TestPointerSimpleDeprecated;
+    procedure TestPointerSimplePlatform;
+    Procedure TestStaticArray;
+    procedure TestStaticArrayDeprecated;
+    procedure TestStaticArrayPlatform;
+    Procedure TestStaticArrayPacked;
+    Procedure TestStaticArrayTypedIndex;
+    Procedure TestDynamicArray;
+    Procedure TestSimpleEnumerated;
+    Procedure TestSimpleEnumeratedDeprecated;
+    Procedure TestSimpleEnumeratedPlatform;
+    Procedure TestAssignedEnumerated;
+    Procedure TestAssignedEnumeratedDeprecated;
+    Procedure TestAssignedEnumeratedPlatform;
+    Procedure TestFileType;
+    Procedure TestFileTypeDeprecated;
+    Procedure TestFileTypePlatform;
+    Procedure TestRangeType;
+    Procedure TestRangeTypeDeprecated;
+    Procedure TestRangeTypePlatform;
+    Procedure TestIdentifierRangeType;
+    Procedure TestIdentifierRangeTypeDeprecated;
+    Procedure TestIdentifierRangeTypePlatform;
+    Procedure TestNegativeIdentifierRangeType;
+    Procedure TestSimpleSet;
+    Procedure TestSimpleSetDeprecated;
+    Procedure TestSimpleSetPlatform;
+    Procedure TestComplexSet;
+    Procedure TestComplexSetDeprecated;
+    Procedure TestComplexSetPlatform;
+    Procedure TestRangeSet;
+    Procedure TestRangeSetDeprecated;
+    Procedure TestRangeSetPlatform;
+    Procedure TestClassOf;
+    Procedure TestClassOfDeprecated;
+    Procedure TestClassOfPlatform;
+    Procedure TestReferenceAlias;
+    Procedure TestReferenceSet;
+    Procedure TestReferenceClassOf;
+    Procedure TestReferenceFile;
+    Procedure TestReferenceArray;
+    Procedure TestReferencePointer;
+  end;
+
+  { TTestRecordTypeParser }
+
+  TTestRecordTypeParser= Class(TBaseTestTypeParser)
+  private
+    Function GetField(AIndex : Integer; R : TPasRecordType) : TPasVariable;
+    Function GetField(AIndex : Integer; R : TPasVariant) : TPasVariable;
+    function GetF(AIndex: Integer): TPasVariable;
+    function GetR: TPasRecordType;
+    Function GetVariant(AIndex : Integer; R : TPasRecordType) : TPasVariant;
+    function GetV(AIndex: Integer): TPasVariant;
+  Protected
+    Procedure TestFields(Const Fields : Array of string; AHint : String; HaveVariant : Boolean = False);
+    procedure AssertVariantSelector(AName, AType: string);
+    procedure AssertField1(Hints: TPasMemberHints);
+    procedure AssertField2(Hints: TPasMemberHints);
+    procedure AssertVariant1(Hints: TPasMemberHints);
+    procedure AssertVariant1(Hints: TPasMemberHints; VariantLabels : Array of string);
+    procedure AssertVariant2(Hints: TPasMemberHints);
+    procedure AssertVariant2(Hints: TPasMemberHints; VariantLabels : Array of string);
+    procedure AssertOneIntegerField(Hints: TPasMemberHints);
+    procedure AssertTwoIntegerFields(Hints1, Hints2: TPasMemberHints);
+    procedure AssertRecordField(AIndex: Integer;Hints: TPasMemberHints);
+    procedure AssertRecordVariant(AIndex: Integer;Hints: TPasMemberHints; VariantLabels : Array of string);
+    Procedure AssertRecordVariantVariant(AIndex: Integer;Const AFieldName,ATypeName: string;Hints: TPasMemberHints; VariantLabels : Array of string);
+    Procedure DoTestEmpty(Const AHint : String);
+    procedure DoTestDeprecatedVariantNoStorage(Const AHint : string);
+    procedure DoTestDeprecatedVariantStorage(Const AHint : string);
+    procedure DoTestVariantNoStorage(Const AHint : string);
+    procedure DoTestVariantStorage(Const AHint : string);
+    procedure DoTestTwoVariantsNoStorage(Const AHint : string);
+    procedure DoTestTwoVariantsStorage(Const AHint : string);
+    procedure DoTestTwoVariantsFirstDeprecatedStorage(Const AHint : string);
+    procedure DoTestTwoVariantsSecondDeprecatedStorage(Const AHint : string);
+    Procedure DoTestVariantTwoLabels(Const AHint : string);
+    Procedure DoTestTwoVariantsTwoLabels(Const AHint : string);
+    procedure DoTestVariantNestedRecord(Const AHint : string);
+    procedure DoTestVariantNestedVariant(Const AHint : string);
+    procedure DoTestVariantNestedVariantFirstDeprecated(Const AHint : string);
+    procedure DoTestVariantNestedVariantSecondDeprecated(const AHint: string);
+    procedure DoTestVariantNestedVariantBothDeprecated(const AHint: string);
+    Property TheRecord : TPasRecordType Read GetR;
+    Property Field1 : TPasVariable Index 0 Read GetF;
+    Property Field2 : TPasVariable Index 1 Read GetF;
+    Property Variant1 : TPasVariant Index 0 Read GetV;
+    Property Variant2 : TPasVariant Index 1 Read GetV;
+  Published
+    Procedure TestEmpty;
+    Procedure TestEmptyDeprecated;
+    Procedure TestEmptyPlatform;
+    Procedure TestOneField;
+    Procedure TestOneFieldDeprecated;
+    Procedure TestOneFieldPlatform;
+    Procedure TestOneFieldSemicolon;
+    Procedure TestOneFieldSemicolonDeprecated;
+    Procedure TestOneFieldSemicolonPlatform;
+    Procedure TestOneDeprecatedField;
+    Procedure TestOneDeprecatedFieldDeprecated;
+    Procedure TestOneDeprecatedFieldPlatform;
+    Procedure TestOnePlatformField;
+    Procedure TestOnePlatformFieldDeprecated;
+    Procedure TestOnePlatformFieldPlatform;
+    Procedure TestTwoFields;
+    Procedure TestTwoFieldDeprecated;
+    Procedure TestTwoFieldPlatform;
+    Procedure TestTwoFieldsFirstDeprecated;
+    Procedure TestTwoFieldsFirstDeprecatedDeprecated;
+    Procedure TestTwoFieldsFirstDeprecatedPlatform;
+    Procedure TestTwoFieldsSecondDeprecated;
+    Procedure TestTwoFieldsSecondDeprecatedDeprecated;
+    Procedure TestTwoFieldsSecondDeprecatedPlatform;
+    Procedure TestTwoFieldsBothDeprecated;
+    Procedure TestTwoFieldsBothDeprecatedDeprecated;
+    Procedure TestTwoFieldsBothDeprecatedPlatform;
+    Procedure TestTwoFieldsCombined;
+    Procedure TestTwoFieldsCombinedDeprecated;
+    Procedure TestTwoFieldsCombinedPlatform;
+    Procedure TestTwoDeprecatedFieldsCombined;
+    Procedure TestTwoDeprecatedFieldsCombinedDeprecated;
+    Procedure TestTwoDeprecatedFieldsCombinedPlatform;
+    Procedure TestNested;
+    Procedure TestNestedDeprecated;
+    Procedure TestNestedPlatform;
+    procedure TestNestedSemicolon;
+    procedure TestNestedSemicolonDeprecated;
+    procedure TestNestedSemicolonPlatform;
+    procedure TestNestedFirst;
+    procedure TestNestedFirstDeprecated;
+    procedure TestNestedFirstPlatform;
+    Procedure TestDeprecatedNested;
+    Procedure TestDeprecatedNestedDeprecated;
+    Procedure TestDeprecatedNestedPlatform;
+    procedure TestDeprecatedNestedFirst;
+    procedure TestDeprecatedNestedFirstDeprecated;
+    procedure TestDeprecatedNestedFirstPlatform;
+    Procedure TestVariantNoStorage;
+    procedure TestVariantNoStorageDeprecated;
+    procedure TestVariantNoStoragePlatform;
+    Procedure TestVariantStorage;
+    procedure TestVariantStorageDeprecated;
+    procedure TestVariantStoragePlatform;
+    Procedure TestDeprecatedVariantNoStorage;
+    procedure TestDeprecatedVariantNoStorageDeprecated;
+    procedure TestDeprecatedVariantNoStoragePlatform;
+    Procedure TestDeprecatedVariantStorage;
+    procedure TestDeprecatedVariantStorageDeprecated;
+    procedure TestDeprecatedVariantStoragePlatform;
+    Procedure TestTwoVariantsNoStorage;
+    procedure TestTwoVariantsNoStorageDeprecated;
+    procedure TestTwoVariantsNoStoragePlatform;
+    Procedure TestTwoVariantsStorage;
+    procedure TestTwoVariantsStorageDeprecated;
+    procedure TestTwoVariantsStoragePlatform;
+    Procedure TestTwoVariantsFirstDeprecatedStorage;
+    procedure TestTwoVariantsFirstDeprecatedStorageDeprecated;
+    procedure TestTwoVariantsFirstDeprecatedStoragePlatform;
+    Procedure TestTwoVariantsSecondDeprecatedStorage;
+    procedure TestTwoVariantsSecondDeprecatedStorageDeprecated;
+    procedure TestTwoVariantsSecondDeprecatedStoragePlatform;
+    Procedure TestVariantTwoLabels;
+    Procedure TestVariantTwoLabelsDeprecated;
+    Procedure TestVariantTwoLabelsPlatform;
+    Procedure TestTwoVariantsTwoLabels;
+    Procedure TestTwoVariantsTwoLabelsDeprecated;
+    Procedure TestTwoVariantsTwoLabelsPlatform;
+    Procedure TestVariantNestedRecord;
+    Procedure TestVariantNestedRecordDeprecated;
+    Procedure TestVariantNestedRecordPlatform;
+    Procedure TestVariantNestedVariant;
+    Procedure TestVariantNestedVariantDeprecated;
+    Procedure TestVariantNestedVariantPlatForm;
+    Procedure TestVariantNestedVariantFirstDeprecated;
+    Procedure TestVariantNestedVariantFirstDeprecatedDeprecated;
+    Procedure TestVariantNestedVariantFirstDeprecatedPlatform;
+    Procedure TestVariantNestedVariantSecondDeprecated;
+    Procedure TestVariantNestedVariantSecondDeprecatedDeprecated;
+    Procedure TestVariantNestedVariantSecondDeprecatedPlatform;
+    Procedure TestVariantNestedVariantBothDeprecated;
+    Procedure TestVariantNestedVariantBothDeprecatedDeprecated;
+    Procedure TestVariantNestedVariantBothDeprecatedPlatform;
+  end;
+
+  { TTestProcedureTypeParser }
+  TCallingConventionTest = Procedure (CC : TCallingConvention;Const AHint : String) of object;
+
+  TTestProcedureTypeParser = Class(TBaseTestTypeParser)
+  Private
+    FProc : TPasProcedureType;
+    procedure CheckArrayOfConstArgument(Aindex: Integer; Ac: TArgumentAccess);
+  Protected
+    procedure DoTestFunction(CC: TCallingConvention; const AHint: String);
+    procedure DoTestFunctionOfObject(CC: TCallingConvention; const AHint: String);
+    procedure DoTestFunctionOneArg(CC: TCallingConvention; const AHint: String);
+    procedure DoTestFunctionOneArgOfObject(CC: TCallingConvention; const AHint: String);
+    procedure DoTestProcedureOfObject(CC: TCallingConvention; const AHint: String);
+    procedure DoTestProcedureOfObjectOneArg(CC: TCallingConvention; const AHint: String);
+    procedure DoTestProcedureIsNested(CC: TCallingConvention; const AHint: String);
+    procedure DoTestProcedureIsNestedOneArg(CC: TCallingConvention; const AHint: String);
+    procedure CheckOpenArrayArgument(Ac: TArgumentAccess);
+    procedure DoTestProcedureArrayOfConst(CC: TCallingConvention; const AHint: String);
+    procedure DoTestProcedureOpenArray(CC: TCallingConvention; const AHint: String);
+    procedure DoTestProcedureConstOpenArray(CC: TCallingConvention; const AHint: String);
+    procedure DoTestProcedureVarOpenArray(CC: TCallingConvention; const AHint: String);
+    procedure DoTestProcedureOutOpenArray(CC: TCallingConvention; const AHint: String);
+    procedure DoTestProcedureOneArgDefault(CC: TCallingConvention;const AHint: String);
+    procedure DoTestProcedureOneArgDefaultExpr(CC: TCallingConvention;const AHint: String);
+    procedure DoTestProcedureOneArgDefaultSet(CC: TCallingConvention;const AHint: String);
+    procedure DoTestProcedureOneConstArgDefault(CC: TCallingConvention; const AHint: String);
+    procedure DoTestProcedureOneVarArgDefault(CC: TCallingConvention; const AHint: String);
+    procedure DoTestProcedureOneOutArgDefault(CC: TCallingConvention; const AHint: String);
+    function CheckArgument(AIndex : Integer; Const AName,ATypeName : String; AAccess : TArgumentAccess) : TPasArgument;
+    Function ParseType(ASource : String; CC : TCallingConvention; ATypeClass : TClass;Const AHint : String = '') : TPasProcedureType; virtual; overload;
+    Procedure DoTestProcedureDecl(CC : TCallingConvention; Const AHint : String);
+    Procedure DoTestProcedureOneArgDecl(CC : TCallingConvention; Const AHint : String);
+    Procedure DoTestProcedureOneVarArgDecl(CC : TCallingConvention; Const AHint : String);
+    Procedure DoTestProcedureOneConstArgDecl(CC : TCallingConvention; Const AHint : String);
+    Procedure DoTestProcedureOneOutArgDecl(CC : TCallingConvention; Const AHint : String);
+    Procedure DoTestProcedureTwoArgsDecl(CC : TCallingConvention; Const AHint : String);
+    Procedure DoTestProcedureTwoVarArgsDecl(CC : TCallingConvention; Const AHint : String);
+    Procedure DoTestProcedureTwoConstArgsDecl(CC : TCallingConvention; Const AHint : String);
+    Procedure DoTestProcedureTwoOutArgsDecl(CC : TCallingConvention; Const AHint : String);
+    Procedure DoTestProcedureTwoCombinedArgsDecl(CC : TCallingConvention; Const AHint : String);
+    Procedure DoTestProcedureTwoCombinedVarArgsDecl(CC : TCallingConvention; Const AHint : String);
+    Procedure DoTestProcedureTwoCombinedConstArgsDecl(CC : TCallingConvention; Const AHint : String);
+    Procedure DoTestProcedureTwoCombinedOutArgsDecl(CC : TCallingConvention; Const AHint : String);
+    Procedure DoTestProcedureDefaultConstArgsDecl(CC : TCallingConvention; Const AHint : String);
+    procedure DoTestProcedureUntypedArgDecl(CC: TCallingConvention; const AHint: String);
+    procedure DoTestProcedureUntypedConstArgDecl(CC: TCallingConvention; const AHint: String);
+    procedure DoTestProcedureUntypedOutArgDecl(CC: TCallingConvention; const AHint: String);
+    procedure DoTestProcedureUntypedDefArg;
+    Procedure TestCallingConventions(Proc : TCallingConventionTest; Const AHint : String);
+    Procedure TestCallingConventions(Proc : TCallingConventionTest);
+    Function FuncProc : TPasFunctionType;
+    Property Proc : TPasProcedureType Read FProc;
+  Published
+    Procedure TestProcedure;
+    Procedure TestProcedureOneArg;
+    Procedure TestProcedureOneVarArg;
+    Procedure TestProcedureOneConstArg;
+    Procedure TestProcedureOneOutArg;
+    Procedure TestProcedureTwoArgs;
+    Procedure TestProcedureTwoVarArgs;
+    Procedure TestProcedureTwoConstArgs;
+    Procedure TestProcedureTwoOutArgs;
+    Procedure TestProcedureTwoCombinedArgs;
+    Procedure TestProcedureTwoCombinedVarArgs;
+    Procedure TestProcedureTwoCombinedConstArgs;
+    Procedure TestProcedureTwoCombinedOutArgs;
+    Procedure TestProcedureDefaultConstArgs;
+    Procedure TestProcedureUntypedArg;
+    Procedure TestProcedureUntypedConstArg;
+    Procedure TestProcedureUntypedOutArg;
+    Procedure TestProcedureUntypedDefArg;
+    Procedure TestProcedureOneArgDefault;
+    Procedure TestProcedureOneArgDefaultExpr;
+    Procedure TestProcedureOneArgDefaultSet;
+    Procedure TestProcedureOneVarArgDefault;
+    Procedure TestProcedureOneConstArgDefault;
+    Procedure TestProcedureOneOutArgDefault;
+    Procedure TestProcedureNoMultiArgDefaults;
+    Procedure TestProcedureOpenArray;
+    Procedure TestProcedureConstOpenArray;
+    Procedure TestProcedureOutOpenArray;
+    Procedure TestProcedureVarOpenArray;
+    Procedure TestProcedureArrayOfConst;
+    Procedure TestProcedureOfObject;
+    Procedure TestProcedureOfObjectOneArg;
+    Procedure TestProcedureIsNested;
+    Procedure TestProcedureIsNesteOneArg;
+    Procedure TestFunction;
+    Procedure TestFunctionOneArg;
+    Procedure TestFunctionOfObject;
+    Procedure TestFunctionOneArgOfObject;
+  end;
+
+
+
+implementation
+
+uses typinfo;
+
+
+
+{ TTestProcedureTypeParser }
+
+procedure TTestProcedureTypeParser.DoTestProcedureUntypedArgDecl(
+  CC: TCallingConvention; const AHint: String);
+
+Var
+  A : TPasArgument;
+
+begin
+  ParseType('procedure(var A)',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',1,Proc.Args.Count);
+  A:=CheckArgument(0,'A','',argVar);
+  AssertNull('No argument type', A.ArgType)
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureUntypedConstArgDecl(
+  CC: TCallingConvention; const AHint: String);
+
+Var
+  A : TPasArgument;
+
+begin
+  ParseType('procedure(const A)',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',1,Proc.Args.Count);
+  A:=CheckArgument(0,'A','',argConst);
+  AssertNull('No argument type', A.ArgType)
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureUntypedOutArgDecl(
+  CC: TCallingConvention; const AHint: String);
+Var
+  A : TPasArgument;
+
+begin
+  ParseType('procedure(out A)',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',1,Proc.Args.Count);
+  A:=CheckArgument(0,'A','',argOut);
+  AssertNull('No argument type', A.ArgType)
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureUntypedDefArg;
+begin
+  ParseType('procedure(A)',ccdefault,TPasProcedureType,'');
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureOneVarArgDefault(
+  CC: TCallingConvention; const AHint: String);
+Var
+  A : TPasArgument;
+
+begin
+  ParseType('procedure(var A : Integer = 1)',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',1,Proc.Args.Count);
+  A:=CheckArgument(0,'A','Integer',argVar);
+  AssertNotNull('have default argument type', A.Value);
+  AssertEquals('argument expr type', TPrimitiveExpr, A.ValueExpr.ClassType);
+  AssertEquals('argument expr type', '1', TPrimitiveExpr(A.ValueExpr).Value);
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureOneOutArgDefault(
+  CC: TCallingConvention; const AHint: String);
+Var
+  A : TPasArgument;
+
+begin
+  ParseType('procedure(out A : Integer = 1)',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',1,Proc.Args.Count);
+  A:=CheckArgument(0,'A','Integer',argOut);
+  AssertNotNull('have default argument type', A.Value);
+  AssertEquals('argument expr type', TPrimitiveExpr, A.ValueExpr.ClassType);
+  AssertEquals('argument expr type', '1', TPrimitiveExpr(A.ValueExpr).Value);
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureOneConstArgDefault(
+  CC: TCallingConvention; const AHint: String);
+Var
+  A : TPasArgument;
+
+begin
+  ParseType('procedure(const A : Integer = 1)',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',1,Proc.Args.Count);
+  A:=CheckArgument(0,'A','Integer',argConst);
+  AssertNotNull('have default argument type', A.Value);
+  AssertEquals('argument expr type', TPrimitiveExpr, A.ValueExpr.ClassType);
+  AssertEquals('argument expr type', '1', TPrimitiveExpr(A.ValueExpr).Value);
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureArrayOfConst(
+  CC: TCallingConvention; const AHint: String);
+Var
+  A : TPasArgument;
+
+begin
+  ParseType('procedure(A : Array of const)',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',1,Proc.Args.Count);
+  CheckArrayOfConstArgument(0,argDefault);
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureOfObject(
+  CC: TCallingConvention; const AHint: String);
+begin
+  ParseType('procedure of Object',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',0,Proc.Args.Count);
+  AssertEquals('Is OF Object',True,Proc.IsOfObject);
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureOfObjectOneArg(
+  CC: TCallingConvention; const AHint: String);
+begin
+  ParseType('procedure (A : integer)of Object',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',1,Proc.Args.Count);
+  AssertEquals('Is OF Object',True,Proc.IsOfObject);
+  CheckArgument(0,'A','Integer',argDefault);
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureIsNested(
+  CC: TCallingConvention; const AHint: String);
+begin
+  ParseType('procedure is nested',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',0,Proc.Args.Count);
+  AssertEquals('Is nested',True,Proc.IsNested);
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureIsNestedOneArg(
+  CC: TCallingConvention; const AHint: String);
+begin
+  ParseType('procedure (A : integer) is nested',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',1,Proc.Args.Count);
+  AssertEquals('Is nested',True,Proc.IsNested);
+  CheckArgument(0,'A','Integer',argDefault);
+end;
+
+
+procedure TTestProcedureTypeParser.CheckArrayOfConstArgument(Aindex : Integer; Ac : TArgumentAccess);
+Var
+  A : TPasArgument;
+  T : TPasArrayType;
+
+begin
+  A:=CheckArgument(Aindex,'A','',ac);
+  AssertEquals('ArrayType',TPasArrayType,A.ArgType.ClassType);
+  T:=A.ArgType as TPasArrayType;
+  AssertNull('Have Element type',T.ElType);
+end;
+
+procedure TTestProcedureTypeParser.DoTestFunction(CC: TCallingConvention;
+  const AHint: String);
+begin
+  ParseType('function : integer',CC,TPasFunctionType,AHint);
+  AssertEquals('Argument count',0,Proc.Args.Count);
+  AssertEquals('Is OF Object',False,Proc.IsOfObject);
+  AssertNotNull('Have result',FuncProc.ResultEl);
+  AssertEquals('Result type class',TPasResultElement,FuncProc.ResultEl.ClassType);
+  AssertNotNull('Have result',FuncProc.ResultEl.ResultType);
+  AssertEquals('Result type element class ',TPasUnresolvedTypeRef,FuncProc.ResultEl.ResultType.ClassType);
+  AssertEquals('Result type element name','Integer',FuncProc.ResultEl.ResultType.Name);
+end;
+
+procedure TTestProcedureTypeParser.DoTestFunctionOfObject(CC: TCallingConvention;
+  const AHint: String);
+begin
+  ParseType('function : integer of object',CC,TPasFunctionType,AHint);
+  AssertEquals('Argument count',0,Proc.Args.Count);
+  AssertEquals('Is OF Object',True,Proc.IsOfObject);
+  AssertNotNull('Have result',FuncProc.ResultEl);
+  AssertEquals('Result type class',TPasResultElement,FuncProc.ResultEl.ClassType);
+  AssertNotNull('Have result',FuncProc.ResultEl.ResultType);
+  AssertEquals('Result type element class ',TPasUnresolvedTypeRef,FuncProc.ResultEl.ResultType.ClassType);
+  AssertEquals('Result type element name','Integer',FuncProc.ResultEl.ResultType.Name);
+end;
+
+procedure TTestProcedureTypeParser.DoTestFunctionOneArg(CC: TCallingConvention;
+  const AHint: String);
+begin
+  ParseType('function (A : Integer) : Integer',CC,TPasFunctionType,AHint);
+  AssertEquals('Argument count',1,Proc.Args.Count);
+  CheckArgument(0,'A','Integer',argDefault);
+  AssertNotNull('Have result',FuncProc.ResultEl);
+  AssertEquals('Result type class',TPasResultElement,FuncProc.ResultEl.ClassType);
+  AssertNotNull('Have result',FuncProc.ResultEl.ResultType);
+  AssertEquals('Result type element class ',TPasUnresolvedTypeRef,FuncProc.ResultEl.ResultType.ClassType);
+  AssertEquals('Result type element name','Integer',FuncProc.ResultEl.ResultType.Name);
+end;
+
+procedure TTestProcedureTypeParser.DoTestFunctionOneArgOfObject(
+  CC: TCallingConvention; const AHint: String);
+begin
+  ParseType('function (A : Integer) : Integer of object',CC,TPasFunctionType,AHint);
+  AssertEquals('Argument count',1,Proc.Args.Count);
+  AssertEquals('Is OF Object',True,Proc.IsOfObject);
+  CheckArgument(0,'A','Integer',argDefault);
+  AssertNotNull('Have result',FuncProc.ResultEl);
+  AssertEquals('Result type class',TPasResultElement,FuncProc.ResultEl.ClassType);
+  AssertNotNull('Have result',FuncProc.ResultEl.ResultType);
+  AssertEquals('Result type element class ',TPasUnresolvedTypeRef,FuncProc.ResultEl.ResultType.ClassType);
+  AssertEquals('Result type element name','Integer',FuncProc.ResultEl.ResultType.Name);
+end;
+
+procedure TTestProcedureTypeParser.CheckOpenArrayArgument(Ac : TArgumentAccess);
+Var
+  A : TPasArgument;
+  T : TPasArrayType;
+
+begin
+  A:=CheckArgument(0,'A','',ac);
+  AssertEquals('ArrayType',TPasArrayType,A.ArgType.ClassType);
+  T:=A.ArgType as TPasArrayType;
+  AssertNotNull('Have Element type',T.ElType);
+  AssertEquals('Element type',TPasUnresolvedTypeRef,T.ElType.ClassType);
+  AssertEquals('Element type name','Integer',TPasUnresolvedTypeRef(T.ElType).Name);
+  AssertEquals('No boundaries','',T.IndexRange);
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureOpenArray(
+  CC: TCallingConvention; const AHint: String);
+
+begin
+  ParseType('procedure(A : Array of integer)',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',1,Proc.Args.Count);
+  CheckOpenArrayArgument(argDefault);
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureConstOpenArray(
+  CC: TCallingConvention; const AHint: String);
+begin
+  ParseType('procedure(const A : Array of integer)',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',1,Proc.Args.Count);
+  CheckOpenArrayArgument(argConst);
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureVarOpenArray(
+  CC: TCallingConvention; const AHint: String);
+begin
+  ParseType('procedure(var A : Array of integer)',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',1,Proc.Args.Count);
+  CheckOpenArrayArgument(argVar);
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureOutOpenArray(
+  CC: TCallingConvention; const AHint: String);
+begin
+  ParseType('procedure(out A : Array of integer)',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',1,Proc.Args.Count);
+  CheckOpenArrayArgument(argOut);
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureOneArgDefault(
+  CC: TCallingConvention; const AHint: String);
+Var
+  A : TPasArgument;
+
+begin
+  ParseType('procedure(A : Integer = 1)',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',1,Proc.Args.Count);
+  A:=CheckArgument(0,'A','Integer',argDefault);
+  AssertNotNull('have default argument type', A.ValueExpr);
+  AssertEquals('argument expr type', TPrimitiveExpr, A.ValueExpr.ClassType);
+  AssertEquals('argument expr value', '1', TPrimitiveExpr(A.ValueExpr).Value);
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureOneArgDefaultExpr(
+  CC: TCallingConvention; const AHint: String);
+
+Var
+  A : TPasArgument;
+  B : TBinaryExpr;
+
+begin
+  ParseType('procedure(A : Integer = 1+2)',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',1,Proc.Args.Count);
+  A:=CheckArgument(0,'A','Integer',argDefault);
+  AssertNotNull('have default argument type', A.ValueExpr);
+  AssertEquals('argument expr type', TBinaryExpr, A.ValueExpr.ClassType);
+  B:=TBinaryExpr(A.ValueExpr);
+  AssertNotNull('have left expr', B.Left);
+  AssertEquals('argument left expr type', TPrimitiveExpr, B.left.ClassType);
+  AssertEquals('argument left expr value', '1', TPrimitiveExpr(B.Left).Value);
+  AssertNotNull('have right expr', B.Right);
+  AssertEquals('argument right expr type', TPrimitiveExpr, B.right.ClassType);
+  AssertEquals('argument right expr value', '2', TPrimitiveExpr(B.right).Value);
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureOneArgDefaultSet(
+  CC: TCallingConvention; const AHint: String);
+Var
+  A : TPasArgument;
+  B : TParamsExpr;
+
+begin
+  ParseType('procedure(A : TB = [])',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',1,Proc.Args.Count);
+  A:=CheckArgument(0,'A','TB',argDefault);
+  AssertNotNull('have default argument type', A.ValueExpr);
+  AssertEquals('argument expr type', TParamsExpr, A.ValueExpr.ClassType);
+  B:=TParamsExpr(A.ValueExpr);
+  AssertEquals('No params',0,Length(B.Params));
+end;
+
+Function TTestProcedureTypeParser.CheckArgument(AIndex: Integer; const AName,
+  ATypeName: String; AAccess: TArgumentAccess) : TPAsArgument;
+Var
+  A : TPasArgument;
+  C : String;
+begin
+  C:='Argument '+IntToStr(AIndex)+' : ';
+  AssertNotNull(C+'assigned',Proc.Args[AIndex]);
+  AssertEquals(C+'class',TPasArgument,TObject(Proc.Args[AIndex]).ClassType);
+  A:=TPasArgument(Proc.Args[AIndex]);
+  AssertEquals(C+'Access',AAccess,A.Access);
+  AssertEquals(C+'name',AName,A.Name);
+  if (ATypeName<>'') then
+    begin
+    AssertNotNull(C+'type assigned',A.ArgType);
+    if (ATypeName[1]='[') then
+      AssertEquals(C+'type classname',LowerCase(Copy(ATypeName,2,Length(ATypeName)-2)),LowerCase(A.ArgType.ClassName))
+    else
+      AssertEquals(C+'type name',ATypeName,A.ArgType.Name);
+    end;
+  Result:=A;
+end;
+
+function TTestProcedureTypeParser.ParseType(ASource: String;
+  CC: TCallingConvention; ATypeClass: TClass; const AHint: String): TPasProcedureType;
+begin
+  if CC=ccdefault then
+    Result:=TPasProcedureType(ParseType(ASource,ATypeClass,AHint))
+  else
+    begin
+    if (AHint<>'') then
+      Result:=TPasProcedureType(ParseType(ASource+';' +cCallingConventions[CC]+';',ATypeClass,AHint))
+    else
+      Result:=TPasProcedureType(ParseType(ASource+';' +cCallingConventions[CC],ATypeClass,AHint));
+    end;
+  FProc:=Result;
+  AssertEquals('Correct calling convention for procedural type',cc,Result.CallingConvention);
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureDecl(CC: TCallingConvention; Const AHint : String);
+
+begin
+  ParseType('procedure',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',0,Proc.Args.Count);
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureOneArgDecl(
+  CC: TCallingConvention; const AHint: String);
+
+begin
+  ParseType('procedure(A : Integer)',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',1,Proc.Args.Count);
+  CheckArgument(0,'A','Integer',argDefault);
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureOneVarArgDecl(
+  CC: TCallingConvention; const AHint: String);
+begin
+  ParseType('procedure(var A : Integer)',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',1,Proc.Args.Count);
+  CheckArgument(0,'A','Integer',argVar);
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureOneConstArgDecl(
+  CC: TCallingConvention; const AHint: String);
+begin
+  ParseType('procedure(const A : Integer)',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',1,Proc.Args.Count);
+  CheckArgument(0,'A','Integer',argConst);
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureOneOutArgDecl(
+  CC: TCallingConvention; const AHint: String);
+begin
+  ParseType('procedure(out A : Integer)',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',1,Proc.Args.Count);
+  CheckArgument(0,'A','Integer',argOut);
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureTwoArgsDecl(
+  CC: TCallingConvention; const AHint: String);
+begin
+  ParseType('procedure(A : Integer;B : String)',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',2,Proc.Args.Count);
+  CheckArgument(0,'A','Integer',argDefault);
+  CheckArgument(1,'B','[TPasAliasType]',argDefault);
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureTwoVarArgsDecl(
+  CC: TCallingConvention; const AHint: String);
+begin
+  ParseType('procedure(Var A : Integer;Var B : String)',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',2,Proc.Args.Count);
+  CheckArgument(0,'A','Integer',argVar);
+  CheckArgument(1,'B','[TPasAliasType]',argVar);
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureTwoConstArgsDecl(
+  CC: TCallingConvention; const AHint: String);
+begin
+  ParseType('procedure(const A : Integer;Const B : String)',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',2,Proc.Args.Count);
+  CheckArgument(0,'A','Integer',argConst);
+  CheckArgument(1,'B','[TPasAliasType]',argConst);
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureTwoOutArgsDecl(
+  CC: TCallingConvention; const AHint: String);
+begin
+  ParseType('procedure(out A : Integer;Out B : String)',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',2,Proc.Args.Count);
+  CheckArgument(0,'A','Integer',argOut);
+  CheckArgument(1,'B','[TPasAliasType]',argOut);
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureTwoCombinedArgsDecl(
+  CC: TCallingConvention; const AHint: String);
+begin
+  ParseType('procedure(A,B : Integer)',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',2,Proc.Args.Count);
+  CheckArgument(0,'A','Integer',argDefault);
+  CheckArgument(1,'B','Integer',argDefault);
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureTwoCombinedVarArgsDecl(
+  CC: TCallingConvention; const AHint: String);
+begin
+  ParseType('procedure(Var A,B : Integer)',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',2,Proc.Args.Count);
+  CheckArgument(0,'A','Integer',argVar);
+  CheckArgument(1,'B','Integer',argVar);
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureTwoCombinedConstArgsDecl(
+  CC: TCallingConvention; const AHint: String);
+begin
+  ParseType('procedure(Const A,B : Integer)',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',2,Proc.Args.Count);
+  CheckArgument(0,'A','Integer',argConst);
+  CheckArgument(1,'B','Integer',argConst);
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureTwoCombinedOutArgsDecl(
+  CC: TCallingConvention; const AHint: String);
+begin
+  ParseType('procedure(Out A,B : Integer)',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',2,Proc.Args.Count);
+  CheckArgument(0,'A','Integer',argOut);
+  CheckArgument(1,'B','Integer',argOut);
+end;
+
+procedure TTestProcedureTypeParser.DoTestProcedureDefaultConstArgsDecl(
+  CC: TCallingConvention; const AHint: String);
+begin
+  ParseType('procedure(A : Integer; Const B : Integer)',CC,TPasProcedureType,AHint);
+  AssertEquals('Argument count',2,Proc.Args.Count);
+  CheckArgument(0,'A','Integer',argDefault);
+  CheckArgument(1,'B','Integer',argConst);
+end;
+
+procedure TTestProcedureTypeParser.TestCallingConventions(
+  Proc: TCallingConventionTest; Const AHint : String);
+
+Var
+  CC : TCallingConvention;
+
+begin
+  For cc:=ccDefault to High(TCallingConvention) do
+    begin
+    if CC<>ccDefault then
+      Setup;
+    try
+      Proc(cc,AHint);
+    finally
+      tearDown;
+    end;
+    end;
+end;
+
+procedure TTestProcedureTypeParser.TestCallingConventions(
+  Proc: TCallingConventionTest);
+begin
+  TestCallingConventions(Proc,'');
+  Setup;
+  TestCallingConventions(Proc,'deprecated');
+  Setup;
+  TestCallingConventions(Proc,'platform');
+end;
+
+function TTestProcedureTypeParser.FuncProc: TPasFunctionType;
+begin
+  Result:=Proc as TPasFunctionType;
+end;
+
+procedure TTestProcedureTypeParser.TestProcedure;
+begin
+  TestCallingConventions(@DoTestProcedureDecl);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureOneArg;
+begin
+  TestCallingConventions(@DoTestProcedureOneArgDecl);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureOneVarArg;
+begin
+  TestCallingConventions(@DoTestProcedureOneVarArgDecl);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureOneConstArg;
+begin
+  TestCallingConventions(@DoTestProcedureOneConstArgDecl);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureOneOutArg;
+begin
+  TestCallingConventions(@DoTestProcedureOneOutArgDecl);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureTwoArgs;
+begin
+  TestCallingConventions(@DoTestProcedureTwoArgsDecl);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureTwoVarArgs;
+begin
+  TestCallingConventions(@DoTestProcedureTwoVarArgsDecl);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureTwoConstArgs;
+begin
+  TestCallingConventions(@DoTestProcedureTwoConstArgsDecl);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureTwoOutArgs;
+begin
+  TestCallingConventions(@DoTestProcedureTwoOutArgsDecl);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureTwoCombinedArgs;
+begin
+  TestCallingConventions(@DoTestProcedureTwoCombinedArgsDecl);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureTwoCombinedVarArgs;
+begin
+  TestCallingConventions(@DoTestProcedureTwoCombinedVarArgsDecl);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureTwoCombinedConstArgs;
+begin
+  TestCallingConventions(@DoTestProcedureTwoCombinedConstArgsDecl);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureTwoCombinedOutArgs;
+begin
+  TestCallingConventions(@DoTestProcedureTwoCombinedOutArgsDecl);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureDefaultConstArgs;
+begin
+  TestCallingConventions(@DoTestProcedureDefaultConstArgsDecl);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureUntypedArg;
+begin
+  TestCallingConventions(@DoTestProcedureUntypedArgDecl);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureUntypedConstArg;
+begin
+  TestCallingConventions(@DoTestProcedureUntypedConstArgDecl);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureUntypedOutArg;
+begin
+  TestCallingConventions(@DoTestProcedureUntypedOutArgDecl);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureUntypedDefArg;
+begin
+  AssertException('No untyped arg by value',EParserError,@DoTestProcedureUntypedDefArg)
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureOneArgDefault;
+begin
+  TestCallingConventions(@DoTestProcedureOneArgDefault);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureOneArgDefaultExpr;
+begin
+  TestCallingConventions(@DoTestProcedureOneArgDefaultExpr);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureOneArgDefaultSet;
+begin
+  TestCallingConventions(@DoTestProcedureOneArgDefaultSet);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureOneVarArgDefault;
+begin
+  TestCallingConventions(@DoTestProcedureOneVarArgDefault);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureOneConstArgDefault;
+begin
+  TestCallingConventions(@DoTestProcedureOneConstArgDefault);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureOneOutArgDefault;
+begin
+  TestCallingConventions(@DoTestProcedureOneOutArgDefault);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureNoMultiArgDefaults;
+begin
+  AssertParseTypeError('procedure (A,B : Integer = 1)');
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureOpenArray;
+begin
+  TestCallingConventions(@DoTestProcedureOpenArray);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureConstOpenArray;
+begin
+  TestCallingConventions(@DoTestProcedureConstOpenArray);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureOutOpenArray;
+begin
+  TestCallingConventions(@DoTestProcedureVarOpenArray);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureVarOpenArray;
+begin
+  TestCallingConventions(@DoTestProcedureOutOpenArray);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureArrayOfConst;
+begin
+  TestCallingConventions(@DoTestProcedureArrayOfConst);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureOfObject;
+begin
+  TestCallingConventions(@DoTestProcedureOfObject);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureOfObjectOneArg;
+begin
+  TestCallingConventions(@DoTestProcedureOfObjectOneArg);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureIsNested;
+begin
+  TestCallingConventions(@DoTestProcedureIsNested);
+end;
+
+procedure TTestProcedureTypeParser.TestProcedureIsNesteOneArg;
+begin
+  TestCallingConventions(@DoTestProcedureIsNestedOneArg);
+end;
+
+procedure TTestProcedureTypeParser.TestFunction;
+begin
+  TestCallingConventions(@DoTestFunction);
+end;
+
+procedure TTestProcedureTypeParser.TestFunctionOneArg;
+begin
+  TestCallingConventions(@DoTestFunctionOneArg);
+end;
+
+procedure TTestProcedureTypeParser.TestFunctionOfObject;
+begin
+  TestCallingConventions(@DoTestFunctionOfObject);
+end;
+
+procedure TTestProcedureTypeParser.TestFunctionOneArgOfObject;
+begin
+  TestCallingConventions(@DoTestFunctionOneArgOfObject);
+
+end;
+
+{ TTestRecordTypeParser }
+
+function TTestRecordTypeParser.GetField(AIndex: Integer; R: TPasRecordType
+  ): TPasVariable;
+begin
+  AssertNotNull(R);
+  AssertNotNull(R.Members);
+  AssertTrue('Have AIndex elements',R.Members.Count>AIndex);
+  AssertEquals('Correct class in member',TPasVariable,TObject(R.Members[AIndex]).ClassType);
+  Result:=TPasVariable(R.Members[AIndex]);
+end;
+
+function TTestRecordTypeParser.GetField(AIndex: Integer; R: TPasVariant
+  ): TPasVariable;
+begin
+  AssertNotNull(R);
+  AssertNotNull('Have variant members', R.Members);
+  AssertNotNull('Have variant members member list',R.Members.Members);
+  AssertTrue('Have AIndex elements',R.Members.Members.Count>AIndex);
+  AssertEquals('Correct class in member',TPasVariable,TObject(R.Members.members[AIndex]).ClassType);
+  Result:=TPasVariable(R.Members.Members[AIndex]);
+end;
+
+function TTestRecordTypeParser.GetF(AIndex: Integer): TPasVariable;
+begin
+  Result:=GetField(AIndex,GetR);
+end;
+
+function TTestRecordTypeParser.GetR: TPasRecordType;
+begin
+  Result:=TheType as TPasRecordType;
+end;
+
+function TTestRecordTypeParser.GetVariant(AIndex: Integer; R: TPasRecordType
+  ): TPasVariant;
+begin
+  AssertNotNull(R);
+  AssertNotNull(R.Variants);
+  AssertTrue('Have AIndex variant elements',R.Variants.Count>AIndex);
+  AssertEquals('Correct class in variant',TPasVariant,TObject(R.Variants[AIndex]).ClassType);
+  Result:=TPasVariant(R.Variants[AIndex]);
+end;
+
+function TTestRecordTypeParser.GetV(AIndex: Integer): TPasVariant;
+begin
+  Result:=GetVariant(AIndex,GetR);
+end;
+
+procedure TTestRecordTypeParser.TestFields(const Fields: array of string;
+  AHint: String; HaveVariant: Boolean);
+
+Var
+  S : String;
+  I : integer;
+
+begin
+  S:='';
+  For I:=Low(Fields) to High(Fields) do
+    begin
+    if (S<>'') then
+      S:=S+sLineBreak;
+    S:=S+'    '+Fields[i];
+    end;
+  if (S<>'') then
+    S:=S+sLineBreak;
+  S:='record'+sLineBreak+s+'  end';
+  ParseType(S,TPasRecordType,AHint);
+  if HaveVariant then
+    begin
+    AssertNotNull('Have variants',TheRecord.Variants);
+    AssertNotNull('Have variant type',TheRecord.VariantType);
+    end
+  else
+    begin
+    AssertNull('No variants',TheRecord.Variants);
+    AssertNull('No variant type',TheRecord.VariantType);
+    AssertEquals('No variant name','',TheRecord.VariantName);
+    end;
+end;
+
+procedure TTestRecordTypeParser.AssertVariantSelector(AName,AType : string);
+
+begin
+  if (AType='') then
+    AType:='Integer';
+  AssertEquals('Have variant selector storage name',AName,TheRecord.VariantName);
+  AssertNotNull('Have variant selector type',TheRecord.VariantType);
+  AssertEquals('Have variant selector type',TPasUnresolvedTypeRef,TheRecord.VariantType.ClassType);
+  AssertEquals('Have variant selector type name',AType,TheRecord.VariantType.Name);
+end;
+
+
+procedure TTestRecordTypeParser.DoTestEmpty(const AHint: String);
+begin
+  TestFields([],AHint);
+  AssertNotNull('Have members array',TheRecord.Members);
+  AssertEquals('Zero members in array',0,TheRecord.Members.Count);
+end;
+
+procedure TTestRecordTypeParser.AssertVariant1(Hints: TPasMemberHints);
+begin
+  AssertVariant1(Hints,['0']);
+end;
+
+
+procedure TTestRecordTypeParser.AssertVariant1(Hints: TPasMemberHints; VariantLabels : Array of string);
+
+Var
+  I : Integer;
+
+begin
+  AssertNotNull('Have variant 1',Variant1);
+  AssertNotNull('Variant 1 has Values ',Variant1.Values);
+  if Length(VariantLabels)=0 then
+    begin
+    AssertEquals('Have 1 value',1,Variant1.Values.Count);
+    AssertEquals('First value is 0','0',Variant1.Values[0]);
+    end
+  else
+    begin
+    AssertEquals('Have correct number of values',Length(VariantLabels),Variant1.Values.Count);
+    For I:=0 to Length(VariantLabels)-1 do
+      AssertEquals(Format('Value %d is %s',[i,VariantLabels[i]]),VariantLabels[i],Variant1.Values[I]);
+    end;
+  AssertNotNull('Have members',Variant1.Members);
+  AssertNotNull('Have member members',Variant1.Members.Members);
+  AssertNotNull('member 0 not null',Variant1.Members.Members[0]);
+  AssertEquals('Member 0 has correct name',TPasVariable,TObject(Variant1.Members.Members[0]).ClassType);
+  AssertEquals('Member 0 has correct name','y',TPasVariable(Variant1.Members.Members[0]).Name);
+  AssertNotNull('member 0 has not null type',TPasVariable(Variant1.Members.Members[0]).VarType);
+  AssertEquals('member 0 has correct type',TPasUnresolvedTypeRef,TPasVariable(Variant1.Members.Members[0]).VarType.ClassType);
+  AssertEquals('member 0 has correct type name','Integer',TPasVariable(Variant1.Members.Members[0]).VarType.Name);
+  AssertTrue('Field 1 hints match',TPasVariable(Variant1.Members.Members[0]).Hints=Hints)
+end;
+
+procedure TTestRecordTypeParser.AssertVariant2(Hints: TPasMemberHints);
+begin
+  AssertVariant2(Hints,['1']);
+end;
+
+procedure TTestRecordTypeParser.AssertVariant2(Hints: TPasMemberHints; VariantLabels : Array of string);
+
+Var
+  I : Integer;
+
+begin
+  AssertNotNull('Have variant 2',Variant2);
+  AssertNotNull('Variant 2 has Values ',Variant2.Values);
+  if Length(VariantLabels)=0 then
+    begin
+    AssertEquals('Variant 2 has 1 value',2,Variant2.Values.Count);
+    AssertEquals('Variant 2 First value is 0','1',Variant2.Values[0]);
+    end
+  else
+    begin
+    AssertEquals('Variant 2 Has correct number of values',Length(VariantLabels),Variant2.Values.Count);
+    For I:=0 to Length(VariantLabels)-1 do
+      AssertEquals(Format('Variant 2, Value %d is %s',[i,VariantLabels[i]]),VariantLabels[i],Variant2.Values[I]);
+    end;
+  AssertNotNull('Have members',Variant2.Members);
+  AssertNotNull('Have member members',Variant2.Members.Members);
+  AssertNotNull('member 1 not null',Variant2.Members.Members[0]);
+  AssertEquals('Member 1 has correct name',TPasVariable,TObject(Variant2.Members.Members[0]).ClassType);
+  AssertEquals('Member 1 has correct name','z',TPasVariable(Variant2.Members.Members[0]).Name);
+  AssertNotNull('member 1 has not null type',TPasVariable(Variant2.Members.Members[0]).VarType);
+  AssertEquals('member 1 has correct type',TPasUnresolvedTypeRef,TPasVariable(Variant2.Members.Members[0]).VarType.ClassType);
+  AssertEquals('member 1 has correct type name','Integer',TPasVariable(Variant2.Members.Members[0]).VarType.Name);
+  AssertTrue('Field 1 hints match',TPasVariable(Variant2.Members.Members[0]).Hints=Hints)
+end;
+
+procedure TTestRecordTypeParser.DoTestVariantNoStorage(const AHint: string);
+begin
+  TestFields(['x : integer;','case integer of','0 : (y : integer;)'],AHint,True);
+  AssertField1([]);
+  AssertVariantSelector('','');
+  AssertVariant1([]);
+end;
+
+procedure TTestRecordTypeParser.DoTestDeprecatedVariantNoStorage(
+  const AHint: string);
+begin
+  TestFields(['x : integer;','case integer of','0 : (y : integer deprecated;)'],AHint,True);
+  AssertField1([]);
+  AssertVariantSelector('','');
+  AssertVariant1([hDeprecated]);
+end;
+
+procedure TTestRecordTypeParser.DoTestDeprecatedVariantStorage(
+  const AHint: string);
+begin
+  TestFields(['x : integer;','case s : integer of','0 : (y : integer deprecated;)'],AHint,True);
+  AssertField1([]);
+  AssertVariantSelector('s','');
+  AssertVariant1([hDeprecated]);
+end;
+
+procedure TTestRecordTypeParser.DoTestVariantStorage(const AHint: string);
+begin
+  TestFields(['x : integer;','case s : integer of','0 : (y : integer;)'],AHint,True);
+  AssertField1([]);
+  AssertVariantSelector('s','');
+  AssertVariant1([]);
+end;
+
+procedure TTestRecordTypeParser.DoTestTwoVariantsNoStorage(const AHint: string
+  );
+begin
+  TestFields(['x : integer;','case integer of','0 : (y : integer;);','1 : (z : integer;)'],AHint,True);
+  AssertField1([]);
+  AssertVariantSelector('','');
+  AssertVariant1([]);
+  AssertVariant2([]);
+end;
+
+procedure TTestRecordTypeParser.DoTestTwoVariantsStorage(const AHint: string);
+begin
+  TestFields(['x : integer;','case s : integer of','0 : (y : integer;);','1 : (z : integer;)'],AHint,True);
+  AssertField1([]);
+  AssertVariantSelector('s','');
+  AssertVariant1([]);
+  AssertVariant2([]);
+end;
+
+procedure TTestRecordTypeParser.DoTestTwoVariantsFirstDeprecatedStorage(
+  const AHint: string);
+begin
+  TestFields(['x : integer;','case s : integer of','0 : (y : integer deprecated;);','1 : (z : integer;)'],AHint,True);
+  AssertField1([]);
+  AssertVariantSelector('s','');
+  AssertVariant1([hdeprecated]);
+  AssertVariant2([]);
+end;
+
+procedure TTestRecordTypeParser.DoTestTwoVariantsSecondDeprecatedStorage(
+  const AHint: string);
+begin
+  TestFields(['x : integer;','case s : integer of','0 : (y : integer ;);','1 : (z : integer deprecated;)'],AHint,True);
+  AssertField1([]);
+  AssertVariantSelector('s','');
+  AssertVariant1([]);
+  AssertVariant2([hdeprecated]);
+end;
+
+procedure TTestRecordTypeParser.DoTestVariantTwoLabels(const AHint: string);
+begin
+  TestFields(['x : integer;','case integer of','0,1 : (y : integer)'],AHint,True);
+  AssertField1([]);
+  AssertVariantSelector('','');
+  AssertVariant1([],['0','1']);
+end;
+
+procedure TTestRecordTypeParser.DoTestTwoVariantsTwoLabels(const AHint: string
+  );
+begin
+  TestFields(['x : integer;','case integer of','0,1 : (y : integer);','2,3 : (z : integer);'],AHint,True);
+  AssertField1([]);
+  AssertVariantSelector('','');
+  AssertVariant1([],['0','1']);
+  AssertVariant2([],['2','3']);
+end;
+
+procedure TTestRecordTypeParser.DoTestVariantNestedRecord(const AHint: string);
+begin
+  TestFields(['x : integer;','case integer of','0 : ( y : record','  z : integer;','end)'],AHint,True);
+  AssertField1([]);
+  AssertVariantSelector('','');
+  AssertRecordVariant(0,[],['0']);
+end;
+
+procedure TTestRecordTypeParser.DoTestVariantNestedVariant(const AHint: string
+  );
+begin
+  TestFields(['x : integer;','case integer of','0 : ( y : record','  z : integer;','  case byte of ','    1 : (i : integer);','    2 : ( j :  byte)', 'end)'],AHint,True);
+  AssertField1([]);
+  AssertVariantSelector('','');
+  AssertRecordVariant(0,[],['0']);
+  AssertRecordVariantVariant(0,'i','Integer',[],['1']);
+  AssertRecordVariantVariant(1,'j','Byte',[],['2'])
+end;
+
+procedure TTestRecordTypeParser.DoTestVariantNestedVariantFirstDeprecated(
+  const AHint: string);
+begin
+  TestFields(['x : integer;','case integer of','0 : ( y : record','  z : integer;','  case byte of ','    1 : (i : integer deprecated);','    2 : ( j :  byte)', 'end)'],AHint,True);
+  AssertField1([]);
+  AssertVariantSelector('','');
+  AssertRecordVariant(0,[],['0']);
+  AssertRecordVariantVariant(0,'i','Integer',[hDeprecated],['1']);
+  AssertRecordVariantVariant(1,'j','Byte',[],['2'])
+end;
+
+procedure TTestRecordTypeParser.DoTestVariantNestedVariantSecondDeprecated(
+  const AHint: string);
+begin
+  TestFields(['x : integer;','case integer of','0 : ( y : record','  z : integer;','  case byte of ','    1 : (i : integer );','    2 : ( j :  byte deprecated)', 'end)'],AHint,True);
+  AssertField1([]);
+  AssertVariantSelector('','');
+  AssertRecordVariant(0,[],['0']);
+  AssertRecordVariantVariant(0,'i','Integer',[],['1']);
+  AssertRecordVariantVariant(1,'j','Byte',[hDeprecated],['2'])
+end;
+
+procedure TTestRecordTypeParser.DoTestVariantNestedVariantBothDeprecated(const AHint: string);
+
+begin
+  TestFields(['x : integer;','case integer of','0 : ( y : record','  z : integer;','  case byte of ','    1 : (i : integer deprecated );','    2 : ( j :  byte deprecated)', 'end)'],AHint,True);
+  AssertField1([]);
+  AssertVariantSelector('','');
+  AssertRecordVariant(0,[],['0']);
+  AssertRecordVariantVariant(0,'i','Integer',[hdeprecated],['1']);
+  AssertRecordVariantVariant(1,'j','Byte',[hDeprecated],['2'])
+end;
+
+procedure TTestRecordTypeParser.TestEmpty;
+begin
+  DoTestEmpty('')
+end;
+
+procedure TTestRecordTypeParser.TestEmptyDeprecated;
+begin
+  DoTestEmpty('Deprecated')
+end;
+
+procedure TTestRecordTypeParser.TestEmptyPlatform;
+begin
+  DoTestEmpty('Platform')
+end;
+
+procedure TTestRecordTypeParser.AssertField1(Hints : TPasMemberHints);
+
+begin
+  AssertEquals('Member 1 field type',TPasVariable,TObject(TheRecord.Members[0]).ClassType);
+  AssertEquals('Field 1 name','x',Field1.Name);
+  AssertNotNull('Have 1 Field type',Field1.VarType);
+  AssertEquals('Field 1 type',TPasUnresolvedTypeRef,Field1.VarType.ClassType);
+  AssertEquals('Field 1 type name','Integer',Field1.VarType.Name);
+  AssertTrue('Field 1 hints match',Field1.Hints=Hints)
+end;
+
+procedure TTestRecordTypeParser.AssertField2(Hints : TPasMemberHints);
+
+begin
+  AssertEquals('Member 2 field type',TPasVariable,TObject(TheRecord.Members[1]).ClassType);
+  AssertEquals('Field 2 name','y',Field2.Name);
+  AssertNotNull('Have 2 Field type',Field2.VarType);
+  AssertEquals('Field 2 type',TPasUnresolvedTypeRef,Field2.VarType.ClassType);
+  AssertEquals('Field 2 type name','Integer',Field2.VarType.Name);
+  AssertTrue('Field 2 hints match',Field2.Hints=Hints)
+end;
+
+procedure TTestRecordTypeParser.AssertOneIntegerField(Hints : TPasMemberHints);
+
+begin
+  AssertEquals('One field',1,TheRecord.Members.Count);
+  AssertField1(Hints);
+end;
+
+procedure TTestRecordTypeParser.AssertTwoIntegerFields(Hints1,Hints2: TPasMemberHints);
+
+begin
+  AssertEquals('Two field',2,TheRecord.Members.Count);
+  AssertField1(Hints1);
+  AssertField2(Hints2);
+end;
+
+procedure TTestRecordTypeParser.AssertRecordField(AIndex: Integer;
+  Hints: TPasMemberHints);
+
+Var
+  F : TPasVariable;
+  R : TPasRecordtype;
+
+begin
+  AssertEquals('Member 2 field type',TPasVariable,TObject(TheRecord.Members[AIndex]).ClassType);
+  F:=GetF(AIndex);
+  if AIndex=1 then
+    AssertEquals('Field 2 name','y',F.Name)
+  else
+    AssertEquals('Field 1 name','x',F.Name);
+  AssertNotNull('Have 2 Field type',F.VarType);
+  AssertEquals('Field 2 type',TPasRecordType,F.VarType.ClassType);
+  R:=F.VarType as TPasRecordType;
+  AssertNotNull('Record field has members',R.Members);
+  AssertEquals('Record field has 1 member',1,R.Members.Count);
+  AssertTrue('Record field hints match',F.Hints=Hints)
+end;
+
+procedure TTestRecordTypeParser.AssertRecordVariant(AIndex: Integer;
+  Hints: TPasMemberHints; VariantLabels : Array of string);
+
+Var
+  F : TPasVariant;
+  V : TPasVariable;
+  R : TPasRecordtype;
+  I : Integer;
+  MN : String;
+
+begin
+  F:=GetV(AIndex);
+  MN:='Variant '+IntToStr(AIndex)+' ';
+  AssertNotNull('Have variant 1',F);
+  AssertEquals('Have correct number of values',Length(VariantLabels),F.Values.Count);
+  For I:=0 to Length(VariantLabels)-1 do
+    AssertEquals(Format('Value %d is %s',[i,VariantLabels[i]]),VariantLabels[i],F.Values[I]);
+  V:=GetField(0,F);
+  AssertEquals(MN+'has correct name','y',V.Name);
+  AssertNotNull(MN+'has not null type',V.VarType);
+  AssertEquals(MN+'has correct type',TPasRecordType,V.VarType.ClassType);
+  AssertTrue(MN+'hints match',V.Hints=Hints);
+  R:=TPasVariable(F.Members.Members[0]).VarType as TPasRecordType;
+  V:=GetField(0,R);
+  AssertEquals('Field 1 has correct name','z',V.Name);
+  AssertNotNull('Record field has members',R.Members);
+  AssertEquals('Record field has 1 member',1,R.Members.Count);
+
+end;
+
+procedure TTestRecordTypeParser.AssertRecordVariantVariant(AIndex: Integer; Const AFieldName,ATypeName: string;
+  Hints: TPasMemberHints; VariantLabels: array of string);
+
+Var
+  F : TPasVariant;
+  V : TPasVariable;
+  R : TPasRecordtype;
+  I : Integer;
+  MN : String;
+
+begin
+  F:=GetV(0);
+  MN:='Nested Variant '+IntToStr(AIndex)+' ';
+  AssertNotNull('Have variant 1',F);
+  AssertEquals('Have correct number of values',1,F.Values.Count);
+  AssertEquals('Value 1 is 0','0',F.Values[I]);
+  // First variant, Y, record
+  V:=GetField(0,F);
+  AssertEquals(MN+'has correct name','y',V.Name);
+  AssertNotNull(MN+'has not null type',V.VarType);
+  AssertEquals(MN+'has correct type',TPasRecordType,V.VarType.ClassType);
+  R:=TPasVariable(F.Members.Members[0]).VarType as TPasRecordType;
+  AssertNotNull('Record field has members',R.Members);
+  AssertEquals('Record field has 2 members',1,R.Members.Count);
+  // First variant
+  F:=GetVariant(Aindex,R);
+  // First field of first variant, i
+  AssertEquals('Have correct number of values',Length(VariantLabels),F.Values.Count);
+  For I:=0 to Length(VariantLabels)-1 do
+    AssertEquals(Format('Value %d is %s',[i,VariantLabels[i]]),VariantLabels[i],F.Values[I]);
+  V:=GetField(0,F);
+  AssertEquals('Nested Variant 0 has correct name',AFieldName,V.Name);
+  AssertEquals('Nested variant 0 has correct type',TPasUnresolvedTypeRef,V.VarType.ClassType);
+  AssertEquals('Nested variant 0 has correct type name',ATypeName,V.VarType.Name);
+  AssertTrue(MN+'hints match',V.Hints=Hints);
+end;
+
+procedure TTestRecordTypeParser.TestOneField;
+begin
+  TestFields(['x : integer'],'',False);
+  AssertOneIntegerField([]);
+end;
+
+procedure TTestRecordTypeParser.TestOneFieldDeprecated;
+begin
+  TestFields(['x : integer'],'deprecated',False);
+  AssertOneIntegerField([]);
+end;
+
+procedure TTestRecordTypeParser.TestOneFieldPlatform;
+begin
+  TestFields(['x : integer'],'platform',False);
+  AssertOneIntegerField([]);
+end;
+
+procedure TTestRecordTypeParser.TestOneFieldSemicolon;
+begin
+  TestFields(['x : integer;'],'',False);
+  AssertOneIntegerField([]);
+end;
+
+procedure TTestRecordTypeParser.TestOneFieldSemicolonDeprecated;
+begin
+  TestFields(['x : integer;'],'deprecated',False);
+  AssertOneIntegerField([]);
+
+end;
+
+procedure TTestRecordTypeParser.TestOneFieldSemicolonPlatform;
+begin
+  TestFields(['x : integer;'],'platform',False);
+  AssertOneIntegerField([]);
+end;
+
+procedure TTestRecordTypeParser.TestOneDeprecatedField;
+begin
+  TestFields(['x : integer deprecated;'],'',False);
+  AssertOneIntegerField([hDeprecated]);
+end;
+
+procedure TTestRecordTypeParser.TestOneDeprecatedFieldDeprecated;
+begin
+  TestFields(['x : integer deprecated;'],'deprecated',False);
+  AssertOneIntegerField([hDeprecated]);
+end;
+
+procedure TTestRecordTypeParser.TestOneDeprecatedFieldPlatform;
+begin
+  TestFields(['x : integer deprecated;'],'platform',False);
+  AssertOneIntegerField([hDeprecated]);
+end;
+
+procedure TTestRecordTypeParser.TestOnePlatformField;
+begin
+  TestFields(['x : integer platform;'],'',False);
+  AssertOneIntegerField([hplatform]);
+end;
+
+procedure TTestRecordTypeParser.TestOnePlatformFieldDeprecated;
+begin
+  TestFields(['x : integer platform;'],'Deprecated',False);
+  AssertOneIntegerField([hplatform]);
+end;
+
+procedure TTestRecordTypeParser.TestOnePlatformFieldPlatform;
+begin
+  TestFields(['x : integer platform;'],'Platform',False);
+  AssertOneIntegerField([hplatform]);
+end;
+
+procedure TTestRecordTypeParser.TestTwoFields;
+begin
+  TestFields(['x : integer;','y : integer'],'',False);
+  AssertTwoIntegerFields([],[]);
+end;
+
+procedure TTestRecordTypeParser.TestTwoFieldDeprecated;
+begin
+  TestFields(['x : integer;','y : integer'],'deprecated',False);
+  AssertTwoIntegerFields([],[]);
+end;
+
+procedure TTestRecordTypeParser.TestTwoFieldPlatform;
+begin
+  TestFields(['x : integer;','y : integer'],'platform',False);
+  AssertTwoIntegerFields([],[]);
+end;
+
+procedure TTestRecordTypeParser.TestTwoFieldsFirstDeprecated;
+begin
+  TestFields(['x : integer deprecated;','y : integer'],'',False);
+  AssertTwoIntegerFields([hdeprecated],[]);
+end;
+
+procedure TTestRecordTypeParser.TestTwoFieldsFirstDeprecatedDeprecated;
+begin
+  TestFields(['x : integer deprecated;','y : integer'],'deprecated',False);
+  AssertTwoIntegerFields([hdeprecated],[]);
+end;
+
+procedure TTestRecordTypeParser.TestTwoFieldsFirstDeprecatedPlatform;
+begin
+  TestFields(['x : integer deprecated;','y : integer'],'platform',False);
+  AssertTwoIntegerFields([hdeprecated],[]);
+end;
+
+procedure TTestRecordTypeParser.TestTwoFieldsSecondDeprecated;
+begin
+  TestFields(['x : integer;','y : integer deprecated;'],'',False);
+  AssertTwoIntegerFields([],[hdeprecated]);
+end;
+
+procedure TTestRecordTypeParser.TestTwoFieldsSecondDeprecatedDeprecated;
+begin
+  TestFields(['x : integer;','y : integer deprecated;'],'deprecated',False);
+  AssertTwoIntegerFields([],[hdeprecated]);
+end;
+
+procedure TTestRecordTypeParser.TestTwoFieldsSecondDeprecatedPlatform;
+begin
+  TestFields(['x : integer;','y : integer deprecated;'],'platform',False);
+  AssertTwoIntegerFields([],[hdeprecated]);
+end;
+
+procedure TTestRecordTypeParser.TestTwoFieldsBothDeprecated;
+begin
+  TestFields(['x : integer deprecated;','y : integer deprecated;'],'',False);
+  AssertTwoIntegerFields([hdeprecated],[hdeprecated]);
+end;
+
+procedure TTestRecordTypeParser.TestTwoFieldsBothDeprecatedDeprecated;
+begin
+  TestFields(['x : integer deprecated;','y : integer deprecated;'],'deprecated',False);
+  AssertTwoIntegerFields([hdeprecated],[hdeprecated]);
+end;
+
+procedure TTestRecordTypeParser.TestTwoFieldsBothDeprecatedPlatform;
+begin
+  TestFields(['x : integer deprecated;','y : integer deprecated;'],'platform',False);
+  AssertTwoIntegerFields([hdeprecated],[hdeprecated]);
+end;
+
+procedure TTestRecordTypeParser.TestTwoFieldsCombined;
+begin
+  TestFields(['x,y : integer;'],'',False);
+  AssertTwoIntegerFields([],[]);
+end;
+
+procedure TTestRecordTypeParser.TestTwoFieldsCombinedDeprecated;
+begin
+  TestFields(['x,y : integer;'],'deprecated',False);
+  AssertTwoIntegerFields([],[]);
+end;
+
+procedure TTestRecordTypeParser.TestTwoFieldsCombinedPlatform;
+begin
+  TestFields(['x,y : integer;'],'platform',False);
+  AssertTwoIntegerFields([],[]);
+end;
+
+procedure TTestRecordTypeParser.TestTwoDeprecatedFieldsCombined;
+begin
+  TestFields(['x,y : integer deprecated;'],'',False);
+  AssertTwoIntegerFields([hdeprecated],[hdeprecated]);
+end;
+
+procedure TTestRecordTypeParser.TestTwoDeprecatedFieldsCombinedDeprecated;
+begin
+  TestFields(['x,y : integer deprecated;'],'deprecated',False);
+  AssertTwoIntegerFields([hdeprecated],[hdeprecated]);
+end;
+
+procedure TTestRecordTypeParser.TestTwoDeprecatedFieldsCombinedPlatform;
+begin
+  TestFields(['x,y : integer deprecated;'],'platform',False);
+  AssertTwoIntegerFields([hdeprecated],[hdeprecated]);
+end;
+
+procedure TTestRecordTypeParser.TestNested;
+begin
+  TestFields(['x : integer;','y : record','  z : integer;','end'],'',False);
+  AssertField1([]);
+  AssertRecordField(1,[])
+end;
+
+procedure TTestRecordTypeParser.TestNestedSemicolon;
+begin
+  TestFields(['x : integer;','y : record','  z : integer;','end;'],'',False);
+  AssertField1([]);
+  AssertRecordField(1,[])
+end;
+
+procedure TTestRecordTypeParser.TestNestedSemicolonDeprecated;
+begin
+  TestFields(['x : integer;','y : record','  z : integer;','end;'],'deprecated',False);
+  AssertField1([]);
+  AssertRecordField(1,[])
+end;
+
+procedure TTestRecordTypeParser.TestNestedSemicolonPlatform;
+begin
+  TestFields(['x : integer;','y : record','  z : integer;','end;'],'platform',False);
+  AssertField1([]);
+  AssertRecordField(1,[])
+end;
+
+procedure TTestRecordTypeParser.TestNestedDeprecated;
+begin
+  TestFields(['x : integer;','y : record','  z : integer;','end'],'deprecated',False);
+  AssertField1([]);
+  AssertRecordField(1,[])
+end;
+
+procedure TTestRecordTypeParser.TestNestedPlatform;
+begin
+  TestFields(['x : integer;','y : record','  z : integer;','end'],'platform',False);
+  AssertField1([]);
+  AssertRecordField(1,[])
+end;
+
+procedure TTestRecordTypeParser.TestNestedFirst;
+begin
+  TestFields(['x : record','  z : integer;','end;','y : integer;'],'',False);
+  AssertField2([]);
+  AssertRecordField(0,[])
+end;
+
+procedure TTestRecordTypeParser.TestNestedFirstDeprecated;
+begin
+  TestFields(['x : record','  z : integer;','end;','y : integer;'],'deprecated',False);
+  AssertField2([]);
+  AssertRecordField(0,[])
+end;
+
+procedure TTestRecordTypeParser.TestNestedFirstPlatform;
+begin
+  TestFields(['x : record','  z : integer;','end;','y : integer;'],'platform',False);
+  AssertField2([]);
+  AssertRecordField(0,[])
+end;
+
+procedure TTestRecordTypeParser.TestDeprecatedNested;
+begin
+  TestFields(['x : integer;','y : record','  z : integer;','end deprecated;'],'',False);
+  AssertField1([]);
+  AssertRecordField(1,[hdeprecated])
+end;
+
+procedure TTestRecordTypeParser.TestDeprecatedNestedDeprecated;
+begin
+  TestFields(['x : integer;','y : record','  z : integer;','end deprecated;'],'deprecated',False);
+  AssertField1([]);
+  AssertRecordField(1,[hdeprecated])
+end;
+
+procedure TTestRecordTypeParser.TestDeprecatedNestedPlatform;
+begin
+  TestFields(['x : integer;','y : record','  z : integer;','end deprecated;'],'platform',False);
+  AssertField1([]);
+  AssertRecordField(1,[hdeprecated])
+end;
+
+procedure TTestRecordTypeParser.TestDeprecatedNestedFirst;
+begin
+  TestFields(['x : record','  z : integer;','end deprecated;','y : integer;'],'',False);
+  AssertField2([]);
+  AssertRecordField(0,[hdeprecated])
+end;
+
+procedure TTestRecordTypeParser.TestDeprecatedNestedFirstDeprecated;
+begin
+  TestFields(['x : record','  z : integer;','end deprecated;','y : integer;'],'deprecated',False);
+  AssertField2([]);
+  AssertRecordField(0,[hdeprecated])
+end;
+
+procedure TTestRecordTypeParser.TestDeprecatedNestedFirstPlatform;
+begin
+  TestFields(['x : record','  z : integer;','end deprecated;','y : integer;'],'platform',False);
+  AssertField2([]);
+  AssertRecordField(0,[hdeprecated])
+end;
+
+procedure TTestRecordTypeParser.TestVariantNoStorage;
+begin
+  DoTestVariantNoStorage('');
+end;
+
+procedure TTestRecordTypeParser.TestVariantNoStorageDeprecated;
+
+begin
+  DoTestVariantNoStorage('deprecated');
+end;
+
+procedure TTestRecordTypeParser.TestVariantNoStoragePlatform;
+
+begin
+  DoTestVariantNoStorage('platform');
+end;
+
+procedure TTestRecordTypeParser.TestVariantStorage;
+begin
+  DoTestVariantStorage('');
+end;
+
+procedure TTestRecordTypeParser.TestVariantStorageDeprecated;
+begin
+  DoTestVariantStorage('deprecated');
+
+end;
+
+procedure TTestRecordTypeParser.TestVariantStoragePlatform;
+begin
+  DoTestVariantStorage('platform');
+end;
+
+procedure TTestRecordTypeParser.TestDeprecatedVariantNoStorage;
+begin
+  DoTestDeprecatedVariantNoStorage('');
+end;
+
+procedure TTestRecordTypeParser.TestDeprecatedVariantNoStorageDeprecated;
+begin
+  DoTestDeprecatedVariantNoStorage('Deprecated');
+end;
+
+procedure TTestRecordTypeParser.TestDeprecatedVariantNoStoragePlatform;
+begin
+  DoTestDeprecatedVariantNoStorage('Platform');
+end;
+
+procedure TTestRecordTypeParser.TestDeprecatedVariantStorage;
+begin
+  DoTestDeprecatedVariantStorage('');
+end;
+
+procedure TTestRecordTypeParser.TestDeprecatedVariantStorageDeprecated;
+begin
+  DoTestDeprecatedVariantStorage('Deprecated');
+end;
+
+procedure TTestRecordTypeParser.TestDeprecatedVariantStoragePlatform;
+begin
+  DoTestDeprecatedVariantStorage('Platform');
+end;
+
+procedure TTestRecordTypeParser.TestTwoVariantsNoStorage;
+begin
+  DoTestTwoVariantsNoStorage('');
+end;
+
+procedure TTestRecordTypeParser.TestTwoVariantsNoStorageDeprecated;
+begin
+  DoTestTwoVariantsNoStorage('deprecated');
+end;
+
+procedure TTestRecordTypeParser.TestTwoVariantsNoStoragePlatform;
+begin
+  DoTestTwoVariantsNoStorage('platform');
+end;
+
+procedure TTestRecordTypeParser.TestTwoVariantsStorage;
+begin
+  DoTestTwoVariantsStorage('');
+end;
+
+procedure TTestRecordTypeParser.TestTwoVariantsStorageDeprecated;
+begin
+  DoTestTwoVariantsStorage('deprecated');
+end;
+
+procedure TTestRecordTypeParser.TestTwoVariantsStoragePlatform;
+begin
+  DoTestTwoVariantsStorage('platform');
+end;
+
+procedure TTestRecordTypeParser.TestTwoVariantsFirstDeprecatedStorage;
+begin
+  DoTestTwoVariantsFirstDeprecatedStorage('');
+end;
+
+procedure TTestRecordTypeParser.TestTwoVariantsFirstDeprecatedStorageDeprecated;
+begin
+  DoTestTwoVariantsFirstDeprecatedStorage('deprecated');
+end;
+
+procedure TTestRecordTypeParser.TestTwoVariantsFirstDeprecatedStoragePlatform;
+begin
+  DoTestTwoVariantsFirstDeprecatedStorage('platform');
+end;
+
+procedure TTestRecordTypeParser.TestTwoVariantsSecondDeprecatedStorage;
+begin
+  DoTestTwoVariantsSecondDeprecatedStorage('');
+end;
+
+procedure TTestRecordTypeParser.TestTwoVariantsSecondDeprecatedStorageDeprecated;
+begin
+  DoTestTwoVariantsSecondDeprecatedStorage('deprecated');
+end;
+
+procedure TTestRecordTypeParser.TestTwoVariantsSecondDeprecatedStoragePlatform;
+begin
+  DoTestTwoVariantsSecondDeprecatedStorage('platform');
+end;
+
+procedure TTestRecordTypeParser.TestVariantTwoLabels;
+begin
+  DoTestVariantTwoLabels('');
+end;
+
+procedure TTestRecordTypeParser.TestVariantTwoLabelsDeprecated;
+begin
+  DoTestVariantTwoLabels('Deprecated');
+end;
+
+procedure TTestRecordTypeParser.TestVariantTwoLabelsPlatform;
+begin
+  DoTestVariantTwoLabels('Platform');
+end;
+
+procedure TTestRecordTypeParser.TestTwoVariantsTwoLabels;
+begin
+  DoTestTwoVariantsTwoLabels('');
+end;
+
+procedure TTestRecordTypeParser.TestTwoVariantsTwoLabelsDeprecated;
+begin
+  DoTestTwoVariantsTwoLabels('Deprecated');
+end;
+
+procedure TTestRecordTypeParser.TestTwoVariantsTwoLabelsPlatform;
+begin
+  DoTestTwoVariantsTwoLabels('Platform');
+end;
+
+procedure TTestRecordTypeParser.TestVariantNestedRecord;
+begin
+  DoTestVariantNestedRecord('');
+end;
+
+procedure TTestRecordTypeParser.TestVariantNestedRecordDeprecated;
+begin
+  DoTestVariantNestedRecord('Deprecated');
+end;
+
+procedure TTestRecordTypeParser.TestVariantNestedRecordPlatform;
+begin
+  DoTestVariantNestedRecord('Platform');
+end;
+
+procedure TTestRecordTypeParser.TestVariantNestedVariant;
+begin
+  DoTestVariantNestedVariant('');
+end;
+
+procedure TTestRecordTypeParser.TestVariantNestedVariantDeprecated;
+begin
+  DoTestVariantNestedVariant('deprecated');
+end;
+
+procedure TTestRecordTypeParser.TestVariantNestedVariantPlatForm;
+begin
+  DoTestVariantNestedVariant('Platform');
+end;
+
+procedure TTestRecordTypeParser.TestVariantNestedVariantFirstDeprecated;
+begin
+  DoTestVariantNestedVariantFirstDeprecated('');
+end;
+
+procedure TTestRecordTypeParser.TestVariantNestedVariantFirstDeprecatedDeprecated;
+begin
+  DoTestVariantNestedVariantFirstDeprecated('deprecated');
+end;
+
+procedure TTestRecordTypeParser.TestVariantNestedVariantFirstDeprecatedPlatform;
+begin
+  DoTestVariantNestedVariantFirstDeprecated('platform');
+end;
+
+procedure TTestRecordTypeParser.TestVariantNestedVariantSecondDeprecated;
+begin
+  DoTestVariantNestedVariantSecondDeprecated('');
+end;
+
+procedure TTestRecordTypeParser.TestVariantNestedVariantSecondDeprecatedDeprecated;
+begin
+  DoTestVariantNestedVariantSecondDeprecated('deprecated');
+end;
+
+procedure TTestRecordTypeParser.TestVariantNestedVariantSecondDeprecatedPlatform;
+begin
+  DoTestVariantNestedVariantSecondDeprecated('platform');
+end;
+
+procedure TTestRecordTypeParser.TestVariantNestedVariantBothDeprecated;
+begin
+  DoTestVariantNestedVariantBothDeprecated('');
+end;
+
+procedure TTestRecordTypeParser.TestVariantNestedVariantBothDeprecatedDeprecated;
+begin
+  DoTestVariantNestedVariantBothDeprecated('deprecated');
+end;
+
+procedure TTestRecordTypeParser.TestVariantNestedVariantBothDeprecatedPlatform;
+begin
+  DoTestVariantNestedVariantBothDeprecated('platform');
+end;
+
+{ TBaseTestTypeParser }
+
+function TBaseTestTypeParser.ParseType(ASource: String; ATypeClass: TClass;Const AHint : String = ''): TPasType;
+
+Var
+  D : String;
+begin
+  Hint:=AHint;
+  Add('Type');
+  D:='A = '+ASource;
+  If Hint<>'' then
+    D:=D+' '+Hint;
+  Add('  '+D+';');
+//  Writeln(source.text);
+  ParseDeclarations;
+  AssertEquals('One type definition',1,Declarations.Types.Count);
+  If (AtypeClass<>Nil) then
+    AssertEquals('First declaration is type definition.',ATypeClass,TObject(Declarations.Types[0]).ClassType);
+  AssertEquals('First declaration has correct name.','A',TPasType(Declarations.Types[0]).Name);
+  Result:=TPasType(Declarations.Types[0]);
+  FType:=Result;
+  Definition:=Result;
+  if (Hint<>'') then
+    CheckHint(TPasMemberHint(Getenumvalue(typeinfo(TPasMemberHint),'h'+Hint)));
+end;
+
+procedure TBaseTestTypeParser.AssertParseTypeError(ASource: String);
+begin
+  try
+    ParseType(ASource,Nil,'');
+    Fail('Expected parser error');
+  except
+    // all OK.
+  end;
+end;
+
+procedure TBaseTestTypeParser.SetUp;
+begin
+  Inherited;
+  FErrorSource:='';
+  FHint:='';
+  FType:=Nil;
+end;
+
+procedure TBaseTestTypeParser.TearDown;
+begin
+  inherited TearDown;
+  FType:=Nil;
+end;
+
+{ TTestTypeParser }
+
+procedure TTestTypeParser.DoTestAliasType(const AnAliasType: String;
+  const AHint: String);
+begin
+  ParseType(AnAliasType,TPasAliasType,AHint);
+  AssertEquals('Unresolved type',TPasUnresolvedTypeRef,TPasAliasType(TheType).DestType.ClassType);
+end;
+
+procedure TTestTypeParser.DoTestStringType(const AnAliasType: String;
+  const AHint: String);
+begin
+  ParseType(AnAliasType,TPasAliasType,AHint);
+  AssertEquals('String type',TPasStringType,TPasAliasType(TheType).DestType.ClassType);
+end;
+
+procedure TTestTypeParser.DoTypeError(Const AMsg,ASource : string);
+
+begin
+  FErrorSource:=ASource;
+  AssertException(AMsg,EParserError,@DoParseError);
+end;
+
+procedure TTestTypeParser.DoParseError;
+begin
+  ParseType(FErrorSource,Nil);
+end;
+
+procedure TTestTypeParser.DoParsePointer(const ASource: String;
+  const AHint: String; ADestType: TClass);
+
+begin
+  ParseType('^'+ASource,TPasPointerType,AHint);
+  if ADestType = Nil then
+    ADestType:=TPasUnresolvedTypeRef;
+  AssertEquals('Destination type '+ADestType.ClassName,ADestType,TPasPointerType(TheType).DestType.ClassType);
+end;
+
+procedure TTestTypeParser.DoParseArray(const ASource: String;
+  const AHint: String; ADestType: TClass);
+begin
+  ParseType(ASource,TPasArrayType,AHint);
+  if ADestType = Nil then
+    ADestType:=TPasUnresolvedTypeRef;
+  AssertEquals('Destination type '+ADestType.ClassName,ADestType,TPasArrayType(TheType).ElType.ClassType);
+end;
+
+procedure TTestTypeParser.DoParseEnumerated(const ASource: String;
+  const AHint: String; ACount: integer);
+
+Var
+  I : Integer;
+
+begin
+  ParseType(ASource,TPasEnumType,AHint);
+  AssertNotNull('Have values',TPasEnumType(TheType).Values);
+  AssertEquals('Value count',ACount,TPasEnumType(TheType).Values.Count);
+  For I:=0 to TPasEnumType(TheType).Values.Count-1 do
+    AssertEquals('Enum value typed element '+IntToStr(I),TPasEnumValue,TObject(TPasEnumType(TheType).Values[i]).ClassType);
+end;
+
+procedure TTestTypeParser.DoTestFileType(const AType: String;
+  const AHint: String; ADestType: TClass);
+begin
+  ParseType('File of '+AType,TPasFileType,AHint);
+  AssertNotNull('Have element type',TPasFileType(TheType).ElType);
+  if ADestType = Nil then
+    ADestType:=TPasUnresolvedTypeRef;
+  AssertEquals('Element type '+ADestType.ClassName,ADestType,TPasFileType(TheType).ElType.ClassType);
+end;
+
+procedure TTestTypeParser.DoTestRangeType(const AStart, AStop, AHint: String);
+begin
+  ParseType(AStart+'..'+AStop,TPasRangeType,AHint);
+  AssertEquals('Range start',AStart,TPasRangeType(TheType).RangeStart);
+  AssertEquals('Range start',AStop,TPasRangeType(TheType).RangeEnd);
+end;
+
+procedure TTestTypeParser.DoParseSimpleSet(const ASource: String;
+  const AHint: String);
+begin
+  ParseType('Set of '+ASource,TPasSetType,AHint);
+  AssertNotNull('Have enumtype',TPasSetType(TheType).EnumType);
+  AssertEquals('Element type ',TPasUnresolvedTypeRef,TPasSetType(TheType).EnumType.ClassType);
+end;
+
+procedure TTestTypeParser.DoParseComplexSet(const ASource: String;
+  const AHint: String);
+
+begin
+  ParseType('Set of '+ASource,TPasSetType,AHint);
+  AssertNotNull('Have enumtype',TPasSetType(TheType).EnumType);
+  AssertEquals('Element type ',TPasEnumType,TPasSetType(TheType).EnumType.ClassType);
+end;
+
+procedure TTestTypeParser.DoParseRangeSet(const ASource: String;
+  const AHint: String);
+
+begin
+  ParseType('Set of '+ASource,TPasSetType,AHint);
+  AssertNotNull('Have enumtype',TPasSetType(TheType).EnumType);
+  AssertEquals('Element type ',TPasRangeType,TPasSetType(TheType).EnumType.ClassType);
+end;
+
+procedure TTestTypeParser.DoTestComplexSet;
+
+Var
+  I : integer;
+
+begin
+  AssertNotNull('Have values',TPasEnumType(TPasSetType(TheType).EnumType).Values);
+  AssertEquals('Have 3 values',3, TPasEnumType(TPasSetType(TheType).EnumType).Values.Count);
+  For I:=0 to TPasEnumType(TPasSetType(TheType).EnumType).Values.Count-1 do
+    AssertEquals('Enum value typed element '+IntToStr(I),TPasEnumValue,TObject(TPasEnumType(TPasSetType(TheType).EnumType).Values[i]).ClassType);
+  AssertEquals('First enumerated value','one',TPasEnumValue(TPasEnumType(TPasSetType(TheType).EnumType).Values[0]).Name);
+  AssertEquals('Second enumerated value','two',TPasEnumValue(TPasEnumType(TPasSetType(TheType).EnumType).Values[1]).Name);
+  AssertEquals('Third enumerated value','three',TPasEnumValue(TPasEnumType(TPasSetType(TheType).EnumType).Values[2]).Name);
+  AssertEquals('Assigned value first enumerated empty','',TPasEnumValue(TPasEnumType(TPasSetType(TheType).EnumType).Values[0]).AssignedValue);
+  AssertEquals('Assigned value second enumerated empty','',TPasEnumValue(TPasEnumType(TPasSetType(TheType).EnumType).Values[1]).AssignedValue);
+  AssertEquals('Assigned value third enumerated empty','',TPasEnumValue(TPasEnumType(TPasSetType(TheType).EnumType).Values[2]).AssignedValue);
+end;
+
+procedure TTestTypeParser.DoTestClassOf(const AHint: string);
+
+begin
+  ParseType('Class of TSomeClass',TPasClassOfType,AHint);
+  AssertNotNull('Have class type',TPasClassOfType(TheType).DestType);
+  AssertEquals('Element type ',TPasUnresolvedTypeRef,TPasClassOfType(TheType).DestType.ClassType);
+end;
+
+procedure TTestTypeParser.TestAliasType;
+begin
+  DoTestAliasType('othertype','');
+  AssertEquals('Unresolved type name ','othertype',TPasUnresolvedTypeRef(TPasAliasType(TheType).DestType).name);
+end;
+
+procedure TTestTypeParser.TestCrossUnitAliasType;
+begin
+  DoTestAliasType('otherunit.othertype','');
+end;
+
+procedure TTestTypeParser.TestAliasTypeDeprecated;
+begin
+  DoTestALiasType('othertype','deprecated');
+end;
+
+procedure TTestTypeParser.TestAliasTypePlatform;
+begin
+  DoTestALiasType('othertype','platform');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeByte;
+begin
+  DoTestAliasType('BYTE','');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeByteDeprecated;
+begin
+  DoTestAliasType('BYTE','deprecated');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeBytePlatform;
+begin
+  DoTestAliasType('BYTE','platform');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeBoolean;
+begin
+  DoTestAliasType('BOOLEAN','');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeBooleanDeprecated;
+begin
+  DoTestAliasType('BOOLEAN','deprecated');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeBooleanPlatform;
+begin
+  DoTestAliasType('BOOLEAN','platform');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeChar;
+begin
+  DoTestAliasType('CHAR','');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeCharDeprecated;
+begin
+  DoTestAliasType('CHAR','deprecated');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeCharPlatform;
+begin
+  DoTestAliasType('CHAR','platform');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeInteger;
+begin
+  DoTestAliasType('INTEGER','');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeIntegerDeprecated;
+begin
+  DoTestAliasType('INTEGER','deprecated');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeIntegerPlatform;
+begin
+  DoTestAliasType('INTEGER','platform');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeInt64;
+begin
+  DoTestAliasType('INT64','');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeInt64Deprecated;
+begin
+  DoTestAliasType('INT64','deprecated');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeInt64Platform;
+begin
+  DoTestAliasType('INT64','platform');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeLongInt;
+begin
+  DoTestAliasType('LONGINT','');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeLongIntDeprecated;
+begin
+  DoTestAliasType('LONGINT','deprecated');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeLongIntPlatform;
+begin
+  DoTestAliasType('LONGINT','platform');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeLongWord;
+begin
+  DoTestAliasType('LONGWORD','');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeLongWordDeprecated;
+begin
+  DoTestAliasType('LONGWORD','deprecated');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeLongWordPlatform;
+begin
+  DoTestAliasType('LONGWORD','platform');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeDouble;
+begin
+  DoTestAliasType('Double','');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeDoubleDeprecated;
+begin
+  DoTestAliasType('Double','deprecated');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeDoublePlatform;
+begin
+  DoTestAliasType('Double','platform');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeShortInt;
+begin
+  DoTestAliasType('SHORTINT','');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeShortIntDeprecated;
+begin
+  DoTestAliasType('SHORTINT','deprecated');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeShortIntPlatform;
+begin
+  DoTestAliasType('SHORTINT','platform');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeSmallInt;
+begin
+  DoTestAliasType('SMALLINT','');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeSmallIntDeprecated;
+begin
+  DoTestAliasType('SMALLINT','deprecated');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeSmallIntPlatform;
+begin
+  DoTestAliasType('SMALLINT','platform');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeString;
+begin
+  DoTestAliasType('STRING','');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeStringDeprecated;
+begin
+  DoTestAliasType('STRING','deprecated');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeStringPlatform;
+begin
+  DoTestAliasType('STRING','platform');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeStringSize;
+begin
+  DoTestStringType('String[10]','');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeStringSizeIncomplete;
+begin
+  DoTypeError('Incomplete string: missing ]','string[10');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeStringSizeWrong;
+begin
+  DoTypeError('Incomplete string, ) instead of ]','string[10)');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeStringSizeDeprecated;
+begin
+  DoTestStringType('String[10]','deprecated');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeStringSizePlatform;
+begin
+  DoTestStringType('String[10]','Platform');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeWord;
+BEGIN
+  DoTestAliasType('WORD','');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeWordDeprecated;
+begin
+  DoTestAliasType('WORD','deprecated');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeWordPlatform;
+begin
+  DoTestAliasType('WORD','platform');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeQWord;
+BEGIN
+  DoTestAliasType('QWORD','');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeQWordDeprecated;
+begin
+  DoTestAliasType('QWORD','deprecated');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeQWordPlatform;
+begin
+  DoTestAliasType('QWORD','platform');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeCardinal;
+begin
+  DoTestAliasType('CARDINAL','');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeCardinalDeprecated;
+begin
+  DoTestAliasType('CARDINAL','deprecated');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeCardinalPlatform;
+begin
+  DoTestAliasType('CARDINAL','platform');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeWideChar;
+begin
+  DoTestAliasType('WIDECHAR','');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeWideCharDeprecated;
+begin
+  DoTestAliasType('WIDECHAR','deprecated');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeWideCharPlatform;
+begin
+  DoTestAliasType('WIDECHAR','platform');
+end;
+
+procedure TTestTypeParser.TestPointerSimple;
+begin
+  DoParsePointer('integer','');
+end;
+
+procedure TTestTypeParser.TestPointerSimpleDeprecated;
+begin
+  DoParsePointer('integer','deprecated');
+end;
+
+procedure TTestTypeParser.TestPointerSimplePlatform;
+begin
+  DoParsePointer('integer','platform');
+end;
+
+procedure TTestTypeParser.TestStaticArray;
+begin
+  DoParseArray('array [0..2] of integer','',Nil);
+  AssertEquals('Array type','0..2',TPasArrayType(TheType).IndexRange);
+end;
+
+procedure TTestTypeParser.TestStaticArrayDeprecated;
+begin
+  DoParseArray('array [0..2] of integer','deprecated',Nil);
+  AssertEquals('Array type','0..2',TPasArrayType(TheType).IndexRange);
+end;
+
+procedure TTestTypeParser.TestStaticArrayPlatform;
+begin
+  DoParseArray('array [0..2] of integer','platform',Nil);
+  AssertEquals('Array type','0..2',TPasArrayType(TheType).IndexRange);
+end;
+
+procedure TTestTypeParser.TestStaticArrayPacked;
+begin
+  DoParseArray('packed array [0..2] of integer','',Nil);
+  AssertEquals('Array type','0..2',TPasArrayType(TheType).IndexRange);
+  AssertEquals('Packed',True,TPasArrayType(TheType).IsPacked);
+end;
+
+procedure TTestTypeParser.TestStaticArrayTypedIndex;
+begin
+  DoParseArray('array [Boolean] of integer','',Nil);
+  AssertEquals('Array type','Boolean',TPasArrayType(TheType).IndexRange);
+end;
+
+procedure TTestTypeParser.TestDynamicArray;
+begin
+  DoParseArray('array of integer','',Nil);
+  AssertEquals('Array type','',TPasArrayType(TheType).IndexRange);
+end;
+
+procedure TTestTypeParser.TestSimpleEnumerated;
+
+begin
+  DoParseEnumerated('(one,two,three)','',3);
+  AssertEquals('First enumerated value','one',TPasEnumValue(TPasEnumType(TheType).Values[0]).Name);
+  AssertEquals('Second enumerated value','two',TPasEnumValue(TPasEnumType(TheType).Values[1]).Name);
+  AssertEquals('Third enumerated value','three',TPasEnumValue(TPasEnumType(TheType).Values[2]).Name);
+  AssertEquals('Assigned value first enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[0]).AssignedValue);
+  AssertEquals('Assigned value second enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[1]).AssignedValue);
+  AssertEquals('Assigned value third enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[2]).AssignedValue);
+end;
+
+procedure TTestTypeParser.TestSimpleEnumeratedDeprecated;
+begin
+  DoParseEnumerated('(one,two,three)','deprecated',3);
+  AssertEquals('First enumerated value','one',TPasEnumValue(TPasEnumType(TheType).Values[0]).Name);
+  AssertEquals('Second enumerated value','two',TPasEnumValue(TPasEnumType(TheType).Values[1]).Name);
+  AssertEquals('Third enumerated value','three',TPasEnumValue(TPasEnumType(TheType).Values[2]).Name);
+  AssertEquals('Assigned value first enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[0]).AssignedValue);
+  AssertEquals('Assigned value second enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[1]).AssignedValue);
+  AssertEquals('Assigned value third enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[2]).AssignedValue);
+end;
+
+procedure TTestTypeParser.TestSimpleEnumeratedPlatform;
+begin
+  DoParseEnumerated('(one,two,three)','platform',3);
+  AssertEquals('First enumerated value','one',TPasEnumValue(TPasEnumType(TheType).Values[0]).Name);
+  AssertEquals('Second enumerated value','two',TPasEnumValue(TPasEnumType(TheType).Values[1]).Name);
+  AssertEquals('Third enumerated value','three',TPasEnumValue(TPasEnumType(TheType).Values[2]).Name);
+  AssertEquals('Assigned value first enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[0]).AssignedValue);
+  AssertEquals('Assigned value second enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[1]).AssignedValue);
+  AssertEquals('Assigned value third enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[2]).AssignedValue);
+end;
+
+procedure TTestTypeParser.TestAssignedEnumerated;
+begin
+  DoParseEnumerated('(one,two:=2,three)','',3);
+  AssertEquals('First enumerated value','one',TPasEnumValue(TPasEnumType(TheType).Values[0]).Name);
+  AssertEquals('Assigned value first enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[0]).AssignedValue);
+  AssertEquals('Second enumerated value','two',TPasEnumValue(TPasEnumType(TheType).Values[1]).Name);
+  AssertEquals('Assigned value enumerated','2',TPasEnumValue(TPasEnumType(TheType).Values[1]).AssignedValue);
+  AssertEquals('Third enumerated value','three',TPasEnumValue(TPasEnumType(TheType).Values[2]).Name);
+  AssertEquals('Assigned value first enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[2]).AssignedValue);
+end;
+
+procedure TTestTypeParser.TestAssignedEnumeratedDeprecated;
+begin
+  DoParseEnumerated('(one,two:=2,three)','',3);
+  AssertEquals('First enumerated value','one',TPasEnumValue(TPasEnumType(TheType).Values[0]).Name);
+  AssertEquals('Assigned value first enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[0]).AssignedValue);
+  AssertEquals('Second enumerated value','two',TPasEnumValue(TPasEnumType(TheType).Values[1]).Name);
+  AssertEquals('Assigned value enumerated','2',TPasEnumValue(TPasEnumType(TheType).Values[1]).AssignedValue);
+  AssertEquals('Third enumerated value','three',TPasEnumValue(TPasEnumType(TheType).Values[2]).Name);
+  AssertEquals('Assigned value first enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[2]).AssignedValue);
+end;
+
+procedure TTestTypeParser.TestAssignedEnumeratedPlatform;
+begin
+  DoParseEnumerated('(one,two:=2,three)','',3);
+  AssertEquals('First enumerated value','one',TPasEnumValue(TPasEnumType(TheType).Values[0]).Name);
+  AssertEquals('Assigned value first enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[0]).AssignedValue);
+  AssertEquals('Second enumerated value','two',TPasEnumValue(TPasEnumType(TheType).Values[1]).Name);
+  AssertEquals('Assigned value enumerated','2',TPasEnumValue(TPasEnumType(TheType).Values[1]).AssignedValue);
+  AssertEquals('Third enumerated value','three',TPasEnumValue(TPasEnumType(TheType).Values[2]).Name);
+  AssertEquals('Assigned value first enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[2]).AssignedValue);
+end;
+
+procedure TTestTypeParser.TestFileType;
+begin
+  DoTestFileType('integer','');
+end;
+
+procedure TTestTypeParser.TestFileTypeDeprecated;
+begin
+  DoTestFileType('integer','deprecated');
+end;
+
+procedure TTestTypeParser.TestFileTypePlatform;
+begin
+  DoTestFileType('integer','platform');
+end;
+
+procedure TTestTypeParser.TestRangeType;
+begin
+  DoTestRangeType('1','4','');
+end;
+
+procedure TTestTypeParser.TestRangeTypeDeprecated;
+begin
+  DoTestRangeType('1','4','deprecated');
+end;
+
+procedure TTestTypeParser.TestRangeTypePlatform;
+begin
+  DoTestRangeType('1','4','platform');
+end;
+
+procedure TTestTypeParser.TestIdentifierRangeType;
+begin
+  DoTestRangeType('tkFirst','tkLast','');
+end;
+
+procedure TTestTypeParser.TestIdentifierRangeTypeDeprecated;
+begin
+  DoTestRangeType('tkFirst','tkLast','deprecated');
+end;
+
+procedure TTestTypeParser.TestIdentifierRangeTypePlatform;
+begin
+  DoTestRangeType('tkFirst','tkLast','platform');
+end;
+
+procedure TTestTypeParser.TestNegativeIdentifierRangeType;
+begin
+  DoTestRangeType('-tkLast','tkLast','');
+end;
+
+procedure TTestTypeParser.TestSimpleSet;
+begin
+  DoParseSimpleSet('Byte','');
+end;
+
+procedure TTestTypeParser.TestSimpleSetDeprecated;
+begin
+  DoParseSimpleSet('Byte','deprecated');
+end;
+
+procedure TTestTypeParser.TestSimpleSetPlatform;
+begin
+  DoParseSimpleSet('Byte','platform');
+end;
+
+
+procedure TTestTypeParser.TestComplexSet;
+
+
+begin
+  DoParseComplexSet('(one, two, three)','');
+  DoTestComplexSet;
+end;
+
+procedure TTestTypeParser.TestComplexSetDeprecated;
+
+begin
+  DoParseComplexSet('(one, two, three)','deprecated');
+  DoTestComplexSet;
+end;
+
+procedure TTestTypeParser.TestComplexSetPlatform;
+
+begin
+  DoParseComplexSet('(one, two, three)','platform');
+  DoTestComplexSet;
+end;
+
+procedure TTestTypeParser.TestRangeSet;
+begin
+  DoParseRangeSet('0..SizeOf(Integer)*8-1','');
+end;
+
+procedure TTestTypeParser.TestRangeSetDeprecated;
+begin
+  DoParseRangeSet('0..SizeOf(Integer)*8-1','deprecated');
+end;
+
+procedure TTestTypeParser.TestRangeSetPlatform;
+begin
+  DoParseRangeSet('0..SizeOf(Integer)*8-1','platform');
+end;
+
+procedure TTestTypeParser.TestClassOf;
+begin
+  DoTestClassOf('');
+end;
+
+procedure TTestTypeParser.TestClassOfDeprecated;
+begin
+  DoTestClassOf('deprecated');
+end;
+
+procedure TTestTypeParser.TestClassOfPlatform;
+begin
+  DoTestClassOf('Platform');
+end;
+
+procedure TTestTypeParser.TestReferenceAlias;
+begin
+  Add('Type');
+  Add(' Type1 = Integer;');
+  Add(' Type2 = Type1;');
+  Add('end.');
+  ParseDeclarations;
+  AssertEquals('Two type definitions',2,Declarations.Types.Count);
+  AssertEquals('First declaration is type definition.',TPasAliasType,TObject(Declarations.Types[0]).ClassType);
+  AssertEquals('Second declaration is type definition.',TPasAliasType,TObject(Declarations.Types[1]).ClassType);
+  AssertEquals('First declaration has correct name.','Type1',TPasType(Declarations.Types[0]).Name);
+  AssertEquals('Second declaration has correct name.','Type2',TPasType(Declarations.Types[1]).Name);
+  AssertSame('Second declaration references first.',Declarations.Types[0],TPasAliasType(Declarations.Types[1]).DestType);
+end;
+
+procedure TTestTypeParser.TestReferenceSet;
+
+begin
+  Add('Type');
+  Add(' Type1 = (a,b,c);');
+  Add(' Type2 = set of Type1;');
+  Add('end.');
+  ParseDeclarations;
+  AssertEquals('Two type definitions',2,Declarations.Types.Count);
+  AssertEquals('First declaration is type definition.',TPasEnumType,TObject(Declarations.Types[0]).ClassType);
+  AssertEquals('Second declaration is type definition.',TPasSetType,TObject(Declarations.Types[1]).ClassType);
+  AssertEquals('First declaration has correct name.','Type1',TPasType(Declarations.Types[0]).Name);
+  AssertEquals('Second declaration has correct name.','Type2',TPasType(Declarations.Types[1]).Name);
+  AssertSame('Second declaration references first.',Declarations.Types[0],TPasSetType(Declarations.Types[1]).EnumType);
+end;
+
+procedure TTestTypeParser.TestReferenceClassOf;
+begin
+  Add('Type');
+  Add(' Type1 = Class(TObject);');
+  Add(' Type2 = Class of Type1;');
+  Add('end.');
+  ParseDeclarations;
+  AssertEquals('1 type definitions',1,Declarations.Types.Count);
+  AssertEquals('1 class definitions',1,Declarations.Classes.Count);
+  AssertEquals('First declaration is class definition.',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
+  AssertEquals('Second declaration is type definition.',TPasClassOfType,TObject(Declarations.Types[0]).ClassType);
+  AssertEquals('First declaration has correct name.','Type2',TPasType(Declarations.Types[0]).Name);
+  AssertEquals('Second declaration has correct name.','Type1',TPasType(Declarations.Classes[0]).Name);
+  AssertSame('Second declaration references first.',Declarations.Classes[0],TPasClassOfType(Declarations.Types[0]).DestType);
+end;
+
+procedure TTestTypeParser.TestReferenceFile;
+begin
+  Add('Type');
+  Add(' Type1 = (a,b,c);');
+  Add(' Type2 = File of Type1;');
+  Add('end.');
+  ParseDeclarations;
+  AssertEquals('Two type definitions',2,Declarations.Types.Count);
+  AssertEquals('First declaration is type definition.',TPasEnumType,TObject(Declarations.Types[0]).ClassType);
+  AssertEquals('Second declaration is type definition.',TPasFileType,TObject(Declarations.Types[1]).ClassType);
+  AssertEquals('First declaration has correct name.','Type1',TPasType(Declarations.Types[0]).Name);
+  AssertEquals('Second declaration has correct name.','Type2',TPasType(Declarations.Types[1]).Name);
+  AssertSame('Second declaration references first.',Declarations.Types[0],TPasFileType(Declarations.Types[1]).elType);
+end;
+
+procedure TTestTypeParser.TestReferenceArray;
+begin
+  Add('Type');
+  Add(' Type1 = (a,b,c);');
+  Add(' Type2 = Array of Type1;');
+  Add('end.');
+  ParseDeclarations;
+  AssertEquals('Two type definitions',2,Declarations.Types.Count);
+  AssertEquals('First declaration is type definition.',TPasEnumType,TObject(Declarations.Types[0]).ClassType);
+  AssertEquals('Second declaration is type definition.',TPasArrayType,TObject(Declarations.Types[1]).ClassType);
+  AssertEquals('First declaration has correct name.','Type1',TPasType(Declarations.Types[0]).Name);
+  AssertEquals('Second declaration has correct name.','Type2',TPasType(Declarations.Types[1]).Name);
+  AssertSame('Second declaration references first.',Declarations.Types[0],TPasArrayType(Declarations.Types[1]).elType);
+end;
+
+procedure TTestTypeParser.TestReferencePointer;
+begin
+  Add('Type');
+  Add(' Type1 = (a,b,c);');
+  Add(' Type2 = ^Type1;');
+  Add('end.');
+  ParseDeclarations;
+  AssertEquals('Two type definitions',2,Declarations.Types.Count);
+  AssertEquals('First declaration is type definition.',TPasEnumType,TObject(Declarations.Types[0]).ClassType);
+  AssertEquals('Second declaration is type definition.',TPasPointerType,TObject(Declarations.Types[1]).ClassType);
+  AssertEquals('First declaration has correct name.','Type1',TPasType(Declarations.Types[0]).Name);
+  AssertEquals('Second declaration has correct name.','Type2',TPasType(Declarations.Types[1]).Name);
+  AssertSame('Second declaration references first.',Declarations.Types[0],TPasPointerType(Declarations.Types[1]).DestType);
+end;
+
+
+initialization
+  RegisterTests([TTestTypeParser,TTestRecordTypeParser,TTestProcedureTypeParser]);
+end.
+

+ 273 - 0
packages/fcl-passrc/tests/tcvarparser.pas

@@ -0,0 +1,273 @@
+unit tcvarparser;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils, pastree, pscanner, pparser,
+  tcbaseparser, testregistry;
+
+Type
+  { TTestVarParser }
+
+  TTestVarParser = Class(TTestParser)
+  private
+    FHint: string;
+    FVar: TPasVariable;
+  Protected
+    Function ParseVar(ASource : String; Const AHint : String = '') : TPasVariable; virtual; overload;
+    Procedure AssertVariableType(Const ATypeName : String);
+    Procedure AssertVariableType(Const AClass : TClass);
+    Procedure AssertParseVarError(ASource : String);
+    Property TheVar : TPasVariable Read FVar;
+    Property Hint : string Read FHint Write FHint;
+    procedure SetUp; override;
+    Procedure TearDown; override;
+  Published
+    Procedure TestSimpleVar;
+    Procedure TestSimpleVarDeprecated;
+    Procedure TestSimpleVarPlatform;
+    Procedure TestVarProcedure;
+    Procedure TestVarProcedureDeprecated;
+    Procedure TestVarRecord;
+    Procedure TestVarRecordDeprecated;
+    Procedure TestVarRecordPlatform;
+    Procedure TestVarArray;
+    Procedure TestVarArrayDeprecated;
+    Procedure TestVarDynArray;
+    Procedure TestVarExternal;
+    Procedure TestVarExternalLib;
+    Procedure TestVarExternalLibName;
+    Procedure TestVarCVar;
+    Procedure TestVarCVarExternal;
+    Procedure TestVarPublic;
+    Procedure TestVarPublicName;
+    Procedure TestVarDeprecatedExternalName;
+  end;
+
+implementation
+
+uses typinfo;
+
+{ TTestVarParser }
+
+function TTestVarParser.ParseVar(ASource: String; const AHint: String
+  ): TPasVariable;
+Var
+  D : String;
+begin
+  Hint:=AHint;
+  Add('Var');
+  D:='A : '+ASource;
+  If Hint<>'' then
+    D:=D+' '+Hint;
+  Add('  '+D+';');
+//  Writeln(source.text);
+  ParseDeclarations;
+  AssertEquals('One variable definition',1,Declarations.Variables.Count);
+  AssertEquals('First declaration is type definition.',TPasVariable,TObject(Declarations.Variables[0]).ClassType);
+  Result:=TPasVariable(Declarations.Variables[0]);
+  AssertEquals('First declaration has correct name.','A',Result.Name);
+  FVar:=Result;
+  Definition:=Result;
+  if (Hint<>'') then
+    CheckHint(TPasMemberHint(Getenumvalue(typeinfo(TPasMemberHint),'h'+Hint)));
+end;
+
+procedure TTestVarParser.AssertVariableType(const ATypeName: String);
+begin
+  AssertVariableType(TPasUnresolvedTypeRef);
+  AssertEquals('Correct unresolved type name',ATypeName,theVar.VarType.Name);
+end;
+
+procedure TTestVarParser.AssertVariableType(const AClass: TClass);
+begin
+  AssertNotNull('Have variable type',theVar.VarType);
+  AssertEquals('Correct type class',AClass,theVar.VarType.ClassType);
+end;
+
+procedure TTestVarParser.AssertParseVarError(ASource: String);
+begin
+  try
+    ParseVar(ASource,'');
+    Fail('Expected parser error');
+  except
+    // all OK.
+  end;
+end;
+
+procedure TTestVarParser.SetUp;
+begin
+  inherited SetUp;
+  FHint:='';
+  FVar:=Nil;
+end;
+
+procedure TTestVarParser.TearDown;
+begin
+  FVar:=Nil;
+  inherited TearDown;
+end;
+
+procedure TTestVarParser.TestSimpleVar;
+begin
+  ParseVar('b','');
+  AssertVariableType('b');
+end;
+
+procedure TTestVarParser.TestSimpleVarDeprecated;
+begin
+  ParseVar('b','deprecated');
+  AssertVariableType('b');
+end;
+
+procedure TTestVarParser.TestSimpleVarPlatform;
+begin
+  ParseVar('b','platform');
+  AssertVariableType('b');
+end;
+
+procedure TTestVarParser.TestVarProcedure;
+begin
+  ParseVar('procedure','');
+  AssertVariableType(TPasProcedureType);
+end;
+
+procedure TTestVarParser.TestVarProcedureDeprecated;
+begin
+  ParseVar('procedure','deprecated');
+  AssertVariableType(TPasProcedureType);
+end;
+
+procedure TTestVarParser.TestVarRecord;
+
+Var
+  R : TPasRecordtype;
+begin
+  ParseVar('record x,y : intger; end','');
+  AssertVariableType(TPasRecordType);
+  R:=TheVar.VarType as TPasRecordType;
+  AssertEquals('Correct number of fields',2,R.Members.Count);
+end;
+
+procedure TTestVarParser.TestVarRecordDeprecated;
+Var
+  R : TPasRecordtype;
+begin
+  ParseVar('record x,y : integer; end','deprecated');
+  AssertVariableType(TPasRecordType);
+  R:=TheVar.VarType as TPasRecordType;
+  AssertEquals('Correct number of fields',2,R.Members.Count);
+end;
+
+procedure TTestVarParser.TestVarRecordPlatform;
+Var
+  R : TPasRecordtype;
+begin
+  ParseVar('record x,y : integer; end','platform');
+  AssertVariableType(TPasRecordType);
+  R:=TheVar.VarType as TPasRecordType;
+  AssertEquals('Correct number of fields',2,R.Members.Count);
+end;
+
+procedure TTestVarParser.TestVarArray;
+
+Var
+  R : TPasArrayType;
+
+begin
+  ParseVar('Array[1..20] of integer','');
+  AssertVariableType(TPasArrayType);
+  R:=TheVar.VarType as TPasArrayType;
+  AssertNotNull('Correct array type name',R.ElType);
+  AssertEquals('Correct array type name',TPasunresolvedTypeRef,R.ElType.ClassType);
+end;
+
+procedure TTestVarParser.TestVarArrayDeprecated;
+
+Var
+  R : TPasArrayType;
+
+begin
+  ParseVar('Array[1..20] of integer','Deprecated');
+  AssertVariableType(TPasArrayType);
+  R:=TheVar.VarType as TPasArrayType;
+  AssertNotNull('Correct array type name',R.ElType);
+  AssertEquals('Correct array type name',TPasunresolvedTypeRef,R.ElType.ClassType);
+end;
+
+procedure TTestVarParser.TestVarDynArray;
+
+Var
+  R : TPasArrayType;
+
+begin
+  ParseVar('Array of integer','');
+  AssertVariableType(TPasArrayType);
+  R:=TheVar.VarType as TPasArrayType;
+  AssertEquals('No index','',R.IndexRange);
+  AssertNotNull('Correct array type name',R.ElType);
+  AssertEquals('Correct array type name',TPasunresolvedTypeRef,R.ElType.ClassType);
+end;
+
+procedure TTestVarParser.TestVarExternal;
+begin
+  ParseVar('integer; external','');
+  AssertEquals('Variable modifiers',[vmexternal],TheVar.VarModifiers);
+end;
+
+procedure TTestVarParser.TestVarExternalLib;
+begin
+  ParseVar('integer; external name ''mylib''','');
+  AssertEquals('Variable modifiers',[vmexternal],TheVar.VarModifiers);
+  AssertEquals('Library name','',TheVar.LibraryName);
+  AssertEquals('Library name','''mylib''',TheVar.ExportName);
+end;
+
+procedure TTestVarParser.TestVarExternalLibName;
+begin
+  ParseVar('integer; external ''mylib'' name ''d''','');
+  AssertEquals('Variable modifiers',[vmexternal],TheVar.VarModifiers);
+  AssertEquals('Library name','''mylib''',TheVar.LibraryName);
+  AssertEquals('Library name','''d''',TheVar.ExportName);
+end;
+
+procedure TTestVarParser.TestVarCVar;
+begin
+  ParseVar('integer; cvar','');
+  AssertEquals('Variable modifiers',[vmcvar],TheVar.VarModifiers);
+end;
+
+procedure TTestVarParser.TestVarCVarExternal;
+begin
+  ParseVar('integer; cvar;external','');
+  AssertEquals('Variable modifiers',[vmcvar,vmexternal],TheVar.VarModifiers);
+end;
+
+procedure TTestVarParser.TestVarPublic;
+begin
+  ParseVar('integer; public','');
+  AssertEquals('Variable modifiers',[vmpublic],TheVar.VarModifiers);
+end;
+
+procedure TTestVarParser.TestVarPublicName;
+begin
+  ParseVar('integer; public name ''c''','');
+  AssertEquals('Variable modifiers',[vmpublic],TheVar.VarModifiers);
+  AssertEquals('Public export name','''c''',TheVar.ExportName);
+end;
+
+procedure TTestVarParser.TestVarDeprecatedExternalName;
+begin
+  ParseVar('integer deprecated; external name ''me''','');
+  CheckHint(TPasMemberHint(Getenumvalue(typeinfo(TPasMemberHint),'hdeprecated')));
+  AssertEquals('Variable modifiers',[vmexternal],TheVar.VarModifiers);
+  AssertEquals('Library name','''me''',TheVar.ExportName);
+end;
+
+initialization
+
+  RegisterTests([TTestVarParser]);
+end.
+

+ 33 - 2
packages/fcl-passrc/tests/testpassrc.lpi

@@ -25,7 +25,8 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+        <CommandLineParams Value="--suite=TTestTypeParser"/>
+        <LaunchingApplication Use="True" PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
     <RequiredPackages Count="2">
@@ -36,7 +37,7 @@
         <PackageName Value="FCL"/>
       </Item2>
     </RequiredPackages>
-    <Units Count="2">
+    <Units Count="8">
       <Unit0>
         <Filename Value="testpassrc.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -47,6 +48,36 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="tcscanner"/>
       </Unit1>
+      <Unit2>
+        <Filename Value="tctypeparser.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tctypeparser"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="tcstatements.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tcstatements"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="tcbaseparser.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tcbaseparser"/>
+      </Unit4>
+      <Unit5>
+        <Filename Value="tcmoduleparser.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tcmoduleparser"/>
+      </Unit5>
+      <Unit6>
+        <Filename Value="tconstparser.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tconstparser"/>
+      </Unit6>
+      <Unit7>
+        <Filename Value="tcvarparser.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tcvarparser"/>
+      </Unit7>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

+ 5 - 1
packages/fcl-passrc/tests/testpassrc.lpr

@@ -3,7 +3,9 @@ program testpassrc;
 {$mode objfpc}{$H+}
 
 uses
-  Classes, consoletestrunner, tcscanner;
+  Classes, consoletestrunner, tcscanner, 
+tctypeparser, tcstatements, tcbaseparser,
+  tcmoduleparser, tconstparser, tcvarparser;
 
 type
 
@@ -19,6 +21,8 @@ var
 
 begin
   Application := TMyTestRunner.Create(nil);
+  DefaultFormat:=fplain;
+  DefaultRunAllTests:=True;
   Application.Initialize;
   Application.Run;
   Application.Free;