From aa96e78b7c012ed1d31d5d19893909e7340d7809 Mon Sep 17 00:00:00 2001 From: peter Date: Tue, 29 Jun 2004 19:48:42 +0000 Subject: [PATCH] * new bugs --- tests/webtbf/tw3186.pp | 14 ++++++++++++++ tests/webtbs/tw3174.pp | 15 ++++++++++++++ tests/webtbs/tw3179.pp | 20 +++++++++++++++++++ tests/webtbs/tw3182.pp | 10 ++++++++++ tests/webtbs/tw3183.pp | 14 ++++++++++++++ tests/webtbs/tw3184.pp | 23 ++++++++++++++++++++++ tests/webtbs/tw3185.pp | 34 ++++++++++++++++++++++++++++++++ tests/webtbs/tw3190.pp | 27 ++++++++++++++++++++++++++ tests/webtbs/uw3179a.pp | 34 ++++++++++++++++++++++++++++++++ tests/webtbs/uw3179b.pp | 25 ++++++++++++++++++++++++ tests/webtbs/uw3184a.pp | 43 +++++++++++++++++++++++++++++++++++++++++ tests/webtbs/uw3184b.pp | 25 ++++++++++++++++++++++++ 12 files changed, 284 insertions(+) create mode 100644 tests/webtbf/tw3186.pp create mode 100644 tests/webtbs/tw3174.pp create mode 100644 tests/webtbs/tw3179.pp create mode 100644 tests/webtbs/tw3182.pp create mode 100644 tests/webtbs/tw3183.pp create mode 100644 tests/webtbs/tw3184.pp create mode 100644 tests/webtbs/tw3185.pp create mode 100644 tests/webtbs/tw3190.pp create mode 100644 tests/webtbs/uw3179a.pp create mode 100644 tests/webtbs/uw3179b.pp create mode 100644 tests/webtbs/uw3184a.pp create mode 100644 tests/webtbs/uw3184b.pp diff --git a/tests/webtbf/tw3186.pp b/tests/webtbf/tw3186.pp new file mode 100644 index 0000000000..1bd2dec29e --- /dev/null +++ b/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. \ No newline at end of file diff --git a/tests/webtbs/tw3174.pp b/tests/webtbs/tw3174.pp new file mode 100644 index 0000000000..89de6b30c2 --- /dev/null +++ b/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. diff --git a/tests/webtbs/tw3179.pp b/tests/webtbs/tw3179.pp new file mode 100644 index 0000000000..4dcb6c6726 --- /dev/null +++ b/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. diff --git a/tests/webtbs/tw3182.pp b/tests/webtbs/tw3182.pp new file mode 100644 index 0000000000..9adc9e6cf1 --- /dev/null +++ b/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. \ No newline at end of file diff --git a/tests/webtbs/tw3183.pp b/tests/webtbs/tw3183.pp new file mode 100644 index 0000000000..4442fedd52 --- /dev/null +++ b/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. + diff --git a/tests/webtbs/tw3184.pp b/tests/webtbs/tw3184.pp new file mode 100644 index 0000000000..bf69bb2545 --- /dev/null +++ b/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. diff --git a/tests/webtbs/tw3185.pp b/tests/webtbs/tw3185.pp new file mode 100644 index 0000000000..be50fd8e43 --- /dev/null +++ b/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. + diff --git a/tests/webtbs/tw3190.pp b/tests/webtbs/tw3190.pp new file mode 100644 index 0000000000..6c8b90b9db --- /dev/null +++ b/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. diff --git a/tests/webtbs/uw3179a.pp b/tests/webtbs/uw3179a.pp new file mode 100644 index 0000000000..1492ddd8a7 --- /dev/null +++ b/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. diff --git a/tests/webtbs/uw3179b.pp b/tests/webtbs/uw3179b.pp new file mode 100644 index 0000000000..cce54cda43 --- /dev/null +++ b/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. diff --git a/tests/webtbs/uw3184a.pp b/tests/webtbs/uw3184a.pp new file mode 100644 index 0000000000..139f8a9a83 --- /dev/null +++ b/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. diff --git a/tests/webtbs/uw3184b.pp b/tests/webtbs/uw3184b.pp new file mode 100644 index 0000000000..acf70af4c6 --- /dev/null +++ b/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.