https://gcc.gnu.org/g:7dc3b373b6ed77ff3c9bbd12467ee57ed40ad73e
commit r17-4014-g7dc3b373b6ed77ff3c9bbd12467ee57ed40ad73e Author: James K. Lowden <[email protected]> Date: Tue Sep 8 15:13:23 2026 -0400 cobol: Allow CALL BY VALUE literal again, and update tests. gcc/cobol/ChangeLog: * parse_ante.h (by_content_ok): Add test for literal. gcc/testsuite/ChangeLog: * cobol.dg/group2/PR126612_-_Ignore_TRACE_-_gnu.cob: New test. * cobol.dg/group2/PR126612_-_Ignore_TRACE_-_ibm.cob: New test. * cobol.dg/group2/PR126612_-_Ignore_TRACE_-_iso.cob: New test. * cobol.dg/group2/PR126612_-_Ignore_TRACE_-_mf.cob: New test. * cobol.dg/group2/RT3611_-_BY_CONTENT_LENGTH_OF.cob: New test. * cobol.dg/group2/__define__text_.cob: New test. * cobol.dg/group2/__define__text_.out: New test. * cobol.dg/group2/customer_bug_Heuristic_Fail.cob: New test. * cobol.dg/group2/customer_bug_Heuristic_Fail.out: New test. Diff: --- gcc/cobol/parse_ante.h | 10 ++++++++-- .../group2/PR126612_-_Ignore_TRACE_-_gnu.cob | 15 ++++++++++++++ .../group2/PR126612_-_Ignore_TRACE_-_ibm.cob | 15 ++++++++++++++ .../group2/PR126612_-_Ignore_TRACE_-_iso.cob | 15 ++++++++++++++ .../group2/PR126612_-_Ignore_TRACE_-_mf.cob | 15 ++++++++++++++ .../group2/RT3611_-_BY_CONTENT_LENGTH_OF.cob | 23 ++++++++++++++++++++++ gcc/testsuite/cobol.dg/group2/__define__text_.cob | 23 ++++++++++++++++++++++ gcc/testsuite/cobol.dg/group2/__define__text_.out | 3 +++ .../group2/customer_bug_Heuristic_Fail.cob | 10 ++++++++++ .../group2/customer_bug_Heuristic_Fail.out | 1 + 10 files changed, 128 insertions(+), 2 deletions(-) diff --git a/gcc/cobol/parse_ante.h b/gcc/cobol/parse_ante.h index ecbfd66e9652..7ecaa78adaef 100644 --- a/gcc/cobol/parse_ante.h +++ b/gcc/cobol/parse_ante.h @@ -3271,12 +3271,18 @@ void by_content_ok( const cbl_loc_t& loc, const std::list<cbl_ffi_arg_t>& args ) { for( const auto& arg : args ) { - if( arg.by_content() && arg.field()->has_attr(intermediate_e) ) { - auto e = symbol_program( 0, arg.field()->name, true ); // seek prototoype + const cbl_field_t *field = arg.field(); + if( arg.by_content() && field->has_attr(intermediate_e) ) { + auto e = symbol_program( 0, field->name, true ); // seek prototoype if( ! e ) { dialect_ok(loc, IbmContentExpr, "BY CONTENT expression"); } } + if( arg.crv == by_value_e && + ! (is_literal(field->type) || is_elementary(field->type)) ) { + error_msg(loc, "%qs must be an elementary data item", + nice_name_of(field)); + } } } diff --git a/gcc/testsuite/cobol.dg/group2/PR126612_-_Ignore_TRACE_-_gnu.cob b/gcc/testsuite/cobol.dg/group2/PR126612_-_Ignore_TRACE_-_gnu.cob new file mode 100644 index 000000000000..55130367fa9c --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/PR126612_-_Ignore_TRACE_-_gnu.cob @@ -0,0 +1,15 @@ + *> Do not edit this generated file. See README.txt + *> { dg-do run } + *> { dg-options "-dialect gnu" } + + identification division. + program-id. prog. + procedure division. + READY TRACE. + para-1. + DISPLAY "OK" NO ADVANCING. + RESET TRACE. + para-2. + DISPLAY "OK" NO ADVANCING. + GOBACK. + diff --git a/gcc/testsuite/cobol.dg/group2/PR126612_-_Ignore_TRACE_-_ibm.cob b/gcc/testsuite/cobol.dg/group2/PR126612_-_Ignore_TRACE_-_ibm.cob new file mode 100644 index 000000000000..d7e25d2c2565 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/PR126612_-_Ignore_TRACE_-_ibm.cob @@ -0,0 +1,15 @@ + *> Do not edit this generated file. See README.txt + *> { dg-do run } + *> { dg-options "-dialect ibm" } + + identification division. + program-id. prog. + procedure division. + READY TRACE. + para-1. + DISPLAY "OK" NO ADVANCING. + RESET TRACE. + para-2. + DISPLAY "OK" NO ADVANCING. + GOBACK. + diff --git a/gcc/testsuite/cobol.dg/group2/PR126612_-_Ignore_TRACE_-_iso.cob b/gcc/testsuite/cobol.dg/group2/PR126612_-_Ignore_TRACE_-_iso.cob new file mode 100644 index 000000000000..298566180ff6 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/PR126612_-_Ignore_TRACE_-_iso.cob @@ -0,0 +1,15 @@ + *> Do not edit this generated file. See README.txt + *> { dg-do run } + *> { dg-options "-dialect iso" } + + identification division. + program-id. prog. + procedure division. + READY TRACE. + para-1. + DISPLAY "OK" NO ADVANCING. + RESET TRACE. + para-2. + DISPLAY "OK" NO ADVANCING. + GOBACK. + diff --git a/gcc/testsuite/cobol.dg/group2/PR126612_-_Ignore_TRACE_-_mf.cob b/gcc/testsuite/cobol.dg/group2/PR126612_-_Ignore_TRACE_-_mf.cob new file mode 100644 index 000000000000..2f88d39f1bc7 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/PR126612_-_Ignore_TRACE_-_mf.cob @@ -0,0 +1,15 @@ + *> Do not edit this generated file. See README.txt + *> { dg-do run } + *> { dg-options "-dialect mf" } + + identification division. + program-id. prog. + procedure division. + READY TRACE. + para-1. + DISPLAY "OK" NO ADVANCING. + RESET TRACE. + para-2. + DISPLAY "OK" NO ADVANCING. + GOBACK. + diff --git a/gcc/testsuite/cobol.dg/group2/RT3611_-_BY_CONTENT_LENGTH_OF.cob b/gcc/testsuite/cobol.dg/group2/RT3611_-_BY_CONTENT_LENGTH_OF.cob new file mode 100644 index 000000000000..3aec619f30e8 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/RT3611_-_BY_CONTENT_LENGTH_OF.cob @@ -0,0 +1,23 @@ + *> Do not edit this generated file. See README.txt + *> { dg-do compile } + *> { dg-options "-dialect ibm" } +[ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 WS-NAME PIC X(30). + + PROCEDURE DIVISION. + CALL "TEST01" + USING BY CONTENT LENGTH OF WS-NAME + GOBACK. + END PROGRAM prog. + IDENTIFICATION DIVISION. + PROGRAM-ID. TEST01. + PROCEDURE DIVISION. + DISPLAY "OK" NO ADVANCING. + GOBACK. + END PROGRAM TEST01. +] diff --git a/gcc/testsuite/cobol.dg/group2/__define__text_.cob b/gcc/testsuite/cobol.dg/group2/__define__text_.cob new file mode 100644 index 000000000000..230af5a531df --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/__define__text_.cob @@ -0,0 +1,23 @@ + *> Do not edit this generated file. See README.txt + *> { dg-do run } + *> { dg-options "-dialect mf" } + *> { dg-output-file "group2/__define__text_.out" } + identification division. + program-id. prog1. + >> define defined_text as "Defined text" + procedure division. + display defined_text + call "prog2" using defined_text + goback. + end program prog1. + + identification division. + program-id. prog2. + data division. + linkage section. + 01 display_text pic X ANY LENGTH. + procedure division using display_text. + display display_text + goback. + end program prog2. + diff --git a/gcc/testsuite/cobol.dg/group2/__define__text_.out b/gcc/testsuite/cobol.dg/group2/__define__text_.out new file mode 100644 index 000000000000..1b11a3706044 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/__define__text_.out @@ -0,0 +1,3 @@ +Defined text +Defined text + diff --git a/gcc/testsuite/cobol.dg/group2/customer_bug_Heuristic_Fail.cob b/gcc/testsuite/cobol.dg/group2/customer_bug_Heuristic_Fail.cob new file mode 100644 index 000000000000..6e66c69be2d5 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/customer_bug_Heuristic_Fail.cob @@ -0,0 +1,10 @@ + *> Do not edit this generated file. See README.txt + *> { dg-do run } + *> { dg-output-file "group2/customer_bug_Heuristic_Fail.out" } +00001 *TITLE 'MRS FIELDS ROLLUP DATA PROGRAM.' 06/07/23 +00002 IDENTIFICATION DIVISION. GD25000A +00003 PROGRAM-ID. prog. LV246 +00005 PROCEDURE DIVISION. +00006 DISPLAY "OK" NO ADVANCING. +00007 STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/customer_bug_Heuristic_Fail.out b/gcc/testsuite/cobol.dg/group2/customer_bug_Heuristic_Fail.out new file mode 100644 index 000000000000..d86bac9de59a --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/customer_bug_Heuristic_Fail.out @@ -0,0 +1 @@ +OK
