Test suite results for test file webtbs/tw1066a.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/tw1066a.pp" information:

t_id 754
t_cpu i386
t_adddate 2003/10/03
t_result 0
t_knownrunerror 0

Detailed test run results:

Record count: 50

Total = 50

OK=7 Percentage= 14.00

Skipped=43 Percentage= 86.00

Result type Cat. Count Percentage First date Last Date
Successfully run 7 14.0 2024/05/08 04:53:00 28 2024/05/08 07:55:00 26
i386 7 100.0 2024/05/08 04:53:00 28 2024/05/08 07:55:00 26
win32 4 57.1 2024/05/08 04:53:00 28 2024/05/08 07:55:00 26
go32v2 3 42.9 2024/05/08 06:01:00 68 2024/05/08 07:26:00 72
3.3.1 3 42.9 2024/05/08 06:01:00 68 2024/05/08 07:26:00 72
3.2.3 4 57.1 2024/05/08 04:53:00 28 2024/05/08 07:55:00 26
Skipping test because for other cpu 43 86.0 2024/05/08 02:37:00 0 2024/05/08 07:51:00 27
sparc 3 7.0 2024/05/08 03:29:00 39 2024/05/08 07:08:00 42
powerpc 1 2.3 2024/05/08 07:48:00 62 2024/05/08 07:48:00 62
x86_64 25 58.1 2024/05/08 02:37:00 0 2024/05/08 07:51:00 27
powerpc64 2 4.7 2024/05/08 03:52:00 58 2024/05/08 04:32:00 56
aarch64 12 27.9 2024/05/08 03:48:00 37 2024/05/08 07:42:00 37
linux 29 67.4 2024/05/08 02:37:00 0 2024/05/08 07:51:00 27
solaris 3 7.0 2024/05/08 03:29:00 39 2024/05/08 07:08:00 42
darwin 10 23.3 2024/05/08 05:42:00 24 2024/05/08 07:12:00 47
aix 1 2.3 2024/05/08 07:48:00 62 2024/05/08 07:48:00 62
3.3.1 21 48.8 2024/05/08 03:11:00 0 2024/05/08 07:12:00 47
3.2.3 22 51.2 2024/05/08 02:37:00 0 2024/05/08 07:51:00 27

Source:

{ %CPU=i386 }
{ Source provided for Free Pascal Bug Report 1066 }
{ Submitted by "Fernando Oscar Schmitt" on  2000-07-24 }
{ e-mail: pulp@cpovo.net }

var
 somevar:longint;

{$asmmode intel}
{$inline on}

procedure putpixel(x,y,color:longint);assembler;inline;
asm
mov edi,x
mov eax,y
cmp edi,0
jl @@putpixelend
cmp eax,0
jl @@putpixelend
cmp edi,1023
jg @@putpixelend
cmp eax,767
jg @@putpixelend
shl eax,12
mov ebx,color
add eax,somevar
mov [eax+edi*4],ebx
@@putpixelend:
end ['eax','ebx','edi'];


procedure pixelrow(y,x1,x2,color:longint);assembler;inline;
asm
mov edi,x1
mov ecx,x2
mov eax,y
cmp edi,ecx
jle @@pixelrowdirok
xchg edi,ecx
@@pixelrowdirok:
cmp eax,0
jl @@endpixelrow
cmp eax,767
jg @@endpixelrow
cmp ecx,0
jl @@endpixelrow
cmp edi,1023
jg @@endpixelrow
cmp edi,0
jge @@pixelrowx1ok
mov edi,0
@@pixelrowx1ok:
cmp ecx,1023
jle @@pixelrowx2ok
mov ecx,1023
@@pixelrowx2ok:
sub ecx,edi
shl eax,12
inc ecx
add eax,somevar
cld
lea edi,[eax+4*edi]
mov eax,color
rep stosd
@@endpixelrow:
end ['eax','ecx','edi'];


function str(w:word):string;
var tmp:string;
begin
system.str(w,tmp);
str:=tmp;
end;

function str(l:longint):string;
var tmp:string;
begin
system.str(l,tmp);
str:=tmp;
end;


procedure circle(x0,y0,r,color:longint);
var x,y:longint;
begin
for x:=0 to trunc(r*(sqrt(2)/2))+1 do
 begin
 y:=round(sqrt(r*r-x*x));
 putpixel(x0+x,y0+y,color);
 putpixel(x0-x,y0+y,color);
 putpixel(x0+x,y0-y,color);
 putpixel(x0-x,y0-y,color);
 putpixel(x0+y,y0+x,color);
 putpixel(x0-y,y0+x,color);
 putpixel(x0+y,y0-x,color);
 putpixel(x0-y,y0-x,color);
 end;
end;


procedure circlefill(x0,y0,r,color:longint);
var x,y:longint;
begin
for x:=0 to trunc(r*(sqrt(2)/2))+1 do
 begin
 y:=round(sqrt(r*r-x*x));
 pixelrow(y0+y,x0-x,x0+x,color);
 pixelrow(y0-y,x0-x,x0+x,color);
 pixelrow(y0+x,x0-y,x0+y,color);
 pixelrow(y0-x,x0-y,x0+y,color);
 end;
end;


begin

end.


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