Win32 fixes, mostly testcases

OCamlPro · May 5, 2024 · ed789c8 · ed789c8
1 parent 7c60012
commit ed789c8
Show file tree

Hide file tree

Showing 8 changed files with 163 additions and 94 deletions.
diff --git a/cobc/error.c b/cobc/error.c
@@ -74,19 +74,19 @@ print_error_prefix (const char *file, int line, const char *prefix)
 		 && file[0] != '\\'
 		 && file[1] != ':'){
 			int filelen = strlen (file);
-			int dirlen = 256;
-			char *cwd ;
-			absfile = cobc_malloc( dirlen + 1 + filelen + 1 );
+			int dirlen = COB_MINI_BUFF;
+			char *cwd;
+			absfile = cobc_malloc (dirlen + 1 + filelen + 1);
 			cwd = getcwd (absfile, dirlen);
 			if (cwd != NULL ){
 #ifdef HAVE_SYS_STAT_H
 				struct stat st;
 #endif
 				dirlen = strlen (cwd);
-				absfile[dirlen] = '/';
-				memcpy (absfile+dirlen+1, file, filelen+1);
+				absfile[dirlen] = SLASH_CHAR;
+				memcpy (absfile + dirlen + 1, file, filelen + 1);
 #ifdef HAVE_SYS_STAT_H
-				if (!stat (absfile,&st))
+				if (!stat (absfile, &st))
 #endif
 				{
 					file = absfile;

diff --git a/libcob/common.c b/libcob/common.c
@@ -1,5 +1,5 @@
 /*
-   Copyright (C) 2001-2012, 2014-2023 Free Software Foundation, Inc.
+   Copyright (C) 2001-2012, 2014-2024 Free Software Foundation, Inc.
    Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman
 
    This file is part of GnuCOBOL.
@@ -21,6 +21,14 @@
 #include "tarstamp.h"
 #include "config.h"
 
+#ifdef __MINGW32__
+/* Is this needed for other environments as well?
+   We want to use all POSIX extensions possible. */
+#ifndef _POSIX_C_SOURCE
+#define _POSIX_C_SOURCE 200112
+#endif
+#endif
+
 #include <stdio.h>
 #include <stdlib.h>
 #include <stddef.h>

diff --git a/libcob/fileio.c b/libcob/fileio.c
@@ -913,7 +913,7 @@ bdb_close_index (cob_file *f, int index)
 
 static int
 bdb_bt_compare (DB *db, const DBT *k1, const DBT *k2
-#if DB_VERSION_MAJOR >= 12 /* ABI break in BDB 12...) */
+#if DB_VERSION_MAJOR >= 6 /* ABI break in DB_VERSION_FAMILY 12 ... */
                 , size_t *locp
 #endif
 )
@@ -927,8 +927,8 @@ bdb_bt_compare (DB *db, const DBT *k1, const DBT *k2
 		cob_runtime_error ("bdb_bt_compare was given keys of different length");
 	}
 	/* LCOV_EXCL_STOP */
-#if DB_VERSION_MAJOR >= 12
-	locp = NULL;	/* docs: must be set to NULL or corruption can occur ...  */
+#if DB_VERSION_MAJOR >= 6
+	locp = NULL;	/* docs: must be set to NULL or corruption can occur ... */
 #endif
 	return indexed_key_compare (k1->data, k2->data, k2->size, col);
 }

diff --git a/tests/atlocal.in b/tests/atlocal.in
@@ -197,7 +197,11 @@ _unset_option () {
 # that doesn't match the one where the tested binaries were built
 # Note: not needed for running the testsuite with MSYS as this translates the path
 _return_path () {
-	echo "$1"
+	if test "x$MSYSTEM" = x; then
+		echo "$1"
+	else
+		cmd //c echo "$1" # note: we want forward slashes here | $SED 's|/|\\|g'
+	fi
 }
 
 # ensure we don't execute windows paths within programs generated by cygwin

diff --git a/tests/testsuite.src/run_extensions.at b/tests/testsuite.src/run_extensions.at
@@ -1,4 +1,4 @@
-## Copyright (C) 2003-2012, 2014-2023 Free Software Foundation, Inc.
+## Copyright (C) 2003-2012, 2014-2024 Free Software Foundation, Inc.
 ## Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart,
 ## Ron Norman
 ##
@@ -2220,6 +2220,9 @@ AT_CHECK([$COBCRUN_DIRECT ./caller], [0],
 +000000004
 ], [])
 
+# same name sometimes leads to locks - especially on Win32
+AT_CHECK([mv callee.$COB_MODULE_EXT callee.old.$COB_MODULE_EXT])
+
 # no argument check leads to only check on use
 AT_CHECK([$COMPILE_MODULE -fno-ec=program-arg-mismatch callee.cob], [0], [], [])
 AT_CHECK([$COBCRUN_DIRECT ./caller], [0],
@@ -2231,6 +2234,8 @@ AT_CHECK([$COBCRUN_DIRECT ./caller], [0],
 +000000004
 ], [])
 
+AT_CHECK([mv callee.$COB_MODULE_EXT callee.nocheck.$COB_MODULE_EXT])
+
 # sticky linkage leads to only check on use
 AT_CHECK([$COMPILE_MODULE -fsticky-linkage callee.cob], [0], [], [])
 AT_CHECK([$COBCRUN_DIRECT ./caller], [0],
@@ -2242,6 +2247,8 @@ AT_CHECK([$COBCRUN_DIRECT ./caller], [0],
 +000000004
 ], [])
 
+AT_CHECK([mv callee.$COB_MODULE_EXT callee.stick.$COB_MODULE_EXT])
+
 AT_CHECK([$COMPILE_MODULE callee.cob], [0], [], [])
 AT_CHECK([$COBCRUN_DIRECT ./caller], [1], [],
 [libcob: callee.cob:12: error: LINKAGE item X not passed by caller
@@ -2641,6 +2648,10 @@ AT_CHECK([$COBCRUN_DIRECT ./caller], [0],
 [Hello, COBOL!
 Bye, COBOL-ENTRY!
 ])
+
+# same name sometimes leads to locks - especially on Win32
+AT_CHECK([mv hello.$COB_MODULE_EXT hello.old.$COB_MODULE_EXT])
+
 # no difference expected with sticky linkage (but other codegen)
 AT_CHECK([$COMPILE_MODULE -fentry-statement=ok -fsticky-linkage hello.cob], [0], [], [])
 AT_CHECK([$COBCRUN_DIRECT ./caller], [0],

diff --git a/tests/testsuite.src/run_file.at b/tests/testsuite.src/run_file.at
@@ -46,10 +46,11 @@ AT_DATA([prog.cob], [
        WORKING-STORAGE SECTION.
        01  WSFS              PIC X(2).
        PROCEDURE DIVISION.
-      *
+       OUT.
            OPEN EXTEND FILE-OPT
            IF WSFS NOT = "05"
-              DISPLAY "STATUS EXTEND, missing optional file:" WSFS.
+              DISPLAY "STATUS EXTEND, missing optional file:" WSFS
+              IF WSFS (1:1) NOT = "0" GO TO INP.
            MOVE ALL "A" TO FOREC
            WRITE FOREC
            IF WSFS NOT = "00"
@@ -64,19 +65,22 @@ AT_DATA([prog.cob], [
            WRITE F0REC
            IF WSFS NOT = "00"
               DISPLAY "STATUS WRITE B:" WSFS.
-           CLOSE FILE0
+           CLOSE FILE0.
       *
+       INP.
            OPEN INPUT FILE-OPT
            IF WSFS NOT = "00"
-              DISPLAY "STATUS INPUT:" WSFS.
+              DISPLAY "STATUS INPUT:" WSFS
+              IF WSFS (1:1) NOT = "0" GO TO EX.
            READ FILE-OPT NEXT
            IF WSFS NOT = "00"
               DISPLAY "STATUS READ A:" WSFS.
            READ FILE-OPT NEXT
            IF WSFS NOT = "00"
               DISPLAY "STATUS READ B:" WSFS.
-           CLOSE FILE-OPT
+           CLOSE FILE-OPT.
       *
+       EX.
            STOP RUN.
 ])
 
@@ -110,32 +114,37 @@ AT_DATA([prog.cob], [
        WORKING-STORAGE SECTION.
        01  WSFS              PIC X(2).
        PROCEDURE DIVISION.
-      *
+       OUT.
            OPEN OUTPUT FILE-TBL
            IF WSFS NOT = "00"
-              DISPLAY "STATUS OPEN OUTPUT:" WSFS.
+              DISPLAY "STATUS OPEN OUTPUT:" WSFS
+              IF WSFS (1:1) NOT = "0" GO TO INP.
            MOVE ALL "A" TO FOREC
            WRITE FOREC
            IF WSFS NOT = "00"
               DISPLAY "STATUS WRITE A:" WSFS.
            CLOSE FILE-TBL WITH LOCK
            IF WSFS NOT = "00"
               DISPLAY "STATUS CLOSE WITH LOCK:" WSFS.
+       INP.
            OPEN INPUT FILE-TBL
            IF WSFS NOT = "38"
               DISPLAY "STATUS INPUT after CLOSE LOCK:" WSFS.
            CLOSE FILE-TBL
            IF WSFS NOT = "42"
               DISPLAY "STATUS CLOSE non-opened:" WSFS.
       *
+       DEL.
       *    Note: MicroFocus _does_ delete the file and returns status 00 here
            DELETE FILE FILE-TBL
            IF WSFS NOT = "38"
               DISPLAY "STATUS DELETE FILE after CLOSE LOCK:" WSFS.
       *
+       INP2.
            OPEN INPUT FILE0
            IF WSFS NOT = "00"
-              DISPLAY "STATUS INPUT separate file:" WSFS.
+              DISPLAY "STATUS INPUT separate file:" WSFS
+              IF WSFS (1:1) NOT = "0" GO TO EX.
            READ FILE0 NEXT
            IF WSFS NOT = "00"
               DISPLAY "STATUS READ A:" WSFS.
@@ -145,6 +154,7 @@ AT_DATA([prog.cob], [
            IF WSFS NOT = "00"
               DISPLAY "STATUS CLOSE:" WSFS.
       *
+       EX.
            STOP RUN.
 ])
 
@@ -173,10 +183,11 @@ AT_DATA([prog.cob], [
        WORKING-STORAGE SECTION.
        01  WSFS              PIC X(2).
        PROCEDURE DIVISION.
-      *
+       MAIN.
            OPEN OUTPUT FILE-TBL
            IF WSFS NOT = "00"
-              DISPLAY "STATUS OPEN OUTPUT:" WSFS.
+              DISPLAY "STATUS OPEN OUTPUT:" WSFS
+              IF WSFS (1:1) NOT = "0" GOBACK.
            MOVE ALL "A" TO FOREC
            WRITE FOREC
            IF WSFS NOT = "00"
@@ -1190,7 +1201,7 @@ AT_DATA([prog.cob], [
        SELECT test-file ASSIGN path
                         ORGANIZATION LINE SEQUENTIAL.
        DATA             DIVISION.
-       FILE	            SECTION.
+       FILE             SECTION.
        FD  test-file.
        01  test-rec     PIC X(5).
        LOCAL-STORAGE    SECTION.
@@ -1230,7 +1241,7 @@ AT_DATA([prog.cob], [
        SELECT test-file ASSIGN path
                         ORGANIZATION LINE SEQUENTIAL.
        DATA             DIVISION.
-       FILE	            SECTION.
+       FILE             SECTION.
        FD  test-file.
        01  test-rec     PIC X(5).
        LOCAL-STORAGE    SECTION.
@@ -1267,7 +1278,7 @@ AT_DATA([prog.cob], [
        SELECT test-file ASSIGN path
                         ORGANIZATION LINE SEQUENTIAL.
        DATA             DIVISION.
-       FILE	            SECTION.
+       FILE             SECTION.
        FD  test-file.
        01  test-rec     PIC X(5).
        WORKING-STORAGE  SECTION.
@@ -1300,7 +1311,7 @@ AT_DATA([prog2.cob], [
                         ORGANIZATION LINE SEQUENTIAL
                         FILE STATUS TEST-STAT.
        DATA             DIVISION.
-       FILE	            SECTION.
+       FILE             SECTION.
        FD  test-file.
        01  test-rec     PIC X(5).
        WORKING-STORAGE  SECTION.
@@ -1521,7 +1532,7 @@ AT_DATA([prog.cob], [
        SELECT test-file ASSIGN path
                         ORGANIZATION LINE SEQUENTIAL.
        DATA             DIVISION.
-       FILE	            SECTION.
+       FILE             SECTION.
        FD  test-file.
        01  test-rec     PIC X(5).
        WORKING-STORAGE  SECTION.
@@ -1561,7 +1572,7 @@ AT_DATA([prog.cob], [
        SELECT test-file ASSIGN fpath
                         ORGANIZATION LINE SEQUENTIAL.
        DATA             DIVISION.
-       FILE	            SECTION.
+       FILE             SECTION.
        FD  test-file.
        01  test-rec     PIC X(5).
        PROCEDURE        DIVISION.
@@ -2343,7 +2354,7 @@ AT_DATA([prog.cob], [
            record is varying in size
                from 107 to 362 characters
                depending on end-tbw-record
-	       .
+           .
        01  tbw-record.
            02 tbw-key                        pic x(100).
            02 tbw-alt.
@@ -14383,8 +14394,8 @@ AT_DATA([prog1.cob], [
        FD FILE2.
          01 FS-FILE2 PIC X(10).
        WORKING-STORAGE SECTION.
-	 01  STAT-FILE1               PIC XX.
-	 01  STAT-FILE2               PIC XX.
+       01  STAT-FILE1               PIC XX.
+       01  STAT-FILE2               PIC XX.
        PROCEDURE DIVISION.
        DECLARATIVES.
        F-FILE1 SECTION. USE AFTER ERROR PROCEDURE ON FILE1.
@@ -14401,7 +14412,7 @@ AT_DATA([prog1.cob], [
        PROGRAMME SECTION.
        MAIN.
           OPEN INPUT FILE1
-	  OPEN INPUT FILE2.
+          OPEN INPUT FILE2.
           DISPLAY "READ FILE1".
           READ FILE1.
           DISPLAY "READ FILE2".
@@ -14431,8 +14442,8 @@ AT_DATA([prog2.cob], [
        FD FILE2.
          01 FS-FILE2 PIC X(10).
        WORKING-STORAGE SECTION.
-	 01  STAT-FILE1               PIC XX.
-	 01  STAT-FILE2               PIC XX.
+       01  STAT-FILE1               PIC XX.
+       01  STAT-FILE2               PIC XX.
        PROCEDURE DIVISION.
        DECLARATIVES.
        F-FILE1 SECTION. USE AFTER ERROR PROCEDURE ON FILE1.
@@ -14449,7 +14460,7 @@ AT_DATA([prog2.cob], [
        PROGRAMME SECTION.
        MAIN.
           OPEN INPUT FILE1
-	             FILE2.
+                     FILE2.
           DISPLAY "READ FILE1".
           READ FILE1.
           DISPLAY "READ FILE2".