From 4cd723710460f529645ee7cdd140bb59cd6fb97d Mon Sep 17 00:00:00 2001 From: David Declerck Date: Fri, 23 Aug 2024 14:41:55 +0200 Subject: [PATCH] Fixes for bug reported under MSVC Debug --- .github/workflows/windows-msvc.yml | 41 ------------------------------ cobc/tree.c | 6 ++--- cobc/typeck.c | 4 +-- libcob/intrinsic.c | 4 +++ libcob/move.c | 4 +-- tests/testsuite.src/run_misc.at | 2 ++ 6 files changed, 13 insertions(+), 48 deletions(-) diff --git a/.github/workflows/windows-msvc.yml b/.github/workflows/windows-msvc.yml index 0bf82e5a4..8545ecd2e 100644 --- a/.github/workflows/windows-msvc.yml +++ b/.github/workflows/windows-msvc.yml @@ -165,49 +165,8 @@ jobs: shell: C:\shells\msys2bash.cmd {0} run: | cd tests - - sed -i '/AT_SETUP(\[MF FIGURATIVE to NUMERIC\])/a AT_SKIP_IF(\[true\])' testsuite.src/run_misc.at - sed -i '/AT_SETUP(\[Default file external name\])/a AT_SKIP_IF(\[true\])' testsuite.src/run_file.at - sed -i '/AT_SETUP(\[EXTFH: SEQUENTIAL files\])/a AT_SKIP_IF(\[true\])' testsuite.src/run_file.at sed -i '/AT_SETUP(\[System routine CBL_GC_HOSTED\])/a AT_SKIP_IF(\[true\])' testsuite.src/run_extensions.at - sed -i '/AT_SETUP(\[MOVE to edited item (4)\])/a AT_SKIP_IF(\[true\])' testsuite.src/run_fundamental.at - sed -i '/AT_SETUP(\[MOVE to item with simple and floating insertion\])/a AT_SKIP_IF(\[true\])' testsuite.src/run_fundamental.at - sed -i '/AT_SETUP(\[Numeric operations (1)\])/a AT_SKIP_IF(\[true\])' testsuite.src/run_fundamental.at - sed -i '/AT_SETUP(\[Numeric operations (3) PACKED-DECIMAL\])/a AT_SKIP_IF(\[true\])' testsuite.src/run_fundamental.at - sed -i '/AT_SETUP(\[DISPLAY with P fields\])/a AT_SKIP_IF(\[true\])' testsuite.src/run_fundamental.at - sed -i '/AT_SETUP(\[MOVE with de-editting to COMP-3\])/a AT_SKIP_IF(\[true\])' testsuite.src/run_fundamental.at - sed -i '/AT_SETUP(\[MOVE between USAGEs\])/a AT_SKIP_IF(\[true\])' testsuite.src/run_fundamental.at - sed -i '/AT_SETUP(\[Computing of different USAGEs w\/- decimal point\])/a AT_SKIP_IF(\[true\])' testsuite.src/run_misc.at - sed -i '/AT_SETUP(\[C-API (param based)\])/a AT_SKIP_IF(\[true\])' testsuite.src/run_misc.at - sed -i '/AT_SETUP(\[C-API (field based)\])/a AT_SKIP_IF(\[true\])' testsuite.src/run_misc.at - sed -i '/AT_SETUP(\[Default Arithmetic Test (2)\])/a AT_SKIP_IF(\[true\])' testsuite.src/run_misc.at - sed -i '/AT_SETUP(\[OSVS Arithmetic Test (2)\])/a AT_SKIP_IF(\[true\])' testsuite.src/run_misc.at - sed -i '/AT_SETUP(\[FUNCTION ACOS\])/a AT_SKIP_IF(\[true\])' testsuite.src/run_functions.at - sed -i '/AT_SETUP(\[FUNCTION ASIN\])/a AT_SKIP_IF(\[true\])' testsuite.src/run_functions.at - sed -i '/AT_SETUP(\[FUNCTION RANDOM\])/a AT_SKIP_IF(\[true\])' testsuite.src/run_functions.at - sed -i '/AT_SETUP(\[MOVE of non-integer to alphanumeric\])/a AT_SKIP_IF(\[true\])' testsuite.src/run_extensions.at - sed -i '/AT_SETUP(\[XML GENERATE trimming\])/a AT_SKIP_IF(\[true\])' testsuite.src/run_ml.at - sed -i '/AT_SETUP(\[JSON GENERATE trimming\])/a AT_SKIP_IF(\[true\])' testsuite.src/run_ml.at - sed -i '/AT_SETUP(\[MOVE PACKED-DECIMAL to BINARY\])/a AT_SKIP_IF(\[true\])' testsuite.src/data_binary.at - sed -i '/AT_SETUP(\[PACKED-DECIMAL dump\])/a AT_SKIP_IF(\[true\])' testsuite.src/data_packed.at - sed -i '/AT_SETUP(\[PACKED-DECIMAL used with MOVE\])/a AT_SKIP_IF(\[true\])' testsuite.src/data_packed.at - sed -i '/AT_SETUP(\[MOVE PACKED-DECIMAL to PACKED-DECIMAL\])/a AT_SKIP_IF(\[true\])' testsuite.src/data_packed.at - sed -i '/AT_SETUP(\[MOVE PACKED-DECIMAL to DISPLAY\])/a AT_SKIP_IF(\[true\])' testsuite.src/data_packed.at - sed -i '/AT_SETUP(\[MOVE DISPLAY to PACKED-DECIMAL\])/a AT_SKIP_IF(\[true\])' testsuite.src/data_packed.at - sed -i '/AT_SETUP(\[PACKED-DECIMAL comparison\])/a AT_SKIP_IF(\[true\])' testsuite.src/data_packed.at - sed -i '/AT_SETUP(\[COMP-6 comparison\])/a AT_SKIP_IF(\[true\])' testsuite.src/data_packed.at - sed -i '/AT_SETUP(\[COMP-3 vs. COMP-6 - BCD comparison\])/a AT_SKIP_IF(\[true\])' testsuite.src/data_packed.at - sed -i '/AT_SETUP(\[PPP COMP-3\])/a AT_SKIP_IF(\[true\])' testsuite.src/data_packed.at - sed -i '/AT_SETUP(\[PPP COMP-6\])/a AT_SKIP_IF(\[true\])' testsuite.src/data_packed.at - sed -i '/AT_SETUP(\[MOVE between several BCD fields\])/a AT_SKIP_IF(\[true\])' testsuite.src/data_packed.at - sed -i '/AT_SETUP(\[BCD ADD and SUBTRACT w\/o SIZE ERROR\])/a AT_SKIP_IF(\[true\])' testsuite.src/data_packed.at - sed -i '/AT_SETUP(\[BCD ADD and SUBTRACT, DEFAULT ROUNDING MODE\])/a AT_SKIP_IF(\[true\])' testsuite.src/data_packed.at - sed -i '/AT_SETUP(\[BCD ADD and SUBTRACT, all ROUNDED MODEs\])/a AT_SKIP_IF(\[true\])' testsuite.src/data_packed.at - sed -i '/AT_SETUP(\[CURRENCY SIGN WITH PICTURE SYMBOL\])/a AT_SKIP_IF(\[true\])' testsuite.src/run_misc.at - -# The tests in sed commands above randomly hang (under debug configurations) - - name: Build testsuite shell: C:\shells\msys2bash.cmd {0} run: | diff --git a/cobc/tree.c b/cobc/tree.c index 5fc7c92e2..fea7af69c 100644 --- a/cobc/tree.c +++ b/cobc/tree.c @@ -2940,14 +2940,14 @@ find_floating_insertion_str (const cob_pic_symbol *str, /* Number of character types in picture strings */ /* - The 25 character types are: - B , . + + + CR cs cs Z Z + + cs cs 9 A L S V P P 1 N E + The 26 character types are: + B , . + + + CR cs cs Z Z + + cs cs 9 A L S V P P 1 N E U 0 - - DB * * - - X / Duplicates indicate floating/non-floating insertion symbols and/or left/right of decimal point positon. */ -#define CB_PIC_CHAR_TYPES 25 +#define CB_PIC_CHAR_TYPES 26 #define CB_FIRST_NON_P_DIGIT_CHAR_TYPE 9 #define CB_LAST_NON_P_DIGIT_CHAR_TYPE 15 #define CB_PIC_S_CHAR_TYPE 18 diff --git a/cobc/typeck.c b/cobc/typeck.c index 1b2a5039a..b719c33bd 100644 --- a/cobc/typeck.c +++ b/cobc/typeck.c @@ -3817,12 +3817,12 @@ cb_validate_collating (cb_tree collating_sequence) } 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] = (unsigned char)(CB_ALPHABET_NAME (x)->low_val_char & 0xFF); 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] = (unsigned char)(CB_ALPHABET_NAME (x)->high_val_char & 0xFF); CB_LITERAL(cb_high)->all = 1; } return 0; diff --git a/libcob/intrinsic.c b/libcob/intrinsic.c index e9c85c94a..29d64ccb3 100644 --- a/libcob/intrinsic.c +++ b/libcob/intrinsic.c @@ -5464,8 +5464,12 @@ cob_intr_random (const int params, ...) double val; #ifdef DISABLE_GMP_RANDOM unsigned int seed = 0; +#else +#ifdef _WIN32 + unsigned long long seed = 0; #else unsigned long seed = 0; +#endif #endif cob_field_attr attr; cob_field field; diff --git a/libcob/move.c b/libcob/move.c index 795ce7846..a2853f6f1 100644 --- a/libcob/move.c +++ b/libcob/move.c @@ -630,7 +630,7 @@ cob_move_display_to_packed (cob_field *f1, cob_field *f2) while ((p < p_end) && (q <= q_end)) { - *q = (unsigned char) (*p << 4) /* -> dropping the higher bits = no use in COB_D2I */ + *q = (unsigned char) ((*p << 4) & 0xFF) /* -> dropping the higher bits = no use in COB_D2I */ + COB_D2I (*(p + 1)); p = p + 2; q++; @@ -644,7 +644,7 @@ cob_move_display_to_packed (cob_field *f1, cob_field *f2) if ((p == p_end) && (q <= q_end)) { - *q = (unsigned char) (*p << 4) & 0xF0; + *q = (unsigned char) (((*p << 4) & 0xF0) & 0xFF); } COB_PUT_SIGN_ADJUSTED (f1, sign); diff --git a/tests/testsuite.src/run_misc.at b/tests/testsuite.src/run_misc.at index 7ec0062f0..210a28758 100644 --- a/tests/testsuite.src/run_misc.at +++ b/tests/testsuite.src/run_misc.at @@ -11877,6 +11877,7 @@ CAPI (void *p1, ...) nargs = cob_get_num_params(); printf ("CAPI called with %d parameters\n",nargs); + fflush(stdout); for (k=1; k <= nargs; k++) { type = cob_get_param_type (k); digits = cob_get_param_digits (k); @@ -12112,6 +12113,7 @@ CAPI (void *p1, ...) nargs = cob_get_num_params(); printf ("CAPI called with %d parameters\n",nargs); + fflush(stdout); for (k=1; k <= nargs; k++) { cob_field *fld = cob_get_param_field (k, "CAPI"); type = cob_get_field_type (fld);