Merge SVN 4628

OCamlPro · Jun 19, 2024 · 867c805 · 867c805
1 parent 3d1bee8
commit 867c805
Show file tree

Hide file tree

Showing 24 changed files with 78 additions and 0 deletions.
diff --git a/cobc/ChangeLog b/cobc/ChangeLog
@@ -335,6 +335,10 @@
 	* tree.c (cb_init_parse_constants), tree.h, cobc.c: renamed
 	  from cb_init_constants
 
+2022-03-11  Fabrice Le Fessant <[email protected]>
+
+	* config.def, parser.y: add support for the STOP ERROR statement
+
 2022-03-10  Simon Sobisch <[email protected]>
 
 	* pplex.l (next_word_is_comment_paragraph_name): extracted from (ppinput)

diff --git a/cobc/config.def b/cobc/config.def
@@ -241,6 +241,9 @@ CB_CONFIG_SUPPORT (cb_stop_literal_statement, "stop-literal-statement",
 CB_CONFIG_SUPPORT (cb_stop_identifier_statement, "stop-identifier-statement",
 	_("STOP-identifier statement"))
 
+CB_CONFIG_SUPPORT (cb_stop_error_statement, "stop-error-statement",
+	_("STOP ERROR statement"))
+
 CB_CONFIG_SUPPORT (cb_debugging_mode, "debugging-mode",
 	_("DEBUGGING MODE and debugging indicator"))
 

diff --git a/cobc/parser.y b/cobc/parser.y
@@ -15812,6 +15812,13 @@ stop_statement:
 	check_unreached = 1;
 	cobc_cs_check = 0;
   }
+| STOP ERROR /* GCOS */
+  {
+	begin_statement (STMT_STOP_ERROR, 0);
+	cb_verify (cb_stop_error_statement, cb_statement_name[STMT_STOP_ERROR]);
+	cb_emit_stop_error ();
+	check_unreached = 1;
+  }
 | STOP stop_argument
   {
 	begin_statement (STMT_STOP, 0);

diff --git a/cobc/tree.h b/cobc/tree.h
@@ -2430,6 +2430,8 @@ extern void		cb_emit_start (cb_tree, cb_tree, cb_tree, cb_tree);
 
 extern void		cb_emit_stop_run (cb_tree);
 
+extern void		cb_emit_stop_error (void);
+
 extern void		cb_emit_stop_thread (cb_tree);
 
 extern void		cb_emit_string (cb_tree, cb_tree, cb_tree);

diff --git a/cobc/typeck.c b/cobc/typeck.c
@@ -13791,6 +13791,12 @@ cb_emit_stop_run (cb_tree x)
 	cb_emit (CB_BUILD_FUNCALL_1 ("cob_stop_run", cb_build_cast_int (x)));
 }
 
+void
+cb_emit_stop_error (void)
+{
+	cb_emit (CB_BUILD_FUNCALL_0 ("cob_stop_error"));
+}
+
 void
 cb_emit_stop_thread (cb_tree handle)
 {

diff --git a/config/ChangeLog b/config/ChangeLog
@@ -25,6 +25,11 @@
 
 	* general: add 'defaultbyte'
 
+2022-03-11  Fabrice Le Fessant <[email protected]>
+
+	* general: add a stop-error-statement option to allow configuring
+	  the support of the STOP ERROR statement
+
 2022-02-07  David Declerck <[email protected]>
 
 	* gcos-strict.conf, gcos.conf, gcos.words: added config files for

diff --git a/config/acu-strict.conf b/config/acu-strict.conf
@@ -217,6 +217,7 @@ padding-character-clause:		obsolete # not verified yet
 section-segments:			ignore # not verified yet
 stop-literal-statement:			obsolete # not verified yet
 stop-identifier-statement:		unconformable
+stop-error-statement:			unconformable
 same-as-clause:				unconformable
 type-to-clause:				unconformable
 usage-type:					unconformable

diff --git a/config/bs2000-strict.conf b/config/bs2000-strict.conf
@@ -214,6 +214,7 @@ padding-character-clause:		ignore
 section-segments:			obsolete
 stop-literal-statement:			obsolete
 stop-identifier-statement:		unconformable
+stop-error-statement:			unconformable
 same-as-clause:				unconformable
 type-to-clause:				unconformable	# TYPEDEF is reserved but unused
 usage-type:					unconformable

diff --git a/config/cobol2002.conf b/config/cobol2002.conf
@@ -213,6 +213,7 @@ padding-character-clause:		obsolete
 section-segments:			unconformable
 stop-literal-statement:			unconformable
 stop-identifier-statement:		unconformable
+stop-error-statement:			unconformable
 same-as-clause:				ok
 type-to-clause:				ok
 usage-type:					unconformable

diff --git a/config/cobol2014.conf b/config/cobol2014.conf
@@ -214,6 +214,7 @@ padding-character-clause:		unconformable
 section-segments:			unconformable
 stop-literal-statement:			unconformable
 stop-identifier-statement:		unconformable
+stop-error-statement:			unconformable
 same-as-clause:				ok
 type-to-clause:				ok
 usage-type:					unconformable

diff --git a/config/cobol85.conf b/config/cobol85.conf
@@ -213,6 +213,7 @@ padding-character-clause:		ok
 section-segments:			obsolete
 stop-literal-statement:			obsolete
 stop-identifier-statement:		unconformable
+stop-error-statement:			unconformable
 same-as-clause:				unconformable
 type-to-clause:				unconformable
 usage-type:					unconformable

diff --git a/config/default.conf b/config/default.conf
@@ -234,6 +234,7 @@ occurs-max-length-without-subscript:	no
 section-segments:			ignore
 stop-literal-statement:			obsolete
 stop-identifier-statement:		obsolete
+stop-error-statement:			unconformable
 same-as-clause:				ok
 type-to-clause:				ok
 usage-type:					ok

diff --git a/config/gcos-strict.conf b/config/gcos-strict.conf
@@ -216,6 +216,7 @@ padding-character-clause:		ok
 section-segments:			obsolete
 stop-literal-statement:			obsolete
 stop-identifier-statement:		unconformable
+stop-error-statement:			ok
 same-as-clause:				unconformable
 type-to-clause:				unconformable
 usage-type:				unconformable

diff --git a/config/ibm-strict.conf b/config/ibm-strict.conf
@@ -213,6 +213,7 @@ padding-character-clause:		obsolete
 section-segments:			ignore
 stop-literal-statement:			obsolete
 stop-identifier-statement:		unconformable
+stop-error-statement:			unconformable
 same-as-clause:				unconformable
 type-to-clause:				unconformable
 usage-type:					unconformable

diff --git a/config/mf-strict.conf b/config/mf-strict.conf
@@ -215,6 +215,7 @@ padding-character-clause:		obsolete
 section-segments:			ignore
 stop-literal-statement:			obsolete
 stop-identifier-statement:		unconformable
+stop-error-statement:			unconformable
 same-as-clause:				unconformable
 type-to-clause:				unconformable	# only supports USAGE type-name
 usage-type:					ok

diff --git a/config/mvs-strict.conf b/config/mvs-strict.conf
@@ -212,6 +212,7 @@ padding-character-clause:		obsolete
 section-segments:			ignore
 stop-literal-statement:			obsolete
 stop-identifier-statement:		unconformable
+stop-error-statement:			unconformable
 same-as-clause:				unconformable
 type-to-clause:				unconformable
 usage-type:					unconformable

diff --git a/config/realia-strict.conf b/config/realia-strict.conf
@@ -217,6 +217,7 @@ padding-character-clause:		ignore
 section-segments:			unconformable
 stop-literal-statement:			ok
 stop-identifier-statement:		unconformable
+stop-error-statement:			unconformable
 same-as-clause:				unconformable
 type-to-clause:				unconformable
 usage-type:					unconformable

diff --git a/config/rm-strict.conf b/config/rm-strict.conf
@@ -218,6 +218,7 @@ padding-character-clause:		ok
 section-segments:			obsolete
 stop-literal-statement:			obsolete
 stop-identifier-statement:		ok
+stop-error-statement:			unconformable
 same-as-clause:				ok
 type-to-clause:				unconformable
 usage-type:					unconformable

diff --git a/config/xopen.conf b/config/xopen.conf
@@ -223,6 +223,7 @@ section-segments:			unconformable	# complete module removed
 # reportwriter and communication:  complete modules removed
 stop-literal-statement:			warning		# should not be used ...
 stop-identifier-statement:		unconformable
+stop-error-statement:			unconformable
 same-as-clause:				unconformable
 type-to-clause:				unconformable
 usage-type:					unconformable

diff --git a/libcob/ChangeLog b/libcob/ChangeLog
@@ -389,6 +389,10 @@
 						compiler into directory different that declared
 						when compiler was built
 
+2022-03-11  Fabrice Le Fessant <[email protected]>
+
+	* common.c, common.h: add support for the STOP ERROR statement
+
 2022-02-21  Ron Norman <[email protected]>
 
 	* move.c (cob_move_display_to_packed): If P used in PIC adjust data move

diff --git a/libcob/common.c b/libcob/common.c
@@ -3187,6 +3187,13 @@ handle_core_on_error ()
 	return core_on_error;
 }
 
+void
+cob_stop_error (void)
+{
+	cob_runtime_error ("STOP ERROR");
+	cob_hard_failure ();
+}
+
 void
 cob_hard_failure ()
 {

diff --git a/libcob/common.h b/libcob/common.h
@@ -1876,6 +1876,7 @@ COB_EXPIMP void	cob_module_leave		(cob_module *);
 COB_EXPIMP void	cob_module_free	(cob_module **);
 
 DECLNORET COB_EXPIMP void	cob_stop_run	(const int) COB_A_NORETURN;
+DECLNORET COB_EXPIMP void	cob_stop_error	(void) COB_A_NORETURN;
 DECLNORET COB_EXPIMP void	cob_fatal_error	(const enum cob_fatal_error) COB_A_NORETURN;
 DECLNORET COB_EXPIMP void	cob_hard_failure_internal (const char *) COB_A_NORETURN;
 DECLNORET COB_EXPIMP void	cob_hard_failure (void) COB_A_NORETURN;

diff --git a/tests/testsuite.src/configuration.at b/tests/testsuite.src/configuration.at
@@ -473,6 +473,7 @@ test.conf: missing definitions:
 	no definition of 'goto-statement-without-name'
 	no definition of 'stop-literal-statement'
 	no definition of 'stop-identifier-statement'
+	no definition of 'stop-error-statement'
 	no definition of 'debugging-mode'
 	no definition of 'use-for-debugging'
 	no definition of 'padding-character-clause'

diff --git a/tests/testsuite.src/run_misc.at b/tests/testsuite.src/run_misc.at
@@ -5273,6 +5273,31 @@ AT_CHECK([$COBCRUN_DIRECT ./prog], [1])
 AT_CLEANUP
 
 
+AT_SETUP([STOP ERROR])
+AT_KEYWORDS([runmisc])
+
+AT_DATA([prog.cob], [
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       PROCEDURE        DIVISION.
+           CALL "prog2".
+           DISPLAY "Whatever".
+           STOP RUN.
+       END PROGRAM      prog.
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog2.
+       PROCEDURE        DIVISION.
+           STOP ERROR.
+])
+
+AT_CHECK([$COMPILE prog.cob -fstop-error-statement=ok], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [],
+[libcob: prog.cob:12: error: STOP ERROR
+])
+
+AT_CLEANUP
+
+
 AT_SETUP([SYMBOLIC clause])
 AT_KEYWORDS([runmisc ALPHABET])