Patchwork [Fortran] C Binding - module+intrinsic cleanup+bug fixes

login
register
mail settings
Submitter Tobias Burnus
Date March 25, 2013, 10:11 a.m.
Message ID <515022CF.7080500@net-b.de>
Download mbox | patch
Permalink /patch/230609/
State New
Headers show

Comments

Tobias Burnus - March 25, 2013, 10:11 a.m.
Hello,

Mikael Morin wrote:
>> The main change of this patch is to move all the special handling of the intrinsics from symbol.c to the normal intrinsics code in intrinsic.{c,h}, check.c, iresolve.c and trans-intrinsics.c. That also implied to do some larger changes to module.c. Additionally, I rewrote all the constraint checks from scratch, based on the Fortran 2003, 2008 and TS29113 standards - and fixed the fallout. Finally, I looked through the bugreports mentioning those intrinsics - and fixed some remaing issues (some were already fixed, either by this patch or since at least GCC 4.6).

Regarding the issues mentioned by Dominque:

* gfortran.dg/c_funloc_tests_8.f90: That was due to a bug in expr.c. I 
had attached an old patch.

* gfortran.dg/transfer_resolve_2.f90:

The way, the value was obtained, was bogus - it is now fixed. While 
doing so, I saw that a valid test case was rejected, cf. 
transfer_resolve_2.f90. Thus, the handling of type(c_ptr) was changed to 
be more in line with the normal code, i.e. symbol_private is properly 
set - and some special code could be removed.

However, that changed the following: gfortran allows as GNU extension to 
do "print *, c_ptr_var"; that continues to work. But it also allowed 
"print *, dt_with_c_ptr_comp" which no longer works. It could be fixed 
by walking all the components of a derived type, but I do not see this 
is important feature. Being able to print a c_ptr for debugging purpose 
can be useful, but printing it as part of a large derived type is 
questionable.


> Really impressive. You can also add PR 55574 to the list (test case
> attached).

Done. And thanks a lot for the quick and thorough review of the long patch!


> There is one thing in the patch I'm uncomfortable with, namely:
>
>> -  isym = gfc_find_subroutine (name);
>> +  if (c->symtree->n.sym->intmod_sym_id)
>> +    isym = gfc_intrinsic_subroutine_by_id ((gfc_isym_id)
>> +					c->symtree->n.sym->intmod_sym_id);
> [...]
> After investigating further, it seems that create_intrinsic_function
> sets the intmod_sym_id field to the gfc_isym_id id (even without your
> patch).
> This is confusing because the non-procedure symbols use as intmod_sym_id
> a ISOCBINDING_* id, whereas procedures use a GFC_ISYM_* id.
> I don't know how it ends up working, but I suggest the following change:
>   - store the ISOCBINDING_* id in intmod_sym_id
>   - retrieve the corresponding GFC_ISYM_* when needed (like above) using
> c_interop_kinds_table[...->intmod_sym_id].value

I followed the suggestion and created two auxiliary functions, 
gfc_isym_id_by_intmod and gfc_isym_id_by_intmod_sym. While calling 
c_interop_kinds_table works for ISO_C_BINDING, for ISO_FORTRAN_ENV, the 
code is a bit longer - hence, I factored it into a function.

> By the way, create_intrinsic_function could certainly be simplified if
> it was called from generate_isocbinding_symbol.

Yes, but only marginally (setting the DT as function result). A lot of 
the rest is required for ISO_Fortran_env's compiler_{options,version} 
and I wouldn't rule out that more such functions will be added in the 
upcoming TS and standards.

>> @@ -693,12 +693,15 @@ gfc_var_strlen (const gfc_expr *a)
>>       {
>>         long start_a, end_a;
>>   
>> +      if (!ra->u.ss.start || !ra->u.ss.end)
>> +	return -1;
>> +
> This is a bit conservative (though not wrong); ra->u.ss.start == NULL at
> least doesn't prevent string length evaluation.

Granted. I modified the code to assumed a start-index of 1 if 
ra->u.ss.start == NULL.


>> +/* Check whether an expression is interoperable. If all_len_okay is true,
>> +   all length-type parameters (for character) are allowed. Required for
>> +   C_LOC (cf. Fortran 2003corr5 or Fortran 2008).  */
> Could you add a comment about MSG?

Done.

> I think full sentences should be used for MSG

Done.

> You should also check ...->from_intmod; just in case there is a vicious
> user using a symbol (from a non-iso_c_binding intrinsic module) with the
> same id as C_FUN/C_FUNPTR. ;-)
Done.

> Could you simplify it a bit like this: if (a == ISOCBINDING_LOC) 
> return_type = c_ptr->n.sym; else if (a == ISOCBINDING_FUNLOC) 
> return_type = c_funptr->n.sym; else return_type = NULL; 
> create_intrinsic_function (..., return_type); 

Done.

>> +! { dg-compile }
> dg-do compile

Ups. Correct all this one and the other copy-and-paste victims.


Is the updated patch now okay for the trunk? (It was build and regtested 
on x86-64-gnu-linux.)

Tobias
Mikael Morin - March 25, 2013, 2:44 p.m.
Le 25/03/2013 11:11, Tobias Burnus a écrit :
> 
> Is the updated patch now okay for the trunk? (It was build and regtested
> on x86-64-gnu-linux.)
> 
OK. Many thanks.

Mikael

Patch

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/49023
	PR fortran/50269
	PR fortran/50612
	PR fortran/52426
	PR fortran/54263
	PR fortran/55343
	PR fortran/55444
	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/49023
	PR fortran/50269
	PR fortran/50612
	PR fortran/52426
	PR fortran/54263
	PR fortran/55343
	PR fortran/55444
	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/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.

 gcc/fortran/check.c             | 397 ++++++++++++++++++++++++-
 gcc/fortran/expr.c              |  47 ++-
 gcc/fortran/gfortran.h          |  19 +-
 gcc/fortran/intrinsic.c         | 107 ++++++-
 gcc/fortran/intrinsic.h         |   7 +
 gcc/fortran/iresolve.c          |  14 +
 gcc/fortran/iso-c-binding.def   |  32 ++-
 gcc/fortran/iso-fortran-env.def |   5 +
 gcc/fortran/module.c            | 206 +++++++++----
 gcc/fortran/resolve.c           | 612 ++-------------------------------------
 gcc/fortran/symbol.c            | 621 +++++++---------------------------------
 gcc/fortran/target-memory.c     |  11 +
 gcc/fortran/trans-expr.c        | 238 +--------------
 gcc/fortran/trans-intrinsic.c   | 214 ++++++++++++++
 gcc/fortran/trans-io.c          |  16 +-
 gcc/fortran/trans-types.c       |  17 +-
 16 files changed, 1098 insertions(+), 1465 deletions(-)

 gcc/testsuite/gfortran.dg/blockdata_7.f90          | 16 +++++++
 gcc/testsuite/gfortran.dg/c_assoc_2.f03            |  8 ++--
 gcc/testsuite/gfortran.dg/c_assoc_4.f90            | 14 +++++++
 .../gfortran.dg/c_f_pointer_shape_test.f90         |  2 +-
 .../gfortran.dg/c_f_pointer_shape_tests_3.f03      |  4 +-
 gcc/testsuite/gfortran.dg/c_f_pointer_tests_5.f90  |  2 +-
 gcc/testsuite/gfortran.dg/c_f_pointer_tests_6.f90  | 43 +++++++++++++++++++
 gcc/testsuite/gfortran.dg/c_f_pointer_tests_7.f90  |  9 ++++
 gcc/testsuite/gfortran.dg/c_funloc_tests_2.f03     |  6 +--
 gcc/testsuite/gfortran.dg/c_funloc_tests_5.f03     |  4 +-
 gcc/testsuite/gfortran.dg/c_funloc_tests_6.f90     |  8 ++--
 gcc/testsuite/gfortran.dg/c_funloc_tests_8.f90     | 49 ++++++++++++++++++++++
 gcc/testsuite/gfortran.dg/c_loc_test_17.f90        | 28 +++++++++++++
 gcc/testsuite/gfortran.dg/c_loc_test_18.f90        | 21 ++++++++++
 gcc/testsuite/gfortran.dg/c_loc_test_19.f90        | 17 ++++++++
 gcc/testsuite/gfortran.dg/c_loc_test_20.f90        | 34 +++++++++++++++
 gcc/testsuite/gfortran.dg/c_loc_tests_10.f03       |  3 +-
 gcc/testsuite/gfortran.dg/c_loc_tests_11.f03       | 10 +++--
 gcc/testsuite/gfortran.dg/c_loc_tests_15.f90       |  2 +-
 gcc/testsuite/gfortran.dg/c_loc_tests_16.f90       | 10 ++---
 gcc/testsuite/gfortran.dg/c_loc_tests_17.f90       | 14 +++++++
 gcc/testsuite/gfortran.dg/c_loc_tests_3.f03        |  2 +-
 gcc/testsuite/gfortran.dg/c_loc_tests_4.f03        |  4 +-
 gcc/testsuite/gfortran.dg/c_loc_tests_8.f03        |  2 +-
 gcc/testsuite/gfortran.dg/c_ptr_tests_13.f03       |  4 +-
 gcc/testsuite/gfortran.dg/c_ptr_tests_14.f90       |  6 ++-
 gcc/testsuite/gfortran.dg/c_ptr_tests_15.f90       |  6 ++-
 gcc/testsuite/gfortran.dg/c_ptr_tests_9.f03        |  4 +-
 gcc/testsuite/gfortran.dg/c_sizeof_1.f90           | 11 ++---
 gcc/testsuite/gfortran.dg/c_sizeof_5.f90           | 12 ++++++
 .../gfortran.dg/iso_c_binding_init_expr.f03        |  4 +-
 .../gfortran.dg/iso_c_binding_rename_3.f90         | 23 ++++++++++
 gcc/testsuite/gfortran.dg/pr32601.f03              |  6 +--
 gcc/testsuite/gfortran.dg/pr32601_1.f03            |  4 +-
 gcc/testsuite/gfortran.dg/storage_size_2.f08       |  4 +-
 gcc/testsuite/gfortran.dg/transfer_resolve_2.f90   | 14 +++++++
 gcc/testsuite/gfortran.dg/transfer_resolve_3.f90   | 20 +++++++++
 37 files changed, 378 insertions(+), 52 deletions(-)


diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 0e71b95..0460bf2 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -693,14 +693,19 @@  gfc_var_strlen (const gfc_expr *a)
     {
       long start_a, end_a;
 
-      if (ra->u.ss.start->expr_type == EXPR_CONSTANT
+      if (!ra->u.ss.end)
+	return -1;
+
+      if ((!ra->u.ss.start || ra->u.ss.start->expr_type == EXPR_CONSTANT)
 	  && ra->u.ss.end->expr_type == EXPR_CONSTANT)
 	{
-	  start_a = mpz_get_si (ra->u.ss.start->value.integer);
+	  start_a = ra->u.ss.start ? mpz_get_si (ra->u.ss.start->value.integer)
+				   : 1;
 	  end_a = mpz_get_si (ra->u.ss.end->value.integer);
-	  return end_a - start_a + 1;
+	  return (end_a < start_a) ? 0 : end_a - start_a + 1;
 	}
-      else if (gfc_dep_compare_expr (ra->u.ss.start, ra->u.ss.end) == 0)
+      else if (ra->u.ss.start
+	       && gfc_dep_compare_expr (ra->u.ss.start, ra->u.ss.end) == 0)
 	return 1;
       else
 	return -1;
@@ -3621,17 +3626,395 @@  gfc_check_sizeof (gfc_expr *arg)
 }
 
 
+/* Check whether an expression is interoperable.  When returning false,
+   msg is set to a string telling why the expression is not interoperable,
+   otherwise, it is set to NULL.  The msg string can be used in diagnostics.
+   If all_len_okay is true, all length-type parameters (for character) are
+   allowed.  Required for C_LOC (cf. Fortran 2003corr5 or Fortran 2008).  */
+
+static bool
+is_c_interoperable (gfc_expr *expr, const char **msg, bool all_len_okay)
+{
+  *msg = NULL;
+
+  if (expr->ts.type == BT_CLASS)
+    {
+      *msg = "Expression is polymorphic";
+      return false;
+    }
+
+  if (expr->ts.type == BT_DERIVED && !expr->ts.u.derived->attr.is_bind_c
+      && !expr->ts.u.derived->ts.is_iso_c)
+    {
+      *msg = "Expression is a noninteroperable derived type";
+      return false;
+    }
+
+  if (expr->ts.type == BT_PROCEDURE)
+    {
+      *msg = "Procedure unexpected as argument";
+      return false;
+    }
+
+  if (gfc_notification_std (GFC_STD_GNU) && expr->ts.type == BT_LOGICAL)
+    {
+      int i;
+      for (i = 0; gfc_logical_kinds[i].kind; i++)
+        if (gfc_logical_kinds[i].kind == expr->ts.kind)
+          return true;
+      *msg = "Extension to use a non-C_Bool-kind LOGICAL";
+      return false;
+    }
+
+  if (gfc_notification_std (GFC_STD_GNU) && expr->ts.type == BT_CHARACTER
+      && expr->ts.kind != 1)
+    {
+      *msg = "Extension to use a non-C_CHAR-kind CHARACTER";
+      return false;
+    }
+
+  if (expr->ts.type == BT_CHARACTER) {
+    if (expr->ts.deferred)
+      {
+	/* TS 29113 allows deferred-length strings as dummy arguments,
+	   but it is not an interoperable type. */
+	*msg = "Expression shall not be a deferred-length string";
+	return false;
+      }
+
+    if (expr->ts.u.cl && expr->ts.u.cl->length
+	&& gfc_simplify_expr (expr, 0) == FAILURE)
+      gfc_internal_error ("is_c_interoperable(): gfc_simplify_expr failed");
+
+    if (!all_len_okay && expr->ts.u.cl
+	&& (!expr->ts.u.cl->length
+	    || expr->ts.u.cl->length->expr_type != EXPR_CONSTANT
+	    || mpz_cmp_si (expr->ts.u.cl->length->value.integer, 1) != 0))
+      {
+	*msg = "Type shall have a character length of 1";
+	return false;
+      }
+    }
+
+  /* Note: The following checks are about interoperatable variables, Fortran
+     15.3.5/15.3.6.  In intrinsics like C_LOC or in procedure interface, more
+     is allowed, e.g. assumed-shape arrays with TS 29113.  */
+
+  if (gfc_is_coarray (expr))
+    {
+      *msg = "Coarrays are not interoperable";
+      return false;
+    }
+
+  if (expr->rank > 0 && expr->expr_type != EXPR_ARRAY)
+    {
+      gfc_array_ref *ar = gfc_find_array_ref (expr);
+      if (ar->type != AR_FULL)
+	{
+	  *msg = "Only whole-arrays are interoperable";
+	  return false;
+	}
+      if (ar->as->type != AS_EXPLICIT && ar->as->type != AS_ASSUMED_SIZE)
+	{
+	  *msg = "Only explicit-size and assumed-size arrays are interoperable";
+	  return false;
+	}
+    }
+
+  return true;
+}
+
+
 gfc_try
 gfc_check_c_sizeof (gfc_expr *arg)
 {
-  if (gfc_verify_c_interop (&arg->ts) != SUCCESS)
+  const char *msg;
+
+  if (is_c_interoperable (arg, &msg, false) != SUCCESS)
     {
       gfc_error ("'%s' argument of '%s' intrinsic at %L must be an "
-		 "interoperable data entity",
+		 "interoperable data entity: %s",
 		 gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
-		 &arg->where);
+		 &arg->where, msg);
+      return FAILURE;
+    }
+
+  if (arg->rank && arg->expr_type == EXPR_VARIABLE
+      && arg->symtree->n.sym->as != NULL
+      && arg->symtree->n.sym->as->type == AS_ASSUMED_SIZE && arg->ref
+      && arg->ref->type == REF_ARRAY && arg->ref->u.ar.type == AR_FULL)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be an "
+		 "assumed-size array", gfc_current_intrinsic_arg[0]->name,
+		 gfc_current_intrinsic, &arg->where);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_c_associated (gfc_expr *c_ptr_1, gfc_expr *c_ptr_2)
+{
+  if (c_ptr_1->ts.type != BT_DERIVED
+      || c_ptr_1->ts.u.derived->from_intmod != INTMOD_ISO_C_BINDING
+      || (c_ptr_1->ts.u.derived->intmod_sym_id != ISOCBINDING_PTR
+	  && c_ptr_1->ts.u.derived->intmod_sym_id != ISOCBINDING_FUNPTR))
+    {
+      gfc_error ("Argument C_PTR_1 at %L to C_ASSOCIATED shall have the "
+		 "type TYPE(C_PTR) or TYPE(C_FUNPTR)", &c_ptr_1->where);
+      return FAILURE;
+    }
+
+  if (scalar_check (c_ptr_1, 0) == FAILURE)
+    return FAILURE;
+
+  if (c_ptr_2
+      && (c_ptr_2->ts.type != BT_DERIVED
+	  || c_ptr_2->ts.u.derived->from_intmod != INTMOD_ISO_C_BINDING
+	  || (c_ptr_1->ts.u.derived->intmod_sym_id
+	      != c_ptr_2->ts.u.derived->intmod_sym_id)))
+    {
+      gfc_error ("Argument C_PTR_2 at %L to C_ASSOCIATED shall have the "
+		 "same type as C_PTR_1: %s instead of %s", &c_ptr_1->where,
+		 gfc_typename (&c_ptr_1->ts),
+		 gfc_typename (&c_ptr_2->ts));
+      return FAILURE;
+    }
+
+  if (c_ptr_2 && scalar_check (c_ptr_2, 1) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_c_f_pointer (gfc_expr *cptr, gfc_expr *fptr, gfc_expr *shape)
+{
+  symbol_attribute attr;
+  const char *msg;
+
+  if (cptr->ts.type != BT_DERIVED
+      || cptr->ts.u.derived->from_intmod != INTMOD_ISO_C_BINDING
+      || cptr->ts.u.derived->intmod_sym_id != ISOCBINDING_PTR)
+    {
+      gfc_error ("Argument CPTR at %L to C_F_POINTER shall have the "
+		 "type TYPE(C_PTR)", &cptr->where);
+      return FAILURE;
+    }
+
+  if (scalar_check (cptr, 0) == FAILURE)
+    return FAILURE;
+
+  attr = gfc_expr_attr (fptr);
+
+  if (!attr.pointer)
+    {
+      gfc_error ("Argument FPTR at %L to C_F_POINTER must be a pointer",
+		 &fptr->where);
+      return FAILURE;
+    }
+
+  if (fptr->ts.type == BT_CLASS)
+    {
+      gfc_error ("FPTR argument at %L to C_F_POINTER shall not be polymorphic",
+		 &fptr->where);
+      return FAILURE;
+    }
+
+  if (gfc_is_coindexed (fptr))
+    {
+      gfc_error ("Argument FPTR at %L to C_F_POINTER shall not be "
+		 "coindexed", &fptr->where);
+      return FAILURE;
+    }
+
+  if (fptr->rank == 0 && shape)
+    {
+      gfc_error ("Unexpected SHAPE argument at %L to C_F_POINTER with scalar "
+		 "FPTR", &fptr->where);
+      return FAILURE;
+    }
+  else if (fptr->rank && !shape)
+    {
+      gfc_error ("Expected SHAPE argument to C_F_POINTER with array "
+		 "FPTR at %L", &fptr->where);
+      return FAILURE;
+    }
+
+  if (shape && rank_check (shape, 2, 1) == FAILURE)
+    return FAILURE;
+
+  if (shape && type_check (shape, 2, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (shape)
+    {
+      mpz_t size;
+
+      if (gfc_array_size (shape, &size) == SUCCESS
+	  && mpz_cmp_ui (size, fptr->rank) != 0)
+	{
+	  mpz_clear (size);
+	  gfc_error ("SHAPE argument at %L to C_F_POINTER must have the same "
+		     "size as the RANK of FPTR", &shape->where);
+	  return FAILURE;
+	}
+      mpz_clear (size);
+    }
+
+  if (fptr->ts.type == BT_CLASS)
+    {
+      gfc_error ("Polymorphic FPTR at %L to C_F_POINTER", &fptr->where);
+      return FAILURE;
+    }
+
+  if (!is_c_interoperable (fptr, &msg, false) && fptr->rank)
+    return gfc_notify_std (GFC_STD_F2008_TS, "Noninteroperable array FPTR "
+			   "at %L to C_F_POINTER: %s", &fptr->where, msg);
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_c_f_procpointer (gfc_expr *cptr, gfc_expr *fptr)
+{
+  symbol_attribute attr;
+
+  if (cptr->ts.type != BT_DERIVED
+      || cptr->ts.u.derived->from_intmod != INTMOD_ISO_C_BINDING
+      || cptr->ts.u.derived->intmod_sym_id != ISOCBINDING_FUNPTR)
+    {
+      gfc_error ("Argument CPTR at %L to C_F_PROCPOINTER shall have the "
+		 "type TYPE(C_FUNPTR)", &cptr->where);
+      return FAILURE;
+    }
+
+  if (scalar_check (cptr, 0) == FAILURE)
+    return FAILURE;
+
+  attr = gfc_expr_attr (fptr);
+
+  if (!attr.proc_pointer)
+    {
+      gfc_error ("Argument FPTR at %L to C_F_PROCPOINTER shall be a procedure "
+		 "pointer", &fptr->where);
+      return FAILURE;
+    }
+
+  if (gfc_is_coindexed (fptr))
+    {
+      gfc_error ("Argument FPTR at %L to C_F_PROCPOINTER shall not be "
+		 "coindexed", &fptr->where);
+      return FAILURE;
+    }
+
+  if (!attr.is_bind_c)
+    return gfc_notify_std (GFC_STD_F2008_TS, "Noninteroperable procedure "
+			   "pointer at %L to C_F_PROCPOINTER", &fptr->where);
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_c_funloc (gfc_expr *x)
+{
+  symbol_attribute attr;
+
+  if (gfc_is_coindexed (x))
+    {
+      gfc_error ("Argument X at %L to C_FUNLOC shall not be "
+		 "coindexed", &x->where);
       return FAILURE;
     }
+
+  attr = gfc_expr_attr (x);
+
+  if (attr.function && !attr.proc_pointer && x->expr_type == EXPR_VARIABLE
+      && x->symtree->n.sym == x->symtree->n.sym->result)
+    {
+      gfc_namespace *ns = gfc_current_ns;
+
+      for (ns = gfc_current_ns; ns; ns = ns->parent)
+	if (x->symtree->n.sym == ns->proc_name)
+	  {
+	    gfc_error ("Function result '%s' at %L is invalid as X argument "
+		       "to C_FUNLOC", x->symtree->n.sym->name, &x->where);
+	    return FAILURE;
+	  }
+    }
+
+  if (attr.flavor != FL_PROCEDURE)
+    {
+      gfc_error ("Argument X at %L to C_FUNLOC shall be a procedure "
+		 "or a procedure pointer", &x->where);
+      return FAILURE;
+    }
+
+  if (!attr.is_bind_c)
+    return gfc_notify_std (GFC_STD_F2008_TS, "Noninteroperable procedure "
+			   "at %L to C_FUNLOC", &x->where);
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_c_loc (gfc_expr *x)
+{
+  symbol_attribute attr;
+  const char *msg;
+
+  if (gfc_is_coindexed (x))
+    {
+      gfc_error ("Argument X at %L to C_LOC shall not be coindexed", &x->where);
+      return FAILURE;
+    }
+
+  if (x->ts.type == BT_CLASS)
+    {
+      gfc_error ("X argument at %L to C_LOC shall not be polymorphic",
+		 &x->where);
+      return FAILURE;
+    }
+
+  attr = gfc_expr_attr (x);
+
+  if (!attr.pointer
+      && (x->expr_type != EXPR_VARIABLE || !attr.target
+	  || attr.flavor == FL_PARAMETER))
+    {
+      gfc_error ("Argument X at %L to C_LOC shall have either "
+		 "the POINTER or the TARGET attribute", &x->where);
+      return FAILURE;
+    }
+
+  if (x->ts.type == BT_CHARACTER
+      && gfc_var_strlen (x) == 0)
+    {
+      gfc_error ("Argument X at %L to C_LOC shall be not be a zero-sized "
+		 "string", &x->where);
+      return FAILURE;
+    }
+
+  if (!is_c_interoperable (x, &msg, true))
+    {
+      if (x->ts.type == BT_CLASS)
+	{
+	  gfc_error ("Argument at %L to C_LOC shall not be polymorphic",
+		     &x->where);
+	  return FAILURE;
+	}
+     
+      if (x->rank
+	  && gfc_notify_std (GFC_STD_F2008_TS, "Noninteroperable array at %L as"
+			 " argument to C_LOC: %s", &x->where, msg) == FAILURE)
+	  return FAILURE;
+    }
+
   return SUCCESS;
 }
 
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 1b74a44..8deb4eb 100644
--- a/gcc/fortran/expr.c
+++ b/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)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 76d2797..f28a99a 100644
--- a/gcc/fortran/gfortran.h
+++ b/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);
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index c571533..358c33e 100644
--- a/gcc/fortran/intrinsic.c
+++ b/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;
 
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index 5d50285..0f9b50c 100644
--- a/gcc/fortran/intrinsic.h
+++ b/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 *);
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 5b2f8c7..2b92b7c 100644
--- a/gcc/fortran/iresolve.c
+++ b/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;
diff --git a/gcc/fortran/iso-c-binding.def b/gcc/fortran/iso-c-binding.def
index aaef80c..c36a478 100644
--- a/gcc/fortran/iso-c-binding.def
+++ b/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
diff --git a/gcc/fortran/iso-fortran-env.def b/gcc/fortran/iso-fortran-env.def
index dfd6364..13ddaa3 100644
--- a/gcc/fortran/iso-fortran-env.def
+++ b/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
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 1b38555..ee09291 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -5570,8 +5570,9 @@  gfc_dump_module (const char *name, int dump_flag)
 
 
 static void
-create_intrinsic_function (const char *name, gfc_isym_id id,
-			   const char *modname, intmod_id module)
+create_intrinsic_function (const char *name, int id,
+			   const char *modname, intmod_id module,
+			   bool subroutine, gfc_symbol *result_type)
 {
   gfc_intrinsic_sym *isym;
   gfc_symtree *tmp_symtree;
@@ -5588,7 +5589,30 @@  create_intrinsic_function (const char *name, gfc_isym_id id,
   gfc_get_sym_tree (name, gfc_current_ns, &tmp_symtree, false);
   sym = tmp_symtree->n.sym;
 
-  isym = gfc_intrinsic_function_by_id (id);
+  if (subroutine)
+    {
+      gfc_isym_id isym_id = gfc_isym_id_by_intmod (module, id);
+      isym = gfc_intrinsic_subroutine_by_id (isym_id);
+      sym->attr.subroutine = 1;
+    }
+  else
+    {
+      gfc_isym_id isym_id = gfc_isym_id_by_intmod (module, id);
+      isym = gfc_intrinsic_function_by_id (isym_id);
+
+      sym->attr.function = 1;
+      if (result_type)
+	{
+	  sym->ts.type = BT_DERIVED;
+	  sym->ts.u.derived = result_type;
+	  sym->ts.is_c_interop = 1;
+	  isym->ts.f90_type = BT_VOID;
+	  isym->ts.type = BT_DERIVED;
+	  isym->ts.f90_type = BT_VOID;
+	  isym->ts.u.derived = result_type;
+	  isym->ts.is_c_interop = 1;
+	}
+    }
   gcc_assert (isym);
 
   sym->attr.flavor = FL_PROCEDURE;
@@ -5609,11 +5633,13 @@  create_intrinsic_function (const char *name, gfc_isym_id id,
 static void
 import_iso_c_binding_module (void)
 {
-  gfc_symbol *mod_sym = NULL;
-  gfc_symtree *mod_symtree = NULL;
+  gfc_symbol *mod_sym = NULL, *return_type;
+  gfc_symtree *mod_symtree = NULL, *tmp_symtree;
+  gfc_symtree *c_ptr = NULL, *c_funptr = NULL;
   const char *iso_c_module_name = "__iso_c_binding";
   gfc_use_rename *u;
   int i;
+  bool want_c_ptr = false, want_c_funptr = false;
 
   /* Look only in the current namespace.  */
   mod_symtree = gfc_find_symtree (gfc_current_ns->sym_root, iso_c_module_name);
@@ -5636,6 +5662,57 @@  import_iso_c_binding_module (void)
       mod_sym->from_intmod = INTMOD_ISO_C_BINDING;
     }
 
+  /* Check whether C_PTR or C_FUNPTR are in the include list, if so, load it;
+     check also whether C_NULL_(FUN)PTR or C_(FUN)LOC are requested, which
+     need C_(FUN)PTR.  */
+  for (u = gfc_rename_list; u; u = u->next)
+    {
+      if (strcmp (c_interop_kinds_table[ISOCBINDING_NULL_PTR].name,
+		  u->use_name) == 0)
+        want_c_ptr = true;
+      else if (strcmp (c_interop_kinds_table[ISOCBINDING_LOC].name,
+		       u->use_name) == 0)
+        want_c_ptr = true;
+      else if (strcmp (c_interop_kinds_table[ISOCBINDING_NULL_FUNPTR].name,
+		       u->use_name) == 0)
+        want_c_funptr = true;
+      else if (strcmp (c_interop_kinds_table[ISOCBINDING_FUNLOC].name,
+		       u->use_name) == 0)
+        want_c_funptr = true;
+      else if (strcmp (c_interop_kinds_table[ISOCBINDING_PTR].name,
+                       u->use_name) == 0)
+	{
+	  c_ptr = generate_isocbinding_symbol (iso_c_module_name,
+                                               (iso_c_binding_symbol)
+							ISOCBINDING_PTR,
+                                               u->local_name[0] ? u->local_name
+                                                                : u->use_name,
+                                               NULL, false);
+	}
+      else if (strcmp (c_interop_kinds_table[ISOCBINDING_FUNPTR].name,
+                       u->use_name) == 0)
+	{
+	  c_funptr
+	     = generate_isocbinding_symbol (iso_c_module_name,
+					    (iso_c_binding_symbol)
+							ISOCBINDING_FUNPTR,
+					     u->local_name[0] ? u->local_name
+							      : u->use_name,
+					     NULL, false);
+	}
+    }
+
+  if ((want_c_ptr || !only_flag) && !c_ptr)
+    c_ptr = generate_isocbinding_symbol (iso_c_module_name,
+					 (iso_c_binding_symbol)
+							ISOCBINDING_PTR,
+					 NULL, NULL, only_flag);
+  if ((want_c_funptr || !only_flag) && !c_funptr)
+    c_funptr = generate_isocbinding_symbol (iso_c_module_name,
+					    (iso_c_binding_symbol)
+							ISOCBINDING_FUNPTR,
+					    NULL, NULL, only_flag);
+
   /* Generate the symbols for the named constants representing
      the kinds for intrinsic data types.  */
   for (i = 0; i < ISOCBINDING_NUMBER; i++)
@@ -5656,29 +5733,27 @@  import_iso_c_binding_module (void)
 		  not_in_std = (gfc_option.allow_std & d) == 0; \
 		  name = b; \
 		  break;
-#include "iso-c-binding.def"
-#undef NAMED_FUNCTION
+#define NAMED_SUBROUTINE(a,b,c,d) \
+	        case a: \
+		  not_in_std = (gfc_option.allow_std & d) == 0; \
+		  name = b; \
+		  break;
 #define NAMED_INTCST(a,b,c,d) \
 	        case a: \
 		  not_in_std = (gfc_option.allow_std & d) == 0; \
 		  name = b; \
 		  break;
-#include "iso-c-binding.def"
-#undef NAMED_INTCST
 #define NAMED_REALCST(a,b,c,d) \
 	        case a: \
 		  not_in_std = (gfc_option.allow_std & d) == 0; \
 		  name = b; \
 		  break;
-#include "iso-c-binding.def"
-#undef NAMED_REALCST
 #define NAMED_CMPXCST(a,b,c,d) \
 	        case a: \
 		  not_in_std = (gfc_option.allow_std & d) == 0; \
 		  name = b; \
 		  break;
 #include "iso-c-binding.def"
-#undef NAMED_CMPXCST
 		default:
 		  not_in_std = false;
 		  name = "";
@@ -5695,20 +5770,43 @@  import_iso_c_binding_module (void)
 	      {
 #define NAMED_FUNCTION(a,b,c,d) \
 	        case a: \
+		  if (a == ISOCBINDING_LOC) \
+		    return_type = c_ptr->n.sym; \
+		  else if (a == ISOCBINDING_FUNLOC) \
+		    return_type = c_funptr->n.sym; \
+		  else \
+		    return_type = NULL; \
+		  create_intrinsic_function (u->local_name[0] \
+					     ? u->local_name : u->use_name, \
+					     a, iso_c_module_name, \
+					     INTMOD_ISO_C_BINDING, false, \
+					     return_type); \
+		  break;
+#define NAMED_SUBROUTINE(a,b,c,d) \
+	        case a: \
 		  create_intrinsic_function (u->local_name[0] ? u->local_name \
 							      : u->use_name, \
-					     (gfc_isym_id) c, \
-                                             iso_c_module_name, \
-                                             INTMOD_ISO_C_BINDING); \
+                                             a, iso_c_module_name, \
+                                             INTMOD_ISO_C_BINDING, true, NULL); \
 		  break;
 #include "iso-c-binding.def"
-#undef NAMED_FUNCTION
 
+		case ISOCBINDING_PTR:
+		case ISOCBINDING_FUNPTR:
+		  /* Already handled above.  */
+		  break;
 		default:
+		  if (i == ISOCBINDING_NULL_PTR)
+		    tmp_symtree = c_ptr;
+		  else if (i == ISOCBINDING_NULL_FUNPTR)
+		    tmp_symtree = c_funptr;
+		  else
+		    tmp_symtree = NULL;
 		  generate_isocbinding_symbol (iso_c_module_name,
 					       (iso_c_binding_symbol) i,
-					       u->local_name[0] ? u->local_name
-								: u->use_name);
+					       u->local_name[0]
+					       ? u->local_name : u->use_name,
+					       tmp_symtree, false);
 	      }
 	  }
 
@@ -5722,30 +5820,27 @@  import_iso_c_binding_module (void)
 		if ((gfc_option.allow_std & d) == 0) \
 		  continue; \
 		break;
-#include "iso-c-binding.def"
-#undef NAMED_FUNCTION
-
+#define NAMED_SUBROUTINE(a,b,c,d) \
+	      case a: \
+		if ((gfc_option.allow_std & d) == 0) \
+		  continue; \
+		break;
 #define NAMED_INTCST(a,b,c,d) \
 	      case a: \
 		if ((gfc_option.allow_std & d) == 0) \
 		  continue; \
 		break;
-#include "iso-c-binding.def"
-#undef NAMED_INTCST
 #define NAMED_REALCST(a,b,c,d) \
 	      case a: \
 		if ((gfc_option.allow_std & d) == 0) \
 		  continue; \
 		break;
-#include "iso-c-binding.def"
-#undef NAMED_REALCST
 #define NAMED_CMPXCST(a,b,c,d) \
 	      case a: \
 		if ((gfc_option.allow_std & d) == 0) \
 		  continue; \
 		break;
 #include "iso-c-binding.def"
-#undef NAMED_CMPXCST
 	      default:
 		; /* Not GFC_STD_* versioned. */
 	    }
@@ -5754,16 +5849,37 @@  import_iso_c_binding_module (void)
 	    {
 #define NAMED_FUNCTION(a,b,c,d) \
 	      case a: \
-		create_intrinsic_function (b, (gfc_isym_id) c, \
-					   iso_c_module_name, \
-					   INTMOD_ISO_C_BINDING); \
+		if (a == ISOCBINDING_LOC) \
+		  return_type = c_ptr->n.sym; \
+		else if (a == ISOCBINDING_FUNLOC) \
+		  return_type = c_funptr->n.sym; \
+		else \
+		  return_type = NULL; \
+		create_intrinsic_function (b, a, iso_c_module_name, \
+					   INTMOD_ISO_C_BINDING, false, \
+					   return_type); \
+		break;
+#define NAMED_SUBROUTINE(a,b,c,d) \
+	      case a: \
+		create_intrinsic_function (b, a, iso_c_module_name, \
+					   INTMOD_ISO_C_BINDING, true, NULL); \
 		  break;
 #include "iso-c-binding.def"
-#undef NAMED_FUNCTION
 
+	      case ISOCBINDING_PTR:
+	      case ISOCBINDING_FUNPTR:
+		/* Already handled above.  */
+		break;
 	      default:
+		if (i == ISOCBINDING_NULL_PTR)
+		  tmp_symtree = c_ptr;
+		else if (i == ISOCBINDING_NULL_FUNPTR)
+		  tmp_symtree = c_funptr;
+		else
+		  tmp_symtree = NULL;
 		generate_isocbinding_symbol (iso_c_module_name,
-					     (iso_c_binding_symbol) i, NULL);
+					     (iso_c_binding_symbol) i, NULL,
+					     tmp_symtree, false);
 	    }
 	}
    }
@@ -5917,23 +6033,16 @@  use_iso_fortran_env_module (void)
 
   intmod_sym symbol[] = {
 #define NAMED_INTCST(a,b,c,d) { a, b, 0, d },
-#include "iso-fortran-env.def"
-#undef NAMED_INTCST
 #define NAMED_KINDARRAY(a,b,c,d) { a, b, 0, d },
-#include "iso-fortran-env.def"
-#undef NAMED_KINDARRAY
 #define NAMED_DERIVED_TYPE(a,b,c,d) { a, b, 0, d },
-#include "iso-fortran-env.def"
-#undef NAMED_DERIVED_TYPE
 #define NAMED_FUNCTION(a,b,c,d) { a, b, c, d },
+#define NAMED_SUBROUTINE(a,b,c,d) { a, b, c, d },
 #include "iso-fortran-env.def"
-#undef NAMED_FUNCTION
     { ISOFORTRANENV_INVALID, NULL, -1234, 0 } };
 
   i = 0;
 #define NAMED_INTCST(a,b,c,d) symbol[i++].value = c;
 #include "iso-fortran-env.def"
-#undef NAMED_INTCST
 
   /* Generate the symbol for the module itself.  */
   mod_symtree = gfc_find_symtree (gfc_current_ns->sym_root, mod);
@@ -5985,7 +6094,6 @@  use_iso_fortran_env_module (void)
 #define NAMED_INTCST(a,b,c,d) \
 		case a:
 #include "iso-fortran-env.def"
-#undef NAMED_INTCST
 		  create_int_parameter (u->local_name[0] ? u->local_name
 							 : u->use_name,
 					symbol[i].value, mod,
@@ -6008,7 +6116,6 @@  use_iso_fortran_env_module (void)
 					      symbol[i].id); \
 		  break;
 #include "iso-fortran-env.def"
-#undef NAMED_KINDARRAY
 
 #define NAMED_DERIVED_TYPE(a,b,TYPE,STD) \
 		case a:
@@ -6018,16 +6125,15 @@  use_iso_fortran_env_module (void)
 				       mod, INTMOD_ISO_FORTRAN_ENV,
 				       symbol[i].id);
 		  break;
-#undef NAMED_DERIVED_TYPE
 
 #define NAMED_FUNCTION(a,b,c,d) \
 		case a:
 #include "iso-fortran-env.def"
-#undef NAMED_FUNCTION
 		  create_intrinsic_function (u->local_name[0] ? u->local_name
 							      : u->use_name,
-					     (gfc_isym_id) symbol[i].value, mod,
-					     INTMOD_ISO_FORTRAN_ENV);
+					     symbol[i].id, mod,
+					     INTMOD_ISO_FORTRAN_ENV, false,
+					     NULL);
 		  break;
 
 		default:
@@ -6054,7 +6160,6 @@  use_iso_fortran_env_module (void)
 #define NAMED_INTCST(a,b,c,d) \
 	    case a:
 #include "iso-fortran-env.def"
-#undef NAMED_INTCST
 	      create_int_parameter (symbol[i].name, symbol[i].value, mod,
 				    INTMOD_ISO_FORTRAN_ENV, symbol[i].id);
 	      break;
@@ -6071,7 +6176,6 @@  use_iso_fortran_env_module (void)
                                         INTMOD_ISO_FORTRAN_ENV, symbol[i].id);\
             break;
 #include "iso-fortran-env.def"
-#undef NAMED_KINDARRAY
 
 #define NAMED_DERIVED_TYPE(a,b,TYPE,STD) \
 	  case a:
@@ -6079,15 +6183,13 @@  use_iso_fortran_env_module (void)
 	    create_derived_type (symbol[i].name, mod, INTMOD_ISO_FORTRAN_ENV,
 				 symbol[i].id);
 	    break;
-#undef NAMED_DERIVED_TYPE
 
 #define NAMED_FUNCTION(a,b,c,d) \
 		case a:
 #include "iso-fortran-env.def"
-#undef NAMED_FUNCTION
-		  create_intrinsic_function (symbol[i].name,
-					     (gfc_isym_id) symbol[i].value, mod,
-					     INTMOD_ISO_FORTRAN_ENV);
+		  create_intrinsic_function (symbol[i].name, symbol[i].id, mod,
+					     INTMOD_ISO_FORTRAN_ENV, false,
+					     NULL);
 		  break;
 
 	  default:
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index e9b6fb9..835b57f 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -520,7 +520,7 @@  static void
 find_arglists (gfc_symbol *sym)
 {
   if (sym->attr.if_source == IFSRC_UNKNOWN || sym->ns != gfc_current_ns
-      || sym->attr.flavor == FL_DERIVED)
+      || sym->attr.flavor == FL_DERIVED || sym->attr.intrinsic)
     return;
 
   resolve_formal_arglist (sym);
@@ -1038,23 +1038,6 @@  resolve_structure_cons (gfc_expr *expr, int init)
 
   cons = gfc_constructor_first (expr->value.constructor);
 
-  /* See if the user is trying to invoke a structure constructor for one of
-     the iso_c_binding derived types.  */
-  if (expr->ts.type == BT_DERIVED && expr->ts.u.derived
-      && expr->ts.u.derived->ts.is_iso_c && cons
-      && (cons->expr == NULL || cons->expr->expr_type != EXPR_NULL))
-    {
-      gfc_error ("Components of structure constructor '%s' at %L are PRIVATE",
-		 expr->ts.u.derived->name, &(expr->where));
-      return FAILURE;
-    }
-
-  /* Return if structure constructor is c_null_(fun)prt.  */
-  if (expr->ts.type == BT_DERIVED && expr->ts.u.derived
-      && expr->ts.u.derived->ts.is_iso_c && cons
-      && cons->expr && cons->expr->expr_type == EXPR_NULL)
-    return SUCCESS;
-
   /* A constructor may have references if it is the result of substituting a
      parameter variable.  In this case we just pull out the component we
      want.  */
@@ -1180,7 +1163,7 @@  resolve_structure_cons (gfc_expr *expr, int init)
 
       if (cons->expr->expr_type == EXPR_NULL
 	  && !(comp->attr.pointer || comp->attr.allocatable
-	       || comp->attr.proc_pointer
+	       || comp->attr.proc_pointer || comp->ts.f90_type == BT_VOID
 	       || (comp->ts.type == BT_CLASS
 		   && (CLASS_DATA (comp)->attr.class_pointer
 		       || CLASS_DATA (comp)->attr.allocatable))))
@@ -1562,12 +1545,20 @@  gfc_resolve_intrinsic (gfc_symbol *sym, locus *loc)
      gfc_find_subroutine directly to check whether it is a function or
      subroutine.  */
 
-  if (sym->intmod_sym_id)
-    isym = gfc_intrinsic_function_by_id ((gfc_isym_id) sym->intmod_sym_id);
+  if (sym->intmod_sym_id && sym->attr.subroutine)
+    {
+      gfc_isym_id id = gfc_isym_id_by_intmod_sym (sym);
+      isym = gfc_intrinsic_subroutine_by_id (id);
+    }
+  else if (sym->intmod_sym_id)
+    {
+      gfc_isym_id id = gfc_isym_id_by_intmod_sym (sym);
+      isym = gfc_intrinsic_function_by_id (id);
+    }
   else if (!sym->attr.subroutine)
     isym = gfc_find_function (sym->name);
 
-  if (isym)
+  if (isym && !sym->attr.subroutine)
     {
       if (sym->ts.type != BT_UNKNOWN && gfc_option.warn_surprising
 	  && !sym->attr.implicit_type)
@@ -1580,7 +1571,7 @@  gfc_resolve_intrinsic (gfc_symbol *sym, locus *loc)
 
       sym->ts = isym->ts;
     }
-  else if ((isym = gfc_find_subroutine (sym->name)))
+  else if (isym || (isym = gfc_find_subroutine (sym->name)))
     {
       if (sym->ts.type != BT_UNKNOWN && !sym->attr.implicit_type)
 	{
@@ -2719,366 +2710,6 @@  pure_stmt_function (gfc_expr *e, gfc_symbol *sym)
 }
 
 
-static gfc_try
-is_scalar_expr_ptr (gfc_expr *expr)
-{
-  gfc_try retval = SUCCESS;
-  gfc_ref *ref;
-  int start;
-  int end;
-
-  /* See if we have a gfc_ref, which means we have a substring, array
-     reference, or a component.  */
-  if (expr->ref != NULL)
-    {
-      ref = expr->ref;
-      while (ref->next != NULL)
-        ref = ref->next;
-
-      switch (ref->type)
-        {
-        case REF_SUBSTRING:
-          if (ref->u.ss.start == NULL || ref->u.ss.end == NULL
-	      || gfc_dep_compare_expr (ref->u.ss.start, ref->u.ss.end) != 0)
-	    retval = FAILURE;
-          break;
-
-        case REF_ARRAY:
-          if (ref->u.ar.type == AR_ELEMENT)
-            retval = SUCCESS;
-          else if (ref->u.ar.type == AR_FULL)
-            {
-              /* The user can give a full array if the array is of size 1.  */
-              if (ref->u.ar.as != NULL
-                  && ref->u.ar.as->rank == 1
-                  && ref->u.ar.as->type == AS_EXPLICIT
-                  && ref->u.ar.as->lower[0] != NULL
-                  && ref->u.ar.as->lower[0]->expr_type == EXPR_CONSTANT
-                  && ref->u.ar.as->upper[0] != NULL
-                  && ref->u.ar.as->upper[0]->expr_type == EXPR_CONSTANT)
-                {
-		  /* If we have a character string, we need to check if
-		     its length is one.	 */
-		  if (expr->ts.type == BT_CHARACTER)
-		    {
-		      if (expr->ts.u.cl == NULL
-			  || expr->ts.u.cl->length == NULL
-			  || mpz_cmp_si (expr->ts.u.cl->length->value.integer, 1)
-			  != 0)
-                        retval = FAILURE;
-		    }
-		  else
-		    {
-		      /* We have constant lower and upper bounds.  If the
-			 difference between is 1, it can be considered a
-			 scalar.
-			 FIXME: Use gfc_dep_compare_expr instead.  */
-		      start = (int) mpz_get_si
-				(ref->u.ar.as->lower[0]->value.integer);
-		      end = (int) mpz_get_si
-				(ref->u.ar.as->upper[0]->value.integer);
-		      if (end - start + 1 != 1)
-			retval = FAILURE;
-		   }
-                }
-              else
-                retval = FAILURE;
-            }
-          else
-            retval = FAILURE;
-          break;
-        default:
-          retval = SUCCESS;
-          break;
-        }
-    }
-  else if (expr->ts.type == BT_CHARACTER && expr->rank == 0)
-    {
-      /* Character string.  Make sure it's of length 1.  */
-      if (expr->ts.u.cl == NULL
-          || expr->ts.u.cl->length == NULL
-          || mpz_cmp_si (expr->ts.u.cl->length->value.integer, 1) != 0)
-        retval = FAILURE;
-    }
-  else if (expr->rank != 0)
-    retval = FAILURE;
-
-  return retval;
-}
-
-
-/* Match one of the iso_c_binding functions (c_associated or c_loc)
-   and, in the case of c_associated, set the binding label based on
-   the arguments.  */
-
-static gfc_try
-gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args,
-                          gfc_symbol **new_sym)
-{
-  char name[GFC_MAX_SYMBOL_LEN + 1];
-  int optional_arg = 0;
-  gfc_try retval = SUCCESS;
-  gfc_symbol *args_sym;
-  gfc_typespec *arg_ts;
-  symbol_attribute arg_attr;
-
-  if (args->expr->expr_type == EXPR_CONSTANT
-      || args->expr->expr_type == EXPR_OP
-      || args->expr->expr_type == EXPR_NULL)
-    {
-      gfc_error ("Argument to '%s' at %L is not a variable",
-		 sym->name, &(args->expr->where));
-      return FAILURE;
-    }
-
-  args_sym = args->expr->symtree->n.sym;
-
-  /* The typespec for the actual arg should be that stored in the expr
-     and not necessarily that of the expr symbol (args_sym), because
-     the actual expression could be a part-ref of the expr symbol.  */
-  arg_ts = &(args->expr->ts);
-  arg_attr = gfc_expr_attr (args->expr);
-
-  if (sym->intmod_sym_id == ISOCBINDING_ASSOCIATED)
-    {
-      /* If the user gave two args then they are providing something for
-	 the optional arg (the second cptr).  Therefore, set the name and
-	 binding label to the c_associated for two cptrs.  Otherwise,
-	 set c_associated to expect one cptr.  */
-      if (args->next)
-	{
-	  /* two args.  */
-	  sprintf (name, "%s_2", sym->name);
-	  optional_arg = 1;
-	}
-      else
-	{
-	  /* one arg.  */
-	  sprintf (name, "%s_1", sym->name);
-	  optional_arg = 0;
-	}
-
-      /* Get a new symbol for the version of c_associated that
-	 will get called.  */
-      *new_sym = get_iso_c_sym (sym, name, NULL, optional_arg);
-    }
-  else if (sym->intmod_sym_id == ISOCBINDING_LOC
-	   || sym->intmod_sym_id == ISOCBINDING_FUNLOC)
-    {
-      sprintf (name, "%s", sym->name);
-
-      /* Error check the call.  */
-      if (args->next != NULL)
-        {
-          gfc_error_now ("More actual than formal arguments in '%s' "
-                         "call at %L", name, &(args->expr->where));
-          retval = FAILURE;
-        }
-      else if (sym->intmod_sym_id == ISOCBINDING_LOC)
-        {
-	  gfc_ref *ref;
-	  bool seen_section;
-
-          /* Make sure we have either the target or pointer attribute.  */
-	  if (!arg_attr.target && !arg_attr.pointer)
-            {
-              gfc_error_now ("Parameter '%s' to '%s' at %L must be either "
-                             "a TARGET or an associated pointer",
-                             args_sym->name,
-                             sym->name, &(args->expr->where));
-              retval = FAILURE;
-            }
-
-	  if (gfc_is_coindexed (args->expr))
-	    {
-	      gfc_error_now ("Coindexed argument not permitted"
-			     " in '%s' call at %L", name,
-			     &(args->expr->where));
-	      retval = FAILURE;
-	    }
-
-	  /* Follow references to make sure there are no array
-	     sections.  */
-	  seen_section = false;
-
-	  for (ref=args->expr->ref; ref; ref = ref->next)
-	    {
-	      if (ref->type == REF_ARRAY)
-		{
-		  if (ref->u.ar.type == AR_SECTION)
-		    seen_section = true;
-
-		  if (ref->u.ar.type != AR_ELEMENT)
-		    {
-		      gfc_ref *r;
-		      for (r = ref->next; r; r=r->next)
-			if (r->type == REF_COMPONENT)
-			  {
-			    gfc_error_now ("Array section not permitted"
-					   " in '%s' call at %L", name,
-					   &(args->expr->where));
-			    retval = FAILURE;
-			    break;
-			  }
-		    }
-		}
-	    }
-
-	  if (seen_section && retval == SUCCESS)
-	    gfc_warning ("Array section in '%s' call at %L", name,
-			 &(args->expr->where));
-
-          /* See if we have interoperable type and type param.  */
-          if (gfc_verify_c_interop (arg_ts) == SUCCESS
-              || gfc_check_any_c_kind (arg_ts) == SUCCESS)
-            {
-              if (args_sym->attr.target == 1)
-                {
-                  /* Case 1a, section 15.1.2.5, J3/04-007: variable that
-                     has the target attribute and is interoperable.  */
-                  /* Case 1b, section 15.1.2.5, J3/04-007: allocated
-                     allocatable variable that has the TARGET attribute and
-                     is not an array of zero size.  */
-                  if (args_sym->attr.allocatable == 1)
-                    {
-                      if (args_sym->attr.dimension != 0
-                          && (args_sym->as && args_sym->as->rank == 0))
-                        {
-                          gfc_error_now ("Allocatable variable '%s' used as a "
-                                         "parameter to '%s' at %L must not be "
-                                         "an array of zero size",
-                                         args_sym->name, sym->name,
-                                         &(args->expr->where));
-                          retval = FAILURE;
-                        }
-                    }
-                  else
-		    {
-		      /* A non-allocatable target variable with C
-			 interoperable type and type parameters must be
-			 interoperable.	 */
-		      if (args_sym && args_sym->attr.dimension)
-			{
-			  if (args_sym->as->type == AS_ASSUMED_SHAPE)
-			    {
-			      gfc_error ("Assumed-shape array '%s' at %L "
-					 "cannot be an argument to the "
-					 "procedure '%s' because "
-					 "it is not C interoperable",
-					 args_sym->name,
-					 &(args->expr->where), sym->name);
-			      retval = FAILURE;
-			    }
-			  else if (args_sym->as->type == AS_DEFERRED)
-			    {
-			      gfc_error ("Deferred-shape array '%s' at %L "
-					 "cannot be an argument to the "
-					 "procedure '%s' because "
-					 "it is not C interoperable",
-					 args_sym->name,
-					 &(args->expr->where), sym->name);
-			      retval = FAILURE;
-			    }
-			}
-
-                      /* Make sure it's not a character string.  Arrays of
-                         any type should be ok if the variable is of a C
-                         interoperable type.  */
-		      if (arg_ts->type == BT_CHARACTER)
-			if (arg_ts->u.cl != NULL
-			    && (arg_ts->u.cl->length == NULL
-				|| arg_ts->u.cl->length->expr_type
-				   != EXPR_CONSTANT
-				|| mpz_cmp_si
-				    (arg_ts->u.cl->length->value.integer, 1)
-				   != 0)
-			    && is_scalar_expr_ptr (args->expr) != SUCCESS)
-			  {
-			    gfc_error_now ("CHARACTER argument '%s' to '%s' "
-					   "at %L must have a length of 1",
-					   args_sym->name, sym->name,
-					   &(args->expr->where));
-			    retval = FAILURE;
-			  }
-                    }
-                }
-              else if (arg_attr.pointer
-		       && is_scalar_expr_ptr (args->expr) != SUCCESS)
-                {
-                  /* Case 1c, section 15.1.2.5, J3/04-007: an associated
-                     scalar pointer.  */
-                  gfc_error_now ("Argument '%s' to '%s' at %L must be an "
-                                 "associated scalar POINTER", args_sym->name,
-                                 sym->name, &(args->expr->where));
-                  retval = FAILURE;
-                }
-            }
-          else
-            {
-              /* The parameter is not required to be C interoperable.  If it
-                 is not C interoperable, it must be a nonpolymorphic scalar
-                 with no length type parameters.  It still must have either
-                 the pointer or target attribute, and it can be
-                 allocatable (but must be allocated when c_loc is called).  */
-              if (args->expr->rank != 0
-                  && is_scalar_expr_ptr (args->expr) != SUCCESS)
-                {
-                  gfc_error_now ("Parameter '%s' to '%s' at %L must be a "
-                                 "scalar", args_sym->name, sym->name,
-                                 &(args->expr->where));
-                  retval = FAILURE;
-                }
-              else if (arg_ts->type == BT_CHARACTER
-                       && is_scalar_expr_ptr (args->expr) != SUCCESS)
-                {
-                  gfc_error_now ("CHARACTER argument '%s' to '%s' at "
-                                 "%L must have a length of 1",
-                                 args_sym->name, sym->name,
-                                 &(args->expr->where));
-                  retval = FAILURE;
-                }
-	      else if (arg_ts->type == BT_CLASS)
-		{
-		  gfc_error_now ("Parameter '%s' to '%s' at %L must not be "
-				 "polymorphic", args_sym->name, sym->name,
-				 &(args->expr->where));
-		  retval = FAILURE;
-		}
-            }
-        }
-      else if (sym->intmod_sym_id == ISOCBINDING_FUNLOC)
-        {
-          if (args_sym->attr.flavor != FL_PROCEDURE)
-            {
-              /* TODO: Update this error message to allow for procedure
-                 pointers once they are implemented.  */
-              gfc_error_now ("Argument '%s' to '%s' at %L must be a "
-                             "procedure",
-                             args_sym->name, sym->name,
-                             &(args->expr->where));
-              retval = FAILURE;
-            }
-	  else if (args_sym->attr.is_bind_c != 1
-		   && gfc_notify_std (GFC_STD_F2008_TS, "Noninteroperable "
-				      "argument '%s' to '%s' at %L",
-				      args_sym->name, sym->name,
-				      &(args->expr->where)) == FAILURE)
-	    retval = FAILURE;
-        }
-
-      /* for c_loc/c_funloc, the new symbol is the same as the old one */
-      *new_sym = sym;
-    }
-  else
-    {
-      gfc_internal_error ("gfc_iso_c_func_interface(): Unhandled "
-			  "iso_c_binding function: '%s'!\n", sym->name);
-    }
-
-  return retval;
-}
-
-
 /* Resolve a function call, which means resolving the arguments, then figuring
    out which entity the name refers to.  */
 
@@ -3141,19 +2772,6 @@  resolve_function (gfc_expr *expr)
 
   inquiry_argument = false;
 
-  /* Need to setup the call to the correct c_associated, depending on
-     the number of cptrs to user gives to compare.  */
-  if (sym && sym->attr.is_iso_c == 1)
-    {
-      if (gfc_iso_c_func_interface (sym, expr->value.function.actual, &sym)
-          == FAILURE)
-        return FAILURE;
-
-      /* Get the symtree for the new symbol (resolved func).
-         the old one will be freed later, when it's no longer used.  */
-      gfc_find_sym_tree (sym->name, sym->ns, 1, &(expr->symtree));
-    }
-
   /* Resume assumed_size checking.  */
   need_full_assumed_size--;
 
@@ -3236,6 +2854,7 @@  resolve_function (gfc_expr *expr)
 	   && GENERIC_ID != GFC_ISYM_LBOUND
 	   && GENERIC_ID != GFC_ISYM_LEN
 	   && GENERIC_ID != GFC_ISYM_LOC
+	   && GENERIC_ID != GFC_ISYM_C_LOC
 	   && GENERIC_ID != GFC_ISYM_PRESENT)
     {
       /* Array intrinsics must also have the last upper bound of an
@@ -3438,190 +3057,6 @@  generic:
 }
 
 
-/* Set the name and binding label of the subroutine symbol in the call
-   expression represented by 'c' to include the type and kind of the
-   second parameter.  This function is for resolving the appropriate
-   version of c_f_pointer() and c_f_procpointer().  For example, a
-   call to c_f_pointer() for a default integer pointer could have a
-   name of c_f_pointer_i4.  If no second arg exists, which is an error
-   for these two functions, it defaults to the generic symbol's name
-   and binding label.  */
-
-static void
-set_name_and_label (gfc_code *c, gfc_symbol *sym,
-                    char *name, const char **binding_label)
-{
-  gfc_expr *arg = NULL;
-  char type;
-  int kind;
-
-  /* The second arg of c_f_pointer and c_f_procpointer determines
-     the type and kind for the procedure name.  */
-  arg = c->ext.actual->next->expr;
-
-  if (arg != NULL)
-    {
-      /* Set up the name to have the given symbol's name,
-         plus the type and kind.  */
-      /* a derived type is marked with the type letter 'u' */
-      if (arg->ts.type == BT_DERIVED)
-        {
-          type = 'd';
-          kind = 0; /* set the kind as 0 for now */
-        }
-      else
-        {
-          type = gfc_type_letter (arg->ts.type);
-          kind = arg->ts.kind;
-        }
-
-      if (arg->ts.type == BT_CHARACTER)
-	/* Kind info for character strings not needed.	*/
-	kind = 0;
-
-      sprintf (name, "%s_%c%d", sym->name, type, kind);
-      /* Set up the binding label as the given symbol's label plus
-         the type and kind.  */
-      *binding_label = gfc_get_string ("%s_%c%d", sym->binding_label, type,
-				       kind);
-    }
-  else
-    {
-      /* If the second arg is missing, set the name and label as
-         was, cause it should at least be found, and the missing
-         arg error will be caught by compare_parameters().  */
-      sprintf (name, "%s", sym->name);
-      *binding_label = sym->binding_label;
-    }
-
-  return;
-}
-
-
-/* Resolve a generic version of the iso_c_binding procedure given
-   (sym) to the specific one based on the type and kind of the
-   argument(s).  Currently, this function resolves c_f_pointer() and
-   c_f_procpointer based on the type and kind of the second argument
-   (FPTR).  Other iso_c_binding procedures aren't specially handled.
-   Upon successfully exiting, c->resolved_sym will hold the resolved
-   symbol.  Returns MATCH_ERROR if an error occurred; MATCH_YES
-   otherwise.  */
-
-match
-gfc_iso_c_sub_interface (gfc_code *c, gfc_symbol *sym)
-{
-  gfc_symbol *new_sym;
-  /* this is fine, since we know the names won't use the max */
-  char name[GFC_MAX_SYMBOL_LEN + 1];
-  const char* binding_label;
-  /* default to success; will override if find error */
-  match m = MATCH_YES;
-
-  /* Make sure the actual arguments are in the necessary order (based on the
-     formal args) before resolving.  */
-  if (gfc_procedure_use (sym, &c->ext.actual, &(c->loc)) == FAILURE)
-    {
-      c->resolved_sym = sym;
-      return MATCH_ERROR;
-    }
-
-  if ((sym->intmod_sym_id == ISOCBINDING_F_POINTER) ||
-      (sym->intmod_sym_id == ISOCBINDING_F_PROCPOINTER))
-    {
-      set_name_and_label (c, sym, name, &binding_label);
-
-      if (sym->intmod_sym_id == ISOCBINDING_F_POINTER)
-	{
-	  if (c->ext.actual != NULL && c->ext.actual->next != NULL)
-	    {
-	      gfc_actual_arglist *arg1 = c->ext.actual;
-	      gfc_actual_arglist *arg2 = c->ext.actual->next;
-	      gfc_actual_arglist *arg3 = c->ext.actual->next->next;
-
-	      /* Check first argument (CPTR).  */
-	      if (arg1->expr->ts.type != BT_DERIVED
-		  || arg1->expr->ts.u.derived->intmod_sym_id != ISOCBINDING_PTR)
-		{
-		  gfc_error ("Argument CPTR to C_F_POINTER at %L shall have "
-			     "the type C_PTR", &arg1->expr->where);
-		  m = MATCH_ERROR;
-		}
-
-	      /* Check second argument (FPTR).  */
-	      if (arg2->expr->ts.type == BT_CLASS)
-		{
-		  gfc_error ("Argument FPTR to C_F_POINTER at %L must not be "
-			     "polymorphic", &arg2->expr->where);
-		  m = MATCH_ERROR;
-		}
-
-	      /* Make sure we got a third arg (SHAPE) if the second arg has
-		 non-zero rank. We must also check that the type and rank are
-		 correct since we short-circuit this check in
-		 gfc_procedure_use() (called above to sort actual args).  */
-	      if (arg2->expr->rank != 0)
-		{
-		  if (arg3 == NULL || arg3->expr == NULL)
-		    {
-		      m = MATCH_ERROR;
-		      gfc_error ("Missing SHAPE argument for call to %s at %L",
-				 sym->name, &c->loc);
-		    }
-		  else if (arg3->expr->ts.type != BT_INTEGER
-			   || arg3->expr->rank != 1)
-		    {
-		      m = MATCH_ERROR;
-		      gfc_error ("SHAPE argument for call to %s at %L must be "
-				 "a rank 1 INTEGER array", sym->name, &c->loc);
-		    }
-		}
-	    }
-	}
-      else /* ISOCBINDING_F_PROCPOINTER.  */
-	{
-	  if (c->ext.actual
-	      && (c->ext.actual->expr->ts.type != BT_DERIVED
-		  || c->ext.actual->expr->ts.u.derived->intmod_sym_id
-		     != ISOCBINDING_FUNPTR))
-	    {
-	      gfc_error ("Argument at %L to C_F_FUNPOINTER shall have the type "
-	                 "C_FUNPTR", &c->ext.actual->expr->where);
-              m = MATCH_ERROR;
-	    }
-	  if (c->ext.actual && c->ext.actual->next
-	      && !gfc_expr_attr (c->ext.actual->next->expr).is_bind_c
-	      && gfc_notify_std (GFC_STD_F2008_TS, "Noninteroperable "
-				 "procedure-pointer at %L to C_F_FUNPOINTER",
-				 &c->ext.actual->next->expr->where)
-		   == FAILURE)
-	    m = MATCH_ERROR;
-	}
-
-      if (m != MATCH_ERROR)
-	{
-	  /* the 1 means to add the optional arg to formal list */
-	  new_sym = get_iso_c_sym (sym, name, binding_label, 1);
-
-	  /* for error reporting, say it's declared where the original was */
-	  new_sym->declared_at = sym->declared_at;
-	}
-    }
-  else
-    {
-      /* no differences for c_loc or c_funloc */
-      new_sym = sym;
-    }
-
-  /* set the resolved symbol */
-  if (m != MATCH_ERROR)
-    c->resolved_sym = new_sym;
-  else
-    c->resolved_sym = sym;
-
-  return m;
-}
-
-
 /* Resolve a subroutine call known to be specific.  */
 
 static match
@@ -3629,12 +3064,6 @@  resolve_specific_s0 (gfc_code *c, gfc_symbol *sym)
 {
   match m;
 
-  if(sym->attr.is_iso_c)
-    {
-      m = gfc_iso_c_sub_interface (c,sym);
-      return m;
-    }
-
   if (sym->attr.external || sym->attr.if_source == IFSRC_IFBODY)
     {
       if (sym->attr.dummy)
@@ -8767,7 +8196,16 @@  resolve_transfer (gfc_code *code)
 	  return;
 	}
 
-      if (derived_inaccessible (ts->u.derived))
+      /* 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 (ts->u.derived->ts.f90_type == BT_VOID)
+	{
+	  if (gfc_notify_std (GFC_STD_GNU, "Data transfer element at %L cannot "
+			      "have PRIVATE components", &code->loc) == FAILURE)
+	    return;
+	}
+      else if (derived_inaccessible (ts->u.derived))
 	{
 	  gfc_error ("Data transfer element at %L cannot have "
 		     "PRIVATE components",&code->loc);
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index ef4076d..ec64231 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -3939,75 +3939,32 @@  verify_bind_c_derived_type (gfc_symbol *derived_sym)
 /* Generate symbols for the named constants c_null_ptr and c_null_funptr.  */
 
 static gfc_try
-gen_special_c_interop_ptr (int ptr_id, const char *ptr_name,
-                           const char *module_name)
+gen_special_c_interop_ptr (gfc_symbol *tmp_sym, gfc_symtree *dt_symtree)
 {
-  gfc_symtree *tmp_symtree;
-  gfc_symbol *tmp_sym;
   gfc_constructor *c;
 
-  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);
-    }
+  gcc_assert (tmp_sym && dt_symtree && dt_symtree->n.sym);
+  dt_symtree->n.sym->attr.referenced = 1;
 
-  tmp_sym->ts.is_c_interop = 1;
   tmp_sym->attr.is_c_interop = 1;
+  tmp_sym->attr.is_bind_c = 1;
+  tmp_sym->ts.is_c_interop = 1;
   tmp_sym->ts.is_iso_c = 1;
   tmp_sym->ts.type = BT_DERIVED;
+  tmp_sym->ts.f90_type = BT_VOID;
   tmp_sym->attr.flavor = FL_PARAMETER;
-
-  /* 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.u.derived = get_iso_c_binding_dt (ISOCBINDING_PTR);
-  else
-    tmp_sym->ts.u.derived = get_iso_c_binding_dt (ISOCBINDING_FUNPTR);
-  if (tmp_sym->ts.u.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,
-                                   (const char *) (ptr_id == ISOCBINDING_NULL_PTR 
-				   ? "c_ptr"
-				   : "c_funptr"));
-      tmp_sym->ts.u.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;
-  /* Since we never generate a call to this symbol, don't set the
-     binding_label.  */
+  tmp_sym->ts.u.derived = dt_symtree->n.sym;
   
   /* 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.f90_type = BT_VOID;
   tmp_sym->value->ts.u.derived = tmp_sym->ts.u.derived;
   gfc_constructor_append_expr (&tmp_sym->value->value.constructor, NULL, NULL);
   c = gfc_constructor_first (tmp_sym->value->value.constructor);
-  c->expr = gfc_get_expr ();
-  c->expr->expr_type = EXPR_NULL;
+  c->expr = gfc_get_int_expr (gfc_index_integer_kind, NULL, 0);
   c->expr->ts.is_iso_c = 1;
 
   return SUCCESS;
@@ -4040,200 +3997,6 @@  add_formal_arg (gfc_formal_arglist **head,
 }
 
 
-/* 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,
-                int iso_c_sym_id)
-{
-  gfc_symbol *param_sym = NULL;
-  gfc_symbol *c_ptr_sym = NULL;
-  gfc_symtree *param_symtree = NULL;
-  gfc_formal_arglist *formal_arg = NULL;
-  const char *c_ptr_in;
-  const char *c_ptr_type = NULL;
-
-  if (iso_c_sym_id == ISOCBINDING_F_PROCPOINTER)
-    c_ptr_type = "c_funptr";
-  else
-    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, false);
-  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 or c_funptr, no matter what it's name is 
-     (user renamed).  */
-  if (iso_c_sym_id == ISOCBINDING_F_PROCPOINTER)
-    c_ptr_sym = get_iso_c_binding_dt (ISOCBINDING_FUNPTR);
-  else
-    c_ptr_sym = get_iso_c_binding_dt (ISOCBINDING_PTR);
-  if (c_ptr_sym == NULL)
-    {
-      /* This can happen if the user did not define c_ptr but they are
-         trying to use one of the iso_c_binding functions that need it.  */
-      if (iso_c_sym_id == ISOCBINDING_F_PROCPOINTER)
-	generate_isocbinding_symbol (module_name, ISOCBINDING_FUNPTR,
-				     (const char *)c_ptr_type);
-      else
-	generate_isocbinding_symbol (module_name, ISOCBINDING_PTR,
-				     (const char *)c_ptr_type);
-
-      gfc_get_ha_symbol (c_ptr_type, &(c_ptr_sym));
-    }
-
-  param_sym->ts.u.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);
-
-  /* Validate changes.  */
-  gfc_commit_symbol (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, int proc)
-{
-  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, false);
-  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++;
-  if (proc)
-    param_sym->attr.proc_pointer = 1;
-  else
-    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);
-
-  /* Validate changes.  */
-  gfc_commit_symbol (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__";
-
-  if (shape_param_name != NULL)
-    shape_param = shape_param_name;
-
-  gfc_get_sym_tree (shape_param, ns, &param_symtree, false);
-  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.  Make it's
-     type BT_VOID initially so we can accept any type/kind combination of
-     integer.  During gfc_iso_c_sub_interface (resolve.c), we'll make it
-     of BT_INTEGER type.  */
-  param_sym->ts.type = BT_VOID;
-
-  /* Initialize the kind to default integer.  However, it will be overridden
-     during resolution to match the kind of the SHAPE parameter given as
-     the actual argument (to allow for any valid integer kind).  */
-  param_sym->ts.kind = gfc_default_integer_kind;
-  param_sym->as = gfc_get_array_spec ();
-
-  param_sym->as->rank = 1;
-  param_sym->as->lower[0] = gfc_get_int_expr (gfc_default_integer_kind,
-					      NULL, 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);
-
-  /* Validate changes.  */
-  gfc_commit_symbol (param_sym);
-}
-
-
 /* Add a procedure interface to the given symbol (i.e., store a
    reference to the list of formal arguments).  */
 
@@ -4314,74 +4077,6 @@  gfc_copy_formal_args_intr (gfc_symbol *dest, gfc_intrinsic_sym *src)
 }
 
 
-/* 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_PROCPOINTER)
-    {
-      gen_cptr_param (&head, &tail, (const char *) new_proc_sym->module,
-		      gfc_current_ns, "cptr", old_sym->intmod_sym_id);
-      gen_fptr_param (&head, &tail, (const char *) new_proc_sym->module,
-		      gfc_current_ns, "fptr", 1);
-    }
-  else if (old_sym->intmod_sym_id == ISOCBINDING_F_POINTER)
-    {
-      gen_cptr_param (&head, &tail, (const char *) new_proc_sym->module,
-		      gfc_current_ns, "cptr", old_sym->intmod_sym_id);
-      gen_fptr_param (&head, &tail, (const char *) new_proc_sym->module,
-		      gfc_current_ns, "fptr", 0);
-      /* If we're dealing with c_f_pointer, it has an optional third arg.  */
-      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", ISOCBINDING_ASSOCIATED);
-      if (add_optional_arg)
-	{
-	  gen_cptr_param (&head, &tail, (const char *) new_proc_sym->module,
-			  gfc_current_ns, "c_ptr_2", ISOCBINDING_ASSOCIATED);
-	  /* 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;
-}
-
 static int
 std_for_isocbinding_symbol (int id)
 {
@@ -4396,8 +4091,12 @@  std_for_isocbinding_symbol (int id)
 #define NAMED_FUNCTION(a,b,c,d) \
       case a:\
         return d;
+#define NAMED_SUBROUTINE(a,b,c,d) \
+      case a:\
+        return d;
 #include "iso-c-binding.def"
 #undef NAMED_FUNCTION
+#undef NAMED_SUBROUTINE
 
        default:
          return GFC_STD_F2003;
@@ -4412,23 +4111,29 @@  std_for_isocbinding_symbol (int id)
    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.  */
+   end of the list. For C_null_(fun)ptr, dt_symtree has to be set and
+   point to the symtree for c_(fun)ptr.  */
 
-
-void
+gfc_symtree *
 generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
-			     const char *local_name)
+			     const char *local_name, gfc_symtree *dt_symtree,
+			     bool hidden)
 {
-  const char *const name = (local_name && local_name[0]) ? local_name
-					     : c_interop_kinds_table[s].name;
-  gfc_symtree *tmp_symtree = NULL;
+  const char *const name = (local_name && local_name[0])
+			   ? local_name : c_interop_kinds_table[s].name;
+  gfc_symtree *tmp_symtree;
   gfc_symbol *tmp_sym = NULL;
   int index;
 
   if (gfc_notification_std (std_for_isocbinding_symbol (s)) == ERROR)
-    return;
+    return NULL;
 
   tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root, name);
+  if (hidden
+      && (!tmp_symtree || !tmp_symtree->n.sym
+	  || tmp_symtree->n.sym->from_intmod != INTMOD_ISO_C_BINDING
+	  || tmp_symtree->n.sym->intmod_sym_id != s))
+    tmp_symtree = NULL;
 
   /* Already exists in this scope so don't re-add it. */
   if (tmp_symtree != NULL && (tmp_sym = tmp_symtree->n.sym) != NULL
@@ -4446,21 +4151,40 @@  generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
   	  gfc_derived_types = dt_list;
         }
 
-      return;
+      return tmp_symtree;
     }
 
   /* Create the sym tree in the current ns.  */
-  gfc_get_sym_tree (name, gfc_current_ns, &tmp_symtree, false);
-  if (tmp_symtree)
-    tmp_sym = tmp_symtree->n.sym;
+  if (hidden)
+    {
+      tmp_symtree = gfc_get_unique_symtree (gfc_current_ns);
+      tmp_sym = gfc_new_symbol (name, gfc_current_ns);
+
+      /* Add to the list of tentative symbols.  */
+      latest_undo_chgset->syms.safe_push (tmp_sym);
+      tmp_sym->old_symbol = NULL;
+      tmp_sym->mark = 1;
+      tmp_sym->gfc_new = 1;
+
+      tmp_symtree->n.sym = tmp_sym;
+      tmp_sym->refs++;
+    }
   else
-    gfc_internal_error ("generate_isocbinding_symbol(): Unable to "
-			"create symbol");
+    {
+      gfc_get_sym_tree (name, gfc_current_ns, &tmp_symtree, false);
+      gcc_assert (tmp_symtree);
+      tmp_sym = tmp_symtree->n.sym;
+    }
 
   /* 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;
+  tmp_sym->attr.is_iso_c = 1;
+  tmp_sym->attr.use_assoc = 1;
+
+  gcc_assert (dt_symtree == NULL || s == ISOCBINDING_NULL_FUNPTR
+	      || s == ISOCBINDING_NULL_PTR);
 
   switch (s)
     {
@@ -4490,11 +4214,6 @@  generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
 	/* 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;
 
 
@@ -4531,70 +4250,69 @@  generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
 	/* 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:
 	{
-	  gfc_interface *intr, *head;
 	  gfc_symbol *dt_sym;
-	  const char *hidden_name;
 	  gfc_dt_list **dt_list_ptr = NULL;
 	  gfc_component *tmp_comp = NULL;
-	  char comp_name[(GFC_MAX_SYMBOL_LEN * 2) + 1];
-
-	  hidden_name = gfc_get_string ("%c%s",
-			    (char) TOUPPER ((unsigned char) tmp_sym->name[0]),
-                            &tmp_sym->name[1]);
 
 	  /* Generate real derived type.  */
-	  tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root,
-					  hidden_name);
-
-	  if (tmp_symtree != NULL)
-	    gcc_unreachable ();
-	  gfc_get_sym_tree (hidden_name, gfc_current_ns, &tmp_symtree, false);
-	  if (tmp_symtree)
-	    dt_sym = tmp_symtree->n.sym;
+	  if (hidden)
+	    dt_sym = tmp_sym;
 	  else
-	    gcc_unreachable ();
-
-	  /* Generate an artificial generic function.  */
-	  dt_sym->name = gfc_get_string (tmp_sym->name);
-	  head = tmp_sym->generic;
-	  intr = gfc_get_interface ();
-	  intr->sym = dt_sym;
-	  intr->where = gfc_current_locus;
-	  intr->next = head;
-	  tmp_sym->generic = intr;
-
-	  if (!tmp_sym->attr.generic
-	      && gfc_add_generic (&tmp_sym->attr, tmp_sym->name, NULL)
-		 == FAILURE)
-	    return;
-
-	  if (!tmp_sym->attr.function
-	      && gfc_add_function (&tmp_sym->attr, tmp_sym->name, NULL)
-		 == FAILURE)
-	    return;
+	    {
+	      const char *hidden_name;
+	      gfc_interface *intr, *head;
+
+	      hidden_name = gfc_get_string ("%c%s",
+					    (char) TOUPPER ((unsigned char)
+							      tmp_sym->name[0]),
+					    &tmp_sym->name[1]);
+	      tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root,
+					      hidden_name);
+	      gcc_assert (tmp_symtree == NULL);
+	      gfc_get_sym_tree (hidden_name, gfc_current_ns, &tmp_symtree, false);
+	      dt_sym = tmp_symtree->n.sym;
+	      dt_sym->name = gfc_get_string (s == ISOCBINDING_PTR
+					    ? "c_ptr" : "c_funptr");
+
+	      /* Generate an artificial generic function.  */
+	      head = tmp_sym->generic;
+	      intr = gfc_get_interface ();
+	      intr->sym = dt_sym;
+	      intr->where = gfc_current_locus;
+	      intr->next = head;
+	      tmp_sym->generic = intr;
+
+	      if (!tmp_sym->attr.generic
+		  && gfc_add_generic (&tmp_sym->attr, tmp_sym->name, NULL)
+		     == FAILURE)
+		return NULL;
+
+	      if (!tmp_sym->attr.function
+		  && gfc_add_function (&tmp_sym->attr, tmp_sym->name, NULL)
+		     == FAILURE)
+		return NULL;
+	    }
 
 	  /* Say what module this symbol belongs to.  */
 	  dt_sym->module = gfc_get_string (mod_name);
 	  dt_sym->from_intmod = INTMOD_ISO_C_BINDING;
 	  dt_sym->intmod_sym_id = s;
+          dt_sym->attr.use_assoc = 1;
 
 	  /* Initialize an integer constant expression node.  */
 	  dt_sym->attr.flavor = FL_DERIVED;
 	  dt_sym->ts.is_c_interop = 1;
 	  dt_sym->attr.is_c_interop = 1;
-	  dt_sym->attr.is_iso_c = 1;
+	  dt_sym->attr.private_comp = 1;
+	  dt_sym->component_access = ACCESS_PRIVATE;
 	  dt_sym->ts.is_iso_c = 1;
 	  dt_sym->ts.type = BT_DERIVED;
+	  dt_sym->ts.f90_type = BT_VOID;
 
 	  /* A derived type must have the bind attribute to be
 	     interoperable (J3/04-007, Section 15.2.3), even though
@@ -4617,15 +4335,9 @@  generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
 	  (*dt_list_ptr)->derived = dt_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", dt_sym->name, "c_address");
-	  gfc_add_component (dt_sym, comp_name, &tmp_comp);
+	  gfc_add_component (dt_sym, "c_address", &tmp_comp);
 	  if (tmp_comp == NULL)
-          gfc_internal_error ("generate_isocbinding_symbol(): Unable to "
-			      "create component for c_address");
+	    gcc_unreachable ();
 
 	  tmp_comp->ts.type = BT_INTEGER;
 
@@ -4635,163 +4347,24 @@  generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
 	  /* 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->attr.pointer = 0;
-	  tmp_comp->attr.dimension = 0;
+	  tmp_comp->attr.access = ACCESS_PRIVATE;
 
 	  /* Mark the component as C interoperable.  */
 	  tmp_comp->ts.is_c_interop = 1;
-
-	  /* Make it use associated (iso_c_binding module).  */
-	  dt_sym->attr.use_assoc = 1;
 	}
 
 	break;
 
       case ISOCBINDING_NULL_PTR:
       case ISOCBINDING_NULL_FUNPTR:
-        gen_special_c_interop_ptr (s, name, mod_name);
+        gen_special_c_interop_ptr (tmp_sym, dt_symtree);
         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.  */
-	tmp_sym->binding_label = 
-	  gfc_get_string ("%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.u.derived =
-                    get_iso_c_binding_dt (ISOCBINDING_PTR);
-                else
-                  tmp_sym->ts.u.derived =
-                    get_iso_c_binding_dt (ISOCBINDING_FUNPTR);
-
-		if (tmp_sym->ts.u.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_PTR,
-		      (const char *)(s == ISOCBINDING_FUNLOC
-				? "c_funptr" : "c_ptr"));
-                    tmp_sym->ts.u.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.pure = 1;
-		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 ();
     }
   gfc_commit_symbol (tmp_sym);
-}
-
-
-/* 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,
-               const 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.  */
-  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);
-  new_symtree->n.sym->from_intmod = old_sym->from_intmod;
-  new_symtree->n.sym->intmod_sym_id = old_sym->intmod_sym_id;
-  if (old_sym->attr.function)
-    new_symtree->n.sym->result = new_symtree->n.sym;
-  /* 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;
+  return tmp_symtree;
 }
 
 
diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c
index caad1b4..7633516 100644
--- a/gcc/fortran/target-memory.c
+++ b/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.");
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 2c3ff1f..06afc4f 100644
--- a/gcc/fortran/trans-expr.c
+++ b/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;
         }
     }
 
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index a2bb2a7..9b2cc19 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/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;
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 9394810..d60d15f 100644
--- a/gcc/fortran/trans-io.c
+++ b/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;
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index cdac0da..4f4c058 100644
--- a/gcc/fortran/trans-types.c
+++ b/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;
diff --git a/gcc/testsuite/gfortran.dg/blockdata_7.f90 b/gcc/testsuite/gfortran.dg/blockdata_7.f90
new file mode 100644
index 0000000..b7de964
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/blockdata_7.f90
@@ -0,0 +1,16 @@ 
+! { 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
diff --git a/gcc/testsuite/gfortran.dg/c_assoc_2.f03 b/gcc/testsuite/gfortran.dg/c_assoc_2.f03
index 4b3b796..275e88e 100644
--- a/gcc/testsuite/gfortran.dg/c_assoc_2.f03
+++ b/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
diff --git a/gcc/testsuite/gfortran.dg/c_assoc_4.f90 b/gcc/testsuite/gfortran.dg/c_assoc_4.f90
new file mode 100644
index 0000000..5421a36
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_assoc_4.f90
@@ -0,0 +1,14 @@ 
+! { 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
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_shape_test.f90 b/gcc/testsuite/gfortran.dg/c_f_pointer_shape_test.f90
index f27730a..9b130ad 100644
--- a/gcc/testsuite/gfortran.dg/c_f_pointer_shape_test.f90
+++ b/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
 
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_3.f03 b/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_3.f03
index 31fd938..632e457 100644
--- a/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_3.f03
+++ b/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
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_tests_5.f90 b/gcc/testsuite/gfortran.dg/c_f_pointer_tests_5.f90
index 05a3d8b..5194e40 100644
--- a/gcc/testsuite/gfortran.dg/c_f_pointer_tests_5.f90
+++ b/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
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_tests_6.f90 b/gcc/testsuite/gfortran.dg/c_f_pointer_tests_6.f90
new file mode 100644
index 0000000..6dc4397
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_tests_6.f90
@@ -0,0 +1,43 @@ 
+! { 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
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_tests_7.f90 b/gcc/testsuite/gfortran.dg/c_f_pointer_tests_7.f90
new file mode 100644
index 0000000..8cabd18
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_tests_7.f90
@@ -0,0 +1,9 @@ 
+! { 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
diff --git a/gcc/testsuite/gfortran.dg/c_funloc_tests_2.f03 b/gcc/testsuite/gfortran.dg/c_funloc_tests_2.f03
index d3ed265..4db7bcc 100644
--- a/gcc/testsuite/gfortran.dg/c_funloc_tests_2.f03
+++ b/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
diff --git a/gcc/testsuite/gfortran.dg/c_funloc_tests_5.f03 b/gcc/testsuite/gfortran.dg/c_funloc_tests_5.f03
index f3fdb2b..ae321a9 100644
--- a/gcc/testsuite/gfortran.dg/c_funloc_tests_5.f03
+++ b/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() 
diff --git a/gcc/testsuite/gfortran.dg/c_funloc_tests_6.f90 b/gcc/testsuite/gfortran.dg/c_funloc_tests_6.f90
index 13ca9d9..1a7f036 100644
--- a/gcc/testsuite/gfortran.dg/c_funloc_tests_6.f90
+++ b/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
diff --git a/gcc/testsuite/gfortran.dg/c_funloc_tests_8.f90 b/gcc/testsuite/gfortran.dg/c_funloc_tests_8.f90
new file mode 100644
index 0000000..1650a79
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_funloc_tests_8.f90
@@ -0,0 +1,49 @@ 
+! { 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
diff --git a/gcc/testsuite/gfortran.dg/c_loc_test_17.f90 b/gcc/testsuite/gfortran.dg/c_loc_test_17.f90
new file mode 100644
index 0000000..4c2a7d6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_test_17.f90
@@ -0,0 +1,28 @@ 
+! { 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
diff --git a/gcc/testsuite/gfortran.dg/c_loc_test_18.f90 b/gcc/testsuite/gfortran.dg/c_loc_test_18.f90
new file mode 100644
index 0000000..b854200
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_test_18.f90
@@ -0,0 +1,21 @@ 
+! { 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
diff --git a/gcc/testsuite/gfortran.dg/c_loc_test_19.f90 b/gcc/testsuite/gfortran.dg/c_loc_test_19.f90
new file mode 100644
index 0000000..a667eaf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_test_19.f90
@@ -0,0 +1,17 @@ 
+! { 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
diff --git a/gcc/testsuite/gfortran.dg/c_loc_test_20.f90 b/gcc/testsuite/gfortran.dg/c_loc_test_20.f90
new file mode 100644
index 0000000..4ff0ca1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_test_20.f90
@@ -0,0 +1,34 @@ 
+! { 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
+
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_10.f03 b/gcc/testsuite/gfortran.dg/c_loc_tests_10.f03
index 867ba18..21cbe0b 100644
--- a/gcc/testsuite/gfortran.dg/c_loc_tests_10.f03
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_10.f03
@@ -1,8 +1,9 @@ 
 ! { 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
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_11.f03 b/gcc/testsuite/gfortran.dg/c_loc_tests_11.f03
index 197666d..b8e6d84 100644
--- a/gcc/testsuite/gfortran.dg/c_loc_tests_11.f03
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_11.f03
@@ -1,4 +1,6 @@ 
 ! { 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
 
     
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_15.f90 b/gcc/testsuite/gfortran.dg/c_loc_tests_15.f90
index 63f8816..c8d5868 100644
--- a/gcc/testsuite/gfortran.dg/c_loc_tests_15.f90
+++ b/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
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_16.f90 b/gcc/testsuite/gfortran.dg/c_loc_tests_16.f90
index 1c86a1f..2c074e8 100644
--- a/gcc/testsuite/gfortran.dg/c_loc_tests_16.f90
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_16.f90
@@ -1,5 +1,5 @@ 
 ! { 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
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_17.f90 b/gcc/testsuite/gfortran.dg/c_loc_tests_17.f90
new file mode 100644
index 0000000..5e4eb8a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_17.f90
@@ -0,0 +1,14 @@ 
+! { 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
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_3.f03 b/gcc/testsuite/gfortran.dg/c_loc_tests_3.f03
index 95eac4a..0cd56a6 100644
--- a/gcc/testsuite/gfortran.dg/c_loc_tests_3.f03
+++ b/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
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_4.f03 b/gcc/testsuite/gfortran.dg/c_loc_tests_4.f03
index 8453ec7..1f28d3e 100644
--- a/gcc/testsuite/gfortran.dg/c_loc_tests_4.f03
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_4.f03
@@ -1,4 +1,6 @@ 
 ! { 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
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_8.f03 b/gcc/testsuite/gfortran.dg/c_loc_tests_8.f03
index a094d69..4a4e73e 100644
--- a/gcc/testsuite/gfortran.dg/c_loc_tests_8.f03
+++ b/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
 
diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests_13.f03 b/gcc/testsuite/gfortran.dg/c_ptr_tests_13.f03
index c7a603b..020b057 100644
--- a/gcc/testsuite/gfortran.dg/c_ptr_tests_13.f03
+++ b/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
diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests_14.f90 b/gcc/testsuite/gfortran.dg/c_ptr_tests_14.f90
index 946c4dd..2bf4262 100644
--- a/gcc/testsuite/gfortran.dg/c_ptr_tests_14.f90
+++ b/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" } }
diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests_15.f90 b/gcc/testsuite/gfortran.dg/c_ptr_tests_15.f90
index 9959d62..dec2e8e 100644
--- a/gcc/testsuite/gfortran.dg/c_ptr_tests_15.f90
+++ b/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" } }
diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests_9.f03 b/gcc/testsuite/gfortran.dg/c_ptr_tests_9.f03
index 8fff547..5a32553 100644
--- a/gcc/testsuite/gfortran.dg/c_ptr_tests_9.f03
+++ b/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
 
diff --git a/gcc/testsuite/gfortran.dg/c_sizeof_1.f90 b/gcc/testsuite/gfortran.dg/c_sizeof_1.f90
index e0ac06f..4a8385b 100644
--- a/gcc/testsuite/gfortran.dg/c_sizeof_1.f90
+++ b/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)
diff --git a/gcc/testsuite/gfortran.dg/c_sizeof_5.f90 b/gcc/testsuite/gfortran.dg/c_sizeof_5.f90
new file mode 100644
index 0000000..127a24a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_sizeof_5.f90
@@ -0,0 +1,12 @@ 
+! { 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
diff --git a/gcc/testsuite/gfortran.dg/iso_c_binding_init_expr.f03 b/gcc/testsuite/gfortran.dg/iso_c_binding_init_expr.f03
index 0a00996..45eaa5c 100644
--- a/gcc/testsuite/gfortran.dg/iso_c_binding_init_expr.f03
+++ b/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
diff --git a/gcc/testsuite/gfortran.dg/iso_c_binding_rename_3.f90 b/gcc/testsuite/gfortran.dg/iso_c_binding_rename_3.f90
new file mode 100644
index 0000000..bbe17cb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iso_c_binding_rename_3.f90
@@ -0,0 +1,23 @@ 
+! { 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
diff --git a/gcc/testsuite/gfortran.dg/pr32601.f03 b/gcc/testsuite/gfortran.dg/pr32601.f03
index 6fa275e..a4048cc 100644
--- a/gcc/testsuite/gfortran.dg/pr32601.f03
+++ b/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
diff --git a/gcc/testsuite/gfortran.dg/pr32601_1.f03 b/gcc/testsuite/gfortran.dg/pr32601_1.f03
index 3e9aa73..a297e17 100644
--- a/gcc/testsuite/gfortran.dg/pr32601_1.f03
+++ b/gcc/testsuite/gfortran.dg/pr32601_1.f03
@@ -1,10 +1,12 @@ 
 ! { 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
diff --git a/gcc/testsuite/gfortran.dg/storage_size_2.f08 b/gcc/testsuite/gfortran.dg/storage_size_2.f08
index 82913c8..ba8bd22 100644
--- a/gcc/testsuite/gfortran.dg/storage_size_2.f08
+++ b/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" }
diff --git a/gcc/testsuite/gfortran.dg/transfer_resolve_2.f90 b/gcc/testsuite/gfortran.dg/transfer_resolve_2.f90
new file mode 100644
index 0000000..b6c5ddd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_resolve_2.f90
@@ -0,0 +1,14 @@ 
+! { 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
diff --git a/gcc/testsuite/gfortran.dg/transfer_resolve_3.f90 b/gcc/testsuite/gfortran.dg/transfer_resolve_3.f90
new file mode 100644
index 0000000..f3a58e2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_resolve_3.f90
@@ -0,0 +1,20 @@ 
+! { 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" } }
+