det: JSON GENERATE CONVERTING ... TO JSON BOOLEAN (Part of #7524, #7709)

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": []},
@@ -1009,6 +1009,7 @@
     {"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.bool(String,boolean)", "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"]},
       {"id": "cobolrt.JsonGenerate.number(String,Field,String...)", "kind": "method", "static": true, "returns": "cobolrt.JsonGenerate.Node", "visibility": "internal", "evidence": ["harness"]},

docs/language_status/cobolrt_rules.json

@@ -118,8 +118,10 @@
     "array",
     "table",
     "anonymous",
+    "bool",
     "read",
     "invalid",
+    "floatText",
     "skip",
     "allBytes",
     "text",
@@ -605,7 +607,7 @@
   {
    "id": "RT-CBL-JSON-GENERATE",
    "family": "CBL",
-   "title": "JSON GENERATE from a group of DISPLAY, COMP / COMP-3 / COMP-5 items and fixed tables (an array per table): names as written, members in storage order, trailing blanks trimmed, numbers as edited, bytes written to the receiver and counted; a receiver too small is the exception condition under ON EXCEPTION (else a Hole), SUPPRESS ... WHEN / EVERY leaves out an item whose value is ZERO / SPACE / LOW-VALUE / HIGH-VALUE, non-digit numeric data is a Hole (the oracle has no JSON statement)",
+   "title": "JSON GENERATE from a group of DISPLAY, COMP / COMP-3 / COMP-5 / COMP-1 items and fixed tables (an array per table), CONVERTING ... TO JSON BOOLEAN (true on a match, else false): names as written, members in storage order, trailing blanks trimmed, numbers as edited, bytes written to the receiver and counted; a receiver too small is the exception condition under ON EXCEPTION (else a Hole), SUPPRESS ... WHEN / EVERY leaves out an item whose value is ZERO / SPACE / LOW-VALUE / HIGH-VALUE, non-digit numeric data is a Hole (the oracle has no JSON statement)",
    "methods": [
     "generate",
     "tryGenerate"

docs/language_status/register/X76.md

@@ -2,9 +2,9 @@
 id: "X76"
 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)"
+title: "JSON GENERATE from a group of DISPLAY, COMP / COMP-3 / COMP-5 / COMP-1 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 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"
+summary: "JSON GENERATE identifier-1 FROM group [COUNT IN] [NAME OF ... IS literal | OMITTED] [SUPPRESS item [WHEN ...] | EVERY [NUMERIC | NONNUMERIC] WHEN ...] [CONVERTING item TO JSON BOOLEAN USING 88 | literal [ALSO ...]] over DISPLAY alphanumeric, fixed-point numeric (DISPLAY, COMP, COMP-3, COMP-5, COMP-1) 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 ... TO JSON NULL, NAME OMITTED on a member, an ODO table inside another table or with an out-of-range count, a table as the source itself, COMP-2 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; 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).
@@ -14,3 +14,5 @@ reached: "no (no burned program uses JSON; fixture tests/cobol_mainframe/test_de
 - **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.
+- **COMP-1 (#7524).** IBM (JSON GENERATE, format conversion of elementary data): an internal floating-point item is converted as if moved to an external floating-point item, COMP-1 with PICTURE `-9.9(8)E+99`, then trimmed: `1.50000000E+00`, `-1.50000000E-05` (a sign only when negative, the exponent always signed, two digits). Only the item's value is read (register C6: the bytes are the oracle's). Assumed: the nine-digit mantissa is rounded half away from zero (the rule RT-HFP-DISPLAY already ASSUMES for DISPLAY); a value of zero is a runtime `Hole` (IBM's trimming of `0.00000000E+00` is not stated). COMP-2 is refused by name: IBM's own picture `-9.9(17)E+99` is stated to be illegal. SUPPRESS ... WHEN ZERO is a numeric comparison for a COMP-1; SPACE / LOW-VALUE / HIGH-VALUE do not select it. JSON PARSE refuses floats.
+- **CONVERTING ... TO JSON BOOLEAN (#7524).** IBM (JSON GENERATE, converting phrase format 1, Enterprise COBOL 6.4 Language Reference: https://www.ibm.com/docs/en/SS6SG3_6.4.0/lr/ref/rlpsjsog.html): identifier-7 is a single-byte alphanumeric elementary item (PIC X); a value matching the condition-name (an 88 directly under it, values or ranges) or the single-byte literal is generated as JSON `true`, every other value as `false`; `ALSO` lists several. Translated as a runtime boolean from the existing comparison / condition-name test (`JsonGenerate.bool`). Refused by name: an item that is not one-byte PIC X, an 88 not directly under the item, a literal longer than one byte, an item in a table (IBM does not say how elements are named), and the same item named in SUPPRESS ... WHEN / EVERY (IBM does not state the interaction). The phrase is a 6.4 addition (the 6.3 page this entry otherwise follows has none); the release that introduced it is not stated on the page and is not claimed here. Not backed by an oracle. Still refused: `TO JSON NULL USING figurative` (format 2) and JSON PARSE CONVERTING.

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

@@ -97,6 +97,28 @@ public static Node number(String name, Field f, String... when) {
         return new Number(name, f, when);
     }
 
+    /**
+     * CONVERTING item TO JSON BOOLEAN USING ... (IBM 6.4): `"name":true` when the item matches the condition-name or the
+     * literal, `"name":false` for every other value.
+     */
+    public static Node bool(String name, boolean matches) {
+        return new Bool(name, matches);
+    }
+
+    private static final class Bool extends Node {
+        final boolean matches;
+
+        Bool(String name, boolean matches) {
+            super(name);
+            this.matches = matches;
+        }
+
+        @Override
+        void value(StringBuilder out, Charset cs) {
+            out.append(matches ? "true" : "false");
+        }
+    }
+
     /**
      * Writes `{root}` to `into` (the root's name is the source group's, or its NAME literal) and returns the
      * number of bytes generated (COUNT IN). `when` on an item (ZERO, SPACE, LOW-VALUE, HIGH-VALUE) is SUPPRESS ... WHEN:
@@ -324,6 +346,11 @@ private BigDecimal read(Charset cs) {
                 negZero = f.isSigned() && (sign == 0x0B || sign == 0x0D);
             } else if (f.kind() == Field.Kind.NUMERIC_BINARY) {
                 negZero = false;
+            } else if (f.kind() == Field.Kind.NUMERIC_FLOAT) {
+                if (f.len != 4) {
+                    throw new Hole("JSON GENERATE: " + name + " is a COMP-2; IBM's conversion picture for it is illegal");
+                }
+                return Hfp.read(f);
             } else {
                 throw new Hole("JSON GENERATE: " + name + " is not a DISPLAY, packed or binary number");
             }
@@ -339,6 +366,25 @@ private BigDecimal read(Charset cs) {
             return v;
         }
 
+        /**
+         * IBM: a COMP-1 is converted as if moved to PICTURE -9.9(8)E+99 and trimmed: `-1.50000000E+00` (a sign only when
+         * negative, one digit, the point, eight digits, E, the exponent's sign, two digits). ASSUMED: the mantissa is
+         * rounded half away from zero (as Hfp.display, RT-HFP-DISPLAY); zero is a Hole (IBM's trimming of "0.0..." is
+         * not stated).
+         */
+        private String floatText(BigDecimal v) {
+            if (v.signum() == 0) {
+                throw new Hole("JSON GENERATE: " + name + " holds zero; IBM's trimming of the float picture is not stated");
+            }
+            BigDecimal r = v.abs().round(new java.math.MathContext(9, java.math.RoundingMode.HALF_UP));
+            int exp = r.precision() - r.scale() - 1;
+            String d = r.unscaledValue().toString();
+            d = d + "0".repeat(9 - d.length());
+            String e = String.valueOf(Math.abs(exp));
+            return (v.signum() < 0 ? "-" : "") + d.charAt(0) + "." + d.substring(1) + "E" + (exp < 0 ? "-" : "+")
+                    + (e.length() < 2 ? "0" : "") + e;
+        }
+
         private Hole invalid() {
             return new Hole("JSON GENERATE: non-digit data in numeric item " + name
                     + "; IBM documents no result (undefined by IBM, register C11)");
@@ -347,6 +393,10 @@ private Hole invalid() {
         @Override
         void value(StringBuilder out, Charset cs) {
             BigDecimal v = read(cs);
+            if (f.kind() == Field.Kind.NUMERIC_FLOAT) {
+                out.append(floatText(v));
+                return;
+            }
             String digits = v.abs().setScale(f.scale()).toPlainString();
             int dot = digits.indexOf('.');
             int cut = 0;