summaryrefslogtreecommitdiff
path: root/tests/test/ulib2a.pp
blob: 9a204327bfb0eaae2954cb83b64ee920c349cfeb (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
{ %OPT=-Cg }

{$mode objfpc}
unit ulib2a;

interface

type
  ITest=interface(IInterface)['{1C37883B-2909-4A74-A10B-D929D0443B1F}']
    procedure DoSomething;
  end;

resourcestring
  STest = 'A test resourcestring';

const
// a resourcestring consists of 3 strings (name,current value,default value)
// Pointer to it actually points to symbol+sizeof(pointer); this offset must not be lost (bug #19416)
  pTest:PAnsiString = @STest;
  
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 test_resourcestring;
begin
  if (pTest<>@STest) or (pTest^<>'A test resourcestring') then
  begin
    writeln('resourcestring relocation error');
    Halt(2);
  end;
end;

procedure TObj.DoSomething;
begin
  writeln('correct method called');
end;

var t: ITest;

initialization
  test_resourcestring;
  t := TObj.Create;
  t.DoSomething;
end.