paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-01 23:50:23 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Packed sets support

Browse Source 
git-svn-id: trunk@35360 -
This commit is contained in:
michael 2017-01-29 14:58:45 +00:00
parent 892b616adf
commit 0dc3d03755
3 changed files with 20 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -535,6 +535,7 @@ type
const Arg: Pointer); override;
public
EnumType: TPasType;
IsPacked : Boolean;
end;
TPasRecordType = class;

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

@ -337,7 +337,7 @@ type
Function ParseFileType(Parent : TPasElement; Const NamePos: TPasSourcePos; Const TypeName : String) : TPasFileType;
Function ParseRecordDecl(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName : string; const Packmode : TPackMode = pmNone) : TPasRecordType;
function ParseEnumType(Parent: TPasElement; Const NamePos: TPasSourcePos; const TypeName: String): TPasEnumType;
function ParseSetType(Parent: TPasElement; Const NamePos: TPasSourcePos; const TypeName: String ): TPasSetType;
function ParseSetType(Parent: TPasElement; Const NamePos: TPasSourcePos; const TypeName: String; AIsPacked : Boolean = False): TPasSetType;
function ParseSpecializeType(Parent: TPasElement; Const TypeName: String): TPasClassType;
Function ParseClassDecl(Parent: TPasElement; Const NamePos: TPasSourcePos; Const AClassName: String; AObjKind: TPasObjKind; PackMode : TPackMode= pmNone): TPasType;
Function ParseProperty(Parent : TPasElement; Const AName : String; AVisibility : TPasMemberVisibility; IsClassField: boolean) : TPasProperty;
@ -966,8 +966,8 @@ begin
if (Result<>pmNone) then
begin
NextToken;
if Not (CurToken in [tkArray, tkRecord, tkObject, tkClass]) then
ParseExcTokenError('ARRAY, RECORD, OBJECT or CLASS');
if Not (CurToken in [tkArray, tkRecord, tkObject, tkClass, tkSet]) then
ParseExcTokenError('SET, ARRAY, RECORD, OBJECT or CLASS');
end;
end;
@ -1222,12 +1222,13 @@ begin
end;
function TPasParser.ParseSetType(Parent: TPasElement;
const NamePos: TPasSourcePos; const TypeName: String): TPasSetType;
const NamePos: TPasSourcePos; const TypeName: String; AIsPacked : Boolean = False): TPasSetType;
var
ok: Boolean;
begin
Result := TPasSetType(CreateElement(TPasSetType, TypeName, Parent, NamePos));
Result.IsPacked:=AIsPacked;
ok:=false;
try
ExpectToken(tkOf);
@ -1291,7 +1292,7 @@ begin
tkFile: Result:=ParseFileType(Parent,NamePos,TypeName);
tkArray: Result:=ParseArrayType(Parent,NamePos,TypeName,pm);
tkBraceOpen: Result:=ParseEnumType(Parent,NamePos,TypeName);
tkSet: Result:=ParseSetType(Parent,NamePos,TypeName);
tkSet: Result:=ParseSetType(Parent,NamePos,TypeName,pm=pmPacked);
tkProcedure: Result:=ParseProcedureType(Parent,NamePos,TypeName,ptProcedure);
tkFunction: Result:=ParseProcedureType(Parent,NamePos,TypeName,ptFunction);
tkRecord:

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

@ -43,7 +43,7 @@ type
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 DoParseSimpleSet(Const ASource : String; Const AHint : String; IsPacked : Boolean = False);
Procedure DoParseComplexSet(Const ASource : String; Const AHint : String);
procedure DoParseRangeSet(const ASource: String; const AHint: String);
Procedure DoTestComplexSet;
@ -137,6 +137,7 @@ type
Procedure TestIdentifierRangeTypePlatform;
Procedure TestNegativeIdentifierRangeType;
Procedure TestSimpleSet;
Procedure TestPackedSet;
Procedure TestSimpleSetDeprecated;
Procedure TestSimpleSetPlatform;
Procedure TestComplexSet;
@ -2519,12 +2520,15 @@ begin
AssertEquals('Range start',AStop,Stringreplace(TPasRangeType(TheType).RangeEnd,' ','',[rfReplaceAll]));
end;
procedure TTestTypeParser.DoParseSimpleSet(const ASource: String;
const AHint: String);
procedure TTestTypeParser.DoParseSimpleSet(const ASource: String; const AHint: String; IsPacked: Boolean);
begin
ParseType('Set of '+ASource,TPasSetType,AHint);
if IsPacked then
ParseType('Packed Set of '+ASource,TPasSetType,AHint)
else
ParseType('Set of '+ASource,TPasSetType,AHint);
AssertNotNull('Have enumtype',TPasSetType(TheType).EnumType);
AssertEquals('Element type ',TPasUnresolvedTypeRef,TPasSetType(TheType).EnumType.ClassType);
AssertEquals('IsPacked is correct',isPacked,TPasSetType(TheType).IsPacked);
end;
procedure TTestTypeParser.DoParseComplexSet(const ASource: String;
@ -3114,6 +3118,11 @@ begin
DoTestComplexSet;
end;
procedure TTestTypeParser.TestPackedSet;
begin
DoParseSimpleSet('Byte','',True);
end;
procedure TTestTypeParser.TestRangeLowHigh;
begin