Adjustments to decimal constant bug patch

OCamlPro · Oct 16, 2023 · 019cc96 · 019cc96
1 parent 7575d39
commit 019cc96
Show file tree

Hide file tree

Showing 2 changed files with 38 additions and 20 deletions.
diff --git 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
@@ -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