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 diff --git a/cobc/codegen.c b/cobc/codegen.c index f32391606..b1cc553d6 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 = literal_cache; + int comment_gen = 0; + for (; 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..3bf50b4a5 100644 --- a/tests/testsuite.src/run_misc.at +++ b/tests/testsuite.src/run_misc.at @@ -14570,3 +14570,63 @@ TST-DECIMAL IS < ZERO-DECIMAL AT_CLEANUP + + +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: :PROG-KIND:. + 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) 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 "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 ==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 ==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], [OKOKOKOKOK], []) +AT_CLEANUP