Merge SVN 3937

OCamlPro · May 30, 2024 · 7ae30a4 · 7ae30a4
1 parent 1c95bd0
commit 7ae30a4
Show file tree

Hide file tree

Showing 8 changed files with 157 additions and 51 deletions.
diff --git a/build_aux/bootstrap b/build_aux/bootstrap
@@ -96,12 +96,15 @@ autoreconf $AC_OPTS $MAINPATH > $msgs 2>&1; ret=$?
 # Filter aminclude_static as those are only used _within_ another
 #        check so reporting as portability problem is only noise.
 # This has the effect of redirecting some error messages to stdout. 
+# to be moved to the Makefile - currently only usable for bootstrap,
+# but should be done on autogen, too
 
 awk '/^aminclude_static[.]am:/ { msg = msg sep $0; sep = "\n"; next } 
      /Makefile[.]am.+aminclude_static.am.+from here/ { 
      					       msg = ""; sep = ""; next }
      msg { print msg > "/dev/stderr"; msg = "" }
      { print }' $msgs
+rm -rf $msgs
 
 if test $ret -ne 0; then
   echo; echo "ERROR, autoreconf returned $ret - aborting bootstrap" && exit $ret

diff --git a/cobc/codegen.c b/cobc/codegen.c
@@ -11925,6 +11925,12 @@ output_module_init_function (struct cb_program *prog)
 		if (cb_flag_trace) {
 			opt |= COB_MODULE_TRACE;
 		}
+#if 0 /* currently unused */
+		if (cobc_wants_debug
+		 || cb_flag_dump) {
+			opt |= COB_MODULE_DEBUG;
+		}
+#endif
 		output_line ("module->flag_debug_trace |= %d;", opt);
 	}
 	output_line ("module->flag_dump_sect = 0x%02X;", cb_flag_dump);

diff --git a/cobc/field.c b/cobc/field.c
@@ -1240,7 +1240,10 @@ validate_any_length_item (struct cb_field *f)
 		return 1;
 	}
 
-	/* CHECKME: Why do we increase the reference counter here and not in another place? */
+	/* CHECKME: Why do we increase the reference counter here
+	            (to ensure the field is generated)?
+	            Better would be to add the check for 'f->count != 0' to the place
+	            where it possibly is missing... */
 	f->count++;
 	return 0;
 }

diff --git a/cobc/pplex.l b/cobc/pplex.l
@@ -227,7 +227,8 @@ DEFNUM_LITERAL	[+-]?[0-9]*[\.]*[0-9]+
 }
 
 ^[ ]*">>"[ ]?"DISPLAY"[ ]+ {
-	/* OpenCOBOL/GnuCOBOL 2.x extension, 202x: display message during compilation */
+	/* previous OpenCOBOL/GnuCOBOL 2.x extension, added in COBOL 202x with slightly different syntax:
+	   display message during compilation --> needs a dialect option to switch to the appropriate state */
 	display_msg[0] = 0;
 	BEGIN DISPLAY_DIRECTIVE_STATE;
 }

diff --git a/cobc/typeck.c b/cobc/typeck.c
@@ -2351,6 +2351,9 @@ cb_build_identifier (cb_tree x, const int subchk)
 	f = CB_FIELD (v);
 
 	/* BASED check and check for OPTIONAL LINKAGE items */
+
+	/* CHECKME: do we need the field founder to decide?  LINKAGE and flag_item_based
+	            should be available in 'f' already ... */
 	if (current_statement && !suppress_data_exceptions &&
 	    (CB_EXCEPTION_ENABLE (COB_EC_DATA_PTR_NULL) ||
 	     CB_EXCEPTION_ENABLE (COB_EC_PROGRAM_ARG_OMITTED))) {

diff --git a/tests/testsuite.src/run_extensions.at b/tests/testsuite.src/run_extensions.at
@@ -968,6 +968,7 @@ AT_DATA([prog.cob], [
 # note: IBM implies -fodoslide
 AT_CHECK([$COBC -x -std=ibm prog.cob], [0], [], [])
 AT_CHECK([$COMPILE -std=ibm prog.cob], [0], [], [])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
 
 AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], [])
 
@@ -2879,6 +2880,7 @@ STATUS OPENO 2 30
 
 AT_CLEANUP
 
+
 AT_SETUP([ASSIGN with COB_FILE_PATH])
 AT_KEYWORDS([extensions runfile])
 
@@ -5844,7 +5846,7 @@ AT_CHECK([$COMPILE prog.cob], [0], [])
 AT_CLEANUP
 
 
-AT_SETUP([Conditional/define directives (8)])
+AT_SETUP([Conditional / define directives (8)])
 AT_KEYWORDS([extensions directive])
 
 AT_DATA([prog.cob], [

diff --git a/tests/testsuite.src/run_file.at b/tests/testsuite.src/run_file.at
@@ -3830,7 +3830,7 @@ AT_CLEANUP
 
 
 AT_SETUP([INDEXED file variable length record])
-AT_KEYWORDS([runfile WRITE START READ])
+AT_KEYWORDS([runfile OPTIONAL SUPPRESS WRITE START READ])
 
 AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"])
 
@@ -3915,9 +3915,10 @@ AT_DATA([prog.cob], [
 
            Perform tbw-read-next thru tbw-exit.
 
-      * Second test.
            Perform tbw-close thru tbw-exit.
 
+      * Second test.
+
            Perform tbw-delete-file thru tbw-exit.
 
            Perform tbw-open-i-o thru tbw-exit.
@@ -3950,6 +3951,9 @@ AT_DATA([prog.cob], [
            Move spaces to tbw-alt.
            Perform tbw-rewrite thru tbw-exit.
 
+      *>   note: should not have status 02 as it a suppressed alternate key
+      *>         therefore duplicate checks must be skipped
+
       * Finish.
            Perform tbw-close thru tbw-exit.
            Display "Test completed".
@@ -3958,75 +3962,92 @@ AT_DATA([prog.cob], [
       * I/O.
        tbw-Open-I-O.
            If flag-tbw-open
-               Perform tbw-Close thru tbw-Close-exit
-           end-if.
+               Perform tbw-Close thru tbw-Close-exit.
            Display "open".
            Open i-o tbw.
-           Display "open".
+           Display "open done".
            If fs-file-status is less than "10"
-               Set flag-tbw-open to true
-           end-if.
+               Set flag-tbw-open to true.
            Go to tbw-exit.
       *
        tbw-Start-Primary-Greater.
            Display "start > tbw-key".
            Start tbw
                key is greater than tbw-key
-               invalid key Continue
-           end-start.
-           Display "start > tbw-key".
+               invalid key
+                 Display "start > tbw-key inv"
+                 Go to tbw-exit
+               not invalid
+                 Display "start > tbw-key done"
+                 Go to tbw-exit.
+           Display "start > tbw-key "  fs-file-status
            Go to tbw-exit.
       *
        tbw-Start-Alternate.
            Display "start >= tbw-alt".
            Start tbw
                key is not less than tbw-alt
-               invalid key Continue
-           end-start.
-           Display "start >= tbw-alt".
+               invalid key
+      *>Inspect! Display "start >= tbw-alt inv"
+                 Display "start >= tbw-alt done"
+                 Go to tbw-exit
+               not invalid
+                 Display "start >= tbw-alt done"
+                 Go to tbw-exit.
+           Display "start >= tbw-alt "  fs-file-status
            Go to tbw-exit.
       *
        tbw-Read-Next.
            Display "read next".
            Read tbw
                next record
-               at end Continue
-           end-read.
-           Display "read next done".
+               at end 
+                 Display "read next end"
+                 Go to tbw-exit
+               not at end
+                 Display "read next done"
+                 Go to tbw-exit.
+           Display "read next "  fs-file-status
            Go to tbw-exit.
       *
        tbw-Write.
            Display "write".
            Write tbw-record
-               invalid key Continue
-           end-write.
-           Display "write".
+               invalid key
+                 Display "write inv"
+                 Go to tbw-exit
+               not invalid
+                 Display "write done"
+                 Go to tbw-exit.
+           Display "write "  fs-file-status
            Go to tbw-exit.
       *
        tbw-Rewrite.
            Display "rewrite".
            Rewrite tbw-record
-               invalid key Continue
-           end-rewrite.
-           Display "rewrite " fs-file-status.
+               invalid key
+                 Display "rewrite inv "  fs-file-status
+                 Go to tbw-exit
+               not invalid
+                 Display "rewrite done " fs-file-status
+                 Go to tbw-exit.
+           Display "rewrite "  fs-file-status
            Go to tbw-exit.
       *
        tbw-Delete-File.
            If flag-tbw-open
-               Perform tbw-Close thru tbw-Close-exit
-           end-if.
+               Perform tbw-Close thru tbw-Close-exit.
            Move "xx" to fs-file-status.
            Display "delete file".
-           Delete file tbw
-           end-delete.
-           Display "delete file".
+           Delete file tbw.
+           Display "delete file done".
            Go to tbw-exit.
       *
        tbw-Close.
            If flag-tbw-open
                Display "close"
                Close tbw
-               Display "close"
+               Display "close done"
                Set flag-tbw-closed to true
            end-if.
        tbw-Close-exit.
@@ -4039,45 +4060,45 @@ AT_CHECK([$COMPILE prog.cob], [0], [], [])
 
 AT_CHECK([$COBCRUN_DIRECT ./prog], [0],
 [delete file
-delete file
+delete file done
 open
-open
-start > tbw-key
+open done
 start > tbw-key
+start > tbw-key inv
 read next
-read next done
+read next 46
 write
-write
-start >= tbw-alt
+write done
 start >= tbw-alt
+start >= tbw-alt done
 start > tbw-key
-start > tbw-key
+start > tbw-key done
 read next
 read next done
 read next
-read next done
-close
+read next end
 close
+close done
 delete file
-delete file
-open
+delete file done
 open
+open done
 start > tbw-key
-start > tbw-key
+start > tbw-key inv
 read next
-read next done
-write
+read next 46
 write
+write done
 write
-write
-start >= tbw-alt
+write done
 start >= tbw-alt
+start >= tbw-alt done
 read next
 read next done
 rewrite
-rewrite 00
-close
+rewrite done 00
 close
+close done
 Test completed
 ], [])
 
@@ -25856,7 +25877,8 @@ AT_DATA([prog.cob], [
            OPEN OUTPUT f
            WRITE f-rec FROM "a"
            CLOSE f
-
+
+           SET LAST EXCEPTION TO OFF
            >>TURN EC-I-O CHECKING ON
            *> Read f too many times without libcob error
            OPEN INPUT f
@@ -25867,6 +25889,7 @@ AT_DATA([prog.cob], [
 
            DISPLAY f-status
            DISPLAY FUNCTION TRIM(FUNCTION EXCEPTION-STATUS)
+           SET LAST EXCEPTION TO OFF
 
            CLOSE f
 
@@ -25881,6 +25904,7 @@ AT_DATA([prog.cob], [
 
            DISPLAY f-status
            DISPLAY FUNCTION TRIM(FUNCTION EXCEPTION-STATUS)
+           SET LAST EXCEPTION TO OFF
 
            CLOSE f
 
@@ -25906,7 +25930,8 @@ a
 10
 
 a
-], [libcob: prog.cob:61: error: end of file (status = 10) for file g ('out.txt') on READ
+],
+[libcob: prog.cob:61: error: end of file (status = 10) for file g ('out.txt') on READ
 libcob: prog.cob:61: warning: implicit CLOSE of g ('out.txt')
 ])