paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-08 04:48:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed loading the address of a copied labelnode in a loadnode

Browse Source 
(mantis #35877)

git-svn-id: trunk@42987 -
This commit is contained in:
Jonas Maebe 2019-09-13 19:06:40 +00:00
parent e3e23df7e2
commit ef6dde6de3
3 changed files with 51 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

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

18
compiler/nld.pas
View File

@ -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
tests/test/units/rtl-generics/tw35877.pp Normal file
View File

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