re PR fortran/32600 ([ISO Bind C] C_F_POINTER w/o SHAPE should not be a library function)
authorChristopher D. Rickett <crickett@lanl.gov>
Mon, 15 Oct 2007 19:58:55 +0000 (19:58 +0000)
committerTobias Burnus <burnus@gcc.gnu.org>
Mon, 15 Oct 2007 19:58:55 +0000 (21:58 +0200)
2007-10-15 Christopher D. Rickett <crickett@lanl.gov>

        PR fortran/32600
        * trans-expr.c (gfc_conv_function_call): Generate code to inline
        c_associated.
        * symbol.c (get_iso_c_sym): Preserve from_intmod and
        * intmod_sym_id
        attributes in the resolved symbol.
        * resolve.c (gfc_iso_c_sub_interface): Remove dead code.

2007-10-15 Christopher D. Rickett <crickett@lanl.gov>

        PR fortran/32600
        * libgfortran/intrinsics/iso_c_binding.c: Remove c_associated_1
        and c_associated_2.
        * libgfortran/intrinsics/iso_c_binding.h: Ditto.
        * libgfortran/gfortran.map: Ditto.

From-SVN: r129367

gcc/fortran/ChangeLog
gcc/fortran/resolve.c
gcc/fortran/symbol.c
gcc/fortran/trans-expr.c
libgfortran/ChangeLog
libgfortran/gfortran.map
libgfortran/intrinsics/iso_c_binding.c
libgfortran/intrinsics/iso_c_binding.h

index 7ee3b07b44a4ff5ddde5900cd8f86e0bfe29dfd7..d9885ae7dd0be5cb87acadeb95f251245b674d92 100644 (file)
@@ -1,3 +1,12 @@
+2007-10-15 Christopher D. Rickett <crickett@lanl.gov>
+
+       PR fortran/32600
+       * trans-expr.c (gfc_conv_function_call): Generate code to inline
+       c_associated.
+       * symbol.c (get_iso_c_sym): Preserve from_intmod and intmod_sym_id
+       attributes in the resolved symbol.
+       * resolve.c (gfc_iso_c_sub_interface): Remove dead code.
+
 2007-10-15  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR fortran/33055
index 2461bc3beeb26097017c4f454305b34e202298bb..65e479fe65fe53249fa7391a0ac5e181dd913df4 100644 (file)
@@ -2479,31 +2479,6 @@ gfc_iso_c_sub_interface (gfc_code *c, gfc_symbol *sym)
          new_sym->declared_at = sym->declared_at;
        }
     }
-  else if (sym->intmod_sym_id == ISOCBINDING_ASSOCIATED)
-    {
-      /* TODO: Figure out if this is even reachable; this part of the
-         conditional may not be necessary.  */
-      int num_args = 0;
-      if (c->ext.actual->next == NULL)
-       {
-         /* The user did not give two args, so resolve to the version
-            of c_associated expecting one arg.  */
-         num_args = 1;
-         /* get rid of the second arg */
-         /* TODO!! Should free up the memory here!  */
-         sym->formal->next = NULL;
-       }
-      else
-       {
-         num_args = 2;
-       }
-
-      new_sym = sym;
-      sprintf (name, "%s_%d", sym->name, num_args);
-      sprintf (binding_label, "%s_%d", sym->binding_label, num_args);
-      sym->name = gfc_get_string (name);
-      strcpy (sym->binding_label, binding_label);
-    }
   else
     {
       /* no differences for c_loc or c_funloc */
index d6bd9638df62733f0a74a02f1d1daf91f6cd11ce..ae97a656759435b5e7af886af9c6d8c06910fbb8 100644 (file)
@@ -4029,6 +4029,8 @@ get_iso_c_sym (gfc_symbol *old_sym, char *new_name,
   new_symtree->n.sym->attr = old_sym->attr;
   new_symtree->n.sym->ts = old_sym->ts;
   new_symtree->n.sym->module = gfc_get_string (old_sym->module);
+  new_symtree->n.sym->from_intmod = old_sym->from_intmod;
+  new_symtree->n.sym->intmod_sym_id = old_sym->intmod_sym_id;
   /* Build the formal arg list.  */
   build_formal_args (new_symtree->n.sym, old_sym, add_optional_arg);
 
index dff1fd8fcc148727e43f0336b9360e270d13cac2..a1f1ee957db08dc84a7a047e09eb75481f49f83f 100644 (file)
@@ -2108,6 +2108,52 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
          arg->expr->ts.kind = sym->ts.derived->ts.kind;
          gfc_conv_expr_reference (se, arg->expr);
       
+         return 0;
+       }
+      else if (sym->intmod_sym_id == ISOCBINDING_ASSOCIATED)
+        {
+         gfc_se arg1se;
+         gfc_se arg2se;
+
+         /* Build the addr_expr for the first argument.  The argument is
+            already an *address* so we don't need to set want_pointer in
+            the gfc_se.  */
+         gfc_init_se (&arg1se, NULL);
+         gfc_conv_expr (&arg1se, arg->expr);
+         gfc_add_block_to_block (&se->pre, &arg1se.pre);
+         gfc_add_block_to_block (&se->post, &arg1se.post);
+
+         /* See if we were given two arguments.  */
+         if (arg->next == NULL)
+           /* Only given one arg so generate a null and do a
+              not-equal comparison against the first arg.  */
+           se->expr = build2 (NE_EXPR, boolean_type_node, arg1se.expr,
+                              fold_convert (TREE_TYPE (arg1se.expr),
+                                            null_pointer_node));
+         else
+           {
+             tree eq_expr;
+             tree not_null_expr;
+             
+             /* Given two arguments so build the arg2se from second arg.  */
+             gfc_init_se (&arg2se, NULL);
+             gfc_conv_expr (&arg2se, arg->next->expr);
+             gfc_add_block_to_block (&se->pre, &arg2se.pre);
+             gfc_add_block_to_block (&se->post, &arg2se.post);
+
+             /* Generate test to compare that the two args are equal.  */
+             eq_expr = build2 (EQ_EXPR, boolean_type_node, arg1se.expr,
+                               arg2se.expr);
+             /* Generate test to ensure that the first arg is not null.  */
+             not_null_expr = build2 (NE_EXPR, boolean_type_node, arg1se.expr,
+                                     null_pointer_node);
+
+             /* Finally, the generated test must check that both arg1 is not
+                NULL and that it is equal to the second arg.  */
+             se->expr = build2 (TRUTH_AND_EXPR, boolean_type_node,
+                                not_null_expr, eq_expr);
+           }
+
          return 0;
        }
     }
index 34df5007e92ad184f2cdfdfda5ecab3305f913d9..d0cecb0167b0a0c2a56db859e89c30ce0d16e2ce 100644 (file)
@@ -1,3 +1,11 @@
+2007-10-15 Christopher D. Rickett <crickett@lanl.gov>
+
+       PR fortran/32600
+       * libgfortran/intrinsics/iso_c_binding.c: Remove c_associated_1
+       and c_associated_2.
+       * libgfortran/intrinsics/iso_c_binding.h: Ditto.
+       * libgfortran/gfortran.map: Ditto.
+
 2007-10-15  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR libfortran/33055
index 429c84c8c4a504efe4f50ecd997a4807867fb6e8..b9f4aa93b73f7b56bb253cb24591187648920eeb 100644 (file)
@@ -1003,8 +1003,6 @@ GFORTRAN_1.0 {
     _gfortran_unpack0_char;
     _gfortran_unpack1;
     _gfortran_unpack1_char;
-    __iso_c_binding_c_associated_1;
-    __iso_c_binding_c_associated_2;
     __iso_c_binding_c_f_pointer;
     __iso_c_binding_c_f_pointer_d0;
     __iso_c_binding_c_f_pointer_i1;
index 5d566bcf11b2f469b7b2ce59754de3ed34843d1d..2a1e994d4d9243e8f4638796de98d4508ae253f0 100644 (file)
@@ -193,42 +193,3 @@ ISO_C_BINDING_PREFIX (c_f_procpointer) (void *c_ptr_in,
 }
 
 
-/* Test if the given c_ptr is associated or not.  This function is
-   called if the user only supplied one c_ptr parameter to the
-   c_associated function.  The second argument is optional, and the
-   Fortran compiler will resolve the function to this version if only
-   one arg was given.  Associated here simply means whether or not the
-   c_ptr is NULL or not.  */
-
-GFC_LOGICAL_4
-ISO_C_BINDING_PREFIX (c_associated_1) (void *c_ptr_in_1)
-{
-  if (c_ptr_in_1 != NULL)
-    return 1;
-  else
-    return 0;
-}
-
-
-/* Test if the two c_ptr arguments are associated with one another.
-   This version of the c_associated function is called if the user
-   supplied two c_ptr args in the Fortran source.  According to the
-   draft standard (J3/04-007), if c_ptr_in_1 is NULL, the two pointers
-   are NOT associated.  If c_ptr_in_1 is non-NULL and it is not equal
-   to c_ptr_in_2, then either c_ptr_in_2 is NULL or is associated with
-   another address; either way, the two pointers are not associated
-   with each other then.  */
-
-GFC_LOGICAL_4
-ISO_C_BINDING_PREFIX (c_associated_2) (void *c_ptr_in_1, void *c_ptr_in_2)
-{
-  /* Since we have the second arg, if it doesn't equal the first,
-     return false; true otherwise.  However, if the first one is null,
-     then return false; otherwise compare the two ptrs for equality.  */
-  if (c_ptr_in_1 == NULL)
-    return 0;
-  else if (c_ptr_in_1 != c_ptr_in_2)
-    return 0;
-  else
-    return 1;
-}
index 206359ad8c9a9427efbe08a9085b8c66c5456034..4679c2aba02f4be2d771c2415fc504b54d3644ab 100644 (file)
@@ -56,9 +56,6 @@ void ISO_C_BINDING_PREFIX(c_f_pointer)(void *, gfc_array_void *,
    implemented.  */
 void ISO_C_BINDING_PREFIX(c_f_procpointer) (void *, gfc_array_void *);
 
-GFC_LOGICAL_4 ISO_C_BINDING_PREFIX(c_associated_1) (void *);
-GFC_LOGICAL_4 ISO_C_BINDING_PREFIX(c_associated_2) (void *, void *);
-
 void ISO_C_BINDING_PREFIX(c_f_pointer_u0) (void *, gfc_array_void *,
                                           const array_t *);
 void ISO_C_BINDING_PREFIX(c_f_pointer_d0) (void *, gfc_array_void *,