Browse Source

* avoid SIGSEGV

pierre 25 years ago
parent
commit
4ab63fea0a
1 changed files with 33 additions and 4 deletions
  1. 33 4
      tests/tbs/tbs0239.pp

+ 33 - 4
tests/tbs/tbs0239.pp

@@ -1,5 +1,5 @@
 {$mode delphi}
 {$mode delphi}
-  uses 
+  uses
 {$ifdef go32v2}
 {$ifdef go32v2}
     dpmiexcp,
     dpmiexcp,
 {$endif go32v2}
 {$endif go32v2}
@@ -7,12 +7,41 @@
    type
    type
      ttest=class
      ttest=class
      end;
      end;
+     ttest2 = class(ttest)
+     end;
      ttestclass=class of ttest;
      ttestclass=class of ttest;
    var
    var
-     i:ttest;
+     i,j:ttest;
      tt:tclass;
      tt:tclass;
    begin
    begin
      tt:=ttest;
      tt:=ttest;
-     write(i is tt);
+     i:=ttest.create;
+     j:=ttest2.create;
+     Writeln('tt is a class of ttest initialized by "tt:=ttest"');
+     Writeln('i is a ttest class initialized by "i:=ttest.create"');
+     Writeln('j is a ttest class initialized by "j:=ttest2.create"');
+     writeln('i is tobject ',i is tobject);
+     if not(i is tobject) then
+       Halt(1);
+     writeln('i is tt ',i is tt);
+     if not(i is tt) then
+       Halt(1);
+     writeln('i is ttest ',i is ttest);
+     if not(i is ttest) then
+       Halt(1);
+     writeln('i is ttest2 ',i is ttest2);
+     if (i is ttest2) then
+       Halt(1);
+     writeln('j is tobject ',j is tobject);
+     if not(j is tobject) then
+       Halt(1);
+     writeln('j is tt ',j is tt);
+     if not(j is tt) then
+       Halt(1);
+     writeln('j is ttest ',j is ttest);
+     if not(j is ttest) then
+       Halt(1);
+     writeln('j is ttest2 ',j is ttest2);
+     if not(j is ttest2) then
+       Halt(1);
    end.
    end.
-