https://gcc.gnu.org/g:815237217d2c5ae50f71942344e805c528e2c0cf
commit r17-1819-g815237217d2c5ae50f71942344e805c528e2c0cf Author: James K. Lowden <[email protected]> Date: Wed Jun 24 16:49:11 2026 -0400 cobol: Ensure REPOSITORY paragraph accepts all intrinsic names. Also clarify error when program fails to end with a Sentence. Fixes RT 3574. Fixes PR 40. gcc/cobol/ChangeLog: * parse.y: Modify grammar to accept list of intrinic function tokens. * parse_ante.h (in_procedure_division): Remove C-syntax (void). (in_environment_division): Declare function. * scan_ante.h (in_procedure_division): Whitespace. (in_environment_division): Define function. (typed_name): Return intrinsic function token in environment division. * scan_post.h (in_procedure_division): Remove duplicate declaration. Diff: --- gcc/cobol/parse.y | 138 ++++++++++++++++++++++++++++++++++++++++++++++++- gcc/cobol/parse_ante.h | 6 ++- gcc/cobol/scan_ante.h | 11 +++- gcc/cobol/scan_post.h | 2 - 4 files changed, 152 insertions(+), 5 deletions(-) diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y index af7f391dbb8b..36e6331622bd 100644 --- a/gcc/cobol/parse.y +++ b/gcc/cobol/parse.y @@ -311,6 +311,7 @@ class locale_tgt_t { struct file_list_t; struct cbl_label_t; typedef struct Elem_list_t<cbl_label_t*> Label_list_t; + typedef struct Elem_list_t<int> token_list_t; struct cbl_file_key_t; typedef struct Elem_list_t<cbl_file_key_t*> key_list_t; @@ -922,6 +923,8 @@ class locale_tgt_t { %type <nameloc> repo_func_name %type <namelocs> repo_func_names +%type <tokens> repo_intrinsics +%type <number> repo_intrinsic %type <codeset> codeset_name %type <locale_phrase> locale_phrase %type <number> convert_hex convert_nat convert_alpha // convert_fmt @@ -969,6 +972,7 @@ class locale_tgt_t { struct perform_t *perf; struct cbl_perform_tgt_t *tgt; Label_list_t *labels; + token_list_t *tokens; key_list_t *file_keys; cbl_file_mode_t io_mode; struct cbl_file_key_t *file_key; @@ -2604,8 +2608,21 @@ repo_func: FUNCTION repo_func_names[namelocs] INTRINSIC { { current.repository_add_all(); } + | FUNCTION repo_intrinsics INTRINSIC + { + for( int token : $repo_intrinsics->elems ) { + if( token != 0 ) { + current.repository_add(keyword_str(token)); + } + } + } + | FUNCTION repo_intrinsics error { + const char *func = $repo_intrinsics->elems.empty() ? + "" : keyword_str($repo_intrinsics->elems.front()); + error_msg(@repo_intrinsics, + "intrinsic function %qs requires INTRINSIC", func); + } | FUNCTION repo_func_names[namelocs] { - // We allow multiple names because GnuCOBOL does. ISO says 1. for( const auto& nameloc : *$namelocs ) { if( 0 != intrinsic_token_of(nameloc.name) ) { error_msg(nameloc.loc, @@ -2645,6 +2662,121 @@ repo_func_name: NAME repo_as { } ; +repo_intrinsics: + repo_intrinsic { $$ = new token_list_t($1); } + | repo_intrinsics repo_intrinsic { + $$ = $1; + $$->elems.push_back($repo_intrinsic); + } + ; + +repo_intrinsic: ABS { $$ = ABS; } + | ACOS { $$ = ACOS; } + | ANNUITY { $$ = ANNUITY; } + | ASIN { $$ = ASIN; } + | ATAN { $$ = ATAN; } + | BASECONVERT { $$ = BASECONVERT; } + | BIT_OF { $$ = BIT_OF; } + | BIT_TO_CHAR { $$ = BIT_TO_CHAR; } + | BOOLEAN_OF_INTEGER { $$ = BOOLEAN_OF_INTEGER; } + | BYTE_LENGTH { $$ = BYTE_LENGTH; } + | CHAR { $$ = CHAR; } + | CHAR_NATIONAL { $$ = CHAR_NATIONAL; } + | COMBINED_DATETIME { $$ = COMBINED_DATETIME; } + | CONCAT { $$ = CONCAT; } + | CONVERT { $$ = CONVERT; } + | COS { $$ = COS; } + | CURRENT_DATE { $$ = CURRENT_DATE; } + | DATE_OF_INTEGER { $$ = DATE_OF_INTEGER; } + | DATE_TO_YYYYMMDD { $$ = DATE_TO_YYYYMMDD; } + | DAY_OF_INTEGER { $$ = DAY_OF_INTEGER; } + | DAY_TO_YYYYDDD { $$ = DAY_TO_YYYYDDD; } + | DISPLAY_OF { $$ = DISPLAY_OF; } + | E { $$ = E; } + | EXCEPTION_FILE { $$ = EXCEPTION_FILE; } + | EXCEPTION_FILE_N { $$ = EXCEPTION_FILE_N; } + | EXCEPTION_LOCATION { $$ = EXCEPTION_LOCATION; } + | EXCEPTION_LOCATION_N { $$ = EXCEPTION_LOCATION_N; } + | EXCEPTION_STATEMENT { $$ = EXCEPTION_STATEMENT; } + | EXCEPTION_STATUS { $$ = EXCEPTION_STATUS; } + | EXP { $$ = EXP; } + | EXP10 { $$ = EXP10; } + | FACTORIAL { $$ = FACTORIAL; } + | FIND_STRING { $$ = FIND_STRING; } + | FORMATTED_CURRENT_DATE { $$ = FORMATTED_CURRENT_DATE; } + | FORMATTED_DATE { $$ = FORMATTED_DATE; } + | FORMATTED_DATETIME { $$ = FORMATTED_DATETIME; } + | FORMATTED_TIME { $$ = FORMATTED_TIME; } + | FRACTION_PART { $$ = FRACTION_PART; } + | HEX_OF { $$ = HEX_OF; } + | HEX_TO_CHAR { $$ = HEX_TO_CHAR; } + | HIGHEST_ALGEBRAIC { $$ = HIGHEST_ALGEBRAIC; } + | INTEGER { $$ = INTEGER; } + | INTEGER_OF_BOOLEAN { $$ = INTEGER_OF_BOOLEAN; } + | INTEGER_OF_DATE { $$ = INTEGER_OF_DATE; } + | INTEGER_OF_DAY { $$ = INTEGER_OF_DAY; } + | INTEGER_OF_FORMATTED_DATE { $$ = INTEGER_OF_FORMATTED_DATE; } + | INTEGER_PART { $$ = INTEGER_PART; } + | LENGTH { $$ = LENGTH; } + | LOCALE_COMPARE { $$ = LOCALE_COMPARE; } + | LOCALE_DATE { $$ = LOCALE_DATE; } + | LOCALE_TIME { $$ = LOCALE_TIME; } + | LOCALE_TIME_FROM_SECONDS { $$ = LOCALE_TIME_FROM_SECONDS; } + | LOG { $$ = LOG; } + | LOG10 { $$ = LOG10; } + | LOWER_CASE { $$ = LOWER_CASE; } + | LOWEST_ALGEBRAIC { $$ = LOWEST_ALGEBRAIC; } + | MAXX { $$ = MAXX; } + | MEAN { $$ = MEAN; } + | MEDIAN { $$ = MEDIAN; } + | MIDRANGE { $$ = MIDRANGE; } + | MINN { $$ = MINN; } + | MOD { $$ = MOD; } + | MODULE_NAME { $$ = MODULE_NAME; } + | NATIONAL_OF { $$ = NATIONAL_OF; } + | NUMVAL { $$ = NUMVAL; } + | NUMVAL_C { $$ = NUMVAL_C; } + | NUMVAL_F { $$ = NUMVAL_F; } + | ORD { $$ = ORD; } + | ORD_MAX { $$ = ORD_MAX; } + | ORD_MIN { $$ = ORD_MIN; } + | PI { $$ = PI; } + | PRESENT_VALUE { $$ = PRESENT_VALUE; } + | RANDOM { $$ = RANDOM; } + | RANGE { $$ = RANGE; } + | REM { $$ = REM; } + | REVERSE { $$ = REVERSE; } + | SECONDS_FROM_FORMATTED_TIME { $$ = SECONDS_FROM_FORMATTED_TIME; } + | SECONDS_PAST_MIDNIGHT { $$ = SECONDS_PAST_MIDNIGHT; } + | SIGN { $$ = SIGN; } + | SIN { $$ = SIN; } + | SMALLEST_ALGEBRAIC { $$ = SMALLEST_ALGEBRAIC; } + | SQRT { $$ = SQRT; } + | STANDARD_COMPARE { $$ = STANDARD_COMPARE; } + | STANDARD_DEVIATION { $$ = STANDARD_DEVIATION; } + | SUBSTITUTE { $$ = SUBSTITUTE; } + | SUM { $$ = SUM; } + | TAN { $$ = TAN; } + | TEST_DATE_YYYYMMDD { $$ = TEST_DATE_YYYYMMDD; } + | TEST_DAY_YYYYDDD { $$ = TEST_DAY_YYYYDDD; } + | TEST_FORMATTED_DATETIME { $$ = TEST_FORMATTED_DATETIME; } + | TEST_NUMVAL { $$ = TEST_NUMVAL; } + | TEST_NUMVAL_C { $$ = TEST_NUMVAL_C; } + | TEST_NUMVAL_F { $$ = TEST_NUMVAL_F; } + | TRIM { $$ = TRIM; } + | ULENGTH { $$ = ULENGTH; } + | UPOS { $$ = UPOS; } + | UPPER_CASE { $$ = UPPER_CASE; } + | USUBSTR { $$ = USUBSTR; } + | USUPPLEMENTARY { $$ = USUPPLEMENTARY; } + | UUID4 { $$ = UUID4; } + | UVALID { $$ = UVALID; } + | UWIDTH { $$ = UWIDTH; } + | VARIANCE { $$ = VARIANCE; } + | WHEN_COMPILED { $$ = WHEN_COMPILED; } + | YEAR_TO_YYYY { $$ = YEAR_TO_YYYY; } + ; + repo_program: PROGRAM_kw NAME repo_as { size_t parent = 0; @@ -5554,6 +5686,10 @@ sentence: statements '.' if( ! successful_parse() ) YYABORT; YYACCEPT; } + | statements end_program1 { + error_msg(@1, "missing %qs before END PROGRAM", "."); + YYERROR; + } | program END_SUBPROGRAM namestr[name] '.' { // a contained program (no prior END PROGRAM) is a "sentence" const cbl_label_t *prog = current.program(); diff --git a/gcc/cobol/parse_ante.h b/gcc/cobol/parse_ante.h index c580c644063c..f329b8a6e212 100644 --- a/gcc/cobol/parse_ante.h +++ b/gcc/cobol/parse_ante.h @@ -247,9 +247,13 @@ is_cobol_charset( const char name[] ) { } bool -in_procedure_division(void) { +in_procedure_division() { return current_division == procedure_div_e; } +bool +in_environment_division() { + return current_division == environment_div_e; +} static inline bool in_file_section(void) { return current_data_section == file_datasect_e; } diff --git a/gcc/cobol/scan_ante.h b/gcc/cobol/scan_ante.h index bc2454b150a3..2a17a8102b33 100644 --- a/gcc/cobol/scan_ante.h +++ b/gcc/cobol/scan_ante.h @@ -1106,7 +1106,8 @@ symbol_function_token( const char name[] ) { return 0; } -bool in_procedure_division(void ); +bool in_procedure_division(void); +bool in_environment_division(void ); static symbol_elem_t * symbol_exists( const char name[] ) { @@ -1175,6 +1176,14 @@ typed_name( const char name[] ) { struct symbol_elem_t *e = symbol_special( PROGRAM, name ); if( e ) return cbl_special_name_of(e)->token; + // If we're in the configuration section, Data Division is still empty. + // Give priority to intrinsic functions names. + if( in_environment_division() ) { + token = keyword_tok(yytext, true); + auto name = intrinsic_function_name(token); + if( name ) return token; + } + if( (token = redefined_token(name)) ) { return token; } e = symbol_exists( name ); diff --git a/gcc/cobol/scan_post.h b/gcc/cobol/scan_post.h index 5c6002f6a258..838882b44cb4 100644 --- a/gcc/cobol/scan_post.h +++ b/gcc/cobol/scan_post.h @@ -322,8 +322,6 @@ static int next_token() { return token; } -bool in_procedure_division(void); - // act on CDF tokens int prelex() {
