Update tests and function name

ddeclerck · Dec 17, 2024 · f44e6a6 · f44e6a6
1 parent e7c9540
commit f44e6a6
Show file tree

Hide file tree

Showing 4 changed files with 23 additions and 29 deletions.
diff --git a/cobc/tree.h b/cobc/tree.h
@@ -2373,6 +2373,7 @@ extern struct cb_program	*cb_build_program (struct cb_program *,
 
 extern cb_tree		cb_check_numeric_value (cb_tree);
 extern size_t		cb_check_index_or_handle_p (cb_tree x);
+extern void		cb_check_valid_set_index (cb_tree, int, int);
 extern void		cb_set_dmax (int scale);
 
 extern void		cb_set_intr_when_compiled (void);

diff --git a/cobc/typeck.c b/cobc/typeck.c
@@ -21,6 +21,7 @@
 
 
 #include "config.h"
+#include "libcob/common.h"
 
 #include <stdio.h>
 #include <stdlib.h>
@@ -13738,8 +13739,10 @@ cb_check_set_to (cb_tree vars, cb_tree x, const int emit_error)
 }
 
 void
-cb_emit_check_index (cb_tree vars, int hasval, int setval)
+cb_check_valid_set_index (cb_tree vars, int hasval, int setval)
 {
+	const int emit_exception = cb_flag_check_subscript_set
+		&& CB_EXCEPTION_ENABLE(COB_EC_BOUND_SUBSCRIPT);
 	cb_tree		l, v;
 	struct cb_field *f, *p;
 	for (l = vars; l; l = CB_CHAIN (l)) {
@@ -13756,8 +13759,10 @@ cb_emit_check_index (cb_tree vars, int hasval, int setval)
 					cb_warning_x (COBC_WARN_FILLER, l,
 						      _("SET %s TO %d is out of bounds"),
 						      f->name, setval);
-					cb_emit (CB_BUILD_FUNCALL_1 ("cob_set_exception",
-								     cb_int (COB_EC_RANGE_INDEX)));
+					if (emit_exception) {
+						cb_emit (CB_BUILD_FUNCALL_1 ("cob_set_exception",
+									     cb_int (COB_EC_RANGE_INDEX)));
+					}
 				}
 				if (setval >= p->occurs_min) continue;
 			}
@@ -13808,7 +13813,7 @@ cb_emit_set_to (cb_tree vars, cb_tree src)
 	}
 	if (cb_flag_check_subscript_set
 	 && CB_EXCEPTION_ENABLE (COB_EC_BOUND_SUBSCRIPT)) {
-		cb_emit_check_index (vars, hasval, setval);
+		cb_check_valid_set_index (vars, hasval, setval);
 	}
 }
 
@@ -13965,7 +13970,7 @@ cb_emit_set_up_down (cb_tree l, cb_tree flag, cb_tree x)
 		}
 	}
 	if (CB_EXCEPTION_ENABLE (COB_EC_RANGE_INDEX)) {
-		cb_emit_check_index (vars, 0, 0);
+		cb_check_valid_set_index (vars, 0, 0);
 	}
 }
 

diff --git a/tests/testsuite.src/run_subscripts.at b/tests/testsuite.src/run_subscripts.at
@@ -609,8 +609,6 @@ AT_DATA([prog.cob], [
                INDEXED BY IB2.
        PROCEDURE DIVISION.
            MOVE 5 TO MAXIDX
-           SET NIDX TO IB1.
-           DISPLAY "Initial value: " NIDX.
            SET IB2 TO 10.
            MOVE "A:" TO MYMRK (1)
            MOVE "B:" TO MYMRK (2)
@@ -683,8 +681,7 @@ AT_DATA([prog.cob], [
 ])
 
 AT_CHECK([$COMPILE -fopt-check-subscript-set -Wno-unfinished -Wno-others prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [Initial value: +01
-Number is +0000000042
+AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [Number is +0000000042
 Number is +0000000002
 Number is +0000000001
 Number is +0000000003
@@ -694,7 +691,7 @@ Number is +0000000003
 +01: A: Freddy  .
 +02: B: Barney  .
 +03: C: Wilma   .
-], [libcob: prog.cob:71: error: subscript of 'MYMRK' out of bounds: 4
+], [libcob: prog.cob:69: error: subscript of 'MYMRK' out of bounds: 4
 note: current maximum subscript for 'MYMRK': 3
 ])
 

diff --git a/tests/testsuite.src/syn_occurs.at b/tests/testsuite.src/syn_occurs.at
@@ -664,29 +664,20 @@ AT_DATA([prog.cob], [
        01  MYIDX  USAGE IS INDEX.
        01  MAXIDX PIC 9999 VALUE 3 COMP-5.
        01  TBL.
-           05  FILLER PIC X(8) VALUE "Fred".
-           05  FILLER PIC X(8) VALUE "Barney".
-           05  FILLER PIC X(8) VALUE "Wilma".
-           05  FILLER PIC X(8) VALUE "Betty".
-       01  FILLER REDEFINES TBL.
-           05  MYNAME PIC X(8) OCCURS 4 INDEXED BY IB1.
+           05  MYNAME PIC X(8) OCCURS 4
+                INDEXED BY IB1
+                VALUES ARE "Fred" "Barney" "Wilma" "Betty".
        01  TBL2.
            05  MYMRK  PIC X(3)
                OCCURS 2 TO 5 DEPENDING ON MAXIDX
-               INDEXED BY IB2.
+               INDEXED BY IB2
+               VALUES ARE "A:" "B:" "C:" "D:" "E:".
        PROCEDURE DIVISION.
-           MOVE 5 TO MAXIDX
            SET NIDX TO IB1.
            DISPLAY "Initial value: " NIDX.
            SET IB2 TO 0.2.
            SET IB2 TO "fred".
            SET IB2 TO 10.
-           MOVE "A:" TO MYMRK (1)
-           MOVE "B:" TO MYMRK (2)
-           MOVE "C:" TO MYMRK (3)
-           MOVE "D:" TO MYMRK (4)
-           MOVE "E:" TO MYMRK (5)
-           MOVE 3 TO MAXIDX.
            SET IB1 TO 2.
            SET MYIDX TO IB1.
            SET IB1 TO 1.
@@ -723,11 +714,11 @@ AT_DATA([prog.cob], [
            END PROGRAM prog.
 ])
 
-AT_CHECK([$COMPILE_ONLY -fopt-check-subscript-set prog.cob], [1], [], [prog.cob:25: error: an integer, INDEX, or a POINTER is expected here
-prog.cob:26: error: an integer, INDEX, or a POINTER is expected here
-prog.cob:27: warning: SET IB2 TO 10 is out of bounds
-prog.cob:45: warning: SET IB1 TO -9 is out of bounds
-prog.cob:46: warning: SET IB1 TO 300 is out of bounds
+AT_CHECK([$COMPILE_ONLY -fopt-check-subscript-set prog.cob], [1], [], [prog.cob:22: error: an integer, INDEX, or a POINTER is expected here
+prog.cob:23: error: an integer, INDEX, or a POINTER is expected here
+prog.cob:24: warning: SET IB2 TO 10 is out of bounds
+prog.cob:36: warning: SET IB1 TO -9 is out of bounds
+prog.cob:37: warning: SET IB1 TO 300 is out of bounds
 ])
 
 AT_CLEANUP