Initial revision

bugs/BUG0052.PP

@@ -0,0 +1,20 @@
+const
+  Triangle: array[1..4] of PointType = ((X: 50; Y: 100), (X: 100; Y:100),
+    (X: 150; Y: 150), (X:  50; Y: 100));
+
+begin
+   graphdefaults;
+   drawpoly
+var Gd, Gm: Integer;
+begin
+  Gd := Detect;
+  InitGraph(Gd, Gm, '');
+  if GraphResult <> grOk then
+    Halt(1);
+  drawpoly(SizeOf(Triangle) div SizeOf(PointType), Triangle);
+  readln;
+  fillpoly(SizeOf(Triangle) div SizeOf(PointType), Triangle);
+  graphdefaults;
+  readln;
+  CloseGraph;
+end.

bugs/BUG0083.PP

@@ -0,0 +1,8 @@
+
+var
+   s1 : set of char;
+   c1,c2,c3 : char;
+
+begin
+   s1:=[c1..c2,c3];
+end.

bugs/bug0001.pp

@@ -0,0 +1,8 @@
+program smalltest;
+  const
+      teststr : string = ' '#9#255#0;
+begin
+      writeln(teststr);
+      teststr := 'gaga';
+      writeln(teststr);
+end.

bugs/bug0002.pp

@@ -0,0 +1,83 @@
+unit bug0002;
+
+  interface
+
+  implementation
+
+{$message starting hexstr}
+    function hexstr(val : longint;cnt : byte) : string;
+    
+      const 
+         hexval : string[16]=('0123456789ABCDEF');
+         
+      var 
+         s : string;
+         l2,i : integer;
+         l1 : longInt;
+         
+      begin
+         s[0]:=char(cnt);
+         l1:=longint($f) shl (4*(cnt-1));
+         for i:=1 to cnt do 
+           begin
+              l2:=(val and l1) shr (4*(cnt-i));
+              l1:=l1 shr 4;
+              s[i]:=hexval[l2+1];
+           end;
+         hexstr:=s;
+      end;
+
+{$message starting dump_stack}
+
+    procedure dump_stack(bp : longint);
+
+{$message starting get_next_frame}
+
+      function get_next_frame(bp : longint) : longint;
+
+        begin
+           asm
+              movl bp,%eax
+              movl (%eax),%eax
+              movl %eax,__RESULT
+           end ['EAX'];
+        end;
+
+      procedure dump_frame(addr : longint);
+
+        begin
+           { to be used by symify }
+           writeln('  0x',HexStr(addr,8));
+        end;
+
+{$message starting get_addr}
+
+      function get_addr(BP : longint) : longint;
+
+        begin
+           asm
+              movl BP,%eax
+              movl 4(%eax),%eax
+              movl %eax,__RESULT
+           end ['EAX'];
+        end;
+
+{$message starting main}
+
+      var
+         i,prevbp : longint;
+
+      begin
+         prevbp:=bp-1;
+         i:=0;
+         while bp > prevbp do
+           begin
+              dump_frame(get_addr(bp));
+              i:=i+1;
+              if i>max_frame_dump then exit;
+              prevbp:=bp;
+              bp:=get_next_frame(bp);
+           end;
+      end;
+
+end.

bugs/bug0003.pp

@@ -0,0 +1,18 @@
+unit bug0002;
+
+  interface
+
+  implementation
+
+
+    procedure dump_stack(bp : longint);
+
+      function get_next_frame(bp : longint) : longint;
+
+        begin
+        end;
+
+      begin
+      end;
+
+end.

bugs/bug0004.pp

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

bugs/bug0005.pp

@@ -0,0 +1,8 @@
+begin
+  if 1=1 then
+    begin
+    end;
+  if 1<>1 then
+    begin
+    end;
+end.

bugs/bug00051.pp

@@ -0,0 +1,6 @@
+var
+   b : boolean;
+
+begin
+  b:=1<>1;
+end.

bugs/bug0006.pp

@@ -0,0 +1,14 @@
+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)');
+end.

bugs/bug00061.pp

@@ -0,0 +1,8 @@
+var
+   r : double;
+   s : string;
+
+begin
+   r:=1234.0;
+   str(r,s);
+end.

bugs/bug0007.pp

@@ -0,0 +1,10 @@
+var
+   count : byte;
+
+begin
+   for count:=1 to 127 do
+     begin
+        writeln(count,'. loop');
+     end;
+end.
+

bugs/bug0008.pp

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

bugs/bug0009.pp

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

bugs/bug0010.pp

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

bugs/bug0011.pp

@@ -0,0 +1,13 @@
+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.
+

bugs/bug0012.pp

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

bugs/bug0013.pp

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

bugs/bug0014.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.

bugs/bug00141.pp

@@ -0,0 +1,44 @@
+
+    type
+       ttreetype = (addn,muln,subn,divn,
+                   modn,assignn,loadn,rangen,
+                   ltn,lten,gtn,gten,
+                   equaln,unequaln,inn,orn,
+                   xorn,shrn,shln,slashn,
+                   andn,subscriptn,derefn,addrn,
+                   ordconstn,typeconvn,calln,callparan,
+                   realconstn,fixconstn,umminusn,asmn,vecn,
+                   stringconstn,funcretn,selfn,
+                   notn,inlinen,niln,errorn,
+                   typen,hnewn,hdisposen,newn,
+                   simpledisposen,setelen,setconstrn,blockn,
+                   anwein,loopn,ifn,breakn,
+                   continuen,repeatn,whilen,forn,
+                   exitn,withn,casen,labeln,
+                   goton,simplenewn,tryexceptn,raisen,
+                   switchesn,tryfinallyn,isn,asn);
+
+
+       { gibt an, welche Nachfolger eines Knotens }
+       ptree = ^ttree;
+
+       ttree = record
+          left,right : ptree;
+          treetype : ttreetype;
+       end;
+   function equal_trees(t1,t2 : ptree) : boolean;
+
+     begin
+             case t1^.treetype of
+                   realconstn,fixconstn,umminusn,asmn,vecn,
+                   stringconstn,funcretn,selfn,
+                equaln,
+                unequaln:
+                   begin
+                      equal_trees:=(equal_trees(t1^.left,t2^.left) and
+                                    equal_trees(t1^.right,t2^.right)) or
+                                   (equal_trees(t1^.right,t2^.left) and
+                                    equal_trees(t1^.left,t2^.right));
+                   end;
+             end;
+     end;

bugs/bug0015.pp

@@ -0,0 +1,20 @@
+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);
+end.

bugs/bug0016.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.

bugs/bug0017.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.
+

bugs/bug0018.pp

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

bugs/bug0019.pp

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

bugs/bug0020.pp

@@ -0,0 +1,26 @@
+uses
+  Gpm;
+
+var
+  Conn: TGPMConnect;
+  Quit: Boolean;
+  Event: TGPMEvent;
+
+begin
+
+  FillChar(Conn, SizeOf(Conn), 0);
+  Conn.EventMask := GPM_MOVE+GPM_DRAG+GPM_DOWN+GPM_UP+GPM_SINGLE+GPM_DOUBLE;
+  Conn.DefaultMask := 0;
+  GPM_Open(Conn, 0);
+  WriteLn('I have opened the mouse... trying to do something tricky...');
+  Quit := False;
+  while not Quit do begin
+    GPM_GetEvent(Event);
+    WriteLn('GetEvent returned... Event.EventType=', Event.EventType);
+    if Event.EventType and GPM_BARE_EVENTS = GPM_DOWN then begin
+      WriteLn('You have pressed a mouse button...');
+      Quit := True;
+    end;
+  end;
+  GPM_Close;
+end.

bugs/bug0021.pp

@@ -0,0 +1,39 @@
+{ tests constant set evalution }
+
+var
+   a : set of byte;
+
+const
+   b : set of byte = [0..255]+[9];
+
+type
+   tcommandset = set of byte;
+
+const
+cmZoom = 10;
+cmClose = 5;
+cmResize = 8;
+cmNext = 12;
+cmPrev = 15;
+
+CONST
+   CurCommandSet : TCommandSet = ([0..255] -
+        [cmZoom, cmClose, cmResize, cmNext, cmPrev]);
+   commands : tcommandset = [];
+
+var
+   CommandSetChanged : boolean;
+
+PROCEDURE DisableCommands (Commands: TCommandSet);
+
+   BEGIN
+      {$IFNDEF PPC_FPK}                                  { FPK bug }
+      CommandSetChanged := CommandSetChanged OR
+        (CurCommandSet * Commands <> []);                { Set changed flag }
+      {$ENDIF}
+      CurCommandSet := CurCommandSet - Commands;         { Update command set }
+   END;
+
+begin
+   a:=[byte(1)]+[byte(2)];
+end.

bugs/bug0022.pp

@@ -0,0 +1,29 @@
+type
+   tobject = object
+      procedure x;
+      constructor c;
+   end;
+
+procedure a;
+
+  begin
+  end;
+
+procedure tobject.x;
+
+  begin
+  end;
+
+constructor tobject.c;
+
+  begin
+  end;
+
+var
+   p : pointer;
+
+begin
+   p:=@a;
+   p:=@tobject.x;
+   p:=@tobject.c;
+end.

bugs/bug0023.pp

@@ -0,0 +1,47 @@
+type
+   tobject = object
+      a : longint;
+      procedure t1;
+      procedure t2;virtual;
+      constructor init;
+   end;
+
+procedure tobject.t1;
+
+  procedure nested1;
+
+    begin
+       writeln;
+       a:=1;
+    end;
+
+  begin
+  end;
+
+procedure tobject.t2;
+
+  procedure nested1;
+
+    begin
+       writeln;
+       a:=1;
+    end;
+
+  begin
+  end;
+
+constructor tobject.init;
+
+  procedure nested1;
+
+    begin
+       writeln;
+       a:=1;
+    end;
+
+  begin
+  end;
+
+
+begin
+end.

bugs/bug0024.pp

@@ -0,0 +1,24 @@
+
+type
+  charset=set of char;
+
+  trec=record
+     junk : array[1..32] of byte;
+     t    : charset;
+  end;
+
+  var
+     tr    : trec;
+     tp    : ^trec;
+
+
+  procedure Crash(const k:charset);
+
+    begin
+       tp^.t:=[#7..#10]+k;
+    end;
+
+  begin
+     tp:=@tr;
+     Crash([#20..#32]);
+  end.

bugs/bug0025.pp

@@ -0,0 +1,15 @@
+procedure p1;
+type
+  datetime=record
+    junk : string;
+end;
+var
+  dt : datetime;
+begin
+  fillchar(dt,sizeof(dt),0);
+end;
+
+begin
+  P1;
+end.
+

bugs/bug0026.pp

@@ -0,0 +1,22 @@
+const
+  HexTbl : array[0..15] of char=('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
+function HexB(b:byte):string;
+begin
+  HexB[0]:=#2;
+  HexB[1]:=HexTbl[b shr 4];
+  HexB[2]:=HexTbl[b and $f];
+end;
+
+
+
+function HexW(w:word):string;
+begin
+  HexW:=HexB(w shr 8)+HexB(w and $ff);
+end;
+
+
+
+begin
+  HexW($fff);
+end.
+

bugs/bug0027.pp

@@ -0,0 +1,5 @@
+type enumtype = (One, two, three, forty:=40, fifty);
+
+begin
+end.
+

bugs/bug0028.pp

@@ -0,0 +1,10 @@
+type
+   enumtype = (a);
+
+var
+   e : enumtype;
+
+begin
+   writeln(ord(e));
+end.
+

bugs/bug0029.pp

@@ -0,0 +1,10 @@
+type
+  TA = object
+  end;
+
+var
+   P: Pointer;
+
+begin
+   P := pointer(TypeOf(TA));
+end.

bugs/bug0030.pp

@@ -0,0 +1,6 @@
+const
+   a : array[0..1] of real = (1,1);
+
+begin
+end.
+

bugs/bug0031.pp

@@ -0,0 +1,8 @@
+var
+   a : array[boolean] of longint;
+
+begin
+   a[true]:=1234;
+   a[false]:=123;
+end.
+

bugs/bug0032.pp

@@ -0,0 +1,6 @@
+var
+   p : procedure(w : word);
+
+begin
+   p(1234);
+end.

bugs/bug0033.pp

@@ -0,0 +1,13 @@
+var
+   p1 : pchar;
+   p2 : array[0..10] of char;
+   s : string;
+   c : char;
+
+begin
+   p1:='c';
+   s:='c';
+   { this isn't allowed
+   p1:=c;
+   }
+end.

bugs/bug0034.pp

@@ -0,0 +1,12 @@
+begin
+   asm
+      movl %eax,%eax
+      movl %eax,%eax
+      movl %eax,%eax
+      movl %eax,%eax
+      movl %eax,%eax
+      movl %eax,%eax
+      movl %eax,%eax
+   end ;
+   i:=0;
+end.

bugs/bug0035.pp

@@ -0,0 +1,13 @@
+program bug0035;
+
+{Discovered by Daniel Mantione.}
+
+label	hallo;
+
+begin
+   writeln('Hello');
+  begin
+hallo:		{Error message: Incorrect expression.}
+  end;
+  writeln('Hello again');
+end.

bugs/bug0036.pp

@@ -0,0 +1,9 @@
+program bug0036;
+
+{Discovered by Daniel Mantione.}
+
+var	a:array[0..31] of char;
+
+begin
+   a:=' ';	{Incorrect Pascal statement, but why a protection error?}
+end.

bugs/bug0037.pp

@@ -0,0 +1,17 @@
+uses
+   graph,crt;
+
+var
+   gd,gm : integer;
+
+begin
+   gd:=detect;
+   initgraph(gd,gm,'');
+   line(1,1,100,100);
+   readkey;
+   setgraphmode($107);
+   line(100,100,1024,800);
+   readkey;
+   closegraph;
+end.
+   

bugs/bug0038.pp

@@ -0,0 +1,5 @@
+CONST ps : ^STRING = nil;
+
+begin
+end.
+

bugs/bug0039.pp

@@ -0,0 +1,10 @@
+VAR a : BYTE;
+BEGIN
+  a := 1;
+  IF a=0 THEN
+    IF a=1 THEN a:=2
+    ELSE
+  ELSE a:=3;        { "Illegal expression" }
+END.
+
+

bugs/bug0040.pp

@@ -0,0 +1,26 @@
+{ xor operator bug                }
+{ needs fix in pass_1.pas line    }
+{ 706. as well as in the code     }
+{ generator - secondadd()         }
+var
+ b1,b2: boolean;
+Begin
+  b1:=true;
+  b2:=false;
+  If (b1 xor b2) Then
+  begin
+  end
+  else
+    begin
+       writeln('Problem with bool xor');
+       halt;
+    end;
+  b1:=true;
+  b2:=true;
+  If (b1 xor b2) Then
+    begin
+       writeln('Problem with bool xor');
+       halt;
+    end;
+  writeln('No problem found');
+end.

bugs/bug0041.pp

@@ -0,0 +1,8 @@
+var
+ b1: boolean;
+Begin
+  begin
+     If b1 then      { illegal expression }
+  end;
+  while b1 do
+End.

bugs/bug0042.pp

@@ -0,0 +1,10 @@
+Program SomeCrash;
+{ with pp -TDOS -Rintel bug0042.pp              }
+{ I'll try to fix this for next release -- Carl }
+
+Begin
+ asm
+   mov ax,3*-4     { evaluator stack underflow }
+ end;              { due to two operators following each other }
+end.               { this will also happen in att syntax.       }
+

bugs/bug0043.pp

@@ -0,0 +1,32 @@
+{ THE OUTPUT is incorrect but the }
+{ parsing is correct.             }
+{ under nasm output only.         }
+{ works correctly under tasm/gas  }
+{ other problems occur with other }
+{ things in math.inc              }
+{ pp -TDOS -Ratt -Anasm bug0043.pp }
+    procedure frac;
+
+      begin
+	 asm
+	    subl $16,%esp
+	    fnstcw -4(%ebp)
+	    fwait                    { unknown instruction }
+	    movw -4(%ebp),%cx
+	    orw $0x0c3f,%cx
+	    movw %cx,-8(%ebp)
+	    fldcw -8(%ebp)
+	    fwait                    { unknown instruction }
+	    fldl 8(%ebp)
+	    frndint
+	    fsubl 8(%ebp)
+	    fabsl
+	    fclex
+	    fldcw -4(%ebp)
+	    leave
+	    ret $8
+	 end ['ECX'];
+      end;
+
+Begin
+end.

bugs/bug0044.pp

@@ -0,0 +1,16 @@
+ { Problem with nested comments -- as you can probably see } 
+ { but it does give out kind of a funny error output :)    }
+
+ 
+ {$UNDEF VP}
+
+ {$IFDEF Windows} ssss {$ENDIF}      {No Syntax Error}
+
+ {$IFDEF VP}
+      {$D+}{$R+}
+ {$ELSE}
+   {$IFDEF Windows} ssss {$ENDIF}    {Syntax Error at: Col 25 }
+ {$ENDIF}
+
+ BEGIN
+ END.

bugs/bug0045.pp

@@ -0,0 +1,26 @@
+
+TYPE
+  tmyexample =object
+  public
+   constructor init;
+   destructor done; virtual;
+  private
+   procedure mytest;virtual;       { syntax error --> should give only a 
+warning ? }
+  end;
+
+  constructor tmyexample.init;
+  begin
+  end;
+
+  destructor tmyexample.done;
+  Begin
+  end;
+
+  procedure tmyexample.mytest;
+  begin
+  end;
+
+Begin
+end.
+    

bugs/bug0046.pp

@@ -0,0 +1,43 @@
+program test;
+
+{$ifdef fpk}
+{$ifdef go32v2}
+uses
+   dpmiexcp;
+{$endif}
+{$endif}
+
+type byteset = set of byte;
+     bl = record i,j : longint;
+          end;
+const set1 : byteset = [1,50,220];
+      set2 : byteset = [55];
+var i : longint;
+    b : bl;
+
+    function bi : longint;
+
+    begin
+       bi:=b.i;
+    end;
+
+begin
+set1:=set1+set2;
+writeln('set 1 = [1,50,55,220]');
+i:=50;
+if i in set1 then writeln(i,' is in set1');
+i:=220;
+if i in set1 then writeln(i,' is in set1');
+i:=$100+220;
+if i in set1 then writeln(i,' is in set1');
+i:=-35;
+if i in set1 then writeln(i,' is in set1');
+b.i:=50;
+i:=$100+220;
+if i in [50,220] then writeln(i,' is in [50,220]');
+if Bi in [50,220] then writeln(b.i,' is in [50,220]');
+b.i:=220;
+if bi in [50,220] then writeln(b.i,' is in [50,220]');
+B.i:=-36;
+if bi in [50,220] then writeln(B.i,' is in [50,220]');
+end.

bugs/bug0047.pp

@@ -0,0 +1,13 @@
+procedure test;
+
+  begin
+  end;
+
+var
+   p1 : procedure;
+   p2 : pointer;
+
+begin
+   p1:=@test;
+   p2:=@test;
+end.

bugs/bug0048.pp

@@ -0,0 +1,26 @@
+uses
+   graph,crt;
+
+var
+   gd,gm : integer;
+   i,size : longint;
+   p : pointer;
+
+begin
+   gd:=detect;
+   initgraph(gd,gm,'');
+   line(0,0,getmaxx,0);
+   readkey;
+   size:=imagesize(0,0,getmaxx,0);
+   getmem(p,size);
+   getimage(0,0,getmaxx,0,p^);
+   cleardevice;
+   for i:=0 to getmaxy do
+     begin
+        putimage(0,i,p^,xorput);
+        putimage(0,i,p^,xorput);
+     end;
+   readkey;
+   closegraph;
+end.
+   

bugs/bug0049.pp

@@ -0,0 +1,6 @@
+type
+   days = (Mon,Tue,Wed,Thu,Fri,Sat,Sun);
+   weekend = Sat..Sun;
+
+begin
+end.

bugs/bug0050.pp

@@ -0,0 +1,9 @@
+function Append : Boolean;
+
+      procedure DoAppend;
+        begin
+           Append := true;
+        end;
+
+begin
+end.

bugs/bug0051.pp

@@ -0,0 +1,31 @@
+program TestPutP;
+
+uses  crt,graph;
+
+var   gd,gm,gError,yi,i : integer;
+      col: longint;
+BEGIN
+  gm:=$111;   {640x480/64K  HiColor}
+  gd:=$FF;
+
+  InitGraph(gd,gm,'');
+  gError := graphResult;
+  IF gError <> grOk
+  THEN begin
+    writeln ('graphDriver=',gd,'  graphMode=',gm,
+    #13#10'Graphics error: ',gError);
+    halt(1);
+  end;
+
+  for i := 0 to 255
+  do begin
+    col := i shl 16 + (i div 2) shl 8 + (i div 3);
+    for yi := 0 to 20 do
+      PutPixel (i,yi,col);
+    SetColor (col);
+    Line (i,22,i,42);
+  end;
+  readkey;
+
+  closegraph;
+END.

bugs/bug0053.pp

@@ -0,0 +1,15 @@
+procedure abc(var a : array of char);
+
+  begin
+     // error: a:='asdf';
+  end;
+
+var
+   c : array[0..10] of char;
+
+begin
+   abc(c);
+   writeln(c);
+   // error: writeln(a);
+end.
+   

bugs/bug0054.pp

@@ -0,0 +1,6 @@
+var
+   wb : wordbool;
+   wl : longbool;
+
+begin
+end.

bugs/bug0055.pp

@@ -0,0 +1,15 @@
+type
+   tarraysingle = array[0..1] of single;
+
+procedure test(var a : tarraysingle);
+
+var   
+   i,j,k : integer;
+
+begin
+   a[i]:=a[j]-a[k];
+end;
+
+begin
+end.
+

bugs/bug0056.pp

@@ -0,0 +1,14 @@
+PROGRAM ShowBug;
+
+(* This will compile
+VAR N, E: Integer;*)
+
+(* This will NOT compile*)
+VAR N, E: LongInt;
+
+BEGIN
+   E := 2;
+   WriteLn(E);
+   N := 44 - E;
+   WriteLn(N);
+END.

bugs/bug0057.pp

@@ -0,0 +1,18 @@
+uses
+   graph,crt;
+        
+var
+   gd,gm : integer;
+
+begin
+   gd:=detect;
+   gm:=$103;
+   initgraph(gd,gm,'');
+   line(1,1,100,100);
+   readkey;
+   closegraph;
+   initgraph(gd,gm,'');
+   line(100,100,1,100);
+   readkey;
+   closegraph;
+end.

bugs/bug0058.pp

@@ -0,0 +1,9 @@
+{$r+}
+var
+   a1 : array[0..1,0..1] of word;
+   a2 : array[0..1,0..1] of longint;
+   i,j,l,n : longint;
+
+begin
+   a1[i,j]:=a2[l,n];
+end.

bugs/bug0059.pp

@@ -0,0 +1,9 @@
+Program ConstBug;
+
+Const
+ S = ord('J');
+ t: byte = ord('J');
+
+
+Begin
+end.

bugs/bug0060.pp

@@ -0,0 +1,21 @@
+Program Test;
+
+{ No errors -- problems is due to the fact that the rules for type 
+compatibility (p.47 language guide) -- are not respected, in other words 
+in case statements there is no type checking whatsoever in fpc!!
+ I think that these are separate cases:
+   1st case) s32bit,u32bit,u8bit,s8bit,s16bit,u16bit
+   2nd case) uchar
+   3rd case) bool8bit
+These are not /should not be compatible with each other in a case 
+statement imho - CEC 
+}
+
+var
+ myvar:char;
+Begin
+ case myvar of
+ 1: ;
+ #2: ;
+ end;
+end.

bugs/bug0061.pp

@@ -0,0 +1,3 @@
+Begin
+ 55ms;
+end.

bugs/bug0062.pp

@@ -0,0 +1,9 @@
+Program Bug0062;
+
+
+var
+ myvar:boolean;
+Begin
+ { by fixing this we also start partly implementing LONGBOOL/WORDBOOL }
+ myvar:=boolean(1);      { illegal type conversion }
+end.

bugs/bug0063.pp

@@ -0,0 +1,13 @@
+{ may also crash/do weird error messages with the compiler }
+var
+ min: char;
+ max: char;
+ i: char;
+begin
+ min:='c';
+ max:='z';
+ if i in [min..max] then
+ Begin
+ end;
+end.
+

bugs/bug0064.pp

@@ -0,0 +1,15 @@
+var
+ i: byte;
+ j: integer;
+ c: char;
+Begin
+  case i of
+  Ord('x'): ;
+  end;
+  case j of
+  Ord('x'): ;
+  end;
+  case c of
+  Chr(112): ;
+  end;
+end.

bugs/bug0065.pp

@@ -0,0 +1,10 @@
+Program Example27;
+
+{ Program to demonstrate the Frac function. }
+
+Var R : Real;
+
+begin
+  Writeln (Frac (123.456):0:3);  { Prints  O.456 }
+  Writeln (Frac (-123.456):0:3); { Prints -O.456 }
+end.

bugs/bug0066.pp

@@ -0,0 +1,10 @@
+Program Example54;
+
+{ Program to demonstrate the Round function. }
+
+begin
+  Writeln (Round(123.456));  { Prints 124  }
+  Writeln (Round(-123.456)); { Prints -124 }
+  Writeln (Round(12.3456));  { Prints 12   }
+  Writeln (Round(-12.3456)); { Prints -12  }
+end.

bugs/bug0067.pp

@@ -0,0 +1,18 @@
+unit bug0067;
+
+interface
+
+type
+  tlong=record
+    a : longint;
+  end;
+
+procedure p(var t:tlong);
+
+implementation
+
+procedure p(var t:tlong);
+begin
+end;
+
+end.

bugs/bug0067b.pp

@@ -0,0 +1,27 @@
+unit bug0067b;
+
+interface
+
+
+type
+  tlong=record
+    a : longint;
+  end;
+
+procedure p(var l:tlong);
+
+implementation
+
+uses bug0067;
+
+{ the tlong parameter is taken from unit bug0067,
+  and not from the interface part of this unit.
+  setting the uses clause in the interface part 
+  removes the problem }
+
+procedure p(var l:tlong);
+begin
+  bug0067.p(bug0067.tlong(l));
+end;
+
+end.

bugs/bug0068.pp

@@ -0,0 +1,9 @@
+program bug0068;
+
+var
+  p : pointer;
+  l  : longint;
+begin
+  l:=Ofs(p); { Ofs returns a pointer type !? }
+  
+end.

bugs/bug0069.pp

@@ -0,0 +1,25 @@
+Unit bug0068;
+
+Interface
+
+Procedure MyTest;Far;         { IMPLEMENTATION expected error. }
+
+{ Further information: NEAR IS NOT ALLOWED IN BORLAND PASCAL  }
+{ Therefore the bugfix should only be for the FAR keyword.    }
+(* Procedure MySecondTest;Near;                             *)
+
+Implementation
+
+{ near and far are not allowed here, but maybe we don't care since they are ignored by }
+{ FPC.                                                                                 }
+Procedure MyTest;
+Begin
+end;
+
+Procedure MySecondTest;
+Begin
+end;
+
+
+
+end.

bugs/bug0070.pp

@@ -0,0 +1,10 @@
+Program Test;
+
+type
+  myenum = (YES,NO,MAYBE);
+var
+ myvar:set of myenum;
+Begin
+ Include(myvar,Yes);
+ Exclude(myvar,No);
+end.

bugs/bug0071.pp

@@ -0,0 +1,5 @@
+program bug71;
+
+begin
+  writeln ('
+end.

bugs/bug0072.pp

@@ -0,0 +1,15 @@
+type
+   tarraysingle = array[0..1] of single;
+
+procedure test(var a : tarraysingle);
+
+var   
+   i,j,k : integer;
+
+begin
+   a[i]:=a[j]-a[k];
+end;
+
+begin
+end.
+

bugs/bug0073.pp

@@ -0,0 +1,30 @@
+Unit bug0068;
+
+Interface
+
+
+Procedure MyTest;Far;         { IMPLEMENTATION expected error. }
+
+{ Further information: NEAR IS NOT ALLOWED IN BORLAND PASCAL  }
+{ Therefore the bugfix should only be for the FAR keyword.    }
+ Procedure MySecondTest;
+
+Implementation
+
+{ near and far are not allowed here, but maybe we don't care since they are ignored by }
+{ FPC.                                                                                 }
+Procedure MyTest;
+Begin
+end;
+
+
+
+Procedure MySecondTest;Far;
+Begin
+end;
+
+
+
+
+
+end.

bugs/bug0074.pp

@@ -0,0 +1,28 @@
+type
+  tmyobject = object
+    constructor init;
+    procedure callit; virtual;
+    destructor done; virtual;
+  end;
+
+
+  constructor tmyobject.init;
+  Begin
+  end;
+
+  destructor tmyobject.done;
+  Begin
+  end;
+
+  procedure tmyobject.callit;
+  Begin
+   WriteLn('Hello...');
+  end;
+
+  var
+   obj: tmyobject;
+  Begin
+    obj.init;
+    obj.callit;
+{    obj.done;}
+  end.

bugs/bug0075.pp

@@ -0,0 +1,31 @@
+Unit bug0068;
+
+Interface
+
+
+Procedure MyTest;Far;         { IMPLEMENTATION expected error. }
+
+{ Further information: NEAR IS NOT ALLOWED IN BORLAND PASCAL  }
+{ Therefore the bugfix should only be for the FAR keyword.    }
+ Procedure MySecondTest;
+
+Implementation
+
+{ near and far are not allowed here, but maybe we don't care since they are ignored by }
+{ FPC.                                                                                 }
+Procedure MyTest;
+Begin
+end;
+
+Procedure MySecondTest;Far;Forward;
+
+
+Procedure MySecondTest;Far;
+Begin
+end;
+
+
+
+
+
+end.

bugs/bug0076.pp

@@ -0,0 +1,24 @@
+program bug0076;
+
+{Generates wrong code when compiled with output set to intel asm.
+
+ Reported from mailinglist by Vtech Kavan.
+ 
+ 15 Januari 1998, Daniel Mantione}
+
+type  TVtx2D = record x,y:longint end;
+
+var  Vtx2d:array[0..2] of TVtx2D;
+
+function SetupScanLines(va,vb,vc:word):single;
+var dx3d,dx2d,dy2d,dz,ex3d,ex2d,ez:longint;
+    r:single;
+begin
+ dy2d := Vtx2d[vb].y;
+ r    := (dy2d-Vtx2d[va].y);     {this line causes error!!!!!!!!!!!!!!!!!!!}
+end;
+
+begin
+ SetupScanLines(1,2,3);
+end.
+

bugs/bug0077.pp

@@ -0,0 +1,9 @@
+uses
+   bug0077b;
+
+begin
+   b:=89;
+   writeln(a);
+end.
+
+

bugs/bug0077b.pp

@@ -0,0 +1,11 @@
+unit bug0077b;
+
+  interface
+
+    var
+       a : longint;
+       b : longint absolute a;
+
+  implementation
+
+end.

bugs/bug0078.pp

@@ -0,0 +1,7 @@
+{ shows error with asm_size_mismatch }
+Begin
+ asm
+   mov eax, 2147483647 
+   mov eax, 2000000000
+ end;
+end.

bugs/bug0079.pp

@@ -0,0 +1,18 @@
+
+procedure nothing(x,y: longint);assembler;
+asm
+  mov eax,x
+  mov ebx,y
+end;
+
+
+{procedure nothing(x,y: longint);
+begin
+ asm
+  mov eax,x
+  mov ebx,y
+ end;
+end; }
+
+Begin
+end.

bugs/bug0080.pp

@@ -0,0 +1,8 @@
+program bug0080;
+
+type 
+
+ tHugeArray = array [ 1 .. High(Word) ] of byte;
+
+begin
+end.

bugs/bug0081.pp

@@ -0,0 +1,7 @@
+program bug0081;
+
+const
+   EOL : array [1..2] of char = #13 + #10;
+   
+begin
+end.

bugs/bug0082.pp

@@ -0,0 +1,29 @@
+Unit bug0083;
+
+interface
+
+Type T = OBject
+      Constructor Init;
+      Destructor Free; virtual;
+      Destructor Destroy; virtual;
+      end;
+      
+implementation
+      
+constructor T.INit;
+
+begin
+end;
+
+Destructor t.Free;
+
+begin
+end;
+
+Destructor t.Destroy;
+
+begin
+end;
+
+
+end.

bugs/bug0084.pp

@@ -0,0 +1,13 @@
+
+{ Basic Pascal principles gone done the drain... !!!! }
+var
+ v: word;
+ w: shortint;
+ z: byte;
+ y: integer;
+Begin
+ y:=64000;
+ z:=32767;
+ w:=64000;
+ v:=-1;
+end.

bugs/bug0085.pp

@@ -0,0 +1,3 @@
+Begin
+ writeln(l);
+end.

bugs/bug0086.pp

@@ -0,0 +1,15 @@
+
+var
+ v: word;
+ w: shortint;
+ z: byte;
+ y: integer;
+
+type
+ zz: shortint = 255;  
+Begin
+ y:=64000;
+ z:=32767;
+ w:=64000;
+ v:=-1;
+end.

bugs/bug0087.pp

@@ -0,0 +1,15 @@
+{
+  BP Error message is 'Pointer variable Expected'
+}
+type
+  tobj=object
+    l : longint;
+    constructor init;
+  end;
+var
+  o : tobj;
+begin
+  new(o);            {This will create a internal error 9999}
+  new(o,init);       {This will create a Segfault and Core Dump under linux}
+end.
+    

bugs/bug0088.pp

@@ -0,0 +1,3 @@
+Begin
+ typeof(x1);    { Gives out an internal error -- better then 9999 though }
+end.

bugs/bug0089.pp

@@ -0,0 +1,3 @@
+Begin
+ sizeof(x);
+end.

bugs/bug0090.pp

@@ -0,0 +1,9 @@
+{$X+}
+var
+ mystr : array[0..3] of char;
+
+Begin
+  if mystr = #0#0#0#0 then
+  Begin
+  end;
+end.

bugs/bug0091.pp

@@ -0,0 +1,23 @@
+{ Page 22 of The Language Guide of Turbo Pascal }
+var
+ t: byte;
+const
+  a = Trunc(1.3);
+  b = Round(1.6);
+  c = abs(-5);
+  ErrStr = 'Hello!';
+  d = Length(ErrStr);
+  e = Lo($1234);
+  f = Hi($1234);
+  g = Chr(34);
+  h = Odd(1);
+  i = Ord('3');
+  j = Pred(34);
+  l = Sizeof(t);
+  m = Succ(9);
+  n = Swap($1234);
+  o = ptr(0,0);
+Begin
+end.
+
+

bugs/bug0092.pp

@@ -0,0 +1,11 @@
+program bug;
+
+{The unfixable bug. Maybe we get an idea when we keep looking at it.
+
+ Daniel Mantione 5 februari 1998.}
+
+var	a:1..4=2;		{Crash 1.}
+   	b:set of 1..4=[2,3];	{Also crashes, but is the same bug.}
+
+begin
+end.

bugs/bug0093.pp

@@ -0,0 +1,18 @@
+{ Two cardinal type bugs }
+var
+  c : cardinal;
+  l : longint;
+  b : byte;
+  s : shortint;
+  w : word;
+begin
+  b:=123;
+  w:=s;
+  l:=b;
+  c:=b;		{generates movzbl %eax,%edx instead of movzbl %al,%edx}
+
+  c:=123;
+  writeln(c);	{Shows '0' outline right! instead of '123' outlined left}
+  c:=$7fffffff;
+  writeln(c);	{Shows '0' outline right! instead of '123' outlined left}
+end.

bugs/bug0094.pp

@@ -0,0 +1,5 @@
+begin
+  case textrec(l).mode of
+   1 ;
+  end;
+end.

bugs/bug0095.pp

@@ -0,0 +1,15 @@
+var
+  ch : char;
+begin
+  ch:=#3;
+  case ch of
+   #0..#31 : ;
+  else
+   writeln('bug');
+  end;
+  case ch of
+   #0,#1,#3 : ;
+  else
+   writeln('bug');
+  end;
+end.