Patchwork [Fortran-dev] Implement TS29113 type handling

login
register
mail settings
Submitter Tobias Burnus
Date April 26, 2013, 8:02 p.m.
Message ID <517ADD55.2020709@net-b.de>
Download mbox | patch
Permalink /patch/240042/
State New
Headers show

Comments

Tobias Burnus - April 26, 2013, 8:02 p.m.
This patch implements the TS29113 type handling. However, there is a 
catch: It does not fix any regression but adds two new ones:

gfortran.dg/mvbits_7.f90
gfortran.dg/mvbits_8.f90

The problem with those is that this patch correctly sets the elem_len; 
that might cause that elem_len and sm do not agree with another. That 
issue shows up with packing:
   type t
      integer :: i, j
   end type t
   type(t), pointer :: x(:)
   call bar(x(:)%i)

Here, "x(:)%i" has the elem_len=4 (= "integer(4)") while the stride 
multiplier is dim[0].sm = 8. Before, the old code used the 
TYPE_UNIT_SIZE(element_type(prev-desc)), which was 8. Usually, that 
shouldn't cause a problem - except if one doesn't start with the first 
element but has a span (possibly with negative strides). In that base, 
the code sets:  "base_addr[offset]" - and the offset calculation is 
based on the element size. It should be "((char*)base_addr) + 
byte_offset"  instead. Namely, gfc_get_dataptr_offset has to be fixed.

Another issue is that in gfc_trans_create_temp_array, the elem_len 
cannot always be set for strings, e.g. the call from TRANSFER where the 
string is the result of a function call - in that case, the string 
length is not available. I haven't tried to check whether the elem_len 
gets properly set later on or not.


But now to the good stuff:
* The type handling now matches TS29113 and in the array functions, 
real(10) and real(16) can be distinguished.
* Even more C examples using the TS29113 interop work now (I had to fix 
some bugs)
* The used data types in the descriptor has been updated - it is a bit 
more compact now
* Some ubound -> extent changes have been done.

Build and regtested on x86-64-gnu-linux.

Do you have comments to that patch? - Or on the general direction/on the 
previous patches?


TODO:
* The most obvious candidate is  gfc_get_dataptr_offset as that one 
caused the new regression. (As follow up: Other code which assumes that 
strides are multiples of an element - for the subelement arrays)
* Internally, lower_bound should start with 0 at some cases (see 
TS29113) - to fix more of the C interop
* Fix remaining testsuite issues (still 22 test-case files fail), see 
also PR56818
* Remove "offset" field
* Other bugs, cleanup, ...

Tobias
Tobias Burnus - April 30, 2013, 10:18 a.m.
Tobias Burnus wrote:
> This patch implements the TS29113 type handling.

I have now committed this patch as Rev. 198447, 
http://gcc.gnu.org/ml/gcc-cvs/2013-04/msg01155.html

The commit contains the -m32 corrections of Dominique, 
http://gcc.gnu.org/ml/fortran/2013-04/msg00248.html

Tobias

Patch

tob@archimedes:~/projects/gcc/gcc/testsuite > diffstat /dev/shm/array-desc-type-v2.diff
 b/gcc/fortran/libgfortran.h                              |   23 -
 b/gcc/fortran/trans-array.c                              |  134 +++---
 b/gcc/fortran/trans-array.h                              |    7 
 b/gcc/fortran/trans-decl.c                               |    4 
 b/gcc/fortran/trans-expr.c                               |   43 +-
 b/gcc/fortran/trans-intrinsic.c                          |   39 -
 b/gcc/fortran/trans-io.c                                 |   16 
 b/gcc/fortran/trans-stmt.c                               |   21 -
 b/gcc/fortran/trans-types.c                              |  165 ++-----
 b/gcc/fortran/trans-types.h                              |    2 
 b/gcc/fortran/trans.c                                    |    4 
 b/gcc/fortran/trans.h                                    |    3 
 b/gcc/testsuite/gfortran.dg/assign_10.f90                |    2 
 b/gcc/testsuite/gfortran.dg/assumed_rank_12.f90          |    3 
 b/gcc/testsuite/gfortran.dg/c_loc_test_22.f90            |   10 
 b/gcc/testsuite/gfortran.dg/class_allocate_14.f90        |    3 
 b/gcc/testsuite/gfortran.dg/iso-ts-29113_1_c.c           |    4 
 b/gcc/testsuite/gfortran.dg/transpose_optimization_2.f90 |    2 
 b/libgfortran/ISO_Fortran_binding.h.tmpl                 |   22 -
 b/libgfortran/intrinsics/associated.c                    |    2 
 b/libgfortran/intrinsics/cshift0.c                       |   63 +--
 b/libgfortran/intrinsics/date_and_time.c                 |    4 
 b/libgfortran/intrinsics/iso_c_binding.c                 |   11 
 b/libgfortran/intrinsics/pack_generic.c                  |  154 +++----
 b/libgfortran/intrinsics/spread_generic.c                |  282 ++++++-------
 b/libgfortran/intrinsics/unpack_generic.c                |  313 +++++++--------
 b/libgfortran/io/io.h                                    |    6 
 b/libgfortran/io/list_read.c                             |   40 -
 b/libgfortran/io/transfer.c                              |   22 -
 b/libgfortran/io/write.c                                 |   26 -
 b/libgfortran/libgfortran.h                              |   95 ----
 b/libgfortran/runtime/in_pack_generic.c                  |  119 ++---
 b/libgfortran/runtime/in_unpack_generic.c                |  136 +++---
 b/libgfortran/runtime/iso_ts29113.c                      |    9 
 gcc/gcc/testsuite/gfortran.dg/iso-ts-29113_2.f90         |  158 +++++++
 gcc/gcc/testsuite/gfortran.dg/iso-ts-29113_3.f90         |   71 +++
 gcc/gcc/testsuite/gfortran.dg/iso-ts-29113_3_c.c         |  206 +++++++++
 37 files changed, 1239 insertions(+), 985 deletions(-)

diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h
index 1444038..672a8d2 100644
--- a/gcc/fortran/libgfortran.h
+++ b/gcc/fortran/libgfortran.h
@@ -115,9 +115,24 @@  libgfortran_stat_codes;
 
 #define GFC_MAX_DIMENSIONS 15
 
-#define GFC_DTYPE_TYPE_SHIFT 3
-#define GFC_DTYPE_TYPE_MASK 0x38
-#define GFC_DTYPE_SIZE_SHIFT 6
+#define GFC_TYPE_MASK 0xFF
+#define GFC_TYPE_KIND_SHIFT 8
+
+/* Array-descriptor attributes, see ISO_Fortran_binding.h.  */
+#define GFC_ATTRIBUTE_POINTER 1
+#define GFC_ATTRIBUTE_ALLOCATABLE 2
+#define GFC_ATTRIBUTE_OTHER 3
+
+/* Array-descriptor basic types, see ISO_Fortran_binding.h.  */
+#define GFC_TYPE_INTEGER 1
+#define GFC_TYPE_LOGICAL 2
+#define GFC_TYPE_REAL 3
+#define GFC_TYPE_COMPLEX 4
+#define GFC_TYPE_CHARACTER 5
+#define GFC_TYPE_STRUCT 6
+#define GFC_TYPE_CPTR 7
+#define GFC_TYPE_CFUNPTR 8
+#define GFC_TYPE_OTHER -1
 
 /* Array-descriptor attributes, see ISO_Fortran_binding.h.  */
 #define GFC_ATTRIBUTE_POINTER 1
@@ -130,7 +145,7 @@  libgfortran_stat_codes;
    used in the run-time library for IO.  */
 typedef enum
 { BT_UNKNOWN = 0, BT_INTEGER, BT_LOGICAL, BT_REAL, BT_COMPLEX,
-  BT_DERIVED, BT_CHARACTER, BT_CLASS, BT_PROCEDURE, BT_HOLLERITH, BT_VOID,
+  BT_CHARACTER, BT_DERIVED, BT_CLASS, BT_PROCEDURE, BT_HOLLERITH, BT_VOID,
   BT_ASSUMED
 }
 bt;
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 4d5e2f2..49eaaae 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -127,9 +127,9 @@  gfc_array_dataptr_type (tree desc)
 #define ELEM_LEN_FIELD 1
 #define VERSION_FIELD 2
 #define RANK_FIELD 3
-#define OFFSET_FIELD 4
+#define ATTR_FIELD 4
 #define DTYPE_FIELD 5
-#define ATTR_FIELD 6
+#define OFFSET_FIELD 6
 #define DIMENSION_FIELD 7
 #define CAF_TOKEN_FIELD 8
 
@@ -283,7 +283,8 @@  gfc_conv_descriptor_dtype (tree desc)
   gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
 
   field = gfc_advance_chain (TYPE_FIELDS (type), DTYPE_FIELD);
-  gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type);
+  gcc_assert (field != NULL_TREE
+	      && TREE_CODE (TREE_TYPE (field)) == INTEGER_TYPE);
 
   return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
 			  desc, field, NULL_TREE);
@@ -306,7 +307,8 @@  gfc_conv_descriptor_rank (tree desc)
   gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
 
   field = gfc_advance_chain (TYPE_FIELDS (type), RANK_FIELD);
-  gcc_assert (field != NULL_TREE && TREE_TYPE (field) == integer_type_node);
+  gcc_assert (field != NULL_TREE
+	      && TREE_CODE (TREE_TYPE (field)) == INTEGER_TYPE);
 
   return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
 			  desc, field, NULL_TREE);
@@ -316,8 +318,8 @@  gfc_conv_descriptor_rank (tree desc)
 void
 gfc_conv_descriptor_rank_set (stmtblock_t *block, tree desc, int rank)
 {
-  gfc_add_modify (block, gfc_conv_descriptor_rank (desc),
-                  build_int_cst (integer_type_node, rank));
+  tree field = gfc_conv_descriptor_rank (desc);
+  gfc_add_modify (block, field, build_int_cst (TREE_TYPE (field), rank));
 }
 
 
@@ -349,11 +351,12 @@  gfc_conv_descriptor_attr_set (stmtblock_t *block, tree desc, int attr)
   gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
 
   field = gfc_advance_chain (TYPE_FIELDS (type), ATTR_FIELD);
-  gcc_assert (field != NULL_TREE && TREE_TYPE (field) == integer_type_node);
+  gcc_assert (field != NULL_TREE
+	      && TREE_CODE (TREE_TYPE (field)) == INTEGER_TYPE);
 
   field = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
 			   desc, field, NULL_TREE);
-  gfc_add_modify (block, field, build_int_cst (integer_type_node, attr));
+  gfc_add_modify (block, field, build_int_cst (TREE_TYPE (field), attr));
 }
 
 
@@ -564,7 +567,8 @@  gfc_conv_descriptor_ubound_set (stmtblock_t *block, tree desc,
 /* Build a null array descriptor constructor.  */
 
 tree
-gfc_build_null_descriptor (tree desc_type, int rank, int attr)
+gfc_build_null_descriptor (tree desc_type, int rank, int attr,
+			   gfc_typespec *ts)
 {
   tree field;
   tree tmp;
@@ -590,16 +594,16 @@  gfc_build_null_descriptor (tree desc_type, int rank, int attr)
   /* Set rank. */
   tmp = gfc_advance_chain (field, RANK_FIELD);
   CONSTRUCTOR_APPEND_ELT (init, tmp,
-			  build_int_cst (integer_type_node, rank));
-
-  /* Set type. */
-  tmp = gfc_advance_chain (field, DTYPE_FIELD);
-  CONSTRUCTOR_APPEND_ELT (init, tmp, gfc_get_dtype (desc_type));
+			  build_int_cst (TREE_TYPE (tmp), rank));
 
   /* Set attribute (allocatable, pointer, other). */
   tmp = gfc_advance_chain (field, ATTR_FIELD);
   CONSTRUCTOR_APPEND_ELT (init, tmp,
-			  build_int_cst (integer_type_node, attr));
+			  build_int_cst (TREE_TYPE (tmp), attr));
+
+  /* Set type. */
+  tmp = gfc_advance_chain (field, DTYPE_FIELD);
+  CONSTRUCTOR_APPEND_ELT (init, tmp, gfc_get_dtype (ts));
 
   /* All other fields are set during allocate/pointer association.  */
   tmp = build_constructor (desc_type, init);
@@ -919,7 +923,7 @@  gfc_trans_static_array_pointer (gfc_symbol * sym)
 
   type = TREE_TYPE (sym->backend_decl);
   DECL_INITIAL (sym->backend_decl)
-	= gfc_build_null_descriptor (type, sym->as->rank, attr);
+	= gfc_build_null_descriptor (type, sym->as->rank, attr, &sym->ts);
 }
 
 
@@ -1190,7 +1194,8 @@  get_array_ref_dim_for_loop_dim (gfc_ss *ss, int loop_dim)
 tree
 gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
 			     tree eltype, tree initial, bool dynamic,
-			     bool dealloc, bool callee_alloc, locus * where)
+			     bool dealloc, bool callee_alloc,
+			     gfc_typespec *ts, tree strlen, locus * where)
 {
   gfc_loopinfo *loop;
   gfc_ss *s;
@@ -1200,6 +1205,7 @@  gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
   tree desc;
   tree tmp;
   tree size;
+  tree elem_len;
   tree nelem;
   tree cond;
   tree or_expr;
@@ -1280,32 +1286,42 @@  gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
   GFC_DECL_PACKED_ARRAY (desc) = 1;
 
   info->descriptor = desc;
-  size = gfc_index_one_node;
 
   /* Fill in the elem_len, version, rank, dtype and attribute.  */
-  gfc_conv_descriptor_elem_len_set (pre, desc,
-				TYPE_SIZE_UNIT (gfc_get_element_type (type)));
+
+  if (class_expr != NULL_TREE)
+    elem_len = gfc_vtable_size_get (class_expr);
+  else if (ts->type == BT_CHARACTER && strlen)
+    elem_len = size_of_string_in_bytes (ts->kind, strlen);
+  else if (ts->type != BT_CHARACTER)
+    elem_len = size_in_bytes (gfc_typenode_for_spec (ts));
+  else
+    elem_len = TYPE_SIZE_UNIT (gfc_get_element_type (type));
+
+  gfc_conv_descriptor_elem_len_set (pre, desc, elem_len);
   gfc_conv_descriptor_version_set (pre, desc);
   gfc_conv_descriptor_rank_set (pre, desc, total_dim);
   tmp = gfc_conv_descriptor_dtype (desc);
-  gfc_add_modify (pre, tmp, gfc_get_dtype (type));
+  gfc_add_modify (pre, tmp, gfc_get_dtype (ts));
   gfc_conv_descriptor_attr_set (pre, desc, GFC_ATTRIBUTE_ALLOCATABLE);
 
   /*
      Fill in the bounds and stride.  This is a packed array, so:
 
-     size = 1;
+     size = elem_len;
      for (n = 0; n < rank; n++)
        {
-	 stride[n] = size
-	 delta = ubound[n] + 1 - lbound[n];
+	 sm[n] = size
+	 delta = extent[n];
 	 size = size * delta;
        }
-     size = size * sizeof(element);
   */
 
   or_expr = NULL_TREE;
 
+  elem_len = fold_convert (gfc_array_index_type, elem_len);
+  size = elem_len;
+
   /* If there is at least one null loop->to[n], it is a callee allocated
      array.  */
   for (n = 0; n < total_dim; n++)
@@ -1334,17 +1350,17 @@  gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
       for (n = 0; n < total_dim; n++)
 	{
 	  /* Store the stride and bound components in the descriptor.  */
-	  gfc_conv_descriptor_stride_set (pre, desc, gfc_rank_cst[n], size);
+	  gfc_conv_descriptor_sm_set (pre, desc, gfc_rank_cst[n], size);
 
 	  gfc_conv_descriptor_lbound_set (pre, desc, gfc_rank_cst[n],
 					  gfc_index_zero_node);
 
-	  gfc_conv_descriptor_ubound_set (pre, desc, gfc_rank_cst[n], to[n]);
-
 	  tmp = fold_build2_loc (input_location, PLUS_EXPR,
 				 gfc_array_index_type,
 				 to[n], gfc_index_one_node);
 
+	  gfc_conv_descriptor_extent_set (pre, desc, gfc_rank_cst[n], tmp);
+
 	  /* Check whether the size for this dimension is negative.  */
 	  cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node,
 				  tmp, gfc_index_zero_node);
@@ -1363,27 +1379,21 @@  gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
     }
 
   /* Get the size of the array.  */
-  if (size && !callee_alloc)
+  if (size != NULL_TREE && !callee_alloc)
     {
-      tree elemsize;
       /* If or_expr is true, then the extent in at least one
 	 dimension is zero and the size is set to zero.  */
       size = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type,
 			      or_expr, gfc_index_zero_node, size);
-
-      nelem = size;
-      if (class_expr == NULL_TREE)
-	elemsize = fold_convert (gfc_array_index_type,
-			TYPE_SIZE_UNIT (gfc_get_element_type (type)));
-      else
-	elemsize = gfc_vtable_size_get (class_expr);
-
-      size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
-			      size, elemsize);
+      nelem = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+			       gfc_array_index_type, size, elem_len);
     }
   else
     {
-      nelem = size;
+      nelem = (size == NULL_TREE)
+	      ? NULL_TREE
+	      : fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+				 gfc_array_index_type, size, elem_len);
       size = NULL_TREE;
     }
 
@@ -1667,7 +1677,7 @@  gfc_trans_array_constructor_subarray (stmtblock_t * pblock,
 
   /* Initialize the loop.  */
   gfc_conv_ss_startstride (&loop);
-  gfc_conv_loop_setup (&loop, &expr->where);
+  gfc_conv_loop_setup (&loop, &expr->where, &expr->ts);
 
   /* Make sure the constructed array has room for the new data.  */
   if (dynamic)
@@ -2502,7 +2512,8 @@  trans_array_constructor (gfc_ss * ss, locus * where)
     }
 
   gfc_trans_create_temp_array (&outer_loop->pre, &outer_loop->post, ss, type,
-			       NULL_TREE, dynamic, true, false, where);
+			       NULL_TREE, dynamic, true, false, &expr->ts,
+			       ss_info->string_length, where);
 
   desc = ss_info->data.array.descriptor;
   offset = gfc_index_zero_node;
@@ -4858,7 +4869,7 @@  set_loop_bounds (gfc_loopinfo *loop)
    moved outside the loop.  */
 
 void
-gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
+gfc_conv_loop_setup (gfc_loopinfo *loop, locus *where, gfc_typespec *ts)
 {
   gfc_ss *tmp_ss;
   tree tmp;
@@ -4894,7 +4905,8 @@  gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
       gcc_assert (tmp_ss->dimen != 0);
 
       gfc_trans_create_temp_array (&loop->pre, &loop->post, tmp_ss, tmp,
-				   NULL_TREE, false, true, false, where);
+				   NULL_TREE, false, true, false, ts,
+				   tmp_ss_info->string_length, where);
     }
 
   /* For array parameters we don't have loop variables, so don't calculate the
@@ -5067,7 +5079,8 @@  gfc_conv_descriptor_cosize (tree desc, int rank, int corank)
 /*GCC ARRAYS*/
 
 static tree
-gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
+gfc_array_init_size (tree descriptor, gfc_typespec *ts,
+		     int rank, int corank, tree * poffset,
 		     gfc_expr ** lower, gfc_expr ** upper, stmtblock_t * pblock,
 		     stmtblock_t * descriptor_block, tree * overflow,
 		     tree expr3_elem_size, tree *nelems, gfc_expr *expr3)
@@ -5095,11 +5108,9 @@  gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
   offset = gfc_index_zero_node;
 
   /* Set the rank and dtype.  */
-  tmp = gfc_conv_descriptor_rank (descriptor);
-  gfc_add_modify (descriptor_block, tmp, build_int_cst (integer_type_node,
-							rank));
+  gfc_conv_descriptor_rank_set (descriptor_block, descriptor, rank);
   tmp = gfc_conv_descriptor_dtype (descriptor);
-  gfc_add_modify (descriptor_block, tmp, gfc_get_dtype (TREE_TYPE (descriptor)));
+  gfc_add_modify (descriptor_block, tmp, gfc_get_dtype (ts));
 
   or_expr = boolean_false_node;
 
@@ -5402,7 +5413,7 @@  gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
   overflow = integer_zero_node;
 
   gfc_init_block (&set_descriptor_block);
-  size = gfc_array_init_size (se->expr, ref->u.ar.as->rank,
+  size = gfc_array_init_size (se->expr, &expr->ts, ref->u.ar.as->rank,
 			      ref->u.ar.as->corank, &offset, lower, upper,
 			      &se->pre, &set_descriptor_block, &overflow,
 			      expr3_elem_size, nelems, expr3);
@@ -5676,7 +5687,8 @@  gfc_conv_array_initializer (tree type, gfc_expr * expr)
       break;
 
     case EXPR_NULL:
-      return gfc_build_null_descriptor (type, 1, GFC_ATTRIBUTE_OTHER);
+      return gfc_build_null_descriptor (type, 1, GFC_ATTRIBUTE_OTHER,
+					&expr->ts);
 
     default:
       gcc_unreachable ();
@@ -6852,7 +6864,7 @@  gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
       gfc_add_ss_to_loop (&loop, loop.temp_ss);
     }
 
-  gfc_conv_loop_setup (&loop, & expr->where);
+  gfc_conv_loop_setup (&loop, &expr->where, &expr->ts);
 
   if (need_tmp)
     {
@@ -6986,13 +6998,13 @@  gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
       if (expr->ts.type == BT_CHARACTER)
 	elem_len = size_of_string_in_bytes (expr->ts.kind, se->string_length);
       else
-	elem_len = size_in_bytes (gfc_get_element_type (TREE_TYPE (desc)));
+	elem_len = size_in_bytes (gfc_typenode_for_spec(&expr->ts));
 
       gfc_conv_descriptor_elem_len_set (&loop.pre, parm, elem_len);
       gfc_conv_descriptor_version_set (&loop.pre, parm);
       gfc_conv_descriptor_rank_set (&loop.pre, parm, loop.dimen);
       tmp = gfc_conv_descriptor_dtype (parm);
-      gfc_add_modify (&loop.pre, tmp, gfc_get_dtype (parmtype));
+      gfc_add_modify (&loop.pre, tmp, gfc_get_dtype (&expr->ts));
       gfc_conv_descriptor_attr_set (&loop.pre, parm, GFC_ATTRIBUTE_OTHER);
 
       /* Set offset for assignments to pointer only to zero if it is not
@@ -7889,7 +7901,7 @@  structure_alloc_comps (gfc_symbol * der_type, tree decl,
 	      gfc_conv_descriptor_version_set (&fnblock, comp);
 	      gfc_conv_descriptor_rank_set (&fnblock, comp, c->as->rank);
 	      gfc_add_modify (&fnblock, gfc_conv_descriptor_dtype (comp),
-			      gfc_get_dtype (TREE_TYPE (comp)));
+			      gfc_get_dtype (&c->ts));
 	      gfc_conv_descriptor_attr_set (&fnblock, comp,
 					    c->attr.allocatable
 					    ?  GFC_ATTRIBUTE_ALLOCATABLE
@@ -7932,7 +7944,7 @@  structure_alloc_comps (gfc_symbol * der_type, tree decl,
 		  gfc_conv_descriptor_rank_set (&fnblock, comp,
 						CLASS_DATA (c)->as->rank);
 		  gfc_add_modify (&fnblock, gfc_conv_descriptor_dtype (comp),
-				  gfc_get_dtype (TREE_TYPE (comp)));
+				  gfc_get_dtype (&c->ts));
 		  gfc_conv_descriptor_attr_set (&fnblock, comp,
 						c->attr.allocatable
 						? GFC_ATTRIBUTE_ALLOCATABLE
@@ -8534,11 +8546,9 @@  gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
 			     1, size2);
   gfc_conv_descriptor_data_set (&alloc_block,
 				desc, tmp);
-  tmp = gfc_conv_descriptor_rank (desc);
-  gfc_add_modify (&alloc_block, tmp, build_int_cst (integer_type_node,
-                                                    expr1->rank));
+  gfc_conv_descriptor_rank_set (&alloc_block, desc, expr1->rank);
   tmp = gfc_conv_descriptor_dtype (desc);
-  gfc_add_modify (&alloc_block, tmp, gfc_get_dtype (TREE_TYPE (desc)));
+  gfc_add_modify (&alloc_block, tmp, gfc_get_dtype (&expr1->ts));
   if ((expr1->ts.type == BT_DERIVED)
 	&& expr1->ts.u.derived->attr.alloc_comp)
     {
@@ -8673,7 +8683,7 @@  gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block)
        gfc_conv_descriptor_version_set (&init, descriptor);
        gfc_conv_descriptor_rank_set (&init, descriptor, sym->as->rank);
        tmp = gfc_conv_descriptor_dtype (descriptor);
-       gfc_add_modify (&init, tmp, gfc_get_dtype (type));
+       gfc_add_modify (&init, tmp, gfc_get_dtype (&sym->ts));
        gcc_assert (sym->attr.allocatable || sym->attr.pointer);
        gfc_conv_descriptor_attr_set (&init, descriptor,
 				     sym->attr.allocatable
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index e4804e9..bb3d4c8 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -32,7 +32,8 @@  void gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping *,
 
 /* Generate code to create a temporary array.  */
 tree gfc_trans_create_temp_array (stmtblock_t *, stmtblock_t *, gfc_ss *,
-				  tree, tree, bool, bool, bool, locus *);
+				  tree, tree, bool, bool, bool,
+				  gfc_typespec *, tree, locus *);
 
 /* Generate function entry code for allocation of compiler allocated array
    variables.  */
@@ -114,13 +115,13 @@  void gfc_trans_scalarizing_loops (gfc_loopinfo *, stmtblock_t *);
 /* Mark the end of the main loop body and the start of the copying loop.  */
 void gfc_trans_scalarized_loop_boundary (gfc_loopinfo *, stmtblock_t *);
 /* Initialize the scalarization loop parameters.  */
-void gfc_conv_loop_setup (gfc_loopinfo *, locus *);
+void gfc_conv_loop_setup (gfc_loopinfo *, locus *, gfc_typespec *ts);
 /* Set each array's delta.  */
 void gfc_set_delta (gfc_loopinfo *);
 /* Resolve array assignment dependencies.  */
 void gfc_conv_resolve_dependencies (gfc_loopinfo *, gfc_ss *, gfc_ss *);
 /* Build a null array descriptor constructor.  */
-tree gfc_build_null_descriptor (tree, int, int);
+tree gfc_build_null_descriptor (tree, int, int, gfc_typespec *);
 
 /* Get a single array element.  */
 void gfc_conv_array_ref (gfc_se *, gfc_array_ref *, gfc_symbol *, locus *);
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 37ec402..aa95051 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -3686,7 +3686,7 @@  gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 	      tmp = gfc_class_data_get (sym->backend_decl);
 	      tmp = gfc_build_null_descriptor (TREE_TYPE (tmp),
 					       CLASS_DATA (sym)->as->rank,
-					       attr);
+					       attr, &sym->ts);
 	    }
 	  else
 	    tmp = null_pointer_node;
@@ -3843,7 +3843,7 @@  gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 		  gfc_conv_descriptor_rank_set (&init, descriptor,
 						CLASS_DATA (sym)->as->rank);
 		  tmp = gfc_conv_descriptor_dtype (descriptor);
-		  gfc_add_modify (&init, tmp, gfc_get_dtype (type));
+		  gfc_add_modify (&init, tmp, gfc_get_dtype (&sym->ts));
 		  gfc_conv_descriptor_attr_set (&init, descriptor,
                                      CLASS_DATA (sym)->attr.allocatable
                                      ? GFC_ATTRIBUTE_ALLOCATABLE
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 5407819..e21c3d2 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -60,7 +60,8 @@  get_scalar_to_descriptor_type (tree scalar, symbol_attribute attr)
 }
 
 tree
-gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
+gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr,
+			       gfc_typespec *ts)
 {
   tree desc, type;
   int desc_attr;
@@ -74,7 +75,7 @@  gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
   gfc_conv_descriptor_version_set (&se->pre, desc);
   gfc_conv_descriptor_rank_set (&se->pre, desc, 0);
   gfc_add_modify (&se->pre, gfc_conv_descriptor_dtype (desc),
-		  gfc_get_dtype (type));
+		  gfc_get_dtype (ts));
   if (attr.pointer)
     desc_attr = GFC_ATTRIBUTE_POINTER;
   else if (attr.allocatable)
@@ -385,7 +386,7 @@  gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
 	      gfc_conv_descriptor_version_set (&parmse->pre, ctree);
 	      gfc_conv_descriptor_rank_set (&parmse->pre, ctree, 0);
 	      gfc_add_modify (&parmse->pre, gfc_conv_descriptor_dtype (ctree),
-			      gfc_get_dtype (type));
+			      gfc_get_dtype (&class_ts));
 
 	      if (attr.pointer)
 		desc_attr = GFC_ATTRIBUTE_POINTER;
@@ -652,13 +653,9 @@  gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts,
     {
       if (e->rank == 0)
 	{
-// FIXME: Use gfc_conv_scalar_to_descriptor
-	  tree type = get_scalar_to_descriptor_type (parmse->expr,
-						     gfc_expr_attr (e));
-	  gfc_add_modify (&block, gfc_conv_descriptor_rank (ctree),
-			  build_int_cst (integer_type_node, 0));
+	  gfc_conv_descriptor_rank_set (&block, ctree, 0);
 	  gfc_add_modify (&block, gfc_conv_descriptor_dtype (ctree),
-			  gfc_get_dtype (type));
+			  gfc_get_dtype (&e->ts));
 
 	  tmp = gfc_class_data_get (parmse->expr);
 	  if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
@@ -3616,7 +3613,7 @@  gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77,
   gfc_add_ss_to_loop (&loop, loop.temp_ss);
 
   /* Setup the scalarizing loops.  */
-  gfc_conv_loop_setup (&loop, &expr->where);
+  gfc_conv_loop_setup (&loop, &expr->where, &expr->ts);
 
   /* Pass the temporary descriptor back to the caller.  */
   info = &loop.temp_ss->info->data.array;
@@ -3680,7 +3677,7 @@  gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77,
   gfc_conv_ss_startstride (&loop2);
 
   /* Setup the scalarizing loops.  */
-  gfc_conv_loop_setup (&loop2, &expr->where);
+  gfc_conv_loop_setup (&loop2, &expr->where, &expr->ts);
 
   gfc_copy_loopinfo_to_se (&lse, &loop2);
   gfc_copy_loopinfo_to_se (&rse, &loop2);
@@ -4334,7 +4331,8 @@  gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 			  && POINTER_TYPE_P (TREE_TYPE (TREE_OPERAND (tmp, 0))))
 			tmp = TREE_OPERAND (tmp, 0);
 		      parmse.expr = gfc_conv_scalar_to_descriptor (&parmse, tmp,
-								   fsym->attr);
+								   fsym->attr,
+								   &e->ts);
 		      parmse.expr = gfc_build_addr_expr (NULL_TREE,
 							 parmse.expr);
 		    }
@@ -4921,6 +4919,8 @@  gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	  gfc_trans_create_temp_array (&se->pre, &se->post, se->ss,
 				       tmp, NULL_TREE, false,
 				       !comp->attr.pointer, callee_alloc,
+		 		       &se->ss->info->expr->ts,
+		 		       se->ss->info->string_length,
 				       &se->ss->info->expr->where);
 
 	  /* Pass the temporary as the first argument.  */
@@ -4957,6 +4957,8 @@  gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	  gfc_trans_create_temp_array (&se->pre, &se->post, se->ss,
 				       tmp, NULL_TREE, false,
 				       !sym->attr.pointer, callee_alloc,
+				       &se->ss->info->expr->ts,
+				       se->ss->info->string_length,
 				       &se->ss->info->expr->where);
 
 	  /* Pass the temporary as the first argument.  */
@@ -5617,7 +5619,7 @@  gfc_conv_initializer (gfc_expr * expr, gfc_typespec * ts, tree type,
       /* Arrays need special handling.  */
       if (pointer)
 	ctor = gfc_build_null_descriptor (type, rank,
-					  GFC_ATTRIBUTE_POINTER);
+					  GFC_ATTRIBUTE_POINTER, ts);
       /* Special case assigning an array to zero.  */
       else if (is_zero_initializer_p (expr))
         ctor = build_constructor (type, NULL);
@@ -5725,7 +5727,7 @@  gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr)
   gfc_conv_ss_startstride (&loop);
 
   /* Setup the scalarizing loops.  */
-  gfc_conv_loop_setup (&loop, &expr->where);
+  gfc_conv_loop_setup (&loop, &expr->where, &expr->ts);
 
   /* Setup the gfc_se structures.  */
   gfc_copy_loopinfo_to_se (&lse, &loop);
@@ -6554,7 +6556,7 @@  gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
 	      if (expr1->ts.deferred || expr1->ts.type == BT_CLASS)
 		{
 		  dtype = gfc_conv_descriptor_dtype (desc);
-		  tmp = gfc_get_dtype (TREE_TYPE (desc));
+		  tmp = gfc_get_dtype (&expr2->ts);
 		  gfc_add_modify (&block, dtype, tmp);
 		}
 
@@ -7005,8 +7007,8 @@  arrayfunc_assign_needs_temporary (gfc_expr * expr1, gfc_expr * expr2)
    reallocatable assignments from extrinsic function calls.  */
 
 static void
-realloc_lhs_loop_for_fcn_call (gfc_se *se, locus *where, gfc_ss **ss,
-			       gfc_loopinfo *loop)
+realloc_lhs_loop_for_fcn_call (gfc_se *se, locus *where, gfc_typespec *ts,
+			       gfc_ss **ss, gfc_loopinfo *loop)
 {
   /* Signal that the function call should not be made by
      gfc_conv_loop_setup. */
@@ -7015,7 +7017,7 @@  realloc_lhs_loop_for_fcn_call (gfc_se *se, locus *where, gfc_ss **ss,
   gfc_add_ss_to_loop (loop, *ss);
   gfc_add_ss_to_loop (loop, se->ss);
   gfc_conv_ss_startstride (loop);
-  gfc_conv_loop_setup (loop, where);
+  gfc_conv_loop_setup (loop, where, ts);
   gfc_copy_loopinfo_to_se (se, loop);
   gfc_add_block_to_block (&se->pre, &loop->pre);
   gfc_add_block_to_block (&se->pre, &loop->post);
@@ -7184,7 +7186,8 @@  gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2)
 	  ss = gfc_walk_expr (expr1);
 	  gcc_assert (ss != gfc_ss_terminator);
 
-	  realloc_lhs_loop_for_fcn_call (&se, &expr1->where, &ss, &loop);
+	  realloc_lhs_loop_for_fcn_call (&se, &expr1->where, &expr1->ts,
+					 &ss, &loop);
 	  ss->is_alloc_lhs = 1;
 	}
       else
@@ -7656,7 +7659,7 @@  gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
       /* Resolve any data dependencies in the statement.  */
       gfc_conv_resolve_dependencies (&loop, lss, rss);
       /* Setup the scalarizing loops.  */
-      gfc_conv_loop_setup (&loop, &expr2->where);
+      gfc_conv_loop_setup (&loop, &expr2->where, &expr2->ts);
 
       /* Setup the gfc_se structures.  */
       gfc_copy_loopinfo_to_se (&lse, &loop);
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 1d7543c..de3ba4a 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -926,7 +926,7 @@  trans_this_image (gfc_se * se, gfc_expr *expr)
 {
   stmtblock_t loop;
   tree type, desc, dim_arg, cond, tmp, m, loop_var, exit_label, min_var,
-       lbound, ubound, extent, ml;
+       lbound, extent, ml;
   gfc_se argse;
   int rank, corank;
 
@@ -1082,10 +1082,7 @@  trans_this_image (gfc_se * se, gfc_expr *expr)
   gfc_add_modify (&loop, ml, m);
 
   /* extent = ...  */
-  lbound = gfc_conv_descriptor_lbound_get (desc, loop_var);
-  ubound = gfc_conv_descriptor_ubound_get (desc, loop_var);
-  extent = gfc_conv_array_extent_dim (lbound, ubound, NULL);
-  extent = fold_convert (type, extent);
+  extent = fold_convert (type, gfc_conv_descriptor_extent_get (desc, loop_var));
 
   /* m = m/extent.  */
   gfc_add_modify (&loop, m, 
@@ -1208,12 +1205,11 @@  trans_image_index (gfc_se * se, gfc_expr *expr)
 
   for (codim = corank + rank - 2; codim >= rank; codim--)
     {
-      tree extent, ubound;
+      tree extent;
 
       /* coindex = coindex*extent(codim) + sub(codim) - lcobound(codim).  */
       lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[codim]);
-      ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[codim]);
-      extent = gfc_conv_array_extent_dim (lbound, ubound, NULL);
+      extent = gfc_conv_descriptor_extent_get (desc, gfc_rank_cst[codim]);
 
       /* coindex *= extent.  */
       coindex = fold_build2_loc (input_location, MULT_EXPR,
@@ -1280,7 +1276,8 @@  gfc_conv_intrinsic_rank (gfc_se *se, gfc_expr *expr)
   gfc_add_block_to_block (&se->pre, &argse.pre);
   gfc_add_block_to_block (&se->post, &argse.post);
 
-  se->expr = gfc_conv_descriptor_rank (argse.expr);
+  se->expr = fold_convert (gfc_get_int_type (gfc_default_integer_kind),
+			   gfc_conv_descriptor_rank (argse.expr));
 }
 
 
@@ -1370,7 +1367,7 @@  gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper)
 	  else
 	    tmp = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))];
           tmp = fold_build2_loc (input_location, GE_EXPR, boolean_type_node,
-				 bound, fold_convert(TREE_TYPE (bound), tmp));
+				 bound, fold_convert (TREE_TYPE (bound), tmp));
           cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR,
 				  boolean_type_node, cond, tmp);
           gfc_trans_runtime_check (true, false, cond, &se->pre, &expr->where,
@@ -2491,7 +2488,7 @@  gfc_conv_intrinsic_anyall (gfc_se * se, gfc_expr * expr, enum tree_code op)
 
   /* Initialize the loop.  */
   gfc_conv_ss_startstride (&loop);
-  gfc_conv_loop_setup (&loop, &expr->where);
+  gfc_conv_loop_setup (&loop, &expr->where, &expr->ts);
 
   gfc_mark_ss_chain_used (arrayss, 1);
   /* Generate the loop body.  */
@@ -2573,7 +2570,7 @@  gfc_conv_intrinsic_count (gfc_se * se, gfc_expr * expr)
 
   /* Initialize the loop.  */
   gfc_conv_ss_startstride (&loop);
-  gfc_conv_loop_setup (&loop, &expr->where);
+  gfc_conv_loop_setup (&loop, &expr->where, &expr->ts);
 
   gfc_mark_ss_chain_used (arrayss, 1);
   /* Generate the loop body.  */
@@ -2707,7 +2704,7 @@  gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
 
       /* Initialize the loop.  */
       gfc_conv_ss_startstride (&loop);
-      gfc_conv_loop_setup (&loop, &expr->where);
+      gfc_conv_loop_setup (&loop, &expr->where, &expr->ts);
 
       gfc_mark_ss_chain_used (arrayss, 1);
       if (maskexpr && maskexpr->rank > 0)
@@ -2928,7 +2925,7 @@  gfc_conv_intrinsic_dot_product (gfc_se * se, gfc_expr * expr)
 
   /* Initialize the loop.  */
   gfc_conv_ss_startstride (&loop);
-  gfc_conv_loop_setup (&loop, &expr->where);
+  gfc_conv_loop_setup (&loop, &expr->where, &expr->ts);
 
   gfc_mark_ss_chain_used (arrayss1, 1);
   gfc_mark_ss_chain_used (arrayss2, 1);
@@ -3169,7 +3166,7 @@  gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
      loops (without conflicting with temporary management), or use a single
      loop minmaxloc implementation.  See PR 31067.  */
   loop.temp_dim = loop.dimen;
-  gfc_conv_loop_setup (&loop, &expr->where);
+  gfc_conv_loop_setup (&loop, &expr->where, &expr->ts);
 
   gcc_assert (loop.dimen == 1);
   if (nonempty == NULL && maskss == NULL && loop.from[0] && loop.to[0])
@@ -3629,7 +3626,7 @@  gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op)
      loops (without conflicting with temporary management), or use a single
      loop minmaxval implementation.  See PR 31067.  */
   loop.temp_dim = loop.dimen;
-  gfc_conv_loop_setup (&loop, &expr->where);
+  gfc_conv_loop_setup (&loop, &expr->where, &expr->ts);
 
   if (nonempty == NULL && maskss == NULL
       && loop.dimen == 1 && loop.from[0] && loop.to[0])
@@ -5603,7 +5600,8 @@  gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr)
   /* Build a destination descriptor, using the pointer, source, as the
      data field.  */
   gfc_trans_create_temp_array (&se->pre, &se->post, se->ss, mold_type,
-			       NULL_TREE, false, true, false, &expr->where);
+			       NULL_TREE, false, true, false,
+			       &expr->ts, NULL_TREE, &expr->where);
 
   /* Cast the pointer to the result.  */
   tmp = gfc_conv_descriptor_data_get (info->descriptor);
@@ -6428,10 +6426,9 @@  conv_isocbinding_subroutine (gfc_code *code)
   /* Set data value, rank, 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_rank (desc),
-		  build_int_cst (integer_type_node, arg->next->expr->rank));
+  gfc_conv_descriptor_rank_set (&block, desc, arg->next->expr->rank);
   gfc_add_modify (&block, gfc_conv_descriptor_dtype (desc),
-		  gfc_get_dtype (TREE_TYPE (desc)));
+		  gfc_get_dtype (&arg->next->expr->ts));
 
   /* Start scalarization of the bounds, using the shape argument.  */
 
@@ -6442,7 +6439,7 @@  conv_isocbinding_subroutine (gfc_code *code)
   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_conv_loop_setup (&loop, &arg->next->expr->where, &arg->next->expr->ts);
   gfc_mark_ss_chain_used (shape_ss, 1);
 
   gfc_copy_loopinfo_to_se (&shapese, &loop);
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 7b03a6b..8cc9d50 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -1539,11 +1539,9 @@  transfer_namelist_element (stmtblock_t * block, const char * var_name,
   tree dt = NULL;
   tree string;
   tree tmp;
-  tree dtype;
   tree dt_parm_addr;
   tree decl = NULL_TREE;
   int n_dim; 
-  int itype;
   int rank = 0;
 
   gcc_assert (sym || c);
@@ -1569,13 +1567,10 @@  transfer_namelist_element (stmtblock_t * block, const char * var_name,
       if (sym && sym->attr.dummy)
         decl = build_fold_indirect_ref_loc (input_location, decl);
       dt =  TREE_TYPE (decl);
-      dtype = gfc_get_dtype (dt);
       tmp = TYPE_SIZE_UNIT (gfc_get_element_type (dt));
     }
   else
     {
-      itype = ts->type;
-      dtype = IARG (itype << GFC_DTYPE_TYPE_SHIFT);
       tmp = TREE_TYPE (decl);
       if (TREE_CODE (tmp) == REFERENCE_TYPE)
 	tmp = TREE_TYPE (tmp);
@@ -1586,15 +1581,16 @@  transfer_namelist_element (stmtblock_t * block, const char * var_name,
 
   /* Build up the arguments for the transfer call.
      The call for the scalar part transfers:
-     (address, name, type, kind or string_length, dtype)  */
+     (address, name, kind, elem_len, type)  */
 
   dt_parm_addr = gfc_build_addr_expr (NULL_TREE, dt_parm);
 
   tmp = build_call_expr_loc (input_location,
 			 iocall[IOCALL_SET_NML_VAL], 7,
 			 dt_parm_addr, addr_expr, string,
-			 IARG (ts->kind), tmp,
-			 build_int_cst (integer_type_node, rank), dtype);
+			 build_int_cst (integer_type_node, ts->kind), tmp,
+			 build_int_cst (integer_type_node, rank),
+			 build_int_cst (integer_type_node, ts->type));
   gfc_add_expr_to_block (block, tmp);
 
   /* If the object is an array, transfer rank times:
@@ -1972,7 +1968,7 @@  transfer_array_component (tree expr, gfc_component * cm, locus * where)
   gfc_init_loopinfo (&loop);
   gfc_add_ss_to_loop (&loop, ss);
   gfc_conv_ss_startstride (&loop);
-  gfc_conv_loop_setup (&loop, where);
+  gfc_conv_loop_setup (&loop, where, &cm->ts);
   gfc_mark_ss_chain_used (ss, 1);
   gfc_start_scalarized_body (&loop, &body);
 
@@ -2286,7 +2282,7 @@  gfc_trans_transfer (gfc_code * code)
 
       /* Initialize the loop.  */
       gfc_conv_ss_startstride (&loop);
-      gfc_conv_loop_setup (&loop, &code->expr1->where);
+      gfc_conv_loop_setup (&loop, &code->expr1->where, &code->expr1->ts);
 
       /* The main loop body.  */
       gfc_mark_ss_chain_used (ss, 1);
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 1b65f2c..19a92e7 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -315,7 +315,8 @@  gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
 	  gfc_init_block (&temp_post);
 	  tmp = gfc_trans_create_temp_array (&se->pre, &temp_post, tmp_ss,
 					     temptype, initial, false, true,
-					     false, &arg->expr->where);
+					     false, &e->ts, se->string_length,
+					     &arg->expr->where);
 	  gfc_add_modify (&se->pre, size, tmp);
 	  tmp = fold_convert (pvoid_type_node, tmp_ss->info->data.array.data);
 	  gfc_add_modify (&se->pre, data, tmp);
@@ -451,7 +452,7 @@  gfc_trans_call (gfc_code * code, bool dependency_check,
 	 subscripts.  This could be prevented in the elemental case
 	 as temporaries are handled separatedly
 	 (below in gfc_conv_elemental_dependencies).  */
-      gfc_conv_loop_setup (&loop, &code->expr1->where);
+      gfc_conv_loop_setup (&loop, &code->expr1->where, &code->expr1->ts);
       gfc_mark_ss_chain_used (ss, 1);
 
       /* Convert the arguments, checking for dependencies.  */
@@ -1217,7 +1218,7 @@  trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
 	     assignment from an unlimited polymorphic object.  */
 	  tmp = gfc_conv_descriptor_dtype (sym->backend_decl);
 	  gfc_add_modify (&se.pre, tmp,
-			  gfc_get_dtype (TREE_TYPE (sym->backend_decl)));
+			  gfc_get_dtype (&sym->ts));
 	}
 
       gfc_add_init_cleanup (block, gfc_finish_block( &se.pre),
@@ -2952,7 +2953,7 @@  generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree count3,
       /* Calculate the bounds of the scalarization.  */
       gfc_conv_ss_startstride (&loop1);
       /* Setup the scalarizing loops.  */
-      gfc_conv_loop_setup (&loop1, &expr->where);
+      gfc_conv_loop_setup (&loop1, &expr->where, &expr->ts);
 
       gfc_mark_ss_chain_used (lss, 1);
 
@@ -3052,7 +3053,7 @@  generate_loop_for_rhs_to_temp (gfc_expr *expr2, tree tmp1, tree count3,
       gfc_add_ss_to_loop (&loop, rss);
 
       gfc_conv_ss_startstride (&loop);
-      gfc_conv_loop_setup (&loop, &expr2->where);
+      gfc_conv_loop_setup (&loop, &expr2->where, &expr2->ts);
 
       gfc_mark_ss_chain_used (rss, 1);
       /* Start the loop body.  */
@@ -3171,7 +3172,7 @@  compute_inner_temp_size (gfc_expr *expr1, gfc_expr *expr2,
       gfc_option.rtcheck &= ~GFC_RTCHECK_BOUNDS;
       gfc_conv_ss_startstride (&loop);
       gfc_option.rtcheck = save_flag;
-      gfc_conv_loop_setup (&loop, &expr2->where);
+      gfc_conv_loop_setup (&loop, &expr2->where, &expr2->ts);
 
       /* Figure out how many elements we need.  */
       for (i = 0; i < loop.dimen; i++)
@@ -3516,7 +3517,7 @@  gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
       /* Setup the scalarizing loops and bounds.  */
       gfc_conv_ss_startstride (&loop);
 
-      gfc_conv_loop_setup (&loop, &expr2->where);
+      gfc_conv_loop_setup (&loop, &expr2->where, &expr2->ts);
 
       info = &rss->info->data.array;
       desc = info->descriptor;
@@ -4034,7 +4035,7 @@  gfc_evaluate_where_mask (gfc_expr * me, forall_info * nested_forall_info,
       gfc_add_ss_to_loop (&loop, rss);
 
       gfc_conv_ss_startstride (&loop);
-      gfc_conv_loop_setup (&loop, &me->where);
+      gfc_conv_loop_setup (&loop, &me->where, &me->ts);
 
       gfc_mark_ss_chain_used (rss, 1);
       /* Start the loop body.  */
@@ -4204,7 +4205,7 @@  gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2,
   gfc_conv_resolve_dependencies (&loop, lss_section, rss);
 
   /* Setup the scalarizing loops.  */
-  gfc_conv_loop_setup (&loop, &expr2->where);
+  gfc_conv_loop_setup (&loop, &expr2->where, &expr2->ts);
 
   /* Setup the gfc_se structures.  */
   gfc_copy_loopinfo_to_se (&lse, &loop);
@@ -4651,7 +4652,7 @@  gfc_trans_where_3 (gfc_code * cblock, gfc_code * eblock)
     }
 
   gfc_conv_ss_startstride (&loop);
-  gfc_conv_loop_setup (&loop, &tdst->where);
+  gfc_conv_loop_setup (&loop, &tdst->where, &tdst->ts);
 
   gfc_mark_ss_chain_used (css, 1);
   gfc_mark_ss_chain_used (tdss, 1);
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 9bd6a16..98a4f43 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -78,7 +78,6 @@  tree complex_float128_type_node = NULL_TREE;
 bool gfc_real16_is_float128 = false;
 
 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)];
 
@@ -861,9 +860,6 @@  gfc_init_types (void)
   char name_buf[18];
   int index;
   tree type;
-  unsigned n;
-  unsigned HOST_WIDE_INT hi;
-  unsigned HOST_WIDE_INT lo;
 
   /* Create and name the types.  */
 #define PUSH_TYPE(name, node) \
@@ -950,19 +946,6 @@  gfc_init_types (void)
 			      build_int_cst (gfc_array_index_type, 0),
 			      NULL_TREE);
 
-  /* The maximum array element size that can be handled is determined
-     by the number of bits available to store this field in the array
-     descriptor.  */
-
-  n = TYPE_PRECISION (gfc_array_index_type) - GFC_DTYPE_SIZE_SHIFT;
-  lo = ~ (unsigned HOST_WIDE_INT) 0;
-  if (n > HOST_BITS_PER_WIDE_INT)
-    hi = lo >> (2*HOST_BITS_PER_WIDE_INT - n);
-  else
-    hi = 0, lo >>= HOST_BITS_PER_WIDE_INT - n;
-  gfc_max_array_element_size
-    = build_int_cst_wide (long_unsigned_type_node, lo, hi);
-
   boolean_type_node = gfc_get_logical_type (gfc_default_logical_kind);
   boolean_true_node = build_int_cst (boolean_type_node, 1);
   boolean_false_node = build_int_cst (boolean_type_node, 0);
@@ -1190,21 +1173,25 @@  gfc_get_element_type (tree type)
 /* Build an array.  This function is called from gfc_sym_type().
    Actually returns array descriptor type.
 
-   Format of array descriptors is as follows:
+   Format of array descriptors is as follows, cf. TS29113:2012.
 
     struct gfc_array_descriptor
     {
-      array *data
-      index offset;
-      index dtype;
-      struct descriptor_dimension dimension[N_DIM];
+      base_type *base_addr;
+      size_t elem_len;
+      int version;
+      int8_t rank;
+      int8_t attribute;
+      int16_t type;
+      ptrdiff_t offset;
+      struct CFI_dim_t dim[N_DIM];
     }
 
-    struct descriptor_dimension
+    struct CFI_dim_t
     {
-      index stride;
-      index lbound;
-      index ubound;
+      ptrdiff_t lower_bound;
+      ptrdiff_t extent;
+      ptrdiff_t sm;
     }
 
    Translation code should use gfc_conv_descriptor_* rather than
@@ -1216,10 +1203,10 @@  gfc_get_element_type (tree type)
    are gfc_array_index_type and the data node is a pointer to the
    data.  See below for the handling of character types.
 
-   The dtype member is formatted as follows:
-    // 3 unused bits (used to be the rank)
-    type = (dtype & GFC_DTYPE_TYPE_MASK) >> GFC_DTYPE_TYPE_SHIFT // 3 bits
-    size = dtype >> GFC_DTYPE_SIZE_SHIFT
+   The type member is formatted as follows; the lower byte contains
+   the type, the upper byte contains the kind value.
+    data_type = (type & GFC_TYPE_MASK)
+    kind = (type >> GFC_TYPE_KIND_SHIFT)
 
    I originally used nested ARRAY_TYPE nodes to represent arrays, but
    this generated poor code for assumed/deferred size arrays.  These
@@ -1386,87 +1373,45 @@  gfc_get_desc_dim_type (void)
    unknown cases abort.  */
 
 tree
-gfc_get_dtype (tree type)
+gfc_get_dtype (gfc_typespec *ts)
 {
-  tree size;
-  int n;
-  HOST_WIDE_INT i;
-  tree tmp;
-  tree dtype;
-  tree etype;
-
-  gcc_assert (GFC_DESCRIPTOR_TYPE_P (type) || GFC_ARRAY_TYPE_P (type));
+  int type;
+  tree int16_type_node
+	= gfc_get_int_type (gfc_get_int_kind_from_width_isofortranenv (16));
 
-  if (GFC_TYPE_ARRAY_DTYPE (type))
-    return GFC_TYPE_ARRAY_DTYPE (type);
-
-  etype = gfc_get_element_type (type);
-
-  switch (TREE_CODE (etype))
+  switch (ts->type)
     {
-    case INTEGER_TYPE:
-      n = BT_INTEGER;
-      break;
-
-    case BOOLEAN_TYPE:
-      n = BT_LOGICAL;
+    case BT_INTEGER:
+      type = GFC_TYPE_INTEGER + (ts->kind << GFC_TYPE_KIND_SHIFT);
       break;
-
-    case REAL_TYPE:
-      n = BT_REAL;
+    case BT_LOGICAL:
+      type = GFC_TYPE_LOGICAL + (ts->kind << GFC_TYPE_KIND_SHIFT);
       break;
-
-    case COMPLEX_TYPE:
-      n = BT_COMPLEX;
+    case BT_REAL:
+      type = GFC_TYPE_REAL + (ts->kind << GFC_TYPE_KIND_SHIFT);
       break;
-
-    /* We will never have arrays of arrays.  */
-    case RECORD_TYPE:
-      n = BT_DERIVED;
+    case BT_COMPLEX:
+      type = GFC_TYPE_COMPLEX + (ts->kind << GFC_TYPE_KIND_SHIFT);
       break;
-
-    case ARRAY_TYPE:
-      n = BT_CHARACTER;
+    case BT_CHARACTER:
+      type = GFC_TYPE_CHARACTER + (ts->kind << GFC_TYPE_KIND_SHIFT);
       break;
-
-    case POINTER_TYPE:
-      n = BT_ASSUMED;
+    case BT_DERIVED:
+      if (ts->f90_type == BT_VOID)
+	type = ts->u.derived
+	       && ts->u.derived->intmod_sym_id == ISOCBINDING_PTR
+	       ? GFC_TYPE_CFUNPTR : GFC_TYPE_CPTR;
+	type = GFC_TYPE_STRUCT;
+      if (ts->u.derived->attr.sequence || ts->u.derived->attr.is_bind_c)
+	type = GFC_TYPE_STRUCT;
+      else
+        type = GFC_TYPE_OTHER;
       break;
-
     default:
-      /* TODO: Don't do dtype for temporary descriptorless arrays.  */
-      /* We can strange array types for temporary arrays.  */
-      return gfc_index_zero_node;
+      type = GFC_TYPE_OTHER;
     }
 
-  size = TYPE_SIZE_UNIT (etype);
-
-  i = (n << GFC_DTYPE_TYPE_SHIFT);
-  if (size && INTEGER_CST_P (size))
-    {
-      if (tree_int_cst_lt (gfc_max_array_element_size, size))
-	gfc_fatal_error ("Array element size too big at %C");
-
-      i += TREE_INT_CST_LOW (size) << GFC_DTYPE_SIZE_SHIFT;
-    }
-  dtype = build_int_cst (gfc_array_index_type, i);
-
-  if (size && !INTEGER_CST_P (size))
-    {
-      tmp = build_int_cst (gfc_array_index_type, GFC_DTYPE_SIZE_SHIFT);
-      tmp  = fold_build2_loc (input_location, LSHIFT_EXPR,
-			      gfc_array_index_type,
-			      fold_convert (gfc_array_index_type, size), tmp);
-      dtype = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
-			       tmp, dtype);
-    }
-  /* If we don't know the size we leave it as zero.  This should never happen
-     for anything that is actually used.  */
-  /* TODO: Check this is actually true, particularly when repacking
-     assumed size parameters.  */
-
-  GFC_TYPE_ARRAY_DTYPE (type) = dtype;
-  return dtype;
+  return build_int_cst (int16_type_node, type);
 }
 
 
@@ -1689,9 +1634,15 @@  gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted,
 			       enum gfc_array_kind akind)
 {
   tree fat_type, decl, arraytype, *chain = NULL;
+  tree int8_type_node, int16_type_node;
   char name[16 + 2*GFC_RANK_DIGITS + 1 + 1];
   int idx;
 
+  int8_type_node
+	= gfc_get_int_type (gfc_get_int_kind_from_width_isofortranenv (8));
+  int16_type_node
+	= gfc_get_int_type (gfc_get_int_kind_from_width_isofortranenv (16));
+
   /* Assumed-rank array.  */
   if (dimen == -1)
     dimen = GFC_MAX_DIMENSIONS;
@@ -1737,25 +1688,25 @@  gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted,
   /* Add the rank component.  */
   decl = gfc_add_field_to_struct_1 (fat_type,
 				    get_identifier ("rank"),
-				    integer_type_node, &chain);
+				    int8_type_node, &chain);
   TREE_NO_WARNING (decl) = 1;
 
-  /* Add the offset component.  */
+  /* Add the attribute component.  */
   decl = gfc_add_field_to_struct_1 (fat_type,
-				    get_identifier ("offset"),
-				    gfc_array_index_type, &chain);
+				    get_identifier ("attribute"),
+				    int8_type_node, &chain);
   TREE_NO_WARNING (decl) = 1;
 
   /* Add the type component.  */
   decl = gfc_add_field_to_struct_1 (fat_type,
 				    get_identifier ("type"),
-				    gfc_array_index_type, &chain);
+				    int16_type_node, &chain);
   TREE_NO_WARNING (decl) = 1;
 
-  /* Add the attribute component.  */
+  /* Add the offset component.  */
   decl = gfc_add_field_to_struct_1 (fat_type,
-				    get_identifier ("attribute"),
-				    integer_type_node, &chain);
+				    get_identifier ("offset"),
+				    gfc_array_index_type, &chain);
   TREE_NO_WARNING (decl) = 1;
 
   /* Build the array type for the stride and bound components.  */
diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h
index eaecfe1..d7bf588 100644
--- a/gcc/fortran/trans-types.h
+++ b/gcc/fortran/trans-types.h
@@ -97,7 +97,7 @@  int gfc_return_by_reference (gfc_symbol *);
 int gfc_is_nodesc_array (gfc_symbol *);
 
 /* Return the DTYPE for an array.  */
-tree gfc_get_dtype (tree);
+tree gfc_get_dtype (gfc_typespec *);
 
 tree gfc_get_ppc_type (gfc_component *);
 
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 8211573..e2e3eae 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -1078,7 +1078,7 @@  gfc_build_final_call (gfc_typespec ts, gfc_expr *final_wrapper, gfc_expr *var,
 	    tmp = TREE_OPERAND (array, 0);
 
 	  gfc_init_se (&se, NULL);
-	  array = gfc_conv_scalar_to_descriptor (&se, array, attr);
+	  array = gfc_conv_scalar_to_descriptor (&se, array, attr, &var->ts);
 	  array = gfc_build_addr_expr (NULL, array);
 	  gcc_assert (se.post.head == NULL_TREE);
 	}
@@ -1122,7 +1122,7 @@  gfc_build_final_call (gfc_typespec ts, gfc_expr *final_wrapper, gfc_expr *var,
 	  /* attr: Argument is neither a pointer/allocatable,
 	     i.e. no copy back needed */
 	  gfc_init_se (&se, NULL);
-	  array = gfc_conv_scalar_to_descriptor (&se, array, attr);
+	  array = gfc_conv_scalar_to_descriptor (&se, array, attr, &var->ts);
 	  array = gfc_build_addr_expr (NULL, array);
 	  gcc_assert (se.post.head == NULL_TREE);
 	}
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 3eb64d2..8b09bb7 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -404,7 +404,8 @@  void gfc_conv_expr_lhs (gfc_se * se, gfc_expr * expr);
 void gfc_conv_expr_reference (gfc_se * se, gfc_expr *);
 void gfc_conv_expr_type (gfc_se * se, gfc_expr *, tree);
 
-tree gfc_conv_scalar_to_descriptor (gfc_se *, tree, symbol_attribute);
+tree gfc_conv_scalar_to_descriptor (gfc_se *, tree, symbol_attribute,
+				    gfc_typespec *);
 
 /* Termine the byte-size of a string. */
 tree size_of_string_in_bytes (int, tree);
diff --git a/gcc/testsuite/gfortran.dg/assign_10.f90 b/gcc/testsuite/gfortran.dg/assign_10.f90
index 3aaa8fc..e37a414 100644
--- a/gcc/testsuite/gfortran.dg/assign_10.f90
+++ b/gcc/testsuite/gfortran.dg/assign_10.f90
@@ -24,5 +24,5 @@  end
 ! Note that it is the kind conversion that generates the temp.
 !
 ! { dg-final { scan-tree-dump-times "parm" 28 "original" } }
-! { dg-final { scan-tree-dump-times "atmp" 28 "original" } }
+! { dg-final { scan-tree-dump-times "atmp" 26 "original" } }
 ! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/assumed_rank_12.f90 b/gcc/testsuite/gfortran.dg/assumed_rank_12.f90
index d5d0dd5..4e4df4e 100644
--- a/gcc/testsuite/gfortran.dg/assumed_rank_12.f90
+++ b/gcc/testsuite/gfortran.dg/assumed_rank_12.f90
@@ -16,6 +16,5 @@  function f() result(res)
 end function f
 end
 
-! { dg-final { scan-tree-dump " = f \\(\\);.*desc.0.base_addr = .void .. D.\[0-9\]+;.*desc.0.elem_len = 48;.*desc.0.version = 1;.*desc.0.rank = 0;.*desc.0.type = 600;.*desc.0.attribute = 1;.*sub \\(&desc.0\\);.*D.\[0-9\]+ = .integer.kind=4. .. desc.0.base_addr;" "original" } }
+! { dg-final { scan-tree-dump " = f \\(\\);.*desc.0.base_addr = .void .. D.\[0-9\]+;.*desc.0.elem_len = 32;.*desc.0.version = 1;.*desc.0.rank = 0;.*desc.0.type = 1025;.*desc.0.attribute = 1;.*sub \\(&desc.0\\);.*D.\[0-9\]+ = .integer.kind=4. .. desc.0.base_addr;" "original" } }
 ! { dg-final { cleanup-tree-dump "original" } }
-
diff --git a/gcc/testsuite/gfortran.dg/c_loc_test_22.f90 b/gcc/testsuite/gfortran.dg/c_loc_test_22.f90
index 5263060..67e7063 100644
--- a/gcc/testsuite/gfortran.dg/c_loc_test_22.f90
+++ b/gcc/testsuite/gfortran.dg/c_loc_test_22.f90
@@ -15,10 +15,10 @@  subroutine sub(xxx, yyy)
   ptr4 = c_loc (yyy(5:))
 end
 ! { dg-final { scan-tree-dump-not " _gfortran_internal_pack" "original" } }
-! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void .\\) &\\(.xxx.\[0-9\]+\\)\\\[0\\\];" 1 "original" } }
-! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void .\\) &\\(.xxx.\[0-9\]+\\)\\\[D.\[0-9\]+ \\* 4\\\];" 1 "original" } }
-! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void .\\) &\\(.yyy.\[0-9\]+\\)\\\[0\\\];" 1 "original" } }
-! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void .\\) &\\(.yyy.\[0-9\]+\\)\\\[D.\[0-9\]+ \\* 4\\\];" 1 "original" } }
+! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.base_addr = \\(void .\\) &\\(.xxx.\[0-9\]+\\)\\\[0\\\];" 1 "original" } }
+! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.base_addr = \\(void .\\) &\\(.xxx.\[0-9\]+\\)\\\[D.\[0-9\]+ \\* 4\\\];" 1 "original" } }
+! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.base_addr = \\(void .\\) &\\(.yyy.\[0-9\]+\\)\\\[0\\\];" 1 "original" } }
+! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.base_addr = \\(void .\\) &\\(.yyy.\[0-9\]+\\)\\\[D.\[0-9\]+ \\* 4\\\];" 1 "original" } }
 
-! { dg-final { scan-tree-dump-times "D.\[0-9\]+ = parm.\[0-9\]+.data;\[^;]+ptr\[1-4\] = D.\[0-9\]+;" 4 "original" } }
+! { dg-final { scan-tree-dump-times "D.\[0-9\]+ = parm.\[0-9\]+.base_addr;\[^;]+ptr\[1-4\] = D.\[0-9\]+;" 4 "original" } }
 ! { dg-final { cleanup-tree-dump "optimized" } }
diff --git a/gcc/testsuite/gfortran.dg/class_allocate_14.f90 b/gcc/testsuite/gfortran.dg/class_allocate_14.f90
index 076176c..00c3c60 100644
--- a/gcc/testsuite/gfortran.dg/class_allocate_14.f90
+++ b/gcc/testsuite/gfortran.dg/class_allocate_14.f90
@@ -25,7 +25,8 @@  call sub()
 call sub2()
 end
 
-! { dg-final { scan-tree-dump-times "static struct __class_m_T_1_0a b = {._data={.base_addr=0B, .elem_len=4, .version=1, .rank=1, .type=296, .attribute=2}, ._vptr=&__vtab_m_T};" 1 "original" } }
+! { dg-final { scan-tree-dump-times "static struct __class_m_T_1_0a b = {._data={.base_addr=0B, .elem_len=4, .version=1, .rank=1, .attribute=2, .type=-1}, ._vptr=&__vtab_m_T};" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "static struct __class_m_T_a y = {._data=0B, ._vptr=&__vtab_m_T};" 1 "original" } }
+
 ! { dg-final { cleanup-tree-dump "original" } }
 
diff --git a/gcc/testsuite/gfortran.dg/iso-ts-29113_1_c.c b/gcc/testsuite/gfortran.dg/iso-ts-29113_1_c.c
index ed9fc8b..9f60b7b 100644
--- a/gcc/testsuite/gfortran.dg/iso-ts-29113_1_c.c
+++ b/gcc/testsuite/gfortran.dg/iso-ts-29113_1_c.c
@@ -20,9 +20,7 @@  test_address (CFI_cdesc_t *dv)
   if (dv->version != CFI_VERSION) abort ();
   if (dv->elem_len != sizeof (float)/ sizeof (char)) abort ();
   if (dv->attribute != CFI_attribute_other) abort ();
-
-  /* FIXME: Add type assert:
-     if (dv->type != CFI_type_float) abort ();  */
+  if (dv->type != CFI_type_float) abort ();
 
   /* FIXME: TS 29113 requires lower_bound == 0,
      currently, lower_bound == 1 is used.  */
diff --git a/gcc/testsuite/gfortran.dg/transpose_optimization_2.f90 b/gcc/testsuite/gfortran.dg/transpose_optimization_2.f90
index 5be77cf..e8efc34 100644
--- a/gcc/testsuite/gfortran.dg/transpose_optimization_2.f90
+++ b/gcc/testsuite/gfortran.dg/transpose_optimization_2.f90
@@ -61,5 +61,5 @@  end
 ! The check below for temporaries gave 14 and 33 for "parm" and "atmp".
 !
 ! { dg-final { scan-tree-dump-times "parm" 102 "original" } }
-! { dg-final { scan-tree-dump-times "atmp" 18 "original" } }
+! { dg-final { scan-tree-dump-times "atmp" 16 "original" } }
 ! { dg-final { cleanup-tree-dump "original" } }
diff --git a/libgfortran/ISO_Fortran_binding.h.tmpl b/libgfortran/ISO_Fortran_binding.h.tmpl
index dd7e7cf..c52052a 100644
--- a/libgfortran/ISO_Fortran_binding.h.tmpl
+++ b/libgfortran/ISO_Fortran_binding.h.tmpl
@@ -67,9 +67,9 @@  extern "C" {
 /* Types definitions.  */
 
 typedef ptrdiff_t CFI_index_t;
-typedef int CFI_attribute_t;
-typedef ptrdiff_t CFI_type_t;
-typedef int CFI_rank_t;
+typedef int8_t CFI_rank_t;
+typedef int8_t CFI_attribute_t;
+typedef int16_t CFI_type_t;
 
 
 typedef struct CFI_dim_t
@@ -86,9 +86,9 @@  typedef struct CFI_cdesc_t
   size_t elem_len;
   int version;
   CFI_rank_t rank;
-  size_t offset;
-  CFI_type_t type;
   CFI_attribute_t attribute;
+  CFI_type_t type;
+  size_t offset;
   CFI_dim_t dim[];
 }
 CFI_cdesc_t;
@@ -102,13 +102,13 @@  struct {\
   size_t elem_len;\
   int version; \
   CFI_rank_t rank; \
-  size_t offset;\
-  CFI_index_t type;\
   CFI_attribute_t attribute; \
+  CFI_type_t type;\
+  size_t offset;\
   CFI_dim_t dim[r];\
 }
 
-#define CFI_CDESC_T(r) CFI_GFC_CDESC_T (r, void)
+#define CFI_CDESC_T(r) CFI_CDESC_TYPE_T (r, void)
 
 
 /* Functions. */
@@ -141,9 +141,9 @@  int CFI_setpointer (CFI_cdesc_t *, CFI_cdesc_t *, const CFI_index_t []);
 
 /* Types without kind paramter.   */
 
-#define CFI_type_struct 7
-#define CFI_type_cptr 8
-#define CFI_type_cfunptr 9
+#define CFI_type_struct 6
+#define CFI_type_cptr 7
+#define CFI_type_cfunptr 8
 #define CFI_type_other -1
 
 
diff --git a/libgfortran/intrinsics/associated.c b/libgfortran/intrinsics/associated.c
index d34a063..e46fe7e 100644
--- a/libgfortran/intrinsics/associated.c
+++ b/libgfortran/intrinsics/associated.c
@@ -37,7 +37,7 @@  associated (const gfc_array_void *pointer, const gfc_array_void *target)
     return 0;
   if (GFC_DESCRIPTOR_DATA (pointer) != GFC_DESCRIPTOR_DATA (target))
     return 0;
-  if (GFC_DESCRIPTOR_DTYPE (pointer) != GFC_DESCRIPTOR_DTYPE (target))
+  if (GFC_DESCRIPTOR_TYPE (pointer) != GFC_DESCRIPTOR_TYPE (target))
     return 0;
 
   rank = GFC_DESCRIPTOR_RANK (pointer);
diff --git a/libgfortran/intrinsics/cshift0.c b/libgfortran/intrinsics/cshift0.c
index ee81111..832e807 100644
--- a/libgfortran/intrinsics/cshift0.c
+++ b/libgfortran/intrinsics/cshift0.c
@@ -51,7 +51,7 @@  cshift0 (gfc_array_char * ret, const gfc_array_char * array,
   index_type n;
   index_type arraysize;
 
-  index_type type_size;
+  CFI_type_t type;
 
   if (which < 1 || which > GFC_DESCRIPTOR_RANK (array))
     runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'");
@@ -92,98 +92,84 @@  cshift0 (gfc_array_char * ret, const gfc_array_char * array,
   if (arraysize == 0)
     return;
 
-  type_size = GFC_DTYPE_TYPE_SIZE (array);
+  type = GFC_DESCRIPTOR_TYPE (array);
+  if ((type == CFI_type_struct || type == CFI_type_other)
+      && GFC_DESCRIPTOR_ELEM_LEN (array) == 1)
+    type = CFI_type_Integer1;
 
-  switch(type_size)
+  switch(type)
     {
-    case GFC_DTYPE_LOGICAL_1:
-    case GFC_DTYPE_INTEGER_1:
-    case GFC_DTYPE_DERIVED_1:
+    case CFI_type_Integer1:
+    case CFI_type_Logical1:
       cshift0_i1 ((gfc_array_i1 *)ret, (gfc_array_i1 *) array, shift, which);
       return;
 
-    case GFC_DTYPE_LOGICAL_2:
-    case GFC_DTYPE_INTEGER_2:
+    case CFI_type_Integer2:
+    case CFI_type_Logical2:
       cshift0_i2 ((gfc_array_i2 *)ret, (gfc_array_i2 *) array, shift, which);
       return;
 
-    case GFC_DTYPE_LOGICAL_4:
-    case GFC_DTYPE_INTEGER_4:
+    case CFI_type_Integer4:
+    case CFI_type_Logical4:
       cshift0_i4 ((gfc_array_i4 *)ret, (gfc_array_i4 *) array, shift, which);
       return;
 
-    case GFC_DTYPE_LOGICAL_8:
-    case GFC_DTYPE_INTEGER_8:
+    case CFI_type_Integer8:
+    case CFI_type_Logical8:
       cshift0_i8 ((gfc_array_i8 *)ret, (gfc_array_i8 *) array, shift, which);
       return;
 
 #ifdef HAVE_GFC_INTEGER_16
-    case GFC_DTYPE_LOGICAL_16:
-    case GFC_DTYPE_INTEGER_16:
+    case CFI_type_Integer16:
+    case CFI_type_Logical16:
       cshift0_i16 ((gfc_array_i16 *)ret, (gfc_array_i16 *) array, shift,
 		   which);
       return;
 #endif
 
-    case GFC_DTYPE_REAL_4:
+    case CFI_type_Real4:
       cshift0_r4 ((gfc_array_r4 *)ret, (gfc_array_r4 *) array, shift, which);
       return;
 
-    case GFC_DTYPE_REAL_8:
+    case CFI_type_Real8:
       cshift0_r8 ((gfc_array_r8 *)ret, (gfc_array_r8 *) array, shift, which);
       return;
 
-/* FIXME: This here is a hack, which will have to be removed when
-   the array descriptor is reworked.  Currently, we don't store the
-   kind value for the type, but only the size.  Because on targets with
-   __float128, we have sizeof(logn double) == sizeof(__float128),
-   we cannot discriminate here and have to fall back to the generic
-   handling (which is suboptimal).  */
-#if !defined(GFC_REAL_16_IS_FLOAT128)
 # ifdef HAVE_GFC_REAL_10
-    case GFC_DTYPE_REAL_10:
+    case CFI_type_Real10:
       cshift0_r10 ((gfc_array_r10 *)ret, (gfc_array_r10 *) array, shift,
 		   which);
       return;
 # endif
 
 # ifdef HAVE_GFC_REAL_16
-    case GFC_DTYPE_REAL_16:
+    case CFI_type_Real16:
       cshift0_r16 ((gfc_array_r16 *)ret, (gfc_array_r16 *) array, shift,
 		   which);
       return;
 # endif
-#endif
 
-    case GFC_DTYPE_COMPLEX_4:
+    case CFI_type_Complex4:
       cshift0_c4 ((gfc_array_c4 *)ret, (gfc_array_c4 *) array, shift, which);
       return;
 
-    case GFC_DTYPE_COMPLEX_8:
+    case CFI_type_Complex8:
       cshift0_c8 ((gfc_array_c8 *)ret, (gfc_array_c8 *) array, shift, which);
       return;
 
-/* FIXME: This here is a hack, which will have to be removed when
-   the array descriptor is reworked.  Currently, we don't store the
-   kind value for the type, but only the size.  Because on targets with
-   __float128, we have sizeof(logn double) == sizeof(__float128),
-   we cannot discriminate here and have to fall back to the generic
-   handling (which is suboptimal).  */
-#if !defined(GFC_REAL_16_IS_FLOAT128)
 # ifdef HAVE_GFC_COMPLEX_10
-    case GFC_DTYPE_COMPLEX_10:
+    case CFI_type_Complex10:
       cshift0_c10 ((gfc_array_c10 *)ret, (gfc_array_c10 *) array, shift,
 		   which);
       return;
 # endif
 
 # ifdef HAVE_GFC_COMPLEX_16
-    case GFC_DTYPE_COMPLEX_16:
+    case CFI_type_Complex16:
       cshift0_c16 ((gfc_array_c16 *)ret, (gfc_array_c16 *) array, shift,
 		   which);
       return;
 # endif
-#endif
 
     default:
       break;
@@ -286,7 +272,6 @@  cshift0 (gfc_array_char * ret, const gfc_array_char * array,
       break;
     }
 
-
   which = which - 1;
   sstride[0] = 0;
   rstride[0] = 0;
diff --git a/libgfortran/intrinsics/date_and_time.c b/libgfortran/intrinsics/date_and_time.c
index d53ea29..ce90bb4 100644
--- a/libgfortran/intrinsics/date_and_time.c
+++ b/libgfortran/intrinsics/date_and_time.c
@@ -271,9 +271,7 @@  secnds (GFC_REAL_4 *x)
   /* Make the INTEGER*4 array for passing to date_and_time.  */
   gfc_array_i4 *avalues = xmalloc (sizeof (gfc_array_i4));
   avalues->base_addr = &values[0];
-  GFC_DESCRIPTOR_DTYPE (avalues) = ((BT_REAL << GFC_DTYPE_TYPE_SHIFT)
-				        & GFC_DTYPE_TYPE_MASK) +
-				    (4 << GFC_DTYPE_SIZE_SHIFT);
+  GFC_DESCRIPTOR_TYPE (avalues) = CFI_type_Real4;
   GFC_DESCRIPTOR_ELEM_LEN (avalues) = sizeof (GFC_INTEGER_4);
   GFC_DIMENSION_SET (avalues->dim[0], 0, 8, sizeof (GFC_REAL_4));
 
diff --git a/libgfortran/intrinsics/iso_c_binding.c b/libgfortran/intrinsics/iso_c_binding.c
index e3e095d..0be7176 100644
--- a/libgfortran/intrinsics/iso_c_binding.c
+++ b/libgfortran/intrinsics/iso_c_binding.c
@@ -60,7 +60,8 @@  ISO_C_BINDING_PREFIX (c_f_pointer) (void *c_ptr_in,
       f_ptr_out->offset = 0;
 
       /* Set the data type (e.g., BT_INTEGER).  */
-      f_ptr_out->type = (type << GFC_DTYPE_TYPE_SHIFT);
+      f_ptr_out->type = type;
+      f_ptr_out->elem_len = elemSize;
     }
   
   /* Use the generic version of c_f_pointer to set common fields.  */
@@ -156,8 +157,7 @@  ISO_C_BINDING_PREFIX (c_f_pointer_u0) (void *c_ptr_in,
          shift right by TYPE_SHIFT bits we'll throw away the existing
          rank.  Then, shift left by the same number to shift in zeros
          and or with the new rank.  */
-      f_ptr_out->type = ((f_ptr_out->type >> GFC_DTYPE_TYPE_SHIFT)
-                           << GFC_DTYPE_TYPE_SHIFT);
+      f_ptr_out->type = f_ptr_out->type;
     }
 }
 
@@ -176,8 +176,7 @@  ISO_C_BINDING_PREFIX (c_f_pointer_d0) (void *c_ptr_in,
   /* Preserve the size and rank bits, but reset the type.  */
   if (shape != NULL)
     {
-      f_ptr_out->type = f_ptr_out->type & (~GFC_DTYPE_TYPE_MASK);
-      f_ptr_out->type = f_ptr_out->type
-			 | (BT_DERIVED << GFC_DTYPE_TYPE_SHIFT);
+      f_ptr_out->type = f_ptr_out->type;
+      f_ptr_out->type = CFI_type_struct;
     }
 }
diff --git a/libgfortran/intrinsics/pack_generic.c b/libgfortran/intrinsics/pack_generic.c
index bae059a..5836c25 100644
--- a/libgfortran/intrinsics/pack_generic.c
+++ b/libgfortran/intrinsics/pack_generic.c
@@ -122,6 +122,8 @@  pack_internal (gfc_array_char *ret, const gfc_array_char *array,
       extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
       sstride[n] = GFC_DESCRIPTOR_SM(array,n);
       mstride[n] = GFC_DESCRIPTOR_SM(mask,n);
+      if (extent[n] <= 0)
+	mptr = NULL;
     }
   if (sstride[0] == 0)
     sstride[0] = size;
@@ -248,160 +250,154 @@  void
 pack (gfc_array_char *ret, const gfc_array_char *array,
       const gfc_array_l1 *mask, const gfc_array_char *vector)
 {
-  index_type type_size;
+  CFI_type_t type;
   index_type size;
 
-  type_size = GFC_DTYPE_TYPE_SIZE(array);
+  type = GFC_DESCRIPTOR_TYPE (array);
+  if ((type == CFI_type_struct || type == CFI_type_other)
+      && GFC_DESCRIPTOR_ELEM_LEN (array) == 1)
+    type = CFI_type_Integer1;
 
-  switch(type_size)
+  switch(type)
     {
-    case GFC_DTYPE_LOGICAL_1:
-    case GFC_DTYPE_INTEGER_1:
-    case GFC_DTYPE_DERIVED_1:
+    case CFI_type_Integer1:
+    case CFI_type_Logical1:
       pack_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) array,
 	       (gfc_array_l1 *) mask, (gfc_array_i1 *) vector);
       return;
 
-    case GFC_DTYPE_LOGICAL_2:
-    case GFC_DTYPE_INTEGER_2:
+    case CFI_type_Integer2:
+    case CFI_type_Logical2:
       pack_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) array,
 	       (gfc_array_l1 *) mask, (gfc_array_i2 *) vector);
       return;
 
-    case GFC_DTYPE_LOGICAL_4:
-    case GFC_DTYPE_INTEGER_4:
+    case CFI_type_Integer4:
+    case CFI_type_Logical4:
       pack_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) array,
 	       (gfc_array_l1 *) mask, (gfc_array_i4 *) vector);
       return;
 
-    case GFC_DTYPE_LOGICAL_8:
-    case GFC_DTYPE_INTEGER_8:
+    case CFI_type_Integer8:
+    case CFI_type_Logical8:
       pack_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) array,
 	       (gfc_array_l1 *) mask, (gfc_array_i8 *) vector);
       return;
 
 #ifdef HAVE_GFC_INTEGER_16
-    case GFC_DTYPE_LOGICAL_16:
-    case GFC_DTYPE_INTEGER_16:
+    case CFI_type_Integer16:
+    case CFI_type_Logical16:
       pack_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) array,
 		(gfc_array_l1 *) mask, (gfc_array_i16 *) vector);
       return;
 #endif
 
-    case GFC_DTYPE_REAL_4:
+    case CFI_type_Real4:
       pack_r4 ((gfc_array_r4 *) ret, (gfc_array_r4 *) array,
 	       (gfc_array_l1 *) mask, (gfc_array_r4 *) vector);
       return;
 
-    case GFC_DTYPE_REAL_8:
+    case CFI_type_Real8:
       pack_r8 ((gfc_array_r8 *) ret, (gfc_array_r8 *) array,
 	       (gfc_array_l1 *) mask, (gfc_array_r8 *) vector);
       return;
 
-/* FIXME: This here is a hack, which will have to be removed when
-   the array descriptor is reworked.  Currently, we don't store the
-   kind value for the type, but only the size.  Because on targets with
-   __float128, we have sizeof(logn double) == sizeof(__float128),
-   we cannot discriminate here and have to fall back to the generic
-   handling (which is suboptimal).  */
-#if !defined(GFC_REAL_16_IS_FLOAT128)
 # ifdef HAVE_GFC_REAL_10
-    case GFC_DTYPE_REAL_10:
+    case CFI_type_Real10:
       pack_r10 ((gfc_array_r10 *) ret, (gfc_array_r10 *) array,
 		(gfc_array_l1 *) mask, (gfc_array_r10 *) vector);
       return;
 # endif
 
 # ifdef HAVE_GFC_REAL_16
-    case GFC_DTYPE_REAL_16:
+    case CFI_type_Real16:
       pack_r16 ((gfc_array_r16 *) ret, (gfc_array_r16 *) array,
 		(gfc_array_l1 *) mask, (gfc_array_r16 *) vector);
       return;
 # endif
-#endif
 
-    case GFC_DTYPE_COMPLEX_4:
+    case CFI_type_Complex4:
       pack_c4 ((gfc_array_c4 *) ret, (gfc_array_c4 *) array,
 	       (gfc_array_l1 *) mask, (gfc_array_c4 *) vector);
       return;
 
-    case GFC_DTYPE_COMPLEX_8:
+    case CFI_type_Complex8:
       pack_c8 ((gfc_array_c8 *) ret, (gfc_array_c8 *) array,
 	       (gfc_array_l1 *) mask, (gfc_array_c8 *) vector);
       return;
 
-/* FIXME: This here is a hack, which will have to be removed when
-   the array descriptor is reworked.  Currently, we don't store the
-   kind value for the type, but only the size.  Because on targets with
-   __float128, we have sizeof(logn double) == sizeof(__float128),
-   we cannot discriminate here and have to fall back to the generic
-   handling (which is suboptimal).  */
-#if !defined(GFC_REAL_16_IS_FLOAT128)
 # ifdef HAVE_GFC_COMPLEX_10
-    case GFC_DTYPE_COMPLEX_10:
+    case CFI_type_Complex10:
       pack_c10 ((gfc_array_c10 *) ret, (gfc_array_c10 *) array,
 		(gfc_array_l1 *) mask, (gfc_array_c10 *) vector);
       return;
 # endif
 
 # ifdef HAVE_GFC_COMPLEX_16
-    case GFC_DTYPE_COMPLEX_16:
+    case CFI_type_Complex16:
       pack_c16 ((gfc_array_c16 *) ret, (gfc_array_c16 *) array,
 		(gfc_array_l1 *) mask, (gfc_array_c16 *) vector);
       return;
 # endif
-#endif
 
       /* For derived types, let's check the actual alignment of the
 	 data pointers.  If they are aligned, we can safely call
 	 the unpack functions.  */
 
-    case GFC_DTYPE_DERIVED_2:
-      if (GFC_UNALIGNED_2(ret->base_addr) || GFC_UNALIGNED_2(array->base_addr)
-	  || (vector && GFC_UNALIGNED_2(vector->base_addr)))
-	break;
-      else
-	{
-	  pack_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) array,
-		   (gfc_array_l1 *) mask, (gfc_array_i2 *) vector);
-	  return;
-	}
+    case CFI_type_struct:
+    case CFI_type_other:
+      switch (GFC_DESCRIPTOR_ELEM_LEN(array))
+        {
+	case 2:
+	  if (GFC_UNALIGNED_2(ret->base_addr)
+	      || GFC_UNALIGNED_2(array->base_addr)
+	      || (vector && GFC_UNALIGNED_2(vector->base_addr)))
+	    break;
+	  else
+	    {
+	      pack_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) array,
+		       (gfc_array_l1 *) mask, (gfc_array_i2 *) vector);
+	      return;
+	    }
 
-    case GFC_DTYPE_DERIVED_4:
-      if (GFC_UNALIGNED_4(ret->base_addr) || GFC_UNALIGNED_4(array->base_addr)
-	  || (vector && GFC_UNALIGNED_4(vector->base_addr)))
-	break;
-      else
-	{
-	  pack_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) array,
-		   (gfc_array_l1 *) mask, (gfc_array_i4 *) vector);
-	  return;
-	}
+	case 4:
+	  if (GFC_UNALIGNED_4(ret->base_addr)
+	      || GFC_UNALIGNED_4(array->base_addr)
+	      || (vector && GFC_UNALIGNED_4(vector->base_addr)))
+	    break;
+	  else
+	    {
+	      pack_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) array,
+		       (gfc_array_l1 *) mask, (gfc_array_i4 *) vector);
+	      return;
+	    }
 
-    case GFC_DTYPE_DERIVED_8:
-      if (GFC_UNALIGNED_8(ret->base_addr) || GFC_UNALIGNED_8(array->base_addr)
-	  || (vector && GFC_UNALIGNED_8(vector->base_addr)))
-	break;
-      else
-	{
-	  pack_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) array,
-		   (gfc_array_l1 *) mask, (gfc_array_i8 *) vector);
-	  return;
-	}
+	case 8:
+	  if (GFC_UNALIGNED_8(ret->base_addr)
+	      || GFC_UNALIGNED_8(array->base_addr)
+	      || (vector && GFC_UNALIGNED_8(vector->base_addr)))
+	    break;
+	  else
+	    {
+	      pack_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) array,
+		       (gfc_array_l1 *) mask, (gfc_array_i8 *) vector);
+	      return;
+	    }
 
 #ifdef HAVE_GFC_INTEGER_16
-    case GFC_DTYPE_DERIVED_16:
-      if (GFC_UNALIGNED_16(ret->base_addr) || GFC_UNALIGNED_16(array->base_addr)
-	  || (vector && GFC_UNALIGNED_16(vector->base_addr)))
-	break;
-      else
-	{
-	  pack_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) array,
-		   (gfc_array_l1 *) mask, (gfc_array_i16 *) vector);
-	  return;
-	}
+	case 16:
+	  if (GFC_UNALIGNED_16(ret->base_addr)
+	      || GFC_UNALIGNED_16(array->base_addr)
+	      || (vector && GFC_UNALIGNED_16(vector->base_addr)))
+	    break;
+	  else
+	    {
+	      pack_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) array,
+			(gfc_array_l1 *) mask, (gfc_array_i16 *) vector);
+	      return;
+	    }
 #endif
-
+      }
     }
 
   size = GFC_DESCRIPTOR_ELEM_LEN (array);
diff --git a/libgfortran/intrinsics/spread_generic.c b/libgfortran/intrinsics/spread_generic.c
index 00c10bf..56a2090 100644
--- a/libgfortran/intrinsics/spread_generic.c
+++ b/libgfortran/intrinsics/spread_generic.c
@@ -252,8 +252,9 @@  spread_internal_scalar (gfc_array_char *ret, const char *source,
     }
   else
     {
-      if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0)  - 1)
-			   / GFC_DESCRIPTOR_STRIDE(ret,0))
+      if (ncopies - 1
+	  > (index_type) ((GFC_DESCRIPTOR_EXTENT(ret,0)  - 1)
+			 / GFC_DESCRIPTOR_STRIDE(ret,0)))
 	runtime_error ("dim too large in spread()");
     }
 
@@ -272,150 +273,146 @@  void
 spread (gfc_array_char *ret, const gfc_array_char *source,
 	const index_type *along, const index_type *pncopies)
 {
-  index_type type_size;
+  CFI_type_t type;
 
-  type_size = GFC_DTYPE_TYPE_SIZE(ret);
-  switch(type_size)
+  type = GFC_DESCRIPTOR_TYPE (ret);
+  if ((type == CFI_type_struct || type == CFI_type_other)
+      && GFC_DESCRIPTOR_ELEM_LEN (ret) == 1)
+    type = CFI_type_Integer1;
+
+  switch(type)
     {
-    case GFC_DTYPE_DERIVED_1:
-    case GFC_DTYPE_LOGICAL_1:
-    case GFC_DTYPE_INTEGER_1:
+    case CFI_type_Integer1:
+    case CFI_type_Logical1:
       spread_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) source,
 		 *along, *pncopies);
       return;
 
-    case GFC_DTYPE_LOGICAL_2:
-    case GFC_DTYPE_INTEGER_2:
+    case CFI_type_Integer2:
+    case CFI_type_Logical2:
       spread_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) source,
 		 *along, *pncopies);
       return;
 
-    case GFC_DTYPE_LOGICAL_4:
-    case GFC_DTYPE_INTEGER_4:
+    case CFI_type_Integer4:
+    case CFI_type_Logical4:
       spread_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) source,
 		 *along, *pncopies);
       return;
 
-    case GFC_DTYPE_LOGICAL_8:
-    case GFC_DTYPE_INTEGER_8:
+    case CFI_type_Integer8:
+    case CFI_type_Logical8:
       spread_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) source,
 		 *along, *pncopies);
       return;
 
 #ifdef HAVE_GFC_INTEGER_16
-    case GFC_DTYPE_LOGICAL_16:
-    case GFC_DTYPE_INTEGER_16:
+    case CFI_type_Integer16:
+    case CFI_type_Logical16:
       spread_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) source,
 		 *along, *pncopies);
       return;
 #endif
 
-    case GFC_DTYPE_REAL_4:
+    case CFI_type_Real4:
       spread_r4 ((gfc_array_r4 *) ret, (gfc_array_r4 *) source,
 		 *along, *pncopies);
       return;
 
-    case GFC_DTYPE_REAL_8:
+    case CFI_type_Real8:
       spread_r8 ((gfc_array_r8 *) ret, (gfc_array_r8 *) source,
 		 *along, *pncopies);
       return;
 
-/* FIXME: This here is a hack, which will have to be removed when
-   the array descriptor is reworked.  Currently, we don't store the
-   kind value for the type, but only the size.  Because on targets with
-   __float128, we have sizeof(logn double) == sizeof(__float128),
-   we cannot discriminate here and have to fall back to the generic
-   handling (which is suboptimal).  */
-#if !defined(GFC_REAL_16_IS_FLOAT128)
 # ifdef GFC_HAVE_REAL_10
-    case GFC_DTYPE_REAL_10:
+    case CFI_type_Real10:
       spread_r10 ((gfc_array_r10 *) ret, (gfc_array_r10 *) source,
 		 *along, *pncopies);
       return;
 # endif
 
 # ifdef GFC_HAVE_REAL_16
-    case GFC_DTYPE_REAL_16:
+    case CFI_type_Real16:
       spread_r16 ((gfc_array_r16 *) ret, (gfc_array_r16 *) source,
 		 *along, *pncopies);
       return;
 # endif
-#endif
 
-    case GFC_DTYPE_COMPLEX_4:
+    case CFI_type_Complex4:
       spread_c4 ((gfc_array_c4 *) ret, (gfc_array_c4 *) source,
 		 *along, *pncopies);
       return;
 
-    case GFC_DTYPE_COMPLEX_8:
+    case CFI_type_Complex8:
       spread_c8 ((gfc_array_c8 *) ret, (gfc_array_c8 *) source,
 		 *along, *pncopies);
       return;
 
-/* FIXME: This here is a hack, which will have to be removed when
-   the array descriptor is reworked.  Currently, we don't store the
-   kind value for the type, but only the size.  Because on targets with
-   __float128, we have sizeof(logn double) == sizeof(__float128),
-   we cannot discriminate here and have to fall back to the generic
-   handling (which is suboptimal).  */
-#if !defined(GFC_REAL_16_IS_FLOAT128)
 # ifdef GFC_HAVE_COMPLEX_10
-    case GFC_DTYPE_COMPLEX_10:
+    case CFI_type_Complex10:
       spread_c10 ((gfc_array_c10 *) ret, (gfc_array_c10 *) source,
 		 *along, *pncopies);
       return;
 # endif
 
 # ifdef GFC_HAVE_COMPLEX_16
-    case GFC_DTYPE_COMPLEX_16:
+    case CFI_type_Complex16:
       spread_c16 ((gfc_array_c16 *) ret, (gfc_array_c16 *) source,
 		 *along, *pncopies);
       return;
 # endif
-#endif
 
-    case GFC_DTYPE_DERIVED_2:
-      if (GFC_UNALIGNED_2(ret->base_addr) || GFC_UNALIGNED_2(source->base_addr))
-	break;
-      else
+    case CFI_type_struct:
+    case CFI_type_other:
+      switch (GFC_DESCRIPTOR_ELEM_LEN(ret))
 	{
-	  spread_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) source,
-		     *along, *pncopies);
+	case 2:
+	  if (GFC_UNALIGNED_2(ret->base_addr)
+	      || GFC_UNALIGNED_2(source->base_addr))
+	    break;
+	  else
+	    {
+	      spread_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) source,
+			 *along, *pncopies);
 	  return;
-	}
+	    }
 
-    case GFC_DTYPE_DERIVED_4:
-      if (GFC_UNALIGNED_4(ret->base_addr) || GFC_UNALIGNED_4(source->base_addr))
-	break;
-      else
-	{
-	  spread_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) source,
-		     *along, *pncopies);
+	case 4:
+	  if (GFC_UNALIGNED_4(ret->base_addr)
+	      || GFC_UNALIGNED_4(source->base_addr))
+	    break;
+	  else
+	    {
+	      spread_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) source,
+			 *along, *pncopies);
 	  return;
-	}
+	    }
 
-    case GFC_DTYPE_DERIVED_8:
-      if (GFC_UNALIGNED_8(ret->base_addr) || GFC_UNALIGNED_8(source->base_addr))
-	break;
-      else
-	{
-	  spread_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) source,
-		     *along, *pncopies);
+	case 8:
+	  if (GFC_UNALIGNED_8(ret->base_addr)
+	      || GFC_UNALIGNED_8(source->base_addr))
+	    break;
+	  else
+	    {
+	      spread_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) source,
+			 *along, *pncopies);
 	  return;
-	}
+	    }
 
 #ifdef HAVE_GFC_INTEGER_16
-    case GFC_DTYPE_DERIVED_16:
-      if (GFC_UNALIGNED_16(ret->base_addr)
-	  || GFC_UNALIGNED_16(source->base_addr))
-	break;
-      else
-	{
-	  spread_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) source,
-		      *along, *pncopies);
-	  return;
-	}
+	case 16:
+	  if (GFC_UNALIGNED_16(ret->base_addr)
+	      || GFC_UNALIGNED_16(source->base_addr))
+	    break;
+	  else
+	    {
+	      spread_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) source,
+			  *along, *pncopies);
+	      return;
+	    }
 #endif
+	}
+      break;
     }
 
   spread_internal (ret, source, along, pncopies);
@@ -465,151 +462,144 @@  void
 spread_scalar (gfc_array_char *ret, const char *source,
 	       const index_type *along, const index_type *pncopies)
 {
-  index_type type_size;
+  CFI_type_t type;
 
   if (!ret->type)
     runtime_error ("return array missing descriptor in spread()");
 
-  type_size = GFC_DTYPE_TYPE_SIZE(ret);
-  switch(type_size)
+  type = GFC_DESCRIPTOR_TYPE (ret);
+  if ((type == CFI_type_struct || type == CFI_type_other)
+      && GFC_DESCRIPTOR_ELEM_LEN (ret) == 1)
+    type = CFI_type_Integer1;
+
+  switch(type)
     {
-    case GFC_DTYPE_DERIVED_1:
-    case GFC_DTYPE_LOGICAL_1:
-    case GFC_DTYPE_INTEGER_1:
+    case CFI_type_Integer1:
+    case CFI_type_Logical1:
       spread_scalar_i1 ((gfc_array_i1 *) ret, (GFC_INTEGER_1 *) source,
 			*along, *pncopies);
       return;
 
-    case GFC_DTYPE_LOGICAL_2:
-    case GFC_DTYPE_INTEGER_2:
+    case CFI_type_Integer2:
+    case CFI_type_Logical2:
       spread_scalar_i2 ((gfc_array_i2 *) ret, (GFC_INTEGER_2 *) source,
 			*along, *pncopies);
       return;
 
-    case GFC_DTYPE_LOGICAL_4:
-    case GFC_DTYPE_INTEGER_4:
+    case CFI_type_Integer4:
+    case CFI_type_Logical4:
       spread_scalar_i4 ((gfc_array_i4 *) ret, (GFC_INTEGER_4 *) source,
 			*along, *pncopies);
       return;
 
-    case GFC_DTYPE_LOGICAL_8:
-    case GFC_DTYPE_INTEGER_8:
+    case CFI_type_Integer8:
+    case CFI_type_Logical8:
       spread_scalar_i8 ((gfc_array_i8 *) ret, (GFC_INTEGER_8 *) source,
 			*along, *pncopies);
       return;
 
 #ifdef HAVE_GFC_INTEGER_16
-    case GFC_DTYPE_LOGICAL_16:
-    case GFC_DTYPE_INTEGER_16:
+    case CFI_type_Integer16:
+    case CFI_type_Logical16:
       spread_scalar_i16 ((gfc_array_i16 *) ret, (GFC_INTEGER_16 *) source,
 			*along, *pncopies);
       return;
 #endif
 
-    case GFC_DTYPE_REAL_4:
+    case CFI_type_Real4:
       spread_scalar_r4 ((gfc_array_r4 *) ret, (GFC_REAL_4 *) source,
 			*along, *pncopies);
       return;
 
-    case GFC_DTYPE_REAL_8:
+    case CFI_type_Real8:
       spread_scalar_r8 ((gfc_array_r8 *) ret, (GFC_REAL_8 *) source,
 			*along, *pncopies);
       return;
 
-/* FIXME: This here is a hack, which will have to be removed when
-   the array descriptor is reworked.  Currently, we don't store the
-   kind value for the type, but only the size.  Because on targets with
-   __float128, we have sizeof(logn double) == sizeof(__float128),
-   we cannot discriminate here and have to fall back to the generic
-   handling (which is suboptimal).  */
-#if !defined(GFC_REAL_16_IS_FLOAT128)
 # ifdef HAVE_GFC_REAL_10
-    case GFC_DTYPE_REAL_10:
+    case CFI_type_Real10:
       spread_scalar_r10 ((gfc_array_r10 *) ret, (GFC_REAL_10 *) source,
 			*along, *pncopies);
       return;
 # endif
 
 # ifdef HAVE_GFC_REAL_16
-    case GFC_DTYPE_REAL_16:
+    case CFI_type_Real16:
       spread_scalar_r16 ((gfc_array_r16 *) ret, (GFC_REAL_16 *) source,
 			*along, *pncopies);
       return;
 # endif
-#endif
 
-    case GFC_DTYPE_COMPLEX_4:
+    case CFI_type_Complex4:
       spread_scalar_c4 ((gfc_array_c4 *) ret, (GFC_COMPLEX_4 *) source,
 			*along, *pncopies);
       return;
 
-    case GFC_DTYPE_COMPLEX_8:
+    case CFI_type_Complex8:
       spread_scalar_c8 ((gfc_array_c8 *) ret, (GFC_COMPLEX_8 *) source,
 			*along, *pncopies);
       return;
 
-/* FIXME: This here is a hack, which will have to be removed when
-   the array descriptor is reworked.  Currently, we don't store the
-   kind value for the type, but only the size.  Because on targets with
-   __float128, we have sizeof(logn double) == sizeof(__float128),
-   we cannot discriminate here and have to fall back to the generic
-   handling (which is suboptimal).  */
-#if !defined(GFC_REAL_16_IS_FLOAT128)
 # ifdef HAVE_GFC_COMPLEX_10
-    case GFC_DTYPE_COMPLEX_10:
+    case CFI_type_Complex10:
       spread_scalar_c10 ((gfc_array_c10 *) ret, (GFC_COMPLEX_10 *) source,
 			*along, *pncopies);
       return;
 # endif
 
 # ifdef HAVE_GFC_COMPLEX_16
-    case GFC_DTYPE_COMPLEX_16:
+    case CFI_type_Complex16:
       spread_scalar_c16 ((gfc_array_c16 *) ret, (GFC_COMPLEX_16 *) source,
 			*along, *pncopies);
       return;
 # endif
-#endif
 
-    case GFC_DTYPE_DERIVED_2:
-      if (GFC_UNALIGNED_2(ret->base_addr) || GFC_UNALIGNED_2(source))
-	break;
-      else
+    case CFI_type_struct:
+    case CFI_type_other:
+      switch (GFC_DESCRIPTOR_ELEM_LEN(ret))
 	{
-	  spread_scalar_i2 ((gfc_array_i2 *) ret, (GFC_INTEGER_2 *) source,
-			    *along, *pncopies);
-	  return;
-	}
+	case 2:
+	  if (GFC_UNALIGNED_2(ret->base_addr) || GFC_UNALIGNED_2(source))
+	    break;
+	  else
+	    {
+	      spread_scalar_i2 ((gfc_array_i2 *) ret, (GFC_INTEGER_2 *) source,
+				*along, *pncopies);
+	      return;
+	    }
 
-    case GFC_DTYPE_DERIVED_4:
-      if (GFC_UNALIGNED_4(ret->base_addr) || GFC_UNALIGNED_4(source))
-	break;
-      else
-	{
-	  spread_scalar_i4 ((gfc_array_i4 *) ret, (GFC_INTEGER_4 *) source,
-			    *along, *pncopies);
-	  return;
-	}
+	case 4:
+	  if (GFC_UNALIGNED_4(ret->base_addr) || GFC_UNALIGNED_4(source))
+	    break;
+	  else
+	    {
+	      spread_scalar_i4 ((gfc_array_i4 *) ret, (GFC_INTEGER_4 *) source,
+				*along, *pncopies);
+	      return;
+	    }
+
+	case 8:
+	  if (GFC_UNALIGNED_8(ret->base_addr) || GFC_UNALIGNED_8(source))
+	    break;
+	  else
+	    {
+	      spread_scalar_i8 ((gfc_array_i8 *) ret, (GFC_INTEGER_8 *) source,
+				*along, *pncopies);
+	      return;
+	    }
 
-    case GFC_DTYPE_DERIVED_8:
-      if (GFC_UNALIGNED_8(ret->base_addr) || GFC_UNALIGNED_8(source))
-	break;
-      else
-	{
-	  spread_scalar_i8 ((gfc_array_i8 *) ret, (GFC_INTEGER_8 *) source,
-			    *along, *pncopies);
-	  return;
-	}
 #ifdef HAVE_GFC_INTEGER_16
-    case GFC_DTYPE_DERIVED_16:
-      if (GFC_UNALIGNED_16(ret->base_addr) || GFC_UNALIGNED_16(source))
-	break;
-      else
-	{
-	  spread_scalar_i16 ((gfc_array_i16 *) ret, (GFC_INTEGER_16 *) source,
-			     *along, *pncopies);
-	  return;
-	}
+	case 16:
+	  if (GFC_UNALIGNED_16(ret->base_addr) || GFC_UNALIGNED_16(source))
+	    break;
+	  else
+	    {
+	      spread_scalar_i16 ((gfc_array_i16 *) ret,
+				 (GFC_INTEGER_16 *) source, *along, *pncopies);
+	      return;
+	    }
 #endif
+	}
     }
 
   spread_internal_scalar (ret, source, along, pncopies);
diff --git a/libgfortran/intrinsics/unpack_generic.c b/libgfortran/intrinsics/unpack_generic.c
index eb72ddf..22fd152 100644
--- a/libgfortran/intrinsics/unpack_generic.c
+++ b/libgfortran/intrinsics/unpack_generic.c
@@ -207,160 +207,155 @@  void
 unpack1 (gfc_array_char *ret, const gfc_array_char *vector,
 	 const gfc_array_l1 *mask, const gfc_array_char *field)
 {
-  index_type type_size;
+  CFI_type_t type;
   index_type size;
 
   if (unlikely(compile_options.bounds_check))
     unpack_bounds (ret, vector, mask, field);
 
-  type_size = GFC_DTYPE_TYPE_SIZE (vector);
   size = GFC_DESCRIPTOR_ELEM_LEN (vector);
 
-  switch(type_size)
+  type = GFC_DESCRIPTOR_TYPE (vector);
+  if ((type == CFI_type_struct || type == CFI_type_other)
+      && GFC_DESCRIPTOR_ELEM_LEN (vector) == 1)
+    type = CFI_type_Integer1;
+
+  switch (type)
     {
-    case GFC_DTYPE_LOGICAL_1:
-    case GFC_DTYPE_INTEGER_1:
-    case GFC_DTYPE_DERIVED_1:
+    case CFI_type_Integer1:
+    case CFI_type_Logical1:
       unpack1_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) vector,
 		  mask, (gfc_array_i1 *) field);
       return;
 
-    case GFC_DTYPE_LOGICAL_2:
-    case GFC_DTYPE_INTEGER_2:
+    case CFI_type_Integer2:
+    case CFI_type_Logical2:
       unpack1_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) vector,
 		  mask, (gfc_array_i2 *) field);
       return;
 
-    case GFC_DTYPE_LOGICAL_4:
-    case GFC_DTYPE_INTEGER_4:
+    case CFI_type_Integer4:
+    case CFI_type_Logical4:
       unpack1_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) vector,
 		  mask, (gfc_array_i4 *) field);
       return;
 
-    case GFC_DTYPE_LOGICAL_8:
-    case GFC_DTYPE_INTEGER_8:
+    case CFI_type_Integer8:
+    case CFI_type_Logical8:
       unpack1_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) vector,
 		  mask, (gfc_array_i8 *) field);
       return;
 
 #ifdef HAVE_GFC_INTEGER_16
-    case GFC_DTYPE_LOGICAL_16:
-    case GFC_DTYPE_INTEGER_16:
+    case CFI_type_Integer16:
+    case CFI_type_Logical16:
       unpack1_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) vector,
 		   mask, (gfc_array_i16 *) field);
       return;
 #endif
 
-    case GFC_DTYPE_REAL_4:
+    case CFI_type_Real4:
       unpack1_r4 ((gfc_array_r4 *) ret, (gfc_array_r4 *) vector,
 		  mask, (gfc_array_r4 *) field);
       return;
 
-    case GFC_DTYPE_REAL_8:
+    case CFI_type_Real8:
       unpack1_r8 ((gfc_array_r8 *) ret, (gfc_array_r8 *) vector,
 		  mask, (gfc_array_r8 *) field);
       return;
 
-/* FIXME: This here is a hack, which will have to be removed when
-   the array descriptor is reworked.  Currently, we don't store the
-   kind value for the type, but only the size.  Because on targets with
-   __float128, we have sizeof(logn double) == sizeof(__float128),
-   we cannot discriminate here and have to fall back to the generic
-   handling (which is suboptimal).  */
-#if !defined(GFC_REAL_16_IS_FLOAT128)
 # ifdef HAVE_GFC_REAL_10
-    case GFC_DTYPE_REAL_10:
+    case CFI_type_Real10:
       unpack1_r10 ((gfc_array_r10 *) ret, (gfc_array_r10 *) vector,
 		   mask, (gfc_array_r10 *) field);
       return;
 # endif
 
 # ifdef HAVE_GFC_REAL_16
-    case GFC_DTYPE_REAL_16:
+    case CFI_type_Real16:
       unpack1_r16 ((gfc_array_r16 *) ret, (gfc_array_r16 *) vector,
 		   mask, (gfc_array_r16 *) field);
       return;
 # endif
-#endif
 
-    case GFC_DTYPE_COMPLEX_4:
+    case CFI_type_Complex4:
       unpack1_c4 ((gfc_array_c4 *) ret, (gfc_array_c4 *) vector,
 		  mask, (gfc_array_c4 *) field);
       return;
 
-    case GFC_DTYPE_COMPLEX_8:
+    case CFI_type_Complex8:
       unpack1_c8 ((gfc_array_c8 *) ret, (gfc_array_c8 *) vector,
 		  mask, (gfc_array_c8 *) field);
       return;
 
-/* FIXME: This here is a hack, which will have to be removed when
-   the array descriptor is reworked.  Currently, we don't store the
-   kind value for the type, but only the size.  Because on targets with
-   __float128, we have sizeof(logn double) == sizeof(__float128),
-   we cannot discriminate here and have to fall back to the generic
-   handling (which is suboptimal).  */
-#if !defined(GFC_REAL_16_IS_FLOAT128)
 # ifdef HAVE_GFC_COMPLEX_10
-    case GFC_DTYPE_COMPLEX_10:
+    case CFI_type_Complex10:
       unpack1_c10 ((gfc_array_c10 *) ret, (gfc_array_c10 *) vector,
 		   mask, (gfc_array_c10 *) field);
       return;
 # endif
 
 # ifdef HAVE_GFC_COMPLEX_16
-    case GFC_DTYPE_COMPLEX_16:
+    case CFI_type_Complex16:
       unpack1_c16 ((gfc_array_c16 *) ret, (gfc_array_c16 *) vector,
 		   mask, (gfc_array_c16 *) field);
       return;
 # endif
-#endif
-
-    case GFC_DTYPE_DERIVED_2:
-      if (GFC_UNALIGNED_2(ret->base_addr) || GFC_UNALIGNED_2(vector->base_addr)
-	  || GFC_UNALIGNED_2(field->base_addr))
-	break;
-      else
-	{
-	  unpack1_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) vector,
-		      mask, (gfc_array_i2 *) field);
-	  return;
-	}
-
-    case GFC_DTYPE_DERIVED_4:
-      if (GFC_UNALIGNED_4(ret->base_addr) || GFC_UNALIGNED_4(vector->base_addr)
-	  || GFC_UNALIGNED_4(field->base_addr))
-	break;
-      else
-	{
-	  unpack1_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) vector,
-		      mask, (gfc_array_i4 *) field);
-	  return;
-	}
 
-    case GFC_DTYPE_DERIVED_8:
-      if (GFC_UNALIGNED_8(ret->base_addr) || GFC_UNALIGNED_8(vector->base_addr)
-	  || GFC_UNALIGNED_8(field->base_addr))
-	break;
-      else
-	{
-	  unpack1_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) vector,
-		      mask, (gfc_array_i8 *) field);
-	  return;
-	}
+    case CFI_type_struct:
+    case CFI_type_other:
+      switch (GFC_DESCRIPTOR_ELEM_LEN(vector))
+        {
+        case 2:
+	  if (GFC_UNALIGNED_2(ret->base_addr)
+	      || GFC_UNALIGNED_2(vector->base_addr)
+	      || GFC_UNALIGNED_2(field->base_addr))
+	    break;
+	  else
+	    {
+	      unpack1_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) vector,
+			  mask, (gfc_array_i2 *) field);
+	      return;
+	    }
+
+        case 4:
+	  if (GFC_UNALIGNED_4(ret->base_addr)
+	      || GFC_UNALIGNED_4(vector->base_addr)
+	      || GFC_UNALIGNED_4(field->base_addr))
+	    break;
+	  else
+	    {
+	      unpack1_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) vector,
+			  mask, (gfc_array_i4 *) field);
+	      return;
+	    }
+
+        case 8:
+	  if (GFC_UNALIGNED_8(ret->base_addr)
+	      || GFC_UNALIGNED_8(vector->base_addr)
+	      || GFC_UNALIGNED_8(field->base_addr))
+	    break;
+	  else
+	    {
+	      unpack1_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) vector,
+			  mask, (gfc_array_i8 *) field);
+	      return;
+	    }
 
 #ifdef HAVE_GFC_INTEGER_16
-    case GFC_DTYPE_DERIVED_16:
-      if (GFC_UNALIGNED_16(ret->base_addr)
-	  || GFC_UNALIGNED_16(vector->base_addr)
-	  || GFC_UNALIGNED_16(field->base_addr))
-	break;
-      else
-	{
-	  unpack1_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) vector,
-		       mask, (gfc_array_i16 *) field);
-	  return;
-	}
+        case 16:
+	  if (GFC_UNALIGNED_16(ret->base_addr)
+	      || GFC_UNALIGNED_16(vector->base_addr)
+	      || GFC_UNALIGNED_16(field->base_addr))
+	    break;
+	  else
+	    {
+	      unpack1_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) vector,
+			   mask, (gfc_array_i16 *) field);
+	      return;
+	    }
 #endif
+        }
     }
 
   unpack_internal (ret, vector, mask, field, size);
@@ -419,160 +414,152 @@  unpack0 (gfc_array_char *ret, const gfc_array_char *vector,
 	 const gfc_array_l1 *mask, char *field)
 {
   gfc_array_char tmp;
-
-  index_type type_size;
+  CFI_type_t type;
 
   if (unlikely(compile_options.bounds_check))
     unpack_bounds (ret, vector, mask, NULL);
 
-  type_size = GFC_DTYPE_TYPE_SIZE (vector);
+  type = GFC_DESCRIPTOR_TYPE (vector);
+  if ((type == CFI_type_struct || type == CFI_type_other)
+      && GFC_DESCRIPTOR_ELEM_LEN (vector) == 1)
+    type = CFI_type_Integer1;
 
-  switch (type_size)
+  switch (type)
     {
-    case GFC_DTYPE_LOGICAL_1:
-    case GFC_DTYPE_INTEGER_1:
-    case GFC_DTYPE_DERIVED_1:
+    case CFI_type_Integer1:
+    case CFI_type_Logical1:
       unpack0_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) vector,
 		  mask, (GFC_INTEGER_1 *) field);
       return;
 
-    case GFC_DTYPE_LOGICAL_2:
-    case GFC_DTYPE_INTEGER_2:
+    case CFI_type_Integer2:
+    case CFI_type_Logical2:
       unpack0_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) vector,
 		  mask, (GFC_INTEGER_2 *) field);
       return;
 
-    case GFC_DTYPE_LOGICAL_4:
-    case GFC_DTYPE_INTEGER_4:
+    case CFI_type_Integer4:
+    case CFI_type_Logical4:
       unpack0_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) vector,
 		  mask, (GFC_INTEGER_4 *) field);
       return;
 
-    case GFC_DTYPE_LOGICAL_8:
-    case GFC_DTYPE_INTEGER_8:
+    case CFI_type_Integer8:
+    case CFI_type_Logical8:
       unpack0_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) vector,
 		  mask, (GFC_INTEGER_8 *) field);
       return;
 
 #ifdef HAVE_GFC_INTEGER_16
-    case GFC_DTYPE_LOGICAL_16:
-    case GFC_DTYPE_INTEGER_16:
+    case CFI_type_Integer16:
+    case CFI_type_Logical16:
       unpack0_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) vector,
 		   mask, (GFC_INTEGER_16 *) field);
       return;
 #endif
 
-    case GFC_DTYPE_REAL_4:
+    case CFI_type_Real4:
       unpack0_r4 ((gfc_array_r4 *) ret, (gfc_array_r4 *) vector,
 		  mask, (GFC_REAL_4 *) field);
       return;
 
-    case GFC_DTYPE_REAL_8:
+    case CFI_type_Real8:
       unpack0_r8 ((gfc_array_r8 *) ret, (gfc_array_r8*) vector,
 		  mask, (GFC_REAL_8  *) field);
       return;
 
-/* FIXME: This here is a hack, which will have to be removed when
-   the array descriptor is reworked.  Currently, we don't store the
-   kind value for the type, but only the size.  Because on targets with
-   __float128, we have sizeof(logn double) == sizeof(__float128),
-   we cannot discriminate here and have to fall back to the generic
-   handling (which is suboptimal).  */
-#if !defined(GFC_REAL_16_IS_FLOAT128)
 # ifdef HAVE_GFC_REAL_10
-    case GFC_DTYPE_REAL_10:
+    case CFI_type_Real10:
       unpack0_r10 ((gfc_array_r10 *) ret, (gfc_array_r10 *) vector,
 		   mask, (GFC_REAL_10 *) field);
       return;
 # endif
 
 # ifdef HAVE_GFC_REAL_16
-    case GFC_DTYPE_REAL_16:
+    case CFI_type_Real16:
       unpack0_r16 ((gfc_array_r16 *) ret, (gfc_array_r16 *) vector,
 		   mask, (GFC_REAL_16 *) field);
       return;
 # endif
-#endif
 
-    case GFC_DTYPE_COMPLEX_4:
+    case CFI_type_Complex4:
       unpack0_c4 ((gfc_array_c4 *) ret, (gfc_array_c4 *) vector,
 		  mask, (GFC_COMPLEX_4 *) field);
       return;
 
-    case GFC_DTYPE_COMPLEX_8:
+    case CFI_type_Complex8:
       unpack0_c8 ((gfc_array_c8 *) ret, (gfc_array_c8 *) vector,
 		  mask, (GFC_COMPLEX_8 *) field);
       return;
 
-/* FIXME: This here is a hack, which will have to be removed when
-   the array descriptor is reworked.  Currently, we don't store the
-   kind value for the type, but only the size.  Because on targets with
-   __float128, we have sizeof(logn double) == sizeof(__float128),
-   we cannot discriminate here and have to fall back to the generic
-   handling (which is suboptimal).  */
-#if !defined(GFC_REAL_16_IS_FLOAT128)
 # ifdef HAVE_GFC_COMPLEX_10
-    case GFC_DTYPE_COMPLEX_10:
+    case CFI_type_Complex10:
       unpack0_c10 ((gfc_array_c10 *) ret, (gfc_array_c10 *) vector,
 		   mask, (GFC_COMPLEX_10 *) field);
       return;
 # endif
 
 # ifdef HAVE_GFC_COMPLEX_16
-    case GFC_DTYPE_COMPLEX_16:
+    case CFI_type_Complex16:
       unpack0_c16 ((gfc_array_c16 *) ret, (gfc_array_c16 *) vector,
 		   mask, (GFC_COMPLEX_16 *) field);
       return;
 # endif
-#endif
-
-    case GFC_DTYPE_DERIVED_2:
-      if (GFC_UNALIGNED_2(ret->base_addr) || GFC_UNALIGNED_2(vector->base_addr)
-	  || GFC_UNALIGNED_2(field))
-	break;
-      else
-	{
-	  unpack0_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) vector,
-		      mask, (GFC_INTEGER_2 *) field);
-	  return;
-	}
-
-    case GFC_DTYPE_DERIVED_4:
-      if (GFC_UNALIGNED_4(ret->base_addr) || GFC_UNALIGNED_4(vector->base_addr)
-	  || GFC_UNALIGNED_4(field))
-	break;
-      else
-	{
-	  unpack0_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) vector,
-		      mask, (GFC_INTEGER_4 *) field);
-	  return;
-	}
 
-    case GFC_DTYPE_DERIVED_8:
-      if (GFC_UNALIGNED_8(ret->base_addr) || GFC_UNALIGNED_8(vector->base_addr)
-	  || GFC_UNALIGNED_8(field))
-	break;
-      else
+    case CFI_type_struct:
+    case CFI_type_other:
+      switch (GFC_DESCRIPTOR_ELEM_LEN(vector))
 	{
-	  unpack0_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) vector,
-		      mask, (GFC_INTEGER_8 *) field);
-	  return;
-	}
+	case 2:
+	  if (GFC_UNALIGNED_2(ret->base_addr)
+	      || GFC_UNALIGNED_2(vector->base_addr)
+	      || GFC_UNALIGNED_2(field))
+	    break;
+	  else
+	    {
+	      unpack0_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) vector,
+			  mask, (GFC_INTEGER_2 *) field);
+	      return;
+	    }
+
+	case 4:
+	  if (GFC_UNALIGNED_4(ret->base_addr)
+	      || GFC_UNALIGNED_4(vector->base_addr)
+	      || GFC_UNALIGNED_4(field))
+	    break;
+	  else
+	    {
+	      unpack0_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) vector,
+			  mask, (GFC_INTEGER_4 *) field);
+	      return;
+	    }
+
+	case 8:
+	  if (GFC_UNALIGNED_8(ret->base_addr)
+	      || GFC_UNALIGNED_8(vector->base_addr)
+	      || GFC_UNALIGNED_8(field))
+	    break;
+	  else
+	    {
+	      unpack0_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) vector,
+			  mask, (GFC_INTEGER_8 *) field);
+	      return;
+	    }
 
 #ifdef HAVE_GFC_INTEGER_16
-    case GFC_DTYPE_DERIVED_16:
-      if (GFC_UNALIGNED_16(ret->base_addr)
-	  || GFC_UNALIGNED_16(vector->base_addr)
-	  || GFC_UNALIGNED_16(field))
-	break;
-      else
-	{
-	  unpack0_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) vector,
-		       mask, (GFC_INTEGER_16 *) field);
-	  return;
-	}
+	case 16:
+	  if (GFC_UNALIGNED_16(ret->base_addr)
+	      || GFC_UNALIGNED_16(vector->base_addr)
+	      || GFC_UNALIGNED_16(field))
+	    break;
+	  else
+	    {
+	      unpack0_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) vector,
+			   mask, (GFC_INTEGER_16 *) field);
+	      return;
+	    }
 #endif
-
+      }
     }
 
   memset (&tmp, 0, sizeof (tmp));
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index 8ea9326..18f4bfe 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -106,6 +106,9 @@  typedef struct namelist_type
   /* Object type.  */
   bt type;
 
+  /* Intrinsic kind.  */
+  int kind;
+
   /* Object name.  */
   char * var_name;
 
@@ -115,9 +118,6 @@  typedef struct namelist_type
   /* Flag to show that a read is to be attempted for this node.  */
   int touched;
 
-  /* Length of intrinsic type in bytes.  */
-  int len;
-
   /* Rank of the object.  */
   int var_rank;
 
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 7188b47..45e57e4 100644
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -2486,7 +2486,7 @@  nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset,
   namelist_info * cmp;
   char * obj_name;
   int nml_carry;
-  int len;
+  int kind;
   int dim;
   index_type dlen;
   index_type m;
@@ -2501,29 +2501,11 @@  nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset,
   dtp->u.p.repeat_count = 0;
   eat_spaces (dtp);
 
-  len = nl->len;
-  switch (nl->type)
-  {
-    case BT_INTEGER:
-    case BT_LOGICAL:
-      dlen = len;
-      break;
-
-    case BT_REAL:
-      dlen = size_from_real_kind (len);
-      break;
-
-    case BT_COMPLEX:
-      dlen = size_from_complex_kind (len);
-      break;
-
-    case BT_CHARACTER:
-      dlen = chigh ? (chigh - clow + 1) : nl->string_length;
-      break;
-
-    default:
-      dlen = 0;
-    }
+  kind = nl->kind;
+  if (nl->type == BT_CHARACTER)
+    dlen = chigh ? (chigh - clow + 1) : nl->string_length;
+  else
+    dlen = nl->size;
 
   do
     {
@@ -2553,27 +2535,27 @@  nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset,
           switch (nl->type)
 	  {
 	  case BT_INTEGER:
-	    read_integer (dtp, len);
+	    read_integer (dtp, kind);
             break;
 
 	  case BT_LOGICAL:
-	    read_logical (dtp, len);
+	    read_logical (dtp, kind);
 	    break;
 
 	  case BT_CHARACTER:
-	    read_character (dtp, len);
+	    read_character (dtp, kind);
 	    break;
 
 	  case BT_REAL:
 	    /* Need to copy data back from the real location to the temp in
 	       order to handle nml reads into arrays.  */
-	    read_real (dtp, pdata, len);
+	    read_real (dtp, pdata, kind);
 	    memcpy (dtp->u.p.value, pdata, dlen);
 	    break;
 
 	  case BT_COMPLEX:
 	    /* Same as for REAL, copy back to temp.  */
-	    read_complex (dtp, pdata, len, dlen);
+	    read_complex (dtp, pdata, kind, dlen);
 	    memcpy (dtp->u.p.value, pdata, dlen);
 	    break;
 
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 9238600..cdeea1d 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -2132,7 +2132,11 @@  transfer_array (st_parameter_dt *dtp, gfc_array_char *desc, int kind,
   if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK)
     return;
 
-  iotype = (bt) GFC_DESCRIPTOR_TYPE (desc);
+  iotype = (bt) (GFC_DESCRIPTOR_TYPE (desc) & CFI_type_mask);
+
+  if (iotype > CFI_type_Character)
+    internal_error (NULL, "transfer_array(): Bad type");
+
   size = iotype == BT_CHARACTER ? charlen
 				: (index_type) GFC_DESCRIPTOR_ELEM_LEN (desc);
 
@@ -3749,15 +3753,13 @@  st_wait (st_parameter_wait *wtp __attribute__((unused)))
    in a linked list of namelist_info types.  */
 
 extern void st_set_nml_var (st_parameter_dt *dtp, void *, char *,
-			    GFC_INTEGER_4, size_t, int,
-			    GFC_INTEGER_4);
+			    int, size_t, int, int);
 export_proto(st_set_nml_var);
 
 
 void
 st_set_nml_var (st_parameter_dt *dtp, void * var_addr, char * var_name,
-		GFC_INTEGER_4 len, size_t elem_len,
-		int rank, GFC_INTEGER_4 type)
+		int kind, size_t elem_len, int rank, int type)
 {
   namelist_info *t1 = NULL;
   namelist_info *nml;
@@ -3771,12 +3773,12 @@  st_set_nml_var (st_parameter_dt *dtp, void * var_addr, char * var_name,
   memcpy (nml->var_name, var_name, var_name_len);
   nml->var_name[var_name_len] = '\0';
 
-  nml->len = (int) len;
-  nml->string_length = len ? (index_type) elem_len/len : 0;
-
-  nml->var_rank = rank;
+  nml->type = (bt) type;
+  nml->kind = kind;
   nml->size = (index_type) elem_len;
-  nml->type = (bt) ((type & GFC_DTYPE_TYPE_MASK) >> GFC_DTYPE_TYPE_SHIFT);
+  nml->string_length = nml->type == BT_CHARACTER
+		       ? (index_type) elem_len/kind : 0;
+  nml->var_rank = rank;
 
   if (nml->var_rank > 0)
     {
diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index 153da2e..17dde93 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -1744,28 +1744,10 @@  nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
 
   num = 1;
 
-  len = obj->len;
-
-  switch (obj->type)
-    {
-
-    case BT_REAL:
-      obj_size = size_from_real_kind (len);
-      break;
-
-    case BT_COMPLEX:
-      obj_size = size_from_complex_kind (len);
-      break;
-
-    case BT_CHARACTER:
-      obj_size = obj->string_length;
-      break;
-
-    default:
-      obj_size = len;      
-    }
-
-  if (obj->var_rank)
+  len = obj->kind;
+  if (obj->type == BT_CHARACTER)
+    obj_size = obj->string_length;
+  else
     obj_size = obj->size;
 
   /* Set the index vector and count the number of elements.  */
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index f897d1d..90be2d8 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -324,9 +324,20 @@  internal_proto(big_endian);
 
 #if GFC_ATTRIBUTE_POINTER != CFI_attribute_pointer \
    || GFC_ATTRIBUTE_ALLOCATABLE != CFI_attribute_allocatable \
-   || GFC_ATTRIBUTE_OTHER != CFI_attribute_other
-   || GFC_MAX_DIMENSIONS != CFI_MAX_RANK
- chokeme
+   || GFC_ATTRIBUTE_OTHER != CFI_attribute_other \
+   || GFC_MAX_DIMENSIONS != CFI_MAX_RANK \
+   || GFC_TYPE_INTEGER != CFI_type_Integer \
+   || GFC_TYPE_LOGICAL != CFI_type_Logical \
+   || GFC_TYPE_REAL != CFI_type_Real \
+   || GFC_TYPE_COMPLEX != CFI_type_Complex \
+   || GFC_TYPE_CHARACTER != CFI_type_Character \
+   || GFC_TYPE_STRUCT != CFI_type_struct \
+   || GFC_TYPE_CPTR != CFI_type_cptr \
+   || GFC_TYPE_CFUNPTR != CFI_type_cfunptr \
+   || GFC_TYPE_OTHER != CFI_type_other \
+   || GFC_TYPE_KIND_SHIFT != CFI_type_kind_shift \
+   || GFC_TYPE_MASK != CFI_type_mask
+ choke me
 #endif
 
 typedef CFI_dim_t descriptor_dimension;
@@ -367,8 +378,7 @@  typedef CFI_CDESC_TYPE_T (GFC_MAX_DIMENSIONS, GFC_LOGICAL_16) gfc_array_l16;
 
 
 #define GFC_DESCRIPTOR_RANK(desc) ((desc)->rank)
-#define GFC_DESCRIPTOR_TYPE(desc) (((desc)->type & GFC_DTYPE_TYPE_MASK) \
-                                   >> GFC_DTYPE_TYPE_SHIFT)
+#define GFC_DESCRIPTOR_TYPE(desc) ((desc)->type)
 #define GFC_DESCRIPTOR_ELEM_LEN(desc) ((desc)->elem_len)
 
 /*  This is for getting the size of a type when the type of the
@@ -376,7 +386,6 @@  typedef CFI_CDESC_TYPE_T (GFC_MAX_DIMENSIONS, GFC_LOGICAL_16) gfc_array_l16;
 
 #define GFC_DESCRIPTOR_SIZE_TYPEKNOWN(desc) (sizeof((desc)->base_addr[0]))
 #define GFC_DESCRIPTOR_DATA(desc) ((desc)->base_addr)
-#define GFC_DESCRIPTOR_DTYPE(desc) ((desc)->type)
 
 #define GFC_DIMENSION_LBOUND(dim) ((dim).lower_bound)
 #define GFC_DIMENSION_UBOUND(dim) ((dim).lower_bound + (dim).extent - 1)
@@ -407,80 +416,8 @@  typedef CFI_CDESC_TYPE_T (GFC_MAX_DIMENSIONS, GFC_LOGICAL_16) gfc_array_l16;
    types.  */
 
 #define GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(desc,i) \
-  (GFC_DESCRIPTOR_SM(desc,i) / GFC_DESCRIPTOR_SIZE_TYPEKNOWN(desc))
+  ((index_type)(GFC_DESCRIPTOR_SM(desc,i) / GFC_DESCRIPTOR_SIZE_TYPEKNOWN(desc)))
 
-/* Macros to get both the size and the type with a single masking operation  */
-
-#define GFC_DTYPE_SIZE_MASK \
-  ((~((index_type) 0) >> GFC_DTYPE_SIZE_SHIFT) << GFC_DTYPE_SIZE_SHIFT)
-#define GFC_DTYPE_TYPE_SIZE_MASK (GFC_DTYPE_SIZE_MASK | GFC_DTYPE_TYPE_MASK)
-
-#define GFC_DTYPE_TYPE_SIZE(desc) ((desc)->type & GFC_DTYPE_TYPE_SIZE_MASK)
-
-#define GFC_DTYPE_INTEGER_1 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
-   | (sizeof(GFC_INTEGER_1) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_INTEGER_2 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
-   | (sizeof(GFC_INTEGER_2) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_INTEGER_4 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
-   | (sizeof(GFC_INTEGER_4) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_INTEGER_8 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
-   | (sizeof(GFC_INTEGER_8) << GFC_DTYPE_SIZE_SHIFT))
-#ifdef HAVE_GFC_INTEGER_16
-#define GFC_DTYPE_INTEGER_16 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
-   | (sizeof(GFC_INTEGER_16) << GFC_DTYPE_SIZE_SHIFT))
-#endif
-
-#define GFC_DTYPE_LOGICAL_1 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
-   | (sizeof(GFC_LOGICAL_1) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_LOGICAL_2 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
-   | (sizeof(GFC_LOGICAL_2) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_LOGICAL_4 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
-   | (sizeof(GFC_LOGICAL_4) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_LOGICAL_8 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
-   | (sizeof(GFC_LOGICAL_8) << GFC_DTYPE_SIZE_SHIFT))
-#ifdef HAVE_GFC_LOGICAL_16
-#define GFC_DTYPE_LOGICAL_16 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
-   | (sizeof(GFC_LOGICAL_16) << GFC_DTYPE_SIZE_SHIFT))
-#endif
-
-#define GFC_DTYPE_REAL_4 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \
-   | (sizeof(GFC_REAL_4) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_REAL_8 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \
-   | (sizeof(GFC_REAL_8) << GFC_DTYPE_SIZE_SHIFT))
-#ifdef HAVE_GFC_REAL_10
-#define GFC_DTYPE_REAL_10  ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \
-   | (sizeof(GFC_REAL_10) << GFC_DTYPE_SIZE_SHIFT))
-#endif
-#ifdef HAVE_GFC_REAL_16
-#define GFC_DTYPE_REAL_16 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \
-   | (sizeof(GFC_REAL_16) << GFC_DTYPE_SIZE_SHIFT))
-#endif
-
-#define GFC_DTYPE_COMPLEX_4 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
-   | (sizeof(GFC_COMPLEX_4) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_COMPLEX_8 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
-   | (sizeof(GFC_COMPLEX_8) << GFC_DTYPE_SIZE_SHIFT))
-#ifdef HAVE_GFC_COMPLEX_10
-#define GFC_DTYPE_COMPLEX_10 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
-   | (sizeof(GFC_COMPLEX_10) << GFC_DTYPE_SIZE_SHIFT))
-#endif
-#ifdef HAVE_GFC_COMPLEX_16
-#define GFC_DTYPE_COMPLEX_16 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
-   | (sizeof(GFC_COMPLEX_16) << GFC_DTYPE_SIZE_SHIFT))
-#endif
-
-#define GFC_DTYPE_DERIVED_1 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
-   | (sizeof(GFC_INTEGER_1) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_DERIVED_2 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
-   | (sizeof(GFC_INTEGER_2) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_DERIVED_4 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
-   | (sizeof(GFC_INTEGER_4) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_DERIVED_8 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
-   | (sizeof(GFC_INTEGER_8) << GFC_DTYPE_SIZE_SHIFT))
-#ifdef HAVE_GFC_INTEGER_16
-#define GFC_DTYPE_DERIVED_16 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
-   | (sizeof(GFC_INTEGER_16) << GFC_DTYPE_SIZE_SHIFT))
-#endif
 
 /* Macros to determine the alignment of pointers.  */
 
diff --git a/libgfortran/runtime/in_pack_generic.c b/libgfortran/runtime/in_pack_generic.c
index 6e5b2b5..df92218 100644
--- a/libgfortran/runtime/in_pack_generic.c
+++ b/libgfortran/runtime/in_pack_generic.c
@@ -46,109 +46,102 @@  internal_pack (gfc_array_char * source)
   int n;
   int packed;
   index_type size;
-  index_type type_size;
+  CFI_type_t type;
 
   if (source->base_addr == NULL)
-    return NULL;
+    return source->base_addr;
+
+  type = GFC_DESCRIPTOR_TYPE (source);
+  if ((type == CFI_type_struct || type == CFI_type_other)
+      && GFC_DESCRIPTOR_ELEM_LEN (source) == 1)
+    type = CFI_type_Integer1;
 
-  type_size = GFC_DTYPE_TYPE_SIZE(source);
-  switch (type_size)
+  switch (type)
     {
-    case GFC_DTYPE_INTEGER_1:
-    case GFC_DTYPE_LOGICAL_1:
-    case GFC_DTYPE_DERIVED_1:
+    case CFI_type_Integer1:
+    case CFI_type_Logical1:
       return internal_pack_1 ((gfc_array_i1 *) source);
 
-    case GFC_DTYPE_INTEGER_2:
-    case GFC_DTYPE_LOGICAL_2:
+    case CFI_type_Integer2:
+    case CFI_type_Logical2:
       return internal_pack_2 ((gfc_array_i2 *) source);
 
-    case GFC_DTYPE_INTEGER_4:
-    case GFC_DTYPE_LOGICAL_4:
+    case CFI_type_Integer4:
+    case CFI_type_Logical4:
       return internal_pack_4 ((gfc_array_i4 *) source);
 	
-    case GFC_DTYPE_INTEGER_8:
-    case GFC_DTYPE_LOGICAL_8:
+    case CFI_type_Integer8:
+    case CFI_type_Logical8:
       return internal_pack_8 ((gfc_array_i8 *) source);
 
 #if defined(HAVE_GFC_INTEGER_16)
-    case GFC_DTYPE_INTEGER_16:
-    case GFC_DTYPE_LOGICAL_16:
+    case CFI_type_Integer16:
+    case CFI_type_Logical16:
       return internal_pack_16 ((gfc_array_i16 *) source);
 #endif
-    case GFC_DTYPE_REAL_4:
+    case CFI_type_Real4:
       return internal_pack_r4 ((gfc_array_r4 *) source);
 
-    case GFC_DTYPE_REAL_8:
+    case CFI_type_Real8:
       return internal_pack_r8 ((gfc_array_r8 *) source);
 
-/* FIXME: This here is a hack, which will have to be removed when
-   the array descriptor is reworked.  Currently, we don't store the
-   kind value for the type, but only the size.  Because on targets with
-   __float128, we have sizeof(logn double) == sizeof(__float128),
-   we cannot discriminate here and have to fall back to the generic
-   handling (which is suboptimal).  */
-#if !defined(GFC_REAL_16_IS_FLOAT128)
 # if defined (HAVE_GFC_REAL_10)
-    case GFC_DTYPE_REAL_10:
+    case CFI_type_Real10:
       return internal_pack_r10 ((gfc_array_r10 *) source);
 # endif
 
 # if defined (HAVE_GFC_REAL_16)
-    case GFC_DTYPE_REAL_16:
+    case CFI_type_Real16:
       return internal_pack_r16 ((gfc_array_r16 *) source);
 # endif
-#endif
 
-    case GFC_DTYPE_COMPLEX_4:
+    case CFI_type_Complex4:
       return internal_pack_c4 ((gfc_array_c4 *) source);
 	
-    case GFC_DTYPE_COMPLEX_8:
+    case CFI_type_Complex8:
       return internal_pack_c8 ((gfc_array_c8 *) source);
 
-/* FIXME: This here is a hack, which will have to be removed when
-   the array descriptor is reworked.  Currently, we don't store the
-   kind value for the type, but only the size.  Because on targets with
-   __float128, we have sizeof(logn double) == sizeof(__float128),
-   we cannot discriminate here and have to fall back to the generic
-   handling (which is suboptimal).  */
-#if !defined(GFC_REAL_16_IS_FLOAT128)
 # if defined (HAVE_GFC_COMPLEX_10)
-    case GFC_DTYPE_COMPLEX_10:
+    case CFI_type_Complex10:
       return internal_pack_c10 ((gfc_array_c10 *) source);
 # endif
 
 # if defined (HAVE_GFC_COMPLEX_16)
-    case GFC_DTYPE_COMPLEX_16:
+    case CFI_type_Complex16:
       return internal_pack_c16 ((gfc_array_c16 *) source);
 # endif
-#endif
 
-    case GFC_DTYPE_DERIVED_2:
-      if (GFC_UNALIGNED_2(source->base_addr))
-	break;
-      else
-	return internal_pack_2 ((gfc_array_i2 *) source);
-
-    case GFC_DTYPE_DERIVED_4:
-      if (GFC_UNALIGNED_4(source->base_addr))
-	break;
-      else
-	return internal_pack_4 ((gfc_array_i4 *) source);
-
-    case GFC_DTYPE_DERIVED_8:
-      if (GFC_UNALIGNED_8(source->base_addr))
-	break;
-      else
-	return internal_pack_8 ((gfc_array_i8 *) source);
+    case CFI_type_struct:
+    case CFI_type_other:
+      switch (GFC_DESCRIPTOR_ELEM_LEN(source))
+	{
+	case 2:
+	  if (GFC_UNALIGNED_2(source->base_addr))
+	    break;
+	  else
+	    return internal_pack_2 ((gfc_array_i2 *) source);
+
+	case 4:
+	  if (GFC_UNALIGNED_4(source->base_addr))
+	    break;
+	  else
+	    return internal_pack_4 ((gfc_array_i4 *) source);
+
+	case 8:
+	  if (GFC_UNALIGNED_8(source->base_addr))
+	    break;
+	  else
+	    return internal_pack_8 ((gfc_array_i8 *) source);
 
 #ifdef HAVE_GFC_INTEGER_16
-    case GFC_DTYPE_DERIVED_16:
-      if (GFC_UNALIGNED_16(source->base_addr))
-	break;
-      else
-	return internal_pack_16 ((gfc_array_i16 *) source);
+	case 16:
+	  if (GFC_UNALIGNED_16(source->base_addr))
+	    break;
+	  else
+	    return internal_pack_16 ((gfc_array_i16 *) source);
 #endif
+	}
+      break;
 
     default:
       break;
@@ -179,8 +172,8 @@  internal_pack (gfc_array_char * source)
   if (packed)
     return source->base_addr;
 
-   /* Allocate storage for the destination.  */
-  destptr = xmalloc (ssize * size);
+  /* Allocate storage for the destination.  */
+  destptr = xmalloc (ssize);
   dest = (char *)destptr;
   src = source->base_addr;
   sm0 = sm[0];
diff --git a/libgfortran/runtime/in_unpack_generic.c b/libgfortran/runtime/in_unpack_generic.c
index 8389b94..9ee8673 100644
--- a/libgfortran/runtime/in_unpack_generic.c
+++ b/libgfortran/runtime/in_unpack_generic.c
@@ -44,142 +44,136 @@  internal_unpack (gfc_array_char * d, const void * s)
   const char *src;
   int n;
   int size;
-  int type_size;
+  CFI_type_t type;
 
   dest = d->base_addr;
   /* This check may be redundant, but do it anyway.  */
   if (s == dest || !s)
     return;
 
-  type_size = GFC_DTYPE_TYPE_SIZE (d);
-  switch (type_size)
+  type = GFC_DESCRIPTOR_TYPE (d);
+  if ((type == CFI_type_struct || type == CFI_type_other)
+      && GFC_DESCRIPTOR_ELEM_LEN (d) == 1)
+    type = CFI_type_Integer1;
+
+  switch (type)
     {
-    case GFC_DTYPE_INTEGER_1:
-    case GFC_DTYPE_LOGICAL_1:
-    case GFC_DTYPE_DERIVED_1:
+    case CFI_type_Integer1:
+    case CFI_type_Logical1:
       internal_unpack_1 ((gfc_array_i1 *) d, (const GFC_INTEGER_1 *) s);
       return;
 
-    case GFC_DTYPE_INTEGER_2:
-    case GFC_DTYPE_LOGICAL_2:
+    case CFI_type_Integer2:
+    case CFI_type_Logical2:
       internal_unpack_2 ((gfc_array_i2 *) d, (const GFC_INTEGER_2 *) s);
       return;
 
-    case GFC_DTYPE_INTEGER_4:
-    case GFC_DTYPE_LOGICAL_4:
+    case CFI_type_Integer4:
+    case CFI_type_Logical4:
       internal_unpack_4 ((gfc_array_i4 *) d, (const GFC_INTEGER_4 *) s);
       return;
 
-    case GFC_DTYPE_INTEGER_8:
-    case GFC_DTYPE_LOGICAL_8:
+    case CFI_type_Integer8:
+    case CFI_type_Logical8:
       internal_unpack_8 ((gfc_array_i8 *) d, (const GFC_INTEGER_8 *) s);
       return;
 
 #if defined (HAVE_GFC_INTEGER_16)
-    case GFC_DTYPE_INTEGER_16:
-    case GFC_DTYPE_LOGICAL_16:
+    case CFI_type_Integer16:
+    case CFI_type_Logical16:
       internal_unpack_16 ((gfc_array_i16 *) d, (const GFC_INTEGER_16 *) s);
       return;
 #endif
 
-    case GFC_DTYPE_REAL_4:
+    case CFI_type_Real4:
       internal_unpack_r4 ((gfc_array_r4 *) d, (const GFC_REAL_4 *) s);
       return;
 
-    case GFC_DTYPE_REAL_8:
+    case CFI_type_Real8:
       internal_unpack_r8 ((gfc_array_r8 *) d, (const GFC_REAL_8 *) s);
       return;
 
-/* FIXME: This here is a hack, which will have to be removed when
-   the array descriptor is reworked.  Currently, we don't store the
-   kind value for the type, but only the size.  Because on targets with
-   __float128, we have sizeof(logn double) == sizeof(__float128),
-   we cannot discriminate here and have to fall back to the generic
-   handling (which is suboptimal).  */
-#if !defined(GFC_REAL_16_IS_FLOAT128)
 # if defined(HAVE_GFC_REAL_10)
-    case GFC_DTYPE_REAL_10:
+    case CFI_type_Real10:
       internal_unpack_r10 ((gfc_array_r10 *) d, (const GFC_REAL_10 *) s);
       return;
 # endif
 
 # if defined(HAVE_GFC_REAL_16)
-    case GFC_DTYPE_REAL_16:
+    case CFI_type_Real16:
       internal_unpack_r16 ((gfc_array_r16 *) d, (const GFC_REAL_16 *) s);
       return;
 # endif
-#endif
 
-    case GFC_DTYPE_COMPLEX_4:
+    case CFI_type_Complex4:
       internal_unpack_c4 ((gfc_array_c4 *)d, (const GFC_COMPLEX_4 *)s);
       return;
 
-    case GFC_DTYPE_COMPLEX_8:
+    case CFI_type_Complex8:
       internal_unpack_c8 ((gfc_array_c8 *)d, (const GFC_COMPLEX_8 *)s);
       return;
 
-/* FIXME: This here is a hack, which will have to be removed when
-   the array descriptor is reworked.  Currently, we don't store the
-   kind value for the type, but only the size.  Because on targets with
-   __float128, we have sizeof(logn double) == sizeof(__float128),
-   we cannot discriminate here and have to fall back to the generic
-   handling (which is suboptimal).  */
-#if !defined(GFC_REAL_16_IS_FLOAT128)
 # if defined(HAVE_GFC_COMPLEX_10)
-    case GFC_DTYPE_COMPLEX_10:
+    case CFI_type_Complex10:
       internal_unpack_c10 ((gfc_array_c10 *) d, (const GFC_COMPLEX_10 *) s);
       return;
 # endif
 
 # if defined(HAVE_GFC_COMPLEX_16)
-    case GFC_DTYPE_COMPLEX_16:
+    case CFI_type_Complex16:
       internal_unpack_c16 ((gfc_array_c16 *) d, (const GFC_COMPLEX_16 *) s);
       return;
 # endif
-#endif
-
-    case GFC_DTYPE_DERIVED_2:
-      if (GFC_UNALIGNED_2(d->base_addr) || GFC_UNALIGNED_2(s))
-	break;
-      else
-	{
-	  internal_unpack_2 ((gfc_array_i2 *) d, (const GFC_INTEGER_2 *) s);
-	  return;
-	}
-    case GFC_DTYPE_DERIVED_4:
-      if (GFC_UNALIGNED_4(d->base_addr) || GFC_UNALIGNED_4(s))
-	break;
-      else
-	{
-	  internal_unpack_4 ((gfc_array_i4 *) d, (const GFC_INTEGER_4 *) s);
-	  return;
-	}
 
-    case GFC_DTYPE_DERIVED_8:
-      if (GFC_UNALIGNED_8(d->base_addr) || GFC_UNALIGNED_8(s))
-	break;
-      else
+    case CFI_type_struct:
+    case CFI_type_other:
+      switch (GFC_DESCRIPTOR_ELEM_LEN(d))
 	{
-	  internal_unpack_8 ((gfc_array_i8 *) d, (const GFC_INTEGER_8 *) s);
-	  return;
-	}
+	case 2:
+	  if (GFC_UNALIGNED_2(d->base_addr) || GFC_UNALIGNED_2(s))
+	    break;
+	  else
+	    {
+	      internal_unpack_2 ((gfc_array_i2 *) d, (const GFC_INTEGER_2 *) s);
+	      return;
+	    }
+
+	case 4:
+	  if (GFC_UNALIGNED_4(d->base_addr) || GFC_UNALIGNED_4(s))
+	    break;
+	  else
+	    {
+	      internal_unpack_4 ((gfc_array_i4 *) d, (const GFC_INTEGER_4 *) s);
+	      return;
+	    }
+
+	case 8:
+	  if (GFC_UNALIGNED_8(d->base_addr) || GFC_UNALIGNED_8(s))
+	    break;
+	  else
+	    {
+	      internal_unpack_8 ((gfc_array_i8 *) d, (const GFC_INTEGER_8 *) s);
+	      return;
+	    }
 
 #ifdef HAVE_GFC_INTEGER_16
-    case GFC_DTYPE_DERIVED_16:
-      if (GFC_UNALIGNED_16(d->base_addr) || GFC_UNALIGNED_16(s))
-	break;
-      else
-	{
-	  internal_unpack_16 ((gfc_array_i16 *) d, (const GFC_INTEGER_16 *) s);
-	  return;
-	}
+	case 16:
+	  if (GFC_UNALIGNED_16(d->base_addr) || GFC_UNALIGNED_16(s))
+	    break;
+	  else
+	    {
+	      internal_unpack_16 ((gfc_array_i16 *) d,
+				  (const GFC_INTEGER_16 *) s);
+	      return;
+	    }
 #endif
+	}
+      break;
 
     default:
       break;
     }
 
-
   dim = GFC_DESCRIPTOR_RANK (d);
   size = GFC_DESCRIPTOR_ELEM_LEN (d);
   dsize = size;
diff --git a/libgfortran/runtime/iso_ts29113.c b/libgfortran/runtime/iso_ts29113.c
index cb2d728..891efeb 100644
--- a/libgfortran/runtime/iso_ts29113.c
+++ b/libgfortran/runtime/iso_ts29113.c
@@ -1,4 +1,4 @@ 
-/* ISO_Fortran_binding.h of GCC's GNU Fortran compiler.
+/* iso_ts29113.c. of GCC's GNU Fortran compiler.
    Copyright (C) 2013 Free Software Foundation, Inc.
 
 This file is part of the GNU Fortran runtime library (libgfortran)
@@ -252,9 +252,9 @@  CFI_section (CFI_cdesc_t *result, const CFI_cdesc_t *source,
   for (i = 0, j = 0; i < source->rank; i++)
     {
       if (lower_bounds)
-	offset += lower_bounds[i]*source->dim[i].sm;
+	offset += (lower_bounds[i]-source->dim[i].lower_bound)*source->dim[i].sm;
 
-      if (source->dim[i].sm == 0)
+      if (strides && strides[i] == 0)
 	continue;
 
       result->dim[j].lower_bound = lower_bounds
@@ -262,7 +262,7 @@  CFI_section (CFI_cdesc_t *result, const CFI_cdesc_t *source,
       if (upper_bounds)
 	{
 	  CFI_index_t extent;
-	  extent = upper_bounds[i] - result->dim[j].lower_bound;
+	  extent = upper_bounds[i] - result->dim[j].lower_bound + 1;
           result->dim[j].extent = extent < 0 ? 0 : extent;
 	}
       else
@@ -273,6 +273,7 @@  CFI_section (CFI_cdesc_t *result, const CFI_cdesc_t *source,
       else
 	{
 	  result->dim[j].sm = source->dim[i].sm * strides[i];
+	  result->dim[j].extent /= strides[i];
 	}
 
       j++;
--- /dev/null	2013-04-26 08:22:44.909104543 +0200
+++ gcc/gcc/testsuite/gfortran.dg/iso-ts-29113_2.f90	2013-04-25 19:36:51.194328662 +0200
@@ -0,0 +1,158 @@ 
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! Check whether the type files are properly set
+!
+subroutine test
+  use iso_c_binding
+  implicit none
+
+  interface
+    subroutine foo(x,i)
+      type(*) :: x(..)
+      integer(2), value :: i
+    end subroutine foo
+  end interface
+
+! /* Array-descriptor basic types, see ISO_Fortran_binding.h.  */
+! #define GFC_TYPE_INTEGER 1
+! #define GFC_TYPE_LOGICAL 2
+! #define GFC_TYPE_REAL 3
+! #define GFC_TYPE_COMPLEX 4
+! #define GFC_TYPE_CHARACTER 5
+! #define GFC_TYPE_STRUCT 6
+! #define GFC_TYPE_CPTR 7
+! #define GFC_TYPE_CFUNPTR 8
+! #define GFC_TYPE_OTHER -1
+
+  integer(2), parameter :: CFI_Int   = 1
+  integer(2), parameter :: CFI_Log   = 2
+  integer(2), parameter :: CFI_Real  = 3
+  integer(2), parameter :: CFI_Cmplx = 4
+  integer(2), parameter :: CFI_Char = 5
+  integer(2), parameter :: CFI_Struct = 6
+  integer(2), parameter :: CFI_cptr = 7
+  integer(2), parameter :: CFI_funcptr = 8
+  integer(2), parameter :: CFI_other = -1
+
+
+  integer(1), allocatable :: x_int1(:)
+  integer(2), allocatable :: x_int2(:)
+  integer(4), allocatable :: x_int4(:)
+  integer(8), allocatable :: x_int8(:)
+
+  logical(1), allocatable :: x_log1(:)
+  logical(2), allocatable :: x_log2(:)
+  logical(4), allocatable :: x_log4(:)
+  logical(8), allocatable :: x_log8(:)
+
+  real(4), allocatable :: x_real4(:)
+  real(8), allocatable :: x_real8(:)
+
+  complex(4), allocatable :: x_cmplx4(:)
+  complex(8), allocatable :: x_cmplx8(:)
+
+  character(kind=1,len=1), allocatable :: x_str1a(:)
+  character(kind=1,len=:), allocatable :: x_str1b(:)
+  character(kind=4,len=1), allocatable :: x_str4a(:)
+  character(kind=4,len=:), allocatable :: x_str4b(:)
+
+  type(c_ptr), allocatable :: x_cptr(:)
+  type(c_funptr), allocatable :: x_funcptr(:)
+
+
+  type t_seq
+    sequence
+    integer :: iii
+  end type t_seq
+
+  type, bind(C) :: t_bindc
+    integer(c_int) :: iii
+  end type t_bindc
+
+  type :: t_ext
+    integer :: iii
+  end type t_ext
+
+  type(t_seq), allocatable :: x_seq(:)
+  type(t_bindc), allocatable :: x_bindc(:)
+  type(t_ext), allocatable :: x_ext(:)
+  class(t_ext), allocatable :: x_class(:)
+
+  call foo(x_int1, CFI_Int + ishft (int(kind(x_int1),kind=2),8))
+  call foo(x_int2, CFI_Int + ishft (int(kind(x_int2),kind=2),8))
+  call foo(x_int4, CFI_Int + ishft (int(kind(x_int4),kind=2),8))
+  call foo(x_int8, CFI_Int + ishft (int(kind(x_int8),kind=2),8))
+
+  call foo(x_log1, CFI_Log + ishft (int(kind(x_log1),kind=2),8))
+  call foo(x_log2, CFI_Log + ishft (int(kind(x_log2),kind=2),8))
+  call foo(x_log4, CFI_Log + ishft (int(kind(x_log4),kind=2),8))
+  call foo(x_log8, CFI_Log + ishft (int(kind(x_log8),kind=2),8))
+
+  call foo(x_real4, CFI_Real + ishft (int(kind(x_real4),kind=2),8))
+  call foo(x_real8, CFI_Real + ishft (int(kind(x_real8),kind=2),8))
+
+  call foo(x_cmplx4, CFI_cmplx + ishft (int(kind(x_cmplx4),kind=2),8))
+  call foo(x_cmplx8, CFI_cmplx + ishft (int(kind(x_cmplx8),kind=2),8))
+
+  call foo(x_str1a, CFI_char + ishft (int(kind(x_str1a),kind=2),8))
+  call foo(x_str1b, CFI_char + ishft (int(kind(x_str1a),kind=2),8))
+  call foo(x_str4a, CFI_char + ishft (int(kind(x_str4a),kind=2),8))
+  call foo(x_str4b, CFI_char + ishft (int(kind(x_str4a),kind=2),8))
+
+  call foo(x_cptr, CFI_cptr)
+  call foo(x_funcptr, CFI_funcptr)
+
+  call foo(x_seq, CFI_struct)
+  call foo(x_bindc, CFI_struct)
+  call foo(x_ext, CFI_other)
+  call foo(x_class, CFI_other)
+end subroutine test
+
+! { dg-final { scan-tree-dump-times "x_cmplx4.type = 1028;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "x_cmplx8.type = 2052;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "x_int1.type = 257;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "x_int2.type = 513;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "x_int4.type = 1025;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "x_int8.type = 2049;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "x_log1.type = 258;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "x_log2.type = 514;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "x_log4.type = 1026;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "x_log8.type = 2050;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "x_real4.type = 1027;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "x_real8.type = 2051;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "x_str1a.type = 261;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "x_str1b.type = 261;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "x_str4a.type = 1029;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "x_str4b.type = 1029;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "x_cptr.type = 2049;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "x_funcptr.type = 2049;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "x_seq.type = 6;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "x_bindc.type = 6;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "x_ext.type = -1;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "x_class._data.type = -1;" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "foo \\(&x_int1, 257\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&x_int2, 513\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&x_int4, 1025\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&x_int8, 2049\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&x_log1, 258\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&x_log2, 514\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&x_log4, 1026\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&x_log8, 2050\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&x_real4, 1027\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&x_real8, 2051\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&x_cmplx4, 1028\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&x_cmplx8, 2052\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&x_str1a, 261, 1\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&x_str1b, 261, .x_str1b\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&x_str4a, 1029, 1\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&x_str4b, 1029, .x_str4b\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&x_cptr, 7\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&x_funcptr, 8\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&x_seq, 6\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&x_bindc, 6\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&x_ext, -1\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&x_class._data, -1\\);" 1 "original" } }
+
+! { dg-final { cleanup-tree-dump "original" } }
--- /dev/null	2013-04-26 08:22:44.909104543 +0200
+++ gcc/gcc/testsuite/gfortran.dg/iso-ts-29113_3.f90	2013-04-26 16:54:02.750866417 +0200
@@ -0,0 +1,71 @@ 
+! { dg-do run }
+! { dg-additional-sources iso-ts-29113_3_c.c }
+! { dg-options "" }
+!
+! dg-options is required to silence -pedantic warnings for
+! the C code.
+!
+! Test whether accessing the array from C works using
+! TS29113's ISO_Fortran_binding.h
+!
+! The C examples are based on TS29113's.
+!
+module m
+  use iso_c_binding
+  implicit none
+
+  interface
+    subroutine test_establish1() bind(C)
+    end subroutine test_establish1
+    subroutine test_establish2() bind(C)
+    end subroutine test_establish2
+    subroutine test_section1(x) bind(C)
+      import
+      real(c_float) :: x(:)
+    end subroutine test_section1
+    subroutine test_section2(x) bind(C)
+      import
+      real(c_float) :: x(:,:)
+    end subroutine test_section2
+  end interface
+
+  real, target :: A(100)
+  real, target :: B(100, 100)
+contains
+  subroutine check_section1(x) bind(C)
+    real(c_float), target :: x(:)
+
+    if (size (x) /= size (A(3::5))) call abort ()
+    if (lbound (x,1) /= lbound (A(3::5),1)) call abort ()
+    if (ubound (x,1) /= ubound (A(3::5),1)) call abort ()
+    if (loc (x(1)) /= loc (A(2))) call abort ()  ! FIXME: Should be A(3::5), lower_bound 0<->1 issue
+    if (any (x /= A(2::5))) call abort ()
+  end subroutine
+  subroutine check_section2(x) bind(C)
+    real(c_float), target :: x(:)
+
+    if (size (x) /= size (B(:,42))) call abort ()
+    if (lbound (x,1) /= lbound (B(:,42),1)) call abort ()
+    if (ubound (x,1) /= ubound (B(:,42),1)) call abort ()
+    if (loc (x(1)) /= loc (B(1,41))) call abort () ! FIXME: Should be B(1,42), lower_bound 0<->1 issue
+    if (any (x /= B(:,41))) call abort () ! FIXME: Should be B(:,42), lower_bound 0<->1 issue
+  end subroutine
+end module m
+
+use m
+implicit none
+integer :: i,j
+
+call test_establish1 ()
+call test_establish2 ()
+
+A = [(i+100, i=0,99)]
+call test_section1 (A)
+
+do j = 1, 100
+  do i = 1, 100
+    B(i,j) = -i - 1000*j
+  end do
+end do
+call test_section2 (B)
+end
--- /dev/null	2013-04-26 08:22:44.909104543 +0200
+++ gcc/gcc/testsuite/gfortran.dg/iso-ts-29113_3_c.c	2013-04-26 16:53:23.333562851 +0200
@@ -0,0 +1,206 @@ 
+/* To be complied together with iso-ts-29113_2.f90.
+
+   Test whether accessing the array from C works using
+   TS29113's ISO_Fortran_binding.h
+
+   The examples are based on TS29113's.  */
+
+#include <ISO_Fortran_binding.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+
+void check_section1 (CFI_cdesc_t *);
+void check_section2 (CFI_cdesc_t *);
+
+
+void
+test_establish1 (void)
+{
+  int ind;
+
+  /* For establish */
+  CFI_rank_t rank;
+  CFI_CDESC_T(1) field;
+
+  /* For allocate */
+  CFI_index_t lower[1], upper[1];
+  size_t dummy = 0;
+
+  rank = 1;
+  ind = CFI_establish ((CFI_cdesc_t *) &field, NULL, CFI_attribute_allocatable,
+		       CFI_type_double, 0, rank, NULL);
+
+  if (ind != CFI_SUCCESS) abort ();
+  if (field.base_addr != NULL) abort ();
+  if (field.rank != 1) abort();
+  if (field.version != CFI_VERSION) abort ();
+  if (field.type != CFI_type_double) abort ();
+  if (field.attribute != CFI_attribute_allocatable) abort ();
+
+  lower[0] = -1;
+  upper[0] = 100;
+  ind = CFI_allocate ((CFI_cdesc_t *) &field, lower, upper, dummy);
+  if (ind != CFI_SUCCESS) abort ();
+  if (field.elem_len != sizeof (double)) abort ();
+  if (field.dim[0].lower_bound != -1) abort ();
+  if (field.dim[0].extent != 100-(-1)+1) abort ();
+  if (field.dim[0].sm != 1*field.elem_len) abort ();
+
+  ind = CFI_allocate ((CFI_cdesc_t *) &field, lower, upper, dummy);
+  if (ind != CFI_ERROR_BASE_ADDR_NOT_NULL) abort ();
+
+  ind = CFI_deallocate ((CFI_cdesc_t *) &field);
+  if (ind != CFI_SUCCESS) abort ();
+}
+
+
+void
+test_establish2 (void)
+{
+  int ind;
+
+  /* For establish */
+  typedef struct {double x; double _Complex y;} t;
+  t a_c[100];
+  CFI_CDESC_T(1) a_fortran;
+  CFI_index_t extent[1];
+
+  /* For allocate */
+  CFI_index_t lower[2], upper[2];
+  size_t dummy = 0;
+
+  extent[0] = 100;
+  ind = CFI_establish((CFI_cdesc_t *) &a_fortran, a_c, CFI_attribute_other,
+		      CFI_type_struct, sizeof(t), 1, extent);
+
+  if (ind != CFI_SUCCESS) abort ();
+  if (a_fortran.base_addr != a_c) abort ();
+  if (a_fortran.rank != 1) abort();
+  if (a_fortran.version != CFI_VERSION) abort ();
+  if (a_fortran.type != CFI_type_struct) abort ();
+  if (a_fortran.elem_len != sizeof(t)) abort ();
+  if (a_fortran.attribute != CFI_attribute_other) abort ();
+  if (a_fortran.dim[0].lower_bound != 0) abort ();
+  if (a_fortran.dim[0].extent != 100) abort ();
+  if (a_fortran.dim[0].sm != a_fortran.elem_len) abort ();
+
+  lower[0] = -1;
+  upper[0] = 100;
+  ind = CFI_allocate ((CFI_cdesc_t *) &a_fortran, lower, upper, dummy);
+  if (ind != CFI_INVALID_ATTRIBUTE) abort ();
+
+  if (a_fortran.base_addr != a_c) abort ();
+  if (a_fortran.rank != 1) abort();
+  if (a_fortran.version != CFI_VERSION) abort ();
+  if (a_fortran.type != CFI_type_struct) abort ();
+  if (a_fortran.elem_len != sizeof(t)) abort ();
+  if (a_fortran.attribute != CFI_attribute_other) abort ();
+  if (a_fortran.dim[0].lower_bound != 0) abort ();
+  if (a_fortran.dim[0].extent != 100) abort ();
+  if (a_fortran.dim[0].sm != a_fortran.elem_len) abort ();
+}
+
+
+void
+test_section1 (CFI_cdesc_t *source)
+{
+  int ind;
+
+  CFI_index_t lower_bounds[] = {2}, strides[] = {5};
+  CFI_CDESC_T(1) section;
+
+  CFI_rank_t rank = 1;
+  ind = CFI_establish ((CFI_cdesc_t *) &section, NULL,
+                       CFI_attribute_other, CFI_type_float, 0, rank, NULL);
+  if (ind != CFI_SUCCESS) abort ();
+  if (section.base_addr != NULL) abort ();
+  if (section.rank != 1) abort();
+  if (section.version != CFI_VERSION) abort ();
+  if (section.type != CFI_type_float) abort ();
+  if (section.attribute != CFI_attribute_other) abort ();
+
+  if (source->base_addr == NULL) abort ();
+  if (source->rank != 1) abort();
+  if (source->version != CFI_VERSION) abort ();
+  if (source->type != CFI_type_float) abort ();
+  if (source->attribute != CFI_attribute_other) abort ();
+  if (source->elem_len != sizeof(float)) abort ();
+  /* FIXME: lower_bound should be 0. */
+  if (source->dim[0].lower_bound != 1) abort ();
+  if (source->dim[0].extent != 100) abort ();
+  if (source->dim[0].sm != source->elem_len) abort (); 
+
+  for (ind = 0; ind < 100; ind++)
+    if (((float *)source->base_addr)[ind] != 100 + ind) abort();
+
+  ind = CFI_section ((CFI_cdesc_t *) &section, source, lower_bounds,
+		     NULL, strides);
+  if (ind != CFI_SUCCESS) abort ();
+  /* FIXME: Off by one due to 0<->1 lower_bound issue.  */
+  if (section.base_addr != source->base_addr+1*source->dim[0].sm) abort ();
+  if (section.dim[0].lower_bound != 2) abort (); /* FIXME: Is this correct? */
+  if (section.dim[0].extent != 20) abort ();
+  if (section.dim[0].sm != source->elem_len*5) abort ();
+  if (section.rank != 1) abort();
+  if (section.version != CFI_VERSION) abort ();
+  if (section.type != CFI_type_float) abort ();
+  if (section.attribute != CFI_attribute_other) abort ();
+  if (section.elem_len != sizeof(float)) abort ();
+
+  check_section1 ((CFI_cdesc_t *) &section);
+}
+
+
+void
+test_section2 (CFI_cdesc_t *source)
+{
+  int ind;
+  CFI_index_t lower_bounds[] = {source->dim[0].lower_bound, 41},
+	      upper_bounds[] = {source->dim[0].lower_bound+source->dim[0].extent-1, 41},
+	      strides[] = {1, 0};
+  CFI_CDESC_T(1) section;
+
+
+  CFI_rank_t rank = 1 ;
+  ind = CFI_establish ((CFI_cdesc_t *) &section, NULL,
+		       CFI_attribute_other, CFI_type_float, 0, rank, NULL);
+
+  if (ind != CFI_SUCCESS) abort ();
+  if (section.base_addr != NULL) abort ();
+  if (section.rank != 1) abort();
+  if (section.version != CFI_VERSION) abort ();
+  if (section.type != CFI_type_float) abort ();
+  if (section.attribute != CFI_attribute_other) abort ();
+
+  if (source->base_addr == NULL) abort ();
+  if (source->rank != 2) abort();
+  if (source->version != CFI_VERSION) abort ();
+  if (source->type != CFI_type_float) abort ();
+  if (source->attribute != CFI_attribute_other) abort ();
+  if (source->elem_len != sizeof(float)) abort ();
+  /* FIXME: Off by one due to 0<->1 lower_bound issue.  */
+  if (source->dim[0].lower_bound != 1) abort ();
+  if (source->dim[1].lower_bound != 1) abort ();
+  if (source->dim[0].extent != 100) abort ();
+  if (source->dim[1].extent != 100) abort ();
+  if (source->dim[0].sm != source->elem_len) abort (); 
+  if (source->dim[1].sm != 100*source->elem_len) abort ();
+
+  ind = CFI_section ((CFI_cdesc_t *) &section, source,
+		     lower_bounds, upper_bounds, strides );
+  if (ind != CFI_SUCCESS) abort ();
+  /* FIXME: Off by one due to 0<->1 lower_bound issue.  */
+  if (section.dim[0].lower_bound != 1) abort ();
+  if (section.dim[0].extent != 100) abort ();
+  if (section.dim[0].sm != source->elem_len) abort ();
+  /* FIXME: Off by one due to 0<->1 lower_bound issue.  */
+  if (section.base_addr != source->base_addr+40*100*source->dim[0].sm) abort ();
+  if (section.rank != 1) abort();
+  if (section.version != CFI_VERSION) abort ();
+  if (section.type != CFI_type_float) abort ();
+  if (section.attribute != CFI_attribute_other) abort ();
+  if (section.elem_len != sizeof(float)) abort ();
+
+  check_section2 ((CFI_cdesc_t *) &section);
+}