From 35e65ee0a5c0529645343cf4ceb00e9c16c88a21 Mon Sep 17 00:00:00 2001
From: David Declerck <david.declerck@ocamlpro.com>
Date: Fri, 23 Aug 2024 14:41:55 +0200
Subject: [PATCH] Fixes for bug reported under MSVC Debug

---
 .github/workflows/windows-msvc.yml | 42 +-----------------
 cobc/tree.c                        | 71 +++++++++++++++---------------
 libcob/intrinsic.c                 |  4 ++
 libcob/move.c                      |  4 +-
 tests/testsuite.src/run_misc.at    |  2 +
 5 files changed, 45 insertions(+), 78 deletions(-)

diff --git a/.github/workflows/windows-msvc.yml b/.github/workflows/windows-msvc.yml
index 0bf82e5a4..90e64d750 100644
--- a/.github/workflows/windows-msvc.yml
+++ b/.github/workflows/windows-msvc.yml
@@ -165,48 +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)
+          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}
diff --git a/cobc/tree.c b/cobc/tree.c
index 5fc7c92e2..cb49c88c8 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  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
@@ -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:
@@ -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;
 	}
@@ -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 };
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..053bbf246 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) & 0xF0)  /* -> 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);
 	}
 
 	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);