Merge SVN 3931

.gitignore

@@ -7,6 +7,7 @@
 
 .deps
 Makefile.in
+Makefile
 
 /aclocal.m4
 /aminclude_static.am

libcob/ChangeLog

@@ -1321,6 +1321,14 @@
 
 	* common.c (cob_check_version): support 3-part version strings
 
+2020-11-05  Simon Sobisch <[email protected]>
+
+	* fileio.c: initialize errno in all places where it is checked afterwards
+	* fileio.c [_WIN32]: implemented file locking via LockFileEx/UnlockFile
+	* common.c (cob_sys_waitpid) [_WIN32]: fixed logic error in #if, allowing
+	  the best process synchronization possible on that platform
+	* common.h [_MSC_VER]: removed unused global includes
+
 2020-11-01  Ron Norman <[email protected]>
 
 	* fsqlxfd.c: use cob_str_case_str instead of strcasestr

libcob/call.c

@@ -60,6 +60,7 @@ FILE *fmemopen (void *buf, size_t size, const char *mode);
 
 #define WIN32_LEAN_AND_MEAN
 #include <windows.h>
+#include <io.h>	/* for access */
 
 static HMODULE
 lt_dlopen (const char *x)

libcob/common.c

@@ -6677,7 +6677,7 @@ cob_sys_waitpid (const void *p_id)
 		*/
 #if defined (PROCESS_QUERY_LIMITED_INFORMATION)
 		process = OpenProcess (SYNCHRONIZE | PROCESS_QUERY_LIMITED_INFORMATION, FALSE, pid);
-#if !defined (_MSC_VER) || !COB_USE_VC2012_OR_GREATER /* only try a higher level if we possibly compile on XP/2003 */
+#if !defined (_MSC_VER) || COB_USE_VC2012_OR_GREATER /* only try a higher level if we possibly compile on XP/2003 */
 		/* TODO: check what happens on WinXP / 2003 as PROCESS_QUERY_LIMITED_INFORMATION isn't available there */
 		if (!process && GetLastError () == ERROR_ACCESS_DENIED) {
 			process = OpenProcess (SYNCHRONIZE | PROCESS_QUERY_INFORMATION, FALSE, pid);

libcob/common.h

@@ -280,9 +280,6 @@ typedef __mpz_struct mpz_t[1];
 #ifndef	_CRT_SECURE_NO_DEPRECATE
 #define _CRT_SECURE_NO_DEPRECATE	1
 #endif
-#include <malloc.h>
-#include <io.h>
-#include <fcntl.h>
 
 /* Disable certain warnings */
 /* Deprecated functions */

libcob/fbdb.c

@@ -1091,6 +1091,7 @@ ix_bdb_file_delete (cob_file_api *a, cob_file *f, char *filename)
 			snprintf (file_open_buff, (size_t)COB_FILE_MAX, "%s.%d", filename, (int)i);
 		}
 		file_open_buff[COB_FILE_MAX] = 0;
+		errno = 0;
 		unlink (file_open_buff);
 	}
 	return 0;

libcob/fileio.c

@@ -2808,6 +2808,7 @@ lock_record (cob_file *f, unsigned int recnum, int forwrite, int *errsts)
 	lck.l_whence = SEEK_SET;
 	lck.l_start = pos;
 	lck.l_len = rcsz;
+	errno = 0;
 	if (fcntl (f->fd, F_SETLK, &lck) != -1) {
 		*errsts = 0;
 		if(recnum == 0
@@ -2937,9 +2938,60 @@ unlock_record (cob_file *f, unsigned int recnum)
 	return 0;						/* Record is not locked! */
 }
 
+#elif defined _WIN32
+
+/*TODO: handle record-level locks*/
+static int
+lock_record(cob_file *f, unsigned int recnum, int forwrite, int *errsts)
+{
+	HANDLE osHandle;
+
+	COB_UNUSED (recnum);
+
+	f->blockpid = 0;
+	f->flag_file_lock = 1;
+
+	osHandle = (HANDLE)_get_osfhandle (f->fd);
+	if (osHandle != INVALID_HANDLE_VALUE) {
+		DWORD flags = LOCKFILE_FAIL_IMMEDIATELY;
+		OVERLAPPED fromStart = {0};
+		if (forwrite) flags |= LOCKFILE_EXCLUSIVE_LOCK;
+		if (LockFileEx (osHandle, flags, 0, MAXDWORD, MAXDWORD, &fromStart)) {
+			*errsts = 0;
+			return 1;
+		}
+	}
+
+	*errsts = EAGAIN; /*TODO: return actual error*/
+	return 0;
+}
+
+/*TODO: handle record-level locks*/
+static int
+unlock_record(cob_file *f, unsigned int recnum)
+{
+	HANDLE osHandle;
+
+	COB_UNUSED (recnum);
+
+	osHandle = (HANDLE)_get_osfhandle (f->fd);
+	if (osHandle != INVALID_HANDLE_VALUE) {
+		if (!UnlockFile (osHandle, 0, 0, MAXDWORD, MAXDWORD)) {
+#if 1 /* CHECKME - What is the correct thing to do here? */
+			/* not translated as "testing only" */
+			cob_runtime_warning ("issue during UnLockFile (%s), lastError: " CB_FMT_LLU,
+				"unlock_record", (cob_u64_t)GetLastError ());
+#endif
+			return 0;
+		}
+		return 1;
+	}
+
+	return 0;
+}
+
 #else
 	/* System does not even have 'fcntl' so no explicit Record/File lock is used */
-	/* TODO: check later for possible fall-back [at least WIN32]*/
 static int
 lock_record(cob_file *f, unsigned int recnum, int forwrite, int *errsts)
 {
@@ -4438,10 +4490,24 @@ cob_file_close (cob_file_api *a, cob_file *f, const int opt)
 			lock.l_whence = SEEK_SET;
 			lock.l_start = 0;
 			lock.l_len = 0;
+			errno = 0;
 			if (fcntl (f->fd, F_SETLK, &lock) == -1) {
 				cob_runtime_warning ("issue during unlock (%s), errno: %d", "cob_file_close", errno);
 			}
 		}
+#elif defined _WIN32
+		{
+			HANDLE osHandle = (HANDLE)_get_osfhandle (f->fd);
+			if (osHandle != INVALID_HANDLE_VALUE) {
+				if (!UnlockFile (osHandle, 0, 0, MAXDWORD, MAXDWORD)) {
+#if 1 /* CHECKME - What is the correct thing to do here? */
+					/* not translated as "testing only" */
+					cob_runtime_warning ("issue during UnLockFile (%s), lastError: " CB_FMT_LLU,
+						"cob_file_close", (cob_u64_t)GetLastError ());
+#endif
+				}
+			}
+		}
 #endif
 		/* Close the file */
 		if (f->organization == COB_ORG_LINE_SEQUENTIAL) {
@@ -5062,6 +5128,7 @@ lineseq_write (cob_file_api *a, cob_file *f, const int opt)
 				}
 			}
 			if (i < size) {
+				errno = 0;
 				ret = fwrite (&p[i],(int)size - i, 1, fo);
 				if (ret <= 0) {
 					return errno_cob_sts (COB_STATUS_30_PERMANENT_ERROR);
@@ -5077,6 +5144,7 @@ lineseq_write (cob_file_api *a, cob_file *f, const int opt)
 					}
 				}
 			}
+			errno = 0;
 			ret = fwrite (f->record->data, size, (size_t)1, fo);
 			/* LCOV_EXCL_START */
 			if (ret != 1) {
@@ -6043,6 +6111,19 @@ cob_file_unlock (cob_file *f)
 					}
 				}
 			}
+#elif defined _WIN32
+			{
+				HANDLE osHandle = (HANDLE)_get_osfhandle (f->fd);
+				if (osHandle != INVALID_HANDLE_VALUE) {
+					if (!UnlockFile (osHandle, 0, 0, MAXDWORD, MAXDWORD)) {
+#if 1 /* CHECKME - What is the correct thing to do here? */
+						/* not translated as "testing only" */
+						cob_runtime_warning ("issue during UnLockFile (%s), lastError: " CB_FMT_LLU,
+							"cob_file_unlock", (cob_u64_t)GetLastError());
+#endif
+					}
+				}
+			}
 #endif
 
 		} else {

libcob/focextfh.c

@@ -120,6 +120,7 @@ indexed_open (cob_file_api *a, cob_file *f, char *filename, const int mode, cons
 	switch (ret) {
 	case COB_NOT_CONFIGURED:
 		a->chk_file_mapping (f, NULL);
+		errno = 0;
 		if (access (filename, F_OK) && errno == ENOENT) {
 			if (mode != COB_OPEN_OUTPUT && f->flag_optional == 0) {
 				return COB_STATUS_35_NOT_EXISTS;
@@ -321,6 +322,7 @@ seqra_open (cob_file_api *a, cob_file *f, char *filename, const int mode, const
 	switch (ret) {
 	case COB_NOT_CONFIGURED:
 		a->chk_file_mapping (f, NULL);
+		errno = 0;
 		if (access (filename, F_OK) && errno == ENOENT) {
 			if (mode != COB_OPEN_OUTPUT && f->flag_optional == 0) {
 				return COB_STATUS_35_NOT_EXISTS;

libcob/fsqlxfd.c

@@ -56,7 +56,7 @@ cob_findkey_attr (cob_file *f, cob_field *kf, int *fullkeylen, int *partlen)
 				} else {
 					*partlen = *fullkeylen;
 				}
-				return k;
+				return (int)k;
 			}
 		}
 	}
@@ -104,7 +104,7 @@ db_savekey (cob_file *f, unsigned char *keyarea, unsigned char *record, int idx)
 		return totlen;
 	}
 	memcpy (keyarea, record + f->keys[idx].offset, f->keys[idx].field->size);
-	return f->keys[idx].field->size;
+	return (int)f->keys[idx].field->size;
 }
 
 /* Compare key for given index 'keyarea' to 'record'.

tests/ChangeLog

@@ -121,6 +121,14 @@
 
 	* atlocal.in, atlocal_valgrind: exec_prefix as exec_prefix
 
+2020-11-04  Simon Sobisch <[email protected]>
+
+	* atlocal.in, atlocal_valgrind, atlocal_win:
+	  fix unsetting of variables which values contain "COB";
+	  allow screenio-tests to be run on cygwin/msys with ncurses
+	  out-of-the box; fixed TEST_LOCAL (may not use pre-inst-env)
+	  and "external" versions with old indexed file msgid
+
 2020-10-26  Simon Sobisch <[email protected]>
 
 	* atlocal.in, atlocal_valgrind, atlocal_win:

tests/atlocal.in

@@ -223,7 +223,10 @@ else
 	fi
 	COB_HAS_64_BIT_POINTER=$(grep "64bit-mode" info.out | cut -d: -f2 | cut -b2-)
 
-	cob_indexed=$(grep -i "indexed file" info.out | cut -d: -f2)
+        cob_indexed=$(grep -i "indexed file" info.out | cut -d: -f2)
+	if test "x$cob_indexed" = "x"; then
+		cob_indexed=$(grep ISAM info.out | cut -d: -f2)
+	fi
 	case "$cob_indexed" in
 	" disabled")	COB_HAS_ISAM="no";;
 	" BDB") 		COB_HAS_ISAM="db";;

tests/atlocal_valgrind

@@ -222,7 +222,10 @@ else
 	fi
 	COB_HAS_64_BIT_POINTER=$(grep "64bit-mode" info.out | cut -d: -f2 | cut -b2-)
 
-	cob_indexed=$(grep -i "indexed file" info.out | cut -d: -f2)
+        cob_indexed=$(grep -i "indexed file" info.out | cut -d: -f2)
+	if test "x$cob_indexed" = "x"; then
+		cob_indexed=$(grep ISAM info.out | cut -d: -f2)
+	fi
 	case "$cob_indexed" in
 	" disabled")	COB_HAS_ISAM="no";;
 	" BDB") 		COB_HAS_ISAM="db";;
@@ -252,6 +255,29 @@ else
 	fi
 fi
 
+if test "x$MSYSTEM" != "x" -o "$OSTYPE" = "cygwin"; then
+	# running MSYS builds as not-visible child processes result in
+	# "Redirection is not supported" (at least with PDCurses "wincon" port)
+	# --> disabling the tests for this feature
+	# ncurses is known to work as long as TERM is appropriate
+	if test $(grep -i -c "ncurses" info.out) != 0; then
+		if test "x$MSYSTEM" != "x"; then
+			TERM=""
+		else
+			TERM="xterm"
+		fi
+		export TERM
+		# no change here... COB_HAS_CURSES="yes"
+	else
+		# manual tests are executed in separate window
+		# and are visible - so no need to handle it there
+		echo "$at_help_all" | grep -q "run_manual_screen" 2>/dev/null
+		if test $? -ne 0; then
+		   COB_HAS_CURSES="no"
+		fi
+	fi
+fi
+
 rm -rf info.out
 
 # NIST tests (tests/cobol85) are executed in a separate perl process with a new environment --> export needed

tests/atlocal_win

@@ -148,7 +148,10 @@ export COB_MSG_FORMAT
 	fi
 	COB_HAS_64_BIT_POINTER=$(grep "64bit-mode" info.out | cut -d: -f2 | cut -b2-)
 
-	cob_indexed=$(grep -i "indexed file" info.out | cut -d: -f2)
+        cob_indexed=$(grep -i "indexed file" info.out | cut -d: -f2)
+	if test "x$cob_indexed" = "x"; then
+		cob_indexed=$(grep ISAM info.out | cut -d: -f2)
+	fi
 	case "$cob_indexed" in
 	" disabled")	COB_HAS_ISAM="no";;
 	" BDB") 		COB_HAS_ISAM="db";;
@@ -177,10 +180,9 @@ export COB_MSG_FORMAT
 		COB_HAS_CURSES="no"
 	fi
 
-
 if test "x$MSYSTEM" != "x" -o "$OSTYPE" = "cygwin"; then
 	# running MSYS builds as not-visible child processes result in
-	# "Redirection is not supported" (at least old PDCurses)
+	# "Redirection is not supported" (at least with PDCurses "wincon" port)
 	# --> disabling the tests for this feature
 	# ncurses is known to work as long as TERM is appropriate
 	if test $(grep -i -c "ncurses" info.out) != 0; then

tests/testsuite.src/run_extensions.at

@@ -2907,9 +2907,11 @@ AT_CHECK([COB_FILE_PATH="tstdir/" $COBCRUN_DIRECT ./prog], [0], [], [])
 AT_CHECK([test -f "tstdir/FILENAMEX"], [0], [], [])
 
 # FIXME: on OPEN we should also output the full filename (if any) leading to the error
-AT_CHECK([COB_FILE_PATH="./nosubhere" $COBCRUN_DIRECT ./prog], [1], [],
+AT_CHECK([COB_FILE_PATH="./nosubhere" $COBCRUN_DIRECT ./prog 2>prog.err], [1], [], [])
+# workaround for testing windows-builds...
+AT_CHECK([cat prog.err | tr '\\' '/'], [0],
 [libcob: prog.cob:13: error: permanent file error (status = 30) for file TEST-FILE ('FILENAMEX' => ./nosubhere/FILENAMEX) on OPEN
-])
+], [])
 
 AT_CLEANUP