re PR fortran/38536 (ICE with C_LOC in resolve.c due to not properly going through expr->ref)

2013-03-25  Tobias Burnus  <burnus@net-b.de>

        PR fortran/38536
        PR fortran/38813
        PR fortran/38894
        PR fortran/39288
        PR fortran/40963
        PR fortran/45824
        PR fortran/47023
        PR fortran/47034
        PR fortran/49023
        PR fortran/50269
        PR fortran/50612
        PR fortran/52426
        PR fortran/54263
        PR fortran/55343
        PR fortran/55444
        PR fortran/55574
        PR fortran/56079
        PR fortran/56378
        * check.c (gfc_var_strlen): Properly handle 0-sized string.
        (gfc_check_c_sizeof): Use is_c_interoperable, add checks.
        (is_c_interoperable, gfc_check_c_associated, gfc_check_c_f_pointer,
        gfc_check_c_f_procpointer, gfc_check_c_funloc, gfc_check_c_loc): New
        functions.
        * expr.c (check_inquiry): Add c_sizeof, compiler_version and
        compiler_options.
        (gfc_check_pointer_assign): Refine function result check.
        gfortran.h (gfc_isym_id): Add GFC_ISYM_C_ASSOCIATED,
        GFC_ISYM_C_F_POINTER, GFC_ISYM_C_F_PROCPOINTER, GFC_ISYM_C_FUNLOC,
        GFC_ISYM_C_LOC.
        (iso_fortran_env_symbol, iso_c_binding_symbol): Handle
        NAMED_SUBROUTINE.
        (generate_isocbinding_symbol): Update prototype.
        (get_iso_c_sym): Remove.
        (gfc_isym_id_by_intmod, gfc_isym_id_by_intmod_sym): New prototypes.
        * intrinsic.c (gfc_intrinsic_subroutine_by_id): New function.
        (gfc_intrinsic_sub_interface): Use it.
        (add_functions, add_subroutines): Add missing C-binding intrinsics.
        (gfc_intrinsic_func_interface): Add special case for c_loc.
        gfc_isym_id_by_intmod, gfc_isym_id_by_intmod_sym): New functions.
        (gfc_intrinsic_func_interface, gfc_intrinsic_sub_interface): Use them.
        * intrinsic.h (gfc_check_c_associated, gfc_check_c_f_pointer,
        gfc_check_c_f_procpointer, gfc_check_c_funloc, gfc_check_c_loc,
        gfc_resolve_c_loc, gfc_resolve_c_funloc): New prototypes.
        * iresolve.c (gfc_resolve_c_loc, gfc_resolve_c_funloc): New
        functions.
        * iso-c-binding.def: Split PROCEDURE into NAMED_SUBROUTINE and
        NAMED_FUNCTION.
        * iso-fortran-env.def: Add NAMED_SUBROUTINE for completeness.
        * module.c (create_intrinsic_function): Support subroutines and
        derived-type results.
        (use_iso_fortran_env_module): Update calls.
        (import_iso_c_binding_module): Ditto; update calls to
        generate_isocbinding_symbol.
        * resolve.c (find_arglists): Skip for intrinsic symbols.
        (gfc_resolve_intrinsic): Find intrinsic subs via id.
        (is_scalar_expr_ptr, gfc_iso_c_func_interface,
        set_name_and_label, gfc_iso_c_sub_interface): Remove.
        (resolve_function, resolve_specific_s0): Remove calls to those.
        (resolve_structure_cons): Fix handling.
        * symbol.c (gen_special_c_interop_ptr): Update c_ptr/c_funptr
        generation.
        (gen_cptr_param, gen_fptr_param, gen_shape_param,
        build_formal_args, get_iso_c_sym): Remove.
        (std_for_isocbinding_symbol): Handle NAMED_SUBROUTINE.
        (generate_isocbinding_symbol): Support hidden symbols and
        using c_ptr/c_funptr symtrees for nullptr defs.
        * target-memory.c (gfc_target_encode_expr): Fix handling
        of c_ptr/c_funptr.
        * trans-expr.c (conv_isocbinding_procedure): Remove.
        (gfc_conv_procedure_call): Remove call to it.
        (gfc_trans_subcomponent_assign, gfc_conv_expr): Update handling
        of c_ptr/c_funptr.
        * trans-intrinsic.c (conv_isocbinding_function,
        conv_isocbinding_subroutine): New.
        (gfc_conv_intrinsic_function, gfc_conv_intrinsic_subroutine):
        Call them.
        * trans-io.c (transfer_expr): Fix handling of c_ptr/c_funptr.
        * trans-types.c (gfc_typenode_for_spec,
        gfc_get_derived_type): Ditto.
        (gfc_init_c_interop_kinds): Handle NAMED_SUBROUTINE.

2013-03-25  Tobias Burnus  <burnus@net-b.de>

        PR fortran/38536
        PR fortran/38813
        PR fortran/38894
        PR fortran/39288
        PR fortran/40963
        PR fortran/45824
        PR fortran/47023
        PR fortran/47034
        PR fortran/49023
        PR fortran/50269
        PR fortran/50612
        PR fortran/52426
        PR fortran/54263
        PR fortran/55343
        PR fortran/55444
        PR fortran/55574
        PR fortran/56079
        PR fortran/56378
        * gfortran.dg/c_assoc_2.f03: Update dg-error wording.
        * gfortran.dg/c_f_pointer_shape_test.f90: Ditto.
        * gfortran.dg/c_f_pointer_shape_tests_3.f03: Ditto.
        * gfortran.dg/c_f_pointer_tests_5.f90: Ditto.
        * gfortran.dg/c_funloc_tests_2.f03: Ditto.
        * gfortran.dg/c_funloc_tests_5.f03: Ditto.
        * gfortran.dg/c_funloc_tests_6.f90: Ditto.
        * gfortran.dg/c_loc_tests_10.f03: Add -std=f2008.
        * gfortran.dg/c_loc_tests_11.f03: Ditto, update dg-error.
        * gfortran.dg/c_loc_tests_16.f90: Ditto.
        * gfortran.dg/c_loc_tests_4.f03: Ditto.
        * gfortran.dg/c_loc_tests_15.f90: Update dg-error wording.
        * gfortran.dg/c_loc_tests_3.f03: Valid since F2003 TC5.
        * gfortran.dg/c_loc_tests_8.f03: Ditto.
        * gfortran.dg/c_ptr_tests_14.f90: Update scan-tree-dump-times.
        * gfortran.dg/c_ptr_tests_15.f90: Ditto.
        * gfortran.dg/c_sizeof_1.f90: Fix invalid code.
        * gfortran.dg/iso_c_binding_init_expr.f03: Update dg-error wording.
        * gfortran.dg/pr32601_1.f03: Ditto.
        * gfortran.dg/storage_size_2.f08: Remove dg-error.
        * gfortran.dg/blockdata_7.f90: New.
        * gfortran.dg/c_assoc_4.f90: New.
        * gfortran.dg/c_f_pointer_tests_6.f90: New.
        * gfortran.dg/c_f_pointer_tests_7.f90: New.
        * gfortran.dg/c_funloc_tests_8.f90: New.
        * gfortran.dg/c_loc_test_17.f90: New.
        * gfortran.dg/c_loc_test_18.f90: New.
        * gfortran.dg/c_loc_test_19.f90: New.
        * gfortran.dg/c_loc_test_20.f90: New.
        * gfortran.dg/c_sizeof_5.f90: New.
        * gfortran.dg/iso_c_binding_rename_3.f90: New.
        * gfortran.dg/transfer_resolve_2.f90: New.
        * gfortran.dg/transfer_resolve_3.f90: New.
        * gfortran.dg/transfer_resolve_4.f90: New.
        * gfortran.dg/pr32601.f03: Update dg-error.
        * gfortran.dg/c_ptr_tests_13.f03: Update dg-error.
        * gfortran.dg/c_ptr_tests_9.f03: Fix test case.

From-SVN: r197053

gcc/fortran/ChangeLog

+2013-03-25  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/38536
+	PR fortran/38813
+	PR fortran/38894
+	PR fortran/39288
+	PR fortran/40963
+	PR fortran/45824
+	PR fortran/47023
+	PR fortran/47034
+	PR fortran/49023
+	PR fortran/50269
+	PR fortran/50612
+	PR fortran/52426
+	PR fortran/54263
+	PR fortran/55343
+	PR fortran/55444
+	PR fortran/55574
+	PR fortran/56079
+	PR fortran/56378
+	* check.c (gfc_var_strlen): Properly handle 0-sized string.
+	(gfc_check_c_sizeof): Use is_c_interoperable, add checks.
+	(is_c_interoperable, gfc_check_c_associated, gfc_check_c_f_pointer,
+	gfc_check_c_f_procpointer, gfc_check_c_funloc, gfc_check_c_loc): New
+	functions.
+	* expr.c (check_inquiry): Add c_sizeof, compiler_version and
+	compiler_options.
+	(gfc_check_pointer_assign): Refine function result check.
+	gfortran.h (gfc_isym_id): Add GFC_ISYM_C_ASSOCIATED,
+	GFC_ISYM_C_F_POINTER, GFC_ISYM_C_F_PROCPOINTER, GFC_ISYM_C_FUNLOC,
+	GFC_ISYM_C_LOC.
+	(iso_fortran_env_symbol, iso_c_binding_symbol): Handle
+	NAMED_SUBROUTINE.
+	(generate_isocbinding_symbol): Update prototype.
+	(get_iso_c_sym): Remove.
+	(gfc_isym_id_by_intmod, gfc_isym_id_by_intmod_sym): New prototypes.
+	* intrinsic.c (gfc_intrinsic_subroutine_by_id): New function.
+	(gfc_intrinsic_sub_interface): Use it.
+	(add_functions, add_subroutines): Add missing C-binding intrinsics.
+	(gfc_intrinsic_func_interface): Add special case for c_loc.
+	gfc_isym_id_by_intmod, gfc_isym_id_by_intmod_sym): New functions.
+	(gfc_intrinsic_func_interface, gfc_intrinsic_sub_interface): Use them.
+	* intrinsic.h (gfc_check_c_associated, gfc_check_c_f_pointer,
+	gfc_check_c_f_procpointer, gfc_check_c_funloc, gfc_check_c_loc,
+	gfc_resolve_c_loc, gfc_resolve_c_funloc): New prototypes.
+	* iresolve.c (gfc_resolve_c_loc, gfc_resolve_c_funloc): New
+	functions.
+	* iso-c-binding.def: Split PROCEDURE into NAMED_SUBROUTINE and
+	NAMED_FUNCTION.
+	* iso-fortran-env.def: Add NAMED_SUBROUTINE for completeness.
+	* module.c (create_intrinsic_function): Support subroutines and
+	derived-type results.
+	(use_iso_fortran_env_module): Update calls.
+	(import_iso_c_binding_module): Ditto; update calls to
+	generate_isocbinding_symbol.
+	* resolve.c (find_arglists): Skip for intrinsic symbols.
+	(gfc_resolve_intrinsic): Find intrinsic subs via id.
+	(is_scalar_expr_ptr, gfc_iso_c_func_interface,
+	set_name_and_label, gfc_iso_c_sub_interface): Remove.
+	(resolve_function, resolve_specific_s0): Remove calls to those.
+	(resolve_structure_cons): Fix handling.
+	* symbol.c (gen_special_c_interop_ptr): Update c_ptr/c_funptr
+	generation.
+	(gen_cptr_param, gen_fptr_param, gen_shape_param,
+	build_formal_args, get_iso_c_sym): Remove.
+	(std_for_isocbinding_symbol): Handle NAMED_SUBROUTINE.
+	(generate_isocbinding_symbol): Support hidden symbols and
+	using c_ptr/c_funptr symtrees for nullptr defs.
+	* target-memory.c (gfc_target_encode_expr): Fix handling
+	of c_ptr/c_funptr.
+	* trans-expr.c (conv_isocbinding_procedure): Remove.
+	(gfc_conv_procedure_call): Remove call to it.
+	(gfc_trans_subcomponent_assign, gfc_conv_expr): Update handling
+	of c_ptr/c_funptr.
+	* trans-intrinsic.c (conv_isocbinding_function,
+	conv_isocbinding_subroutine): New.
+	(gfc_conv_intrinsic_function, gfc_conv_intrinsic_subroutine):
+	Call them.
+	* trans-io.c (transfer_expr): Fix handling of c_ptr/c_funptr.
+	* trans-types.c (gfc_typenode_for_spec,
+	gfc_get_derived_type): Ditto.
+	(gfc_init_c_interop_kinds): Handle NAMED_SUBROUTINE.
+
 2013-03-18  Tobias Burnus  <burnus@net-b.de>
 
 	* gfortran.h (gfc_option_t): Remove flag_whole_file.

gcc/fortran/expr.c

@@ -2256,7 +2256,7 @@ check_inquiry (gfc_expr *e, int not_restricted)
     "new_line", NULL
   };
 
-  int i;
+  int i = 0;
   gfc_actual_arglist *ap;
 
   if (!e->value.function.isym
@@ -2267,17 +2267,31 @@ check_inquiry (gfc_expr *e, int not_restricted)
   if (e->symtree == NULL)
     return MATCH_NO;
 
-  name = e->symtree->n.sym->name;
+  if (e->symtree->n.sym->from_intmod)
+    {
+      if (e->symtree->n.sym->from_intmod == INTMOD_ISO_FORTRAN_ENV
+	  && e->symtree->n.sym->intmod_sym_id != ISOFORTRAN_COMPILER_OPTIONS
+	  && e->symtree->n.sym->intmod_sym_id != ISOFORTRAN_COMPILER_VERSION)
+	return MATCH_NO;
+
+      if (e->symtree->n.sym->from_intmod == INTMOD_ISO_C_BINDING
+	  && e->symtree->n.sym->intmod_sym_id != ISOCBINDING_C_SIZEOF)
+	return MATCH_NO;
+    }
+  else
+    {
+      name = e->symtree->n.sym->name;
 
-  functions = (gfc_option.warn_std & GFC_STD_F2003)
+      functions = (gfc_option.warn_std & GFC_STD_F2003)
 		? inquiry_func_f2003 : inquiry_func_f95;
 
-  for (i = 0; functions[i]; i++)
-    if (strcmp (functions[i], name) == 0)
-      break;
+      for (i = 0; functions[i]; i++)
+	if (strcmp (functions[i], name) == 0)
+	  break;
 
-  if (functions[i] == NULL)
-    return MATCH_ERROR;
+	if (functions[i] == NULL)
+	  return MATCH_ERROR;
+    }
 
   /* At this point we have an inquiry function with a variable argument.  The
      type of the variable might be undefined, but we need it now, because the
@@ -3429,13 +3443,18 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
 	      attr = gfc_expr_attr (rvalue);
 	    }
 	  /* Check for result of embracing function.  */
-	  if (sym == gfc_current_ns->proc_name
-	      && sym->attr.function && sym->result == sym)
+	  if (sym->attr.function && sym->result == sym)
 	    {
-	      gfc_error ("Function result '%s' is invalid as proc-target "
-			 "in procedure pointer assignment at %L",
-			 sym->name, &rvalue->where);
-	      return FAILURE;
+	      gfc_namespace *ns;
+
+	      for (ns = gfc_current_ns; ns; ns = ns->parent)
+		if (sym == ns->proc_name)
+		  {
+		    gfc_error ("Function result '%s' is invalid as proc-target "
+			       "in procedure pointer assignment at %L",
+			       sym->name, &rvalue->where);
+		    return FAILURE;
+		  }
 	    }
 	}
       if (attr.abstract)

gcc/fortran/gfortran.h

@@ -343,6 +343,11 @@ enum gfc_isym_id
   GFC_ISYM_CPU_TIME,
   GFC_ISYM_CSHIFT,
   GFC_ISYM_CTIME,
+  GFC_ISYM_C_ASSOCIATED,
+  GFC_ISYM_C_F_POINTER,
+  GFC_ISYM_C_F_PROCPOINTER,
+  GFC_ISYM_C_FUNLOC,
+  GFC_ISYM_C_LOC,
   GFC_ISYM_C_SIZEOF,
   GFC_ISYM_DATE_AND_TIME,
   GFC_ISYM_DBLE,
@@ -610,6 +615,7 @@ gfc_reverse;
 #define NAMED_INTCST(a,b,c,d) a,
 #define NAMED_KINDARRAY(a,b,c,d) a,
 #define NAMED_FUNCTION(a,b,c,d) a,
+#define NAMED_SUBROUTINE(a,b,c,d) a,
 #define NAMED_DERIVED_TYPE(a,b,c,d) a,
 typedef enum
 {
@@ -621,6 +627,7 @@ iso_fortran_env_symbol;
 #undef NAMED_INTCST
 #undef NAMED_KINDARRAY
 #undef NAMED_FUNCTION
+#undef NAMED_SUBROUTINE
 #undef NAMED_DERIVED_TYPE
 
 #define NAMED_INTCST(a,b,c,d) a,
@@ -630,8 +637,8 @@ iso_fortran_env_symbol;
 #define NAMED_CHARKNDCST(a,b,c) a,
 #define NAMED_CHARCST(a,b,c) a,
 #define DERIVED_TYPE(a,b,c) a,
-#define PROCEDURE(a,b) a,
 #define NAMED_FUNCTION(a,b,c,d) a,
+#define NAMED_SUBROUTINE(a,b,c,d) a,
 typedef enum
 {
   ISOCBINDING_INVALID = -1,
@@ -647,8 +654,8 @@ iso_c_binding_symbol;
 #undef NAMED_CHARKNDCST
 #undef NAMED_CHARCST
 #undef DERIVED_TYPE
-#undef PROCEDURE
 #undef NAMED_FUNCTION
+#undef NAMED_SUBROUTINE
 
 typedef enum
 {
@@ -2635,8 +2642,8 @@ gfc_try gfc_verify_c_interop_param (gfc_symbol *);
 gfc_try verify_bind_c_sym (gfc_symbol *, gfc_typespec *, int, gfc_common_head *);
 gfc_try verify_bind_c_derived_type (gfc_symbol *);
 gfc_try verify_com_block_vars_c_interop (gfc_common_head *);
-void generate_isocbinding_symbol (const char *, iso_c_binding_symbol, const char *);
-gfc_symbol *get_iso_c_sym (gfc_symbol *, char *, const char *, int);
+gfc_symtree *generate_isocbinding_symbol (const char *, iso_c_binding_symbol,
+					  const char *, gfc_symtree *, bool);
 int gfc_get_sym_tree (const char *, gfc_namespace *, gfc_symtree **, bool);
 int gfc_get_ha_symbol (const char *, gfc_symbol **);
 int gfc_get_ha_sym_tree (const char *, gfc_symtree **);
@@ -2707,6 +2714,10 @@ int gfc_intrinsic_actual_ok (const char *, const bool);
 gfc_intrinsic_sym *gfc_find_function (const char *);
 gfc_intrinsic_sym *gfc_find_subroutine (const char *);
 gfc_intrinsic_sym *gfc_intrinsic_function_by_id (gfc_isym_id);
+gfc_intrinsic_sym *gfc_intrinsic_subroutine_by_id (gfc_isym_id);
+gfc_isym_id gfc_isym_id_by_intmod (intmod_id, int);
+gfc_isym_id gfc_isym_id_by_intmod_sym (gfc_symbol *);
+
 
 match gfc_intrinsic_func_interface (gfc_expr *, int);
 match gfc_intrinsic_sub_interface (gfc_code *, int);

gcc/fortran/intrinsic.c

@@ -810,6 +810,57 @@ find_sym (gfc_intrinsic_sym *start, int n, const char *name)
 }
 
 
+gfc_isym_id
+gfc_isym_id_by_intmod (intmod_id from_intmod, int intmod_sym_id)
+{
+  if (from_intmod == INTMOD_ISO_C_BINDING)
+    return (gfc_isym_id) c_interop_kinds_table[intmod_sym_id].value;
+  else if (from_intmod == INTMOD_ISO_FORTRAN_ENV)
+    switch (intmod_sym_id)
+      {
+#define NAMED_SUBROUTINE(a,b,c,d) \
+      case a: \
+	return (gfc_isym_id) c;
+#define NAMED_FUNCTION(a,b,c,d) \
+      case a: \
+	return (gfc_isym_id) c;
+#include "iso-fortran-env.def"
+      default:
+	gcc_unreachable ();
+      }
+  else
+    {
+      gcc_unreachable ();
+    }
+  return (gfc_isym_id) 0;
+}
+
+
+gfc_isym_id
+gfc_isym_id_by_intmod_sym (gfc_symbol *sym)
+{
+  return gfc_isym_id_by_intmod (sym->from_intmod, sym->intmod_sym_id);
+}
+
+
+gfc_intrinsic_sym *
+gfc_intrinsic_subroutine_by_id (gfc_isym_id id)
+{
+  gfc_intrinsic_sym *start = subroutines;
+  int n = nsub;
+
+  while (true)
+    {
+      gcc_assert (n > 0);
+      if (id == start->id)
+	return start;
+
+      start++;
+      n--;
+    }
+}
+
+
 gfc_intrinsic_sym *
 gfc_intrinsic_function_by_id (gfc_isym_id id)
 {
@@ -2652,9 +2703,28 @@ add_functions (void)
 
   make_generic ("sizeof", GFC_ISYM_SIZEOF, GFC_STD_GNU);
 
-  /* C_SIZEOF is part of ISO_C_BINDING.  */
+  /* The following functions are part of ISO_C_BINDING.  */
+  add_sym_2 ("c_associated", GFC_ISYM_C_ASSOCIATED, CLASS_INQUIRY, ACTUAL_NO,
+	     BT_LOGICAL, dl, GFC_STD_F2003, gfc_check_c_associated, NULL, NULL,
+	     "C_PTR_1", BT_VOID, 0, REQUIRED,
+	     "C_PTR_2", BT_VOID, 0, OPTIONAL);
+  make_from_module();
+
+  add_sym_1 ("c_loc", GFC_ISYM_C_LOC, CLASS_INQUIRY, ACTUAL_NO,
+	     BT_VOID, 0, GFC_STD_F2003,
+	     gfc_check_c_loc, NULL, gfc_resolve_c_loc,
+	     x, BT_UNKNOWN, 0, REQUIRED);
+  make_from_module();
+
+  add_sym_1 ("c_funloc", GFC_ISYM_C_FUNLOC, CLASS_INQUIRY, ACTUAL_NO,
+	     BT_VOID, 0, GFC_STD_F2003,
+	     gfc_check_c_funloc, NULL, gfc_resolve_c_funloc,
+	     x, BT_UNKNOWN, 0, REQUIRED);
+  make_from_module();
+
   add_sym_1 ("c_sizeof", GFC_ISYM_C_SIZEOF, CLASS_INQUIRY, ACTUAL_NO,
-	     BT_INTEGER, ii, GFC_STD_F2008, gfc_check_c_sizeof, NULL, NULL,
+	     BT_INTEGER, gfc_index_integer_kind, GFC_STD_F2008,
+	     gfc_check_c_sizeof, NULL, NULL,
 	     x, BT_UNKNOWN, 0, REQUIRED);
   make_from_module();
 
@@ -3056,6 +3126,22 @@ add_subroutines (void)
 	      pt, BT_INTEGER, di, OPTIONAL, INTENT_IN,
 	      gt, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
 
+  /* The following subroutines are part of ISO_C_BINDING.  */
+
+  add_sym_3s ("c_f_pointer", GFC_ISYM_C_F_POINTER, CLASS_IMPURE, BT_UNKNOWN, 0,
+	      GFC_STD_F2003, gfc_check_c_f_pointer, NULL, NULL,
+	      "cptr", BT_VOID, 0, REQUIRED, INTENT_IN,
+	      "fptr", BT_UNKNOWN, 0, REQUIRED, INTENT_OUT,
+	      "shape", BT_INTEGER, di, OPTIONAL, INTENT_IN);
+  make_from_module();
+
+  add_sym_2s ("c_f_procpointer", GFC_ISYM_C_F_PROCPOINTER, CLASS_IMPURE,
+	      BT_UNKNOWN, 0, GFC_STD_F2003, gfc_check_c_f_procpointer,
+	      NULL, NULL,
+	      "cptr", BT_VOID, 0, REQUIRED, INTENT_IN,
+	      "fptr", BT_UNKNOWN, 0, REQUIRED, INTENT_OUT);
+  make_from_module();
+
   /* More G77 compatibility garbage.  */
   add_sym_3s ("alarm", GFC_ISYM_ALARM, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
 	      gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub,
@@ -4078,8 +4164,8 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
 
   if (expr->symtree->n.sym->intmod_sym_id)
     {
-      int id = expr->symtree->n.sym->intmod_sym_id;
-      isym = specific = gfc_intrinsic_function_by_id ((gfc_isym_id) id);
+      gfc_isym_id id = gfc_isym_id_by_intmod_sym (expr->symtree->n.sym);
+      isym = specific = gfc_intrinsic_function_by_id (id);
     }
   else
     isym = specific = gfc_find_function (name);
@@ -4105,12 +4191,12 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
 
   gfc_current_intrinsic_where = &expr->where;
 
-  /* Bypass the generic list for min and max.  */
+  /* Bypass the generic list for min, max and ISO_C_Binding's c_loc.  */
   if (isym->check.f1m == gfc_check_min_max)
     {
       init_arglist (isym);
 
-      if (gfc_check_min_max (expr->value.function.actual) == SUCCESS)
+      if (isym->check.f1m (expr->value.function.actual) == SUCCESS)
 	goto got_specific;
 
       if (!error_flag)
@@ -4192,7 +4278,14 @@ gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
 
   name = c->symtree->n.sym->name;
 
-  isym = gfc_find_subroutine (name);
+  if (c->symtree->n.sym->intmod_sym_id)
+    {
+      gfc_isym_id id;
+      id = gfc_isym_id_by_intmod_sym (c->symtree->n.sym);
+      isym = gfc_intrinsic_subroutine_by_id (id);
+    }
+  else
+    isym = gfc_find_subroutine (name);
   if (isym == NULL)
     return MATCH_NO;
 

gcc/fortran/intrinsic.h

@@ -143,6 +143,11 @@ gfc_try gfc_check_size (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_try gfc_check_sign (gfc_expr *, gfc_expr *);
 gfc_try gfc_check_signal (gfc_expr *, gfc_expr *);
 gfc_try gfc_check_sizeof (gfc_expr *);
+gfc_try gfc_check_c_associated (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_c_f_pointer (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_c_f_procpointer (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_c_funloc (gfc_expr *);
+gfc_try gfc_check_c_loc (gfc_expr *);
 gfc_try gfc_check_c_sizeof (gfc_expr *);
 gfc_try gfc_check_sngl (gfc_expr *);
 gfc_try gfc_check_spread (gfc_expr *, gfc_expr *, gfc_expr *);
@@ -421,6 +426,8 @@ void gfc_resolve_atomic_ref (gfc_code *);
 void gfc_resolve_besn (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_bessel_n2 (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *a);
 void gfc_resolve_btest (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_c_loc (gfc_expr *, gfc_expr *);
+void gfc_resolve_c_funloc (gfc_expr *, gfc_expr *);
 void gfc_resolve_ceiling (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_char (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_chdir (gfc_expr *, gfc_expr *);

gcc/fortran/iresolve.c

@@ -501,6 +501,20 @@ gfc_resolve_btest (gfc_expr *f, gfc_expr *i, gfc_expr *pos)
 
 
 void
+gfc_resolve_c_loc (gfc_expr *f, gfc_expr *x ATTRIBUTE_UNUSED)
+{
+  f->ts = f->value.function.isym->ts;
+}
+
+
+void
+gfc_resolve_c_funloc (gfc_expr *f, gfc_expr *x ATTRIBUTE_UNUSED)
+{
+  f->ts = f->value.function.isym->ts;
+}
+
+
+void
 gfc_resolve_ceiling (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
 {
   f->ts.type = BT_INTEGER;

gcc/fortran/iso-c-binding.def

@@ -43,6 +43,10 @@ along with GCC; see the file COPYING3.  If not see
 # define NAMED_FUNCTION(a,b,c,d)
 #endif
 
+#ifndef NAMED_SUBROUTINE
+# define NAMED_SUBROUTINE(a,b,c,d)
+#endif
+
 /* The arguments to NAMED_*CST are:
      -- an internal name
      -- the symbol name in the module, as seen by Fortran code
@@ -165,26 +169,26 @@ DERIVED_TYPE (ISOCBINDING_FUNPTR, "c_funptr", \
 DERIVED_TYPE (ISOCBINDING_NULL_FUNPTR, "c_null_funptr", \
               get_int_kind_from_node (ptr_type_node))
 
-  
-#ifndef PROCEDURE
-# define PROCEDURE(a,b) 
-#endif
-
-PROCEDURE (ISOCBINDING_F_POINTER, "c_f_pointer")
-PROCEDURE (ISOCBINDING_ASSOCIATED, "c_associated")
-PROCEDURE (ISOCBINDING_LOC, "c_loc")
-PROCEDURE (ISOCBINDING_FUNLOC, "c_funloc")
-PROCEDURE (ISOCBINDING_F_PROCPOINTER, "c_f_procpointer")
-
-/* The arguments to NAMED_FUNCTIONS are:
+/* The arguments to NAMED_FUNCTIONS and NAMED_SUBROUTINES are:
      -- the ISYM
      -- the symbol name in the module, as seen by Fortran code
      -- the Fortran standard  */
 
+NAMED_SUBROUTINE (ISOCBINDING_F_POINTER, "c_f_pointer",
+                  GFC_ISYM_C_F_POINTER, GFC_STD_F2003)
+NAMED_SUBROUTINE (ISOCBINDING_F_PROCPOINTER, "c_f_procpointer",
+                  GFC_ISYM_C_F_PROCPOINTER, GFC_STD_F2003)
+
+NAMED_FUNCTION (ISOCBINDING_ASSOCIATED, "c_associated",
+		GFC_ISYM_C_ASSOCIATED, GFC_STD_F2003)
+NAMED_FUNCTION (ISOCBINDING_FUNLOC, "c_funloc",
+                GFC_ISYM_C_FUNLOC, GFC_STD_F2003)
+NAMED_FUNCTION (ISOCBINDING_LOC, "c_loc",
+                GFC_ISYM_C_LOC, GFC_STD_F2003)
+
 NAMED_FUNCTION (ISOCBINDING_C_SIZEOF, "c_sizeof", \
                 GFC_ISYM_C_SIZEOF, GFC_STD_F2008)
 
-
 #undef NAMED_INTCST
 #undef NAMED_REALCST
 #undef NAMED_CMPXCST
@@ -192,5 +196,5 @@ NAMED_FUNCTION (ISOCBINDING_C_SIZEOF, "c_sizeof", \
 #undef NAMED_CHARCST
 #undef NAMED_CHARKNDCST
 #undef DERIVED_TYPE
-#undef PROCEDURE
 #undef NAMED_FUNCTION
+#undef NAMED_SUBROUTINE

gcc/fortran/iso-fortran-env.def

@@ -27,6 +27,10 @@ along with GCC; see the file COPYING3.  If not see
 # define NAMED_KINDARRAY(a,b,c,d)
 #endif
 
+#ifndef NAMED_SUBROUTINE
+# define NAMED_SUBROUTINE(a,b,c,d)
+#endif
+
 #ifndef NAMED_FUNCTION
 # define NAMED_FUNCTION(a,b,c,d)
 #endif
@@ -120,4 +124,5 @@ NAMED_DERIVED_TYPE (ISOFORTRAN_LOCK_TYPE, "lock_type", \
 #undef NAMED_INTCST
 #undef NAMED_KINDARRAY
 #undef NAMED_FUNCTION
+#undef NAMED_SUBROUTINE
 #undef NAMED_DERIVED_TYPE

gcc/fortran/target-memory.c

@@ -316,6 +316,17 @@ gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer,
 	}
 
     case BT_DERIVED:
+      if (source->ts.u.derived->ts.f90_type == BT_VOID)
+	{
+	  gfc_constructor *c;
+	  gcc_assert (source->expr_type == EXPR_STRUCTURE);
+	  c = gfc_constructor_first (source->value.constructor);
+	  gcc_assert (c->expr->expr_type == EXPR_CONSTANT
+		      && c->expr->ts.type == BT_INTEGER);
+	  return encode_integer (gfc_index_integer_kind, c->expr->value.integer,
+				 buffer, buffer_size);
+	}
+
       return encode_derived (source, buffer, buffer_size);
     default:
       gfc_internal_error ("Invalid expression in gfc_target_encode_expr.");

gcc/fortran/trans-expr.c

@@ -3695,229 +3695,6 @@ conv_arglist_function (gfc_se *se, gfc_expr *expr, const char *name)
 }
 
 
-/* The following routine generates code for the intrinsic
-   procedures from the ISO_C_BINDING module:
-    * C_LOC           (function)
-    * C_FUNLOC        (function)
-    * C_F_POINTER     (subroutine)
-    * C_F_PROCPOINTER (subroutine)
-    * C_ASSOCIATED    (function)
-   One exception which is not handled here is C_F_POINTER with non-scalar
-   arguments. Returns 1 if the call was replaced by inline code (else: 0).  */
-
-static int
-conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym,
-			    gfc_actual_arglist * arg)
-{
-  gfc_symbol *fsym;
-
-  if (sym->intmod_sym_id == ISOCBINDING_LOC)
-    {
-      if (arg->expr->rank == 0)
-	gfc_conv_expr_reference (se, arg->expr);
-      else
-	{
-	  int f;
-	  /* This is really the actual arg because no formal arglist is
-	     created for C_LOC.	 */
-	  fsym = arg->expr->symtree->n.sym;
-
-	  /* We should want it to do g77 calling convention.  */
-	  f = (fsym != NULL)
-	    && !(fsym->attr.pointer || fsym->attr.allocatable)
-	    && fsym->as->type != AS_ASSUMED_SHAPE;
-	  f = f || !sym->attr.always_explicit;
-
-	  gfc_conv_array_parameter (se, arg->expr, f, NULL, NULL, NULL);
-	}
-
-      /* TODO -- the following two lines shouldn't be necessary, but if
-	 they're removed, a bug is exposed later in the code path.
-	 This workaround was thus introduced, but will have to be
-	 removed; please see PR 35150 for details about the issue.  */
-      se->expr = convert (pvoid_type_node, se->expr);
-      se->expr = gfc_evaluate_now (se->expr, &se->pre);
-
-      return 1;
-    }
-  else if (sym->intmod_sym_id == ISOCBINDING_FUNLOC)
-    {
-      arg->expr->ts.type = sym->ts.u.derived->ts.type;
-      arg->expr->ts.f90_type = sym->ts.u.derived->ts.f90_type;
-      arg->expr->ts.kind = sym->ts.u.derived->ts.kind;
-      gfc_conv_expr_reference (se, arg->expr);
-
-      return 1;
-    }
-  else if (sym->intmod_sym_id == ISOCBINDING_F_POINTER
-	   || sym->intmod_sym_id == ISOCBINDING_F_PROCPOINTER)
-    {
-      /* Convert c_f_pointer and c_f_procpointer.  */
-      gfc_se cptrse;
-      gfc_se fptrse;
-      gfc_se shapese;
-      gfc_ss *shape_ss;
-      tree desc, dim, tmp, stride, offset;
-      stmtblock_t body, block;
-      gfc_loopinfo loop;
-
-      gfc_init_se (&cptrse, NULL);
-      gfc_conv_expr (&cptrse, arg->expr);
-      gfc_add_block_to_block (&se->pre, &cptrse.pre);
-      gfc_add_block_to_block (&se->post, &cptrse.post);
-
-      gfc_init_se (&fptrse, NULL);
-      if (arg->next->expr->rank == 0)
-	{
-	  if (sym->intmod_sym_id == ISOCBINDING_F_POINTER
-	      || gfc_is_proc_ptr_comp (arg->next->expr))
-	    fptrse.want_pointer = 1;
-
-	  gfc_conv_expr (&fptrse, arg->next->expr);
-	  gfc_add_block_to_block (&se->pre, &fptrse.pre);
-	  gfc_add_block_to_block (&se->post, &fptrse.post);
-	  if (arg->next->expr->symtree->n.sym->attr.proc_pointer
-	      && arg->next->expr->symtree->n.sym->attr.dummy)
-	    fptrse.expr = build_fold_indirect_ref_loc (input_location,
-						       fptrse.expr);
-     	  se->expr = fold_build2_loc (input_location, MODIFY_EXPR,
-				      TREE_TYPE (fptrse.expr),
-				      fptrse.expr,
-				      fold_convert (TREE_TYPE (fptrse.expr),
-						    cptrse.expr));
-	  return 1;
-	}
-
-      gfc_start_block (&block);
-
-      /* Get the descriptor of the Fortran pointer.  */
-      fptrse.descriptor_only = 1;
-      gfc_conv_expr_descriptor (&fptrse, arg->next->expr);
-      gfc_add_block_to_block (&block, &fptrse.pre);
-      desc = fptrse.expr;
-
-      /* Set data value, dtype, and offset.  */
-      tmp = GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc));
-      gfc_conv_descriptor_data_set (&block, desc,
-				    fold_convert (tmp, cptrse.expr));
-      gfc_add_modify (&block, gfc_conv_descriptor_dtype (desc),
-		      gfc_get_dtype (TREE_TYPE (desc)));
-
-      /* Start scalarization of the bounds, using the shape argument.  */
-
-      shape_ss = gfc_walk_expr (arg->next->next->expr);
-      gcc_assert (shape_ss != gfc_ss_terminator);
-      gfc_init_se (&shapese, NULL);
-
-      gfc_init_loopinfo (&loop);
-      gfc_add_ss_to_loop (&loop, shape_ss);
-      gfc_conv_ss_startstride (&loop);
-      gfc_conv_loop_setup (&loop, &arg->next->expr->where);
-      gfc_mark_ss_chain_used (shape_ss, 1);
-
-      gfc_copy_loopinfo_to_se (&shapese, &loop);
-      shapese.ss = shape_ss;
-
-      stride = gfc_create_var (gfc_array_index_type, "stride");
-      offset = gfc_create_var (gfc_array_index_type, "offset");
-      gfc_add_modify (&block, stride, gfc_index_one_node);
-      gfc_add_modify (&block, offset, gfc_index_zero_node);
-
-      /* Loop body.  */
-      gfc_start_scalarized_body (&loop, &body);
-
-      dim = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
-			     loop.loopvar[0], loop.from[0]);
-
-      /* Set bounds and stride. */
-      gfc_conv_descriptor_lbound_set (&body, desc, dim, gfc_index_one_node);
-      gfc_conv_descriptor_stride_set (&body, desc, dim, stride);
-
-      gfc_conv_expr (&shapese, arg->next->next->expr);
-      gfc_add_block_to_block (&body, &shapese.pre);
-      gfc_conv_descriptor_ubound_set (&body, desc, dim, shapese.expr);
-      gfc_add_block_to_block (&body, &shapese.post);
-
-      /* Calculate offset. */
-      gfc_add_modify (&body, offset,
-		      fold_build2_loc (input_location, PLUS_EXPR,
-				       gfc_array_index_type, offset, stride));
-      /* Update stride.  */
-      gfc_add_modify (&body, stride,
-		      fold_build2_loc (input_location, MULT_EXPR,
-				       gfc_array_index_type, stride,
-				       fold_convert (gfc_array_index_type,
-						     shapese.expr)));
-      /* Finish scalarization loop.  */
-      gfc_trans_scalarizing_loops (&loop, &body);
-      gfc_add_block_to_block (&block, &loop.pre);
-      gfc_add_block_to_block (&block, &loop.post);
-      gfc_add_block_to_block (&block, &fptrse.post);
-      gfc_cleanup_loop (&loop);
-
-      gfc_add_modify (&block, offset,
-		      fold_build1_loc (input_location, NEGATE_EXPR,
-				       gfc_array_index_type, offset));
-      gfc_conv_descriptor_offset_set (&block, desc, offset);
-
-      se->expr = gfc_finish_block (&block);
-      return 1;
-    }
-  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 = fold_build2_loc (input_location, 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 = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
-				     arg1se.expr, arg2se.expr);
-	  /* Generate test to ensure that the first arg is not null.  */
-	  not_null_expr = fold_build2_loc (input_location, 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 = fold_build2_loc (input_location, TRUTH_AND_EXPR,
-				      boolean_type_node,
-				      not_null_expr, eq_expr);
-	}
-
-      return 1;
-    }
-
-  /* Nothing was done.  */
-  return 0;
-}
-
-
 /* Generate code for a procedure call.  Note can return se->post != NULL.
    If se->direct_byref is set then se->expr contains the return parameter.
    Return nonzero, if the call has alternate specifiers.
@@ -3964,10 +3741,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
   len = NULL_TREE;
   gfc_clear_ts (&ts);
 
-  if (sym->from_intmod == INTMOD_ISO_C_BINDING
-      && conv_isocbinding_procedure (se, sym, args))
-    return 0;
-
   comp = gfc_get_proc_ptr_comp (expr);
 
   if (se->ss != NULL)
@@ -6013,7 +5786,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr)
 	  gfc_add_expr_to_block (&block, tmp);
 	}
     }
-  else if (expr->ts.type == BT_DERIVED)
+  else if (expr->ts.type == BT_DERIVED && expr->ts.f90_type != BT_VOID)
     {
       if (expr->expr_type != EXPR_STRUCTURE)
 	{
@@ -6224,8 +5997,7 @@ gfc_conv_expr (gfc_se * se, gfc_expr * expr)
      null_pointer_node.  C_PTR and C_FUNPTR are converted to match the
      typespec for the C_PTR and C_FUNPTR symbols, which has already been
      updated to be an integer with a kind equal to the size of a (void *).  */
-  if (expr->ts.type == BT_DERIVED && expr->ts.u.derived
-      && expr->ts.u.derived->attr.is_iso_c)
+  if (expr->ts.type == BT_DERIVED && expr->ts.u.derived->ts.f90_type == BT_VOID)
     {
       if (expr->expr_type == EXPR_VARIABLE
 	  && (expr->symtree->n.sym->intmod_sym_id == ISOCBINDING_NULL_PTR
@@ -6240,9 +6012,9 @@ gfc_conv_expr (gfc_se * se, gfc_expr * expr)
         {
           /* Update the type/kind of the expression to be what the new
              type/kind are for the updated symbols of C_PTR/C_FUNPTR.  */
-          expr->ts.type = expr->ts.u.derived->ts.type;
-          expr->ts.f90_type = expr->ts.u.derived->ts.f90_type;
-          expr->ts.kind = expr->ts.u.derived->ts.kind;
+          expr->ts.type = BT_INTEGER;
+          expr->ts.f90_type = BT_VOID;
+          expr->ts.kind = gfc_index_integer_kind;
         }
     }
 

gcc/fortran/trans-intrinsic.c

@@ -6301,6 +6301,208 @@ gfc_conv_intrinsic_loc (gfc_se * se, gfc_expr * expr)
   se->expr = temp_var;
 }
 
+
+/* The following routine generates code for the intrinsic
+   functions from the ISO_C_BINDING module:
+    * C_LOC
+    * C_FUNLOC
+    * C_ASSOCIATED  */
+
+static void
+conv_isocbinding_function (gfc_se *se, gfc_expr *expr)
+{
+  gfc_actual_arglist *arg = expr->value.function.actual;
+
+  if (expr->value.function.isym->id == GFC_ISYM_C_LOC)
+    {
+      if (arg->expr->rank == 0)
+	gfc_conv_expr_reference (se, arg->expr);
+      else
+	gfc_conv_array_parameter (se, arg->expr, true, NULL, NULL, NULL);
+
+      /* TODO -- the following two lines shouldn't be necessary, but if
+	 they're removed, a bug is exposed later in the code path.
+	 This workaround was thus introduced, but will have to be
+	 removed; please see PR 35150 for details about the issue.  */
+      se->expr = convert (pvoid_type_node, se->expr);
+      se->expr = gfc_evaluate_now (se->expr, &se->pre);
+    }
+  else if (expr->value.function.isym->id == GFC_ISYM_C_FUNLOC)
+    gfc_conv_expr_reference (se, arg->expr);
+  else if (expr->value.function.isym->id == GFC_ISYM_C_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->expr == NULL)
+	/* Only given one arg so generate a null and do a
+	   not-equal comparison against the first arg.  */
+	se->expr = fold_build2_loc (input_location, 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 = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+				     arg1se.expr, arg2se.expr);
+	  /* Generate test to ensure that the first arg is not null.  */
+	  not_null_expr = fold_build2_loc (input_location, 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 = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+				      boolean_type_node,
+				      not_null_expr, eq_expr);
+	}
+    }
+  else
+    gcc_unreachable ();
+}
+
+
+/* The following routine generates code for the intrinsic
+   subroutines from the ISO_C_BINDING module:
+    * C_F_POINTER
+    * C_F_PROCPOINTER.  */
+
+static tree
+conv_isocbinding_subroutine (gfc_code *code)
+{
+  gfc_se se;
+  gfc_se cptrse;
+  gfc_se fptrse;
+  gfc_se shapese;
+  gfc_ss *shape_ss;
+  tree desc, dim, tmp, stride, offset;
+  stmtblock_t body, block;
+  gfc_loopinfo loop;
+  gfc_actual_arglist *arg = code->ext.actual;
+
+  gfc_init_se (&se, NULL);
+  gfc_init_se (&cptrse, NULL);
+  gfc_conv_expr (&cptrse, arg->expr);
+  gfc_add_block_to_block (&se.pre, &cptrse.pre);
+  gfc_add_block_to_block (&se.post, &cptrse.post);
+
+  gfc_init_se (&fptrse, NULL);
+  if (arg->next->expr->rank == 0)
+    {
+      fptrse.want_pointer = 1;
+      gfc_conv_expr (&fptrse, arg->next->expr);
+      gfc_add_block_to_block (&se.pre, &fptrse.pre);
+      gfc_add_block_to_block (&se.post, &fptrse.post);
+      if (arg->next->expr->symtree->n.sym->attr.proc_pointer
+	  && arg->next->expr->symtree->n.sym->attr.dummy)
+	fptrse.expr = build_fold_indirect_ref_loc (input_location,
+						       fptrse.expr);
+      se.expr = fold_build2_loc (input_location, MODIFY_EXPR,
+				 TREE_TYPE (fptrse.expr),
+				 fptrse.expr,
+				 fold_convert (TREE_TYPE (fptrse.expr),
+					       cptrse.expr));
+      gfc_add_expr_to_block (&se.pre, se.expr);
+      gfc_add_block_to_block (&se.pre, &se.post);
+      return gfc_finish_block (&se.pre);
+    }
+
+  gfc_start_block (&block);
+
+  /* Get the descriptor of the Fortran pointer.  */
+  fptrse.descriptor_only = 1;
+  gfc_conv_expr_descriptor (&fptrse, arg->next->expr);
+  gfc_add_block_to_block (&block, &fptrse.pre);
+  desc = fptrse.expr;
+
+  /* Set data value, dtype, and offset.  */
+  tmp = GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc));
+  gfc_conv_descriptor_data_set (&block, desc, fold_convert (tmp, cptrse.expr));
+  gfc_add_modify (&block, gfc_conv_descriptor_dtype (desc),
+		  gfc_get_dtype (TREE_TYPE (desc)));
+
+  /* Start scalarization of the bounds, using the shape argument.  */
+
+  shape_ss = gfc_walk_expr (arg->next->next->expr);
+  gcc_assert (shape_ss != gfc_ss_terminator);
+  gfc_init_se (&shapese, NULL);
+
+  gfc_init_loopinfo (&loop);
+  gfc_add_ss_to_loop (&loop, shape_ss);
+  gfc_conv_ss_startstride (&loop);
+  gfc_conv_loop_setup (&loop, &arg->next->expr->where);
+  gfc_mark_ss_chain_used (shape_ss, 1);
+
+  gfc_copy_loopinfo_to_se (&shapese, &loop);
+  shapese.ss = shape_ss;
+
+  stride = gfc_create_var (gfc_array_index_type, "stride");
+  offset = gfc_create_var (gfc_array_index_type, "offset");
+  gfc_add_modify (&block, stride, gfc_index_one_node);
+  gfc_add_modify (&block, offset, gfc_index_zero_node);
+
+  /* Loop body.  */
+  gfc_start_scalarized_body (&loop, &body);
+
+  dim = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			     loop.loopvar[0], loop.from[0]);
+
+  /* Set bounds and stride. */
+  gfc_conv_descriptor_lbound_set (&body, desc, dim, gfc_index_one_node);
+  gfc_conv_descriptor_stride_set (&body, desc, dim, stride);
+
+  gfc_conv_expr (&shapese, arg->next->next->expr);
+  gfc_add_block_to_block (&body, &shapese.pre);
+  gfc_conv_descriptor_ubound_set (&body, desc, dim, shapese.expr);
+  gfc_add_block_to_block (&body, &shapese.post);
+
+  /* Calculate offset. */
+  gfc_add_modify (&body, offset,
+		  fold_build2_loc (input_location, PLUS_EXPR,
+				   gfc_array_index_type, offset, stride));
+  /* Update stride.  */
+  gfc_add_modify (&body, stride,
+		  fold_build2_loc (input_location, MULT_EXPR,
+				   gfc_array_index_type, stride,
+				   fold_convert (gfc_array_index_type,
+						 shapese.expr)));
+  /* Finish scalarization loop.  */
+  gfc_trans_scalarizing_loops (&loop, &body);
+  gfc_add_block_to_block (&block, &loop.pre);
+  gfc_add_block_to_block (&block, &loop.post);
+  gfc_add_block_to_block (&block, &fptrse.post);
+  gfc_cleanup_loop (&loop);
+
+  gfc_add_modify (&block, offset,
+		  fold_build1_loc (input_location, NEGATE_EXPR,
+				   gfc_array_index_type, offset));
+  gfc_conv_descriptor_offset_set (&block, desc, offset);
+
+  gfc_add_expr_to_block (&se.pre, gfc_finish_block (&block));
+  gfc_add_block_to_block (&se.pre, &se.post);
+  return gfc_finish_block (&se.pre);
+}
+
+
 /* Generate code for an intrinsic function.  Some map directly to library
    calls, others get special handling.  In some cases the name of the function
    used depends on the type specifiers.  */
@@ -6476,6 +6678,12 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       gfc_conv_intrinsic_bitcomp (se, expr, LT_EXPR);
       break;
 
+    case GFC_ISYM_C_ASSOCIATED:
+    case GFC_ISYM_C_FUNLOC:
+    case GFC_ISYM_C_LOC:
+      conv_isocbinding_function (se, expr);
+      break;
+
     case GFC_ISYM_ACHAR:
     case GFC_ISYM_CHAR:
       gfc_conv_intrinsic_char (se, expr);
@@ -7585,6 +7793,12 @@ gfc_conv_intrinsic_subroutine (gfc_code *code)
       res = conv_intrinsic_atomic_ref (code);
       break;
 
+    case GFC_ISYM_C_F_POINTER:
+    case GFC_ISYM_C_F_PROCPOINTER:
+      res = conv_isocbinding_subroutine (code);
+      break;
+
+
     default:
       res = NULL_TREE;
       break;

gcc/fortran/trans-io.c

@@ -2026,20 +2026,8 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code)
       && ts->u.derived != NULL
       && (ts->is_iso_c == 1 || ts->u.derived->ts.is_iso_c == 1))
     {
-      /* C_PTR and C_FUNPTR have private components which means they can not
-         be printed.  However, if -std=gnu and not -pedantic, allow
-         the component to be printed to help debugging.  */
-      if (gfc_notification_std (GFC_STD_GNU) != SILENT)
-	{
-	  gfc_error_now ("Derived type '%s' at %L has PRIVATE components",
-			 ts->u.derived->name, code != NULL ? &(code->loc) : 
-			 &gfc_current_locus);
-	  return;
-	}
-
-      ts->type = ts->u.derived->ts.type;
-      ts->kind = ts->u.derived->ts.kind;
-      ts->f90_type = ts->u.derived->ts.f90_type;
+      ts->type = BT_INTEGER;
+      ts->kind = gfc_index_integer_kind;
     }
   
   kind = ts->kind;

gcc/fortran/trans-types.c

@@ -338,12 +338,11 @@ gfc_init_c_interop_kinds (void)
   strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
   c_interop_kinds_table[a].f90_type = BT_DERIVED; \
   c_interop_kinds_table[a].value = c;
-#define PROCEDURE(a,b) \
+#define NAMED_FUNCTION(a,b,c,d) \
   strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
   c_interop_kinds_table[a].f90_type = BT_PROCEDURE; \
-  c_interop_kinds_table[a].value = 0;
-#include "iso-c-binding.def"
-#define NAMED_FUNCTION(a,b,c,d) \
+  c_interop_kinds_table[a].value = c;
+#define NAMED_SUBROUTINE(a,b,c,d) \
   strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
   c_interop_kinds_table[a].f90_type = BT_PROCEDURE; \
   c_interop_kinds_table[a].value = c;
@@ -1111,11 +1110,11 @@ gfc_typenode_for_spec (gfc_typespec * spec)
          type and kind to fit a (void *) and the basetype returned was a
          ptr_type_node.  We need to pass up this new information to the
          symbol that was declared of type C_PTR or C_FUNPTR.  */
-      if (spec->u.derived->attr.is_iso_c)
+      if (spec->u.derived->ts.f90_type == BT_VOID)
         {
-          spec->type = spec->u.derived->ts.type;
-          spec->kind = spec->u.derived->ts.kind;
-          spec->f90_type = spec->u.derived->ts.f90_type;
+          spec->type = BT_INTEGER;
+          spec->kind = gfc_index_integer_kind;
+          spec->f90_type = BT_VOID;
         }
       break;
     case BT_VOID:
@@ -2349,7 +2348,7 @@ gfc_get_derived_type (gfc_symbol * derived)
     derived = gfc_find_dt_in_generic (derived);
 
   /* See if it's one of the iso_c_binding derived types.  */
-  if (derived->attr.is_iso_c == 1)
+  if (derived->attr.is_iso_c == 1 || derived->ts.f90_type == BT_VOID)
     {
       if (derived->backend_decl)
 	return derived->backend_decl;

gcc/testsuite/ChangeLog

+2013-03-25  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/38536
+	PR fortran/38813
+	PR fortran/38894
+	PR fortran/39288
+	PR fortran/40963
+	PR fortran/45824
+	PR fortran/47023
+	PR fortran/47034
+	PR fortran/49023
+	PR fortran/50269
+	PR fortran/50612
+	PR fortran/52426
+	PR fortran/54263
+	PR fortran/55343
+	PR fortran/55444
+	PR fortran/55574
+	PR fortran/56079
+	PR fortran/56378
+	* gfortran.dg/c_assoc_2.f03: Update dg-error wording.
+	* gfortran.dg/c_f_pointer_shape_test.f90: Ditto.
+	* gfortran.dg/c_f_pointer_shape_tests_3.f03: Ditto.
+	* gfortran.dg/c_f_pointer_tests_5.f90: Ditto.
+	* gfortran.dg/c_funloc_tests_2.f03: Ditto.
+	* gfortran.dg/c_funloc_tests_5.f03: Ditto.
+	* gfortran.dg/c_funloc_tests_6.f90: Ditto.
+	* gfortran.dg/c_loc_tests_10.f03: Add -std=f2008.
+	* gfortran.dg/c_loc_tests_11.f03: Ditto, update dg-error.
+	* gfortran.dg/c_loc_tests_16.f90: Ditto.
+	* gfortran.dg/c_loc_tests_4.f03: Ditto.
+	* gfortran.dg/c_loc_tests_15.f90: Update dg-error wording.
+	* gfortran.dg/c_loc_tests_3.f03: Valid since F2003 TC5.
+	* gfortran.dg/c_loc_tests_8.f03: Ditto.
+	* gfortran.dg/c_ptr_tests_14.f90: Update scan-tree-dump-times.
+	* gfortran.dg/c_ptr_tests_15.f90: Ditto.
+	* gfortran.dg/c_sizeof_1.f90: Fix invalid code.
+	* gfortran.dg/iso_c_binding_init_expr.f03: Update dg-error wording.
+	* gfortran.dg/pr32601_1.f03: Ditto.
+	* gfortran.dg/storage_size_2.f08: Remove dg-error.
+	* gfortran.dg/blockdata_7.f90: New.
+	* gfortran.dg/c_assoc_4.f90: New.
+	* gfortran.dg/c_f_pointer_tests_6.f90: New.
+	* gfortran.dg/c_f_pointer_tests_7.f90: New.
+	* gfortran.dg/c_funloc_tests_8.f90: New.
+	* gfortran.dg/c_loc_test_17.f90: New.
+	* gfortran.dg/c_loc_test_18.f90: New.
+	* gfortran.dg/c_loc_test_19.f90: New.
+	* gfortran.dg/c_loc_test_20.f90: New.
+	* gfortran.dg/c_sizeof_5.f90: New.
+	* gfortran.dg/iso_c_binding_rename_3.f90: New.
+	* gfortran.dg/transfer_resolve_2.f90: New.
+	* gfortran.dg/transfer_resolve_3.f90: New.
+	* gfortran.dg/transfer_resolve_4.f90: New.
+	* gfortran.dg/pr32601.f03: Update dg-error.
+	* gfortran.dg/c_ptr_tests_13.f03: Update dg-error.
+	* gfortran.dg/c_ptr_tests_9.f03: Fix test case.
+
 2013-03-25  Kyrylo Tkachov  <kyrylo.tkachov@arm.com>
 
 	* gcc.target/arm/vseleqdf.c: New test.

gcc/testsuite/gfortran.dg/blockdata_7.f90

+! { dg-do compile }
+!
+! PR fortran/55444
+!
+! Contributed by Henrik Holst
+!
+      BLOCKDATA
+!       USE ISO_C_BINDING, ONLY: C_INT, C_FLOAT ! WORKS
+        USE :: ISO_C_BINDING  ! FAILS
+        INTEGER(C_INT) X
+        REAL(C_FLOAT) Y
+        COMMON /FOO/ X,Y
+        BIND(C,NAME='fortranStuff') /FOO/
+        DATA X /1/
+        DATA Y /2.0/
+      END BLOCKDATA

gcc/testsuite/gfortran.dg/c_assoc_2.f03

@@ -16,19 +16,19 @@ contains
        call abort()
     end if
 
-    if(.not. c_associated(my_c_ptr, my_c_ptr, my_c_ptr)) then ! { dg-error "More actual than formal arguments" }
+    if(.not. c_associated(my_c_ptr, my_c_ptr, my_c_ptr)) then ! { dg-error "Too many arguments in call" }
        call abort()
     end if
 
-    if(.not. c_associated()) then ! { dg-error "Missing argument" }
+    if(.not. c_associated()) then ! { dg-error "Missing actual argument 'C_PTR_1' in call to 'c_associated'" }
        call abort()
-    end if ! { dg-error "Expecting END SUBROUTINE" }
+    end if
 
     if(.not. c_associated(my_c_ptr_2)) then
        call abort()
     end if
 
-    if(.not. c_associated(my_integer)) then ! { dg-error "Type mismatch" }
+    if(.not. c_associated(my_integer)) then ! { dg-error "shall have the type TYPE.C_PTR. or TYPE.C_FUNPTR." }
        call abort()
     end if
   end subroutine sub0

gcc/testsuite/gfortran.dg/c_assoc_4.f90

+! { dg-do compile }
+!
+! PR fortran/49023
+!
+PROGRAM test
+
+  USE, INTRINSIC :: iso_c_binding
+  IMPLICIT NONE
+
+  TYPE (C_PTR) :: x, y
+
+  PRINT *, C_ASSOCIATED([x,y])  ! { dg-error "'C_PTR_1' argument of 'c_associated' intrinsic at .1. must be a scalar" }
+
+END PROGRAM test

gcc/testsuite/gfortran.dg/c_f_pointer_shape_test.f90

@@ -13,7 +13,7 @@ contains
     type(c_ptr), value :: cPtr
     
     myArrayPtr => myArray
-    call c_f_pointer(cPtr, myArrayPtr) ! { dg-error "Missing SHAPE argument" }
+    call c_f_pointer(cPtr, myArrayPtr) ! { dg-error "Expected SHAPE argument to C_F_POINTER with array FPTR" }
   end subroutine test_0
 end module c_f_pointer_shape_test
 

gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_3.f03

@@ -8,7 +8,7 @@ contains
     type(c_ptr), value :: my_c_array
     integer(c_int), dimension(:), pointer :: my_array_ptr
     
-    call c_f_pointer(my_c_array, my_array_ptr, (/ 10.0 /)) ! { dg-error "must be a rank 1 INTEGER array" }
+    call c_f_pointer(my_c_array, my_array_ptr, (/ 10.0 /)) ! { dg-error "must be INTEGER" }
   end subroutine sub0
 
   subroutine sub1(my_c_array) bind(c)
@@ -17,6 +17,6 @@ contains
     integer(c_int), dimension(1,1) :: shape
 
     shape(1,1) = 10
-    call c_f_pointer(my_c_array, my_array_ptr, shape) ! { dg-error "must be a rank 1 INTEGER array" }
+    call c_f_pointer(my_c_array, my_array_ptr, shape) ! { dg-error "must be of rank 1" }
   end subroutine sub1
 end module c_f_pointer_shape_tests_3

gcc/testsuite/gfortran.dg/c_f_pointer_tests_5.f90

@@ -9,5 +9,5 @@ type :: nc
 end type
 type(c_ptr) :: cSelf
 class(nc), pointer :: self
-call c_f_pointer(cSelf, self)  ! { dg-error "must not be polymorphic" }
+call c_f_pointer(cSelf, self)  ! { dg-error "shall not be polymorphic" }
 end

gcc/testsuite/gfortran.dg/c_f_pointer_tests_6.f90

+! { dg-do compile }
+!
+! PR fortran/38894
+!
+!
+
+subroutine test2
+use iso_c_binding
+type(c_funptr) :: fun
+type(c_ptr) :: fptr
+procedure(), pointer :: bar
+integer, pointer :: bari
+call c_f_procpointer(fptr,bar) ! { dg-error "Argument CPTR at .1. to C_F_PROCPOINTER shall have the type TYPE.C_FUNPTR." }
+call c_f_pointer(fun,bari) ! { dg-error "Argument CPTR at .1. to C_F_POINTER shall have the type TYPE.C_PTR." }
+fun = fptr ! { dg-error "Can't convert TYPE.c_ptr. to TYPE.c_funptr." }
+end
+
+subroutine test()
+use iso_c_binding, c_ptr2 => c_ptr
+type(c_ptr2) :: fun
+procedure(), pointer :: bar
+integer, pointer :: foo
+call c_f_procpointer(fun,bar) ! { dg-error "Argument CPTR at .1. to C_F_PROCPOINTER shall have the type TYPE.C_FUNPTR." }
+call c_f_pointer(fun,foo)  ! OK
+end
+
+module rename
+  use, intrinsic :: iso_c_binding, only: my_c_ptr_0 => c_ptr
+end module rename
+
+program p
+  use, intrinsic :: iso_c_binding, my_c_ptr => c_ptr
+  type(my_c_ptr) :: my_ptr
+  print *,c_associated(my_ptr)
+contains
+  subroutine sub()
+    use rename   ! (***)
+    type(my_c_ptr_0) :: my_ptr2
+    type(c_funptr) :: myfun
+    print *,c_associated(my_ptr,my_ptr2)
+    print *,c_associated(my_ptr,myfun) ! { dg-error "Argument C_PTR_2 at .1. to C_ASSOCIATED shall have the same type as C_PTR_1: TYPE.c_ptr. instead of TYPE.c_funptr." }
+  end subroutine
+end

gcc/testsuite/gfortran.dg/c_f_pointer_tests_7.f90

+! { dg-do compile }
+!
+! PR fortran/54263
+!
+use iso_c_binding
+type(c_ptr) :: cp
+integer, pointer :: p
+call c_f_pointer (cp, p, shape=[2]) ! { dg-error "Unexpected SHAPE argument at .1. to C_F_POINTER with scalar FPTR" }
+end

gcc/testsuite/gfortran.dg/c_funloc_tests_2.f03

@@ -8,9 +8,9 @@ contains
     type(c_funptr) :: my_c_funptr
     integer :: my_local_variable
     
-    my_c_funptr = c_funloc() ! { dg-error "Missing argument" }
+    my_c_funptr = c_funloc() ! { dg-error "Missing actual argument 'x' in call to 'c_funloc'" }
     my_c_funptr = c_funloc(sub0)
-    my_c_funptr = c_funloc(sub0, sub0) ! { dg-error "More actual than formal" }
-    my_c_funptr = c_funloc(my_local_variable) ! { dg-error "must be a procedure" }
+    my_c_funptr = c_funloc(sub0, sub0) ! { dg-error "Too many arguments in call to 'c_funloc'" }
+    my_c_funptr = c_funloc(my_local_variable) ! { dg-error "Argument X at .1. to C_FUNLOC shall be a procedure or a procedure pointer" }
   end subroutine sub0
 end module c_funloc_tests_2

gcc/testsuite/gfortran.dg/c_funloc_tests_5.f03

@@ -8,9 +8,9 @@ contains
   subroutine sub0() bind(c)
     type(c_funptr) :: my_c_funptr
 
-    my_c_funptr = c_funloc(sub1) ! { dg-error "TS 29113: Noninteroperable argument" }
+    my_c_funptr = c_funloc(sub1) ! { dg-error "TS 29113: Noninteroperable procedure at .1. to C_FUNLOC" }
 
-    my_c_funptr = c_funloc(func0) ! { dg-error "TS 29113: Noninteroperable argument" }
+    my_c_funptr = c_funloc(func0) ! { dg-error "TS 29113: Noninteroperable procedure at .1. to C_FUNLOC" }
   end subroutine sub0
 
   subroutine sub1() 

gcc/testsuite/gfortran.dg/c_funloc_tests_6.f90

@@ -23,9 +23,9 @@ procedure(integer), pointer :: fint
 cp = c_funloc (sub) ! { dg-error "Can't convert TYPE.c_funptr. to TYPE.c_ptr." })
 cfp = c_loc (int)   ! { dg-error "Can't convert TYPE.c_ptr. to TYPE.c_funptr." }
 
-call c_f_pointer (cfp, int)     ! { dg-error "Argument CPTR to C_F_POINTER at .1. shall have the type C_PTR" }
-call c_f_procpointer (cp, fsub) ! { dg-error "Argument at .1. to C_F_FUNPOINTER shall have the type C_FUNPTR" }
+call c_f_pointer (cfp, int)     ! { dg-error "Argument CPTR at .1. to C_F_POINTER shall have the type TYPE.C_PTR." }
+call c_f_procpointer (cp, fsub) ! { dg-error "Argument CPTR at .1. to C_F_PROCPOINTER shall have the type TYPE.C_FUNPTR." }
 
-cfp = c_funloc (noCsub) ! { dg-error "TS 29113: Noninteroperable argument 'nocsub' to 'c_funloc'" }
-call c_f_procpointer (cfp, fint) ! { dg-error "TS 29113: Noninteroperable procedure-pointer at .1. to C_F_FUNPOINTER" }
+cfp = c_funloc (noCsub) ! { dg-error "TS 29113: Noninteroperable procedure at .1. to C_FUNLOC" }
+call c_f_procpointer (cfp, fint) ! { dg-error "TS 29113: Noninteroperable procedure pointer at .1. to C_F_PROCPOINTER" }
 end

gcc/testsuite/gfortran.dg/c_funloc_tests_8.f90

+! { dg-do compile }
+!
+! PR fortran/50612
+! PR fortran/47023
+!
+subroutine test
+  use iso_c_binding
+  implicit none
+  external foo
+  procedure(), pointer :: pp
+  print *, c_sizeof(pp) ! { dg-error "Procedure unexpected as argument" }
+  print *, c_sizeof(foo) ! { dg-error "Procedure unexpected as argument" }
+  print *, c_sizeof(bar) ! { dg-error "Procedure unexpected as argument" }
+contains
+  subroutine bar()
+  end subroutine bar
+end
+
+integer function foo2()
+  procedure(), pointer :: ptr
+  ptr => foo2 ! { dg-error "Function result 'foo2' is invalid as proc-target in procedure pointer assignment" }
+  foo2 = 7
+  block
+    ptr => foo2 ! { dg-error "Function result 'foo2' is invalid as proc-target in procedure pointer assignment" }
+  end block
+contains
+  subroutine foo()
+    ptr => foo2 ! { dg-error "Function result 'foo2' is invalid as proc-target in procedure pointer assignment" }
+  end subroutine foo
+end function foo2
+
+module m2
+contains
+integer function foo(i, fptr) bind(C)
+  use iso_c_binding
+  implicit none
+  integer :: i
+  type(c_funptr) :: fptr
+  fptr = c_funloc(foo) ! { dg-error "Function result 'foo' at .1. is invalid as X argument to C_FUNLOC" }
+  block
+    fptr = c_funloc(foo) ! { dg-error "Function result 'foo' at .1. is invalid as X argument to C_FUNLOC" }
+  end block
+  foo = 42*i
+contains
+  subroutine bar()
+    fptr = c_funloc(foo) ! { dg-error "Function result 'foo' at .1. is invalid as X argument to C_FUNLOC" }
+  end subroutine bar
+end function foo
+end module m2

gcc/testsuite/gfortran.dg/c_loc_test_17.f90

+! { dg-do compile }
+! { dg-options "" }
+!
+! PR fortran/56378
+! PR fortran/52426
+!
+! Contributed by David Sagan & Joost VandeVondele
+!
+
+module t
+ use, intrinsic :: iso_c_binding
+ interface fvec2vec
+   module procedure int_fvec2vec
+ end interface
+contains
+ function int_fvec2vec (f_vec, n) result (c_vec)
+ integer f_vec(:)
+ integer(c_int), target :: c_vec(n)
+ end function int_fvec2vec
+ subroutine lat_to_c (Fp, C) bind(c)
+ integer, allocatable :: ic(:)
+ call lat_to_c2 (c_loc(fvec2vec(ic, n1_ic))) ! { dg-error "Argument X at .1. to C_LOC shall have either the POINTER or the TARGET attribute" }
+ end subroutine lat_to_c
+end module
+
+use iso_c_binding
+print *, c_loc([1]) ! { dg-error "Argument X at .1. to C_LOC shall have either the POINTER or the TARGET attribute" }
+end

gcc/testsuite/gfortran.dg/c_loc_test_18.f90

+! { dg-do compile }
+!
+! PR fortran/39288
+!
+! From IR F03/0129, cf.
+! Fortran 2003, Technical Corrigendum 5
+!
+! Was invalid before.
+
+  SUBROUTINE S(A,I,K)
+    USE ISO_C_BINDING
+    CHARACTER(*),TARGET :: A
+    CHARACTER(:),ALLOCATABLE,TARGET :: B
+    TYPE(C_PTR) P1,P2,P3,P4,P5
+    P1 = C_LOC(A(1:1))    ! *1
+    P2 = C_LOC(A(I:I))    ! *2
+    P3 = C_LOC(A(1:))     ! *3
+    P4 = C_LOC(A(I:K))    ! *4
+    ALLOCATE(CHARACTER(1)::B)
+    P5 = C_LOC(B)         ! *5
+  END SUBROUTINE

gcc/testsuite/gfortran.dg/c_loc_test_19.f90

+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! PR fortran/50269
+!
+Program gf
+   Use iso_c_binding
+   Real( c_double ), Dimension( 1:10 ), Target :: a
+   Call test( a )
+Contains
+   Subroutine test( aa )
+     Real( c_double ), Dimension( : ), Target :: aa
+     Type( c_ptr ), Pointer :: b
+     b = c_loc( aa( 1 ) )  ! was rejected before.
+     b = c_loc( aa ) ! { dg-error "TS 29113: Noninteroperable array at .1. as argument to C_LOC: Only explicit-size and assumed-size arrays are interoperable" }
+   End Subroutine test
+End Program gf

gcc/testsuite/gfortran.dg/c_loc_test_20.f90

+! { dg-do run }
+!
+! PR fortran/38829
+! PR fortran/40963
+! PR fortran/38813
+!
+!
+program testcloc
+    use, intrinsic :: iso_c_binding
+    implicit none
+
+    type obj
+        real :: array(10,10)
+        real, allocatable :: array2(:,:)
+    end type
+
+    type(obj), target :: obj1
+    type(c_ptr) :: cptr
+    integer :: i
+    real, pointer :: array(:)
+
+    allocate (obj1%array2(10,10))
+    obj1%array  = reshape ([(i, i=1,100)], shape (obj1%array))
+    obj1%array2 = reshape ([(i, i=1,100)], shape (obj1%array))
+
+    cptr = c_loc (obj1%array)
+    call c_f_pointer (cptr, array, shape=[100])
+    if (any (array /= [(i, i=1,100)])) call abort ()
+
+    cptr = c_loc (obj1%array2)
+    call c_f_pointer (cptr, array, shape=[100])
+    if (any (array /= [(i, i=1,100)])) call abort ()
+end program testcloc
+

gcc/testsuite/gfortran.dg/c_loc_tests_10.f03

 ! { dg-do compile }
+! { dg-options "-std=f2008" }
 subroutine aaa(in)
   use iso_c_binding
   implicit none
   integer(KIND=C_int), DIMENSION(:), TARGET  :: in
   type(c_ptr) :: cptr
-  cptr = c_loc(in) ! { dg-error "not C interoperable" }
+  cptr = c_loc(in) ! { dg-error "TS 29113: Noninteroperable array at .1. as argument to C_LOC" }
 end subroutine aaa

gcc/testsuite/gfortran.dg/c_loc_tests_11.f03

 ! { dg-do compile }
+! { dg-options "-std=f2008" }
+!
 ! Test argument checking for C_LOC with subcomponent parameters.
 module c_vhandle_mod
   use iso_c_binding
@@ -29,9 +31,9 @@ contains
     integer(c_int), intent(in) :: handle
     
     if (.true.) then   ! The ultimate component is an allocatable target 
-      get_double_vector_address = c_loc(dbv_pool(handle)%v)
+      get_double_vector_address = c_loc(dbv_pool(handle)%v)  ! { dg-error "TS 29113: Noninteroperable array at .1. as argument to C_LOC: Only explicit-size and assumed-size arrays are interoperable" }
     else
-      get_double_vector_address = c_loc(vv)
+      get_double_vector_address = c_loc(vv)  ! { dg-error "TS 29113: Noninteroperable array at .1. as argument to C_LOC: Only explicit-size and assumed-size arrays are interoperable" }
     endif
     
   end function get_double_vector_address
@@ -39,9 +41,9 @@ contains
 
   type(c_ptr) function get_foo_address(handle)
     integer(c_int), intent(in) :: handle    
-    get_foo_address = c_loc(foo_pool(handle)%v)    
+    get_foo_address = c_loc(foo_pool(handle)%v)
 
-    get_foo_address = c_loc(foo_pool2(handle)%v) ! { dg-error "must be a scalar" } 
+    get_foo_address = c_loc(foo_pool2(handle)%v) ! { dg-error "TS 29113: Noninteroperable array at .1. as argument to C_LOC: Expression is a noninteroperable derived type" }
   end function get_foo_address
 
     

gcc/testsuite/gfortran.dg/c_loc_tests_15.f90

@@ -11,6 +11,6 @@
 
   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" }
+  if (associated(tt_fptr)) tt_cptr = c_loc(tt_fptr)  ! { dg-error "shall not be polymorphic" }
 
 end

gcc/testsuite/gfortran.dg/c_loc_tests_16.f90

 ! { dg-do compile }
-! { dg-options "-fcoarray=single" }
+! { dg-options "-fcoarray=single -std=f2008" }
 ! PR 38536 - array sections as arguments to c_loc are illegal.
   use iso_c_binding
   type, bind(c) :: t1
@@ -18,8 +18,8 @@
   integer(c_int), target :: x[*]
   type(C_PTR) :: p
 
-  p = c_loc(tt%t%i(1))  ! { dg-error "Array section not permitted" }
-  p = c_loc(n(1:2))  ! { dg-warning "Array section" }
-  p = c_loc(ttt%t(5,1:2)%i(1)) ! { dg-error "Array section not permitted" }
-  p = c_loc(x[1]) ! { dg-error "Coindexed argument not permitted" }
+  p = c_loc(tt%t%i(1))
+  p = c_loc(n(1:2))  ! { dg-error "TS 29113: Noninteroperable array at .1. as argument to C_LOC: Only whole-arrays are interoperable" }
+  p = c_loc(ttt%t(5,1:2)%i(1)) ! { dg-error "TS 29113: Noninteroperable array at .1. as argument to C_LOC: Only whole-arrays are interoperable" }
+  p = c_loc(x[1]) ! { dg-error "shall not be coindexed" }
   end

gcc/testsuite/gfortran.dg/c_loc_tests_17.f90

+! { dg-do compile }
+!
+! PR fortran/55574
+! The following code used to be accepted because C_LOC pulls in C_PTR
+! implicitly.
+!
+! Contributed by Valery Weber <valeryweber@hotmail.com>
+!
+program aaaa
+  use iso_c_binding, only : c_loc
+  integer, target :: i
+  type(C_PTR) :: f_ptr ! { dg-error "being used before it is defined" }
+  f_ptr=c_loc(i)  ! { dg-error "Can't convert" }
+end program aaaa

gcc/testsuite/gfortran.dg/c_loc_tests_3.f03

@@ -3,6 +3,6 @@ use iso_c_binding
 implicit none
 character(kind=c_char,len=256),target :: arg
 type(c_ptr),pointer :: c
-c = c_loc(arg) ! { dg-error "must have a length of 1" }
+c = c_loc(arg) ! OK since Fortran 2003, Tech Corrigenda 5; IR F03/0129
 
 end

gcc/testsuite/gfortran.dg/c_loc_tests_4.f03

 ! { dg-do compile }
+! { dg-options "-std=f2008" }
+!
 module c_loc_tests_4
   use, intrinsic :: iso_c_binding
   implicit none
@@ -10,6 +12,6 @@ contains
     type(c_ptr) :: my_c_ptr
 
     my_array_ptr => my_array
-    my_c_ptr = c_loc(my_array_ptr) ! { dg-error "must be an associated scalar POINTER" }
+    my_c_ptr = c_loc(my_array_ptr) ! { dg-error "Noninteroperable array at .1. as argument to C_LOC: Only explicit-size and assumed-size arrays are interoperable" }
   end subroutine sub0
 end module c_loc_tests_4

gcc/testsuite/gfortran.dg/c_loc_tests_8.f03

@@ -7,7 +7,7 @@ contains
 SUBROUTINE glutInit_f03()
   TYPE(C_PTR), DIMENSION(1), TARGET :: argv=C_NULL_PTR
   character(kind=c_char, len=5), target :: string="hello"
-  argv(1)=C_LOC(string) ! { dg-error "must have a length of 1" }
+  argv(1)=C_LOC(string) ! OK since Fortran 2003, Tech Corrigenda 5; IR F03/0129
 END SUBROUTINE
 end module x
 

gcc/testsuite/gfortran.dg/c_ptr_tests_13.f03

@@ -10,6 +10,6 @@ program main
    integer(C_INTPTR_T) p
    type(C_PTR) cptr
    p = 0
-   cptr = C_PTR(p+1) ! { dg-error "Components of structure constructor" }
-   cptr = C_PTR(1) ! { dg-error "Components of structure constructor" } 
+   cptr = C_PTR(p+1) ! { dg-error "is a PRIVATE component of 'c_ptr'" }
+   cptr = C_PTR(1) ! { dg-error "is a PRIVATE component of 'c_ptr'" }
 end program main

gcc/testsuite/gfortran.dg/c_ptr_tests_14.f90

@@ -39,8 +39,10 @@ program test
   if(c_associated(file%gsl_func)) call abort()
 end program test
 
-! { dg-final { scan-tree-dump-times "gsl_file = 0B" 1 "original" } }
-! { dg-final { scan-tree-dump-times "gsl_func = 0B" 1 "original" } }
+! { dg-final { scan-tree-dump-times "c_funptr.\[0-9\]+ = 0B;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "fgsl_file.\[0-9\]+.gsl_func = c_funptr.\[0-9\]+;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "c_ptr.\[0-9\]+ = 0B;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "fgsl_file.\[0-9\]+.gsl_file = c_ptr.\[0-9\]+;" 1 "original" } }
 
 ! { dg-final { scan-tree-dump-times "NIptr = 0B"    0 "original" } }
 ! { dg-final { scan-tree-dump-times "NIfunptr = 0B" 0 "original" } }

gcc/testsuite/gfortran.dg/c_ptr_tests_15.f90

@@ -41,8 +41,10 @@ program test
   if(c_associated(file%gsl_func)) call abort()
 end program test
 
-! { dg-final { scan-tree-dump-times "gsl_file = 0B" 1 "original" } }
-! { dg-final { scan-tree-dump-times "gsl_func = 0B" 1 "original" } }
+! { dg-final { scan-tree-dump-times "c_funptr.\[0-9\]+ = 0B;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "fgsl_file.\[0-9\]+.gsl_func = c_funptr.\[0-9\]+;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "c_ptr.\[0-9\]+ = 0B;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "fgsl_file.\[0-9\]+.gsl_file = c_ptr.\[0-9\]+;" 1 "original" } }
 
 ! { dg-final { scan-tree-dump-times "NIptr = 0B"    0 "original" } }
 ! { dg-final { scan-tree-dump-times "NIfunptr = 0B" 0 "original" } }

gcc/testsuite/gfortran.dg/c_ptr_tests_9.f03

@@ -16,9 +16,9 @@ contains
     type(myF90Derived), pointer :: my_f90_type_ptr
 
     my_f90_type%my_c_ptr = c_null_ptr
-    print *, 'my_f90_type is: ', my_f90_type
+    print *, 'my_f90_type is: ', my_f90_type%my_c_ptr
     my_f90_type_ptr => my_f90_type
-    print *, 'my_f90_type_ptr is: ', my_f90_type_ptr
+    print *, 'my_f90_type_ptr is: ', my_f90_type_ptr%my_c_ptr
   end subroutine sub0
 end module c_ptr_tests_9
 

gcc/testsuite/gfortran.dg/c_sizeof_1.f90

@@ -4,7 +4,8 @@
 use iso_c_binding, only: c_int, c_char, c_ptr, c_intptr_t, c_null_ptr, c_sizeof
 
 integer(kind=c_int) :: i, j(10)
-character(kind=c_char,len=4),parameter :: str(1) = "abcd"
+character(kind=c_char,len=4),parameter :: str(1 ) = "abcd"
+character(kind=c_char,len=1),parameter :: str2(4) = ["a","b","c","d"]
 type(c_ptr) :: cptr
 integer(c_intptr_t) :: iptr
 
@@ -15,13 +16,13 @@ if (i /= 4) call abort()
 i = c_sizeof(j)
 if (i /= 40) call abort()
 
-i = c_sizeof(str)
+i = c_sizeof(str2)
 if (i /= 4) call abort()
 
-i = c_sizeof(str(1))
-if (i /= 4) call abort()
+i = c_sizeof(str2(1))
+if (i /= 1) call abort()
 
-i = c_sizeof(str(1)(1:3))
+i = c_sizeof(str2(1:3))
 if (i /= 3) call abort()
 
 write(*,*) c_sizeof(cptr), c_sizeof(iptr), c_sizeof(C_NULL_PTR)

gcc/testsuite/gfortran.dg/c_sizeof_5.f90

+! { dg-do run }
+! { dg-options "-fcray-pointer" }
+!
+use iso_c_binding
+real target(10)
+real pointee(10)
+pointer (ipt, pointee)
+integer(c_intptr_t) :: int_cptr
+real :: x
+if (c_sizeof(ipt) /= c_sizeof(int_cptr)) call abort()
+if (c_sizeof(pointee) /= c_sizeof(x)*10) call abort()
+end

gcc/testsuite/gfortran.dg/iso_c_binding_init_expr.f03

@@ -5,7 +5,7 @@ use iso_c_binding
 implicit none
 integer, target :: a
 type t
-  type(c_ptr) :: ptr = c_loc(a)    ! { dg-error "must be an intrinsic function" }
+  type(c_ptr) :: ptr = c_loc(a)    ! { dg-error "Intrinsic function 'c_loc' at .1. is not permitted in an initialization expression" }
 end type t
-type(c_ptr) :: ptr2 = c_loc(a)     ! { dg-error "must be an intrinsic function" }
+type(c_ptr) :: ptr2 = c_loc(a)     ! { dg-error "Intrinsic function 'c_loc' at .1. is not permitted in an initialization expression" }
 end

gcc/testsuite/gfortran.dg/iso_c_binding_rename_3.f90

+! { dg-do compile }
+!
+! PR fortran/55343
+!
+! Contributed by Janus Weil
+!
+module my_mod
+  implicit none
+  type int_type
+    integer :: i
+  end type int_type
+end module my_mod
+program main
+  use iso_c_binding, only: C_void_ptr=>C_ptr, C_string_ptr=>C_ptr
+  use my_mod, only: i1_type=>int_type, i2_type=>int_type
+  implicit none
+  type(C_string_ptr) :: p_string
+  type(C_void_ptr) :: p_void
+  type (i1_type) :: i1
+  type (i2_type) :: i2
+  p_void = p_string
+  i1 = i2
+end program main

gcc/testsuite/gfortran.dg/pr32601.f03

@@ -19,9 +19,9 @@ type(c_ptr) :: t
 t = c_null_ptr
 
 ! Next two lines should be errors if -pedantic or -std=f2003
-print *, c_null_ptr, t  ! { dg-error "has PRIVATE components" }
-print *, t ! { dg-error "has PRIVATE components" }
+print *, c_null_ptr, t  ! { dg-error "cannot have PRIVATE components" }
+print *, t ! { dg-error "cannot have PRIVATE components" }
 
-print *, c_loc(get_ptr()) ! { dg-error "has PRIVATE components" }
+print *, c_loc(get_ptr()) ! { dg-error "cannot have PRIVATE components" }
 
 end

gcc/testsuite/gfortran.dg/pr32601_1.f03

 ! { dg-do compile }
+! { dg-options "" }
+!
 ! PR fortran/32601
 use, intrinsic :: iso_c_binding, only: c_loc, c_ptr
 implicit none
 
 ! This was causing an ICE, but is an error because the argument to C_LOC 
 ! needs to be a variable.
-print *, c_loc(4) ! { dg-error "not a variable" }
+print *, c_loc(4) ! { dg-error "shall have either the POINTER or the TARGET attribute" }
 
 end

gcc/testsuite/gfortran.dg/storage_size_2.f08

@@ -14,10 +14,10 @@ integer(4) :: i1
 integer(c_int) :: i2
 type(t) :: x
 
-print *,c_sizeof(i1)                ! { dg-error "must be an interoperable data entity" }
+print *,c_sizeof(i1)
 print *,c_sizeof(i2)
 print *,c_sizeof(x)
-print *, c_sizeof(ran())            ! { dg-error "must be an interoperable data entity" }
+print *, c_sizeof(ran())
 
 print *,storage_size(1.0,4)
 print *,storage_size(1.0,3.2)       ! { dg-error "must be INTEGER" }

gcc/testsuite/gfortran.dg/transfer_resolve_2.f90

+! { dg-do compile }
+!
+! PR fortran/56079
+!
+! Contributed by  Thomas Koenig
+!
+program gar_nichts
+   use ISO_C_BINDING
+   use ISO_C_BINDING, only: C_PTR
+   use ISO_C_BINDING, only: abc => C_PTR
+   use ISO_C_BINDING, only: xyz => C_PTR
+   type(xyz) nada
+   nada = transfer(C_NULL_PTR,nada)
+end program gar_nichts

gcc/testsuite/gfortran.dg/transfer_resolve_3.f90

+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/56079
+!
+use iso_c_binding
+implicit none
+type t
+  type(c_ptr) :: ptr = c_null_ptr
+end type t
+
+type(t), parameter :: para = t()
+integer(c_intptr_t) :: intg
+intg = transfer (para, intg)
+intg = transfer (para%ptr, intg)
+end
+
+! { dg-final { scan-tree-dump-times "intg = 0;" 2 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+

gcc/testsuite/gfortran.dg/transfer_resolve_4.f90

+! { dg-do compile }
+!
+! PR fortran/47034
+!
+! Contributed by James Van Buskirk
+!
+subroutine james
+   use iso_c_binding
+   type(C_PTR), parameter :: p1 = &
+   transfer(32512_C_INTPTR_T,C_NULL_PTR)
+   integer(C_INTPTR_T), parameter :: n1 = transfer(p1,0_C_INTPTR_T)
+end