* new bugs

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.

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: [email protected] }
+
+{$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.

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: [email protected] }
+{$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.

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: [email protected] }
+
+{ 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.

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: [email protected] }
+{$ifdef FPC}
+{$mode Delphi}
+{$endif}
+begin
+ with TObject.Create do
+  Destroy;
+end.

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: [email protected] }
+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.

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: [email protected] }
+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
+.

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: [email protected] }
+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.

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: [email protected] }
+
+{$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.