mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-05 08:18:12 +02:00
9450407ed5
the result of a objtype.method2 call, ensure that we call method2 with
objtype as methdpointer rather than the self node of the current routine
(mantis #24844)
git-svn-id: trunk@27977 -
50 lines
843 B
ObjectPascal
50 lines
843 B
ObjectPascal
program method_init;
|
|
|
|
{$mode objfpc}
|
|
{.$mode delphi}
|
|
|
|
Type
|
|
|
|
{ TObj }
|
|
|
|
TObj = Class
|
|
procedure Test;
|
|
end;
|
|
|
|
{ TObj }
|
|
|
|
procedure TObj.Test;
|
|
Var
|
|
|
|
proc : procedure of object;
|
|
|
|
begin
|
|
|
|
proc := {$IFNDEF FPC_DELPHI}@{$ENDIF}TObject.Create.Free;
|
|
WriteLn('Expected TObject actual: ', TObject(TMethod(Proc).Data).ClassName);
|
|
if TObject(TMethod(Proc).Data).ClassName<>'TObject' then
|
|
halt(1);
|
|
end;
|
|
|
|
procedure UncompilableProc;
|
|
Var
|
|
|
|
proc : procedure of object;
|
|
|
|
begin
|
|
|
|
proc := {$IFNDEF FPC_DELPHI}@{$ENDIF}TObject.Create.Free; // uncompilable in FPC mode
|
|
WriteLn('Expected TObject actual: ', TObject(TMethod(Proc).Data).ClassName);
|
|
if TObject(TMethod(Proc).Data).ClassName<>'TObject' then
|
|
halt(2);
|
|
end;
|
|
|
|
begin
|
|
|
|
WriteLn('Mode: ', {$IFDEF FPC_DELPHI}'delphi'{$ELSE}'objfpc'{$ENDIF});
|
|
|
|
TObj.Create.Test;
|
|
UncompilableProc;
|
|
|
|
end.
|