* some files from bugs directory

tests/tbf0008.pp

@@ -0,0 +1,6 @@
+const
+   compilerconst=1;
+
+begin
+   dec(compilerconst);
+end.

tests/tbf0010.pp

@@ -0,0 +1,6 @@
+program hello;
+
+  begin
+     writeln('Hello);
+  end.
+

tests/tbs0004.pp

@@ -0,0 +1,13 @@
+var
+   i : longint;
+
+begin
+   for i:=1 to 100 do
+     begin
+        writeln('Hello');
+        continue;
+        writeln('ohh');
+	Halt(1);
+     end;
+end.
+

tests/tbs0005.pp

@@ -0,0 +1,10 @@
+begin
+  if 1=1 then
+    begin
+      Writeln('OK');
+    end;
+  if 1<>1 then
+    begin
+      Halt(1);
+    end;
+end.

tests/tbs0006.pp

@@ -0,0 +1,16 @@
+var
+   a,b,c,d,e,f,g,r : double;
+
+begin
+   a:=10.0;
+   b:=11.0;
+   c:=13.0;
+   d:=17.0;
+   e:=19.0;
+   f:=23.0;
+   r:=2.0;
+   a:= a - 2*b*e - 2*c*f - 2*d*g - Sqr(r);
+   writeln(a,' (must be -1010)');
+   if a<>-1010.0 then
+     Halt(1);
+end.

tests/tbs0007.pp

@@ -0,0 +1,14 @@
+var
+   count : byte;
+   test : longint;
+begin
+   test:=0;
+   for count:=1 to 127 do
+     begin
+        inc(test);
+        writeln(count,'. loop');
+        if test>127 then 
+          Halt(1);
+     end;
+end.
+

tests/tbs0009.pp

@@ -0,0 +1,27 @@
+var c:byte;
+
+  Procedure a(b:boolean);
+
+    begin
+       if b then writeln('TRUE') else writeln('FALSE');
+    end;
+
+  function Test_a(b:boolean) : string;
+
+    begin
+       if b then Test_a:='TRUE' else Test_a:='FALSE';
+    end;
+
+  begin {main program}
+     a(true); {works}
+     if Test_a(true)<>'TRUE' then halt(1);
+     a(false); {works}
+     if Test_a(false)<>'FALSE' then halt(1);
+     c:=0;
+     a(c>0); {doesn't work}
+     if Test_a(c>0)<>'FALSE' then halt(1);
+     a(c<0); {doesn't work}
+     if Test_a(c<0)<>'FALSE' then halt(1);
+     a(c=0);
+     if Test_a(c=0)<>'TRUE' then halt(1);
+  end.

tests/tbs0011.pp

@@ -0,0 +1,14 @@
+{$message don't know how to make a test from bug0011 (PM)}
+var
+   vga : array[0..320*200-1] of byte;
+
+procedure test(x,y : longint);
+
+  begin
+     vga[x+y mod 320]:=random(256);
+     vga[x+y mod 320]:=random(256);
+  end;
+
+begin
+end.
+

tests/tbs0012.pp

@@ -0,0 +1,13 @@
+var
+   a,b : longint;
+
+begin
+   a:=1;
+   b:=2;
+   if byte(a>b)=byte(a<b) then
+     begin
+        writeln('Ohhhh');
+	Halt(1);
+    end;
+end.
+

tests/tbs0013.pp

@@ -0,0 +1,9 @@
+procedure test(w : word);
+
+  begin
+  end;
+
+begin
+   test(1234);
+end.
+

tests/tbs0014.pp

@@ -0,0 +1,22 @@
+type
+   prec = ^trec;
+
+   trec = record
+      p : prec;
+      l : longint;
+   end;
+
+function test(p1,p2 : prec) : boolean;
+
+  begin
+     if p1^.l=12 then
+     case p1^.l of
+        123 : test:=(test(p1^.p,p2^.p) and test(p1^.p,p2^.p)) or
+                     (test(p1^.p,p2^.p) and test(p1^.p,p2^.p));
+        1234 : test:=(test(p1^.p,p2^.p) and test(p1^.p,p2^.p)) or
+                     (test(p1^.p,p2^.p) and test(p1^.p,p2^.p));
+     end;
+  end;
+
+begin
+end.

tests/tbs0015.pp

@@ -0,0 +1,21 @@
+program test;
+type            
+    realgr=    array [1..1000]  of double;  
+var                                
+    sx    :realgr;
+    i     :integer;
+    stemp :double;
+begin
+     sx[1]:=10;
+     sx[2]:=-20;
+     sx[3]:=30;
+     sx[4]:=-40;
+     sx[5]:=50;
+     sx[6]:=-60;
+     i:=1;
+     stemp:=1000;
+     stemp := stemp+abs(sx[i])+abs(sx[i+1])+abs(sx[i+2])+abs(sx[i+3])+
+              abs(sx[i+4])+abs(sx[i+5]);
+     writeln(stemp);
+     if stemp<>1210.0 then halt(1);
+end.

tests/tbs0016.pp

@@ -0,0 +1,193 @@
+  uses
+     crt;
+
+  const
+     { ... parameters }
+     w = 10;    { max. 10 }
+     h = 10;   { max. 10 }
+
+  type
+     tp = array[0..w,0..h] of double;
+
+  var
+     temp : tp;
+     phi : tp;
+     Bi : tp;
+
+     boundary : array[0..w,0..h] of double;
+
+  function start_temp(i,j : longint) : double;
+
+    begin
+       start_temp:=(boundary[i,0]*(h-j)+boundary[i,h]*j+boundary[0,j]*(w-i)+boundary[w,j]*i)/(w+h);
+    end;
+
+  procedure init;
+
+    var
+       i,j : longint;
+
+    begin
+       for i:=0 to w do
+         for j:=0 to h do
+           temp[i,j]:=start_temp(i,j);
+    end;
+
+  procedure draw;
+
+    var
+       i,j : longint;
+
+    begin
+       for i:=0 to w do
+         for j:=0 to h do
+           begin
+              textcolor(white);
+              gotoxy(i*7+1,j*2+1);
+              writeln(temp[i,j]:6:0);
+              textcolor(darkgray);
+              gotoxy(i*7+1,j*2+2);
+              writeln(phi[i,j]:6:3);
+           end;
+    end;
+
+  procedure calc_phi;
+
+    var
+       i,j : longint;
+
+    begin
+       for i:=0 to w do
+         for j:=0 to h do
+           begin
+              if (i=0) and (j=0) then
+                begin
+                   phi[i,j]:=Bi[i,j]*boundary[i,j]+0.5*temp[i,j+1]+0.5*temp[i+1,j]-(1+Bi[i,j])*temp[i,j];
+                end
+              else if (i=0) and (j=h) then
+                begin
+                   phi[i,j]:=Bi[i,j]*boundary[i,j]+0.5*temp[i,j-1]+0.5*temp[i+1,j]-(1+Bi[i,j])*temp[i,j];
+                end
+              else if (i=w) and (j=0) then
+                begin
+                   phi[i,j]:=Bi[i,j]*boundary[i,j]+0.5*temp[i,j+1]+0.5*temp[i-1,j]-(1+Bi[i,j])*temp[i,j];
+                end
+              else if (i=w) and (j=h) then
+                begin
+                   phi[i,j]:=Bi[i,j]*boundary[i,j]+0.5*temp[i,j-1]+0.5*temp[i-1,j]-(1+Bi[i,j])*temp[i,j];
+                end
+              else if i=0 then
+                begin
+                   phi[i,j]:=Bi[i,j]*boundary[i,j]+temp[i+1,j]+0.5*temp[i,j-1]+0.5*temp[i,j+1]-(2+Bi[i,j])*temp[i,j];
+                end
+              else if i=w then
+                begin
+                   phi[i,j]:=Bi[i,j]*boundary[i,j]+temp[i-1,j]+0.5*temp[i,j-1]+0.5*temp[i,j+1]-(2+Bi[i,j])*temp[i,j];
+                end
+              else if j=0 then
+                begin
+                   phi[i,j]:=Bi[i,j]*boundary[i,j]+temp[i,j+1]+0.5*temp[i-1,j]+0.5*temp[i+1,j]-(2+Bi[i,j])*temp[i,j];
+                end
+              else if j=h then
+                begin
+                   phi[i,j]:=Bi[i,j]*boundary[i,j]+temp[i,j-1]+0.5*temp[i-1,j]+0.5*temp[i+1,j]-(2+Bi[i,j])*temp[i,j];
+                end
+              else
+                phi[i,j]:=temp[i,j-1]+temp[i-1,j]-4*temp[i,j]+temp[i+1,j]+temp[i,j+1];
+           end;
+    end;
+
+  procedure adapt(i,j : longint);
+
+    begin
+       if (i=0) and (j=0) then
+         begin
+            temp[i,j]:=(Bi[i,j]*boundary[i,j]+0.5*temp[i,j+1]+0.5*temp[i+1,j])/(1+Bi[i,j]);
+         end
+       else if (i=0) and (j=h) then
+         begin
+            temp[i,j]:=(Bi[i,j]*boundary[i,j]+0.5*temp[i,j-1]+0.5*temp[i+1,j])/(1+Bi[i,j]);
+         end
+       else if (i=w) and (j=0) then
+         begin
+            temp[i,j]:=(Bi[i,j]*boundary[i,j]+0.5*temp[i,j+1]+0.5*temp[i-1,j])/(1+Bi[i,j]);
+         end
+       else if (i=w) and (j=h) then
+         begin
+            temp[i,j]:=(Bi[i,j]*boundary[i,j]+0.5*temp[i,j-1]+0.5*temp[i-1,j])/(1+Bi[i,j]);
+         end
+       else if i=0 then
+         begin
+            temp[i,j]:=(Bi[i,j]*boundary[i,j]+temp[i+1,j]+0.5*temp[i,j-1]+0.5*temp[i,j+1])/(2+Bi[i,j]);
+         end
+       else if i=w then
+         begin
+            temp[i,j]:=(Bi[i,j]*boundary[i,j]+temp[i-1,j]+0.5*temp[i,j-1]+0.5*temp[i,j+1])/(2+Bi[i,j]);
+         end
+       else if j=0 then
+         begin
+            temp[i,j]:=(Bi[i,j]*boundary[i,j]+temp[i,j+1]+0.5*temp[i-1,j]+0.5*temp[i+1,j])/(2+Bi[i,j]);
+         end
+       else if j=h then
+         begin
+            temp[i,j]:=(Bi[i,j]*boundary[i,j]+temp[i,j-1]+0.5*temp[i-1,j]+0.5*temp[i+1,j])/(2+Bi[i,j]);
+         end
+       else
+         temp[i,j]:=(temp[i,j-1]+temp[i-1,j]+temp[i+1,j]+temp[i,j+1])/4;
+       end;
+
+  var
+     iter,i,j,mi,mj : longint;
+     habs,sigma_phi : double;
+
+  begin
+     clrscr;
+     iter:=0;
+     { setup boundary conditions }
+     for i:=0 to w do
+       for j:=0 to h do
+         begin
+            if (i=0) or (i=w) then
+              bi[i,j]:=100
+            else
+              bi[i,j]:=100;
+
+            if (j=0) then
+              boundary[i,j]:=1000
+            else
+              boundary[i,j]:=300;
+         end;
+     init;
+     draw;
+     repeat
+       calc_phi;
+       mi:=0;
+       mj:=0;
+       sigma_phi:=0;
+       inc(iter);
+       habs:=abs(phi[mi,mj]);
+       for i:=0 to w do
+         for j:=0 to h do
+           begin
+              if abs(phi[i,j])>habs then
+                begin
+                   mi:=i;
+                   mj:=j;
+                   habs:=abs(phi[mi,mj]);
+                end;
+              { calculate error }
+              sigma_phi:=sigma_phi+abs(phi[i,j]);
+           end;
+       adapt(mi,mj);
+       gotoxy(1,23);
+       textcolor(white);
+       writeln(iter,' iterations, sigma_phi=',sigma_phi);
+     until {keypressed or }(sigma_phi<0.5);
+     draw;
+     gotoxy(1,23);
+     textcolor(white);
+     writeln(iter,' iterations, sigma_phi=',sigma_phi);
+     {writeln('press a key');
+     if readkey=#0 then
+       readkey;}
+  end.

tests/tbs0017.pp

@@ -0,0 +1,27 @@
+  procedure init;
+
+    var
+       endofparas : boolean;
+
+    procedure getparastring;
+
+      procedure nextopt;
+
+        begin
+           getparastring;
+           init;
+           endofparas:=false;
+        end;
+
+      begin
+         nextopt;
+      end;
+      
+    begin
+       getparastring;
+    end;      
+     
+begin
+   init;
+end.
+

tests/tbs0018.pp

@@ -0,0 +1,12 @@
+type
+   p = ^x;
+   x = byte;
+
+var
+   b : p;
+
+begin
+   new(b);
+   b^:=12;
+end.
+

tests/tbs0019.pp

@@ -0,0 +1,13 @@
+type
+   b = ^x;
+
+   x = byte;
+
+var
+   pb : b;
+
+begin
+   new(pb);
+   pb^:=10;
+end.   
+