Merge SVN 5139

libcob/ChangeLog

@@ -73,6 +73,11 @@
 	* move.c (cob_move_display_to_packed): fix data corruption caused
 	  by packing one extra digit from the input display field
 
+2023-07-24  Simon Sobisch <[email protected]>
+
+	* fileio.c: only check -1 as invalid fd; return fileio status for
+	  invalid file state in CBL_ routines, instead of fixed -1 / 35
+
 2023-07-22  Simon Sobisch <[email protected]>
 
 	* coblocal.h (COB_MAX_FIELD_SIZE_LINKAGE): new definition
@@ -155,6 +160,7 @@ after suggestions by Chuck Haatvedt <[email protected]>
 	  otherwise it is lost on first CLOSE
 	* fileio.c->fextfh.c: disable setting of record min/max size outside of OPEN,
 	  disable setting of record size in some places
+	* fileio.c: adjusted setting of SORT-RETURN register
 
 2023-06-01  Simon Sobisch <[email protected]>
 

libcob/fextfh.c

@@ -42,8 +42,6 @@ static const cob_field_attr compx_attr = {COB_TYPE_NUMERIC_BINARY, 0, 0, 0, NULL
 static void copy_keys_fcd_to_file (FCD3 *fcd, cob_file *f, int doall);
 static int	EXTFH3 (unsigned char *opcode, FCD3 *fcd);
 
-extern unsigned int		eop_status;
-
 /*
  * Free up allocated memory
  */
@@ -319,23 +317,12 @@ update_fcd_to_file (FCD3* fcd, cob_file *f, cob_field *fnstatus, int wasOpen)
 	if (wasOpen >= 0) {
 		const int status_code_1 = isdigit(fcd->fileStatus[0])
 			? COB_D2I (fcd->fileStatus[0]) : 9;
-		if (status_code_1 == 0) {
+		if (status_code_1 != 0
+		 || cob_last_exception_is (COB_EC_I_O_EOP)) {
 			/* EOP is non-fatal therefore 00 status but needs exception;
-			   note that this global variable is only set if GnuCOBOL is used
+			   note that the global exception is only set if GnuCOBOL is used
 			   as EXTFH, in every other case we currently can't set EOP;
 			   also note that fcd->lineCount is never read/set */
-			if (eop_status == 0) {
-				cobglobptr->cob_exception_code = 0;
-		} else {
-#if 0 /* correct thing to do, but then also needs to have codegen adjusted
-         --> module-incompatibility --> 4.x */
-				cob_set_exception (eop_status);
-#else
-				cob_set_exception (COB_EC_I_O_EOP);
-#endif
-				eop_status = 0;
-			}
-		} else {
 			cob_set_exception (status_exception[status_code_1]);
 		}
 		if (f->file_status) {

libcob/fileio.c

@@ -4150,6 +4150,9 @@ cob_fd_file_open (cob_file *f, char *filename,
 
 	errno = 0;
 	fd = open (filename, fdmode, fperms);
+	if (fd != -1) {
+		errno = 0;
+	}
 	ret = errno;
 
 	switch (ret) {
@@ -8265,9 +8268,10 @@ open_cbl_file (cob_u8_ptr file_name, int file_access,
 	cob_chk_file_mapping (NULL, NULL);
 
 	fd = open (file_open_name, flag, COB_FILE_MODE);
-	if (fd < 0) {
+	if (fd == -1) {
+		int ret = errno_cob_sts (COB_STATUS_35_NOT_EXISTS);
 		memset (file_handle, -1, (size_t)4);
-		return 35;
+		return ret;
 	}
 	memcpy (file_handle, &fd, (size_t)4);
 	return 0;
@@ -8481,9 +8485,9 @@ cob_sys_copy_file (unsigned char *fname1, unsigned char *fname2)
 
 	flag |= O_RDONLY;
 	fd1 = open (file_open_name, flag, 0);
-	if (fd1 < 0) {
+	if (fd1 == -1) {
 		cob_free (fn2);
-		return -1;
+		return errno_cob_sts (COB_STATUS_35_NOT_EXISTS);
 	}
 
 	strncpy (file_open_name, fn2, (size_t)COB_FILE_MAX);
@@ -8494,9 +8498,10 @@ cob_sys_copy_file (unsigned char *fname1, unsigned char *fname2)
 	flag &= ~O_RDONLY;
 	flag |= O_CREAT | O_TRUNC | O_WRONLY;
 	fd2 = open (file_open_name, flag, COB_FILE_MODE);
-	if (fd2 < 0) {
+	if (fd2 == -1) {
+		int ret = errno_cob_sts (COB_STATUS_35_NOT_EXISTS);
 		close (fd1);
-		return -1;
+		return ret;
 	}
 
 	ret = 0;
@@ -9025,7 +9030,7 @@ cob_create_tmpfile (const char *ext)
 	fd = open (filename,
 		    O_CREAT | O_TRUNC | O_RDWR | O_BINARY | COB_OPEN_TEMPORARY,
 		    COB_FILE_MODE);
-	if (fd < 0) {
+	if (fd == -1) {
 		cob_free (filename);
 		return NULL;
 	}
@@ -9508,6 +9513,11 @@ cob_file_sort_using_extfh (cob_file *sort_file, cob_file *data_file,
 		if (data_file->file_status[0] == '4') {
 			cob_set_exception (COB_EC_SORT_MERGE_FILE_OPEN);
 		}
+		if (hp->sort_return) {
+			*(int *)(hp->sort_return) = 16;	/* TODO: recheck with MF */
+		} else {
+			/* IBM doc: if not used then a runtime message is displayed */
+		}
 		return;
 	}
 	for (;;) {
@@ -9567,6 +9577,9 @@ cob_file_sort_giving_internal (cob_file *sort_file, const size_t giving_cnt,
 			if (using_file->file_status[0] == '4') {
 				cob_set_exception (COB_EC_SORT_MERGE_FILE_OPEN);
 			}
+			if (!hp->sort_return) {
+				/* IBM doc: if not used then a runtime message is displayed */
+			}
 			opt[i] = -1;
 		}
 	}
@@ -9611,6 +9624,9 @@ cob_file_sort_giving_internal (cob_file *sort_file, const size_t giving_cnt,
 			if (using_file->file_status[0] == '3') {
 				int j;
 				opt[i] = -2;
+				if (!hp->sort_return) {
+					/* IBM doc: if not used then a runtime message is displayed */
+				}
 				/* early exit if no GIVING file left */
 				for (j = 0; j < giving_cnt; ++j) {
 					if (opt[i] >= 0) {
@@ -9647,6 +9663,16 @@ cob_file_sort_giving_internal (cob_file *sort_file, const size_t giving_cnt,
 	if (callfh) {
 		cob_free (callfh);
 	}
+
+	/* if any error happened with the GIVING files update SORT-RETURN */
+	if (hp->sort_return) {
+		for (i = 0; i < giving_cnt; ++i) {
+			if (opt[i] < 0) {
+				*(int *)(hp->sort_return) = 16;
+				break;
+			}
+		}
+	}
 }
 
 /* SORT: WRITE all records from 'sort_file' to all passed USING files */
@@ -9731,8 +9757,6 @@ cob_file_release (cob_file *f)
 		}
 		if (hp->sort_return) {
 			*(int *)(hp->sort_return) = 16;
-		} else {
-			/* IBM doc: if not used then a runtime message is displayed */
 		}
 		cob_file_save_status (f, fnstatus, COB_STATUS_30_PERMANENT_ERROR);
 	} else {
@@ -9758,8 +9782,6 @@ cob_file_return (cob_file *f)
 		}
 		if (hp->sort_return) {
 			*(int *)(hp->sort_return) = 16;
-		} else {
-			/* IBM doc: if not used then a runtime message is displayed */
 		}
 		cob_file_save_status (f, fnstatus, COB_STATUS_30_PERMANENT_ERROR);
 	} else {