From 5c3c5dfb83c6f96c457bf2d323e5d393cdfb945f Mon Sep 17 00:00:00 2001
From: pierre <pierre@freepascal.org>
Date: Thu, 23 Dec 1999 12:00:34 +0000
Subject: [PATCH]  same as testchar but with $P-

---
 tests/test/testchr2.pp | 148 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 148 insertions(+)
 create mode 100644 tests/test/testchr2.pp

diff --git a/tests/test/testchr2.pp b/tests/test/testchr2.pp
new file mode 100644
index 0000000000..91bcab2267
--- /dev/null
+++ b/tests/test/testchr2.pp
@@ -0,0 +1,148 @@
+{$P-}
+
+type
+   CharA4 = array [1..4] of char;
+   CharA6 = array [1..6] of char;
+   String4 = String[4];
+   String5 = String[5];
+   String6 = String[6];
+   String8 = String[8];
+
+const
+   car4_1 : CharA4 = 'ABCD';
+   car4_2 : CharA4 = 'abcd';
+   car6_1 : CharA6 = 'EFGHIJ';
+   car6_2 : CharA6 = 'efghij';
+   cst4_1 : String4 = 'ABCD';
+   cst6_2 : string6 = 'EFGHIJ';
+   cst8_1 : string8 = 'abcd';
+   cst8_2 : string8 = 'efghij';
+
+var
+  ar4_1, ar4_2 : CharA4;
+  ar6_1, ar6_2 : CharA6;
+  st4_1, st4_2 : string4;
+  st5_1, st5_2 : string5;
+  st6_1, st6_2 : string6;
+  st8_1, st8_2 : string8;
+  pc : pchar;
+
+const
+  has_errors : boolean = false;
+
+  procedure error(const st : string);
+    begin
+      Writeln('Error: ',st);
+      has_errors:=true;
+    end;
+
+  procedure testvalueconv(st : string4);
+  begin
+    Writeln('st=',st);
+    Writeln('Length(st)=',Length(st));
+    If Length(st)>4 then
+      Error('string length too big in calling value arg');
+  end;
+
+  procedure testconstconv(const st : string4);
+  begin
+    Writeln('st=',st);
+    Writeln('Length(st)=',Length(st));
+    If Length(st)>4 then
+      Error('string length too big in calling const arg');
+  end;
+
+  procedure testvarconv(var st : string4);
+  begin
+    Writeln('st=',st);
+    Writeln('Length(st)=',Length(st));
+    If Length(st)>4 then
+      Error('string length too big in calling var arg');
+  end;
+
+  procedure testvarconv2(var st : string4);
+  begin
+    Writeln('st=',st);
+    Writeln('Length(st)=',Length(st));
+    If Length(st)>4 then
+      Error('string length too big in calling var arg without openstring');
+  end;
+
+begin
+  { compare array of char to constant strings }
+  Writeln('Testing if "',car4_1,'" is equal to "',cst4_1,'"');
+  if car4_1<>cst4_1 then
+    error('Comparison of array of char and string don''t work');
+  Writeln('Testing if "',car4_1,'" is equal to "ABCD"');
+  if car4_1<>'ABCD' then
+    error('Comparison of array of char and constat string don''t work');
+  Writeln('Testing if "',cst4_1,'" is equal to "ABCD"');
+  if 'ABCD'<>cst4_1 then
+    error('Comparison of string and constant string don''t work');
+  car4_1:='AB'#0'D';
+  if car4_1='AB' then
+    Writeln('Anything beyond a #0 is ignored')
+  else if car4_1='AB'#0'D' then
+    Writeln('Chars after #0 are not ignored')
+  else
+    Error('problems if #0 in array of char');
+{$ifdef FPC this is not allowed in BP !}
+  car4_1:=cst4_1;
+{ if it is allowed then it must also work correctly !! }
+  Writeln('Testing if "',car4_1,'" is equal to "',cst4_1,'"');
+  if car4_1<>cst4_1 then
+    error('Comparison of array of char and string don''t work');
+  if string4(car6_2)<>'efgh' then
+    error('typcasting to shorter strings leads to problems');
+  ar4_2:='Test';
+  ar4_1:=cst6_2;
+  if ar4_2<>'Test' then
+    error('overwriting beyond char array size');
+  ar6_1:='Test'#0'T';
+  st6_1:=ar6_1;
+  if (st6_1<>ar6_1) or (st6_1='Test') then
+    error('problems with #0');
+  ar6_1:='AB';
+  if ar6_1='AB'#0't'#0'T' then
+    Error('assigning strings to array of char does not zero end of array if string is shorter');
+  if ar6_1='AB'#0#0#0#0 then
+    writeln('assigning shorter strings to array of char does zero  fo tserarray')
+  else
+    error('assigning "AB" to ar6_1 gives '+ar6_1);
+{$endif}
+  cst8_1:=car4_1;
+{ if it is allowed then it must also work correctly !! }
+  Writeln('Testing if "',car4_1,'" is equal to "',cst8_1,'"');
+  if car4_1<>cst8_1 then
+    error('Comparison of array of char and string don''t work');
+  st4_2:='Test';
+  st4_1:=car6_1;
+  if (st4_2<>'Test') or (st4_1<>'EFGH') then
+    error('problems when copying long char array to shorter string');
+  testvalueconv('AB');
+  testvalueconv('ABCDEFG');
+  testvalueconv(car4_1);
+  testvalueconv(car6_1);
+  getmem(pc,256);
+  pc:='Long Test';
+  testvalueconv(pc);
+  testconstconv('AB');
+  testconstconv('ABCDEFG');
+  testconstconv(st4_1);
+  testconstconv(cst6_2);
+  testconstconv(pc);
+  testvarconv(st4_2);
+  testvarconv(cst4_1);
+  testvarconv(st6_1);
+  testvarconv(cst8_1);
+  { testvarconv(pc); this one fails at compilation }
+  testvarconv2(st4_2);
+  testvarconv2(cst4_1);
+  testvarconv2(st6_1);
+  testvarconv2(cst8_1);
+  if has_errors then
+    begin
+      Writeln('There are still problems with arrays of char');
+      Halt(1);
+    end;
+end.