diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 61f1ceae4..d7e478ab4 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -1,4 +1,23 @@ +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 7b5f30bbd..88d003120 100644 --- a/cobc/cobc.h +++ b/cobc/cobc.h @@ -620,6 +620,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 c7dd66d17..8e8fb48e2 100644 --- a/cobc/codegen.c +++ b/cobc/codegen.c @@ -2512,11 +2512,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"); } } @@ -2524,11 +2524,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"); } } @@ -2612,8 +2612,6 @@ output_literals_figuratives_and_constants (void) if (gen_figurative) { output_newline (); - output_low_value (); - output_high_value (); output_quote (); output_space (); output_zero (); @@ -2651,16 +2649,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) { @@ -4274,9 +4266,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 { @@ -5007,10 +4999,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) { @@ -10723,9 +10715,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; @@ -14014,6 +14006,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 2502e3a8f..a861236dd 100644 --- a/cobc/tree.c +++ b/cobc/tree.c @@ -2193,6 +2193,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 f9302a2ec..85c2ba249 100644 --- a/cobc/tree.h +++ b/cobc/tree.h @@ -1901,6 +1901,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 7ca5db3f7..f626f1900 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 */ @@ -3804,8 +3735,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; @@ -3819,17 +3763,33 @@ cb_validate_collating (cb_tree collating_sequence) cb_name (collating_sequence)); return 1; } + +#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 + if (CB_ALPHABET_NAME (x)->alphabet_type != CB_ALPHABET_CUSTOM) { 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)->data[0] = prog->low_value = (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)->data[0] = prog->high_value = (unsigned char)CB_ALPHABET_NAME (x)->high_val_char; CB_LITERAL(cb_high)->all = 1; } return 0; @@ -3854,8 +3814,9 @@ validate_alphabet (cb_tree alphabet) if (ap->alphabet_type == CB_ALPHABET_ASCII) { for (n = 0; n < 256; n++) { #ifdef COB_EBCDIC_MACHINE - ap->values[n] = (int)cob_refer_ascii[n]; - ap->alphachr[n] = (int)cob_refer_ascii[n]; + load_collating_tables (); + ap->values[n] = (int)ascii_to_ebcdic[n]; + ap->alphachr[n] = (int)ascii_to_ebcdic[n]; #else ap->values[n] = n; ap->alphachr[n] = n; @@ -3871,8 +3832,9 @@ validate_alphabet (cb_tree alphabet) ap->values[n] = n; ap->alphachr[n] = n; #else - ap->values[n] = (int)cob_refer_ebcdic[n]; - ap->alphachr[n] = (int)cob_refer_ebcdic[n]; + load_collating_tables (); + ap->values[n] = (int)ebcdic_to_ascii[n]; + ap->alphachr[n] = (int)ebcdic_to_ascii[n]; #endif } return; @@ -4241,10 +4203,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 5f7f8b9ea..41c9d0d9d 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -1,4 +1,10 @@ +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 ef61e56c2..f77688a87 100644 --- a/libcob/strings.c +++ b/libcob/strings.c @@ -101,6 +101,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) { @@ -424,9 +434,11 @@ inspect_common (cob_field *f1, cob_field *f2, const enum inspect_type type) } if (unlikely (!f1)) { + cob_update_low_value (); f1 = &str_cob_low; } if (unlikely (!f2)) { + cob_update_low_value (); f2 = &str_cob_low; } @@ -650,9 +662,11 @@ cob_inspect_converting (const cob_field *f1, const cob_field *f2) } 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 18b32583d..00e3f7f2f 100644 --- a/tests/testsuite.src/run_misc.at +++ b/tests/testsuite.src/run_misc.at @@ -14631,3 +14631,189 @@ AT_DATA([prog.cob], [ AT_CHECK([$COMPILE_MODULE prog.cob], [0], [], []) AT_CHECK([$COBCRUN prog], [0], [OKOKOKOKOK], []) 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 PIC 999. + 01 HV PIC 999. + PROCEDURE DIVISION. + MOVE FUNCTION ORD (LOW-VALUE) TO LV. + MOVE FUNCTION ORD (HIGH-VALUE) TO HV. + DISPLAY "LOW-VALUE: " LV + " HIGH-VALUE: " HV WITH NO ADVANCING. + STOP RUN. +]) + +AT_CHECK([$COMPILE prog1.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog1], [0], [LOW-VALUE: 064 HIGH-VALUE: 193], []) + +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 PIC 999. + 01 HV PIC 999. + PROCEDURE DIVISION. + MOVE FUNCTION ORD (LOW-VALUE) TO LV. + MOVE FUNCTION ORD (HIGH-VALUE) TO HV. + DISPLAY "LOW-VALUE: " LV + " HIGH-VALUE: " HV WITH NO ADVANCING. + STOP RUN. +]) + +AT_CHECK([$COMPILE prog2.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], [LOW-VALUE: 065 HIGH-VALUE: 256], []) + +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 PIC 999. + 01 HV PIC 999. + PROCEDURE DIVISION. + MOVE FUNCTION ORD (LOW-VALUE) TO LV. + MOVE FUNCTION ORD (HIGH-VALUE) TO HV. + DISPLAY "LOW-VALUE: " LV + " HIGH-VALUE: " HV WITH NO ADVANCING. + STOP RUN. +]) + +AT_CHECK([$COMPILE -febcdic-table=ebcdic500_latin1 prog3.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog3], [0], [LOW-VALUE: 001 HIGH-VALUE: 160], []) + +AT_DATA([prog4.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 LV PIC 999. + 01 HV PIC 999. + PROCEDURE DIVISION. + MOVE FUNCTION ORD (LOW-VALUE) TO LV. + MOVE FUNCTION ORD (HIGH-VALUE) TO HV. + DISPLAY "LOW-VALUE: " LV + " HIGH-VALUE: " HV WITH NO ADVANCING. + 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], []) + +AT_DATA([prog5.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. + PROCEDURE DIVISION. + IF "X" < HIGH-VALUE + DISPLAY "X < HIGH-VALUE" WITH NO ADVANCING + ELSE + DISPLAY "X > HIGH-VALUE" WITH NO ADVANCING + END-IF. + STOP RUN. +]) + +AT_CHECK([$COMPILE -febcdic-table=ebcdic500_latin1 prog5.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog5], [0], [X < HIGH-VALUE], []) + +AT_DATA([prog6.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + PROCEDURE DIVISION. + IF "X" < HIGH-VALUE + DISPLAY "X < HIGH-VALUE" WITH NO ADVANCING + ELSE + DISPLAY "X > HIGH-VALUE" WITH NO ADVANCING + END-IF. + STOP RUN. +]) + +AT_CHECK([$COMPILE -fdefault-colseq=EBCDIC -febcdic-table=ebcdic500_latin1 prog6.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog6], [0], [X < HIGH-VALUE], []) + +AT_DATA([prog7.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 PIC 999. + 01 HV PIC 999. + PROCEDURE DIVISION. + MOVE FUNCTION ORD (LOW-VALUE) TO LV. + MOVE FUNCTION ORD (HIGH-VALUE) TO HV. + DISPLAY "P1 LOW-VALUE: " LV + " HIGH-VALUE: " HV. + 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 PIC 999. + 01 HV PIC 999. + PROCEDURE DIVISION. + MOVE FUNCTION ORD (LOW-VALUE) TO LV. + MOVE FUNCTION ORD (HIGH-VALUE) TO HV. + DISPLAY "P2 LOW-VALUE: " LV + " HIGH-VALUE: " HV WITH NO ADVANCING. + STOP RUN. + END PROGRAM prog2. +]) + +AT_CHECK([$COMPILE -save-temps -febcdic-table=ebcdic500_latin1 prog7.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog7], [0], +[P1 LOW-VALUE: 001 HIGH-VALUE: 160 +P2 LOW-VALUE: 001 HIGH-VALUE: 256], []) + +AT_CLEANUP