diff --git a/docs/language_status/cobolrt_api.json b/docs/language_status/cobolrt_api.json index 12b9faef4..7fad936c8 100644 --- a/docs/language_status/cobolrt_api.json +++ b/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.(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"]}, diff --git a/docs/language_status/cobolrt_rules.json b/docs/language_status/cobolrt_rules.json index 7fe3474bb..b4602928b 100644 --- a/docs/language_status/cobolrt_rules.json +++ b/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" diff --git a/docs/language_status/register/X76.md b/docs/language_status/register/X76.md index 25508891e..e272d053c 100644 --- a/docs/language_status/register/X76.md +++ b/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. diff --git a/gitgalaxy/tools/cobol_to_java/det/cobolrt/JsonGenerate.java b/gitgalaxy/tools/cobol_to_java/det/cobolrt/JsonGenerate.java index d22c2636b..efb8f4149 100644 --- a/gitgalaxy/tools/cobol_to_java/det/cobolrt/JsonGenerate.java +++ b/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; diff --git a/gitgalaxy/tools/cobol_to_java/det/gen.py b/gitgalaxy/tools/cobol_to_java/det/gen.py index 3f513f5c1..6b9e388e1 100644 --- a/gitgalaxy/tools/cobol_to_java/det/gen.py +++ b/gitgalaxy/tools/cobol_to_java/det/gen.py @@ -3270,6 +3270,30 @@ def json_tree(self, d: dict, cls: str, what: str, src_ref: E.Ref) -> str: if any(v != "ZERO" and not self.json_when_fits(w, v) for v in vals): raise Untranslatable(f"{what}: SUPPRESS {w.name} WHEN {' OR '.join(vals)} does not fit its usage") named_when.setdefault(id(w), []).extend(vals) + # #7524: CONVERTING item TO JSON BOOLEAN USING condition-name | literal (IBM 6.4: true when the item matches, else + # false; identifier-7 a single-byte PIC X elementary item, the 88 directly subordinate to it). + bool_tests: dict[int, str] = {} + for r, test in d.get("bools", []): + b = self.resolve(r) + if ( + r.subscripts + or r.refmod is not None + or b.category != "ALPHANUMERIC" + or b.usage != "DISPLAY" + or b.size != 1 + ): + raise Untranslatable(f"{what}: CONVERTING TO JSON BOOLEAN needs a one-byte PIC X item, not {b.name}") + if isinstance(test, str): + if len(test) != 1: + raise Untranslatable(f"{what}: CONVERTING ... USING {test!r} is not a single-byte literal") + bool_tests[id(b)] = self.cond(E.Rel("=", r, E.Lit(test))) + else: + cn = self.resolve_cond(test) + if cn is None or cn.parent is not b: + raise Untranslatable( + f"{what}: CONVERTING ... USING {test.name} is not an 88 directly under {b.name}" + ) + bool_tests[id(b)] = self.cond(E.CondName(test)) src = self.resolve(src_ref) 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)") @@ -3284,26 +3308,56 @@ def elem(it: L.Item, name: str, idx: tuple[int, ...], top: bool = False) -> str if not kids and not top: return None # a group whose members are all ignored is ignored return f"__PACKAGE__.cobolrt.{cls}.group({jstr(name)}{''.join(', ' + k for k in kids)})" - numeric = it.category == "NUMERIC" - if it.category not in ("ALPHANUMERIC", "ALPHABETIC", "NUMERIC"): + numeric = it.category in ("NUMERIC", "FLOAT") + if it.category == "FLOAT": + # IBM (JSON GENERATE, format conversion of elementary data): a COMP-1 is converted as if moved to + # PICTURE -9.9(8)E+99; for a COMP-2 IBM's own picture is illegal. Only the value is read (X76). + if not wide: + raise Untranslatable( + f"{what}: {it.name} is {it.usage} (a float is modelled for JSON GENERATE only)" + ) + if it.usage != "COMP-1": + raise Untranslatable( + f"{what}: {it.name} is {it.usage}; IBM's conversion picture -9.9(17)E+99 is illegal (not modelled)" + ) + elif it.category not in ("ALPHANUMERIC", "ALPHABETIC", "NUMERIC"): raise Untranslatable( f"{what}: {it.name} is {it.usage} {it.category} (only text and numbers are modelled)" ) - if it.usage != "DISPLAY" and not (numeric and it.usage in ("BINARY", "COMP-5", "PACKED")): + if ( + it.category != "FLOAT" + and it.usage != "DISPLAY" + and not (numeric and it.usage in ("BINARY", "COMP-5", "PACKED")) + ): raise Untranslatable( f"{what}: {it.name} is {it.usage} {it.category} (only DISPLAY text and numbers are modelled)" ) if numeric and (it.p_scaled or it.scale < 0 or it.sign_separate or it.sign_leading): raise Untranslatable(f"{what}: {it.name} is a P-scaled or separately signed number (not modelled)") - if self.overlaps_float(it) is not None or self.check_lift(it): + if it.category != "FLOAT" and (self.overlaps_float(it) is not None or self.check_lift(it)): raise Untranslatable(f"{what}: {it.name} overlaps a float or lifted item") - if it.usage != "COMP-5" and self.overlaps_float(it, self.comp5_extents) is not None: + if ( + it.category != "FLOAT" + and it.usage != "COMP-5" + and self.overlaps_float(it, self.comp5_extents) is not None + ): raise Untranslatable( f"{what}: {it.name} overlaps a COMP-5 item (its bytes are the oracle's, not z/OS's)" ) f = self.ids.get(id(it)) if f is None: raise Untranslatable(f"{what}: {it.name} has no storage name") + if id(it) in bool_tests: + if idx or it.occurs != 1: + raise Untranslatable( + f"{what}: CONVERTING TO JSON BOOLEAN on {it.name}, an item in a table (not modelled)" + ) + if id(it) in named_when or d["generic"]: + raise Untranslatable( + f"{what}: CONVERTING TO JSON BOOLEAN with SUPPRESS ... WHEN (IBM does not state it)" + ) + leaves[0] += 1 + return f"__PACKAGE__.cobolrt.{cls}.bool({jstr(name)}, {bool_tests[id(it)]})" for lvl, k in zip(_occurs_chain(it), idx, strict=False): f += f".at({k}, {lvl.size})" leaves[0] += 1 diff --git a/gitgalaxy/tools/cobol_to_java/det/stmt.py b/gitgalaxy/tools/cobol_to_java/det/stmt.py index df8bccea5..ed79fe4ad 100644 --- a/gitgalaxy/tools/cobol_to_java/det/stmt.py +++ b/gitgalaxy/tools/cobol_to_java/det/stmt.py @@ -1456,7 +1456,7 @@ def starts(k: int) -> bool: return "".join(out) + text[last:] -_JSON_PHRASES = ("COUNT", "NAME", "SUPPRESS", "END-JSON", "WITH") +_JSON_PHRASES = ("COUNT", "NAME", "SUPPRESS", "END-JSON", "WITH", "CONVERTING") def _json_name_phrase(p: E.Parser, names: list, omitted_ok: bool = False) -> None: @@ -1501,6 +1501,34 @@ def _json_when(p: E.Parser) -> list[str]: return vals +def _json_converting_phrase(p: E.Parser, bools: list) -> None: + """#7524: CONVERTING item TO [JSON] {BOOLEAN | BOOL} USING {condition-name | literal} [ALSO ...] (Enterprise COBOL 6.4 LR, + JSON GENERATE, format 1): appends (item, condition-name ref | alphanumeric literal text). The TO JSON NULL format + raises ExprError (a later slice).""" + p.take() + while True: + item = p.ref() + if not p.accept("TO"): + raise E.ExprError("CONVERTING without TO") + p.accept("JSON") + if p.up() not in ("BOOLEAN", "BOOL"): + raise E.ExprError(f"CONVERTING TO {p.up()}") + p.take() + if not p.accept("USING"): + raise E.ExprError("CONVERTING without USING") + if p.up() in ("ALSO", "END-JSON", None): + raise E.ExprError("CONVERTING USING nothing") + test = p.operand() + if isinstance(test, E.Lit) and isinstance(test.value, str): + bools.append((item, test.value)) + elif isinstance(test, E.Ref): + bools.append((item, test)) + else: + raise E.ExprError("CONVERTING USING needs a condition-name or an alphanumeric literal") + if not p.accept("ALSO"): + return + + def _json_suppress_phrase(p: E.Parser, suppress: list, when: list | None = None, generic: list | None = None) -> None: """SUPPRESS {item [WHEN figurative [OR ...]]} ... | EVERY [NUMERIC | NONNUMERIC] WHEN figurative [OR ...]: appends the unconditional items to `suppress`, (item, [figurative]) to `when` and (class or None, [figurative]) to @@ -1534,7 +1562,7 @@ def _json_generate(text: str, line: int) -> Stmt: literal-1 ...] [SUPPRESS identifier-5 ...] [END-JSON] (Enterprise COBOL 6.3 Language Reference, JSON GENERATE). 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, a literal that is not alphanumeric) + on the statement (CONVERTING ... TO JSON NULL, 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() @@ -1546,6 +1574,7 @@ def _json_generate(text: str, line: int) -> Stmt: suppress: list[E.Ref] = [] when: list[tuple[E.Ref, list[str]]] = [] generic: list[tuple[str | None, list[str]]] = [] + bools: list[tuple[E.Ref, E.Ref | str]] = [] while not p.done(): u = p.up() if u == "COUNT": @@ -1556,6 +1585,8 @@ def _json_generate(text: str, line: int) -> Stmt: _json_name_phrase(p, names, True) elif u == "SUPPRESS": _json_suppress_phrase(p, suppress, when, generic) + elif u == "CONVERTING": + _json_converting_phrase(p, bools) elif u == "END-JSON": p.take() else: @@ -1572,6 +1603,7 @@ def _json_generate(text: str, line: int) -> Stmt: "suppress": suppress, "when": when, "generic": generic, + "bools": bools, }, ) diff --git a/tests/cobol_mainframe/test_det_json_generate.py b/tests/cobol_mainframe/test_det_json_generate.py index 38dc65102..3a78dac1a 100644 --- a/tests/cobol_mainframe/test_det_json_generate.py +++ b/tests/cobol_mainframe/test_det_json_generate.py @@ -50,6 +50,12 @@ def _translate(tmp_path, *body: str): return P.translate(src, [], "public class ProgService { }", "t") +def test_a_comp1_item_is_a_number_node_and_comp2_is_refused(tmp_path): + data = WIDE.replace(" 01 OUT", " 05 FL COMP-1.\n 01 OUT") + r = _wide(tmp_path, "JSON GENERATE OUT FROM REC", data=data) + assert r.stats["holes"] == [] and 'JsonGenerate.number("FL"' in str(r.java) + + def test_a_group_source_is_a_runtime_call_with_its_members_in_storage_order(tmp_path): r = _translate(tmp_path, "JSON GENERATE OUT FROM REC COUNT IN N") assert r.stats["holes"] == [] @@ -70,10 +76,9 @@ def test_name_of_and_suppress_shape_the_members(tmp_path): ("JSON GENERATE OUT FROM REC SUPPRESS AMT WHEN ZERO OR", "WHEN ... OR without a figurative"), ("JSON GENERATE OUT FROM REC SUPPRESS EVERY NUMERIC", "SUPPRESS EVERY without WHEN"), ("JSON GENERATE OUT FROM REC SUPPRESS WHEN ZERO", "SUPPRESS ... WHEN / EVERY"), - ( - "JSON GENERATE OUT FROM REC CONVERTING ON EXCEPTION\n DISPLAY 'X'\n END-JSON", - "CONVERTING phrase", - ), + ("JSON GENERATE OUT FROM REC CONVERTING CITY TO JSON NULL USING ZERO", "CONVERTING TO NULL"), + ("JSON GENERATE OUT FROM REC CONVERTING CITY TO BOOLEAN", "CONVERTING without USING"), + ("JSON GENERATE OUT FROM REC CONVERTING CITY TO BOOLEAN USING", "CONVERTING USING nothing"), ], ) def test_a_shape_the_model_does_not_take_is_refused_by_name(tmp_path, stmt, why): @@ -227,6 +232,8 @@ def test_the_runtime_writes_ibms_text_and_stops_where_ibm_is_silent(tmp_path): JsonGenerate.Node g = JsonGenerate.group("G", JsonGenerate.text("A-B", a), JsonGenerate.group("H")); // an all-ignored group is left out System.out.println("anon " + JsonGenerate.generate(out, JsonGenerate.anonymous(g), CS) + " " + new String(st.bytes, 100, 40, CS).trim()); + JsonGenerate.Node b = JsonGenerate.group("G", JsonGenerate.bool("T", true), JsonGenerate.bool("F", false)); + System.out.println("bool " + JsonGenerate.generate(out, b, CS) + " " + new String(st.bytes, 100, 40, CS).trim()); } } """ @@ -248,6 +255,9 @@ def test_the_runtime_writes_ibms_text_and_stops_where_ibm_is_silent(tmp_path): assert "non-digit data in numeric item N" in out[6] and "undefined by IBM" in out[6] assert "beyond ASCII" in out[7] and "negative zero" in out[8] assert out[9] == 'anon 13 {"A-B":"Ann"}' # OMITTED: the source group's own name is not written + assert ( + out[10] == 'bool 26 {"G":{"T":true,"F":false}}' + ) # CONVERTING ... TO JSON BOOLEAN: true on a match, else false WIDE = """ IDENTIFICATION DIVISION. @@ -298,7 +308,7 @@ def test_name_of_and_suppress_apply_to_a_table_and_its_elements(tmp_path): [ (" 05 T PIC X OCCURS 1 TO 5 DEPENDING ON N1.", None), (" 05 T PIC X OCCURS 300.", "more than 256 items and table elements"), - (" 05 T COMP-1.", "COMP-1 FLOAT"), + (" 05 T COMP-2.", "COMP-2; IBM's conversion picture -9.9(17)E+99 is illegal"), (" 05 T PIC S9(4) SIGN LEADING SEPARATE.", "P-scaled or separately signed"), (" 05 T PIC 9(4) COMP-3 REDEFINES N1.", None), ], @@ -410,6 +420,16 @@ def test_the_runtime_writes_comp_numbers_and_tables(tmp_path): show("badsign", o2, bad, JsonGenerate.number("P", Field.packed(bad, 2, 3, 0, true))); show("negzero", o2, bad, JsonGenerate.number("P", Field.packed(bad, 4, 1, 0, true))); show("overpic", o2, bad, JsonGenerate.number("B", Field.binary(bad, 0, 2, 0, false, false))); + Storage fl = st(0x41, 0x18, 0, 0, 0xC1, 0x18, 0, 0, 0x40, 0x80, 0, 0, 0x42, 0x64, 0, 0, 0x40, 0x19, 0x99, 0x99, + 0, 0, 0, 0, 0, 0, 0, 0, 0x41, 0x10, 0, 0, 0, 0, 0, 0); + Field o3 = Field.alphanumeric(fl, 100, 100, false); + show("f1.5", o3, fl, JsonGenerate.number("F", Field.hfp(fl, 0, false))); + show("f-1.5", o3, fl, JsonGenerate.number("F", Field.hfp(fl, 4, false))); + show("f.5", o3, fl, JsonGenerate.number("F", Field.hfp(fl, 8, false))); + show("f100", o3, fl, JsonGenerate.number("F", Field.hfp(fl, 12, false))); + show("fround", o3, fl, JsonGenerate.number("F", Field.hfp(fl, 16, false))); + show("fzero", o3, fl, JsonGenerate.number("F", Field.hfp(fl, 20, false))); + show("fcomp2", o3, fl, JsonGenerate.number("F", Field.hfp(fl, 28, true))); } } """ @@ -427,7 +447,12 @@ def test_the_runtime_writes_comp_numbers_and_tables(tmp_path): assert '"T":["a","b"]' in out[4] and '"U":[{"Q":12}]' in out[4] assert out[5] == 'odo2 {"G":{"T":["a","b"]}}' and out[6] == 'odo0 {"G":{"T":[]}}' assert "outside 0 to 2" in out[7] and "outside 1 to 1" in out[8] and "undefined" in out[7] - out = out[:5] + out[9:] + floats = out[-7:] # #7524: COMP-1 as PICTURE -9.9(8)E+99, trimmed (IBM, format conversion of elementary data) + assert floats[0] == 'f1.5 {"F":1.50000000E+00}' and floats[1] == 'f-1.5 {"F":-1.50000000E+00}' + assert floats[2] == 'f.5 {"F":5.00000000E-01}' and floats[3] == 'f100 {"F":1.00000000E+02}' + assert floats[4] == 'fround {"F":9.99999642E-02}' # 0.099999964237...: nine digits, half away from zero (ASSUMED) + assert "holds zero" in floats[5] and "COMP-2" in floats[6] + out = out[:5] + out[9:-7] assert "non-digit data in numeric item P" in out[5] and "non-digit data in numeric item P" in out[6] assert "negative zero" in out[7] and "past its PICTURE's digits" in out[8] @@ -615,3 +640,49 @@ def test_the_runtime_leaves_out_what_suppress_when_selects(tmp_path): assert got["allgone"] == '{"G":{}}' # the source group itself is always written assert "non-digit data in numeric item N" in got["junkzero"] assert got["numspace"] == '{"G":{"A":"ab","I":{"P":12}}}' + + +BOOLS = DATA.replace( + " 01 OUT", + " 05 FLAG-A PIC X VALUE 'F'.\n 05 FLAG-B PIC X VALUE 'b'.\n" + " 88 B-LOWER VALUE 'a' THRU 'z'.\n 05 FLAG-C PIC XX.\n" + " 88 C-ON VALUE 'Y'.\n 01 OUT", +) + + +def _bools(tmp_path, stmt): + src = tmp_path / "PROG.cbl" + for kw in (" CONVERTING", " ALSO", " SUPPRESS"): # fixed form: nothing past column 72 + stmt = stmt.replace(kw, "\n " + kw.strip()) + src.write_text(BOOLS + f" {stmt}\n GOBACK.\n", encoding="utf-8") + return P.translate(src, [], "public class ProgService { }", "t") + + +def test_converting_to_boolean_parses_both_using_forms_and_also(): + st = S._json_generate("JSON GENERATE A FROM R CONVERTING X TO BOOLEAN USING 'T' ALSO Y TO JSON BOOL USING Z", 1) + assert [(r.name, t if isinstance(t, str) else t.name) for r, t in st.data["bools"]] == [("X", "T"), ("Y", "Z")] + + +def test_converting_to_boolean_is_a_bool_node_tested_by_the_literal_or_the_88(tmp_path): + r = _bools( + tmp_path, + "JSON GENERATE OUT FROM REC CONVERTING FLAG-A TO BOOLEAN USING 'T' ALSO FLAG-B TO BOOLEAN USING B-LOWER", + ) + assert r.stats["holes"] == [] + assert 'JsonGenerate.bool("FLAG-A", ' in r.java and 'JsonGenerate.bool("FLAG-B", isBLower())' in r.java + assert 'text("FLAG-A"' not in r.java + + +@pytest.mark.parametrize( + ("stmt", "why"), + [ + ("CONVERTING FLAG-C TO BOOLEAN USING 'Y'", "needs a one-byte PIC X item"), + ("CONVERTING AMT TO BOOLEAN USING 'Y'", "needs a one-byte PIC X item"), + ("CONVERTING FLAG-A TO BOOLEAN USING 'TT'", "is not a single-byte literal"), + ("CONVERTING FLAG-A TO BOOLEAN USING B-LOWER", "is not an 88 directly under FLAG-A"), + ("CONVERTING FLAG-A TO BOOLEAN USING 'T' SUPPRESS FLAG-A WHEN SPACE", "SUPPRESS ... WHEN"), + ], +) +def test_a_converting_shape_ibm_does_not_allow_or_state_is_refused_by_name(tmp_path, stmt, why): + r = _bools(tmp_path, f"JSON GENERATE OUT FROM REC {stmt}") + assert len(r.stats["holes"]) == 1 and why in str(r.stats["holes"][0])