mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-09 15:08:44 +02:00
* When relocating local symbols on x86_64, put symbol address into addend field of the relocation, resolves #13671.
+ test git-svn-id: trunk@17556 -
This commit is contained in:
parent
4fc4154293
commit
9c27a802a0
3
.gitattributes
vendored
3
.gitattributes
vendored
@ -9944,6 +9944,8 @@ tests/test/tisogoto3.pp svneol=native#text/pascal
|
||||
tests/test/tisogoto4.pp svneol=native#text/pascal
|
||||
tests/test/tlib1a.pp svneol=native#text/plain
|
||||
tests/test/tlib1b.pp svneol=native#text/plain
|
||||
tests/test/tlib2a.pp svneol=native#text/plain
|
||||
tests/test/tlib2b.pp svneol=native#text/plain
|
||||
tests/test/tlibrary1.pp svneol=native#text/plain
|
||||
tests/test/tlibrary2.pp svneol=native#text/plain
|
||||
tests/test/tlibrary3.pp svneol=native#text/plain
|
||||
@ -10336,6 +10338,7 @@ tests/test/uimpluni1.pp svneol=native#text/plain
|
||||
tests/test/uimpluni2.pp svneol=native#text/plain
|
||||
tests/test/uinline4a.pp svneol=native#text/plain
|
||||
tests/test/uinline4b.pp svneol=native#text/plain
|
||||
tests/test/ulib2a.pp svneol=native#text/plain
|
||||
tests/test/umaclocalprocparam3f.pp svneol=native#text/plain
|
||||
tests/test/umacpas1.pp svneol=native#text/plain
|
||||
tests/test/umainnam.pp svneol=native#text/plain
|
||||
|
@ -768,8 +768,12 @@ implementation
|
||||
inc(data,symaddr-len-CurrObjSec.Size)
|
||||
else
|
||||
begin
|
||||
{$ifndef x86_64}
|
||||
CurrObjSec.addsectionreloc(CurrObjSec.Size,p.objsection,reltype);
|
||||
inc(data,symaddr);
|
||||
{$else x86_64}
|
||||
CurrObjSec.addsymreloc(CurrObjSec.Size,p,reltype);
|
||||
{$endif}
|
||||
end;
|
||||
end
|
||||
else
|
||||
@ -887,12 +891,23 @@ implementation
|
||||
{ Symbol }
|
||||
if assigned(objreloc.symbol) then
|
||||
begin
|
||||
if objreloc.symbol.symidx=-1 then
|
||||
{$ifdef x86_64}
|
||||
if (objreloc.symbol.bind=AB_LOCAL) and
|
||||
(objreloc.typ in [RELOC_RELATIVE,RELOC_ABSOLUTE,RELOC_ABSOLUTE32]) then
|
||||
begin
|
||||
writeln(objreloc.symbol.Name);
|
||||
internalerror(200603012);
|
||||
end;
|
||||
relsym:=objreloc.symbol.symidx;
|
||||
inc(rel.addend,objreloc.symbol.address);
|
||||
relsym:=objreloc.symbol.objsection.secsymidx;
|
||||
end
|
||||
else
|
||||
{$endif}
|
||||
begin
|
||||
if objreloc.symbol.symidx=-1 then
|
||||
begin
|
||||
writeln(objreloc.symbol.Name);
|
||||
internalerror(200603012);
|
||||
end;
|
||||
relsym:=objreloc.symbol.symidx;
|
||||
end
|
||||
end
|
||||
else
|
||||
begin
|
||||
|
10
tests/test/tlib2a.pp
Normal file
10
tests/test/tlib2a.pp
Normal file
@ -0,0 +1,10 @@
|
||||
{ %target=linux }
|
||||
{ %norun }
|
||||
|
||||
library lib2a;
|
||||
|
||||
uses ulib2a;
|
||||
|
||||
begin
|
||||
end.
|
||||
|
20
tests/test/tlib2b.pp
Normal file
20
tests/test/tlib2b.pp
Normal file
@ -0,0 +1,20 @@
|
||||
{ %target=linux }
|
||||
{ %needlibrary }
|
||||
|
||||
uses dl;
|
||||
|
||||
var
|
||||
hdl : Pointer;
|
||||
|
||||
begin
|
||||
WriteLn('dlopen');
|
||||
hdl := dlopen('./libtlib2a.so', RTLD_LAZY);
|
||||
if hdl = nil then
|
||||
WriteLn(dlerror())
|
||||
else
|
||||
begin
|
||||
WriteLn('dlclose');
|
||||
dlclose(hdl);
|
||||
end;
|
||||
WriteLn('exit');
|
||||
end.
|
38
tests/test/ulib2a.pp
Normal file
38
tests/test/ulib2a.pp
Normal file
@ -0,0 +1,38 @@
|
||||
|
||||
{$mode objfpc}
|
||||
unit ulib2a;
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
ITest=interface(IInterface)['{1C37883B-2909-4A74-A10B-D929D0443B1F}']
|
||||
procedure DoSomething;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
// must be declared in implementation, so DoSomething is not global
|
||||
type
|
||||
TObj=class(TInterfacedObject,ITest)
|
||||
procedure DoSomething;
|
||||
end;
|
||||
|
||||
// this is located at the start of .text section. If relocation offset is lost,
|
||||
// calling DoSomething will likely transfer control here.
|
||||
procedure DoSomethingElse;
|
||||
begin
|
||||
writeln('wrong!!!');
|
||||
halt(1);
|
||||
end;
|
||||
|
||||
procedure TObj.DoSomething;
|
||||
begin
|
||||
writeln('correct method called');
|
||||
end;
|
||||
|
||||
var t: ITest;
|
||||
|
||||
initialization
|
||||
t := TObj.Create;
|
||||
t.DoSomething;
|
||||
end.
|
Loading…
Reference in New Issue
Block a user