fpcsrc/tests/webtbs/tw4009.pp


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

{ Source provided for Free Pascal Bug Report 4009 }
{ Submitted by "Daniël Mantione" on  2005-05-23 }
{ e-mail: daniel@freepascal.org }
program testpointercalcbug;

{$R+}
{$Q+}

type    Pheader=^Theader;
        Theader=record
          x:cardinal
        end;

        Ppayload=^Tpayload;
        Tpayload=record
          s:string;
        end;

        Trecordwithheader=record
          header:Theader;
          payload:Tpayload;
        end;

{$ifndef fpc} ptruint = cardinal; {$endif}

var r:Trecordwithheader;
    p:Ppayload;
    h:Pheader;
    l,l2 : cardinal;
begin
  p:=@r.payload;
  {Calculate address of header from address of payload.}

  h:=Pheader(ptruint(p)-shortint(sizeof(Theader)));
  writeln(ptruint(h));
  l:=$ffffffff;
  l2:=1;
  writeln(l-l2);
end.