From 80957d88e174722236333675945c56f08be4f1ac Mon Sep 17 00:00:00 2001 From: David Declerck Date: Tue, 20 Feb 2024 08:47:15 +0100 Subject: [PATCH 1/3] Fix bug #948: make HIGH/LOW-VALUE sensitive to ASCII/EBCDIC program collating sequence --- cobc/ChangeLog | 19 ++ cobc/cobc.h | 5 + cobc/codegen.c | 48 ++--- cobc/tree.c | 2 + cobc/tree.h | 2 + cobc/typeck.c | 146 ++++++------- libcob/ChangeLog | 6 + libcob/strings.c | 14 ++ tests/testsuite.src/run_misc.at | 367 ++++++++++++++++++++++++++++++++ 9 files changed, 500 insertions(+), 109 deletions(-) diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 310f24579..99bd68397 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -196,6 +196,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.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 2710761f8..919efb622 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,16 +2652,10 @@ 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"); - } + load_collating_tables (); } if (gen_native) { @@ -4275,9 +4267,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 { @@ -5062,10 +5054,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) { @@ -10808,9 +10800,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; @@ -14155,6 +14147,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/tree.c b/cobc/tree.c index 9ae64d219..ed6e91d6e 100644 --- a/cobc/tree.c +++ b/cobc/tree.c @@ -2201,6 +2201,8 @@ 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 = '\xff'; if (cb_call_extfh) { p->extfh = cobc_parse_strdup (cb_call_extfh); } diff --git a/cobc/tree.h b/cobc/tree.h index 19878838f..975cc28f1 100644 --- a/cobc/tree.h +++ b/cobc/tree.h @@ -1916,6 +1916,8 @@ 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 */ 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 69d4de0c0..b58107e60 100644 --- a/cobc/typeck.c +++ b/cobc/typeck.c @@ -201,79 +201,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 */ @@ -3819,8 +3750,21 @@ get_value (cb_tree x) } } +void +load_collating_tables (void) +{ + static int coltab_loaded = 0; + if (coltab_loaded) { + return; + } + if (cob_load_collation (cb_ebcdic_table, ebcdic_to_ascii, ascii_to_ebcdic) < 0) { + cobc_err_exit (_("invalid parameter: %s"), "-febcdic-table"); + } + coltab_loaded = 1; +} + static int -cb_validate_collating (cb_tree collating_sequence) +cb_validate_collating (struct cb_program *prog, cb_tree collating_sequence) { cb_tree x; @@ -3834,17 +3778,34 @@ 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) { + load_collating_tables (); + 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) { + load_collating_tables (); + 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) { + prog->low_value = (unsigned char)CB_ALPHABET_NAME (x)->low_val_char; + prog->high_value = (unsigned char)CB_ALPHABET_NAME (x)->high_val_char; + } else { return 0; } - if (CB_ALPHABET_NAME (x)->low_val_char) { + + if (prog->low_value) { 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)->data[0] = prog->low_value; CB_LITERAL(cb_low)->all = 1; } - if (CB_ALPHABET_NAME (x)->high_val_char != 255){ + + if (prog->high_value != 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)->data[0] = prog->high_value; CB_LITERAL(cb_high)->all = 1; } return 0; @@ -3889,6 +3850,8 @@ validate_alphabet (cb_tree alphabet) *entry = n; entry++; } + ap->low_val_char = 0; + ap->high_val_char = 255; return; } @@ -3897,12 +3860,20 @@ 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]; + load_collating_tables (); + *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; } @@ -3914,11 +3885,18 @@ validate_alphabet (cb_tree alphabet) #ifdef COB_EBCDIC_MACHINE *entry = n; #else - *entry = (int)cob_refer_ebcdic[n]; + load_collating_tables (); + *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; } @@ -4321,10 +4299,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 95362db3f..5056482f4 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -334,6 +334,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 30bb235f3..197f16486 100644 --- a/libcob/strings.c +++ b/libcob/strings.c @@ -114,6 +114,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) { @@ -460,9 +470,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; } @@ -747,9 +759,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 69dfde687..23fc1783a 100644 --- a/tests/testsuite.src/run_misc.at +++ b/tests/testsuite.src/run_misc.at @@ -15251,3 +15251,370 @@ AT_CHECK([$COMPILE prog.cob]) AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [1.2345E-5 1.2345E-5], []) 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 From 4d96940a182e7e3bcb4449a459f17711a577cb45 Mon Sep 17 00:00:00 2001 From: Nicolas Berthier Date: Fri, 23 Aug 2024 09:32:47 +0200 Subject: [PATCH 2/3] Add a `SEARCH ALL` test with non-0xff `HIGH-VALUE` --- tests/testsuite.src/run_misc.at | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) diff --git a/tests/testsuite.src/run_misc.at b/tests/testsuite.src/run_misc.at index 23fc1783a..483296aeb 100644 --- a/tests/testsuite.src/run_misc.at +++ b/tests/testsuite.src/run_misc.at @@ -4073,6 +4073,38 @@ 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. + 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 -fdefault-colseq=EBCDIC prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +AT_CLEANUP + + AT_SETUP([PIC ZZZ-, ZZZ+]) AT_KEYWORDS([runmisc editing]) From 768ad62e553d58f8ca26e01bec5b7c74641ac308 Mon Sep 17 00:00:00 2001 From: David Declerck Date: Tue, 5 Nov 2024 12:46:02 +0100 Subject: [PATCH 3/3] Improvements --- .github/workflows/windows-msvc.yml | 6 +- build_windows/makedist.cmd | 2 +- cobc/cobc.c | 4 ++ cobc/codegen.c | 6 -- cobc/scanner.l | 19 +---- cobc/tree.c | 6 +- cobc/tree.h | 2 + cobc/typeck.c | 48 ++++++------- tests/testsuite.src/run_misc.at | 104 +++++++++++++--------------- tests/testsuite.src/syn_literals.at | 2 +- 10 files changed, 83 insertions(+), 116 deletions(-) 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/build_windows/makedist.cmd b/build_windows/makedist.cmd index 65a9c0282..de6ce2291 100644 --- a/build_windows/makedist.cmd +++ b/build_windows/makedist.cmd @@ -120,7 +120,7 @@ if exist "%cob_source_path%doc\*.html" ( echo Copying configuration files... mkdir config -set "config_ext_list=conf conf-inc words cfg" +set "config_ext_list=conf conf-inc words cfg ttbl" for %%f in (%config_ext_list%) do ( copy "%cob_source_path%config\*.%%f" config\ 1>nul ) diff --git a/cobc/cobc.c b/cobc/cobc.c index 34b38a8da..052af95d2 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/codegen.c b/cobc/codegen.c index 919efb622..791b4bf3d 100644 --- a/cobc/codegen.c +++ b/cobc/codegen.c @@ -2652,12 +2652,6 @@ output_colseq_table_field (const char * field_name, const char * table_name) static void output_collating_tables (void) { - - /* Load the collating tables if needed */ - if (gen_ascii_ebcdic || gen_ebcdic_ascii) { - load_collating_tables (); - } - if (gen_native) { output_storage ("\n/* NATIVE table */\n"); output_colseq_table ("cob_native", NULL); 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 ed6e91d6e..ad7f4d04c 100644 --- a/cobc/tree.c +++ b/cobc/tree.c @@ -2201,8 +2201,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 = '\xff'; + 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 975cc28f1..0c3d0679c 100644 --- a/cobc/tree.h +++ b/cobc/tree.h @@ -1918,6 +1918,8 @@ struct cb_program { 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 b58107e60..bd67a4cdc 100644 --- a/cobc/typeck.c +++ b/cobc/typeck.c @@ -3750,19 +3750,6 @@ get_value (cb_tree x) } } -void -load_collating_tables (void) -{ - static int coltab_loaded = 0; - if (coltab_loaded) { - return; - } - if (cob_load_collation (cb_ebcdic_table, ebcdic_to_ascii, ascii_to_ebcdic) < 0) { - cobc_err_exit (_("invalid parameter: %s"), "-febcdic-table"); - } - coltab_loaded = 1; -} - static int cb_validate_collating (struct cb_program *prog, cb_tree collating_sequence) { @@ -3781,33 +3768,40 @@ cb_validate_collating (struct cb_program *prog, cb_tree collating_sequence) #ifdef COB_EBCDIC_MACHINE if (CB_ALPHABET_NAME (x)->alphabet_type == CB_ALPHABET_ASCII) { - load_collating_tables (); 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) { - load_collating_tables (); 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) { - prog->low_value = (unsigned char)CB_ALPHABET_NAME (x)->low_val_char; - prog->high_value = (unsigned char)CB_ALPHABET_NAME (x)->high_val_char; + 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 (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 (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 */ } - 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; - } return 0; } @@ -3860,7 +3854,6 @@ validate_alphabet (cb_tree alphabet) register int *entry = ap->values; for (n = 0; n < COB_MAX_CHAR_ALPHANUMERIC + 1; n++) { #ifdef COB_EBCDIC_MACHINE - load_collating_tables (); *entry = (int)ascii_to_ebcdic[n]; #else *entry = n; @@ -3885,7 +3878,6 @@ validate_alphabet (cb_tree alphabet) #ifdef COB_EBCDIC_MACHINE *entry = n; #else - load_collating_tables (); *entry = (int)ebcdic_to_ascii[n]; #endif entry++; diff --git a/tests/testsuite.src/run_misc.at b/tests/testsuite.src/run_misc.at index 483296aeb..7661c5251 100644 --- a/tests/testsuite.src/run_misc.at +++ b/tests/testsuite.src/run_misc.at @@ -4079,6 +4079,12 @@ 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. @@ -4099,7 +4105,7 @@ AT_DATA([prog.cob], [ STOP RUN. ]) -AT_CHECK([$COMPILE -febcdic-table=ebcdic500_latin1 -fdefault-colseq=EBCDIC prog.cob], [0], [], []) +AT_CHECK([$COMPILE -febcdic-table=ebcdic500_latin1 prog.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) AT_CLEANUP @@ -15303,19 +15309,17 @@ AT_DATA([prog1.cob], [ 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. + 88 IS-LV VALUE LOW-VALUE. + 01 LV-VAL REDEFINES LV BINARY-CHAR UNSIGNED. 01 HV PIC X. - 88 IS-HV VALUE HIGH-VALUE. + 88 IS-HV VALUE HIGH-VALUE. + 01 HV-VAL REDEFINES HV BINARY-CHAR UNSIGNED. 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. + DISPLAY "LOW-VALUE: " LV-VAL + " HIGH-VALUE: " HV-VAL. IF LV = LOW-VALUE AND IS-LV DISPLAY "LOW-VALUE OK" ELSE @@ -15341,7 +15345,7 @@ AT_DATA([prog1.cob], [ AT_CHECK([$COMPILE prog1.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog1], [0], -[LOW-VALUE: 064 HIGH-VALUE: 193 +[LOW-VALUE: 063 HIGH-VALUE: 192 LOW-VALUE OK HIGH-VALUE OK X > LOW-VALUE @@ -15360,19 +15364,17 @@ AT_DATA([prog2.cob], [ 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. + 88 IS-LV VALUE LOW-VALUE. + 01 LV-VAL REDEFINES LV BINARY-CHAR UNSIGNED. 01 HV PIC X. - 88 IS-HV VALUE HIGH-VALUE. + 88 IS-HV VALUE HIGH-VALUE. + 01 HV-VAL REDEFINES HV BINARY-CHAR UNSIGNED. 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. + DISPLAY "LOW-VALUE: " LV-VAL + " HIGH-VALUE: " HV-VAL. IF LV = LOW-VALUE AND IS-LV DISPLAY "LOW-VALUE OK" ELSE @@ -15398,7 +15400,7 @@ AT_DATA([prog2.cob], [ AT_CHECK([$COMPILE prog2.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], -[LOW-VALUE: 065 HIGH-VALUE: 256 +[LOW-VALUE: 064 HIGH-VALUE: 255 LOW-VALUE OK HIGH-VALUE OK X > LOW-VALUE @@ -15416,19 +15418,17 @@ AT_DATA([prog3.cob], [ 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. + 88 IS-LV VALUE LOW-VALUE. + 01 LV-VAL REDEFINES LV BINARY-CHAR UNSIGNED. 01 HV PIC X. - 88 IS-HV VALUE HIGH-VALUE. + 88 IS-HV VALUE HIGH-VALUE. + 01 HV-VAL REDEFINES HV BINARY-CHAR UNSIGNED. 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. + DISPLAY "LOW-VALUE: " LV-VAL + " HIGH-VALUE: " HV-VAL. IF LV = LOW-VALUE AND IS-LV DISPLAY "LOW-VALUE OK" ELSE @@ -15454,7 +15454,7 @@ AT_DATA([prog3.cob], [ AT_CHECK([$COMPILE -febcdic-table=ebcdic500_latin1 prog3.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog3], [0], -[LOW-VALUE: 001 HIGH-VALUE: 160 +[LOW-VALUE: 000 HIGH-VALUE: 159 LOW-VALUE OK HIGH-VALUE OK X > LOW-VALUE @@ -15466,19 +15466,17 @@ AT_DATA([prog4.cob], [ 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. + 88 IS-LV VALUE LOW-VALUE. + 01 LV-VAL REDEFINES LV BINARY-CHAR UNSIGNED. 01 HV PIC X. - 88 IS-HV VALUE HIGH-VALUE. + 88 IS-HV VALUE HIGH-VALUE. + 01 HV-VAL REDEFINES HV BINARY-CHAR UNSIGNED. 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. + DISPLAY "LOW-VALUE: " LV-VAL + " HIGH-VALUE: " HV-VAL. IF LV = LOW-VALUE AND IS-LV DISPLAY "LOW-VALUE OK" ELSE @@ -15504,7 +15502,7 @@ AT_DATA([prog4.cob], [ 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: 000 HIGH-VALUE: 159 LOW-VALUE OK HIGH-VALUE OK X > LOW-VALUE @@ -15522,19 +15520,17 @@ AT_DATA([prog5.cob], [ 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. + 88 IS-LV VALUE LOW-VALUE. + 01 LV-VAL REDEFINES LV BINARY-CHAR UNSIGNED. 01 HV PIC X. - 88 IS-HV VALUE HIGH-VALUE. + 88 IS-HV VALUE HIGH-VALUE. + 01 HV-VAL REDEFINES HV BINARY-CHAR UNSIGNED. 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. + DISPLAY "P1 LOW-VALUE: " LV-VAL + " HIGH-VALUE: " HV-VAL. IF LV = LOW-VALUE AND IS-LV DISPLAY "LOW-VALUE OK" ELSE @@ -15568,19 +15564,17 @@ AT_DATA([prog5.cob], [ 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. + 88 IS-LV VALUE LOW-VALUE. + 01 LV-VAL REDEFINES LV BINARY-CHAR UNSIGNED. 01 HV PIC X. - 88 IS-HV VALUE HIGH-VALUE. + 88 IS-HV VALUE HIGH-VALUE. + 01 HV-VAL REDEFINES HV BINARY-CHAR UNSIGNED. 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. + DISPLAY "P2 LOW-VALUE: " LV-VAL + " HIGH-VALUE: " HV-VAL. IF LV = LOW-VALUE AND IS-LV DISPLAY "LOW-VALUE OK" ELSE @@ -15607,12 +15601,12 @@ AT_DATA([prog5.cob], [ AT_CHECK([$COMPILE -febcdic-table=ebcdic500_latin1 prog5.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog5], [0], -[P1 LOW-VALUE: 001 HIGH-VALUE: 160 +[P1 LOW-VALUE: 000 HIGH-VALUE: 159 LOW-VALUE OK HIGH-VALUE OK X > LOW-VALUE X < HIGH-VALUE -P2 LOW-VALUE: 001 HIGH-VALUE: 256 +P2 LOW-VALUE: 000 HIGH-VALUE: 255 LOW-VALUE OK HIGH-VALUE OK X > LOW-VALUE 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