diff --git a/.gitignore b/.gitignore index 6f6278e4e..62dfb1c45 100644 --- a/.gitignore +++ b/.gitignore @@ -7,6 +7,7 @@ .deps Makefile.in +Makefile /aclocal.m4 /aminclude_static.am diff --git a/libcob/ChangeLog b/libcob/ChangeLog index b5bb0ab8c..60f5e044e 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -1321,6 +1321,14 @@ * common.c (cob_check_version): support 3-part version strings +2020-11-05 Simon Sobisch + + * 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 * fsqlxfd.c: use cob_str_case_str instead of strcasestr diff --git a/libcob/call.c b/libcob/call.c index 76534493c..d4eb5f89e 100644 --- a/libcob/call.c +++ b/libcob/call.c @@ -60,6 +60,7 @@ FILE *fmemopen (void *buf, size_t size, const char *mode); #define WIN32_LEAN_AND_MEAN #include +#include /* for access */ static HMODULE lt_dlopen (const char *x) diff --git a/libcob/common.c b/libcob/common.c index 08e8a2b17..62f11cb27 100644 --- a/libcob/common.c +++ b/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); diff --git a/libcob/common.h b/libcob/common.h index 2ae5954ee..fcbfc8ecf 100644 --- a/libcob/common.h +++ b/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 -#include -#include /* Disable certain warnings */ /* Deprecated functions */ diff --git a/libcob/fbdb.c b/libcob/fbdb.c index d89d8ebef..455dce5e2 100644 --- a/libcob/fbdb.c +++ b/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; diff --git a/libcob/fileio.c b/libcob/fileio.c index a09f47485..f565e1fa6 100644 --- a/libcob/fileio.c +++ b/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 { diff --git a/libcob/focextfh.c b/libcob/focextfh.c index 50ae091b2..934af6326 100644 --- a/libcob/focextfh.c +++ b/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; diff --git a/libcob/fsqlxfd.c b/libcob/fsqlxfd.c index 6659d93d6..2a186129b 100644 --- a/libcob/fsqlxfd.c +++ b/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'. diff --git a/tests/ChangeLog b/tests/ChangeLog index e059b7bab..35225c826 100644 --- a/tests/ChangeLog +++ b/tests/ChangeLog @@ -121,6 +121,14 @@ * atlocal.in, atlocal_valgrind: exec_prefix as exec_prefix +2020-11-04 Simon Sobisch + + * 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 * atlocal.in, atlocal_valgrind, atlocal_win: diff --git a/tests/atlocal.in b/tests/atlocal.in index db0496794..09ad64db7 100644 --- a/tests/atlocal.in +++ b/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";; diff --git a/tests/atlocal_valgrind b/tests/atlocal_valgrind index 19c80c547..11173ce5c 100644 --- a/tests/atlocal_valgrind +++ b/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 diff --git a/tests/atlocal_win b/tests/atlocal_win index 4b2b0fcef..13216460a 100644 --- a/tests/atlocal_win +++ b/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 diff --git a/tests/testsuite.src/run_extensions.at b/tests/testsuite.src/run_extensions.at index 153846bfa..90b1d72f9 100644 --- a/tests/testsuite.src/run_extensions.at +++ b/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 diff --git a/tests/testsuite.src/run_file.at b/tests/testsuite.src/run_file.at index d683b585e..58233082d 100644 --- a/tests/testsuite.src/run_file.at +++ b/tests/testsuite.src/run_file.at @@ -110,40 +110,40 @@ AT_DATA([prog.cob], [ * *> DELETE FILE FILE-OPT *> ON EXCEPTION - *> DISPLAY "STATUS DELETE FILE (missing) - EXCEPTION:" WSFS + *> DISPLAY "STATUS DELETE FILE (missing) - EXCEPTION: " WSFS *> END-DISPLAY *> NOT ON EXCEPTION *> IF WSFS NOT = "05" - *> DISPLAY "STATUS DELETE FILE (missing):" WSFS + *> DISPLAY "STATUS DELETE FILE (missing): " WSFS *> END-IF *> END-DELETE OPEN I-O FILE-OPT IF WSFS NOT = "05" - DISPLAY "STATUS I-O, missing optional file:" WSFS. + DISPLAY "STATUS I-O, missing optional file: " WSFS. CLOSE FILE-OPT IF WSFS NOT = "00" - DISPLAY "STATUS CLOSE:" WSFS. + DISPLAY "STATUS CLOSE: " WSFS. OPEN I-O FILE-OPT IF WSFS NOT = "00" - DISPLAY "STATUS I-O, empty file:" WSFS. + DISPLAY "STATUS I-O, empty file: " WSFS. DELETE FILE FILE-OPT *> ON EXCEPTION IF WSFS NOT = "41" - DISPLAY "STATUS DELETE FILE (OPENED):" WSFS + DISPLAY "STATUS DELETE FILE (opened): " WSFS END-IF *> NOT ON EXCEPTION - *> DISPLAY "STATUS DELETE FILE (OPENED) - NO EXCEPTION:" WSFS + *> DISPLAY "STATUS DELETE FILE (opened) - NO EXCEPTION: " WSFS *> END-DELETE CLOSE FILE-OPT IF WSFS NOT = "00" - DISPLAY "STATUS CLOSE #2:" WSFS. + DISPLAY "STATUS CLOSE #2: " WSFS. DELETE FILE FILE-OPT *> ON EXCEPTION - *> DISPLAY "STATUS DELETE FILE (closed) - EXCEPTION:" WSFS + *> DISPLAY "STATUS DELETE FILE (closed) - EXCEPTION: " WSFS *> END-DISPLAY *> NOT ON EXCEPTION IF WSFS NOT = "00" - DISPLAY "STATUS DELETE FILE (closed):" WSFS + DISPLAY "STATUS DELETE FILE (closed): " WSFS END-IF *> END-DELETE * @@ -291,40 +291,40 @@ AT_DATA([prog.cob], [ * *> DELETE FILE FILE-OPT *> ON EXCEPTION - *> DISPLAY "STATUS DELETE FILE (missing) - EXCEPTION:" WSFS + *> DISPLAY "STATUS DELETE FILE (missing) - EXCEPTION: " WSFS *> END-DISPLAY *> NOT ON EXCEPTION *> IF WSFS NOT = "05" - *> DISPLAY "STATUS DELETE FILE (missing):" WSFS + *> DISPLAY "STATUS DELETE FILE (missing): " WSFS *> END-IF *> END-DELETE OPEN I-O FILE-OPT IF WSFS NOT = "05" - DISPLAY "STATUS I-O, missing optional file:" WSFS. + DISPLAY "STATUS I-O, missing optional file: " WSFS. CLOSE FILE-OPT IF WSFS NOT = "00" - DISPLAY "STATUS CLOSE:" WSFS. + DISPLAY "STATUS CLOSE: " WSFS. OPEN I-O FILE-OPT IF WSFS NOT = "00" - DISPLAY "STATUS I-O, empty file:" WSFS. + DISPLAY "STATUS I-O, empty file: " WSFS. DELETE FILE FILE-OPT *> ON EXCEPTION IF WSFS NOT = "41" - DISPLAY "STATUS DELETE FILE (OPENED):" WSFS + DISPLAY "STATUS DELETE FILE (opened): " WSFS END-IF *> NOT ON EXCEPTION - *> DISPLAY "STATUS DELETE FILE (OPENED) - NO EXCEPTION:" WSFS + *> DISPLAY "STATUS DELETE FILE (opened) - NO EXCEPTION: " WSFS *> END-DELETE CLOSE FILE-OPT IF WSFS NOT = "00" - DISPLAY "STATUS CLOSE #2:" WSFS. + DISPLAY "STATUS CLOSE #2: " WSFS. DELETE FILE FILE-OPT *> ON EXCEPTION - *> DISPLAY "STATUS DELETE FILE (closed) - EXCEPTION:" WSFS + *> DISPLAY "STATUS DELETE FILE (closed) - EXCEPTION: " WSFS *> END-DISPLAY *> NOT ON EXCEPTION IF WSFS NOT = "00" - DISPLAY "STATUS DELETE FILE (closed):" WSFS + DISPLAY "STATUS DELETE FILE (closed): " WSFS END-IF *> END-DELETE * @@ -6366,12 +6366,12 @@ AT_DATA([prog2.cob], [ procedure division. open i-o file1. if fs not = "61" - display "I-O FAILED: " fs + display "I-O FAILED 1: " fs close file1 end-if. open input file1. if fs not = "00" - display "IN FAILED: " fs + display "IN FAILED 2: " fs else close file1 end-if. diff --git a/tests/testsuite.src/syn_copy.at b/tests/testsuite.src/syn_copy.at index 6e03a7f91..d61c8469a 100644 --- a/tests/testsuite.src/syn_copy.at +++ b/tests/testsuite.src/syn_copy.at @@ -195,7 +195,7 @@ AT_DATA([prog3.cob], [ PROGRAM-ID. prog. DATA DIVISION. WORKING-STORAGE SECTION. - COPY "sub.inc" OF SUB. + COPY "subb.inc" OF SUB. PROCEDURE DIVISION. DISPLAY TEST-VAR. STOP RUN. @@ -206,7 +206,7 @@ AT_DATA([prog4.cob], [ PROGRAM-ID. prog. DATA DIVISION. WORKING-STORAGE SECTION. - COPY "sub" OF SUB. + COPY "subb" OF SUB. PROCEDURE DIVISION. DISPLAY TEST-VAR. STOP RUN. @@ -217,7 +217,7 @@ AT_DATA([prog5.cob], [ PROGRAM-ID. prog. DATA DIVISION. WORKING-STORAGE SECTION. - COPY "sub" OF "..". + COPY "subb" OF "..". PROCEDURE DIVISION. DISPLAY TEST-VAR. STOP RUN. @@ -228,7 +228,7 @@ AT_DATA([prog6.cob], [ PROGRAM-ID. prog. DATA DIVISION. WORKING-STORAGE SECTION. - COPY "sub". + COPY "subb". PROCEDURE DIVISION. DISPLAY TEST-VAR. STOP RUN. @@ -238,7 +238,7 @@ AT_DATA([copy.inc], [ 77 TEST-VAR PIC X VALUE 'V'. ]) AT_CHECK([mkdir -p SUB/OSUB], [0], [], []) -AT_DATA([SUB/sub.inc], [ +AT_DATA([SUB/subb.inc], [ 77 TEST-VAR PIC X VALUE 'V'. ]) diff --git a/tests/testsuite.src/used_binaries.at b/tests/testsuite.src/used_binaries.at index 85e89e82a..0a71e2854 100644 --- a/tests/testsuite.src/used_binaries.at +++ b/tests/testsuite.src/used_binaries.at @@ -461,7 +461,8 @@ AT_CHECK([$COBCRUN -v --version], [0], [ignore], []) AT_CHECK([$COBCRUN -q --version], [0], [ignore], []) AT_CHECK([$COBCRUN --help], [0], [ignore], []) AT_CHECK([$COBCRUN --info], [0], [ignore], []) -AT_CHECK([$COBCRUN -v --info], [0], [ignore], []) +# we explicit do not want to run this here, as it initializes curses +# AT_CHECK([$COBCRUN -v --info], [0], [ignore], []) AT_CHECK([$COBCRUN -q --info], [0], [ignore], []) AT_CHECK([$COBCRUN --dumpversion], [0], [ignore], []) AT_CLEANUP