View Issue Details

IDProjectCategoryView StatusLast Update
0035787FPCCompilerpublic2019-07-01 21:43
ReporterJ. Gareth Moreton Assigned ToPierre Muller  
PrioritylowSeveritytweakReproducibilityN/A
Status resolvedResolutionfixed 
PlatformCross-platformOSMicrosoft Windows 
Product Version3.3.1 
Summary0035787: [Patch] XML node dump improvements on subroutines
DescriptionThe attached patch "node_subs.patch" seeks to address some shortcomings with the current node dumps when it comes to procedure definitions:

- The tag "<procedure>" is now "<subroutine>" for reasons of clarity (it's not always a procedure).
- If the subroutine is a method, a 'struct' attribute will now be present, listing the relevant class name.
- A 'type' attribute is now present if the subroutine is not a regular procedure or function (appears for constructors, destructors, class constructors, class destructors, class methods, static class methods, unit initialization and finalization blocks and a few other miscellaneous cases that are converted to subroutines during compilation)
- Hidden parameters are now listed (e.g. 'Self').
- If the subroutine returns a value (e.g. because it's a function), an explicit "<returndef>" element now appears in the XML file dictating what it is (it is omitted if the subroutine is a procedure or the returndef is otherwise void).
- Additional options are printed for "reintroduce", "virtual", "final", "override" and "overload" directives.
- The <code> element is now printed as <code /> if the subroutine has no code (e.g. an empty unit inltialization block).

For example, the header "constructor TTestClass.Create(I: Integer)" is dumped as:

<subroutine struct="TTestClass" type="constructor" name="constructor Create(<TTestClass>;<Class Of TTestClass>;LongInt);">

(the angled brackets are written as "&lt;" and "&gt;" inside the string - currently there is no means to remove the word 'constructor' from the start of the method name without modifying the "tprocdef.customprocname" method, which is potentially possible)
Steps To ReproduceApply patch and confirm successful compilation and correct output of XML files with -dDEBUG_NODE_XML option.
Additional InformationThe "node_static.patch" file adds the 'static' modifier to a couple of internal class methods used for the node printing. This is for reasons of efficiency because while "SanitiseXMLString" and "WritePointer" are class methods for TNode, they don't actually use anything related to the class and are otherwise regular functions. In other words, there's no point in setting up and passing the class-type parameter
Tagscompiler, debug, node, patch, XML
Fixed in Revision42318
FPCOldBugId
FPCTarget-
Attached Files

Relationships

child of 0035017 resolvedPierre Muller [Feature] XML node dump 

Activities

J. Gareth Moreton

2019-07-01 00:47

developer  

node_static.patch (823 bytes)   
Index: compiler/node.pas
===================================================================
--- compiler/node.pas	(revision 42309)
+++ compiler/node.pas	(working copy)
@@ -389,8 +389,8 @@
          procedure XMLPrintNodeInfo(var T: Text); dynamic;
          procedure XMLPrintNodeData(var T: Text); virtual;
          procedure XMLPrintNodeTree(var T: Text); virtual;
-         class function SanitiseXMLString(const S: ansistring): ansistring;
-         class function WritePointer(const P: Pointer): ansistring;
+         class function SanitiseXMLString(const S: ansistring): ansistring; static;
+         class function WritePointer(const P: Pointer): ansistring; static;
 {$endif DEBUG_NODE_XML}
          procedure concattolist(l : tlinkedlist);virtual;
          function ischild(p : tnode) : boolean;virtual;
node_static.patch (823 bytes)   
node_subs.patch (4,606 bytes)   
Index: compiler/psub.pas
===================================================================
--- compiler/psub.pas	(revision 42309)
+++ compiler/psub.pas	(working copy)
@@ -1167,6 +1167,11 @@
         W: Word;
         syssym: tsyssym;
 
+      procedure PrintType(Flag: string);
+        begin
+          Write(T, ' type="', Flag, '"');
+        end;
+
       procedure PrintOption(Flag: string);
         begin
           WriteLn(T, PrintNodeIndention, '<option>', Flag, '</option>');
@@ -1186,9 +1191,62 @@
             Exit;
           end;
         {$pop}
-        Write(T, PrintNodeIndention, '<procedure');
-        Write(T, ' name="', TNode.SanitiseXMLString(procdef.customprocname([])), '"');
+        Write(T, PrintNodeIndention, '<subroutine');
 
+        { Check to see if the procedure is a class or object method }
+        if Assigned(procdef.struct) then
+          begin
+            if Assigned(procdef.struct.objrealname) then
+              Write(T, ' struct="', TNode.SanitiseXMLString(procdef.struct.objrealname^), '"')
+            else
+              Write(T, ' struct="&lt;NULL&gt;"');
+          end;
+
+        case procdef.proctypeoption of
+          potype_none: { Do nothing };
+
+          potype_procedure,
+          potype_function:
+            if po_classmethod in procdef.procoptions then
+              begin
+                if po_staticmethod in procdef.procoptions then
+                  PrintType('static class method')
+                else
+                  PrintType('class method');
+              end;
+            { Do nothing otherwise }
+
+          potype_proginit,
+          potype_unitinit:
+            PrintType('initialization');
+          potype_unitfinalize:
+            PrintType('finalization');
+          potype_constructor:
+            PrintType('constructor');
+          potype_destructor:
+            PrintType('destructor');
+          potype_operator:
+            PrintType('operator');
+          potype_class_constructor:
+            PrintType('class constructor');
+          potype_class_destructor:
+            PrintType('class destructor');
+          potype_propgetter:
+            PrintType('dispinterface getter');
+          potype_propsetter:
+            PrintType('dispinterface setter');
+          potype_exceptfilter:
+            PrintType('except filter');
+          potype_mainstub:
+            PrintType('main stub');
+          potype_libmainstub:
+            PrintType('library main stub');
+          potype_pkgstub:
+            PrintType('package stub');
+        end;
+
+        Write(T, ' name="', TNode.SanitiseXMLString(procdef.customprocname([pno_showhidden, pno_noclassmarker])), '"');
+
         if po_hascallingconvention in procdef.procoptions then
           Write(T, ' convention="', proccalloptionStr[procdef.proccalloption], '"');
 
@@ -1196,6 +1254,19 @@
 
         PrintNodeIndent;
 
+        if Assigned(procdef.returndef) and not is_void(procdef.returndef) then
+          WriteLn(T, PrintNodeIndention, '<returndef>', TNode.SanitiseXMLString(procdef.returndef.typesymbolprettyname), '</returndef>');
+
+        if po_reintroduce in procdef.procoptions then
+          PrintOption('reintroduce');
+        if po_virtualmethod in procdef.procoptions then
+          PrintOption('virtual');
+        if po_finalmethod in procdef.procoptions then
+          PrintOption('final');
+        if po_overridingmethod in procdef.procoptions then
+          PrintOption('override');
+        if po_overload in procdef.procoptions then
+          PrintOption('overload');
         if po_compilerproc in procdef.procoptions then
           PrintOption('compilerproc');
         if po_assembler in procdef.procoptions then
@@ -1209,13 +1280,19 @@
         if po_noinline in procdef.procoptions then
           PrintOption('noinline');
 
-        WriteLn(T, PrintNodeIndention, '<code>');
-        PrintNodeIndent;
-        XMLPrintNode(T, Code);
+        if Assigned(Code) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<code>');
+            PrintNodeIndent;
+            XMLPrintNode(T, Code);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</code>');
+          end
+        else
+          WriteLn(T, PrintNodeIndention, '<code />');
+
         PrintNodeUnindent;
-        WriteLn(T, PrintNodeIndention, '</code>');
-        PrintNodeUnindent;
-        WriteLn(T, PrintNodeIndention, '</procedure>');
+        WriteLn(T, PrintNodeIndention, '</subroutine>');
         WriteLn(T); { Line for spacing }
         Close(T);
       end;
node_subs.patch (4,606 bytes)   

Pierre Muller

2019-07-01 21:43

developer   ~0117026

  Patch tested and committed as revision #42318 in trunk branch.

Issue History

Date Modified Username Field Change
2019-07-01 00:47 J. Gareth Moreton New Issue
2019-07-01 00:47 J. Gareth Moreton Status new => assigned
2019-07-01 00:47 J. Gareth Moreton Assigned To => Pierre Muller
2019-07-01 00:47 J. Gareth Moreton File Added: node_static.patch
2019-07-01 00:47 J. Gareth Moreton File Added: node_subs.patch
2019-07-01 00:47 J. Gareth Moreton Relationship added child of 0035017
2019-07-01 00:48 J. Gareth Moreton Tag Attached: compiler
2019-07-01 00:48 J. Gareth Moreton Tag Attached: debug
2019-07-01 00:48 J. Gareth Moreton Tag Attached: patch
2019-07-01 00:48 J. Gareth Moreton Tag Attached: node
2019-07-01 00:48 J. Gareth Moreton Tag Attached: XML
2019-07-01 00:48 J. Gareth Moreton Priority normal => low
2019-07-01 00:48 J. Gareth Moreton Severity minor => tweak
2019-07-01 00:48 J. Gareth Moreton Description Updated View Revisions
2019-07-01 00:48 J. Gareth Moreton FPCTarget => -
2019-07-01 00:49 J. Gareth Moreton Description Updated View Revisions
2019-07-01 00:50 J. Gareth Moreton Description Updated View Revisions
2019-07-01 18:25 J. Gareth Moreton Description Updated View Revisions
2019-07-01 21:43 Pierre Muller Status assigned => resolved
2019-07-01 21:43 Pierre Muller Resolution open => fixed
2019-07-01 21:43 Pierre Muller Fixed in Revision => 42318
2019-07-01 21:43 Pierre Muller Note Added: 0117026