+ Fix from Dave Strodtman to properly support packed

This commit is contained in:
michael 2004-12-06 08:53:47 +00:00
parent 164acd59d2
commit c2c2131784
3 changed files with 41 additions and 4 deletions

View File

@ -175,6 +175,7 @@ type
function ElementTypeName: String; override;
function GetDeclaration(full : boolean) : String; override;
IndexRange : String;
IsPacked : Boolean; // 12/04/04 - Dave - Added
ElType: TPasType;
end;
@ -223,6 +224,7 @@ type
function ElementTypeName: String; override;
ObjKind: TPasObjKind;
AncestorType: TPasType; // TPasClassType or TPasUnresolvedTypeRef
IsPacked: Boolean; // 12/04/04 - Dave - Added
Members: TList; // array of TPasElement objects
end;
@ -715,6 +717,7 @@ end;
constructor TPasClassType.Create(const AName: String; AParent: TPasElement);
begin
inherited Create(AName, AParent);
IsPacked := False; // 12/04/04 - Dave - Added
Members := TList.Create;
end;
@ -1048,6 +1051,8 @@ end;
function TPasArrayType.GetDeclaration (full : boolean) : string;
begin
Result:='Array['+IndexRange+'] of ';
If IsPacked then
Result := 'packed '+Result; // 12/04/04 Dave - Added
If Assigned(Eltype) then
Result:=Result+ElType.Name
else
@ -1397,7 +1402,10 @@ end.
{
$Log$
Revision 1.5 2004-07-24 00:03:13 michael
Revision 1.6 2004-12-06 08:53:48 michael
+ Fix from Dave Strodtman to properly support packed
Revision 1.5 2004/07/24 00:03:13 michael
+ Fixed getdeclaration of TPasRecordType (semicolons not/wrongly placed)
Revision 1.4 2004/07/23 23:42:02 michael

View File

@ -208,6 +208,8 @@ var
begin
PrepareDeclSection('type');
wrt(AClass.Name + ' = ');
if AClass.IsPacked then
wrt('packed '); // 12/04/04 - Dave - Added
case AClass.ObjKind of
okObject: wrt('object');
okClass: wrt('class');
@ -616,7 +618,10 @@ end.
{
$Log$
Revision 1.1 2003-03-13 21:47:42 sg
Revision 1.2 2004-12-06 08:53:47 michael
+ Fix from Dave Strodtman to properly support packed
Revision 1.1 2003/03/13 21:47:42 sg
* First version as part of FCL
}

View File

@ -858,11 +858,23 @@ var
var
EnumValue: TPasEnumValue;
Prefix : String;
HadPackedModifier : Boolean; // 12/04/04 - Dave - Added
begin
TypeName := CurTokenString;
ExpectToken(tkEqual);
NextToken;
// 12/04/04 - Dave - allow PACKED for ARRAYs, OBJECTs, CLASSes and RECORDs
HadPackedModifier := False; { Assume not present }
if CurToken = tkPacked then { If PACKED modifier }
begin { Handle PACKED modifier for all situations }
NextToken; { Move to next token for rest of parse }
if CurToken in [tkArray, tkRecord, tkObject, tkClass] then { If allowed }
HadPackedModifier := True { rememeber for later }
else { otherwise, syntax error }
ParseExc(Format(SParserExpectTokenError,['ARRAY, RECORD, OBJECT or CLASS']))
end;
// 12/04/04 - Dave - End of added code
case CurToken of
tkRecord:
begin
@ -870,11 +882,13 @@ begin
Parent));
try
ParseRecordDecl(TPasRecordType(Result));
TPasRecordType(Result).IsPacked := HadPackedModifier;
except
Result.Free;
raise;
end;
end;
{ 12/04/04 - Dave - cannot happen. Handled above. Unnecessary code removed by commenting
tkPacked:
begin
Result := TPasRecordType(CreateElement(TPasRecordType, TypeName,
@ -887,11 +901,17 @@ begin
Result.Free;
raise;
end;
end;
end; End of removed code - Dave - 12/04/04 }
tkObject:
begin // 12/04/04 - Dave - Added
Result := ParseClassDecl(Parent, TypeName, okObject);
TPasClassType(Result).IsPacked := HadPackedModifier; // 12/04/04 - Dave - Added
end; // 12/04/04 - Dave - Added
tkClass:
begin // 12/04/04 - Dave - Added
Result := ParseClassDecl(Parent, TypeName, okClass);
TPasClassType(Result).IsPacked := HadPackedModifier; // 12/04/04 - Dave - Added
end; // 12/04/04 - Dave - Added
tkInterface:
Result := ParseClassDecl(Parent, TypeName, okInterface);
tkCaret:
@ -964,6 +984,7 @@ begin
Result := TPasArrayType(CreateElement(TPasArrayType, TypeName, Parent));
try
ParseArrayType(TPasArrayType(Result));
TPasArrayType(Result).IsPacked := HadPackedModifier; // 12/04/04 - Dave - Added
ExpectToken(tkSemicolon);
except
Result.Free;
@ -1834,7 +1855,10 @@ end.
{
$Log$
Revision 1.9 2004-10-16 18:55:31 michael
Revision 1.10 2004-12-06 08:53:47 michael
+ Fix from Dave Strodtman to properly support packed
Revision 1.9 2004/10/16 18:55:31 michael
+ Support for cross-unit aliases
Revision 1.8 2004/09/13 16:02:36 peter