mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 10:48:30 +02:00
50 lines
1.2 KiB
ObjectPascal
50 lines
1.2 KiB
ObjectPascal
{ Old file: tbs0194.pp }
|
|
{ @procedure var returns value in it instead of address !! OK 0.99.11 (PM) }
|
|
|
|
{$Q+}
|
|
|
|
type
|
|
tproc = function : longint;
|
|
|
|
var
|
|
f : tproc;
|
|
fa : array [0..1] of tproc;
|
|
|
|
function dummy : longint;
|
|
begin
|
|
dummy:=25;
|
|
end;
|
|
const
|
|
prog_has_errors : boolean = false;
|
|
|
|
procedure Wrong(const s : string);
|
|
begin
|
|
writeln(s);
|
|
prog_has_errors:=True;
|
|
end;
|
|
|
|
Begin
|
|
f:=@dummy;
|
|
if f()<>25 then
|
|
Wrong('f() does not call dummy !!');
|
|
{$if sizeof(Codepointer)=sizeof(pointer) }
|
|
if pointer(@f)=codepointer(@dummy) then
|
|
Wrong('@f returns value of f !');
|
|
{$else}
|
|
Writeln('address of variable and functions of different size');
|
|
{$endif}
|
|
if longint(f)=longint(@f) then
|
|
Wrong('longint(@f)=longint(f) !!!!');
|
|
if f<>@dummy then
|
|
Wrong('f does not return the address of dummy');
|
|
if longint(@f)=longint(@dummy) then
|
|
Wrong('longint(@f) returns address of dummy instead of address of f');
|
|
fa[0]:=@dummy;
|
|
if longint(@f)=longint(@fa[0]) then
|
|
Wrong('arrays of procvar also wrong');
|
|
if longint(f)<>longint(fa[0]) then
|
|
Wrong('arrays of procvar and procvars are handled differently !!');
|
|
if prog_has_errors then
|
|
Halt(1);
|
|
End.
|