 gcc/fortran/decl.c                                 |  23 -
 gcc/fortran/expr.c                                 |   8 +-
 gcc/fortran/gfortran.h                             |  31 +-
 gcc/fortran/interface.c                            |  15 +
 gcc/fortran/trans-array.c                          | 119 ++++
 gcc/fortran/trans-array.h                          |  13 +
 gcc/fortran/trans-decl.c                           | 624 ++++++++++++++++-----
 gcc/fortran/trans-expr.c                           | 572 ++++++++++++++-----
 gcc/fortran/trans-stmt.c                           |  44 +-
 gcc/fortran/trans-types.c                          | 105 +++-
 gcc/fortran/trans-types.h                          |   3 +-
 gcc/fortran/trans.c                                |  11 +-
 gcc/fortran/trans.h                                |   2 -
 .../gfortran.dg/ISO_Fortran_binding_4.f90          |  22 +-
 gcc/testsuite/gfortran.dg/PR93963.f90              |  94 +++-
 gcc/testsuite/gfortran.dg/assumed_type_12.f90      |  35 ++
 gcc/testsuite/gfortran.dg/bind-c-intent-out.f90    |   9 +-
 .../gfortran.dg/bind_c_array_params_2.f90          |  30 +-
 gcc/testsuite/gfortran.dg/bind_c_char_10.f90       |  25 +-
 libgfortran/runtime/ISO_Fortran_binding.c          |   4 +
 20 files changed, 1402 insertions(+), 387 deletions(-)

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 05081c40f1e..ff098bf6fae 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1584,15 +1584,6 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
 					    sym->name, &sym->declared_at,
 					    sym->ns->proc_name->name))
 		    retval = false;
-		  else if (!sym->attr.dimension)
-		    {
-		      /* FIXME: Use CFI array descriptor for scalars.  */
-		      gfc_error ("Sorry, deferred-length scalar character dummy "
-				 "argument %qs at %L of procedure %qs with "
-				 "BIND(C) not yet supported", sym->name,
-				 &sym->declared_at, sym->ns->proc_name->name);
-		      retval = false;
-		    }
 		}
 	      else if (sym->attr.value
 		       && (!cl || !cl->length
@@ -1614,20 +1605,6 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
 				      "attribute", sym->name, &sym->declared_at,
 				      sym->ns->proc_name->name))
 		    retval = false;
-		  else if (!sym->attr.dimension
-			   || sym->as->type == AS_ASSUMED_SIZE
-			   || sym->as->type == AS_EXPLICIT)
-		    {
-		      /* FIXME: Valid - should use the CFI array descriptor, but
-			 not yet handled for scalars and assumed-/explicit-size
-			 arrays.  */
-		      gfc_error ("Sorry, character dummy argument %qs at %L "
-				 "with assumed length is not yet supported for "
-				 "procedure %qs with BIND(C) attribute",
-				 sym->name, &sym->declared_at,
-				 sym->ns->proc_name->name);
-		      retval = false;
-		    }
 		}
 	      else if (cl->length->expr_type != EXPR_CONSTANT)
 		{
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 35563a78697..0560f5b8c43 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -1078,11 +1078,13 @@ is_CFI_desc (gfc_symbol *sym, gfc_expr *e)
 
   if (sym && sym->attr.dummy
       && sym->ns->proc_name->attr.is_bind_c
-      && sym->attr.dimension
       && (sym->attr.pointer
 	  || sym->attr.allocatable
-	  || sym->as->type == AS_ASSUMED_SHAPE
-	  || sym->as->type == AS_ASSUMED_RANK))
+	  || (sym->attr.dimension
+	      && (sym->as->type == AS_ASSUMED_SHAPE
+		  || sym->as->type == AS_ASSUMED_RANK))
+	  || (sym->ts.type == BT_CHARACTER
+	      && (!sym->ts.u.cl || !sym->ts.u.cl->length))))
     return true;
 
 return false;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 48cdcdf6cb8..b6ac5d307b2 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -48,7 +48,6 @@ not after.
    libgfortran/libgfortran_frontend.h  */
 #include "libgfortran.h"
 
-
 #include "intl.h"
 #include "splay-tree.h"
 
@@ -105,6 +104,36 @@ typedef struct
 }
 mstring;
 
+/* ISO_Fortran_binding.h
+   CAUTION: This has to be kept in sync with libgfortran.  */
+
+#define CFI_type_kind_shift 8
+#define CFI_type_from_type_kind(t, k) (t + (k << CFI_type_kind_shift))
+
+/* Constants, defined as macros. */
+#define CFI_VERSION 1
+#define CFI_MAX_RANK 15
+
+/* Attributes. */
+#define CFI_attribute_pointer 0
+#define CFI_attribute_allocatable 1
+#define CFI_attribute_other 2
+
+#define CFI_type_mask 0xFF
+#define CFI_type_kind_shift 8
+
+/* Intrinsic types. Their kind number defines their storage size. */
+#define CFI_type_Integer 1
+#define CFI_type_Logical 2
+#define CFI_type_Real 3
+#define CFI_type_Complex 4
+#define CFI_type_Character 5
+
+/* Types with no kind. */
+#define CFI_type_struct 6
+#define CFI_type_cptr 7
+#define CFI_type_cfunptr 8
+#define CFI_type_other -1
 
 
 /*************************** Enums *****************************/
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 9e3e8aa9da9..d49f71d31f6 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -2448,6 +2448,21 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
       return false;
     }
 
+  /* F2018, C711.  */
+  if (actual->ts.type == BT_ASSUMED
+      && formal->attr.dimension
+      && formal->as->type == AS_ASSUMED_RANK
+      && (!actual->symtree->n.sym->attr.dimension
+	  || (actual->symtree->n.sym->as->type != AS_ASSUMED_RANK
+	      && actual->symtree->n.sym->as->type != AS_ASSUMED_SHAPE)))
+    {
+      if (where)
+	gfc_error ("Assumed-type actual argument at %L must be of assumed rank"
+		   " or assumed shape as dummy argument %qs has assumed rank",
+		   &actual->where, formal->name);
+      return false;
+    }
+
   /* F2008, 12.5.2.5; IR F08/0073.  */
   if (formal->ts.type == BT_CLASS && formal->attr.class_ok
       && actual->expr_type != EXPR_NULL
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 0d013defdbb..543de55bdb2 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -103,6 +103,111 @@ gfc_array_dataptr_type (tree desc)
   return (GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc)));
 }
 
+/* Build expressions to access members of the CFI descriptor.  */
+#define CFI_FIELD_BASE_ADDR 0
+#define CFI_FIELD_ELEM_LEN 1
+#define CFI_FIELD_VERSION 2
+#define CFI_FIELD_RANK 3
+#define CFI_FIELD_ATTRIBUTE 4
+#define CFI_FIELD_TYPE 5
+#define CFI_FIELD_DIM 6
+
+#define CFI_DIM_FIELD_LOWER_BOUND 0
+#define CFI_DIM_FIELD_EXTENT 1
+#define CFI_DIM_FIELD_SM 2
+
+static tree
+gfc_get_cfi_descriptor_field (tree desc, unsigned field_idx)
+{
+  tree type = TREE_TYPE (desc);
+  gcc_assert (TREE_CODE (type) == RECORD_TYPE
+	      && TYPE_FIELDS (type)
+	      && (strcmp ("base_addr",
+			 IDENTIFIER_POINTER (DECL_NAME (TYPE_FIELDS (type))))
+		  == 0));
+  tree field = gfc_advance_chain (TYPE_FIELDS (type), field_idx);
+  gcc_assert (field != NULL_TREE);
+
+  return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
+			  desc, field, NULL_TREE);
+}
+
+tree
+gfc_get_cfi_desc_base_addr (tree desc)
+{
+  return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_BASE_ADDR);
+}
+
+tree
+gfc_get_cfi_desc_elem_len (tree desc)
+{
+  return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_ELEM_LEN);
+}
+
+tree
+gfc_get_cfi_desc_version (tree desc)
+{
+  return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_VERSION);
+}
+
+tree
+gfc_get_cfi_desc_rank (tree desc)
+{
+  return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_RANK);
+}
+
+tree
+gfc_get_cfi_desc_type (tree desc)
+{
+  return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_TYPE);
+}
+
+tree
+gfc_get_cfi_desc_attribute (tree desc)
+{
+  return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_ATTRIBUTE);
+}
+
+static tree
+gfc_get_cfi_dim_item (tree desc, tree idx, unsigned field_idx)
+{
+  tree tmp = gfc_get_cfi_descriptor_field (desc, CFI_FIELD_DIM);
+  tmp = gfc_build_array_ref (tmp, idx, NULL);
+  tree field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp)), field_idx);
+  gcc_assert (field != NULL_TREE);
+  return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
+			  tmp, field, NULL_TREE);
+}
+
+tree
+gfc_get_cfi_dim_lbound (tree desc, tree idx)
+{
+  return gfc_get_cfi_dim_item (desc, idx, CFI_DIM_FIELD_LOWER_BOUND);
+}
+
+tree
+gfc_get_cfi_dim_extent (tree desc, tree idx)
+{
+  return gfc_get_cfi_dim_item (desc, idx, CFI_DIM_FIELD_EXTENT);
+}
+
+tree
+gfc_get_cfi_dim_sm (tree desc, tree idx)
+{
+  return gfc_get_cfi_dim_item (desc, idx, CFI_DIM_FIELD_SM);
+}
+
+#undef CFI_FIELD_BASE_ADDR
+#undef CFI_FIELD_ELEM_LEN
+#undef CFI_FIELD_VERSION
+#undef CFI_FIELD_RANK
+#undef CFI_FIELD_ATTRIBUTE
+#undef CFI_FIELD_TYPE
+#undef CFI_FIELD_DIM
+
+#undef CFI_DIM_FIELD_LOWER_BOUND
+#undef CFI_DIM_FIELD_EXTENT
+#undef CFI_DIM_FIELD_SM
 
 /* Build expressions to access the members of an array descriptor.
    It's surprisingly easy to mess up here, so never access
@@ -288,6 +393,20 @@ gfc_conv_descriptor_attribute (tree desc)
 			  dtype, tmp, NULL_TREE);
 }
 
+tree
+gfc_conv_descriptor_type (tree desc)
+{
+  tree tmp;
+  tree dtype;
+
+  dtype = gfc_conv_descriptor_dtype (desc);
+  tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_TYPE);
+  gcc_assert (tmp!= NULL_TREE
+	      && TREE_TYPE (tmp) == signed_char_type_node);
+  return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
+			  dtype, tmp, NULL_TREE);
+}
+
 tree
 gfc_get_descriptor_dimension (tree desc)
 {
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index e4d443d7118..f60ee7a377a 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -173,6 +173,7 @@ tree gfc_conv_descriptor_dtype (tree);
 tree gfc_conv_descriptor_rank (tree);
 tree gfc_conv_descriptor_elem_len (tree);
 tree gfc_conv_descriptor_attribute (tree);
+tree gfc_conv_descriptor_type (tree);
 tree gfc_get_descriptor_dimension (tree);
 tree gfc_conv_descriptor_stride_get (tree, tree);
 tree gfc_conv_descriptor_lbound_get (tree, tree);
@@ -186,6 +187,18 @@ void gfc_conv_descriptor_stride_set (stmtblock_t *, tree, tree, tree);
 void gfc_conv_descriptor_lbound_set (stmtblock_t *, tree, tree, tree);
 void gfc_conv_descriptor_ubound_set (stmtblock_t *, tree, tree, tree);
 
+/* CFI descriptor.  */
+tree gfc_get_cfi_desc_base_addr (tree);
+tree gfc_get_cfi_desc_elem_len (tree);
+tree gfc_get_cfi_desc_version (tree);
+tree gfc_get_cfi_desc_rank (tree);
+tree gfc_get_cfi_desc_type (tree);
+tree gfc_get_cfi_desc_attribute (tree);
+tree gfc_get_cfi_dim_lbound (tree, tree);
+tree gfc_get_cfi_dim_extent (tree, tree);
+tree gfc_get_cfi_dim_sm (tree, tree);
+
+
 /* Shift lower bound of descriptor, updating ubound and offset.  */
 void gfc_conv_shift_descriptor_lbound (stmtblock_t*, tree, int, tree);
 
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index bed61e2325d..84e601a7457 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -117,8 +117,6 @@ tree gfor_fndecl_fdate;
 tree gfor_fndecl_ttynam;
 tree gfor_fndecl_in_pack;
 tree gfor_fndecl_in_unpack;
-tree gfor_fndecl_cfi_to_gfc;
-tree gfor_fndecl_gfc_to_cfi;
 tree gfor_fndecl_associated;
 tree gfor_fndecl_system_clock4;
 tree gfor_fndecl_system_clock8;
@@ -1548,6 +1546,14 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 	      || (sym->module && sym->attr.if_source != IFSRC_DECL
 		  && sym->backend_decl));
 
+  if (sym->attr.dummy && sym->ns->proc_name->attr.is_bind_c
+      && is_CFI_desc (sym, NULL))
+    {
+      gcc_assert (sym->backend_decl && (sym->ts.type != BT_CHARACTER
+					|| sym->ts.u.cl->backend_decl));
+      return sym->backend_decl;
+    }
+
   if (sym->ns && sym->ns->proc_name && sym->ns->proc_name->attr.function)
     byref = gfc_return_by_reference (sym->ns->proc_name);
   else
@@ -1595,9 +1601,6 @@ gfc_get_symbol_decl (gfc_symbol * sym)
       sym->ts.u.cl->backend_decl = build_fold_indirect_ref (sym->ts.u.cl->backend_decl);
     }
 
-  if (is_CFI_desc (sym, NULL))
-    gfc_defer_symbol_init (sym);
-
   fun_or_res = byref && (sym->attr.result
 			 || (sym->attr.function && sym->ts.deferred));
   if ((sym->attr.dummy && ! sym->attr.function) || fun_or_res)
@@ -2755,9 +2758,19 @@ create_function_arglist (gfc_symbol * sym)
       if (f->sym->attr.volatile_)
 	type = build_qualified_type (type, TYPE_QUAL_VOLATILE);
 
-      /* Build the argument declaration.  */
-      parm = build_decl (input_location,
-			 PARM_DECL, gfc_sym_identifier (f->sym), type);
+      /* Build the argument declaration. For C descriptors, we use a
+	 '_'-prefixed name as the decl inside the proc uses the
+	 sym->name. */
+      tree parm_name;
+      if (sym->attr.is_bind_c && is_CFI_desc (f->sym, NULL))
+	{
+	  strcpy (&name[1], f->sym->name);
+	  name[0] = '_';
+	  parm_name = get_identifier (name);
+	}
+      else
+	parm_name = gfc_sym_identifier (f->sym);
+      parm = build_decl (input_location, PARM_DECL, parm_name, type);
 
       if (f->sym->attr.volatile_)
 	{
@@ -3834,19 +3847,6 @@ gfc_build_builtin_function_decls (void)
 	get_identifier (PREFIX("internal_unpack")), ". w R ",
 	void_type_node, 2, pvoid_type_node, pvoid_type_node);
 
-  /* These two builtins write into what the first argument points to and
-     read from what the second argument points to, but we can't use R
-     for that, because the directly pointed structure contains a pointer
-     which is copied into the descriptor pointed by the first argument,
-     effectively escaping that way.  See PR92123.  */
-  gfor_fndecl_cfi_to_gfc = gfc_build_library_function_decl_with_spec (
-	get_identifier (PREFIX("cfi_desc_to_gfc_desc")), ". w . ",
-	void_type_node, 2, pvoid_type_node, ppvoid_type_node);
-
-  gfor_fndecl_gfc_to_cfi = gfc_build_library_function_decl_with_spec (
-	get_identifier (PREFIX("gfc_desc_to_cfi_desc")), ". w . ",
-	void_type_node, 2, ppvoid_type_node, pvoid_type_node);
-
   gfor_fndecl_associated = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("associated")), ". R R ",
 	integer_type_node, 2, ppvoid_type_node, ppvoid_type_node);
@@ -4464,115 +4464,6 @@ gfc_null_and_pass_deferred_len (gfc_symbol *sym, stmtblock_t *init,
 }
 
 
-/* Convert CFI descriptor dummies into gfc types and back again.  */
-static void
-convert_CFI_desc (gfc_wrapped_block * block, gfc_symbol *sym)
-{
-  tree gfc_desc;
-  tree gfc_desc_ptr;
-  tree CFI_desc;
-  tree CFI_desc_ptr;
-  tree dummy_ptr;
-  tree tmp;
-  tree present;
-  tree incoming;
-  tree outgoing;
-  stmtblock_t outer_block;
-  stmtblock_t tmpblock;
-
-  /* dummy_ptr will be the pointer to the passed array descriptor,
-     while CFI_desc is the descriptor itself.  */
-  if (DECL_LANG_SPECIFIC (sym->backend_decl))
-    CFI_desc = GFC_DECL_SAVED_DESCRIPTOR (sym->backend_decl);
-  else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (sym->backend_decl))))
-    CFI_desc = sym->backend_decl;
-  else
-    CFI_desc = NULL;
-
-  dummy_ptr = CFI_desc;
-
-  if (CFI_desc)
-    {
-      CFI_desc = build_fold_indirect_ref_loc (input_location, CFI_desc);
-
-      /* The compiler will have given CFI_desc the correct gfortran
-	 type. Use this new variable to store the converted
-	 descriptor.  */
-      gfc_desc = gfc_create_var (TREE_TYPE (CFI_desc), "gfc_desc");
-      tmp = build_pointer_type (TREE_TYPE (gfc_desc));
-      gfc_desc_ptr = gfc_create_var (tmp, "gfc_desc_ptr");
-      CFI_desc_ptr = gfc_create_var (pvoid_type_node, "CFI_desc_ptr");
-
-      /* Fix the condition for the presence of the argument.  */
-      gfc_init_block (&outer_block);
-      present = fold_build2_loc (input_location, NE_EXPR,
-				 logical_type_node, dummy_ptr,
-				 build_int_cst (TREE_TYPE (dummy_ptr), 0));
-
-      gfc_init_block (&tmpblock);
-      /* Pointer to the gfc descriptor.  */
-      gfc_add_modify (&tmpblock, gfc_desc_ptr,
-		      gfc_build_addr_expr (NULL, gfc_desc));
-      /* Store the pointer to the CFI descriptor.  */
-      gfc_add_modify (&tmpblock, CFI_desc_ptr,
-		      fold_convert (pvoid_type_node, dummy_ptr));
-      tmp = gfc_build_addr_expr (ppvoid_type_node, CFI_desc_ptr);
-      /* Convert the CFI descriptor.  */
-      incoming = build_call_expr_loc (input_location,
-			gfor_fndecl_cfi_to_gfc, 2, gfc_desc_ptr, tmp);
-      gfc_add_expr_to_block (&tmpblock, incoming);
-      /* Set the dummy pointer to point to the gfc_descriptor.  */
-      gfc_add_modify (&tmpblock, dummy_ptr,
-		      fold_convert (TREE_TYPE (dummy_ptr), gfc_desc_ptr));
-
-      /* The hidden string length is not passed to bind(C) procedures so set
-	 it from the descriptor element length.  */
-      if (sym->ts.type == BT_CHARACTER
-	  && sym->ts.u.cl->backend_decl
-	  && VAR_P (sym->ts.u.cl->backend_decl))
-	{
-	  tmp = build_fold_indirect_ref_loc (input_location, dummy_ptr);
-	  tmp = gfc_conv_descriptor_elem_len (tmp);
-	  gfc_add_modify (&tmpblock, sym->ts.u.cl->backend_decl,
-			  fold_convert (TREE_TYPE (sym->ts.u.cl->backend_decl),
-				        tmp));
-	}
-
-      /* Check that the argument is present before executing the above.  */
-      incoming = build3_v (COND_EXPR, present,
-			   gfc_finish_block (&tmpblock),
-			   build_empty_stmt (input_location));
-      gfc_add_expr_to_block (&outer_block, incoming);
-      incoming = gfc_finish_block (&outer_block);
-
-      /* Convert the gfc descriptor back to the CFI type before going
-	 out of scope, if the CFI type was present at entry.  */
-      outgoing = NULL_TREE;
-      if ((sym->attr.pointer || sym->attr.allocatable)
-	  && !sym->attr.value
-	  && sym->attr.intent != INTENT_IN)
-	{
-	  gfc_init_block (&outer_block);
-	  gfc_init_block (&tmpblock);
-
-	  tmp = gfc_build_addr_expr (ppvoid_type_node, CFI_desc_ptr);
-	  outgoing = build_call_expr_loc (input_location,
-					  gfor_fndecl_gfc_to_cfi, 2,
-					  tmp, gfc_desc_ptr);
-	  gfc_add_expr_to_block (&tmpblock, outgoing);
-
-	  outgoing = build3_v (COND_EXPR, present,
-			       gfc_finish_block (&tmpblock),
-			       build_empty_stmt (input_location));
-	  gfc_add_expr_to_block (&outer_block, outgoing);
-	  outgoing = gfc_finish_block (&outer_block);
-	}
-
-      /* Add the lot to the procedure init and finally blocks.  */
-      gfc_add_init_cleanup (block, incoming, outgoing);
-    }
-}
-
 /* Get the result expression for a procedure.  */
 
 static tree
@@ -5149,13 +5040,6 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 	}
       else if (!(UNLIMITED_POLY(sym)) && !is_pdt_type)
 	gcc_unreachable ();
-
-      /* Assumed shape and assumed rank arrays are passed to BIND(C) procedures
-	 as ISO Fortran Interop descriptors. These have to be converted to
-	 gfortran descriptors and back again.  This has to be done here so that
-	 the conversion occurs at the start of the init block.  */
-      if (is_CFI_desc (sym, NULL))
-	convert_CFI_desc (block, sym);
     }
 
   gfc_init_block (&tmpblock);
@@ -6779,6 +6663,399 @@ finish_oacc_declare (gfc_namespace *ns, gfc_symbol *sym, bool block)
   return;
 }
 
+static void
+gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t *finally,
+		     tree cfi_desc, tree gfc_desc, gfc_symbol *sym)
+{
+  stmtblock_t block;
+  gfc_init_block (&block);
+  tree cfi = build_fold_indirect_ref_loc (input_location, cfi_desc);
+  tree rank, label_loop, label_end, idx, etype, tmp, tmp2;
+
+  /* When allocatable + intent out, free the cfi descriptor.  */
+  if (sym->attr.allocatable && sym->attr.intent == INTENT_OUT)
+    {
+      tmp = gfc_get_cfi_desc_base_addr (cfi);
+      tree call = builtin_decl_explicit (BUILT_IN_FREE);
+      call = build_call_expr_loc (input_location, call, 1, tmp);
+      gfc_add_expr_to_block (&block, fold_convert (void_type_node, call));
+      gfc_add_modify (&block, tmp,
+		      fold_convert (TREE_TYPE (tmp), null_pointer_node));
+    }
+
+  if (!sym->attr.referenced)
+    goto done;
+
+  /* Set string length for len=* and len=:, otherwise, it is already set.  */
+  if (sym->ts.type == BT_CHARACTER && !sym->ts.u.cl->length)
+    {
+      tmp = fold_convert (gfc_array_index_type,
+			  gfc_get_cfi_desc_elem_len (cfi));
+      if (sym->ts.kind != 1)
+	tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+			       gfc_array_index_type, tmp,
+			       build_int_cst (gfc_charlen_type_node,
+					      sym->ts.kind));
+      gfc_add_modify (&block, sym->ts.u.cl->backend_decl, tmp);
+    }
+  /* gfc->data = cfi->base_addr - or for scalars: gfc = cfi->base_addr. */
+  if (!sym->attr.dimension)
+    {
+      tmp = gfc_get_cfi_desc_base_addr (cfi);
+      gfc_add_modify (&block, gfc_desc,
+		      fold_convert (TREE_TYPE (gfc_desc), tmp));
+      goto done;
+    }
+
+   /* gfc->dtype = ... (from declaration, not from cfi).  */
+  etype = gfc_get_element_type (TREE_TYPE (gfc_desc));
+  gfc_add_modify (&block, gfc_conv_descriptor_dtype (gfc_desc),
+		  gfc_get_dtype_rank_type (sym->as->rank, etype));
+
+  /* gfc->data = cfi->base_addr. */
+  gfc_conv_descriptor_data_set (&block, gfc_desc,
+				gfc_get_cfi_desc_base_addr (cfi));
+
+  /* -fcheck=bound: Do version, rank, attribute, type and is-NULL checks.  */
+  if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
+    {
+      char *msg;
+      tree tmp3;
+      msg = xasprintf ("Unexpected version %%d (expected %d) in CFI descriptor "
+		       "passed to dummy argument %s", CFI_VERSION, sym->name);
+      tmp2 = gfc_get_cfi_desc_version (cfi);
+      tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, tmp2,
+			     build_int_cst (TREE_TYPE (tmp2), CFI_VERSION));
+      gfc_trans_runtime_check (true, false, tmp, &block, &sym->declared_at,
+			       msg, tmp2);
+      free (msg);
+
+      msg = xasprintf ("Invalid rank %%d (expected 0..%d) in CFI descriptor "
+		       "passed to dummy argument %s", CFI_MAX_RANK, sym->name);
+      tmp3 = tmp2 = tmp = gfc_get_cfi_desc_rank (cfi);
+      tmp = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, tmp,
+			     build_int_cst (TREE_TYPE (tmp), 0));
+      tmp2 = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, tmp2,
+			      build_int_cst (TREE_TYPE (tmp2), CFI_MAX_RANK));
+      tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR, boolean_type_node,
+			     tmp, tmp2);
+      gfc_trans_runtime_check (true, false, tmp, &block, &sym->declared_at,
+			       msg, tmp3);
+      free (msg);
+
+      tmp3 = tmp = gfc_get_cfi_desc_attribute (cfi);
+      if (sym->attr.allocatable || sym->attr.pointer)
+	{
+	  int attr = (sym->attr.pointer ? CFI_attribute_pointer
+					: CFI_attribute_allocatable);
+	  msg = xasprintf ("Invalid attribute %%d (expected %d) in CFI "
+			   "descriptor passed to %s dummy argument %s", attr,
+			   sym->attr.pointer ? "pointer" : "allocatable",
+			   sym->name);
+	  tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+				 tmp, build_int_cst (TREE_TYPE (tmp), attr));
+	}
+      else
+	{
+	  int amin = MIN (CFI_attribute_pointer,
+			  MIN (CFI_attribute_allocatable, CFI_attribute_other));
+	  int amax = MAX (CFI_attribute_pointer,
+			  MAX (CFI_attribute_allocatable, CFI_attribute_other));
+	  msg = xasprintf ("Invalid attribute %%d (expected %d..%d) in CFI "
+			   "descriptor passed to nonallocatable, nonpointer "
+			   "dummy argument %s", amin, amax, sym->name);
+	  tmp2 = tmp;
+	  tmp = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, tmp,
+			     build_int_cst (TREE_TYPE (tmp), amin));
+	  tmp2 = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, tmp2,
+			     build_int_cst (TREE_TYPE (tmp2), amax));
+	  tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+				 boolean_type_node, tmp, tmp2);
+	  gfc_trans_runtime_check (true, false, tmp, &block, &sym->declared_at,
+				   msg, tmp3);
+	  free (msg);
+	  msg = xasprintf ("Invalid unallocatated/unassociated CFI "
+			   "descriptor passed to nonallocatable, nonpointer "
+			   "dummy argument %s", sym->name);
+	  tmp3 = tmp = gfc_get_cfi_desc_base_addr (cfi),
+	  tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+				 tmp, null_pointer_node);
+	}
+      gfc_trans_runtime_check (true, false, tmp, &block, &sym->declared_at,
+			       msg, tmp3);
+      free (msg);
+
+      if (sym->ts.type != BT_ASSUMED)
+	{
+	  int type = CFI_type_other;
+	  if (sym->ts.f90_type == BT_VOID)
+	    {
+	      type = (sym->ts.u.derived->intmod_sym_id == ISOCBINDING_FUNPTR
+		      ? CFI_type_cfunptr : CFI_type_cptr);
+	    }
+	  else
+	    switch (sym->ts.type)
+	      {
+		case BT_INTEGER:
+		case BT_LOGICAL:
+		case BT_REAL:
+		case BT_COMPLEX:
+		  type = CFI_type_from_type_kind (sym->ts.type, sym->ts.kind);
+		  break;
+		case BT_CHARACTER:
+		  type = CFI_type_from_type_kind (sym->ts.type, sym->ts.kind);
+		  break;
+		case BT_DERIVED:
+		  type = CFI_type_struct;
+		  break;
+		case BT_VOID:
+		  type = (sym->ts.u.derived->intmod_sym_id == ISOCBINDING_FUNPTR
+			? CFI_type_cfunptr : CFI_type_cptr);
+		  break;
+		case BT_ASSUMED:
+		case BT_CLASS:
+		case BT_PROCEDURE:
+		case BT_HOLLERITH:
+		case BT_UNION:
+		case BT_BOZ:
+		case BT_UNKNOWN:
+		  gcc_unreachable ();
+	    }
+	  msg = xasprintf ("Unexpected type %%d (expected %d) in CFI descriptor"
+			   " passed to dummy argument %s", type, sym->name);
+	  tmp2 = tmp = gfc_get_cfi_desc_type (cfi);
+	  tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+				 tmp, build_int_cst (TREE_TYPE (tmp), type));
+	  gfc_trans_runtime_check (true, false, tmp, &block, &sym->declared_at,
+			       msg, tmp2);
+	  free (msg);
+	}
+    }
+
+  /* Set gfc->dtype.rank, if assumed-rank.  */
+  if (sym->as->rank < 0)
+    {
+      rank = gfc_get_cfi_desc_rank (cfi);
+      gfc_add_modify (&block, gfc_conv_descriptor_rank (gfc_desc), rank);
+    }
+  else
+    rank = build_int_cst (signed_char_type_node, sym->as->rank);
+
+  /* If cfi->data != NULL. */
+  stmtblock_t block2;
+  gfc_init_block (&block2);
+
+  /* gfc->dspan = ((cfi->dim[0].sm % cfi->elem_len)
+		   ? cfi->dim[0].sm : cfi->elem_len).  */
+  tmp = gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]);
+  tmp = fold_build2_loc (input_location, TRUNC_MOD_EXPR,
+			 gfc_array_index_type, tmp,
+			 fold_convert (gfc_array_index_type,
+				       gfc_get_cfi_desc_elem_len (cfi)));
+  tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			 tmp, gfc_index_zero_node);
+  tmp = build3_loc (input_location, COND_EXPR, gfc_array_index_type, tmp,
+		    gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]),
+		    fold_convert (gfc_array_index_type,
+				  gfc_get_cfi_desc_elem_len (cfi)));
+  gfc_conv_descriptor_span_set (&block2, gfc_desc, tmp);
+
+  /* Calculate offset + set lbound, ubound and stride.  */
+  gfc_conv_descriptor_offset_set (&block2, gfc_desc, gfc_index_zero_node);
+  if (sym->as->rank > 0 && !sym->attr.pointer && !sym->attr.allocatable)
+    for (int i = 0; i < sym->as->rank; ++i)
+      {
+	gfc_se se;
+	gfc_init_se (&se, NULL );
+	if (sym->as->lower[i])
+	  {
+	    gfc_conv_expr (&se, sym->as->lower[i]);
+	    tmp = se.expr;
+	  }
+	else
+	  tmp = gfc_index_one_node;
+	gfc_add_block_to_block (&block2, &se.pre);
+	gfc_conv_descriptor_lbound_set (&block2, gfc_desc, gfc_rank_cst[i],
+					tmp);
+	gfc_add_block_to_block (&block2, &se.post);
+      }
+
+  /* Loop: for (i = 0; i < rank; ++i).  */
+  label_loop = gfc_build_label_decl (NULL_TREE);
+  label_end = gfc_build_label_decl (NULL_TREE);
+  idx = gfc_create_var (TREE_TYPE (rank), "idx");
+  gfc_add_modify (&block2, idx, build_int_cst (TREE_TYPE (idx), 0));
+  TREE_USED (label_loop) = 1;
+  tmp = build1_v (LABEL_EXPR, label_loop);
+  gfc_add_expr_to_block (&block2, tmp);
+  tmp = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, idx, rank);
+  tmp = build3_v (COND_EXPR, tmp, build1_v (GOTO_EXPR, label_end),
+		  build_empty_stmt (input_location));
+  gfc_add_expr_to_block (&block2, tmp);
+
+  /* Loop body.  */
+  /* gfc->dim[i].lbound = ... */
+  if (sym->attr.pointer || sym->attr.allocatable)
+    {
+      tmp = gfc_get_cfi_dim_lbound (cfi, idx);
+      gfc_conv_descriptor_lbound_set (&block2, gfc_desc, idx, tmp);
+    }
+  else if (sym->as->rank < 0)
+    gfc_conv_descriptor_lbound_set (&block2, gfc_desc, idx, gfc_index_one_node);
+
+  /* gfc->dim[i].ubound = gfc->dim[i].lbound + cfi->dim[i].extent - 1. */
+  tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			     gfc_conv_descriptor_lbound_get (gfc_desc, idx),
+			     gfc_index_one_node);
+  tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			     gfc_get_cfi_dim_extent (cfi, idx), tmp);
+  gfc_conv_descriptor_ubound_set (&block2, gfc_desc, idx, tmp);
+
+  /* gfc->dim[i].stride = cfi->dim[i].sm / cfi>elem_len */
+  tmp = gfc_get_cfi_dim_sm (cfi, idx);
+  tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+			     gfc_array_index_type, tmp,
+			     fold_convert (gfc_array_index_type,
+					   gfc_get_cfi_desc_elem_len (cfi)));
+   gfc_conv_descriptor_stride_set (&block2, gfc_desc, idx, tmp);
+
+  /* gfc->offset -= gfc->dim[i].stride * gfc->dim[i].lbound. */
+  tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			     gfc_conv_descriptor_stride_get (gfc_desc, idx),
+			     gfc_conv_descriptor_lbound_get (gfc_desc, idx));
+  tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			     gfc_conv_descriptor_offset_get (gfc_desc), tmp);
+  gfc_conv_descriptor_offset_set (&block2, gfc_desc, tmp);
+
+  /* End of loop body.  */
+  tmp = fold_build2_loc (input_location, PLUS_EXPR, signed_char_type_node, idx,
+			 build_int_cst (signed_char_type_node, 1));
+  gfc_add_modify (&block2, idx, tmp);
+  gfc_add_expr_to_block (&block2, build1_v (GOTO_EXPR, label_loop));
+  TREE_USED (label_end) = 1;
+  tmp = build1_v (LABEL_EXPR, label_end);
+  gfc_add_expr_to_block (&block2, tmp);
+
+  if (sym->attr.allocatable || sym->attr.pointer)
+    {
+      tmp = gfc_get_cfi_desc_base_addr (cfi),
+      tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			     tmp, null_pointer_node);
+      tmp = build3_v (COND_EXPR, tmp, gfc_finish_block (&block2),
+		      build_empty_stmt (input_location));
+      gfc_add_expr_to_block (&block, tmp);
+    }
+  else
+    gfc_add_block_to_block (&block, &block2);
+
+done:
+  /* If optional arg: 'if (arg) { block } else { local_arg = NULL; }'.  */
+  if (sym->attr.optional)
+    {
+      tree present = fold_build2_loc (input_location, NE_EXPR,
+				      boolean_type_node, cfi_desc,
+				      null_pointer_node);
+      tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
+			     sym->backend_decl,
+			     fold_convert (TREE_TYPE (sym->backend_decl),
+					   null_pointer_node));
+      tmp = build3_v (COND_EXPR, present, gfc_finish_block (&block), tmp);
+      gfc_add_expr_to_block (init, tmp);
+    }
+  else
+    gfc_add_block_to_block (init, &block);
+
+  /* Nothing to do if either not referenced or pointer not changed.  */
+  if (!sym->attr.referenced
+      || ((!sym->attr.pointer && !sym->attr.allocatable)
+	  || sym->attr.intent == INTENT_IN))
+    return;
+
+  /* Update pointer + array data data on exit.  */
+  gfc_init_block (&block);
+  tmp = gfc_get_cfi_desc_base_addr (cfi);
+  tmp2 = (!sym->attr.dimension
+	       ? gfc_desc : gfc_conv_descriptor_data_get (gfc_desc));
+  gfc_add_modify (&block, tmp, fold_convert (TREE_TYPE (tmp), tmp2));
+
+  /* Set string length for len=:, only.  */
+  if (sym->ts.type == BT_CHARACTER && !sym->ts.u.cl->length)
+    {
+      tmp = sym->ts.u.cl->backend_decl;
+      if (sym->ts.kind != 1)
+	tmp = fold_build2_loc (input_location, MULT_EXPR,
+			       gfc_array_index_type,
+			       sym->ts.u.cl->backend_decl, tmp);
+      tmp2 = gfc_get_cfi_desc_elem_len (cfi);
+      gfc_add_modify (&block, tmp2, fold_convert (TREE_TYPE (tmp2), tmp));
+    }
+
+  if (!sym->attr.dimension)
+    goto done_finally;
+
+  gfc_init_block (&block2);
+
+  /* Loop: for (i = 0; i < rank; ++i).  */
+  label_loop = gfc_build_label_decl (NULL_TREE);
+  label_end = gfc_build_label_decl (NULL_TREE);
+  idx = gfc_create_var (TREE_TYPE (rank), "idx");
+  gfc_add_modify (&block2, idx, build_int_cst (TREE_TYPE (idx), 0));
+  TREE_USED (label_loop) = 1;
+  tmp = build1_v (LABEL_EXPR, label_loop);
+  gfc_add_expr_to_block (&block2, tmp);
+  tmp = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, idx, rank);
+  tmp = build3_v (COND_EXPR, tmp, build1_v (GOTO_EXPR, label_end),
+		  build_empty_stmt (input_location));
+  gfc_add_expr_to_block (&block2, tmp);
+
+  /* Loop body.  */
+  /* cfi->dim[i].lower_bound = gfc->dim[i].lbound */
+  gfc_add_modify (&block2, gfc_get_cfi_dim_lbound (cfi, idx),
+		  gfc_conv_descriptor_lbound_get (gfc_desc, idx));
+  /* cfi->dim[i].extent = gfc->dim[i].ubound - gfc->dim[i].lbound + 1.  */
+  tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			     gfc_conv_descriptor_ubound_get (gfc_desc, idx),
+			     gfc_conv_descriptor_lbound_get (gfc_desc, idx));
+  tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, tmp,
+			 gfc_index_one_node);
+  gfc_add_modify (&block2, gfc_get_cfi_dim_extent (cfi, idx), tmp);
+  /* d->dim[n].sm = gfc->dim[i].stride  * gfc->span); */
+  tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			     gfc_conv_descriptor_stride_get (gfc_desc, idx),
+			     gfc_conv_descriptor_span_get (gfc_desc));
+  gfc_add_modify (&block2, gfc_get_cfi_dim_sm (cfi, idx), tmp);
+
+  /* End of loop body.  */
+  tmp = fold_build2_loc (input_location, PLUS_EXPR, signed_char_type_node, idx,
+			 build_int_cst (signed_char_type_node, 1));
+  gfc_add_modify (&block2, idx, tmp);
+  gfc_add_expr_to_block (&block2, build1_v (GOTO_EXPR, label_loop));
+  TREE_USED (label_end) = 1;
+  tmp = build1_v (LABEL_EXPR, label_end);
+  gfc_add_expr_to_block (&block2, tmp);
+
+  /* if (gfc->data != NULL) { block2 }.  */
+  tmp = gfc_get_cfi_desc_base_addr (cfi),
+  tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			 tmp, null_pointer_node);
+  tmp = build3_v (COND_EXPR, tmp, gfc_finish_block (&block2),
+		  build_empty_stmt (input_location));
+  gfc_add_expr_to_block (&block, tmp);
+
+done_finally:
+  /* If optional arg: 'if (arg) { block } else { local_arg = NULL; }'.  */
+  if (sym->attr.optional)
+    {
+      tree present = fold_build2_loc (input_location, NE_EXPR,
+				      boolean_type_node, cfi_desc,
+				      null_pointer_node);
+      tmp = build3_v (COND_EXPR, present, gfc_finish_block (&block),
+		      build_empty_stmt (input_location));
+      gfc_add_expr_to_block (finally, tmp);
+     }
+   else
+     gfc_add_block_to_block (finally, &block);
+}
 
 /* Generate code for a function.  */
 
@@ -6824,6 +7101,7 @@ gfc_generate_function_code (gfc_namespace * ns)
   trans_function_start (sym);
 
   gfc_init_block (&init);
+  gfc_init_block (&cleanup);
 
   if (ns->entries && ns->proc_name->ts.type == BT_CHARACTER)
     {
@@ -6847,6 +7125,76 @@ gfc_generate_function_code (gfc_namespace * ns)
 	|| ns->parent == NULL)
     parent_fake_result_decl = NULL_TREE;
 
+  /* For BIND(C):
+     - deallocate intent-out allocatable dummy arguments.
+     - Create GFC variable which will later be populated by convert_CFI_desc  */
+  if (sym->attr.is_bind_c)
+    for (gfc_formal_arglist *formal = gfc_sym_get_dummy_args (sym);
+	 formal; formal = formal->next)
+      {
+	gfc_symbol *fsym = formal->sym;
+	if (!is_CFI_desc (fsym, NULL))
+	  continue;
+	if (!fsym->attr.referenced)
+	  {
+	    gfc_conv_cfi_to_gfc (&init, &cleanup, fsym->backend_decl,
+				 NULL_TREE, fsym);
+	    continue;
+	  }
+
+// FIXME: CHECK THAT OPTIONAL IS HANDLED CORRECTLY IN trans-openmp.c
+// OR OTHERPLACES WITH USE LANG SPECIFIC AND/OR PARAM_DECL IN THE CHECK
+
+// FIXME: TESTING SHOWS THAT DEBUGGING DOES NOT WORK WELL
+// IMPROVE DEBUGGING EXPERIENCE!
+
+	/* Let's now create a local GFI descriptor. Afterwards:
+	   desc is the local descriptor,
+	   desc_p is a pointer to it
+	     and stored in sym->backend_decl
+	   GFC_DECL_SAVED_DESCRIPTOR (desc_p) contains the CFI descriptor
+	     -> PARM_DECL and before sym->backend_decl.
+	   For scalars, decl == decl_p is a pointer variable.  */
+	tree desc_p, desc;
+	location_t loc = gfc_get_location (&sym->declared_at);
+	if (fsym->ts.type == BT_CHARACTER && !fsym->ts.u.cl->length)
+	  fsym->ts.u.cl->backend_decl = gfc_create_var (gfc_array_index_type,
+							fsym->name);
+	else if (fsym->ts.type == BT_CHARACTER && !fsym->ts.u.cl->backend_decl)
+	  {
+	    gfc_se se;
+	    gfc_init_se (&se, NULL );
+	    gfc_conv_expr (&se, fsym->ts.u.cl->length);
+	    gfc_add_block_to_block (&init, &se.pre);
+	    fsym->ts.u.cl->backend_decl = se.expr;
+	    gcc_assert(se.post.head == NULL_TREE);
+	  }
+	/* Nullify, otherwise gfc_sym_type will return the CFI type.  */
+	tree tmp = fsym->backend_decl;
+	fsym->backend_decl = NULL;
+	tree type = gfc_sym_type (fsym);
+	gcc_assert (POINTER_TYPE_P (type));
+	if (POINTER_TYPE_P (TREE_TYPE (type)))
+	  /* For instance, allocatable scalars.  */
+	  type = TREE_TYPE (type);
+	if (TREE_CODE (type) == REFERENCE_TYPE)
+	  /* FIXME: restrict qualifier? */
+	  type = build_pointer_type (TREE_TYPE (type));
+	desc_p = build_decl (loc, VAR_DECL, get_identifier (fsym->name), type);
+	if (!fsym->attr.dimension)
+	  desc = desc_p;
+	else
+	  {
+	    desc = gfc_create_var (TREE_TYPE (type), fsym->name);
+	    gfc_add_modify (&init, desc_p, gfc_build_addr_expr (NULL, desc));
+	  }
+	//gfc_allocate_lang_decl (desc_p);
+	//GFC_DECL_SAVED_DESCRIPTOR (desc_p) = tmp;
+	pushdecl (desc_p);
+	fsym->backend_decl = desc_p;
+	gfc_conv_cfi_to_gfc (&init, &cleanup, tmp, desc, fsym);
+      }
+
   gfc_generate_contained_functions (ns);
 
   has_coarray_vars = false;
@@ -7002,8 +7350,6 @@ gfc_generate_function_code (gfc_namespace * ns)
 	gfc_add_expr_to_block (&body, gfc_generate_return ());
     }
 
-  gfc_init_block (&cleanup);
-
   /* Reset recursion-check variable.  */
   if (recurcheckvar != NULL_TREE)
     {
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index c4291cce079..aaaf5a3a34c 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2864,6 +2864,9 @@ tree
 gfc_maybe_dereference_var (gfc_symbol *sym, tree var, bool descriptor_only_p,
 			   bool is_classarray)
 {
+  if (is_CFI_desc (sym, NULL))
+    return build_fold_indirect_ref_loc (input_location, var);
+
   /* Characters are entirely different from other types, they are treated
      separately.  */
   if (sym->ts.type == BT_CHARACTER)
@@ -5481,168 +5484,452 @@ set_dtype_for_unallocated (gfc_se *parmse, gfc_expr *e)
 static void
 gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
 {
-  tree tmp;
-  tree cfi_desc_ptr;
-  tree gfc_desc_ptr;
-  tree type;
-  tree cond;
-  tree desc_attr;
-  int attribute;
-  int cfi_attribute;
-  symbol_attribute attr = gfc_expr_attr (e);
+  stmtblock_t block, block2;
+  tree cfi, gfc, gfc_strlen, tmp, tmp2;
+  tree present = NULL;
+  tree rank;
+  gfc_se se;
+
+  if (fsym->attr.optional
+      && e->expr_type == EXPR_VARIABLE
+      && e->symtree->n.sym->attr.optional)
+    present = gfc_conv_expr_present (e->symtree->n.sym);
 
-  /* If this is a full array or a scalar, the allocatable and pointer
-     attributes can be passed. Otherwise it is 'CFI_attribute_other'*/
-  attribute = 2;
-  if (!e->rank || gfc_get_full_arrayspec_from_expr (e))
+  // FIXME: If already a CFI descriptor, use it - unless bounds have to be modified.
+  // In particular, re-use type - especially for AT_ASSUMED
+
+  gfc_init_block (&block);
+
+  /* Convert original argument to a tree. */
+  gfc_init_se (&se, NULL);
+  if (e->rank == 0)
     {
-      if (attr.pointer)
-	attribute = 0;
-      else if (attr.allocatable)
-	attribute = 1;
+      gfc_conv_expr (&se, e);
+      gfc = se.expr;
+      if (!POINTER_TYPE_P (TREE_TYPE (gfc)))
+	gfc = gfc_build_addr_expr (NULL_TREE, gfc);
     }
-
-  if (fsym->attr.pointer)
-    cfi_attribute = 0;
-  else if (fsym->attr.allocatable)
-    cfi_attribute = 1;
   else
-    cfi_attribute = 2;
-
-  if (e->rank != 0)
     {
-      parmse->force_no_tmp = 1;
+      se.force_no_tmp = 1;
       if (fsym->attr.contiguous
 	  && !gfc_is_simply_contiguous (e, false, true))
-	gfc_conv_subref_array_arg (parmse, e, false, fsym->attr.intent,
+	gfc_conv_subref_array_arg (&se, e, false, fsym->attr.intent,
 				   fsym->attr.pointer);
       else
-	gfc_conv_expr_descriptor (parmse, e);
-
-      if (POINTER_TYPE_P (TREE_TYPE (parmse->expr)))
-	parmse->expr = build_fold_indirect_ref_loc (input_location,
-						    parmse->expr);
-      bool is_artificial = (INDIRECT_REF_P (parmse->expr)
-			    ? DECL_ARTIFICIAL (TREE_OPERAND (parmse->expr, 0))
-			    : DECL_ARTIFICIAL (parmse->expr));
-
-      /* Unallocated allocatable arrays and unassociated pointer arrays
-	 need their dtype setting if they are argument associated with
-	 assumed rank dummies.  */
-      if (fsym && fsym->as
-	  && (gfc_expr_attr (e).pointer
-	      || gfc_expr_attr (e).allocatable))
-	set_dtype_for_unallocated (parmse, e);
-
-      /* All the temporary descriptors are marked as DECL_ARTIFICIAL. If
-	 the expression type is different from the descriptor type, then
-	 the offset must be found (eg. to a component ref or substring)
-	 and the dtype updated.  Assumed type entities are only allowed
-	 to be dummies in Fortran. They therefore lack the decl specific
-	 appendiges and so must be treated differently from other fortran
-	 entities passed to CFI descriptors in the interface decl.  */
-      type = e->ts.type != BT_ASSUMED ? gfc_typenode_for_spec (&e->ts) :
-					NULL_TREE;
-
-      if (type && is_artificial
-	  && type != gfc_get_element_type (TREE_TYPE (parmse->expr)))
-	{
-	  /* Obtain the offset to the data.  */
-	  gfc_get_dataptr_offset (&parmse->pre, parmse->expr, parmse->expr,
-				  gfc_index_zero_node, true, e);
-
-	  /* Update the dtype.  */
-	  gfc_add_modify (&parmse->pre,
-			  gfc_conv_descriptor_dtype (parmse->expr),
-			  gfc_get_dtype_rank_type (e->rank, type));
-	}
-      else if (type == NULL_TREE
-	       || (!is_subref_array (e) && !is_artificial))
-	{
-	  /* Make sure that the span is set for expressions where it
-	     might not have been done already.  */
-	  tmp = gfc_conv_descriptor_elem_len (parmse->expr);
-	  tmp = fold_convert (gfc_array_index_type, tmp);
-	  gfc_conv_descriptor_span_set (&parmse->pre, parmse->expr, tmp);
-	}
+	gfc_conv_expr_descriptor (&se, e);
+      gfc = se.expr;
+      /* For dt(:)%var the elem_len*stride != sm, hence, GFC uses
+	 elem_len = sizeof(dt) and base_addr = dt(lb) instead.
+	 gfc_get_dataptr_offset fixes the base_addr; for elem_len, see below.
+	 While sm is fine as it uses span*stride and not elem_len.  */
+      if (POINTER_TYPE_P (TREE_TYPE (gfc)))
+	gfc = build_fold_indirect_ref_loc (input_location, gfc);
+      else if (is_subref_array (e) && e->ts.type != BT_CHARACTER)
+	 gfc_get_dataptr_offset (&se.pre, gfc, gfc, NULL, true, e);
+    }
+  gfc_strlen = se.string_length;
+  gfc_add_block_to_block (&block, &se.pre);
+
+  /* Create array decriptor and set version, rank, attribute, type. */
+  cfi = gfc_create_var (gfc_get_cfi_type (e->rank < 0
+					  ? GFC_MAX_DIMENSIONS : e->rank,
+					  false), "cfi");
+  tmp = gfc_get_cfi_desc_version (cfi);
+  gfc_add_modify (&block, tmp,
+		  build_int_cst (TREE_TYPE (tmp), CFI_VERSION));
+  if (e->rank < 0)
+    rank = fold_convert (signed_char_type_node, gfc_conv_descriptor_rank (gfc));
+  else
+    rank = build_int_cst (signed_char_type_node, e->rank);
+  tmp = gfc_get_cfi_desc_rank (cfi);
+  gfc_add_modify (&block, tmp, rank);
+  int itype = CFI_type_other;
+  if (e->ts.f90_type == BT_VOID)
+    itype = (e->ts.u.derived->intmod_sym_id == ISOCBINDING_FUNPTR
+	     ? CFI_type_cfunptr : CFI_type_cptr);
+  else
+    switch (e->ts.type)
+      {
+	case BT_INTEGER:
+	case BT_LOGICAL:
+	case BT_REAL:
+	case BT_COMPLEX:
+	case BT_CHARACTER:
+	  itype = CFI_type_from_type_kind (e->ts.type, e->ts.kind);
+	  break;
+	case BT_DERIVED:
+	  itype = CFI_type_struct;
+	  break;
+	case BT_VOID:
+	  itype = (e->ts.u.derived->intmod_sym_id == ISOCBINDING_FUNPTR
+		   ? CFI_type_cfunptr : CFI_type_cptr);
+	  break;
+	case BT_ASSUMED:
+	  itype = CFI_type_other;  // FIXME: Or CFI_type_cptr ?
+	  break;
+	case BT_CLASS:
+	case BT_PROCEDURE:
+	case BT_HOLLERITH:
+	case BT_UNION:
+	case BT_BOZ:
+	case BT_UNKNOWN:
+	  // FIXME: Really unreachable? Or reachable for type(*) ? If so, CFI_type_other?
+	  gcc_unreachable ();
+      }
+
+  tmp = gfc_get_cfi_desc_type (cfi);
+  gfc_add_modify (&block, tmp,
+		  build_int_cst (TREE_TYPE (tmp), itype));
+
+  int attr = CFI_attribute_other;
+  if (fsym->attr.pointer)
+    attr = CFI_attribute_pointer;
+  else if (fsym->attr.allocatable)
+    attr = CFI_attribute_allocatable;
+  tmp = gfc_get_cfi_desc_attribute (cfi);
+  gfc_add_modify (&block, tmp,
+		  build_int_cst (TREE_TYPE (tmp), attr));
+
+  if (e->rank == 0)
+    {
+      tmp = gfc_get_cfi_desc_base_addr (cfi);
+      gfc_add_modify (&block, tmp, fold_convert (TREE_TYPE (tmp), gfc));
     }
   else
     {
-      gfc_conv_expr (parmse, e);
-
-      if (POINTER_TYPE_P (TREE_TYPE (parmse->expr)))
-	parmse->expr = build_fold_indirect_ref_loc (input_location,
-						    parmse->expr);
+      tmp = gfc_get_cfi_desc_base_addr (cfi);
+      tmp2 = gfc_conv_descriptor_data_get (gfc);
+      gfc_add_modify (&block, tmp, fold_convert (TREE_TYPE (tmp), tmp2));
+    }
 
-      parmse->expr = gfc_conv_scalar_to_descriptor (parmse,
-						    parmse->expr, attr);
+  /* When allocatable + intent out, free the cfi descriptor.  */
+  if (fsym->attr.allocatable && fsym->attr.intent == INTENT_OUT)
+    {
+      tmp = gfc_get_cfi_desc_base_addr (cfi);
+      tree call = builtin_decl_explicit (BUILT_IN_FREE);
+      call = build_call_expr_loc (input_location, call, 1, tmp);
+      gfc_add_expr_to_block (&block, fold_convert (void_type_node, call));
+      gfc_add_modify (&block, tmp,
+                      fold_convert (TREE_TYPE (tmp), null_pointer_node));
+      goto done;
     }
 
-  /* Set the CFI attribute field through a temporary value for the
-     gfc attribute.  */
-  desc_attr = gfc_conv_descriptor_attribute (parmse->expr);
-  tmp = fold_build2_loc (input_location, MODIFY_EXPR,
-			 void_type_node, desc_attr,
-			 build_int_cst (TREE_TYPE (desc_attr), cfi_attribute));
-  gfc_add_expr_to_block (&parmse->pre, tmp);
+  /* If not unallocated/unassociated. */
+  gfc_init_block (&block2);
 
-  /* Now pass the gfc_descriptor by reference.  */
-  parmse->expr = gfc_build_addr_expr (NULL_TREE, parmse->expr);
+  if (e->ts.type == BT_CHARACTER)
+    {
+      gcc_assert (gfc_strlen);
+      tmp = gfc_strlen;
+      if (e->ts.kind != 1)
+        tmp = fold_build2_loc (input_location, MULT_EXPR,
+                               gfc_charlen_type_node, tmp,
+                               build_int_cst (gfc_charlen_type_node,
+                                              e->ts.kind));
+      tmp2 = gfc_get_cfi_desc_elem_len (cfi);
+      gfc_add_modify (&block2, tmp2, fold_convert (TREE_TYPE (tmp2), tmp));
+    }
+  else if (e->ts.type != BT_ASSUMED)
+    {
+      /* Length is known at compile time; use use 'block' for it.  */
+      tmp = size_in_bytes (gfc_typenode_for_spec (&e->ts));
+      tmp2 = gfc_get_cfi_desc_elem_len (cfi);
+      gfc_add_modify (&block, tmp2, fold_convert (TREE_TYPE (tmp2), tmp));
+    }
+  else
+    {
+      tmp = gfc_conv_descriptor_elem_len (gfc);
+      tmp2 = gfc_get_cfi_desc_elem_len (cfi);
+      gfc_add_modify (&block2, tmp2, fold_convert (TREE_TYPE (tmp2), tmp));
+    }
 
-  /* Variables to point to the gfc and CFI descriptors; cfi = NULL implies
-     that the CFI descriptor is allocated by the gfor_fndecl_gfc_to_cfi call.  */
-  gfc_desc_ptr = parmse->expr;
-  cfi_desc_ptr = gfc_create_var (pvoid_type_node, "cfi");
-  gfc_add_modify (&parmse->pre, cfi_desc_ptr, null_pointer_node);
+  if (e->ts.type == BT_ASSUMED)
+    {
+      /* Note: type(*) implies assumed-shape/assumed-rank if fsym requires
+	 an CFI descriptor.  Use the type in the descritor as it provide
+	 mode information. (Quality of implementation feature.)  */
+      tree cond;
+      tree ctype = gfc_get_cfi_desc_type (cfi);
+      tree type = fold_convert (TREE_TYPE (ctype),
+				gfc_conv_descriptor_type (gfc));
+      tree kind = fold_convert (TREE_TYPE (ctype),
+				gfc_conv_descriptor_elem_len (gfc));
+      kind = fold_build2_loc (input_location, LSHIFT_EXPR, TREE_TYPE (type),
+			      kind, build_int_cst (TREE_TYPE (type),
+						   CFI_type_kind_shift));
+
+      /* if (BT_VOID) CFI_type_cptr else CFI_type_other  */
+      /* Note: BT_VOID is could also be CFI_type_funcptr, but assume c_ptr. */
+      cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, type,
+			      build_int_cst (TREE_TYPE (type), BT_VOID));
+      tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, ctype,
+			     build_int_cst (TREE_TYPE (type), CFI_type_cptr));
+      tmp2 = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
+			      ctype,
+			      build_int_cst (TREE_TYPE (type), CFI_type_other));
+      tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
+			      tmp, tmp2);
+      /* if (BT_DERIVED) CFI_type_struct else  < tmp2 >  */
+      cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, type,
+			      build_int_cst (TREE_TYPE (type), BT_DERIVED));
+      tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, ctype,
+			     build_int_cst (TREE_TYPE (type), CFI_type_struct));
+      tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
+			      tmp, tmp2);
+      /* if (BT_CHARACTER) CFI_type_struct + kind=1 else  < tmp2 >  */
+      /* Note: could also be kind=4, with cfi->elem_len = gfc->elem_len/4.  */
+      cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, type,
+			      build_int_cst (TREE_TYPE (type), BT_CHARACTER));
+      tmp = build_int_cst (TREE_TYPE (type),
+			   CFI_type_from_type_kind (CFI_type_Character, 1));
+      tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
+			     ctype, tmp);
+      tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
+			      tmp, tmp2);
+      /* if (BT_COMPLEX) CFI_type_Character + kind/2 else  < tmp2 >  */
+      cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, type,
+			      build_int_cst (TREE_TYPE (type), BT_CHARACTER));
+      tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR, TREE_TYPE (type),
+			     kind, build_int_cst (TREE_TYPE (type), 2));
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (type), tmp,
+			     build_int_cst (TREE_TYPE (type),
+					    CFI_type_Complex));
+      tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
+			     ctype, tmp);
+      tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
+			      tmp, tmp2);
+      /* if (BT_INTEGER || BT_LOGICAL || BT_REAL) type + kind else  <tmp2>  */
+      cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, type,
+			      build_int_cst (TREE_TYPE (type), BT_INTEGER));
+      tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, type,
+			      build_int_cst (TREE_TYPE (type), BT_LOGICAL));
+      cond = fold_build2_loc (input_location, TRUTH_OR_EXPR, boolean_type_node,
+			      cond, tmp);
+      tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, type,
+			      build_int_cst (TREE_TYPE (type), BT_REAL));
+      cond = fold_build2_loc (input_location, TRUTH_OR_EXPR, boolean_type_node,
+			      cond, tmp);
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (type),
+			     type, kind);
+      tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
+			     ctype, tmp);
+      tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
+			      tmp, tmp2);
+      gfc_add_expr_to_block (&block2, tmp2);
+    }
 
-  /* Allocate the CFI descriptor itself and fill the fields.  */
-  tmp = gfc_build_addr_expr (NULL_TREE, cfi_desc_ptr);
-  tmp = build_call_expr_loc (input_location,
-			     gfor_fndecl_gfc_to_cfi, 2, tmp, gfc_desc_ptr);
-  gfc_add_expr_to_block (&parmse->pre, tmp);
+  if (e->rank != 0)
+    {
+      /* Loop: for (i = 0; i < rank; ++i).  */
+      tree label_loop = gfc_build_label_decl (NULL_TREE);
+      tree label_end = gfc_build_label_decl (NULL_TREE);
+      tree idx = gfc_create_var (signed_char_type_node, "idx");
+      gfc_add_modify (&block2, idx, build_int_cst (TREE_TYPE (idx), 0));
+      TREE_USED (label_loop) = 1;
+      tmp = build1_v (LABEL_EXPR, label_loop);
+      gfc_add_expr_to_block (&block2, tmp);
+      tmp = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, idx,
+			     rank);
+      tmp = build3_v (COND_EXPR, tmp, build1_v (GOTO_EXPR, label_end),
+		      build_empty_stmt (input_location));
+      gfc_add_expr_to_block (&block2, tmp);
 
-  /* Now set the gfc descriptor attribute.  */
-  tmp = fold_build2_loc (input_location, MODIFY_EXPR,
-			 void_type_node, desc_attr,
-			 build_int_cst (TREE_TYPE (desc_attr), attribute));
-  gfc_add_expr_to_block (&parmse->pre, tmp);
+      /* Loop body.  */
+      /* cfi->dim[i].lower_bound = (allocatable/pointer)
+				   ? gfc->dim[i].lbound : 0 */
+      if (fsym->attr.pointer || fsym->attr.allocatable)
+	tmp = gfc_conv_descriptor_lbound_get (gfc, idx);
+      else
+	tmp = gfc_index_zero_node;
+      gfc_add_modify (&block2, gfc_get_cfi_dim_lbound (cfi, idx), tmp);
+      /* cfi->dim[i].extent = gfc->dim[i].ubound - gfc->dim[i].lbound + 1.  */
+      tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			     gfc_conv_descriptor_ubound_get (gfc, idx),
+			     gfc_conv_descriptor_lbound_get (gfc, idx));
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			     tmp, gfc_index_one_node);
+      gfc_add_modify (&block2, gfc_get_cfi_dim_extent (cfi, idx), tmp);
+      /* d->dim[n].sm = gfc->dim[i].stride  * gfc->span); */
+      tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			     gfc_conv_descriptor_stride_get (gfc, idx),
+			     gfc_conv_descriptor_span_get (gfc));
+      gfc_add_modify (&block2, gfc_get_cfi_dim_sm (cfi, idx), tmp);
+
+      /* End of loop body.  */
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, signed_char_type_node,
+			     idx, build_int_cst (signed_char_type_node, 1));
+      gfc_add_modify (&block2, idx, tmp);
+      gfc_add_expr_to_block (&block2, build1_v (GOTO_EXPR, label_loop));
+      TREE_USED (label_end) = 1;
+      tmp = build1_v (LABEL_EXPR, label_end);
+      gfc_add_expr_to_block (&block2, tmp);
 
-  /* The CFI descriptor is passed to the bind_C procedure.  */
-  parmse->expr = cfi_desc_ptr;
+      if (e->expr_type == EXPR_VARIABLE
+	  && e->ref
+	  && e->ref->u.ar.type == AR_FULL
+	  && e->symtree->n.sym->attr.dummy
+	  && e->symtree->n.sym->as
+	  && e->symtree->n.sym->as->type == AS_ASSUMED_SIZE)
+	{
+	  tmp = gfc_get_cfi_dim_extent (cfi, gfc_rank_cst[e->rank-1]),
+	  gfc_add_modify (&block2, tmp, build_int_cst (TREE_TYPE (tmp), -1));
+	}
+    }
 
-  /* Free the CFI descriptor.  */
-  tmp = gfc_call_free (cfi_desc_ptr);
-  gfc_prepend_expr_to_block (&parmse->post, tmp);
+// FIXME: Check that the bounds calculation is proper - for all kind of vars, including strided input etc.
 
-  /* Transfer values back to gfc descriptor.  */
-  if (cfi_attribute != 2  /* CFI_attribute_other.  */
-      && !fsym->attr.value
-      && fsym->attr.intent != INTENT_IN)
+  if (fsym->attr.allocatable || fsym->attr.pointer)
     {
-      tmp = gfc_build_addr_expr (NULL_TREE, parmse->expr);
-      tmp = build_call_expr_loc (input_location,
-				 gfor_fndecl_cfi_to_gfc, 2, gfc_desc_ptr, tmp);
-      gfc_prepend_expr_to_block (&parmse->post, tmp);
+      tmp = gfc_get_cfi_desc_base_addr (cfi),
+      tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			     tmp, null_pointer_node);
+      tmp = build3_v (COND_EXPR, tmp, gfc_finish_block (&block2),
+   		      build_empty_stmt (input_location));
+      gfc_add_expr_to_block (&block, tmp);
     }
+  else
+    gfc_add_block_to_block (&block, &block2);
 
-  /* Deal with an optional dummy being passed to an optional formal arg
-     by finishing the pre and post blocks and making their execution
-     conditional on the dummy being present.  */
-  if (fsym->attr.optional && e->expr_type == EXPR_VARIABLE
-      && e->symtree->n.sym->attr.optional)
+
+done:
+  parmse->expr = gfc_build_addr_expr (NULL_TREE, cfi);
+  if (present)
     {
-      cond = gfc_conv_expr_present (e->symtree->n.sym);
-      tmp = fold_build2 (MODIFY_EXPR, void_type_node,
-			 cfi_desc_ptr,
-			 build_int_cst (pvoid_type_node, 0));
-      tmp = build3_v (COND_EXPR, cond,
-		      gfc_finish_block (&parmse->pre), tmp);
+      parmse->expr = build3_loc (input_location, COND_EXPR,
+				 TREE_TYPE (parmse->expr),
+				 present, parmse->expr, null_pointer_node);
+      tmp = build3_v (COND_EXPR, present, gfc_finish_block (&block),
+                      build_empty_stmt (input_location));
       gfc_add_expr_to_block (&parmse->pre, tmp);
-      tmp = build3_v (COND_EXPR, cond,
-		      gfc_finish_block (&parmse->post),
+    }
+  else
+    gfc_add_block_to_block (&parmse->pre, &block);
+
+  gfc_init_block (&block);
+
+  if ((!fsym->attr.allocatable && !fsym->attr.pointer)
+      || fsym->attr.intent == INTENT_IN)
+    goto post_call;
+
+  gfc_init_block (&block2);
+  if (e->rank == 0)
+    {
+      tmp = gfc_get_cfi_desc_base_addr (cfi);
+      gfc_add_modify (&block, gfc, fold_convert (TREE_TYPE (gfc), tmp));
+    }
+  else
+    {
+      tmp = gfc_get_cfi_desc_base_addr (cfi);
+      gfc_conv_descriptor_data_set (&block, gfc, tmp);
+
+      /* gfc->dspan = ((cfi->dim[0].sm % cfi->elem_len)
+		       ? cfi->dim[0].sm : cfi->elem_len).  */
+      tmp = gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]);
+      tmp = fold_build2_loc (input_location, TRUNC_MOD_EXPR,
+			     gfc_array_index_type, tmp,
+			     fold_convert (gfc_array_index_type,
+					   gfc_get_cfi_desc_elem_len (cfi)));
+      tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			     tmp, gfc_index_zero_node);
+      tmp = build3_loc (input_location, COND_EXPR, gfc_array_index_type, tmp,
+			gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]),
+			fold_convert (gfc_array_index_type,
+				      gfc_get_cfi_desc_elem_len (cfi)));
+      gfc_conv_descriptor_span_set (&block2, gfc, tmp);
+
+      /* Calculate offset + set lbound, ubound and stride.  */
+      gfc_conv_descriptor_offset_set (&block2, gfc, gfc_index_zero_node);
+      /* Loop: for (i = 0; i < rank; ++i).  */
+      tree label_loop = gfc_build_label_decl (NULL_TREE);
+      tree label_end = gfc_build_label_decl (NULL_TREE);
+      tree idx = gfc_create_var (signed_char_type_node, "idx");
+      gfc_add_modify (&block2, idx, build_int_cst (TREE_TYPE (idx), 0));
+      TREE_USED (label_loop) = 1;
+      tmp = build1_v (LABEL_EXPR, label_loop);
+      gfc_add_expr_to_block (&block2, tmp);
+      tmp = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, idx,
+			     rank);
+      tmp = build3_v (COND_EXPR, tmp, build1_v (GOTO_EXPR, label_end),
 		      build_empty_stmt (input_location));
+      gfc_add_expr_to_block (&block2, tmp);
+
+      /* Loop body.  */
+
+// FIXME: CHECK!
+      /* gfc->dim[i].lbound = ... */
+      tmp = gfc_get_cfi_dim_lbound (cfi, idx);
+      gfc_conv_descriptor_lbound_set (&block2, gfc, idx, tmp);
+
+      /* gfc->dim[i].ubound = gfc->dim[i].lbound + cfi->dim[i].extent - 1. */
+      tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			     gfc_conv_descriptor_lbound_get (gfc, idx),
+			     gfc_index_one_node);
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			     gfc_get_cfi_dim_extent (cfi, idx), tmp);
+      gfc_conv_descriptor_ubound_set (&block2, gfc, idx, tmp);
+
+      /* gfc->dim[i].stride = cfi->dim[i].sm / cfi>elem_len */
+      tmp = gfc_get_cfi_dim_sm (cfi, idx);
+      tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+			     gfc_array_index_type, tmp,
+			     fold_convert (gfc_array_index_type,
+					   gfc_get_cfi_desc_elem_len (cfi)));
+      gfc_conv_descriptor_stride_set (&block2, gfc, idx, tmp);
+
+      /* gfc->offset -= gfc->dim[i].stride * gfc->dim[i].lbound. */
+      tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			     gfc_conv_descriptor_stride_get (gfc, idx),
+			     gfc_conv_descriptor_lbound_get (gfc, idx));
+      tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			     gfc_conv_descriptor_offset_get (gfc), tmp);
+      gfc_conv_descriptor_offset_set (&block2, gfc, tmp);
+
+      /* End of loop body.  */
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, signed_char_type_node,
+			     idx, build_int_cst (signed_char_type_node, 1));
+      gfc_add_modify (&block2, idx, tmp);
+      gfc_add_expr_to_block (&block2, build1_v (GOTO_EXPR, label_loop));
+      TREE_USED (label_end) = 1;
+      tmp = build1_v (LABEL_EXPR, label_end);
+      gfc_add_expr_to_block (&block2, tmp);
+    }
+
+  if (e->ts.type == BT_CHARACTER && !e->ts.u.cl->length)
+    {
+      tmp = fold_convert (gfc_charlen_type_node,
+			  gfc_get_cfi_desc_elem_len (cfi));
+      if (e->ts.kind != 1)
+        tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+                               gfc_charlen_type_node, tmp,
+                               build_int_cst (gfc_charlen_type_node,
+                                              e->ts.kind));
+      gfc_add_modify (&block2, gfc_strlen, tmp);
+    }
+
+  tmp = gfc_get_cfi_desc_base_addr (cfi),
+  tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			 tmp, null_pointer_node);
+  tmp = build3_v (COND_EXPR, tmp, gfc_finish_block (&block2),
+		  build_empty_stmt (input_location));
+  gfc_add_expr_to_block (&block, tmp);
+
+post_call:
+  gfc_add_block_to_block (&block, &se.post);
+  if (present && block.head)
+    {
+      tmp = build3_v (COND_EXPR, present, gfc_finish_block (&block),
+                      build_empty_stmt (input_location));
       gfc_add_expr_to_block (&parmse->post, tmp);
     }
+  else if (block.head)
+    gfc_add_block_to_block (&parmse->post, &block);
+
+
+// Update pointer 
+// If char -> update length
+// (e->ts.type != BT_CHARACTER || !e->ts.u.cl->length)))*
+// If array, update descriptor etc. -> else = done.
 }
 
 
@@ -5761,17 +6048,12 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
        arg = arg->next, formal = formal ? formal->next : NULL, ++argc)
     {
       bool finalized = false;
-      bool assumed_length_string = false;
       tree derived_array = NULL_TREE;
 
       e = arg->expr;
       fsym = formal ? formal->sym : NULL;
       parm_kind = MISSING;
 
-      if (fsym && fsym->ts.type == BT_CHARACTER
-	  && (!fsym->ts.u.cl || !fsym->ts.u.cl->length))
-	assumed_length_string = true;
-
       /* If the procedure requires an explicit interface, the actual
 	 argument is passed according to the corresponding formal
 	 argument.  If the corresponding formal argument is a POINTER,
@@ -6002,9 +6284,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		    parmse.expr = convert (type, tmp);
 		}
 
-	      else if (sym->attr.is_bind_c && e
-		       && (is_CFI_desc (fsym, NULL)
-			   || assumed_length_string))
+	      else if (sym->attr.is_bind_c && e && is_CFI_desc (fsym, NULL))
 		/* Implement F2018, 18.3.6, list item (5), bullet point 2.  */
 		gfc_conv_gfc_desc_to_cfi_desc (&parmse, e, fsym);
 
@@ -6214,7 +6494,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		  if (fsym && fsym->attr.intent == INTENT_OUT
 		      && (fsym->attr.allocatable
 			  || (fsym->ts.type == BT_CLASS
-			      && CLASS_DATA (fsym)->attr.allocatable)))
+			      && CLASS_DATA (fsym)->attr.allocatable))
+		      && !is_CFI_desc (fsym, NULL))
 		    {
 		      stmtblock_t block;
 		      tree ptr;
@@ -6448,8 +6729,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		    parmse.force_tmp = 1;
 		}
 
-	      if (sym->attr.is_bind_c && e
-		  && (is_CFI_desc (fsym, NULL) || assumed_length_string))
+	      if (sym->attr.is_bind_c && e && is_CFI_desc (fsym, NULL))
 		/* Implement F2018, 18.3.6, list item (5), bullet point 2.  */
 		gfc_conv_gfc_desc_to_cfi_desc (&parmse, e, fsym);
 
@@ -6536,9 +6816,11 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		}
 
 	      /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is
-		 allocated on entry, it must be deallocated.  */
+		 allocated on entry, it must be deallocated.
+		 CFI descriptors are handled elsewhere.  */
 	      if (fsym && fsym->attr.allocatable
-		  && fsym->attr.intent == INTENT_OUT)
+		  && fsym->attr.intent == INTENT_OUT
+		  && !is_CFI_desc (fsym, NULL))
 		{
 		  if (fsym->ts.type == BT_DERIVED
 		      && fsym->ts.u.derived->attr.alloc_comp)
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 11df1863bad..466109e8af3 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -3669,10 +3669,7 @@ gfc_trans_select_rank_cases (gfc_code * code)
   tree tmp;
   tree cond;
   tree low;
-  tree sexpr;
   tree rank;
-  tree rank_minus_one;
-  tree minus_one;
   gfc_se se;
   gfc_se cse;
   stmtblock_t block;
@@ -3686,24 +3683,25 @@ gfc_trans_select_rank_cases (gfc_code * code)
   gfc_conv_expr_descriptor (&se, code->expr1);
   rank = gfc_conv_descriptor_rank (se.expr);
   rank = gfc_evaluate_now (rank, &block);
-  minus_one = build_int_cst (TREE_TYPE (rank), -1);
-  tmp = fold_build2_loc (input_location, MINUS_EXPR,
-			 gfc_array_index_type,
-			 fold_convert (gfc_array_index_type, rank),
-			 build_int_cst (gfc_array_index_type, 1));
-  rank_minus_one = gfc_evaluate_now (tmp, &block);
-  tmp = gfc_conv_descriptor_ubound_get (se.expr, rank_minus_one);
-  cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
-			  tmp, build_int_cst (TREE_TYPE (tmp), -1));
-  tmp = fold_build3_loc (input_location, COND_EXPR,
-			 TREE_TYPE (rank), cond,
-			 rank, minus_one);
-  cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
-			  rank, build_int_cst (TREE_TYPE (rank), 0));
-  sexpr = fold_build3_loc (input_location, COND_EXPR,
-			   TREE_TYPE (rank), cond,
-			   rank, tmp);
-  sexpr = gfc_evaluate_now (sexpr, &block);
+  symbol_attribute attr = gfc_expr_attr (code->expr1);
+  if (!attr.pointer || !attr.allocatable)
+    {
+      /* Special case for assumed-rank ('rank(*)', internally -1):
+	 rank = (rank == 0 || ubound[rank-1] != -1) ? rank : -1.  */
+      cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
+			      rank, build_int_cst (TREE_TYPE (rank), 0));
+      tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			     fold_convert (gfc_array_index_type, rank),
+			     gfc_index_one_node);
+      tmp = gfc_conv_descriptor_ubound_get (se.expr, tmp);
+      tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
+			     tmp, build_int_cst (TREE_TYPE (tmp), -1));
+      cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR,
+			      logical_type_node, cond, tmp);
+      tmp = fold_build3_loc (input_location, COND_EXPR, TREE_TYPE (rank),
+			     cond, rank, build_int_cst (TREE_TYPE (rank), -1));
+      rank = gfc_evaluate_now (tmp, &block);
+    }
   TREE_USED (code->exit_label) = 0;
 
 repeat:
@@ -3747,8 +3745,8 @@ repeat:
       if (low != NULL_TREE)
 	{
 	  cond = fold_build2_loc (input_location, EQ_EXPR,
-				  TREE_TYPE (sexpr), sexpr,
-				  fold_convert (TREE_TYPE (sexpr), low));
+				  TREE_TYPE (rank), rank,
+				  fold_convert (TREE_TYPE (rank), low));
 	  tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
 				 cond, tmp,
 				 build_empty_stmt (input_location));
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 1c78a906397..d76d1bd8e54 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -77,6 +77,7 @@ static GTY(()) tree gfc_desc_dim_type;
 static GTY(()) tree gfc_max_array_element_size;
 static GTY(()) tree gfc_array_descriptor_base[2 * (GFC_MAX_DIMENSIONS+1)];
 static GTY(()) tree gfc_array_descriptor_base_caf[2 * (GFC_MAX_DIMENSIONS+1)];
+static GTY(()) tree gfc_cfi_descriptor_base[2 * (CFI_MAX_RANK + 2)];
 
 /* Arrays for all integral and real kinds.  We'll fill this in at runtime
    after the target has a chance to process command-line options.  */
@@ -1575,8 +1576,9 @@ gfc_get_dtype_rank_type (int rank, tree etype)
 
   field = gfc_advance_chain (TYPE_FIELDS (dtype_type_node),
 			     GFC_DTYPE_RANK);
-  CONSTRUCTOR_APPEND_ELT (v, field,
-			  build_int_cst (TREE_TYPE (field), rank));
+  if (rank >= 0)
+    CONSTRUCTOR_APPEND_ELT (v, field,
+			    build_int_cst (TREE_TYPE (field), rank));
 
   field = gfc_advance_chain (TYPE_FIELDS (dtype_type_node),
 			     GFC_DTYPE_TYPE);
@@ -2244,7 +2246,7 @@ gfc_nonrestricted_type (tree t)
    especially for character and array types.  */
 
 tree
-gfc_sym_type (gfc_symbol * sym)
+gfc_sym_type (gfc_symbol * sym, bool is_bind_c)
 {
   tree type;
   int byref;
@@ -2299,7 +2301,11 @@ gfc_sym_type (gfc_symbol * sym)
   if (!restricted)
     type = gfc_nonrestricted_type (type);
 
-  if (sym->attr.dimension || sym->attr.codimension)
+  /* Dummy argument to a bind(C) procedure.  */
+  if (is_bind_c && is_CFI_desc (sym, NULL))
+    type = gfc_get_cfi_type (sym->attr.dimension ? sym->as->rank : 0,
+			     restricted);
+  else if (sym->attr.dimension || sym->attr.codimension)
     {
       if (gfc_is_nodesc_array (sym))
         {
@@ -3131,7 +3137,7 @@ gfc_get_function_type (gfc_symbol * sym, gfc_actual_arglist *actual_args,
 	      type = build_pointer_type (type);
 	    }
 	  else
-	    type = gfc_sym_type (arg);
+	    type = gfc_sym_type (arg, sym->attr.is_bind_c);
 
 	  /* Parameter Passing Convention
 
@@ -3722,4 +3728,93 @@ gfc_get_caf_reference_type ()
   return reference_type;
 }
 
+static tree
+gfc_get_cfi_dim_type ()
+{
+  static tree CFI_dim_t = NULL;
+
+  if (CFI_dim_t)
+    return CFI_dim_t;
+
+  CFI_dim_t = make_node (RECORD_TYPE);
+  TYPE_NAME (CFI_dim_t) = get_identifier ("CFI_dim_t");
+  TYPE_NAMELESS (CFI_dim_t) = 1;
+  tree field;
+  tree *chain = NULL;
+  field = gfc_add_field_to_struct_1 (CFI_dim_t, get_identifier ("lower_bound"),
+				     gfc_array_index_type, &chain);
+  suppress_warning (field);
+  field = gfc_add_field_to_struct_1 (CFI_dim_t, get_identifier ("extent"),
+				     gfc_array_index_type, &chain);
+  suppress_warning (field);
+  field = gfc_add_field_to_struct_1 (CFI_dim_t, get_identifier ("sm"),
+				     gfc_array_index_type, &chain);
+  suppress_warning (field);
+  gfc_finish_type (CFI_dim_t);
+  TYPE_DECL_SUPPRESS_DEBUG (TYPE_STUB_DECL (CFI_dim_t)) = 1;
+  return CFI_dim_t;
+}
+
+
+/* Return the CFI type; use dimen == -1 for dim[] (only for pointers);
+   otherwise dim[dimen] is used.  */
+
+tree
+gfc_get_cfi_type (int dimen, bool restricted)
+{
+  gcc_assert (dimen >= -1 && dimen <= CFI_MAX_RANK);
+
+  int idx = 2*(dimen + 1) + restricted;
+
+  if (gfc_cfi_descriptor_base[idx])
+    return gfc_cfi_descriptor_base[idx];
+
+  /* Build the type node.  */
+  tree CFI_cdesc_t = make_node (RECORD_TYPE);
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  if (dimen != -1)
+    sprintf (name, "CFI_cdesc_t" GFC_RANK_PRINTF_FORMAT, dimen);
+  TYPE_NAME (CFI_cdesc_t) = get_identifier (dimen < 0 ? "CFI_cdesc_t" : name);
+  TYPE_NAMELESS (CFI_cdesc_t) = 1;
+
+  tree field;
+  tree *chain = NULL;
+  field = gfc_add_field_to_struct_1 (CFI_cdesc_t, get_identifier ("base_addr"),
+				     (restricted ? prvoid_type_node
+						 : ptr_type_node), &chain);
+  suppress_warning (field);
+  field = gfc_add_field_to_struct_1 (CFI_cdesc_t, get_identifier ("elem_len"),
+				     size_type_node, &chain);
+  suppress_warning (field);
+  field = gfc_add_field_to_struct_1 (CFI_cdesc_t, get_identifier ("version"),
+				     integer_type_node, &chain);
+  suppress_warning (field);
+  field = gfc_add_field_to_struct_1 (CFI_cdesc_t, get_identifier ("rank"),
+				     signed_char_type_node, &chain);
+  suppress_warning (field);
+  field = gfc_add_field_to_struct_1 (CFI_cdesc_t, get_identifier ("attribute"),
+				     signed_char_type_node, &chain);
+  suppress_warning (field);
+  field = gfc_add_field_to_struct_1 (CFI_cdesc_t, get_identifier ("type"),
+				     get_typenode_from_name (INT16_TYPE),
+				     &chain);
+  suppress_warning (field);
+
+  if (dimen != 0)
+    {
+      tree range = NULL_TREE;
+      if (dimen > 0)
+	range = build_range_type (gfc_array_index_type, gfc_index_zero_node,
+				  gfc_rank_cst[dimen - 1]);
+      tree CFI_dim_t = build_array_type (gfc_get_cfi_dim_type (), range);
+      field = gfc_add_field_to_struct_1 (CFI_cdesc_t, get_identifier ("dim"),
+					 CFI_dim_t, &chain);
+      suppress_warning (field);
+    }
+
+  gfc_finish_type (CFI_cdesc_t);
+  gfc_cfi_descriptor_base[idx] = CFI_cdesc_t;
+  return CFI_cdesc_t;
+}
+
 #include "gt-fortran-trans-types.h"
diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h
index 3b45ce25666..f8bccec79f8 100644
--- a/gcc/fortran/trans-types.h
+++ b/gcc/fortran/trans-types.h
@@ -84,7 +84,8 @@ tree gfc_get_character_type (int, gfc_charlen *);
 tree gfc_get_character_type_len (int, tree);
 tree gfc_get_character_type_len_for_eltype (tree, tree);
 
-tree gfc_sym_type (gfc_symbol *);
+tree gfc_sym_type (gfc_symbol *, bool is_bind_c_arg = false);
+tree gfc_get_cfi_type (int dimen, bool restricted);
 tree gfc_typenode_for_spec (gfc_typespec *, int c = 0);
 int gfc_copy_dt_decls_ifequal (gfc_symbol *, gfc_symbol *, bool);
 
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index eb5682a7cda..22f267645e8 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -608,9 +608,9 @@ gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock,
 
   if (once)
     {
-       tmpvar = gfc_create_var (logical_type_node, "print_warning");
+       tmpvar = gfc_create_var (boolean_type_node, "print_warning");
        TREE_STATIC (tmpvar) = 1;
-       DECL_INITIAL (tmpvar) = logical_true_node;
+       DECL_INITIAL (tmpvar) = boolean_true_node;
        gfc_add_expr_to_block (pblock, tmpvar);
     }
 
@@ -631,7 +631,7 @@ gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock,
   va_end (ap);
 
   if (once)
-    gfc_add_modify (&block, tmpvar, logical_false_node);
+    gfc_add_modify (&block, tmpvar, boolean_false_node);
 
   body = gfc_finish_block (&block);
 
@@ -643,9 +643,8 @@ gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock,
     {
       if (once)
 	cond = fold_build2_loc (gfc_get_location (where), TRUTH_AND_EXPR,
-				long_integer_type_node, tmpvar, cond);
-      else
-	cond = fold_convert (long_integer_type_node, cond);
+				boolean_type_node, tmpvar,
+				fold_convert (boolean_type_node, cond));
 
       tmp = fold_build3_loc (gfc_get_location (where), COND_EXPR, void_type_node,
 			     cond, body,
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 78578cfd732..897c5d60b2a 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -855,8 +855,6 @@ extern GTY(()) tree gfor_fndecl_ctime;
 extern GTY(()) tree gfor_fndecl_fdate;
 extern GTY(()) tree gfor_fndecl_in_pack;
 extern GTY(()) tree gfor_fndecl_in_unpack;
-extern GTY(()) tree gfor_fndecl_cfi_to_gfc;
-extern GTY(()) tree gfor_fndecl_gfc_to_cfi;
 extern GTY(()) tree gfor_fndecl_associated;
 extern GTY(()) tree gfor_fndecl_system_clock4;
 extern GTY(()) tree gfor_fndecl_system_clock8;
diff --git a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_4.f90 b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_4.f90
index 7731d1a6c88..c596e47cfdd 100644
--- a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_4.f90
+++ b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_4.f90
@@ -19,23 +19,37 @@ contains
 
   subroutine substr(str) BIND(C)
     character(*) :: str(:)
-    if (str(2) .ne. "ghi") stop 2
+    if (str(1) .ne. "bcd") stop 2
+    if (str(2) .ne. "ghi") stop 3
     str = ['uvw','xyz']
   end subroutine
 
+  subroutine substr4(str4) BIND(C)
+    character(*, kind=4) :: str4(:)
+    print *, str4(1)
+    print *, str4(2)
+    if (str4(1) .ne. 4_"bcd") stop 4
+    if (str4(2) .ne. 4_"ghi") stop 5
+    str4 = [4_'uvw', 4_'xyz']
+  end subroutine
+
 end module
 
 program p
   use mod_ctg
   implicit none
   real :: x(6)
-  character(5) :: str(2) = ['abcde','fghij']
+  character(5)         :: str(2)  = ['abcde', 'fghij']
+  character(5, kind=4) :: str4(2) = [4_'abcde', 4_'fghij']
   integer :: i
 
   x = [ (real(i), i=1, size(x)) ]
   call ctg(x(2::2))
   if (any (abs (x - [1.,20.,3.,40.,5.,60.]) > 1.e-6)) stop 3
 
-  call substr(str(:)(2:4))
-  if (any (str .ne. ['auvwe','fxyzj'])) stop 4
+  !call substr(str(:)(2:4))
+  !if (any (str .ne. ['auvwe','fxyzj'])) stop 4
+
+  call substr4(str4(:)(2:4))
+  if (any (str4 .ne. [4_'auvwe', 4_'fxyzj'])) stop 4
 end program
diff --git a/gcc/testsuite/gfortran.dg/PR93963.f90 b/gcc/testsuite/gfortran.dg/PR93963.f90
index 4e1b06fd525..e2174627242 100644
--- a/gcc/testsuite/gfortran.dg/PR93963.f90
+++ b/gcc/testsuite/gfortran.dg/PR93963.f90
@@ -3,6 +3,8 @@
 ! Test the fix for PR93963
 !
 
+module m
+contains
 function rank_p(this) result(rnk) bind(c)
   use, intrinsic :: iso_c_binding, only: c_int
 
@@ -11,6 +13,13 @@ function rank_p(this) result(rnk) bind(c)
   integer(kind=c_int), pointer, intent(in) :: this(..)
   integer(kind=c_int)                      :: rnk
 
+  if (.not. associated (this)) then
+    rnk = rank (this)
+    return
+  end if
+
+  ! Only valid when associated
+  ! As otherweise, only inquiry functions permitted.
   select rank(this)
   rank(0)
     rnk = 0
@@ -58,6 +67,13 @@ function rank_a(this) result(rnk) bind(c)
   integer(kind=c_int), allocatable, intent(in) :: this(..)
   integer(kind=c_int)                          :: rnk
 
+  if (.not. allocated (this)) then
+    rnk = rank (this)
+    return
+  end if
+
+  ! Only valid when allocated
+  ! As otherweise, only inquiry functions permitted.
   select rank(this)
   rank(0)
     rnk = 0
@@ -97,27 +113,60 @@ function rank_a(this) result(rnk) bind(c)
   return
 end function rank_a
 
-program selr_p
-
+function rank_o(this) result(rnk) bind(c)
   use, intrinsic :: iso_c_binding, only: c_int
 
   implicit none
+  
+  integer(kind=c_int), intent(in) :: this(..)
+  integer(kind=c_int)             :: rnk
 
-  interface
-    function rank_p(this) result(rnk) bind(c)
-      use, intrinsic :: iso_c_binding, only: c_int
-      integer(kind=c_int), pointer, intent(in) :: this(..)
-      integer(kind=c_int)                      :: rnk
-    end function rank_p
-  end interface
-
-  interface
-    function rank_a(this) result(rnk) bind(c)
-      use, intrinsic :: iso_c_binding, only: c_int
-      integer(kind=c_int), allocatable, intent(in) :: this(..)
-      integer(kind=c_int)                          :: rnk
-    end function rank_a
-  end interface
+  select rank(this)
+  rank(0)
+    rnk = 0
+  rank(1)
+    rnk = 1
+  rank(2)
+    rnk = 2
+  rank(3)
+    rnk = 3
+  rank(4)
+    rnk = 4
+  rank(5)
+    rnk = 5
+  rank(6)
+    rnk = 6
+  rank(7)
+    rnk = 7
+  rank(8)
+    rnk = 8
+  rank(9)
+    rnk = 9
+  rank(10)
+    rnk = 10
+  rank(11)
+    rnk = 11
+  rank(12)
+    rnk = 12
+  rank(13)
+    rnk = 13
+  rank(14)
+    rnk = 14
+  rank(15)
+    rnk = 15
+  rank default
+    rnk = -1000
+  end select
+  return
+end function rank_o
+
+end module m
+
+program selr_p
+  use m
+  use, intrinsic :: iso_c_binding, only: c_int
+
+  implicit none
 
   integer(kind=c_int), parameter :: siz = 7
   integer(kind=c_int), parameter :: rnk = 1
@@ -139,12 +188,19 @@ program selr_p
   irnk = rank_p(intp)
   if (irnk /= rnk)        stop 5
   if (irnk /= rank(intp)) stop 6
+  irnk = rank_o(intp)
+  if (irnk /= rnk)        stop 7
+  if (irnk /= rank(intp)) stop 8
   deallocate(intp)
   nullify(intp)
   !
   allocate(inta(siz))
-  if (irnk /= rnk)        stop 7
-  if (irnk /= rank(inta)) stop 8
+  irnk = rank_a(inta)
+  if (irnk /= rnk)        stop 9
+  if (irnk /= rank(inta)) stop 10
+  irnk = rank_o(inta)
+  if (irnk /= rnk)        stop 11
+  if (irnk /= rank(inta)) stop 12
   deallocate(inta)
 
 end program selr_p
diff --git a/gcc/testsuite/gfortran.dg/assumed_type_12.f90 b/gcc/testsuite/gfortran.dg/assumed_type_12.f90
new file mode 100644
index 00000000000..852fd41445d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_type_12.f90
@@ -0,0 +1,35 @@
+! PR fortran/102086
+
+implicit none (type, external)
+contains
+subroutine as(a)
+  type(*) :: a(:,:)
+end
+subroutine ar(b)
+  type(*) :: b(..)
+end
+subroutine bar(x,y)
+  type(*) :: x
+  type(*) :: y(3,*)
+  call as(x)  ! { dg-error "Rank mismatch in argument 'a' at .1. \\(rank-2 and scalar\\)" }
+  call ar(x)  ! { dg-error "Assumed-type actual argument at .1. must be of assumed rank or assumed shape as dummy argument 'b' has assumed rank" }
+  call as(y)  ! { dg-error "Actual argument for 'a' cannot be an assumed-size array" }
+  call ar(y)  ! { dg-error "Assumed-type actual argument at .1. must be of assumed rank or assumed shape as dummy argument 'b' has assumed rank" }
+  call as(y(1,3))  ! { dg-error "Assumed-type variable y at .1. shall not have a subobject reference" }
+  call ar(y(1,3))  ! { dg-error "Assumed-type variable y at .1. shall not have a subobject reference" }
+  call as(y(1:1,3:3))  ! { dg-error "Assumed-type variable y at .1. shall not have a subobject reference" }
+  call ar(y(1:1,3:3))  ! { dg-error "Assumed-type variable y at .1. shall not have a subobject reference" }
+end
+
+subroutine okayish(x,y,z)
+  type(*) :: x(:)
+  type(*) :: y(:,:)
+  type(*) :: z(..)
+  call as(x) ! { dg-error "Rank mismatch in argument 'a' at .1. \\(rank-2 and rank-1\\)" }
+  call as(y) 
+  call as(z) ! { dg-error "The assumed-rank array at .1. requires that the dummy argument 'a' has assumed-rank" }
+  call ar(x)
+  call ar(y)
+  call ar(z)
+end
+end
diff --git a/gcc/testsuite/gfortran.dg/bind-c-intent-out.f90 b/gcc/testsuite/gfortran.dg/bind-c-intent-out.f90
index 39822c0753a..b159ba808fc 100644
--- a/gcc/testsuite/gfortran.dg/bind-c-intent-out.f90
+++ b/gcc/testsuite/gfortran.dg/bind-c-intent-out.f90
@@ -32,11 +32,14 @@ program p
 end program p
 
 ! "cfi" only appears in context of "a" -> bind-C descriptor
-! the intent(out) implies freeing in the callee (!), hence the "free"
+! the intent(out) implies freeing in the callee (!) (when implemented in Fortran), hence the "free"
+! and also in the caller (when implemented in Fortran)
 ! It is the only 'free' as 'a' is part of the main program and, hence, implicitly has the SAVE attribute.
 ! The  'cfi = 0' appears before the call due to the deallocate and when preparing the C descriptor
 ! As cfi (i.e. the descriptor itself) is allocated in libgomp, it has to be freed after the call.
 
 ! { dg-final { scan-tree-dump-times "__builtin_free" 2 "original" } }
-! { dg-final { scan-tree-dump-times "__builtin_free \\(cfi\\.\[0-9\]+\\);" 2 "original" } }
-! { dg-final { scan-tree-dump-times "cfi\\.\[0-9\]+ = 0B;" 2 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_free \\(_x->base_addr\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_x->base_addr = 0B;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_free \\(cfi\\.\[0-9\]+\\.base_addr\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "cfi\\.\[0-9\]+\\.base_addr = 0B;" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/bind_c_array_params_2.f90 b/gcc/testsuite/gfortran.dg/bind_c_array_params_2.f90
index ede6eff67fa..688fb972527 100644
--- a/gcc/testsuite/gfortran.dg/bind_c_array_params_2.f90
+++ b/gcc/testsuite/gfortran.dg/bind_c_array_params_2.f90
@@ -22,4 +22,32 @@ end
 ! { dg-final { scan-assembler-times "brasl\t%r\[0-9\]*,myBindC" 1 { target { s390*-*-* } } } }
 ! { dg-final { scan-assembler-times "bl \.myBindC" 1 { target { powerpc-ibm-aix* } } } }
 ! { dg-final { scan-assembler-times "add_u32\t\[sv\]\[0-9\]*, \[sv\]\[0-9\]*, myBindC@rel32@lo" 1 { target { amdgcn*-*-* } } } }
-! { dg-final { scan-tree-dump-times "gfc_desc_to_cfi_desc \\\(&cfi\\." 1 "original" } }
+
+
+! { dg-final { scan-tree-dump "parm...span = 4;" "original" } }
+! { dg-final { scan-tree-dump "parm...dtype = {.elem_len=4, .rank=2, .type=1};" "original" } }
+! { dg-final { scan-tree-dump "parm...dim\\\[0\\\].lbound = 1;" "original" } }
+! { dg-final { scan-tree-dump "parm...dim\\\[0\\\].ubound = 4;" "original" } }
+! { dg-final { scan-tree-dump "parm...dim\\\[0\\\].stride = 1;" "original" } }
+! { dg-final { scan-tree-dump "parm...dim\\\[1\\\].lbound = 1;" "original" } }
+! { dg-final { scan-tree-dump "parm...dim\\\[1\\\].ubound = 4;" "original" } }
+! { dg-final { scan-tree-dump "parm...dim\\\[1\\\].stride = 4;" "original" } }
+! { dg-final { scan-tree-dump "parm...data = \\(void \\*\\) &aa\\\[0\\\];" "original" } }
+! { dg-final { scan-tree-dump "parm...offset = -5;" "original" } }
+! { dg-final { scan-tree-dump "cfi...version = 1;" "original" } }
+! { dg-final { scan-tree-dump "cfi...rank = 2;" "original" } }
+! { dg-final { scan-tree-dump "cfi...type = 1025;" "original" } }
+! { dg-final { scan-tree-dump "cfi...attribute = 2;" "original" } }
+! { dg-final { scan-tree-dump "cfi...base_addr = parm.0.data;" "original" } }
+! { dg-final { scan-tree-dump "cfi...elem_len = 4;" "original" } }
+! { dg-final { scan-tree-dump "idx.2 = 0;" "original" } }
+
+! { dg-final { scan-tree-dump "if \\(idx.. > 1\\) goto L..;" "original" } }
+! { dg-final { scan-tree-dump "cfi...dim\\\[idx..\\\].lower_bound = 0;" "original" } }
+! { dg-final { scan-tree-dump "cfi...dim\\\[idx..\\\].extent = \\(parm...dim\\\[idx..\\\].ubound - parm...dim\\\[idx..\\\].lbound\\) \\+ 1;" "original" } }
+! { dg-final { scan-tree-dump "cfi...dim\\\[idx..\\\].sm = parm...dim\\\[idx..\\\].stride \\* parm...span;" "original" } }
+! { dg-final { scan-tree-dump "idx.. = idx.. \\+ 1;" "original" } }
+
+! { dg-final { scan-tree-dump "test \\(&cfi..\\);" "original" } }
+
+
diff --git a/gcc/testsuite/gfortran.dg/bind_c_char_10.f90 b/gcc/testsuite/gfortran.dg/bind_c_char_10.f90
index 35958515d38..7c6f4dcc961 100644
--- a/gcc/testsuite/gfortran.dg/bind_c_char_10.f90
+++ b/gcc/testsuite/gfortran.dg/bind_c_char_10.f90
@@ -466,15 +466,16 @@ program main
 end
 
 ! All arguments shall use array descriptors
-! { dg-final { scan-tree-dump-times "void as1 \\(struct array01_character\\(kind=1\\) & restrict x1\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "void as2 \\(struct array01_character\\(kind=1\\) & restrict x2\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "void as4 \\(struct array01_character\\(kind=1\\) & restrict xstar\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "void as3 \\(struct array01_character\\(kind=1\\) & restrict xn, integer(kind=4) & restrict n)
-! { dg-final { scan-tree-dump-times "void ar1 \\(struct array15_character\\(kind=1\\) & restrict x1\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "void ar2 \\(struct array15_character\\(kind=1\\) & restrict x2\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "void ar3 \\(struct array15_character\\(kind=1\\) & restrict xn, integer(kind=4) & restrict n)
-! { dg-final { scan-tree-dump-times "void ar4 \\(struct array15_character\\(kind=1\\) & restrict xstar\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "void a5a \\(struct array01_character\\(kind=1\\) & restrict xcolon\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "void a5ar \\(struct array15_character\\(kind=1\\) & restrict xcolon\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "void a5p \\(struct array01_character\\(kind=1\\) & xcolon\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "void a5pr \\(struct array15_character\\(kind=1\\) & xcolon\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void as1 \\(struct CFI_cdesc_t01 & restrict _x1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void as2 \\(struct CFI_cdesc_t01 & restrict _x2\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void as3 \\(struct CFI_cdesc_t01 & restrict _xn, integer\\(kind=4\\) & restrict n\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void as4 \\(struct CFI_cdesc_t01 & restrict _xstar\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void ar1 \\(struct CFI_cdesc_t & restrict _x1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void ar2 \\(struct CFI_cdesc_t & restrict _x2\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void ar3 \\(struct CFI_cdesc_t & restrict _xn, integer\\(kind=4\\) & restrict n\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void ar4 \\(struct CFI_cdesc_t & restrict _xstar\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void a5ar \\(struct CFI_cdesc_t & restrict _xcolon\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void a5a \\(struct CFI_cdesc_t01 & restrict _xcolon\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void a5pr \\(struct CFI_cdesc_t & _xcolon\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void a5p \\(struct CFI_cdesc_t01 & _xcolon\\)" 1 "original" } }
+
diff --git a/libgfortran/runtime/ISO_Fortran_binding.c b/libgfortran/runtime/ISO_Fortran_binding.c
index f8b3ecd0046..b38eb0bbcb0 100644
--- a/libgfortran/runtime/ISO_Fortran_binding.c
+++ b/libgfortran/runtime/ISO_Fortran_binding.c
@@ -34,6 +34,8 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 extern void cfi_desc_to_gfc_desc (gfc_array_void *, CFI_cdesc_t **);
 export_proto(cfi_desc_to_gfc_desc);
 
+/* NOTE: Since GCC 12, the FE generates code to do the conversion
+   directly without calling this function.  */
 void
 cfi_desc_to_gfc_desc (gfc_array_void *d, CFI_cdesc_t **s_ptr)
 {
@@ -111,6 +113,8 @@ cfi_desc_to_gfc_desc (gfc_array_void *d, CFI_cdesc_t **s_ptr)
 extern void gfc_desc_to_cfi_desc (CFI_cdesc_t **, const gfc_array_void *);
 export_proto(gfc_desc_to_cfi_desc);
 
+/* NOTE: Since GCC 12, the FE generates code to do the conversion
+   directly without calling this function.  */
 void
 gfc_desc_to_cfi_desc (CFI_cdesc_t **d_ptr, const gfc_array_void *s)
 {
