diff --git a/gcc/cobol/cdf.y b/gcc/cobol/cdf.y index 77ea416303e7eafbb2fb1909bffc9b1f7e49d264..428ed9d59f7e24b0c45ace22b4096e4052947cf8 100644 --- a/gcc/cobol/cdf.y +++ b/gcc/cobol/cdf.y @@ -265,9 +265,9 @@ apply_cdf_turn( exception_turns_t& turns ) { %token IN 583 %token NAME 286 %token NUMSTR 304 -%token OF 661 -%token PSEUDOTEXT 697 -%token REPLACING 719 +%token OF 662 +%token PSEUDOTEXT 698 +%token REPLACING 720 %token LITERAL 297 %token SUPPRESS 375 @@ -279,19 +279,19 @@ apply_cdf_turn( exception_turns_t& turns ) { %token AS 454 CONSTANT 357 DEFINED 359 %type <boolean> DEFINED -%token OTHER 673 PARAMETER_kw 364 OFF 662 OVERRIDE 365 -%token THRU 909 -%token TRUE_kw 784 +%token OTHER 674 PARAMETER_kw 364 OFF 663 OVERRIDE 365 +%token THRU 910 +%token TRUE_kw 785 -%token TURN 786 CHECKING 478 LOCATION 625 ON 664 WITH 810 +%token TURN 787 CHECKING 478 LOCATION 626 ON 665 WITH 811 -%left OR 910 -%left AND 911 -%right NOT 912 -%left '<' '>' '=' NE 913 LE 914 GE 915 +%left OR 911 +%left AND 912 +%right NOT 913 +%left '<' '>' '=' NE 914 LE 915 GE 916 %left '-' '+' %left '*' '/' -%right NEG 916 +%right NEG 917 %define api.prefix {ydf} %define api.token.prefix{YDF_} diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y index ea0c9ac06237a8be26d3abe12dc3e07ef66b39b5..01140e74c164b5a5b477001c01c191da55eabc29 100644 --- a/gcc/cobol/parse.y +++ b/gcc/cobol/parse.y @@ -681,7 +681,7 @@ KANJI KEY - LABEL LAST LEADING LEFT LENGTH LEVEL LEVEL66 + LABEL LAST LEADING LEFT LENGTH LENGTH_OF LEVEL LEVEL66 LEVEL88 LIMIT LIMITS LINE LINES LINE_COUNTER LINAGE LINKAGE LOCALE LOCALE_COMPARE LOCALE_DATE LOCALE_TIME LOCALE_TIME_FROM_SECONDS @@ -2704,6 +2704,7 @@ data_descr: data_descr1 const_value: cce_expr | BYTE_LENGTH of name { $$ = $name->data.capacity; } | LENGTH of name { $$ = $name->data.capacity; } + | LENGTH_OF of name { $$ = $name->data.capacity; } ; value78: literalism @@ -5618,6 +5619,17 @@ num_value: scalar | num_literal { $$ = new_reference($1); } | ADDRESS OF scalar {$$ = $scalar; $$->addr_of = true; } | DETAIL OF scalar {$$ = $scalar; } + | LENGTH_OF scalar[val] { + location_set(@1); + $$ = new cbl_refer_t( new_tempnumeric_float() ); + auto r1 = $val; + if( ! dialect_ibm() ) { + yyerrorv("LENGTH OF %s requires '-dialect ibm' option", + $val->field->name); + } + if( ! intrinsic_call_1($$->field, LENGTH, r1) ) YYERROR; + } + ; @@ -6846,7 +6858,7 @@ set: SET set_tgts[tgts] TO set_operand[src] // send the signal to clear the stashed exception values parser_exception_raise(ec_none_e); } - | SET LENGTH OF scalar TO scalar + | SET LENGTH_OF scalar TO scalar { statement_begin(@1, SET); yyerror("SET LENGTH OF is not implemented"); @@ -7855,7 +7867,7 @@ ffi_by_val: by_value_arg { $$ = new cbl_ffi_arg_t(by_value_e, $scalar, address_of_e); } - | LENGTH OF scalar + | LENGTH_OF scalar { $$ = new cbl_ffi_arg_t(by_value_e, $scalar, length_of_e); } @@ -8440,17 +8452,6 @@ intrinsic: function_udf parser_exception_file( $$, $filename ); } - | LENGTH OF scalar[val] { - location_set(@1); - $$ = new_tempnumeric_float(); - auto r1 = $val; - if( ! intrinsic_call_1($$, LENGTH, r1) ) YYERROR; - if( ! dialect_ibm() ) { - yyerrorv("LENGTH OF %s requires '-dialect ibm' option", - $val->field->name); - } - } - | FORMATTED_DATE '(' DATE_FMT[r1] expr[r2] ')' { location_set(@1); $$ = new_alphanumeric(MAXLENGTH_FORMATTED_DATE); diff --git a/gcc/cobol/scan.l b/gcc/cobol/scan.l index 9dccbfb22df07cf647824de5c21ec81e5ad9179e..f893f51915733b731bbe4c2946ab33805d7333cc 100644 --- a/gcc/cobol/scan.l +++ b/gcc/cobol/scan.l @@ -331,6 +331,7 @@ LC_MONETARY { return LC_MONETARY_kw; } LC_NUMERIC { return LC_NUMERIC_kw; } LC_TIME { return LC_TIME_kw; } LENGTH { return LENGTH; } +LENGTH{SPC}OF { return LENGTH_OF; } LOCALE { return LOCALE; } LOWLIGHT { return LOWLIGHT; } NEAREST-AWAY-FROM-ZERO { return NEAREST_AWAY_FROM_ZERO; } @@ -904,6 +905,7 @@ USE([[:space:]]+FOR)? { return USE; } ANY { return ANY; } LENGTH { return LENGTH; } + LENGTH{SPC}OF { return LENGTH_OF; } BASED { return BASED; } USAGE { return USAGE; } COMP(UTATIONAL)?-5 { return ucomputable(FldNumericBin5, 0); }