@@ -3271,14 +3271,17 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym,
return 1;
}
- else if ((sym->intmod_sym_id == ISOCBINDING_F_POINTER
- && arg->next->expr->rank == 0)
+ else if (sym->intmod_sym_id == ISOCBINDING_F_POINTER
|| sym->intmod_sym_id == ISOCBINDING_F_PROCPOINTER)
{
- /* Convert c_f_pointer if fptr is a scalar
- and convert c_f_procpointer. */
+ /* Convert c_f_pointer and c_f_procpointer. */
gfc_se cptrse;
gfc_se fptrse;
+ gfc_se shapese;
+ gfc_ss *ss, *shape_ss;
+ tree desc, dim, tmp;
+ stmtblock_t body;
+ gfc_loopinfo loop;
gfc_init_se (&cptrse, NULL);
gfc_conv_expr (&cptrse, arg->expr);
@@ -3286,24 +3289,79 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym,
gfc_add_block_to_block (&se->post, &cptrse.post);
gfc_init_se (&fptrse, NULL);
- if (sym->intmod_sym_id == ISOCBINDING_F_POINTER
- || gfc_is_proc_ptr_comp (arg->next->expr, NULL))
- fptrse.want_pointer = 1;
+ if (arg->next->expr->rank == 0)
+ {
+ if (sym->intmod_sym_id == ISOCBINDING_F_POINTER
+ || gfc_is_proc_ptr_comp (arg->next->expr, NULL))
+ fptrse.want_pointer = 1;
+
+ gfc_conv_expr (&fptrse, arg->next->expr);
+ gfc_add_block_to_block (&se->pre, &fptrse.pre);
+ gfc_add_block_to_block (&se->post, &fptrse.post);
+ if (arg->next->expr->symtree->n.sym->attr.proc_pointer
+ && arg->next->expr->symtree->n.sym->attr.dummy)
+ fptrse.expr = build_fold_indirect_ref_loc (input_location,
+ fptrse.expr);
+ se->expr = fold_build2_loc (input_location, MODIFY_EXPR,
+ TREE_TYPE (fptrse.expr),
+ fptrse.expr,
+ fold_convert (TREE_TYPE (fptrse.expr),
+ cptrse.expr));
+ return 1;
+ }
- gfc_conv_expr (&fptrse, arg->next->expr);
+ /* Get the descriptor of the Fortran pointer. */
+ ss = gfc_walk_expr (arg->next->expr);
+ gcc_assert (ss != gfc_ss_terminator);
+ gfc_conv_expr_descriptor (&fptrse, arg->next->expr, ss);
gfc_add_block_to_block (&se->pre, &fptrse.pre);
gfc_add_block_to_block (&se->post, &fptrse.post);
-
- if (arg->next->expr->symtree->n.sym->attr.proc_pointer
- && arg->next->expr->symtree->n.sym->attr.dummy)
- fptrse.expr = build_fold_indirect_ref_loc (input_location,
- fptrse.expr);
-
- se->expr = fold_build2_loc (input_location, MODIFY_EXPR,
- TREE_TYPE (fptrse.expr),
- fptrse.expr,
- fold_convert (TREE_TYPE (fptrse.expr),
- cptrse.expr));
+ desc = fptrse.expr;
+
+ /* Set data value, dtype, and offset. */
+ tmp = GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc));
+ gfc_conv_descriptor_data_set (&se->pre, desc,
+ fold_convert (tmp, cptrse.expr));
+ gfc_conv_descriptor_offset_set (&se->pre, desc,
+ build_int_cst (gfc_array_index_type,
+ -1*arg->next->expr->rank));
+ gfc_add_modify (&se->pre, gfc_conv_descriptor_dtype (desc),
+ gfc_get_dtype (TREE_TYPE (desc)));
+
+ /* Start scalarization of the bounds, using the shape argument. */
+ shape_ss = gfc_walk_expr (arg->next->next->expr);
+ gcc_assert (shape_ss != gfc_ss_terminator);
+ gfc_init_se (&shapese, NULL);
+
+ gfc_init_loopinfo (&loop);
+ gfc_add_ss_to_loop (&loop, shape_ss);
+ gfc_conv_ss_startstride (&loop);
+ gfc_conv_loop_setup (&loop, &arg->next->expr->where);
+ gfc_mark_ss_chain_used (shape_ss, 1);
+
+ gfc_copy_loopinfo_to_se (&shapese, &loop);
+ shapese.ss = shape_ss;
+
+ gfc_start_block (&body);
+ gfc_start_scalarized_body (&loop, &body);
+
+ dim = loop.loopvar[0];
+
+ gfc_conv_descriptor_lbound_set (&body, desc, dim, gfc_index_one_node);
+ gfc_conv_descriptor_stride_set (&body, desc, dim, gfc_index_one_node);
+
+ gfc_conv_expr (&shapese, arg->next->next->expr);
+ gfc_add_block_to_block (&body, &shapese.pre);
+ gfc_conv_descriptor_ubound_set (&body, desc, dim, shapese.expr);
+ gfc_add_block_to_block (&body, &shapese.post);
+
+ gfc_trans_scalarizing_loops (&loop, &body);
+ gfc_add_block_to_block (&se->pre, &loop.pre);
+ gfc_add_block_to_block (&se->post, &loop.post);
+ gfc_cleanup_loop (&loop);
+ gfc_free_ss (ss);
+
+ se->expr = build_empty_stmt (input_location);
return 1;
}
Dear all, I seriously struggle with the following patch. It replaces a library call by inline code for C_F_POINTER(C-pointer, Fortran-array-pointer, shape-of-the-array) (Purpose: (a) The current library version fails for SHAPE with strides. (b) For the new array descriptor (fortran-dev branch), the current lib function lacks data needed to set the stride multiplier (sm).) The code works for a single "call c_f_pointer(...)". However, if I use call c_f_pointer twice, the dump shows that the assignment to the array gets lost - which shouldn't be affected and is before the c_f_pointer line! Additionally, some variable declaration get lost, which leads to a link error: /dev/shm/foo.f90:9: undefined reference to `A.0.1881' /dev/shm/foo.f90:11: undefined reference to `A.1.1884' I was looking at the code for several hours and tried some other versions, but without success. [As the comment for ISOCBINDING_LOC in the same function indicates, others had also problems (though of slightly different kind and called via other functions).] My impression is that either I forgot something important - or that se.{expr,pre,post} is somehow in a bad state. But I have no idea what goes wrong. For c_f_pointer, the call tree is: * fortran/trans-expr.c (conv_isocbinding_procedure): The procedure in question, the relevant source code is shown in t he patch. * fortran/trans-expr.c (gfc_conv_procedure_call): Simply calls conv_isocbinding_procedure and returns 0. * fortran/trans-stmt.c (gfc_trans_call): Calls gfc_conv_procedure_call (for "ss == gfc_ss_terminator"). I am happy for any suggestion regarding debugging and/or solving this issue. Tobias