Browse Source

no message

florian 20 years ago
parent
commit
2fa0967349
2 changed files with 64 additions and 0 deletions
  1. 31 0
      tests/tbs/tb0483.pp
  2. 33 0
      tests/tbs/tb0483u.pp

+ 31 - 0
tests/tbs/tb0483.pp

@@ -0,0 +1,31 @@
+{$mode delphi}
+{ this should be only allowed in delphi mode; it's a delphi bug }
+uses
+  tb0483u;
+
+type
+  tmyclass2 = class(tmyclass1)
+    procedure x(var l : longint);message 1234;
+  end;
+
+procedure tmyclass2.x(var l : longint);
+  begin
+    inherited;
+  end;
+
+var
+  myclass2 : tmyclass2;
+  l : longint;
+
+begin
+  myclass2:=tmyclass2.create;
+  myclass2.x(l);
+  myclass2.free;
+  if testresult<>1 then
+    begin
+      writeln('error');
+      halt(1);
+    end;
+  writeln('ok');
+end.
+

+ 33 - 0
tests/tbs/tb0483u.pp

@@ -0,0 +1,33 @@
+{$mode delphi}
+unit tb0483u;
+
+interface
+
+  type
+    tmyclass1 = class
+    private
+      procedure x(var l : longint);message 1234;
+    public
+      procedure defaulthandler(var msg);override;
+    end;
+
+  const
+    testresult : longint = 0;
+
+
+implementation
+
+  procedure tmyclass1.defaulthandler(var msg);
+    begin
+      writeln('error; being in tmyclass1.defaulthandler');
+      halt(1);
+    end;
+
+
+  procedure tmyclass1.x(var l : longint);
+    begin
+      testresult:=1;
+    end;
+
+end.
+