Test suite results for test file webtbs/tw0947.pp

Test run data :

Run ID:
Operating system: darwin
Processor: aarch64
Version: 3.3.1
Fails/OK/Total: 28/9327/9355
Version: 3.3.1
Full version: 3.3.1-15676-g9b1861a104
Comment: -O3 -dALL_RECOMPILED -Fl/usr/lib -XR/Library/Developer/CommandLineTools/SDKs/MacOSX.sdk
Machine: gcc104
Category: 1
SVN revisions: 9b1861a104:d6cf3c98d0:e657d6a07d:485b31de21
Submitter: pierre
Date: 2024/05/08 06:53:00 <> 2024/05/07
Previous run: 947265
Next run: 948689

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

Record count: 1

No log of 948014.

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.