From b3f799b880967263120675dcfddd76d37f98bc84 Mon Sep 17 00:00:00 2001
From: David Declerck <david.declerck@ocamlpro.com>
Date: Fri, 31 May 2024 17:51:00 +0200
Subject: [PATCH] Merge SVN 3945

---
 NEWS                                  |  4 +-
 tests/testsuite.src/run_extensions.at | 68 +++++++++++++++++++++++++++
 2 files changed, 70 insertions(+), 2 deletions(-)

diff --git a/NEWS b/NEWS
index 8d2beb73f..2dcf6e6bb 100644
--- a/NEWS
+++ b/NEWS
@@ -469,7 +469,7 @@ Open Plans:
    still applied;
    File name mapping now applies both to COBOL statements and CALLable
    CBL_ and C$ file routines.
-   
+
 ** Screen I/O: initial mouse support (for details see runtime.cfg),
    use of CURSOR clause in SPECIAL-NAMES for positioning on ACCEPT
 
@@ -522,7 +522,7 @@ Open Plans:
        not included in -Wall any more
    -Wno-ignored-error allows to suppress messages that normally would be an
        error and are only allowed because they are never executed
-   -Wcorresponding is now enabled by default
+   -Wimplicit-define and -Wcorresponding are now enabled by default
 
    -f[no]-diagnostics-show-option, enabled by default, shows the
     command line option responsible for the diagnostic message
diff --git a/tests/testsuite.src/run_extensions.at b/tests/testsuite.src/run_extensions.at
index c603daa54..27de88b76 100644
--- a/tests/testsuite.src/run_extensions.at
+++ b/tests/testsuite.src/run_extensions.at
@@ -1274,6 +1274,74 @@ GRP-5:***Mon49eyMon49eyMon49eyMon49eyMon49eyMon49eyMon49eyMon
 AT_CLEANUP
 
 
+AT_SETUP([INITIALIZE OCCURS UNBOUNDED])
+AT_KEYWORDS([extensions runsubscripts subscripts refmod INITIALIZE])
+
+AT_DATA([prog.cob], [
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01  p            USAGE POINTER.
+       01  p2           USAGE POINTER.
+
+       LINKAGE SECTION.
+       01  a-table.
+           03  prefix.
+               05  n    PIC 9(03)  VALUE 123.
+           03  table-data value all "ABCDE".
+            04  rows    OCCURS 0 TO UNBOUNDED TIMES
+                        DEPENDING ON n.
+               05 col1  PIC X.
+               05 col2  PIC X(02).
+
+       PROCEDURE DIVISION.
+           ALLOCATE LENGTH OF prefix CHARACTERS
+                    RETURNING p
+           SET ADDRESS OF a-table TO p
+           INITIALIZE prefix ALL TO VALUE
+           IF FUNCTION LENGTH (a-table) NOT = 372
+              DISPLAY 'WRONG LENGTH table: ' FUNCTION LENGTH (a-table)
+              END-DISPLAY
+           END-IF
+           ALLOCATE FUNCTION LENGTH (a-table) CHARACTERS
+                    RETURNING p2
+           SET ADDRESS OF a-table TO p2
+           FREE p
+           INITIALIZE prefix ALL TO VALUE
+      *> FIXME: broken - initializes up to max but only should initialize
+      *>        up to current size   INITIALIZE table-data ALL TO VALUE
+      *>  INITIALIZE table-data  ALL TO VALUE
+      *> FIXME: broken - FUNCTION LENGTH(table-data) must be resolved
+      *>        at run-time but is currently set to max at compile-time
+      *>   INITIALIZE table-data (1:FUNCTION LENGTH(table-data))
+      *>              ALL TO VALUE
+           INITIALIZE table-data (1:FUNCTION LENGTH(rows(1)) * n)
+                      ALL TO VALUE
+           IF col2(1) NOT = "BC"
+              DISPLAY "col2(1) wrong: " col2(1)
+              END-DISPLAY
+           END-IF
+           IF rows(2) NOT = "DEA"
+              DISPLAY "rows(2) wrong: " rows(2)
+              END-DISPLAY
+           END-IF
+           DISPLAY LENGTH OF a-table
+      *>   check if ref-mod also works as expected
+           MOVE ALL ZEROES TO a-table (1: (LENGTH OF a-table))
+           .
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+
+# multiple issues, see comments above
+AT_XFAIL_IF(true)
+
+AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], [])
+
+AT_CLEANUP
+
+
 AT_SETUP([DEPENDING ON with ODOSLIDE])
 AT_KEYWORDS([nested ODO])