Browse Source

* new bugs from the web

peter 24 years ago
parent
commit
2b2150e897

+ 10 - 0
tests/webtbf/tb1432.pp

@@ -0,0 +1,10 @@
+{ %FAIL }
+
+procedure something;
+ procedure SomethingExt (onepar:longint); external;
+begin
+ SomethingExt (1);
+end;
+
+begin
+end.

+ 15 - 0
tests/webtbs/tb1409.pp

@@ -0,0 +1,15 @@
+{$MODE objfpc}
+type
+  TPoint = record
+    x, y: Integer;
+  end;
+
+procedure Test(const Args: array of TPoint);
+begin
+end;
+
+const
+  p1: TPoint = (x: 10; y: 10);
+begin
+  Test([p1]);
+end.

+ 18 - 0
tests/webtbs/tb1412.pp

@@ -0,0 +1,18 @@
+PROGRAM initializationBug( INPUT, OUTPUT );
+{$H+}
+CONST
+  bufferSize = 8;
+  tableSize = 2;
+
+TYPE
+  bufferRecord = RECORD
+    stringBuffer     : String;
+    characterBuffer  : ARRAY[ 1..bufferSize ] OF CHAR;
+  END;
+
+VAR
+  bufferTable  : ARRAY[ 1..tableSize ] OF bufferRecord;
+
+BEGIN
+  WRITELN( '< INITIALIZATION BUG HAS NOT OCCURRED!' );
+END.

+ 23 - 0
tests/webtbs/tb1416.pp

@@ -0,0 +1,23 @@
+var s:ansistring;
+begin
+  s:='TeSt....10........20........30'+
+  '........40........50'+
+  '........60........70........80'+
+  '........90.......100'+
+  '.......110.......120.......130'+
+  '.......140.......150'+
+  '.......160.......170.......180'+
+  '.......190.......200'+
+  '.......210.......220.......230'+
+  '.......240.......250'+
+  '.......260.......270.......280'+
+  '.......290.......300';
+  writeln(s);
+  writeln(upcase(s));
+  writeln(lowercase(s));
+  if (length(upcase(s))<length(s)) or (length(lowercase(s))<length(s)) then
+   begin
+     writeln('ERROR');
+     halt(1);
+   end;
+end. 

+ 39 - 0
tests/webtbs/tb1445.pp

@@ -0,0 +1,39 @@
+{$ifdef fpc}{$mode objfpc}{$endif}
+
+uses classes, sysutils;
+
+var list : TStringList;
+
+begin
+  list := TStringList.Create;
+  try
+    try
+      list.commatext := '"OK"';
+      writeln ('---');
+      writeln (list.text);
+      writeln ('---');
+    except
+      on e:exception do
+          begin
+            writeln('Exception: '+e.message);
+            halt(1);
+          end;
+    end;
+    try
+      //Failed
+      list.commatext := '';
+      writeln ('---');
+      writeln (list.text);
+      writeln ('---');
+    except
+      on e:exception do
+          begin
+            writeln('Exception: '+e.message);
+            halt(1);
+          end;
+    end;
+  finally
+    list.Free;
+    writeln ('Freeing list');
+  end;
+end.

+ 23 - 0
tests/webtbs/tb1450.pp

@@ -0,0 +1,23 @@
+{$ifdef fpc}{$mode objfpc}{$endif}
+
+uses classes;
+
+var SL : TStringlist;
+
+begin
+  SL := TStringlist.Create;
+  sl.Add('1');
+  sl.Add('2');
+  sl.Add('A"A');
+  sl.Add('B');
+  sl.Add('C,C');
+  sl.Add('D;D');
+  writeln(sl.Text);
+  writeln(sl.CommaText);
+  if sl.CommaText<>'1,2,"A""A",B,"C,C",D;D' then
+   begin
+     writeln('ERROR!');
+     halt(1);
+   end;
+  sl.free;
+end.

+ 18 - 0
tests/webtbs/tb1451.pp

@@ -0,0 +1,18 @@
+{$ifdef fpc}{$mode objfpc}{$endif}
+
+uses
+  sysutils;
+
+var ErrorFileHandle : Text;
+
+begin
+  //No Assignfile
+  Writeln('----');
+  try
+    CloseFile(ErrorFileHandle);
+  except
+    on E: Exception
+        do Writeln('ExceptionMessage: '+e.Message);
+  end;
+  Writeln('----');
+end.