diff --git a/gcc/cobol/failures/playpen/playpen.cbl b/gcc/cobol/failures/playpen/playpen.cbl index 80755fc361bdbd4613c7a34de9eb99cd5d458656..6eee55391a806c9851dff0f5fc34005f7a3d82d9 100644 --- a/gcc/cobol/failures/playpen/playpen.cbl +++ b/gcc/cobol/failures/playpen/playpen.cbl @@ -1,37 +1,15 @@ IDENTIFICATION DIVISION. - FUNCTION-ID. callee. + PROGRAM-ID. callee. DATA DIVISION. - LOCAL-STORAGE SECTION. - 01 LCL-X PIC 999 . - LINKAGE SECTION. - 01 parm PIC 999. - 01 retval PIC 999. - PROCEDURE DIVISION USING parm RETURNING retval. - display "On entry, parm is: " parm - move parm to lcl-x - move parm to retval - subtract 1 from parm - if parm > 0 - display "A The function returns " function callee(parm). - if lcl-x not equal to retval - display "On exit, lcl-s and retval are: " lcl-x " and " retval - display "But they should be equal to each other" - end-if - goback. - end function callee. - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - FUNCTION callee. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 val PIC 999 VALUE 5. + 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. - DISPLAY "Starting value is: " val - display "B The function returns " function callee(val). - STOP RUN. - end program caller. - + 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 ca520cf062d0480f177fcdbe4122f143b92e9986..fe71f9b6baa5e734365323a0d6b59577f9789028 100644 --- a/gcc/cobol/genapi.cc +++ b/gcc/cobol/genapi.cc @@ -11090,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); @@ -11104,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 )