* ppudump: JSON output of float, string, file, variant, undefined, formal definitions.

git-svn-id: trunk@24407 -

compiler/utils/ppuutils/ppudump.pp

@@ -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 :

compiler/utils/ppuutils/ppuout.pp

@@ -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;