Browse Source

* more bugs

peter 23 years ago
parent
commit
1c22644da3

+ 16 - 0
tests/webtbf/tw1599.pp

@@ -0,0 +1,16 @@
+{ %fail }
+
+{$ifdef fpc}{$MODE objfpc}{$endif}
+
+unit tw1599;
+interface
+type
+  TMyClass = class;
+
+implementation
+
+type
+  TMyClass = class
+  end;
+
+end.

+ 17 - 0
tests/webtbs/tw1532.pp

@@ -0,0 +1,17 @@
+{ %version=1.1 }
+
+ uses sysutils;
+ Var I : Longint;
+     a:char;
+
+ begin
+ a:='A';
+ a:=upcase(a);   //OK
+
+ Writeln;
+ Writeln (Lowercase('ABCDEFGHIJKLMNOPQRSTUVWXYZ')); //OK
+ Writeln (Lowercase(A)); // OK
+ a:=Lowercase(A);        // ERROR
+ Writeln (a);
+ end.
+ 

+ 10 - 0
tests/webtbs/tw1709.pp

@@ -0,0 +1,10 @@
+{ %version=1.1 }
+
+{$ifdef fpc}{$mode delphi}{$endif}
+
+var
+ x: array of byte;
+begin
+  // This should free the dynamic array
+  x := nil;
+end.

+ 36 - 0
tests/webtbs/tw1744.pp

@@ -0,0 +1,36 @@
+var  outfile:text;
+     err:boolean;
+begin
+writeln('there should be three errors below:');
+
+assign(outfile,'notexist.fil');
+{$i-}
+Append(outfile);
+//rewrite(outfile);
+{$i+}
+//write(ioresult);  // 2 file not found
+if IOResult <> 0 then writeln('err append')
+else
+ err:=true;
+
+{$i-}
+writeln(outfile,'----------------------');
+{$i+}
+//write(ioresult);   // 103 file not open
+if IOResult <> 0 then writeln('err write')
+else
+ err:=true;
+
+{$i-}
+close(outfile);
+{$i+}
+//write(ioresult);  // 103 file not open
+if IOResult <> 0 then writeln('err close')
+else
+ err:=true;
+
+   if err then
+     halt(1)
+   else
+     writeln('success');
+end.

+ 30 - 0
tests/webtbs/tw1755.pp

@@ -0,0 +1,30 @@
+var
+  err : boolean;
+
+begin
+  err:=false;
+
+  write('assigned(nil): ');
+  if assigned(nil) then
+   err:=true
+  else
+   writeln('nil');
+  write('assigned(pointer(0)): ');
+  if assigned(pointer(0)) then
+   err:=true
+  else
+   writeln('nil');
+  write('assigned(pointer(10000)): ');
+  if assigned(pointer(10000)) then
+   writeln('assigned')
+  else
+   err:=true;
+
+  if err then
+   begin
+     writeln('err');
+     halt(1);
+   end;
+
+end.
+

+ 15 - 0
tests/webtbs/tw1758.pp

@@ -0,0 +1,15 @@
+{ %interactive }
+
+uses crt;
+
+begin
+clrscr;
+Window(1,2,80,3); {this does not work; if you set the last parameter to 4 (=3 lines) everything is fine}
+gotoxy(1,1); write('clear now ? (this is only to fill some text...)');
+readkey;
+clrscr;
+readkey;
+write('cleared !');
+readkey;
+
+end.

+ 13 - 0
tests/webtbs/tw1765.pp

@@ -0,0 +1,13 @@
+{$mode delphi}
+
+type mytype=array[1..2] of string;
+const myconst:mytype=('foo','bar');
+
+procedure myproc(myparam:mytype);
+begin
+ writeln(myparam[1],' ',myparam[2]);
+end;
+
+begin
+ myproc(myconst);
+end.