PR modula2/109908 Delete from m2iso Strings is broken

This patch re-implements Strings.Delete and also supplies
some runtime test code.

gcc/m2/ChangeLog:

	PR modula2/109908
	* gm2-libs-iso/Strings.mod (Delete): Re-implement.

gcc/testsuite/ChangeLog:

	PR modula2/109908
	* gm2/isolib/run/pass/testdelete.mod: New test.

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

2 files changed, 133 insertions, 10 deletions

diff --git a/gcc/m2/gm2-libs-iso/Strings.mod b/gcc/m2/gm2-libs-iso/Strings.mod
index c30f8eb..7b098b5 100644
--- a/gcc/m2/gm2-libs-iso/Strings.mod
+++ b/gcc/m2/gm2-libs-iso/Strings.mod
@@ -103,26 +103,64 @@ BEGIN
 END Extract ;
 
 
+PROCEDURE MinCard (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+   IF a < b
+   THEN
+      RETURN a
+   ELSE
+      RETURN b
+   END
+END MinCard ;
+
+
 (* Deletes at most numberToDelete characters from stringVar, starting at position
    startIndex.
 *)
 
 PROCEDURE Delete (VAR stringVar: ARRAY OF CHAR;
                   startIndex, numberToDelete: CARDINAL) ;
+CONST
+   Debugging = FALSE ;
 VAR
-   h: CARDINAL ;
+   length,
+   high,
+   last   : CARDINAL ;
 BEGIN
-   IF numberToDelete>0
+   IF numberToDelete > 0
    THEN
-      (* numberToDelete can be consider as the number of characters to skip over *)
-      h := Length(stringVar) ;
-      WHILE (startIndex+numberToDelete<h) DO
-         stringVar[startIndex] := stringVar[startIndex+numberToDelete] ;
-         INC(startIndex)
-      END ;
-      IF startIndex<HIGH(stringVar)
+      length := Length (stringVar) ;
+      IF startIndex < length
       THEN
-         stringVar[startIndex] := ASCII.nul
+         high := HIGH (stringVar) ;
+         (* Calculate the number of characters to delete.  *)
+         last := MinCard (high, length-1) ;
+         IF last - startIndex < numberToDelete
+         THEN
+            numberToDelete := last - startIndex + 1
+         END ;
+         IF numberToDelete > 0
+         THEN
+            IF Debugging
+            THEN
+               printf ("startIndex = %d, numberToDelete = %d, last = %d\n",
+                       startIndex, numberToDelete, last)
+            END ;
+            WHILE startIndex + numberToDelete <= last DO
+               IF Debugging
+               THEN
+                  printf ("strVar[%d] is %c\n", startIndex, stringVar[startIndex]) ;
+                  printf ("  overwriting with strVar[%d] <- %c\n",
+                          startIndex + numberToDelete, stringVar[startIndex + numberToDelete])
+               END ;
+               stringVar[startIndex] := stringVar[startIndex + numberToDelete] ;
+               INC (startIndex) ;
+            END
+         END ;
+         IF startIndex <= high
+         THEN
+            stringVar[startIndex] := ASCII.nul
+         END
       END
    END
 END Delete ;
diff --git a/gcc/testsuite/gm2/isolib/run/pass/testdelete.mod b/gcc/testsuite/gm2/isolib/run/pass/testdelete.mod
new file mode 100644
index 0000000..c834faf
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/testdelete.mod
@@ -0,0 +1,85 @@
+MODULE testdelete ;
+
+FROM libc IMPORT printf, exit ;
+FROM Strings IMPORT Delete, Length ;
+FROM StrLib IMPORT StrEqual ;
+
+
+VAR
+   code : INTEGER ;
+   one  : ARRAY [0..0] OF CHAR ;
+   two  : ARRAY [0..1] OF CHAR ;
+   three: ARRAY [0..2] OF CHAR ;
+   four : ARRAY [0..3] OF CHAR ;
+   large: ARRAY [0..79] OF CHAR ;
+
+
+PROCEDURE Assert (condition: BOOLEAN; message: ARRAY OF CHAR) ;
+BEGIN
+   IF NOT condition
+   THEN
+      printf ("error: %s\n", message) ;
+      code := 1
+   END
+END Assert ;
+
+
+PROCEDURE stresstest ;
+BEGIN
+   one := '1' ;
+   Delete (one, 0, 1) ;
+   printf ("after Delete string one = '%s'\n", one) ;
+   Assert (StrEqual (one, ''), 'string one should be empty after delete') ;
+   Assert (Length (one) = 0, 'string one have length 0 after delete') ;
+   two := '12' ;
+   Delete (two, 0, 1) ;
+   printf ("after Delete string two = '%s'\n", two) ;
+   Assert (StrEqual (two, '2'), "string two should be '2' after delete") ;
+   Assert (Length (two) = 1, 'string two have length 1 after delete') ;
+   three := '123' ;
+   Delete (three, 0, 1) ;
+   printf ("after Delete string three = '%s'\n", three) ;
+   Assert (StrEqual (three, '23'), "string three should be '23' after delete") ;
+   Assert (Length (three) = 2, 'string three should have length 2 after delete') ;
+   four := '4' ;
+   Delete (four, 0, 1) ;
+   printf ("after Delete string four = '%s'\n", four) ;
+   Assert (StrEqual (four, ''), "string four should be '' after delete") ;
+   Assert (Length (four) = 0, 'string four should have length 0 after delete') ;
+   large := '012345678901234567890123456789' ;
+   Delete (large, 20, 20) ;
+   printf ("after Delete string large = '%s'\n", large) ;
+   Assert (StrEqual (large, '01234567890123456789'), "string four should be '01234567890123456789' after delete") ;
+   Assert (Length (large) = 20, 'string large should have length 20 after delete') ;
+
+   large := '012345678901234567890123456789' ;
+   Delete (large, 10, 10) ;
+   printf ("after Delete string large = '%s'\n", large) ;
+   Assert (StrEqual (large, '01234567890123456789'), "string four should be '01234567890123456789' after delete") ;
+   Assert (Length (large) = 20, 'string large should have length 20 after delete') ;
+
+   three := '123' ;
+   Delete (three, 1, 1) ;
+   printf ("after Delete string three = '%s'\n", three) ;
+   Assert (StrEqual (three, '13'), "string three should be '13' after delete") ;
+   Assert (Length (three) = 2, 'string three should have length 2 after delete') ;
+
+   four := '123' ;
+   Delete (four, 1, 1) ;
+   printf ("after Delete string four = '%s'\n", four) ;
+   Assert (StrEqual (four, '13'), "string four should be '13' after delete") ;
+   Assert (Length (four) = 2, 'string four should have length 2 after delete') ;
+
+END stresstest ;
+
+
+BEGIN
+   code := 0 ;
+   stresstest ;
+   IF code = 0
+   THEN
+      printf ("all tests pass\n")
+   ELSE
+      exit (code)
+   END
+END testdelete.
\ No newline at end of file