Test suite results for test file webtbs/tw0947.pp

Test run data :

Run ID:
Operating system: linux
Processor: powerpc
Version: 3.2.3
Fails/OK/Total: 44/7941/7985
Version: 3.2.3
Full version: 3.2.3-1374-g849fbd722c-unpushed
Comment: -O1 -Xd -Fl/usr/lib32 -Fd -Fl/usr/lib/gcc/powerpc64-linux-gnu/13/32 -Fd
Machine: gcc203
Category: 1
SVN revisions: fdf93c5b29:849fbd722c:ae0fe8a6a0:d1c29e6cb9
Submitter: pierre
Date: 2024/04/19 11:03:00 <> 2024/04/10
Previous run: 933760
Next run: 936192

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
443652550934965TrueFalseSuccessfully run

Record count: 1

No log of 934965.

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.