Test suite results for test file tbs/tb0309.pp

Test run data :

Run ID:
Operating system: win32
Processor: i386
Version: 3.3.1
Fails/OK/Total: 27/9678/9705
Version: 3.3.1
Full version: 3.3.1-15610-gfc6d6c123d
Comment: -CX -XX -O3 -Fd
Machine: fpcWin7-64
Category: 1
SVN revisions: fc6d6c123d:a5cb0b6179:0d375c638c:61397d40ae
Submitter: pierre
Date: 2024/04/26 16:15:00 <> 2024/04/25
Previous run: 938953
Next run: 940602

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

Record count: 1

No log of 939786.

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.