diff options
Diffstat (limited to 'gcc/fortran/trans-io.c')
-rw-r--r-- | gcc/fortran/trans-io.c | 30 |
1 files changed, 22 insertions, 8 deletions
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index 4d7695e..4b70871 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -1712,7 +1712,7 @@ gfc_trans_dt_end (gfc_code * code) } static void -transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr); +transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code); /* Given an array field in a derived type variable, generate the code for the loop that iterates over array elements, and the code that @@ -1780,7 +1780,7 @@ transfer_array_component (tree expr, gfc_component * cm) /* Now se.expr contains an element of the array. Take the address and pass it to the IO routines. */ tmp = build_fold_addr_expr (se.expr); - transfer_expr (&se, &cm->ts, tmp); + transfer_expr (&se, &cm->ts, tmp, NULL); /* We are done now with the loop body. Wrap up the scalarizer and return. */ @@ -1805,7 +1805,7 @@ transfer_array_component (tree expr, gfc_component * cm) /* Generate the call for a scalar transfer node. */ static void -transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr) +transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code) { tree tmp, function, arg2, field, expr; gfc_component *c; @@ -1814,9 +1814,23 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr) /* It is possible to get a C_NULL_PTR or C_NULL_FUNPTR expression here if the user says something like: print *, 'c_null_ptr: ', c_null_ptr We need to translate the expression to a constant if it's either - C_NULL_PTR or C_NULL_FUNPTR. */ - if (ts->type == BT_DERIVED && ts->is_iso_c == 1 && ts->derived != NULL) + C_NULL_PTR or C_NULL_FUNPTR. We could also get a user variable of + type C_PTR or C_FUNPTR, in which case the ts->type may no longer be + BT_DERIVED (could have been changed by gfc_conv_expr). */ + if ((ts->type == BT_DERIVED && ts->is_iso_c == 1 && ts->derived != NULL) + || (ts->derived != NULL && ts->derived->ts.is_iso_c == 1)) { + /* C_PTR and C_FUNPTR have private components which means they can not + be printed. However, if -std=gnu and not -pedantic, allow + the component to be printed to help debugging. */ + if (gfc_notification_std (GFC_STD_GNU) != SILENT) + { + gfc_error_now ("Derived type '%s' at %L has PRIVATE components", + ts->derived->name, code != NULL ? &(code->loc) : + &gfc_current_locus); + return; + } + ts->type = ts->derived->ts.type; ts->kind = ts->derived->ts.kind; ts->f90_type = ts->derived->ts.f90_type; @@ -1883,7 +1897,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr) { if (!c->pointer) tmp = build_fold_addr_expr (tmp); - transfer_expr (se, &c->ts, tmp); + transfer_expr (se, &c->ts, tmp, code); } } return; @@ -1949,7 +1963,7 @@ gfc_trans_transfer (gfc_code * code) { /* Transfer a scalar value. */ gfc_conv_expr_reference (&se, expr); - transfer_expr (&se, &expr->ts, se.expr); + transfer_expr (&se, &expr->ts, se.expr, code); } else { @@ -1988,7 +2002,7 @@ gfc_trans_transfer (gfc_code * code) se.ss = ss; gfc_conv_expr_reference (&se, expr); - transfer_expr (&se, &expr->ts, se.expr); + transfer_expr (&se, &expr->ts, se.expr, code); } finish_block_label: |