* new bugs

tests/webtbf/tw2414.pp

@@ -0,0 +1,12 @@
+{ %fail }
+
+USES uw2414;
+
+VAR
+        ob      : anObj;
+BEGIN
+        ob.k:=8;
+        ob.A('xxyyzzww');
+        ob.A('aabbcc',4);  { call to a private method allowed !? }
+END
+.

tests/webtbf/uw2414.pp

@@ -0,0 +1,27 @@
+{ Source provided for Free Pascal Bug Report 2414 }
+{ Submitted by "Louis Jean-Richard" on  2003-03-10 }
+{ e-mail: Ljean_richard@compuserve.com }
+UNIT uw2414;
+INTERFACE
+TYPE
+        anObj   =
+                OBJECT
+                        PROCEDURE A( CONST s : string );
+                        k       : cardinal;
+                        PRIVATE
+                        PROCEDURE A( CONST s : string; n : word );
+                END
+                ;
+IMPLEMENTATION
+PROCEDURE anObj.A( CONST s : string; n : word );
+BEGIN
+        WriteLn(' ':n, s)
+END
+;
+PROCEDURE anObj.A( CONST s : string );
+BEGIN
+        A(s, k)
+END
+;
+END
+.

tests/webtbs/tw2409.pp

@@ -0,0 +1,28 @@
+{ %version=1.1 }
+
+{ Source provided for Free Pascal Bug Report 2409 }
+{ Submitted by "Mattias Gaertner" on  2003-03-07 }
+{ e-mail: nc-gaertnma@netcologne.de }
+unit tw2409;
+
+{$mode objfpc}{$H+}
+
+interface
+
+type
+  HDC = type integer;
+
+  TMyClass = class
+    procedure DoSomething(H: HDC);
+  end;
+
+implementation
+
+{ TMyClass }
+
+procedure TMyClass.DoSomething(H: HDC);
+begin
+
+end;
+
+end.

tests/webtbs/tw2421.pp

@@ -0,0 +1,59 @@
+{ Source provided for Free Pascal Bug Report 2421 }
+{ Submitted by "N. Hug" on  2003-03-16 }
+{ e-mail: hug__@t-online.de }
+PROGRAM Bug;
+
+{$ifdef fpc}{$MODE DELPHI}{$endif}
+
+TYPE  TTestEvent =PROCEDURE OF OBJECT;
+
+TYPE  TTest      =CLASS
+                    FOnTest   :TTestEvent;
+                    PROPERTY OnTest:TTestEvent READ FOnTest WRITE FOnTest;
+                  END;
+
+
+TYPE  THost      =CLASS
+                  PRIVATE
+                    FTest :TTest;
+                    PROCEDURE DoTest;
+
+                  PUBLIC
+                    CONSTRUCTOR Create;
+                  END;
+
+
+PROCEDURE THost.DoTest;
+BEGIN
+  // Accessing instance data results in a crash.
+  // It shows that SELF is not properly set.
+  IF FTest = NIL THEN begin
+  END;
+END;
+
+
+CONSTRUCTOR THost.Create;
+BEGIN
+  INHERITED;
+
+  FTest := TTest.Create;
+
+  // Buggy code:
+  FTest.OnTest := DoTest;
+
+  // Non buggy alternatives:
+  // FTest.OnTest  := SELF.DoTest;
+  // FTest.FOnTest := DoTest;
+
+  // Now call it.
+  FTest.OnTest;
+END;
+
+
+
+VAR  M     :THost;
+
+BEGIN
+  M := THost.Create;
+  M.Free;
+END.