Fix INPUT/CLOSE with double arg

OCamlPro · Jul 10, 2023 · c508c69 · c508c69
1 parent 327adca
commit c508c69
Show file tree

Hide file tree

Showing 3 changed files with 19 additions and 5 deletions.
diff --git a/cobc/ChangeLog b/cobc/ChangeLog
@@ -1,4 +1,10 @@
 
+2023-07-09  Fabrice Le Fessant <[email protected]>
+
+	* parser.y: fix code generation for INPUT/CLOSE with double arg
+	  where DECLARATIVES for both arguments were called when only one
+	  failed
+
 2023-07-07  Simon Sobisch <[email protected]>
 
 	common preparser cleanup

diff --git a/cobc/parser.y b/cobc/parser.y
@@ -12900,15 +12900,21 @@ close_body:
 close_files:
   file_name _close_option
   {
-#if 0 /* CHECKME: likely not needed */
+	/* 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 ();
-#endif
 	cb_emit_close ($1, $2);
+	current_statement = saved_current_statement ;
   }
 | close_files file_name _close_option
   {
+	struct cb_statement * saved_current_statement = current_statement ;
 	begin_implicit_statement ();
 	cb_emit_close ($2, $3);
+	current_statement = saved_current_statement ;
   }
 ;
 
@@ -13081,8 +13087,10 @@ delete_file_list:
   }
 | delete_file_list file_name
   {
+	struct cb_statement * saved_current_statement = current_statement ;
 	begin_implicit_statement ();
 	cb_emit_delete_file ($2);
+	current_statement = saved_current_statement ;
   }
 ;
 
@@ -15341,8 +15349,10 @@ open_file_entry:
 
 	for (l = $5; l; l = CB_CHAIN (l)) {
 		if (CB_VALID_TREE (CB_VALUE (l))) {
+			struct cb_statement * saved_current_statement = current_statement ;
 			begin_implicit_statement ();
 			cb_emit_open (CB_VALUE (l), $2, x);
+			current_statement = saved_current_statement ;
 		}
 	}
   }

diff --git a/tests/testsuite.src/run_file.at b/tests/testsuite.src/run_file.at
@@ -13772,7 +13772,7 @@ EXITING NESTED-PROGRAM-1-2
 AT_CLEANUP
 
 AT_SETUP([INPUT/CLOSE double arg])
-# AT_KEYWORD([])
+AT_KEYWORDS([DECLARATIVES error])
 
 AT_DATA([prog1.cob], [
        IDENTIFICATION DIVISION.
@@ -13888,8 +13888,6 @@ AT_CHECK([$COMPILE prog1.cob])
 AT_CHECK([$COBCRUN_DIRECT ./prog1 > prog1.txt])
 AT_CHECK([diff expected.txt prog1.txt])
 
-AT_XFAIL_IF([true])
-
 AT_CHECK([$COMPILE prog2.cob])
 AT_CHECK([$COBCRUN_DIRECT ./prog2 > prog2.txt])
 AT_CHECK([diff expected.txt prog2.txt])