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

gcc/fortran/ChangeLog

+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

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;

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*);

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}:

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)

gcc/testsuite/ChangeLog

+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

gcc/testsuite/gfortran.dg/c_loc_tests_15.f90

+! { 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