diff --git a/gcc/cobol/UAT/testsuite.src/run_misc.at b/gcc/cobol/UAT/testsuite.src/run_misc.at
index 7bb5fbed558106774bbceef211ef6f74eaf04eb3..0434296447ea3c725c9952fff148e923b016f831 100644
--- a/gcc/cobol/UAT/testsuite.src/run_misc.at
+++ b/gcc/cobol/UAT/testsuite.src/run_misc.at
@@ -2573,7 +2573,7 @@ AT_DATA([prog.cob], [
DATA DIVISION.
WORKING-STORAGE SECTION.
01 TSRDF.
- 05 WS-ASK-ID-DATE PIC X(10) VALUE ALL '*'.
+ 05 WS-ASK-ID-DATE PIC X(10).
05 WS-ASK-ID-DATE-R REDEFINES WS-ASK-ID-DATE.
10 WS-ASK-ID-DATE-YYYY PIC 9(4) VALUE 2017.
10 FILLER PIC X VALUE '-'.
@@ -2581,6 +2581,7 @@ AT_DATA([prog.cob], [
10 FILLER PIC X VALUE '-'.
10 WS-ASK-ID-DATE-DD PIC 9(2).
PROCEDURE DIVISION.
+ MOVE ALL '*' TO WS-ASK-ID-DATE
MOVE 2015 TO WS-ASK-ID-DATE-YYYY
MOVE 08 TO WS-ASK-ID-DATE-MM
MOVE 21 TO WS-ASK-ID-DATE-DD
diff --git a/gcc/cobol/tests/initialize_2/Makefile b/gcc/cobol/tests/initialize_2/Makefile
deleted file mode 100644
index f77e46b3451abf45cb70ed9dc161be56b3b063c7..0000000000000000000000000000000000000000
--- a/gcc/cobol/tests/initialize_2/Makefile
+++ /dev/null
@@ -1 +0,0 @@
-include ../Makefile.inc
diff --git a/gcc/cobol/tests/initialize_2/UseGlobal.cbl.example b/gcc/cobol/tests/initialize_2/UseGlobal.cbl.example
deleted file mode 100644
index 268777a8ee92bd60bc29b75af0f449b4c66cd8ba..0000000000000000000000000000000000000000
--- a/gcc/cobol/tests/initialize_2/UseGlobal.cbl.example
+++ /dev/null
@@ -1,49 +0,0 @@
- IDENTIFICATION DIVISION.
- PROGRAM-ID. IC233A.
- ENVIRONMENT DIVISION.
- CONFIGURATION SECTION.
- SOURCE-COMPUTER.
- GNU-Linux.
- OBJECT-COMPUTER.
- GNU-Linux.
- INPUT-OUTPUT SECTION.
- FILE-CONTROL.
- SELECT PRINT-FILE ASSIGN TO
- REPORTT.
- SELECT OPTIONAL TEST-FILE ASSIGN TO
- "XXXXX018".
- DATA DIVISION.
- FILE SECTION.
- FD PRINT-FILE.
- 01 PRINT-REC PICTURE X(120).
- 01 DUMMY-RECORD PICTURE X(120).
- FD TEST-FILE GLOBAL.
- 01 TEST-REC PIC X(20).
- PROCEDURE DIVISION.
- DECLARATIVES.
- SECT-IC233A-001 SECTION.
- USE GLOBAL AFTER ERROR PROCEDURE ON INPUT.
- USE-TEST-2.
- DISPLAY "At USE-TEST-2".
- END DECLARATIVES.
- CALL "IC233A-1".
-
- IDENTIFICATION DIVISION.
- PROGRAM-ID. IC233A-1.
- PROCEDURE DIVISION.
- *> DECLARATIVES.
- *> SECT-IC233A-001 SECTION.
- *> USE AFTER ERROR PROCEDURE ON INPUT.
- *> USE-INPUT-ERROR.
- *> DISPLAY "At USE-INPUT-ERROR".
- *> END DECLARATIVES.
- SECT-IC233A-1-001 SECTION.
- USE-INIT-1.
- OPEN INPUT TEST-FILE.
- DISPLAY "After open "
- READ TEST-FILE.
- DISPLAY "After read ".
- END-PROG.
- EXIT PROGRAM.
- END PROGRAM IC233A-1.
- END PROGRAM IC233A.
diff --git a/gcc/cobol/tests/initialize_2/input.txt b/gcc/cobol/tests/initialize_2/input.txt
deleted file mode 100644
index 6e4186aca58aa94ddf74133dabe2a63b25e333bd..0000000000000000000000000000000000000000
--- a/gcc/cobol/tests/initialize_2/input.txt
+++ /dev/null
@@ -1,16 +0,0 @@
-Iowa
-100000
-Georgia
-FL
-DE
-Missouri
-Indiana
-1500000
-nh
-10000000
-New Hampshirex
-Phoenixx
-Albanyx
-Salemx
-MX
-North Dakotax
diff --git a/gcc/cobol/tests/initialize_2/known-good.txt b/gcc/cobol/tests/initialize_2/known-good.txt
deleted file mode 100644
index b0c880a366202483d4a586b98fb9cf1cc2609a00..0000000000000000000000000000000000000000
--- a/gcc/cobol/tests/initialize_2/known-good.txt
+++ /dev/null
@@ -1,10 +0,0 @@
-The date is 2015*08*21 Compiled
-The date is 0000*08*21 INITIALIZE
-The date is 0000 08 21 WITH FILLER
-The date is 2017 08 21 WITH FILLER
-The date is 2017-08-21 ALL TO VALUE
-"123456"
-" "
-"123456"
-"XXXXXX"
-"123X56"
diff --git a/gcc/cobol/tests/initialize_2/playpen.cbl b/gcc/cobol/tests/initialize_2/playpen.cbl
deleted file mode 100644
index 82b1ba25e4a5353c340af6823d6b8c493dbc5369..0000000000000000000000000000000000000000
--- a/gcc/cobol/tests/initialize_2/playpen.cbl
+++ /dev/null
@@ -1,56 +0,0 @@
-
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 TSRDF.
- 05 WS-ASK-ID-DATE PIC X(10) VALUE ALL '*'.
- 05 WS-ASK-ID-DATE-R REDEFINES WS-ASK-ID-DATE.
- 10 WS-ASK-ID-DATE-YYYY PIC 9(4) VALUE 2017.
- 10 FILLER PIC X VALUE '-'.
- 10 WS-ASK-ID-DATE-MM PIC 9(2).
- 10 FILLER PIC X VALUE '-'.
- 10 WS-ASK-ID-DATE-DD PIC 9(2).
-
- 01 TABL VALUE "123456".
- 02 T PIC X OCCURS 6 VALUE 'X'.
-
-
- PROCEDURE DIVISION.
- MOVE 2015 TO WS-ASK-ID-DATE-YYYY
- MOVE 08 TO WS-ASK-ID-DATE-MM
- MOVE 21 TO WS-ASK-ID-DATE-DD
- DISPLAY "The date is " WS-ASK-ID-DATE " Compiled".
-
- INITIALIZE WS-ASK-ID-DATE-R.
- MOVE 08 TO WS-ASK-ID-DATE-MM
- MOVE 21 TO WS-ASK-ID-DATE-DD
- DISPLAY "The date is " WS-ASK-ID-DATE " INITIALIZE".
-
- INITIALIZE WS-ASK-ID-DATE-R WITH FILLER.
- MOVE 08 TO WS-ASK-ID-DATE-MM
- MOVE 21 TO WS-ASK-ID-DATE-DD
- DISPLAY "The date is " WS-ASK-ID-DATE " WITH FILLER".
-
- INITIALIZE WS-ASK-ID-DATE-R ALL TO VALUE
- MOVE 08 TO WS-ASK-ID-DATE-MM
- MOVE 21 TO WS-ASK-ID-DATE-DD
- DISPLAY "The date is " WS-ASK-ID-DATE " WITH FILLER".
-
- INITIALIZE WS-ASK-ID-DATE-R WITH FILLER ALL TO VALUE.
- MOVE 08 TO WS-ASK-ID-DATE-MM
- MOVE 21 TO WS-ASK-ID-DATE-DD
- DISPLAY "The date is " WS-ASK-ID-DATE " ALL TO VALUE".
-
- DISPLAY """" TABL """"
- INITIALIZE TABL
- DISPLAY """" TABL """"
- INITIALIZE TABL ALL VALUE
- DISPLAY """" TABL """"
- INITIALIZE T ALL VALUE
- DISPLAY """" TABL """"
- INITIALIZE TABL ALL VALUE
- INITIALIZE T(4) ALL VALUE.
- DISPLAY """" TABL """"
-
- STOP RUN.
diff --git a/gcc/cobol/tests/initialize_3/Makefile b/gcc/cobol/tests/initialize_3/Makefile
deleted file mode 100644
index f77e46b3451abf45cb70ed9dc161be56b3b063c7..0000000000000000000000000000000000000000
--- a/gcc/cobol/tests/initialize_3/Makefile
+++ /dev/null
@@ -1 +0,0 @@
-include ../Makefile.inc
diff --git a/gcc/cobol/tests/initialize_3/UseGlobal.cbl.example b/gcc/cobol/tests/initialize_3/UseGlobal.cbl.example
deleted file mode 100644
index 268777a8ee92bd60bc29b75af0f449b4c66cd8ba..0000000000000000000000000000000000000000
--- a/gcc/cobol/tests/initialize_3/UseGlobal.cbl.example
+++ /dev/null
@@ -1,49 +0,0 @@
- IDENTIFICATION DIVISION.
- PROGRAM-ID. IC233A.
- ENVIRONMENT DIVISION.
- CONFIGURATION SECTION.
- SOURCE-COMPUTER.
- GNU-Linux.
- OBJECT-COMPUTER.
- GNU-Linux.
- INPUT-OUTPUT SECTION.
- FILE-CONTROL.
- SELECT PRINT-FILE ASSIGN TO
- REPORTT.
- SELECT OPTIONAL TEST-FILE ASSIGN TO
- "XXXXX018".
- DATA DIVISION.
- FILE SECTION.
- FD PRINT-FILE.
- 01 PRINT-REC PICTURE X(120).
- 01 DUMMY-RECORD PICTURE X(120).
- FD TEST-FILE GLOBAL.
- 01 TEST-REC PIC X(20).
- PROCEDURE DIVISION.
- DECLARATIVES.
- SECT-IC233A-001 SECTION.
- USE GLOBAL AFTER ERROR PROCEDURE ON INPUT.
- USE-TEST-2.
- DISPLAY "At USE-TEST-2".
- END DECLARATIVES.
- CALL "IC233A-1".
-
- IDENTIFICATION DIVISION.
- PROGRAM-ID. IC233A-1.
- PROCEDURE DIVISION.
- *> DECLARATIVES.
- *> SECT-IC233A-001 SECTION.
- *> USE AFTER ERROR PROCEDURE ON INPUT.
- *> USE-INPUT-ERROR.
- *> DISPLAY "At USE-INPUT-ERROR".
- *> END DECLARATIVES.
- SECT-IC233A-1-001 SECTION.
- USE-INIT-1.
- OPEN INPUT TEST-FILE.
- DISPLAY "After open "
- READ TEST-FILE.
- DISPLAY "After read ".
- END-PROG.
- EXIT PROGRAM.
- END PROGRAM IC233A-1.
- END PROGRAM IC233A.
diff --git a/gcc/cobol/tests/initialize_3/input.txt b/gcc/cobol/tests/initialize_3/input.txt
deleted file mode 100644
index 6e4186aca58aa94ddf74133dabe2a63b25e333bd..0000000000000000000000000000000000000000
--- a/gcc/cobol/tests/initialize_3/input.txt
+++ /dev/null
@@ -1,16 +0,0 @@
-Iowa
-100000
-Georgia
-FL
-DE
-Missouri
-Indiana
-1500000
-nh
-10000000
-New Hampshirex
-Phoenixx
-Albanyx
-Salemx
-MX
-North Dakotax
diff --git a/gcc/cobol/tests/initialize_3/known-good.txt b/gcc/cobol/tests/initialize_3/known-good.txt
deleted file mode 100644
index 666f0ea4d12c7ca94f2470d39cb8d20f2537f7e6..0000000000000000000000000000000000000000
--- a/gcc/cobol/tests/initialize_3/known-good.txt
+++ /dev/null
@@ -1,18 +0,0 @@
-VAR1 is "aaaaaaaabbbbbbbbcccccccc"
-should be "aaaaaaaabbbbbbbbcccccccc"
-
-VAR1 is " "
-should be " "
-
-VAR1 is "aaaaaaaabbbbbbbbcccccccc"
-should be "aaaaaaaabbbbbbbbcccccccc"
-
-VAR1 is " "
-should be " "
-
-VAR1 is "111111112222222233333333"
-should be "111111112222222233333333"
-
-VAR1 is "1111111122222222xxxxyyyy"
-should be "1111111122222222xxxxyyyy"
-
diff --git a/gcc/cobol/tests/initialize_3/playpen.cbl b/gcc/cobol/tests/initialize_3/playpen.cbl
deleted file mode 100644
index 93344e58a46c6e2b4761ef75585ae681572dbd3d..0000000000000000000000000000000000000000
--- a/gcc/cobol/tests/initialize_3/playpen.cbl
+++ /dev/null
@@ -1,43 +0,0 @@
-
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 VAR1 VALUE "aaaaaaaabbbbbbbbcccccccc".
- 05 VAR1A PIC X(8) VALUE "11111111".
- 05 VAR1B PIC X(8) VALUE "22222222".
- 05 VAR2 VALUE "33333333".
- 10 VAR2A PIC X(4) VALUE "xxxx".
- 10 VAR2B PIC X(4) VALUE "yyyy".
-
- PROCEDURE DIVISION.
- DISPLAY "VAR1 is " """" VAR1 """"
- DISPLAY "should be " """" "aaaaaaaabbbbbbbbcccccccc" """"
- DISPLAY ""
-
- INITIALIZE VAR1
- DISPLAY "VAR1 is " """" VAR1 """"
- DISPLAY "should be " """" " " """"
- DISPLAY ""
-
- INITIALIZE VAR1 ALL VALUE
- DISPLAY "VAR1 is " """" VAR1 """"
- DISPLAY "should be " """" "aaaaaaaabbbbbbbbcccccccc" """"
- DISPLAY ""
-
- INITIALIZE VAR1A VAR1B VAR2
- DISPLAY "VAR1 is " """" VAR1 """"
- DISPLAY "should be " """" " " """"
- DISPLAY ""
-
- INITIALIZE VAR1A VAR1B VAR2 ALL TO VALUE
- DISPLAY "VAR1 is " """" VAR1 """"
- DISPLAY "should be " """" "111111112222222233333333" """"
- DISPLAY ""
-
- INITIALIZE VAR2A VAR2B ALL TO VALUE
- DISPLAY "VAR1 is " """" VAR1 """"
- DISPLAY "should be " """" "1111111122222222xxxxyyyy" """"
- DISPLAY ""
-
- STOP RUN.
diff --git a/libgcobol/libgcobol.cc b/libgcobol/libgcobol.cc
index c4d7d523acc36873965feef7d5343f31a699f56c..9a356356aabb1f12c2ec4a2ddbc514455682839d 100644
--- a/libgcobol/libgcobol.cc
+++ b/libgcobol/libgcobol.cc
@@ -61,6 +61,10 @@
#include "ec.h"
#include "../gcc/cobol/except.h"
+// This couldn't be defined in symbols.h because it conflicts with a LEVEL66
+// in parse.h
+#define LEVEL66 (66)
+#define LEVEL88 (88)
// These global variables are returned when the functions
// EXCEPTION-FILE
@@ -2563,7 +2567,7 @@ format_for_display_internal(char **dest,
case FldClass:
{
- if( var->level != 88 )
+ if( var->level != LEVEL88 )
{
size_t retsize = MINIMUM_ALLOCATION_SIZE;
memset(*dest, 0, retsize);
@@ -4020,14 +4024,15 @@ init_var_both(cblc_field_t *var,
char *local_initial = as_initial(var->initial);
-// if( var->type != FldClass && var->level != 88 )
+// if( var->type != FldClass && var->level != LEVEL88 )
// {
// // Do nothing to these types here
// }
// else
- if( var->type == FldClass || var->level != 88 )
+ if( var->type == FldClass || var->level != LEVEL88 )
+ if( var->type == FldClass )
{
- if( var->level == 88 )
+ if( var->level == LEVEL88 )
{
// We need to convert the options to the internal native codeset
@@ -4090,8 +4095,6 @@ init_var_both(cblc_field_t *var,
}
}
- bool a_parent_initialized = false;
-
// Next order of business: When the variable was allocated in
// parser_symbol_add(), only LEVEL 01 variables had memory allocated. All
// child variables were given NULL data pointers. It is at this point that
@@ -4116,6 +4119,17 @@ init_var_both(cblc_field_t *var,
return;
}
+ if( !(var->attr & based_e) && (var->attr & external_e) )
+ {
+ // These types can't be initialized
+ return;
+ }
+
+ // There are times, for example, when we are table with OCCURS, that we
+ // look like a variable with no initial, and we might be tempted to set our
+ // memory to the default. But if a parent has been initialized, we must not
+ // touch our memory:
+ bool a_parent_initialized = false;
if( var->data && !explicitly )
{
while(parent)
@@ -4133,13 +4147,7 @@ init_var_both(cblc_field_t *var,
}
}
- if( !(var->attr & based_e) && (var->attr & external_e) )
- {
- // These types can't be initialized
- return;
- }
-
- if( is_redefined || a_parent_initialized )
+ if( is_redefined || a_parent_initialized || var->level == LEVEL66 || var->level == LEVEL88)
{
// Don't initialize variables that have the REDEFINES clause. Many things
// in COBOL programs don't work if you do, in particular the initialization