diff options
Diffstat (limited to 'mips/tests')
46 files changed, 1145 insertions, 181 deletions
diff --git a/mips/tests/Makefile b/mips/tests/Makefile index cfc720c897..46bc840699 100644 --- a/mips/tests/Makefile +++ b/mips/tests/Makefile @@ -1898,6 +1898,7 @@ endif ifndef TEST_OPT TEST_OPT= endif +override TEST_OPT+=-Fd ifndef TEST_FPC_VERSION TEST_FPC_COMPILERINFO:=$(shell $(TEST_FPC) -iVSPTPSOTODW) TEST_FPC_VERSION:=$(word 1,$(TEST_FPC_COMPILERINFO)) diff --git a/mips/tests/Makefile.fpc b/mips/tests/Makefile.fpc index da9bd9ea6d..b3c4052845 100644 --- a/mips/tests/Makefile.fpc +++ b/mips/tests/Makefile.fpc @@ -36,6 +36,11 @@ ifndef TEST_OPT TEST_OPT= endif +# disable directory cache; completely loading all directories significantly +# slows down running the testsuite because the programs use very few units +# and most testsuite directories contain thousands of files +override TEST_OPT+=-Fd + # Retrieve Test compiler info ifndef TEST_FPC_VERSION TEST_FPC_COMPILERINFO:=$(shell $(TEST_FPC) -iVSPTPSOTODW) diff --git a/mips/tests/tbs/tb0193.pp b/mips/tests/tbs/tb0193.pp index d2b2376b8b..6097cef5b7 100644 --- a/mips/tests/tbs/tb0193.pp +++ b/mips/tests/tbs/tb0193.pp @@ -11,15 +11,18 @@ asm {$ifdef CPUI386} movl stacksize,%eax end ['EAX']; +{$define implemented} {$endif CPUI386} {$ifdef CPUX86_64} movq stacksize@GOTPCREL(%rip),%rax movq (%rax),%rax end ['EAX']; +{$define implemented} {$endif CPUX86_64} {$ifdef CPU68K} move.l stacksize,d0 end ['D0']; +{$define implemented} {$endif CPU68K} {$ifdef cpupowerpc} {$if not defined(macos) and not defined(aix)} @@ -30,11 +33,13 @@ end ['D0']; lwz r3, 0(r3) {$endif macos} end; +{$define implemented} {$endif cpupowerpc} {$ifdef cpusparc} sethi %hi(stacksize),%i0 or %i0,%lo(stacksize),%i0 end; +{$define implemented} {$endif cpusparc} {$ifdef cpuarm} ldr r0,.Lpstacksize @@ -44,7 +49,18 @@ end; .long stacksize .Lend: end; +{$define implemented} {$endif cpuarm} +{$ifdef cpumips} + la $v0,stacksize + lw $v0,($v0) + end; +{$define implemented} +{$endif cpumips} +{$ifndef implemented} + {$error This test does not supported this CPU} +end; +{$endif} begin writeln(getstacksize); diff --git a/mips/tests/tbs/tb0524.pp b/mips/tests/tbs/tb0524.pp index a7be19e064..ba10a014b0 100644 --- a/mips/tests/tbs/tb0524.pp +++ b/mips/tests/tbs/tb0524.pp @@ -1,9 +1,46 @@ -{%TARGET=linux,freebsd,darwin,aix} +{%TARGET=linux,freebsd,darwin,aix,openbsd,netbsd} program tb0524; uses sockets,baseunix,sysutils; + const port=6667; + textfile = 'tb0524.txt'; + +procedure reset_textfile; +var + f : text; +begin + assign(f,textfile); + rewrite(f); + writeln(f,'Normal server start'); + close(f); +end; + +procedure stop(error : longint); +var + f : text; +begin + assign(f,textfile); + rewrite(f); + writeln(f,'Server startup failed'); + close(f); + halt(error); +end; + +function server_failed : boolean; +var + f : text; + st : string; +begin + server_failed:=false; + assign(f,textfile); + reset(f); + readln(f,st); + if pos('Server startup failed',st)=1 then + server_failed:=true; + close(f); +end; procedure do_server; @@ -15,11 +52,12 @@ var s,t:string; i:byte; begin + reset_textfile; lsock:=fpsocket(af_inet,sock_stream,0); if lsock=-1 then begin - writeln('socket:',socketerror); - halt(1); + writeln('socket call error:',socketerror); + stop(1); end; with saddr do @@ -31,22 +69,22 @@ begin if fpbind(lsock,@saddr,sizeof(saddr))<>0 then begin - writeln('bind:',socketerror); - halt(1); + writeln('bind call error:',socketerror); + stop(1); end; if fplisten(lsock,1)<>0 then begin - writeln('listen:',socketerror); - halt(1); + writeln('listen call error:',socketerror); + stop(1); end; len:=sizeof(saddr); usock:=fpaccept(lsock,@saddr,@len); if usock=-1 then begin - writeln('accept:',SocketError); - halt(1); + writeln('accept call error:',SocketError); + stop(1); end; sock2text(usock,sin,sout); @@ -101,6 +139,12 @@ begin begin {Give server some time to start.} sleep(2000); - do_client; + if server_failed then + begin + writeln('Server startup failed, test can not be completed'); + halt(2); + end + else + do_client; end; end. diff --git a/mips/tests/tbs/tb0528.pp b/mips/tests/tbs/tb0528.pp index 8a6899c5a0..d362385828 100644 --- a/mips/tests/tbs/tb0528.pp +++ b/mips/tests/tbs/tb0528.pp @@ -2,7 +2,7 @@ {%skiptarget=darwin,aix} { darwin limits statically declared data structures to 32 bit for efficiency reasons } -{ the aix assembler cannot deal with the way we declare these arrays in assembler code ) +{ the aix assembler cannot deal with the way we declare these arrays in assembler code } program tb0528; diff --git a/mips/tests/test/jvm/tenum2.pp b/mips/tests/test/jvm/tenum2.pp new file mode 100644 index 0000000000..a485691298 --- /dev/null +++ b/mips/tests/test/jvm/tenum2.pp @@ -0,0 +1,34 @@ +program tenum2; + +{$mode delphi} + +type + tenum2enum = (e_zero, e_one, e_two); + + tenum2base = class abstract + constructor create; + procedure init; virtual; abstract; + end; + + tenum2child = class(tenum2base) + fenum: tenum2enum; + procedure init; override; + end; + +constructor tenum2base.create; + begin + init; + end; + +procedure tenum2child.init; + begin + fenum:=e_one; + end; + +var + c: tenum2child; +begin + c:=tenum2child.create; + if c.fenum<>e_one then + halt(1); +end. diff --git a/mips/tests/test/jvm/testall.bat b/mips/tests/test/jvm/testall.bat index 2435e66f15..594e8b76f6 100644 --- a/mips/tests/test/jvm/testall.bat +++ b/mips/tests/test/jvm/testall.bat @@ -64,10 +64,14 @@ if %errorlevel% neq 0 exit /b %errorlevel% java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tbyte if %errorlevel% neq 0 exit /b %errorlevel% del uenum.ppu -ppcjvm -O2 -g tenum +ppcjvm -O2 -g -CTenumfieldinit tenum if %errorlevel% neq 0 exit /b %errorlevel% java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tenum if %errorlevel% neq 0 exit /b %errorlevel% +ppcjvm -O2 -g tenum2 +if %errorlevel% neq 0 exit /b %errorlevel% +java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tenum2 +if %errorlevel% neq 0 exit /b %errorlevel% ppcjvm -O2 -g tprop if %errorlevel% neq 0 exit /b %errorlevel% java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tprop @@ -236,4 +240,7 @@ ppcjvm -O2 -g -B taddbool if %errorlevel% neq 0 exit /b %errorlevel% java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. -Sa TAddBool if %errorlevel% neq 0 exit /b %errorlevel% - +ppcjvm -O2 -g -B tsetansistr +if %errorlevel% neq 0 exit /b %errorlevel% +java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. -Sa tsetansistr +if %errorlevel% neq 0 exit /b %errorlevel% diff --git a/mips/tests/test/jvm/testall.sh b/mips/tests/test/jvm/testall.sh index c80baf74a9..ddd869b8a7 100755 --- a/mips/tests/test/jvm/testall.sh +++ b/mips/tests/test/jvm/testall.sh @@ -47,8 +47,10 @@ $PPC -O2 -g forw $PPC -O2 -g tbyte java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/$RTLDIR:. tbyte rm -f uenum.ppu -$PPC -O2 -g tenum +$PPC -O2 -g -CTenumfieldinit tenum java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/$RTLDIR:. tenum +$PPC -O2 -g tenum2 +java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/$RTLDIR:. tenum2 $PPC -O2 -g tprop java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/$RTLDIR:. tprop $PPC -O2 -g tprop2 @@ -133,3 +135,5 @@ $PPC -O2 -g -B -Sa tassert java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/$RTLDIR:. tassert $PPC -O2 -g -B -Sa taddbool java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/$RTLDIR:. TAddBool +$PPC -O2 -g -B -Sa tsetansistr +java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/$RTLDIR:. tsetansistr diff --git a/mips/tests/test/jvm/tsetansistr.pp b/mips/tests/test/jvm/tsetansistr.pp new file mode 100644 index 0000000000..1dd983dff0 --- /dev/null +++ b/mips/tests/test/jvm/tsetansistr.pp @@ -0,0 +1,31 @@ +program tsetansistr;
+
+{$mode delphi}
+{$modeswitch unicodestrings}
+
+type
+ ByteArray = array of byte;
+
+const
+ AnsiStrOffset = 1;
+
+function AnsiStringOfBytes(const Src : ByteArray) : AnsiString;
+var
+ i : integer;
+begin
+ SetLength(Result, Length(Src));
+
+ for i := 0 to Length(Src) - 1 do
+ Result[i + AnsiStrOffset] := Chr(Src[i]);
+end;
+
+var
+ A : ByteArray;
+ B : AnsiString;
+begin
+ DefaultSystemCodePage:=20127; // ASCII
+ SetLength(A, 1); A[0] := $98;
+ B := AnsiStringOfBytes(A);
+ if ord(B[1]) <> $98 then
+ halt(1);
+end.
diff --git a/mips/tests/test/opt/tretopt.pp b/mips/tests/test/opt/tretopt.pp index b10ac0933d..fa1294bd21 100644 --- a/mips/tests/test/opt/tretopt.pp +++ b/mips/tests/test/opt/tretopt.pp @@ -294,7 +294,7 @@ begin {$ifdef darwin} movl %eax,p3-.Lpic(%ecx) {$else darwin} - addl $_GLOBAL_OFFSET_TABLE_,%ecx + addl $_GLOBAL_OFFSET_TABLE_+1,%ecx movl %eax,p3@GOT(%ecx) {$endif darwin} {$endif FPC_PIC} @@ -349,7 +349,7 @@ begin {$ifdef darwin} movl %eax,p3-.Lpic(%ecx) {$else darwin} - addl $_GLOBAL_OFFSET_TABLE_,%ecx + addl $_GLOBAL_OFFSET_TABLE_+1,%ecx movl %eax,p3@GOT(%ecx) {$endif darwin} {$endif FPC_PIC} diff --git a/mips/tests/test/packages/bzip2/tbzip2streamtest.pp b/mips/tests/test/packages/bzip2/tbzip2streamtest.pp index b82616c5be..dfa10fe6ba 100644 --- a/mips/tests/test/packages/bzip2/tbzip2streamtest.pp +++ b/mips/tests/test/packages/bzip2/tbzip2streamtest.pp @@ -70,53 +70,56 @@ begin UncompressedFile:=SysUtils.GetTempFileName(EmptyStr, 'UNC'); CompressedFile:=SysUtils.GetTempFileName(EmptyStr, 'BZ2'); - // Set up test bz2 file - // create a resource stream which points to our resource - ExampleFileResourceStream := TResourceStream.Create(HInstance, 'ALL', 'RT_RCDATA'); try - ExampleFileStream := TFileStream.Create(CompressedFile, fmCreate); + // Set up test bz2 file + // create a resource stream which points to our resource + ExampleFileResourceStream := TResourceStream.Create(HInstance, 'ALL', 'RT_RCDATA'); try - ExampleFileStream.CopyFrom(ExampleFileResourceStream, ExampleFileResourceStream.Size); + ExampleFileStream := TFileStream.Create(CompressedFile, fmCreate); + try + ExampleFileStream.CopyFrom(ExampleFileResourceStream, ExampleFileResourceStream.Size); + finally + ExampleFileStream.Free; + end; finally - ExampleFileStream.Free; + ExampleFileResourceStream.Free; end; - finally - ExampleFileResourceStream.Free; - end; - // Actual decompression - if decompress(CompressedFile, UncompressedFile) then - begin - // Now check if contents match. - UncompressedHash:=MD5Print(MD5File(UncompressedFile, MDDefBufSize)); - if UncompressedHash=ExpectedHash then - begin - code:=0; //success - end - else - begin - writeln('MD5 hash comparison between original file and uncompressed file failed'); - writeln('Got hash:'+UncompressedHash); - writeln('Expected:'+ExpectedHash); - code:=2; - end; - end - else - begin - writeln('bunzip2 decompression failure'); - code:=1; - end; + // Actual decompression + if decompress(CompressedFile, UncompressedFile) then + begin + // Now check if contents match. + UncompressedHash:=MD5Print(MD5File(UncompressedFile, MDDefBufSize)); + if UncompressedHash=ExpectedHash then + begin + code:=0; //success + end + else + begin + writeln('MD5 hash comparison between original file and uncompressed file failed'); + writeln('Got hash:'+UncompressedHash); + writeln('Expected:'+ExpectedHash); + code:=2; + end; + end + else + begin + writeln('bunzip2 decompression failure'); + code:=1; + end; - try - if CompressedFile<>EmptyStr then DeleteFile(CompressedFile); - if UncompressedFile<>EmptyStr then DeleteFile(UncompressedFile); - finally - // Ignore errors; operating system should clean out temp files - end; - if code = 0 then - writeln('Basic bzip2 tests passed') - else - writeln('Basic bzip2 test failed: ', code); + if code = 0 then + writeln('Basic bzip2 tests passed') + else + writeln('Basic bzip2 test failed: ', code); + finally + try + if CompressedFile<>EmptyStr then DeleteFile(CompressedFile); + if UncompressedFile<>EmptyStr then DeleteFile(UncompressedFile); + finally + // Ignore errors; operating system should clean out temp files + end; + end; Halt(code); end. diff --git a/mips/tests/test/tasmread.pp b/mips/tests/test/tasmread.pp index c3ac8fd3a8..b7c0bf7372 100644 --- a/mips/tests/test/tasmread.pp +++ b/mips/tests/test/tasmread.pp @@ -20,7 +20,7 @@ begin {$ifdef darwin} mov [test.l-@@LPIC+ecx],5 {$else darwin} - add ecx, _GLOBAL_OFFSET_TABLE_ + add ecx, _GLOBAL_OFFSET_TABLE_+1 mov [test.l + ecx],5 {$endif darwin} {$endif FPC_PIC} diff --git a/mips/tests/test/tcg1.pp b/mips/tests/test/tcg1.pp index bd8f702c83..59a6818dbc 100644 --- a/mips/tests/test/tcg1.pp +++ b/mips/tests/test/tcg1.pp @@ -2,71 +2,32 @@ {$R-} program test_register_pushing; -var - before, after : longint; - wpush,lpush : longint; const haserror : boolean = false; - + +procedure dotest; +var + wpush,lpush: longint; begin -{$ifdef CPUI386} {$asmmode att} asm -{$ifndef FPC_PIC} - movl %esp,before - pushw %es - movl %esp,after - popw %es -{$else not FPC_PIC} - call .LPIC -.LPIC: - popl %ecx -{$ifdef darwin} - movl %esp,before-.LPIC(%ecx) - pushw %es - movl %esp,after-.LPIC(%ecx) - popw %es -{$else darwin} - addl $_GLOBAL_OFFSET_TABLE_,%ecx - movl %esp,before@GOT(%ecx) + movl %esp,wpush pushw %es - movl %esp,after@GOT(%ecx) + subl %esp,wpush popw %es -{$endif darwin} -{$endif not FPC_PIC} end; - wpush:=before-after; if wpush<>2 then begin Writeln('Compiler does not push "pushw %es" into 2 bytes'); haserror:=true; end; + asm -{$ifndef FPC_PIC} - movl %esp,before + movl %esp,lpush pushl %es - movl %esp,after + subl %esp,lpush popl %es -{$else not FPC_PIC} - call .LPIC -.LPIC: - popl %ecx -{$ifdef darwin} - movl %esp,before-.LPIC(%ecx) - pushl %es - movl %esp,after-.LPIC(%ecx) - popl %es -{$else darwin} - addl $_GLOBAL_OFFSET_TABLE_,%ecx - movl %esp,before@GOT(%ecx) - pushl %es - movl %esp,after@GOT(%ecx) - popl %es -{$endif darwin} -{$endif not FPC_PIC} end; - lpush:=before-after; - if lpush<>4 then begin Writeln('Compiler does not push "pushl %es" into 4 bytes'); @@ -74,61 +35,22 @@ begin end; asm -{$ifndef FPC_PIC} - movl %esp,before - pushw %gs - movl %esp,after - popw %gs -{$else not FPC_PIC} - call .LPIC -.LPIC: - popl %ecx -{$ifdef darwin} - movl %esp,before-.LPIC(%ecx) + movl %esp,wpush pushw %gs - movl %esp,after-.LPIC(%ecx) + subl %esp,wpush popw %gs -{$else darwin} - addl $_GLOBAL_OFFSET_TABLE_,%ecx - movl %esp,before@GOT(%ecx) - pushw %gs - movl %esp,after@GOT(%ecx) - popw %gs -{$endif darwin} -{$endif not FPC_PIC} end; - wpush:=before-after; if wpush<>2 then begin Writeln('Compiler does not push "pushw %gs" into 2 bytes'); haserror:=true; end; asm -{$ifndef FPC_PIC} - movl %esp,before - pushl %gs - movl %esp,after - popl %gs -{$else not FPC_PIC} - call .LPIC -.LPIC: - popl %ecx -{$ifdef darwin} - movl %esp,before-.LPIC(%ecx) + movl %esp,lpush pushl %gs - movl %esp,after-.LPIC(%ecx) + subl %esp,lpush popl %gs -{$else darwin} - addl $_GLOBAL_OFFSET_TABLE_,%ecx - movl %esp,before@GOT(%ecx) - pushl %gs - movl %esp,after@GOT(%ecx) - popl %gs -{$endif darwin} -{$endif not FPC_PIC} end; - lpush:=before-after; - if lpush<>4 then begin Writeln('Compiler does not push "pushl %gs" into 4 bytes'); @@ -136,31 +58,16 @@ begin end; {$asmmode intel} asm -{$ifndef FPC_PIC} - mov before,esp + mov lpush,esp push es - mov after,esp + sub lpush,esp pop es -{$else not FPC_PIC} - call @@LPIC -@@LPIC: - pop ecx -{$ifdef darwin} - mov [before-@@LPIC+ecx],esp - push es - mov [after-@@LPIC+ecx],esp - pop es -{$else darwin} - add ecx,@_GLOBAL_OFFSET_TABLE_ - mov [ecx].OFFSET before,esp - push es - mov [ecx].OFFSET after,esp - pop es -{$endif darwin} -{$endif not FPC_PIC} end; - Writeln('Intel "push es" uses ',before-after,' bytes'); -{$endif CPUI386} + Writeln('Intel "push es" uses ',lpush,' bytes'); if haserror then Halt(1); +end; + +begin + dotest; end. diff --git a/mips/tests/test/testsse2.pp b/mips/tests/test/testsse2.pp index e6ecd81ad9..5ad9cb0d30 100644 --- a/mips/tests/test/testsse2.pp +++ b/mips/tests/test/testsse2.pp @@ -22,7 +22,7 @@ begin psubq %xmm1,%xmm2 psubq q-.LPIC(%ecx),%xmm4 {$else darwin} - addl $_GLOBAL_OFFSET_TABLE_,%ecx + addl $_GLOBAL_OFFSET_TABLE_+1,%ecx movdqa %xmm1,%xmm2 movdqa q@GOT(%ecx),%xmm4 psubq %xmm1,%xmm2 diff --git a/mips/tests/test/tgeneric76.pp b/mips/tests/test/tgeneric76.pp new file mode 100644 index 0000000000..4b2aa6ef6e --- /dev/null +++ b/mips/tests/test/tgeneric76.pp @@ -0,0 +1,45 @@ +{$mode delphi} + +unit tgeneric76; + +interface + +type + + { TPointEx } + + TPointEx<T> = record + X, Y: T; + function Create(const AX, AY: T): TPointEx<T>; + class procedure Swap(var A, B: TPointEx<T>); static; + class procedure OrderByY(var A, B: TPointEx<T>); static; + end; + + TPoint = TPointEx<integer>; + TPointF = TPointEx<single>; + +implementation + +function TPointEx<T>.Create(const AX, AY: T): TPointEx<T>; +begin + result.X:=AX; + result.Y:=AY; +end; + +class procedure TPointEx<T>.Swap(var A, B: TPointEx<T>); +var + tmp: TPointEx<T>; +begin + tmp:=A; + A:=B; + B:=tmp; +end; + +class procedure TPointEx<T>.OrderByY(var A, B: TPointEx<T>); +begin + if A.Y > B.Y then + TPointEx<T>.Swap(A,B); +end; + + +end. diff --git a/mips/tests/test/tgeneric77.pp b/mips/tests/test/tgeneric77.pp new file mode 100644 index 0000000000..060c802d37 --- /dev/null +++ b/mips/tests/test/tgeneric77.pp @@ -0,0 +1,48 @@ +{$mode objfpc}{$h+} +{$modeswitch advancedrecords} + +unit tgeneric77; + +interface + +type + + { TPointEx } + + generic TPointEx<T> = record + X, Y: T; + function Create(const AX, AY: T): TPointEx; + class procedure Swap(var A, B: TPointEx); static; + class procedure OrderByY(var A, B: TPointEx); static; + end; + + //TPoint = specialize TPointEx<integer>; + TPointF = specialize TPointEx<single>; + +implementation + +{ TPoint<T> } + +function TPointEx.Create(const AX, AY: T): TPointEx; +begin + result.X:=AX; + result.Y:=AY; +end; + +class procedure TPointEx.Swap(var A, B: TPointEx); +var + tmp: TPointEx; +begin + tmp:=A; + A:=B; + B:=tmp; +end; + +class procedure TPointEx.OrderByY(var A, B: TPointEx); +begin + if A.Y > B.Y then + TPointEx.Swap(A,B); +end; + + +end. diff --git a/mips/tests/test/tgeneric78.pp b/mips/tests/test/tgeneric78.pp new file mode 100644 index 0000000000..4addc2b12e --- /dev/null +++ b/mips/tests/test/tgeneric78.pp @@ -0,0 +1,27 @@ +{ %NORUN } + +{ additional test based on 21064 } +program tgeneric78; + +{$mode delphi} + +type + IGenericIntf<T> = interface + function SomeMethod: T; + end; + + TGenericClass<T> = class(TInterfacedObject, IGenericIntf<LongInt>) + private + protected + function GenericIntf_SomeMethod: LongInt; + function IGenericIntf<LongInt>.SomeMethod = GenericIntf_SomeMethod; + end; + +function TGenericClass<T>.GenericIntf_SomeMethod: LongInt; +begin +end; + +type + TGenericClassLongInt = TGenericClass<String>; +begin +end. diff --git a/mips/tests/test/tgeneric79.pp b/mips/tests/test/tgeneric79.pp new file mode 100644 index 0000000000..da94c73e20 --- /dev/null +++ b/mips/tests/test/tgeneric79.pp @@ -0,0 +1,27 @@ +{ %NORUN } + +{ additional test based on 21064 } +program tgeneric79; + +{$mode objfpc} + +type + generic IGenericIntf<T> = interface + function SomeMethod: T; + end; + + generic TGenericClass<T> = class(TInterfacedObject, specialize IGenericIntf<LongInt>) + private + protected + function GenericIntf_SomeMethod: LongInt; + function IGenericIntf<LongInt>.SomeMethod = GenericIntf_SomeMethod; + end; + +function TGenericClass.GenericIntf_SomeMethod: LongInt; +begin +end; + +type + TGenericClassLongInt = specialize TGenericClass<String>; +begin +end. diff --git a/mips/tests/test/tgeneric80.pp b/mips/tests/test/tgeneric80.pp new file mode 100644 index 0000000000..f23c900dc1 --- /dev/null +++ b/mips/tests/test/tgeneric80.pp @@ -0,0 +1,18 @@ +{ %NORUN } + +program tgeneric80; + +{$mode delphi} + +type + TTest<T, S> = record + end; + TTest<T> = record + end; + PTest = ^TTest; + TTest = record + end; + +begin + +end. diff --git a/mips/tests/test/tgeneric81.pp b/mips/tests/test/tgeneric81.pp new file mode 100644 index 0000000000..8618e9ad39 --- /dev/null +++ b/mips/tests/test/tgeneric81.pp @@ -0,0 +1,18 @@ +{ %NORUN } + +program tgeneric81; + +{$mode delphi} + +type + PTest = ^TTest; + TTest<T, S> = record + end; + TTest<T> = record + end; + TTest = record + end; + +begin + +end. diff --git a/mips/tests/test/tgeneric82.pp b/mips/tests/test/tgeneric82.pp new file mode 100644 index 0000000000..7b556ce0f7 --- /dev/null +++ b/mips/tests/test/tgeneric82.pp @@ -0,0 +1,18 @@ +{ %NORUN } + +program tgeneric82; + +{$mode delphi} + +type + TTest = record + end; + TTest<T, S> = record + end; + TTest<T> = record + end; + PTest = ^TTest; + +begin + +end. diff --git a/mips/tests/test/tgeneric83.pp b/mips/tests/test/tgeneric83.pp new file mode 100644 index 0000000000..0e081956fd --- /dev/null +++ b/mips/tests/test/tgeneric83.pp @@ -0,0 +1,16 @@ +{ %FAIL } + +program tgeneric83; + +{$mode delphi} + +type + TTest<T> = record + end; + +const + Test: ^TTest = Nil; + +begin + +end. diff --git a/mips/tests/test/tgeneric84.pp b/mips/tests/test/tgeneric84.pp new file mode 100644 index 0000000000..ec33dd07a1 --- /dev/null +++ b/mips/tests/test/tgeneric84.pp @@ -0,0 +1,14 @@ +{ %FAIL } + +program tgeneric84; + +{$mode objfpc} + +type + generic TTest<T> = record + end; + + PTest = ^TTest; + +begin +end. diff --git a/mips/tests/test/tgeneric85.pp b/mips/tests/test/tgeneric85.pp new file mode 100644 index 0000000000..e7c634560f --- /dev/null +++ b/mips/tests/test/tgeneric85.pp @@ -0,0 +1,16 @@ +{ %FAIL } + +program tgeneric85; + +{$mode objfpc} + +type + generic TTest<T> = record + end; + +const + Test: ^TTest = Nil; + +begin + +end. diff --git a/mips/tests/test/tgeneric86.pp b/mips/tests/test/tgeneric86.pp new file mode 100644 index 0000000000..02520a0f41 --- /dev/null +++ b/mips/tests/test/tgeneric86.pp @@ -0,0 +1,17 @@ +{ %NORUN } + +program tgeneric86; + +{$mode objfpc}{$H+} +{$modeswitch advancedrecords} + +type + generic TTest<T> = record + type + PTest = ^TTest; + end; + +begin + +end. + diff --git a/mips/tests/test/tgeneric87.pp b/mips/tests/test/tgeneric87.pp new file mode 100644 index 0000000000..33e2afc92c --- /dev/null +++ b/mips/tests/test/tgeneric87.pp @@ -0,0 +1,18 @@ +{ %FAIL } + +program tgeneric87; + +{$mode objfpc} + +type + generic TTest<T> = record + + end; + +const + TestLongIntNil: ^specialize TTest<LongInt> = Nil; + TestBooleanNil: ^specialize TTest<Boolean> = Nil; + +begin + +end. diff --git a/mips/tests/test/tgeneric88.pp b/mips/tests/test/tgeneric88.pp new file mode 100644 index 0000000000..c8233ee7e2 --- /dev/null +++ b/mips/tests/test/tgeneric88.pp @@ -0,0 +1,17 @@ +{ %FAIL } + +program tgeneric88; + +{$mode objfpc} + +type + generic TTest<T> = record + + end; + + PTestLongInt = ^specialize TTest<LongInt>; + PTestBoolean = ^specialize TTest<Boolean>; + +begin + +end. diff --git a/mips/tests/test/tgeneric89.pp b/mips/tests/test/tgeneric89.pp new file mode 100644 index 0000000000..5e50ef1549 --- /dev/null +++ b/mips/tests/test/tgeneric89.pp @@ -0,0 +1,17 @@ +{ %NORUN } + +program tgeneric89; + +{$mode delphi} + +type + TTest<T> = record + + end; + + PTestLongInt = ^TTest<LongInt>; + PTestBoolean = ^TTest<Boolean>; + +begin + +end. diff --git a/mips/tests/test/tgeneric90.pp b/mips/tests/test/tgeneric90.pp new file mode 100644 index 0000000000..0c9ae3c4cb --- /dev/null +++ b/mips/tests/test/tgeneric90.pp @@ -0,0 +1,26 @@ +{ %NORUN } + +program tgeneric90; + +{$mode delphi} + +type + TTest = record + + end; + + TTest<T> = record + + end; + + TTest<T, S> = record + + end; + + PTestLongInt = ^TTest<LongInt>; + PTestLongIntLongInt = ^TTest<LongInt, LongInt>; + PTest = ^TTest; + +begin + +end. diff --git a/mips/tests/test/tint642.pp b/mips/tests/test/tint642.pp index 7beab28039..c60ab52a3b 100644 --- a/mips/tests/test/tint642.pp +++ b/mips/tests/test/tint642.pp @@ -248,6 +248,8 @@ procedure testshlshrqword; l1:=16; l2:=0; + if (q1 shl 0)<>q1 then + do_error(1499); if (q1 shl 16)<>q3 then do_error(1500); if (q1 shl 48)<>q0 then @@ -277,6 +279,8 @@ procedure testshlshrqword; if ((q1+q0) shl (l1+l2))<>q3 then do_error(1509); + if (q1 shr 0)<>q1 then + do_error(15091); if (q1 shr 16)<>q2 then do_error(1510); if (q1 shr 48)<>q0 then diff --git a/mips/tests/test/trhlp44.pp b/mips/tests/test/trhlp44.pp new file mode 100644 index 0000000000..4c4951ec3b --- /dev/null +++ b/mips/tests/test/trhlp44.pp @@ -0,0 +1,31 @@ +{ %NORUN } + +program trhlp44; + +{$mode delphi} + +type + TTest = record + + end; + + TTestHelper = record helper for TTest + procedure SayHello(const I: Integer); overload; + procedure SayHello(const S: string); overload; + end; + +procedure TTestHelper.SayHello(const I: Integer); overload; +begin + Writeln('Hello ', I); +end; + +procedure TTestHelper.SayHello(const S: string); overload; +begin + Writeln('Hello ', S); +end; + +var + Obj: TTest; +begin + Obj.SayHello('FPC'); +end. diff --git a/mips/tests/webtbf/tw22219.pp b/mips/tests/webtbf/tw22219.pp new file mode 100644 index 0000000000..fa805dffa6 --- /dev/null +++ b/mips/tests/webtbf/tw22219.pp @@ -0,0 +1,16 @@ +{ %FAIL } + +program tw22219; +{$MODE DELPHI} + +type + TWrapper<P, Q> = record end; + TWrapper<R> = record end; + AmbiguousPointer = ^TWrapper; + +var + Z: AmbiguousPointer; + +begin + +end. diff --git a/mips/tests/webtbs/tw20947.pp b/mips/tests/webtbs/tw20947.pp new file mode 100644 index 0000000000..b2d3ac7675 --- /dev/null +++ b/mips/tests/webtbs/tw20947.pp @@ -0,0 +1,21 @@ +{ the important part of this test is a cross compilation which a change in the + size of the bitness, e.g. from Win32 to Win64 where the unit "fgl" was + compiled with the 32-to-64-bit cross compiler and this program itself is + compiled with the native 64-bit compiler } + +program tw20947; + +uses + fgl; + +type + TTestList = specialize TFPGList<Byte>; + +Var + Test : TTestList; +begin + Test := TTestList.Create; + Test.Add(2); + WriteLn(Test[0]); // This should output 2 to console + Test.Free; +end. diff --git a/mips/tests/webtbs/tw20998.pp b/mips/tests/webtbs/tw20998.pp index 92b6f93d15..6ee9ea7cbf 100644 --- a/mips/tests/webtbs/tw20998.pp +++ b/mips/tests/webtbs/tw20998.pp @@ -1,18 +1,23 @@ var i : int64; - + j, k: longint; begin - i:=6400; - i:=i div 64; - if i<>100 then - halt(1); + k:=64; + for j:=6400 to 6464 do + begin + i:=j; + if (i div 64) <> (i div k) then + halt(1); + end; i:=6500; i:=i div 65; if i<>100 then halt(1); - i:=-6400; - i:=i div 64; - if i<>-100 then - halt(1); + for j:=-6400 downto -6464 do + begin + i:=j; + if (i div 64) <> (i div k) then + halt(2); + end; writeln('ok'); end. diff --git a/mips/tests/webtbs/tw21064a.pp b/mips/tests/webtbs/tw21064a.pp new file mode 100644 index 0000000000..e813aab427 --- /dev/null +++ b/mips/tests/webtbs/tw21064a.pp @@ -0,0 +1,26 @@ +{ %NORUN } + +program tw21064a; + +{$mode delphi} + +type + IGenericIntf<T> = interface + function SomeMethod: T; + end; + + TGenericClass<T> = class(TInterfacedObject, IGenericIntf<T>) + private + protected + function GenericIntf_SomeMethod: T; + function IGenericIntf<T>.SomeMethod = GenericIntf_SomeMethod; + end; + +function TGenericClass<T>.GenericIntf_SomeMethod: T; +begin +end; + +type + TGenericClassLongInt = TGenericClass<LongInt>; +begin +end. diff --git a/mips/tests/webtbs/tw21064b.pp b/mips/tests/webtbs/tw21064b.pp new file mode 100644 index 0000000000..64be8cc69c --- /dev/null +++ b/mips/tests/webtbs/tw21064b.pp @@ -0,0 +1,28 @@ +{ %NORUN } + +program tw21064b; + +{$mode delphi} + +type + IGenericIntf<T> = interface + function SomeMethod: T; + end; + + TGenericClass<T> = class(TInterfacedObject, IGenericIntf<T>) + private + type + IntfType = IGenericIntf<T>; + protected + function GenericIntf_SomeMethod: T; + function IntfType.SomeMethod = GenericIntf_SomeMethod; + end; + +function TGenericClass<T>.GenericIntf_SomeMethod: T; +begin +end; + +type + TGenericClassLongInt = TGenericClass<LongInt>; +begin +end. diff --git a/mips/tests/webtbs/tw21350a.pp b/mips/tests/webtbs/tw21350a.pp new file mode 100644 index 0000000000..a67d6b3997 --- /dev/null +++ b/mips/tests/webtbs/tw21350a.pp @@ -0,0 +1,45 @@ +{$mode delphi} + +unit tw21350a; + +interface + +type + + { TPointEx } + + TPointEx<T> = object + X, Y: T; + function Create(const AX, AY: T): TPointEx<T>; + class procedure Swap(var A, B: TPointEx<T>); static; + class procedure OrderByY(var A, B: TPointEx<T>); static; + end; + + TPoint = TPointEx<integer>; + TPointF = TPointEx<single>; + +implementation + +function TPointEx<T>.Create(const AX, AY: T): TPointEx<T>; +begin + result.X:=AX; + result.Y:=AY; +end; + +class procedure TPointEx<T>.Swap(var A, B: TPointEx<T>); +var + tmp: TPointEx<T>; +begin + tmp:=A; + A:=B; + B:=tmp; +end; + +class procedure TPointEx<T>.OrderByY(var A, B: TPointEx<T>); +begin + if A.Y > B.Y then + TPointEx<T>.Swap(A,B); +end; + + +end. diff --git a/mips/tests/webtbs/tw21350b.pp b/mips/tests/webtbs/tw21350b.pp new file mode 100644 index 0000000000..5aefe310db --- /dev/null +++ b/mips/tests/webtbs/tw21350b.pp @@ -0,0 +1,47 @@ +{$mode objfpc}{$h+} + +unit tw21350b; + +interface + +type + + { TPointEx } + + generic TPointEx<T> = object + X, Y: T; + function Create(const AX, AY: T): TPointEx; + class procedure Swap(var A, B: TPointEx); static; + class procedure OrderByY(var A, B: TPointEx); static; + end; + + //TPoint = specialize TPointEx<integer>; + TPointF = specialize TPointEx<single>; + +implementation + +{ TPoint<T> } + +function TPointEx.Create(const AX, AY: T): TPointEx; +begin + result.X:=AX; + result.Y:=AY; +end; + +class procedure TPointEx.Swap(var A, B: TPointEx); +var + tmp: TPointEx; +begin + tmp:=A; + A:=B; + B:=tmp; +end; + +class procedure TPointEx.OrderByY(var A, B: TPointEx); +begin + if A.Y > B.Y then + TPointEx.Swap(A,B); +end; + + +end. diff --git a/mips/tests/webtbs/tw21457.pp b/mips/tests/webtbs/tw21457.pp new file mode 100644 index 0000000000..efde6895ac --- /dev/null +++ b/mips/tests/webtbs/tw21457.pp @@ -0,0 +1,24 @@ +unit tw21457; +{$mode objfpc} +interface +uses Classes; + +Type + TFileStreamHelper = class helper for TFileStream + public + constructor CreateRetry(const AFileName: string; Mode: Word; Rights: Cardinal); + end; + + +implementation + +{ TFileStreamHelper } + +constructor TFileStreamHelper.CreateRetry(const AFileName:string; Mode:Word; Rights: Cardinal); +begin + //TODO + //=> internal error 200305103 +end; + + +end. diff --git a/mips/tests/webtbs/tw21921.pp b/mips/tests/webtbs/tw21921.pp new file mode 100644 index 0000000000..8ed4924b97 --- /dev/null +++ b/mips/tests/webtbs/tw21921.pp @@ -0,0 +1,28 @@ +{ %NORUN } + +program tw21921; + +{$mode Delphi}{$H+} + +type + + { THashEntry } + + THashEntry<T> = record + Key: string; + Value: T; + class function Create(const AKey: string; const AValue: T): THashEntry<T>; static; inline; + end; + +class function THashEntry<T>.Create(const AKey: string; const AValue: T): THashEntry<T>; +begin + Result.Key := AKey; + Result.Value := AValue; +end; + +var + Entry: THashEntry<Integer>; +begin + Entry := THashEntry<Integer>.Create('One', 1); +end. + diff --git a/mips/tests/webtbs/tw22154.pp b/mips/tests/webtbs/tw22154.pp new file mode 100644 index 0000000000..775c14b562 --- /dev/null +++ b/mips/tests/webtbs/tw22154.pp @@ -0,0 +1,18 @@ +program tw22154; + +{$MODE DELPHI} + +type + TWrapper<T> = class + procedure Z; + end; + +procedure TWrapper<T>.Z; +const + A0: array [0..0] of Integer = (0); { OK } + A1: array [0..1] of Integer = (0, 1); { Comma not exepcted } +begin +end; + +begin +end. diff --git a/mips/tests/webtbs/tw22320.pp b/mips/tests/webtbs/tw22320.pp new file mode 100644 index 0000000000..1d5752cf3b --- /dev/null +++ b/mips/tests/webtbs/tw22320.pp @@ -0,0 +1,73 @@ +program Test; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +{$APPTYPE CONSOLE} + +type + TwbSignature = array[0..3] of AnsiChar; + + TwbConflictPriority = ( + cpIgnore, + cpBenign, + cpTranslate, + cpNormal, + cpCritical, + cpFormID + ); + + IwbElement = interface + ['{F4B4637D-C794-415F-B5C7-587EAA4095B3}'] + end; + + TwbDontShowCallback = function(const aElement: IwbElement): Boolean; + + IwbSubRecordDef = interface + ['{D848E426-8768-45F4-B192-4DEFBE34D40A}'] + end; + + IwbByteArrayDef = interface + ['{3069E1AC-4307-421B-93E4-797E18075EF9}'] + end; + +function wbByteArray(const aName : string = 'Unknown'; + aSize : Cardinal = 0; + aPriority : TwbConflictPriority = cpNormal; + aRequired : Boolean = False; + aDontShow : TwbDontShowCallback = nil) + : IwbByteArrayDef; overload; +begin + Result := nil; +end; + +function wbByteArray(const aSignature : TwbSignature; + const aName : string = 'Unknown'; + aSize : Cardinal = 0; + aPriority : TwbConflictPriority = cpNormal; + aRequired : Boolean = False; + aSizeMatch : Boolean = False; + aDontShow : TwbDontShowCallback = nil) + : IwbSubRecordDef; overload; +begin + Result := nil; + halt(2); +end; + +function wbUnknown(aPriority : TwbConflictPriority = cpNormal; + aRequired : Boolean = False; + aDontShow : TwbDontShowCallback = nil) + : IwbByteArrayDef; +begin + Result := wbByteArray('Unknown', 0, aPriority, aRequired, aDontShow); +end; + +function cb(const aElement: IwbElement): Boolean; +begin + halt(1); +end; + +begin + wbUnknown(cpNormal,False,cb); +end. diff --git a/mips/tests/webtbs/tw22326.pp b/mips/tests/webtbs/tw22326.pp new file mode 100644 index 0000000000..9ff1416934 --- /dev/null +++ b/mips/tests/webtbs/tw22326.pp @@ -0,0 +1,9 @@ +var + q1: QWord; +begin + q1:=$1020304050607080; + if (q1 shl 0) <> q1 then + halt(1); + if (q1 shr 0) <> q1 then + halt(2); +end. diff --git a/mips/tests/webtbs/tw22329.pp b/mips/tests/webtbs/tw22329.pp new file mode 100644 index 0000000000..81a9ec9dc3 --- /dev/null +++ b/mips/tests/webtbs/tw22329.pp @@ -0,0 +1,32 @@ +{ %NORUN } + +program tw22329; + +{$mode delphi} + +type + TObjectHelper = class helper for TObject + procedure SayHello(const I: Integer); overload; + procedure SayHello(const S: string); overload; + end; + +procedure TObjectHelper.SayHello(const I: Integer); overload; +begin + Writeln('Hello ', I); +end; + +procedure TObjectHelper.SayHello(const S: string); overload; +begin + Writeln('Hello ', S); +end; + +var + Obj: TObject; +begin + Obj := TObject.Create; + try + Obj.SayHello('FPC'); + finally + Obj.Free; + end; +end. diff --git a/mips/tests/webtbs/tw22331.pp b/mips/tests/webtbs/tw22331.pp new file mode 100644 index 0000000000..01c1485e6c --- /dev/null +++ b/mips/tests/webtbs/tw22331.pp @@ -0,0 +1,139 @@ +procedure X; +var + w, h: integer; +begin + w:=1; + h:=2; + writeln(round(w / 2 - 0), round(h - 0)); + writeln(round(w / 2 - 138.809093), round(h - 661.165204)); + writeln(round(w / 2 - 138.683051), round(h - 661.003245)); + writeln(round(w / 2 - 138.556540), round(h - 660.840685)); + writeln(round(w / 2 - 138.429558), round(h - 660.677449)); + writeln(round(w / 2 - 138.302098), round(h - 660.513612)); + writeln(round(w / 2 - 138.174178), round(h - 660.349250)); + writeln(round(w / 2 - 138.045779), round(h - 660.184211)); + writeln(round(w / 2 - 137.916911), round(h - 660.018571)); + writeln(round(w / 2 - 137.787573), round(h - 659.852405)); + writeln(round(w / 2 - 137.657765), round(h - 659.685563)); + writeln(round(w / 2 - 137.527488), round(h - 659.518121)); + writeln(round(w / 2 - 137.396732), round(h - 659.350077)); + writeln(round(w / 2 - 137.265516), round(h - 659.181432)); + writeln(round(w / 2 - 137.133821), round(h - 659.012187)); + writeln(round(w / 2 - 137.001656), round(h - 658.842340)); + writeln(round(w / 2 - 136.869023), round(h - 658.671892)); + writeln(round(w / 2 - 136.735910), round(h - 658.500844)); + writeln(round(w / 2 - 136.602337), round(h - 658.329119)); + writeln(round(w / 2 - 136.468294), round(h - 658.156944)); + writeln(round(w / 2 - 136.333773), round(h - 657.984017)); + writeln(round(w / 2 - 136.198782), round(h - 657.810490)); + writeln(round(w / 2 - 136.063322), round(h - 657.636437)); + writeln(round(w / 2 - 135.927392), round(h - 657.461782)); + writeln(round(w / 2 - 135.790993), round(h - 657.286452)); + writeln(round(w / 2 - 135.654114), round(h - 657.110521)); + writeln(round(w / 2 - 135.516776), round(h - 656.933988)); + writeln(round(w / 2 - 135.378959), round(h - 656.756930)); + writeln(round(w / 2 - 135.240672), round(h - 656.579196)); + writeln(round(w / 2 - 135.101916), round(h - 656.400936)); + writeln(round(w / 2 - 134.962690), round(h - 656.222000)); + writeln(round(w / 2 - 134.822995), round(h - 656.042463)); + writeln(round(w / 2 - 134.682821), round(h - 655.862325)); + writeln(round(w / 2 - 134.542186), round(h - 655.681586)); + writeln(round(w / 2 - 134.147430), round(h - 655.174225)); + writeln(round(w / 2 - 134.006815), round(h - 654.993486)); + writeln(round(w / 2 - 133.866669), round(h - 654.813348)); + writeln(round(w / 2 - 133.727002), round(h - 654.633886)); + writeln(round(w / 2 - 133.607551), round(h - 654.480415)); + writeln(round(w / 2 - 133.488777), round(h - 654.287807)); + writeln(round(w / 2 - 133.370406), round(h - 654.095800)); + writeln(round(w / 2 - 133.252440), round(h - 653.904469)); + writeln(round(w / 2 - 133.134877), round(h - 653.713814)); + writeln(round(w / 2 - 133.017708), round(h - 653.523836)); + writeln(round(w / 2 - 132.900953), round(h - 653.334458)); + writeln(round(w / 2 - 132.784592), round(h - 653.145756)); + writeln(round(w / 2 - 132.668644), round(h - 652.957730)); + writeln(round(w / 2 - 132.553090), round(h - 652.770306)); + writeln(round(w / 2 - 132.437940), round(h - 652.583557)); + writeln(round(w / 2 - 132.323204), round(h - 652.397485)); + writeln(round(w / 2 - 132.208862), round(h - 652.212088)); + writeln(round(w / 2 - 132.094923), round(h - 652.027293)); + writeln(round(w / 2 - 131.981379), round(h - 651.843098)); + writeln(round(w / 2 - 131.868248), round(h - 651.659655)); + writeln(round(w / 2 - 131.755521), round(h - 651.476812)); + writeln(round(w / 2 - 131.643198), round(h - 651.294721)); + writeln(round(w / 2 - 131.531269), round(h - 651.113231)); + writeln(round(w / 2 - 131.419753), round(h - 650.932342)); + writeln(round(w / 2 - 131.308631), round(h - 650.752129)); + writeln(round(w / 2 - 131.197914), round(h - 650.572516)); + writeln(round(w / 2 - 131.087609), round(h - 650.393655)); + writeln(round(w / 2 - 130.977699), round(h - 650.215395)); + writeln(round(w / 2 - 130.868193), round(h - 650.037812)); + writeln(round(w / 2 - 130.759090), round(h - 649.860904)); + writeln(round(w / 2 - 130.650391), round(h - 649.684597)); + writeln(round(w / 2 - 130.542087), round(h - 649.508966)); + writeln(round(w / 2 - 130.434196), round(h - 649.334011)); + writeln(round(w / 2 - 130.326708), round(h - 649.159657)); + writeln(round(w / 2 - 130.219615), round(h - 648.985980)); + writeln(round(w / 2 - 130.112935), round(h - 648.813053)); + writeln(round(w / 2 - 130.006650), round(h - 648.640577)); + writeln(round(w / 2 - 129.900768), round(h - 648.468928)); + writeln(round(w / 2 - 129.795290), round(h - 648.297879)); + writeln(round(w / 2 - 129.690215), round(h - 648.127507)); + writeln(round(w / 2 - 129.585554), round(h - 647.957735)); + writeln(round(w / 2 - 129.481278), round(h - 647.788565)); + writeln(round(w / 2 - 129.377415), round(h - 647.620146)); + writeln(round(w / 2 - 129.273956), round(h - 647.452402)); + writeln(round(w / 2 - 129.170901), round(h - 647.285260)); + writeln(round(w / 2 - 129.068240), round(h - 647.118794)); + writeln(round(w / 2 - 128.965992), round(h - 646.952929)); + writeln(round(w / 2 - 128.864138), round(h - 646.787815)); + writeln(round(w / 2 - 128.762689), round(h - 646.623302)); + writeln(round(w / 2 - 128.661652), round(h - 646.459390)); + writeln(round(w / 2 - 128.561010), round(h - 646.296154)); + writeln(round(w / 2 - 128.460771), round(h - 646.133594)); + writeln(round(w / 2 - 128.360937), round(h - 645.971710)); + writeln(round(w / 2 - 128.261506), round(h - 645.810502)); + writeln(round(w / 2 - 128.162469), round(h - 645.649895)); + writeln(round(w / 2 - 128.063846), round(h - 645.489889)); + writeln(round(w / 2 - 127.965627), round(h - 645.330635)); + writeln(round(w / 2 - 127.894723), round(h - 645.215626)); + writeln(round(w / 2 - 127.808626), round(h - 645.050587)); + writeln(round(w / 2 - 127.722895), round(h - 644.886149)); + writeln(round(w / 2 - 127.637511), round(h - 644.722462)); + writeln(round(w / 2 - 127.552485), round(h - 644.559452)); + writeln(round(w / 2 - 127.467815), round(h - 644.397042)); + writeln(round(w / 2 - 127.383502), round(h - 644.235383)); + writeln(round(w / 2 - 127.299537), round(h - 644.074476)); + writeln(round(w / 2 - 127.215937), round(h - 643.914170)); + writeln(round(w / 2 - 127.132695), round(h - 643.754540)); + writeln(round(w / 2 - 127.049800), round(h - 643.595585)); + writeln(round(w / 2 - 126.967261), round(h - 643.437307)); + writeln(round(w / 2 - 126.885080), round(h - 643.279780)); + writeln(round(w / 2 - 126.803255), round(h - 643.122854)); + writeln(round(w / 2 - 126.721788), round(h - 642.966680)); + writeln(round(w / 2 - 126.640677), round(h - 642.811106)); + writeln(round(w / 2 - 126.559923), round(h - 642.656359)); + writeln(round(w / 2 - 126.479516), round(h - 642.502137)); + writeln(round(w / 2 - 126.399475), round(h - 642.348667)); + writeln(round(w / 2 - 126.319782), round(h - 642.195872)); + writeln(round(w / 2 - 126.240446), round(h - 642.043754)); + writeln(round(w / 2 - 126.161467), round(h - 641.892312)); + writeln(round(w / 2 - 126.082844), round(h - 641.741546)); + writeln(round(w / 2 - 126.004578), round(h - 641.591456)); + writeln(round(w / 2 - 125.926669), round(h - 641.442117)); + writeln(round(w / 2 - 125.849108), round(h - 641.293379)); + writeln(round(w / 2 - 125.771913), round(h - 641.145393)); + writeln(round(w / 2 - 125.695065), round(h - 640.998007)); + writeln(round(w / 2 - 125.618583), round(h - 640.851372)); + writeln(round(w / 2 - 125.542449), round(h - 640.705414)); + writeln(round(w / 2 - 125.466671), round(h - 640.560132)); + writeln(round(w / 2 - 125.391251), round(h - 640.415525)); + writeln(round(w / 2 - 125.316178), round(h - 640.271595)); + writeln(round(w / 2 - 125.241471), round(h - 640.128341)); + writeln(round(w / 2 - 125.167121), round(h - 639.985763)); + writeln(round(w / 2 - 125.093118), round(h - 639.843861)); + writeln(round(w / 2 - 125.019472), round(h - 639.702711)); + writeln(round(w / 2 - 124.873260), round(h - 639.422287)); +end; +begin + X +end. diff --git a/mips/tests/webtbs/tw22344.pp b/mips/tests/webtbs/tw22344.pp new file mode 100644 index 0000000000..a20b70ab17 --- /dev/null +++ b/mips/tests/webtbs/tw22344.pp @@ -0,0 +1,24 @@ +program showbug ; + +{$mode macpas} + +var + glob: integer; + +function countchars: INTEGER ; +begin + countchars:=255; + if glob=5 then + countchars := 0 + else + begin + inc(glob); + countchars := 1 + countchars + end + end; + +begin + if countchars<>5 then + halt(1); +end . + |