diff --git a/tests/webtbs/tw2588.pp b/tests/webtbs/tw2588.pp new file mode 100644 index 0000000000..48b247f059 --- /dev/null +++ b/tests/webtbs/tw2588.pp @@ -0,0 +1,40 @@ +{$MODE DELPHI} +uses classes; + + +type + TNotifyEventA = procedure (Sender:TObject) of object; + TWOLBetaObject = class; + + TwolBrushes = class(TPersistent) + private + FOnChange :TNotifyEventA; + public + property OnChange :TNotifyEventA read FOnChange Write FOnChange; + end; + + + TWOLBetaObject = class(TComponent) + public + constructor Create(AOwner:TComponent); + protected + procedure DoBrushChange(Sender:TObject); + private + FBrush : TWolBrushes; + end; + + + procedure TWOLBetaObject.DoBrushChange(Sender:TObject); + var DC:longint; + begin + end; + +constructor TWOLBetaObject.Create(AOwner:TComponent); + begin + FBrush :=TWOLBrushes.Create; + FBrush.OnChange:=DoBrushChange; + end; + + +begin +end. diff --git a/tests/webtbs/tw2589.pp b/tests/webtbs/tw2589.pp new file mode 100644 index 0000000000..f21a33f517 --- /dev/null +++ b/tests/webtbs/tw2589.pp @@ -0,0 +1,51 @@ +{ Source provided for Free Pascal Bug Report 2589 } +{ Submitted by "Al Led" on 2003-07-23 } +{ e-mail: alled@volny.cz } + +{$mode objfpc} + +program Test; +uses SysUtils; + +var + __ReadData, __Calculate : boolean; + +begin + __ReadData := true; + while __ReadData do + begin + // read data from input... + __readdata:=false; + __Calculate := false; + try +// ********************************************** +// next construction with Continue statement +// causes linking error +// but only if next code contains another +// while...do loop [!!!] + + if not __Calculate then // no more calcs -> + Continue; // skip rest and read + // next data... + +// ********************************************** + + // another required operations, checks -> + // maybe __Calculate := false; + +// [!!!] + while __Calculate do + begin + // do something... -> + // -> save results... + // checks -> maybe __Calculate := false; + end; + + except + on E:exception do + raise Exception.Create('Err : ' + E.Message); + end; // try..except + + end; // while __ReadData... + +end. diff --git a/tests/webtbs/tw2594.pp b/tests/webtbs/tw2594.pp new file mode 100644 index 0000000000..3a365e2c9c --- /dev/null +++ b/tests/webtbs/tw2594.pp @@ -0,0 +1,35 @@ +{ Source provided for Free Pascal Bug Report 2594 } +{ Submitted by "Pavel V. Ozerski" on 2003-07-24 } +{ e-mail: ozerski@list.ru } +{$apptype console} +{$ifdef fpc} +{$mode delphi} +{$endif} +type + tp=procedure; +var + err : boolean; +procedure expect(l1,l2:longint); +begin + if l1<>l2 then + begin + writeln('ERROR got ',l1,' expected ',l2); + err:=true; + end + else + writeln(l1); +end; + +var + p:tp; + pp:pointer absolute p; +begin + expect(longint(@p),0); + expect(longint(@pp),longint(@@p)); + expect(longint(addr(@p)),longint(@@p)); + expect(longint(@addr(p)),longint(@@p)); + expect(longint(@(addr(p))),longint(@@p)); + expect(longint(@(@p)),longint(@@p)); + if err then + halt(1); +end. diff --git a/tests/webtbs/tw2595.pp b/tests/webtbs/tw2595.pp new file mode 100644 index 0000000000..0656a41980 --- /dev/null +++ b/tests/webtbs/tw2595.pp @@ -0,0 +1,33 @@ +{ Source provided for Free Pascal Bug Report 2595 } +{ Submitted by "Michalis Kamburelis" on 2003-07-24 } +{ e-mail: michalis@camelot.homedns.org } + +{ With fpc 1.1 (from snapshot downloaded at 23.07.2003) this program causes compilation error "Error: Wrong number of parameters specified" + near the "F(1)" statement. But you can see everything is ok and there is no error. + (Of course, this particular program would cause runtime error because F is not initialized, but it's semantically correct). + Error is only under DELPHI and TP modes. + Change declaration + TFuncByObject = function(i:Integer):boolean of object; + to + TFuncByObject = procedure(i:Integer); + (make procedure instead of a function) and everything will compile ok. + Change it to + TFuncByObject = function(i:Integer):boolean; + (no longer "by object") and again everything will compile ok. + It has to be "function" and "by object" to cause the bug. + + Observed with FPC under win32 and linux (i386). +} + +{$mode DELPHI} + +type + TFuncByObject = function(i:Integer):boolean of object; + +var F:TFuncByObject; + i : integer; +begin + i:=0; + if i=1 then + F(1); +end. diff --git a/tests/webtbs/tw2602.pp b/tests/webtbs/tw2602.pp new file mode 100644 index 0000000000..17e1c8af0a --- /dev/null +++ b/tests/webtbs/tw2602.pp @@ -0,0 +1,12 @@ +{ %version=1.1 } + +{ Source provided for Free Pascal Bug Report 2602 } +{ Submitted by "Pavel V. Ozerski" on 2003-07-25 } +{ e-mail: ozerski@list.ru } +{$ifdef FPC} +{$mode Delphi} +{$endif} +begin + with TObject.Create do + Destroy; +end. diff --git a/tests/webtbs/tw2607.pp b/tests/webtbs/tw2607.pp new file mode 100644 index 0000000000..522f052a42 --- /dev/null +++ b/tests/webtbs/tw2607.pp @@ -0,0 +1,32 @@ +{ %version=1.1 } +{ %opt=-vh } + +{ Source provided for Free Pascal Bug Report 2607 } +{ Submitted by "Will" on 2003-07-27 } +{ e-mail: oohaynotihs@yahoo.com } +Program AbstractFunctionTest; + +Type + pAbstractObject = ^AbstractObject; + AbstractObject = Object + Public + + Constructor Init; + Destructor Done; + Procedure Test; Virtual; Abstract; + End; + +Constructor AbstractObject.Init; +Begin +End; + +Destructor AbstractObject.Done; +Begin +End; + +Var + Test : ^AbstractObject; + +Begin + Test := New(pAbstractObject, Init); {Obviously, this will cause a compiler error} +End. diff --git a/tests/webtbs/tw2620.pp b/tests/webtbs/tw2620.pp new file mode 100644 index 0000000000..54694167c8 --- /dev/null +++ b/tests/webtbs/tw2620.pp @@ -0,0 +1,16 @@ +{ %version=1.1 } + +{ Source provided for Free Pascal Bug Report 2620 } +{ Submitted by "Louis Jean-Richard" on 2003-08-04 } +{ e-mail: l.jean-richard@bluewin.ch } +CONST + prime : ARRAY[1 .. 4] OF cardinal = + ( 536870909, 1073741789, 2147483647, 4294967291); +BEGIN + WriteLn( 'HIGH(cardinal) = ', HIGH(cardinal) ); + WriteLn( '4294967291 < HIGH(cardinal) ', (4294967291 < HIGH(cardinal)) , ' !?'); + if not(4294967291 < HIGH(cardinal)) then + halt(1); + WriteLn(prime[4]) +END +. diff --git a/tests/webtbs/tw2626.pp b/tests/webtbs/tw2626.pp new file mode 100644 index 0000000000..d6aa0bf9c2 --- /dev/null +++ b/tests/webtbs/tw2626.pp @@ -0,0 +1,27 @@ +{ Source provided for Free Pascal Bug Report 2626 } +{ Submitted by "Jose Santos" on 2003-08-10 } +{ e-mail: jcas@netcabo.pt } +program ShowBug(Input, Output); +{$MODE DELPHI} +type + TBug = class + public + constructor Create; overload; + constructor Create(var S: String); overload; + end; + + constructor TBug.Create; + begin + end; + + constructor TBug.Create(var S: String); + begin + S:='Test'; + end; + +var + Bug: TBug; + +begin + Bug:=TBug.Create; +end. diff --git a/tests/webtbs/tw2627.pp b/tests/webtbs/tw2627.pp new file mode 100644 index 0000000000..5c89e3296f --- /dev/null +++ b/tests/webtbs/tw2627.pp @@ -0,0 +1,18 @@ +{ Source provided for Free Pascal Bug Report 2627 } +{ Submitted by "Sergey Kosarevsky" on 2003-08-10 } +{ e-mail: netsurfer@au.ru } + +{$mode objfpc} + +Type tMyClass=Class + Procedure DoSomething;Virtual;Abstract; + Class Procedure Process(C:tMyClass); + End; + +Class Procedure tMyClass.Process(C:tMyClass); +Begin + With C Do DoSomething; +End; + +Begin +End.