Skip to content

Commit

Permalink
Fixes for bug reported under MSVC Debug
Browse files Browse the repository at this point in the history
  • Loading branch information
@ddeclerck
ddeclerck committed Aug 28, 2024
1 parent 2ed1057 commit 8ae65ac
Show file tree
Hide file tree
Showing 7 changed files with 71 additions and 87 deletions.
48 changes: 7 additions & 41 deletions .github/workflows/windows-msvc.yml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -160,53 +160,19 @@ jobs:
cd tests
sed -i '/AT_SETUP(\[runtime check: write to internal storage (1)\])/a AT_SKIP_IF(\[true\])' testsuite.src/run_misc.at
# Skip two tests that behave differently (fail or hand) 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: |
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)
sed -i '/AT_SETUP(\[PROGRAM COLLATING SEQUENCE\])/a AT_SKIP_IF(\[true\])' testsuite.src/syn_definition.at
- name: Build testsuite
shell: C:\shells\msys2bash.cmd {0}
Expand Down
9 changes: 7 additions & 2 deletions cobc/ChangeLog
View file
Original file line number Diff line number Diff line change
@@ -1,17 +1,22 @@

2024-08-28 David Declerck <[email protected]>

* tree.c (char_to_precedence_idx, get_char_type_description, valid_char_order):
adjusted size of precedence table and gave proper precedence to U

2024-08-06 Simon Sobisch <[email protected]>

* codegen.c (output_alphabet_name_definition): cater for national alphabet
* typeck.c (validate_alphabet): speedup for alphabet checks
* pplex.l (ppopen_get_file): explicit check for UTF16/UTF32 and
hint to use iconv

2024-08-05 Simon Sobisch <[email protected]>

* typeck.c (validate_alphabet), tree.h (cb_alphabet_name): cater for
national alphabets with increased size (max. 65535 instead of 255)
* typeck.c (validate_alphabet): check that alphabet and literal types match

2024-07-29 Chuck Haatvedt <[email protected]>

* tree.c (cb_build_picture): added logic to find the valid floating
Expand Down
71 changes: 36 additions & 35 deletions cobc/tree.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 U N E
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
Expand Down Expand Up @@ -3043,13 +3043,13 @@ char_to_precedence_idx (const cob_pic_symbol *str,
case '1':
return 22;

case 'N':
case 'U':
return 23;

case 'E':
case 'N':
return 24;

case 'U':
case 'E':
return 25;

default:
Expand Down Expand Up @@ -3140,11 +3140,11 @@ get_char_type_description (const int idx)
case 22:
return "1";
case 23:
return "N";
return "U";
case 24:
return "E";
return "N";
case 25:
return "U";
return "E";
default:
return NULL;
}
Expand Down Expand Up @@ -3180,35 +3180,36 @@ valid_char_order (const cob_pic_symbol *str, const int s_char_seen, const unsign
manual.
*/
/*
B , . + + + CR cs cs Z Z + + cs cs 9 A L S V P P 1 N E
B , . + + + CR cs cs Z Z + + cs cs 9 A L S V P P 1 U N E
0 - - DB * * - - X
/
*/
{ 1, 1, 1, 0, 1, 0, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 0, 1, 0, 1, 0 },
{ 1, 1, 1, 0, 1, 0, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0 },
{ 1, 1, 0, 0, 1, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0 },
{ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1 },
{ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 },
{ 1, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 1, 1, 1, 0, 0, 0, 1, 1, 1, 0, 0, 0 },
{ 1, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 1, 1, 1, 0, 0, 0, 1, 1, 1, 0, 0, 0 },
{ 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 },
{ 1, 1, 1, 0, 1, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 1, 0, 0, 0 },
{ 1, 1, 0, 0, 1, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 },
{ 1, 1, 1, 0, 1, 0, 0, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0 },
{ 1, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 },
{ 1, 1, 1, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0 },
{ 1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 },
{ 1, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0 },
{ 1, 1, 1, 1, 1, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 0, 1, 0, 0, 1 },
{ 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0 },
{ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 },
{ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 },
{ 1, 1, 0, 0, 1, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, 0, 0, 0 },
{ 1, 1, 0, 0, 1, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, 0, 0, 0 },
{ 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0 },
{ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0 },
{ 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0 },
{ 1, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0 },
{ 1, 1, 1, 0, 1, 0, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 0, 1, 0, 0, 1, 0 },
{ 1, 1, 1, 0, 1, 0, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0 },
{ 1, 1, 0, 0, 1, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 },
{ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1 },
{ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 },
{ 1, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 1, 1, 1, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0 },
{ 1, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 1, 1, 1, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0 },
{ 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 },
{ 1, 1, 1, 0, 1, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0 },
{ 1, 1, 0, 0, 1, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 },
{ 1, 1, 1, 0, 1, 0, 0, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0 },
{ 1, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 },
{ 1, 1, 1, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0 },
{ 1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 },
{ 1, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0 },
{ 1, 1, 1, 1, 1, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 0, 1, 0, 0, 0, 1 },
{ 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0 },
{ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 },
{ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 },
{ 1, 1, 0, 0, 1, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0 },
{ 1, 1, 0, 0, 1, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0 },
{ 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, 0 },
{ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0 },
{ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0 },
{ 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0 },
{ 1, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 },
};
int error_emitted[CB_PIC_CHAR_TYPES][CB_PIC_CHAR_TYPES] = {{ 0 }};
int chars_seen[CB_PIC_CHAR_TYPES] = { 0 };
Expand Down
6 changes: 6 additions & 0 deletions libcob/ChangeLog
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,10 @@

2024-08-28 David Declerck <[email protected]>

* intrinsics.c (cob_intr_random), move.c (cob_move_display_to_packed):
make casts with loss of data explicit using masking to silence
the MSVC runtime error checker

2024-08-22 David Declerck <[email protected]>

* common.c (DllMain) [_MSC_VER]: added calls to _CrtSetReportMode
Expand Down
18 changes: 11 additions & 7 deletions libcob/intrinsic.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5462,11 +5462,7 @@ cob_intr_random (const int params, ...)
cob_field *f;
va_list args;
double val;
#ifdef DISABLE_GMP_RANDOM
unsigned int seed = 0;
#else
unsigned long seed = 0;
#endif
unsigned long seed = 0;
cob_field_attr attr;
cob_field field;

Expand All @@ -5478,7 +5474,11 @@ cob_intr_random (const int params, ...)
if (specified_seed < 0) {
cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
} else {
#ifdef _WIN32
seed = (unsigned long)(specified_seed & 0xFFFFFFFF);
#else
seed = (unsigned long)specified_seed;
#endif
}
rand_needs_seeding++;
#ifdef DISABLE_GMP_RANDOM
Expand All @@ -5490,8 +5490,12 @@ cob_intr_random (const int params, ...)
note: we need an explicit integer cast to get around some warnings,
but then need a matching size to get around others...*/
#ifdef COB_64_BIT_POINTER
seed = get_seconds_past_midnight ()
* (((cob_s64_t)COB_MODULE_PTR) & 0xFFFFF);
seed = (get_seconds_past_midnight ()
#ifdef _WIN32
* (((cob_s64_t)COB_MODULE_PTR) & 0xFFFFF)) & 0xFFFFFFFF;
#else
* (((cob_s64_t)COB_MODULE_PTR) & 0xFFFFF));
#endif
#else
seed = get_seconds_past_midnight ()
* (((cob_s32_t)COB_MODULE_PTR) & 0xFFFF);
Expand Down
4 changes: 2 additions & 2 deletions libcob/move.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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) & 0xF0) /* -> dropping the higher bits = no use in COB_D2I */
+ COB_D2I (*(p + 1));
p = p + 2;
q++;
Expand All @@ -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);
}

COB_PUT_SIGN_ADJUSTED (f1, sign);
Expand Down
2 changes: 2 additions & 0 deletions tests/testsuite.src/run_misc.at
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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);
Expand Down Expand Up @@ -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);
Expand Down

0 comments on commit 8ae65ac

Please sign in to comment.