diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc index 56ed9811ff3a8095023d6a204c60d46d8efaeb46..db96951322f8edce3166ff822fbcfa105fc04864 100644 --- a/gcc/cobol/genapi.cc +++ b/gcc/cobol/genapi.cc @@ -8615,6 +8615,15 @@ intrinsic_convert_return(cbl_ctype_t returned_type, cbl_field_t *dest, tree stmt } #endif +void +parser_intrinsic_numval_c( cbl_field_t *f, + cbl_refer_t& input, + bool locale, + cbl_refer_t& currency, + bool anycase, + bool test_numval_c ) // true for TEST-NUMVAL-C +{} + void parser_intrinsic_subst( cbl_field_t *f, cbl_refer_t& ref1, diff --git a/gcc/cobol/genapi.h b/gcc/cobol/genapi.h index 2aa820ce3a36a48df5d85850b3f08e1263591472..ea37e6bf0200f6470879716d6c7fc858b30539d1 100644 --- a/gcc/cobol/genapi.h +++ b/gcc/cobol/genapi.h @@ -459,6 +459,14 @@ parser_inspect_conv( cbl_refer_t input, void parser_exception_file( cbl_field_t *tgt, cbl_file_t* file = NULL ); +void +parser_intrinsic_numval_c( cbl_field_t *f, + cbl_refer_t& input, + bool locale, + cbl_refer_t& currency, + bool anycases, + bool test_numval_c = false); + void parser_intrinsic_subst( cbl_field_t *f, cbl_refer_t& ref1, diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y index ff1775cafd2d9fdacdc12130c8c13e92220d6524..b1c97f4d0e47db0c802a6048b4d08f38440b9edb 100644 --- a/gcc/cobol/parse.y +++ b/gcc/cobol/parse.y @@ -457,6 +457,7 @@ %type <prog_end> end_program1 %type <substitution> subst_input %type <substitutions> subst_inputs +%type <numval_locale_t> numval_locale %union { bool boolean; @@ -547,6 +548,8 @@ struct { cbl_special_name_t *special; vargs_t *vargs; } display; substitution_t substitution; substitutions_t *substitutions; + struct { bool is_locale; cbl_refer_t *arg2; } numval_locale_t; + } %printer { fprintf(yyo, "clauses: 0x%04x", $$); } data_clauses @@ -8528,16 +8531,11 @@ intrinsic: intrinsic0 if( ! intrinsic_call_1($$, $func, $r1 )) YYERROR; } ; - | NUMVAL_C '(' varg[r1] varg[r2] ')' { - location_set(@1); - $$ = new_tempnumeric_float(); - if( ! intrinsic_call_2($$, NUMVAL_C, $r1, $r2) ) YYERROR; - } - | NUMVAL_C '(' varg[r1] ')' { + | NUMVAL_C '(' varg[r1] numval_locale[r2] anycase ')' { location_set(@1); $$ = new_tempnumeric_float(); - cbl_refer_t dummy = {}; - if( ! intrinsic_call_2($$, NUMVAL_C, $r1, &dummy) ) YYERROR; + parser_intrinsic_numval_c( $$, *$r1, $r2.is_locale, + *$r2.arg2, $anycase ); } | ORD '(' alpha_val[r1] ')' { @@ -8575,15 +8573,11 @@ intrinsic: intrinsic0 } - | TEST_NUMVAL_C '(' varg[r1] varg[r2] ')' { + | TEST_NUMVAL_C '(' varg[r1] numval_locale[r2] anycase ')' { location_set(@1); - $$ = new_alphanumeric(64); // how long? - if( ! intrinsic_call_2($$, TEST_NUMVAL_C, $r1, $r2) ) YYERROR; - } - | TEST_NUMVAL_C '(' varg[r1] ')' { - location_set(@1); - $$ = new_alphanumeric(64); // how long? - if( ! intrinsic_call_2($$, TEST_NUMVAL_C, $r1, NULL) ) YYERROR; + $$ = new_alphanumeric(64); + parser_intrinsic_numval_c( $$, *$r1, $r2.is_locale, + *$r2.arg2, $anycase, true ); } | TRIM '(' error ')' { yyerrorv("error: invalid TRIM argument"); @@ -8830,6 +8824,13 @@ intrinsic: intrinsic0 | intrinsic_locale ; +numval_locale: %empty { $$.is_locale = false; $$.arg2 = NULL; } + | LOCALE NAME { $$.is_locale = true; $$.arg2 = NULL; + yyerror("unimplemented: NUMVAL_C LOCALE"); YYERROR; + } + | varg { $$.is_locale = false; $$.arg2 = $1; } + ; + subst_inputs: subst_input { $$ = new substitutions_t; $$->push_back($1); } | subst_inputs subst_input { $$ = $1; $$->push_back($2); } ; @@ -8964,8 +8965,7 @@ intrinsic0: CURRENT_DATE { } ; -intrinsic_I: BYTE_LENGTH { $$ = BYTE_LENGTH; } - | DATE_OF_INTEGER { $$ = DATE_OF_INTEGER; } +intrinsic_I: DATE_OF_INTEGER { $$ = DATE_OF_INTEGER; } | DAY_OF_INTEGER { $$ = DAY_OF_INTEGER; } | FACTORIAL { $$ = FACTORIAL; } | FRACTION_PART { $$ = FRACTION_PART; } @@ -8978,8 +8978,6 @@ intrinsic_I: BYTE_LENGTH { $$ = BYTE_LENGTH; } | SIGN { $$ = SIGN; } | TEST_DATE_YYYYMMDD { $$ = TEST_DATE_YYYYMMDD; } | TEST_DAY_YYYYDDD { $$ = TEST_DAY_YYYYDDD; } - | TEST_NUMVAL { $$ = TEST_NUMVAL; } - | TEST_NUMVAL_F { $$ = TEST_NUMVAL_F; } | ULENGTH { $$ = ULENGTH; } | UPOS { $$ = UPOS; } | USUPPLEMENTARY { $$ = USUPPLEMENTARY; } @@ -9010,11 +9008,14 @@ intrinsic_N2: ANNUITY { $$ = ANNUITY; } ; intrinsic_X: BIT_TO_CHAR { $$ = BIT_TO_CHAR; } + | BYTE_LENGTH { $$ = BYTE_LENGTH; } | HEX_TO_CHAR { $$ = HEX_TO_CHAR; } | LENGTH { $$ = LENGTH; } | NUMVAL { $$ = NUMVAL; } | NUMVAL_F { $$ = NUMVAL_F; } | REVERSE { $$ = REVERSE; } + | TEST_NUMVAL { $$ = TEST_NUMVAL; } + | TEST_NUMVAL_F { $$ = TEST_NUMVAL_F; } ; intrinsic_X2: NATIONAL_OF { $$ = NATIONAL_OF; }