Test suite results for test file tbs/tb0309.pp

Test run data :

Run ID:
Operating system: solaris
Processor: sparc
Version: 3.3.1
Fails/OK/Total: 57/9104/9161
Version: 3.3.1
Full version: 3.3.1-15627-g64f2e4b-unpushed
Comment: -Cg -Fd
Machine: unstable10s
Category: 1
SVN revisions: e601156:d3fd0b8:64f2e4b:6a10963
Submitter: pierre
Date: 2024/04/28 13:29:00
Previous run: 940467
Next run: 941969

Hide skipped tests

Hide successful tests

Test file "tbs/tb0309.pp" information:

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

Detailed test run results:

tr_idruntr_oktr_skiptr_result
482484145941232TrueFalseSuccessfully run

Record count: 1

No log of 941232.

Source:

{$R+}
type
   ta = object
      constructor init;
      destructor done;
      procedure p;virtual;
   end;

   pa = ^ta;

constructor ta.init;

  begin
  end;

destructor ta.done;

  begin
  end;

procedure ta.p;

  begin
  end;

type
   plongint = ^longint;

var
   p : pa;
   data : array[0..4] of longint;
   saveexit : pointer;

  procedure testerror;
    begin
       exitproc:=saveexit;
       if errorcode=210 then
         begin
            errorcode:=0;
            writeln('Object valid VMT check works');
            runerror(0);
         end
       else
         halt(1);
    end;

begin
   saveexit:=exitproc;
   exitproc:=@testerror;
   fillchar(data,sizeof(data),12);
   p:=new(pa,init);
   p^.p;
   { the vmt pointer gets an invalid value: }
   plongint(p)^:=longint(@data);
   { causes runerror }
   p^.p;
   halt(1);
end.

Link to SVN view of tbs/tb0309.pp source.