det: refuse a non-digit in the PERFORM VARYING variable and SET BY target (Part of #4692)

docs/language_status/cobolrt_rules.json

@@ -821,7 +821,7 @@
   {
    "id": "RT-CBL-RECEIVER-NONDIGIT-REFUSED",
    "family": "CBL",
-   "title": "The receiver of ADD / SUBTRACT / MULTIPLY / DIVIDE is read before it stores: a zoned receiver holding a non-digit is refused by name",
+   "title": "The receiver of ADD / SUBTRACT / MULTIPLY / DIVIDE, the PERFORM VARYING variable and the SET UP / DOWN BY target are read before it stores: a zoned receiver holding a non-digit is refused by name",
    "methods": [
     "receiverNum"
    ],

gitgalaxy/tools/cobol_to_java/det/cobolrt/Cobol.java

@@ -819,7 +819,8 @@ public static BigDecimal intOperand(Field f, Charset cs, boolean binaryTarget) {
     }
 
     /** The current value of the receiver of `ADD x TO y` / `SUBTRACT x FROM y` / `MULTIPLY x BY y` / `DIVIDE x INTO y`
-     *  (#4692, register C11): the statement reads y before it stores. A zoned y holding a non-digit -- spaces,
+     *  and the step of a PERFORM VARYING variable and of SET x UP / DOWN BY (#4692, register C11): the statement reads
+     *  y before it stores. A zoned y holding a non-digit -- spaces,
      *  letters, low-values, a sign byte that is no sign -- is refused by name: IBM documents no result (ZONEDATA(PFD),
      *  the default, assumes valid zone bits; ZONEDATA(NOPFD|MIG) makes an addition correct invalid zone bits, APAR
      *  PI57769, but no source states what a non-digit digit position adds up to), and GnuCOBOL 3.1.2's answer

gitgalaxy/tools/cobol_to_java/det/gen.py

@@ -2061,7 +2061,9 @@ def _statement(self, s: S.Stmt, ind: str) -> list[str]:
             for t in s.data["targets"]:
                 f = self.field_expr(t)
                 op = "add" if s.data["up"] else "subtract"
-                out.append(f"{ind}Cobol.store({f}, Cobol.num({f}, CS).{op}({self.num(s.data['by'])}), false, CS);")
+                out.append(
+                    f"{ind}Cobol.store({f}, Cobol.receiverNum({f}, CS).{op}({self.num(s.data['by'])}), false, CS);"
+                )  # #4692
             return out
         if k == "CALL":
             return [c, *self.call(s, ind)]
@@ -2662,7 +2664,7 @@ def perform(self, s: S.Stmt, ind: str) -> list[str]:
                 if not isinstance(frm, (E.Bin, E.Neg))
                 else f"Cobol.store({f}, {self.num(frm)}, false, CS);"
             )
-            step = f"Cobol.store({f}, Cobol.num({f}, CS).add({self.num(by)}), false, CS);"
+            step = f"Cobol.store({f}, Cobol.receiverNum({f}, CS).add({self.num(by)}), false, CS);"  # #4692: read before stored
             self.leak = leak_before
             until_code = self.cond_top(until)
             self.leak = leak_after

tests/cobol_mainframe/test_det_nondigit_zoned.py

@@ -684,3 +684,48 @@ def test_a_bad_sign_byte_moved_to_alphanumeric_is_refused_by_name_and_a_good_one
         with tempfile.TemporaryDirectory() as d:
             parts += [f"== {_pkey(c)}", *_esc(_pcobc(c, Path(d))), "== end"]
     P_EXPECTED.write_text("\n".join(parts) + "\n")
+
+
+# ---------------------------------------------------------------------------------------------------------------
+# #4692: the PERFORM VARYING variable and the SET x UP / DOWN BY target are read before they store, as the receiver of
+# ADD is: a zoned one holding a non-digit is refused by name (Cobol.receiverNum, register C11); a digit-only one steps.
+# ---------------------------------------------------------------------------------------------------------------
+VARYING_OP = "PERFORM VARYING V FROM 1 BY 1 UNTIL V > 2\n               CONTINUE END-PERFORM"
+
+
+def _step_program(op: str, start: bytes) -> str:
+    return "\n".join(["       IDENTIFICATION DIVISION.", "       PROGRAM-ID. NDB.", "       DATA DIVISION.",
+                      "       WORKING-STORAGE SECTION.", "       01 R PIC X(4).", "       01 V REDEFINES R PIC 9(4).",
+                      "       PROCEDURE DIVISION.", f"           MOVE X'{start.hex().upper()}' TO R", f"           {op}",
+                      "           DISPLAY 'R=' R", "           GOBACK.", ""])  # fmt: skip
+
+
+@pytest.mark.skipif(_java() is None, reason="needs a JDK 17 (JAVA_HOME / JDK_17)")
+def test_a_non_digit_varying_variable_is_only_read_after_the_from_overwrites_it(tmp_path):
+    """FROM stores before the first step reads, so spaces before the loop never reach the step: translated, 0003."""
+    pytest.importorskip("tree_sitter_language_pack")
+    run = _det(_step_program(VARYING_OP, b"    "), tmp_path, "STD")
+    assert run.returncode == 0, run.stderr
+    assert "R=0003" in run.stdout.replace("\r", ""), run.stdout
+
+
+@pytest.mark.skipif(_java() is None, reason="needs a JDK 17 (JAVA_HOME / JDK_17)")
+def test_a_varying_step_that_meets_a_non_digit_is_refused_by_name(tmp_path):
+    """The loop body blanks the variable, so the next step reads spaces."""
+    pytest.importorskip("tree_sitter_language_pack")
+    op = "PERFORM VARYING V FROM 1 BY 1 UNTIL V > 2\n               MOVE SPACES TO R END-PERFORM"
+    run = _det(_step_program(op, b"0000"), tmp_path, "STD")
+    assert run.returncode != 0 and "register C11" in run.stderr, run.stderr
+    assert "receiver is a zoned item holding a non-digit is not modelled" in run.stderr, run.stderr
+
+
+@pytest.mark.skipif(_java() is None, reason="needs a JDK 17 (JAVA_HOME / JDK_17)")
+def test_a_digit_only_varying_step_counts_as_ever(tmp_path):
+    pytest.importorskip("tree_sitter_language_pack")
+    run = _det(
+        _step_program("PERFORM VARYING V FROM 1 BY 2 UNTIL V > 4\n               CONTINUE END-PERFORM", b"0000"),
+        tmp_path,
+        "STD",
+    )
+    assert run.returncode == 0, run.stderr
+    assert "R=0005" in run.stdout.replace("\r", ""), run.stdout