Explorar el Código

* some small fixes
+ added several new tests

carl hace 23 años
padre
commit
f274f1baad
Se han modificado 8 ficheros con 190 adiciones y 0 borrados
  1. 1 0
      tests/tbf/tb0127.pp
  2. 24 0
      tests/tbf/tb0144.pp
  3. 25 0
      tests/tbf/tb0145.pp
  4. 31 0
      tests/tbf/tb0146.pp
  5. 31 0
      tests/tbf/tb0147.pp
  6. 39 0
      tests/tbf/tb0148.pp
  7. 27 0
      tests/tbf/tb0149.pp
  8. 12 0
      tests/tbf/ub0149.pp

+ 1 - 0
tests/tbf/tb0127.pp

@@ -1,4 +1,5 @@
 { %version=1.1 }
+{ %fail }
 { Interfaces only supported in v1.1 }
 { Should give the same error as /tbf/tb0125.pp }
 {$ifdef fpc}

+ 24 - 0
tests/tbf/tb0144.pp

@@ -0,0 +1,24 @@
+{ %FAIL }
+
+{ OpenString with high should not be allowed }
+program tb0144;
+
+procedure TestOpen(var s: OpenString); cdecl;
+var
+ b: byte;
+begin
+ b:=high(s); 
+end;
+
+
+
+Begin
+end.
+
+{
+   $Log$
+   Revision 1.1  2002-11-26 19:24:30  carl
+     * some small fixes
+     + added several new tests
+
+}

+ 25 - 0
tests/tbf/tb0145.pp

@@ -0,0 +1,25 @@
+{ %FAIL }
+
+{ This should fail compilation because open parameters are not 
+  allowed with cdecl'ed routines.
+}
+
+procedure TestOpen(var s: array of byte); cdecl;
+var
+ b: byte;
+begin
+ b:=high(s); 
+end;
+
+
+
+Begin
+end.
+
+{
+   $Log$
+   Revision 1.1  2002-11-26 19:24:30  carl
+     * some small fixes
+     + added several new tests
+
+}

+ 31 - 0
tests/tbf/tb0146.pp

@@ -0,0 +1,31 @@
+{ %VERSION=1.1 }
+{ %FAIL }
+{ %OPT=-Sew -vw }
+{$MODE OBJFPC}
+type
+  tmyclass = class
+   procedure myabstract; virtual; abstract;
+  end;
+
+  tmyclass2 = class(tmyclass)
+  end;
+
+  tmyclassnode = class of tmyclass;
+
+var
+ cla : tmyclass2;
+ cla1 : tmyclass;
+ classnode : tmyclassnode;
+Begin
+ cla := tmyclass2.create;
+ classnode := tmyclass2;
+ cla1 := classnode.create;
+end.
+
+{
+  $Log$
+  Revision 1.1  2002-11-26 19:24:30  carl
+    * some small fixes
+    + added several new tests
+
+}

+ 31 - 0
tests/tbf/tb0147.pp

@@ -0,0 +1,31 @@
+{ %VERSION=1.1 }
+{ %FAIL }
+{ %OPT=-Sew -vw }
+{$MODE OBJFPC}
+type
+  tmyclass = class
+   procedure myabstract; virtual; abstract;
+  end;
+
+  tmyclass2 = class(tmyclass)
+  end;
+
+  tmyclassnode = class of tmyclass;
+
+var
+ cla : tmyclass2;
+ cla1 : tmyclass;
+ classnode : tmyclassnode;
+Begin
+ cla := tmyclass2.create;
+ classnode := tmyclass2;
+ cla1 := classnode.create;
+end.
+
+{
+  $Log$
+  Revision 1.1  2002-11-26 19:24:30  carl
+    * some small fixes
+    + added several new tests
+
+}

+ 39 - 0
tests/tbf/tb0148.pp

@@ -0,0 +1,39 @@
+{ %VERSION=1.1 }
+{ %FAIL }
+{ %OPT=-Sew -vw }
+
+{$MODE OBJFPC}
+
+{ This tests that non-implemented abstract methods which are
+  overloaded (but not in all cases) will still give out a 
+  warning
+ }
+type
+  tmyclass = class
+   procedure myabstract(x: integer); virtual; abstract;
+   procedure myabstract(z: byte); virtual; abstract;
+  end;
+
+  tmyclass2 = class(tmyclass)
+   procedure myabstract(x: integer) ; override;
+  end;
+
+
+  procedure tmyclass2.myabstract(x: integer); 
+   begin
+   end;
+
+
+var
+ cla : tmyclass2;
+Begin
+ cla := tmyclass2.create;
+end.
+
+{
+  $Log$
+  Revision 1.1  2002-11-26 19:24:30  carl
+    * some small fixes
+    + added several new tests
+
+}

+ 27 - 0
tests/tbf/tb0149.pp

@@ -0,0 +1,27 @@
+{ %VERSION=1.1 }
+{ %FAIL }
+{ %OPT=-Sew -vw }
+
+uses ub0149;
+
+  
+  
+procedure testdef1(b: tdefinition);
+begin
+  b:=12;
+end;
+
+
+type
+  tdefinition = 1..10;
+  
+procedure testdef2(b : tdefinition);
+begin
+  b:=10;
+end;
+
+
+Begin
+  testdef1(0);
+  testdef2(0);
+end.

+ 12 - 0
tests/tbf/ub0149.pp

@@ -0,0 +1,12 @@
+unit ub0149;
+
+interface
+
+type
+  tdefinition = 1..10;
+
+
+implementation
+
+
+end.