[multiple changes]

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

	* interface.c (gfc_compare_derived_types): Special case for comparing
	derived types across namespaces.
	(gfc_compare_types): Deal with BT_VOID.
	(compare_parameter): Use BT_VOID to accept ISO C Binding pointers.
	* trans-expr.c (gfc_conv_function_call): Remove setting parm_kind
	to SCALAR
	(gfc_conv_initializer): Deal with ISO C Binding NULL_PTR and 
	NULL_FUNPTR.
	(gfc_conv_expr): Convert expressions for ISO C Binding derived types.
	* symbol.c (gfc_set_default_type): BIND(C) variables should not be
	implicitly declared.
	(check_conflict): Add BIND(C) and check for conflicts.
	(gfc_add_explicit_interface): Whitespace.	
	(gfc_add_is_bind_c): New function.  
	(gfc_copy_attr): Use it.
	(gfc_new_symbol): Initialize ISO C Binding objects.
	(get_iso_c_binding_dt):  New function.
	(verify_bind_c_derived_type): Ditto.
	(gen_special_c_interop_ptr): Ditto.
	(add_formal_arg): Ditto.
	(gen_cptr_param): Ditto.
	(gen_fptr_param): Ditto.
	(gen_shape_param): Ditto.
	(add_proc_interface): Ditto.
	(build_formal_args): Ditto.
	(generate_isocbinding_symbol):  Ditto.
	(get_iso_c_sym):  Ditto.
	* decl.c (num_idents_on_line, has_name_equals): New variables.
	(verify_c_interop_param): New function.
	(build_sym): Finish binding labels and deal with COMMON blocks.
	(add_init_expr_to_sym): Check if the initialized expression is
	an iso_c_binding named constants
	(variable_decl): Set ISO C Binding type_spec components.
	(gfc_match_kind_spec): Check match for C interoperable kind.
	(match_char_spec): Fix comment. Chnage gfc_match_small_int
	to gfc_match_small_int_expr.  Check for C interoperable kind.
	(match_type_spec): Clear the current binding label.
	(match_attr_spec): Add DECL_IS_BIND_C.  If BIND(C) is found, use it
	to set attributes.
	(set_binding_label): New function.
	(set_com_block_bind_c): Ditto.
	(verify_c_interop): Ditto.
	(verify_com_block_vars_c_interop): Ditto.
	(verify_bind_c_sym): Ditto.
	(set_verify_bind_c_sym): Ditto.
	(set_verify_bind_c_com_block): Ditto.
	(get_bind_c_idents): Ditto.
	(gfc_match_bind_c_stmt): Ditto.
	(gfc_match_data_decl): Use num_idents_on_line.
	(match_result): Deal with right paren in BIND(C).
	(gfc_match_suffix): New function.
	(gfc_match_function_decl): Use it.  Code is re-arranged to deal with
	ISO C Binding result clauses.
	(gfc_match_subroutine):  Deal with BIND(C).
 	(gfc_match_bind_c): New function.
	(gfc_get_type_attr_spec): New function.  Code is re-arranged in and
	taken from gfc_match_derived_decl.
	(gfc_match_derived_decl): Add check for BIND(C).
	* trans-common.c: Forward declare gfc_get_common.
	(gfc_sym_mangled_common_id): Change arg from 'const char *name' to
	'gfc_common_head *com'.  Check for ISO C Binding of the common block.
	(build_common_decl): 'com->name' to 'com in SET_DECL_ASSEMBLER_NAME.
	* gfortran.h: Add GFC_MAX_BINDING_LABEL_LEN
	(bt): Add BT_VOID
	(sym_flavor): Add FL_VOID.
 	(iso_fortran_env_symbol, iso_c_binding_symbol, intmod_id): New enum
	(CInteropKind_t): New struct.
	(c_interop_kinds_table): Use it.  Declare an array of structs.
	(symbol_attribute): Add is_bind_c, is_c_interop, and is_iso_c
	bitfields.
	(gfc_typespec): Add is_c_interop; is_iso_c, and f90_type members.
	(gfc_symbol): Add from_intmod, intmod_sym_id, binding_label, and
	common_block members.
	(gfc_common_head): Add binding_label and is_bind_c members.
	(gfc_gsymbol): Add sym_name, mod_name, and binding_label members.
	Add prototypes for get_c_kind, gfc_validate_c_kind, 
	gfc_check_any_c_kind, gfc_add_is_bind_c, gfc_add_value,
	verify_c_interop, verify_c_interop_param, verify_bind_c_sym,
	verify_bind_c_derived_type, verify_com_block_vars_c_interop,
	generate_isocbinding_symbol, get_iso_c_sym, gfc_iso_c_sub_interface
	* iso-c-binding.def: New file. This file contains the definitions
	of the types provided by the Fortran 2003 ISO_C_BINDING intrinsic
	module.
	* trans-const.c (gfc_conv_constant_to_tree): Deal with C_NULL_PTR
	 or C_NULL_FUNPTR expressions.
	* expr.c (gfc_copy_expr): Add BT_VOID case.  For BT_CHARACTER, the
	ISO C Binding requires a minimum string length of 1 for '\0'.  
	* module.c (intmod_sym): New struct.
	(pointer_info): Add binding_label member.
	(write_atom): Set len to 0 for NULL pointers. Check for NULL p and *p.
	(ab_attribute): Add AB_IS_BIND_C, AB_IS_C_INTEROP and AB_IS_ISO_C.
	(attr_bits): Add "IS_BIND_C", "IS_C_INTEROP", and "IS_ISO_C".
	(mio_symbol_attribute): Deal with ISO C Binding attributes.
	(bt_types): Add "VOID".
	(mio_typespec): Deal with ISO C Binding components.
	(mio_namespace_ref): Add intmod variable. 
	(mio_symbol): Check for symbols from an intrinsic module.
	(load_commons): Check for BIND(C) common block.
	(read_module): Read binding_label and use it.
	(write_common): Add label.  Write BIND(C) info.
	(write_blank_common): Blank commons are not BIND(C).  Explicitly
	set is_bind_c=0.
	(write_symbol): Deal with binding_label.
	(sort_iso_c_rename_list): New function.
	(import_iso_c_binding_module): Ditto.
	(create_int_parameter): Add to args.
	(use_iso_fortran_env_module): Adjust to deal with iso_c_binding
	intrinsic module.
	* trans-types.c (c_interop_kinds_table): new array of structs. 
	(gfc_validate_c_kind): New function.
	(gfc_check_any_c_kind): Ditto.
	(get_real_kind_from_node): Ditto.
	(get_int_kind_from_node): Ditto.
	(get_int_kind_from_width): Ditto.
	(get_int_kind_from_minimal_width): Ditto.
	(init_c_interop_kinds): Ditto.
	(gfc_init_kinds): call init_c_interop_kinds.
	(gfc_typenode_for_spec): Adjust for BT_VOID and ISO C Binding pointers.
	Adjust handling of BT_DERIVED.
	(gfc_sym_type): Whitespace.
	(gfc_get_derived_type):  Account for iso_c_binding derived types
	* resolve.c (is_scalar_expr_ptr): New function.
	(gfc_iso_c_func_interface): Ditto.
	(resolve_function): Use gfc_iso_c_func_interface. 
	(set_name_and_label): New function.
	(gfc_iso_c_sub_interface): Ditto.
	(resolve_specific_s0): Use gfc_iso_c_sub_interface.
	(resolve_bind_c_comms): New function.
	(resolve_bind_c_derived_types): Ditto.
	(gfc_verify_binding_labels): Ditto.
	(resolve_fl_procedure): Check for ISO C interoperability.
	(resolve_symbol): Check C interoperability.
	(resolve_types): Walk the namespace.  Check COMMON blocks.
	* trans-decl.c (gfc_sym_mangled_identifier):  Prevent the mangling
	of identifiers that have an assigned binding label.
	(gfc_sym_mangled_function_id): Use the binding label rather than
	the mangled name.
	(gfc_finish_var_decl): Put variables that are BIND(C) into a common
	segment of the object file, because this is what C would do.
	(gfc_create_module_variable): Conver to proper types
	(set_tree_decl_type_code): New function.
	(generate_local_decl): Check dummy variables and derived types for
	ISO C Binding attributes.
	* match.c (gfc_match_small_int_expr): New function.
	(gfc_match_name_C): Ditto.
	(match_common_name): Deal with ISO C Binding in COMMON blocks
	* trans-io.c (transfer_expr):  Deal with C_NULL_PTR or C_NULL_FUNPTR
	expressions
	* match.h: Add prototypes for gfc_match_small_int_expr,
	gfc_match_name_C, match_common_name, set_com_block_bind_c,
	set_binding_label, set_verify_bind_c_sym,
	set_verify_bind_c_com_block, get_bind_c_idents,
	gfc_match_bind_c_stmt, gfc_match_suffix, gfc_match_bind_c,
	gfc_get_type_attr_spec
	* parse.c (decode_statement): Use gfc_match_bind_c_stmt
	(parse_derived): Init *derived_sym = NULL, and gfc_current_block
	later for valiadation.
	* primary.c (got_delim): Set ISO C Binding components of ts.
	(match_logical_constant): Ditto.
	(match_complex_constant): Ditto.
	(match_complex_constant): Ditto.
	(gfc_match_rvalue): Check for existence of at least one arg for
	C_LOC, C_FUNLOC, and C_ASSOCIATED.
	* misc.c (gfc_clear_ts): Clear ISO C Bindoing components in ts.
	(get_c_kind): New function.

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

	* Makefile.in: Add support for iso_c_generated_procs.c and
	iso_c_binding.c.
	* Makefile.am: Ditto.
	* intrinsics/iso_c_generated_procs.c: New file containing helper
	functions.
	* intrinsics/iso_c_binding.c: Ditto.
	* intrinsics/iso_c_binding.h: New file
	* gfortran.map: Include the __iso_c_binding_c_* functions.
	* libgfortran.h: define GFC_NUM_RANK_BITS.

2007-06-23  Christopher D. Rickett  <crickett@lanl.gov>

	* bind_c_array_params.f03: New files for Fortran 2003 ISO C Binding.
	* bind_c_coms.f90: Ditto.
	* bind_c_coms_driver.c: Ditto.
	* bind_c_dts.f90: Ditto.
	* bind_c_dts_2.f03: Ditto.
	* bind_c_dts_2_driver.c: Ditto.
	* bind_c_dts_3.f03: Ditto.
	* bind_c_dts_4.f03: Ditto.
	* bind_c_dts_driver.c: Ditto.
	* bind_c_implicit_vars.f03: Ditto.
	* bind_c_procs.f03: Ditto.
	* bind_c_usage_2.f03: Ditto.
	* bind_c_usage_3.f03: Ditto.
	* bind_c_usage_5.f03: Ditto.
	* bind_c_usage_6.f03: Ditto.
	* bind_c_usage_7.f03: Ditto.
	* bind_c_vars.f90: Ditto.
	* bind_c_vars_driver.c: Ditto.
	* binding_c_table_15_1.f03: Ditto.
	* binding_label_tests.f03: Ditto.
	* binding_label_tests_10.f03: Ditto.
	* binding_label_tests_10_main.f03: Ditto.
	* binding_label_tests_11.f03: Ditto.
	* binding_label_tests_11_main.f03: Ditto.
	* binding_label_tests_12.f03: Ditto.
	* binding_label_tests_13.f03: Ditto.
	* binding_label_tests_13_main.f03: Ditto.
	* binding_label_tests_14.f03: Ditto.
	* binding_label_tests_2.f03: Ditto.
	* binding_label_tests_3.f03: Ditto.
	* binding_label_tests_4.f03: Ditto.
	* binding_label_tests_5.f03: Ditto.
	* binding_label_tests_6.f03: Ditto.
	* binding_label_tests_7.f03: Ditto.
	* binding_label_tests_8.f03: Ditto.
	* binding_label_tests_9.f03: Ditto.
	* c_assoc.f90: Ditto.
	* c_assoc_2.f03: Ditto.
	* c_f_pointer_shape_test.f90: Ditto.
	* c_f_pointer_tests.f90: Ditto.
	* c_f_tests_driver.c: Ditto.
	* c_funloc_tests.f03: Ditto.
	* c_funloc_tests_2.f03: Ditto.
	* c_funloc_tests_3.f03: Ditto.
	* c_funloc_tests_3_funcs.c: Ditto.
	* c_kind_params.f90: Ditto.
	* c_kind_tests_2.f03: Ditto.
	* c_kinds.c: Ditto.
	* c_loc_driver.c: Ditto.
	* c_loc_test.f90: Ditto.
	* c_loc_tests_2.f03: Ditto.
	* c_loc_tests_2_funcs.c: Ditto.
	* c_loc_tests_3.f03: Ditto.
	* c_loc_tests_4.f03: Ditto.
	* c_loc_tests_5.f03: Ditto.
	* c_loc_tests_6.f03: Ditto.
	* c_loc_tests_7.f03: Ditto.
	* c_loc_tests_8.f03: Ditto.
	* c_ptr_tests.f03: Ditto.
	* c_ptr_tests_10.f03: Ditto.
	* c_ptr_tests_5.f03: Ditto.
	* c_ptr_tests_7.f03: Ditto.
	* c_ptr_tests_7_driver.c: Ditto.
	* c_ptr_tests_8.f03: Ditto.
	* c_ptr_tests_8_funcs.c: Ditto.
	* c_ptr_tests_9.f03: Ditto.
	* c_ptr_tests_driver.c: Ditto.
	* c_size_t_driver.c: Ditto.
	* c_size_t_test.f03: Ditto.
	* com_block_driver.f90: Ditto.
	* global_vars_c_init.f90: Ditto.
	* global_vars_c_init_driver.c: Ditto.
	* global_vars_f90_init.f90: Ditto.
	* global_vars_f90_init_driver.c: Ditto.
	* interop_params.f03: Ditto.
	* iso_c_binding_only.f03: Ditto.
	* iso_c_binding_rename_1.f03: Ditto.
	* iso_c_binding_rename_1_driver.c: Ditto.
	* iso_c_binding_rename_2.f03: Ditto.
	* iso_c_binding_rename_2_driver.c: Ditto.
	* kind_tests_2.f03: Ditto.
	* kind_tests_3.f03: Ditto.
	* module_md5_1.f90: Ditto.
	* only_clause_main.c: Ditto.
	* print_c_kinds.f90: Ditto.
	* test_bind_c_parens.f03: Ditto.
	* test_c_assoc.c: Ditto.
	* test_com_block.f90: Ditto.
	* test_common_binding_labels.f03: Ditto.
	* test_common_binding_labels_2.f03: Ditto.
	* test_common_binding_labels_2_main.f03: Ditto.
	* test_common_binding_labels_3.f03: Ditto.
	* test_common_binding_labels_3_main.f03: Ditto.
	* test_only_clause.f90: Ditto.
	* use_iso_c_binding.f90: Ditto.
	* value_5.f90: Ditto.
	* value_test.f90: Ditto.
	* value_tests_f03.f90: Ditto.

From-SVN: r126185

1 files changed, 954 insertions, 10 deletions

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index e1b27dc..867c6ef 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -27,6 +27,7 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
 #include "gfortran.h"
 #include "parse.h"
 
+
 /* Strings for all symbol attributes.  We use these for dumping the
    parse tree, in error messages, and also when reading and writing
    modules.  */
@@ -249,6 +250,32 @@ gfc_set_default_type (gfc_symbol *sym, int error_flag, gfc_namespace *ns)
   sym->ts = *ts;
   sym->attr.implicit_type = 1;
 
+  if (sym->attr.is_bind_c == 1)
+    {
+      /* BIND(C) variables should not be implicitly declared.  */
+      gfc_warning_now ("Implicitly declared BIND(C) variable '%s' at %L may "
+                       "not be C interoperable", sym->name, &sym->declared_at);
+      sym->ts.f90_type = sym->ts.type;
+    }
+
+  if (sym->attr.dummy != 0)
+    {
+      if (sym->ns->proc_name != NULL
+	  && (sym->ns->proc_name->attr.subroutine != 0
+	      || sym->ns->proc_name->attr.function != 0)
+	  && sym->ns->proc_name->attr.is_bind_c != 0)
+        {
+          /* Dummy args to a BIND(C) routine may not be interoperable if
+             they are implicitly typed.  */
+          gfc_warning_now ("Implicity declared variable '%s' at %L may not "
+                           "be C interoperable but it is a dummy argument to "
+                           "the BIND(C) procedure '%s' at %L", sym->name,
+                           &(sym->declared_at), sym->ns->proc_name->name,
+                           &(sym->ns->proc_name->declared_at));
+          sym->ts.f90_type = sym->ts.type;
+        }
+    }
+  
   return SUCCESS;
 }
 
@@ -319,7 +346,8 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
     *dimension = "DIMENSION", *in_equivalence = "EQUIVALENCE",
     *use_assoc = "USE ASSOCIATED", *cray_pointer = "CRAY POINTER",
     *cray_pointee = "CRAY POINTEE", *data = "DATA", *value = "VALUE",
-    *volatile_ = "VOLATILE", *protected = "PROTECTED";
+    *volatile_ = "VOLATILE", *protected = "PROTECTED",
+    *is_bind_c = "BIND(C)";
   static const char *threadprivate = "THREADPRIVATE";
 
   const char *a1, *a2;
@@ -370,7 +398,6 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
   conf (dummy, save);
   conf (dummy, threadprivate);
   conf (pointer, target);
-  conf (pointer, external);
   conf (pointer, intrinsic);
   conf (pointer, elemental);
   conf (allocatable, elemental);
@@ -418,6 +445,17 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
 
   conf (function, subroutine);
 
+  if (!function && !subroutine)
+    conf (is_bind_c, dummy);
+
+  conf (is_bind_c, cray_pointer);
+  conf (is_bind_c, cray_pointee);
+  conf (is_bind_c, allocatable);
+
+  /* Need to also get volatile attr, according to 5.1 of F2003 draft.
+     Parameter conflict caught below.  Also, value cannot be specified
+     for a dummy procedure.  */
+
   /* Cray pointer/pointee conflicts.  */
   conf (cray_pointer, cray_pointee);
   conf (cray_pointer, dimension);
@@ -449,10 +487,6 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
   conf (data, allocatable);
   conf (data, use_assoc);
 
-  conf (protected, intrinsic)
-  conf (protected, external)
-  conf (protected, in_common)
-
   conf (value, pointer)
   conf (value, allocatable)
   conf (value, subroutine)
@@ -469,6 +503,10 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
       goto conflict;
     }
 
+  conf (protected, intrinsic)
+  conf (protected, external)
+  conf (protected, in_common)
+
   conf (volatile_, intrinsic)
   conf (volatile_, external)
 
@@ -596,6 +634,8 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
       conf2 (value);
       conf2 (volatile_);
       conf2 (threadprivate);
+      /* TODO: hmm, double check this.  */
+      conf2 (value);
       break;
 
     default:
@@ -1269,9 +1309,35 @@ gfc_add_access (symbol_attribute *attr, gfc_access access,
 }
 
 
+/* Set the is_bind_c field for the given symbol_attribute.  */
+
+try
+gfc_add_is_bind_c (symbol_attribute *attr, const char *name, locus *where,
+                   int is_proc_lang_bind_spec)
+{
+
+  if (is_proc_lang_bind_spec == 0 && attr->flavor == FL_PROCEDURE)
+    gfc_error_now ("BIND(C) attribute at %L can only be used for "
+		   "variables or common blocks", where);
+  else if (attr->is_bind_c)
+    gfc_error_now ("Duplicate BIND attribute specified at %L", where);
+  else
+    attr->is_bind_c = 1;
+  
+  if (where == NULL)
+    where = &gfc_current_locus;
+   
+  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: BIND(C) at %L", where)
+      == FAILURE)
+    return FAILURE;
+
+  return check_conflict (attr, name, where);
+}
+
+
 try
-gfc_add_explicit_interface (gfc_symbol * sym, ifsrc source,
-			    gfc_formal_arglist * formal, locus * where)
+gfc_add_explicit_interface (gfc_symbol *sym, ifsrc source,
+			    gfc_formal_arglist * formal, locus *where)
 {
 
   if (check_used (&sym->attr, sym->name, where))
@@ -1363,9 +1429,10 @@ gfc_missing_attr (symbol_attribute *attr ATTRIBUTE_UNUSED,
    where we are called from, so we ignore some bits.  */
 
 try
-gfc_copy_attr (symbol_attribute * dest, symbol_attribute * src, locus * where)
+gfc_copy_attr (symbol_attribute *dest, symbol_attribute *src, locus *where)
 {
-
+  int is_proc_lang_bind_spec;
+  
   if (src->allocatable && gfc_add_allocatable (dest, where) == FAILURE)
     goto fail;
 
@@ -1437,6 +1504,17 @@ gfc_copy_attr (symbol_attribute * dest, symbol_attribute * src, locus * where)
   if (src->cray_pointee && gfc_add_cray_pointee (dest, where) == FAILURE)
     goto fail;    
 
+  is_proc_lang_bind_spec = (src->flavor == FL_PROCEDURE ? 1 : 0);
+  if (src->is_bind_c
+      && gfc_add_is_bind_c (dest, NULL, where, is_proc_lang_bind_spec)
+	 != SUCCESS)
+    return FAILURE;
+
+  if (src->is_c_interop)
+    dest->is_c_interop = 1;
+  if (src->is_iso_c)
+    dest->is_iso_c = 1;
+  
   if (src->external && gfc_add_external (dest, where) == FAILURE)
     goto fail;
   if (src->intrinsic && gfc_add_intrinsic (dest, where) == FAILURE)
@@ -2087,6 +2165,16 @@ gfc_new_symbol (const char *name, gfc_namespace *ns)
     gfc_internal_error ("new_symbol(): Symbol name too long");
 
   p->name = gfc_get_string (name);
+
+  /* Make sure flags for symbol being C bound are clear initially.  */
+  p->attr.is_bind_c = 0;
+  p->attr.is_iso_c = 0;
+  /* Make sure the binding label field has a Nul char to start.  */
+  p->binding_label[0] = '\0';
+
+  /* Clear the ptrs we may need.  */
+  p->common_block = NULL;
+  
   return p;
 }
 
@@ -2872,3 +2960,859 @@ gfc_get_gsymbol (const char *name)
 
   return s;
 }
+
+
+static gfc_symbol *
+get_iso_c_binding_dt (int sym_id)
+{
+  gfc_dt_list *dt_list;
+
+  dt_list = gfc_derived_types;
+
+  /* Loop through the derived types in the name list, searching for
+     the desired symbol from iso_c_binding.  Search the parent namespaces
+     if necessary and requested to (parent_flag).  */
+  while (dt_list != NULL)
+    {
+      if (dt_list->derived->from_intmod != INTMOD_NONE
+	  && dt_list->derived->intmod_sym_id == sym_id)
+        return dt_list->derived;
+
+      dt_list = dt_list->next;
+    }
+
+  return NULL;
+}
+
+
+/* Verifies that the given derived type symbol, derived_sym, is interoperable
+   with C.  This is necessary for any derived type that is BIND(C) and for
+   derived types that are parameters to functions that are BIND(C).  All
+   fields of the derived type are required to be interoperable, and are tested
+   for such.  If an error occurs, the errors are reported here, allowing for
+   multiple errors to be handled for a single derived type.  */
+
+try
+verify_bind_c_derived_type (gfc_symbol *derived_sym)
+{
+  gfc_component *curr_comp = NULL;
+  try is_c_interop = FAILURE;
+  try retval = SUCCESS;
+   
+  if (derived_sym == NULL)
+    gfc_internal_error ("verify_bind_c_derived_type(): Given symbol is "
+                        "unexpectedly NULL");
+
+  /* If we've already looked at this derived symbol, do not look at it again
+     so we don't repeat warnings/errors.  */
+  if (derived_sym->ts.is_c_interop)
+    return SUCCESS;
+  
+  /* The derived type must have the BIND attribute to be interoperable
+     J3/04-007, Section 15.2.3.  */
+  if (derived_sym->attr.is_bind_c != 1)
+    {
+      derived_sym->ts.is_c_interop = 0;
+      gfc_error_now ("Derived type '%s' declared at %L must have the BIND "
+                     "attribute to be C interoperable", derived_sym->name,
+                     &(derived_sym->declared_at));
+      retval = FAILURE;
+    }
+  
+  curr_comp = derived_sym->components;
+
+  /* TODO: is this really an error?  */
+  if (curr_comp == NULL)
+    {
+      gfc_error ("Derived type '%s' at %L is empty",
+		 derived_sym->name, &(derived_sym->declared_at));
+      return FAILURE;
+    }
+
+  /* Initialize the derived type as being C interoperable.
+     If we find an error in the components, this will be set false.  */
+  derived_sym->ts.is_c_interop = 1;
+  
+  /* Loop through the list of components to verify that the kind of
+     each is a C interoperable type.  */
+  do
+    {
+      /* The components cannot be pointers (fortran sense).  
+         J3/04-007, Section 15.2.3, C1505.	*/
+      if (curr_comp->pointer != 0)
+        {
+          gfc_error ("Component '%s' at %L cannot have the "
+                     "POINTER attribute because it is a member "
+                     "of the BIND(C) derived type '%s' at %L",
+                     curr_comp->name, &(curr_comp->loc),
+                     derived_sym->name, &(derived_sym->declared_at));
+          retval = FAILURE;
+        }
+
+      /* The components cannot be allocatable.
+         J3/04-007, Section 15.2.3, C1505.	*/
+      if (curr_comp->allocatable != 0)
+        {
+          gfc_error ("Component '%s' at %L cannot have the "
+                     "ALLOCATABLE attribute because it is a member "
+                     "of the BIND(C) derived type '%s' at %L",
+                     curr_comp->name, &(curr_comp->loc),
+                     derived_sym->name, &(derived_sym->declared_at));
+          retval = FAILURE;
+        }
+      
+      /* BIND(C) derived types must have interoperable components.  */
+      if (curr_comp->ts.type == BT_DERIVED
+	  && curr_comp->ts.derived->ts.is_iso_c != 1 
+          && curr_comp->ts.derived != derived_sym)
+        {
+          /* This should be allowed; the draft says a derived-type can not
+             have type parameters if it is has the BIND attribute.  Type
+             parameters seem to be for making parameterized derived types.
+             There's no need to verify the type if it is c_ptr/c_funptr.  */
+          retval = verify_bind_c_derived_type (curr_comp->ts.derived);
+	}
+      else
+	{
+	  /* Grab the typespec for the given component and test the kind.  */ 
+	  is_c_interop = verify_c_interop (&(curr_comp->ts), curr_comp->name,
+                                           &(curr_comp->loc));
+	  
+	  if (is_c_interop != SUCCESS)
+	    {
+	      /* Report warning and continue since not fatal.  The
+		 draft does specify a constraint that requires all fields
+		 to interoperate, but if the user says real(4), etc., it
+		 may interoperate with *something* in C, but the compiler
+		 most likely won't know exactly what.  Further, it may not
+		 interoperate with the same data type(s) in C if the user
+		 recompiles with different flags (e.g., -m32 and -m64 on
+		 x86_64 and using integer(4) to claim interop with a
+		 C_LONG).  */
+	      if (derived_sym->attr.is_bind_c == 1)
+		/* If the derived type is bind(c), all fields must be
+		   interop.  */
+		gfc_warning ("Component '%s' in derived type '%s' at %L "
+                             "may not be C interoperable, even though "
+                             "derived type '%s' is BIND(C)",
+                             curr_comp->name, derived_sym->name,
+                             &(curr_comp->loc), derived_sym->name);
+	      else
+		/* If derived type is param to bind(c) routine, or to one
+		   of the iso_c_binding procs, it must be interoperable, so
+		   all fields must interop too.	 */
+		gfc_warning ("Component '%s' in derived type '%s' at %L "
+                             "may not be C interoperable",
+                             curr_comp->name, derived_sym->name,
+                             &(curr_comp->loc));
+	    }
+	}
+      
+      curr_comp = curr_comp->next;
+    } while (curr_comp != NULL); 
+
+
+  /* Make sure we don't have conflicts with the attributes.  */
+  if (derived_sym->attr.access == ACCESS_PRIVATE)
+    {
+      gfc_error ("Derived type '%s' at %L cannot be declared with both "
+                 "PRIVATE and BIND(C) attributes", derived_sym->name,
+                 &(derived_sym->declared_at));
+      retval = FAILURE;
+    }
+
+  if (derived_sym->attr.sequence != 0)
+    {
+      gfc_error ("Derived type '%s' at %L cannot have the SEQUENCE "
+                 "attribute because it is BIND(C)", derived_sym->name,
+                 &(derived_sym->declared_at));
+      retval = FAILURE;
+    }
+
+  /* Mark the derived type as not being C interoperable if we found an
+     error.  If there were only warnings, proceed with the assumption
+     it's interoperable.  */
+  if (retval == FAILURE)
+    derived_sym->ts.is_c_interop = 0;
+  
+  return retval;
+}
+
+
+/* Generate symbols for the named constants c_null_ptr and c_null_funptr.  */
+
+static try
+gen_special_c_interop_ptr (int ptr_id, const char *ptr_name,
+                           const char *module_name)
+{
+  gfc_symtree *tmp_symtree;
+  gfc_symbol *tmp_sym;
+
+  tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root, ptr_name);
+	 
+  if (tmp_symtree != NULL)
+    tmp_sym = tmp_symtree->n.sym;
+  else
+    {
+      tmp_sym = NULL;
+      gfc_internal_error ("gen_special_c_interop_ptr(): Unable to "
+                          "create symbol for %s", ptr_name);
+    }
+
+  /* Set up the symbol's important fields.  Save attr required so we can
+     initialize the ptr to NULL.  */
+  tmp_sym->attr.save = 1;
+  tmp_sym->ts.is_c_interop = 1;
+  tmp_sym->attr.is_c_interop = 1;
+  tmp_sym->ts.is_iso_c = 1;
+  tmp_sym->ts.type = BT_DERIVED;
+
+  /* The c_ptr and c_funptr derived types will provide the
+     definition for c_null_ptr and c_null_funptr, respectively.  */
+  if (ptr_id == ISOCBINDING_NULL_PTR)
+    tmp_sym->ts.derived = get_iso_c_binding_dt (ISOCBINDING_PTR);
+  else
+    tmp_sym->ts.derived = get_iso_c_binding_dt (ISOCBINDING_FUNPTR);
+  if (tmp_sym->ts.derived == NULL)
+    {
+      /* This can occur if the user forgot to declare c_ptr or
+         c_funptr and they're trying to use one of the procedures
+         that has arg(s) of the missing type.  In this case, a
+         regular version of the thing should have been put in the
+         current ns.  */
+      generate_isocbinding_symbol (module_name, ptr_id == ISOCBINDING_NULL_PTR 
+                                   ? ISOCBINDING_PTR : ISOCBINDING_FUNPTR,
+                                   (char *) (ptr_id == ISOCBINDING_NULL_PTR 
+				   ? "_gfortran_iso_c_binding_c_ptr"
+				   : "_gfortran_iso_c_binding_c_funptr"));
+
+      tmp_sym->ts.derived =
+        get_iso_c_binding_dt (ptr_id == ISOCBINDING_NULL_PTR
+                              ? ISOCBINDING_PTR : ISOCBINDING_FUNPTR);
+    }
+
+  /* Module name is some mangled version of iso_c_binding.  */
+  tmp_sym->module = gfc_get_string (module_name);
+  
+  /* Say it's from the iso_c_binding module.  */
+  tmp_sym->attr.is_iso_c = 1;
+  
+  tmp_sym->attr.use_assoc = 1;
+  tmp_sym->attr.is_bind_c = 1;
+  /* Set the binding_label.  */
+  sprintf (tmp_sym->binding_label, "%s_%s", module_name, tmp_sym->name);
+  
+  /* Set the c_address field of c_null_ptr and c_null_funptr to
+     the value of NULL.	 */
+  tmp_sym->value = gfc_get_expr ();
+  tmp_sym->value->expr_type = EXPR_STRUCTURE;
+  tmp_sym->value->ts.type = BT_DERIVED;
+  tmp_sym->value->ts.derived = tmp_sym->ts.derived;
+  tmp_sym->value->value.constructor = gfc_get_constructor ();
+  /* This line will initialize the c_null_ptr/c_null_funptr
+     c_address field to NULL.  */
+  tmp_sym->value->value.constructor->expr = gfc_int_expr (0);
+  /* Must declare c_null_ptr and c_null_funptr as having the
+     PARAMETER attribute so they can be used in init expressions.  */
+  tmp_sym->attr.flavor = FL_PARAMETER;
+
+  return SUCCESS;
+}
+
+
+/* Add a formal argument, gfc_formal_arglist, to the
+   end of the given list of arguments.	Set the reference to the
+   provided symbol, param_sym, in the argument.  */
+
+static void
+add_formal_arg (gfc_formal_arglist **head,
+                gfc_formal_arglist **tail,
+                gfc_formal_arglist *formal_arg,
+                gfc_symbol *param_sym)
+{
+  /* Put in list, either as first arg or at the tail (curr arg).  */
+  if (*head == NULL)
+    *head = *tail = formal_arg;
+  else
+    {
+      (*tail)->next = formal_arg;
+      (*tail) = formal_arg;
+    }
+   
+  (*tail)->sym = param_sym;
+  (*tail)->next = NULL;
+   
+  return;
+}
+
+
+/* Generates a symbol representing the CPTR argument to an
+   iso_c_binding procedure.  Also, create a gfc_formal_arglist for the
+   CPTR and add it to the provided argument list.  */
+
+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_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";
+
+  if(c_ptr_name == NULL)
+    c_ptr_in = "gfc_cptr__";
+  else
+    c_ptr_in = c_ptr_name;
+  gfc_get_sym_tree (c_ptr_in, ns, &param_symtree);
+  if (param_symtree != NULL)
+    param_sym = param_symtree->n.sym;
+  else
+    gfc_internal_error ("gen_cptr_param(): Unable to "
+			"create symbol for %s", c_ptr_in);
+
+  /* Set up the appropriate fields for the new c_ptr param sym.  */
+  param_sym->refs++;
+  param_sym->attr.flavor = FL_DERIVED;
+  param_sym->ts.type = BT_DERIVED;
+  param_sym->attr.intent = INTENT_IN;
+  param_sym->attr.dummy = 1;
+
+  /* This will pass the ptr to the iso_c routines as a (void *).  */
+  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).  */
+  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");
+      generate_isocbinding_symbol (module_name, ISOCBINDING_PTR,
+                                   (char *) "_gfortran_iso_c_binding_c_ptr");
+
+      gfc_get_ha_symbol (c_ptr_type, &(c_ptr_sym));
+    }
+
+  param_sym->ts.derived = c_ptr_sym;
+  param_sym->module = gfc_get_string (module_name);
+
+  /* Make new formal arg.  */
+  formal_arg = gfc_get_formal_arglist ();
+  /* Add arg to list of formal args (the CPTR arg).  */
+  add_formal_arg (head, tail, formal_arg, param_sym);
+}
+
+
+/* Generates a symbol representing the FPTR argument to an
+   iso_c_binding procedure.  Also, create a gfc_formal_arglist for the
+   FPTR and add it to the provided argument list.  */
+
+static void
+gen_fptr_param (gfc_formal_arglist **head,
+                gfc_formal_arglist **tail,
+                const char *module_name,
+                gfc_namespace *ns, const char *f_ptr_name)
+{
+  gfc_symbol *param_sym = NULL;
+  gfc_symtree *param_symtree = NULL;
+  gfc_formal_arglist *formal_arg = NULL;
+  const char *f_ptr_out = "gfc_fptr__";
+
+  if (f_ptr_name != NULL)
+    f_ptr_out = f_ptr_name;
+
+  gfc_get_sym_tree (f_ptr_out, ns, &param_symtree);
+  if (param_symtree != NULL)
+    param_sym = param_symtree->n.sym;
+  else
+    gfc_internal_error ("generateFPtrParam(): Unable to "
+			"create symbol for %s", f_ptr_out);
+
+  /* Set up the necessary fields for the fptr output param sym.  */
+  param_sym->refs++;
+  param_sym->attr.pointer = 1;
+  param_sym->attr.dummy = 1;
+  param_sym->attr.use_assoc = 1;
+
+  /* ISO C Binding type to allow any pointer type as actual param.  */
+  param_sym->ts.type = BT_VOID;
+  param_sym->module = gfc_get_string (module_name);
+   
+  /* Make the arg.  */
+  formal_arg = gfc_get_formal_arglist ();
+  /* Add arg to list of formal args.  */
+  add_formal_arg (head, tail, formal_arg, param_sym);
+}
+
+
+/* Generates a symbol representing the optional SHAPE argument for the
+   iso_c_binding c_f_pointer() procedure.  Also, create a
+   gfc_formal_arglist for the SHAPE and add it to the provided
+   argument list.  */
+
+static void
+gen_shape_param (gfc_formal_arglist **head,
+                 gfc_formal_arglist **tail,
+                 const char *module_name,
+                 gfc_namespace *ns, const char *shape_param_name)
+{
+  gfc_symbol *param_sym = NULL;
+  gfc_symtree *param_symtree = NULL;
+  gfc_formal_arglist *formal_arg = NULL;
+  const char *shape_param = "gfc_shape_array__";
+  int i;
+
+  if (shape_param_name != NULL)
+    shape_param = shape_param_name;
+
+  gfc_get_sym_tree (shape_param, ns, &param_symtree);
+  if (param_symtree != NULL)
+    param_sym = param_symtree->n.sym;
+  else
+    gfc_internal_error ("generateShapeParam(): Unable to "
+			"create symbol for %s", shape_param);
+   
+  /* Set up the necessary fields for the shape input param sym.  */
+  param_sym->refs++;
+  param_sym->attr.dummy = 1;
+  param_sym->attr.use_assoc = 1;
+
+  /* Integer array, rank 1, describing the shape of the object.  */
+  param_sym->ts.type = BT_INTEGER;
+  param_sym->ts.kind = gfc_default_integer_kind;   
+  param_sym->as = gfc_get_array_spec ();
+
+  /* Clear out the dimension info for the array.  */
+  for (i = 0; i < GFC_MAX_DIMENSIONS; i++)
+    {
+      param_sym->as->lower[i] = NULL;
+      param_sym->as->upper[i] = NULL;
+    }
+  param_sym->as->rank = 1;
+  param_sym->as->lower[0] = gfc_int_expr (1);
+
+  /* The extent is unknown until we get it.  The length give us
+     the rank the incoming pointer.  */
+  param_sym->as->type = AS_ASSUMED_SHAPE;
+
+  /* The arg is also optional; it is required iff the second arg
+     (fptr) is to an array, otherwise, it's ignored.  */
+  param_sym->attr.optional = 1;
+  param_sym->attr.intent = INTENT_IN;
+  param_sym->attr.dimension = 1;
+  param_sym->module = gfc_get_string (module_name);
+   
+  /* Make the arg.  */
+  formal_arg = gfc_get_formal_arglist ();
+  /* Add arg to list of formal args.  */
+  add_formal_arg (head, tail, formal_arg, param_sym);
+}
+
+/* Add a procedure interface to the given symbol (i.e., store a
+   reference to the list of formal arguments).  */
+
+static void
+add_proc_interface (gfc_symbol *sym, ifsrc source,
+                    gfc_formal_arglist *formal)
+{
+
+  sym->formal = formal;
+  sym->attr.if_source = source;
+}
+
+
+/* Builds the parameter list for the iso_c_binding procedure
+   c_f_pointer or c_f_procpointer.  The old_sym typically refers to a
+   generic version of either the c_f_pointer or c_f_procpointer
+   functions.  The new_proc_sym represents a "resolved" version of the
+   symbol.  The functions are resolved to match the types of their
+   parameters; for example, c_f_pointer(cptr, fptr) would resolve to
+   something similar to c_f_pointer_i4 if the type of data object fptr
+   pointed to was a default integer.  The actual name of the resolved
+   procedure symbol is further mangled with the module name, etc., but
+   the idea holds true.  */
+
+static void
+build_formal_args (gfc_symbol *new_proc_sym,
+                   gfc_symbol *old_sym, int add_optional_arg)
+{
+  gfc_formal_arglist *head = NULL, *tail = NULL;
+  gfc_namespace *parent_ns = NULL;
+
+  parent_ns = gfc_current_ns;
+  /* Create a new namespace, which will be the formal ns (namespace
+     of the formal args).  */
+  gfc_current_ns = gfc_get_namespace(parent_ns, 0);
+  gfc_current_ns->proc_name = new_proc_sym;
+
+  /* Generate the params.  */
+  if ((old_sym->intmod_sym_id == ISOCBINDING_F_POINTER) ||
+      (old_sym->intmod_sym_id == ISOCBINDING_F_PROCPOINTER))
+    {
+      gen_cptr_param (&head, &tail, (const char *) new_proc_sym->module,
+		      gfc_current_ns, "cptr");
+      gen_fptr_param (&head, &tail, (const char *) new_proc_sym->module,
+		      gfc_current_ns, "fptr");
+
+      /* If we're dealing with c_f_pointer, it has an optional third arg.  */
+      if (old_sym->intmod_sym_id == ISOCBINDING_F_POINTER)
+	{
+	  gen_shape_param (&head, &tail,
+			   (const char *) new_proc_sym->module,
+			   gfc_current_ns, "shape");
+	}
+    }
+  else if (old_sym->intmod_sym_id == ISOCBINDING_ASSOCIATED)
+    {
+      /* 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");
+      if (add_optional_arg)
+	{
+	  gen_cptr_param (&head, &tail, (const char *) new_proc_sym->module,
+			  gfc_current_ns, "c_ptr_2");
+	  /* The last param is optional so mark it as such.  */
+	  tail->sym->attr.optional = 1;
+	}
+    }
+
+  /* Add the interface (store formal args to new_proc_sym).  */
+  add_proc_interface (new_proc_sym, IFSRC_DECL, head);
+
+  /* Set up the formal_ns pointer to the one created for the
+     new procedure so it'll get cleaned up during gfc_free_symbol().  */
+  new_proc_sym->formal_ns = gfc_current_ns;
+
+  gfc_current_ns = parent_ns;
+}
+
+
+/* Generate the given set of C interoperable kind objects, or all
+   interoperable kinds.  This function will only be given kind objects
+   for valid iso_c_binding defined types because this is verified when
+   the 'use' statement is parsed.  If the user gives an 'only' clause,
+   the specific kinds are looked up; if they don't exist, an error is
+   reported.  If the user does not give an 'only' clause, all
+   iso_c_binding symbols are generated.  If a list of specific kinds
+   is given, it must have a NULL in the first empty spot to mark the
+   end of the list.  */
+
+
+void
+generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
+			     char *local_name)
+{
+  char *name = (local_name && local_name[0]) ? local_name
+					     : c_interop_kinds_table[s].name;
+  gfc_symtree *tmp_symtree = NULL;
+  gfc_symbol *tmp_sym = NULL;
+  gfc_dt_list **dt_list_ptr = NULL;
+  gfc_component *tmp_comp = NULL;
+  char comp_name[(GFC_MAX_SYMBOL_LEN * 2) + 1];
+  int index;
+
+  tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root, name);
+
+  /* Already exists in this scope so don't re-add it.
+     TODO: we should probably check that it's really the same symbol.  */
+  if (tmp_symtree != NULL)
+    return;
+
+  /* Create the sym tree in the current ns.  */
+  gfc_get_sym_tree (name, gfc_current_ns, &tmp_symtree);
+  if (tmp_symtree)
+    tmp_sym = tmp_symtree->n.sym;
+  else
+    gfc_internal_error ("generate_isocbinding_symbol(): Unable to "
+			"create symbol");
+
+  /* Say what module this symbol belongs to.  */
+  tmp_sym->module = gfc_get_string (mod_name);
+  tmp_sym->from_intmod = INTMOD_ISO_C_BINDING;
+  tmp_sym->intmod_sym_id = s;
+
+  switch (s)
+    {
+
+#define NAMED_INTCST(a,b,c) case a :
+#define NAMED_REALCST(a,b,c) case a :
+#define NAMED_CMPXCST(a,b,c) case a :
+#define NAMED_LOGCST(a,b,c) case a :
+#define NAMED_CHARKNDCST(a,b,c) case a :
+#include "iso-c-binding.def"
+
+	tmp_sym->value = gfc_int_expr (c_interop_kinds_table[s].value);
+
+	/* Initialize an integer constant expression node.  */
+	tmp_sym->attr.flavor = FL_PARAMETER;
+	tmp_sym->ts.type = BT_INTEGER;
+	tmp_sym->ts.kind = gfc_default_integer_kind;
+
+	/* Mark this type as a C interoperable one.  */
+	tmp_sym->ts.is_c_interop = 1;
+	tmp_sym->ts.is_iso_c = 1;
+	tmp_sym->value->ts.is_c_interop = 1;
+	tmp_sym->value->ts.is_iso_c = 1;
+	tmp_sym->attr.is_c_interop = 1;
+
+	/* Tell what f90 type this c interop kind is valid.  */
+	tmp_sym->ts.f90_type = c_interop_kinds_table[s].f90_type;
+
+	/* Say it's from the iso_c_binding module.  */
+	tmp_sym->attr.is_iso_c = 1;
+
+	/* Make it use associated.  */
+	tmp_sym->attr.use_assoc = 1;
+	break;
+
+
+#define NAMED_CHARCST(a,b,c) case a :
+#include "iso-c-binding.def"
+
+	/* Initialize an integer constant expression node for the
+	   length of the character.  */
+	tmp_sym->value = gfc_get_expr (); 
+	tmp_sym->value->expr_type = EXPR_CONSTANT;
+	tmp_sym->value->ts.type = BT_CHARACTER;
+	tmp_sym->value->ts.kind = gfc_default_character_kind;
+	tmp_sym->value->where = gfc_current_locus;
+	tmp_sym->value->ts.is_c_interop = 1;
+	tmp_sym->value->ts.is_iso_c = 1;
+	tmp_sym->value->value.character.length = 1;
+	tmp_sym->value->value.character.string = gfc_getmem (2);
+	tmp_sym->value->value.character.string[0]
+	  = (char) c_interop_kinds_table[s].value;
+	tmp_sym->value->value.character.string[1] = '\0';
+
+	/* May not need this in both attr and ts, but do need in
+	   attr for writing module file.  */
+	tmp_sym->attr.is_c_interop = 1;
+
+	tmp_sym->attr.flavor = FL_PARAMETER;
+	tmp_sym->ts.type = BT_CHARACTER;
+
+	/* Need to set it to the C_CHAR kind.  */
+	tmp_sym->ts.kind = gfc_default_character_kind;
+
+	/* Mark this type as a C interoperable one.  */
+	tmp_sym->ts.is_c_interop = 1;
+	tmp_sym->ts.is_iso_c = 1;
+
+	/* Tell what f90 type this c interop kind is valid.  */
+	tmp_sym->ts.f90_type = BT_CHARACTER;
+
+	/* Say it's from the iso_c_binding module.  */
+	tmp_sym->attr.is_iso_c = 1;
+
+	/* Make it use associated.  */
+	tmp_sym->attr.use_assoc = 1;
+	break;
+
+      case ISOCBINDING_PTR:
+      case ISOCBINDING_FUNPTR:
+
+	/* Initialize an integer constant expression node.  */
+	tmp_sym->attr.flavor = FL_DERIVED;
+	tmp_sym->ts.is_c_interop = 1;
+	tmp_sym->attr.is_c_interop = 1;
+	tmp_sym->attr.is_iso_c = 1;
+	tmp_sym->ts.is_iso_c = 1;
+	tmp_sym->ts.type = BT_DERIVED;
+
+	/* A derived type must have the bind attribute to be
+	   interoperable (J3/04-007, Section 15.2.3), even though
+	   the binding label is not used.  */
+	tmp_sym->attr.is_bind_c = 1;
+
+	tmp_sym->attr.referenced = 1;
+
+	tmp_sym->ts.derived = tmp_sym;
+
+        /* Add the symbol created for the derived type to the current ns.  */
+        dt_list_ptr = &(gfc_derived_types);
+        while (*dt_list_ptr != NULL && (*dt_list_ptr)->next != NULL)
+          dt_list_ptr = &((*dt_list_ptr)->next);
+
+        /* There is already at least one derived type in the list, so append
+           the one we're currently building for c_ptr or c_funptr.  */
+        if (*dt_list_ptr != NULL)
+          dt_list_ptr = &((*dt_list_ptr)->next);
+        (*dt_list_ptr) = gfc_get_dt_list ();
+        (*dt_list_ptr)->derived = tmp_sym;
+        (*dt_list_ptr)->next = NULL;
+
+        /* Set up the component of the derived type, which will be
+           an integer with kind equal to c_ptr_size.  Mangle the name of
+           the field for the c_address to prevent the curious user from
+           trying to access it from Fortran.  */
+        sprintf (comp_name, "__%s_%s", tmp_sym->name, "c_address");
+        gfc_add_component (tmp_sym, comp_name, &tmp_comp);
+        if (tmp_comp == NULL)
+          gfc_internal_error ("generate_isocbinding_symbol(): Unable to "
+			      "create component for c_address");
+
+        tmp_comp->ts.type = BT_INTEGER;
+
+        /* Set this because the module will need to read/write this field.  */
+        tmp_comp->ts.f90_type = BT_INTEGER;
+
+        /* The kinds for c_ptr and c_funptr are the same.  */
+        index = get_c_kind ("c_ptr", c_interop_kinds_table);
+        tmp_comp->ts.kind = c_interop_kinds_table[index].value;
+
+        tmp_comp->pointer = 0;
+        tmp_comp->dimension = 0;
+
+        /* Mark the component as C interoperable.  */
+        tmp_comp->ts.is_c_interop = 1;
+
+        /* Make it use associated (iso_c_binding module).  */
+        tmp_sym->attr.use_assoc = 1;
+	break;
+
+      case ISOCBINDING_NULL_PTR:
+      case ISOCBINDING_NULL_FUNPTR:
+        gen_special_c_interop_ptr (s, name, mod_name);
+        break;
+
+      case ISOCBINDING_F_POINTER:
+      case ISOCBINDING_ASSOCIATED:
+      case ISOCBINDING_LOC:
+      case ISOCBINDING_FUNLOC:
+      case ISOCBINDING_F_PROCPOINTER:
+
+	tmp_sym->attr.proc = PROC_MODULE;
+
+        /* Use the procedure's name as it is in the iso_c_binding module for
+           setting the binding label in case the user renamed the symbol.  */
+	sprintf (tmp_sym->binding_label, "%s_%s", mod_name,
+                 c_interop_kinds_table[s].name);
+	tmp_sym->attr.is_iso_c = 1;
+	if (s == ISOCBINDING_F_POINTER || s == ISOCBINDING_F_PROCPOINTER)
+	  tmp_sym->attr.subroutine = 1;
+	else
+	  {
+            /* TODO!  This needs to be finished more for the expr of the
+               function or something!
+               This may not need to be here, because trying to do c_loc
+               as an external.  */
+	    if (s == ISOCBINDING_ASSOCIATED)
+	      {
+		tmp_sym->attr.function = 1;
+		tmp_sym->ts.type = BT_LOGICAL;
+		tmp_sym->ts.kind = gfc_default_logical_kind;
+		tmp_sym->result = tmp_sym;
+	      }
+	    else
+	      {
+               /* Here, we're taking the simple approach.  We're defining
+                  c_loc as an external identifier so the compiler will put
+                  what we expect on the stack for the address we want the
+                  C address of.  */
+		tmp_sym->ts.type = BT_DERIVED;
+                if (s == ISOCBINDING_LOC)
+                  tmp_sym->ts.derived =
+                    get_iso_c_binding_dt (ISOCBINDING_PTR);
+                else
+                  tmp_sym->ts.derived =
+                    get_iso_c_binding_dt (ISOCBINDING_FUNPTR);
+
+                if (tmp_sym->ts.derived == NULL)
+                  {
+                    /* Create the necessary derived type so we can continue
+                       processing the file.  */
+                    generate_isocbinding_symbol
+                      (mod_name, s == ISOCBINDING_FUNLOC
+                       ? ISOCBINDING_FUNPTR : ISOCBINDING_FUNPTR,
+                       (char *)(s == ISOCBINDING_FUNLOC 
+                                ? "_gfortran_iso_c_binding_c_funptr"
+				: "_gfortran_iso_c_binding_c_ptr"));
+                    tmp_sym->ts.derived =
+                      get_iso_c_binding_dt (s == ISOCBINDING_FUNLOC
+                                            ? ISOCBINDING_FUNPTR
+                                            : ISOCBINDING_PTR);
+                  }
+
+		/* The function result is itself (no result clause).  */
+		tmp_sym->result = tmp_sym;
+		tmp_sym->attr.external = 1;
+		tmp_sym->attr.use_assoc = 0;
+		tmp_sym->attr.if_source = IFSRC_UNKNOWN;
+		tmp_sym->attr.proc = PROC_UNKNOWN;
+	      }
+	  }
+
+	tmp_sym->attr.flavor = FL_PROCEDURE;
+	tmp_sym->attr.contained = 0;
+	
+       /* Try using this builder routine, with the new and old symbols
+          both being the generic iso_c proc sym being created.  This
+          will create the formal args (and the new namespace for them).
+          Don't build an arg list for c_loc because we're going to treat
+          c_loc as an external procedure.  */
+	if (s != ISOCBINDING_LOC && s != ISOCBINDING_FUNLOC)
+          /* The 1 says to add any optional args, if applicable.  */
+	  build_formal_args (tmp_sym, tmp_sym, 1);
+
+        /* Set this after setting up the symbol, to prevent error messages.  */
+	tmp_sym->attr.use_assoc = 1;
+
+        /* This symbol will not be referenced directly.  It will be
+           resolved to the implementation for the given f90 kind.  */
+	tmp_sym->attr.referenced = 0;
+
+	break;
+
+      default:
+	gcc_unreachable ();
+    }
+}
+
+
+/* Creates a new symbol based off of an old iso_c symbol, with a new
+   binding label.  This function can be used to create a new,
+   resolved, version of a procedure symbol for c_f_pointer or
+   c_f_procpointer that is based on the generic symbols.  A new
+   parameter list is created for the new symbol using
+   build_formal_args().  The add_optional_flag specifies whether the
+   to add the optional SHAPE argument.  The new symbol is
+   returned.  */
+
+gfc_symbol *
+get_iso_c_sym (gfc_symbol *old_sym, char *new_name,
+               char *new_binding_label, int add_optional_arg)
+{
+  gfc_symtree *new_symtree = NULL;
+
+  /* See if we have a symbol by that name already available, looking
+     through any parent namespaces.  */
+  gfc_find_sym_tree (new_name, gfc_current_ns, 1, &new_symtree);
+  if (new_symtree != NULL)
+    /* Return the existing symbol.  */
+    return new_symtree->n.sym;
+
+  /* Create the symtree/symbol, with attempted host association.  */
+  gfc_get_ha_sym_tree (new_name, &new_symtree);
+  if (new_symtree == NULL)
+    gfc_internal_error ("get_iso_c_sym(): Unable to create "
+			"symtree for '%s'", new_name);
+
+  /* Now fill in the fields of the resolved symbol with the old sym.  */
+  strcpy (new_symtree->n.sym->binding_label, new_binding_label);
+  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);
+  /* Build the formal arg list.  */
+  build_formal_args (new_symtree->n.sym, old_sym, add_optional_arg);
+
+  gfc_commit_symbol (new_symtree->n.sym);
+
+  return new_symtree->n.sym;
+}
+