* new bugs

tests/webtbf/tw3186.pp

@@ -0,0 +1,14 @@
+{ %fail }
+
+{ Source provided for Free Pascal Bug Report 3186 }
+{ Submitted by "Sergey Kosarevsky" on  2004-06-25 }
+{ e-mail: netsurfer@au.ru }
+
+{$mode objfpc}
+
+Type tMyType=Class
+     End;
+
+Begin
+   If Assigned(tMyType) Then;
+End.

tests/webtbs/tw3174.pp

@@ -0,0 +1,15 @@
+{ Source provided for Free Pascal Bug Report 3174 }
+{ Submitted by "C Western" on  2004-06-19 }
+{ e-mail: mftq75@dsl.pipex.com }
+program test;
+
+procedure Mumble(s: PChar);
+begin
+  WriteLn(s^);
+  if s^<>'A' then
+    halt(1);
+end;
+
+begin
+  Mumble('A');
+end.

tests/webtbs/tw3179.pp

@@ -0,0 +1,20 @@
+{ Source provided for Free Pascal Bug Report 3179 }
+{ Submitted by "Martin Schreiber" on  2004-06-21 }
+{ e-mail:  }
+{$mode objfpc}{$H+}
+
+uses
+  uw3179a,uw3179b;
+
+var
+ class1: tclass1;
+ class2: tclass2;
+
+begin
+ class1:= tclass1.create;
+ class1.proc1;             //ok
+ class1.free;
+ class2:= tclass2.create;
+ class2.proc2;             //abstracterror in tclass1.proc1
+ class2.free;
+end.

tests/webtbs/tw3182.pp

@@ -0,0 +1,10 @@
+{ Source provided for Free Pascal Bug Report 3182 }
+{ Submitted by "Michalis Kamburelis" on  2004-06-22 }
+{ e-mail: michalis@camelot.homedns.org }
+{$Y+,L+}
+
+unit tw3182;
+
+interface
+implementation
+end.

tests/webtbs/tw3183.pp

@@ -0,0 +1,14 @@
+{$ifdef fpc}{$mode delphi}{$endif}
+
+type
+  IA=interface
+   function copy:String;
+  end;
+
+  IB=interface(IA)
+   function copy:integer;
+  end;
+
+begin
+end.
+

tests/webtbs/tw3184.pp

@@ -0,0 +1,23 @@
+{ Source provided for Free Pascal Bug Report 3184 }
+{ Submitted by "Martin Schreiber" on  2004-06-25 }
+{ e-mail:  }
+
+{$ifdef fpc}{$mode objfpc}{$H+}{$endif}
+
+uses
+  uw3184a,uw3184b;
+
+var
+ class1: tclass1;
+ class2: tclass2;
+
+begin
+ class1:= tclass1.create;
+ if class1.proc1<>10 then
+   halt(1);      //exp: 'tclass1.proc' act: 'tclass1.proc' -> ok
+ class1.free;
+ class2:= tclass2.create;
+ if class2.proc2<>10 then
+   halt(1);      //exp: 'tclass1.proc' act: 'tclass0.proc' -> error
+ class2.free;
+end.

tests/webtbs/tw3185.pp

@@ -0,0 +1,34 @@
+{ Source provided for Free Pascal Bug Report 3185 }
+{ Submitted by "Martin Schreiber" on  2004-06-25 }
+{ e-mail:  }
+program project1;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes;
+type
+ enum1ty = (a1,b1,c1,d1);
+ set1ty = set of enum1ty;
+ enum2ty = (a2=ord(a1),b2=ord(b1),c2=ord(c1),d2=ord(d1),e2);
+ set2ty = set of enum2ty;
+
+procedure proc(aset: set2ty);
+begin
+ if aset = [b2] then begin
+  writeln(longword(aset),' ok');
+ end
+ else begin
+  writeln(longword(aset),' error');
+  halt(1);
+ end;
+end;
+
+var
+ en1: enum1ty;
+
+begin
+ en1:= b1;
+ proc(set2ty(longword([en1]))); //exp: 2 ok act: 1 error
+end.
+

tests/webtbs/tw3190.pp

@@ -0,0 +1,27 @@
+{ Source provided for Free Pascal Bug Report 3190 }
+{ Submitted by "Martin Schreiber" on  2004-06-28 }
+{ e-mail:  }
+program test;
+
+{$mode delphi}
+
+uses
+ TypInfo,Classes;
+var
+ po1: ptypeinfo;
+begin
+ po1:= typeinfo(tcomponent);   //compile error: 'Illegal parameter list'
+ if po1 <> nil then begin      //compiles on kylix, result: 'TComponent'
+  writeln(po1^.name);
+ end
+ else begin
+  writeln('typeinfo(tcomponent) = nil');
+ end;
+ po1:= typeinfo(tobject);      //compile error: 'Illegal parameter list'
+ if po1 <> nil then begin      //compiles on kylix, result: 'TObject'
+  writeln(po1^.name);
+ end
+ else begin
+  writeln('typeinfo(tobject) = nil');
+ end;
+end.

tests/webtbs/uw3179a.pp

@@ -0,0 +1,34 @@
+{ Source provided for Free Pascal Bug Report 3179 }
+{ Submitted by "Martin Schreiber" on  2004-06-21 }
+{ e-mail:  }
+unit uw3179a;
+
+{$mode objfpc}{$H+}
+
+interface
+
+type
+ tclass0 = class
+  private
+   procedure proc; virtual; abstract;
+ end;
+
+ tclass1 = class(tclass0)
+  private
+   procedure proc; override;
+  public
+   procedure proc1;
+ end;
+
+implementation
+
+procedure tclass1.proc;
+begin
+end;
+
+procedure tclass1.proc1;
+begin
+ proc;
+end;
+
+end.

tests/webtbs/uw3179b.pp

@@ -0,0 +1,25 @@
+{ Source provided for Free Pascal Bug Report 3179 }
+{ Submitted by "Martin Schreiber" on  2004-06-21 }
+{ e-mail:  }
+unit uw3179b;
+
+{$mode objfpc}{$H+}
+
+interface
+uses
+ uw3179a;
+ 
+type
+ tclass2 = class(tclass1)
+  public
+   procedure proc2;
+ end;
+
+implementation
+
+procedure tclass2.proc2;
+begin
+ proc1;
+end;
+
+end.

tests/webtbs/uw3184a.pp

@@ -0,0 +1,43 @@
+{ Source provided for Free Pascal Bug Report 3184 }
+{ Submitted by "Martin Schreiber" on  2004-06-25 }
+{ e-mail:  }
+unit uw3184a;
+
+{$ifdef fpc}{$mode objfpc}{$H+}{$endif}
+
+interface
+
+
+type
+ tclass0 = class
+  private
+   function proc:longint; virtual;
+ end;
+
+ tclass1 = class(tclass0)
+  protected   //same behaviour if private
+   function proc:longint override;
+  public
+   function proc1:longint;
+ end;
+
+implementation
+
+function tclass0.proc:longint;
+begin
+ writeln('tclass0.proc');
+ result:=0;
+end;
+
+function tclass1.proc:longint;
+begin
+ writeln('tclass1.proc');
+ result:=10;
+end;
+
+function tclass1.proc1:longint;
+begin
+ result:=proc;
+end;
+
+end.

tests/webtbs/uw3184b.pp

@@ -0,0 +1,25 @@
+{ Source provided for Free Pascal Bug Report 3184 }
+{ Submitted by "Martin Schreiber" on  2004-06-25 }
+{ e-mail:  }
+unit uw3184b;
+
+{$ifdef fpc}{$mode objfpc}{$H+}{$endif}
+
+interface
+uses
+ uw3184a;
+
+type
+ tclass2 = class(tclass1)
+  public
+   function proc2:longint;
+ end;
+
+implementation
+
+function tclass2.proc2:longint;
+begin
+ result:=proc1;
+end;
+
+end.