[gcc r17-1819] cobol: Ensure REPOSITORY paragraph accepts all intrinsic names.
James K. Lowden
jklowden@gcc.gnu.org
Wed Jun 24 21:28:18 GMT 2026
https://gcc.gnu.org/g:815237217d2c5ae50f71942344e805c528e2c0cf
commit r17-1819-g815237217d2c5ae50f71942344e805c528e2c0cf
Author: James K. Lowden <jklowden@cobolworx.com>
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() {
More information about the Gcc-cvs
mailing list