diff --git a/gcc/cobol/UAT/failsuite.src/run_functions.at b/gcc/cobol/UAT/failsuite.src/run_functions.at
index e26b0f98abf419ae16b184771a70072fa897b9ea..477152f3c04c1d1a424457c8fcb6972c3ffa9fa4 100644
--- a/gcc/cobol/UAT/failsuite.src/run_functions.at
+++ b/gcc/cobol/UAT/failsuite.src/run_functions.at
@@ -2823,6 +2823,8 @@ AT_CLEANUP
AT_SETUP([FUNCTION STORED-CHAR-LENGTH])
AT_KEYWORDS([functions])
+AT_XFAIL_IF([test "$COB_DIALECT" != "gnu"])
+
AT_DATA([prog.cob], [
IDENTIFICATION DIVISION.
PROGRAM-ID. prog.
diff --git a/gcc/cobol/cdf.y b/gcc/cobol/cdf.y
index 82104118dd2b24aaf7a16a9444cd9acda841eba6..1a88a31fb5d2e72ee27f9c5f7b2c96d68c2d46d0 100644
--- a/gcc/cobol/cdf.y
+++ b/gcc/cobol/cdf.y
@@ -259,15 +259,15 @@ apply_cdf_turn( exception_turns_t& turns ) {
%type <file> filename
%type <files> filenames
-%token BY 467
+%token BY 468
%token COPY 356
%token CDF_DISPLAY 378
-%token IN 580
+%token IN 581
%token NAME 286
%token NUMSTR 304
-%token OF 658
-%token PSEUDOTEXT 694
-%token REPLACING 716
+%token OF 659
+%token PSEUDOTEXT 695
+%token REPLACING 717
%token LITERAL 297
%token SUPPRESS 373
@@ -277,21 +277,21 @@ apply_cdf_turn( exception_turns_t& turns ) {
%token CDF_IF 379 CDF_ELSE 380 CDF_END_IF 381
%token CDF_EVALUATE 382 CDF_WHEN 383 CDF_END_EVALUATE 384
-%token AS 451 CONSTANT 355 DEFINED 357
+%token AS 452 CONSTANT 355 DEFINED 357
%type <boolean> DEFINED
-%token OTHER 670 PARAMETER_kw 362 OFF 659 OVERRIDE 363
-%token THRU 905
-%token TRUE_kw 780
+%token OTHER 671 PARAMETER_kw 362 OFF 660 OVERRIDE 363
+%token THRU 907
+%token TRUE_kw 782
-%token TURN 782 CHECKING 475 LOCATION 622 ON 661 WITH 806
+%token TURN 784 CHECKING 476 LOCATION 623 ON 662 WITH 808
-%left OR 906
-%left AND 907
-%right NOT 908
-%left '<' '>' '=' NE 909 LE 910 GE 911
+%left OR 908
+%left AND 909
+%right NOT 910
+%left '<' '>' '=' NE 911 LE 912 GE 913
%left '-' '+'
%left '*' '/'
-%right NEG 912
+%right NEG 914
%define api.prefix {ydf}
%define api.token.prefix{YDF_}
diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc
index e412527ecd3b3f2eabffa72e8d021472739fefb3..e200f043c97fe493101f3da1f9cf2839335fd284 100644
--- a/gcc/cobol/genapi.cc
+++ b/gcc/cobol/genapi.cc
@@ -8638,6 +8638,13 @@ parser_intrinsic_callv( cbl_field_t *tgt,
SHOW_PARSE_END
}
+ if( function_name == substitute_billboard ) {
+ auto truth_of_the_matter = reinterpret_cast<cbl_substitute_t*>(refs);
+ warnx("%s: unimplemented: FUNCTION SUBSTITUTE", __func__);
+ return;
+ }
+
+
TRACE1
{
TRACE1_HEADER
diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y
index 065b4209ef311ca606d17d285114e9669c79e236..4bf0586dccf3c18d540d3f09a57cc9a1a87625af 100644
--- a/gcc/cobol/parse.y
+++ b/gcc/cobol/parse.y
@@ -135,6 +135,29 @@
typedef std::map<data_category_t, struct cbl_refer_t*> category_map_t;
+ struct substitution_t {
+ enum subst_fl_t { subst_all_e, subst_first_e = 'F', subst_last_e = 'L' };
+ bool anycase;
+ subst_fl_t first_last;
+ cbl_refer_t *orig, *replacement;
+
+ substitution_t& init( bool anycase, char first_last,
+ cbl_refer_t *orig, cbl_refer_t *replacement ) {
+ this->anycase = anycase;
+ switch(first_last) {
+ case 'F': this->first_last = subst_first_e; break;
+ case 'L': this->first_last = subst_last_e; break;
+ default:
+ this->first_last = subst_all_e;
+ break;
+ }
+ this->orig = orig;
+ this->replacement = replacement;
+ return *this;
+ }
+ };
+ typedef std::list<substitution_t> substitutions_t;
+
struct init_statement_t {
bool to_value;
bool to_default;
@@ -409,8 +432,8 @@
%type <error_clauses> io_invalids read_eofs write_eops
%type <boolean> io_invalid read_eof write_eop
- global is_global
-%type <number> mistake globally
+ global is_global anycase
+%type <number> mistake globally first_last
%type <use_culprit> culprits
%type <labels> labels
@@ -432,6 +455,8 @@
%type <refer> init_data stop_how stop_status
%type <float128> cce_expr cce_factor const_value
%type <prog_end> end_program1
+%type <substitution> subst_input
+%type <substitutions> subst_inputs
%union {
bool boolean;
@@ -520,6 +545,8 @@
category_map_t *replacements;
init_statement_t *init_stmt;
struct { cbl_special_name_t *special; vargs_t *vargs; } display;
+ substitution_t substitution;
+ substitutions_t *substitutions;
}
%printer { fprintf(yyo, "clauses: 0x%04x", $$); } data_clauses
@@ -601,7 +628,7 @@
ALLOCATE
ALPHABET ALPHABETIC ALPHABETIC_LOWER
ALPHABETIC_UPPER ALPHANUMERIC ALPHANUMERIC_EDITED
- ALPHED ALSO ALTERNATE ANNUITY ANY APPLY ARE
+ ALPHED ALSO ALTERNATE ANNUITY ANY ANYCASE APPLY ARE
AREA AREAS AS
ASCENDING ASIN ASSIGN AT ATAN AUTHOR
@@ -693,7 +720,7 @@
SPACES SPECIAL_NAMES SQRT STANDARD STANDARD_ALPHABET
STANDARD_1 STANDARD_DEVIATION STATUS
STDERR STDIN STDOUT
- LITERAL SUM SWITCH SYMBOL SYMBOLIC SYNCHRONIZED
+ LITERAL SUBSTITUTE SUM SWITCH SYMBOL SYMBOLIC SYNCHRONIZED
SYSIN SYSIPT SYSLST SYSOUT SYSPCH SYSPUNCH
TALLY TALLYING TAN TERMINATE TEST TEST_DATE_YYYYMMDD
@@ -8475,14 +8502,14 @@ intrinsic: intrinsic0
if( ! intrinsic_call_2($$, INTEGER_OF_FORMATTED_DATE,
r1, $r2) ) YYERROR;
}
- | SECONDS_FROM_FORMATTED_TIME '(' TIME_FMT[r1] num_operand[r2] ')' {
+ | SECONDS_FROM_FORMATTED_TIME '(' TIME_FMT[r1] varg[r2] ')' {
location_set(@1);
$$ = new_tempnumeric();
auto r1 = new_reference(new_literal($r1, quoted_e));
if( ! intrinsic_call_2($$, SECONDS_FROM_FORMATTED_TIME,
r1, $r2) ) YYERROR;
}
- | SECONDS_FROM_FORMATTED_TIME '(' DATETIME_FMT[r1] num_operand[r2] ')'
+ | SECONDS_FROM_FORMATTED_TIME '(' DATETIME_FMT[r1] varg[r2] ')'
{
location_set(@1);
$$ = new_tempnumeric();
@@ -8530,6 +8557,24 @@ intrinsic: intrinsic0
$$ = new_tempnumeric_float();
if( ! intrinsic_call_1($$, RANDOM, $r1) ) YYERROR;
}
+
+ | SUBSTITUTE '(' varg[r1] subst_inputs[inputs] ')' {
+ location_set(@1);
+ $$ = new_alphanumeric(64);
+ auto narg = $inputs->size();
+ cbl_substitute_t args[narg];
+ std::transform( $inputs->begin(), $inputs->end(), args,
+ []( const substitution_t& arg ) {
+ cbl_substitute_t output( arg.anycase,
+ char(arg.first_last),
+ arg.orig,
+ arg.replacement );
+ return output; } );
+ auto fake = reinterpret_cast<cbl_refer_t*>(args);
+ parser_intrinsic_callv($$, substitute_billboard, narg, fake);
+ }
+
+
| TEST_NUMVAL_C '(' varg[r1] varg[r2] ')' {
location_set(@1);
$$ = new_alphanumeric(64); // how long?
@@ -8758,8 +8803,6 @@ intrinsic: intrinsic0
$r1, $r2, $r3) ) YYERROR;
}
-
-
| intrinsic_N2 '(' expr[r1] expr[r2] ')'
{
location_set(@1);
@@ -8787,6 +8830,14 @@ intrinsic: intrinsic0
| intrinsic_locale
;
+subst_inputs: subst_input { $$ = new substitutions_t; $$->push_back($1); }
+ | subst_inputs subst_input { $$ = $1; $$->push_back($2); }
+ ;
+subst_input: anycase first_last varg[v1] varg[v2] {
+ $$.init( $anycase, $first_last, $v1, $v2 );
+ }
+ ;
+
intrinsic_locale:
LOCALE_COMPARE '(' varg[r1] varg[r2] ')'
{
@@ -8896,6 +8947,11 @@ intrinsic0: CURRENT_DATE {
$$ = new_tempnumeric_float();
parser_intrinsic_call_0( $$, "__gg__pi" );
}
+ | SECONDS_PAST_MIDNIGHT {
+ location_set(@1);
+ $$ = new_tempnumeric();
+ intrinsic_call_0( $$, SECONDS_PAST_MIDNIGHT );
+ }
| UUID4 {
location_set(@1);
$$ = new_alphanumeric(32); // don't know correct size
@@ -8982,6 +9038,10 @@ all: %empty { $$ = false; }
| ALL { $$ = true; }
;
+anycase: %empty { $$ = false; }
+ | ANYCASE { $$ = true; }
+ ;
+
as: %empty
| AS
;
@@ -9018,6 +9078,11 @@ file: %empty
| FILE_KW
;
+first_last: %empty { $$ = 0; }
+ | FIRST { $$ = 'F'; }
+ | LAST { $$ = 'L'; }
+ ;
+
is_global: %empty %prec GLOBAL { $$ = false; }
| is GLOBAL { $$ = true; }
;
diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h
index 75e29d696acf00dad9f1193f07771536dd9a1fbf..a23f876490192c13f81abe41f7a5043a399d3c42 100644
--- a/gcc/cobol/symbols.h
+++ b/gcc/cobol/symbols.h
@@ -76,6 +76,7 @@ strfromf128 (char *restrict string, size_t size,
#endif
extern const char *numed_message;
+extern const char substitute_billboard[];
enum cbl_dialect_t {
dialect_gcc_e = 0x00,
@@ -832,6 +833,21 @@ struct cbl_refer_t {
}
};
+struct cbl_substitute_t {
+ enum subst_fl_t { subst_all_e, subst_first_e, subst_last_e };
+ bool anycase;
+ subst_fl_t first_last;
+ cbl_refer_t orig, replacement;
+
+ cbl_substitute_t( bool anycase = false, char first_last = 0,
+ cbl_refer_t *orig = NULL, cbl_refer_t *replacement = NULL )
+ : anycase(anycase)
+ , first_last(subst_fl_t(first_last))
+ , orig(*orig)
+ , replacement(*replacement)
+ {}
+};
+
static inline const char *
field_name( const cbl_field_t *f ) { return f? f->name : "(void)"; }
diff --git a/gcc/cobol/util.cc b/gcc/cobol/util.cc
index bbc3e7824c9d56824e10f4e149eed1800de043c0..0e638d0d143b6e1afbec7c057ffe73cce66851d3 100644
--- a/gcc/cobol/util.cc
+++ b/gcc/cobol/util.cc
@@ -208,6 +208,7 @@ repeat_count( const char picture[] )
}
const char *numed_message;
+const char substitute_billboard[] = "__gg__substitute";
#include <cctype>
extern int yydebug;