Browse Source

* get rid of the hack that tlabelnode inherits from tunarynode and stores a statement in left, resolves #40964

florian 9 months ago
parent
commit
511beac49c
6 changed files with 31 additions and 43 deletions
  1. 0 2
      compiler/ncgflw.pas
  2. 2 7
      compiler/nflw.pas
  3. 2 14
      compiler/optdfa.pas
  4. 1 7
      compiler/optutils.pas
  5. 12 13
      compiler/pstatmnt.pas
  6. 14 0
      tests/webtbs/tw40964.pp

+ 0 - 2
compiler/ncgflw.pas

@@ -509,8 +509,6 @@ implementation
          if assigned(labsym) and
             assigned(labsym.asmblocklabel) then
            hlcg.a_label(current_asmdata.CurrAsmList,labsym.asmblocklabel);
-
-         secondpass(left);
       end;
 
 

+ 2 - 7
compiler/nflw.pas

@@ -199,7 +199,7 @@ interface
        end;
        tgotonodeclass = class of tgotonode;
 
-       tlabelnode = class(tunarynode)
+       tlabelnode = class(tnode)
           exceptionblock : integer;
           { when copying trees, this points to the newly created copy of a label }
           copiedto : tlabelnode;
@@ -2439,7 +2439,7 @@ implementation
 
     constructor tlabelnode.create(l:tnode;alabsym:tlabelsym);
       begin
-        inherited create(labeln,l);
+        inherited create(labeln);
         exceptionblock:=current_exceptblock;
         labsym:=alabsym;
         { Register labelnode in labelsym }
@@ -2494,9 +2494,6 @@ implementation
     function tlabelnode.pass_typecheck:tnode;
       begin
         result:=nil;
-        { left could still be unassigned }
-        if assigned(left) then
-         typecheckpass(left);
         resultdef:=voidtype;
       end;
 
@@ -2509,8 +2506,6 @@ implementation
         if not (nf_internal in flags) then
           include(current_procinfo.flags,pi_has_label);
 
-        if assigned(left) then
-          firstpass(left);
         if (m_non_local_goto in current_settings.modeswitches) and
             { the owner can be Nil for internal labels }
             assigned(labsym.owner) and

+ 2 - 14
compiler/optdfa.pas

@@ -574,17 +574,7 @@ unit optdfa;
                 calclife(node);
               end;
 
-            labeln:
-              begin
-                calclife(node);
-
-                if assigned(tlabelnode(node).left) then
-                  begin
-                    l:=node.optinfo^.life;
-                    DFASetIncludeSet(l,tlabelnode(node).optinfo^.life);
-                    UpdateLifeInfo(node,l);
-                  end;
-              end;
+            labeln,
             tempcreaten,
             tempdeleten,
             nothingn,
@@ -946,9 +936,6 @@ unit optdfa;
                 MaybeDoCheck(tcasenode(node).elseblock);
               end;
 
-            labeln:
-              MaybeDoCheck(tlabelnode(node).left);
-
             { we are aware of the following nodes so if new node types are added to the compiler
               and pop up in the search, the ie below kicks in as a reminder }
             exitn:
@@ -979,6 +966,7 @@ unit optdfa;
             { all other platforms except jvm translate raise nodes into call nodes during pass_1 }
             raisen,
 {$endif JVM}
+            labeln,
             loadn,
             assignn,
             calln,

+ 1 - 7
compiler/optutils.pas

@@ -324,13 +324,7 @@ unit optutils;
             labeln:
               begin
                 result:=p;
-                if assigned(tlabelnode(p).left) then
-                  begin
-                    DoSet(tlabelnode(p).left,succ);
-                    p.successor:=tlabelnode(p).left;
-                  end
-                else
-                  p.successor:=succ;
+                p.successor:=succ;
               end;
             assignn:
               begin

+ 12 - 13
compiler/pstatmnt.pas

@@ -1319,6 +1319,7 @@ implementation
     function statement : tnode;
       var
          p,
+         astatement,
          code       : tnode;
          filepos    : tfileposinfo;
          srsym      : tsym;
@@ -1487,21 +1488,19 @@ implementation
 
              if p.nodetype=labeln then
                begin
-                 { the pointer to the following instruction }
-                 { isn't a very clean way                   }
-                 if token in endtokens then
-                   tlabelnode(p).left:=cnothingnode.create
-                 else
-                   tlabelnode(p).left:=statement();
-                 { be sure to have left also typecheckpass }
-                 typecheckpass(tlabelnode(p).left);
+                 if not(token in endtokens) then
+                   begin
+                     astatement:=statement();
+                     typecheckpass(astatement);
+                     p:=cblocknode.create(cstatementnode.create(p,cstatementnode.create(astatement,nil)));
+                     Include(TBlockNode(p).blocknodeflags, bnf_strippable);
+                   end;
                end
              else
-
-             { change a load of a procvar to a call. this is also
-               supported in fpc mode }
-             if p.nodetype in [vecn,derefn,typeconvn,subscriptn,loadn] then
-               maybe_call_procvar(p,false);
+               { change a load of a procvar to a call. this is also
+                 supported in fpc mode }
+               if p.nodetype in [vecn,derefn,typeconvn,subscriptn,loadn] then
+                 maybe_call_procvar(p,false);
 
              { blockn support because a read/write is changed into a blocknode
                with a separate statement for each read/write operation (JM)

+ 14 - 0
tests/webtbs/tw40964.pp

@@ -0,0 +1,14 @@
+{$goto on}
+program ie200211262;
+
+function func(v: pointer): string; inline;
+begin
+  func:='';
+end;
+
+label lab;
+
+begin
+  lab:
+  func(@lab); // app.lpr(11,3) Error: Internal error 200211262
+end.