瀏覽代碼

* updates

peter 25 年之前
父節點
當前提交
824186ff92
共有 4 個文件被更改,包括 131 次插入120 次删除
  1. 3 2
      tests/tbs/tbs0348.pp
  2. 119 0
      tests/webtbs/tbug1066a.pp
  3. 2 117
      tests/webtbs/tbug1066b.pp
  4. 7 1
      tests/webtbs/tbug1092.pp

+ 3 - 2
tests/tbs/tbs0348.pp

@@ -5,7 +5,8 @@ type fluparr=array[0..1000] of longint;
 
 var flup : Flupptr;
     Flupresult : longint;
-
+    flupa : fluparr;
 begin
- flupresult:=flup[5];
+  flup:=@flupa;
+  flupresult:=flup[5];
 end.

+ 119 - 0
tests/webtbs/tbug1066a.pp

@@ -0,0 +1,119 @@
+{ Source provided for Free Pascal Bug Report 1066 }
+{ Submitted by "Fernando Oscar Schmitt" on  2000-07-24 }
+{ e-mail: [email protected] }
+
+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.
+
+

+ 2 - 117
tests/webtbs/tbug1066.pp → tests/webtbs/tbug1066b.pp

@@ -1,122 +1,7 @@
-{ Source provided for Free Pascal Bug Report 1066 }
-{ Submitted by "Fernando Oscar Schmitt" on  2000-07-24 }
-{ e-mail: [email protected] }
-
-var
- somevar:longint;
-
-
-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.
-
-
 {----------------cut here----------------}
 
+{$asmmode intel}
+{$inline on}
 
 var
  somevar:longint;

+ 7 - 1
tests/webtbs/tbug1092.pp

@@ -6,8 +6,14 @@ const
 {$else}
   path='c:\';
 {$endif}
+var
+  t : text;
 BEGIN
-  if FSearch('tbug1092.pp',path)<>'tbug1092.pp' then
+  { create a file }
+  assign(t,'tbug1092.txt');
+  rewrite(t);
+  close(t);
+  if FSearch('tbug1092.txt',path)<>'tbug1092.txt' then
    begin
      writeln('FSearch didn''t find file in the current dir!');
      halt(1);