Test suite results for test file webtbs/tw3540.pp

Test run data :

Free Pascal Compiler Test Suite Results

View Test suite results

Please specify search criteria:
File:
Operating system:
Processor:
Version
Date
Submitter
Machine
Comment
Limit
Cond
Category
Only failed tests
Hide skipped tests
List all tests

Test file "webtbs/tw3540.pp" information:

t_id 1460
t_cpu i386 %opt=-s -Amasm
t_adddate 2005/01/25
t_result 0
t_knownrunerror 0

Detailed test run results:

Record count: 50

Total = 50

OK=0 Percentage= 0.00

Skipped=50 Percentage= 100.00

Result type Cat. Count Percentage First date Last Date
Skipping test because for other cpu 46 92.0 2024/10/19 07:29:00 50 2024/10/19 13:36:00 24
m68k 2 4.3 2024/10/19 07:29:00 50 2024/10/19 10:22:00 40
sparc 4 8.7 2024/10/19 08:05:00 45 2024/10/19 11:16:00 40
powerpc 6 13.0 2024/10/19 08:40:00 51 2024/10/19 13:26:00 65
arm 2 4.3 2024/10/19 09:36:00 32 2024/10/19 10:03:00 32
x86_64 11 23.9 2024/10/19 08:27:00 30 2024/10/19 13:36:00 24
powerpc64 9 19.6 2024/10/19 08:43:00 65 2024/10/19 11:23:00 69
mips 2 4.3 2024/10/19 09:54:00 35 2024/10/19 10:28:00 38
mipsel 2 4.3 2024/10/19 09:59:00 38 2024/10/19 10:35:00 142
aarch64 3 6.5 2024/10/19 09:13:00 24 2024/10/19 09:57:00 26
sparc64 2 4.3 2024/10/19 09:25:00 118 2024/10/19 10:46:00 141
riscv64 1 2.2 2024/10/19 10:25:00 33 2024/10/19 10:25:00 33
loongarch64 2 4.3 2024/10/19 09:45:00 25 2024/10/19 10:17:00 30
linux 30 65.2 2024/10/19 07:29:00 50 2024/10/19 11:38:00 25
solaris 7 15.2 2024/10/19 13:22:00 24 2024/10/19 13:36:00 24
aix 9 19.6 2024/10/19 08:40:00 51 2024/10/19 13:26:00 65
3.3.1 26 56.5 2024/10/19 08:05:00 45 2024/10/19 13:26:00 65
3.2.3 20 43.5 2024/10/19 07:29:00 50 2024/10/19 13:36:00 24
Skipping test because for other target 4 8.0 2024/10/19 09:39:00 55 2024/10/19 10:27:00 65
i386 4 100.0 2024/10/19 09:39:00 55 2024/10/19 10:27:00 65
linux 2 50.0 2024/10/19 09:40:00 209 2024/10/19 10:08:00 202
go32v2 2 50.0 2024/10/19 09:39:00 55 2024/10/19 10:27:00 65
3.3.1 4 100.0 2024/10/19 09:39:00 55 2024/10/19 10:27:00 65

Source:

{ %cpu=i386 %opt=-s -Amasm -TWin32 -Rintel}
{ Source provided for Free Pascal Bug Report 3540 }
{ Submitted by "Vladimir Panteleev" on  2005-01-11 }
{ e-mail: thecybershadow@gmail.com }
library Test;

type
  Integer=LongInt;

  ULONG=Cardinal;
  PUCHAR=PChar;

type
  TMyVars=record
    RandSeed: Integer;
    SX: Integer;
    end;

  TMyData=record
    SomeConst: Integer;
    end;

var
  RMyData:TMyData=(
    SomeConst: 31337;
    );

{$R-,Q-}

function CalcAddr(const V):Pointer;stdcall;assembler;
var
  P: Integer absolute V;
asm
  call @@next
@@next:
  pop eax
  sub eax, offset @@next
  add eax, P
end;

type
  PMyVars=^TMyVars;

var
  RMyVars: TMyVars;

function MyVars:PMyVars;
begin MyVars:=CalcAddr(RMyVars) end;

type
  PMyData=^TMyData;

function MyData:PMyData;
begin MyData:=CalcAddr(RMyData) end;

procedure VidBufferToScreenBlt(Buffer:PUCHAR; x:ULONG; y:ULONG; width:ULONG; height:ULONG; lDelta:ULONG); stdcall; external;
type TPalette=array[0..15,0..3]of byte;PPalette=^TPalette;
function Palette:PPalette; external;

type
  TBitmapInfo=record
    Width, Height: Word;
    Bits: Pointer;
    end;

procedure DrawBitmap(X, Y: Integer; const Bitmap: TBitmapInfo);
begin
  VidBufferToScreenBlt(CalcAddr(Bitmap.Bits^), X, Y, Bitmap.Width, Bitmap.Height, 4);
end;

const
  test_palette: TPalette = (
    ($00, $00, $00, 0),
    ($80, $00, $00, 0),
    ($00, $80, $00, 0),
    ($80, $80, $00, 0),
    ($00, $00, $80, 0),
    ($80, $00, $80, 0),
    ($00, $80, $80, 0),
    ($80, $80, $80, 0),
    ($C0, $C0, $C0, 0),
    ($FF, $00, $00, 0),
    ($00, $FF, $00, 0),
    ($FF, $FF, $00, 0),
    ($00, $00, $FF, 0),
    ($FF, $00, $FF, 0),
    ($00, $FF, $FF, 0),
    ($FF, $FF, $FF, 0));

procedure Draw; stdcall;
var
  i:integer;
  x1,y1,x2,y2:integer;
begin
  Palette^:=TPalette(CalcAddr(Test_palette)^);
end;

end.

Link to SVN view of webtbs/tw3540.pp source.