https://gcc.gnu.org/g:a0d865a303a1a9a3b0ebcedd625dddab181231d4
commit r17-2472-ga0d865a303a1a9a3b0ebcedd625dddab181231d4 Author: James K. Lowden <[email protected]> Date: Thu Jul 16 12:24:25 2026 -0400 cobol: Fix PR 126002. Accept parenthesized sign condition. Also new specific diagnostics for invalid use of a device name outside SELECT. gcc/cobol/ChangeLog: * parse.y: New diagnostic messages regarding invalid device name use. * scan.l: Add right paren as lexical terminator for simple condition. Diff: --- gcc/cobol/parse.y | 26 +++++++++++++++++++++++++- gcc/cobol/scan.l | 12 ++++++------ 2 files changed, 31 insertions(+), 7 deletions(-) diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y index 60fa04603731..7ad7fa3d4803 100644 --- a/gcc/cobol/parse.y +++ b/gcc/cobol/parse.y @@ -6749,7 +6749,7 @@ simple_cond: kind_of_name $$ = new_reference(new_temporary(FldConditional)); ast_relop(@$, $$->field, lhs, ne_op, rhs); } - | expr posneg[op] { + | expr /* IS */ posneg[op] { $$ = new_reference(new_temporary(FldConditional)); relop_t op = static_cast<relop_t>($op); cbl_field_t *zero = constant_of(constant_index(ZERO)); @@ -9121,6 +9121,18 @@ file_record: NAME { $$ = cbl_field_of(symbol_at($filename->default_record)); } + | device_name[dev] + { + auto dev = symbol_special($dev.id); + error_msg(@dev, "invalid device %qs: FD name required", dev->name); + YYERROR; + auto e = symbol_file(PROGRAM, dev->name); + if( ! e ) { + error_msg(@dev, "no FD selected for device %qs", dev->name); + YYERROR; + } + $$ = cbl_field_of(symbol_at(cbl_file_of(e)->default_record)); + } ; advance_when: BEFORE { $$ = BEFORE; } | AFTER { $$ = AFTER; } @@ -10108,6 +10120,18 @@ filename: NAME } $$ = cbl_file_of(e); } + | device_name[dev] + { + auto dev = symbol_special($dev.id); + error_msg(@dev, "invalid device %qs: FD name required", dev->name); + YYERROR; + auto e = symbol_file(PROGRAM, dev->name); + if( ! e ) { + error_msg(@dev, "no FD selected for device '%s'", dev->name); + YYERROR; + } + $$ = cbl_file_of(e); + } ; label_name: NAME diff --git a/gcc/cobol/scan.l b/gcc/cobol/scan.l index 85604b505f2f..551b1e962098 100644 --- a/gcc/cobol/scan.l +++ b/gcc/cobol/scan.l @@ -1880,13 +1880,13 @@ USE({SPC}FOR)? { return USE; } yylval.string = xstrdup(yytext); return NAME; } - (IS{SPC})?POSITIVE/[[:space:]] { yylval.number = IS; return POSITIVE; } - (IS{SPC})?NEGATIVE/[[:space:]] { yylval.number = IS; return NEGATIVE; } - (IS{SPC})?ZERO/[[:space:]] { yylval.number = IS; return ZERO; } + (IS{SPC})?POSITIVE/[)[:space:]] { yylval.number = IS; return POSITIVE; } + (IS{SPC})?NEGATIVE/[)[:space:]] { yylval.number = IS; return NEGATIVE; } + (IS{SPC})?ZERO/[)[:space:]] { yylval.number = IS; return ZERO; } - {ISNT}{SPC}POSITIVE/[[:space:]] { yylval.number = NOT; return POSITIVE; } - {ISNT}{SPC}NEGATIVE/[[:space:]] { yylval.number = NOT; return NEGATIVE; } - {ISNT}{SPC}ZERO/[[:space:]] { yylval.number = NOT; return ZERO; } + {ISNT}{SPC}POSITIVE/[)[:space:]] { yylval.number = NOT; return POSITIVE; } + {ISNT}{SPC}NEGATIVE/[)[:space:]] { yylval.number = NOT; return NEGATIVE; } + {ISNT}{SPC}ZERO/[)[:space:]] { yylval.number = NOT; return ZERO; } {ISNT}{SPC}/OMITTED { return NOT; }
