Merge branch 'release/v1.5.2J'

Author: n-isaka

ChangeLog

@@ -1,3 +1,7 @@
+2019-04-19  OSS Consortium <[email protected]>
+
+	* opensource COBOL Version 1.5.2J released.
+
 2016-12-09  OSS Consortium <[email protected]>
 
 	* opensource COBOL Version 1.5.1J released.

NEWS

@@ -1,5 +1,44 @@
 NEWS - user visible changes				-*- outline -*-
 
+* Changes in opensource COBOL 1.5.2J
+
+** New features
+
+*** ADD new Error check.
+    (1) Detected division by zero.
+        Compile check: use the character "0".
+        Runtime check: use variable with value 0.
+        
+        Use this option, Add the following values to config.
+        enable-zero-division-error:		yes
+        
+    (2) Check subscript out of bounds.
+        This feature was previously included in the debug options.
+        
+        Use this option, Add the following values to config.
+        enable-check-subscript-out-of-bounds:	yes
+        
+    (3) Expect numeric error.
+        Compile check: Move const string to numeric variable.
+        Runtime check: Move variable included string to numeric variable.
+        
+        Use this option, Add the following values to config.
+        enable-expect-numeric-error:		yes
+        
+    (4) Expect compute string error.
+        This feature was previously included in the debug options.
+        
+        Use this option, Add the following values to config.
+        enable-expect-compute-string-error:	yes
+        
+
+** Bug fixes
+
+*** Correct errors in Japanese translation on cobc help.
+
+
+-----------------------------------------------------------------------
+
 * Changes in opensource COBOL 1.5.1J
 
 ** Bug fixes

cobc/cobc.c

@@ -817,7 +817,7 @@ cobc_sig_handler (int sig)
 static void
 cobc_print_version (void)
 {
-	puts ("opensource COBOL 1.5.1J");
+	puts ("opensource COBOL 1.5.2J");
 	puts ("OSS Consortium's patched version of OpenCOBOL1.1(Feb.06 2009)");
 #ifdef	I18N_UTF8
 	puts ("[unicode/utf-8 support]");
@@ -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/codegen.c

@@ -6,12 +6,12 @@
  * it under the terms of the GNU General Public License as published by
  * the Free Software Foundation; either version 2, or (at your option)
  * any later version.
- * 
+ *
  * This program is distributed in the hope that it will be useful,
  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  * GNU General Public License for more details.
- * 
+ *
  * You should have received a copy of the GNU General Public License
  * along with this software; see the file COPYING.  If not, write to
  * the Free Software Foundation, 51 Franklin Street, Fifth Floor
@@ -1594,7 +1594,7 @@ initialize_type (struct cb_initialize *p, struct cb_field *f, int topfield)
 			} else if (cb_tree_type (CB_TREE (f)) == COB_TYPE_NUMERIC_DISPLAY) {
 				if (f->flag_sign_separate) {
 					return INITIALIZE_ONE;
-				} else if (cb_display_sign == COB_DISPLAY_SIGN_EBCDIC 
+				} else if (cb_display_sign == COB_DISPLAY_SIGN_EBCDIC
 				             && f->pic->have_sign) {
 					return INITIALIZE_ONE;
 				} else {
@@ -3267,6 +3267,12 @@ output_stmt (cb_tree x)
 			output_line ("cob_exception_code = 0;");
 		}
 
+		if (cb_enable_zero_division_error && p->name &&
+			((strcmp (p->name, "DIVIDE") == 0) || (strcmp (p->name, "COMPUTE") == 0)) &&
+				(!p->handler1 && !p->handler2)) {
+			output_line ("cob_error_on_exit_flag = 1;");
+		}
+
 		if (p->null_check) {
 			output_stmt (p->null_check);
 		}

cobc/config.def

@@ -6,12 +6,12 @@
  * it under the terms of the GNU General Public License as published by
  * the Free Software Foundation; either version 2, or (at your option)
  * any later version.
- * 
+ *
  * This program is distributed in the hope that it will be useful,
  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  * GNU General Public License for more details.
- * 
+ *
  * You should have received a copy of the GNU General Public License
  * along with this software; see the file COPYING.  If not, write to
  * the Free Software Foundation, 51 Franklin Street, Fifth Floor
@@ -59,6 +59,10 @@ CB_CONFIG_BOOLEAN (cb_switch_no_mnemonic, "switch-no-mnemonic")
 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_enable_zero_division_error, "enable-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/tree.c

@@ -1324,7 +1324,7 @@ cb_build_picture (const char *str)
 			if (count_value == 0) {
 				goto error;
 			} else if (count_value == CHARACTER_LENGTH_OVERFLOW) {
-				n = CHARACTER_LENGTH_OVERFLOW;	
+				n = CHARACTER_LENGTH_OVERFLOW;
 			} else if (n != CHARACTER_LENGTH_OVERFLOW) {
 				remain = INT_MAX - n;
 				if (remain < (count_value - 1)) {
@@ -1837,7 +1837,7 @@ static void
 compute_composite_key (cb_tree key, struct cb_key_component *component_list)
 {
 	int cb;
-	char pic[32]; 
+	char pic[32];
 	struct cb_key_component *key_component;
 	struct cb_field *composite_key;
 
@@ -1883,7 +1883,7 @@ finalize_file (struct cb_file *f, struct cb_field *records)
 				compute_composite_key (alt_key->key, alt_key->component_list);
 			}
 		}
-	} 
+	}
 
 	/* check the record size if it is limited */
 	if (cb_ignore_invalid_record_contains) {
@@ -2251,6 +2251,12 @@ cb_build_binary_op (cb_tree x, int op, cb_tree y)
 		if (x == cb_error_node || y == cb_error_node) {
 			return cb_error_node;
 		}
+		if (cb_enable_zero_division_error && op == '/') {
+			y = cb_check_zero_division (y);
+			if (y == cb_error_node) {
+				return cb_error_node;
+			}
+		}
 		category = CB_CATEGORY_NUMERIC;
 		break;
 

cobc/tree.h

@@ -260,6 +260,7 @@ extern int		cb_fits_long_long (cb_tree x);
 extern int		cb_get_int (cb_tree x);
 extern int		cb_is_digist_data (cb_tree x);
 extern long long	cb_get_long_long (cb_tree x);
+extern cb_tree          cb_check_zero_division(cb_tree x);
 
 /*
  * Constants

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)));
 	}
 }
@@ -7717,3 +7777,22 @@ cb_build_write_advancing_page (cb_tree pos)
 
 	return cb_int (opt | COB_WRITE_PAGE);
 }
+
+cb_tree
+cb_check_zero_division (cb_tree x)
+{
+	if (x == cb_error_node) {
+		return cb_error_node;
+	}
+
+	if (! CB_NUMERIC_LITERAL_P (x)) {
+		return x;
+	}
+
+	if (cb_get_int(x) == 0) {
+		cb_error_x (x, _("Detected division by zero."));	
+		return cb_error_node;
+	}
+
+	return x;
+}

config/default-en.conf

@@ -22,7 +22,7 @@ assign-clause: mf
 #  3. the value of environment variable 'DATAFILE' or
 #  4. the literal "DATAFILE"
 # If no, the value of the assign clause is the file name.
-# 
+#
 # Value: 'yes', 'no'
 filename-mapping: yes
 
@@ -87,7 +87,7 @@ sticky-linkage: no
 
 # If yes, set the file assign to the external file
 # Value: 'yes', 'no'
-assign_external: no 
+assign_external: no
 
 # If yes, allow non-matching level numbers
 # Value: 'yes', 'no'
@@ -147,3 +147,7 @@ switch-no-mnemonic:			no
 allow-is-in-sort-key-spec:		no
 allow-search-key-in-rhs:		no
 ignore-invalid-record-contains:		no
+enable-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

@@ -22,7 +22,7 @@ assign-clause: mf
 #  3. the value of environment variable 'DATAFILE' or
 #  4. the literal "DATAFILE"
 # If no, the value of the assign clause is the file name.
-# 
+#
 # Value: 'yes', 'no'
 filename-mapping: yes
 
@@ -87,7 +87,7 @@ sticky-linkage: no
 
 # If yes, set the file assign to the external file
 # Value: 'yes', 'no'
-assign_external: no 
+assign_external: no
 
 # If yes, allow non-matching level numbers
 # Value: 'yes', 'no'
@@ -147,3 +147,7 @@ switch-no-mnemonic:			no
 allow-is-in-sort-key-spec:		no
 allow-search-key-in-rhs:		no
 ignore-invalid-record-contains:		no
+enable-zero-division-error:		yes
+enable-check-subscript-out-of-bounds:	yes
+enable-expect-numeric-error:		yes
+enable-expect-compute-string-error:	yes