re PR fortran/44925 ([OOP] C_LOC with CLASS pointer)

2010-07-14  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/44925
	* gfortran.h (gfc_is_data_pointer): Remove prototype.
	* dependency.c (gfc_is_data_pointer): Make it static.
	* intrinsic.texi: Update documentation on C_LOC.
	* resolve.c (gfc_iso_c_func_interface): Fix pointer and target checks
	and add a check for polymorphic variables.

2010-07-14  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/44925
	* gfortran.dg/c_loc_tests_15.f90: New.

From-SVN: r162169

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e8eeffc67609810582d6fbb9ab6b7134b9b3e3ff..2f028b1299caa5782235eb47a9b4013d08c174ea 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2010-07-14  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/44925
+       * gfortran.h (gfc_is_data_pointer): Remove prototype.
+       * dependency.c (gfc_is_data_pointer): Make it static.
+       * intrinsic.texi: Update documentation on C_LOC.
+       * resolve.c (gfc_iso_c_func_interface): Fix pointer and target checks
+       and add a check for polymorphic variables.
+
 2010-07-14  Jakub Jelinek  <jakub@redhat.com>
 
        * trans-expr.c (string_to_single_character): Also optimize

diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c
index fcf5b25d35086accb5b9817f30a2c2f9d6ca41a9..083058dab8b92c7cbbb3b672cbaa013dafccf59c 100644 (file)
--- a/gcc/fortran/dependency.c
+++ b/gcc/fortran/dependency.c
@@ -424,7 +424,7 @@ gfc_ref_needs_temporary_p (gfc_ref *ref)
 }
 
 
-int
+static int
 gfc_is_data_pointer (gfc_expr *e)
 {
   gfc_ref *ref;

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index cf14bb46af2f0203b6779dcd63c47fe45957519a..11ff594f59ba1c20bf00d821091973854e505a87 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2810,7 +2810,6 @@ 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/intrinsic.texi b/gcc/fortran/intrinsic.texi
index af2f3b2816a11a4e38f5e1b772a9e38a5dcecf5a..2e91a3eb37af1f6e55470400ba242b73be9bc098 100644 (file)
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -2142,9 +2142,9 @@ Inquiry function
 @code{RESULT = C_LOC(X)}
 
 @item @emph{Arguments}:
-@multitable @columnfractions .15 .70
-@item @var{X} @tab Associated scalar pointer or interoperable scalar
-or allocated allocatable variable with @code{TARGET} attribute.
+@multitable @columnfractions .10 .75
+@item @var{X} @tab  Shall have either the POINTER or TARGET attribute. It shall not be a coindexed object. It shall either be a variable with interoperable type and kind type parameters, or be a scalar, nonpolymorphic variable with no length type parameters.
+
 @end multitable
 
 @item @emph{Return value}:

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 640a4d89fe188fb432547b52d2adc4c0d3cc3356..15b67d46ca185eb21baa2a929a6ff999beecdc81 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2440,10 +2440,11 @@ 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, is_pointer = 0;
+  int optional_arg = 0;
   gfc_try retval = SUCCESS;
   gfc_symbol *args_sym;
   gfc_typespec *arg_ts;
+  symbol_attribute arg_attr;
 
   if (args->expr->expr_type == EXPR_CONSTANT
       || args->expr->expr_type == EXPR_OP
@@ -2460,8 +2461,7 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args,
      and not necessarily that of the expr symbol (args_sym), because
      the actual expression could be a part-ref of the expr symbol.  */
   arg_ts = &(args->expr->ts);
-
-  is_pointer = gfc_is_data_pointer (args->expr);
+  arg_attr = gfc_expr_attr (args->expr);
     
   if (sym->intmod_sym_id == ISOCBINDING_ASSOCIATED)
     {
@@ -2504,7 +2504,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 && !is_pointer)
+         if (!arg_attr.target && !arg_attr.pointer)
             {
               gfc_error_now ("Parameter '%s' to '%s' at %L must be either "
                              "a TARGET or an associated pointer",
@@ -2587,7 +2587,7 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args,
                          }
                     }
                 }
-              else if (is_pointer
+              else if (arg_attr.pointer
                       && is_scalar_expr_ptr (args->expr) != SUCCESS)
                 {
                   /* Case 1c, section 15.1.2.5, J3/04-007: an associated
@@ -2622,6 +2622,13 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args,
                                  &(args->expr->where));
                   retval = FAILURE;
                 }
+             else if (arg_ts->type == BT_CLASS)
+               {
+                 gfc_error_now ("Parameter '%s' to '%s' at %L must not be "
+                                "polymorphic", args_sym->name, sym->name,
+                                &(args->expr->where));
+                 retval = FAILURE;
+               }
             }
         }
       else if (sym->intmod_sym_id == ISOCBINDING_FUNLOC)

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index aa86ae395b94a068fc896c980b877bac6a71a06b..44785593ce21b096273ed826dc00db7e05bb8bde 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2010-07-14  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/44925
+       * gfortran.dg/c_loc_tests_15.f90: New.
+
 2010-07-13  Jason Merrill  <jason@redhat.com>
 
        PR c++/44909

diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_15.f90 b/gcc/testsuite/gfortran.dg/c_loc_tests_15.f90
new file mode 100644 (file)
index 0000000..63f8816
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_15.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+!
+! PR 44925: [OOP] C_LOC with CLASS pointer
+!
+! Contributed by Barron Bichon <barron.bichon@swri.org>
+
+  use iso_c_binding
+
+  type :: t
+  end type t
+
+  type(c_ptr) :: tt_cptr
+  class(t), pointer :: tt_fptr
+  if (associated(tt_fptr)) tt_cptr = c_loc(tt_fptr)  ! { dg-error "must not be polymorphic" }
+
+end