diff --git a/packages/fcl-passrc/src/pastree.pp b/packages/fcl-passrc/src/pastree.pp index f6a2db1006..e70ac8674e 100644 --- a/packages/fcl-passrc/src/pastree.pp +++ b/packages/fcl-passrc/src/pastree.pp @@ -535,6 +535,7 @@ type const Arg: Pointer); override; public EnumType: TPasType; + IsPacked : Boolean; end; TPasRecordType = class; diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp index 4c72b1c003..1b6a049a73 100644 --- a/packages/fcl-passrc/src/pparser.pp +++ b/packages/fcl-passrc/src/pparser.pp @@ -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: diff --git a/packages/fcl-passrc/tests/tctypeparser.pas b/packages/fcl-passrc/tests/tctypeparser.pas index 6b7f3db318..47ac377319 100644 --- a/packages/fcl-passrc/tests/tctypeparser.pas +++ b/packages/fcl-passrc/tests/tctypeparser.pas @@ -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