diff --git a/gcc/cobol/UAT/bugsuite.src/bugs.at b/gcc/cobol/UAT/bugsuite.src/bugs.at
index 62329fafb3a25a328a789367c54c00a441d8f20d..b3d782cb2183725c9a6ce6dcb1c8b717506f3ee2 100644
--- a/gcc/cobol/UAT/bugsuite.src/bugs.at
+++ b/gcc/cobol/UAT/bugsuite.src/bugs.at
@@ -253,3 +253,27 @@ AT_CHECK([./a.out], [0],
 * BDBBBDB              00 00 30 BDWWWDB              
 ], [])
 AT_CLEANUP
+
+
+AT_SETUP([Multiple INDEXED BY variables with the same name])
+#
+# This compilation should succeed
+#
+AT_KEYWORDS([bugs])
+AT_DATA([prog.cob], [       IDENTIFICATION DIVISION.
+       PROGRAM-ID. prog.
+       DATA DIVISION.
+       WORKING-STORAGE SECTION.
+       01  GROUP-1-TABLE.
+           05  TABLE-LEVEL-1.
+               06  TABLE-ITEM PICTURE X OCCURS 15 TIMES INDEXED BY IND.
+               88  EQUALS-M   VALUE "M".
+       01  GROUP-2-TABLE.
+           05  TABLE-LEVEL-1.
+               06  TABLE-ITEM PICTURE X OCCURS 15 TIMES INDEXED BY IND.
+               88  EQUALS-M   VALUE "M".
+       PROCEDURE DIVISION.
+            goback.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CLEANUP
diff --git a/gcc/cobol/failures/Makefile.inc b/gcc/cobol/failures/Makefile.inc
index b9c767350bd976ff3672e71cfa602f64745a5439..4a1044143e1c5c72f53f625a70b5cc85801cd711 100644
--- a/gcc/cobol/failures/Makefile.inc
+++ b/gcc/cobol/failures/Makefile.inc
@@ -38,7 +38,7 @@ endif
 #        $(DEBUG) -O0 -o $(basename $(SOURCE_FILE)).s
 #endif
 	$(GCC_BIN)/$(GCOBOL) -main $(SEARCH_PATHS) $(DEBUG) -O0 -o test $(GCOPTIONS) $(SOURCE_FILE) \
-        $(COBOL_RUNTIME_LIBRARY) -Wa,-a > $(basename $(SOURCE_FILE)).lst
+        $(COBOL_RUNTIME_LIBRARY) -Wa,-a | sed -e '/^\f.*$$/d' -e '/^$$/d' > $(basename $(SOURCE_FILE)).lst
 	./test < input.txt
 ifneq ("$(AFTER)","")
 	./$(AFTER)
@@ -67,7 +67,7 @@ tests:
 	$(GCC_BIN)/$(GCOBOL) -main $(SEARCH_PATHS) $(DEBUG) -O0 -S -o test.s $(GCOPTIONS) $(SOURCE_FILE)
 	$(GCC_BIN)/$(GCOBOL) -main $(SEARCH_PATHS) $(DEBUG) -O0    -o test   $(GCOPTIONS) $(SOURCE_FILE) \
         $(COBOL_RUNTIME_LIBRARY) \
-        -Wa,-a > $(basename $(SOURCE_FILE)).lst
+        -Wa,-a | sed -e '/^\f.*$$/d' -e '/^$$/d' > $(basename $(SOURCE_FILE)).lst
 
 .PHONY: gc
 gc:
diff --git a/gcc/cobol/failures/playpen/copybook.cpy b/gcc/cobol/failures/playpen/copybook.cpy
new file mode 100644
index 0000000000000000000000000000000000000000..b8589883d090a912170f152844d764223b73bcd3
--- /dev/null
+++ b/gcc/cobol/failures/playpen/copybook.cpy
@@ -0,0 +1,4 @@
+            display "I am copybook:1"
+            display "I am copybook:2"
+            display "I am copybook:3"
+            display "I am copybook:4"
diff --git a/gcc/cobol/failures/playpen/one.cpy b/gcc/cobol/failures/playpen/one.cpy
deleted file mode 100644
index a5afc3edef9752c0275f7436041b3ca7d0be9ffb..0000000000000000000000000000000000000000
--- a/gcc/cobol/failures/playpen/one.cpy
+++ /dev/null
@@ -1,2 +0,0 @@
-        display "I am copybook one"
-        copy two.
diff --git a/gcc/cobol/failures/playpen/playpen b/gcc/cobol/failures/playpen/playpen
deleted file mode 100755
index 27e256e1859345d39780260b7c6307933f2071f4..0000000000000000000000000000000000000000
Binary files a/gcc/cobol/failures/playpen/playpen and /dev/null differ
diff --git a/gcc/cobol/failures/playpen/playpen.cbl b/gcc/cobol/failures/playpen/playpen.cbl
index ee548dba244784c751bbde245c705f9eef9c971c..04f02a4112a3c177739815aa99a0c199f54fc4cf 100644
--- a/gcc/cobol/failures/playpen/playpen.cbl
+++ b/gcc/cobol/failures/playpen/playpen.cbl
@@ -1,8 +1,13 @@
-        identification      division.
-        program-id.         prog.
-        procedure           division.
-        display "I am the alpha"
-        copy one.
-        display "I am the omega"
-        goback.
+        identification          division.
+        program-id.             prog.
+        procedure               division.
+            display "I am prog:4"
+            display "I am prog:5"
+            display "I am prog:6".
+            copy    copybook.
+            display "I am prog:8"
+            display "I am prog:9"
+            display "I am prog:10"
+            goback.
+        end program             prog.
 
diff --git a/gcc/cobol/failures/playpen/three.cpy b/gcc/cobol/failures/playpen/three.cpy
deleted file mode 100644
index 8263820671d16c785540c50cd5aab6cd62fe0bee..0000000000000000000000000000000000000000
--- a/gcc/cobol/failures/playpen/three.cpy
+++ /dev/null
@@ -1 +0,0 @@
-        display "I am copybook three"
diff --git a/gcc/cobol/failures/playpen/two.cpy b/gcc/cobol/failures/playpen/two.cpy
deleted file mode 100644
index 5b9db0dd4803a61a199f1959f64d06144311da04..0000000000000000000000000000000000000000
--- a/gcc/cobol/failures/playpen/two.cpy
+++ /dev/null
@@ -1,3 +0,0 @@
-        display "I am copybook two"
-        copy three.
-