https://gcc.gnu.org/g:f43c2ee451c57025065c91fbdc067128e93d2ec4

commit r14-11059-gf43c2ee451c57025065c91fbdc067128e93d2ec4
Author: Gaius Mulley <gaiusm...@gmail.com>
Date:   Wed Dec 4 08:01:13 2024 +0000

    [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.
    
    (cherry picked from commit e37641458e9e1be1a81ff7fab4f4ab8398147d80)
    
    Signed-off-by: Gaius Mulley <gaiusm...@gmail.com>

Diff:
---
 gcc/m2/gm2-compiler/M2GenGCC.mod             | 24 ++++++++++++++++--------
 gcc/testsuite/gm2/iso/fail/forloopbyzero.mod | 18 ++++++++++++++++++
 2 files changed, 34 insertions(+), 8 deletions(-)

diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod
index 1cb60a87a84f..b6e34e019b04 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 000000000000..912eccfddfff
--- /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.

Reply via email to