From 3d18bdff957cf3b4321b8e93a24e2da55e11e340 Mon Sep 17 00:00:00 2001 From: pierre Date: Wed, 27 Jan 1999 12:47:57 +0000 Subject: [PATCH] new tbs and tbf added, some rewritten --- tests/tbf0203.pp | 13 +++++++++++++ tests/tbf0203a.pp | 25 +++++++++++++++++++++++++ tests/tbf0205.pp | 31 +++++++++++++++++++++++++++++++ tests/tbf0208.pp | 11 +++++++++++ tests/tbs0037.pp | 5 +++-- tests/tbs0048.pp | 6 +++--- tests/tbs0051.pp | 2 +- tests/tbs0052.pp | 8 ++++---- tests/tbs0057.pp | 4 ++-- tests/tbs0102.pp | 4 +++- tests/tbs0123.pp | 1 + tests/tbs0124.pp | 32 +++++++++++++++++++++++++++++++- tests/tbs0128.pp | 3 +++ tests/tbs0141.pp | 10 +++++----- tests/tbs0202.pp | 31 +++++++++++++++++++++++++++++++ tests/tbs0204.pp | 30 ++++++++++++++++++++++++++++++ tests/tbs0206.pp | 10 ++++++++++ tests/tbs0207.pp | 8 ++++++++ tests/tbs0209.pp | 18 ++++++++++++++++++ 19 files changed, 233 insertions(+), 19 deletions(-) create mode 100644 tests/tbf0203.pp create mode 100644 tests/tbf0203a.pp create mode 100644 tests/tbf0205.pp create mode 100644 tests/tbf0208.pp create mode 100644 tests/tbs0202.pp create mode 100644 tests/tbs0204.pp create mode 100644 tests/tbs0206.pp create mode 100644 tests/tbs0207.pp create mode 100644 tests/tbs0209.pp diff --git a/tests/tbf0203.pp b/tests/tbf0203.pp new file mode 100644 index 0000000000..e339afa201 --- /dev/null +++ b/tests/tbf0203.pp @@ -0,0 +1,13 @@ +program tbf0203; + +uses +{$ifdef go32v2} + dpmiexcp, +{$endif def go32v2} + tbf0203a; + +begin + c; + a; +end. + diff --git a/tests/tbf0203a.pp b/tests/tbf0203a.pp new file mode 100644 index 0000000000..f425eea19a --- /dev/null +++ b/tests/tbf0203a.pp @@ -0,0 +1,25 @@ +unit tbf0203a; + +interface + procedure a; + procedure c; + + const is_called : boolean = false; + +implementation + + procedure c; + begin + a; + end; + + procedure b;[public, alias : '_assembler_a']; + begin + Writeln('b called'); + Is_called:=true; + end; + + procedure a;external name '_assembler_a'; + +end. + diff --git a/tests/tbf0205.pp b/tests/tbf0205.pp new file mode 100644 index 0000000000..739bd51cca --- /dev/null +++ b/tests/tbf0205.pp @@ -0,0 +1,31 @@ +program bug_show; +{ By PAV (pavsoft@usa.net) } + +function bad_uppercase(s:string):string; +var i:integer; +begin + for i:=1 to length(s) do + if (ord(s[i])>=97 and ord(s[i])<=122) then s[i]:=chr(ord(s[i])-97+65); + bad_uppercase:=s; +end; + +function good_uppercase(s:string):string; +var i:integer; +begin + for i:=1 to length(s) do + if (ord(s[i])>=97) and (ord(s[i])<=122) then s[i]:=chr(ord(s[i])-97+65); + good_uppercase:=s; +end; + +const cadena='Free Paskal Compiler 0.99.8 !!! (bug)'; +begin + writeln('This is the original string before convert it'); + writeln(cadena); + writeln(); + writeln('This is a bad result, using "if ( and )"'); + writeln(bad_uppercase(cadena)); + writeln(); + writeln('This is a good result, using "if () and ()"'); + writeln(good_uppercase(cadena)); + writeln(); +end. diff --git a/tests/tbf0208.pp b/tests/tbf0208.pp new file mode 100644 index 0000000000..e115414944 --- /dev/null +++ b/tests/tbf0208.pp @@ -0,0 +1,11 @@ +program tbf0208; + +{ implicit boolean to integer conversion should not be + allowed } +var + b : boolean; + i : longint; +begin + b:=true; + i:=b; +end. \ No newline at end of file diff --git a/tests/tbs0037.pp b/tests/tbs0037.pp index 830d513463..ce1e821ae5 100644 --- a/tests/tbs0037.pp +++ b/tests/tbs0037.pp @@ -8,10 +8,11 @@ begin gd:=detect; initgraph(gd,gm,''); line(1,1,100,100); - readkey; + {readkey;} setgraphmode($107); line(100,100,1024,800); - readkey; + {readkey;} + delay(1000); closegraph; end. diff --git a/tests/tbs0048.pp b/tests/tbs0048.pp index 211ce915e4..65ad7b83a9 100644 --- a/tests/tbs0048.pp +++ b/tests/tbs0048.pp @@ -11,7 +11,7 @@ begin initgraph(gd,gm,''); setcolor(brown); line(0,0,getmaxx,0); - readkey; + {readkey;}delay(1000); size:=imagesize(0,0,getmaxx,0); getmem(p,size); getimage(0,0,getmaxx,0,p^); @@ -20,12 +20,12 @@ begin begin putimage(0,i,p^,xorput); end; - readkey; + {readkey;}delay(1000); for i:=0 to getmaxy do begin putimage(0,i,p^,xorput); end; - readkey; + {readkey;}delay(1000); closegraph; end. diff --git a/tests/tbs0051.pp b/tests/tbs0051.pp index 63bb61ee1c..de7675314f 100644 --- a/tests/tbs0051.pp +++ b/tests/tbs0051.pp @@ -38,7 +38,7 @@ BEGIN for i:=0 to 255 do if not ColorsEqual(getpixel(i,15),getpixel(i,30)) then Halt(1); - readkey; + {readkey;}delay(1000); closegraph; END. diff --git a/tests/tbs0052.pp b/tests/tbs0052.pp index 48f72d2092..123f71fadc 100644 --- a/tests/tbs0052.pp +++ b/tests/tbs0052.pp @@ -1,5 +1,5 @@ uses - graph; + crt,graph; const Triangle: array[1..3] of PointType = ((X: 50; Y: 100), (X: 100; Y:100), @@ -16,10 +16,10 @@ begin if GraphResult <> grOk then Halt(1); drawpoly(SizeOf(Triangle) div SizeOf(PointType), Triangle); - readln; + {readln;}delay(1000); setcolor(red); fillpoly(SizeOf(Triangle) div SizeOf(PointType), Triangle); - readln; + {readln;}delay(1000); SetFillStyle(SolidFill,blue); Bar(0,0,GetMaxX,GetMaxY); Rectangle(25,25,GetMaxX-25,GetMaxY-25); @@ -30,6 +30,6 @@ begin fillpoly(SizeOf(Rect) div SizeOf(PointType), Rect); fillpoly(SizeOf(Penta) div SizeOf(PointType), Penta); graphdefaults; - readln; + {readln;}delay(1000); CloseGraph; end. diff --git a/tests/tbs0057.pp b/tests/tbs0057.pp index 20f1a8b082..0c05841679 100644 --- a/tests/tbs0057.pp +++ b/tests/tbs0057.pp @@ -9,10 +9,10 @@ begin gm:=$103; initgraph(gd,gm,''); line(1,1,100,100); - readkey; + {readkey;}delay(1000); closegraph; initgraph(gd,gm,''); line(100,100,1,100); - readkey; + {readkey;}delay(1000); closegraph; end. diff --git a/tests/tbs0102.pp b/tests/tbs0102.pp index 662a77197c..cc567c5574 100644 --- a/tests/tbs0102.pp +++ b/tests/tbs0102.pp @@ -1,10 +1,11 @@ -{ $OPT= -Tamiga } +{ assembler reader of m68k for register ranges } unit tbs0102; interface implementation +{$ifdef M68K} procedure int_help_constructor; begin @@ -12,6 +13,7 @@ unit tbs0102; movem.l d0-a7,-(sp) end; end; +{$endif M68K} end. diff --git a/tests/tbs0123.pp b/tests/tbs0123.pp index f05a43cfbb..c796f5d50d 100644 --- a/tests/tbs0123.pp +++ b/tests/tbs0123.pp @@ -1,3 +1,4 @@ +{ bug for shrd assemblerreader } begin {$asmmode intel} asm diff --git a/tests/tbs0124.pp b/tests/tbs0124.pp index 261ed4bd66..5342caa496 100644 --- a/tests/tbs0124.pp +++ b/tests/tbs0124.pp @@ -1,11 +1,41 @@ + +{ this problem comes from the fact that + L is a static variable, not a local one !! + but the static variable symtable is the localst of the + main procedure (PM) + It must be checked if we are at main level or not !! } + var l : longint; + + procedure error; + begin + Writeln('Error in tbs0124'); + Halt(1); + end; + begin +{$asmmode direct} + asm + movl $5,l + end; + if l<>5 then error; +{$asmmode att} + asm + movl l,%eax + addl $2,%eax + movl %eax,l + end; + if l<>7 then error; {$asmmode intel} { problem here is that l is replaced by BP-offset } { relative to stack, and the parser thinks all wrong } { because of this. } asm - mov eax, [eax*4+l] + mov eax,l + add eax,5 + mov l,eax end; + if l<>12 then error; + Writeln('tbs0124 OK'); end. diff --git a/tests/tbs0128.pp b/tests/tbs0128.pp index a6076ae434..f8b2881421 100644 --- a/tests/tbs0128.pp +++ b/tests/tbs0128.pp @@ -1,3 +1,6 @@ +{ ^ followed by a letter must be interpreted differently + depending on context } + const ArrowKeysOrFirstLetter='arrow keys '^]^r^z' or First letter. '; diff --git a/tests/tbs0141.pp b/tests/tbs0141.pp index 02b10f33a3..19f4fe3866 100644 --- a/tests/tbs0141.pp +++ b/tests/tbs0141.pp @@ -23,15 +23,15 @@ var begin a := TObjectAB.Create; -WriteLn(a.InstanceSize, ' Should be: 8'); -if a.InstanceSize + SizeOf(integer)*2 <> SizeOf(TObjectABCD) then +WriteLn(a.InstanceSize, ' Should be: 12'); +if a.InstanceSize + SizeOf(integer)*2 <> TObjectABCD.InstanceSize then Halt(1); b := TObjectABCD.Create; -if b.InstanceSize + SizeOf(integer)*2 <> SizeOf(TObjectABCDEF) then +if b.InstanceSize + SizeOf(integer)*2 <> TObjectABCDEF.InstanceSize then Halt(1); -WriteLn(b.InstanceSize, ' Should be: 16'); +WriteLn(b.InstanceSize, ' Should be: 20'); c := TObjectABCDEF.Create; -WriteLn(c.InstanceSize, ' Should be: 24'); +WriteLn(c.InstanceSize, ' Should be: 28'); end. { diff --git a/tests/tbs0202.pp b/tests/tbs0202.pp new file mode 100644 index 0000000000..c3418aae4b --- /dev/null +++ b/tests/tbs0202.pp @@ -0,0 +1,31 @@ +program silly; + +var greater : boolean; + +procedure error; +begin + Writeln('Error in tbs0202'); + Halt(1); +end; + +procedure compare(i,j : integer); +begin + case (i>j) of + true : begin + greater:=true; + end; + false : begin + greater:=false; + end; + end; +end; + +begin + compare(45,2); + if not greater then + error; + compare(-5,26) + if greater then + error; +end. + diff --git a/tests/tbs0204.pp b/tests/tbs0204.pp new file mode 100644 index 0000000000..e7d9cea910 --- /dev/null +++ b/tests/tbs0204.pp @@ -0,0 +1,30 @@ +{ boolean(byte) byte(boolean) + word(wordbool) wordbool(word) + longint(longbool) and longbool(longint) + must be accepted as var parameters + or a left of an assignment } + +procedure error; +begin + Writeln('Error in tbs0204'); + Halt(1); +end; + +var + b : boolean; + wb : wordbool; + lb : longbool; + +begin + byte(b):=1; + word(wb):=1; + longint(lb):=1; + if (not b) or (not wb) or (not lb) then + error; + byte(b):=2; + Writeln('if a boolean contains 2 it is considered as ',b); + byte(b):=3; + Writeln('if a boolean contains 3 it is considered as ',b); + shortint(b):=-1; + Writeln('if a boolean contains shortint(-1) it is considered as ',b); +end. \ No newline at end of file diff --git a/tests/tbs0206.pp b/tests/tbs0206.pp new file mode 100644 index 0000000000..7cfad907c3 --- /dev/null +++ b/tests/tbs0206.pp @@ -0,0 +1,10 @@ +PROGRAM SetRange_Bug; +CONST a:char='A';z:char='Z'; +VAR s:set of char;c:char; +BEGIN + s:=[a..z]; + for c:=#0 to #255 do + if c in s then + write(c); + writeln; +END. \ No newline at end of file diff --git a/tests/tbs0207.pp b/tests/tbs0207.pp new file mode 100644 index 0000000000..33a487e290 --- /dev/null +++ b/tests/tbs0207.pp @@ -0,0 +1,8 @@ + +{$mode delphi} + var i : longint; + +begin + for i:=1 to maxlongint do + tobject.create.free; +end. diff --git a/tests/tbs0209.pp b/tests/tbs0209.pp new file mode 100644 index 0000000000..a203f85008 --- /dev/null +++ b/tests/tbs0209.pp @@ -0,0 +1,18 @@ +program bug0209; + +{ problem with boolean expression mixing different boolean sizes } + +var + b : boolean; + wb : wordbool; + lb : longbool; +begin + b:=true; + wb:=true; + lb:=true; + if (not b) or (not wb) or (not lb) then + begin + Writeln('Error with boolean expressions of different sizes'); + Halt(1); + end; +end. \ No newline at end of file