diff --git a/tests/webtbf/tw2414.pp b/tests/webtbf/tw2414.pp new file mode 100644 index 0000000000..a3364b3faa --- /dev/null +++ b/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 +. diff --git a/tests/webtbf/uw2414.pp b/tests/webtbf/uw2414.pp new file mode 100644 index 0000000000..06f6bd7147 --- /dev/null +++ b/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 +. diff --git a/tests/webtbs/tw2409.pp b/tests/webtbs/tw2409.pp new file mode 100644 index 0000000000..7f710a8bef --- /dev/null +++ b/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. diff --git a/tests/webtbs/tw2421.pp b/tests/webtbs/tw2421.pp new file mode 100644 index 0000000000..a56663ad71 --- /dev/null +++ b/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.