equivalence: cases for GenApp's front-end and test programs (#4270)

docs/language_status/oracle_assumptions.md

@@ -116,6 +116,7 @@ verdict, but it limits what the proof says about inputs outside the scenarios.
 | Q7 | Db2 | `CCSID EBCDIC` tables hold Unicode text: string order differs | DIFFERS | no |
 | Q8 | Db2 | Positioned UPDATE / DELETE: the Java side by row id | MATCHED | yes (GenApp LGUPDB01) |
 | Q9 | Db2 | More host variables than columns: SQLWARN3, the rest untouched | MATCHED | yes (GenApp LGUPDB01) |
+| Q10 | Db2 | A statement the driver fails with no Db2 SQLCODE (a blank timestamp host variable) | REFUSED (the task; an enumerated fault task not judged) | no (met by LGTESTP4's add, left out: #4652) |
 | J1 | Java | VSAM files on H2, not the target database | ASSUMED | — |
 | M1 | method | The scenarios are ours, not production traffic | — | — |
 | M2 | method | SQL faults: injected on both sides at a statement (#4173), the SQLCA as the stub sets it | MATCHED (ASSUMED SQLCA) | yes (17 Db2 cases) |
@@ -316,6 +317,9 @@ verdict, but it limits what the proof says about inputs outside the scenarios.
   GnuCOBOL does not; the proofs differ on both inputs.
 - **Now.** Those inputs are not in the case, so the three COMEN01C survivors in the port's own digit test stay case
   gaps. A z/OS run (#4050) settles which side is right.
+- **Also met (#4652).** GenApp LGTESTP4's add leaves CA-BROKERID / CA-PAYMENT (PIC 9) as spaces, which LGAPDB01 moves
+  to binary host variables: GnuCOBOL gives 931773840 / 707773840, the det port 0. The data is the program's own, so
+  genapp-lgtestp4 leaves that add out.
 
 ### C12. FUNCTION RANDOM — the numbers DIFFER from z/OS, the interface ASSUMED; refused where IBM does not allow the seed
 - **IBM** (Enterprise COBOL 6.4 Language Reference, RANDOM,
@@ -1070,6 +1074,13 @@ The length READQ TS returns on ITEMERR or QIDERR is not documented, so it is not
   leaves the sixth as it was; both sides now do the same (the COBOL stub had reported an error, the Java side a
   NULL).
 
+### Q10. A statement the driver fails with no Db2 SQLCODE — REFUSED (#4270)
+- **What.** A host variable Db2 cannot take (GenApp LGAPDB01's INSERT COMMERCIAL with a blank CA-LASTCHANGED as its
+  REQUESTDATE, reached when the SELECT LASTCHANGED before it is faulted) fails in the client: Db2's CLI gives its own
+  native code -99999 (SQLSTATE 22007), IBM's JDBC driver its own -4220. What Db2 for z/OS answers is not known here,
+  so the COBOL stub stops the task by name ("the CLI failed it in the client") instead of passing -99999 on as an
+  SQLCODE: an enumerated fault task (M2) that reaches it is not judged; a declared scenario stops the case.
+
 ## The Java side
 
 ### J1. Files on H2 — ASSUMED

gitgalaxy/tools/cobol_to_java/det/expr.py

@@ -32,6 +32,16 @@ class Lit:
     """A nonnumeric literal (text) or a numeric literal (Decimal)."""
 
     value: str | Decimal | bytes
+    # #4270: a numeric literal's digits as written. Compared with an alphanumeric item, an integer literal is the
+    # nonnumeric literal of its digits (IBM, "Comparison of numeric and alphanumeric operands"), leading zeros and all:
+    # GenApp's LGTESTP4 `ENP4CNOO Not = 0000000000` -- a Decimal keeps no leading zeros.
+    digits: str | None = field(default=None, compare=False)
+
+
+def _digits(tok: str) -> str | None:
+    """An unsigned integer literal's digits as written (`0000000000`), else None."""
+    t = tok.lstrip("+-")
+    return t if t.isdigit() else None
 
 
 @dataclass
@@ -180,10 +190,10 @@ def operand(self) -> object:
             raise ExprError("NULL: pointers are not modelled")
         if _is_number(tok):
             self.i += 1
-            return Lit(Decimal(tok.replace(",", ".") if tok.count(",") == 1 and "." not in tok else tok))
+            return Lit(Decimal(tok.replace(",", ".") if tok.count(",") == 1 and "." not in tok else tok), _digits(tok))
         if u in ("+", "-") and (nxt1 := self.peek(1)) is not None and _is_number(nxt1):
             self.i += 2
-            return Lit(Decimal(u + self.t[self.i - 1]))
+            return Lit(Decimal(u + self.t[self.i - 1]), _digits(self.t[self.i - 1]))
         if u == "FUNCTION":
             self.i += 1
             name = self.take().upper()

gitgalaxy/tools/cobol_to_java/det/gen.py

@@ -881,6 +881,10 @@ def cmp(self, a: E.Ref, b, jop: str = "<") -> str:
         if isinstance(b, E.Ref):
             return f"Cobol.compare({fa}, {self.field_expr(b)}, CS{c})"
         if isinstance(b, E.Lit):
+            if isinstance(b.value, Decimal) and b.digits and not self.is_numeric(a):
+                # #4270: an integer literal against an alphanumeric item: the nonnumeric literal of its digits as
+                # written (`0000000000`, not the value's `0`)
+                return f"Cobol.compare({fa}, {jstr(b.digits)}, CS{c})"
             if isinstance(b.value, Decimal):
                 return f"Cobol.compare({fa}, {self.const(b.value)}, CS{c})"
             return f"Cobol.compare({fa}, {self.text(b)}, CS{c})"

gitgalaxy/tools/cobol_to_java/det/program.py

@@ -1252,6 +1252,19 @@ def _cics_parts(gen: G.Gen, records: list, roots: dict, proc: S.Procedure,
             "    }",
             "",
         ]
+    else:
+        # #4270 (GenApp's LGTESTP1-4: no DFHCOMMAREA, `IF EIBCALEN > 0 GO TO A-GAIN`): a program with no LINKAGE
+        # COMMAREA still has EIBCALEN, the length of the area its task started with (the RETURN TRANSID COMMAREA it
+        # left) -- only no storage to address it through. Its length is the DTO's the task carries.
+        for cls in [x for x in dict.fromkeys([cx.gp.contract, *cx.gp.records.values()]) if x]:
+            try:
+                size = cx.gp.dto(cls).size
+            except (OSError, C.CicsError):
+                continue
+            kw = "if" if not ca_in else "} else if"
+            ca_in += [f"        {kw} (ca instanceof {cls}) {{", f"            calen = cx(task, {size});"]
+        if ca_in:
+            ca_in.append("        }")
     store_cases = [f'            case "{n}" -> {e};' for n, e in cx.stores.items()]
     members = [
         "    private CicsTask task;",

tests/cobol_mainframe/test_det_translate.py

@@ -2016,3 +2016,29 @@ def test_a_commarea_of_a_stated_length_is_all_dfhcommarea_holds(tmp_path):
     assert 'throw new DetCics.PastFrom("COMMAREA past EIBCALEN (" + calen + " bytes): not modelled");' in run
     assert "} finally { if (caWhole != null) { caWhole(caWhole); } }" in run
     assert "private void caWhole(byte[] whole) {" in r.java
+
+
+def test_an_integer_literal_against_an_alphanumeric_item_keeps_its_leading_zeros(tmp_path):
+    """#4270 (GenApp LGTESTP4: `ENP4CNOO Not = 0000000000` on a map field of ten digits): compared with an
+    alphanumeric item, an integer literal is the nonnumeric literal of its digits as written (IBM, "Comparison of
+    numeric and alphanumeric operands"). As a value it is 0, whose text "0" made '0000000000' unequal to it."""
+    pytest.importorskip("tree_sitter_language_pack")
+    from gitgalaxy.tools.cobol_to_java.det import program as P
+
+    (tmp_path / "T5.cbl").write_text(
+        "       IDENTIFICATION DIVISION.\n       PROGRAM-ID. T5.\n       DATA DIVISION.\n"
+        "       WORKING-STORAGE SECTION.\n       01  REC.\n           05  WS-A              PIC X(10).\n"
+        "           05  WS-B              PIC X(2).\n       01  WS-N                  PIC 9(3) VALUE 7.\n"
+        "       PROCEDURE DIVISION.\n       MAIN-PARA.\n           MOVE SPACES TO REC\n"
+        "           IF WS-A NOT = 0000000000 AND WS-A NOT = 0\n               MOVE 'Y' TO WS-B\n           END-IF\n"
+        "           IF WS-N = 007\n               MOVE 'N' TO WS-B\n           END-IF\n"
+        "           EXEC CICS RETURN END-EXEC.\n",
+        encoding="utf-8",
+    )
+    (tmp_path / "proj/src/main/java/com/x").mkdir(parents=True)
+    stub = "package com.x.service;\nimport com.x.cics.CicsTask;\npublic class T5Service {\n" \
+           "    public void runTask(CicsTask task) {}\n}\n"  # fmt: skip
+    r = P.translate(tmp_path / "T5.cbl", [], stub, "com.x", {}, tmp_path / "proj")
+    assert r.stats["holes"] == []
+    assert '_WS_A, "0000000000", CS) == 0' in r.java and '_WS_A, "0", CS) == 0' in r.java
+    assert '"007"' not in r.java  # a numeric item against it: by value, as before

tests/cobol_mainframe/test_equivalence_cics.py

@@ -1193,3 +1193,15 @@ def test_the_stub_starts_the_task_with_its_channel_and_writes_what_it_leaves(tmp
     run = subprocess.run([str(exe)], capture_output=True, text=True, env=env, check=False)  # noqa: S603
     assert run.stdout.splitlines()[:2] == ["get resp=0 len=4 into=0001", "put resp=0"]
     assert (o / "containers.out").read_text() == "CHANNEL MYCHANNEL\nINPUTCONTAINER 30303031\nOUT 393938\n"
+
+
+def test_each_linked_sql_program_gets_the_next_free_ids_within_four_digits():
+    """#4270: GG-SQL-ID is PIC 9(4). Twelve LINKed programs (GenApp's LGTESTP1) once took ranges of 1000 by their
+    place in "programs", and the tenth's 10000 lost its high digit (an unknown GG-SQL-ID); each program's statements
+    now start at the next hundred after the ids already taken."""
+    assert ec.sql_first_id("") == 100
+    table = (
+        "S 1 SELECT1 1 1 - P 10\nI 0 X 1 0 0 0 0\nS 2 EXEC 1 0 - P 20\nS 100 OPEN 0 0 C Q 30\nS 117 FETCH 0 1 C Q 40\n"
+    )
+    assert ec.sql_first_id(table) == 200
+    assert ec.sql_first_id("S 199 EXEC 0 0 - P 1\n") == 200

tests/cobol_mainframe/test_estate4_dbb.py

@@ -88,6 +88,19 @@ def test_a_lower_case_copybook_is_staged_under_its_member_name(tmp_path):
     assert sorted(p.name for p in src.iterdir()) == ["EPSNBRPM.cpy", "epsnbrpm.cpy"]
 
 
+def test_a_bms_map_source_does_not_shadow_its_generated_symbolic_map(tmp_path):
+    # #4270: GenApp's base/src holds ssmap.bms beside the programs; COPY SSMAP means the symbolic map generated from
+    # it (@bms/SSMAP.cpy), not the assembler macros staged under the member's name
+    corpus = tmp_path / "corpus"
+    (corpus / "src").mkdir(parents=True)
+    (corpus / "src" / "ssmap.bms").write_text("SSMAP   DFHMSD TYPE=MAP\n", encoding="utf-8")
+    (corpus / "src" / "lgcmarea.cpy").write_text("       03 A PIC X.\n", encoding="utf-8")
+    src = tmp_path / "src"
+    src.mkdir()
+    common.stage_copybooks({"copy_dirs": ["src"]}, corpus, src)
+    assert sorted(p.name for p in src.iterdir()) == ["LGCMAREA.cpy", "lgcmarea.cpy"]
+
+
 def _undefined(commarea, cobol_value):
     cev = [{"event": "RETURN", "commarea": {"RETCODE": cobol_value, "IND": "3"}}]
     jev = [{"event": "RETURN", "commarea": {"RETCODE": 0, "IND": "3"}}]

tests/equivalence/db2/ggsql.c

@@ -162,6 +162,10 @@ static void diag(sqlca_t *c, SQLSMALLINT kind, SQLHANDLE h, SQLRETURN rc) {
         return;
     }
     if (SQLGetDiagRec(kind, h, 1, state, &native, msg, sizeof msg, &len) == SQL_SUCCESS) {
+        /* #4270 (Q10): -99999 is the CLI's own error, not Db2's (GenApp LGAPDB01's INSERT COMMERCIAL of a blank
+           CA-LASTCHANGED as REQUESTDATE: 22007 in the client). What Db2 for z/OS answers is not known here, and the
+           Java side's JDBC driver reports a client code of its own (-4220): refused by name, never compared */
+        if (rc == SQL_ERROR && native == -99999) die("statement", "the CLI failed it in the client (no Db2 SQLCODE)");
         c->sqlcode = native;
         memcpy(c->sqlstate, state, 5);
         if (rc == SQL_SUCCESS_WITH_INFO && native == 0) c->sqlcode = 0;  /* a driver note, no Db2 warning */