Browse Source

better check

pierre 25 years ago
parent
commit
32581d349c
1 changed files with 19 additions and 5 deletions
  1. 19 5
      tests/webtbs/tbug891.pp

+ 19 - 5
tests/webtbs/tbug891.pp

@@ -1,22 +1,36 @@
 { this declaration: ;}
 { this declaration: ;}
-{$mode TP}
+{$ifdef FPC}
+  {$mode TP}
+{$endif}
  var
  var
    name_a : packed array[0..255] of char;
    name_a : packed array[0..255] of char;
 
 
 const
 const
-   name_b : PChar = 'test';
+   name_b : PChar = 't';
 
 
 begin
 begin
    { the FPC compiler (0.99.14a) will refuse to compile
    { the FPC compiler (0.99.14a) will refuse to compile
     the line ; }
     the line ; }
-
+    name_a[0]:='x';
+    name_a[1]:=#0;
     if (name_b <> name_a) then
     if (name_b <> name_a) then
-      writeln(' a and b are different');
+      begin
+        writeln(' a and b are different');
+      end
+    else
+      writeln('address of name_a and name_b are equal');
     { while it works under Turbo Pascal (TP). ;}
     { while it works under Turbo Pascal (TP). ;}
+    name_b:=@name_a;
+    if name_a<>name_b then
+      begin
+        Writeln('Wrong result');
+        Halt(1);
+      end;
+{$ifdef FPC}
      if (name_b <> PChar(name_a)) then
      if (name_b <> PChar(name_a)) then
       writeln(' a and b are different');
       writeln(' a and b are different');
     { is a legal FPC line, but illegal in TP.}
     { is a legal FPC line, but illegal in TP.}
-
+{$endif}
     { I used ; }
     { I used ; }
     if (name_b <> PChar(@name_a)) then
     if (name_b <> PChar(@name_a)) then
       writeln(' a and b are different');
       writeln(' a and b are different');