paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 13:29:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

--- Merging r31205 into '.':

Browse Source 
U    packages/fcl-passrc/src/pastree.pp
U    packages/fcl-passrc/src/pparser.pp
U    packages/fcl-passrc/tests/tctypeparser.pas
--- Recording mergeinfo for merge of r31205 into '.':
 U   .

# revisions: 31205

git-svn-id: branches/fixes_3_0@31206 -
This commit is contained in:
marco 2015-07-12 16:26:35 +00:00
parent 2c2b736218
commit e99d0c17e6
3 changed files with 215 additions and 136 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
packages/fcl-passrc/src/pastree.pp
View File

@ -683,7 +683,7 @@ type
Args: TFPList; // List of TPasArgument objects Args: TFPList; // List of TPasArgument objects
ReadAccessorName, WriteAccessorName,ImplementsName, ReadAccessorName, WriteAccessorName,ImplementsName,
StoredAccessorName: string; StoredAccessorName: string;
IsDefault, IsNodefault: Boolean; IsClass, IsDefault, IsNodefault: Boolean;
Function ResolvedType : TPasType; Function ResolvedType : TPasType;
Function IndexValue : String; Function IndexValue : String;
Function DefaultValue : string; Function DefaultValue : string;

103
packages/fcl-passrc/src/pparser.pp
View File

@ -64,6 +64,9 @@ resourcestring
SParserNoFieldsAllowed = 'Fields are not allowed in Interfaces'; SParserNoFieldsAllowed = 'Fields are not allowed in Interfaces';
SParserInvalidRecordVisibility = 'Records can only have public and (strict) private as visibility specifiers'; SParserInvalidRecordVisibility = 'Records can only have public and (strict) private as visibility specifiers';
SErrRecordMethodsNotAllowed = 'Record methods not allowed at this location.'; SErrRecordMethodsNotAllowed = 'Record methods not allowed at this location.';
SErrRecordPropertiesNotAllowed = 'Record properties not allowed at this location.';
SErrRecordVisibilityNotAllowed = 'Record visibilities not allowed at this location.';
type type
TPasParserLogHandler = Procedure (Sender : TObject; Const Msg : String) of object; TPasParserLogHandler = Procedure (Sender : TObject; Const Msg : String) of object;
TPParserLogEvent = (pleInterface,pleImplementation); TPParserLogEvent = (pleInterface,pleImplementation);
@ -154,6 +157,7 @@ type
procedure ParseClassLocalConsts(AType: TPasClassType; AVisibility: TPasMemberVisibility); procedure ParseClassLocalConsts(AType: TPasClassType; AVisibility: TPasMemberVisibility);
procedure ParseClassLocalTypes(AType: TPasClassType; AVisibility: TPasMemberVisibility); procedure ParseClassLocalTypes(AType: TPasClassType; AVisibility: TPasMemberVisibility);
procedure ParseVarList(Parent: TPasElement; VarList: TFPList; AVisibility: TPasMemberVisibility; Full: Boolean); procedure ParseVarList(Parent: TPasElement; VarList: TFPList; AVisibility: TPasMemberVisibility; Full: Boolean);
procedure SetOptions(AValue: TPOptions);
protected protected
Function SaveComments : String; Function SaveComments : String;
Function SaveComments(Const AValue : String) : String; Function SaveComments(Const AValue : String) : String;
@ -257,7 +261,7 @@ type
property Engine: TPasTreeContainer read FEngine; property Engine: TPasTreeContainer read FEngine;
property CurToken: TToken read FCurToken; property CurToken: TToken read FCurToken;
property CurTokenString: String read FCurTokenString; property CurTokenString: String read FCurTokenString;
Property Options : TPOptions Read FOptions Write FOptions; Property Options : TPOptions Read FOptions Write SetOptions;
Property CurModule : TPasModule Read FCurModule; Property CurModule : TPasModule Read FCurModule;
Property LogEvents : TPParserLogEvents Read FLogEvents Write FLogEvents; Property LogEvents : TPParserLogEvents Read FLogEvents Write FLogEvents;
Property OnLog : TPasParserLogHandler Read FOnLog Write FOnLog; Property OnLog : TPasParserLogHandler Read FOnLog Write FOnLog;
@ -563,7 +567,7 @@ begin
end; end;
end; end;
Destructor TPasParser.Destroy; destructor TPasParser.Destroy;
begin begin
FreeAndNil(FCommentsBuffer[0]); FreeAndNil(FCommentsBuffer[0]);
FreeAndNil(FCommentsBuffer[1]); FreeAndNil(FCommentsBuffer[1]);
@ -590,12 +594,12 @@ begin
end; end;
end; end;
Function TPasParser.CurComments: TStrings; function TPasParser.CurComments: TStrings;
begin begin
Result:=FCurComments; Result:=FCurComments;
end; end;
Function TPasParser.SavedComments: String; function TPasParser.SavedComments: String;
begin begin
Result:=FSavedComments; Result:=FSavedComments;
end; end;
@ -690,13 +694,13 @@ begin
Result := CurTokenString; Result := CurTokenString;
end; end;
Function TPasParser.CurTokenIsIdentifier(Const S: String): Boolean; function TPasParser.CurTokenIsIdentifier(const S: String): Boolean;
begin begin
Result:=(Curtoken=tkidentifier) and (CompareText(S,CurtokenText)=0); Result:=(Curtoken=tkidentifier) and (CompareText(S,CurtokenText)=0);
end; end;
Function TPasParser.IsCurTokenHint(out AHint : TPasMemberHint) : Boolean; function TPasParser.IsCurTokenHint(out AHint: TPasMemberHint): Boolean;
begin begin
Result:=CurToken=tklibrary; Result:=CurToken=tklibrary;
if Result then if Result then
@ -705,21 +709,21 @@ begin
Result:=IsHintToken(CurTokenString,ahint); Result:=IsHintToken(CurTokenString,ahint);
end; end;
Function TPasParser.IsCurTokenHint: Boolean; function TPasParser.IsCurTokenHint: Boolean;
var var
dummy : TPasMemberHint; dummy : TPasMemberHint;
begin begin
Result:=IsCurTokenHint(dummy); Result:=IsCurTokenHint(dummy);
end; end;
Function TPasParser.TokenIsCallingConvention(S: String; out function TPasParser.TokenIsCallingConvention(S: String; out
CC: TCallingConvention): Boolean; CC: TCallingConvention): Boolean;
begin begin
Result:=IsCallingConvention(S,CC); Result:=IsCallingConvention(S,CC);
end; end;
Function TPasParser.TokenIsProcedureModifier(Parent: TPasElement; S: String; function TPasParser.TokenIsProcedureModifier(Parent: TPasElement; S: String;
Out Pm: TProcedureModifier): Boolean; out Pm: TProcedureModifier): Boolean;
begin begin
Result:=IsModifier(S,PM); Result:=IsModifier(S,PM);
if result and (pm in [pmPublic,pmForward]) then if result and (pm in [pmPublic,pmForward]) then
@ -731,7 +735,8 @@ begin
end; end;
Function TPasParser.CheckHint(Element : TPasElement; ExpectSemiColon : Boolean) : TPasMemberHints; function TPasParser.CheckHint(Element: TPasElement; ExpectSemiColon: Boolean
): TPasMemberHints;
Var Var
Found : Boolean; Found : Boolean;
@ -837,7 +842,8 @@ begin
end; end;
end; end;
function TPasParser.ParseSimpleType(Parent: TPasElement; Const TypeName : String; IsFull : Boolean = False): TPasType; function TPasParser.ParseSimpleType(Parent: TPasElement;
const TypeName: String; IsFull: Boolean): TPasType;
Type Type
TSimpleTypeKind = (stkAlias,stkString,stkRange); TSimpleTypeKind = (stkAlias,stkString,stkRange);
@ -911,7 +917,8 @@ begin
end; end;
// On entry, we're on the TYPE token // On entry, we're on the TYPE token
function TPasParser.ParseAliasType(Parent: TPasElement; Const TypeName: String): TPasTypeAliasType; function TPasParser.ParseAliasType(Parent: TPasElement; const TypeName: String
): TPasTypeAliasType;
begin begin
Result := TPasTypeAliasType(CreateElement(TPasTypeAliasType, TypeName, Parent)); Result := TPasTypeAliasType(CreateElement(TPasTypeAliasType, TypeName, Parent));
try try
@ -922,7 +929,8 @@ begin
end; end;
end; end;
function TPasParser.ParsePointerType(Parent : TPasElement; Const TypeName : String) : TPasPointerType; function TPasParser.ParsePointerType(Parent: TPasElement; const TypeName: String
): TPasPointerType;
begin begin
Result := TPasPointerType(CreateElement(TPasPointerType, TypeName, Parent)); Result := TPasPointerType(CreateElement(TPasPointerType, TypeName, Parent));
@ -985,7 +993,8 @@ begin
end; end;
end; end;
function TPasParser.ParseType(Parent: TPasElement; Const TypeName : String = ''; Full : Boolean = False): TPasType; function TPasParser.ParseType(Parent: TPasElement; const TypeName: String;
Full: Boolean): TPasType;
Const Const
// These types are allowed only when full type declarations // These types are allowed only when full type declarations
@ -1073,7 +1082,8 @@ begin
end; end;
end; end;
Function TPasParser.ParseArrayType(Parent : TPasElement; Const TypeName : String; PackMode : TPackMode) : TPasArrayType; function TPasParser.ParseArrayType(Parent: TPasElement; const TypeName: String;
PackMode: TPackMode): TPasArrayType;
Var Var
S : String; S : String;
@ -1115,7 +1125,8 @@ begin
end; end;
end; end;
Function TPasParser.ParseFileType(Parent : TPasElement; Const TypeName : String) : TPasFileType; function TPasParser.ParseFileType(Parent: TPasElement; const TypeName: String
): TPasFileType;
begin begin
@ -1181,7 +1192,7 @@ begin
end; end;
end; end;
Function TPasParser.TokenToExprOp (AToken : TToken) : TExprOpCode; function TPasParser.TokenToExprOp(AToken: TToken): TExprOpCode;
begin begin
Case AToken of Case AToken of
@ -2276,7 +2287,7 @@ end;
// Starts after the type name // Starts after the type name
function TPasParser.ParseRangeType(AParent: TPasElement; function TPasParser.ParseRangeType(AParent: TPasElement;
Const TypeName: String; Full: Boolean): TPasRangeType; const TypeName: String; Full: Boolean): TPasRangeType;
Var Var
PE : TPasExpr; PE : TPasExpr;
@ -2331,7 +2342,7 @@ begin
end; end;
function TPasParser.ParseSpecializeType(Parent: TPasElement; function TPasParser.ParseSpecializeType(Parent: TPasElement;
Const TypeName: String): TPasClassType; const TypeName: String): TPasClassType;
begin begin
Result := TPasClassType(Engine.CreateElement(TPasClassType, TypeName, Parent, Scanner.CurFilename, Scanner.CurRow)); Result := TPasClassType(Engine.CreateElement(TPasClassType, TypeName, Parent, Scanner.CurFilename, Scanner.CurRow));
@ -2372,8 +2383,8 @@ begin
Result:=ParseType(Parent,TypeName,True); Result:=ParseType(Parent,TypeName,True);
end; end;
function TPasParser.GetVariableValueAndLocation(Parent: TPasElement; Out function TPasParser.GetVariableValueAndLocation(Parent: TPasElement; out
Value: TPasExpr; Out Location: String): Boolean; Value: TPasExpr; out Location: String): Boolean;
begin begin
Value:=Nil; Value:=Nil;
@ -2403,7 +2414,7 @@ begin
UngetToken; UngetToken;
end; end;
function TPasParser.GetVariableModifiers(Out VarMods: TVariableModifiers; Out function TPasParser.GetVariableModifiers(out VarMods: TVariableModifiers; out
Libname, ExportName: string): string; Libname, ExportName: string): string;
Var Var
@ -2528,14 +2539,22 @@ begin
end; end;
end; end;
Function TPasParser.SaveComments: String; procedure TPasParser.SetOptions(AValue: TPOptions);
begin
if FOptions=AValue then Exit;
FOptions:=AValue;
If Assigned(FScanner) then
FScanner.Options:=AValue;
end;
function TPasParser.SaveComments: String;
begin begin
if Engine.NeedComments then if Engine.NeedComments then
FSavedComments:=CurComments.Text; // Expensive, so don't do unless needed. FSavedComments:=CurComments.Text; // Expensive, so don't do unless needed.
Result:=FSavedComments; Result:=FSavedComments;
end; end;
Function TPasParser.SaveComments(Const AValue: String): String; function TPasParser.SaveComments(const AValue: String): String;
begin begin
FSavedComments:=AValue; FSavedComments:=AValue;
Result:=FSavedComments; Result:=FSavedComments;
@ -2546,7 +2565,7 @@ begin
Result:=E in FLogEvents; Result:=E in FLogEvents;
end; end;
Procedure TPasParser.DoLog(Const Msg: String; SkipSourceInfo: Boolean); procedure TPasParser.DoLog(const Msg: String; SkipSourceInfo: Boolean);
begin begin
If Assigned(FOnLog) then If Assigned(FOnLog) then
if SkipSourceInfo or not assigned(scanner) then if SkipSourceInfo or not assigned(scanner) then
@ -2555,7 +2574,7 @@ begin
FOnLog(Self,Format('%s(%d) : %s',[Scanner.CurFilename,SCanner.CurRow,Msg])); FOnLog(Self,Format('%s(%d) : %s',[Scanner.CurFilename,SCanner.CurRow,Msg]));
end; end;
Procedure TPasParser.DoLog(Const Fmt: String; Args: Array of const; procedure TPasParser.DoLog(const Fmt: String; Args: array of const;
SkipSourceInfo: Boolean); SkipSourceInfo: Boolean);
begin begin
DoLog(Format(Fmt,Args),SkipSourceInfo); DoLog(Format(Fmt,Args),SkipSourceInfo);
@ -2980,7 +2999,8 @@ begin
end; end;
Function TPasParser.ParseProperty(Parent : TPasElement; Const AName : String; AVisibility : TPasMemberVisibility) : TPasProperty; function TPasParser.ParseProperty(Parent: TPasElement; const AName: String;
AVisibility: TPasMemberVisibility): TPasProperty;
procedure MaybeReadFullyQualifiedIdentifier(Var r : String); procedure MaybeReadFullyQualifiedIdentifier(Var r : String);
@ -3715,7 +3735,8 @@ begin
Until Done; Until Done;
end; end;
procedure TPasParser.DumpCurToken(Const Msg : String; IndentAction : TIndentAction = iaNone); procedure TPasParser.DumpCurToken(const Msg: String; IndentAction: TIndentAction
);
begin begin
if IndentAction=iaUndent then if IndentAction=iaUndent then
FDumpIndent:=copy(FDumpIndent,1,Length(FDumpIndent)-2); FDumpIndent:=copy(FDumpIndent,1,Length(FDumpIndent)-2);
@ -3735,19 +3756,30 @@ Var
Proc: TPasProcedure; Proc: TPasProcedure;
ProcType: TProcType; ProcType: TProcType;
Prop : TPasProperty; Prop : TPasProperty;
isClass : Boolean;
begin begin
v:=visDefault; v:=visDefault;
isClass:=False;
while CurToken<>AEndToken do while CurToken<>AEndToken do
begin begin
SaveComments; SaveComments;
Case CurToken of Case CurToken of
tkProperty: tkClass:
begin begin
if Not AllowMethods then if Not AllowMethods then
ParseExc(SErrRecordMethodsNotAllowed); ParseExc(SErrRecordMethodsNotAllowed);
if isClass then
ParseExc(SParserTypeSyntaxError);
isClass:=True;
end;
tkProperty:
begin
if Not AllowMethods then
ParseExc(SErrRecordPropertiesNotAllowed);
ExpectToken(tkIdentifier); ExpectToken(tkIdentifier);
Prop:=ParseProperty(ARec,CurtokenString,v); Prop:=ParseProperty(ARec,CurtokenString,v);
Prop.isClass:=isClass;
Arec.Members.Add(Prop); Arec.Members.Add(Prop);
end; end;
tkProcedure, tkProcedure,
@ -3755,7 +3787,7 @@ begin
begin begin
if Not AllowMethods then if Not AllowMethods then
ParseExc(SErrRecordMethodsNotAllowed); ParseExc(SErrRecordMethodsNotAllowed);
ProcType:=GetProcTypeFromtoken(CurToken,False); ProcType:=GetProcTypeFromtoken(CurToken,isClass);
Proc:=ParseProcedureOrFunctionDecl(ARec,ProcType,v); Proc:=ParseProcedureOrFunctionDecl(ARec,ProcType,v);
if Proc.Parent is TPasOverloadedProc then if Proc.Parent is TPasOverloadedProc then
TPasOverloadedProc(Proc.Parent).Overloads.Add(Proc) TPasOverloadedProc(Proc.Parent).Overloads.Add(Proc)
@ -3767,6 +3799,8 @@ begin
// If (po_delphi in Scanner.Options) then // If (po_delphi in Scanner.Options) then
if CheckVisibility(CurtokenString,v) then if CheckVisibility(CurtokenString,v) then
begin begin
If not (po_delphi in Scanner.Options) then
ParseExc(SErrRecordVisibilityNotAllowed);
if not (v in [visPrivate,visPublic,visStrictPrivate]) then if not (v in [visPrivate,visPublic,visStrictPrivate]) then
ParseExc(SParserInvalidRecordVisibility); ParseExc(SParserInvalidRecordVisibility);
NextToken; NextToken;
@ -3796,11 +3830,14 @@ begin
end; end;
if CurToken<>AEndToken then if CurToken<>AEndToken then
NextToken; NextToken;
If CurToken<>tkClass then
isClass:=False;
end; end;
end; end;
// Starts after the "record" token // Starts after the "record" token
Function TPasParser.ParseRecordDecl(Parent: TPasElement; Const TypeName : string; const Packmode : TPackMode = pmNone) : TPasRecordType; function TPasParser.ParseRecordDecl(Parent: TPasElement;
const TypeName: string; const Packmode: TPackMode): TPasRecordType;
begin begin
Result := TPasRecordType(CreateElement(TPasRecordType, TypeName, Parent)); Result := TPasRecordType(CreateElement(TPasRecordType, TypeName, Parent));
@ -4070,7 +4107,7 @@ begin
end; end;
end; end;
Function TPasParser.ParseClassDecl(Parent: TPasElement; function TPasParser.ParseClassDecl(Parent: TPasElement;
const AClassName: String; AObjKind: TPasObjKind; PackMode: TPackMode const AClassName: String; AObjKind: TPasObjKind; PackMode: TPackMode
): TPasType; ): TPasType;

246
packages/fcl-passrc/tests/tctypeparser.pas
View File

@ -243,6 +243,8 @@ type
Procedure TestTwoDeprecatedFieldsCombinedPlatform; Procedure TestTwoDeprecatedFieldsCombinedPlatform;
Procedure TestFieldAndMethod; Procedure TestFieldAndMethod;
Procedure TestFieldAnd2Methods; Procedure TestFieldAnd2Methods;
Procedure TestFieldAndProperty;
Procedure TestFieldAndClassMethod;
Procedure TestNested; Procedure TestNested;
Procedure TestNestedDeprecated; Procedure TestNestedDeprecated;
Procedure TestNestedPlatform; Procedure TestNestedPlatform;
@ -1101,7 +1103,7 @@ end;
{ TTestRecordTypeParser } { TTestRecordTypeParser }
Function TTestRecordTypeParser.GetField(AIndex: Integer; R: TPasRecordType function TTestRecordTypeParser.GetField(AIndex: Integer; R: TPasRecordType
): TPasVariable; ): TPasVariable;
begin begin
AssertNotNull(R); AssertNotNull(R);
@ -1111,7 +1113,7 @@ begin
Result:=TPasVariable(R.Members[AIndex]); Result:=TPasVariable(R.Members[AIndex]);
end; end;
Function TTestRecordTypeParser.GetField(AIndex: Integer; R: TPasVariant function TTestRecordTypeParser.GetField(AIndex: Integer; R: TPasVariant
): TPasVariable; ): TPasVariable;
begin begin
AssertNotNull(R); AssertNotNull(R);
@ -1132,7 +1134,7 @@ begin
Result:=TheType as TPasRecordType; Result:=TheType as TPasRecordType;
end; end;
Function TTestRecordTypeParser.GetVariant(AIndex: Integer; R: TPasRecordType function TTestRecordTypeParser.GetVariant(AIndex: Integer; R: TPasRecordType
): TPasVariant; ): TPasVariant;
begin begin
AssertNotNull(R); AssertNotNull(R);
@ -1147,7 +1149,7 @@ begin
Result:=GetVariant(AIndex,GetR); Result:=GetVariant(AIndex,GetR);
end; end;
Procedure TTestRecordTypeParser.TestFields(Const Fields: Array of string; procedure TTestRecordTypeParser.TestFields(const Fields: array of string;
AHint: String; HaveVariant: Boolean); AHint: String; HaveVariant: Boolean);
Var Var
@ -1193,7 +1195,7 @@ begin
end; end;
Procedure TTestRecordTypeParser.DoTestEmpty(Const AHint: String); procedure TTestRecordTypeParser.DoTestEmpty(const AHint: String);
begin begin
TestFields([],AHint); TestFields([],AHint);
AssertNotNull('Have members array',TheRecord.Members); AssertNotNull('Have members array',TheRecord.Members);
@ -1207,7 +1209,7 @@ end;
procedure TTestRecordTypeParser.AssertVariant1(Hints: TPasMemberHints; procedure TTestRecordTypeParser.AssertVariant1(Hints: TPasMemberHints;
VariantLabels: Array of string); VariantLabels: array of string);
Var Var
I : Integer; I : Integer;
@ -1248,7 +1250,7 @@ begin
end; end;
procedure TTestRecordTypeParser.AssertVariant2(Hints: TPasMemberHints; procedure TTestRecordTypeParser.AssertVariant2(Hints: TPasMemberHints;
VariantLabels: Array of string); VariantLabels: array of string);
Var Var
I : Integer; I : Integer;
@ -1283,7 +1285,7 @@ begin
AssertTrue('Field 1 hints match',TPasVariable(Variant2.Members.Members[0]).Hints=Hints) AssertTrue('Field 1 hints match',TPasVariable(Variant2.Members.Members[0]).Hints=Hints)
end; end;
procedure TTestRecordTypeParser.DoTestVariantNoStorage(Const AHint: string); procedure TTestRecordTypeParser.DoTestVariantNoStorage(const AHint: string);
begin begin
TestFields(['x : integer;','case integer of','0 : (y : integer;)'],AHint,True); TestFields(['x : integer;','case integer of','0 : (y : integer;)'],AHint,True);
AssertField1([]); AssertField1([]);
@ -1292,7 +1294,7 @@ begin
end; end;
procedure TTestRecordTypeParser.DoTestDeprecatedVariantNoStorage( procedure TTestRecordTypeParser.DoTestDeprecatedVariantNoStorage(
Const AHint: string); const AHint: string);
begin begin
TestFields(['x : integer;','case integer of','0 : (y : integer deprecated;)'],AHint,True); TestFields(['x : integer;','case integer of','0 : (y : integer deprecated;)'],AHint,True);
AssertField1([]); AssertField1([]);
@ -1301,7 +1303,7 @@ begin
end; end;
procedure TTestRecordTypeParser.DoTestDeprecatedVariantStorage( procedure TTestRecordTypeParser.DoTestDeprecatedVariantStorage(
Const AHint: string); const AHint: string);
begin begin
TestFields(['x : integer;','case s : integer of','0 : (y : integer deprecated;)'],AHint,True); TestFields(['x : integer;','case s : integer of','0 : (y : integer deprecated;)'],AHint,True);
AssertField1([]); AssertField1([]);
@ -1309,7 +1311,7 @@ begin
AssertVariant1([hDeprecated]); AssertVariant1([hDeprecated]);
end; end;
procedure TTestRecordTypeParser.DoTestVariantStorage(Const AHint: string); procedure TTestRecordTypeParser.DoTestVariantStorage(const AHint: string);
begin begin
TestFields(['x : integer;','case s : integer of','0 : (y : integer;)'],AHint,True); TestFields(['x : integer;','case s : integer of','0 : (y : integer;)'],AHint,True);
AssertField1([]); AssertField1([]);
@ -1317,7 +1319,7 @@ begin
AssertVariant1([]); AssertVariant1([]);
end; end;
procedure TTestRecordTypeParser.DoTestTwoVariantsNoStorage(Const AHint: string); procedure TTestRecordTypeParser.DoTestTwoVariantsNoStorage(const AHint: string);
begin begin
TestFields(['x : integer;','case integer of','0 : (y : integer;);','1 : (z : integer;)'],AHint,True); TestFields(['x : integer;','case integer of','0 : (y : integer;);','1 : (z : integer;)'],AHint,True);
AssertField1([]); AssertField1([]);
@ -1326,7 +1328,7 @@ begin
AssertVariant2([]); AssertVariant2([]);
end; end;
procedure TTestRecordTypeParser.DoTestTwoVariantsStorage(Const AHint: string); procedure TTestRecordTypeParser.DoTestTwoVariantsStorage(const AHint: string);
begin begin
TestFields(['x : integer;','case s : integer of','0 : (y : integer;);','1 : (z : integer;)'],AHint,True); TestFields(['x : integer;','case s : integer of','0 : (y : integer;);','1 : (z : integer;)'],AHint,True);
AssertField1([]); AssertField1([]);
@ -1336,7 +1338,7 @@ begin
end; end;
procedure TTestRecordTypeParser.DoTestTwoVariantsFirstDeprecatedStorage( procedure TTestRecordTypeParser.DoTestTwoVariantsFirstDeprecatedStorage(
Const AHint: string); const AHint: string);
begin begin
TestFields(['x : integer;','case s : integer of','0 : (y : integer deprecated;);','1 : (z : integer;)'],AHint,True); TestFields(['x : integer;','case s : integer of','0 : (y : integer deprecated;);','1 : (z : integer;)'],AHint,True);
AssertField1([]); AssertField1([]);
@ -1346,7 +1348,7 @@ begin
end; end;
procedure TTestRecordTypeParser.DoTestTwoVariantsSecondDeprecatedStorage( procedure TTestRecordTypeParser.DoTestTwoVariantsSecondDeprecatedStorage(
Const AHint: string); const AHint: string);
begin begin
TestFields(['x : integer;','case s : integer of','0 : (y : integer ;);','1 : (z : integer deprecated;)'],AHint,True); TestFields(['x : integer;','case s : integer of','0 : (y : integer ;);','1 : (z : integer deprecated;)'],AHint,True);
AssertField1([]); AssertField1([]);
@ -1355,7 +1357,7 @@ begin
AssertVariant2([hdeprecated]); AssertVariant2([hdeprecated]);
end; end;
Procedure TTestRecordTypeParser.DoTestVariantTwoLabels(Const AHint: string); procedure TTestRecordTypeParser.DoTestVariantTwoLabels(const AHint: string);
begin begin
TestFields(['x : integer;','case integer of','0,1 : (y : integer)'],AHint,True); TestFields(['x : integer;','case integer of','0,1 : (y : integer)'],AHint,True);
AssertField1([]); AssertField1([]);
@ -1363,7 +1365,7 @@ begin
AssertVariant1([],['0','1']); AssertVariant1([],['0','1']);
end; end;
Procedure TTestRecordTypeParser.DoTestTwoVariantsTwoLabels(Const AHint: string); procedure TTestRecordTypeParser.DoTestTwoVariantsTwoLabels(const AHint: string);
begin begin
TestFields(['x : integer;','case integer of','0,1 : (y : integer);','2,3 : (z : integer);'],AHint,True); TestFields(['x : integer;','case integer of','0,1 : (y : integer);','2,3 : (z : integer);'],AHint,True);
AssertField1([]); AssertField1([]);
@ -1372,7 +1374,7 @@ begin
AssertVariant2([],['2','3']); AssertVariant2([],['2','3']);
end; end;
procedure TTestRecordTypeParser.DoTestVariantNestedRecord(Const AHint: string); procedure TTestRecordTypeParser.DoTestVariantNestedRecord(const AHint: string);
begin begin
TestFields(['x : integer;','case integer of','0 : ( y : record',' z : integer;','end)'],AHint,True); TestFields(['x : integer;','case integer of','0 : ( y : record',' z : integer;','end)'],AHint,True);
AssertField1([]); AssertField1([]);
@ -1380,7 +1382,7 @@ begin
AssertRecordVariant(0,[],['0']); AssertRecordVariant(0,[],['0']);
end; end;
procedure TTestRecordTypeParser.DoTestVariantNestedVariant(Const AHint: string); procedure TTestRecordTypeParser.DoTestVariantNestedVariant(const AHint: string);
begin begin
TestFields(['x : integer;','case integer of','0 : ( y : record',' z : integer;',' case byte of ',' 1 : (i : integer);',' 2 : ( j : byte)', 'end)'],AHint,True); TestFields(['x : integer;','case integer of','0 : ( y : record',' z : integer;',' case byte of ',' 1 : (i : integer);',' 2 : ( j : byte)', 'end)'],AHint,True);
AssertField1([]); AssertField1([]);
@ -1391,7 +1393,7 @@ begin
end; end;
procedure TTestRecordTypeParser.DoTestVariantNestedVariantFirstDeprecated( procedure TTestRecordTypeParser.DoTestVariantNestedVariantFirstDeprecated(
Const AHint: string); const AHint: string);
begin 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); 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([]); AssertField1([]);
@ -1423,23 +1425,23 @@ begin
AssertRecordVariantVariant(1,'j','Byte',[hDeprecated],['2']) AssertRecordVariantVariant(1,'j','Byte',[hDeprecated],['2'])
end; end;
Procedure TTestRecordTypeParser.TestEmpty; procedure TTestRecordTypeParser.TestEmpty;
begin begin
DoTestEmpty('') DoTestEmpty('')
end; end;
Procedure TTestRecordTypeParser.TestEmptyComment; procedure TTestRecordTypeParser.TestEmptyComment;
begin begin
AddComment:=True; AddComment:=True;
TestEmpty; TestEmpty;
end; end;
Procedure TTestRecordTypeParser.TestEmptyDeprecated; procedure TTestRecordTypeParser.TestEmptyDeprecated;
begin begin
DoTestEmpty('Deprecated') DoTestEmpty('Deprecated')
end; end;
Procedure TTestRecordTypeParser.TestEmptyPlatform; procedure TTestRecordTypeParser.TestEmptyPlatform;
begin begin
DoTestEmpty('Platform') DoTestEmpty('Platform')
end; end;
@ -1524,7 +1526,7 @@ begin
end; end;
procedure TTestRecordTypeParser.AssertRecordVariant(AIndex: Integer; procedure TTestRecordTypeParser.AssertRecordVariant(AIndex: Integer;
Hints: TPasMemberHints; VariantLabels: Array of string); Hints: TPasMemberHints; VariantLabels: array of string);
Var Var
F : TPasVariant; F : TPasVariant;
@ -1556,9 +1558,9 @@ begin
end; end;
Procedure TTestRecordTypeParser.AssertRecordVariantVariant(AIndex: Integer; procedure TTestRecordTypeParser.AssertRecordVariantVariant(AIndex: Integer;
Const AFieldName, ATypeName: string; Hints: TPasMemberHints; const AFieldName, ATypeName: string; Hints: TPasMemberHints;
VariantLabels: Array of string); VariantLabels: array of string);
Var Var
F : TPasVariant; F : TPasVariant;
@ -1598,13 +1600,13 @@ begin
AssertTrue(MN+'hints match',V.Hints=Hints); AssertTrue(MN+'hints match',V.Hints=Hints);
end; end;
Procedure TTestRecordTypeParser.TestOneField; procedure TTestRecordTypeParser.TestOneField;
begin begin
TestFields(['x : integer'],'',False); TestFields(['x : integer'],'',False);
AssertOneIntegerField([]); AssertOneIntegerField([]);
end; end;
Procedure TTestRecordTypeParser.TestOneFieldComment; procedure TTestRecordTypeParser.TestOneFieldComment;
begin begin
AddComment:=True; AddComment:=True;
TestFields(['{a} x : integer'],'',False); TestFields(['{a} x : integer'],'',False);
@ -1612,74 +1614,74 @@ begin
AssertEquals('Member 1 comment','a'+sLineBreak,TPAsElement(TheRecord.Members[0]).DocComment); AssertEquals('Member 1 comment','a'+sLineBreak,TPAsElement(TheRecord.Members[0]).DocComment);
end; end;
Procedure TTestRecordTypeParser.TestOneFieldDeprecated; procedure TTestRecordTypeParser.TestOneFieldDeprecated;
begin begin
TestFields(['x : integer'],'deprecated',False); TestFields(['x : integer'],'deprecated',False);
AssertOneIntegerField([]); AssertOneIntegerField([]);
end; end;
Procedure TTestRecordTypeParser.TestOneFieldPlatform; procedure TTestRecordTypeParser.TestOneFieldPlatform;
begin begin
TestFields(['x : integer'],'platform',False); TestFields(['x : integer'],'platform',False);
AssertOneIntegerField([]); AssertOneIntegerField([]);
end; end;
Procedure TTestRecordTypeParser.TestOneFieldSemicolon; procedure TTestRecordTypeParser.TestOneFieldSemicolon;
begin begin
TestFields(['x : integer;'],'',False); TestFields(['x : integer;'],'',False);
AssertOneIntegerField([]); AssertOneIntegerField([]);
end; end;
Procedure TTestRecordTypeParser.TestOneFieldSemicolonDeprecated; procedure TTestRecordTypeParser.TestOneFieldSemicolonDeprecated;
begin begin
TestFields(['x : integer;'],'deprecated',False); TestFields(['x : integer;'],'deprecated',False);
AssertOneIntegerField([]); AssertOneIntegerField([]);
end; end;
Procedure TTestRecordTypeParser.TestOneFieldSemicolonPlatform; procedure TTestRecordTypeParser.TestOneFieldSemicolonPlatform;
begin begin
TestFields(['x : integer;'],'platform',False); TestFields(['x : integer;'],'platform',False);
AssertOneIntegerField([]); AssertOneIntegerField([]);
end; end;
Procedure TTestRecordTypeParser.TestOneDeprecatedField; procedure TTestRecordTypeParser.TestOneDeprecatedField;
begin begin
TestFields(['x : integer deprecated;'],'',False); TestFields(['x : integer deprecated;'],'',False);
AssertOneIntegerField([hDeprecated]); AssertOneIntegerField([hDeprecated]);
end; end;
Procedure TTestRecordTypeParser.TestOneDeprecatedFieldDeprecated; procedure TTestRecordTypeParser.TestOneDeprecatedFieldDeprecated;
begin begin
TestFields(['x : integer deprecated;'],'deprecated',False); TestFields(['x : integer deprecated;'],'deprecated',False);
AssertOneIntegerField([hDeprecated]); AssertOneIntegerField([hDeprecated]);
end; end;
Procedure TTestRecordTypeParser.TestOneDeprecatedFieldPlatform; procedure TTestRecordTypeParser.TestOneDeprecatedFieldPlatform;
begin begin
TestFields(['x : integer deprecated;'],'platform',False); TestFields(['x : integer deprecated;'],'platform',False);
AssertOneIntegerField([hDeprecated]); AssertOneIntegerField([hDeprecated]);
end; end;
Procedure TTestRecordTypeParser.TestOnePlatformField; procedure TTestRecordTypeParser.TestOnePlatformField;
begin begin
TestFields(['x : integer platform;'],'',False); TestFields(['x : integer platform;'],'',False);
AssertOneIntegerField([hplatform]); AssertOneIntegerField([hplatform]);
end; end;
Procedure TTestRecordTypeParser.TestOnePlatformFieldDeprecated; procedure TTestRecordTypeParser.TestOnePlatformFieldDeprecated;
begin begin
TestFields(['x : integer platform;'],'Deprecated',False); TestFields(['x : integer platform;'],'Deprecated',False);
AssertOneIntegerField([hplatform]); AssertOneIntegerField([hplatform]);
end; end;
Procedure TTestRecordTypeParser.TestOnePlatformFieldPlatform; procedure TTestRecordTypeParser.TestOnePlatformFieldPlatform;
begin begin
TestFields(['x : integer platform;'],'Platform',False); TestFields(['x : integer platform;'],'Platform',False);
AssertOneIntegerField([hplatform]); AssertOneIntegerField([hplatform]);
end; end;
Procedure TTestRecordTypeParser.TestTwoFields; procedure TTestRecordTypeParser.TestTwoFields;
begin begin
TestFields(['x : integer;','y : integer'],'',False); TestFields(['x : integer;','y : integer'],'',False);
AssertTwoIntegerFields([],[]); AssertTwoIntegerFields([],[]);
@ -1687,17 +1689,18 @@ end;
procedure TTestRecordTypeParser.TestTwoFieldPrivateNoDelphi; procedure TTestRecordTypeParser.TestTwoFieldPrivateNoDelphi;
Var Var
B : Boolean; EC : TClass;
begin begin
try try
TestFields(['private','x : integer'],'',False); TestFields(['private','x : integer'],'',False);
Fail('Need poDelphi for visibility specifier') Fail('Need po_Delphi for visibility specifier');
except except
on EA : EAssertionFailedError do
Raise;
on E : Exception do on E : Exception do
B:=E is EParserError; EC:=E.ClassType;
end; end;
If not B then AssertEquals('Exception class',EParserError,EC);
Fail('Wrong exception class.');
end; end;
procedure TTestRecordTypeParser.TestTwoFieldProtected; procedure TTestRecordTypeParser.TestTwoFieldProtected;
@ -1715,7 +1718,7 @@ begin
Fail('Wrong exception class.'); Fail('Wrong exception class.');
end; end;
Procedure TTestRecordTypeParser.TestTwoFieldPrivate; procedure TTestRecordTypeParser.TestTwoFieldPrivate;
begin begin
Scanner.Options:=[po_Delphi]; Scanner.Options:=[po_Delphi];
TestFields(['private','x,y : integer'],'',False); TestFields(['private','x,y : integer'],'',False);
@ -1729,119 +1732,121 @@ begin
AssertTwoIntegerFields([],[]); AssertTwoIntegerFields([],[]);
end; end;
Procedure TTestRecordTypeParser.TestTwoFieldDeprecated; procedure TTestRecordTypeParser.TestTwoFieldDeprecated;
begin begin
TestFields(['x : integer;','y : integer'],'deprecated',False); TestFields(['x : integer;','y : integer'],'deprecated',False);
AssertTwoIntegerFields([],[]); AssertTwoIntegerFields([],[]);
end; end;
Procedure TTestRecordTypeParser.TestTwoFieldPlatform; procedure TTestRecordTypeParser.TestTwoFieldPlatform;
begin begin
TestFields(['x : integer;','y : integer'],'platform',False); TestFields(['x : integer;','y : integer'],'platform',False);
AssertTwoIntegerFields([],[]); AssertTwoIntegerFields([],[]);
end; end;
Procedure TTestRecordTypeParser.TestTwoFieldsFirstDeprecated; procedure TTestRecordTypeParser.TestTwoFieldsFirstDeprecated;
begin begin
TestFields(['x : integer deprecated;','y : integer'],'',False); TestFields(['x : integer deprecated;','y : integer'],'',False);
AssertTwoIntegerFields([hdeprecated],[]); AssertTwoIntegerFields([hdeprecated],[]);
end; end;
Procedure TTestRecordTypeParser.TestTwoFieldsFirstDeprecatedDeprecated; procedure TTestRecordTypeParser.TestTwoFieldsFirstDeprecatedDeprecated;
begin begin
TestFields(['x : integer deprecated;','y : integer'],'deprecated',False); TestFields(['x : integer deprecated;','y : integer'],'deprecated',False);
AssertTwoIntegerFields([hdeprecated],[]); AssertTwoIntegerFields([hdeprecated],[]);
end; end;
Procedure TTestRecordTypeParser.TestTwoFieldsFirstDeprecatedPlatform; procedure TTestRecordTypeParser.TestTwoFieldsFirstDeprecatedPlatform;
begin begin
TestFields(['x : integer deprecated;','y : integer'],'platform',False); TestFields(['x : integer deprecated;','y : integer'],'platform',False);
AssertTwoIntegerFields([hdeprecated],[]); AssertTwoIntegerFields([hdeprecated],[]);
end; end;
Procedure TTestRecordTypeParser.TestTwoFieldsSecondDeprecated; procedure TTestRecordTypeParser.TestTwoFieldsSecondDeprecated;
begin begin
TestFields(['x : integer;','y : integer deprecated;'],'',False); TestFields(['x : integer;','y : integer deprecated;'],'',False);
AssertTwoIntegerFields([],[hdeprecated]); AssertTwoIntegerFields([],[hdeprecated]);
end; end;
Procedure TTestRecordTypeParser.TestTwoFieldsSecondDeprecatedDeprecated; procedure TTestRecordTypeParser.TestTwoFieldsSecondDeprecatedDeprecated;
begin begin
TestFields(['x : integer;','y : integer deprecated;'],'deprecated',False); TestFields(['x : integer;','y : integer deprecated;'],'deprecated',False);
AssertTwoIntegerFields([],[hdeprecated]); AssertTwoIntegerFields([],[hdeprecated]);
end; end;
Procedure TTestRecordTypeParser.TestTwoFieldsSecondDeprecatedPlatform; procedure TTestRecordTypeParser.TestTwoFieldsSecondDeprecatedPlatform;
begin begin
TestFields(['x : integer;','y : integer deprecated;'],'platform',False); TestFields(['x : integer;','y : integer deprecated;'],'platform',False);
AssertTwoIntegerFields([],[hdeprecated]); AssertTwoIntegerFields([],[hdeprecated]);
end; end;
Procedure TTestRecordTypeParser.TestTwoFieldsBothDeprecated; procedure TTestRecordTypeParser.TestTwoFieldsBothDeprecated;
begin begin
TestFields(['x : integer deprecated;','y : integer deprecated;'],'',False); TestFields(['x : integer deprecated;','y : integer deprecated;'],'',False);
AssertTwoIntegerFields([hdeprecated],[hdeprecated]); AssertTwoIntegerFields([hdeprecated],[hdeprecated]);
end; end;
Procedure TTestRecordTypeParser.TestTwoFieldsBothDeprecatedDeprecated; procedure TTestRecordTypeParser.TestTwoFieldsBothDeprecatedDeprecated;
begin begin
TestFields(['x : integer deprecated;','y : integer deprecated;'],'deprecated',False); TestFields(['x : integer deprecated;','y : integer deprecated;'],'deprecated',False);
AssertTwoIntegerFields([hdeprecated],[hdeprecated]); AssertTwoIntegerFields([hdeprecated],[hdeprecated]);
end; end;
Procedure TTestRecordTypeParser.TestTwoFieldsBothDeprecatedPlatform; procedure TTestRecordTypeParser.TestTwoFieldsBothDeprecatedPlatform;
begin begin
TestFields(['x : integer deprecated;','y : integer deprecated;'],'platform',False); TestFields(['x : integer deprecated;','y : integer deprecated;'],'platform',False);
AssertTwoIntegerFields([hdeprecated],[hdeprecated]); AssertTwoIntegerFields([hdeprecated],[hdeprecated]);
end; end;
Procedure TTestRecordTypeParser.TestTwoFieldsCombined; procedure TTestRecordTypeParser.TestTwoFieldsCombined;
begin begin
TestFields(['x,y : integer;'],'',False); TestFields(['x,y : integer;'],'',False);
AssertTwoIntegerFields([],[]); AssertTwoIntegerFields([],[]);
end; end;
Procedure TTestRecordTypeParser.TestTwoFieldsCombinedDeprecated; procedure TTestRecordTypeParser.TestTwoFieldsCombinedDeprecated;
begin begin
TestFields(['x,y : integer;'],'deprecated',False); TestFields(['x,y : integer;'],'deprecated',False);
AssertTwoIntegerFields([],[]); AssertTwoIntegerFields([],[]);
end; end;
Procedure TTestRecordTypeParser.TestTwoFieldsCombinedPlatform; procedure TTestRecordTypeParser.TestTwoFieldsCombinedPlatform;
begin begin
TestFields(['x,y : integer;'],'platform',False); TestFields(['x,y : integer;'],'platform',False);
AssertTwoIntegerFields([],[]); AssertTwoIntegerFields([],[]);
end; end;
Procedure TTestRecordTypeParser.TestTwoDeprecatedFieldsCombined; procedure TTestRecordTypeParser.TestTwoDeprecatedFieldsCombined;
begin begin
TestFields(['x,y : integer deprecated;'],'',False); TestFields(['x,y : integer deprecated;'],'',False);
AssertTwoIntegerFields([hdeprecated],[hdeprecated]); AssertTwoIntegerFields([hdeprecated],[hdeprecated]);
end; end;
Procedure TTestRecordTypeParser.TestTwoDeprecatedFieldsCombinedDeprecated; procedure TTestRecordTypeParser.TestTwoDeprecatedFieldsCombinedDeprecated;
begin begin
TestFields(['x,y : integer deprecated;'],'deprecated',False); TestFields(['x,y : integer deprecated;'],'deprecated',False);
AssertTwoIntegerFields([hdeprecated],[hdeprecated]); AssertTwoIntegerFields([hdeprecated],[hdeprecated]);
end; end;
Procedure TTestRecordTypeParser.TestTwoDeprecatedFieldsCombinedPlatform; procedure TTestRecordTypeParser.TestTwoDeprecatedFieldsCombinedPlatform;
begin begin
TestFields(['x,y : integer deprecated;'],'platform',False); TestFields(['x,y : integer deprecated;'],'platform',False);
AssertTwoIntegerFields([hdeprecated],[hdeprecated]); AssertTwoIntegerFields([hdeprecated],[hdeprecated]);
end; end;
Procedure TTestRecordTypeParser.TestFieldAndMethod; procedure TTestRecordTypeParser.TestFieldAndMethod;
begin begin
Parser.Options:=[po_delphi];
TestFields(['x : integer;','procedure dosomething2;'],'',False); TestFields(['x : integer;','procedure dosomething2;'],'',False);
AssertIntegerFieldAndMethod([],[]); AssertIntegerFieldAndMethod([],[]);
end; end;
Procedure TTestRecordTypeParser.TestFieldAnd2Methods; procedure TTestRecordTypeParser.TestFieldAnd2Methods;
Var Var
P : TPasFunction; P : TPasFunction;
begin begin
Parser.Options:=[po_delphi];
TestFields(['x : integer;','procedure dosomething2;','function dosomething3 : Integer;'],'',False); TestFields(['x : integer;','procedure dosomething2;','function dosomething3 : Integer;'],'',False);
AssertEquals('Member count',3,TheRecord.Members.Count); AssertEquals('Member count',3,TheRecord.Members.Count);
AssertField1([]); AssertField1([]);
@ -1854,7 +1859,44 @@ begin
AssertEquals('Method 2 result type','Integer', P.FuncType.ResultEl.ResultType.Name); AssertEquals('Method 2 result type','Integer', P.FuncType.ResultEl.ResultType.Name);
end; end;
Procedure TTestRecordTypeParser.TestNested; procedure TTestRecordTypeParser.TestFieldAndProperty;
Var
P : TPasProperty;
begin
Parser.Options:=[po_delphi];
TestFields(['private','x : integer;','public','property MyX : Integer read X write X'],'',False);
AssertEquals('Member count',2,TheRecord.Members.Count);
AssertField1([]);
AssertEquals('Member 2 type',TPasProperty,TObject(TheRecord.Members[1]).ClassType);
P:=TPasProperty(TheRecord.Members[1]);
AssertEquals('Property name','MyX',P.Name);
AssertNotNull('Method 2 type',P.ResolvedType);
AssertEquals('Method 2 type','Integer',P.ResolvedType.Name);
AssertEquals('Method 2 read','X', P.ReadAccessorName);
AssertEquals('Method 2 Write','X', P.WriteAccessorName);
end;
procedure TTestRecordTypeParser.TestFieldAndClassMethod;
Var
P : TPasFunction;
begin
TestFields(['x : integer;','class procedure dosomething2;','function dosomething3 : Integer;'],'',False);
AssertEquals('Member count',3,TheRecord.Members.Count);
AssertField1([]);
AssertMethod2([]);
AssertEquals('Class procedure',TPasProcedure,TObject(TheRecord.Members[1]).ClassType);
AssertEquals('Member 3 type',TPasFunction,TObject(TheRecord.Members[2]).ClassType);
P:=TPasFunction(TheRecord.Members[2]);
AssertEquals('Method 2 name','dosomething3',P.Name);
AssertTrue('Method 2 hints match',[]=P.Hints);
// Standard type
AssertEquals('Method 2 result type','Integer', P.FuncType.ResultEl.ResultType.Name);
end;
procedure TTestRecordTypeParser.TestNested;
begin begin
TestFields(['x : integer;','y : record',' z : integer;','end'],'',False); TestFields(['x : integer;','y : record',' z : integer;','end'],'',False);
AssertField1([]); AssertField1([]);
@ -1882,14 +1924,14 @@ begin
AssertRecordField(1,[]) AssertRecordField(1,[])
end; end;
Procedure TTestRecordTypeParser.TestNestedDeprecated; procedure TTestRecordTypeParser.TestNestedDeprecated;
begin begin
TestFields(['x : integer;','y : record',' z : integer;','end'],'deprecated',False); TestFields(['x : integer;','y : record',' z : integer;','end'],'deprecated',False);
AssertField1([]); AssertField1([]);
AssertRecordField(1,[]) AssertRecordField(1,[])
end; end;
Procedure TTestRecordTypeParser.TestNestedPlatform; procedure TTestRecordTypeParser.TestNestedPlatform;
begin begin
TestFields(['x : integer;','y : record',' z : integer;','end'],'platform',False); TestFields(['x : integer;','y : record',' z : integer;','end'],'platform',False);
AssertField1([]); AssertField1([]);
@ -1917,21 +1959,21 @@ begin
AssertRecordField(0,[]) AssertRecordField(0,[])
end; end;
Procedure TTestRecordTypeParser.TestDeprecatedNested; procedure TTestRecordTypeParser.TestDeprecatedNested;
begin begin
TestFields(['x : integer;','y : record',' z : integer;','end deprecated;'],'',False); TestFields(['x : integer;','y : record',' z : integer;','end deprecated;'],'',False);
AssertField1([]); AssertField1([]);
AssertRecordField(1,[hdeprecated]) AssertRecordField(1,[hdeprecated])
end; end;
Procedure TTestRecordTypeParser.TestDeprecatedNestedDeprecated; procedure TTestRecordTypeParser.TestDeprecatedNestedDeprecated;
begin begin
TestFields(['x : integer;','y : record',' z : integer;','end deprecated;'],'deprecated',False); TestFields(['x : integer;','y : record',' z : integer;','end deprecated;'],'deprecated',False);
AssertField1([]); AssertField1([]);
AssertRecordField(1,[hdeprecated]) AssertRecordField(1,[hdeprecated])
end; end;
Procedure TTestRecordTypeParser.TestDeprecatedNestedPlatform; procedure TTestRecordTypeParser.TestDeprecatedNestedPlatform;
begin begin
TestFields(['x : integer;','y : record',' z : integer;','end deprecated;'],'platform',False); TestFields(['x : integer;','y : record',' z : integer;','end deprecated;'],'platform',False);
AssertField1([]); AssertField1([]);
@ -1959,7 +2001,7 @@ begin
AssertRecordField(0,[hdeprecated]) AssertRecordField(0,[hdeprecated])
end; end;
Procedure TTestRecordTypeParser.TestVariantNoStorage; procedure TTestRecordTypeParser.TestVariantNoStorage;
begin begin
DoTestVariantNoStorage(''); DoTestVariantNoStorage('');
end; end;
@ -1976,7 +2018,7 @@ begin
DoTestVariantNoStorage('platform'); DoTestVariantNoStorage('platform');
end; end;
Procedure TTestRecordTypeParser.TestVariantStorage; procedure TTestRecordTypeParser.TestVariantStorage;
begin begin
DoTestVariantStorage(''); DoTestVariantStorage('');
end; end;
@ -1992,7 +2034,7 @@ begin
DoTestVariantStorage('platform'); DoTestVariantStorage('platform');
end; end;
Procedure TTestRecordTypeParser.TestDeprecatedVariantNoStorage; procedure TTestRecordTypeParser.TestDeprecatedVariantNoStorage;
begin begin
DoTestDeprecatedVariantNoStorage(''); DoTestDeprecatedVariantNoStorage('');
end; end;
@ -2007,7 +2049,7 @@ begin
DoTestDeprecatedVariantNoStorage('Platform'); DoTestDeprecatedVariantNoStorage('Platform');
end; end;
Procedure TTestRecordTypeParser.TestDeprecatedVariantStorage; procedure TTestRecordTypeParser.TestDeprecatedVariantStorage;
begin begin
DoTestDeprecatedVariantStorage(''); DoTestDeprecatedVariantStorage('');
end; end;
@ -2022,7 +2064,7 @@ begin
DoTestDeprecatedVariantStorage('Platform'); DoTestDeprecatedVariantStorage('Platform');
end; end;
Procedure TTestRecordTypeParser.TestTwoVariantsNoStorage; procedure TTestRecordTypeParser.TestTwoVariantsNoStorage;
begin begin
DoTestTwoVariantsNoStorage(''); DoTestTwoVariantsNoStorage('');
end; end;
@ -2037,7 +2079,7 @@ begin
DoTestTwoVariantsNoStorage('platform'); DoTestTwoVariantsNoStorage('platform');
end; end;
Procedure TTestRecordTypeParser.TestTwoVariantsStorage; procedure TTestRecordTypeParser.TestTwoVariantsStorage;
begin begin
DoTestTwoVariantsStorage(''); DoTestTwoVariantsStorage('');
end; end;
@ -2052,7 +2094,7 @@ begin
DoTestTwoVariantsStorage('platform'); DoTestTwoVariantsStorage('platform');
end; end;
Procedure TTestRecordTypeParser.TestTwoVariantsFirstDeprecatedStorage; procedure TTestRecordTypeParser.TestTwoVariantsFirstDeprecatedStorage;
begin begin
DoTestTwoVariantsFirstDeprecatedStorage(''); DoTestTwoVariantsFirstDeprecatedStorage('');
end; end;
@ -2067,7 +2109,7 @@ begin
DoTestTwoVariantsFirstDeprecatedStorage('platform'); DoTestTwoVariantsFirstDeprecatedStorage('platform');
end; end;
Procedure TTestRecordTypeParser.TestTwoVariantsSecondDeprecatedStorage; procedure TTestRecordTypeParser.TestTwoVariantsSecondDeprecatedStorage;
begin begin
DoTestTwoVariantsSecondDeprecatedStorage(''); DoTestTwoVariantsSecondDeprecatedStorage('');
end; end;
@ -2082,107 +2124,107 @@ begin
DoTestTwoVariantsSecondDeprecatedStorage('platform'); DoTestTwoVariantsSecondDeprecatedStorage('platform');
end; end;
Procedure TTestRecordTypeParser.TestVariantTwoLabels; procedure TTestRecordTypeParser.TestVariantTwoLabels;
begin begin
DoTestVariantTwoLabels(''); DoTestVariantTwoLabels('');
end; end;
Procedure TTestRecordTypeParser.TestVariantTwoLabelsDeprecated; procedure TTestRecordTypeParser.TestVariantTwoLabelsDeprecated;
begin begin
DoTestVariantTwoLabels('Deprecated'); DoTestVariantTwoLabels('Deprecated');
end; end;
Procedure TTestRecordTypeParser.TestVariantTwoLabelsPlatform; procedure TTestRecordTypeParser.TestVariantTwoLabelsPlatform;
begin begin
DoTestVariantTwoLabels('Platform'); DoTestVariantTwoLabels('Platform');
end; end;
Procedure TTestRecordTypeParser.TestTwoVariantsTwoLabels; procedure TTestRecordTypeParser.TestTwoVariantsTwoLabels;
begin begin
DoTestTwoVariantsTwoLabels(''); DoTestTwoVariantsTwoLabels('');
end; end;
Procedure TTestRecordTypeParser.TestTwoVariantsTwoLabelsDeprecated; procedure TTestRecordTypeParser.TestTwoVariantsTwoLabelsDeprecated;
begin begin
DoTestTwoVariantsTwoLabels('Deprecated'); DoTestTwoVariantsTwoLabels('Deprecated');
end; end;
Procedure TTestRecordTypeParser.TestTwoVariantsTwoLabelsPlatform; procedure TTestRecordTypeParser.TestTwoVariantsTwoLabelsPlatform;
begin begin
DoTestTwoVariantsTwoLabels('Platform'); DoTestTwoVariantsTwoLabels('Platform');
end; end;
Procedure TTestRecordTypeParser.TestVariantNestedRecord; procedure TTestRecordTypeParser.TestVariantNestedRecord;
begin begin
DoTestVariantNestedRecord(''); DoTestVariantNestedRecord('');
end; end;
Procedure TTestRecordTypeParser.TestVariantNestedRecordDeprecated; procedure TTestRecordTypeParser.TestVariantNestedRecordDeprecated;
begin begin
DoTestVariantNestedRecord('Deprecated'); DoTestVariantNestedRecord('Deprecated');
end; end;
Procedure TTestRecordTypeParser.TestVariantNestedRecordPlatform; procedure TTestRecordTypeParser.TestVariantNestedRecordPlatform;
begin begin
DoTestVariantNestedRecord('Platform'); DoTestVariantNestedRecord('Platform');
end; end;
Procedure TTestRecordTypeParser.TestVariantNestedVariant; procedure TTestRecordTypeParser.TestVariantNestedVariant;
begin begin
DoTestVariantNestedVariant(''); DoTestVariantNestedVariant('');
end; end;
Procedure TTestRecordTypeParser.TestVariantNestedVariantDeprecated; procedure TTestRecordTypeParser.TestVariantNestedVariantDeprecated;
begin begin
DoTestVariantNestedVariant('deprecated'); DoTestVariantNestedVariant('deprecated');
end; end;
Procedure TTestRecordTypeParser.TestVariantNestedVariantPlatForm; procedure TTestRecordTypeParser.TestVariantNestedVariantPlatForm;
begin begin
DoTestVariantNestedVariant('Platform'); DoTestVariantNestedVariant('Platform');
end; end;
Procedure TTestRecordTypeParser.TestVariantNestedVariantFirstDeprecated; procedure TTestRecordTypeParser.TestVariantNestedVariantFirstDeprecated;
begin begin
DoTestVariantNestedVariantFirstDeprecated(''); DoTestVariantNestedVariantFirstDeprecated('');
end; end;
Procedure TTestRecordTypeParser.TestVariantNestedVariantFirstDeprecatedDeprecated; procedure TTestRecordTypeParser.TestVariantNestedVariantFirstDeprecatedDeprecated;
begin begin
DoTestVariantNestedVariantFirstDeprecated('deprecated'); DoTestVariantNestedVariantFirstDeprecated('deprecated');
end; end;
Procedure TTestRecordTypeParser.TestVariantNestedVariantFirstDeprecatedPlatform; procedure TTestRecordTypeParser.TestVariantNestedVariantFirstDeprecatedPlatform;
begin begin
DoTestVariantNestedVariantFirstDeprecated('platform'); DoTestVariantNestedVariantFirstDeprecated('platform');
end; end;
Procedure TTestRecordTypeParser.TestVariantNestedVariantSecondDeprecated; procedure TTestRecordTypeParser.TestVariantNestedVariantSecondDeprecated;
begin begin
DoTestVariantNestedVariantSecondDeprecated(''); DoTestVariantNestedVariantSecondDeprecated('');
end; end;
Procedure TTestRecordTypeParser.TestVariantNestedVariantSecondDeprecatedDeprecated; procedure TTestRecordTypeParser.TestVariantNestedVariantSecondDeprecatedDeprecated;
begin begin
DoTestVariantNestedVariantSecondDeprecated('deprecated'); DoTestVariantNestedVariantSecondDeprecated('deprecated');
end; end;
Procedure TTestRecordTypeParser.TestVariantNestedVariantSecondDeprecatedPlatform; procedure TTestRecordTypeParser.TestVariantNestedVariantSecondDeprecatedPlatform;
begin begin
DoTestVariantNestedVariantSecondDeprecated('platform'); DoTestVariantNestedVariantSecondDeprecated('platform');
end; end;
Procedure TTestRecordTypeParser.TestVariantNestedVariantBothDeprecated; procedure TTestRecordTypeParser.TestVariantNestedVariantBothDeprecated;
begin begin
DoTestVariantNestedVariantBothDeprecated(''); DoTestVariantNestedVariantBothDeprecated('');
end; end;
Procedure TTestRecordTypeParser.TestVariantNestedVariantBothDeprecatedDeprecated; procedure TTestRecordTypeParser.TestVariantNestedVariantBothDeprecatedDeprecated;
begin begin
DoTestVariantNestedVariantBothDeprecated('deprecated'); DoTestVariantNestedVariantBothDeprecated('deprecated');
end; end;
Procedure TTestRecordTypeParser.TestVariantNestedVariantBothDeprecatedPlatform; procedure TTestRecordTypeParser.TestVariantNestedVariantBothDeprecatedPlatform;
begin begin
DoTestVariantNestedVariantBothDeprecated('platform'); DoTestVariantNestedVariantBothDeprecated('platform');
end; end;