Test suite results for test file webtbs/tw0947.pp

Test run data :

Run ID:
Operating system: linux
Processor: mipsel
Version: 3.2.3
Fails/OK/Total: 151/7818/7969
Version: 3.2.3
Full version: 3.2.3-1373-gae0fe8a6a0
Comment: -ao-xgot -fPIC -XR/home/muller/sys-root/mipsel-linux -Xd -Xr/home/muller/sys-root/mipsel-linux
Machine: gcc188
Category: 1
SVN revisions: fdf93c5b29:c17a0e20f5:ae0fe8a6a0:d1c29e6cb9
Submitter: muller
Date: 2024/04/21 17:33:00
Previous run: 935782
Next run: 937106

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

Record count: 1

No log of 936436.

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.