det: JSON PARSE fills fixed OCCURS tables from a JSON array (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": 1201, "members_public": 810, "members_internal": 391},
+  "summary": {"types": 128, "types_public": 105, "members": 1202, "members_public": 811, "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": []},
@@ -1019,6 +1019,7 @@
     {"id": "cobolrt.JsonGenerate.Node", "kind": "class", "source": "gitgalaxy/tools/cobol_to_java/det/cobolrt/JsonGenerate.java", "variants": ["det-batch", "det-standalone", "sort-job"], "supers": [], "visibility": "public", "evidence": ["signature", "harness", "runtime"], "members": [
     ]},
     {"id": "cobolrt.JsonParse", "kind": "class", "source": "gitgalaxy/tools/cobol_to_java/det/cobolrt/JsonParse.java", "variants": ["det-batch", "det-standalone", "sort-job"], "supers": [], "visibility": "public", "evidence": ["emitter", "emitter-dynamic", "signature", "harness", "runtime"], "members": [
+      {"id": "cobolrt.JsonParse.array(String,Node...)", "kind": "method", "static": true, "returns": "cobolrt.JsonParse.Node", "visibility": "public", "evidence": ["emitter-dynamic", "harness"]},
       {"id": "cobolrt.JsonParse.group(String,Node...)", "kind": "method", "static": true, "returns": "cobolrt.JsonParse.Node", "visibility": "public", "evidence": ["emitter-dynamic", "harness"]},
       {"id": "cobolrt.JsonParse.number(String,Field)", "kind": "method", "static": true, "returns": "cobolrt.JsonParse.Node", "visibility": "public", "evidence": ["harness"]},
       {"id": "cobolrt.JsonParse.parse(Field,Node,Charset)", "kind": "method", "static": true, "returns": "void", "visibility": "public", "evidence": ["emitter", "harness"]},

docs/language_status/register/X77.md

@@ -4,11 +4,12 @@ family: "X"
 status: "ASSUMED"
 title: "JSON PARSE into a group of DISPLAY, COMP, COMP-3 and COMP-5 items is translated from IBM's text alone — ASSUMED, oracle-unbacked (#7524)"
 area: "COBOL"
-summary: "JSON PARSE source [WITH DETAIL] INTO group [NAME OF ... IS] [SUPPRESS item] over DISPLAY alphanumeric text and fixed-point numbers (DISPLAY, COMP, COMP-3 / PACKED-DECIMAL, COMP-5) is generated as a runtime call that reads one JSON object and stores its members by name. GnuCOBOL has no JSON statement, so nothing backs it: no L2+ claim. ON EXCEPTION / NOT ON EXCEPTION are modelled for malformed text, a non-object, a type mismatch, empty text, text after the closing brace and no name matching (the exception condition). JSON-CODE after an exception (100 invalid text, 101 empty, 102 text after the closing brace, 104 incompatible value, 106 no name matched) is set from IBM's Programming Guide table; JSON-STATUS is set to the nonexception bits of a successful parse (a program naming it after an exception stays a runtime Hole); SUPPRESS WHEN / EVERY, CONVERTING, NAME OMITTED, tables, float items, an elementary receiver and any character beyond ASCII stay holes or runtime Holes"
+summary: "JSON PARSE source [WITH DETAIL] INTO group [NAME OF ... IS] [SUPPRESS item] over DISPLAY alphanumeric text and fixed-point numbers (DISPLAY, COMP, COMP-3 / PACKED-DECIMAL, COMP-5) is generated as a runtime call that reads one JSON object and stores its members by name. GnuCOBOL has no JSON statement, so nothing backs it: no L2+ claim. ON EXCEPTION / NOT ON EXCEPTION are modelled for malformed text, a non-object, a type mismatch, empty text, text after the closing brace and no name matching (the exception condition). JSON-CODE after an exception (100 invalid text, 101 empty, 102 text after the closing brace, 104 incompatible value, 106 no name matched) is set from IBM's Programming Guide table; JSON-STATUS is set to the nonexception bits of a successful parse (a program naming it after an exception stays a runtime Hole); SUPPRESS WHEN / EVERY, CONVERTING, NAME OMITTED, OCCURS DEPENDING ON tables, float items, an elementary receiver and any character beyond ASCII stay holes or runtime Holes"
 reached: "no (no burned program uses JSON; fixture tests/cobol_mainframe/test_det_json_parse.py)"
 ---
 - **What IBM says** (Enterprise COBOL for z/OS 6.3 Language Reference, JSON PARSE: https://www.ibm.com/docs/SS6SG3_6.3.0/lr/ref/rlpsjsop.html and its sub-pages). The members of the JSON object are matched by name to the subordinate items of the receiving group; a JSON name with no data item is ignored and an item with no JSON member is left unchanged; NAME OF renames an item, SUPPRESS leaves one out; a string goes to an alphanumeric item (left-justified, padded with spaces) and a number to a numeric item (aligned on the decimal point); WITH DETAIL only widens what the exception condition reports. A text that is not valid JSON, or a value that does not fit or has the wrong type, raises the exception condition (JSON-CODE nonzero, ON EXCEPTION).
 - **Modelled.** `det/stmt.py` `_json_parse` parses the statement, `det/gen.py` `json_parse` builds the receiving tree (shared with JSON GENERATE through `json_tree`) and refuses the shapes below by name, `cobolrt/JsonParse.java` reads and stores. A statement it cannot take keeps the `JSON PARSE (...): not modelled` hole text, with the reason for the shape appended.
 - **What we assume.** (1) The text is one JSON object whose members map to the group's subordinates; the group's own name is not in the text (unlike the GENERATE wrapper). (2) Names match case-sensitively and exactly. (3) The exception condition (#7524): with ON EXCEPTION / NOT ON EXCEPTION, malformed text, text that is not a JSON object, a value of the wrong type, empty text, text after the closing brace and no name matching raise it (ON EXCEPTION runs, else NOT ON EXCEPTION); without the phrases each is a runtime `Hole`. Malformed text and text after the closing brace store nothing; after a type or size failure the items matched before it keep the values stored (assumed: IBM's text is read as leaving the receiver unspecified, the model stores left to right). A string longer than its item and a number too large for it are nonexception in IBM (JSON-STATUS 256 / 128, stored anyway, in a form the text does not state), so they are a `Hole`; so are a JSON array, `true`, `false`, `null`, a non-object top level (no JSON-CODE stated), and JSON-STATUS after an exception. A number with more decimals than the item, a negative number for an unsigned item, an exponent, a repeated name in one object and any character beyond ASCII are a `Hole` even with the phrases, never a guess. JSON-CODE (S9(9) BINARY) is the exception code of the Programming Guide's Table 109 and 0 on success; JSON-STATUS (#7709): a program that names it and has a JSON PARSE gets a hidden item of IBM's declared shape, `PICTURE S9(9) USAGE BINARY VALUE 0` (a JSON GENERATE alone does not: IBM does not say it sets the register, so the name stays unresolved and the port is refused). After a parse with no exception it holds the runtime's bits 1 (a data item had no pair) and 2 (a pair matched no item) of Table 108, 0 when neither happened. Assumed: the register is reset at each JSON PARSE (IBM: it holds the conditions "at termination of a JSON PARSE statement"; the reset rule is not stated). After an exception its value (the bits seen before it) is a runtime `Hole`, never a guess. A program's own JSON-STATUS item is kept. A program's own JSON-CODE item is kept. The hidden JSON-CODE register is S9(9) BINARY, IBM's declared shape (#7709). (4) WITH DETAIL changes nothing the model reports, since only the exception condition uses it.
-- **Packed and binary numbers (#7524, #7709).** A COMP / COMP-3 / COMP-5 numeric receiver takes the number by the same rules as a DISPLAY one (decimal alignment, no extra decimals, no negative for an unsigned item, a value past the PICTURE digits is the exception condition); the store is the runtime's `Cobol.store`, IBM's text states no other byte layout. A table receiver stays refused for PARSE.
-- **Status:** ASSUMED, **oracle-unbacked**; a port using it is reported as assumed (IBM-documented). JSON-STATUS bits 4-512 (duplicate names, tables, null, which the model refuses or does not reach), JSON-STATUS after an exception, SUPPRESS WHEN / EVERY, CONVERTING and the wider item kinds are later slices of #7524.
+- **Packed and binary numbers (#7524, #7709).** A COMP / COMP-3 / COMP-5 numeric receiver takes the number by the same rules as a DISPLAY one (decimal alignment, no extra decimals, no negative for an unsigned item, a value past the PICTURE digits is the exception condition); the store is the runtime's `Cobol.store`, IBM's text states no other byte layout. A fixed OCCURS table receiver is taken (next bullet); an OCCURS DEPENDING ON receiver stays refused for PARSE.
+- **Fixed tables (#7524).** A fixed `OCCURS` item (elementary or group elements, nested fixed tables too) in the receiving group is a JSON array under the item's name (IBM's table format, the one JSON GENERATE writes): element k of the array goes to occurrence k, by the scalar rules above (a group element is an object matched by name). A value that is not an array is a type mismatch (JSON-CODE 104). Assumed-not-guessed: an array with more or fewer elements than the OCCURS count is a runtime `Hole` (IBM's pages do not state it); a top-level array stays a `Hole`; `null`, `true` and `false` elements stay a `Hole`. Items stored before a failing element keep their values (as above). A table as the receiving item itself is refused.
+- **Status:** ASSUMED, **oracle-unbacked**; a port using it is reported as assumed (IBM-documented). JSON-STATUS bits 4-512 (duplicate names, null, which the model refuses or does not reach), JSON-STATUS after an exception, CONVERTING, ODO tables and float items are later slices of #7524 (SUPPRESS WHEN / EVERY is a JSON GENERATE phrase in IBM's syntax, not a PARSE gap).

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

@@ -59,6 +59,11 @@ public static Node number(String name, Field f) {
         return new Num(name, f);
     }
 
+    /** A fixed OCCURS table: a JSON array under the item's name, one element node per occurrence. */
+    public static Node array(String name, Node... elements) {
+        return new Array(name, List.of(elements));
+    }
+
     /** The exception condition of IBM's definition (JSON-CODE nonzero): caught by tryParse, else a Hole. */
     private static final class JsonError extends Hole {
         /** IBM's JSON-CODE for this exception, or -1 when the Programming Guide does not state it for this shape. */
@@ -124,6 +129,9 @@ private static void parse(Field src, Node root, Charset cs, int[] status) {
         }
         Object v = r.value();
         r.ws();
+        if (v instanceof List) {
+            throw new Hole("JSON PARSE: a top-level JSON array is not modelled; the Programming Guide states no JSON-CODE for it");
+        }
         if (!(v instanceof Members)) {
             throw new JsonError("JSON PARSE: the text is not a JSON object; the Programming Guide states no JSON-CODE for it", -1);
         }
@@ -189,6 +197,31 @@ void accept(Object value, Ctx c) {
         }
     }
 
+    private static final class Array extends Node {
+        final List<Node> elements;
+
+        Array(String name, List<Node> elements) {
+            super(name);
+            this.elements = elements;
+        }
+
+        @Override
+        void accept(Object value, Ctx c) {
+            if (!(value instanceof List)) {
+                throw new JsonError("JSON PARSE: " + name + " is a table but the JSON value is not an array (JSON-CODE 104)", 104);
+            }
+            List<?> a = (List<?>) value;
+            if (a.size() != elements.size()) {
+                // IBM's pages do not say what an array of another length does to a fixed OCCURS table
+                throw new Hole("JSON PARSE: " + a.size() + " array elements for " + name + " of OCCURS " + elements.size()
+                        + "; IBM does not state the result (not modelled)");
+            }
+            for (int k = 0; k < a.size(); k++) {
+                elements.get(k).accept(a.get(k), c);
+            }
+        }
+    }
+
     private static final class Text extends Node {
         final Field f;
 
@@ -277,12 +310,39 @@ Object value() {
             if (c == '-' || (c >= '0' && c <= '9')) {
                 return number();
             }
-            if (c == '[' || s.startsWith("true", i) || s.startsWith("false", i) || s.startsWith("null", i)) {
-                throw new Hole("JSON PARSE: a JSON array, true, false or null at offset " + i + " is not modelled");
+            if (c == '[') {
+                return array();
+            }
+            if (s.startsWith("true", i) || s.startsWith("false", i) || s.startsWith("null", i)) {
+                throw new Hole("JSON PARSE: true, false or null at offset " + i + " is not modelled");
             }
             throw bad("a malformed value");
         }
 
+        List<Object> array() {
+            List<Object> a = new ArrayList<>();
+            i++;
+            ws();
+            if (i < s.length() && s.charAt(i) == ']') {
+                i++;
+                return a;
+            }
+            while (true) {
+                ws();
+                a.add(value());
+                ws();
+                if (i < s.length() && s.charAt(i) == ',') {
+                    i++;
+                    continue;
+                }
+                if (i < s.length() && s.charAt(i) == ']') {
+                    i++;
+                    return a;
+                }
+                throw bad("a comma or closing bracket was expected");
+            }
+        }
+
         Members object() {
             Members m = new Members();
             i++;

gitgalaxy/tools/cobol_to_java/det/gen.py

@@ -3274,7 +3274,7 @@ def json_tree(self, d: dict, cls: str, what: str, src_ref: E.Ref) -> str:
         if src.category != "GROUP" or src_ref.subscripts or src_ref.refmod is not None:
             raise Untranslatable(f"{what}: {src.name} is not a plain group (an elementary item is not modelled)")
         seen: set[str] = set()
-        wide = cls == "JsonGenerate"  # #7524: tables are modelled for GENERATE only
+        wide = cls == "JsonGenerate"  # #7524: floats and OCCURS DEPENDING ON tables are modelled for GENERATE only
         leaves = [0]
 
         def elem(it: L.Item, name: str, idx: tuple[int, ...], top: bool = False) -> str | None:
@@ -3341,8 +3341,10 @@ def node(it: L.Item, top: bool, idx: tuple[int, ...]) -> str | None:
             """The Java node of `it`, or None when IBM leaves it out (FILLER, REDEFINES, SUPPRESSed, an empty group)."""
             if it.name.upper() == "FILLER" or it.redefines:
                 return None
-            if it.occurs != 1 and (not wide or top):
+            if it.occurs != 1 and top:
                 raise Untranslatable(f"{what}: {it.name} is a table (OCCURS is not modelled)")
+            if it.depending and not wide:
+                raise Untranslatable(f"{what}: {it.name} is OCCURS DEPENDING ON (modelled for JSON GENERATE only)")
             if it.depending and idx:
                 # IBM's pages do not say how a variable-length table inside another table is generated: refused
                 raise Untranslatable(f"{what}: {it.name} is OCCURS DEPENDING ON inside another table (not modelled)")

tests/cobol_mainframe/test_det_json_generate.py

@@ -343,20 +343,19 @@ def test_an_odo_table_inside_another_table_is_refused(tmp_path):
 
 def test_parse_still_refuses_an_odo_table(tmp_path):
     r = _wide(tmp_path, "JSON PARSE OUT INTO REC", data=ODO_DATA)
-    assert len(r.stats["holes"]) == 1 and "table" in str(r.stats["holes"][0])
+    assert len(r.stats["holes"]) == 1 and "OCCURS DEPENDING ON" in str(r.stats["holes"][0])
 
 
 def test_a_table_as_the_source_itself_is_still_refused(tmp_path):
     r = _wide(tmp_path, "JSON GENERATE OUT FROM LINES-T")
     assert len(r.stats["holes"]) == 1 and "table" in str(r.stats["holes"][0])
 
 
-def test_parse_does_not_take_what_only_generate_models(tmp_path):
-    """JSON PARSE takes COMP numbers (#7524, X77) but still refuses tables (a sibling slice)."""
+def test_parse_takes_a_fixed_table_but_not_what_only_generate_models(tmp_path):
+    """JSON PARSE takes COMP numbers and fixed tables (#7524, X77); floats and ODO tables stay GENERATE-only."""
     r = _wide(tmp_path, "JSON PARSE OUT INTO REC")
-    assert (
-        len(r.stats["holes"]) == 1 and "JSON PARSE" in str(r.stats["holes"][0]) and "table" in str(r.stats["holes"][0])
-    )
+    assert r.stats["holes"] == [] or "JSON PARSE" in str(r.stats["holes"][0])
+    assert not any("is a table" in str(h) for h in r.stats["holes"])
 
 
 @pytest.mark.skipif(_jdk() is None, reason="needs a JDK 17 (JAVA_HOME / JDK_17)")