Fix OPEN/CLOSE with multiple filenames

cobc/ChangeLog

@@ -1,4 +1,10 @@
 
+2023-07-09  Fabrice Le Fessant <[email protected]>
+
+	* parser.y: fix code generation for OPEN/CLOSE with multiple
+	filenames, where DECLARATIVES for all arguments were called when
+	only one argument failed
+
 2023-07-07  Simon Sobisch <[email protected]>
 
 	common preparser cleanup

cobc/cobc.c

@@ -1343,11 +1343,9 @@ void *
 cobc_plex_strsub (const char *s, const int len)
 {
 	void	*p;
-	int	n;
-
-	n = strlen (s);
 
 #ifdef	COB_TREE_DEBUG
+	int	n = strlen (s);
 	/* LCOV_EXCL_START */
 	if ( len>n ) {
 		cobc_err_msg ("call to %s with bad argument len=%d>%d=strlen(s)",

cobc/parser.y

@@ -447,17 +447,23 @@ begin_statement_at_tree_pos (enum cob_statement statement, const unsigned int te
 	cobc_in_area_a = backup_in_area_a;
 }
 
-/* create a new statement with base attributes of current_statement
-   and set this as new current_statement */
+/* create a new statement with base attributes of real_statement, the
+   location of pos and set this as new current_statement */
 static void
-begin_implicit_statement (void)
+begin_implicit_statement (struct cb_statement* real_statement, cb_tree pos)
 {
 	struct cb_statement	*new_statement;
-	new_statement = cb_build_statement (current_statement->statement);
+	new_statement = cb_build_statement (real_statement->statement);
 	new_statement->common = current_statement->common;
 	new_statement->flag_in_debug = !!in_debugging;
 	new_statement->flag_implicit = 1;
-	current_statement->body = cb_list_add (current_statement->body,
+	if (pos){
+		cb_tree stmt_tree;
+		stmt_tree = CB_TREE (new_statement);
+		stmt_tree->source_file = pos->source_file;
+		stmt_tree->source_line = pos->source_line;
+	}
+	real_statement->body = cb_list_add (real_statement->body,
 					    CB_TREE (new_statement));
 	current_statement = new_statement;
 }
@@ -12900,15 +12906,21 @@ close_body:
 close_files:
   file_name _close_option
   {
-#if 0 /* CHECKME: likely not needed */
-	begin_implicit_statement ();
-#endif
+	/* We need to create a list with a CLOSE statement for every file
+	   within the current_statement instead of nesting them, which
+	   is what would happen if we don't save the current statement
+	   and restore it. */
+	struct cb_statement * saved_current_statement = current_statement ;
+	begin_implicit_statement (current_statement, $1);
 	cb_emit_close ($1, $2);
+	current_statement = saved_current_statement ;
   }
 | close_files file_name _close_option
   {
-	begin_implicit_statement ();
+	struct cb_statement * saved_current_statement = current_statement ;
+	begin_implicit_statement (current_statement, $2);
 	cb_emit_close ($2, $3);
+	current_statement = saved_current_statement ;
   }
 ;
 
@@ -13074,15 +13086,17 @@ delete_body:
 delete_file_list:
   file_name
   {
-#if 0 /* CHECKME: likely not needed */
-	begin_implicit_statement ();
-#endif
+	struct cb_statement * saved_current_statement = current_statement ;
+	begin_implicit_statement (current_statement, $1);
 	cb_emit_delete_file ($1);
+	current_statement = saved_current_statement ;
   }
 | delete_file_list file_name
   {
-	begin_implicit_statement ();
+	struct cb_statement * saved_current_statement = current_statement ;
+	begin_implicit_statement (current_statement, $2);
 	cb_emit_delete_file ($2);
+	current_statement = saved_current_statement ;
   }
 ;
 
@@ -14483,7 +14497,7 @@ generate_body:
   qualified_word
   {
 #if 0 /* CHECKME: likely not needed */
-	begin_implicit_statement ();
+	begin_implicit_statement (current_statement, $1);
 #endif
 	if ($1 != cb_error_node) {
 		cb_emit_generate ($1);
@@ -14737,15 +14751,15 @@ initiate_body:
   report_name
   {
 #if 0 /* CHECKME: likely not needed */
-	begin_implicit_statement ();
+	begin_implicit_statement (current_statement, $1);
 #endif
 	if ($1 != cb_error_node) {
 		cb_emit_initiate ($1);
 	}
   }
 | initiate_body report_name
   {
-	begin_implicit_statement ();
+	begin_implicit_statement (current_statement, $2);
 	if ($2 != cb_error_node) {
 		cb_emit_initiate ($2);
 	}
@@ -15339,9 +15353,10 @@ open_file_entry:
 		x = $1;
 	}
 
+	struct cb_statement * top_statement = current_statement ;
 	for (l = $5; l; l = CB_CHAIN (l)) {
 		if (CB_VALID_TREE (CB_VALUE (l))) {
-			begin_implicit_statement ();
+			begin_implicit_statement (top_statement, CB_VALUE(l));
 			cb_emit_open (CB_VALUE (l), $2, x);
 		}
 	}
@@ -16932,15 +16947,15 @@ terminate_body:
   report_name
   {
 #if 0 /* CHECKME: likely not needed */
-	begin_implicit_statement ();
+	begin_implicit_statement (current_statement, $1);
 #endif
 	if ($1 != cb_error_node) {
 	    cb_emit_terminate ($1);
 	}
   }
 | terminate_body report_name
   {
-	begin_implicit_statement ();
+	begin_implicit_statement (current_statement, $2);
 	if ($2 != cb_error_node) {
 		cb_emit_terminate ($2);
 	}

cobc/typeck.c

@@ -9023,6 +9023,12 @@ cb_emit_delete_file (cb_tree file)
 	if (file == cb_error_node) {
 		return;
 	}
+	/* Note: we should uncomment the following statement to have errors in DELETE FILE
+	   run DECLARATIVES handlers. The problem is that such a change would probably break
+	   existing programs.
+
+	current_statement->file = file;
+	*/
 	if (CB_FILE (file)->organization == COB_ORG_SORT) {
 		cb_error_x (CB_TREE (current_statement),
 				_("%s not allowed on %s files"), "DELETE FILE", "SORT");

tests/testsuite.src/run_file.at

@@ -13771,8 +13771,8 @@ EXITING NESTED-PROGRAM-1-2
 ], [])
 AT_CLEANUP
 
-AT_SETUP([INPUT/CLOSE double arg])
-# AT_KEYWORD([])
+AT_SETUP([OPEN / CLOSE with multiple filenames])
+AT_KEYWORDS([DECLARATIVES file error])
 
 AT_DATA([prog1.cob], [
        IDENTIFICATION DIVISION.
@@ -13817,6 +13817,9 @@ AT_DATA([prog1.cob], [
           DISPLAY "CLOSE FILES".
           CLOSE FILE1.
           CLOSE FILE2.
+          DISPLAY "DELETE FILES".
+          DELETE FILE FILE1.
+          DELETE FILE FILE2.
           STOP RUN.
 ])
 AT_DATA([prog2.cob], [
@@ -13862,9 +13865,11 @@ AT_DATA([prog2.cob], [
           DISPLAY "CLOSE FILES".
           CLOSE FILE1
                 FILE2.
+          DISPLAY "DELETE FILES".
+          DELETE FILE FILE1
+                      FILE2.
           STOP RUN.
 ])
-AT_DATA([file1.txt], [])
 
 AT_DATA([expected.txt],
 [ERROR ON FILE2
@@ -13882,15 +13887,16 @@ CLOSE FILES
 ERROR ON FILE2
   STAT-FILE1: 00
   STAT-FILE2: 42
+DELETE FILES
 ])
 
 AT_CHECK([$COMPILE prog1.cob])
+AT_DATA([file1.txt], [])
 AT_CHECK([$COBCRUN_DIRECT ./prog1 > prog1.txt])
 AT_CHECK([diff expected.txt prog1.txt])
 
-AT_XFAIL_IF([true])
-
 AT_CHECK([$COMPILE prog2.cob])
+AT_DATA([file1.txt], [])
 AT_CHECK([$COBCRUN_DIRECT ./prog2 > prog2.txt])
 AT_CHECK([diff expected.txt prog2.txt])