diff --git a/gcc/cobol/failures/.gitignore b/gcc/cobol/failures/.gitignore
index 2062f0d68afc9be704b6a12170a5f045d09914d3..b58c7495295e25b36b7c9fa4cd12d070eb61e98f 100644
--- a/gcc/cobol/failures/.gitignore
+++ b/gcc/cobol/failures/.gitignore
@@ -10,4 +10,3 @@ dump.txt
*.html
XXXXX*
REPORTT
-playpen/
diff --git a/gcc/cobol/failures/playpen/Makefile b/gcc/cobol/failures/playpen/Makefile
new file mode 100644
index 0000000000000000000000000000000000000000..f77e46b3451abf45cb70ed9dc161be56b3b063c7
--- /dev/null
+++ b/gcc/cobol/failures/playpen/Makefile
@@ -0,0 +1 @@
+include ../Makefile.inc
diff --git a/gcc/cobol/failures/playpen/input.txt b/gcc/cobol/failures/playpen/input.txt
new file mode 100644
index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391
diff --git a/gcc/cobol/failures/playpen/playpen.cbl b/gcc/cobol/failures/playpen/playpen.cbl
new file mode 100644
index 0000000000000000000000000000000000000000..6eee55391a806c9851dff0f5fc34005f7a3d82d9
--- /dev/null
+++ b/gcc/cobol/failures/playpen/playpen.cbl
@@ -0,0 +1,15 @@
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. callee.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 V123 PIC 999 VALUE 123.
+ 01 VALB PIC 999 BASED.
+ 01 VALB2 PIC 999 BASED.
+ 01 VALP POINTER.
+ 01 VALP2 POINTER.
+ PROCEDURE DIVISION.
+ set VALP VALP2 to address of V123.
+ set ADDRESS OF VALB ADDRESS OF VALB2 TO VALP.
+ display VALB.
+ goback.
+ end PROGRAM callee.
diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc
index 4b2e3ad75a2d48ed1c751088a8f76a52181bbfbb..fe71f9b6baa5e734365323a0d6b59577f9789028 100644
--- a/gcc/cobol/genapi.cc
+++ b/gcc/cobol/genapi.cc
@@ -5469,6 +5469,21 @@ parser_division(cbl_division_t division,
// It makes more sense if you don't think about it too hard.
+
+ // We need to be able to restore prior arguments when doing recursive
+ // calls:
+ IF( member(args[i].refer.field->var_decl_node, "data"),
+ ne_op,
+ gg_cast(UCHAR_P, null_pointer_node) )
+ {
+ gg_call(VOID,
+ "__gg__push_local_variable",
+ 1,
+ gg_get_address_of(args[i].refer.field->var_decl_node));
+ }
+ ELSE
+ ENDIF
+
tree base = gg_define_variable(UCHAR_P);
gg_assign(rt_i, build_int_cst_type(INT, i));
IF( rt_i, lt_op , var_decl_call_parameter_count )
@@ -11075,6 +11090,17 @@ parser_set_pointers( size_t ntgt, cbl_refer_t *tgts, cbl_refer_t source )
SHOW_PARSE
{
SHOW_PARSE_HEADER
+ SHOW_PARSE_FIELD(" source ", source.field);
+ char ach[128];
+ sprintf(ach,
+ " source.addr_of %s",
+ source.addr_of ? "TRUE" : "FALSE" );
+ SHOW_PARSE_TEXT(ach);
+ for( size_t i=0; i<ntgt; i++ )
+ {
+ SHOW_PARSE_INDENT
+ SHOW_PARSE_FIELD("target ", tgts[i].field)
+ }
SHOW_PARSE_END
}
refer_fill_source(source);
@@ -11089,8 +11115,8 @@ parser_set_pointers( size_t ntgt, cbl_refer_t *tgts, cbl_refer_t source )
}
else
{
- // When ADDRESS OF TARGET, the target must be linkage:
- gcc_assert( tgts[i].field->attr & linkage_e );
+ // When ADDRESS OF TARGET, the target must be linkage or based
+ gcc_assert( tgts[i].field->attr & (linkage_e | based_e) );
}
if( source.field && !source.addr_of )
diff --git a/gcc/cobol/tests/c-to-cobol/call_stuff.cbl b/gcc/cobol/tests/c-to-cobol/call_stuff.cbl
index 10513501abc73cf67694ea3dc5d1af42d1cac919..a76c2919a856fbd4e184206b239dc8932e974aef 100644
--- a/gcc/cobol/tests/c-to-cobol/call_stuff.cbl
+++ b/gcc/cobol/tests/c-to-cobol/call_stuff.cbl
@@ -6,7 +6,7 @@ WORKING-STORAGE SECTION.
01 CWD PIC X(100).
01 RETURNED-CWD PIC X(100).
01 LEN_OF_CWD PIC 999 VALUE 100.
-01 USR-LOCAL-BIN PIC X(14) VALUE "/usr/local/bin".
+01 USR-LOCAL-BIN PIC X(15) VALUE "/usr/local/bin".
01 CHDIR_RETURN PIC S999 BINARY.
01 var1 pic x(24) VALUE "I shouldn't change".
@@ -17,7 +17,7 @@ WORKING-STORAGE SECTION.
PROCEDURE DIVISION.
- CALL "chdir"
+ MOVE X'00' TO USR-LOCAL-BIN(15:1)
CALL "chdir"
USING BY CONTENT USR-LOCAL-BIN
RETURNING CHDIR_RETURN