diff --git a/.github/workflows/windows-msvc.yml b/.github/workflows/windows-msvc.yml index 03211301c..0a2e7d800 100644 --- a/.github/workflows/windows-msvc.yml +++ b/.github/workflows/windows-msvc.yml @@ -178,18 +178,14 @@ jobs: # sed -i '/AT_SETUP(\[runtime check: write to internal storage (1)\])/a AT_SKIP_IF(\[true\])' tests/testsuite.src/run_misc.at sed -i '/run_misc/{N;/write to internal storage (1)/{N;N;N;N;s/traceon/traceon; echo "workflow:1">"$at_check_line_file"; at_fn_check_skip 77/;}}' tests/testsuite - # Fail two tests that behave differently under MSVC Debug + # Fail tests that behave differently under MSVC Debug # - System routine CBL_GC_HOSTED: fails because libcob is linked with the debug version # of the C runtime while the generated module is linked with the release version - # - PROGRAM COLLATING SEQUENCE: fails because of a data loss in a cast, due - # to lack of specific handling of LOW/HIGH-VALUE for NATIONAL alphabets - # (see typeck.c:cb_validate_collating) - name: Adjust testsuite for Debug target if: ${{ matrix.target == 'Debug' }} shell: C:\shells\msys2bash.cmd {0} run: | sed -i '/run_extensions/{N;/System routine CBL_GC_HOSTED/{N;s/at_xfail=no/at_xfail=yes/;}}' tests/testsuite - sed -i '/syn_definition/{N;/PROGRAM COLLATING SEQUENCE/{N;s/at_xfail=no/at_xfail=yes/;}}' tests/testsuite - name: Run testsuite run: | diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 8c5853b8e..fc35cad4e 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -177,6 +177,25 @@ also forces -E, -foneline-deps, -MT=copybooks, disables errors on missing copybooks and removes output on stdout +2024-02-26 David Declerck + + BUG #948: comparison with HIGH-VALUE in presence of collating sequences + * tree.h: add low_value and high_value fields to hold the low + and high values used by the program collating sequence + * tree.c: initialize the low_value and high_value fields + to reasonable default values + * typeck.c: replace cob_refer_ascii and cob_refer_ebcdic by + ebcdic_to_ascii and ascii_to_ebcdic; add load_collating_table + to load the tables; modify cb_validate_collating to call + load_collating_table and set low_value and high_value + fields modify validate_alphabet to use the new tables + * cobc.h: export the new symbols defined in typeck.c + * codegen.c: replace hard-coded 0 and 255 / 0xff contants with + the low_value and high_value fields where appropriate; move + the cob_all_low and cob_all_high fields from global to local; + adjust the output_collating_tables function to use the tables and + functions defined in typeck.c; set the new module field low_value + 2024-02-19 Boris Eng * parser.y (screen_value_clause): replaced basic literals by literals diff --git a/cobc/cobc.c b/cobc/cobc.c index de9c1d6f1..975b7e201 100644 --- a/cobc/cobc.c +++ b/cobc/cobc.c @@ -4230,6 +4230,10 @@ process_command_line (const int argc, char **argv) cb_flag_alt_ebcdic ? "alternate" : "default"); } + if (cob_load_collation (cb_ebcdic_table, ebcdic_to_ascii, ascii_to_ebcdic) < 0) { + cobc_err_exit (_("invalid parameter: %s"), "-febcdic-table"); + } + /* Exit on missing options */ #ifdef COB_INTERNAL_XREF if (cb_listing_xref && !cb_listing_outputfile) { diff --git a/cobc/cobc.h b/cobc/cobc.h index 2c1bcf2ca..c276e08d8 100644 --- a/cobc/cobc.h +++ b/cobc/cobc.h @@ -624,6 +624,11 @@ extern int yyparse (void); /* typeck.c */ extern size_t suppress_warn; /* no warnings for internal generated stuff */ +extern cob_u8_t ebcdic_to_ascii[256]; +extern cob_u8_t ascii_to_ebcdic[256]; + +void load_collating_tables (void); + /* error.c */ #define CB_MSG_STYLE_GCC 0 #define CB_MSG_STYLE_MSC 1U diff --git a/cobc/codegen.c b/cobc/codegen.c index c46d67f24..8a5e124c6 100644 --- a/cobc/codegen.c +++ b/cobc/codegen.c @@ -2515,11 +2515,11 @@ static void output_low_value (void) { if (gen_figurative & CB_NEED_LOW) { - output ("static cob_field cob_all_low\t= "); - output ("{1, "); - output ("(cob_u8_ptr)\"\\0\", "); - output ("&cob_all_attr};"); - output_newline (); + output_local ("static cob_field cob_all_low\t= "); + output_local ("{1, "); + output_local ("(cob_u8_ptr)\"\\x%02x\", ", current_prog->low_value); + output_local ("&cob_all_attr};"); + output_local ("\n"); } } @@ -2527,11 +2527,11 @@ static void output_high_value (void) { if (gen_figurative & CB_NEED_HIGH) { - output ("static cob_field cob_all_high\t= "); - output ("{1, "); - output ("(cob_u8_ptr)\"\\xff\", "); - output ("&cob_all_attr};"); - output_newline (); + output_local ("static cob_field cob_all_high\t= "); + output_local ("{1, "); + output_local ("(cob_u8_ptr)\"\\x%02x\", ", current_prog->high_value); + output_local ("&cob_all_attr};"); + output_local ("\n"); } } @@ -2615,8 +2615,6 @@ output_literals_figuratives_and_constants (void) if (gen_figurative) { output_newline (); - output_low_value (); - output_high_value (); output_quote (); output_space (); output_zero (); @@ -2654,18 +2652,6 @@ output_colseq_table_field (const char * field_name, const char * table_name) static void output_collating_tables (void) { - cob_u8_t ebcdic_to_ascii[256]; - cob_u8_t ascii_to_ebcdic[256]; - - /* Load the collating tables if needed */ - if (gen_ascii_ebcdic || gen_ebcdic_ascii) { - if (cob_load_collation (cb_ebcdic_table, - gen_ebcdic_ascii ? ebcdic_to_ascii : NULL, - gen_ascii_ebcdic ? ascii_to_ebcdic : NULL) < 0) { - cobc_err_exit (_("invalid parameter: %s"), "-febcdic-table"); - } - } - if (gen_native) { output_storage ("\n/* NATIVE table */\n"); output_colseq_table ("cob_native", NULL); @@ -4277,9 +4263,9 @@ output_funcall_typed (struct cb_funcall *p, const char type) } else if (p->argv[1] == cb_zero) { output (") - '0')"); } else if (p->argv[1] == cb_low) { - output ("))"); + output (") - %d)", current_prog->low_value); } else if (p->argv[1] == cb_high) { - output (") - 255)"); + output (") - %d)", current_prog->high_value); } else if (CB_LITERAL_P (p->argv[1])) { output_char (") - ", CB_LITERAL (p->argv[1])->data[0], ")"); } else { @@ -5064,10 +5050,10 @@ output_initialize_to_value (struct cb_field *f, cb_tree x, output_figurative (x, f, ' ', init_occurs); return; } else if (value == cb_low) { - output_figurative (x, f, 0, init_occurs); + output_figurative (x, f, current_prog->low_value, init_occurs); return; } else if (value == cb_high) { - output_figurative (x, f, 255, init_occurs); + output_figurative (x, f, current_prog->high_value, init_occurs); return; } else if (value == cb_quote) { if (cb_flag_apostrophe) { @@ -10810,9 +10796,9 @@ output_class_name_definition (struct cb_class_name *p) } else if (x == cb_null) { vals[0] = 1; } else if (x == cb_low) { - vals[0] = 1; + vals[current_prog->low_value] = 1; } else if (x == cb_high) { - vals[255] = 1; + vals[current_prog->high_value] = 1; } else { size = CB_LITERAL (x)->size; data = CB_LITERAL (x)->data; @@ -14157,6 +14143,12 @@ codegen_internal (struct cb_program *prog, const int subsequent_call) output_local ("\n"); } } + + /* Low and high values */ + if (gen_figurative) { + output_low_value (); + output_high_value (); + } } void diff --git a/cobc/scanner.l b/cobc/scanner.l index 878e660e9..dd7e21c52 100644 --- a/cobc/scanner.l +++ b/cobc/scanner.l @@ -1347,10 +1347,6 @@ static cob_u8_t scan_ebcdic_char (int c) { char buff[10]; /* Arbitrary limit, mostly for error-reporting */ -#ifndef COB_EBCDIC_MACHINE - static cob_u8_t ebcdic_to_ascii[256] ; - static int ebcdic_to_ascii_initialized = 0 ; -#endif unsigned int j = 0; do { buff[j++] = (char)c; @@ -1367,20 +1363,7 @@ scan_ebcdic_char (int c) #ifdef COB_EBCDIC_MACHINE return (cob_u8_t) c; #else - if (!ebcdic_to_ascii_initialized ) { - if (cob_load_collation (cb_ebcdic_table, ebcdic_to_ascii, NULL) < 0) { - cb_error (_("invalid parameter: %s"), "-febcdic-table"); - ebcdic_to_ascii_initialized = -1; - } else { - ebcdic_to_ascii_initialized = 1; - } - } - - if (ebcdic_to_ascii_initialized > 0) { - return ebcdic_to_ascii[c]; - } else { - return '?'; - } + return ebcdic_to_ascii[c]; #endif } diff --git a/cobc/tree.c b/cobc/tree.c index 0e2f9bb18..6e781ed9c 100644 --- a/cobc/tree.c +++ b/cobc/tree.c @@ -2193,6 +2193,10 @@ cb_build_program (struct cb_program *last_program, const int nest_level) p->decimal_point = '.'; p->currency_symbol = '$'; p->numeric_separator = ','; + p->low_value = 0; + p->high_value = 255; + p->low_value_n = 0; + p->high_value_n = 65535; if (cb_call_extfh) { p->extfh = cobc_parse_strdup (cb_call_extfh); } diff --git a/cobc/tree.h b/cobc/tree.h index 19878838f..0c3d0679c 100644 --- a/cobc/tree.h +++ b/cobc/tree.h @@ -1916,6 +1916,10 @@ struct cb_program { unsigned char decimal_point; /* '.' or ',' */ unsigned char currency_symbol; /* '$' or user-specified */ unsigned char numeric_separator; /* ',' or '.' */ + cob_u8_t low_value; /* Low-value for this program */ + cob_u8_t high_value; /* High-value for this program */ + cob_u16_t low_value_n; /* National Low-value */ + cob_u16_t high_value_n; /* National High-value */ enum cob_module_type prog_type; /* Program type (program = 0, function = 1) */ cb_tree entry_convention; /* ENTRY convention / PROCEDURE convention */ struct literal_list *decimal_constants; diff --git a/cobc/typeck.c b/cobc/typeck.c index 3f87068dd..26825d397 100644 --- a/cobc/typeck.c +++ b/cobc/typeck.c @@ -196,79 +196,10 @@ static const unsigned char expr_prio[256] = { static unsigned char expr_prio[256]; #endif -#ifdef COB_EBCDIC_MACHINE -/* EBCDIC referring to ASCII */ -static const unsigned char cob_refer_ascii[256] = { - 0x00, 0x01, 0x02, 0x03, 0x37, 0x2D, 0x2E, 0x2F, - 0x16, 0x05, 0x25, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F, - 0x10, 0x11, 0x12, 0x13, 0x3C, 0x3D, 0x32, 0x26, - 0x18, 0x19, 0x3F, 0x27, 0x1C, 0x1D, 0x1E, 0x1F, - 0x40, 0x5A, 0x7F, 0x7B, 0x5B, 0x6C, 0x50, 0x7D, - 0x4D, 0x5D, 0x5C, 0x4E, 0x6B, 0x60, 0x4B, 0x61, - 0xF0, 0xF1, 0xF2, 0xF3, 0xF4, 0xF5, 0xF6, 0xF7, - 0xF8, 0xF9, 0x7A, 0x5E, 0x4C, 0x7E, 0x6E, 0x6F, - 0x7C, 0xC1, 0xC2, 0xC3, 0xC4, 0xC5, 0xC6, 0xC7, - 0xC8, 0xC9, 0xD1, 0xD2, 0xD3, 0xD4, 0xD5, 0xD6, - 0xD7, 0xD8, 0xD9, 0xE2, 0xE3, 0xE4, 0xE5, 0xE6, - 0xE7, 0xE8, 0xE9, 0xAD, 0xE0, 0xBD, 0x5F, 0x6D, - 0x79, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, - 0x88, 0x89, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, - 0x97, 0x98, 0x99, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6, - 0xA7, 0xA8, 0xA9, 0xC0, 0x6A, 0xD0, 0xA1, 0x07, - 0x68, 0xDC, 0x51, 0x42, 0x43, 0x44, 0x47, 0x48, - 0x52, 0x53, 0x54, 0x57, 0x56, 0x58, 0x63, 0x67, - 0x71, 0x9C, 0x9E, 0xCB, 0xCC, 0xCD, 0xDB, 0xDD, - 0xDF, 0xEC, 0xFC, 0xB0, 0xB1, 0xB2, 0x3E, 0xB4, - 0x45, 0x55, 0xCE, 0xDE, 0x49, 0x69, 0x9A, 0x9B, - 0xAB, 0x9F, 0xBA, 0xB8, 0xB7, 0xAA, 0x8A, 0x8B, - 0xB6, 0xB5, 0x62, 0x4F, 0x64, 0x65, 0x66, 0x20, - 0x21, 0x22, 0x70, 0x23, 0x72, 0x73, 0x74, 0xBE, - 0x76, 0x77, 0x78, 0x80, 0x24, 0x15, 0x8C, 0x8D, - 0x8E, 0x41, 0x06, 0x17, 0x28, 0x29, 0x9D, 0x2A, - 0x2B, 0x2C, 0x09, 0x0A, 0xAC, 0x4A, 0xAE, 0xAF, - 0x1B, 0x30, 0x31, 0xFA, 0x1A, 0x33, 0x34, 0x35, - 0x36, 0x59, 0x08, 0x38, 0xBC, 0x39, 0xA0, 0xBF, - 0xCA, 0x3A, 0xFE, 0x3B, 0x04, 0xCF, 0xDA, 0x14, - 0xE1, 0x8F, 0x46, 0x75, 0xFD, 0xEB, 0xEE, 0xED, - 0x90, 0xEF, 0xB3, 0xFB, 0xB9, 0xEA, 0xBB, 0xFF -}; -#else -/* ASCII referring to EBCDIC */ -static const unsigned char cob_refer_ebcdic[256] = { - 0x00, 0x01, 0x02, 0x03, 0xEC, 0x09, 0xCA, 0x7F, - 0xE2, 0xD2, 0xD3, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F, - 0x10, 0x11, 0x12, 0x13, 0xEF, 0xC5, 0x08, 0xCB, - 0x18, 0x19, 0xDC, 0xD8, 0x1C, 0x1D, 0x1E, 0x1F, - 0xB7, 0xB8, 0xB9, 0xBB, 0xC4, 0x0A, 0x17, 0x1B, - 0xCC, 0xCD, 0xCF, 0xD0, 0xD1, 0x05, 0x06, 0x07, - 0xD9, 0xDA, 0x16, 0xDD, 0xDE, 0xDF, 0xE0, 0x04, - 0xE3, 0xE5, 0xE9, 0xEB, 0x14, 0x15, 0x9E, 0x1A, - 0x20, 0xC9, 0x83, 0x84, 0x85, 0xA0, 0xF2, 0x86, - 0x87, 0xA4, 0xD5, 0x2E, 0x3C, 0x28, 0x2B, 0xB3, - 0x26, 0x82, 0x88, 0x89, 0x8A, 0xA1, 0x8C, 0x8B, - 0x8D, 0xE1, 0x21, 0x24, 0x2A, 0x29, 0x3B, 0x5E, - 0x2D, 0x2F, 0xB2, 0x8E, 0xB4, 0xB5, 0xB6, 0x8F, - 0x80, 0xA5, 0x7C, 0x2C, 0x25, 0x5F, 0x3E, 0x3F, - 0xBA, 0x90, 0xBC, 0xBD, 0xBE, 0xF3, 0xC0, 0xC1, - 0xC2, 0x60, 0x3A, 0x23, 0x40, 0x27, 0x3D, 0x22, - 0xC3, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, - 0x68, 0x69, 0xAE, 0xAF, 0xC6, 0xC7, 0xC8, 0xF1, - 0xF8, 0x6A, 0x6B, 0x6C, 0x6D, 0x6E, 0x6F, 0x70, - 0x71, 0x72, 0xA6, 0xA7, 0x91, 0xCE, 0x92, 0xA9, - 0xE6, 0x7E, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, - 0x79, 0x7A, 0xAD, 0xA8, 0xD4, 0x5B, 0xD6, 0xD7, - 0x9B, 0x9C, 0x9D, 0xFA, 0x9F, 0xB1, 0xB0, 0xAC, - 0xAB, 0xFC, 0xAA, 0xFE, 0xE4, 0x5D, 0xBF, 0xE7, - 0x7B, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, - 0x48, 0x49, 0xE8, 0x93, 0x94, 0x95, 0xA2, 0xED, - 0x7D, 0x4A, 0x4B, 0x4C, 0x4D, 0x4E, 0x4F, 0x50, - 0x51, 0x52, 0xEE, 0x96, 0x81, 0x97, 0xA3, 0x98, - 0x5C, 0xF0, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, - 0x59, 0x5A, 0xFD, 0xF5, 0x99, 0xF7, 0xF6, 0xF9, - 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, - 0x38, 0x39, 0xDB, 0xFB, 0x9A, 0xF4, 0xEA, 0xFF -}; -#endif +/* ASCII/EBCDIC translation tables */ + +cob_u8_t ebcdic_to_ascii[256]; +cob_u8_t ascii_to_ebcdic[256]; /* System routines */ @@ -3815,7 +3746,7 @@ get_value (cb_tree x) } static int -cb_validate_collating (cb_tree collating_sequence) +cb_validate_collating (struct cb_program *prog, cb_tree collating_sequence) { cb_tree x; @@ -3829,19 +3760,43 @@ cb_validate_collating (cb_tree collating_sequence) cb_name (collating_sequence)); return 1; } - if (CB_ALPHABET_NAME (x)->alphabet_type != CB_ALPHABET_CUSTOM) { + +#ifdef COB_EBCDIC_MACHINE + if (CB_ALPHABET_NAME (x)->alphabet_type == CB_ALPHABET_ASCII) { + prog->low_value = ascii_to_ebcdic[0x00]; + prog->high_value = ascii_to_ebcdic[0xff]; +#else + if (CB_ALPHABET_NAME (x)->alphabet_type == CB_ALPHABET_EBCDIC) { + prog->low_value = ebcdic_to_ascii[0x00]; + prog->high_value = ebcdic_to_ascii[0xff]; +#endif + } else if (CB_ALPHABET_NAME (x)->alphabet_type == CB_ALPHABET_CUSTOM) { + if (CB_ALPHABET_NAME (x)->alphabet_target == CB_ALPHABET_ALPHANUMERIC) { + prog->low_value = (cob_u8_t)CB_ALPHABET_NAME (x)->low_val_char; + prog->high_value = (cob_u8_t)CB_ALPHABET_NAME (x)->high_val_char; + } else /* CB_ALPHABET_NATIONAL */ { + prog->low_value_n = (cob_u16_t)CB_ALPHABET_NAME (x)->low_val_char; + prog->high_value_n = (cob_u16_t)CB_ALPHABET_NAME (x)->high_val_char; + } + } else { return 0; } - if (CB_ALPHABET_NAME (x)->low_val_char) { - cb_low = cb_build_alphanumeric_literal ("\0", (size_t)1); - CB_LITERAL(cb_low)->data[0] = (unsigned char)CB_ALPHABET_NAME (x)->low_val_char; - CB_LITERAL(cb_low)->all = 1; - } - if (CB_ALPHABET_NAME (x)->high_val_char != 255){ - cb_high = cb_build_alphanumeric_literal ("\0", (size_t)1); - CB_LITERAL(cb_high)->data[0] = (unsigned char)CB_ALPHABET_NAME (x)->high_val_char; - CB_LITERAL(cb_high)->all = 1; + + if (CB_ALPHABET_NAME (x)->alphabet_target == CB_ALPHABET_ALPHANUMERIC) { + if (prog->low_value) { + cb_low = cb_build_alphanumeric_literal ("\0", (size_t)1); + CB_LITERAL(cb_low)->data[0] = prog->low_value; + CB_LITERAL(cb_low)->all = 1; + } + if (prog->high_value != 255){ + cb_high = cb_build_alphanumeric_literal ("\0", (size_t)1); + CB_LITERAL(cb_high)->data[0] = prog->high_value; + CB_LITERAL(cb_high)->all = 1; + } + } else /* CB_ALPHABET_NATIONAL */ { + /* TODO: LOW/HIGH-VALUE for national */ } + return 0; } @@ -3884,6 +3839,8 @@ validate_alphabet (cb_tree alphabet) *entry = n; entry++; } + ap->low_val_char = 0; + ap->high_val_char = 255; return; } @@ -3892,12 +3849,19 @@ validate_alphabet (cb_tree alphabet) register int *entry = ap->values; for (n = 0; n < COB_MAX_CHAR_ALPHANUMERIC + 1; n++) { #ifdef COB_EBCDIC_MACHINE - *entry = (int)cob_refer_ascii[n]; + *entry = (int)ascii_to_ebcdic[n]; #else *entry = n; #endif entry++; } +#ifdef COB_EBCDIC_MACHINE + ap->low_val_char = ascii_to_ebcdic[0x00]; + ap->high_val_char = ascii_to_ebcdic[0xff]; +#else + ap->low_val_char = 0; + ap->high_val_char = 255; +#endif memcpy (ap->alphachr, ap->values, memsize); return; } @@ -3909,11 +3873,17 @@ validate_alphabet (cb_tree alphabet) #ifdef COB_EBCDIC_MACHINE *entry = n; #else - *entry = (int)cob_refer_ebcdic[n]; + *entry = (int)ebcdic_to_ascii[n]; #endif entry++; } - +#ifdef COB_EBCDIC_MACHINE + ap->low_val_char = 0; + ap->high_val_char = 255; +#else + ap->low_val_char = ebcdic_to_ascii[0x00]; + ap->high_val_char = ebcdic_to_ascii[0xff]; +#endif memcpy (ap->alphachr, ap->values, memsize); return; } @@ -4316,10 +4286,10 @@ cb_validate_program_environment (struct cb_program *prog) } /* Resolve the program collating sequences */ - if (cb_validate_collating (prog->collating_sequence)) { + if (cb_validate_collating (prog, prog->collating_sequence)) { prog->collating_sequence = NULL; }; - if (cb_validate_collating (prog->collating_sequence_n)) { + if (cb_validate_collating (prog, prog->collating_sequence_n)) { prog->collating_sequence_n = NULL; }; diff --git a/libcob/ChangeLog b/libcob/ChangeLog index 8b440116e..ed3304c16 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -238,6 +238,12 @@ FR #488: using state structures instead of state vars for strings * strings.c: moved static variables to structures +2024-02-26 David Declerck + + BUG #948: comparison with HIGH-VALUE in presence of collating sequences + * strings.c: use the collating_sequence field of cob_module to + determine the low value instead of the hard-coded constant "\0" + 2024-01-25 David Declerck FR #459: support COLLATING SEQUENCE clause on SELECT / INDEXED files diff --git a/libcob/strings.c b/libcob/strings.c index f107cfdb0..51c3bf46c 100644 --- a/libcob/strings.c +++ b/libcob/strings.c @@ -108,6 +108,16 @@ static cob_field str_cob_low; /* Local functions */ +static COB_INLINE COB_A_INLINE void +cob_update_low_value (void) +{ + if (COB_MODULE_PTR->collating_sequence != NULL) { + str_cob_low.data = (cob_u8_ptr)&COB_MODULE_PTR->collating_sequence[0]; + } else { + str_cob_low.data = (cob_u8_ptr)"\0"; + } +} + static void cob_str_memcpy (cob_field *dst, unsigned char *src, const int size) { @@ -454,9 +464,11 @@ inspect_common ( } if (unlikely (!f1)) { + cob_update_low_value (); f1 = &str_cob_low; } if (unlikely (!f2)) { + cob_update_low_value (); f2 = &str_cob_low; } @@ -737,9 +749,11 @@ cob_inspect_converting_intern ( } if (unlikely (!f1)) { + cob_update_low_value (); f1 = &str_cob_low; } if (unlikely (!f2)) { + cob_update_low_value (); f2 = &str_cob_low; } if (f1->size != f2->size) { diff --git a/tests/testsuite.src/run_misc.at b/tests/testsuite.src/run_misc.at index cd7cf27e6..a7a230b0e 100644 --- a/tests/testsuite.src/run_misc.at +++ b/tests/testsuite.src/run_misc.at @@ -4003,6 +4003,44 @@ AT_CHECK([$COBCRUN_DIRECT ./ebcdic], [0], [], []) AT_CLEANUP +AT_SETUP([SEARCH ALL with non-0xff HIGH-VALUE]) +AT_KEYWORDS([runmisc default-colseq]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + OBJECT-COMPUTER. x86, + PROGRAM COLLATING SEQUENCE IS alpha-ebcdic. + SPECIAL-NAMES. + ALPHABET alpha-ebcdic IS EBCDIC. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 TAB. + 02 TAB-ELT OCCURS 3 + ASCENDING KEY TAB-KEY + INDEXED BY TI. + 05 TAB-KEY PIC X. + PROCEDURE DIVISION. + MOVE HIGH-VALUE TO TAB + MOVE "1" TO TAB-ELT (1) + * DISPLAY "|" TAB "|" + SEARCH ALL TAB-ELT + AT END + DISPLAY '"1" NOT FOUND' + WHEN TAB-KEY (TI) = "1" + CONTINUE + END-SEARCH + STOP RUN. +]) + +AT_CHECK([$COMPILE -febcdic-table=ebcdic500_latin1 prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +AT_CLEANUP + + AT_SETUP([PIC ZZZ-, ZZZ+]) AT_KEYWORDS([runmisc editing]) @@ -15131,3 +15169,370 @@ AT_CHECK([COB_PROF_ENABLE=1 COB_PROF_FILE=prof.csv $COBCRUN_DIRECT ./caller], [0 ]) AT_CLEANUP + + +# See bug #948 - Comparison with HIGH-VALUE in presence of collating sequences +AT_SETUP([LOW/HIGH-VALUE when using non-native program collating sequence]) +AT_KEYWORDS([LOW-VALUE HIGH-VALUE ALPHABET EBCDIC ASCII]) + +AT_DATA([prog1.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + OBJECT-COMPUTER. x86, + PROGRAM COLLATING SEQUENCE IS alpha-custom. + SPECIAL-NAMES. + ALPHABET alpha-custom IS + 64 THRU 1 + 65 THRU 192 + 256 THRU 193. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 LV-ORD PIC 999. + 01 LV PIC X. + 88 IS-LV VALUE LOW-VALUE. + 01 HV-ORD PIC 999. + 01 HV PIC X. + 88 IS-HV VALUE HIGH-VALUE. + PROCEDURE DIVISION. + MOVE LOW-VALUE TO LV. + MOVE HIGH-VALUE TO HV. + MOVE FUNCTION ORD (LOW-VALUE) TO LV-ORD. + MOVE FUNCTION ORD (HIGH-VALUE) TO HV-ORD. + DISPLAY "LOW-VALUE: " LV-ORD + " HIGH-VALUE: " HV-ORD. + IF LV = LOW-VALUE AND IS-LV + DISPLAY "LOW-VALUE OK" + ELSE + DISPLAY "LOW-VALUE KO" + END-IF. + IF HV = HIGH-VALUE AND IS-HV + DISPLAY "HIGH-VALUE OK" + ELSE + DISPLAY "HIGH-VALUE KO" + END-IF. + IF "X" > LOW-VALUE AND "X" > LV + DISPLAY "X > LOW-VALUE" + ELSE + DISPLAY "X < LOW-VALUE" + END-IF. + IF "X" < HIGH-VALUE AND "X" < HV + DISPLAY "X < HIGH-VALUE" + ELSE + DISPLAY "X > HIGH-VALUE" + END-IF. + STOP RUN. +]) + +AT_CHECK([$COMPILE prog1.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog1], [0], +[LOW-VALUE: 064 HIGH-VALUE: 193 +LOW-VALUE OK +HIGH-VALUE OK +X > LOW-VALUE +X < HIGH-VALUE +], []) + +AT_DATA([prog2.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + OBJECT-COMPUTER. x86, + PROGRAM COLLATING SEQUENCE IS alpha-custom. + SPECIAL-NAMES. + ALPHABET alpha-custom IS + 65. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 LV-ORD PIC 999. + 01 LV PIC X. + 88 IS-LV VALUE LOW-VALUE. + 01 HV-ORD PIC 999. + 01 HV PIC X. + 88 IS-HV VALUE HIGH-VALUE. + PROCEDURE DIVISION. + MOVE LOW-VALUE TO LV. + MOVE HIGH-VALUE TO HV. + MOVE FUNCTION ORD (LOW-VALUE) TO LV-ORD. + MOVE FUNCTION ORD (HIGH-VALUE) TO HV-ORD. + DISPLAY "LOW-VALUE: " LV-ORD + " HIGH-VALUE: " HV-ORD. + IF LV = LOW-VALUE AND IS-LV + DISPLAY "LOW-VALUE OK" + ELSE + DISPLAY "LOW-VALUE KO" + END-IF. + IF HV = HIGH-VALUE AND IS-HV + DISPLAY "HIGH-VALUE OK" + ELSE + DISPLAY "HIGH-VALUE KO" + END-IF. + IF "X" > LOW-VALUE AND "X" > LV + DISPLAY "X > LOW-VALUE" + ELSE + DISPLAY "X < LOW-VALUE" + END-IF. + IF "X" < HIGH-VALUE AND "X" < HV + DISPLAY "X < HIGH-VALUE" + ELSE + DISPLAY "X > HIGH-VALUE" + END-IF. + STOP RUN. +]) + +AT_CHECK([$COMPILE prog2.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], +[LOW-VALUE: 065 HIGH-VALUE: 256 +LOW-VALUE OK +HIGH-VALUE OK +X > LOW-VALUE +X < HIGH-VALUE +], []) + +AT_DATA([prog3.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + OBJECT-COMPUTER. x86, + PROGRAM COLLATING SEQUENCE IS alpha-ebcdic. + SPECIAL-NAMES. + ALPHABET alpha-ebcdic IS EBCDIC. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 LV-ORD PIC 999. + 01 LV PIC X. + 88 IS-LV VALUE LOW-VALUE. + 01 HV-ORD PIC 999. + 01 HV PIC X. + 88 IS-HV VALUE HIGH-VALUE. + PROCEDURE DIVISION. + MOVE LOW-VALUE TO LV. + MOVE HIGH-VALUE TO HV. + MOVE FUNCTION ORD (LOW-VALUE) TO LV-ORD. + MOVE FUNCTION ORD (HIGH-VALUE) TO HV-ORD. + DISPLAY "LOW-VALUE: " LV-ORD + " HIGH-VALUE: " HV-ORD. + IF LV = LOW-VALUE AND IS-LV + DISPLAY "LOW-VALUE OK" + ELSE + DISPLAY "LOW-VALUE KO" + END-IF. + IF HV = HIGH-VALUE AND IS-HV + DISPLAY "HIGH-VALUE OK" + ELSE + DISPLAY "HIGH-VALUE KO" + END-IF. + IF "X" > LOW-VALUE AND "X" > LV + DISPLAY "X > LOW-VALUE" + ELSE + DISPLAY "X < LOW-VALUE" + END-IF. + IF "X" < HIGH-VALUE AND "X" < HV + DISPLAY "X < HIGH-VALUE" + ELSE + DISPLAY "X > HIGH-VALUE" + END-IF. + STOP RUN. +]) + +AT_CHECK([$COMPILE -febcdic-table=ebcdic500_latin1 prog3.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog3], [0], +[LOW-VALUE: 001 HIGH-VALUE: 160 +LOW-VALUE OK +HIGH-VALUE OK +X > LOW-VALUE +X < HIGH-VALUE +], []) + +AT_DATA([prog4.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 LV-ORD PIC 999. + 01 LV PIC X. + 88 IS-LV VALUE LOW-VALUE. + 01 HV-ORD PIC 999. + 01 HV PIC X. + 88 IS-HV VALUE HIGH-VALUE. + PROCEDURE DIVISION. + MOVE LOW-VALUE TO LV. + MOVE HIGH-VALUE TO HV. + MOVE FUNCTION ORD (LOW-VALUE) TO LV-ORD. + MOVE FUNCTION ORD (HIGH-VALUE) TO HV-ORD. + DISPLAY "LOW-VALUE: " LV-ORD + " HIGH-VALUE: " HV-ORD. + IF LV = LOW-VALUE AND IS-LV + DISPLAY "LOW-VALUE OK" + ELSE + DISPLAY "LOW-VALUE KO" + END-IF. + IF HV = HIGH-VALUE AND IS-HV + DISPLAY "HIGH-VALUE OK" + ELSE + DISPLAY "HIGH-VALUE KO" + END-IF. + IF "X" > LOW-VALUE AND "X" > LV + DISPLAY "X > LOW-VALUE" + ELSE + DISPLAY "X < LOW-VALUE" + END-IF. + IF "X" < HIGH-VALUE AND "X" < HV + DISPLAY "X < HIGH-VALUE" + ELSE + DISPLAY "X > HIGH-VALUE" + END-IF. + STOP RUN. +]) + +AT_CHECK([$COMPILE -fdefault-colseq=EBCDIC -febcdic-table=ebcdic500_latin1 prog4.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog4], [0], +[LOW-VALUE: 001 HIGH-VALUE: 160 +LOW-VALUE OK +HIGH-VALUE OK +X > LOW-VALUE +X < HIGH-VALUE +], []) + +AT_DATA([prog5.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog1. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + OBJECT-COMPUTER. x86, + PROGRAM COLLATING SEQUENCE IS alpha-ebcdic. + SPECIAL-NAMES. + ALPHABET alpha-ebcdic IS EBCDIC. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 LV-ORD PIC 999. + 01 LV PIC X. + 88 IS-LV VALUE LOW-VALUE. + 01 HV-ORD PIC 999. + 01 HV PIC X. + 88 IS-HV VALUE HIGH-VALUE. + PROCEDURE DIVISION. + MOVE LOW-VALUE TO LV. + MOVE HIGH-VALUE TO HV. + MOVE FUNCTION ORD (LOW-VALUE) TO LV-ORD. + MOVE FUNCTION ORD (HIGH-VALUE) TO HV-ORD. + DISPLAY "P1 LOW-VALUE: " LV-ORD + " HIGH-VALUE: " HV-ORD. + IF LV = LOW-VALUE AND IS-LV + DISPLAY "LOW-VALUE OK" + ELSE + DISPLAY "LOW-VALUE KO" + END-IF. + IF HV = HIGH-VALUE AND IS-HV + DISPLAY "HIGH-VALUE OK" + ELSE + DISPLAY "HIGH-VALUE KO" + END-IF. + IF "X" > LOW-VALUE AND "X" > LV + DISPLAY "X > LOW-VALUE" + ELSE + DISPLAY "X < LOW-VALUE" + END-IF. + IF "X" < HIGH-VALUE AND "X" < HV + DISPLAY "X < HIGH-VALUE" + ELSE + DISPLAY "X > HIGH-VALUE" + END-IF. + CALL "prog2". + STOP RUN. + END PROGRAM prog1. + IDENTIFICATION DIVISION. + PROGRAM-ID. prog2. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + OBJECT-COMPUTER. x86, + PROGRAM COLLATING SEQUENCE IS alpha-ascii. + SPECIAL-NAMES. + ALPHABET alpha-ascii IS ASCII. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 LV-ORD PIC 999. + 01 LV PIC X. + 88 IS-LV VALUE LOW-VALUE. + 01 HV-ORD PIC 999. + 01 HV PIC X. + 88 IS-HV VALUE HIGH-VALUE. + PROCEDURE DIVISION. + MOVE LOW-VALUE TO LV. + MOVE HIGH-VALUE TO HV. + MOVE FUNCTION ORD (LOW-VALUE) TO LV-ORD. + MOVE FUNCTION ORD (HIGH-VALUE) TO HV-ORD. + DISPLAY "P2 LOW-VALUE: " LV-ORD + " HIGH-VALUE: " HV-ORD. + IF LV = LOW-VALUE AND IS-LV + DISPLAY "LOW-VALUE OK" + ELSE + DISPLAY "LOW-VALUE KO" + END-IF. + IF HV = HIGH-VALUE AND IS-HV + DISPLAY "HIGH-VALUE OK" + ELSE + DISPLAY "HIGH-VALUE KO" + END-IF. + IF "X" > LOW-VALUE AND "X" > LV + DISPLAY "X > LOW-VALUE" + ELSE + DISPLAY "X < LOW-VALUE" + END-IF. + IF "X" < HIGH-VALUE AND "X" < HV + DISPLAY "X < HIGH-VALUE" + ELSE + DISPLAY "X > HIGH-VALUE" + END-IF. + STOP RUN. + END PROGRAM prog2. +]) + +AT_CHECK([$COMPILE -febcdic-table=ebcdic500_latin1 prog5.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog5], [0], +[P1 LOW-VALUE: 001 HIGH-VALUE: 160 +LOW-VALUE OK +HIGH-VALUE OK +X > LOW-VALUE +X < HIGH-VALUE +P2 LOW-VALUE: 001 HIGH-VALUE: 256 +LOW-VALUE OK +HIGH-VALUE OK +X > LOW-VALUE +X < HIGH-VALUE +], []) + +AT_DATA([prog6.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 IND PIC 9(02). + 01 ENDX PIC X(01). + 01 ENDXS PIC X(05). + PROCEDURE DIVISION. + INITIALIZE ENDX. + PERFORM VARYING IND FROM 1 BY 1 UNTIL ENDX = HIGH-VALUE + DISPLAY IND " " WITH NO ADVANCING + IF IND = 9 + MOVE HIGH-VALUE TO ENDX + END-IF + END-PERFORM. + INITIALIZE ENDXS. + PERFORM VARYING IND FROM 1 BY 1 UNTIL ENDXS = HIGH-VALUE + DISPLAY IND " " WITH NO ADVANCING + IF IND = 9 + MOVE HIGH-VALUE TO ENDXS + END-IF + END-PERFORM. + STOP RUN. +]) + +AT_CHECK([$COMPILE -fdefault-colseq=EBCDIC -febcdic-table=ebcdic500_latin1 prog6.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog6], [0], +[01 02 03 04 05 06 07 08 09 01 02 03 04 05 06 07 08 09 ], []) + +AT_CLEANUP diff --git a/tests/testsuite.src/syn_literals.at b/tests/testsuite.src/syn_literals.at index f4d8f8a5d..ea9d3d7da 100644 --- a/tests/testsuite.src/syn_literals.at +++ b/tests/testsuite.src/syn_literals.at @@ -1556,7 +1556,7 @@ AT_CHECK([$COMPILE prog2.cob], [0], [], ]) AT_CHECK([$COMPILE -febcdic-symbolic-characters -febcdic-table=dummyNotThere prog2.cob], [1], [], [libcob: error: can't open translation table 'dummyNotThere' -prog2.cob:5: error: invalid parameter: -febcdic-table +cobc: error: invalid parameter: -febcdic-table ]) AT_CLEANUP