PR modula2/119915: Sprintf1 repeats the entire format string if it starts with a directive

This bugfix is for FormatStrings to ensure that in the case of %x, %u the
procedure function PerformFormatString uses Copy rather than Slice to
avoid the case on an upper bound of zero in Slice.  Oddly the %d case
had the correct code.

gcc/m2/ChangeLog:

	PR modula2/119915
	* gm2-libs/FormatStrings.mod (PerformFormatString): Handle
	the %u and %x format specifiers in a similar way to the %d
	specifier.  Avoid using Slice and use Copy instead.

gcc/testsuite/ChangeLog:

	PR modula2/119915
	* gm2/pimlib/run/pass/format2.mod: New test.

Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>

2 files changed, 65 insertions, 2 deletions

diff --git a/gcc/m2/gm2-libs/FormatStrings.mod b/gcc/m2/gm2-libs/FormatStrings.mod
index ec2985b..aea8da9 100644
--- a/gcc/m2/gm2-libs/FormatStrings.mod
+++ b/gcc/m2/gm2-libs/FormatStrings.mod
@@ -378,7 +378,7 @@ BEGIN
          THEN
             INC (afterperc) ;
             Cast (u, w) ;
-            in := ConCat (in, Slice (fmt, startpos, nextperc)) ;
+            in := Copy (fmt, in, startpos, nextperc) ;
             in := ConCat (in, CardinalToString (u, width, leader, 16, TRUE)) ;
             startpos := afterperc ;
             DSdbExit (NIL) ;
@@ -387,7 +387,7 @@ BEGIN
          THEN
             INC (afterperc) ;
             Cast (u, w) ;
-            in := ConCat (in, Slice (fmt, startpos, nextperc)) ;
+            in := Copy (fmt, in, startpos, nextperc) ;
             in := ConCat (in, CardinalToString (u, width, leader, 10, FALSE)) ;
             startpos := afterperc ;
             DSdbExit (NIL) ;
diff --git a/gcc/testsuite/gm2/pimlib/run/pass/format2.mod b/gcc/testsuite/gm2/pimlib/run/pass/format2.mod
new file mode 100644
index 0000000..2ad6a8c
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/run/pass/format2.mod
@@ -0,0 +1,63 @@
+MODULE format2;
+
+FROM libc IMPORT exit, printf ;
+FROM Terminal IMPORT Write, WriteLn;
+FROM NumberIO IMPORT WriteCard;
+FROM DynamicStrings IMPORT String, Length, char, InitString;
+FROM FormatStrings IMPORT Sprintf1;
+
+PROCEDURE WriteString (s: String);
+VAR
+   l, i: CARDINAL;
+BEGIN
+   l := Length (s) ;
+   i := 0 ;
+   WHILE i < l DO
+      Write (char (s, i)) ;
+      INC (i)
+   END
+END WriteString;
+
+
+(*
+   assert -
+*)
+
+PROCEDURE assert (cond: BOOLEAN; line: CARDINAL; file: ARRAY OF CHAR) ;
+BEGIN
+   IF NOT cond
+   THEN
+      printf ("%s:%d assertion failed\n", file, line);
+      exit (1)
+   END
+END assert ;
+
+
+VAR
+   n: CARDINAL;
+   r, s: String;
+BEGIN
+   n := 2;
+   r := InitString("%u pieces of cake") ;
+   WriteString (r) ; WriteLn ;
+   assert (Length (r) = 17, __LINE__, __FILE__) ;
+   s := Sprintf1 (r, n) ;
+   WriteCard (Length (s), 4) ; WriteLn ;
+   assert (Length (s) = 16, __LINE__, __FILE__) ;
+
+   r := InitString("%d pieces of cake") ;
+   WriteString (r) ; WriteLn ;
+   assert (Length (r) = 17, __LINE__, __FILE__) ;
+   s := Sprintf1 (r, n) ;
+   WriteCard (Length (s), 4) ; WriteLn ;
+   assert (Length (s) = 16, __LINE__, __FILE__) ;
+
+   r := InitString("%x pieces of cake") ;
+   WriteString (r) ; WriteLn ;
+   assert (Length (r) = 17, __LINE__, __FILE__) ;
+   s := Sprintf1 (r, n) ;
+   WriteCard (Length (s), 4) ; WriteLn ;
+   assert (Length (s) = 16, __LINE__, __FILE__) ;
+
+   WriteString (InitString ('all tests pass')) ; WriteLn ;
+END format2.