Browse Source

+ several tbs/tbf

pierre 26 years ago
parent
commit
5e63dbceeb
9 changed files with 203 additions and 0 deletions
  1. 9 0
      tests/tbf0186.pp
  2. 13 0
      tests/tbf0219.pp
  3. 53 0
      tests/tbs0215.pp
  4. 34 0
      tests/tbs0216.pp
  5. 19 0
      tests/tbs0217.pp
  6. 25 0
      tests/tbs0218.pp
  7. 4 0
      tests/tbs0254.pp
  8. 9 0
      tests/tbs0255.pp
  9. 37 0
      tests/ts010016.pp

+ 9 - 0
tests/tbf0186.pp

@@ -0,0 +1,9 @@
+  program bug0186;
+   var
+    endline:^integer;
+    line:array [1..endline^] of ^char;
+   begin
+    new (endline);
+    endline^:=5;  
+    endline^:=10;
+   end.

+ 13 - 0
tests/tbf0219.pp

@@ -0,0 +1,13 @@
+{ Should give '(' expected in line 6 }
+
+   const
+     replaces=4;
+     replacetab : array[1..replaces,1..2] of string[32]=(
+       ':',' or colon',
+       'mem8','mem or bits8',
+       'mem16','mem or bits16',
+       'mem32','mem or bits32'
+     )
+begin
+end.
+

+ 53 - 0
tests/tbs0215.pp

@@ -0,0 +1,53 @@
+{ $OPT=-St }
+{ allow static keyword }
+{ submitted by Andrew Wilson }
+
+Program X;
+
+{$ifdef go32v2}
+  uses dpmiexcp;
+{$endif go32v2}
+
+Type
+   PY=^Y;
+   Y=Object
+      A : LongInt;
+      P : PY; static;
+      Constructor Init(NewA:LongInt);
+      Procedure StaticMethod; static;
+      Procedure VirtualMethod; virtual;
+   End;
+
+
+Constructor Y.Init(NewA:LongInt);
+   Begin
+      A:=NewA;
+      P:=@self;
+   End;
+
+Procedure Y.StaticMethod;
+   Begin
+      Writeln(P^.A);    // Compiler complains about using A.
+      P^.VirtualMethod; // Same with the virtual method.
+      With P^ do begin
+         Writeln(A);    // These two seem to compile, but I
+         VirtualMethod; // can't get them to work. It seems to
+      End;              // be the same problem as last time, so
+   End;                 // I'll check it again when I get the
+                        // new snapshot.
+Procedure Y.VirtualMethod;
+   Begin
+      Writeln('VirtualMethod ',A);
+   End;
+
+var T1,T2 :  PY;
+
+Begin
+  New(T1,init(1));
+  New(T2,init(2));
+  T1^.VirtualMethod;
+  T2^.VirtualMethod;
+  Y.StaticMethod;
+  T1^.StaticMethod;
+  T2^.StaticMethod;
+End.

+ 34 - 0
tests/tbs0216.pp

@@ -0,0 +1,34 @@
+type rec = record
+         a : Longint;
+         b : Longint;
+         c : Longint;
+         d : record
+           e : Longint;
+           f : Word;
+         end;
+         g : Longint;
+     end;
+
+const r : rec = (
+        a : 100; b : 200; c : 300; d : (e : 20; f : 30); g : 10);
+
+
+begin
+     with r do begin
+          Writeln('A : ', a);
+          if a<>100 then halt(1);
+          Writeln('B : ', b);
+          if b<>200 then halt(1);
+          Writeln('C : ', c);
+          if c<>300 then halt(1);
+          Writeln('D');
+          with d do begin
+               Writeln('E : ', e);
+               if e<>20 then halt(1);
+               Writeln('F : ', f);
+               if f<>30 then halt(1);
+          end;
+          Writeln('G : ', g);
+          if g<>10 then halt(1);
+     end;
+end.

+ 19 - 0
tests/tbs0217.pp

@@ -0,0 +1,19 @@
+{$ifdef fpc}{$mode tp}{$endif}
+
+type tmpproc=function:longint;
+
+function a:longint;{$ifndef fpc}far;{$endif}
+begin
+ a:=-1;
+end;
+
+procedure tmp(aa: tmpproc);
+begin
+  writeln(aa);           { "Cannot read/write variables of this type", TP kan dit
+wel? }
+  if aa<>-1 then halt(1);
+end;
+
+begin
+  tmp(a);               { de TP manier , in FPC moet dit zijn tmp(@a); }
+end.

+ 25 - 0
tests/tbs0218.pp

@@ -0,0 +1,25 @@
+Program Wrong_Output;
+{}
+Var r,rr:Extended; s:String;
+    code : word;
+{}
+Begin
+  Writeln('Size of Extended type (r)=',SizeOf(r),' bytes');
+  r:=0.000058184639;
+  Writeln('r=',r);
+  Writeln('r=',r:16:13);
+  Writeln('r=',r:15:12);
+  Writeln('r=',r:14:11);
+  Writeln('r=',r:13:10);
+  Writeln('r=',r:12:9);
+  Writeln('r=',r:11:8);
+  Writeln('r=',r:10:7);
+  Writeln('r=',r:9:6);
+  Writeln('r=',r:8:5);
+  Writeln('r=',r:7:4);
+  Str(r:7:4,s);
+  Writeln('r=',s,' (as string)')
+  str(r,s);
+  val(s,rr,code);
+  if r<>rr then halt(1);
+End.

+ 4 - 0
tests/tbs0254.pp

@@ -0,0 +1,4 @@
+begin
+end.
+
+disposestr

+ 9 - 0
tests/tbs0255.pp

@@ -0,0 +1,9 @@
+
+function a: char;
+begin
+  a:='c';
+end;
+
+begin
+  if #12 in [a, a, a, a, a] then ; { <--- }
+end.

+ 37 - 0
tests/ts010016.pp

@@ -0,0 +1,37 @@
+{ problem of conversion between 
+  smallsets and long sets }
+type
+
+{ Command sets }
+
+  PCommandSet = ^TCommandSet;
+  TCommandSet = set of Byte;
+
+Const
+  cmValid   = 0;
+  cmQuit    = 1;
+  cmError   = 2;
+  cmMenu    = 3;
+  cmClose   = 4;
+  cmZoom    = 5;
+  cmResize  = 6;
+  cmNext    = 7;
+  cmPrev    = 8;
+  cmHelp    = 9;
+
+{ Application command codes }
+
+  cmCut     = 20;
+  cmCopy    = 21;
+  cmPaste   = 22;
+  cmUndo    = 23;
+  cmClear   = 24;
+  cmTile    = 25;
+  cmCascade = 26;
+
+  CurCommandSet: TCommandSet =
+    [0..255] - [cmZoom, cmClose, cmResize, cmNext, cmPrev];
+
+
+  begin
+  end.