From d6ec46f94ebc8536f75ecee50e7a6fd1c701e2ab Mon Sep 17 00:00:00 2001 From: David Declerck Date: Wed, 19 Jun 2024 17:44:15 +0200 Subject: [PATCH] Merge SVN 4653 --- cobc/ChangeLog | 20 ++ cobc/codegen.c | 4 + cobc/scanner.l | 406 ++++++++++++++------------- cobc/tree.c | 43 ++- cobc/typeck.c | 339 ++++++++++++---------- libcob/intrinsic.c | 3 + tests/testsuite.src/run_functions.at | 58 +++- tests/testsuite.src/syn_misc.at | 12 +- 8 files changed, 512 insertions(+), 373 deletions(-) diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 63fd96b61..09f166e2a 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -237,6 +237,26 @@ * tree.c (cb_build_picture), tree.h: return cb_picture instead of cb_tree as all but one caller directly use it that way +2022-07-12 Simon Sobisch + + * scanner.l (read_literal): do the necessary conversion for national + literals (simple approach, only working with source in iso-8859-15 + or plain ascii) + * typeck.c (get_value): return correct numeric value for national + (utf16) literals + * tree.c (cb_build_intrinsic): fixed optimized length generation for + national fields and literals + * typeck.c (cb_validate_program_environment): refactored, + reducing variable scope and extracted (validate_alphabet) and + (check_class_duplicates); call the later depending on + cb_warn_additional, no need to test if the final result is ignored + * typeck.c (validate_alphabet): adjustments for national literals, + now partially supported + * scanner.l: moved static literal_error to local variable, + passing it (to error_literal); return a valid literal in case of + literal errors (intead of cb_error_node) to prevent spurious + follow-up errors on their use + 2022-07-06 Nicolas Berthier * cobc.h: define function purity attribute COB_A_PURE diff --git a/cobc/codegen.c b/cobc/codegen.c index 0f248560b..c6cc9eeb8 100644 --- a/cobc/codegen.c +++ b/cobc/codegen.c @@ -5347,6 +5347,10 @@ initialize_uniform_char (const struct cb_field *f, return '0'; case COB_TYPE_ALPHANUMERIC: return ' '; +#if 1 /* TODO: proper initialization of NATIONAL data */ + case COB_TYPE_NATIONAL: + return ' '; +#endif default: return -1; } diff --git a/cobc/scanner.l b/cobc/scanner.l index 9beadc62a..8ae70549f 100644 --- a/cobc/scanner.l +++ b/cobc/scanner.l @@ -157,7 +157,6 @@ static size_t pic2_size; static unsigned int last_token_is_dot = 0; static unsigned int integer_is_label = 0; static unsigned int inside_bracket = 0; -static unsigned int literal_error; static char err_msg[COB_MINI_BUFF]; /* Function declarations */ @@ -1289,7 +1288,7 @@ H#[0-9A-Za-z]+ { %% static void -error_literal (const char *type, const char *literal) +error_literal (const char *type, const char *literal, unsigned int literal_error) { if (!literal_error) { char lit_out[CB_ERR_LITMAX + 1]; @@ -1318,7 +1317,6 @@ error_literal (const char *type, const char *literal) } #endif } - literal_error++; cb_error ("%s", err_msg); } @@ -1327,8 +1325,7 @@ read_literal (const char mark, const char *type) { size_t i; int c; - - literal_error = 0; + unsigned int literal_error = 0; i = 0; /* read until a not-escaped mark is found (see break) @@ -1363,10 +1360,13 @@ read_literal (const char mark, const char *type) for (escaped) mark before checking the max length */ if (i++ == cb_lit_length) { snprintf (err_msg, COB_MINI_MAX, - _("literal length exceeds %d characters"), + _("literal length exceeds %u characters"), cb_lit_length); plex_buff[cb_lit_length] = 0; /* ensure valid C-string for error message */ - error_literal ("", plex_buff); + error_literal ("", plex_buff, literal_error); + if (!literal_error) { + literal_error = cb_lit_length; + } } } if (c == EOF @@ -1376,8 +1376,11 @@ read_literal (const char mark, const char *type) ) { snprintf (err_msg, COB_MINI_MAX, _("missing terminating %c character"), mark); - plex_buff[plex_size - 1] = 0; /* ensure valid C-string for error message */ - error_literal ("", plex_buff); + plex_buff[i] = 0; /* ensure valid C-string for error message */ + error_literal ("", plex_buff, literal_error); + if (!literal_error) { + literal_error = i; + } } /* FIXME: Exact behavior should depend on level of support: @@ -1404,6 +1407,20 @@ read_literal (const char mark, const char *type) if (type[0] != 'N') { yylval = cb_build_alphanumeric_literal (plex_buff, i); } else { + /* poor-man's conversion iso-8859 -> utf-16 */ + /* "!a0" = x'21613000' -> nx'00210061003000' */ + size_t new_size = i * 2; + if (new_size + 1 > plex_size) { + plex_size = new_size + 1; + plex_buff = cobc_realloc (plex_buff, plex_size); + } + plex_buff[new_size] = 0; + while (i) { + i--; + plex_buff[i * 2 + 1] = plex_buff [i]; + plex_buff[i * 2] = 0; + } + i = new_size; if (type[1] != 'C') { if (cb_verify (cb_national_literals, _("national literal"))) { CB_UNFINISHED (_("national literal")); @@ -1425,9 +1442,8 @@ scan_x (const char *text, const char *type) char *dst; size_t curr_len; size_t result_len; - int c; - - literal_error = 0; + char c; + unsigned int literal_error = 0; /* Remark: The standard allows for 8,191 (normal/national/boolean) character positions */ @@ -1439,8 +1455,7 @@ scan_x (const char *text, const char *type) curr_len--; if (curr_len == 0) { cb_verify (cb_zero_length_lit, _("zero-length literal")); - plex_buff[0] = '\0'; - plex_buff[1] = '\0'; + memset (plex_buff, 0, 5); cb_warning (COBC_WARN_FILLER, _("hexadecimal literal has zero length; X'00' will be assumed")); if (type[0] == 'B') { @@ -1453,39 +1468,50 @@ scan_x (const char *text, const char *type) RETURN_TOK (LITERAL); } + /* ensure buffers don't get too big */ + if (curr_len > (size_t)cb_lit_length + 1) { + curr_len = cb_lit_length + 1; + } if (curr_len + 1 > plex_size) { plex_size = curr_len + 1; - plex_buff = cobc_realloc (plex_buff, plex_size); + cobc_free (plex_buff); + plex_buff = cobc_malloc (plex_size); } memcpy (plex_buff, text, curr_len); if (type[0] == 'X') { result_len = curr_len / 2; /* characters, two half-bytes (hex) = 1 byte */ } else if (type[0] == 'B') { + result_len = curr_len * 4; /* boolean characters B -> 1110 */ if (!cb_verify (cb_hexadecimal_boolean, _("hexadecimal-boolean literal"))) { - goto error; /* early exit possible as complete literal is consumed */ + yylval = cb_build_numeric_literal (0, "0", 0); + RETURN_TOK (LITERAL); } - result_len = curr_len * 4; /* boolean characters B -> 1110 */ + /* GnuCOBOL currently only support 64 bit booleans */ if (result_len > 64) { snprintf (err_msg, COB_MINI_MAX, - _("literal length %d exceeds %d characters"), - (int) result_len, 64); - error_literal (type, plex_buff); - goto error; + _("literal length %lu exceeds %u characters"), + (unsigned long) result_len, 64); + error_literal (type, plex_buff, literal_error++); + /* we'll get an overflow below, but that's no problem, + an alternative would be to incement *text to only parse 64 / 4 + characters but that leads to not verified data, which is + more important as the compilation will error-exit in any case */ } } else { + result_len = curr_len / (2 * COB_NATIONAL_SIZE); if (!cb_verify (cb_national_hex_literals, _("hexadecimal-national literal"))) { - goto error; /* early exit possible as complete literal is consumed */ + yylval = cb_build_national_literal ("", 1); + RETURN_TOK (LITERAL); + } else { + CB_UNFINISHED (_("national literal")); } - CB_UNFINISHED (_("national literal")); - result_len = curr_len / (2 * COB_NATIONAL_SIZE); /* national characters */ } if (result_len > cb_lit_length) { snprintf (err_msg, COB_MINI_MAX, - _("literal length %d exceeds %d characters"), - (int) result_len, cb_lit_length); - error_literal (type, plex_buff); - goto error; + _("literal length %lu exceeds %u characters"), + (unsigned long) result_len, cb_lit_length); + error_literal (type, plex_buff, literal_error++); } p = (char *)text; @@ -1496,13 +1522,13 @@ scan_x (const char *text, const char *type) /* hexadecimal-boolean */ cob_u64_t val = 0; for (; *p != *e; p++) { - c = (int) *p; + c = *p; if ('0' <= c && c <= '9') { - val = (val << 4) + ((cob_u64_t)c - '0'); + c = c - '0'; } else if ('A' <= c && c <= 'F') { - val = (val << 4) + ((cob_u64_t)c - 'A' + 10); + c = c - 'A' + 10; } else if ('a' <= c && c <= 'f') { - val = (val << 4) + ((cob_u64_t)c - 'a' + 10); + c = c - 'a' + 10; } else { snprintf (err_msg, COB_MINI_MAX, _("literal contains invalid character '%c'"), c); @@ -1510,15 +1536,13 @@ scan_x (const char *text, const char *type) memcpy (plex_buff, text, curr_len + 1); plex_buff[curr_len] = 0; } - error_literal (type, plex_buff); + error_literal (type, plex_buff, literal_error++); /* By not breaking immediately, we detect any following - invalid chars + invalid chars */ - continue; + c = 0; } - } - if (literal_error != 0) { - goto error; + val = (val << 4) + c; } sprintf ((char *)plex_buff, CB_FMT_LLU, val); yylval = cb_build_numeric_literal (0, (const void *)plex_buff, 0); @@ -1542,18 +1566,16 @@ scan_x (const char *text, const char *type) memcpy (plex_buff, text, curr_len + 1); plex_buff[curr_len] = 0; } - error_literal (type, plex_buff); + error_literal (type, plex_buff, literal_error++); /* By not breaking immediately, we detect any following invalid chars */ - continue; + c = 0; } - if (literal_error == 0) { - if (high) { - *dst = (cob_u8_t)(c << 4); - } else { - *dst++ += (cob_u8_t)c; - } + if (high) { + *dst = (cob_u8_t)(c << 4); + } else { + *dst++ += (cob_u8_t)c; } high = 1 - high; } @@ -1566,10 +1588,7 @@ scan_x (const char *text, const char *type) memcpy (plex_buff, text, curr_len + 1); plex_buff[curr_len] = 0; } - error_literal (type, plex_buff); - } - if (literal_error != 0) { - goto error; + error_literal (type, plex_buff, literal_error++); } if (type[0] != 'N') { yylval = cb_build_alphanumeric_literal (plex_buff, (size_t)(dst - plex_buff)); @@ -1579,87 +1598,80 @@ scan_x (const char *text, const char *type) } RETURN_TOK (LITERAL); - -error: - yylval = cb_error_node; - RETURN_TOK (LITERAL); } static int scan_z (const char *text, const char *type) { - size_t currlen; - - literal_error = 0; - - /* currlen includes the terminating quote */ - currlen = strlen (text); - if ((currlen - 1) > cb_lit_length) { - currlen--; + /* curr_len includes the terminating quote */ + size_t curr_len = strlen (text); + + if (curr_len == 1) { + curr_len--; + snprintf (err_msg, COB_MINI_MAX, + _("%s literals must contain at least one character"), + type); + error_literal (type, "", 0); + yylval = cb_build_alphanumeric_literal ("", 1); + RETURN_TOK (LITERAL); + } + if ((unsigned long)(curr_len - 1) > cb_lit_length) { + curr_len--; snprintf (err_msg, COB_MINI_MAX, - _("literal length %d exceeds %d characters"), - (int) currlen, cb_lit_length); - error_literal (type, text); - goto error; - } else if (currlen == 1) { - currlen--; - snprintf (err_msg, COB_MINI_MAX, - _("%s literals must contain at least one character"), - type); - error_literal (type, ""); - goto error; - } - if (currlen > plex_size) { - plex_size = currlen; - plex_buff = cobc_realloc (plex_buff, plex_size); - } - memcpy (plex_buff, text, currlen); - plex_buff[currlen - 1] = 0; + _("literal length %lu exceeds %u characters"), + (unsigned long) curr_len, cb_lit_length); + error_literal (type, text, 0); + curr_len = cb_lit_length + 1; /* ensure buffers don't get too big */ + } + if (curr_len > plex_size) { + plex_size = curr_len; + cobc_free (plex_buff); + plex_buff = cobc_malloc (plex_size); + } + memcpy (plex_buff, text, curr_len); + plex_buff[curr_len - 1] = 0; /* Count is correct here as the trailing quote is now a null */ - yylval = cb_build_alphanumeric_literal (plex_buff, currlen); + yylval = cb_build_alphanumeric_literal (plex_buff, curr_len); if (type[0] == 'L') { CB_LITERAL(yylval)->llit = 1; } RETURN_TOK (LITERAL); - - error: - yylval = cb_error_node; - RETURN_TOK (LITERAL); } static int scan_h (const char *text, const char *type) { - size_t currlen; + size_t curr_len; char *p; cob_u64_t val = 0; int c; + unsigned int literal_error = 0; - literal_error = 0; - - if (type[1] == '#' && - !cb_verify (cb_acu_literals, _("ACUCOBOL numeric literal"))) { - goto error; /* early exit possible as complete literal is consumed */ + if (type[1] == '#' + && !cb_verify (cb_acu_literals, _("ACUCOBOL numeric literal"))) { + /* note: early exit with valid literal */ + yylval = cb_build_numeric_literal (0, "0", 0); + RETURN_TOK (LITERAL); } - /* currlen can include the terminating quote */ - currlen = strlen (text); - memcpy (plex_buff, text, currlen + 1); + /* curr_len can include the terminating quote */ + curr_len = strlen (text); + memcpy (plex_buff, text, curr_len + 1); if (type[1] != '#') { - currlen--; - if (currlen == 0) { + curr_len--; + if (curr_len == 0) { cb_error (_("H literals must contain at least one character")); - goto error; + yylval = cb_build_numeric_literal (0, "0", 0); + RETURN_TOK (LITERAL); } - plex_buff[currlen] = 0; + plex_buff[curr_len] = 0; } - if (currlen > 16) { + if (curr_len > 16) { snprintf (err_msg, COB_MINI_MAX, - _("literal length %d exceeds %d characters"), - (int) currlen, 16); - error_literal ("hex", plex_buff); - goto error; + _("literal length %lu exceeds %u characters"), + (unsigned long) curr_len, 16); + error_literal ("hex", plex_buff, literal_error++); } for (p = plex_buff; *p != 0; p++) { @@ -1673,11 +1685,11 @@ scan_h (const char *text, const char *type) } else { snprintf (err_msg, COB_MINI_MAX, _("literal contains invalid character '%c'"), c); - error_literal (type, plex_buff); + error_literal (type, plex_buff, literal_error++); /* By not breaking immediately, we detect any following invalid chars */ - continue; + c = 0; } val = (val << 4) + c; @@ -1686,25 +1698,20 @@ scan_h (const char *text, const char *type) if (type[1] == '#') { /* limit for ACUCOBOL literals: UINT_MAX */ if (val > UINT_MAX) { - snprintf (err_msg, COB_MINI_MAX, - _("literal exceeds limit %u"), UINT_MAX); - error_literal (type, plex_buff); + if (curr_len <= 16) { + snprintf (err_msg, COB_MINI_MAX, + _("literal exceeds limit %u"), UINT_MAX); + error_literal (type, plex_buff, literal_error++); + } + val = UINT_MAX; } } - if (literal_error) { - goto error; - } - /* Duplication? */ sprintf ((char *)plex_buff, CB_FMT_LLU, val); yylval = cb_build_numeric_literal (0, (const void *)plex_buff, 0); RETURN_TOK (LITERAL); - -error: - yylval = cb_error_node; - RETURN_TOK (LITERAL); } static int @@ -1714,50 +1721,56 @@ scan_b (const char *text, const char *type) COBOL 2002 allows up to 160 boolean characters --> both identical to "literal-length" maximum GnuCOBOL currently only supports 64 boolean characters, - check if it works to concatenate after 64 characters, similar to read_literal() + more need a different storage */ - size_t currlen; + size_t curr_len; char *p; cob_u64_t val = 0; int c; + unsigned int literal_error = 0; - literal_error = 0; - - /* currlen can include the terminating quote */ - currlen = strlen (text); + /* curr_len can include the terminating quote */ + curr_len = strlen (text); if (type[1] == 0) { if (!cb_verify (cb_numeric_boolean, _("numeric boolean literal"))) { - goto error; /* early exit possible as complete literal is consumed */ + /* early exit possible as complete literal is consumed */ + curr_len = 0; } - if (currlen == 1) { + if (curr_len == 1) { cb_verify (cb_zero_length_lit, _("zero-length literal")); cb_warning (COBC_WARN_FILLER, _("Boolean literal has zero length; B'0' will be assumed")); + } + if (curr_len <= 1) { /* FIXME: we should really build a boolean literal... */ yylval = cb_build_numeric_literal (0, "0", 0); RETURN_TOK (LITERAL); } } else { if (!cb_verify (cb_acu_literals, _("ACUCOBOL numeric literal"))) { - goto error; /* early exit possible as complete literal is consumed */ + yylval = cb_build_numeric_literal (0, "0", 0); + RETURN_TOK (LITERAL); } }; - if (currlen >= plex_size) { - currlen = plex_size - 1; + if (curr_len >= plex_size) { + curr_len = plex_size - 1; } - memcpy (plex_buff, text, currlen + 1); + memcpy (plex_buff, text, curr_len + 1); if (type[1] == 0) { - currlen--; + curr_len--; } - plex_buff[currlen] = 0; - if (currlen > 64) { + plex_buff[curr_len] = 0; + if (curr_len > 64) { snprintf (err_msg, COB_MINI_MAX, - _("literal length %d exceeds %d characters"), - (int) currlen, 64); - error_literal (type, plex_buff); - goto error; + _("literal length %lu exceeds %u characters"), + (unsigned long) curr_len, 64); + error_literal (type, plex_buff, literal_error++); + /* we'll get an overflow below, but that's no problem, + an alternative would be to incement *text to only parse 64 / 4 + characters but that leads to not verified data, which is + more important as the compilation will error-exit in any case */ } for (p = plex_buff; *p != 0; p++) { @@ -1769,8 +1782,8 @@ scan_b (const char *text, const char *type) } else { snprintf (err_msg, COB_MINI_MAX, _("literal contains invalid character '%c'"), c); - error_literal (type, plex_buff); - continue; + error_literal (type, plex_buff, literal_error++); + c = 0; } val = (val << 1) + c; @@ -1778,78 +1791,75 @@ scan_b (const char *text, const char *type) if (type[1] == '#') { /* limit for ACUCOBOL literals: UINT_MAX */ if (val > UINT_MAX) { - snprintf (err_msg, COB_MINI_MAX, - _("literal exceeds limit %u"), UINT_MAX); - error_literal (type, plex_buff); + if (curr_len <= 64) { + snprintf (err_msg, COB_MINI_MAX, + _("literal exceeds limit %u"), UINT_MAX); + error_literal (type, plex_buff, literal_error); + } + val = UINT_MAX; } } - if (literal_error) { - goto error; - } - sprintf ((char *)plex_buff, CB_FMT_LLU, val); /* FIXME: we should likely build a boolean literal ... */ yylval = cb_build_numeric_literal (0, (const void *)plex_buff, 0); RETURN_TOK (LITERAL); - - error: - yylval = cb_error_node; - RETURN_TOK (LITERAL); } static int scan_o (const char *text, const char *type) { - size_t currlen; - char *p; + size_t curr_len; cob_u64_t val = 0; - int c; - - literal_error = 0; + char *p; + char c; + unsigned int literal_error = 0; if (type[0] == '%') { if (!cb_verify (cb_hp_octal_literals, _("HP COBOL octal literal"))) { - goto error; /* early exit possible as complete literal is consumed */ + /* early exit possible as complete literal is consumed */ + yylval = cb_build_numeric_literal (0, "0", 0); + RETURN_TOK (LITERAL); } } else { if (!cb_verify (cb_acu_literals, _("ACUCOBOL numeric literal"))) { - goto error; /* early exit possible as complete literal is consumed */ + /* early exit possible as complete literal is consumed */ + yylval = cb_build_numeric_literal (0, "0", 0); + RETURN_TOK (LITERAL); } } - currlen = strlen (text); - memcpy (plex_buff, text, currlen + 1); - if (currlen > 22) { + curr_len = strlen (text); + memcpy (plex_buff, text, curr_len + 1); + if (curr_len > 22) { snprintf (err_msg, COB_MINI_MAX, - _("literal length %d exceeds %d characters"), - (int) currlen, 22); - error_literal (type, plex_buff); - goto error; + _("literal length %lu exceeds %u characters"), + (unsigned long) curr_len, 22); + error_literal (type, plex_buff, literal_error++); } for (p = plex_buff; *p != 0; p++) { - c = (int) *p; - if (!('0' <= c && c <= '7')) { + c = *p; + if ('0' <= c && c <= '7') { + c = c - '0'; + } else { snprintf (err_msg, COB_MINI_MAX, _("literal contains invalid character '%c'"), c); - error_literal (type, plex_buff); - continue; + error_literal (type, plex_buff, literal_error++); + c = 0; } - c = c - '0'; val = (val << 3) + c; } /* limit for ACUCOBOL literals: UINT_MAX */ if (val > UINT_MAX) { - snprintf (err_msg, COB_MINI_MAX, - _("literal exceeds limit %u"), UINT_MAX); - error_literal (type, plex_buff); - } - - if (literal_error) { - goto error; + if (curr_len <= 22) { + snprintf (err_msg, COB_MINI_MAX, + _("literal exceeds limit %u"), UINT_MAX); + error_literal (type, plex_buff, literal_error++); + } + val = UINT_MAX; } if (type[0] == '%') { @@ -1869,10 +1879,6 @@ scan_o (const char *text, const char *type) yylval = cb_build_numeric_literal (0, (const void *)plex_buff, 0); RETURN_TOK (LITERAL); - - error: - yylval = cb_error_node; - RETURN_TOK (LITERAL); } static int @@ -1901,6 +1907,7 @@ scan_numeric (const char *text) char *s; int sign; int scale; + size_t curr_len; /* Get sign */ sign = get_sign (*p); @@ -1919,22 +1926,22 @@ scan_numeric (const char *text) /* Note that leading zeroes are not removed from the literal. */ - if (strlen (p) > COB_MAX_DIGITS) { + curr_len = strlen (p); + + if (curr_len > COB_MAX_DIGITS) { /* Absolute limit */ snprintf (err_msg, COB_MINI_MAX, - _("literal length %d exceeds maximum of %d digits"), - (int) strlen (p), COB_MAX_DIGITS); - error_literal ("num", text); - yylval = cb_error_node; - } else if (strlen (p) > cb_numlit_length) { + _("literal length %lu exceeds maximum of %u digits"), + (unsigned long) curr_len, COB_MAX_DIGITS); + error_literal ("num", text, 0); + p[COB_MAX_DIGITS] = 0; + } else if (curr_len > cb_numlit_length) { snprintf (err_msg, COB_MINI_MAX, - _("literal length %d exceeds %d digits"), - (int) strlen (p), cb_numlit_length); - error_literal ("num", text); - yylval = cb_error_node; - } else { - yylval = cb_build_numeric_literal (sign, p, scale); + _("literal length %lu exceeds %u digits"), + (unsigned long) curr_len, cb_numlit_length); + error_literal ("num", text, 0); } + yylval = cb_build_numeric_literal (sign, p, scale); RETURN_TOK (LITERAL); } @@ -1988,8 +1995,7 @@ scan_floating_numeric (const char *text) char *exponent_pos; char result[128] = { '\0' }; - - literal_error = 0; + unsigned int literal_error = 0; /* Separate into significand and exponent */ n = sscanf (text, COB_FLOAT_DIGITS_WIDTH "[0-9.,+-]%*1[Ee]%7[0-9.,+-]", @@ -2044,18 +2050,18 @@ scan_floating_numeric (const char *text) /* note: same message in tree.c for floating-point numeric-edited item */ snprintf (err_msg, COB_MINI_MAX, _("significand has more than %d digits"), COB_FLOAT_DIGITS_MAX); - error_literal ("float", text); + error_literal ("float", text, literal_error++); } else { if (strchr (exponent_pos, current_program->decimal_point)) { snprintf (err_msg, COB_MINI_MAX, _("exponent has decimal point")); - error_literal ("float", text); + error_literal ("float", text, literal_error++); } else { if (strlen (exponent_pos) > 4) { /* note: same message in tree.c for floating-point numeric-edited item */ snprintf (err_msg, COB_MINI_MAX, _("exponent has more than 4 digits")); - error_literal ("float", text); + error_literal ("float", text, literal_error++); } else { n = sscanf (exponent_pos, "%d", &exponent); /* We check the return for silencing warnings, but @@ -2085,7 +2091,7 @@ scan_floating_numeric (const char *text) if (!(-6143 <= exponent && exponent <= 6144)) { snprintf (err_msg, COB_MINI_MAX, _("exponent not between -6143 and 6144")); - error_literal ("float", text); + error_literal ("float", text, literal_error++); } } } @@ -2094,22 +2100,22 @@ scan_floating_numeric (const char *text) if (sig_sign == -1) { snprintf (err_msg, COB_MINI_MAX, _("significand of 0 must be positive")); - error_literal ("float", text); + error_literal ("float", text, literal_error++); } if (exponent != 0) { snprintf (err_msg, COB_MINI_MAX, _("exponent of 0 must be 0")); - error_literal ("float", text); + error_literal ("float", text, literal_error++); } if (exp_sign == -1) { snprintf (err_msg, COB_MINI_MAX, _("exponent of 0 must be positive")); - error_literal ("float", text); + error_literal ("float", text, literal_error++); } } if (literal_error) { - yylval = cb_error_node; + yylval = cb_build_numeric_literal (0, "0", 0); RETURN_TOK (LITERAL); } diff --git a/cobc/tree.c b/cobc/tree.c index ceae92f0f..c9664649e 100644 --- a/cobc/tree.c +++ b/cobc/tree.c @@ -7172,6 +7172,10 @@ cb_build_intrinsic (cb_tree func, cb_tree args, cb_tree refmod, double drslt, dval; char result[64]; + /* TODO: if all arguments are constants: build a cob_field, + then call into libcob to get the value and from there the string representation + inserting it here directly (-> numeric/alphanumeric/national constant, + which allows also for optimized use of it */ numargs = (int)cb_list_length (args); if (isuser) { @@ -7430,17 +7434,34 @@ cb_build_intrinsic (cb_tree func, cb_tree args, cb_tree refmod, fld = CB_FIELD_PTR (x); if (!cb_field_variable_size (fld) && !fld->flag_any_length) { - if (!(fld->pic - && (fld->pic->category == CB_CATEGORY_NATIONAL - || fld->pic->category == CB_CATEGORY_NATIONAL_EDITED))) - return cb_build_length (x); + int len = fld->size; + char buff[32]; + if (cbp->intr_enum != CB_INTR_BYTE_LENGTH) { + /* CHECKME: why don't we just check the category? + Maybe needs to enforce field validation (see cb_build_length) */ + if ( fld->pic + && (fld->pic->category == CB_CATEGORY_NATIONAL + || fld->pic->category == CB_CATEGORY_NATIONAL_EDITED)) { + len /= COB_NATIONAL_SIZE; + } + } + sprintf (buff, "%d", len); + return cb_build_numeric_literal (0, buff, 0); } } else if (CB_LITERAL_P (x)) { - /* FIXME: we currently generate national constants as alphanumeric constants */ - if (cbp->intr_enum != CB_INTR_BYTE_LENGTH - || (CB_TREE_CATEGORY (x) != CB_CATEGORY_NATIONAL_EDITED - && CB_TREE_CATEGORY (x) != CB_CATEGORY_NATIONAL)) - return cb_build_length (x); + unsigned int len = CB_LITERAL(x)->size; + char buff[32]; + if (cbp->intr_enum != CB_INTR_BYTE_LENGTH) { + enum cb_category cat = CB_TREE_CATEGORY (x); + /* CHECKME: why don't we just check the category? + Maybe needs to enforce field validation (see cb_build_length) */ + if (cat == CB_CATEGORY_NATIONAL + || cat == CB_CATEGORY_NATIONAL_EDITED) { + len /= COB_NATIONAL_SIZE; + } + } + sprintf (buff, "%u", len); + return cb_build_numeric_literal (0, buff, 0); } return make_intrinsic (func, cbp, args, NULL, NULL, 0); @@ -7551,6 +7572,7 @@ cb_build_intrinsic (cb_tree func, cb_tree args, cb_tree refmod, case CB_INTR_HIGHEST_ALGEBRAIC: case CB_INTR_LOWEST_ALGEBRAIC: + /* TODO: resolve for all (?) values */ x = CB_VALUE (args); if (!CB_REF_OR_FIELD_P (x)) { cb_error_x (func, _("FUNCTION '%s' has invalid argument"), cbp->name); @@ -7587,11 +7609,13 @@ cb_build_intrinsic (cb_tree func, cb_tree args, cb_tree refmod, case CB_INTR_DISPLAY_OF: case CB_INTR_NATIONAL_OF: + /* TODO: resolve for literals */ return make_intrinsic (func, cbp, args, cb_int1, refmod, 0); case CB_INTR_BIT_OF: case CB_INTR_HEX_OF: + /* TODO: resolve for literals */ x = CB_VALUE (args); if (!CB_REF_OR_FIELD_P (x) && !CB_LITERAL_P (x)) { @@ -7601,6 +7625,7 @@ cb_build_intrinsic (cb_tree func, cb_tree args, cb_tree refmod, return make_intrinsic (func, cbp, args, NULL, refmod, 0); case CB_INTR_BIT_TO_CHAR: case CB_INTR_HEX_TO_CHAR: + /* TODO: resolve for literals */ x = CB_VALUE (args); if (!CB_REF_OR_FIELD_P (x) &&!CB_LITERAL_P (x)) { diff --git a/cobc/typeck.c b/cobc/typeck.c index 9febd6520..67086252d 100644 --- a/cobc/typeck.c +++ b/cobc/typeck.c @@ -3770,80 +3770,61 @@ cb_validate_collating (cb_tree collating_sequence) return 0; } -void -cb_validate_program_environment (struct cb_program *prog) +static void +validate_alphabet (cb_tree alphabet) { - cb_tree x; - cb_tree y; - cb_tree l; - cb_tree ls; - struct cb_alphabet_name *ap; - struct cb_class_name *cp; - unsigned char *data; - size_t dupls; - size_t unvals; - size_t count; - int lower; - int upper; - int size; - int n; - int i; - int pos; - int lastval; - int tableval; - int values[256]; - int charvals[256]; - int dupvals[256]; + struct cb_alphabet_name *ap = CB_ALPHABET_NAME (alphabet); + unsigned int n; - /* Check ALPHABET clauses */ - /* Complicated by difference between code set and collating sequence */ - for (l = prog->alphabet_name_list; l; l = CB_CHAIN (l)) { - ap = CB_ALPHABET_NAME (CB_VALUE (l)); - - /* Native */ - if (ap->alphabet_type == CB_ALPHABET_NATIVE) { - for (n = 0; n < 256; n++) { - ap->values[n] = n; - ap->alphachr[n] = n; - } - continue; + /* Native */ + if (ap->alphabet_type == CB_ALPHABET_NATIVE) { + for (n = 0; n < 256; n++) { + ap->values[n] = n; + ap->alphachr[n] = n; } + return; + } - /* ASCII */ - if (ap->alphabet_type == CB_ALPHABET_ASCII) { - for (n = 0; n < 256; n++) { + /* ASCII */ + if (ap->alphabet_type == CB_ALPHABET_ASCII) { + for (n = 0; n < 256; n++) { #ifdef COB_EBCDIC_MACHINE - ap->values[n] = (int)cob_refer_ascii[n]; - ap->alphachr[n] = (int)cob_refer_ascii[n]; + ap->values[n] = (int)cob_refer_ascii[n]; + ap->alphachr[n] = (int)cob_refer_ascii[n]; #else - ap->values[n] = n; - ap->alphachr[n] = n; + ap->values[n] = n; + ap->alphachr[n] = n; #endif - } - continue; } + return; + } - /* EBCDIC */ - if (ap->alphabet_type == CB_ALPHABET_EBCDIC) { - for (n = 0; n < 256; n++) { + /* EBCDIC */ + if (ap->alphabet_type == CB_ALPHABET_EBCDIC) { + for (n = 0; n < 256; n++) { #ifdef COB_EBCDIC_MACHINE - ap->values[n] = n; - ap->alphachr[n] = n; + ap->values[n] = n; + ap->alphachr[n] = n; #else - ap->values[n] = (int)cob_refer_ebcdic[n]; - ap->alphachr[n] = (int)cob_refer_ebcdic[n]; + ap->values[n] = (int)cob_refer_ebcdic[n]; + ap->alphachr[n] = (int)cob_refer_ebcdic[n]; #endif - } - continue; } + return; + } + + /* Custom alphabet */ + { + cb_tree l, x; + size_t count = 0; + int unvals = 0, dupls = 0; + int lastval = 0, tableval = 0; + int pos = 0; + int i; + int values[256]; + int charvals[256]; + int dupvals[256]; - /* Custom alphabet */ - dupls = 0; - unvals = 0; - pos = 0; - count = 0; - lastval = 0; - tableval = 0; for (n = 0; n < 256; n++) { values[n] = -1; charvals[n] = -1; @@ -3853,21 +3834,24 @@ cb_validate_program_environment (struct cb_program *prog) } ap->low_val_char = 0; ap->high_val_char = 255; - for (y = ap->custom_list; y; y = CB_CHAIN (y)) { + for (l = ap->custom_list; l; l = CB_CHAIN (l)) { pos++; if (count > 255) { unvals = pos; break; } - x = CB_VALUE (y); + x = CB_VALUE (l); if (CB_PAIR_P (x)) { /* X THRU Y */ - lower = get_value (CB_PAIR_X (x)); - upper = get_value (CB_PAIR_Y (x)); + int lower = get_value (CB_PAIR_X (x)); + int upper = get_value (CB_PAIR_Y (x)); lastval = upper; if (!count) { ap->low_val_char = lower; } + /* regression in NATIONAL literals as + thpose are unfinished; would be fine + with national alphabet in general */ if (lower < 0 || lower > 255) { unvals = pos; continue; @@ -3902,6 +3886,7 @@ cb_validate_program_environment (struct cb_program *prog) } } } else if (CB_LIST_P (x)) { + cb_tree ls; /* X ALSO Y ... */ if (!count) { ap->low_val_char = get_value (CB_VALUE (x)); @@ -3911,6 +3896,9 @@ cb_validate_program_environment (struct cb_program *prog) if (!CB_CHAIN (ls)) { lastval = n; } + /* regression in NATIONAL literals as + those are unfinished; would be fine + with national alphabet in general */ if (n < 0 || n > 255) { unvals = pos; continue; @@ -3950,23 +3938,49 @@ cb_validate_program_environment (struct cb_program *prog) ap->values[n] = tableval++; count++; } else if (CB_LITERAL_P (x)) { - size = (int)CB_LITERAL (x)->size; - data = CB_LITERAL (x)->data; + int size = (int)CB_LITERAL (x)->size; + unsigned char* data = CB_LITERAL (x)->data; if (!count) { ap->low_val_char = data[0]; } lastval = data[size - 1]; - for (i = 0; i < size; i++) { - n = data[i]; - if (values[n] != -1) { - dupvals[n] = n; - dupls = 1; + if (CB_TREE_CATEGORY (x) != CB_CATEGORY_NATIONAL) { + for (i = 0; i < size; i++) { + n = data[i]; + if (values[n] != -1) { + dupvals[n] = n; + dupls = 1; + } + values[n] = n; + charvals[n] = n; + ap->alphachr[tableval] = n; + ap->values[n] = tableval++; + count++; + } + } else { + for (i = 0; i < size; i++) { + /* assuming we have UTF16BE here */ + if (data[i] == 0) { + /* only checking lower entries, all others, + which are currently only possible with + national-hex literals are not checked + TODO: add a list of values for those and + iterate over the list */ + n = data[++i]; + if (values[n] != -1) { + dupvals[n] = n; + dupls = 1; + } + values[n] = n; + charvals[n] = n; + ap->values[n] = tableval; + } else { + n = data[i++]; + n = n * 255 + data[i]; + } + ap->alphachr[tableval++] = n; + count++; } - values[n] = n; - charvals[n] = n; - ap->alphachr[tableval] = n; - ap->values[n] = tableval++; - count++; } } else { n = get_value (x); @@ -3990,31 +4004,29 @@ cb_validate_program_environment (struct cb_program *prog) } } if (dupls || unvals) { - cb_tree alphabet = CB_VALUE (l); if (dupls) { - /* FIXME: can't handle UTF8 / NATIONAL values */ - char dup_vals[256]; + char errmsg[256]; i = 0; for (n = 0; n < 256; n++) { if (dupvals[n] != -1) { if (i > 240) { - i += sprintf (dup_vals + i, ", ..."); + i += sprintf (&errmsg[i], ", ..."); break; } if (i) { - i += sprintf (dup_vals + i, ", "); + i += sprintf (&errmsg[i], ", "); } if (isprint (n)) { - dup_vals[i++] = (char)n; + errmsg[i++] = (char)n; } else { - i += sprintf (dup_vals + i, "x'%02x'", n); + i += sprintf (&errmsg[i], "x'%02x'", n); } }; } - dup_vals[i] = 0; + errmsg[i] = 0; cb_error_x (alphabet, _("duplicate character values in alphabet '%s': %s"), - ap->name, dup_vals); + ap->name, errmsg); } if (unvals) { cb_error_x (alphabet, @@ -4059,6 +4071,81 @@ cb_validate_program_environment (struct cb_program *prog) } } } +} + +static void +check_class_duplicates (cb_tree class_name) +{ + struct cb_class_name* cp = CB_CLASS_NAME (class_name); + size_t dupls = 0; + int values[256] = { 0 }; + cb_tree l; + +#if 0 /* should not be necessary with init above */ + memset (values, 0, sizeof (values)); +#endif + for (l = cp->list; l; l = CB_CHAIN (l)) { + cb_tree x = CB_VALUE (l); + if (CB_PAIR_P (x)) { + /* X THRU Y */ + int lower = get_value (CB_PAIR_X (x)); + int upper = get_value (CB_PAIR_Y (x)); + int i; + for (i = lower; i <= upper; i++) { + if (values[i]) { + dupls = 1; + } else { + values[i] = 1; + } + } + } else { + int n; + if (CB_NUMERIC_LITERAL_P (x)) { + n = get_value (x); + if (values[n]) { + dupls = 1; + } else { + values[n] = 1; + } + } else if (CB_LITERAL_P (x)) { + int size = (int)CB_LITERAL (x)->size; + unsigned char* data = CB_LITERAL (x)->data; + int i; + for (i = 0; i < size; i++) { + n = data[i]; + if (values[n]) { + dupls = 1; + } else { + values[n] = 1; + } + } + } else { + n = get_value (x); + if (values[n]) { + dupls = 1; + } else { + values[n] = 1; + } + } + } + } + if (dupls) { + cb_warning_x (cb_warn_additional, class_name, + _("duplicate character values in class '%s'"), + cb_name (class_name)); + } +} + +void +cb_validate_program_environment (struct cb_program *prog) +{ + cb_tree l; + + /* Check ALPHABET clauses */ + /* Complicated by difference between code set and collating sequence */ + for (l = prog->alphabet_name_list; l; l = CB_CHAIN (l)) { + validate_alphabet (CB_VALUE (l)); + } /* Reset HIGH/LOW-VALUES */ cb_low = cb_norm_low; @@ -4066,80 +4153,28 @@ cb_validate_program_environment (struct cb_program *prog) /* Check and generate SYMBOLIC clauses */ for (l = prog->symbolic_char_list; l; l = CB_CHAIN (l)) { + cb_tree x; if (CB_VALUE (l)) { - y = cb_ref (CB_VALUE (l)); - if (y == cb_error_node) { + x = cb_ref (CB_VALUE (l)); + if (x == cb_error_node) { continue; } - if (!CB_ALPHABET_NAME_P (y)) { - cb_error_x (y, _("invalid ALPHABET name")); + if (!CB_ALPHABET_NAME_P (x)) { + cb_error_x (x, _("invalid ALPHABET name")); continue; } } else { - y = NULL; + x = NULL; } - cb_build_symbolic_chars (CB_PURPOSE (l), y); + cb_build_symbolic_chars (CB_PURPOSE (l), x); } - /* Check CLASS clauses */ - for (l = prog->class_name_list; l; l = CB_CHAIN (l)) { - cp = CB_CLASS_NAME (CB_VALUE (l)); - /* LCOV_EXCL_START */ - if (cp == NULL) { /* keep the analyzer happy... */ - cobc_err_msg ("invalid CLASS detected"); /* not translated as highly unlikely */ - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - dupls = 0; - memset (values, 0, sizeof(values)); - for (y = cp->list; y; y = CB_CHAIN (y)) { - x = CB_VALUE (y); - if (CB_PAIR_P (x)) { - /* X THRU Y */ - lower = get_value (CB_PAIR_X (x)); - upper = get_value (CB_PAIR_Y (x)); - for (i = lower; i <= upper; i++) { - if (values[i]) { - dupls = 1; - } else { - values[i] = 1; - } - } - } else { - if (CB_NUMERIC_LITERAL_P (x)) { - n = get_value (x); - if (values[n]) { - dupls = 1; - } else { - values[n] = 1; - } - } else if (CB_LITERAL_P (x)) { - size = (int)CB_LITERAL (x)->size; - data = CB_LITERAL (x)->data; - for (i = 0; i < size; i++) { - n = data[i]; - if (values[n]) { - dupls = 1; - } else { - values[n] = 1; - } - } - } else { - n = get_value (x); - if (values[n]) { - dupls = 1; - } else { - values[n] = 1; - } - } - } - } - if (dupls) { - cb_warning_x (cb_warn_additional, CB_VALUE(l), - _("duplicate character values in class '%s'"), - cb_name (CB_VALUE(l))); - } + /* Check CLASS clauses for duplicates */ + if (cb_warn_additional) { + for (l = prog->class_name_list; l; l = CB_CHAIN (l)) { + check_class_duplicates (CB_VALUE (l)); } + } /* Resolve the program collating sequences */ if (cb_validate_collating (prog->collating_sequence)) { @@ -4151,7 +4186,7 @@ cb_validate_program_environment (struct cb_program *prog) /* Resolve the program classification */ if (prog->classification && prog->classification != cb_int1) { - x = cb_ref (prog->classification); + cb_tree x = cb_ref (prog->classification); if (!CB_LOCALE_NAME_P (x)) { cb_error_x (prog->classification, _("'%s' is not a locale name"), @@ -4727,7 +4762,7 @@ cb_validate_program_data (struct cb_program *prog) && !cb_odoslide) { xerr = x; cb_error_x (x, - _ ("'%s' cannot have nested OCCURS DEPENDING"), + _("'%s' cannot have nested OCCURS DEPENDING"), cb_name (x)); } odo_level++; @@ -4750,7 +4785,7 @@ cb_validate_program_data (struct cb_program *prog) && x != xerr) { xerr = x; cb_error_x (x, - _ ("'%s' cannot have OCCURS DEPENDING because of '%s'"), + _("'%s' cannot have OCCURS DEPENDING because of '%s'"), cb_name (x), p->sister->name); break; } diff --git a/libcob/intrinsic.c b/libcob/intrinsic.c index d5f8b44f5..644bfb45a 100644 --- a/libcob/intrinsic.c +++ b/libcob/intrinsic.c @@ -3580,6 +3580,7 @@ cob_intr_binop (cob_field *f1, const int op, cob_field *f2) /* Intrinsics */ +/* FUNCTION LENGTH - amount of positions */ cob_field * cob_intr_length (cob_field *srcfield) { @@ -3600,6 +3601,8 @@ cob_intr_length (cob_field *srcfield) return curr_field; } + +/* FUNCTION BYTE-LENGTH (or, as an extension: LENGTH-AN) - amount of bytes */ cob_field * cob_intr_byte_length (cob_field *srcfield) { diff --git a/tests/testsuite.src/run_functions.at b/tests/testsuite.src/run_functions.at index e92050833..9e600cece 100644 --- a/tests/testsuite.src/run_functions.at +++ b/tests/testsuite.src/run_functions.at @@ -1,4 +1,4 @@ -## Copyright (C) 2003-2012, 2014-2020 Free Software Foundation, Inc. +## Copyright (C) 2003-2012, 2014-2022 Free Software Foundation, Inc. ## Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart ## ## This file is part of GnuCOBOL. @@ -416,6 +416,8 @@ AT_DATA([prog.cob], [ 01 Y PIC X(4) VALUE "HI.". 01 BIN PIC 9(9) BINARY VALUE 12. 01 PAC PIC 9(5) COMP-3 VALUE 1234. + 01 N9 PIC 9(2) USAGE NATIONAL VALUE 12. + 01 NX PIC N(2) VALUE N"!". 01 HEXX PIC X(10). 88 HEXX-FILLER VALUE ALL "-". PROCEDURE DIVISION. @@ -459,6 +461,36 @@ AT_DATA([prog.cob], [ >> END-IF DISPLAY "UNEXPECTED HEX-VALUE OF z'01': " HEXX. + SET HEXX-FILLER TO TRUE + STRING FUNCTION HEX-OF (' ') DELIMITED BY SIZE INTO HEXX. + IF HEXX NOT = "20--------" + DISPLAY "UNEXPECTED HEX-VALUE OF ' ': " HEXX. + + SET HEXX-FILLER TO TRUE + STRING FUNCTION HEX-OF (n' ') DELIMITED BY SIZE INTO HEXX. + IF HEXX NOT = "0020------" + DISPLAY "UNEXPECTED HEX-VALUE OF n' ': " HEXX. + + *> FIXME: Failing with "3132------" -> missing padding + *> -> codegen issue for initialization / move + *> and libcob issue at least for MOVE + *> SET HEXX-FILLER TO TRUE + *> STRING FUNCTION HEX-OF (N9) DELIMITED BY SIZE INTO HEXX. + *> IF HEXX NOT = "00310032--" + *> DISPLAY "UNEXPECTED HEX-VALUE OF N9: " HEXX. + + *> FIXME: Failing with "00212020--" -> bad padding + *> -> codegen issue for initialization / move + *> and libcob issue at least for MOVE + *> SET HEXX-FILLER TO TRUE + *> STRING FUNCTION HEX-OF (NX) DELIMITED BY SIZE INTO HEXX. + *> IF HEXX NOT = "00210020--" + *> DISPLAY "UNEXPECTED HEX-VALUE OF NX: " HEXX. + + *> setting up test data: + SET HEXX-FILLER TO TRUE + STRING FUNCTION HEX-OF (z"01") DELIMITED BY SIZE INTO HEXX. + IF FUNCTION HEX-TO-CHAR (HEXX(1:6)) NOT = z"01" DISPLAY "UNEXPECTED CHAR VALUE, does not match z'01': " HEXX (1:6). @@ -477,7 +509,7 @@ AT_DATA([prog.cob], [ STOP RUN. ]) -AT_CHECK([$COMPILE prog.cob], [0], [], []) +AT_CHECK([$COMPILE -Wno-unfinished prog.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) AT_CLEANUP @@ -1748,6 +1780,9 @@ AT_DATA([prog.cob], [ 01 X PIC S9(4)V9(4) VALUE -1.5. 01 N PIC N(9). 01 TEST-FLD PIC S9(04)V9(02). + 01 TEST-TAB. + 05 T-ENTRIES PIC 99 VALUE 10. + 05 TEST-ENTRY PIC X OCCURS 1 TO 10 DEPENDING ON T-ENTRIES. PROCEDURE DIVISION. MOVE FUNCTION LENGTH ( X ) TO TEST-FLD @@ -1793,13 +1828,24 @@ AT_DATA([prog.cob], [ DISPLAY 'LENGTH n"a0" wrong: ' TEST-FLD END-DISPLAY END-IF + MOVE 10 TO T-ENTRIES + MOVE FUNCTION LENGTH ( TEST-TAB) + TO TEST-FLD + IF TEST-FLD NOT = 12 + DISPLAY 'LENGTH TEST-TAB (10 entries): ' TEST-FLD + END-DISPLAY + END-IF + MOVE 1 TO T-ENTRIES + MOVE FUNCTION LENGTH ( TEST-TAB) + TO TEST-FLD + IF TEST-FLD NOT = 3 + DISPLAY 'LENGTH TEST-TAB (1 entry): ' TEST-FLD + END-DISPLAY + END-IF STOP RUN. ]) -AT_CHECK([$COMPILE prog.cob], [0], [], -[prog.cob:7: warning: handling of USAGE NATIONAL is unfinished; implementation is likely to be changed -prog.cob:48: warning: handling of national literal is unfinished; implementation is likely to be changed -]) +AT_CHECK([$COMPILE -Wno-unfinished prog.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) AT_CLEANUP diff --git a/tests/testsuite.src/syn_misc.at b/tests/testsuite.src/syn_misc.at index 6b1c26b1d..d069a28f0 100644 --- a/tests/testsuite.src/syn_misc.at +++ b/tests/testsuite.src/syn_misc.at @@ -6938,13 +6938,13 @@ AT_DATA([prog.cob], [ 01 n PIC 9. PROCEDURE DIVISION. - MOVE X'' TO x - MOVE H'' TO x - MOVE Z'' TO x - MOVE L'' TO x - MOVE N"" TO nat + MOVE X'' TO x + MOVE H'' TO n + MOVE Z'' TO x + MOVE L'' TO x + MOVE N"" TO nat MOVE NX'' TO nat - MOVE B"" TO n + MOVE B"" TO n MOVE BX"" TO n . ])