From 7575d3929c53c1da4c59c302e8e9395a9fb76f3d Mon Sep 17 00:00:00 2001 From: David Declerck Date: Tue, 3 Oct 2023 23:13:43 +0200 Subject: [PATCH 1/5] Fix decimal constant bug occuring when several programs in a COBOL file --- cobc/codegen.c | 45 +++++++++++++++++---------------- tests/testsuite.src/run_misc.at | 29 +++++++++++++++++++++ 2 files changed, 52 insertions(+), 22 deletions(-) diff --git a/cobc/codegen.c b/cobc/codegen.c index f32391606..fd6fe7ead 100644 --- a/cobc/codegen.c +++ b/cobc/codegen.c @@ -13926,6 +13926,29 @@ codegen_internal (struct cb_program *prog, const int subsequent_call) /* Switch to main storage file */ output_target = cb_storage_file; } + + /* Decimal constants */ + { + struct literal_list* m; + int comment_gen = 0; + for (m = literal_cache; m; m = m->next) { + if (CB_TREE_CLASS (m->x) == CB_CLASS_NUMERIC + && m->make_decimal) { + if (!comment_gen) { + comment_gen = 1; + output_local ("\n/* Decimal constants */\n"); + } + output_local ("static\tcob_decimal\t%s%d;\n", + CB_PREFIX_DEC_FIELD, m->id); + output_local ("static\tcob_decimal\t*%s%d = NULL;\n", + CB_PREFIX_DEC_CONST, m->id); + } + } + if (comment_gen) { + output_local ("\n"); + } + } + } void @@ -13965,28 +13988,6 @@ codegen_finalize (void) } } - /* Decimal constants */ - { - struct literal_list* m; - int comment_gen = 0; - for (m = literal_cache; m; m = m->next) { - if (CB_TREE_CLASS (m->x) == CB_CLASS_NUMERIC - && m->make_decimal) { - if (!comment_gen) { - comment_gen = 1; - output_storage ("\n/* Decimal constants */\n"); - } - output_storage ("static\tcob_decimal\t%s%d;\n", - CB_PREFIX_DEC_FIELD, m->id); - output_storage ("static\tcob_decimal\t*%s%d = NULL;\n", - CB_PREFIX_DEC_CONST, m->id); - } - } - if (comment_gen) { - output_storage ("\n"); - } - } - /* Clean up by clearing these */ attr_cache = NULL; literal_cache = NULL; diff --git a/tests/testsuite.src/run_misc.at b/tests/testsuite.src/run_misc.at index 1b0a26de6..b9352255e 100644 --- a/tests/testsuite.src/run_misc.at +++ b/tests/testsuite.src/run_misc.at @@ -14570,3 +14570,32 @@ TST-DECIMAL IS < ZERO-DECIMAL AT_CLEANUP + +AT_SETUP([Decimal constants working after sub-program call]) +AT_KEYWORDS([runmisc]) + +# this used to cause a SIGSEGV + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC 9(2). + PROCEDURE DIVISION. + CALL "prog2" + IF X + 42 <> 0 + DISPLAY "OK". + STOP RUN. + END PROGRAM prog. + + PROGRAM-ID. prog2 INITIAL. + PROCEDURE DIVISION. + EXIT PROGRAM. + END PROGRAM prog2. +]) + +AT_CHECK([$COMPILE_MODULE prog.cob], [0], [], []) +AT_CHECK([$COBCRUN prog], [0], [OK +], []) +AT_CLEANUP From 019cc9630cab61d648e596196ed18e1c1062c0e2 Mon Sep 17 00:00:00 2001 From: David Declerck Date: Mon, 16 Oct 2023 10:02:35 +0200 Subject: [PATCH 2/5] Adjustments to decimal constant bug patch --- cobc/codegen.c | 13 ++++------ tests/testsuite.src/run_misc.at | 45 ++++++++++++++++++++++++--------- 2 files changed, 38 insertions(+), 20 deletions(-) diff --git a/cobc/codegen.c b/cobc/codegen.c index fd6fe7ead..746418c90 100644 --- a/cobc/codegen.c +++ b/cobc/codegen.c @@ -12602,8 +12602,7 @@ output_internal_function (struct cb_program *prog, cb_tree parameter_list) seen = 0; for (m = literal_cache; m; m = m->next) { - if (CB_TREE_CLASS (m->x) == CB_CLASS_NUMERIC - && m->make_decimal) { + if (m->make_decimal) { if (!seen) { seen = 1; output_line ("/* Set Decimal Constant values */"); @@ -12810,8 +12809,7 @@ output_internal_function (struct cb_program *prog, cb_tree parameter_list) output_line ("P_clear_decimal:"); seen = 0; for (m = literal_cache; m; m = m->next) { - if (CB_TREE_CLASS (m->x) == CB_CLASS_NUMERIC - && m->make_decimal) { + if (m->make_decimal) { if (!seen) { seen = 1; output_line ("/* Clear Decimal Constant values */"); @@ -13929,11 +13927,10 @@ codegen_internal (struct cb_program *prog, const int subsequent_call) /* Decimal constants */ { - struct literal_list* m; + struct literal_list* m = literal_cache; int comment_gen = 0; - for (m = literal_cache; m; m = m->next) { - if (CB_TREE_CLASS (m->x) == CB_CLASS_NUMERIC - && m->make_decimal) { + for (; m; m = m->next) { + if (m->make_decimal) { if (!comment_gen) { comment_gen = 1; output_local ("\n/* Decimal constants */\n"); diff --git a/tests/testsuite.src/run_misc.at b/tests/testsuite.src/run_misc.at index b9352255e..e356b9e04 100644 --- a/tests/testsuite.src/run_misc.at +++ b/tests/testsuite.src/run_misc.at @@ -14571,31 +14571,52 @@ TST-DECIMAL IS < ZERO-DECIMAL AT_CLEANUP -AT_SETUP([Decimal constants working after sub-program call]) + +AT_SETUP([Decimal constants and INITIAL programs in same source]) AT_KEYWORDS([runmisc]) -# this used to cause a SIGSEGV +# this used to cause a SIGSEGV, see bug #917 + +AT_DATA([prog.cpy], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. :PROG-NAME: INITIAL. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC 9(2) VALUE 42. + 01 Y PIC 9v9 VALUE 0.1. + PROCEDURE DIVISION. + MAIN. + * ensure that cobc cannot optimize the expression away + IF FUNCTION CURRENT-DATE = 0 + ADD 1 TO Y. + IF (X + Y) / 42.1 = 1 + DISPLAY "OK" WITH NO ADVANCING. + EXIT PROGRAM. + END PROGRAM :PROG-NAME:. +]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. PROGRAM-ID. prog. DATA DIVISION. WORKING-STORAGE SECTION. - 01 X PIC 9(2). + 01 X PIC 9(2) VALUE 0. + 01 Y PIC 9v9 VALUE 0.1. PROCEDURE DIVISION. + MAIN. + * ensure that cobc cannot optimize the expression away + IF FUNCTION CURRENT-DATE = 0 + ADD 1 TO Y. CALL "prog2" - IF X + 42 <> 0 - DISPLAY "OK". + CALL "prog3" + IF X + Y + 42.1 <> 0 + DISPLAY "OK" WITH NO ADVANCING. STOP RUN. + COPY prog REPLACING ==:PROG-NAME:== BY ==prog2==. END PROGRAM prog. - - PROGRAM-ID. prog2 INITIAL. - PROCEDURE DIVISION. - EXIT PROGRAM. - END PROGRAM prog2. + COPY prog REPLACING ==:PROG-NAME:== BY ==prog3==. ]) AT_CHECK([$COMPILE_MODULE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN prog], [0], [OK -], []) +AT_CHECK([$COBCRUN prog], [0], [OKOKOK], []) AT_CLEANUP From 142afae002aa9487f4da48d464b2aa4ad54ad117 Mon Sep 17 00:00:00 2001 From: David Declerck Date: Mon, 16 Oct 2023 16:51:52 +0200 Subject: [PATCH 3/5] More tests for decimal constant bug patch --- tests/testsuite.src/run_misc.at | 26 ++++++++++++++++++-------- 1 file changed, 18 insertions(+), 8 deletions(-) diff --git a/tests/testsuite.src/run_misc.at b/tests/testsuite.src/run_misc.at index e356b9e04..3bf50b4a5 100644 --- a/tests/testsuite.src/run_misc.at +++ b/tests/testsuite.src/run_misc.at @@ -14572,14 +14572,14 @@ TST-DECIMAL IS < ZERO-DECIMAL AT_CLEANUP -AT_SETUP([Decimal constants and INITIAL programs in same source]) -AT_KEYWORDS([runmisc]) +AT_SETUP([Decimal constants and programs in same source]) +AT_KEYWORDS([runmisc INITIAL CANCEL CALL]) # this used to cause a SIGSEGV, see bug #917 AT_DATA([prog.cpy], [ IDENTIFICATION DIVISION. - PROGRAM-ID. :PROG-NAME: INITIAL. + PROGRAM-ID. :PROG-NAME: :PROG-KIND:. DATA DIVISION. WORKING-STORAGE SECTION. 01 X PIC 9(2) VALUE 42. @@ -14607,16 +14607,26 @@ AT_DATA([prog.cob], [ * ensure that cobc cannot optimize the expression away IF FUNCTION CURRENT-DATE = 0 ADD 1 TO Y. - CALL "prog2" - CALL "prog3" + CALL "nested_init" + CALL "nonnested_init" + CALL "nested_noninit" + CANCEL "nested_noninit" + CALL "nonnested_noninit" + CANCEL "nonnested_noninit" IF X + Y + 42.1 <> 0 DISPLAY "OK" WITH NO ADVANCING. STOP RUN. - COPY prog REPLACING ==:PROG-NAME:== BY ==prog2==. + COPY prog REPLACING ==:PROG-NAME:== BY ==nested_init== + ==:PROG-KIND:== BY ==INITIAL==. + COPY prog REPLACING ==:PROG-NAME:== BY ==nested_noninit== + ==:PROG-KIND:== BY ====. END PROGRAM prog. - COPY prog REPLACING ==:PROG-NAME:== BY ==prog3==. + COPY prog REPLACING ==:PROG-NAME:== BY ==nonnested_init== + ==:PROG-KIND:== BY ==INITIAL==. + COPY prog REPLACING ==:PROG-NAME:== BY ==nonnested_noninit== + ==:PROG-KIND:== BY ====. ]) AT_CHECK([$COMPILE_MODULE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN prog], [0], [OKOKOK], []) +AT_CHECK([$COBCRUN prog], [0], [OKOKOKOKOK], []) AT_CLEANUP From dbaaf167934e08e97cb17b43ba54bf216b910064 Mon Sep 17 00:00:00 2001 From: David Declerck Date: Tue, 17 Oct 2023 09:46:07 +0200 Subject: [PATCH 4/5] Add ChangeLog entry --- cobc/ChangeLog | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 0c5659e71..3b23c9baf 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -1,4 +1,11 @@ +2023-10-17 David Declerck + + * codegen.c (codegen_internal, codegen_finalize): move declaration + of decimal constants from global storage to local storage to + fix bug #917 (segfault on decimal constant after CANCEL on + subprogram) + 2023-07-26 Simon Sobisch * typeck.c (search_set_keys): improving SEARCH ALL syntax checks From 50940f0db37ba896934846423ab5bcc228d2e81d Mon Sep 17 00:00:00 2001 From: David Declerck Date: Tue, 17 Oct 2023 16:08:00 +0200 Subject: [PATCH 5/5] Minor adjustments --- cobc/codegen.c | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/cobc/codegen.c b/cobc/codegen.c index 746418c90..b1cc553d6 100644 --- a/cobc/codegen.c +++ b/cobc/codegen.c @@ -12602,7 +12602,8 @@ output_internal_function (struct cb_program *prog, cb_tree parameter_list) seen = 0; for (m = literal_cache; m; m = m->next) { - if (m->make_decimal) { + if (CB_TREE_CLASS (m->x) == CB_CLASS_NUMERIC + && m->make_decimal) { if (!seen) { seen = 1; output_line ("/* Set Decimal Constant values */"); @@ -12809,7 +12810,8 @@ output_internal_function (struct cb_program *prog, cb_tree parameter_list) output_line ("P_clear_decimal:"); seen = 0; for (m = literal_cache; m; m = m->next) { - if (m->make_decimal) { + if (CB_TREE_CLASS (m->x) == CB_CLASS_NUMERIC + && m->make_decimal) { if (!seen) { seen = 1; output_line ("/* Clear Decimal Constant values */"); @@ -13930,7 +13932,8 @@ codegen_internal (struct cb_program *prog, const int subsequent_call) struct literal_list* m = literal_cache; int comment_gen = 0; for (; m; m = m->next) { - if (m->make_decimal) { + if (CB_TREE_CLASS (m->x) == CB_CLASS_NUMERIC + && m->make_decimal) { if (!comment_gen) { comment_gen = 1; output_local ("\n/* Decimal constants */\n");