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

* Patch from Mattias Gaertner to fix range expression parsing (bug ID 29138)

Browse Source 
git-svn-id: trunk@32752 -
This commit is contained in:
michael 2015-12-27 10:31:18 +00:00
parent dda3f60df5
commit 07ca0393ff
3 changed files with 138 additions and 135 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1355,17 +1355,6 @@ begin
end; end;
end; end;
if CurToken = tkDotDot then begin
NextToken;
b:=TBinaryExpr.CreateRange(AParent,x, DoParseExpression(AParent));
if not Assigned(b.right) then
begin
b.free;
Exit; // error
end;
x:=b;
end;
Result:=x; Result:=x;
finally finally
if not Assigned(Result) then x.Free; if not Assigned(Result) then x.Free;
@ -1439,11 +1428,16 @@ const
t : TToken; t : TToken;
xright : TPasExpr; xright : TPasExpr;
xleft : TPasExpr; xleft : TPasExpr;
bin : TBinaryExpr;
begin begin
t:=PopOper; t:=PopOper;
xright:=PopExp; xright:=PopExp;
xleft:=PopExp; xleft:=PopExp;
expstack.Add(TBinaryExpr.Create(AParent,xleft, xright, TokenToExprOp(t))); if t=tkDotDot then
bin := TBinaryExpr.CreateRange(AParent,xleft, xright)
else
bin := TBinaryExpr.Create(AParent,xleft, xright, TokenToExprOp(t));
expstack.Add(bin);
end; end;
begin begin

7
packages/fcl-passrc/tests/tcexprparser.pas
View File

@ -258,15 +258,18 @@ end;
procedure TTestExpressions.TestRange; procedure TTestExpressions.TestRange;
Var Var
P : TParamsExpr;
B : TBinaryExpr; B : TBinaryExpr;
begin begin
DeclareVar('boolean','a'); DeclareVar('boolean','a');
DeclareVar('byte','b'); DeclareVar('byte','b');
ParseExpression('b in 0..10'); ParseExpression('b in [0..10]');
AssertBinaryExpr('Simple binary In',eopIn,FLeft,FRight); AssertBinaryExpr('Simple binary In',eopIn,FLeft,FRight);
AssertExpression('Left is b',TheLeft,pekIdent,'b'); AssertExpression('Left is b',TheLeft,pekIdent,'b');
B:=TBinaryExpr(AssertExpression('Right is range',TheRight,pekRange,TBinaryExpr)); P:=TParamsExpr(AssertExpression('Right is set',TheRight,pekSet,TParamsExpr));
AssertEquals('Number of items',1,Length(P.Params));
B:=TBinaryExpr(AssertExpression('First element is range',P.Params[0],pekRange,TBinaryExpr));
AssertExpression('Left is 0',B.Left,pekNumber,'0'); AssertExpression('Left is 0',B.Left,pekNumber,'0');
AssertExpression('Right is 10',B.Right,pekNumber,'10'); AssertExpression('Right is 10',B.Right,pekNumber,'10');
end; end;

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

@ -142,6 +142,7 @@ type
Procedure TestSubRangeSet; Procedure TestSubRangeSet;
Procedure TestRangeSetDeprecated; Procedure TestRangeSetDeprecated;
Procedure TestRangeSetPlatform; Procedure TestRangeSetPlatform;
Procedure TestNegativeRangeType;
Procedure TestClassOf; Procedure TestClassOf;
Procedure TestClassOfComment; Procedure TestClassOfComment;
Procedure TestClassOfDeprecated; Procedure TestClassOfDeprecated;
@ -2363,8 +2364,8 @@ end;
{ TTestTypeParser } { TTestTypeParser }
Procedure TTestTypeParser.DoTestAliasType(Const AnAliasType: String; procedure TTestTypeParser.DoTestAliasType(const AnAliasType: String;
Const AHint: String); const AHint: String);
begin begin
ParseType(AnAliasType,TPasAliasType,AHint); ParseType(AnAliasType,TPasAliasType,AHint);
AssertEquals('Unresolved type',TPasUnresolvedTypeRef,TPasAliasType(TheType).DestType.ClassType); AssertEquals('Unresolved type',TPasUnresolvedTypeRef,TPasAliasType(TheType).DestType.ClassType);
@ -2377,20 +2378,20 @@ begin
AssertEquals('String type',TPasStringType,TPasAliasType(TheType).DestType.ClassType); AssertEquals('String type',TPasStringType,TPasAliasType(TheType).DestType.ClassType);
end; end;
procedure TTestTypeParser.DoTypeError(Const AMsg,ASource : string); procedure TTestTypeParser.DoTypeError(const AMsg, ASource: string);
begin begin
FErrorSource:=ASource; FErrorSource:=ASource;
AssertException(AMsg,EParserError,@DoParseError); AssertException(AMsg,EParserError,@DoParseError);
end; end;
Procedure TTestTypeParser.DoParseError; procedure TTestTypeParser.DoParseError;
begin begin
ParseType(FErrorSource,Nil); ParseType(FErrorSource,Nil);
end; end;
Procedure TTestTypeParser.DoParsePointer(Const ASource: String; procedure TTestTypeParser.DoParsePointer(const ASource: String;
Const AHint: String; ADestType: TClass); const AHint: String; ADestType: TClass);
begin begin
ParseType('^'+ASource,TPasPointerType,AHint); ParseType('^'+ASource,TPasPointerType,AHint);
@ -2399,8 +2400,8 @@ begin
AssertEquals('Destination type '+ADestType.ClassName,ADestType,TPasPointerType(TheType).DestType.ClassType); AssertEquals('Destination type '+ADestType.ClassName,ADestType,TPasPointerType(TheType).DestType.ClassType);
end; end;
Procedure TTestTypeParser.DoParseArray(Const ASource: String; procedure TTestTypeParser.DoParseArray(const ASource: String;
Const AHint: String; ADestType: TClass); const AHint: String; ADestType: TClass);
begin begin
ParseType(ASource,TPasArrayType,AHint); ParseType(ASource,TPasArrayType,AHint);
if ADestType = Nil then if ADestType = Nil then
@ -2408,8 +2409,8 @@ begin
AssertEquals('Destination type '+ADestType.ClassName,ADestType,TPasArrayType(TheType).ElType.ClassType); AssertEquals('Destination type '+ADestType.ClassName,ADestType,TPasArrayType(TheType).ElType.ClassType);
end; end;
Procedure TTestTypeParser.DoParseEnumerated(Const ASource: String; procedure TTestTypeParser.DoParseEnumerated(const ASource: String;
Const AHint: String; ACount: integer); const AHint: String; ACount: integer);
Var Var
I : Integer; I : Integer;
@ -2422,8 +2423,8 @@ begin
AssertEquals('Enum value typed element '+IntToStr(I),TPasEnumValue,TObject(TPasEnumType(TheType).Values[i]).ClassType); AssertEquals('Enum value typed element '+IntToStr(I),TPasEnumValue,TObject(TPasEnumType(TheType).Values[i]).ClassType);
end; end;
Procedure TTestTypeParser.DoTestFileType(Const AType: String; procedure TTestTypeParser.DoTestFileType(const AType: String;
Const AHint: String; ADestType: TClass); const AHint: String; ADestType: TClass);
begin begin
ParseType('File of '+AType,TPasFileType,AHint); ParseType('File of '+AType,TPasFileType,AHint);
AssertNotNull('Have element type',TPasFileType(TheType).ElType); AssertNotNull('Have element type',TPasFileType(TheType).ElType);
@ -2432,23 +2433,23 @@ begin
AssertEquals('Element type '+ADestType.ClassName,ADestType,TPasFileType(TheType).ElType.ClassType); AssertEquals('Element type '+ADestType.ClassName,ADestType,TPasFileType(TheType).ElType.ClassType);
end; end;
Procedure TTestTypeParser.DoTestRangeType(Const AStart, AStop, AHint: String); procedure TTestTypeParser.DoTestRangeType(const AStart, AStop, AHint: String);
begin begin
ParseType(AStart+'..'+AStop,TPasRangeType,AHint); ParseType(AStart+'..'+AStop,TPasRangeType,AHint);
AssertEquals('Range start',AStart,TPasRangeType(TheType).RangeStart); AssertEquals('Range start',AStart,Stringreplace(TPasRangeType(TheType).RangeStart,' ','',[rfReplaceAll]));
AssertEquals('Range start',AStop,TPasRangeType(TheType).RangeEnd); AssertEquals('Range start',AStop,Stringreplace(TPasRangeType(TheType).RangeEnd,' ','',[rfReplaceAll]));
end; end;
Procedure TTestTypeParser.DoParseSimpleSet(Const ASource: String; procedure TTestTypeParser.DoParseSimpleSet(const ASource: String;
Const AHint: String); const AHint: String);
begin begin
ParseType('Set of '+ASource,TPasSetType,AHint); ParseType('Set of '+ASource,TPasSetType,AHint);
AssertNotNull('Have enumtype',TPasSetType(TheType).EnumType); AssertNotNull('Have enumtype',TPasSetType(TheType).EnumType);
AssertEquals('Element type ',TPasUnresolvedTypeRef,TPasSetType(TheType).EnumType.ClassType); AssertEquals('Element type ',TPasUnresolvedTypeRef,TPasSetType(TheType).EnumType.ClassType);
end; end;
Procedure TTestTypeParser.DoParseComplexSet(Const ASource: String; procedure TTestTypeParser.DoParseComplexSet(const ASource: String;
Const AHint: String); const AHint: String);
begin begin
ParseType('Set of '+ASource,TPasSetType,AHint); ParseType('Set of '+ASource,TPasSetType,AHint);
@ -2465,7 +2466,7 @@ begin
AssertEquals('Element type ',TPasRangeType,TPasSetType(TheType).EnumType.ClassType); AssertEquals('Element type ',TPasRangeType,TPasSetType(TheType).EnumType.ClassType);
end; end;
Procedure TTestTypeParser.DoTestComplexSet; procedure TTestTypeParser.DoTestComplexSet;
Var Var
I : integer; I : integer;
@ -2483,7 +2484,7 @@ begin
AssertEquals('Assigned value third enumerated empty','',TPasEnumValue(TPasEnumType(TPasSetType(TheType).EnumType).Values[2]).AssignedValue); AssertEquals('Assigned value third enumerated empty','',TPasEnumValue(TPasEnumType(TPasSetType(TheType).EnumType).Values[2]).AssignedValue);
end; end;
Procedure TTestTypeParser.DoTestClassOf(Const AHint: string); procedure TTestTypeParser.DoTestClassOf(const AHint: string);
begin begin
ParseType('Class of TSomeClass',TPasClassOfType,AHint); ParseType('Class of TSomeClass',TPasClassOfType,AHint);
@ -2491,285 +2492,285 @@ begin
AssertEquals('Element type ',TPasUnresolvedTypeRef,TPasClassOfType(TheType).DestType.ClassType); AssertEquals('Element type ',TPasUnresolvedTypeRef,TPasClassOfType(TheType).DestType.ClassType);
end; end;
Procedure TTestTypeParser.TestAliasType; procedure TTestTypeParser.TestAliasType;
begin begin
DoTestAliasType('othertype',''); DoTestAliasType('othertype','');
AssertEquals('Unresolved type name ','othertype',TPasUnresolvedTypeRef(TPasAliasType(TheType).DestType).name); AssertEquals('Unresolved type name ','othertype',TPasUnresolvedTypeRef(TPasAliasType(TheType).DestType).name);
end; end;
Procedure TTestTypeParser.TestCrossUnitAliasType; procedure TTestTypeParser.TestCrossUnitAliasType;
begin begin
DoTestAliasType('otherunit.othertype',''); DoTestAliasType('otherunit.othertype','');
end; end;
Procedure TTestTypeParser.TestAliasTypeDeprecated; procedure TTestTypeParser.TestAliasTypeDeprecated;
begin begin
DoTestALiasType('othertype','deprecated'); DoTestALiasType('othertype','deprecated');
end; end;
Procedure TTestTypeParser.TestAliasTypePlatform; procedure TTestTypeParser.TestAliasTypePlatform;
begin begin
DoTestALiasType('othertype','platform'); DoTestALiasType('othertype','platform');
end; end;
Procedure TTestTypeParser.TestSimpleTypeByte; procedure TTestTypeParser.TestSimpleTypeByte;
begin begin
DoTestAliasType('BYTE',''); DoTestAliasType('BYTE','');
end; end;
Procedure TTestTypeParser.TestSimpleTypeByteComment; procedure TTestTypeParser.TestSimpleTypeByteComment;
begin begin
AddComment:=True; AddComment:=True;
DoTestAliasType('BYTE',''); DoTestAliasType('BYTE','');
AssertComment; AssertComment;
end; end;
Procedure TTestTypeParser.TestSimpleTypeByteDeprecated; procedure TTestTypeParser.TestSimpleTypeByteDeprecated;
begin begin
DoTestAliasType('BYTE','deprecated'); DoTestAliasType('BYTE','deprecated');
end; end;
Procedure TTestTypeParser.TestSimpleTypeBytePlatform; procedure TTestTypeParser.TestSimpleTypeBytePlatform;
begin begin
DoTestAliasType('BYTE','platform'); DoTestAliasType('BYTE','platform');
end; end;
Procedure TTestTypeParser.TestSimpleTypeBoolean; procedure TTestTypeParser.TestSimpleTypeBoolean;
begin begin
DoTestAliasType('BOOLEAN',''); DoTestAliasType('BOOLEAN','');
end; end;
Procedure TTestTypeParser.TestSimpleTypeBooleanDeprecated; procedure TTestTypeParser.TestSimpleTypeBooleanDeprecated;
begin begin
DoTestAliasType('BOOLEAN','deprecated'); DoTestAliasType('BOOLEAN','deprecated');
end; end;
Procedure TTestTypeParser.TestSimpleTypeBooleanPlatform; procedure TTestTypeParser.TestSimpleTypeBooleanPlatform;
begin begin
DoTestAliasType('BOOLEAN','platform'); DoTestAliasType('BOOLEAN','platform');
end; end;
Procedure TTestTypeParser.TestSimpleTypeChar; procedure TTestTypeParser.TestSimpleTypeChar;
begin begin
DoTestAliasType('CHAR',''); DoTestAliasType('CHAR','');
end; end;
Procedure TTestTypeParser.TestSimpleTypeCharDeprecated; procedure TTestTypeParser.TestSimpleTypeCharDeprecated;
begin begin
DoTestAliasType('CHAR','deprecated'); DoTestAliasType('CHAR','deprecated');
end; end;
Procedure TTestTypeParser.TestSimpleTypeCharPlatform; procedure TTestTypeParser.TestSimpleTypeCharPlatform;
begin begin
DoTestAliasType('CHAR','platform'); DoTestAliasType('CHAR','platform');
end; end;
Procedure TTestTypeParser.TestSimpleTypeInteger; procedure TTestTypeParser.TestSimpleTypeInteger;
begin begin
DoTestAliasType('INTEGER',''); DoTestAliasType('INTEGER','');
end; end;
Procedure TTestTypeParser.TestSimpleTypeIntegerDeprecated; procedure TTestTypeParser.TestSimpleTypeIntegerDeprecated;
begin begin
DoTestAliasType('INTEGER','deprecated'); DoTestAliasType('INTEGER','deprecated');
end; end;
Procedure TTestTypeParser.TestSimpleTypeIntegerPlatform; procedure TTestTypeParser.TestSimpleTypeIntegerPlatform;
begin begin
DoTestAliasType('INTEGER','platform'); DoTestAliasType('INTEGER','platform');
end; end;
Procedure TTestTypeParser.TestSimpleTypeInt64; procedure TTestTypeParser.TestSimpleTypeInt64;
begin begin
DoTestAliasType('INT64',''); DoTestAliasType('INT64','');
end; end;
Procedure TTestTypeParser.TestSimpleTypeInt64Deprecated; procedure TTestTypeParser.TestSimpleTypeInt64Deprecated;
begin begin
DoTestAliasType('INT64','deprecated'); DoTestAliasType('INT64','deprecated');
end; end;
Procedure TTestTypeParser.TestSimpleTypeInt64Platform; procedure TTestTypeParser.TestSimpleTypeInt64Platform;
begin begin
DoTestAliasType('INT64','platform'); DoTestAliasType('INT64','platform');
end; end;
Procedure TTestTypeParser.TestSimpleTypeLongInt; procedure TTestTypeParser.TestSimpleTypeLongInt;
begin begin
DoTestAliasType('LONGINT',''); DoTestAliasType('LONGINT','');
end; end;
Procedure TTestTypeParser.TestSimpleTypeLongIntDeprecated; procedure TTestTypeParser.TestSimpleTypeLongIntDeprecated;
begin begin
DoTestAliasType('LONGINT','deprecated'); DoTestAliasType('LONGINT','deprecated');
end; end;
Procedure TTestTypeParser.TestSimpleTypeLongIntPlatform; procedure TTestTypeParser.TestSimpleTypeLongIntPlatform;
begin begin
DoTestAliasType('LONGINT','platform'); DoTestAliasType('LONGINT','platform');
end; end;
Procedure TTestTypeParser.TestSimpleTypeLongWord; procedure TTestTypeParser.TestSimpleTypeLongWord;
begin begin
DoTestAliasType('LONGWORD',''); DoTestAliasType('LONGWORD','');
end; end;
Procedure TTestTypeParser.TestSimpleTypeLongWordDeprecated; procedure TTestTypeParser.TestSimpleTypeLongWordDeprecated;
begin begin
DoTestAliasType('LONGWORD','deprecated'); DoTestAliasType('LONGWORD','deprecated');
end; end;
Procedure TTestTypeParser.TestSimpleTypeLongWordPlatform; procedure TTestTypeParser.TestSimpleTypeLongWordPlatform;
begin begin
DoTestAliasType('LONGWORD','platform'); DoTestAliasType('LONGWORD','platform');
end; end;
Procedure TTestTypeParser.TestSimpleTypeDouble; procedure TTestTypeParser.TestSimpleTypeDouble;
begin begin
DoTestAliasType('Double',''); DoTestAliasType('Double','');
end; end;
Procedure TTestTypeParser.TestSimpleTypeDoubleDeprecated; procedure TTestTypeParser.TestSimpleTypeDoubleDeprecated;
begin begin
DoTestAliasType('Double','deprecated'); DoTestAliasType('Double','deprecated');
end; end;
Procedure TTestTypeParser.TestSimpleTypeDoublePlatform; procedure TTestTypeParser.TestSimpleTypeDoublePlatform;
begin begin
DoTestAliasType('Double','platform'); DoTestAliasType('Double','platform');
end; end;
Procedure TTestTypeParser.TestSimpleTypeShortInt; procedure TTestTypeParser.TestSimpleTypeShortInt;
begin begin
DoTestAliasType('SHORTINT',''); DoTestAliasType('SHORTINT','');
end; end;
Procedure TTestTypeParser.TestSimpleTypeShortIntDeprecated; procedure TTestTypeParser.TestSimpleTypeShortIntDeprecated;
begin begin
DoTestAliasType('SHORTINT','deprecated'); DoTestAliasType('SHORTINT','deprecated');
end; end;
Procedure TTestTypeParser.TestSimpleTypeShortIntPlatform; procedure TTestTypeParser.TestSimpleTypeShortIntPlatform;
begin begin
DoTestAliasType('SHORTINT','platform'); DoTestAliasType('SHORTINT','platform');
end; end;
Procedure TTestTypeParser.TestSimpleTypeSmallInt; procedure TTestTypeParser.TestSimpleTypeSmallInt;
begin begin
DoTestAliasType('SMALLINT',''); DoTestAliasType('SMALLINT','');
end; end;
Procedure TTestTypeParser.TestSimpleTypeSmallIntDeprecated; procedure TTestTypeParser.TestSimpleTypeSmallIntDeprecated;
begin begin
DoTestAliasType('SMALLINT','deprecated'); DoTestAliasType('SMALLINT','deprecated');
end; end;
Procedure TTestTypeParser.TestSimpleTypeSmallIntPlatform; procedure TTestTypeParser.TestSimpleTypeSmallIntPlatform;
begin begin
DoTestAliasType('SMALLINT','platform'); DoTestAliasType('SMALLINT','platform');
end; end;
Procedure TTestTypeParser.TestSimpleTypeString; procedure TTestTypeParser.TestSimpleTypeString;
begin begin
DoTestAliasType('STRING',''); DoTestAliasType('STRING','');
end; end;
Procedure TTestTypeParser.TestSimpleTypeStringDeprecated; procedure TTestTypeParser.TestSimpleTypeStringDeprecated;
begin begin
DoTestAliasType('STRING','deprecated'); DoTestAliasType('STRING','deprecated');
end; end;
Procedure TTestTypeParser.TestSimpleTypeStringPlatform; procedure TTestTypeParser.TestSimpleTypeStringPlatform;
begin begin
DoTestAliasType('STRING','platform'); DoTestAliasType('STRING','platform');
end; end;
Procedure TTestTypeParser.TestSimpleTypeStringSize; procedure TTestTypeParser.TestSimpleTypeStringSize;
begin begin
DoTestStringType('String[10]',''); DoTestStringType('String[10]','');
end; end;
Procedure TTestTypeParser.TestSimpleTypeStringSizeIncomplete; procedure TTestTypeParser.TestSimpleTypeStringSizeIncomplete;
begin begin
DoTypeError('Incomplete string: missing ]','string[10'); DoTypeError('Incomplete string: missing ]','string[10');
end; end;
Procedure TTestTypeParser.TestSimpleTypeStringSizeWrong; procedure TTestTypeParser.TestSimpleTypeStringSizeWrong;
begin begin
DoTypeError('Incomplete string, ) instead of ]','string[10)'); DoTypeError('Incomplete string, ) instead of ]','string[10)');
end; end;
Procedure TTestTypeParser.TestSimpleTypeStringSizeDeprecated; procedure TTestTypeParser.TestSimpleTypeStringSizeDeprecated;
begin begin
DoTestStringType('String[10]','deprecated'); DoTestStringType('String[10]','deprecated');
end; end;
Procedure TTestTypeParser.TestSimpleTypeStringSizePlatform; procedure TTestTypeParser.TestSimpleTypeStringSizePlatform;
begin begin
DoTestStringType('String[10]','Platform'); DoTestStringType('String[10]','Platform');
end; end;
Procedure TTestTypeParser.TestSimpleTypeWord; procedure TTestTypeParser.TestSimpleTypeWord;
BEGIN BEGIN
DoTestAliasType('WORD',''); DoTestAliasType('WORD','');
end; end;
Procedure TTestTypeParser.TestSimpleTypeWordDeprecated; procedure TTestTypeParser.TestSimpleTypeWordDeprecated;
begin begin
DoTestAliasType('WORD','deprecated'); DoTestAliasType('WORD','deprecated');
end; end;
Procedure TTestTypeParser.TestSimpleTypeWordPlatform; procedure TTestTypeParser.TestSimpleTypeWordPlatform;
begin begin
DoTestAliasType('WORD','platform'); DoTestAliasType('WORD','platform');
end; end;
Procedure TTestTypeParser.TestSimpleTypeQWord; procedure TTestTypeParser.TestSimpleTypeQWord;
BEGIN BEGIN
DoTestAliasType('QWORD',''); DoTestAliasType('QWORD','');
end; end;
Procedure TTestTypeParser.TestSimpleTypeQWordDeprecated; procedure TTestTypeParser.TestSimpleTypeQWordDeprecated;
begin begin
DoTestAliasType('QWORD','deprecated'); DoTestAliasType('QWORD','deprecated');
end; end;
Procedure TTestTypeParser.TestSimpleTypeQWordPlatform; procedure TTestTypeParser.TestSimpleTypeQWordPlatform;
begin begin
DoTestAliasType('QWORD','platform'); DoTestAliasType('QWORD','platform');
end; end;
Procedure TTestTypeParser.TestSimpleTypeCardinal; procedure TTestTypeParser.TestSimpleTypeCardinal;
begin begin
DoTestAliasType('CARDINAL',''); DoTestAliasType('CARDINAL','');
end; end;
Procedure TTestTypeParser.TestSimpleTypeCardinalDeprecated; procedure TTestTypeParser.TestSimpleTypeCardinalDeprecated;
begin begin
DoTestAliasType('CARDINAL','deprecated'); DoTestAliasType('CARDINAL','deprecated');
end; end;
Procedure TTestTypeParser.TestSimpleTypeCardinalPlatform; procedure TTestTypeParser.TestSimpleTypeCardinalPlatform;
begin begin
DoTestAliasType('CARDINAL','platform'); DoTestAliasType('CARDINAL','platform');
end; end;
Procedure TTestTypeParser.TestSimpleTypeWideChar; procedure TTestTypeParser.TestSimpleTypeWideChar;
begin begin
DoTestAliasType('WIDECHAR',''); DoTestAliasType('WIDECHAR','');
end; end;
Procedure TTestTypeParser.TestSimpleTypeWideCharDeprecated; procedure TTestTypeParser.TestSimpleTypeWideCharDeprecated;
begin begin
DoTestAliasType('WIDECHAR','deprecated'); DoTestAliasType('WIDECHAR','deprecated');
end; end;
Procedure TTestTypeParser.TestSimpleTypeWideCharPlatform; procedure TTestTypeParser.TestSimpleTypeWideCharPlatform;
begin begin
DoTestAliasType('WIDECHAR','platform'); DoTestAliasType('WIDECHAR','platform');
end; end;
Procedure TTestTypeParser.TestPointerSimple; procedure TTestTypeParser.TestPointerSimple;
begin begin
DoParsePointer('integer',''); DoParsePointer('integer','');
end; end;
@ -2784,13 +2785,13 @@ begin
DoParsePointer('integer','platform'); DoParsePointer('integer','platform');
end; end;
Procedure TTestTypeParser.TestStaticArray; procedure TTestTypeParser.TestStaticArray;
begin begin
DoParseArray('array [0..2] of integer','',Nil); DoParseArray('array [0..2] of integer','',Nil);
AssertEquals('Array type','0..2',TPasArrayType(TheType).IndexRange); AssertEquals('Array type','0..2',TPasArrayType(TheType).IndexRange);
end; end;
Procedure TTestTypeParser.TestStaticArrayComment; procedure TTestTypeParser.TestStaticArrayComment;
begin begin
AddComment:=True; AddComment:=True;
TestStaticArray; TestStaticArray;
@ -2809,26 +2810,26 @@ begin
AssertEquals('Array type','0..2',TPasArrayType(TheType).IndexRange); AssertEquals('Array type','0..2',TPasArrayType(TheType).IndexRange);
end; end;
Procedure TTestTypeParser.TestStaticArrayPacked; procedure TTestTypeParser.TestStaticArrayPacked;
begin begin
DoParseArray('packed array [0..2] of integer','',Nil); DoParseArray('packed array [0..2] of integer','',Nil);
AssertEquals('Array type','0..2',TPasArrayType(TheType).IndexRange); AssertEquals('Array type','0..2',TPasArrayType(TheType).IndexRange);
AssertEquals('Packed',True,TPasArrayType(TheType).IsPacked); AssertEquals('Packed',True,TPasArrayType(TheType).IsPacked);
end; end;
Procedure TTestTypeParser.TestStaticArrayTypedIndex; procedure TTestTypeParser.TestStaticArrayTypedIndex;
begin begin
DoParseArray('array [Boolean] of integer','',Nil); DoParseArray('array [Boolean] of integer','',Nil);
AssertEquals('Array type','Boolean',TPasArrayType(TheType).IndexRange); AssertEquals('Array type','Boolean',TPasArrayType(TheType).IndexRange);
end; end;
Procedure TTestTypeParser.TestDynamicArray; procedure TTestTypeParser.TestDynamicArray;
begin begin
DoParseArray('array of integer','',Nil); DoParseArray('array of integer','',Nil);
AssertEquals('Array type','',TPasArrayType(TheType).IndexRange); AssertEquals('Array type','',TPasArrayType(TheType).IndexRange);
end; end;
Procedure TTestTypeParser.TestDynamicArrayComment; procedure TTestTypeParser.TestDynamicArrayComment;
begin begin
AddComment:=True; AddComment:=True;
DoParseArray('array of integer','',Nil); DoParseArray('array of integer','',Nil);
@ -2836,7 +2837,7 @@ begin
AssertComment; AssertComment;
end; end;
Procedure TTestTypeParser.TestSimpleEnumerated; procedure TTestTypeParser.TestSimpleEnumerated;
begin begin
DoParseEnumerated('(one,two,three)','',3); DoParseEnumerated('(one,two,three)','',3);
@ -2848,7 +2849,7 @@ begin
AssertEquals('Assigned value third enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[2]).AssignedValue); AssertEquals('Assigned value third enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[2]).AssignedValue);
end; end;
Procedure TTestTypeParser.TestSimpleEnumeratedComment; procedure TTestTypeParser.TestSimpleEnumeratedComment;
begin begin
AddComment:=True; AddComment:=True;
TestSimpleEnumerated; TestSimpleEnumerated;
@ -2858,7 +2859,7 @@ begin
AssertEquals('No comment on enum 2','',TPasEnumValue(TPasEnumType(TheType).Values[2]).DocComment); AssertEquals('No comment on enum 2','',TPasEnumValue(TPasEnumType(TheType).Values[2]).DocComment);
end; end;
Procedure TTestTypeParser.TestSimpleEnumeratedComment2; procedure TTestTypeParser.TestSimpleEnumeratedComment2;
begin begin
AddComment:=True; AddComment:=True;
DoParseEnumerated('( {a} one, {b} two, {c} three)','',3); DoParseEnumerated('( {a} one, {b} two, {c} three)','',3);
@ -2867,7 +2868,7 @@ begin
AssertEquals('comment on enum 2','c'+sLineBreak,TPasEnumValue(TPasEnumType(TheType).Values[2]).DocComment); AssertEquals('comment on enum 2','c'+sLineBreak,TPasEnumValue(TPasEnumType(TheType).Values[2]).DocComment);
end; end;
Procedure TTestTypeParser.TestSimpleEnumeratedDeprecated; procedure TTestTypeParser.TestSimpleEnumeratedDeprecated;
begin begin
DoParseEnumerated('(one,two,three)','deprecated',3); DoParseEnumerated('(one,two,three)','deprecated',3);
AssertEquals('First enumerated value','one',TPasEnumValue(TPasEnumType(TheType).Values[0]).Name); AssertEquals('First enumerated value','one',TPasEnumValue(TPasEnumType(TheType).Values[0]).Name);
@ -2878,7 +2879,7 @@ begin
AssertEquals('Assigned value third enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[2]).AssignedValue); AssertEquals('Assigned value third enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[2]).AssignedValue);
end; end;
Procedure TTestTypeParser.TestSimpleEnumeratedPlatform; procedure TTestTypeParser.TestSimpleEnumeratedPlatform;
begin begin
DoParseEnumerated('(one,two,three)','platform',3); DoParseEnumerated('(one,two,three)','platform',3);
AssertEquals('First enumerated value','one',TPasEnumValue(TPasEnumType(TheType).Values[0]).Name); AssertEquals('First enumerated value','one',TPasEnumValue(TPasEnumType(TheType).Values[0]).Name);
@ -2889,7 +2890,7 @@ begin
AssertEquals('Assigned value third enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[2]).AssignedValue); AssertEquals('Assigned value third enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[2]).AssignedValue);
end; end;
Procedure TTestTypeParser.TestAssignedEnumerated; procedure TTestTypeParser.TestAssignedEnumerated;
begin begin
DoParseEnumerated('(one,two:=2,three)','',3); DoParseEnumerated('(one,two:=2,three)','',3);
AssertEquals('First enumerated value','one',TPasEnumValue(TPasEnumType(TheType).Values[0]).Name); AssertEquals('First enumerated value','one',TPasEnumValue(TPasEnumType(TheType).Values[0]).Name);
@ -2900,7 +2901,7 @@ begin
AssertEquals('Assigned value first enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[2]).AssignedValue); AssertEquals('Assigned value first enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[2]).AssignedValue);
end; end;
Procedure TTestTypeParser.TestAssignedEnumeratedDeprecated; procedure TTestTypeParser.TestAssignedEnumeratedDeprecated;
begin begin
DoParseEnumerated('(one,two:=2,three)','',3); DoParseEnumerated('(one,two:=2,three)','',3);
AssertEquals('First enumerated value','one',TPasEnumValue(TPasEnumType(TheType).Values[0]).Name); AssertEquals('First enumerated value','one',TPasEnumValue(TPasEnumType(TheType).Values[0]).Name);
@ -2911,7 +2912,7 @@ begin
AssertEquals('Assigned value first enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[2]).AssignedValue); AssertEquals('Assigned value first enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[2]).AssignedValue);
end; end;
Procedure TTestTypeParser.TestAssignedEnumeratedPlatform; procedure TTestTypeParser.TestAssignedEnumeratedPlatform;
begin begin
DoParseEnumerated('(one,two:=2,three)','',3); DoParseEnumerated('(one,two:=2,three)','',3);
AssertEquals('First enumerated value','one',TPasEnumValue(TPasEnumType(TheType).Values[0]).Name); AssertEquals('First enumerated value','one',TPasEnumValue(TPasEnumType(TheType).Values[0]).Name);
@ -2922,73 +2923,73 @@ begin
AssertEquals('Assigned value first enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[2]).AssignedValue); AssertEquals('Assigned value first enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[2]).AssignedValue);
end; end;
Procedure TTestTypeParser.TestFileType; procedure TTestTypeParser.TestFileType;
begin begin
DoTestFileType('integer',''); DoTestFileType('integer','');
end; end;
Procedure TTestTypeParser.TestFileTypeDeprecated; procedure TTestTypeParser.TestFileTypeDeprecated;
begin begin
DoTestFileType('integer','deprecated'); DoTestFileType('integer','deprecated');
end; end;
Procedure TTestTypeParser.TestFileTypePlatform; procedure TTestTypeParser.TestFileTypePlatform;
begin begin
DoTestFileType('integer','platform'); DoTestFileType('integer','platform');
end; end;
Procedure TTestTypeParser.TestRangeType; procedure TTestTypeParser.TestRangeType;
begin begin
DoTestRangeType('1','4',''); DoTestRangeType('1','4','');
end; end;
Procedure TTestTypeParser.TestRangeTypeDeprecated; procedure TTestTypeParser.TestRangeTypeDeprecated;
begin begin
DoTestRangeType('1','4','deprecated'); DoTestRangeType('1','4','deprecated');
end; end;
Procedure TTestTypeParser.TestRangeTypePlatform; procedure TTestTypeParser.TestRangeTypePlatform;
begin begin
DoTestRangeType('1','4','platform'); DoTestRangeType('1','4','platform');
end; end;
Procedure TTestTypeParser.TestIdentifierRangeType; procedure TTestTypeParser.TestIdentifierRangeType;
begin begin
DoTestRangeType('tkFirst','tkLast',''); DoTestRangeType('tkFirst','tkLast','');
end; end;
Procedure TTestTypeParser.TestIdentifierRangeTypeDeprecated; procedure TTestTypeParser.TestIdentifierRangeTypeDeprecated;
begin begin
DoTestRangeType('tkFirst','tkLast','deprecated'); DoTestRangeType('tkFirst','tkLast','deprecated');
end; end;
Procedure TTestTypeParser.TestIdentifierRangeTypePlatform; procedure TTestTypeParser.TestIdentifierRangeTypePlatform;
begin begin
DoTestRangeType('tkFirst','tkLast','platform'); DoTestRangeType('tkFirst','tkLast','platform');
end; end;
Procedure TTestTypeParser.TestNegativeIdentifierRangeType; procedure TTestTypeParser.TestNegativeIdentifierRangeType;
begin begin
DoTestRangeType('-tkLast','tkLast',''); DoTestRangeType('-tkLast','tkLast','');
end; end;
Procedure TTestTypeParser.TestSimpleSet; procedure TTestTypeParser.TestSimpleSet;
begin begin
DoParseSimpleSet('Byte',''); DoParseSimpleSet('Byte','');
end; end;
Procedure TTestTypeParser.TestSimpleSetDeprecated; procedure TTestTypeParser.TestSimpleSetDeprecated;
begin begin
DoParseSimpleSet('Byte','deprecated'); DoParseSimpleSet('Byte','deprecated');
end; end;
Procedure TTestTypeParser.TestSimpleSetPlatform; procedure TTestTypeParser.TestSimpleSetPlatform;
begin begin
DoParseSimpleSet('Byte','platform'); DoParseSimpleSet('Byte','platform');
end; end;
Procedure TTestTypeParser.TestComplexSet; procedure TTestTypeParser.TestComplexSet;
begin begin
@ -2996,64 +2997,69 @@ begin
DoTestComplexSet; DoTestComplexSet;
end; end;
Procedure TTestTypeParser.TestComplexSetDeprecated; procedure TTestTypeParser.TestComplexSetDeprecated;
begin begin
DoParseComplexSet('(one, two, three)','deprecated'); DoParseComplexSet('(one, two, three)','deprecated');
DoTestComplexSet; DoTestComplexSet;
end; end;
Procedure TTestTypeParser.TestComplexSetPlatform; procedure TTestTypeParser.TestComplexSetPlatform;
begin begin
DoParseComplexSet('(one, two, three)','platform'); DoParseComplexSet('(one, two, three)','platform');
DoTestComplexSet; DoTestComplexSet;
end; end;
Procedure TTestTypeParser.TestRangeSet; procedure TTestTypeParser.TestRangeSet;
begin begin
// TRange = (rLow, rMiddle, rHigh); // TRange = (rLow, rMiddle, rHigh);
DoParseRangeSet('rMiddle..high(TRange)',''); DoParseRangeSet('rMiddle..high(TRange)','');
end; end;
Procedure TTestTypeParser.TestSubRangeSet; procedure TTestTypeParser.TestSubRangeSet;
begin begin
DoParseRangeSet('0..SizeOf(Integer)*8-1',''); DoParseRangeSet('0..SizeOf(Integer)*8-1','');
end; end;
Procedure TTestTypeParser.TestRangeSetDeprecated; procedure TTestTypeParser.TestRangeSetDeprecated;
begin begin
DoParseRangeSet('0..SizeOf(Integer)*8-1','deprecated'); DoParseRangeSet('0..SizeOf(Integer)*8-1','deprecated');
end; end;
Procedure TTestTypeParser.TestRangeSetPlatform; procedure TTestTypeParser.TestRangeSetPlatform;
begin begin
DoParseRangeSet('0..SizeOf(Integer)*8-1','platform'); DoParseRangeSet('0..SizeOf(Integer)*8-1','platform');
end; end;
Procedure TTestTypeParser.TestClassOf; procedure TTestTypeParser.TestNegativeRangeType;
begin
DoTestRangeType('2-1','3','');
end;
procedure TTestTypeParser.TestClassOf;
begin begin
DoTestClassOf(''); DoTestClassOf('');
end; end;
Procedure TTestTypeParser.TestClassOfComment; procedure TTestTypeParser.TestClassOfComment;
begin begin
AddComment:=True; AddComment:=True;
DoTestClassOf(''); DoTestClassOf('');
AssertComment; AssertComment;
end; end;
Procedure TTestTypeParser.TestClassOfDeprecated; procedure TTestTypeParser.TestClassOfDeprecated;
begin begin
DoTestClassOf('deprecated'); DoTestClassOf('deprecated');
end; end;
Procedure TTestTypeParser.TestClassOfPlatform; procedure TTestTypeParser.TestClassOfPlatform;
begin begin
DoTestClassOf('Platform'); DoTestClassOf('Platform');
end; end;
Procedure TTestTypeParser.TestReferenceAlias; procedure TTestTypeParser.TestReferenceAlias;
begin begin
Add('Type'); Add('Type');
Add(' Type1 = Integer;'); Add(' Type1 = Integer;');
@ -3068,7 +3074,7 @@ begin
AssertSame('Second declaration references first.',Declarations.Types[0],TPasAliasType(Declarations.Types[1]).DestType); AssertSame('Second declaration references first.',Declarations.Types[0],TPasAliasType(Declarations.Types[1]).DestType);
end; end;
Procedure TTestTypeParser.TestReferenceSet; procedure TTestTypeParser.TestReferenceSet;
begin begin
Add('Type'); Add('Type');
@ -3084,7 +3090,7 @@ begin
AssertSame('Second declaration references first.',Declarations.Types[0],TPasSetType(Declarations.Types[1]).EnumType); AssertSame('Second declaration references first.',Declarations.Types[0],TPasSetType(Declarations.Types[1]).EnumType);
end; end;
Procedure TTestTypeParser.TestReferenceClassOf; procedure TTestTypeParser.TestReferenceClassOf;
begin begin
Add('Type'); Add('Type');
Add(' Type1 = Class(TObject);'); Add(' Type1 = Class(TObject);');
@ -3100,7 +3106,7 @@ begin
AssertSame('Second declaration references first.',Declarations.Classes[0],TPasClassOfType(Declarations.Types[0]).DestType); AssertSame('Second declaration references first.',Declarations.Classes[0],TPasClassOfType(Declarations.Types[0]).DestType);
end; end;
Procedure TTestTypeParser.TestReferenceFile; procedure TTestTypeParser.TestReferenceFile;
begin begin
Add('Type'); Add('Type');
Add(' Type1 = (a,b,c);'); Add(' Type1 = (a,b,c);');
@ -3115,7 +3121,7 @@ begin
AssertSame('Second declaration references first.',Declarations.Types[0],TPasFileType(Declarations.Types[1]).elType); AssertSame('Second declaration references first.',Declarations.Types[0],TPasFileType(Declarations.Types[1]).elType);
end; end;
Procedure TTestTypeParser.TestReferenceArray; procedure TTestTypeParser.TestReferenceArray;
begin begin
Add('Type'); Add('Type');
Add(' Type1 = (a,b,c);'); Add(' Type1 = (a,b,c);');
@ -3130,7 +3136,7 @@ begin
AssertSame('Second declaration references first.',Declarations.Types[0],TPasArrayType(Declarations.Types[1]).elType); AssertSame('Second declaration references first.',Declarations.Types[0],TPasArrayType(Declarations.Types[1]).elType);
end; end;
Procedure TTestTypeParser.TestReferencePointer; procedure TTestTypeParser.TestReferencePointer;
begin begin
Add('Type'); Add('Type');
Add(' Type1 = (a,b,c);'); Add(' Type1 = (a,b,c);');