From e37641458e9e1be1a81ff7fab4f4ab8398147d80 Mon Sep 17 00:00:00 2001
From: Gaius Mulley <gaiusmod2@gmail.com>
Date: Mon, 18 Nov 2024 16:34:42 +0000
Subject: [PATCH] PR modula2/117371: Add check for zero step in for loop

This patch is a follow on from PR modula2/117371 which could include
a check to enforce the ISO restriction on a zero for loop step.

gcc/m2/ChangeLog:

	PR modula2/117371
	* gm2-compiler/M2GenGCC.mod (PerformLastForIterator):
	Add check for zero step value and issue an error message.

gcc/testsuite/ChangeLog:

	PR modula2/117371
	* gm2/iso/fail/forloopbyzero.mod: New test.

Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>
---
 gcc/m2/gm2-compiler/M2GenGCC.mod             | 24 +++++++++++++-------
 gcc/testsuite/gm2/iso/fail/forloopbyzero.mod | 18 +++++++++++++++
 2 files changed, 34 insertions(+), 8 deletions(-)
 create mode 100644 gcc/testsuite/gm2/iso/fail/forloopbyzero.mod

diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod
index 1cb60a87a84..b6e34e019b0 100644
--- a/gcc/m2/gm2-compiler/M2GenGCC.mod
+++ b/gcc/m2/gm2-compiler/M2GenGCC.mod
@@ -529,7 +529,15 @@ BEGIN
       e2 := GetNth (tuple, 2) ;
       e1tree := Mod2Gcc (e1) ;
       e2tree := Mod2Gcc (e2) ;
-      IF CompareTrees (incrtree, GetIntegerZero (location)) > 0
+      IF CompareTrees (incrtree, GetIntegerZero (location)) = 0
+      THEN
+         MetaErrorT0 (lastpos,
+                      'the {%kFOR} loop step value must not be zero') ;
+         MetaErrorDecl (incr, TRUE) ;
+         NoChange := FALSE ;
+         SubQuad (quad) ;
+         success := FALSE
+      ELSIF CompareTrees (incrtree, GetIntegerZero (location)) > 0
       THEN
          (* If incr > 0 then LastIterator := ((e2-e1) DIV incr) * incr + e1.  *)
          expr := BuildSub (location, e2tree, e1tree, FALSE) ;
@@ -3537,9 +3545,9 @@ BEGIN
    IF StrictTypeChecking AND
       (NOT AssignmentTypeCompatible (virtpos, "", des, expr))
    THEN
-      MetaErrorT2 (virtpos,
-                   'assignment check caught mismatch between {%1Ead} and {%2ad}',
-                   des, expr)
+      ErrorMessageDecl (virtpos,
+                        'assignment check caught mismatch between {%1Ead} and {%2ad}',
+                        des, expr, TRUE)
    END ;
    IF IsConstString (expr) AND (NOT IsConstStringKnown (expr))
    THEN
@@ -3554,9 +3562,9 @@ BEGIN
       checkDeclare (des) ;
       IF NOT PrepareCopyString (becomespos, length, exprt, expr, SkipType (GetType (des)))
       THEN
-         MetaErrorT2 (virtpos,
-                      'string constant {%1Ea} is too large to be assigned to the array {%2ad}',
-                      expr, des)
+         ErrorMessageDecl (virtpos,
+                           'string constant {%1Ea} is too large to be assigned to the array {%2ad}',
+                           expr, des, TRUE)
       END ;
       AddStatement (location,
                     MaybeDebugBuiltinMemcpy (location,
@@ -3590,7 +3598,7 @@ BEGIN
                                          FoldConstBecomes (virtpos, des, expr))
             END
          ELSE
-            SubQuad (quad)  (* we don't want multiple errors for the quad.  *)
+            SubQuad (quad)  (* We don't want multiple errors for the quad.  *)
          END
       END
    END
diff --git a/gcc/testsuite/gm2/iso/fail/forloopbyzero.mod b/gcc/testsuite/gm2/iso/fail/forloopbyzero.mod
new file mode 100644
index 00000000000..912eccfddff
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/forloopbyzero.mod
@@ -0,0 +1,18 @@
+MODULE forloopbyzero ;
+
+CONST
+   ConstExp = 10 - 10 ;
+
+PROCEDURE test ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   FOR i := 1 TO 10 BY ConstExp DO
+
+   END
+END test ;
+
+
+BEGIN
+   test
+END forloopbyzero.