Merge pull request #40 from opensourcecobol/feature/add_Runtime_error_check

実行時エラーチェックを追加

Author: n-isaka

cobc/cobc.c

@@ -2327,6 +2327,15 @@ main (int argc, char *argv[])
 	/* Process command line arguments */
 	iargs = process_command_line (argc, argv);
 
+	/* Process config file options */
+	if (cb_enable_check_subscript_out_of_bounds) {
+		CB_EXCEPTION_ENABLE (COB_EC_BOUND_SUBSCRIPT) = 1;
+	}
+	if (cb_enable_expect_compute_string_error) {
+		CB_EXCEPTION_ENABLE (COB_EC_DATA_INCOMPATIBLE) = 1;
+	}
+
+
 	/* Check the filename */
 	if (iargs == argc) {
 		fprintf (stderr, "cobc: No input files\n");

cobc/config.def

@@ -60,6 +60,9 @@ CB_CONFIG_BOOLEAN (cb_allow_is_in_sort_key_spec, "allow-is-in-sort-key-spec")
 CB_CONFIG_BOOLEAN (cb_allow_search_key_in_rhs, "allow-search-key-in-rhs")
 CB_CONFIG_BOOLEAN (cb_ignore_invalid_record_contains, "ignore-invalid-record-contains")
 CB_CONFIG_BOOLEAN (cb_zero_division_error, "zero_division_error")
+CB_CONFIG_BOOLEAN (cb_enable_check_subscript_out_of_bounds, "enable-check-subscript-out-of-bounds")
+CB_CONFIG_BOOLEAN (cb_enable_expect_numeric_error, "enable-expect-numeric-error")
+CB_CONFIG_BOOLEAN (cb_enable_expect_compute_string_error, "enable-expect-compute-string-error")
 CB_CONFIG_SUPPORT (cb_author_paragraph, "author-paragraph")
 CB_CONFIG_SUPPORT (cb_memory_size_clause, "memory-size-clause")
 CB_CONFIG_SUPPORT (cb_multiple_file_tape_clause, "multiple-file-tape-clause")

cobc/typeck.c

@@ -4689,6 +4689,56 @@ move_error (cb_tree src, cb_tree dst, const size_t value_flag, const int flag,
 	return 0;
 }
 
+static void
+error_destination (cb_tree x)
+{
+	struct cb_reference     *r;
+	struct cb_field         *f;
+	cb_tree                 loc;
+
+	r = CB_REFERENCE (x);
+	f = CB_FIELD (r->value);
+	loc = CB_TREE (f);
+
+	if (r->offset) {
+		return;
+	}
+
+	if (!strcmp (f->name, "RETURN-CODE") ||
+			!strcmp (f->name, "SORT-RETURN") ||
+			!strcmp (f->name, "NUMBER-OF-CALL-PARAMETERS")) {
+		cb_error (_("Internal register '%s' defined as BINARY-LONG"), f->name);
+	} else if (f->pic) {
+		cb_error_x (loc, _("'%s' defined here as PIC %s"), check_filler_name ((char *)f->name), f->pic->orig);
+	} else {
+		cb_error_x (loc, _("'%s' defined here as a group of length %d"), check_filler_name ((char *)f->name), f->size);
+	}
+}
+
+static int
+move_error2 (cb_tree src, cb_tree dst, const size_t value_flag, const int flag,
+		const int src_flag, const char *msg)
+{
+	cb_tree loc;
+
+	loc = src->source_line ? src : dst;
+	if (value_flag) {
+		/* VALUE clause */
+		cb_error_x (loc, msg);
+	} else {
+		/* MOVE statement */
+		if (flag) {
+			cb_error_x (loc, msg);
+			if (src_flag) {
+				error_destination (src);
+			}
+			error_destination (dst);
+		}
+	}
+
+	return 0;
+}
+
 /* count the number of free places in an alphanumeric edited field */
 static int
 count_pic_alphanumeric_edited (struct cb_field *field)
@@ -5335,6 +5385,11 @@ validate_move (cb_tree src, cb_tree dst, size_t is_value)
 	return 0;
 
 expect_numeric:
+	if (cb_enable_expect_numeric_error) {
+		return move_error2 (src, dst, is_value, 1, 0,
+				   _("Numeric value is expected"));
+	}
+
 	return move_error (src, dst, is_value, cb_warn_strict_typing, 0,
 			   _("Numeric value is expected"));
 
@@ -6029,6 +6084,11 @@ cb_emit_move (cb_tree src, cb_tree dsts)
 	}
 
 	for (l = dsts; l; l = CB_CHAIN (l)) {
+		if (cb_enable_expect_numeric_error) {
+			if (CB_TREE_TAG (src) == CB_TAG_REFERENCE) {
+				cb_emit (cb_build_funcall_2 ("cob_check_mvstrnum", src, CB_VALUE (l)));
+			}
+		}
 		cb_emit (cb_build_move (src, CB_VALUE (l)));
 	}
 }

config/default-en.conf

@@ -148,3 +148,6 @@ allow-is-in-sort-key-spec:		no
 allow-search-key-in-rhs:		no
 ignore-invalid-record-contains:		no
 zero_division_error:			no
+enable-check-subscript-out-of-bounds:	yes
+enable-expect-numeric-error:		yes
+enable-expect-compute-string-error:	yes

config/default-jp.conf

@@ -148,3 +148,6 @@ allow-is-in-sort-key-spec:		no
 allow-search-key-in-rhs:		no
 ignore-invalid-record-contains:		no
 zero_division_error:			yes
+enable-check-subscript-out-of-bounds:	yes
+enable-expect-numeric-error:		yes
+enable-expect-compute-string-error:	yes

config/default.conf

@@ -148,3 +148,6 @@ allow-is-in-sort-key-spec:		no
 allow-search-key-in-rhs:		no
 ignore-invalid-record-contains:		no
 zero_division_error:			no
+enable-check-subscript-out-of-bounds:	no
+enable-expect-numeric-error:		no
+enable-expect-compute-string-error:	no

config/jp-compat.conf

@@ -23,6 +23,9 @@ allow-is-in-sort-key-spec:		yes
 allow-search-key-in-rhs:		yes
 ignore-invalid-record-contains:		yes
 zero_division_error:			yes
+enable-check-subscript-out-of-bounds:	yes
+enable-expect-numeric-error:		yes
+enable-expect-compute-string-error:	yes
 
 # Value: 'any', 'fatal', 'never'
 abort-on-io-exception: 			fatal

libcob/common.c

@@ -1692,6 +1692,35 @@ cob_check_ref_mod (const int offset, const int length, const int size, const cha
 	}
 }
 
+void
+cob_check_mvstrnum (cob_field *src, cob_field *dst)
+{
+	size_t	i;
+
+	switch (COB_FIELD_TYPE (src)) {
+	case COB_TYPE_ALPHANUMERIC:
+	case COB_TYPE_ALPHANUMERIC_ALL:
+	case COB_TYPE_ALPHANUMERIC_EDITED:
+		switch (COB_FIELD_TYPE (dst)) {
+		case COB_TYPE_NUMERIC:
+		/*case COB_TYPE_NUMERIC_DISPLAY:*/
+		case COB_TYPE_NUMERIC_BINARY:
+		case COB_TYPE_NUMERIC_PACKED:
+		case COB_TYPE_NUMERIC_FLOAT:
+		case COB_TYPE_NUMERIC_DOUBLE:
+		case COB_TYPE_NUMERIC_EDITED:
+			for (i=0; i<src->size; i++) {
+				if (! isdigit(COB_FIELD_DATA (src) [i])) {
+					cob_runtime_error ("Numeric value is expected");
+					cob_stop_run (1);
+				}
+			}
+			break;
+		}
+		break;
+    }
+}
+
 unsigned char *
 cob_external_addr (const char *exname, const int exlength)
 {

libcob/common.h

@@ -502,6 +502,8 @@ COB_EXPIMP void cob_check_ref_mod_national		(int, int, int, const char *);
 COB_EXPIMP int  cob_check_env			(const char *, const char *);
 COB_EXPIMP void cob_check_ref_mod			(const int, const int,
 						 const int, const char *);
+COB_EXPIMP void cob_check_mvstrnum			(cob_field *, cob_field *);
+
 
 /* Comparison functions */
 COB_EXPIMP int cob_numeric_cmp			(cob_field *, cob_field *);

tests/atlocal.in

@@ -37,10 +37,12 @@ TEMPLATE="${abs_srcdir}/data-rep.src"
 FLAGS="-std=cobol2002 -debug -Wall ${COBOL_FLAGS}"
 FLAGS_NONE=""
 FLAGS_JP_COMPAT="${FLAGS} ${CONF_JP_COMPAT}"
+FLAGS_JP_COMPAT_NONE="${FLAGS_NONE} ${CONF_JP_COMPAT}"
 FLAGS_LIMIT_TEST="${FLAGS} ${CONF_LIMIT_TEST}"
 COMPILE="${COBC} -x ${FLAGS}"
 COMPILE_DEFAULT="${COBC} -x ${FLAGS_NONE}"
 COMPILE_JP_COMPAT="${COBC} -x ${FLAGS_JP_COMPAT}"
+COMPILE_JP_COMPAT_DEFAULT="${COBC} -x ${FLAGS_JP_COMPAT_NONE}"
 COMPILE_LIMIT_TEST="${COBC} -x ${FLAGS_LIMIT_TEST}"
 COMPILE_ONLY="${COBC} -fsyntax-only ${FLAGS}"
 COMPILE_ONLY_JP_COMPAT="${COBC} -fsyntax-only ${FLAGS_JP_COMPAT}"