Test suite results for test file webtbs/tw0947.pp

Test run data :

Run ID:
Operating system: linux
Processor: arm
Version: 3.3.1
Fails/OK/Total: 42/9188/9230
Version: 3.3.1
Full version: 3.3.1-Unversioned_directory
Comment: -Cparmv7 -Cfvfpv2 -Caeabihf -XR/home/muller/sys-root/arm-linux-gnueabihf -Xd -Xr/home/muller/sys-root/arm-linux-gnueabihf
Machine: gcc188
Category: 1
SVN revisions: 2f9ed0576e:8b7dbb81b1:3f8bbd3b00:2f9ed0576e
Submitter: muller
Date: 2024/04/19 11:27:00
Previous run: 934307
Next run: 935645

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

Record count: 1

No log of 934983.

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.