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/05/16 22:06:00 76 | 2024/05/17 00:25:00 23 | |
i386 | 18 | 36.0 | 2024/05/16 22:08:00 35 | 2024/05/16 23:57:00 23 | |
sparc | 18 | 36.0 | 2024/05/16 23:24:00 38 | 2024/05/16 23:55:00 41 | |
powerpc | 1 | 2.0 | 2024/05/16 22:06:00 76 | 2024/05/16 22:06:00 76 | |
x86_64 | 12 | 24.0 | 2024/05/16 22:26:00 31 | 2024/05/17 00:25:00 23 | |
aarch64 | 1 | 2.0 | 2024/05/17 00:12:00 32 | 2024/05/17 00:12:00 32 | |
linux | 4 | 8.0 | 2024/05/16 22:06:00 76 | 2024/05/17 00:12:00 32 | |
win32 | 4 | 8.0 | 2024/05/16 22:08:00 35 | 2024/05/16 23:57:00 23 | |
solaris | 41 | 82.0 | 2024/05/16 22:26:00 31 | 2024/05/16 23:55:00 41 | |
win64 | 1 | 2.0 | 2024/05/17 00:25:00 23 | 2024/05/17 00:25:00 23 | |
3.3.1 | 27 | 54.0 | 2024/05/16 22:08:00 35 | 2024/05/17 00:12:00 32 | |
3.2.3 | 23 | 46.0 | 2024/05/16 22:06:00 76 | 2024/05/17 00:25:00 23 |
{ 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.