From 3fb8c38c5648abc6eeab611ad7dbb97a55e1a0d3 Mon Sep 17 00:00:00 2001 From: ZaneHam Date: Sat, 6 Jun 2026 23:07:40 +1200 Subject: [PATCH 1/2] zCobol SEARCH WHEN: handle relational noise words (IS/EQUAL/NOT/THAN/TO) (#825) --- rt/bash/runcbltests | 2 + rt/bat/RUNCBLTESTS.BAT | 2 + .../groovy/org/z390/test/RunCblTests.groovy | 2 +- zcobol/mac/WHEN.MAC | 110 ++++++++++++++---- zcobol/tests/TSRCHEND.CBL | 74 ++++++++++++ zcobol/tests/TSRCHOP.CBL | 80 +++++++++++++ 6 files changed, 245 insertions(+), 25 deletions(-) create mode 100644 zcobol/tests/TSRCHEND.CBL create mode 100644 zcobol/tests/TSRCHOP.CBL diff --git a/rt/bash/runcbltests b/rt/bash/runcbltests index 9cd0028b3..41b1917ed 100755 --- a/rt/bash/runcbltests +++ b/rt/bash/runcbltests @@ -48,6 +48,8 @@ export OUTFILE= bash/cblclg zcobol/tests/TESTSIX1 $1 $2 $3 $4 $5 $6 $7 $8 $9 bash/cblclg zcobol/tests/TESTSIX2 $1 $2 $3 $4 $5 $6 $7 $8 $9 bash/cblclg zcobol/tests/TESTSRCH $1 $2 $3 $4 $5 $6 $7 $8 $9 +bash/cblclg zcobol/tests/TSRCHEND $1 $2 $3 $4 $5 $6 $7 $8 $9 +bash/cblclg zcobol/tests/TSRCHOP $1 $2 $3 $4 $5 $6 $7 $8 $9 bash/cblclg zcobol/tests/TESTSUB1 $1 $2 $3 $4 $5 $6 $7 $8 $9 bash/cblclg zcobol/tests/TESTSUB2 $1 $2 $3 $4 $5 $6 $7 $8 $9 bash/cblclg zcobol/tests/TESTTRC1 $1 $2 $3 $4 $5 $6 $7 $8 $9 TRUNC diff --git a/rt/bat/RUNCBLTESTS.BAT b/rt/bat/RUNCBLTESTS.BAT index da411ec6f..62a4faf10 100644 --- a/rt/bat/RUNCBLTESTS.BAT +++ b/rt/bat/RUNCBLTESTS.BAT @@ -54,6 +54,8 @@ set OUTFILE= call bat\CBLCLG %z_TraceMode% zcobol\tests\TESTSIX1 %1 %2 %3 %4 %5 %6 %7 %8 %9 || goto error call bat\CBLCLG %z_TraceMode% zcobol\tests\TESTSIX2 %1 %2 %3 %4 %5 %6 %7 %8 %9 || goto error call bat\CBLCLG %z_TraceMode% zcobol\tests\TESTSRCH %1 %2 %3 %4 %5 %6 %7 %8 %9 || goto error +call bat\CBLCLG %z_TraceMode% zcobol\tests\TSRCHEND %1 %2 %3 %4 %5 %6 %7 %8 %9 || goto error +call bat\CBLCLG %z_TraceMode% zcobol\tests\TSRCHOP %1 %2 %3 %4 %5 %6 %7 %8 %9 || goto error call bat\CBLCLG %z_TraceMode% zcobol\tests\TESTSUB1 %1 %2 %3 %4 %5 %6 %7 %8 %9 || goto error call bat\CBLCLG %z_TraceMode% zcobol\tests\TESTSUB2 %1 %2 %3 %4 %5 %6 %7 %8 %9 || goto error call bat\CBLCLG %z_TraceMode% zcobol\tests\TESTTRC1 %1 %2 %3 %4 %5 %6 %7 %8 %9 TRUNC || goto error diff --git a/z390test/src/test/groovy/org/z390/test/RunCblTests.groovy b/z390test/src/test/groovy/org/z390/test/RunCblTests.groovy index 5501791f4..90231c621 100644 --- a/z390test/src/test/groovy/org/z390/test/RunCblTests.groovy +++ b/z390test/src/test/groovy/org/z390/test/RunCblTests.groovy @@ -22,7 +22,7 @@ class RunCblTests extends z390Test{ 'TESTCMP1', 'TESTCMP2', 'TESTCMP3', 'TESTCMP4', 'TESTCMP5', 'TESTCMP6', 'TESTCPY1', 'TESTCPY2', 'TESTDFP1', 'TESTDIV1', 'TESTDIV2', 'TESTDSP1', 'TESTGO1', 'TESTHFP1', 'TESTISP1', 'TESTPIC1', 'TESTPM1', 'TESTPM2', 'TESTSIX1', 'TESTSIX2', 'TESTSRCH', 'TESTSUB1', 'TESTSUB2', 'TESTTRC2', 'TESTWS1', 'TESTFUN1', 'TESTINT1', 'TESTMPY1', 'TESTMPY2', 'TESTRMD1', 'TESTSTR1', 'TESTSTR2', 'TESTSTR3', 'TSUNSTR', - 'YOUZPI1', 'YOUZPI2' + 'YOUZPI1', 'YOUZPI2', 'TSRCHEND', 'TSRCHOP' ] modules.each { module -> tests.add( diff --git a/zcobol/mac/WHEN.MAC b/zcobol/mac/WHEN.MAC index 49897337e..03d2416cf 100644 --- a/zcobol/mac/WHEN.MAC +++ b/zcobol/mac/WHEN.MAC @@ -123,11 +123,68 @@ MEXIT AEND .* -.* Get the comparison operator (=, <, >, etc.) -.* PARM_IX was advanced by GET_PARM_FIELD, now points to operator +.* Parse the COBOL relational operator, tolerating the reserved +.* noise words IS, THAN and TO and the word forms EQUAL, GREATER, +.* LESS and NOT. On entry PARM_IX points at the first token after +.* field1; on exit it points at the first token of the 2nd operand. .* +.* &SRC_REL - canonical relation: EQ GT LT GE LE +.* &SRC_NEG - set when the relation is negated with NOT +.* + AIF ('&SYSLIST(&PARM_IX)' EQ 'IS') skip optional IS + :&PARM_IX SETA &PARM_IX+1 + AEND + :&SRC_NEG SETB 0 + AIF ('&SYSLIST(&PARM_IX)' EQ 'NOT') optional NOT + :&SRC_NEG SETB 1 + :&PARM_IX SETA &PARM_IX+1 + AEND :&OPER SETC '&SYSLIST(&PARM_IX)' :&PARM_IX SETA &PARM_IX+1 + :&SRC_REL SETC '' + AIF ('&OPER' EQ '=' OR '&OPER' EQ 'EQUAL') + :&SRC_REL SETC 'EQ' + AIF ('&SYSLIST(&PARM_IX)' EQ 'TO') skip noise TO + :&PARM_IX SETA &PARM_IX+1 + AEND + AELSEIF ('&OPER' EQ '>=' OR '&OPER' EQ 'GE') + :&SRC_REL SETC 'GE' + AELSEIF ('&OPER' EQ '<=' OR '&OPER' EQ 'LE') + :&SRC_REL SETC 'LE' + AELSEIF ('&OPER' EQ '>' OR '&OPER' EQ 'GREATER') + :&SRC_REL SETC 'GT' + AIF ('&SYSLIST(&PARM_IX)' EQ 'THAN') skip noise THAN + :&PARM_IX SETA &PARM_IX+1 + AEND + AIF ('&SYSLIST(&PARM_IX)' EQ 'OR') GREATER OR EQUAL + :&SRC_REL SETC 'GE' + :&PARM_IX SETA &PARM_IX+1 + AIF ('&SYSLIST(&PARM_IX)' EQ 'EQUAL') + :&PARM_IX SETA &PARM_IX+1 + AEND + AIF ('&SYSLIST(&PARM_IX)' EQ 'TO') + :&PARM_IX SETA &PARM_IX+1 + AEND + AEND + AELSEIF ('&OPER' EQ '<' OR '&OPER' EQ 'LESS') + :&SRC_REL SETC 'LT' + AIF ('&SYSLIST(&PARM_IX)' EQ 'THAN') skip noise THAN + :&PARM_IX SETA &PARM_IX+1 + AEND + AIF ('&SYSLIST(&PARM_IX)' EQ 'OR') LESS OR EQUAL + :&SRC_REL SETC 'LE' + :&PARM_IX SETA &PARM_IX+1 + AIF ('&SYSLIST(&PARM_IX)' EQ 'EQUAL') + :&PARM_IX SETA &PARM_IX+1 + AEND + AIF ('&SYSLIST(&PARM_IX)' EQ 'TO') + :&PARM_IX SETA &PARM_IX+1 + AEND + AEND + AELSE + MNOTE 8,'SEARCH WHEN INVALID OPERATOR - &OPER' + MEXIT + AEND .* .* Parse second operand (right side of comparison) .* Can be a field name or a literal value @@ -138,31 +195,36 @@ :&SRC_FLD2 SETC '&FIELD_NAME' :&SRC_FLD2_IX SETA &FIELD_IX .* -.* Map COBOL operator to condition code for FALSE branch -.* -.* We branch to INCR when condition is FALSE (try next element) -.* So we need the INVERSE condition code: -.* COBOL "=" -> branch on NOT EQUAL (ZC_NE) -.* COBOL "<" -> branch on GREATER OR EQUAL (ZC_GE) -.* COBOL ">" -> branch on LESS OR EQUAL (ZC_LE) -.* etc. +.* Map relation (and optional NOT) to the condition-code mask used +.* to branch to INCR when the WHEN condition is FALSE. When not +.* negated we branch on the inverse relation; when negated (NOT) we +.* branch on the relation itself. .* :&SRC_CCT SETC '' - AIF ('&OPER' EQ '=' OR '&OPER' EQ 'EQUAL') - :&SRC_CCT SETC 'ZC_NE' - AELSEIF ('&OPER' EQ '<' OR '&OPER' EQ 'LESS') - :&SRC_CCT SETC 'ZC_GE' - AELSEIF ('&OPER' EQ '>' OR '&OPER' EQ 'GREATER') - :&SRC_CCT SETC 'ZC_LE' - AELSEIF ('&OPER' EQ '<=' OR '&OPER' EQ 'LE') - :&SRC_CCT SETC 'ZC_H' - AELSEIF ('&OPER' EQ '>=' OR '&OPER' EQ 'GE') - :&SRC_CCT SETC 'ZC_L' - AELSEIF ('&OPER' EQ 'NOT') - :&SRC_CCT SETC 'ZC_EQ' + AIF (NOT &SRC_NEG) + AIF ('&SRC_REL' EQ 'EQ') + :&SRC_CCT SETC 'ZC_NE' + AELSEIF ('&SRC_REL' EQ 'LT') + :&SRC_CCT SETC 'ZC_GE' + AELSEIF ('&SRC_REL' EQ 'GT') + :&SRC_CCT SETC 'ZC_LE' + AELSEIF ('&SRC_REL' EQ 'LE') + :&SRC_CCT SETC 'ZC_H' + AELSEIF ('&SRC_REL' EQ 'GE') + :&SRC_CCT SETC 'ZC_L' + AEND AELSE - MNOTE 8,'SEARCH WHEN INVALID OPERATOR - &OPER' - MEXIT + AIF ('&SRC_REL' EQ 'EQ') + :&SRC_CCT SETC 'ZC_EQ' + AELSEIF ('&SRC_REL' EQ 'LT') + :&SRC_CCT SETC 'ZC_L' + AELSEIF ('&SRC_REL' EQ 'GT') + :&SRC_CCT SETC 'ZC_H' + AELSEIF ('&SRC_REL' EQ 'LE') + :&SRC_CCT SETC 'ZC_LE' + AELSEIF ('&SRC_REL' EQ 'GE') + :&SRC_CCT SETC 'ZC_GE' + AEND AEND .* .* Generate the actual field comparison code diff --git a/zcobol/tests/TSRCHEND.CBL b/zcobol/tests/TSRCHEND.CBL new file mode 100644 index 000000000..46b72da9d --- /dev/null +++ b/zcobol/tests/TSRCHEND.CBL @@ -0,0 +1,74 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. TSRCHEND. + ****************************************************************** + * Repro for issue #825 - SEARCH not generating AT END label. + * Mirrors NIST NC401M: SEARCH with AT END plus a WHEN condition + * written with COBOL relational noise words (IS EQUAL TO). + * + * Expected (after fix): translates, assembles, runs, AT END path + * taken for a missing key, WHEN path taken for a present key. + ****************************************************************** + ENVIRONMENT DIVISION. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 EMPLOYEE-TABLE. + 05 EMP-ENTRY OCCURS 5 TIMES INDEXED BY EMP-IX. + 10 EMP-ID PIC 9(3). + 10 EMP-NAME PIC X(10). + 01 PASS-COUNT PIC 9(2) VALUE 0. + 01 FAIL-COUNT PIC 9(2) VALUE 0. + 01 WS-FOUND PIC 9 VALUE 0. + 01 SEARCH-ID PIC 9(3) VALUE 0. + + PROCEDURE DIVISION. + MAIN-PARA. + DISPLAY 'TSRCHEND - SEARCH AT END NOISE-WORD TEST'. + MOVE 101 TO EMP-ID(1). + MOVE 102 TO EMP-ID(2). + MOVE 103 TO EMP-ID(3). + MOVE 104 TO EMP-ID(4). + MOVE 105 TO EMP-ID(5). + * + * Test 1: present key, WHEN ... IS EQUAL TO ... + * + MOVE 0 TO WS-FOUND. + MOVE 103 TO SEARCH-ID. + SET EMP-IX TO 1. + SEARCH EMP-ENTRY + AT END + MOVE 9 TO WS-FOUND + WHEN EMP-ID(EMP-IX) IS EQUAL TO SEARCH-ID + MOVE 1 TO WS-FOUND + END-SEARCH. + IF WS-FOUND = 1 + DISPLAY 'TEST 1: PASS - FOUND ID 103' + ADD 1 TO PASS-COUNT + ELSE + DISPLAY 'TEST 1: FAIL - DID NOT FIND ID 103' + ADD 1 TO FAIL-COUNT. + * + * Test 2: missing key, AT END must fire + * + MOVE 0 TO WS-FOUND. + MOVE 999 TO SEARCH-ID. + SET EMP-IX TO 1. + SEARCH EMP-ENTRY + AT END + MOVE 2 TO WS-FOUND + WHEN EMP-ID(EMP-IX) IS EQUAL TO SEARCH-ID + MOVE 1 TO WS-FOUND + END-SEARCH. + IF WS-FOUND = 2 + DISPLAY 'TEST 2: PASS - AT END EXECUTED FOR ID 999' + ADD 1 TO PASS-COUNT + ELSE + DISPLAY 'TEST 2: FAIL - AT END NOT EXECUTED' + ADD 1 TO FAIL-COUNT. + DISPLAY 'TSRCHEND - COMPLETED'. + DISPLAY 'PASSED: ' PASS-COUNT ' FAILED: ' FAIL-COUNT. + IF FAIL-COUNT = 0 + DISPLAY 'TSRCHEND - ALL TESTS PASSED' + ELSE + DISPLAY 'TSRCHEND - SOME TESTS FAILED' + MOVE 8 TO RETURN-CODE. + STOP RUN. diff --git a/zcobol/tests/TSRCHOP.CBL b/zcobol/tests/TSRCHOP.CBL new file mode 100644 index 000000000..cf96b12ce --- /dev/null +++ b/zcobol/tests/TSRCHOP.CBL @@ -0,0 +1,80 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. TSRCHOP. + ****************************************************************** + * Exercises SEARCH WHEN relational-operator forms in WHEN.MAC + * (>, IS GREATER THAN OR EQUAL TO, IS LESS THAN, IS NOT EQUAL TO) + * comparing against WORKING-STORAGE FIELDS (not literals), so the + * test isolates operator/condition-code handling from the + * separate GEN_COMP literal-operand defect. + * Table values 10 20 30 40 50, index starts at 1, hits are known. + ****************************************************************** + ENVIRONMENT DIVISION. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 T. + 05 E OCCURS 5 TIMES INDEXED BY IX. + 10 V PIC 9(3). + 01 HIT PIC 9(3) VALUE 0. + 01 LIM25 PIC 9(3) VALUE 25. + 01 LIM30 PIC 9(3) VALUE 30. + 01 LIM20 PIC 9(3) VALUE 20. + 01 LIM10 PIC 9(3) VALUE 10. + 01 PASS-COUNT PIC 9(2) VALUE 0. + 01 FAIL-COUNT PIC 9(2) VALUE 0. + + PROCEDURE DIVISION. + MAIN. + MOVE 10 TO V(1). + MOVE 20 TO V(2). + MOVE 30 TO V(3). + MOVE 40 TO V(4). + MOVE 50 TO V(5). + * > 25 => first hit 30 + MOVE 0 TO HIT. + SET IX TO 1. + SEARCH E AT END MOVE 0 TO HIT + WHEN V(IX) > LIM25 MOVE V(IX) TO HIT + END-SEARCH. + PERFORM CHECK-30. + * >= 30 => first hit 30 + MOVE 0 TO HIT. + SET IX TO 1. + SEARCH E AT END MOVE 0 TO HIT + WHEN V(IX) IS GREATER THAN OR EQUAL TO LIM30 + MOVE V(IX) TO HIT + END-SEARCH. + PERFORM CHECK-30. + * IS LESS THAN 20 => first hit 10 + MOVE 0 TO HIT. + SET IX TO 1. + SEARCH E AT END MOVE 0 TO HIT + WHEN V(IX) IS LESS THAN LIM20 MOVE V(IX) TO HIT + END-SEARCH. + IF HIT = 10 + ADD 1 TO PASS-COUNT + ELSE + DISPLAY 'FAIL LESS THAN, HIT=' HIT + ADD 1 TO FAIL-COUNT. + * IS NOT EQUAL TO 10 => first hit 20 + MOVE 0 TO HIT. + SET IX TO 1. + SEARCH E AT END MOVE 0 TO HIT + WHEN V(IX) IS NOT EQUAL TO LIM10 MOVE V(IX) TO HIT + END-SEARCH. + IF HIT = 20 + ADD 1 TO PASS-COUNT + ELSE + DISPLAY 'FAIL NOT EQUAL, HIT=' HIT + ADD 1 TO FAIL-COUNT. + DISPLAY 'TSRCHOP PASSED: ' PASS-COUNT ' FAILED: ' FAIL-COUNT. + IF FAIL-COUNT = 0 + DISPLAY 'TSRCHOP - ALL TESTS PASSED' + ELSE + MOVE 8 TO RETURN-CODE. + STOP RUN. + CHECK-30. + IF HIT = 30 + ADD 1 TO PASS-COUNT + ELSE + DISPLAY 'FAIL EXPECTED 30, HIT=' HIT + ADD 1 TO FAIL-COUNT. From e73d2326a69b6d44142bd12a8f456e4e4e3be203 Mon Sep 17 00:00:00 2001 From: ZaneHam Date: Sun, 7 Jun 2026 11:12:35 +1200 Subject: [PATCH 2/2] zCobol SEARCH: give SEARCH its own IE_TYPE (16); 15 collided with RETURN (#818, #825) --- zcobol/cpy/ZC_WS.CPY | 4 ++-- zcobol/mac/END_SEARCH.MAC | 4 ++-- zcobol/mac/PERIOD.MAC | 4 +++- zcobol/mac/SEARCH.MAC | 6 +++--- zcobol/mac/WHEN.MAC | 4 ++-- 5 files changed, 12 insertions(+), 10 deletions(-) diff --git a/zcobol/cpy/ZC_WS.CPY b/zcobol/cpy/ZC_WS.CPY index 1f1422576..690b624ba 100644 --- a/zcobol/cpy/ZC_WS.CPY +++ b/zcobol/cpy/ZC_WS.CPY @@ -257,7 +257,7 @@ GBLA &IE_LVL CURRENT LEVEL FOR IF OR EVALUATE GBLA &IE_TYPE(100) 1=IF, 2=EVALUATE, 3=END_READ 4=PM .* 11=ADD,12=SUB,13=MPY,14=DIV -.* 15=SEARCH +.* 15=RETURN,16=SEARCH GBLA &IE_TCNT(100) IE TYPE COUNT GBLA &IE_NOT(100) NOT ON SIZE ERROR USED AT LEVEL GBLA &IE_BCNT(100) IE BLOCK COUNT WITHIN TYPE @@ -267,7 +267,7 @@ GBLA &IE_WHEN(100) CURRENT EVAL WHEN LABEL # GBLC &IE_PM_LAB(100) CURRENT PM STMT LOOP LABEL .* -.* SEARCH STATEMENT SUPPORT (IE_TYPE=15) +.* SEARCH STATEMENT SUPPORT (IE_TYPE=16) .* These variables store context for SEARCH/WHEN/END-SEARCH processing .* Indexed by IE_LVL to support nested SEARCH statements .* diff --git a/zcobol/mac/END_SEARCH.MAC b/zcobol/mac/END_SEARCH.MAC index c9212f426..eb5027181 100644 --- a/zcobol/mac/END_SEARCH.MAC +++ b/zcobol/mac/END_SEARCH.MAC @@ -32,7 +32,7 @@ .* 5. END label (exit point for completed search) .* .* Uses IE block tracking to match with corresponding SEARCH: -.* IE_TYPE 15 = SEARCH (see ZC_WS.CPY:254) +.* IE_TYPE 16 = SEARCH (see ZC_WS.CPY) .********************************************************************* END_SEARCH COPY ZC_WS @@ -43,7 +43,7 @@ MNOTE 8,'END-SEARCH WITHOUT MATCHING SEARCH' MEXIT AEND - AIF (&IE_TYPE(&IE_LVL) NE 15) + AIF (&IE_TYPE(&IE_LVL) NE 16) MNOTE 8,'END-SEARCH NOT IN A SEARCH BLOCK' MEXIT AEND diff --git a/zcobol/mac/PERIOD.MAC b/zcobol/mac/PERIOD.MAC index 9fc1f46b0..c3eb7306a 100644 --- a/zcobol/mac/PERIOD.MAC +++ b/zcobol/mac/PERIOD.MAC @@ -24,7 +24,7 @@ .* 10/06/08 ZSTRMAC .* 07/14/09 RPI 1064 drop b2's at period if used .* 02/21/12 RPI 1182 move base reset to GEN_PERFROM and GEN_LABEL -.* 2025/12 ZH: Add SEARCH support (IE_TYPE=15) +.* 2025/12 ZH: Add SEARCH support (IE_TYPE=16; 15=RETURN) .********************************************************************* PERIOD COPY ZC_WS @@ -47,6 +47,8 @@ END_DIVIDE AELSEIF (&IE_TYPE(&IE_LVL) EQ 15) END_RETURN + AELSEIF (&IE_TYPE(&IE_LVL) EQ 16) + END_SEARCH AELSE MNOTE 8,'PERIOD UNKNOWN LEVEL TYPE - &IE_TYPE(&IE_X LVL)' diff --git a/zcobol/mac/SEARCH.MAC b/zcobol/mac/SEARCH.MAC index c4ae13c79..f1f67a5ff 100644 --- a/zcobol/mac/SEARCH.MAC +++ b/zcobol/mac/SEARCH.MAC @@ -33,7 +33,7 @@ .* value and increments until a WHEN condition matches or end-of-table. .* .* Uses IE (If/Evaluate) block tracking system - see ZC_WS.CPY: -.* IE_TYPE 15 = SEARCH (added to existing types 1-14) +.* IE_TYPE 16 = SEARCH (15 = RETURN; added to existing types 1-14) .* IE_SRC_* variables store SEARCH-specific context for END_SEARCH .* .* Generated label structure: @@ -129,7 +129,7 @@ .* This allows nested SEARCH/IF/EVALUATE and proper END_SEARCH matching .* .* IE_LVL - Current nesting depth (incremented for each block) -.* IE_TYPE - Block type identifier (15 = SEARCH, see ZC_WS.CPY:254) +.* IE_TYPE - Block type identifier (16 = SEARCH, see ZC_WS.CPY) .* IE_TCNT - Label counter for unique label generation .* .* IE_SRC_* variables hold SEARCH context for WHEN and END_SEARCH: @@ -142,7 +142,7 @@ .* :&SRC_LAB SETA &SRC_LAB+1 :&IE_LVL SETA &IE_LVL+1 - :&IE_TYPE(&IE_LVL) SETA 15 + :&IE_TYPE(&IE_LVL) SETA 16 :&IE_TCNT(&IE_LVL) SETA &SRC_LAB :&IE_SRC_TBL(&IE_LVL) SETC '&TBL_NAME' :&IE_SRC_IDX(&IE_LVL) SETC '&IDX_NAME' diff --git a/zcobol/mac/WHEN.MAC b/zcobol/mac/WHEN.MAC index 03d2416cf..915773cbc 100644 --- a/zcobol/mac/WHEN.MAC +++ b/zcobol/mac/WHEN.MAC @@ -32,7 +32,7 @@ MNOTE 8,'WHEN MISSING EVALUATE OR SEARCH' MEXIT AEND - AIF (&IE_TYPE(&IE_LVL) EQ 15) + AIF (&IE_TYPE(&IE_LVL) EQ 16) .* .* SEARCH WHEN - Format: WHEN field = value .* @@ -68,7 +68,7 @@ .* .********************************************************************* .* SEARCH WHEN HANDLER -.* Called when WHEN appears inside a SEARCH block (IE_TYPE=15) +.* Called when WHEN appears inside a SEARCH block (IE_TYPE=16) .* .* Syntax: WHEN field1 operator field2 .* Example: WHEN TABLE-KEY(IDX) = SEARCH-ARG