Fail on EC-SIZE exceptions as per the standard

NEWS

@@ -6,6 +6,19 @@ NEWS - user visible changes				-*- outline -*-
 
 * New GnuCOBOL features
 
+** at runtime, fatal size exception codes now fail when activated (with
+   -fec=ALL or -fec=SIZE or its subordinates). Theses exceptions can be
+   caught with ON SIZE ERROR phrases to avoid the program failing when
+   they are set. The affected exception codes are:
+   EC-SIZE
+   EC-SIZE-ADDRESS
+   EC-SIZE-EXPONENTIATION
+   EC-SIZE-OVERFLOW
+   EC-SIZE-TRUNCATION
+   EC-SIZE-UNDERFLOW
+   EC-SIZE-ZERO-DIVIDE
+
+
 ** cobc now checks for binary and multi-byte encoded files and early exit
    parsing those; the error output for format errors (for example invalid
    indicator column) is now limited to 5 per source file

cobc/ChangeLog

@@ -21,6 +21,13 @@
 	* ppparse.y: error on extraneous periods at the end of SET
 	  directives; turn to a warning in relaxed syntax mode.
 
+2025-11-24  Emilien Lemaire <emilien.lemaire@ocamlpro.com>
+
+	* codegen.c (output_ec_size_handler): generate a check for a
+	size exception on statements that can raise them
+	* codegen.c (output_stmt): add a check for `ON SIZE ERROR` phrase, and
+	if not present  then generate a check for enabled size exceptions
+
 2025-11-01  Simon Sobisch <simonsobisch@gnu.org>
 
 	* codegen.c (output_xml_parse): fixed xml state to be static-local

cobc/codegen.c

@@ -8718,6 +8718,44 @@ output_ec_condition_for_handler (const enum cb_handler_type handler_type)
 	}
 }
 
+static void
+output_ec_size_handler (void)
+{
+	int ec_checked = 0;
+	if (CB_EXCEPTION_ENABLE (COB_EC_SIZE_ADDRESS)) {
+		ec_checked |= CB_EXCEPTION_CODE (COB_EC_SIZE_ADDRESS);
+	}
+	if (CB_EXCEPTION_ENABLE (COB_EC_SIZE_EXPONENTIATION)) {
+		ec_checked |= CB_EXCEPTION_CODE (COB_EC_SIZE_EXPONENTIATION);
+	}
+	if (CB_EXCEPTION_ENABLE (COB_EC_SIZE_IMP)) {
+		ec_checked |= CB_EXCEPTION_CODE (COB_EC_SIZE_IMP);
+	}
+	if (CB_EXCEPTION_ENABLE (COB_EC_SIZE_OVERFLOW)) {
+		ec_checked |= CB_EXCEPTION_CODE (COB_EC_SIZE_OVERFLOW);
+	}
+	if (CB_EXCEPTION_ENABLE (COB_EC_SIZE_TRUNCATION)) {
+		ec_checked |= CB_EXCEPTION_CODE (COB_EC_SIZE_TRUNCATION);
+	}
+	if (CB_EXCEPTION_ENABLE (COB_EC_SIZE_UNDERFLOW)) {
+		ec_checked |= CB_EXCEPTION_CODE (COB_EC_SIZE_UNDERFLOW);
+	}
+	if (CB_EXCEPTION_ENABLE (COB_EC_SIZE_ZERO_DIVIDE)) {
+		ec_checked |= CB_EXCEPTION_CODE (COB_EC_SIZE_ZERO_DIVIDE);
+	}
+	if (ec_checked) {
+		output_line (
+			"if (((cob_glob_ptr->cob_exception_code & 0x%04x) == 0x%04x)"
+			" && ((cob_glob_ptr->cob_exception_code & 0x%04x) != 0)"
+			" && (cob_glob_ptr->cob_got_exception > 0))",
+			CB_EXCEPTION_CODE (COB_EC_SIZE),
+			CB_EXCEPTION_CODE (COB_EC_SIZE),
+			ec_checked & 0x00FF);
+		output_line ("\t" "cob_fatal_exception (cob_glob_ptr->cob_exception_code);");
+	}
+
+}
+
 static void
 output_handler (const struct cb_statement *stmt)
 {
@@ -8726,6 +8764,11 @@ output_handler (const struct cb_statement *stmt)
 		return;
 	}
 
+	if (stmt->ex_handler || stmt->not_ex_handler) {
+		/* We have a handler, so the exceptions should not be raised, and we reset them
+		 * before in case the handling statements can also raise exceptions. */
+		output_line("cob_reset_exception ();");
+	}
 	if (stmt->ex_handler) {
 		output_ec_condition_for_handler (stmt->handler_type);
 		output_block_open ();
@@ -8736,6 +8779,8 @@ output_handler (const struct cb_statement *stmt)
 		}
 	}
 	if (stmt->not_ex_handler) {
+		/* We have a not handler, so we should reset exceptions to avoid them
+		 * being triggered after */
 		if (stmt->ex_handler == NULL) {
 			output_line ("if (!cob_glob_ptr->cob_exception_code)");
 		}
@@ -9173,6 +9218,13 @@ output_stmt (cb_tree x)
 				output_debug_stmts (debug_checks);
 			}
 		}
+
+		if (p->handler_type == SIZE_ERROR_HANDLER
+		     && p->ex_handler == NULL
+		     && p->not_ex_handler == NULL) {
+			output_ec_size_handler ();
+		}
+
 		break;
 	}
 	case CB_TAG_LABEL:

cobc/parser.y

@@ -18134,13 +18134,40 @@ on_size_error_phrases:
   %prec SHIFT_PREFER
   {
 	/* no [NOT] ON SIZE ERROR is specified (= no explicit handling) */
+	if (CB_EXCEPTION_ENABLE (COB_EC_SIZE_ADDRESS)
+	     || CB_EXCEPTION_ENABLE (COB_EC_SIZE_EXPONENTIATION)
+	     || CB_EXCEPTION_ENABLE (COB_EC_SIZE_IMP)
+	     || CB_EXCEPTION_ENABLE (COB_EC_SIZE_OVERFLOW)
+	     || CB_EXCEPTION_ENABLE (COB_EC_SIZE_TRUNCATION)
+	     || CB_EXCEPTION_ENABLE (COB_EC_SIZE_UNDERFLOW)
+	     || CB_EXCEPTION_ENABLE (COB_EC_SIZE_ZERO_DIVIDE))
+	{
+		current_statement->handler_type = SIZE_ERROR_HANDLER;
+		current_statement->ex_handler = NULL;
+	}
   }
 | on_size_error _not_on_size_error
 | not_on_size_error _on_size_error
   {
 	if ($2) {
 		cb_verify (cb_not_exception_before_exception,
 			_("NOT SIZE ERROR before SIZE ERROR"));
+	} else if ($1 && $1 != cb_int1) {
+		/* One NOT ON SIZE ERROR, but no ON SIZE ERROR, so we need to
+		   check on exceptions */
+#if 0 /* CHECK ME: possible dialect configuration
+		if (CB_EXCEPTION_ENABLE (COB_EC_SIZE_ADDRESS)
+		     || CB_EXCEPTION_ENABLE (COB_EC_SIZE_EXPONENTIATION)
+		     || CB_EXCEPTION_ENABLE (COB_EC_SIZE_IMP)
+		     || CB_EXCEPTION_ENABLE (COB_EC_SIZE_OVERFLOW)
+		     || CB_EXCEPTION_ENABLE (COB_EC_SIZE_TRUNCATION)
+		     || CB_EXCEPTION_ENABLE (COB_EC_SIZE_UNDERFLOW)
+		     || CB_EXCEPTION_ENABLE (COB_EC_SIZE_ZERO_DIVIDE))
+		{
+			current_statement->handler_type = SIZE_ERROR_HANDLER;
+			current_statement->ex_handler = NULL;
+		} */
+#endif
 	}
   }
 ;

cobc/typeck.c

@@ -6207,8 +6207,11 @@ build_store_option (cb_tree x, cb_tree round_opt)
 		if (current_statement->ex_handler) {
 			opt |= COB_STORE_KEEP_ON_OVERFLOW;
 		}
-	} else if (current_statement->handler_type != NO_HANDLER) {
-		/* There is a [NOT] ERROR/OVERFLOW/EXCEPTION - Set in parser */
+	} else if (current_statement->handler_type != NO_HANDLER
+		    && (current_statement->ex_handler
+			|| current_statement->not_ex_handler)) {
+		/* There is a [NOT] ERROR/OVERFLOW/EXCEPTION and it is not
+		 * implied by the enabled exceptions - Set in parser */
 		opt |= COB_STORE_KEEP_ON_OVERFLOW;
 	} else if (usage == CB_USAGE_BINARY && cb_binary_truncate) {
 		/* Truncate binary field to digits in picture */

libcob/ChangeLog

@@ -8,6 +8,21 @@
 	* fileio.c (cob_file_close): close file depending on internal state, not
 	  depending on file organization
 
+2025-12-04  Emilien Lemaire <emilien.lemaire@ocamlpro.com>
+
+	* exception.def: exceptions values for EC-SIZE are now bit exclusive
+
+2025-11-24  Emilien Lemaire <emilien.lemaire@ocamlpro.com>
+
+	* common.h, common.c: add `cob_reset_exception` which disable an
+	  exception check after one was performed, but still allows the
+	  exception intrinsic functions to check for them
+	* common.h, common.c: add `cob_last_exception_fatal`, to check if the
+	  last raised exception was fatal
+	* common.h, common.c: add enum member `COB_FERROR_FATAL_EC` for
+	  `struct cob_fatal_error` which can be used when terminating the
+	  program due to a fatal exception
+
 2025-11-19  Oğuzcan Kırmemiş <oguzcan.kirmemis@gmail.com>
 
 	* common.c (cob_set_signal): add the enum COB_SIGNAL_REGIME to toggle
@@ -37,6 +52,14 @@
 	  parsing and general handling of finished/not finished also when built
 	  without libxml2
 
+2025-11-10  Emilien Lemaire <emilien.lemaire@ocamlpro.com>
+
+	* common.h, common.c: add `cob_exception_tab_fatal`, which informs
+	whether an exception is fatal or not
+	* common.h, common.c: add enum member `COB_FERROR_FATAL_EC` for
+	`struct cob_fatal_error` which can be used when terminating the
+	program due to a fatal exception
+
 2025-11-09  Oğuzcan Kırmemiş <oguzcan.kirmemis@gmail.com>
 
 	* common.c: remove strbuff variable and cob_strcat/cob_strjoin utilities

libcob/call.c

@@ -1049,6 +1049,13 @@ cob_call_error (void)
 	cob_hard_failure ();
 }
 
+void
+cob_fatal_exception (const int exception_code) {
+	cob_runtime_error("Fatal exception not handled: %s",
+			cob_get_last_exception_name());
+	cob_hard_failure ();
+}
+
 void
 cob_set_cancel (cob_module *m)
 {

libcob/common.c

@@ -466,8 +466,6 @@ static const int		cob_exception_tab_code[] = {
 	0		/* COB_EC_MAX */
 };
 
-#undef	COB_EXCEPTION
-
 #define EXCEPTION_TAB_SIZE	sizeof (cob_exception_tab_code) / sizeof (int)
 
 /* Switches */
@@ -2493,6 +2491,7 @@ void
 cob_set_exception (const int id)
 {
 	cobglobptr->cob_exception_code = cob_exception_tab_code[id];
+	cobglobptr->cob_exception_id = id;
 	last_exception_code = cobglobptr->cob_exception_code;
 
 	cobglobptr->last_exception_statement = STMT_UNKNOWN;
@@ -2550,6 +2549,14 @@ cob_set_exception (const int id)
 	}
 }
 
+/* reset exception for the exception checker only */
+void
+cob_reset_exception (void) {
+	if (cobglobptr->cob_got_exception) {
+		cobglobptr->cob_got_exception = -1;
+	}
+}
+
 /* add to last exception, set if empty */
 void
 cob_add_exception (const int id)
@@ -9353,6 +9360,10 @@ cob_fatal_error (const enum cob_fatal_error fatal_error)
 	case COB_FERROR_JSON:
 		cob_runtime_error (_("attempt to use non-implemented JSON I/O"));
 		break;
+	case COB_FERROR_FATAL_EC:
+		cob_runtime_error(_("unhandled fatal exception code: %s"),
+			cob_get_last_exception_name ());
+		break;
 	default:
 		/* internal rare error, no need for translation */
 		cob_runtime_error ("unknown failure: %d", fatal_error);

libcob/common.h

@@ -801,7 +801,8 @@ enum cob_fatal_error {
 	COB_FERROR_FUNCTION,
 	COB_FERROR_FREE,
 	COB_FERROR_XML,
-	COB_FERROR_JSON
+	COB_FERROR_JSON,
+	COB_FERROR_FATAL_EC,
 };
 
 /* Exception identifier enumeration */
@@ -1614,14 +1615,16 @@ typedef struct __cob_global {
 	char			*cob_locale_time;	/* Initial locale */
 
 	int			cob_exception_code;	/* current exception code, in contrast to last_exception_code heavily changed */
+	int			cob_exception_id;	/* current exception id, to use with internal exceptions table */
 	int			cob_call_params;	/* Number of current arguments
 									   This is set to the actual number before a CALL
 									   and is stored directly on module entry to its
 									   cob_module structure within cob_module_enter().
 									*/
 	int			cob_initial_external;	/* First external ref */
-	unsigned int		last_exception_line;		/* Last exception: Program source line */
-	unsigned int		cob_got_exception;	/* Exception active (see last_exception) */
+	unsigned int		last_exception_line;	/* Last exception: Program source line */
+	unsigned int		last_exception_fatal;	/* Last exception: is fatal */
+	int			cob_got_exception;	/* Exception active (see last_exception) */
 	unsigned int		cob_screen_initialized;	/* Screen initialized */
 	unsigned int		cob_physical_cancel;	/* Unloading of modules */
 												/* screenio / termio */
@@ -1682,6 +1685,8 @@ COB_EXPIMP void		print_runtime_conf	(void);
 
 COB_EXPIMP void		cob_set_exception	(const int);
 COB_EXPIMP int		cob_last_exception_is	(const int);
+COB_EXPIMP int		cob_last_exception_fatal(void);
+COB_EXPIMP void		cob_reset_exception	(void);
 
 COB_EXPIMP int		cob_last_exit_code	(void);
 COB_EXPIMP const char*	cob_last_runtime_error	(void);
@@ -2083,6 +2088,7 @@ COB_EXPIMP cob_s64_t	cob_s64_pow (cob_s64_t, cob_s64_t);
 /* Functions in call.c */
 
 DECLNORET COB_EXPIMP void	cob_call_error		(void) COB_A_NORETURN;
+DECLNORET COB_EXPIMP void	cob_fatal_exception	(const int) COB_A_NORETURN;
 COB_EXPIMP void		cob_field_constant (cob_field *f, cob_field *t, cob_field_attr *a, void *d);
 
 COB_EXPIMP void		cob_set_cancel		(cob_module *);

libcob/exception.def

@@ -571,31 +571,31 @@ COB_EXCEPTION  (1000, COB_EC_SIZE,
 		"EC-SIZE", 0)
 
 /* Invalid pointer arithmetic */
-COB_EXCEPTION  (1001, COB_EC_SIZE_ADDRESS,
+COB_EXCEPTION  (1000 | (1 << 0), COB_EC_SIZE_ADDRESS,
 		"EC-SIZE-ADDRESS", 1)
 
 /* Exponentiation rules violated */
-COB_EXCEPTION  (1002, COB_EC_SIZE_EXPONENTIATION,
+COB_EXCEPTION  (1000 | (1 << 1), COB_EC_SIZE_EXPONENTIATION,
 		"EC-SIZE-EXPONENTIATION", 1)
 
 /* Implementation-defined size error exception */
-COB_EXCEPTION  (1003, COB_EC_SIZE_IMP,
+COB_EXCEPTION  (1000 | (1 << 2), COB_EC_SIZE_IMP,
 		"EC-SIZE-IMP", 0)
 
 /* Arithmetic overflow in calculation */
-COB_EXCEPTION  (1004, COB_EC_SIZE_OVERFLOW,
+COB_EXCEPTION  (1000 | (1 << 3), COB_EC_SIZE_OVERFLOW,
 		"EC-SIZE-OVERFLOW", 1)
 
 /* Significant digits truncated in store */
-COB_EXCEPTION  (1005, COB_EC_SIZE_TRUNCATION,
+COB_EXCEPTION  (1000 | (1 << 4), COB_EC_SIZE_TRUNCATION,
 		"EC-SIZE-TRUNCATION", 1)
 
 /* Floating-point underflow */
-COB_EXCEPTION  (1006, COB_EC_SIZE_UNDERFLOW,
+COB_EXCEPTION  (1000 | (1 << 5), COB_EC_SIZE_UNDERFLOW,
 		"EC-SIZE-UNDERFLOW", 1)
 
 /* Division by zero */
-COB_EXCEPTION  (1007, COB_EC_SIZE_ZERO_DIVIDE,
+COB_EXCEPTION  (1000 | (1 << 6), COB_EC_SIZE_ZERO_DIVIDE,
 		"EC-SIZE-ZERO-DIVIDE", 1)
 
 

tests/cobol85/report.pl

@@ -236,6 +236,7 @@
 #$cobc_flags{DB203A} = "-fno-ec=data-incompatible";
 #$cobc_flags{DB204A} = "-fno-ec=data-incompatible";
 
+
 # Programs that need to be "visual" inspected
 # NC113M: inspected additional to normal tests for output of hex values
 # SQ101M, SQ201M, SQ207M, SQ208M, SQ209M, SQ210M: send report.log to printer and check result

tests/testsuite.src/data_binary.at

@@ -2261,7 +2261,7 @@ AT_DATA([prog.cob], [
            STOP RUN.
 ])
 
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COMPILE -fno-ec=size-overflow prog.cob], [0], [], [])
 AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], [])
 
 AT_CLEANUP