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-04  Mikael Morin  <mikael.morin@tele2.fr>

	PR fortran/38536
	* gfortran.dg/c_loc_tests_13.f90: New test.
	* gfortran.dg/c_loc_tests_14.f90: New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@143050 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 28fa368..e3c652c 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+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.

diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c
index 56a6d36..639d6e3 100644 (file)
--- a/gcc/fortran/dependency.c
+++ b/gcc/fortran/dependency.c
@@ -422,16 +422,20 @@ gfc_ref_needs_temporary_p (gfc_ref *ref)
 }
 
 
-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;

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index c05fb88..bb2230d 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2579,6 +2579,7 @@ void gfc_global_used (gfc_gsymbol *, locus *);
 
 /* dependency.c */
 int gfc_dep_compare_expr (gfc_expr *, gfc_expr *);
+int gfc_is_data_pointer (gfc_expr *);
 
 /* check.c */
 gfc_try gfc_check_same_strlen (const gfc_expr*, const gfc_expr*, const char*);

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 18a81e9..27a4d99 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2047,12 +2047,10 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args,
 {
   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
@@ -2070,32 +2068,8 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args,
      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
@@ -2137,10 +2111,7 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args,
       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",
@@ -2223,9 +2194,7 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args,
                          }
                     }
                 }
-              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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7e24163..a1d4eb0 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2009-01-04  Mikael Morin  <mikael.morin@tele2.fr>
+
+       PR fortran/38536
+       * gfortran.dg/c_loc_tests_13.f90: New test.
+       * gfortran.dg/c_loc_tests_14.f90: New test.
+
 2009-01-03  Daniel Franke  <franke.daniel@gmail.com>
 
        * gfortran.dg/func_result_4.f90: New.

diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_13.f90 b/gcc/testsuite/gfortran.dg/c_loc_tests_13.f90
new file mode 100644 (file)
index 0000000..62bfe0a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_13.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+!
+! PR fortran/38536  
+! Consecutive array and substring references rejected as C_LOC argument
+!
+! contributed by Scot Breitenfield <brtnfld@hdfgroup.org>
+
+  USE ISO_C_BINDING
+  TYPE test
+     CHARACTER(LEN=2), DIMENSION(1:2) :: c
+  END TYPE test
+  TYPE(test), TARGET :: chrScalar
+  TYPE(C_PTR) :: f_ptr
+
+  f_ptr = C_LOC(chrScalar%c(1)(1:1))
+  END

diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_14.f90 b/gcc/testsuite/gfortran.dg/c_loc_tests_14.f90
new file mode 100644 (file)
index 0000000..ec455ec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_14.f90
@@ -0,0 +1,29 @@
+! { 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
+