t_id
225
t_adddate
2003/10/03
t_result
0
t_knownrunerror
0
Record count: 50
Total = 50
OK=50 Percentage= 100.00
Result type | Cat. | Count | Percentage | First date | Last Date |
Successfully run | 50 | 100.0 | 2024/09/26 18:42:00 90 | 2024/09/26 23:02:00 44 | |
i386 | 4 | 8.0 | 2024/09/26 19:54:00 70 | 2024/09/26 22:38:00 79 | |
powerpc | 14 | 28.0 | 2024/09/26 19:41:00 35 | 2024/09/26 23:02:00 44 | |
powerpc64 | 17 | 34.0 | 2024/09/26 18:42:00 90 | 2024/09/26 22:29:00 103 | |
wasm32 | 7 | 14.0 | 2024/09/26 19:31:00 339 | 2024/09/26 22:50:00 299 | |
riscv64 | 8 | 16.0 | 2024/09/26 19:14:00 123 | 2024/09/26 19:59:00 123 | |
linux | 39 | 78.0 | 2024/09/26 18:42:00 90 | 2024/09/26 23:02:00 44 | |
go32v2 | 4 | 8.0 | 2024/09/26 19:54:00 70 | 2024/09/26 22:38:00 79 | |
wasi | 7 | 14.0 | 2024/09/26 19:31:00 339 | 2024/09/26 22:50:00 299 | |
3.3.1 | 34 | 68.0 | 2024/09/26 18:42:00 90 | 2024/09/26 22:50:00 299 | |
3.2.3 | 16 | 32.0 | 2024/09/26 21:17:00 71 | 2024/09/26 23:02:00 44 |
{ Copyright (c) Carl Eric Codere } { This program tests the assigned() routine } { Tested against Delphi 6 Personal Edition } {$ifdef fpc} {$mode objfpc} {$endif} type tmyobject = object procedure myroutine(x: byte); end; tmyclass = class procedure myroutine(x: byte); end; tobjectmethod = procedure (x: byte) of object; tclassmethod = procedure (x: byte) of object; tproc = procedure (x: byte); type objpointer = packed record _method : pointer; _vmt : pointer; end; var myobject : tmyobject; myclass : tmyclass; procedure fail; begin WriteLn('Failure!'); halt(1); end; procedure mydummyproc(x: byte); begin end; function getpointer : pointer; begin getpointer := nil; end; function getprocpointer : tproc; begin getprocpointer:=@mydummyproc; end; {$ifdef fpc} function getobjmethodpointer : tobjectmethod; begin getobjmethodpointer:=@myobject.myroutine; end; function getclamethodpointer : tclassmethod; begin getclamethodpointer:=@myclass.myroutine; end; {$endif} procedure tmyclass.myroutine(x: byte); begin end; procedure tmyobject.myroutine(x: byte); begin end; { possible chocies (fixes branch only) : LOC_REGISTER LOC_REFERENCE second branch handles this in a generic way } var objmethod : tobjectmethod; clamethod : tclassmethod; proc : tproc; p : pointer; x: array[1..8] of integer; _result : boolean; ptrrecord : objpointer; Begin myclass := tmyclass.create; Write('Assigned(pointer) tests...'); _result := true; p:=@x; if not assigned(p) then _result := false; p:=nil; if assigned(p) then _result := false; {$ifdef fpc} if assigned(getpointer) then _result := false; {$endif} if _result then WriteLn('Success!') else fail; {*******************************************************} Write('Assigned(proc) tests...'); _result := true; proc:=@mydummyproc; if not assigned(proc) then _result := false; proc:=nil; {$ifdef fpc} if assigned(proc) then _result := false; if not assigned(getprocpointer) then _result := false; {$endif} if _result then WriteLn('Success!') else fail; {*******************************************************} Write('Assigned(object method) tests...'); _result := true; {$ifdef fpc} objmethod:=@myobject.myroutine; if not assigned(objmethod) then _result := false; {$endif} objmethod:=nil; if assigned(objmethod) then _result := false; { lets put the individual fields to nil This is a hack which should never occur } objmethod:={$ifdef fpc}@{$endif}myobject.myroutine; move(objmethod, ptrrecord, sizeof(ptrrecord)); ptrrecord._vmt := nil; move(ptrrecord, objmethod, sizeof(ptrrecord)); if not assigned(objmethod) then _result := false; objmethod:={$ifdef fpc}@{$endif}myobject.myroutine; move(objmethod, ptrrecord, sizeof(ptrrecord)); ptrrecord._method := nil; move(ptrrecord, objmethod, sizeof(ptrrecord)); if assigned(objmethod) then _result := false; {$ifdef fpc} if not assigned(getobjmethodpointer) then _result := false; {$endif} if _result then WriteLn('Success!') else fail; {*******************************************************} Write('Assigned(class method) tests...'); _result := true; {$ifdef fpc} clamethod:=@myclass.myroutine; if not assigned(clamethod) then _result := false; {$endif} clamethod:=nil; if assigned(clamethod) then _result := false; { lets put the individual fields to nil This is a hack which should never occur } clamethod:={$ifdef fpc}@{$endif}myclass.myroutine; move(clamethod, ptrrecord, sizeof(ptrrecord)); ptrrecord._vmt := nil; move(ptrrecord, clamethod, sizeof(ptrrecord)); if not assigned(clamethod) then _result := false; clamethod:={$ifdef fpc}@{$endif}myclass.myroutine; move(clamethod, ptrrecord, sizeof(ptrrecord)); ptrrecord._method := nil; move(ptrrecord, clamethod, sizeof(ptrrecord)); if assigned(clamethod) then _result := false; {$ifdef fpc} if not assigned(getclamethodpointer) then _result := false; {$endif} if _result then WriteLn('Success!') else fail; end.