From 75983abf49f40c2f02fb4c9fd101eeb4f1206290 Mon Sep 17 00:00:00 2001 From: Fabrice Le Fessant Date: Sun, 9 Jul 2023 23:11:57 +0200 Subject: [PATCH] Fix OPEN/CLOSE with multiple filenames --- cobc/ChangeLog | 6 ++++ cobc/cobc.c | 4 +-- cobc/parser.y | 53 +++++++++++++++++++++------------ cobc/typeck.c | 6 ++++ tests/testsuite.src/run_file.at | 16 ++++++---- 5 files changed, 58 insertions(+), 27 deletions(-) diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 2c373635f..514a36369 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -1,4 +1,10 @@ +2023-07-09 Fabrice Le Fessant + + * 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 common preparser cleanup diff --git a/cobc/cobc.c b/cobc/cobc.c index 3c1ceb401..a0b48f495 100644 --- a/cobc/cobc.c +++ b/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)", diff --git a/cobc/parser.y b/cobc/parser.y index b10f0b338..39a0131f8 100644 --- a/cobc/parser.y +++ b/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,7 +14751,7 @@ 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); @@ -14745,7 +14759,7 @@ initiate_body: } | 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,7 +16947,7 @@ 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); @@ -16940,7 +16955,7 @@ terminate_body: } | terminate_body report_name { - begin_implicit_statement (); + begin_implicit_statement (current_statement, $2); if ($2 != cb_error_node) { cb_emit_terminate ($2); } diff --git a/cobc/typeck.c b/cobc/typeck.c index 75a173de1..e37099045 100644 --- a/cobc/typeck.c +++ b/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"); diff --git a/tests/testsuite.src/run_file.at b/tests/testsuite.src/run_file.at index ece581f94..641076f57 100644 --- a/tests/testsuite.src/run_file.at +++ b/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])