Browse Source

bugs 212-214 + 252-253

pierre 26 years ago
parent
commit
3fa1d1b644
6 changed files with 214 additions and 0 deletions
  1. 18 0
      tests/tbs0212.pp
  2. 35 0
      tests/tbs0213.pp
  3. 96 0
      tests/tbs0213a.pp
  4. 29 0
      tests/tbs0214.pp
  5. 18 0
      tests/tbs0252.pp
  6. 18 0
      tests/tbs0253.pp

+ 18 - 0
tests/tbs0212.pp

@@ -0,0 +1,18 @@
+program proptest;
+
+type
+  TMyRec = record
+    Int: Integer;
+    Str: String;
+  end;
+
+  TMyClass = class
+  private
+    FMyRec: TMyRec;
+  public
+    property AnInt: Integer read FMyRec.Int;
+    property AStr: String read FMyRec.Str;
+  end;
+
+begin
+end.

+ 35 - 0
tests/tbs0213.pp

@@ -0,0 +1,35 @@
+uses
+  tbs0213a;
+
+PROCEDURE Testsomething(VAR A:LONGINT);
+
+FUNCTION Internaltest(L:LONGINT):LONGINT;
+
+BEGIN
+ InternalTest:=L+10;
+END;
+
+BEGIN
+ A:=Internaltest(20)+5;
+END;
+
+PROCEDURE Testsomething(VAR A:WORD);
+
+FUNCTION Internaltest(L:LONGINT):WORD;
+
+BEGIN
+ InternalTest:=L+15;
+END;
+
+BEGIN
+ A:=Internaltest(20)+5;
+END;
+
+VAR O  : LONGINT;
+    O2 : WORD;
+
+BEGIN
+ TestSomething(O);
+ TestSomething(O2);
+END.
+

+ 96 - 0
tests/tbs0213a.pp

@@ -0,0 +1,96 @@
+{ different tests for the problem of local 
+  functions having the same name }
+
+unit tbs0213a;
+
+interface
+
+PROCEDURE Testsomething(VAR A:LONGINT);
+
+PROCEDURE Testsomething(VAR A:WORD);
+
+implementation
+
+
+PROCEDURE Testsomething(VAR A:LONGINT);
+
+FUNCTION Internaltest(L:LONGINT):LONGINT;
+
+BEGIN
+ InternalTest:=L+10;
+END;
+
+BEGIN
+ A:=Internaltest(20)+5;
+END;
+
+PROCEDURE Testsomething(VAR A:WORD);
+
+FUNCTION Internaltest(L:LONGINT):WORD;
+
+BEGIN
+ InternalTest:=L+15;
+END;
+
+BEGIN
+ A:=Internaltest(20)+5;
+END;
+
+PROCEDURE Testsomething2(VAR A:LONGINT);
+
+FUNCTION Internaltest(L:LONGINT):LONGINT;
+
+BEGIN
+ InternalTest:=L+10;
+END;
+
+BEGIN
+ A:=Internaltest(20)+5;
+END;
+
+PROCEDURE Testsomething2(VAR A:WORD);
+
+FUNCTION Internaltest(L:LONGINT):WORD;
+
+BEGIN
+ InternalTest:=L+15;
+END;
+
+BEGIN
+ A:=Internaltest(20)+5;
+END;
+
+PROCEDURE Testsomething3(VAR A:WORD);forward;
+
+PROCEDURE Testsomething3(VAR A:LONGINT);
+
+FUNCTION Internaltest(L:LONGINT):LONGINT;
+
+BEGIN
+ InternalTest:=L+10;
+END;
+
+BEGIN
+ A:=Internaltest(20)+5;
+END;
+
+PROCEDURE Testsomething3(VAR A:WORD);
+
+FUNCTION Internaltest(L:LONGINT):WORD;
+
+BEGIN
+ InternalTest:=L+15;
+END;
+
+BEGIN
+ A:=Internaltest(20)+5;
+END;
+
+VAR O  : LONGINT;
+    O2 : WORD;
+
+BEGIN
+ TestSomething(O);
+ TestSomething(O2);
+END.
+

+ 29 - 0
tests/tbs0214.pp

@@ -0,0 +1,29 @@
+{ $OPT=-St }
+
+Program SttcTest;
+{ Note: I've cut a lot out of this program, it did originally have
+        constructors, destructors and instanced objects, but this
+        is the minimum required to produce the problem, and I think
+        that this should work, unless I've misunderstood the use of
+        the static keyword. }
+Type
+   TObjectType1 = Object
+      Procedure Setup; static;
+      Procedure Weird; static;
+   End;
+   
+Procedure TObjectType1.Setup;
+   Begin
+   End;
+   
+Procedure TObjectType1.Weird;
+   Begin
+   End;
+   
+Begin
+   TObjectType1.Setup;
+   TObjectType1.Weird;
+   TObjectType1.Weird; // GPFs before exiting "Weird"
+   Writeln('THE END.');
+End.
+

+ 18 - 0
tests/tbs0252.pp

@@ -0,0 +1,18 @@
+type
+  wnd=procedure;
+  r=record
+    w : wnd;
+  end;
+
+procedure p;
+begin
+end;
+
+const
+  r1:r=(
+   w : wnd(@p);
+  );
+
+begin
+end.
+

+ 18 - 0
tests/tbs0253.pp

@@ -0,0 +1,18 @@
+procedure test(w : word);forward;
+
+procedure test(a : string);
+begin
+   Writeln(a);
+   test(20);
+end;
+
+procedure test(w :word);
+begin
+   writeln(w);
+end;
+
+begin
+  test('test');
+  test(32);
+end.
+