det: JSON GENERATE NAME OF the source IS OMITTED (Part of #7524)

docs/language_status/cobolrt_api.json

@@ -1,7 +1,7 @@
 {
   "schema": "cobolrt-api/1",
   "about": ["The cobolrt public API (#4718). Written by tests/tools/cobolrt_api.py generate: edit only a `visibility`, to public or internal; docs/cobolrt_api_contract.md says what they promise.", "`evidence` records who called the item when it was last refreshed, and is never checked: det-port, model-port (committed ports), frozen-overlay (a frozen runtime copy's call to a live class), generated (translator output), emitter (a translator string), emitter-dynamic (a name a computed emission may take), runtime, harness; empty: no caller was found."],
-  "summary": {"types": 128, "types_public": 105, "members": 1200, "members_public": 809, "members_internal": 391},
+  "summary": {"types": 128, "types_public": 105, "members": 1201, "members_public": 810, "members_internal": 391},
   "types": [
     {"id": "batch.CobolAbend", "kind": "class", "source": "gitgalaxy/tools/cobol_to_java/cobol_to_java_batch_forge.py", "variants": ["forge-batch-jobs", "forge-batch-files"], "supers": ["RuntimeException"], "visibility": "public", "evidence": ["det-port", "emitter", "model-port", "signature", "harness"], "members": [
       {"id": "batch.CobolAbend.<init>(String,String)", "kind": "constructor", "visibility": "internal", "evidence": []},
@@ -1007,6 +1007,7 @@
       {"id": "cobolrt.Hole.<init>(String)", "kind": "constructor", "visibility": "public", "evidence": ["det-port", "model-port", "runtime"]}
     ]},
     {"id": "cobolrt.JsonGenerate", "kind": "class", "source": "gitgalaxy/tools/cobol_to_java/det/cobolrt/JsonGenerate.java", "variants": ["det-batch", "det-standalone", "sort-job"], "supers": [], "visibility": "public", "evidence": ["emitter", "emitter-dynamic", "signature", "harness", "runtime"], "members": [
+      {"id": "cobolrt.JsonGenerate.anonymous(Node)", "kind": "method", "static": true, "returns": "cobolrt.JsonGenerate.Node", "visibility": "public", "evidence": ["emitter-dynamic", "harness"]},
       {"id": "cobolrt.JsonGenerate.array(String,Node...)", "kind": "method", "static": true, "returns": "cobolrt.JsonGenerate.Node", "visibility": "public", "evidence": ["emitter-dynamic", "harness"]},
       {"id": "cobolrt.JsonGenerate.generate(Field,Node,Charset)", "kind": "method", "static": true, "returns": "int", "visibility": "public", "evidence": ["emitter", "harness"]},
       {"id": "cobolrt.JsonGenerate.group(String,Node...)", "kind": "method", "static": true, "returns": "cobolrt.JsonGenerate.Node", "visibility": "public", "evidence": ["emitter-dynamic", "harness"]},

docs/language_status/cobolrt_rules.json

@@ -117,6 +117,7 @@
     "group",
     "array",
     "table",
+    "anonymous",
     "read",
     "invalid",
     "skip",

docs/language_status/register/X76.md

@@ -4,13 +4,13 @@ family: "X"
 status: "ASSUMED"
 title: "JSON GENERATE from a group of DISPLAY, COMP / COMP-3 / COMP-5 items and fixed tables is translated from IBM's text alone — ASSUMED, oracle-unbacked (#7524)"
 area: "COBOL"
-summary: "JSON GENERATE identifier-1 FROM group [COUNT IN] [NAME OF ... IS] [SUPPRESS item [WHEN ...] | EVERY [NUMERIC | NONNUMERIC] WHEN ...] over DISPLAY alphanumeric, fixed-point numeric (DISPLAY, COMP, COMP-3, COMP-5) items and fixed OCCURS tables and OCCURS DEPENDING ON tables is generated as a runtime call that writes IBM's JSON text (names as written, group wrapper, trailing blanks trimmed, numbers as edited). GnuCOBOL has no JSON statement, so nothing backs it: no L2+ claim. JSON-STATUS, CONVERTING, NAME OMITTED, an ODO table inside another table or with an out-of-range count, a table as the source itself, float items, an elementary source and any character beyond ASCII stay holes or runtime Holes"
+summary: "JSON GENERATE identifier-1 FROM group [COUNT IN] [NAME OF ... IS literal | OMITTED] [SUPPRESS item [WHEN ...] | EVERY [NUMERIC | NONNUMERIC] WHEN ...] over DISPLAY alphanumeric, fixed-point numeric (DISPLAY, COMP, COMP-3, COMP-5) items and fixed OCCURS tables and OCCURS DEPENDING ON tables is generated as a runtime call that writes IBM's JSON text (names as written, group wrapper, trailing blanks trimmed, numbers as edited). GnuCOBOL has no JSON statement, so nothing backs it: no L2+ claim. JSON-STATUS, CONVERTING, NAME OMITTED on a member, an ODO table inside another table or with an out-of-range count, a table as the source itself, float items, an elementary source and any character beyond ASCII stay holes or runtime Holes"
 reached: "no (no burned program uses JSON; fixture tests/cobol_mainframe/test_det_json_generate.py)"
 ---
-- **What IBM says** (Enterprise COBOL for z/OS 6.3 Language Reference, JSON GENERATE: https://www.ibm.com/docs/SS6SG3_6.3.0/lr/ref/rlpsjsog.html and its sub-pages). Data names are written as they are spelled in the program (case and hyphens kept); the source group's own name wraps its members as `{"GROUP":{...}}`; trailing spaces of an alphanumeric item are trimmed, an all-space item becomes one space; `"` `\` and control characters are escaped; a number is written as edited (a leading `-` for a negative value, leading zeros dropped to one integer digit, the decimals kept, no sign for a positive value); COUNT IN receives the bytes generated; FILLER / unnamed items, REDEFINES items and groups whose members are all ignored are left out; names must be unique; SUPPRESS names an item (a group takes its subtree); SUPPRESS item WHEN names an elementary item and leaves it out when its value is one of the listed figuratives (ZERO is a numeric comparison for a number, SPACE / LOW-VALUE / HIGH-VALUE select USAGE DISPLAY items, of the numeric ones only integers), SUPPRESS EVERY [NUMERIC | NONNUMERIC] WHEN does so for every item of that class, and a group left with no member goes too while the source group itself is always written (`{"A":{}}`); NAME OF renames an item; a receiver too small raises the exception condition (JSON-CODE nonzero, receiver undefined; ON EXCEPTION runs, else NOT ON EXCEPTION).
+- **What IBM says** (Enterprise COBOL for z/OS 6.3 Language Reference, JSON GENERATE: https://www.ibm.com/docs/SS6SG3_6.3.0/lr/ref/rlpsjsog.html and its sub-pages). Data names are written as they are spelled in the program (case and hyphens kept); the source group's own name wraps its members as `{"GROUP":{...}}`; trailing spaces of an alphanumeric item are trimmed, an all-space item becomes one space; `"` `\` and control characters are escaped; a number is written as edited (a leading `-` for a negative value, leading zeros dropped to one integer digit, the decimals kept, no sign for a positive value); COUNT IN receives the bytes generated; FILLER / unnamed items, REDEFINES items and groups whose members are all ignored are left out; names must be unique; SUPPRESS names an item (a group takes its subtree); SUPPRESS item WHEN names an elementary item and leaves it out when its value is one of the listed figuratives (ZERO is a numeric comparison for a number, SPACE / LOW-VALUE / HIGH-VALUE select USAGE DISPLAY items, of the numeric ones only integers), SUPPRESS EVERY [NUMERIC | NONNUMERIC] WHEN does so for every item of that class, and a group left with no member goes too while the source group itself is always written (`{"A":{}}`); NAME OF renames an item; NAME OF the source IS OMITTED (with PTF for APAR PH18641) generates an anonymous JSON object whose top-level parent name is not written, so `{"A":{"B":1}}` becomes `{"B":1}` (IBM allows OMITTED only on identifier-2 itself; the pages show no example, so the anonymous object is read as the source group's `{members}` alone, and OMITTED on any other item is refused); a receiver too small raises the exception condition (JSON-CODE nonzero, receiver undefined; ON EXCEPTION runs, else NOT ON EXCEPTION).
 - **Modelled.** `det/stmt.py` `_json_generate` parses the statement, `det/gen.py` `json_generate` builds the member tree and refuses the shapes below by name, `cobolrt/JsonGenerate.java` writes the text as US-ASCII bytes into the receiver (the bytes past the text are untouched). A JSON statement it cannot take keeps the `JSON GENERATE (...): not modelled` hole text, with the reason for the shape appended.
 - **What we assume.** (1) The elementary-source wrapper and a negative zero are not stated precisely enough: each is refused, not guessed. (2) Output is 7-bit ASCII only (UTF-8 and the EBCDIC code page agree there); any other character is a runtime `Hole`. (3) Non-digit data in a numeric DISPLAY item is **undefined by IBM** (register C11, family U): a runtime `Hole`. (4) A receiver shorter than the text is IBM's exception condition. With ON EXCEPTION / NOT ON EXCEPTION the port takes the exception branch and leaves the receiver and COUNT IN as they were (IBM leaves them undefined, so a program reading them there reads undefined data); without either phrase and without JSON-CODE named the exception is a runtime `Hole`; a program that names JSON-CODE takes the exception branch too (JSON-CODE 1, below). (5) A fixed table or an OCCURS DEPENDING ON table (below) is an array under the item's name: an elementary item gives an array of values, a group an array of objects (IBM's table format); at most 256 items and elements are taken. A packed item with an invalid digit or sign nibble, or a binary item past its PICTURE digits, is undefined by IBM (C11): a runtime `Hole`. A COMP-5 item that overlaps another COMP-5 byte range is refused (its bytes are the oracle's). JSON PARSE keeps DISPLAY-only, table-free shapes. (6) IBM's DISPLAY has no ON EXCEPTION, so the phrases after a DISPLAY inside the first phrase belong to the JSON GENERATE. JSON PARSE and XML statements keep their phrases inside the hole.
-- **Status:** ASSUMED, **oracle-unbacked**. GnuCOBOL has no JSON statement (the equivalence harness cannot compare it), so no L2+ claim rests on this entry; a port using it is reported as assumed (IBM-documented). JSON PARSE (X77), JSON-STATUS, CONVERTING, NAME OMITTED and JSON PARSE tables are later slices of #7524.
+- **Status:** ASSUMED, **oracle-unbacked**. GnuCOBOL has no JSON statement (the equivalence harness cannot compare it), so no L2+ claim rests on this entry; a port using it is reported as assumed (IBM-documented). JSON PARSE (X77), CONVERTING, JSON-STATUS, NAME OMITTED on a member (IBM shows no example text: the reading above is an assumption) and JSON PARSE tables are later slices of #7524.
 - **SUPPRESS ... WHEN / EVERY (#7524).** The figuratives are read per the IBM page (ZERO / ZEROS / ZEROES, SPACE(S), LOW-VALUE(S), HIGH-VALUE(S), joined by OR). Assumed: ZERO on an alphanumeric item is an alphanumeric comparison with ZEROS (every character `0`); SPACE / LOW-VALUE / HIGH-VALUE compare the item's bytes (SPACE is the code page's blank); a number equal to zero is suppressed by ZERO, so invalid data in it is a runtime `Hole` (C11) and a negative zero stays one. A named WHEN on a group, or on a USAGE the figurative does not select, is refused by name; the generic phrase silently skips the items it does not select. An item inside an OCCURS table is refused by name (the LR does not say whether one element or the table goes). JSON PARSE keeps refusing WHEN / EVERY.
 - **JSON-CODE (#7524, #7709).** A program that names JSON-CODE gets a hidden item of IBM's declared shape, S9(9) BINARY, set to 0 after a JSON GENERATE that raised no exception (the LR states this) and to 1 after the exception "receiver too small" (Programming Guide, Table 107 as #7928 read it from IBM's PDF; not re-read here and not backed by an oracle). With ON EXCEPTION / NOT ON EXCEPTION the phrases run on that condition; without them control goes to the end of the statement. A program's own JSON-CODE item is kept. JSON PARSE sets the register from Table 109 (X77). JSON-STATUS is not modelled.
 - **OCCURS DEPENDING ON (#7524).** IBM (JSON GENERATE, SUPPRESS examples and Operation): a table is an array of as many elements as its ODO object holds, and a table with none is `[]` (a zero-occurrence group table shows no members). `cobolrt/JsonGenerate.table` takes the count at run time. What IBM's pages do not state is refused or a runtime `Hole`: a count outside the clause's bounds (undefined), and an ODO table inside another table (refused by name). JSON PARSE still refuses every table.

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

@@ -60,6 +60,28 @@ public static Node table(String name, int count, int low, String depending, Node
         return new Array(name, List.of(elements).subList(0, count));
     }
 
+    /**
+     * NAME OF the source IS OMITTED (IBM: an anonymous JSON object, the top-level parent name not generated): the text is
+     * the root group's `{members}` alone.
+     */
+    public static Node anonymous(Node root) {
+        return new Anonymous(root);
+    }
+
+    private static final class Anonymous extends Node {
+        final Node root;
+
+        Anonymous(Node root) {
+            super(root.name);
+            this.root = root;
+        }
+
+        @Override
+        void value(StringBuilder out, Charset cs) {
+            root.value(out, cs);
+        }
+    }
+
     /** A group: `"name":{members}` (an object, its members in storage order). */
     public static Node group(String name, Node... members) {
         return new Group(name, List.of(members));
@@ -98,9 +120,14 @@ public static int generate(Field into, Node root, Charset cs) {
      */
     // [rule RT-CBL-JSON-GENERATE]
     public static int tryGenerate(Field into, Node root, Charset cs) {
-        StringBuilder out = new StringBuilder("{");
-        root.render(out, cs);
-        out.append('}');
+        StringBuilder out = new StringBuilder();
+        if (root instanceof Anonymous a) {
+            a.value(out, cs);
+        } else {
+            out.append('{');
+            root.render(out, cs);
+            out.append('}');
+        }
         byte[] b = out.toString().getBytes(StandardCharsets.US_ASCII);
         if (b.length > into.length()) {
             return -1;

gitgalaxy/tools/cobol_to_java/det/gen.py

@@ -3248,7 +3248,16 @@ def json_tree(self, d: dict, cls: str, what: str, src_ref: E.Ref) -> str:
         DISPLAY alphanumeric / numeric items under their names (NAME OF literals applied, SUPPRESSed items left out).
         The oracle has no JSON statement, so the model is IBM's text alone (registers X76 / X77); what it does not define
         is refused by name."""
-        names = {id(self.resolve(r)): lit for r, lit in d["names"]}
+        names = {id(self.resolve(r)): lit for r, lit in d["names"] if lit is not None}
+        # #7524: NAME OF x IS OMITTED (IBM: an anonymous JSON object, the top-level parent name not generated; x must be
+        # identifier-2). The last NAME specification of the same item wins.
+        omitted = False
+        for r, lit in d["names"]:
+            if self.resolve(r) is not self.resolve(src_ref):
+                if lit is None:
+                    raise Untranslatable(f"{what}: NAME OF {r.name} IS OMITTED (IBM needs the source itself)")
+            else:
+                omitted = lit is None
         suppressed = {id(self.resolve(r)) for r in d["suppress"]}
         # #7524: SUPPRESS item WHEN figurative ... (an elementary item) and SUPPRESS EVERY [NUMERIC | NONNUMERIC] WHEN ...
         named_when: dict[int, list[str]] = {}
@@ -3350,7 +3359,8 @@ def node(it: L.Item, top: bool, idx: tuple[int, ...]) -> str | None:
                 )
             return f"__PACKAGE__.cobolrt.{cls}.array({jstr(name)}{''.join(', ' + str(e) for e in elems)})"
 
-        return node(src, True, ()) or ""
+        root = node(src, True, ()) or ""
+        return f"__PACKAGE__.cobolrt.{cls}.anonymous({root})" if omitted else root
 
     @staticmethod
     def json_when_fits(it: L.Item, value: str) -> bool:

gitgalaxy/tools/cobol_to_java/det/stmt.py

@@ -1459,14 +1459,19 @@ def starts(k: int) -> bool:
 _JSON_PHRASES = ("COUNT", "NAME", "SUPPRESS", "END-JSON", "WITH")
 
 
-def _json_name_phrase(p: E.Parser, names: list) -> None:
-    """NAME [OF] item [IS] literal ...: appends (item, literal text); anything but an alphanumeric literal raises."""
+def _json_name_phrase(p: E.Parser, names: list, omitted_ok: bool = False) -> None:
+    """NAME [OF] item [IS] literal ...: appends (item, literal text); anything but an alphanumeric literal raises.
+    #7524: `IS OMITTED` (JSON GENERATE only, `omitted_ok`) appends (item, None)."""
     p.take()
     p.accept("OF")
     start = len(names)
     while not p.done() and p.up() not in _JSON_PHRASES:
         item = p.ref()
         p.accept("IS")
+        if omitted_ok and p.up() == "OMITTED":
+            p.take()
+            names.append((item, None))
+            continue
         lit = p.operand()
         if not (isinstance(lit, E.Lit) and isinstance(lit.value, str)):
             raise E.ExprError("NAME needs an alphanumeric literal")
@@ -1527,9 +1532,9 @@ def _json_suppress_phrase(p: E.Parser, suppress: list, when: list | None = None,
 def _json_generate(text: str, line: int) -> Stmt:
     """#7524: JSON GENERATE identifier-1 FROM identifier-2 [COUNT [IN] identifier-3] [NAME [OF] identifier-4 [IS]
     literal-1 ...] [SUPPRESS identifier-5 ...] [END-JSON] (Enterprise COBOL 6.3 Language Reference, JSON GENERATE).
-    data: into, src, count, names [(item, literal text)], suppress [item], when [(item, [figurative])] (SUPPRESS item
+    data: into, src, count, names [(item, literal text | None for OMITTED)], suppress [item], when [(item, [figurative])] (SUPPRESS item
     WHEN), generic [(NUMERIC | NONNUMERIC | None, [figurative])] (SUPPRESS EVERY ... WHEN). Everything else IBM defines
-    on the statement (CONVERTING, NAME OMITTED, a literal that is not alphanumeric)
+    on the statement (CONVERTING, a literal that is not alphanumeric)
     raises ExprError, and the caller holes the statement with that as the shape."""
     p = E.Parser(E.tokenize(text)[2:])
     into = p.ref()
@@ -1548,7 +1553,7 @@ def _json_generate(text: str, line: int) -> Stmt:
             p.accept("IN")
             count = p.ref()
         elif u == "NAME":
-            _json_name_phrase(p, names)
+            _json_name_phrase(p, names, True)
         elif u == "SUPPRESS":
             _json_suppress_phrase(p, suppress, when, generic)
         elif u == "END-JSON":