Test suite results for test file webtbs/tw0947.pp

Test run data :

Run ID:
Operating system: linux
Processor: m68k
Version: 3.2.3
Fails/OK/Total: 60/7907/7967
Version: 3.2.3
Full version: 3.2.3-1373-gae0fe8a6a0
Comment: -XR/home/pierre/sys-root/m68k-linux -Xd -Xr/home/pierre/sys-root/m68k-linux
Machine: gcclocal
Category: 1
SVN revisions: fdf93c5b29:c17a0e20f5:ae0fe8a6a0:d1c29e6cb9
Submitter: pierre
Date: 2024/04/19 10:45:00 <> 2024/04/09
Previous run: 934297
Next run: 935635

Hide skipped tests

Hide successful tests

Test file "webtbs/tw0947.pp" information:

t_id 743
t_adddate 2003/10/03
t_result 0
t_knownrunerror 0

Detailed test run results:

tr_idruntr_oktr_skiptr_result
443652544934963TrueFalseSuccessfully run

Record count: 1

No log of 934963.

Source:

{$mode objfpc}

var
  last,lastt2 : integer;

type
  T1 = class
    procedure SomeMethod(Param: Integer); virtual;
  end;

  T2 = class(T1)
    procedure SomeMethod(Param: Integer); override;
    procedure InheritedMethod(Param: Integer);
    destructor Destroy; override;
  end;

procedure T1.SomeMethod(Param: Integer);
begin
  last:=Param;
  writeln('T1 ', Param);
end;

procedure T2.InheritedMethod(Param: Integer);
begin
  inherited SomeMethod(Param);
end;

procedure T2.SomeMethod(Param: Integer);
begin
  lastt2:=param;
  writeln('T2 ', Param);
end;

destructor T2.Destroy;
begin
  SomeMethod(3);
  inherited SomeMethod(2);
  inherited Destroy;
end;

var
  A: T2;
begin
  Last:=0;
  lastt2:=0;
  A:=T2.Create;
  A.SomeMethod(1); { Ok }
  if lastt2<>1 then
    Halt(1);
  A.InheritedMethod(4); { Ok }
  if last<>4 then
    Halt(1);
  A.Free; { error }
  if last<>2 then
    Halt(1);
  if lastt2<>3 then
    Halt(1);
  Writeln('Bug with calling inherited in destructors solved');
end.

Link to SVN view of webtbs/tw0947.pp source.