+ ppudump: XML output.

git-svn-id: trunk@24409 -

.gitattributes

@@ -739,6 +739,7 @@ compiler/utils/ppumove.pp svneol=native#text/plain
 compiler/utils/ppuutils/ppudump.pp svneol=native#text/plain
 compiler/utils/ppuutils/ppujson.pp svneol=native#text/plain
 compiler/utils/ppuutils/ppuout.pp svneol=native#text/plain
+compiler/utils/ppuutils/ppuxml.pp svneol=native#text/plain
 compiler/utils/samplecfg svneol=native#text/plain
 compiler/utils/usubst.pp svneol=native#text/plain
 compiler/verbose.pas svneol=native#text/plain

compiler/utils/ppuutils/ppudump.pp

@@ -38,7 +38,8 @@ uses
   tokens,
   version,
   ppuout,
-  ppujson;
+  ppujson,
+  ppuxml;
 
 const
   Title     = 'PPU-Analyser';
@@ -3538,6 +3539,7 @@ begin
   writeln('    -F<format>  Set output format to <format>');
   writeln('                  t - text format (default)');
   writeln('                  j - JSON format');
+  writeln('                  j - XML format');
   writeln('    -M Exit with ExitCode=2 if more information is available');
   writeln('    -S Skip PPU version check. May lead to reading errors');
   writeln('    -V<verbose>  Set verbosity to <verbose>');
@@ -3579,6 +3581,11 @@ begin
                       nostdout:=True;
                       pout:=TPpuJsonOutput.Create(Output);
                     end;
+                  'X':
+                    begin
+                      nostdout:=True;
+                      pout:=TPpuXmlOutput.Create(Output);
+                    end;
                   else
                     begin
                       WriteError('Invalid output format: ' + para[3]);
@@ -3621,7 +3628,11 @@ begin
     for nrfile:=startpara to paramcount do
       dofile (paramstr(nrfile));
     if not has_errors and (pout <> nil) then
-      UnitList.Write(pout);
+     begin
+       pout.Init;
+       UnitList.Write(pout);
+       pout.Done;
+     end;
   finally
     UnitList.Free;
     pout.Free;

compiler/utils/ppuutils/ppujson.pp

@@ -38,9 +38,9 @@ type
     procedure WriteAttr(const AName, AValue: string);
   protected
     procedure WriteObjectStart(const AName: string; Def: TPpuDef); override;
-    procedure WriteObjectEnd(Def: TPpuDef); override;
+    procedure WriteObjectEnd(const AName: string; Def: TPpuDef); override;
     procedure WriteArrayStart(const AName: string); override;
-    procedure WriteArrayEnd; override;
+    procedure WriteArrayEnd(const AName: string); override;
     procedure WriteStr(const AName, AValue: string); override;
     procedure WriteInt(const AName: string; AValue: Int64; Signed: boolean); override;
     procedure WriteFloat(const AName: string; AValue: extended); override;
@@ -195,7 +195,7 @@ begin
   inherited;
 end;
 
-procedure TPpuJsonOutput.WriteArrayEnd;
+procedure TPpuJsonOutput.WriteArrayEnd(const AName: string);
 begin
   inherited;
   Write(']');
@@ -208,7 +208,7 @@ begin
   inherited;
 end;
 
-procedure TPpuJsonOutput.WriteObjectEnd(Def: TPpuDef);
+procedure TPpuJsonOutput.WriteObjectEnd(const AName: string; Def: TPpuDef);
 begin
   inherited;
   Write('}');

compiler/utils/ppuutils/ppuout.pp

@@ -48,9 +48,9 @@ type
     procedure SetIndentSize(AValue: integer);
   protected
     procedure WriteObjectStart(const AName: string; Def: TPpuDef = nil); virtual;
-    procedure WriteObjectEnd(Def: TPpuDef = nil); virtual;
+    procedure WriteObjectEnd(const AName: string; Def: TPpuDef = nil); virtual;
     procedure WriteArrayStart(const AName: string); virtual;
-    procedure WriteArrayEnd; virtual;
+    procedure WriteArrayEnd(const AName: string); virtual;
     procedure WriteStr(const AName, AValue: string); virtual;
     procedure WriteInt(const AName: string; AValue: Int64; Signed: boolean = True); virtual;
     procedure WriteFloat(const AName: string; AValue: extended); virtual;
@@ -63,6 +63,8 @@ type
     procedure WriteLn(const s: string = '');
     procedure IncI; virtual;
     procedure DecI; virtual;
+    procedure Init; virtual;
+    procedure Done; virtual;
     property Indent: integer read FIndent write SetIndent;
     property IndentSize: integer read FIndentSize write SetIndentSize;
   end;
@@ -734,7 +736,7 @@ begin
     for opt:=Low(opt) to High(opt) do
       if opt in Options then
         Output.WriteStr('', ArrayOptionNames[opt]);
-    Output.WriteArrayEnd;
+    Output.WriteArrayEnd('Options');
   end;
   ElType.Write(Output, 'ElType');
   RangeType.Write(Output, 'RangeType');;
@@ -934,7 +936,7 @@ begin
     for opt:=Low(opt) to High(opt) do
       if opt in Options then
         Output.WriteStr('', ObjOptionNames[opt]);
-    Output.WriteArrayEnd;
+    Output.WriteArrayEnd('Options');
   end;
   if IID <> '' then
     Output.WriteStr('IID', IID);
@@ -1014,7 +1016,7 @@ begin
         WriteInt('SymId', Id)
       else
         WriteInt('Id', Id);
-      WriteObjectEnd;
+      WriteObjectEnd(RefName);
     end;
 end;
 
@@ -1048,7 +1050,7 @@ begin
     for opt:=Low(opt) to High(opt) do
       if opt in Options then
         Output.WriteStr('', ProcOptionNames[opt]);
-    Output.WriteArrayEnd;
+    Output.WriteArrayEnd('Options');
   end;
   if Options*[poProcedure, poDestructor] = [] then
     ReturnType.Write(Output, 'RetType');
@@ -1133,7 +1135,7 @@ begin
   IncI;
 end;
 
-procedure TPpuOutput.WriteArrayEnd;
+procedure TPpuOutput.WriteArrayEnd(const AName: string);
 begin
   DecI;
 end;
@@ -1149,7 +1151,7 @@ begin
     WriteStr('Name', Def.Name);
 end;
 
-procedure TPpuOutput.WriteObjectEnd(Def: TPpuDef);
+procedure TPpuOutput.WriteObjectEnd(const AName: string; Def: TPpuDef);
 begin
   DecI;
 end;
@@ -1189,6 +1191,14 @@ begin
   Indent:=Indent - 1;
 end;
 
+procedure TPpuOutput.Init;
+begin
+end;
+
+procedure TPpuOutput.Done;
+begin
+end;
+
 { TPpuUnitDef }
 
 procedure TPpuUnitDef.WriteDef(Output: TPpuOutput);
@@ -1211,7 +1221,7 @@ begin
       WriteArrayStart('Units');
       for i:=0 to High(RefUnits) do
         WriteStr('', RefUnits[i]);
-      WriteArrayEnd;
+      WriteArrayEnd('Units');
     end;
     SourceFiles.WriteDef(Output);
   end;
@@ -1287,7 +1297,7 @@ begin
   Output.WriteArrayStart(ItemsName);
   for i:=0 to Count - 1 do
     Items[i].Write(Output);
-  Output.WriteArrayEnd;
+  Output.WriteArrayEnd(ItemsName);
 end;
 
 procedure TPpuContainerDef.BeforeWriteItems(Output: TPpuOutput);
@@ -1401,7 +1411,7 @@ begin
         WriteInt('File', FilePos.FileIndex);
       WriteInt('Line', FilePos.Line);
       WriteInt('Col', FilePos.Col);
-      WriteObjectEnd;
+      WriteObjectEnd('Pos');
     end;
     if Visibility <> dvPublic then
       WriteStr('Visibility', DefVisibilityNames[Visibility]);
@@ -1431,7 +1441,7 @@ begin
     Output.WriteObjectStart(AttrName, Self);
   WriteDef(Output);
   if Parent <> nil then
-    Output.WriteObjectEnd(Self);
+    Output.WriteObjectEnd(AttrName, Self);
 end;
 
 function TPpuDef.CanWrite: boolean;

compiler/utils/ppuutils/ppuxml.pp

@@ -0,0 +1,171 @@
+{
+    Copyright (c) 2013 by Yury Sidorov and the FPC Development Team
+
+    XML output of a PPU File
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************}
+
+unit ppuxml;
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  SysUtils, Classes, ppuout;
+
+type
+  { TPpuXmlOutput }
+
+  TPpuXmlOutput = class(TPpuOutput)
+  private
+    function XmlStr(const s: string): string;
+    function GetTagName(const n, def: string): string;
+  protected
+    procedure WriteObjectStart(const AName: string; Def: TPpuDef); override;
+    procedure WriteObjectEnd(const AName: string; Def: TPpuDef); override;
+    procedure WriteArrayStart(const AName: string); override;
+    procedure WriteArrayEnd(const AName: string); override;
+    procedure WriteStr(const AName, AValue: string); override;
+  public
+    constructor Create(var OutFile: Text); override;
+    procedure Init; override;
+  end;
+
+implementation
+
+{ TPpuXmlOutput }
+
+function TPpuXmlOutput.XmlStr(const s: string): string;
+var
+  ps, pd: PAnsiChar;
+  slen, dlen, dpos: integer;
+
+  procedure _AddChar(c: ansichar);
+  begin
+    if dpos = dlen then begin
+      dlen:=dlen*2;
+      SetLength(Result, dlen);
+      pd:=PAnsiChar(Result) + dpos;
+    end;
+    pd^:=c;
+    Inc(pd);
+    Inc(dpos);
+  end;
+
+  procedure _AddStr(const s: string);
+  var
+    p: PAnsiChar;
+    i: integer;
+  begin
+    p:=PAnsiChar(s);
+    for i:=1 to Length(s) do begin
+      _AddChar(p^);
+      Inc(p);
+    end;
+  end;
+
+var
+  c: ansichar;
+begin
+  ps:=PAnsiChar(s);
+  slen:=Length(s);
+  dlen:=slen + 2;
+  SetLength(Result, dlen);
+  pd:=PAnsiChar(Result);
+  dpos:=0;
+  while slen > 0 do begin
+    c:=ps^;
+    case c of
+      '<': _AddStr('&lt;');
+      '>': _AddStr('&gt;');
+      '&': _AddStr('&amp;');
+      '''': _AddStr('&apos;');
+      '"': _AddStr('&quot;');
+      '\': _AddStr('\\');
+      else
+        if c < #32 then
+          _AddStr('\x' + hexStr(byte(c), 2))
+        else
+          _AddChar(c);
+    end;
+    Inc(ps);
+    Dec(slen);
+  end;
+  SetLength(Result, dpos);
+end;
+
+function TPpuXmlOutput.GetTagName(const n, def: string): string;
+begin
+  Result:=LowerCase(n);
+  if Result = '' then
+    Result:=def;
+end;
+
+procedure TPpuXmlOutput.WriteStr(const AName, AValue: string);
+begin
+  if AName = 'Type' then
+    exit;
+  WriteLn(Format('<%s>%s</%0:s>', [GetTagName(AName, 'value'), XmlStr(AValue)]));
+end;
+
+procedure TPpuXmlOutput.WriteArrayStart(const AName: string);
+begin
+  if (AName = '') and (Indent = 0) then
+    exit;
+  WriteLn(Format('<%s>', [GetTagName(AName, 'array')]));
+  inherited;
+end;
+
+procedure TPpuXmlOutput.WriteArrayEnd(const AName: string);
+begin
+  if (AName = '') and (Indent = 0) then
+    exit;
+  inherited;
+  WriteLn(Format('</%s>', [GetTagName(AName, 'array')]));
+end;
+
+procedure TPpuXmlOutput.WriteObjectStart(const AName: string; Def: TPpuDef);
+begin
+  if Def = nil then
+    WriteLn(Format('<%s>', [GetTagName(AName, 'object')]))
+  else
+    WriteLn(Format('<%s>', [GetTagName(Def.DefTypeName, 'object')]));
+  inherited;
+end;
+
+procedure TPpuXmlOutput.WriteObjectEnd(const AName: string; Def: TPpuDef);
+begin
+  inherited;
+  if Def = nil then
+    WriteLn(Format('</%s>', [GetTagName(AName, 'object')]))
+  else
+    WriteLn(Format('</%s>', [GetTagName(Def.DefTypeName, 'object')]));
+end;
+
+constructor TPpuXmlOutput.Create(var OutFile: Text);
+begin
+  inherited Create(OutFile);
+end;
+
+procedure TPpuXmlOutput.Init;
+begin
+  inherited Init;
+  WriteLn('<?xml version="1.0" encoding="utf-8"?>');
+end;
+
+end.
+