re PR fortran/32579 (problem using iso_c_binding (II))

2007-07-02  Christopher D. Rickett  <crickett@lanl.gov>

	PR fortran/32579
	* symbol.c (gen_cptr_param): Generate C_PTR and C_FUNPTR if
	necessary.
	(build_formal_args): Pass intrinsic module symbol id to
	gen_cptr_param.

	* gfortran.dg/iso_c_binding_only.f03: Updated test case.

From-SVN: r126280

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 22088129dca0d95cba44166188cbc3af5eba324f..51fcdf9c49f887363c9bf7b09475edb7d14f58d0 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2007-07-03  Christopher D. Rickett  <crickett@lanl.gov>
+
+       PR fortran/32579
+       * symbol.c (gen_cptr_param): Generate C_PTR and C_FUNPTR if necessary.
+       (build_formal_args): Pass intrinsic module symbol id to
+       gen_cptr_param.
+
 2007-07-03  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/25062

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 867c6ef802680ca2aaa8a3632c2967a984193fec..c7527bfb1c11f5f094611b0f10dd07d27a81027e 100644 (file)
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -3254,14 +3254,21 @@ static void
 gen_cptr_param (gfc_formal_arglist **head,
                 gfc_formal_arglist **tail,
                 const char *module_name,
-                gfc_namespace *ns, const char *c_ptr_name)
+                gfc_namespace *ns, const char *c_ptr_name,
+                int iso_c_sym_id)
 {
   gfc_symbol *param_sym = NULL;
   gfc_symbol *c_ptr_sym = NULL;
   gfc_symtree *param_symtree = NULL;
   gfc_formal_arglist *formal_arg = NULL;
   const char *c_ptr_in;
-  const char *c_ptr_type = "c_ptr";
+  const char *c_ptr_type = NULL;
+
+  if (iso_c_sym_id == ISOCBINDING_F_PROCPOINTER)
+    c_ptr_type = "_gfortran_iso_c_binding_c_funptr";
+
+  else
+    c_ptr_type = "_gfortran_iso_c_binding_c_ptr";
 
   if(c_ptr_name == NULL)
     c_ptr_in = "gfc_cptr__";
@@ -3285,15 +3292,22 @@ gen_cptr_param (gfc_formal_arglist **head,
   param_sym->attr.value = 1;
   param_sym->attr.use_assoc = 1;
 
-  /* Get the symbol for c_ptr, no matter what it's name is (user renamed).  */
+  /* Get the symbol for c_ptr or c_funptr, no matter what it's name is 
+     (user renamed).  */
+  if (iso_c_sym_id == ISOCBINDING_F_PROCPOINTER)
+    c_ptr_sym = get_iso_c_binding_dt (ISOCBINDING_FUNPTR);
+  else
   c_ptr_sym = get_iso_c_binding_dt (ISOCBINDING_PTR);
   if (c_ptr_sym == NULL)
     {
       /* This can happen if the user did not define c_ptr but they are
          trying to use one of the iso_c_binding functions that need it.  */
-      gfc_error_now ("Type 'C_PTR' required for ISO_C_BINDING function at %C");
+      if (iso_c_sym_id == ISOCBINDING_F_PROCPOINTER)
+       generate_isocbinding_symbol (module_name, ISOCBINDING_FUNPTR,
+                                    (char *)c_ptr_type);
+      else
       generate_isocbinding_symbol (module_name, ISOCBINDING_PTR,
-                                   (char *) "_gfortran_iso_c_binding_c_ptr");
+                                    (char *)c_ptr_type);
 
       gfc_get_ha_symbol (c_ptr_type, &(c_ptr_sym));
     }
@@ -3455,7 +3469,7 @@ build_formal_args (gfc_symbol *new_proc_sym,
       (old_sym->intmod_sym_id == ISOCBINDING_F_PROCPOINTER))
     {
       gen_cptr_param (&head, &tail, (const char *) new_proc_sym->module,
-                     gfc_current_ns, "cptr");
+                     gfc_current_ns, "cptr", old_sym->intmod_sym_id);
       gen_fptr_param (&head, &tail, (const char *) new_proc_sym->module,
                      gfc_current_ns, "fptr");
 
@@ -3472,11 +3486,11 @@ build_formal_args (gfc_symbol *new_proc_sym,
       /* c_associated has one required arg and one optional; both
         are c_ptrs.  */
       gen_cptr_param (&head, &tail, (const char *) new_proc_sym->module,
-                     gfc_current_ns, "c_ptr_1");
+                     gfc_current_ns, "c_ptr_1", ISOCBINDING_ASSOCIATED);
       if (add_optional_arg)
        {
          gen_cptr_param (&head, &tail, (const char *) new_proc_sym->module,
-                         gfc_current_ns, "c_ptr_2");
+                         gfc_current_ns, "c_ptr_2", ISOCBINDING_ASSOCIATED);
          /* The last param is optional so mark it as such.  */
          tail->sym->attr.optional = 1;
        }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index e6b226839ce981f60f70126b48e049b8abbe60af..fc5dca36f8ccb93435b8db0776da7ee4c5c94ff8 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-07-03  Christopher D. Rickett  <crickett@lanl.gov>
+
+       PR fortran/32579
+        * gfortran.dg/iso_c_binding_only.f03: Updated test case.
+
 2007-07-03  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/25062

diff --git a/gcc/testsuite/gfortran.dg/iso_c_binding_only.f03 b/gcc/testsuite/gfortran.dg/iso_c_binding_only.f03
index 40c45a467264ae27df375814575442c6119424f5..dff4318e806ac42914a9f42365115d5ce91be4ac 100644 (file)
--- a/gcc/testsuite/gfortran.dg/iso_c_binding_only.f03
+++ b/gcc/testsuite/gfortran.dg/iso_c_binding_only.f03
@@ -1,6 +1,8 @@
 ! { dg-do compile }
 module iso_c_binding_only
-  use, intrinsic :: iso_c_binding, only: c_null_ptr
+  ! c_f_procpointer verifies that the c_funptr derived type for the cptr param
+  ! is auto-generated, and c_f_pointer tests c_ptr.
+  use, intrinsic :: iso_c_binding, only: c_null_ptr, c_f_procpointer
   ! This should be allowed since the C_PTR that the C_NULL_PTR needs will use
   ! a mangled name to prevent collisions.
   integer :: c_ptr