+2009-01-04 Mikael Morin <mikael.morin@tele2.fr>
+
+ PR fortran/38536
+ * gfortran.h (gfc_is_data_pointer): Added prototype
+ * resolve.c (gfc_iso_c_func_interface):
+ Use gfc_is_data_pointer to test for pointer attribute.
+ * dependency.c (gfc_is_data_pointer):
+ Support pointer-returning functions.
+
2009-01-03 Daniel Franke <franke.daniel@gmail.com>
* symbol.c (save_symbol): Don't SAVE function results.
}
-static int
+int
gfc_is_data_pointer (gfc_expr *e)
{
gfc_ref *ref;
- if (e->expr_type != EXPR_VARIABLE)
+ if (e->expr_type != EXPR_VARIABLE && e->expr_type != EXPR_FUNCTION)
return 0;
+ /* No subreference if it is a function */
+ gcc_assert (e->expr_type == EXPR_VARIABLE || !e->ref);
+
if (e->symtree->n.sym->attr.pointer)
return 1;
+
for (ref = e->ref; ref; ref = ref->next)
if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer)
return 1;
{
char name[GFC_MAX_SYMBOL_LEN + 1];
char binding_label[GFC_MAX_BINDING_LABEL_LEN + 1];
- int optional_arg = 0;
+ int optional_arg = 0, is_pointer = 0;
gfc_try retval = SUCCESS;
gfc_symbol *args_sym;
gfc_typespec *arg_ts;
- gfc_ref *parent_ref;
- gfc_ref *curr_ref;
if (args->expr->expr_type == EXPR_CONSTANT
|| args->expr->expr_type == EXPR_OP
the actual expression could be a part-ref of the expr symbol. */
arg_ts = &(args->expr->ts);
- /* Get the parent reference (if any) for the expression. This happens for
- cases such as a%b%c. */
- parent_ref = args->expr->ref;
- curr_ref = NULL;
- if (parent_ref != NULL)
- {
- curr_ref = parent_ref->next;
- while (curr_ref != NULL && curr_ref->next != NULL)
- {
- parent_ref = curr_ref;
- curr_ref = curr_ref->next;
- }
- }
-
- /* If curr_ref is non-NULL, we had a part-ref expression. If the curr_ref
- is for a REF_COMPONENT, then we need to use it as the parent_ref for
- the name, etc. Otherwise, the current parent_ref should be correct. */
- if (curr_ref != NULL && curr_ref->type == REF_COMPONENT)
- parent_ref = curr_ref;
-
- if (parent_ref == args->expr->ref)
- parent_ref = NULL;
- else if (parent_ref != NULL && parent_ref->type != REF_COMPONENT)
- gfc_internal_error ("Unexpected expression reference type in "
- "gfc_iso_c_func_interface");
-
+ is_pointer = gfc_is_data_pointer (args->expr);
+
if (sym->intmod_sym_id == ISOCBINDING_ASSOCIATED)
{
/* If the user gave two args then they are providing something for
else if (sym->intmod_sym_id == ISOCBINDING_LOC)
{
/* Make sure we have either the target or pointer attribute. */
- if (!(args_sym->attr.target)
- && !(args_sym->attr.pointer)
- && (parent_ref == NULL ||
- !parent_ref->u.c.component->attr.pointer))
+ if (!args_sym->attr.target && !is_pointer)
{
gfc_error_now ("Parameter '%s' to '%s' at %L must be either "
"a TARGET or an associated pointer",
}
}
}
- else if ((args_sym->attr.pointer == 1 ||
- (parent_ref != NULL
- && parent_ref->u.c.component->attr.pointer))
+ else if (is_pointer
&& is_scalar_expr_ptr (args->expr) != SUCCESS)
{
/* Case 1c, section 15.1.2.5, J3/04-007: an associated
--- /dev/null
+! { dg-do compile }
+!
+! PR fortran/38536
+! Accept as argument to C_LOC a subcomponent accessed through a pointer.
+
+ USE ISO_C_BINDING
+
+ IMPLICIT NONE
+ TYPE test3
+ INTEGER, DIMENSION(5) :: b
+ END TYPE test3
+
+ TYPE test2
+ TYPE(test3), DIMENSION(:), POINTER :: a
+ END TYPE test2
+
+ TYPE test
+ TYPE(test2), DIMENSION(2) :: c
+ END TYPE test
+
+ TYPE(test) :: chrScalar
+ TYPE(C_PTR) :: f_ptr
+ TYPE(test3), TARGET :: d(3)
+
+
+ chrScalar%c(1)%a => d
+ f_ptr = C_LOC(chrScalar%c(1)%a(1)%b(1))
+ end
+