diff --git a/docs/language_status/cobolrt_rules.json b/docs/language_status/cobolrt_rules.json index a4c941982..b38f762eb 100644 --- a/docs/language_status/cobolrt_rules.json +++ b/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" ], diff --git a/gitgalaxy/tools/cobol_to_java/det/cobolrt/Cobol.java b/gitgalaxy/tools/cobol_to_java/det/cobolrt/Cobol.java index 0b8ce3964..3fc5d8689 100644 --- a/gitgalaxy/tools/cobol_to_java/det/cobolrt/Cobol.java +++ b/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 diff --git a/gitgalaxy/tools/cobol_to_java/det/gen.py b/gitgalaxy/tools/cobol_to_java/det/gen.py index 04156949a..d6805ae41 100644 --- a/gitgalaxy/tools/cobol_to_java/det/gen.py +++ b/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 diff --git a/tests/cobol_mainframe/test_det_nondigit_zoned.py b/tests/cobol_mainframe/test_det_nondigit_zoned.py index 6bdd59f6b..de6d3fa61 100644 --- a/tests/cobol_mainframe/test_det_nondigit_zoned.py +++ b/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