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

login
register
mail settings
Submitter Tobias Burnus
Date March 23, 2013, 9:59 a.m.
Message ID <20130323095856.GA20419@physik.fu-berlin.de>
Download mbox | patch
Permalink /patch/230323/
State New
Headers show

Comments

Tobias Burnus - March 23, 2013, 9:59 a.m.
Dear all,

initially, I only wanted to allow assumed-rank arrays with C_LOC, even if I played with the idea to cleanup the intrinsic handling of the ISO_C_Binding module for quite some time. But Mikael rejected a hacky version.

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).

Build and regtested on x86-64-gnu-linux.
OK for the trunk?


Follow-up tasks:

* Implement Fortran 2008's IS_CONTIGUOUS intrinsic, add a gfc_is_not_contiguous function (has various use: to simplify that intrinsic, for error checks in c_loc, to make copy-out unconditional etc.). Plus fixing some issues with gfc_is_simply_contiguous (e.g. BT_CLASS is unhandled, but there are more issues). See PR38536, gfortran.dg/c_loc_tests_16.f90 (w/o -std=f2008) and probably more PRs.

* Implement compile-time simplification of (c_)sizeof; required for MPICH. See PR 46641, 36437, 56650

* Cleanup and bug fixes related to BIND(C) procedures, including some of the new TS29113 features and F2008. (Full support requires the new array descriptor)

* Other C binding issues, e.g. having multiple interfaces for the same binding name or fixing binding-name issues with COMMON. And a bunch of other issues, including ICEs.

* New array descriptor / Other TS29113 tasks

(None of those rank top on my to-do list.)

Tobias

PS: What I like about the patch is that it reduces the number of code lines, brings Bind(C) code into line with the rest of gfortran and (hopefully) fixes some bugs, improves diagnostic and lifts some restrictions (new F2008/TS29113 features).
gcc/fortran directory:  16 files changed, 1035 insertions(+), 1417 deletions(-)
Mikael Morin - March 23, 2013, 9:41 p.m.
Hello,

Le 23/03/2013 10:59, Tobias Burnus a écrit :
> Dear all,
> 
> initially, I only wanted to allow assumed-rank arrays with C_LOC, even if I played with the idea to cleanup the intrinsic handling of the ISO_C_Binding module for quite some time. But Mikael rejected a hacky version.
>
Did I? Never mind, the rejection proves fruitful in the end.  :-)

> 
> 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).
> 

> 2013-03-22  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
Really impressive. You can also add PR 55574 to the list (test case
attached).


There is one thing in the patch I'm uncomfortable with, namely:

> @@ -4192,7 +4245,11 @@ 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)
> +    isym = gfc_intrinsic_subroutine_by_id ((gfc_isym_id)
> +					c->symtree->n.sym->intmod_sym_id);
Err... an iso_c_binding_symbol id is a different thing from a
gfc_isym_id id; isn't it?

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

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



Otherwise, looks good. The usual nits below.

Mikael

> diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
> index 0e71b95..28172fc 100644
> --- a/gcc/fortran/check.c
> +++ b/gcc/fortran/check.c
> @@ -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.


> @@ -3621,17 +3624,389 @@ gfc_check_sizeof (gfc_expr *arg)
>  }
>  
>  
> +/* 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?
Something like:
"when returning false, MSG is set to a string telling why the expression
is not interoperable, which can be used in diagnostics"

I think full sentences should be used for MSG, to avoid getting
confusing messages like the following (and to help translation):
"'foo' argument of 'bar' intrinsic at (1) must be an interoperable data
entity: deferred-length string"
thus:
"expression shall not be a deferred-length string"
instead of
"deferred-length string"

same for "Extension to use non-C_Bool-kind LOGICAL", "Extension:
Non-C_CHAR-kind CHARACTER"

[...]

> +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->intmod_sym_id != ISOCBINDING_PTR
> +	  && c_ptr_1->ts.u.derived->intmod_sym_id != ISOCBINDING_FUNPTR))
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. ;-)

There are several instances of this with c_associated, c_f_pointer, etc.




> diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
> index 1b38555..8a92386 100644
> --- a/gcc/fortran/module.c
> +++ b/gcc/fortran/module.c

> @@ -5695,20 +5767,60 @@ import_iso_c_binding_module (void)
>  	      {
>  #define NAMED_FUNCTION(a,b,c,d) \
>  	        case a: \
> +		  if (a == ISOCBINDING_LOC) \
> +		    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, false, \
> +					       c_ptr->n.sym); \
> +		  else if (a == ISOCBINDING_FUNLOC) \
> +		    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, false, \
> +					       c_funptr->n.sym); \
> +		  else \
> +		    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, false, NULL); \
> +		  break;
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);


>  		default:
> -		  generate_isocbinding_symbol (iso_c_module_name,
> -					       (iso_c_binding_symbol) i,
> -					       u->local_name[0] ? u->local_name
> -								: u->use_name);
> +		  if (i == ISOCBINDING_NULL_PTR)
> +		    generate_isocbinding_symbol (iso_c_module_name,
> +						 (iso_c_binding_symbol) i,
> +						 u->local_name[0]
> +						 ? u->local_name : u->use_name,
> +						 c_ptr, false);
> +		  else if (i == ISOCBINDING_NULL_FUNPTR)
> +		    generate_isocbinding_symbol (iso_c_module_name,
> +						 (iso_c_binding_symbol) i,
> +						 u->local_name[0]
> +						 ? u->local_name : u->use_name,
> +						 c_funptr, false);
> +		  else
> +		    generate_isocbinding_symbol (iso_c_module_name,
> +						 (iso_c_binding_symbol) i,
> +						 u->local_name[0]
> +						 ? u->local_name : u->use_name,
> +						 NULL, false);
Ditto here...


> @@ -5754,16 +5863,47 @@ import_iso_c_binding_module (void)
>  	    {
>  #define NAMED_FUNCTION(a,b,c,d) \
>  	      case a: \
> +		if (a == ISOCBINDING_LOC) \
> +		  create_intrinsic_function (b, (gfc_isym_id) c, \
> +					     iso_c_module_name, \
> +					     INTMOD_ISO_C_BINDING, false, \
> +					     c_ptr->n.sym); \
> +		else if (a == ISOCBINDING_FUNLOC) \
> +		  create_intrinsic_function (b, (gfc_isym_id) c, \
> +					     iso_c_module_name, \
> +					     INTMOD_ISO_C_BINDING, false, \
> +					     c_funptr->n.sym); \
> +		else \
> +		  create_intrinsic_function (b, (gfc_isym_id) c, \
> +					     iso_c_module_name, \
> +					     INTMOD_ISO_C_BINDING, false, \
> +					     NULL); \
> +		  break;
...and here...


>  	      default:
> -		generate_isocbinding_symbol (iso_c_module_name,
> -					     (iso_c_binding_symbol) i, NULL);
> +		if (i == ISOCBINDING_NULL_PTR)
> +		  generate_isocbinding_symbol (iso_c_module_name,
> +					       (iso_c_binding_symbol) i, NULL,
> +					       c_ptr, false);
> +		else if (i == ISOCBINDING_NULL_FUNPTR)
> +		  generate_isocbinding_symbol (iso_c_module_name,
> +					       (iso_c_binding_symbol) i, NULL,
> +					       c_funptr, false);
> +	        else
> +		  generate_isocbinding_symbol (iso_c_module_name,
> +					       (iso_c_binding_symbol) i, NULL,
> +					       NULL, false);
... and here.



> diff --git a/gcc/testsuite/gfortran.dg/blockdata_7.f90 b/gcc/testsuite/gfortran.dg/blockdata_7.f90
> new file mode 100644
> index 0000000..16329c3
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/blockdata_7.f90
> @@ -0,0 +1,16 @@
> +! { dg-compile }
dg-do compile


> 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..19393c8
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/c_f_pointer_tests_6.f90
> @@ -0,0 +1,43 @@
> +! { dg-compile }
dg-do compile
! { 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

Patch

2013-03-22  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.
	* 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.
	* 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.
	* 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-22  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
	* gfortran.dg/c_assoc_4.f90
	* gfortran.dg/c_f_pointer_tests_6.f90
	* gfortran.dg/c_f_pointer_tests_7.f90
	* gfortran.dg/c_funloc_tests_8.f90
	* gfortran.dg/c_loc_test_17.f90
	* gfortran.dg/c_loc_test_18.f90
	* gfortran.dg/c_loc_test_19.f90
	* gfortran.dg/c_loc_test_20.f90
	* gfortran.dg/c_sizeof_5.f90
	* gfortran.dg/iso_c_binding_rename_3.f90
	* gfortran.dg/transfer_resolve_2.f90


 gcc/fortran/check.c             | 383 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 gcc/fortran/expr.c              |  47 +++++++---
 gcc/fortran/gfortran.h          |  16 +++-
 gcc/fortran/intrinsic.c         |  67 +++++++++++++-
 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            | 217 +++++++++++++++++++++++++++++++++++---------
 gcc/fortran/resolve.c           | 574 ++-----------------------------------------------------------------------------------------------------------------
 gcc/fortran/symbol.c            | 613 +++++++++++++++++++--------------------------------------------------------------------------------------------------------
 gcc/fortran/target-memory.c     |   3 +
 gcc/fortran/trans-expr.c        | 238 +-----------------------------------------------
 gcc/fortran/trans-intrinsic.c   | 214 +++++++++++++++++++++++++++++++++++++++++++
 gcc/fortran/trans-io.c          |   5 +-
 gcc/fortran/trans-types.c       |  17 ++--
 16 files changed, 1035 insertions(+), 1417 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 ++++++++++++++
 gcc/testsuite/gfortran.dg/c_f_pointer_shape_test.f90    |  2 +-
 gcc/testsuite/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             | 27 +++++++++++++++++++++++++++
 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_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_14.f90            |  6 ++++--
 gcc/testsuite/gfortran.dg/c_ptr_tests_15.f90            |  6 ++++--
 gcc/testsuite/gfortran.dg/c_sizeof_1.f90                | 11 ++++++-----
 gcc/testsuite/gfortran.dg/c_sizeof_5.f90                | 12 ++++++++++++
 gcc/testsuite/gfortran.dg/iso_c_binding_init_expr.f03   |  4 ++--
 gcc/testsuite/gfortran.dg/iso_c_binding_rename_3.f90    | 23 +++++++++++++++++++++++
 gcc/testsuite/gfortran.dg/pr32601_1.f03                 |  2 +-
 gcc/testsuite/gfortran.dg/storage_size_2.f08            |  4 ++--
 gcc/testsuite/gfortran.dg/transfer_resolve_2.f90        | 14 ++++++++++++++
 32 files changed, 334 insertions(+), 45 deletions(-)

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 0e71b95..28172fc 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -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;
+
       if (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);
 	  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)
 	return 1;
@@ -3621,17 +3624,389 @@  gfc_check_sizeof (gfc_expr *arg)
 }
 
 
+/* 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).  */
+
+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 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: 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 = "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->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_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->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->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..c992945 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 != GFC_ISYM_COMPILER_OPTIONS
+	  && e->symtree->n.sym->intmod_sym_id != GFC_ISYM_COMPILER_VERSION)
+	return MATCH_NO;
+
+      if (e->symtree->n.sym->from_intmod == INTMOD_ISO_C_BINDING
+	  && e->symtree->n.sym->intmod_sym_id != GFC_ISYM_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 = gfc_current_ns;
+
+	      for (ns = gfc_current_ns; ns; ns = ns->parent)
+		if (sym == gfc_current_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..9c966b0 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,7 @@  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);
 
 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..6e1e15b 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -811,6 +811,24 @@  find_sym (gfc_intrinsic_sym *start, int n, const char *name)
 
 
 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)
 {
   gfc_intrinsic_sym *start = functions;
@@ -2652,9 +2670,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 +3093,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,
@@ -4105,12 +4158,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 +4245,11 @@  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)
+    isym = gfc_intrinsic_subroutine_by_id ((gfc_isym_id)
+					   c->symtree->n.sym->intmod_sym_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..8a92386 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -5571,7 +5571,8 @@  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)
+			   const char *modname, intmod_id module,
+			   bool subroutine, gfc_symbol *result_type)
 {
   gfc_intrinsic_sym *isym;
   gfc_symtree *tmp_symtree;
@@ -5588,7 +5589,27 @@  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)
+    {
+      isym = gfc_intrinsic_subroutine_by_id (id);
+      sym->attr.subroutine = 1;
+    }
+  else
+    {
+      isym = gfc_intrinsic_function_by_id (id);
+      sym->attr.function = 1;
+      if (result_type)
+	{
+	  sym->ts.type = BT_DERIVED;
+	  isym->ts.f90_type = BT_VOID;
+	  sym->ts.u.derived = result_type;
+	  sym->ts.is_c_interop = 1;
+	  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;
@@ -5614,6 +5635,8 @@  import_iso_c_binding_module (void)
   const char *iso_c_module_name = "__iso_c_binding";
   gfc_use_rename *u;
   int i;
+  bool want_c_ptr = false, want_c_funptr = false;
+  gfc_symtree *c_ptr = NULL, *c_funptr = NULL;
 
   /* Look only in the current namespace.  */
   mod_symtree = gfc_find_symtree (gfc_current_ns->sym_root, iso_c_module_name);
@@ -5636,6 +5659,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 +5730,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 +5767,60 @@  import_iso_c_binding_module (void)
 	      {
 #define NAMED_FUNCTION(a,b,c,d) \
 	        case a: \
+		  if (a == ISOCBINDING_LOC) \
+		    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, false, \
+					       c_ptr->n.sym); \
+		  else if (a == ISOCBINDING_FUNLOC) \
+		    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, false, \
+					       c_funptr->n.sym); \
+		  else \
+		    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, false, NULL); \
+		  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); \
+                                             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:
-		  generate_isocbinding_symbol (iso_c_module_name,
-					       (iso_c_binding_symbol) i,
-					       u->local_name[0] ? u->local_name
-								: u->use_name);
+		  if (i == ISOCBINDING_NULL_PTR)
+		    generate_isocbinding_symbol (iso_c_module_name,
+						 (iso_c_binding_symbol) i,
+						 u->local_name[0]
+						 ? u->local_name : u->use_name,
+						 c_ptr, false);
+		  else if (i == ISOCBINDING_NULL_FUNPTR)
+		    generate_isocbinding_symbol (iso_c_module_name,
+						 (iso_c_binding_symbol) i,
+						 u->local_name[0]
+						 ? u->local_name : u->use_name,
+						 c_funptr, false);
+		  else
+		    generate_isocbinding_symbol (iso_c_module_name,
+						 (iso_c_binding_symbol) i,
+						 u->local_name[0]
+						 ? u->local_name : u->use_name,
+						 NULL, false);
 	      }
 	  }
 
@@ -5722,30 +5834,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 +5863,47 @@  import_iso_c_binding_module (void)
 	    {
 #define NAMED_FUNCTION(a,b,c,d) \
 	      case a: \
+		if (a == ISOCBINDING_LOC) \
+		  create_intrinsic_function (b, (gfc_isym_id) c, \
+					     iso_c_module_name, \
+					     INTMOD_ISO_C_BINDING, false, \
+					     c_ptr->n.sym); \
+		else if (a == ISOCBINDING_FUNLOC) \
+		  create_intrinsic_function (b, (gfc_isym_id) c, \
+					     iso_c_module_name, \
+					     INTMOD_ISO_C_BINDING, false, \
+					     c_funptr->n.sym); \
+		else \
+		  create_intrinsic_function (b, (gfc_isym_id) c, \
+					     iso_c_module_name, \
+					     INTMOD_ISO_C_BINDING, false, \
+					     NULL); \
+		  break;
+#define NAMED_SUBROUTINE(a,b,c,d) \
+	      case a: \
 		create_intrinsic_function (b, (gfc_isym_id) c, \
 					   iso_c_module_name, \
-					   INTMOD_ISO_C_BINDING); \
+					   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:
-		generate_isocbinding_symbol (iso_c_module_name,
-					     (iso_c_binding_symbol) i, NULL);
+		if (i == ISOCBINDING_NULL_PTR)
+		  generate_isocbinding_symbol (iso_c_module_name,
+					       (iso_c_binding_symbol) i, NULL,
+					       c_ptr, false);
+		else if (i == ISOCBINDING_NULL_FUNPTR)
+		  generate_isocbinding_symbol (iso_c_module_name,
+					       (iso_c_binding_symbol) i, NULL,
+					       c_funptr, false);
+	        else
+		  generate_isocbinding_symbol (iso_c_module_name,
+					       (iso_c_binding_symbol) i, NULL,
+					       NULL, false);
 	    }
 	}
    }
@@ -5917,23 +6057,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 +6118,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 +6140,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 +6149,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);
+					     INTMOD_ISO_FORTRAN_ENV, false,
+					     NULL);
 		  break;
 
 		default:
@@ -6054,7 +6184,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 +6200,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 +6207,14 @@  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);
+					     INTMOD_ISO_FORTRAN_ENV, false,
+					     NULL);
 		  break;
 
 	  default:
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index e9b6fb9..f14c898 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);
@@ -1562,12 +1562,14 @@  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)
+  if (sym->intmod_sym_id && sym->attr.subroutine)
+    isym = gfc_intrinsic_subroutine_by_id ((gfc_isym_id) sym->intmod_sym_id);
+  else if (sym->intmod_sym_id)
     isym = gfc_intrinsic_function_by_id ((gfc_isym_id) sym->intmod_sym_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 +1582,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 +2721,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 +2783,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 +2865,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 +3068,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 +3075,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)
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index ef4076d..86c47d7 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -3939,70 +3939,28 @@  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);
@@ -4040,200 +3998,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 +4078,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 +4092,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 +4112,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 +4152,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 +4215,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,57 +4251,53 @@  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);
@@ -4592,9 +4308,10 @@  generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
 	  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->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 +4334,10 @@  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");
+	    gfc_internal_error ("generate_isocbinding_symbol(): Unable to "
+				"create component for c_address");
 
 	  tmp_comp->ts.type = BT_INTEGER;
 
@@ -4641,157 +4353,20 @@  generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
 
 	  /* 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..faeee0d 100644
--- a/gcc/fortran/target-memory.c
+++ b/gcc/fortran/target-memory.c
@@ -316,6 +316,9 @@  gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer,
 	}
 
     case BT_DERIVED:
+      if (source->ts.u.derived->ts.f90_type == BT_VOID)
+	return encode_integer (gfc_index_integer_kind, source->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..27525bb 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -2037,9 +2037,8 @@  transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code)
 	  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..16329c3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/blockdata_7.f90
@@ -0,0 +1,16 @@ 
+! { dg-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..19393c8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_tests_6.f90
@@ -0,0 +1,43 @@ 
+! { dg-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..4657cba
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_test_17.f90
@@ -0,0 +1,27 @@ 
+! { dg-do compile }
+!
+! 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..70079d1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_test_18.f90
@@ -0,0 +1,21 @@ 
+! { dg-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_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_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_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_1.f03 b/gcc/testsuite/gfortran.dg/pr32601_1.f03
index 3e9aa73..40a26f2 100644
--- a/gcc/testsuite/gfortran.dg/pr32601_1.f03
+++ b/gcc/testsuite/gfortran.dg/pr32601_1.f03
@@ -5,6 +5,6 @@  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