mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-20 09:09:41 +01:00
* ppudump: JSON output of float, string, file, variant, undefined, formal definitions.
git-svn-id: trunk@24407 -
This commit is contained in:
yury
parent
44a0b61224
commit
ad8f42cd29
@ -2522,6 +2522,9 @@ var
|
||||
enumdef: TPpuEnumDef absolute def;
|
||||
setdef: TPpuSetDef absolute def;
|
||||
orddef: TPpuOrdDef absolute def;
|
||||
floatdef: TPpuFloatDef absolute def;
|
||||
strdef: TPpuStringDef absolute def;
|
||||
filedef: TPpuFileDef absolute def;
|
||||
begin
|
||||
with ppufile do
|
||||
begin
|
||||
@ -2670,7 +2673,8 @@ begin
|
||||
orddef.OrdType:=otCurrency;
|
||||
orddef.Size:=8;
|
||||
end;
|
||||
else WriteWarning('Invalid base type: ' + IntToStr(b));
|
||||
else
|
||||
WriteWarning('Invalid base type: ' + IntToStr(b));
|
||||
end;
|
||||
iexpr:=getexprint;
|
||||
orddef.RangeLow:=iexpr.svalue;
|
||||
@ -2682,8 +2686,44 @@ begin
|
||||
|
||||
ibfloatdef :
|
||||
begin
|
||||
readcommondef('Float definition',defoptions);
|
||||
writeln([space,' Float type : ',getbyte]);
|
||||
floatdef:=TPpuFloatDef.Create(ParentDef);
|
||||
readcommondef('Float definition',defoptions,floatdef);
|
||||
write ([space,' Float type : ']);
|
||||
b:=getbyte;
|
||||
case b of
|
||||
ftSingle:
|
||||
begin
|
||||
writeln('Single');
|
||||
floatdef.FloatType:=pftSingle;
|
||||
end;
|
||||
ftDouble:
|
||||
begin
|
||||
writeln('Double');
|
||||
floatdef.FloatType:=pftDouble;
|
||||
end;
|
||||
ftExtended:
|
||||
begin
|
||||
writeln('Extended');
|
||||
floatdef.FloatType:=pftExtended;
|
||||
end;
|
||||
ftComp:
|
||||
begin
|
||||
writeln('Comp');
|
||||
floatdef.FloatType:=pftComp;
|
||||
end;
|
||||
ftCurr:
|
||||
begin
|
||||
writeln('Currency');
|
||||
floatdef.FloatType:=pftCurrency;
|
||||
end;
|
||||
ftFloat128:
|
||||
begin
|
||||
writeln('Float128');
|
||||
floatdef.FloatType:=pftFloat128;
|
||||
end;
|
||||
else
|
||||
WriteWarning('Invalid float type: ' + IntToStr(b));
|
||||
end;
|
||||
end;
|
||||
|
||||
ibarraydef :
|
||||
@ -2791,32 +2831,47 @@ begin
|
||||
|
||||
ibshortstringdef :
|
||||
begin
|
||||
readcommondef('ShortString definition',defoptions);
|
||||
writeln([space,' Length : ',getbyte]);
|
||||
strdef:=TPpuStringDef.Create(ParentDef);
|
||||
strdef.StrType:=stShort;
|
||||
readcommondef('ShortString definition',defoptions,strdef);
|
||||
strdef.Len:=getbyte;
|
||||
writeln([space,' Length : ',strdef.Len]);
|
||||
end;
|
||||
|
||||
ibwidestringdef :
|
||||
begin
|
||||
readcommondef('WideString definition',defoptions);
|
||||
writeln([space,' Length : ',getaint]);
|
||||
strdef:=TPpuStringDef.Create(ParentDef);
|
||||
strdef.StrType:=stWide;
|
||||
readcommondef('WideString definition',defoptions,strdef);
|
||||
strdef.Len:=getaint;
|
||||
writeln([space,' Length : ',strdef.Len]);
|
||||
end;
|
||||
|
||||
ibunicodestringdef :
|
||||
begin
|
||||
readcommondef('UnicodeString definition',defoptions);
|
||||
writeln([space,' Length : ',getaint]);
|
||||
strdef:=TPpuStringDef.Create(ParentDef);
|
||||
strdef.StrType:=stUnicode;
|
||||
readcommondef('UnicodeString definition',defoptions,strdef);
|
||||
strdef.Len:=getaint;
|
||||
writeln([space,' Length : ',strdef.Len]);
|
||||
end;
|
||||
|
||||
ibansistringdef :
|
||||
begin
|
||||
readcommondef('AnsiString definition',defoptions);
|
||||
writeln([space,' Length : ',getaint]);
|
||||
strdef:=TPpuStringDef.Create(ParentDef);
|
||||
strdef.StrType:=stAnsi;
|
||||
readcommondef('AnsiString definition',defoptions,strdef);
|
||||
strdef.Len:=getaint;
|
||||
writeln([space,' Length : ',strdef.Len]);
|
||||
end;
|
||||
|
||||
iblongstringdef :
|
||||
begin
|
||||
readcommondef('Longstring definition',defoptions);
|
||||
writeln([space,' Length : ',getaint]);
|
||||
strdef:=TPpuStringDef.Create(ParentDef);
|
||||
strdef.StrType:=stLong;
|
||||
readcommondef('Longstring definition',defoptions,strdef);
|
||||
strdef.Len:=getaint;
|
||||
writeln([space,' Length : ',strdef.Len]);
|
||||
end;
|
||||
|
||||
ibrecorddef :
|
||||
@ -2905,7 +2960,8 @@ begin
|
||||
{ IIDGUID }
|
||||
for j:=1to 16 do
|
||||
getbyte;
|
||||
writeln([space,' IID String : ',getstring]);
|
||||
objdef.IID:=getstring;
|
||||
writeln([space,' IID String : ',objdef.IID]);
|
||||
end;
|
||||
|
||||
writeln([space,' Abstract methods : ',getlongint]);
|
||||
@ -2914,7 +2970,7 @@ begin
|
||||
(oo_is_classhelper in current_objectoptions) then
|
||||
begin
|
||||
write([space,' Helper parent : ']);
|
||||
readderef('');
|
||||
readderef('',objdef.HelperParent);
|
||||
end;
|
||||
|
||||
l:=getlongint;
|
||||
@ -2963,27 +3019,40 @@ begin
|
||||
|
||||
ibfiledef :
|
||||
begin
|
||||
ReadCommonDef('File definition',defoptions);
|
||||
filedef:=TPpuFileDef.Create(ParentDef);
|
||||
ReadCommonDef('File definition',defoptions,filedef);
|
||||
write ([space,' Type : ']);
|
||||
case getbyte of
|
||||
0 : writeln('Text');
|
||||
0 : begin
|
||||
writeln('Text');
|
||||
filedef.FileType:=ftText;
|
||||
end;
|
||||
1 : begin
|
||||
writeln('Typed');
|
||||
filedef.FileType:=ftTyped;
|
||||
write ([space,' File of Type : ']);
|
||||
readderef('');
|
||||
readderef('',filedef.TypeRef);
|
||||
end;
|
||||
2 : begin
|
||||
writeln('Untyped');
|
||||
filedef.FileType:=ftUntyped;
|
||||
end;
|
||||
2 : writeln('Untyped');
|
||||
end;
|
||||
end;
|
||||
|
||||
ibformaldef :
|
||||
begin
|
||||
readcommondef('Generic definition (void-typ)',defoptions);
|
||||
writeln([space,' Is Typed : ',(getbyte<>0)]);
|
||||
def:=TPpuFormalDef.Create(ParentDef);
|
||||
readcommondef('Generic definition (void-typ)',defoptions,def);
|
||||
TPpuFormalDef(def).IsTyped:=(getbyte<>0);
|
||||
writeln([space,' Is Typed : ',TPpuFormalDef(def).IsTyped]);
|
||||
end;
|
||||
|
||||
ibundefineddef :
|
||||
readcommondef('Undefined definition (generic parameter)',defoptions);
|
||||
begin
|
||||
def:=TPpuUndefinedDef.Create(ParentDef);
|
||||
readcommondef('Undefined definition (generic parameter)',defoptions,def);
|
||||
end;
|
||||
|
||||
ibenumdef :
|
||||
begin
|
||||
@ -3036,18 +3105,21 @@ begin
|
||||
|
||||
ibvariantdef :
|
||||
begin
|
||||
readcommondef('Variant definition',defoptions);
|
||||
def:=TPpuVariantDef.Create(ParentDef);
|
||||
readcommondef('Variant definition',defoptions,def);
|
||||
write ([space,' Varianttype : ']);
|
||||
b:=getbyte;
|
||||
case tvarianttype(b) of
|
||||
vt_normalvariant :
|
||||
writeln('Normal');
|
||||
vt_olevariant :
|
||||
writeln('OLE');
|
||||
begin
|
||||
TPpuVariantDef(def).IsOLE:=True;
|
||||
writeln('OLE');
|
||||
end
|
||||
else
|
||||
WriteWarning('Invalid varianttype: ' + IntToStr(b));
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
iberror :
|
||||
|
||||
@ -30,7 +30,7 @@ uses SysUtils, cclasses, Classes;
|
||||
type
|
||||
TPpuDefType = (dtNone, dtUnit, dtObject, dtRecord, dtProc, dtField, dtProp, dtParam, dtVar,
|
||||
dtTypeRef, dtConst, dtProcType, dtEnum, dtSet, dtClassRef, dtArray, dtPointer,
|
||||
dtOrd);
|
||||
dtOrd, dtFloat, dtString, dtFile, dtVariant, dtUndefined, dtFormal);
|
||||
|
||||
TPpuDef = class;
|
||||
TPpuContainerDef = class;
|
||||
@ -259,6 +259,8 @@ type
|
||||
ObjType: TPpuObjType;
|
||||
Ancestor: TPpuRef;
|
||||
Options: TPpuObjOptions;
|
||||
IID: string;
|
||||
HelperParent: TPpuRef;
|
||||
constructor Create(AParent: TPpuContainerDef); override;
|
||||
destructor Destroy; override;
|
||||
function CanWrite: boolean; override;
|
||||
@ -364,13 +366,73 @@ type
|
||||
constructor Create(AParent: TPpuContainerDef); override;
|
||||
end;
|
||||
|
||||
TPpuFloatType = (pftSingle, pftDouble, pftExtended, pftComp, pftCurrency, pftFloat128);
|
||||
|
||||
{ TPpuFloatDef }
|
||||
TPpuFloatDef = class(TPpuDef)
|
||||
protected
|
||||
procedure WriteDef(Output: TPpuOutput); override;
|
||||
public
|
||||
FloatType: TPpuFloatType;
|
||||
constructor Create(AParent: TPpuContainerDef); override;
|
||||
end;
|
||||
|
||||
TPpuStrType = (stShort, stAnsi, stWide, stUnicode, stLong);
|
||||
|
||||
{ TPpuStringDef }
|
||||
TPpuStringDef = class(TPpuDef)
|
||||
protected
|
||||
procedure WriteDef(Output: TPpuOutput); override;
|
||||
public
|
||||
StrType: TPpuStrType;
|
||||
Len: integer;
|
||||
constructor Create(AParent: TPpuContainerDef); override;
|
||||
end;
|
||||
|
||||
TPpuFileType = (ftText, ftTyped, ftUntyped);
|
||||
|
||||
{ TPpuFileDef }
|
||||
TPpuFileDef = class(TPpuDef)
|
||||
protected
|
||||
procedure WriteDef(Output: TPpuOutput); override;
|
||||
public
|
||||
FileType: TPpuFileType;
|
||||
TypeRef: TPpuRef;
|
||||
constructor Create(AParent: TPpuContainerDef); override;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
{ TPpuVariantDef }
|
||||
TPpuVariantDef = class(TPpuDef)
|
||||
protected
|
||||
procedure WriteDef(Output: TPpuOutput); override;
|
||||
public
|
||||
IsOLE: boolean;
|
||||
constructor Create(AParent: TPpuContainerDef); override;
|
||||
end;
|
||||
|
||||
{ TPpuUndefinedDef }
|
||||
TPpuUndefinedDef = class(TPpuDef)
|
||||
public
|
||||
constructor Create(AParent: TPpuContainerDef); override;
|
||||
end;
|
||||
|
||||
{ TPpuFormalDef }
|
||||
TPpuFormalDef = class(TPpuDef)
|
||||
protected
|
||||
procedure WriteDef(Output: TPpuOutput); override;
|
||||
public
|
||||
IsTyped: boolean;
|
||||
constructor Create(AParent: TPpuContainerDef); override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
DefTypeNames: array[TPpuDefType] of string =
|
||||
('', 'unit', 'obj', 'rec', 'proc', 'field', 'prop', 'param', 'var',
|
||||
'type', 'const', 'proctype', 'enum', 'set', 'classref', 'array', 'ptr', 'ord');
|
||||
'type', 'const', 'proctype', 'enum', 'set', 'classref', 'array', 'ptr',
|
||||
'ord', 'float', 'string', 'file', 'variant', 'undefined', 'formal');
|
||||
|
||||
ProcOptionNames: array[TPpuProcOption] of string =
|
||||
('procedure', 'function', 'constructor', 'destructor', 'operator',
|
||||
@ -397,6 +459,15 @@ const
|
||||
OrdTypeNames: array[TPpuOrdType] of string =
|
||||
('void', 'uint', 'sint', 'pasbool', 'bool', 'char', 'currency');
|
||||
|
||||
FloatTypeNames: array[TPpuFloatType] of string =
|
||||
('single', 'double', 'extended', 'comp', 'currency', 'float128');
|
||||
|
||||
StrTypeNames: array[TPpuStrType] of string =
|
||||
('short', 'ansi', 'wide', 'unicode', 'long');
|
||||
|
||||
FileTypeNames: array[TPpuFileType] of string =
|
||||
('text', 'typed', 'untyped');
|
||||
|
||||
SymIdBit = $80000000;
|
||||
InvalidId = cardinal(-1);
|
||||
InvalidUnit = word(-1);
|
||||
@ -406,6 +477,96 @@ begin
|
||||
Result:=Id and SymIdBit <> 0;
|
||||
end;
|
||||
|
||||
{ TPpuUndefinedDef }
|
||||
|
||||
constructor TPpuUndefinedDef.Create(AParent: TPpuContainerDef);
|
||||
begin
|
||||
inherited Create(AParent);
|
||||
DefType:=dtUndefined;
|
||||
end;
|
||||
|
||||
{ TPpuFormalDef }
|
||||
|
||||
procedure TPpuFormalDef.WriteDef(Output: TPpuOutput);
|
||||
begin
|
||||
inherited WriteDef(Output);
|
||||
Output.WriteBool('IsTyped', IsTyped);
|
||||
end;
|
||||
|
||||
constructor TPpuFormalDef.Create(AParent: TPpuContainerDef);
|
||||
begin
|
||||
inherited Create(AParent);
|
||||
DefType:=dtFormal;
|
||||
end;
|
||||
|
||||
{ TPpuVariantDef }
|
||||
|
||||
procedure TPpuVariantDef.WriteDef(Output: TPpuOutput);
|
||||
begin
|
||||
inherited WriteDef(Output);
|
||||
if IsOLE then
|
||||
Output.WriteBool('OleVariant', True);
|
||||
end;
|
||||
|
||||
constructor TPpuVariantDef.Create(AParent: TPpuContainerDef);
|
||||
begin
|
||||
inherited Create(AParent);
|
||||
DefType:=dtVariant;
|
||||
end;
|
||||
|
||||
{ TPpuFileDef }
|
||||
|
||||
procedure TPpuFileDef.WriteDef(Output: TPpuOutput);
|
||||
begin
|
||||
inherited WriteDef(Output);
|
||||
Output.WriteStr('FileType', FileTypeNames[FileType]);
|
||||
if FileType = ftTyped then
|
||||
TypeRef.Write(Output, 'TypeRef');
|
||||
end;
|
||||
|
||||
constructor TPpuFileDef.Create(AParent: TPpuContainerDef);
|
||||
begin
|
||||
inherited Create(AParent);
|
||||
DefType:=dtFile;
|
||||
TypeRef:=TPpuRef.Create;
|
||||
end;
|
||||
|
||||
destructor TPpuFileDef.Destroy;
|
||||
begin
|
||||
TypeRef.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{ TPpuStringDef }
|
||||
|
||||
procedure TPpuStringDef.WriteDef(Output: TPpuOutput);
|
||||
begin
|
||||
inherited WriteDef(Output);
|
||||
Output.WriteStr('StrType', StrTypeNames[StrType]);
|
||||
if Len >= 0 then
|
||||
Output.WriteInt('Len', Len);
|
||||
end;
|
||||
|
||||
constructor TPpuStringDef.Create(AParent: TPpuContainerDef);
|
||||
begin
|
||||
inherited Create(AParent);
|
||||
DefType:=dtString;
|
||||
end;
|
||||
|
||||
{ TPpuFloatDef }
|
||||
|
||||
procedure TPpuFloatDef.WriteDef(Output: TPpuOutput);
|
||||
begin
|
||||
inherited WriteDef(Output);
|
||||
Output.WriteStr('FloatType', FloatTypeNames[FloatType]);
|
||||
end;
|
||||
|
||||
constructor TPpuFloatDef.Create(AParent: TPpuContainerDef);
|
||||
begin
|
||||
inherited Create(AParent);
|
||||
DefType:=dtFloat;
|
||||
end;
|
||||
|
||||
{ TPpuOrdDef }
|
||||
|
||||
procedure TPpuOrdDef.WriteDef(Output: TPpuOutput);
|
||||
@ -775,6 +936,10 @@ begin
|
||||
Output.WriteStr('', ObjOptionNames[opt]);
|
||||
Output.WriteArrayEnd;
|
||||
end;
|
||||
if IID <> '' then
|
||||
Output.WriteStr('IID', IID);
|
||||
if not HelperParent.IsNull then
|
||||
HelperParent.Write(Output, 'HelperParent');
|
||||
end;
|
||||
|
||||
constructor TPpuObjectDef.Create(AParent: TPpuContainerDef);
|
||||
@ -784,11 +949,13 @@ begin
|
||||
ItemsName:='Fields';
|
||||
ObjType:=otUnknown;
|
||||
Ancestor:=TPpuRef.Create;
|
||||
HelperParent:=TPpuRef.Create;
|
||||
end;
|
||||
|
||||
destructor TPpuObjectDef.Destroy;
|
||||
begin
|
||||
Ancestor.Free;
|
||||
HelperParent.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user