diff --git a/NEWS b/NEWS index 1a12b93a..4ff27fce 100644 --- a/NEWS +++ b/NEWS @@ -116,11 +116,17 @@ Open Plans: to stop compiliation at first error use -Wfatal-errors ** default value for -fmax-errors was changed from 128 to 20 +* More notable changes + +** execution times were significantly reduced for the following: + INSPECT CONVERTING (and "simple" INSPECT REPLACING), in general + and especially if both from and to are constants + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - GnuCOBOL 3.2 (20230728) - GnuCOBOL 3.2rc1 (20230118) - GnuCOBOL 3.2rc2 (20230210) + GnuCOBOL 3.2 (20230728) + GnuCOBOL 3.2rc1 (20230118) + GnuCOBOL 3.2rc2 (20230210) * New GnuCOBOL features diff --git a/cobc/ChangeLog b/cobc/ChangeLog index e726a34c..a4736552 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -36,6 +36,27 @@ * typeck.c (cb_emit, cb_emit_list): changed from defines to inline functions, now returning the tree that was emitted +2023-09-12 Simon Sobisch + + * codegen.c (literal_list): removed self-reference as tree + * replace.c (ppecho_replace): now inline + * replace.c (cb_free_replace): removed setting child to zero before free + * replace.c: style adjustment + +2023-09-07 Simon Sobisch + + * typeck.c (cb_build_converting): protoype (disabled) to pre-generate + conversion table and call new function cob_inspect_translating instead + of cob_inspect_converting if both operands are literals/alphabets + +2023-09-06 Simon Sobisch + + * typeck.c (validate_inspect): check for identical operands, + check for invalid combination of operands + * typeck.c (cb_build_converting): shortcut when identical operands + are used + * tree.h: change alphabet_target and alphabet_type from defines to enums + 2023-09-01 Simon Sobisch * pplex.l (ppopen_get_file): test for binary file and directly error out diff --git a/cobc/codegen.c b/cobc/codegen.c index 2bb8caef..227f0efa 100644 --- a/cobc/codegen.c +++ b/cobc/codegen.c @@ -104,7 +104,6 @@ struct attr_list { struct literal_list { struct literal_list *next; struct cb_literal *literal; - cb_tree x; int id; int make_decimal; }; @@ -720,7 +719,12 @@ output_string (const unsigned char *s, const int size, const cob_u32_t llit) } else #endif if (!isprint (c)) { +#if 1 /* octal */ output ("\\%03o", c); +#else /* hex (can be useful for a small amount of non-printable characters, + but gets really uggly if the string has a lot of those */ + output ("\" \"\\x%X\" \"", c); +#endif } else if (c == '\"') { output ("\\%c", c); } else if ((c == '\\' || c == '?') && !llit) { @@ -825,7 +829,7 @@ chk_field_variable_address (struct cb_field *fld) if (!cb_odoslide) return 0; if (!fld->flag_vaddr_done) { - /* Note: this is called _very_ often and takes 15-20% of parse + codegen time, + /* Note: this was called _very_ often and took 15-20% of parse + codegen time, with about half the time in chk_field_variable_size; so try to not call this function if not necessary (according to the testsuite: as long as cb_odoslide is not set, but the caller's coverage is not that well...) */ @@ -833,10 +837,9 @@ chk_field_variable_address (struct cb_field *fld) struct cb_field *p; for (p = f->parent; p; f = f->parent, p = f->parent) { for (p = p->children; p != f; p = p->sister) { - /* Skip PIC L fields as their representation - have constant length */ - if (p->depending || - (!p->flag_picture_l && chk_field_variable_size (p))) { + if (p->depending /* ODO leads to variable size */ + || (!p->flag_picture_l && chk_field_variable_size (p)) /* skipping PIC L fields */ + ) { fld->flag_vaddr_done = 1; fld->vaddr = 1; return 1; @@ -3177,7 +3180,7 @@ output_literals_figuratives_and_constants (void) for (lit = literal_cache; lit; lit = lit->next) { output ("static const cob_field %s%d\t= ", CB_PREFIX_CONST, lit->id); - output_field (lit->x); + output_field (CB_TREE(lit->literal)); output (";"); output_newline (); } @@ -3379,7 +3382,6 @@ cb_lookup_literal (cb_tree x, int make_decimal) l->id = cb_literal_id; l->literal = literal; l->make_decimal = make_decimal; - l->x = x; l->next = literal_cache; literal_cache = l; @@ -13568,7 +13570,7 @@ output_internal_function (struct cb_program *prog, cb_tree parameter_list) /* Check matching version */ #if !defined (HAVE_ATTRIBUTE_CONSTRUCTOR) #ifdef _WIN32 - if (prog->flag_main) /* otherwise we generate that in DllMain*/ + if (prog->flag_main) /* otherwise we generate that in DllMain */ #else if (!prog->nested_level) #endif @@ -13667,8 +13669,7 @@ output_internal_function (struct cb_program *prog, cb_tree parameter_list) seen = 0; for (m = literal_cache; m; m = m->next) { - if (CB_TREE_CLASS (m->x) == CB_CLASS_NUMERIC - && m->make_decimal) { + if (m->make_decimal) { if (!seen) { seen = 1; output_line ("/* Set Decimal Constant values */"); @@ -13887,8 +13888,7 @@ output_internal_function (struct cb_program *prog, cb_tree parameter_list) output_line ("P_clear_decimal:"); seen = 0; for (m = literal_cache; m; m = m->next) { - if (CB_TREE_CLASS (m->x) == CB_CLASS_NUMERIC - && m->make_decimal) { + if (m->make_decimal) { if (!seen) { seen = 1; output_line ("/* Clear Decimal Constant values */"); @@ -14972,8 +14972,7 @@ codegen_finalize (void) struct literal_list* m; int comment_gen = 0; for (m = literal_cache; m; m = m->next) { - if (CB_TREE_CLASS (m->x) == CB_CLASS_NUMERIC - && m->make_decimal) { + if (m->make_decimal) { if (!comment_gen) { comment_gen = 1; output_storage ("\n/* Decimal constants */\n"); diff --git a/cobc/replace.c b/cobc/replace.c index 49e28619..cabaa372 100644 --- a/cobc/replace.c +++ b/cobc/replace.c @@ -200,7 +200,7 @@ static struct cb_replacement_state * replace_repls; static struct cb_replacement_state * copy_repls; /* forward definitions */ -static void ppecho_replace (WITH_DEPTH const char *text, const char* token); +static COB_INLINE COB_A_INLINE void ppecho_replace (WITH_DEPTH const char *text, const char* token); static void do_replace (WITH_DEPTH struct cb_replacement_state* repls); static void check_replace_after_match (WITH_DEPTH struct cb_replacement_state *repls); static void check_replace_all (WITH_DEPTH struct cb_replacement_state *repls, @@ -220,8 +220,7 @@ token_list_add (WITH_DEPTH struct cb_token_list *list, adding on the same head, other `last` fields in the middle of the list not being correctly updated... */ -static -struct cb_token_list * +static struct cb_token_list * token_list_add (WITH_DEPTH struct cb_token_list *list, const char *text, const char *token) { @@ -250,8 +249,8 @@ token_list_add (WITH_DEPTH struct cb_token_list *list, } } -static -void pop_token (WITH_DEPTH struct cb_replacement_state *repls, +static void +pop_token (WITH_DEPTH struct cb_replacement_state *repls, const char **text, const char **token) { const struct cb_token_list *q = repls->token_queue; @@ -264,8 +263,8 @@ void pop_token (WITH_DEPTH struct cb_replacement_state *repls, if (token) *token = q->token; } -static -void ppecho_switch (WITH_DEPTH struct cb_replacement_state *repls, +static void +ppecho_switch (WITH_DEPTH struct cb_replacement_state *repls, const char* text, const char* token) { #ifdef DEBUG_REPLACE_TRACE @@ -283,8 +282,8 @@ void ppecho_switch (WITH_DEPTH struct cb_replacement_state *repls, } } -static -void ppecho_switch_text_list (WITH_DEPTH struct cb_replacement_state *repls, +static void +ppecho_switch_text_list (WITH_DEPTH struct cb_replacement_state *repls, const struct cb_text_list *p) { #ifdef DEBUG_REPLACE_TRACE @@ -298,8 +297,8 @@ void ppecho_switch_text_list (WITH_DEPTH struct cb_replacement_state *repls, } -static -void ppecho_switch_token_list (WITH_DEPTH struct cb_replacement_state *repls, +static void +ppecho_switch_token_list (WITH_DEPTH struct cb_replacement_state *repls, const struct cb_token_list *p) { #ifdef DEBUG_REPLACE_TRACE @@ -312,8 +311,8 @@ void ppecho_switch_token_list (WITH_DEPTH struct cb_replacement_state *repls, } } -static -int is_leading_or_trailing (WITH_DEPTH int leading, +static int +is_leading_or_trailing (WITH_DEPTH int leading, const char* src_text, const char* text, int strict) @@ -342,8 +341,8 @@ int is_leading_or_trailing (WITH_DEPTH int leading, /* after a LEADING or TRAILING match, perform the replacement within the text, and pass the resulting new text to the next stream */ -static -void ppecho_leading_or_trailing (WITH_DEPTH struct cb_replacement_state *repls, +static void +ppecho_leading_or_trailing (WITH_DEPTH struct cb_replacement_state *repls, int leading, const char *src_text, const char *text, @@ -384,8 +383,8 @@ void ppecho_leading_or_trailing (WITH_DEPTH struct cb_replacement_state *repls, * * `replace_list`: the current list of possible replacements on check */ -static -void check_replace (WITH_DEPTH struct cb_replacement_state* repls, +static void +check_replace (WITH_DEPTH struct cb_replacement_state* repls, const struct cb_replace_list *replace_list) { #ifdef DEBUG_REPLACE_TRACE @@ -471,8 +470,8 @@ is_space_or_nl (const char c) * * `src` is the list of texts from the replacement to be matched * * `replace_list` is the next replacements to try in case of failure */ -static -void check_replace_all (WITH_DEPTH +static void +check_replace_all (WITH_DEPTH struct cb_replacement_state *repls, const struct cb_text_list *new_text, struct cb_token_list *texts, @@ -553,8 +552,8 @@ void check_replace_all (WITH_DEPTH } } -static -void check_replace_after_match (WITH_DEPTH struct cb_replacement_state *repls) +static void +check_replace_after_match (WITH_DEPTH struct cb_replacement_state *repls) { #ifdef DEBUG_REPLACE_TRACE fprintf (stderr, "%scheck_replace_after_match(%s)\n", @@ -574,8 +573,8 @@ void check_replace_after_match (WITH_DEPTH struct cb_replacement_state *repls) } } -static -void do_replace (WITH_DEPTH struct cb_replacement_state* repls) +static void +do_replace (WITH_DEPTH struct cb_replacement_state* repls) { #ifdef DEBUG_REPLACE_TRACE fprintf (stderr, "%sdo_replace(%s)\n",DEPTH, repls->name); @@ -599,34 +598,39 @@ void do_replace (WITH_DEPTH struct cb_replacement_state* repls) } /* Whether a word matches the definition of WORD in pplex.l */ -static -int is_word (WITH_DEPTH const char* s) { - int i; - size_t len = strlen (s); +static int +is_word (WITH_DEPTH const char *s) { + for (;;) { + unsigned char c = (unsigned char) *s++; - for (i = 0; i= '0' && c <= '9' ) || ( c >= 'A' && c <= 'Z' ) || ( c >= 'a' && c <= 'z' ) - || ( c >= 128 && c <= 255 ) ) { - /* word character, just go on */ - } else { + || ( c >= 128) ) { + continue; + } + + /* end of string, no previous bad character -> is a word */ + if (c == 0) { #ifdef DEBUG_REPLACE_TRACE - fprintf (stderr, "%sis_word('%s') -> 0\n", DEPTH, s); + fprintf (stderr, "%sis_word('%s') -> 1\n", DEPTH, s); #endif - return 0; + return 1; } - } + + /* string 's' contains non-word characters -> isn't a word */ #ifdef DEBUG_REPLACE_TRACE - fprintf (stderr, "%sis_word('%s') -> 1\n", DEPTH, s); + fprintf (stderr, "%sis_word('%s') -> 0\n", DEPTH, s); #endif - return 1; + return 0; + } } -static void add_text_to_replace (WITH_DEPTH struct cb_replacement_state *repls, +static void +add_text_to_replace (WITH_DEPTH struct cb_replacement_state *repls, int prequeue, const char* text, const char* token ) { @@ -690,7 +694,8 @@ static void add_text_to_replace (WITH_DEPTH struct cb_replacement_state *repls, stream). Use prequeue = 1 so that texts of the same kind are merged into a single text. */ -static void ppecho_replace (WITH_DEPTH const char *text, const char *token) +static void +ppecho_replace (WITH_DEPTH const char *text, const char *token) { #ifdef DEBUG_REPLACE fprintf (stderr, "%sppecho_replace('%s')\n", DEPTH, text); @@ -702,7 +707,8 @@ static void ppecho_replace (WITH_DEPTH const char *text, const char *token) pplex.l). Use prequeue = 0 as texts of the same kind from the source file should not be merged. */ -void cb_ppecho_copy_replace (const char *text, const char *token) +void +cb_ppecho_copy_replace (const char *text, const char *token) { #ifdef DEBUG_REPLACE fprintf (stderr, "cb_ppecho_copy_replace('%s')\n", text); @@ -711,12 +717,11 @@ void cb_ppecho_copy_replace (const char *text, const char *token) } -static -struct cb_replacement_state * create_replacements (enum cb_ppecho ppecho) +static struct cb_replacement_state * +create_replacements (enum cb_ppecho ppecho) { - struct cb_replacement_state * s; - - s = cobc_malloc (sizeof(struct cb_replacement_state)); + struct cb_replacement_state *s + = cobc_malloc (sizeof(struct cb_replacement_state)); s->text_prequeue = NULL; s->token_queue = NULL; @@ -735,48 +740,46 @@ struct cb_replacement_state * create_replacements (enum cb_ppecho ppecho) return s; } -static void reset_replacements (struct cb_replacement_state * s) +#if 0 /* no use in just setting the child elements to zero */ +static void +reset_replacements (struct cb_replacement_state * s) { s->text_prequeue = NULL; s->token_queue = NULL; - s->replace_list = NULL ; - s->current_list = NULL ; + s->replace_list = NULL; + s->current_list = NULL ; } - -static -void init_replace( void ) -{ -#ifdef DEBUG_REPLACE_TRACE - for(int i=0; ireplace_list ; } @@ -784,10 +787,11 @@ struct cb_replace_list *cb_get_copy_replacing_list (void) /* Called by pplex.l, either at the end of a file to restore the previous stack of active copy-replacing, or when a new file is open to set additional copy replacing */ -void cb_set_copy_replacing_list (struct cb_replace_list *list) +void +cb_set_copy_replacing_list (struct cb_replace_list *list) { copy_repls->current_list = NULL; - copy_repls->replace_list = list ; + copy_repls->replace_list = list; #ifdef DEBUG_REPLACE fprintf (stderr, "set_copy_replacing_list(\n"); for(;list != NULL; list=list->next){ diff --git a/cobc/tree.h b/cobc/tree.h index ff59b64b..4fd76801 100644 --- a/cobc/tree.h +++ b/cobc/tree.h @@ -140,18 +140,22 @@ enum cb_tag { }; /* Alphabet target */ -#define CB_ALPHABET_ALPHANUMERIC 0 -#define CB_ALPHABET_NATIONAL 1 +enum cb_alphabet_target { + CB_ALPHABET_ALPHANUMERIC = 0, + CB_ALPHABET_NATIONAL = 1 +}; /* Alphabet type */ -#define CB_ALPHABET_NATIVE 0 -#define CB_ALPHABET_ASCII 1 -#define CB_ALPHABET_EBCDIC 2 -#define CB_ALPHABET_CUSTOM 3 -#define CB_ALPHABET_LOCALE 4 -#define CB_ALPHABET_UTF_8 5 -#define CB_ALPHABET_UTF_16 6 -#define CB_ALPHABET_UCS_4 7 +enum cb_alphabet_type { + CB_ALPHABET_NATIVE = 0, + CB_ALPHABET_ASCII = 1, + CB_ALPHABET_EBCDIC = 2, + CB_ALPHABET_CUSTOM = 3, + CB_ALPHABET_LOCALE = 4, + CB_ALPHABET_UTF_8 = 5, + CB_ALPHABET_UTF_16 = 6, + CB_ALPHABET_UCS_4 = 7 +}; /* Call convention bits */ /* Bit number Meaning Value */ @@ -324,46 +328,46 @@ enum cb_storage { /* Field types */ enum cb_usage { - CB_USAGE_BINARY = 0, /* 0 */ - CB_USAGE_BIT, /* 1 */ - CB_USAGE_COMP_5, /* 2 */ - CB_USAGE_COMP_X, /* 3 */ - CB_USAGE_DISPLAY, /* 4 */ - CB_USAGE_FLOAT, /* 5 */ - CB_USAGE_DOUBLE, /* 6 */ - CB_USAGE_INDEX, /* 7 */ - CB_USAGE_NATIONAL, /* 8 */ - CB_USAGE_OBJECT, /* 9 */ - CB_USAGE_PACKED, /* 10 */ - CB_USAGE_POINTER, /* 11 */ - CB_USAGE_LENGTH, /* 12 */ - CB_USAGE_PROGRAM_POINTER, /* 13 */ - CB_USAGE_UNSIGNED_CHAR, /* 14 */ - CB_USAGE_SIGNED_CHAR, /* 15 */ - CB_USAGE_UNSIGNED_SHORT, /* 16 */ - CB_USAGE_SIGNED_SHORT, /* 17 */ - CB_USAGE_UNSIGNED_INT, /* 18 */ - CB_USAGE_SIGNED_INT, /* 19 */ - CB_USAGE_UNSIGNED_LONG, /* 20 */ - CB_USAGE_SIGNED_LONG, /* 21 */ - CB_USAGE_COMP_6, /* 22 */ - CB_USAGE_FP_DEC64, /* 23 */ - CB_USAGE_FP_DEC128, /* 24 */ - CB_USAGE_FP_BIN32, /* 25 */ - CB_USAGE_FP_BIN64, /* 26 */ - CB_USAGE_FP_BIN128, /* 27 */ - CB_USAGE_LONG_DOUBLE, /* 28 */ - CB_USAGE_HNDL, /* 29 */ - CB_USAGE_HNDL_WINDOW, /* 30 */ - CB_USAGE_HNDL_SUBWINDOW, /* 31 */ - CB_USAGE_HNDL_FONT, /* 32 */ - CB_USAGE_HNDL_THREAD, /* 33 */ - CB_USAGE_HNDL_MENU, /* 34 */ - CB_USAGE_HNDL_VARIANT, /* 35 */ - CB_USAGE_HNDL_LM, /* 36 */ - CB_USAGE_COMP_N, /* 37 */ - CB_USAGE_CONTROL, /* 38 */ - CB_USAGE_ERROR /* 39, always last */ + CB_USAGE_BINARY = 0, + CB_USAGE_BIT, + CB_USAGE_COMP_5, + CB_USAGE_COMP_X, + CB_USAGE_DISPLAY, + CB_USAGE_FLOAT, + CB_USAGE_DOUBLE, + CB_USAGE_INDEX, + CB_USAGE_NATIONAL, + CB_USAGE_OBJECT, + CB_USAGE_PACKED, + CB_USAGE_POINTER, + CB_USAGE_LENGTH, + CB_USAGE_PROGRAM_POINTER, + CB_USAGE_UNSIGNED_CHAR, + CB_USAGE_SIGNED_CHAR, + CB_USAGE_UNSIGNED_SHORT, + CB_USAGE_SIGNED_SHORT, + CB_USAGE_UNSIGNED_INT, + CB_USAGE_SIGNED_INT, + CB_USAGE_UNSIGNED_LONG, + CB_USAGE_SIGNED_LONG, + CB_USAGE_COMP_6, + CB_USAGE_FP_DEC64, + CB_USAGE_FP_DEC128, + CB_USAGE_FP_BIN32, + CB_USAGE_FP_BIN64, + CB_USAGE_FP_BIN128, + CB_USAGE_LONG_DOUBLE, + CB_USAGE_HNDL, + CB_USAGE_HNDL_WINDOW, + CB_USAGE_HNDL_SUBWINDOW, + CB_USAGE_HNDL_FONT, + CB_USAGE_HNDL_THREAD, + CB_USAGE_HNDL_MENU, + CB_USAGE_HNDL_VARIANT, + CB_USAGE_HNDL_LM, + CB_USAGE_COMP_N, + CB_USAGE_CONTROL, + CB_USAGE_ERROR /* always last */ }; @@ -707,8 +711,8 @@ struct cb_alphabet_name { const char *name; /* Original name */ char *cname; /* Name used in C */ cb_tree custom_list; /* Custom ALPHABET / LOCALE reference */ - unsigned int alphabet_target; /* ALPHANUMERIC or NATIONAL */ - unsigned int alphabet_type; /* ALPHABET type */ + enum cb_alphabet_target alphabet_target; /* ALPHANUMERIC or NATIONAL */ + enum cb_alphabet_type alphabet_type; /* ALPHABET type */ int low_val_char; /* LOW-VALUE */ int high_val_char; /* HIGH-VALUE */ int values[256]; /* Collating values */ diff --git a/cobc/typeck.c b/cobc/typeck.c index 8b733780..39e9e771 100644 --- a/cobc/typeck.c +++ b/cobc/typeck.c @@ -8692,7 +8692,8 @@ cb_emit_accept (cb_tree var, cb_tree pos, struct cb_attr_struct *attr_ptr) } if (CB_REF_OR_FIELD_P (var) && CB_FIELD_PTR (var)->storage == CB_STORAGE_SCREEN) { - output_screen_from (CB_FIELD_PTR (var), 0); + struct cb_field *var_field = CB_FIELD_PTR (var); + output_screen_from (var_field, 0); gen_screen_ptr = 1; if (pos) { if (CB_LIST_P (pos)) { @@ -8712,7 +8713,7 @@ cb_emit_accept (cb_tree var, cb_tree pos, struct cb_attr_struct *attr_ptr) cb_int (line_col_zero_is_supported ()))); } gen_screen_ptr = 0; - output_screen_to (CB_FIELD (cb_ref (var)), 0); + output_screen_to (var_field, 0); return; } } @@ -10717,14 +10718,11 @@ cb_emit_initialize (cb_tree vars, cb_tree fillinit, cb_tree value, } static size_t -calc_reference_size (cb_tree xr) +calc_reference_size (cb_tree xr, cb_tree ref) { - cb_tree ref = cb_ref (xr); - if (ref == cb_error_node) { - return 0; - } - if (CB_REF_OR_FIELD_P (ref)) { - struct cb_reference *r = CB_REFERENCE (xr); + if (CB_FIELD_P (ref)) { + const struct cb_reference *r = CB_REFERENCE (xr); + const struct cb_field *f = CB_FIELD (ref); if (r->offset) { if (r->length) { if (CB_LITERAL_P (r->length)) { @@ -10732,12 +10730,11 @@ calc_reference_size (cb_tree xr) } } else { if (CB_LITERAL_P (r->offset)) { - return (size_t)CB_FIELD_PTR (xr)->size - - cb_get_int (r->offset) + 1; + return f->size - cb_get_int (r->offset) + 1; } } } else { - return CB_FIELD_PTR (xr)->size; + return f->size; } } else if (CB_ALPHABET_NAME_P (ref)) { return 256; @@ -10748,15 +10745,25 @@ calc_reference_size (cb_tree xr) /* INSPECT statement */ -static void +/* validating FROM and TO references and their size to be matching + returns non-zero on error */ +static int validate_inspect (cb_tree x, cb_tree y, const unsigned int replacing_or_converting) { - size_t size1; - size_t size2; + cb_tree refx = NULL, refy = NULL; + int size1, size2; - switch (CB_TREE_TAG(x)) { + const enum cb_tag tag_x = CB_TREE_TAG (x); + const enum cb_tag tag_y = CB_TREE_TAG (y); + + /* get FROM size */ + switch (tag_x) { case CB_TAG_REFERENCE: - size1 = calc_reference_size (x); + refx = cb_ref (x); + if (refx == cb_error_node) { + return -1; + } + size1 = calc_reference_size (x, refx); break; case CB_TAG_LITERAL: size1 = CB_LITERAL(x)->size; @@ -10768,29 +10775,69 @@ validate_inspect (cb_tree x, cb_tree y, const unsigned int replacing_or_converti size1 = 0; break; } - if (size1) { - switch (CB_TREE_TAG(y)) { - case CB_TAG_REFERENCE: - size2 = calc_reference_size (y); - break; - case CB_TAG_LITERAL: - size2 = CB_LITERAL(y)->size; - break; - /* note: in case of CONST the original size is used */ - default: - size2 = 0; - break; + + /* get TO size for comparison with FROM size */ + switch (tag_y) { + case CB_TAG_REFERENCE: + refy = cb_ref (y); + if (refy == cb_error_node) { + return -1; } - if (size2 && size1 != size2) { + size2 = calc_reference_size (y, refy); + /* check for identical reference */ + if (refx == refy) { if (replacing_or_converting == 1) { - cb_error_x (CB_TREE (current_statement), - _("%s operands differ in size"), "REPLACING"); + cb_warning_x (COBC_WARN_FILLER, CB_TREE (current_statement), + _("%s operands are the same"), "REPLACING"); + return 0; } else { - cb_error_x (CB_TREE (current_statement), - _("%s operands differ in size"), "CONVERTING"); + cb_warning_x (COBC_WARN_FILLER, CB_TREE (current_statement), + _("%s operands are the same"), "CONVERTING"); + return 2; /* converting without change, decrease to no-op */ } } + break; + case CB_TAG_LITERAL: + size2 = CB_LITERAL (y)->size; + break; + case CB_TAG_CONST: + /* note: in case of CONST (like SPACES or LOW-VALUES) + the original size is used in libcob */ + /* Fall-through */ + default: + size2 = 0; + break; + } + + if (tag_y != CB_TAG_CONST + && size1 != size2) { + if (replacing_or_converting == 1) { + cb_error_x (CB_TREE (current_statement), + _("%s operands incompatible"), "REPLACING"); + } else { + cb_error_x (CB_TREE (current_statement), + _("%s operands incompatible"), "CONVERTING"); + } + cb_note_x (COB_WARNOPT_NONE, CB_TREE (current_statement), + _("operands differ in size")); + return 1; + } + + if (tag_x == CB_TAG_LITERAL + && tag_y == CB_TAG_LITERAL + && memcmp (CB_LITERAL (x)->data, CB_LITERAL (y)->data, size1) == 0) { + if (replacing_or_converting == 1) { + cb_warning_x (COBC_WARN_FILLER, CB_TREE (current_statement), + _ ("%s operands are the same"), "REPLACING"); + return 0; + } else { + cb_warning_x (COBC_WARN_FILLER, CB_TREE (current_statement), + _ ("%s operands are the same"), "CONVERTING"); + return 2; /* converting without change, decrease to no-op */ + } } + + return 0; } static void @@ -10953,35 +11000,164 @@ cb_build_replacing_characters (cb_tree x, cb_tree l) cb_tree cb_build_replacing_all (cb_tree x, cb_tree y, cb_tree l) { - validate_inspect (x, y, 1); + (void) validate_inspect (x, y, 1); return cb_list_add (l, CB_BUILD_FUNCALL_2 ("cob_inspect_all", y, x)); } cb_tree cb_build_replacing_leading (cb_tree x, cb_tree y, cb_tree l) { - validate_inspect (x, y, 1); + (void) validate_inspect (x, y, 1); return cb_list_add (l, CB_BUILD_FUNCALL_2 ("cob_inspect_leading", y, x)); } cb_tree cb_build_replacing_first (cb_tree x, cb_tree y, cb_tree l) { - validate_inspect (x, y, 1); + (void) validate_inspect (x, y, 1); return cb_list_add (l, CB_BUILD_FUNCALL_2 ("cob_inspect_first", y, x)); } cb_tree cb_build_replacing_trailing (cb_tree x, cb_tree y, cb_tree l) { - validate_inspect (x, y, 1); + (void) validate_inspect (x, y, 1); return cb_list_add (l, CB_BUILD_FUNCALL_2 ("cob_inspect_trailing", y, x)); } +/* pre-filled conversion table */ +static const unsigned char char_tab_0x00_to_0xff[256] = { + 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, + 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, + 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, + 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, + 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, + 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, + 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, 124, 125, 126, 127, + 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, + 144, 145, 146, 147, 148, 149, 150, 151, 152, 153, 154, 155, 156, 157, 158, 159, + 160, 161, 162, 163, 164, 165, 166, 167, 168, 169, 170, 171, 172, 173, 174, 175, + 176, 177, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, + 192, 193, 194, 195, 196, 197, 198, 199, 200, 201, 202, 203, 204, 205, 206, 207, + 208, 209, 210, 211, 212, 213, 214, 215, 216, 217, 218, 219, 220, 221, 222, 223, + 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, + 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, 251, 252, 253, 254, 255 +}; + cb_tree cb_build_converting (cb_tree x, cb_tree y, cb_tree l) { - validate_inspect (x, y, 2); + const enum cb_tag tag_x = CB_TREE_TAG (x); + const enum cb_tag tag_y = CB_TREE_TAG (y); + + const int ret = validate_inspect (x, y, 2); + if (ret) { + /* assume 2 - if there was another one (=error) we don't use the tree below */ + /* identical FROM/TO - we still need the func call if the variable + is signed-numeric and not sign separate, but don't need to convert anything */ + /* FIXME: add test case ! */ + return cb_list_add (l, CB_BUILD_FUNCALL_0 ("cob_inspect_finish")); + } + +#if 0 /* Simon: unfinished prototype, get back to it later */ + if (tag_x == tag_y) { + switch (tag_x) { + case CB_TAG_LITERAL: + { + unsigned char conv_tab[256]; + const struct cb_literal *lit_x = CB_LITERAL (x); + const unsigned char *conv_to = (tag_y == CB_TAG_CONST) + ? (unsigned char *)CB_CONST (y)->val + : CB_LITERAL (y)->data; + const unsigned char *conv_from = lit_x->data; + const unsigned char *const conv_from_end = conv_from + lit_x->size; + char conv_set[256] = { 0 }; + + /* pre-fill conversion table */ + memcpy (conv_tab, char_tab_0x00_to_0xff, 256); + /* update conversion table with from/to, skipping duplicates */ + while (conv_from < conv_from_end) { + if (conv_set[*conv_from] == 0) { + conv_set[*conv_from] = 1; + conv_tab[*conv_from] = *conv_to; + } + conv_from++; + if (tag_y != CB_TAG_CONST) { + conv_to++; + } + } + /* TODO: not use an alphanumeric literal - generates a cob_field + for the call - possibly a new type that will be used with an own prefix + for generating general collation, too */ + return cb_list_add (l, + CB_BUILD_FUNCALL_1 ("cob_inspect_translating", + cb_build_alphanumeric_literal (conv_tab, 256))); + } + break; + case CB_TAG_REFERENCE: + if (CB_ALPHABET_NAME_P (cb_ref (x)) + && CB_ALPHABET_NAME_P (cb_ref (y))) { + const struct cb_alphabet_name *alph_x = CB_ALPHABET_NAME (cb_ref (x)); + const struct cb_alphabet_name *alph_y = CB_ALPHABET_NAME (cb_ref (y)); + + /* TODO: see note above */ + if ( (alph_x->alphabet_type == CB_ALPHABET_EBCDIC + && alph_y->alphabet_type == CB_ALPHABET_ASCII) + || (alph_y->alphabet_type == CB_ALPHABET_EBCDIC + && alph_x->alphabet_type == CB_ALPHABET_ASCII)) { + /* use the existing and configurable translation table */ + return cb_list_add (l, + CB_BUILD_FUNCALL_1 ("cob_inspect_translating", CB_TREE (alph_y))); + } else { + + // TODO: create conversion tab + struct cb_alphabet_name *alph_conv; + char conv_name[COB_MAX_WORDLEN * 2 + 2 + 1] = { 0 }; + unsigned int i; + + const int *conv_to = alph_y->values; + const int *conv_from = alph_x->values; + /* note: after (validate_alphabet) we have an entry of 256 integer elements */ + const int *const conv_from_end = conv_from + 256; + char conv_set[256] = { 0 }; + + strcat (conv_name, alph_x->name); + strcat (conv_name, "--"); + strcat (conv_name, alph_y->name); + alph_conv = CB_ALPHABET_NAME (cb_build_alphabet_name (cb_build_reference (conv_name))); + + alph_conv->alphabet_type = CB_ALPHABET_CUSTOM; + + /* setup conversion table with from/to, skipping duplicates */ + while (conv_from < conv_from_end) { + const unsigned char to = (unsigned char) *conv_to; + if (conv_set[to] == 0) { + conv_set[to] = 1; + alph_conv->values[to] = *conv_from; + } + conv_from++; + conv_to++; + } + for (i = 0; i < 256; i++) { + if (conv_set[i] == 0) { + alph_conv->values[i] = i; + } + } + return cb_list_add (l, + CB_BUILD_FUNCALL_1 ("cob_inspect_translating", CB_TREE (alph_conv))); + } + + } + break; + default: + cobc_err_msg (_("call to '%s' with invalid parameter '%s'"), + "cb_build_converting", "x"); + CB_TREE_TAG_UNEXPECTED_ABORT (x); + } + } +#endif + return cb_list_add (l, CB_BUILD_FUNCALL_2 ("cob_inspect_converting", x, y)); } diff --git a/libcob/ChangeLog b/libcob/ChangeLog index aa961757..36ed9cbd 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -74,6 +74,17 @@ * fisam.c: Updated to set index field type for 'short' & 'int' Enabled support for variable length records is using V-ISAM/D-ISAM +2023-09-07 Simon Sobisch + + * strings.c (alloc_figurative): optimized handling for SPACES and ZEROES + * strings.c (cob_inspect_translating), common.h: variant of + cob_inspect_converting that is called with a pre-computed translation + table (COBOL source using only constants) + * strings.c (cob_inspect_converting): replaced partial conversion table + with full table, which saves a check on each replaced byte + * strings.c (cob_inspect_converting): also call cob_real_put_sign for + early exits + 2023-09-04 Simon Sobisch * numeric.c (cob_add_int): minor adjustment to scale handling diff --git a/libcob/call.c b/libcob/call.c index d5c51b88..df0ea8d0 100644 --- a/libcob/call.c +++ b/libcob/call.c @@ -52,13 +52,15 @@ FILE *fmemopen (void *buf, size_t size, const char *mode); #define COB_LIB_EXPIMP #include "coblocal.h" -/* NOTE - The following variable should be uncommented when - it is known that dlopen(NULL) is borked. - This is known to be true for some PA-RISC HP-UX 11.11 systems. +/* NOTE: + COB_BORKED_DLOPEN should be set with LIBCOB_CFFLAGS=-DCOB_BORKED_DLOPEN + when it is known that either dlopen(NULL) is borked or dlclose is a no-op. + The first is known to be true for some PA-RISC HP-UX 11.11 systems. This is fixed with HP patch PHSS_28871. (There are newer but this fixes dlopen/dlsym problems) + The second (no-op dlclose) is the case with musl, see + https://wiki.musl-libc.org/functional-differences-from-glibc.html#Unloading_libraries */ -/* #define COB_BORKED_DLOPEN */ #ifdef _WIN32 @@ -305,7 +307,6 @@ cob_set_library_path () char *p; char *pstr; size_t i; - struct stat st; int flag; @@ -396,9 +397,12 @@ cob_set_library_path () /* check if directory (note: entries like X:\ _must_ be specified with trailing slash !) */ - if (stat (p, &st) || !(S_ISDIR (st.st_mode))) { - /* possibly raise a warning, maybe only if explicit asked */ - continue; + { + struct stat st; + if (stat (p, &st) || !(S_ISDIR (st.st_mode))) { + /* possibly raise a warning, maybe only if explicit asked */ + continue; + } } /* remove trailing slash from entry (always added on use) */ diff --git a/libcob/common.h b/libcob/common.h index 94b64705..fc9eda95 100644 --- a/libcob/common.h +++ b/libcob/common.h @@ -1481,19 +1481,19 @@ struct cob_func_loc { #define COB_MAX_KEYCOMP 16 /* max number of parts in a compound key (disam.h :: NPARTS ) */ typedef struct __cob_file_key { - unsigned int offset; /* Offset of field within record */ - short len_suppress; /* length of SUPPRESS "string" */ - short count_components; /* 0..1::simple-key 2..n::split-key */ - unsigned char keyn; /* Index Number */ - unsigned char tf_duplicates; /* WITH DUPLICATES (for RELATIVE/INDEXED) */ - /* 0=NO DUPS, 1=DUPS OK, 2=NO DUPS precheck */ - unsigned char tf_ascending; /* ASCENDING/DESCENDING (for SORT)*/ - unsigned char tf_suppress; /* supress keys where all chars = char_suppress */ - unsigned char char_suppress; /* key supression character */ - unsigned char tf_compress; /* $SET KEYCOMPRESS value */ - cob_field *field; /* Key field (or SPLIT key save area) */ - unsigned char *str_suppress; /* Complete SUPPRESS "string" */ - cob_field *component[COB_MAX_KEYCOMP];/* key-components iff split-key */ + unsigned int offset; /* Offset of field within record */ + short len_suppress; /* length of SUPPRESS "string" */ + short count_components; /* 0..1::simple-key 2..n::split-key */ + unsigned char keyn; /* Index Number */ + unsigned char tf_duplicates; /* WITH DUPLICATES (for RELATIVE/INDEXED) */ + /* 0=NO DUPS, 1=DUPS OK, 2=NO DUPS precheck */ + unsigned char tf_ascending; /* ASCENDING/DESCENDING (for SORT) */ + unsigned char tf_suppress; /* supress keys where all chars = char_suppress (for INDEXED) */ + unsigned char char_suppress; /* key supression character (for INDEXED) */ + unsigned char tf_compress; /* $SET KEYCOMPRESS value */ + cob_field *field; /* Key field (or SPLIT key save area) */ + unsigned char *str_suppress; /* Complete SUPPRESS "string" */ + cob_field *component[COB_MAX_KEYCOMP]; /* key-components iff split-key */ #if 0 /* TODO (for file keys, not for SORT/MERGE) */ const unsigned char *collating_sequence; /* COLLATING */ #endif @@ -2143,6 +2143,7 @@ COB_EXPIMP void cob_inspect_leading (cob_field *, cob_field *); COB_EXPIMP void cob_inspect_first (cob_field *, cob_field *); COB_EXPIMP void cob_inspect_trailing (cob_field *, cob_field *); COB_EXPIMP void cob_inspect_converting (const cob_field *, const cob_field *); +COB_EXPIMP void cob_inspect_translating (const unsigned char *); COB_EXPIMP void cob_inspect_finish (void); COB_EXPIMP void cob_string_init (cob_field *, cob_field *); diff --git a/libcob/strings.c b/libcob/strings.c index 488aa900..51f0d1b8 100644 --- a/libcob/strings.c +++ b/libcob/strings.c @@ -115,13 +115,20 @@ cob_str_memcpy (cob_field *dst, unsigned char *src, const int size) static void alloc_figurative (const cob_field *f1, const cob_field *f2) { + const size_t size2 = f2->size; - unsigned char *s; - size_t size1; - size_t size2; - size_t n; +#if 1 /* size1 is always 1 here, so several optimizations possible */ + if (*f1->data == ' ' && size2 <= COB_SPACES_ALPHABETIC_BYTE_LENGTH) { + alpha_fld.size = size2; + alpha_fld.data = (unsigned char *) COB_SPACES_ALPHABETIC; + return; + } + if (*f1->data == '0' && size2 <= COB_ZEROES_ALPHABETIC_BYTE_LENGTH) { + alpha_fld.size = size2; + alpha_fld.data = (unsigned char *) COB_ZEROES_ALPHABETIC; + return; + } - size2 = f2->size; if (size2 > figurative_size) { if (figurative_ptr) { cob_free (figurative_ptr); @@ -129,15 +136,31 @@ alloc_figurative (const cob_field *f1, const cob_field *f2) figurative_ptr = cob_malloc (size2); figurative_size = size2; } - size1 = 0; - s = figurative_ptr; - for (n = 0; n < size2; ++n, ++s) { - *s = f1->data[size1]; - size1++; - if (size1 >= f1->size) { - size1 = 0; + + memset (figurative_ptr, *f1->data, size2); +#else + if (size2 > figurative_size) { + if (figurative_ptr) { + cob_free (figurative_ptr); } + figurative_ptr = cob_malloc (size2); + figurative_size = size2; } + + { + unsigned char *s = figurative_ptr; + size_t n = size2; + size_t size1 = 0; + while (n != 0) { + if (size1 >= f1->size) { + size1 = 0; + } + *s++ = f1->data[size1++]; + --n; + } + } +#endif + alpha_fld.size = size2; alpha_fld.data = figurative_ptr; } @@ -520,7 +543,7 @@ cob_inspect_init (cob_field *var, const cob_u32_t replacing) cob_inspect_start (setting inspect_start/end) cob_inspect_before (optional, adjusting inspect_end) cob_inspect_after (optional, adjusting inspect_start) - one-time cob_inspect_converting (actual converstion) */ + one-time cob_inspect_converting/cob_inspect_translating (actual converstion) */ void cob_inspect_init_converting (cob_field *var) @@ -571,7 +594,7 @@ cob_inspect_characters (cob_field *f1) } if (inspect_replacing) { - /* INSPECT REPLACING CHARACTERS BY f1 */ + /* INSPECT REPLACING CHARACTERS BY f1 (= size 1) */ const unsigned char repl_by = *f1->data; unsigned char *repdata; setup_repdata (); @@ -645,7 +668,7 @@ cob_inspect_converting (const cob_field *f1, const cob_field *f2) if (inspect_len == 0) { /* our task is to convert either a zero-length field or AFTER ... has not found a place to start the conversion */ - return; + goto end; } if (!f1) { @@ -660,7 +683,7 @@ cob_inspect_converting (const cob_field *f1, const cob_field *f2) f2 = &alpha_fld; } else { cob_set_exception (COB_EC_RANGE_INSPECT_SIZE); - return; + goto end; } } @@ -671,14 +694,32 @@ cob_inspect_converting (const cob_field *f1, const cob_field *f2) unsigned char * const cur_data_end = cur_data + inspect_len; #if 1 /* table-approach, _much faster_, _should_ be portable */ - char conv_tab[256] = { 0 }; /* using 256 to remove the need to use offset */ - char conv_set[256] = { 0 }; + /* pre-filled conversion table */ + unsigned char conv_tab[256] = { + 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, + 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, + 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, + 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, + 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, + 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, + 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, 124, 125, 126, 127, + 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, + 144, 145, 146, 147, 148, 149, 150, 151, 152, 153, 154, 155, 156, 157, 158, 159, + 160, 161, 162, 163, 164, 165, 166, 167, 168, 169, 170, 171, 172, 173, 174, 175, + 176, 177, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, + 192, 193, 194, 195, 196, 197, 198, 199, 200, 201, 202, 203, 204, 205, 206, 207, + 208, 209, 210, 211, 212, 213, 214, 215, 216, 217, 218, 219, 220, 221, 222, 223, + 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, + 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, 251, 252, 253, 254, 255 + }; - /* pre-fill conversion table, skipping duplicates */ + /* update conversion table with from/to, skipping duplicates */ { const unsigned char *conv_to = f2->data; const unsigned char *conv_from = f1->data; - const unsigned char * const conv_from_end = f1->data + f1->size; + const unsigned char * const conv_from_end = conv_from + f1->size; + char conv_set[256] = { 0 }; while (conv_from < conv_from_end) { if (conv_set[*conv_from] == 0) { conv_set[*conv_from] = 1; @@ -687,11 +728,9 @@ cob_inspect_converting (const cob_field *f1, const cob_field *f2) conv_from++, conv_to++; } } - /* iterate over target converting with table */ + /* iterate over target converting with full table */ while (cur_data < cur_data_end) { - if (conv_set[*cur_data]) { - *cur_data = conv_tab[*cur_data]; - } + *cur_data = conv_tab[*cur_data]; cur_data++; } #else @@ -718,8 +757,39 @@ cob_inspect_converting (const cob_field *f1, const cob_field *f2) #endif } +end: /* note: copied here for 3.2+ as cob_inspect_finish is not generated for TRANSFORM/INSPECT CONVERTING any more */ + if (inspect_var) { + /* FIXME: needs test cases for all "goto end" cases above, + ideally with a SIGN SEPARATE variable */ + cob_real_put_sign (inspect_var, inspect_sign); + } +} + +/* note: currently not used by cobc (disabled unfinished prototype) */ +void +cob_inspect_translating (const unsigned char *conv_table) +{ + const size_t inspect_len = inspect_end - inspect_start; + + if (inspect_len == 0) { + /* our task is to convert either a zero-length field or + AFTER ... has not found a place to start the conversion + --> nothing to do here */ + } else { + /* directly convert _all_ positions of the inspect target using the + pre-generated conversion table */ + unsigned char * cur_data = inspect_data + (inspect_start - inspect_data); + unsigned char * const cur_data_end = cur_data + inspect_len; + + /* iterate over target converting with full table */ + while (cur_data < cur_data_end) { + *cur_data = conv_table[*cur_data]; + cur_data++; + } + } + if (inspect_var) { cob_real_put_sign (inspect_var, inspect_sign); } @@ -756,6 +826,13 @@ cob_inspect_finish (void) } /* STRING */ +/* a STRING is split into multiple parts: + one-time cob_string_init (setting up memory and static variables) + 1..n : + cob_string_delimited (setting delimiter struct entries) + 1..n: + cob_string_append (to handle a single source) + one-time cob_string_finish (setting the string pointer) */ void cob_string_init (cob_field *dst, cob_field *ptr) @@ -782,10 +859,11 @@ cob_string_init (cob_field *dst, cob_field *ptr) void cob_string_delimited (cob_field *dlm) { - string_dlm = NULL; if (dlm) { string_dlm_copy = *dlm; string_dlm = &string_dlm_copy; + } else { + string_dlm = NULL; } } diff --git a/tests/testsuite.src/syn_misc.at b/tests/testsuite.src/syn_misc.at index 37d622bd..bd93997e 100644 --- a/tests/testsuite.src/syn_misc.at +++ b/tests/testsuite.src/syn_misc.at @@ -929,12 +929,18 @@ AT_DATA([prog.cob], [ ]) AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:14: error: REPLACING operands differ in size -prog.cob:15: error: REPLACING operands differ in size -prog.cob:17: error: CONVERTING operands differ in size -prog.cob:18: error: CONVERTING operands differ in size -prog.cob:20: error: CONVERTING operands differ in size -prog.cob:23: error: CONVERTING operands differ in size +[prog.cob:14: error: REPLACING operands incompatible +prog.cob:14: note: operands differ in size +prog.cob:15: error: REPLACING operands incompatible +prog.cob:15: note: operands differ in size +prog.cob:17: error: CONVERTING operands incompatible +prog.cob:17: note: operands differ in size +prog.cob:18: error: CONVERTING operands incompatible +prog.cob:18: note: operands differ in size +prog.cob:20: error: CONVERTING operands incompatible +prog.cob:20: note: operands differ in size +prog.cob:23: error: CONVERTING operands incompatible +prog.cob:23: note: operands differ in size ]) AT_CLEANUP @@ -4132,7 +4138,8 @@ prog.cob:20: error: 'not-a-num' is not numeric prog.cob:20: error: 3 is not an alphanumeric literal prog.cob:20: error: invalid target for TALLYING prog.cob:21: error: 'not-display' is not USAGE DISPLAY -prog.cob:20: error: REPLACING operands differ in size +prog.cob:20: error: REPLACING operands incompatible +prog.cob:20: note: operands differ in size prog.cob:20: error: invalid target for REPLACING prog.cob:22: error: 'f' is not a field prog.cob:22: error: 3 is not an alphanumeric literal diff --git a/tests/testsuite.src/syn_refmod.at b/tests/testsuite.src/syn_refmod.at index 285a3d9f..07eb6ce1 100644 --- a/tests/testsuite.src/syn_refmod.at +++ b/tests/testsuite.src/syn_refmod.at @@ -149,13 +149,13 @@ AT_CHECK([$COMPILE_ONLY -fdiagnostics-show-option -Wno-constant-numlit-expressio prog.cob:11: warning: length of 'X' out of bounds: 0 [-Wignored-error] prog.cob:12: warning: offset of 'X' out of bounds: 5 [-Wadditional] prog.cob:13: warning: length of 'X' out of bounds: 5 [-Wadditional] -prog.cob:15: warning: CONVERTING operands differ in size [-Wignored-error] +prog.cob:15: warning: CONVERTING operands incompatible [-Wignored-error] +prog.cob:15: note: operands differ in size ]]) -# should actually raise a warning... - AT_CHECK([$COMPILE_ONLY -Wno-constant-numlit-expression -fno-constant-folding prog.cob], [0], [], []) -#AT_CHECK([$COMPILE_ONLY -Wno-constant-numlit-expression -fno-constant-folding prog.cob], [1], [], -#[prog.cob:15: error: CONVERTING operands differ in size -#]) +AT_CHECK([$COMPILE_ONLY -Wno-constant-numlit-expression -fno-constant-folding prog.cob], [1], [], +[prog.cob:15: error: CONVERTING operands incompatible +prog.cob:15: note: operands differ in size +]) AT_CLEANUP