Browse Source

* new tests

peter 24 years ago
parent
commit
b620a6c66d

+ 25 - 0
tests/tbs/tb0356.pp

@@ -0,0 +1,25 @@
+{$mode objfpc}
+type
+  tc = class
+    function test(var c: tc): boolean;
+    left,right: tc;
+  end;
+
+  testfunc = function(var c: tc):boolean of object;
+
+  function foreach(var c: tc; p: testfunc): boolean;
+    begin
+      if not assigned(c) then
+        exit;
+    end;
+
+
+  function tc.test(var c: tc): boolean;
+  begin
+    result := foreach(c.left,@test);
+    result := foreach(c.right,@test) or result;
+  end;
+
+
+begin
+end.

+ 32 - 0
tests/webtbf/tw1483.pp

@@ -0,0 +1,32 @@
+{ %fail }
+
+Type pBug=^tBug;
+     tBug=Object
+       Private
+        A:Longint;
+        Go:Procedure Of Object;
+        Procedure Go1;
+       Public
+        Constructor Init;
+     End;
+
+Constructor tBug.Init;
+Begin
+   A:=10;
+   Go:=Go1; { <-- It's wring, it should        }
+            {     be Go:=@Go1; but compiler    }
+            {     says it's ok, and the program}
+            {     even runs... }
+End;
+
+Procedure tBug.Go1;
+Begin
+   WriteLn(A);
+End;
+
+Var Bug:pBug;
+
+Begin
+   Bug:=New(pBug,Init);
+   Bug^.Go;
+End.

+ 1 - 0
tests/webtbs/tw1279.pp

@@ -1,3 +1,4 @@
+{ %opt=-Un }
 { %version=1.1 }
 
 uses

+ 8 - 0
tests/webtbs/tw1477.pp

@@ -0,0 +1,8 @@
+CONST
+  Digit:Byte=3;{did work if we use DWord}
+VAR
+  x:Real;
+BEGIN
+  x:=10;
+  WriteLn(x:1:Digit);
+END.

+ 17 - 0
tests/webtbs/tw1479.pp

@@ -0,0 +1,17 @@
+{$ifdef fpc}{$mode objfpc}{$endif}
+
+uses
+  sysutils;
+
+var
+  fn : string;
+begin
+  fn:=FileSearch('tw1479.pp',';');
+  writeln('found: ',fn);
+  if fn<>'tw1479.pp' then
+   halt(1);
+  fn:=FileSearch('.\tw1479.pp',';');
+  writeln('found: ',fn);
+  if fn<>'.\tw1479.pp' then
+   halt(1);
+end.

+ 25 - 0
tests/webtbs/tw1489.pp

@@ -0,0 +1,25 @@
+{$ifdef fpc}{$mode delphi}{$endif}
+
+uses classes;
+
+var
+  StrList : TStringList;
+  x                             : Integer;
+  Para : string;
+begin
+  Para:='Hello,"This","i"s",a,"Test for"," TStringList"';
+  StrList := TStringList.Create;
+
+  writeln('Parameter: '+Para);
+  StrList.CommaText := Para;
+  writeln('Strings:');
+  for x := 0 to StrList.Count-1 do
+    writeln(StrList.Strings[x]);
+  writeln('CommaText: '+StrList.CommaText);
+  if StrList.CommaText<>'Hello,This,i,"s""",a,"Test for"," TStringList"' then
+   begin
+     writeln('ERROR!');
+     halt(1);
+   end;
+  StrList.Free;
+end.

+ 18 - 0
tests/webtbs/tw1501.pp

@@ -0,0 +1,18 @@
+{$mode objfpc}
+
+function Uper1(const Pwd:AnsiString):AnsiString;
+begin
+        Result := UpCase(Pwd);
+        Exit;
+end;
+
+function Uper2(const Pwd:AnsiString):AnsiString;
+begin
+        Exit(UpCase(Pwd));
+end;
+
+begin
+        writeln('test', Uper1('test'));
+        writeln('test', Uper2('test'));
+
+end.

+ 1 - 1
tests/webtbs/uw1279.pp

@@ -1,4 +1,4 @@
-unit uw1279;
+unit testunit;
 interface
 implementation
 end.