2
0
Эх сурвалжийг харах

* fixed loading the address of a copied labelnode in a loadnode
(mantis #35877)

git-svn-id: trunk@42987 -

Jonas Maebe 5 жил өмнө
parent
commit
ef6dde6de3

+ 1 - 0
.gitattributes

@@ -15514,6 +15514,7 @@ tests/test/units/matrix/tinv1.pp svneol=native#text/pascal
 tests/test/units/objects/testobj.pp svneol=native#text/plain
 tests/test/units/objects/testobj1.pp svneol=native#text/plain
 tests/test/units/objects/testobj2.pp svneol=native#text/plain
+tests/test/units/rtl-generics/tw35877.pp svneol=native#text/plain
 tests/test/units/sharemem/libtest.pp svneol=native#text/plain
 tests/test/units/sharemem/test1.pp svneol=native#text/plain
 tests/test/units/softfpu/sfttst.pp svneol=native#text/plain

+ 17 - 1
compiler/nld.pas

@@ -188,7 +188,7 @@ implementation
       defutil,defcmp,
       cpuinfo,
       htypechk,pass_1,procinfo,paramgr,
-      ncon,ninl,ncnv,nmem,ncal,nutils,
+      ncon,nflw,ninl,ncnv,nmem,ncal,nutils,
       cgbase
       ;
 
@@ -273,12 +273,28 @@ implementation
     function tloadnode.dogetcopy : tnode;
       var
          n : tloadnode;
+         orglabel,
+         labelcopy : tlabelnode;
       begin
          n:=tloadnode(inherited dogetcopy);
          n.symtable:=symtable;
          n.symtableentry:=symtableentry;
          n.fprocdef:=fprocdef;
          n.loadnodeflags:=loadnodeflags;
+         if symtableentry.typ=labelsym then
+           begin
+             { see the comments for the tgotonode.labelsym field }
+             orglabel:=tlabelnode(tlabelsym(symtableentry).code);
+             labelcopy:=tlabelnode(orglabel.dogetcopy);
+             if not assigned(labelcopy.labsym) then
+               begin
+                 if not assigned(orglabel.labsym) then
+                   internalerror(2019091301);
+                 labelcopy.labsym:=clabelsym.create('$copiedlabelfrom$'+orglabel.labsym.RealName);
+                 labelcopy.labsym.code:=labelcopy;
+               end;
+             n.symtableentry:=labelcopy.labsym;
+           end;
          result:=n;
       end;
 

+ 33 - 0
tests/test/units/rtl-generics/tw35877.pp

@@ -0,0 +1,33 @@
+program project1;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}
+  cthreads,
+  {$ENDIF}
+  Classes
+  { you can add units after this }
+  , Generics.Collections;
+
+type
+  TSimpleRPCMessage2 = record
+  end;
+  TSimpleRPCResponse2 = record
+    R:array of TSimpleRPCMessage2;
+  end;
+  TResponses2 = specialize THashMap<string, TSimpleRPCResponse2>;
+  TSimpleRPCReqHandler2 = class(TInterfacedObject)
+    strict private
+      FResp:TResponses2;
+      procedure ReadResp(var R: TSimpleRPCResponse2);
+  end;
+
+procedure TSimpleRPCReqHandler2.ReadResp(var R: TSimpleRPCResponse2);
+begin
+  R:=FResp.Items['123']; // throws project1.lpr(28,11) Error: Internal error 200510032
+end;
+
+begin
+end.
+