Index: gcc/fortran/trans-decl.c
===================================================================
*** gcc/fortran/trans-decl.c	(revision 270149)
--- gcc/fortran/trans-decl.c	(working copy)
*************** gfc_get_symbol_decl (gfc_symbol * sym)
*** 1494,1499 ****
--- 1494,1506 ----
        && sym->attr.dummy)
      gfc_defer_symbol_init (sym);
  
+   if (sym->attr.dummy
+       && sym->ns->proc_name->attr.is_bind_c
+       && sym->attr.dimension
+       && (sym->as->type == AS_ASSUMED_SHAPE
+ 	  || sym->as->type == AS_ASSUMED_RANK))
+     gfc_defer_symbol_init (sym);
+ 
    /* All deferred character length procedures need to retain the backend
       decl, which is a pointer to the character length in the caller's
       namespace and to declare a local character length.  */
*************** gfc_null_and_pass_deferred_len (gfc_symb
*** 4268,4273 ****
--- 4275,4353 ----
  }
  
  
+ /* Convert CFI descriptor dummies into gfc types and back again.  */
+ static void
+ convert_CFI_desc (gfc_wrapped_block * block, gfc_symbol *sym)
+ {
+   tree gfc_desc;
+   tree gfc_desc_ptr;
+   tree CFI_desc;
+   tree CFI_desc_ptr;
+   tree dummy_ptr;
+   tree tmp;
+   tree incoming;
+   tree outgoing;
+   stmtblock_t tmpblock;
+ 
+   /* dummy_ptr will be the pointer to the passed array descriptor,
+      while CFI_desc is the descriptor itself.  */
+   dummy_ptr = sym->backend_decl;
+   CFI_desc = sym->backend_decl;
+   if (POINTER_TYPE_P (TREE_TYPE (CFI_desc)))
+     CFI_desc = build_fold_indirect_ref_loc (input_location, CFI_desc);
+   if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (CFI_desc)))
+     {
+       if (DECL_LANG_SPECIFIC (sym->backend_decl))
+ 	CFI_desc = GFC_DECL_SAVED_DESCRIPTOR (sym->backend_decl);
+       else
+ 	CFI_desc = NULL;
+       dummy_ptr = CFI_desc;
+     }
+ 
+   if (CFI_desc)
+     {
+       if (POINTER_TYPE_P (TREE_TYPE (CFI_desc)))
+ 	CFI_desc = build_fold_indirect_ref_loc (input_location, CFI_desc);
+ 
+       /* The compiler will have given CFI_desc the correct gfortran
+ 	 type. Use this new variable to store the converted
+ 	 descriptor.  */
+       gfc_desc = gfc_create_var (TREE_TYPE (CFI_desc), "gfc_desc");
+       tmp = build_pointer_type (TREE_TYPE (gfc_desc));
+       gfc_desc_ptr = gfc_create_var (tmp, "gfc_desc_ptr");
+       CFI_desc_ptr = gfc_create_var (pvoid_type_node, "CFI_desc_ptr");
+ 
+       gfc_init_block (&tmpblock);
+       /* Pointer to the gfc descriptor.  */
+       gfc_add_modify (&tmpblock, gfc_desc_ptr,
+ 		      gfc_build_addr_expr (NULL, gfc_desc));
+       /* Store the pointer to the CFI descriptor.  */
+       gfc_add_modify (&tmpblock, CFI_desc_ptr,
+ 		      fold_convert (pvoid_type_node, dummy_ptr));
+       tmp = gfc_build_addr_expr (ppvoid_type_node, CFI_desc_ptr);
+       /* Convert the CFI descriptor.  */
+       incoming = build_call_expr_loc (input_location,
+ 			gfor_fndecl_cfi_to_gfc, 2, gfc_desc_ptr, tmp);
+       gfc_add_expr_to_block (&tmpblock, incoming);
+       /* Set the dummy pointer to point to the gfc_descriptor.  */
+       gfc_add_modify (&tmpblock, dummy_ptr,
+ 		      fold_convert (TREE_TYPE (dummy_ptr), gfc_desc_ptr));
+       incoming = gfc_finish_block (&tmpblock);
+ 
+       gfc_init_block (&tmpblock);
+       /* Convert the gfc descriptor back to the CFI type before going
+ 	 out of scope.  */
+       tmp = gfc_build_addr_expr (ppvoid_type_node, CFI_desc_ptr);
+       outgoing = build_call_expr_loc (input_location,
+ 			gfor_fndecl_gfc_to_cfi, 2, tmp, gfc_desc_ptr);
+       gfc_add_expr_to_block (&tmpblock, outgoing);
+       outgoing = gfc_finish_block (&tmpblock);
+ 
+       /* Add the lot to the procedure init and finally blocks.  */
+       gfc_add_init_cleanup (block, incoming, outgoing);
+     }
+ }
+ 
  /* Get the result expression for a procedure.  */
  
  static tree
*************** gfc_trans_deferred_vars (gfc_symbol * pr
*** 4844,4849 ****
--- 4924,4940 ----
  	}
        else if (!(UNLIMITED_POLY(sym)) && !is_pdt_type)
  	gcc_unreachable ();
+ 
+       /* Assumed shape and assumed rank arrays are passed to BIND(C) procedures
+ 	 as ISO Fortran Interop descriptors. These have to be converted to
+ 	 gfortran descriptors and back again.  This has to be done here so that
+ 	 the conversion occurs at the start of the init block.  */
+       if (sym->attr.dummy
+ 	  && sym->ns->proc_name->attr.is_bind_c
+ 	  && sym->attr.dimension
+ 	  && (sym->as->type == AS_ASSUMED_SHAPE
+ 	      || sym->as->type == AS_ASSUMED_RANK))
+ 	convert_CFI_desc (block, sym);
      }
  
    gfc_init_block (&tmpblock);
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c	(revision 270149)
--- gcc/fortran/trans-expr.c	(working copy)
*************** gfc_conv_gfc_desc_to_cfi_desc (gfc_se *p
*** 4990,4997 ****
--- 4990,4999 ----
    tree ptr = NULL_TREE;
    tree size;
    tree type;
+   tree cond;
    int attribute;
    symbol_attribute attr = gfc_expr_attr (e);
+   stmtblock_t block;
  
    /* If this is a full array or a scalar, the allocatable and pointer
       attributes can be passed. Otherwise it is 'CFI_attribute_other'*/
*************** gfc_conv_gfc_desc_to_cfi_desc (gfc_se *p
*** 5135,5140 ****
--- 5137,5144 ----
    /* Variables to point to the gfc and CFI descriptors.  */
    gfc_desc_ptr = parmse->expr;
    cfi_desc_ptr = gfc_create_var (pvoid_type_node, "cfi");
+   gfc_add_modify (&parmse->pre, cfi_desc_ptr,
+ 		  build_int_cst (pvoid_type_node, 0));
  
    /* Allocate the CFI descriptor and fill the fields.  */
    tmp = gfc_build_addr_expr (NULL_TREE, cfi_desc_ptr);
*************** gfc_conv_gfc_desc_to_cfi_desc (gfc_se *p
*** 5147,5154 ****
  
    if (ptr)
      {
!       /* Free both the temporary data and the CFI descriptor for
! 	 INTENT(IN) arrays.  */
        tmp = gfc_call_free (ptr);
        gfc_prepend_expr_to_block (&parmse->post, tmp);
        tmp = gfc_call_free (cfi_desc_ptr);
--- 5151,5157 ----
  
    if (ptr)
      {
!       /* Free the temporary data for INTENT(IN) arrays.  */
        tmp = gfc_call_free (ptr);
        gfc_prepend_expr_to_block (&parmse->post, tmp);
        tmp = gfc_call_free (cfi_desc_ptr);
*************** gfc_conv_gfc_desc_to_cfi_desc (gfc_se *p
*** 5156,5162 ****
        return;
      }
  
!   /* Transfer values back to gfc descriptor and free the CFI descriptor.  */
    tmp = gfc_build_addr_expr (NULL_TREE, parmse->expr);
    tmp = build_call_expr_loc (input_location,
  			     gfor_fndecl_cfi_to_gfc, 2, gfc_desc_ptr, tmp);
--- 5159,5177 ----
        return;
      }
  
!   /* Free the CFI descriptor.  */
!   gfc_init_block (&block);
!   cond = fold_build2_loc (input_location, NE_EXPR,
! 			  logical_type_node, cfi_desc_ptr,
! 			  build_int_cst (TREE_TYPE (cfi_desc_ptr), 0));
!   tmp = gfc_call_free (cfi_desc_ptr);
!   gfc_add_expr_to_block (&block, tmp);
!   tmp = build3_v (COND_EXPR, cond,
! 		  gfc_finish_block (&block),
! 		  build_empty_stmt (input_location));
!   gfc_prepend_expr_to_block (&parmse->post, tmp);
! 
!   /* Transfer values back to gfc descriptor.  */
    tmp = gfc_build_addr_expr (NULL_TREE, parmse->expr);
    tmp = build_call_expr_loc (input_location,
  			     gfor_fndecl_cfi_to_gfc, 2, gfc_desc_ptr, tmp);
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.c
===================================================================
*** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.c	(revision 270149)
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.c	(working copy)
*************** float section_c(int *std_case, CFI_cdesc
*** 105,111 ****
    CFI_index_t idx[CFI_MAX_RANK], lower[CFI_MAX_RANK],
  		  strides[CFI_MAX_RANK], upper[CFI_MAX_RANK];
    CFI_CDESC_T(1) section;
!   int ind, size;
    float *ret_addr;
    float ans = 0.0;
  
--- 105,111 ----
    CFI_index_t idx[CFI_MAX_RANK], lower[CFI_MAX_RANK],
  		  strides[CFI_MAX_RANK], upper[CFI_MAX_RANK];
    CFI_CDESC_T(1) section;
!   int ind;
    float *ret_addr;
    float ans = 0.0;
  
*************** float section_c(int *std_case, CFI_cdesc
*** 121,129 ****
        if (ind) return -2.0;
  
        /* Sum over the section  */
!       size = (section.dim[0].extent - 1)
! 		* section.elem_len/section.dim[0].sm + 1;
!       for (idx[0] = 0; idx[0] < size; idx[0]++)
          ans += *(float*)CFI_address ((CFI_cdesc_t*)&section, idx);
        return ans;
      }
--- 121,127 ----
        if (ind) return -2.0;
  
        /* Sum over the section  */
!       for (idx[0] = 0; idx[0] < section.dim[0].extent; idx[0]++)
          ans += *(float*)CFI_address ((CFI_cdesc_t*)&section, idx);
        return ans;
      }
*************** float section_c(int *std_case, CFI_cdesc
*** 143,151 ****
        if (ind) return -2.0;
  
        /* Sum over the section  */
!       size = (section.dim[0].extent - 1)
! 		* section.elem_len/section.dim[0].sm + 1;
!       for (idx[0] = 0; idx[0] < size; idx[0]++)
          ans += *(float*)CFI_address ((CFI_cdesc_t*)&section, idx);
        return ans;
      }
--- 141,147 ----
        if (ind) return -2.0;
  
        /* Sum over the section  */
!       for (idx[0] = 0; idx[0] < section.dim[0].extent; idx[0]++)
          ans += *(float*)CFI_address ((CFI_cdesc_t*)&section, idx);
        return ans;
      }
*************** int setpointer_c(CFI_cdesc_t * ptr, int
*** 191,205 ****
  
  int assumed_size_c(CFI_cdesc_t * desc)
  {
!   int ierr;
  
!   ierr = CFI_is_contiguous(desc);
!   if (ierr)
      return 1;
    if (desc->rank)
!     ierr = 2 * (desc->dim[desc->rank-1].extent
  				!= (CFI_index_t)(long long)(-1));
    else
!     ierr = 3;
!   return ierr;
  }
--- 187,201 ----
  
  int assumed_size_c(CFI_cdesc_t * desc)
  {
!   int res;
  
!   res = CFI_is_contiguous(desc);
!   if (!res)
      return 1;
    if (desc->rank)
!     res = 2 * (desc->dim[desc->rank-1].extent
  				!= (CFI_index_t)(long long)(-1));
    else
!     res = 3;
!   return res;
  }
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.f90	(revision 270149)
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.f90	(working copy)
*************** end subroutine test_CFI_address
*** 170,185 ****
      integer, dimension (2,*) :: arg
      character(4), dimension(2) :: chr
  ! These are contiguous
!     if (c_contiguous (arg) .ne. 0) stop 20
      if (.not.allocated (x)) allocate (x(2, 2))
!     if (c_contiguous (x) .ne. 0) stop 22
      deallocate (x)
!     if (c_contiguous (chr) .ne. 0) stop 23
  ! These are not contiguous
!     if (c_contiguous (der%i) .eq. 0) stop 24
!     if (c_contiguous (arg(1:1,1:2)) .eq. 0) stop 25
!     if (c_contiguous (d(4:2:-2, 1:3:2)) .eq. 0) stop 26
!     if (c_contiguous (chr(:)(2:3)) .eq. 0) stop 27
    end subroutine test_CFI_contiguous
  
    subroutine test_CFI_section (arg)
--- 170,185 ----
      integer, dimension (2,*) :: arg
      character(4), dimension(2) :: chr
  ! These are contiguous
!     if (c_contiguous (arg) .ne. 1) stop 20
      if (.not.allocated (x)) allocate (x(2, 2))
!     if (c_contiguous (x) .ne. 1) stop 22
      deallocate (x)
!     if (c_contiguous (chr) .ne. 1) stop 23
  ! These are not contiguous
!     if (c_contiguous (der%i) .eq. 1) stop 24
!     if (c_contiguous (arg(1:1,1:2)) .eq. 1) stop 25
!     if (c_contiguous (d(4:2:-2, 1:3:2)) .eq. 1) stop 26
!     if (c_contiguous (chr(:)(2:3)) .eq. 1) stop 27
    end subroutine test_CFI_contiguous
  
    subroutine test_CFI_section (arg)
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.c
===================================================================
*** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.c	(nonexistent)
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.c	(working copy)
***************
*** 0 ****
--- 1,73 ----
+ /* Test the fix of PR89843.  */
+ 
+ /* Contributed by Reinhold Bader  <Bader@lrz.de> */
+ 
+ #include "../../../libgfortran/ISO_Fortran_binding.h"
+ #include <stdlib.h>
+ #include <stdio.h>
+ #include <stdbool.h>
+ 
+ void sa(CFI_cdesc_t *, int, int *);
+ 
+ void si(CFI_cdesc_t *this, int flag, int *status)
+ {
+   int value, sum;
+   bool err;
+   CFI_CDESC_T(1) that;
+   CFI_index_t lb[] = { 0, 0 };
+   CFI_index_t ub[] = { 4, 1 };
+   CFI_index_t st[] = { 2, 0 };
+   int chksum[] = { 9, 36, 38 };
+ 
+   if (flag == 1)
+     {
+       lb[0] = 0; lb[1] = 2;
+       ub[0] = 2; ub[1] = 2;
+       st[0] = 1; st[1] = 0;
+     }
+   else if (flag == 2)
+     {
+       lb[0] = 1; lb[1] = 0;
+       ub[0] = 1; ub[1] = 3;
+       st[0] = 0; st[1] = 1;
+     }
+ 
+   CFI_establish((CFI_cdesc_t *) &that, NULL, CFI_attribute_other,
+ 		CFI_type_float, 0, 1, NULL);
+ 
+   *status = CFI_section((CFI_cdesc_t *) &that, this, lb, ub, st);
+ 
+   if (*status != CFI_SUCCESS)
+     {
+       printf("FAIL C: status is %i\n",status);
+       return;
+     }
+ 
+   value = CFI_is_contiguous((CFI_cdesc_t *) &that);
+   err = ((flag == 0 && value != 0)
+ 	 || (flag == 1 && value != 1)
+ 	 || (flag == 2 && value != 0));
+ 
+   if (err)
+     {
+       printf("FAIL C: contiguity for flag value %i - is %i\n",flag, value);
+       *status = 10;
+       return;
+     }
+ 
+   sum = 0;
+   for (int i = 0; i < that.dim[0].extent; i++)
+     {
+       CFI_index_t idx[] = {i};
+       sum += (int)(*(float *)CFI_address ((CFI_cdesc_t *)&that, idx));
+     }
+ 
+   if (sum != chksum[flag])
+     {
+       printf ("FAIL C: check sum = %d(%d)\n", sum, chksum[flag]);
+       *status = 11;
+       return;
+     }
+ 
+     sa((CFI_cdesc_t *) &that, flag, status);
+ }
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.f90
===================================================================
*** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.f90	(nonexistent)
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.f90	(working copy)
***************
*** 0 ****
--- 1,99 ----
+ ! { dg-do run { target c99_runtime } }
+ ! { dg-additional-sources ISO_Fortran_binding_10.c }
+ !
+ ! Test the fix of PR89843.
+ !
+ ! Contributed by Reinhold Bader  <Bader@lrz.de>
+ !
+ module mod_section_01
+   use, intrinsic :: iso_c_binding
+   implicit none
+   interface
+      subroutine si(this, flag, status) bind(c)
+        import :: c_float, c_int
+        real(c_float) :: this(:,:)
+        integer(c_int), value :: flag
+        integer(c_int) :: status
+      end subroutine si
+   end interface
+ contains
+   subroutine sa(this, flag, status) bind(c)
+     real(c_float) :: this(:)
+     integer(c_int), value :: flag
+     integer(c_int) :: status
+ 
+     status = 0
+ 
+     select case (flag)
+     case (0)
+        if (is_contiguous(this)) then
+           write(*,*) 'FAIL 1:'
+           status = status + 1
+        end if
+        if (size(this,1) /= 3) then
+           write(*,*) 'FAIL 2:',size(this)
+           status = status + 1
+           goto 10
+        end if
+        if (maxval(abs(this - [ 1.0, 3.0, 5.0 ])) > 1.0e-6) then
+           write(*,*) 'FAIL 3:',this
+           status = status + 1
+        end if
+   10   continue
+    case (1)
+       if (size(this,1) /= 3) then
+           write(*,*) 'FAIL 4:',size(this)
+           status = status + 1
+           goto 20
+        end if
+        if (maxval(abs(this - [ 11.0, 12.0, 13.0 ])) > 1.0e-6) then
+           write(*,*) 'FAIL 5:',this
+           status = status + 1
+        end if
+   20   continue
+    case (2)
+       if (size(this,1) /= 4) then
+           write(*,*) 'FAIL 6:',size(this)
+           status = status + 1
+           goto 30
+        end if
+       if (maxval(abs(this - [ 2.0, 7.0, 12.0, 17.0 ])) > 1.0e-6) then
+           write(*,*) 'FAIL 7:',this
+           status = status + 1
+        end if
+   30   continue
+     end select
+ 
+ !    if (status == 0) then
+ !       write(*,*) 'OK'
+ !    end if
+   end subroutine sa
+ end module mod_section_01
+ 
+ program section_01
+   use mod_section_01
+   implicit none
+   real(c_float) :: v(5,4)
+   integer :: i
+   integer :: status
+ 
+   v = reshape( [ (real(i), i = 1, 20) ], [ 5, 4 ] )
+   call si(v, 0, status)
+   if (status .ne. 0) stop 1
+ 
+   call sa(v(1:5:2, 1), 0, status)
+   if (status .ne. 0) stop 2
+ 
+   call si(v, 1, status)
+   if (status .ne. 0) stop 3
+ 
+   call sa(v(1:3, 3), 1, status)
+   if (status .ne. 0) stop 4
+ 
+   call si(v, 2, status)
+   if (status .ne. 0) stop 5
+ 
+   call sa(v(2,1:4), 2, status)
+   if (status .ne. 0) stop 6
+ 
+ end program section_01
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_4.f90
===================================================================
*** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_4.f90	(revision 270149)
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_4.f90	(working copy)
*************** contains
*** 10,18 ****
--- 10,20 ----
  
      if (any(abs(x - [2.,4.,6.]) > 1.e-6)) then
         write(*,*) 'FAIL'
+        stop 1
      else
         write(*,*) 'OK'
      end if
+     x = [2.,4.,6.]*10.0
    end subroutine
  end module
  program p
*************** program p
*** 23,27 ****
  
    x = [ (real(i), i=1, size(x)) ]
    call ctg(x(2::2))
! 
  end program
--- 25,29 ----
  
    x = [ (real(i), i=1, size(x)) ]
    call ctg(x(2::2))
!   if (any (abs (x - [1.,20.,3.,40.,5.,60.]) > 1.e-6)) stop 2
  end program
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_9.c
===================================================================
*** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_9.c	(nonexistent)
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_9.c	(working copy)
***************
*** 0 ****
--- 1,14 ----
+ /* Test fix of a problem with CFI_is_contiguous.  */
+ 
+ /* Contributed by Gilles Gouaillardet  <gilles@rist.or.jp> */
+ 
+ #include "../../../libgfortran/ISO_Fortran_binding.h"
+ #include <stdlib.h>
+ 
+ int cdesc_c(CFI_cdesc_t* x, long *expected)
+ {
+   int res;
+   res = CFI_is_contiguous (x);
+   if (x->base_addr != (void *)*expected) res = 0;
+   return res;
+ }
\ No newline at end of file
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_9.f90
===================================================================
*** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_9.f90	(nonexistent)
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_9.f90	(working copy)
***************
*** 0 ****
--- 1,28 ----
+ ! { dg-do run { target c99_runtime } }
+ ! { dg-additional-sources ISO_Fortran_binding_9.c }
+ !
+ ! Fix a problem with CFI_is_contiguous
+ !
+ ! Contributed by Gilles Gouaillardet  <gilles@rist.or.jp>
+ !
+ module cdesc
+   interface
+   function cdesc_f08(buf, expected) result (res) BIND(C, name="cdesc_c")
+       USE, INTRINSIC :: ISO_C_BINDING
+       implicit none
+       INTEGER(C_INT) :: res
+       type(*), dimension(..), INTENT(INOUT) :: buf
+       integer(kind=8),INTENT(IN) :: expected
+     end function cdesc_f08
+   end interface
+ end module
+ 
+ program cdesc_test
+   use cdesc
+   implicit none
+   integer :: a0, a1(10), a2(10,10), a3(10,10,10)
+   if (cdesc_f08(a0, LOC(a0)) .ne. 1) stop 1
+   if (cdesc_f08(a1, LOC(a1(1))) .ne. 1) stop 2
+   if (cdesc_f08(a2, LOC(a2(1,1))) .ne. 1) stop 3
+   if (cdesc_f08(a3, LOC(a3(1,1,1))) .ne. 1) stop 4
+ end program
Index: libgfortran/runtime/ISO_Fortran_binding.c
===================================================================
*** libgfortran/runtime/ISO_Fortran_binding.c	(revision 270149)
--- libgfortran/runtime/ISO_Fortran_binding.c	(working copy)
*************** void
*** 37,59 ****
  cfi_desc_to_gfc_desc (gfc_array_void *d, CFI_cdesc_t **s_ptr)
  {
    int n;
    CFI_cdesc_t *s = *s_ptr;
  
!   /* If not a full pointer or allocatable array free the descriptor
!      and return.  */
!   if (!s || s->attribute == CFI_attribute_other)
!     goto finish;
  
    GFC_DESCRIPTOR_DATA (d) = s->base_addr;
- 
-   if (!s->rank || s->dim[0].sm == (CFI_index_t)s->elem_len)
-     GFC_DESCRIPTOR_SIZE (d) = s->elem_len;
-   else
-     GFC_DESCRIPTOR_SIZE (d) =  (index_type)s->dim[0].sm;
- 
-   d->dtype.version = s->version;
-   GFC_DESCRIPTOR_RANK (d) = (signed char)s->rank;
    GFC_DESCRIPTOR_TYPE (d) = (signed char)(s->type & CFI_type_mask);
  
    /* Correct the unfortunate difference in order with types.  */
    if (GFC_DESCRIPTOR_TYPE (d) == BT_CHARACTER)
--- 37,51 ----
  cfi_desc_to_gfc_desc (gfc_array_void *d, CFI_cdesc_t **s_ptr)
  {
    int n;
+   index_type kind;
    CFI_cdesc_t *s = *s_ptr;
  
!   if (!s)
!     return;
  
    GFC_DESCRIPTOR_DATA (d) = s->base_addr;
    GFC_DESCRIPTOR_TYPE (d) = (signed char)(s->type & CFI_type_mask);
+   kind = (index_type)((s->type - (s->type & CFI_type_mask)) >> CFI_type_kind_shift);
  
    /* Correct the unfortunate difference in order with types.  */
    if (GFC_DESCRIPTOR_TYPE (d) == BT_CHARACTER)
*************** cfi_desc_to_gfc_desc (gfc_array_void *d,
*** 61,72 ****
    else if (GFC_DESCRIPTOR_TYPE (d) == BT_DERIVED)
      GFC_DESCRIPTOR_TYPE (d) = BT_CHARACTER;
  
    d->dtype.attribute = (signed short)s->attribute;
  
    if (s->rank)
      d->span = (index_type)s->dim[0].sm;
  
-   /* On the other hand, CFI_establish can change the bounds.  */
    d->offset = 0;
    for (n = 0; n < GFC_DESCRIPTOR_RANK (d); n++)
      {
--- 53,73 ----
    else if (GFC_DESCRIPTOR_TYPE (d) == BT_DERIVED)
      GFC_DESCRIPTOR_TYPE (d) = BT_CHARACTER;
  
+   if (!s->rank || s->dim[0].sm == (CFI_index_t)s->elem_len)
+     GFC_DESCRIPTOR_SIZE (d) = s->elem_len;
+   else if (GFC_DESCRIPTOR_TYPE (d) != BT_DERIVED)
+     GFC_DESCRIPTOR_SIZE (d) = kind;
+   else
+     GFC_DESCRIPTOR_SIZE (d) = s->elem_len;
+ 
+   d->dtype.version = s->version;
+   GFC_DESCRIPTOR_RANK (d) = (signed char)s->rank;
+ 
    d->dtype.attribute = (signed short)s->attribute;
  
    if (s->rank)
      d->span = (index_type)s->dim[0].sm;
  
    d->offset = 0;
    for (n = 0; n < GFC_DESCRIPTOR_RANK (d); n++)
      {
*************** cfi_desc_to_gfc_desc (gfc_array_void *d,
*** 76,86 ****
        GFC_DESCRIPTOR_STRIDE(d, n) = (index_type)(s->dim[n].sm / s->elem_len);
        d->offset -= GFC_DESCRIPTOR_STRIDE(d, n) * GFC_DESCRIPTOR_LBOUND(d, n);
      }
- 
- finish:
-   if (s)
-     free (s);
-   s = NULL;
  }
  
  extern void gfc_desc_to_cfi_desc (CFI_cdesc_t **, const gfc_array_void *);
--- 77,82 ----
*************** gfc_desc_to_cfi_desc (CFI_cdesc_t **d_pt
*** 95,102 ****
    /* Play it safe with allocation of the flexible array member 'dim'
       by setting the length to CFI_MAX_RANK. This should not be necessary
       but valgrind complains accesses after the allocated block.  */
!   d = malloc (sizeof (CFI_cdesc_t)
  		+ (CFI_type_t)(CFI_MAX_RANK * sizeof (CFI_dim_t)));
  
    d->base_addr = GFC_DESCRIPTOR_DATA (s);
    d->elem_len = GFC_DESCRIPTOR_SIZE (s);
--- 91,101 ----
    /* Play it safe with allocation of the flexible array member 'dim'
       by setting the length to CFI_MAX_RANK. This should not be necessary
       but valgrind complains accesses after the allocated block.  */
!   if (*d_ptr == NULL)
!     d = malloc (sizeof (CFI_cdesc_t)
  		+ (CFI_type_t)(CFI_MAX_RANK * sizeof (CFI_dim_t)));
+   else
+     d = *d_ptr;
  
    d->base_addr = GFC_DESCRIPTOR_DATA (s);
    d->elem_len = GFC_DESCRIPTOR_SIZE (s);
*************** gfc_desc_to_cfi_desc (CFI_cdesc_t **d_pt
*** 115,121 ****
      d->type = (CFI_type_t)(d->type
  		+ ((CFI_type_t)d->elem_len << CFI_type_kind_shift));
  
!   /* Full pointer or allocatable arrays have zero lower_bound.  */
    for (n = 0; n < GFC_DESCRIPTOR_RANK (s); n++)
      {
        if (d->attribute != CFI_attribute_other)
--- 114,120 ----
      d->type = (CFI_type_t)(d->type
  		+ ((CFI_type_t)d->elem_len << CFI_type_kind_shift));
  
!   /* Full pointer or allocatable arrays retain their lower_bounds.  */
    for (n = 0; n < GFC_DESCRIPTOR_RANK (s); n++)
      {
        if (d->attribute != CFI_attribute_other)
*************** gfc_desc_to_cfi_desc (CFI_cdesc_t **d_pt
*** 134,140 ****
        d->dim[n].sm = (CFI_index_t)(GFC_DESCRIPTOR_STRIDE(s, n) * s->span);
      }
  
!   *d_ptr = d;
  }
  
  void *CFI_address (const CFI_cdesc_t *dv, const CFI_index_t subscripts[])
--- 133,140 ----
        d->dim[n].sm = (CFI_index_t)(GFC_DESCRIPTOR_STRIDE(s, n) * s->span);
      }
  
!   if (*d_ptr == NULL)
!     *d_ptr = d;
  }
  
  void *CFI_address (const CFI_cdesc_t *dv, const CFI_index_t subscripts[])
*************** int CFI_is_contiguous (const CFI_cdesc_t
*** 416,422 ****
        if (dv == NULL)
  	{
  	  fprintf (stderr, "CFI_is_contiguous: C descriptor is NULL.\n");
! 	  return CFI_INVALID_DESCRIPTOR;
  	}
  
        /* Base address must not be NULL. */
--- 416,422 ----
        if (dv == NULL)
  	{
  	  fprintf (stderr, "CFI_is_contiguous: C descriptor is NULL.\n");
! 	  return 0;
  	}
  
        /* Base address must not be NULL. */
*************** int CFI_is_contiguous (const CFI_cdesc_t
*** 424,430 ****
  	{
  	  fprintf (stderr, "CFI_is_contiguous: Base address of C Descriptor "
  		   "is already NULL.\n");
! 	  return CFI_ERROR_BASE_ADDR_NULL;
  	}
  
        /* Must be an array. */
--- 424,430 ----
  	{
  	  fprintf (stderr, "CFI_is_contiguous: Base address of C Descriptor "
  		   "is already NULL.\n");
! 	  return 0;
  	}
  
        /* Must be an array. */
*************** int CFI_is_contiguous (const CFI_cdesc_t
*** 432,444 ****
  	{
  	  fprintf (stderr, "CFI_is_contiguous: C Descriptor must describe an "
  		   "array (0 < dv->rank = %d).\n", dv->rank);
! 	  return CFI_INVALID_RANK;
  	}
      }
  
    /* Assumed size arrays are always contiguous.  */
    if (dv->rank > 0 && dv->dim[dv->rank - 1].extent == -1)
!     return CFI_SUCCESS;
  
    /* If an array is not contiguous the memory stride is different to the element
     * length. */
--- 432,444 ----
  	{
  	  fprintf (stderr, "CFI_is_contiguous: C Descriptor must describe an "
  		   "array (0 < dv->rank = %d).\n", dv->rank);
! 	  return 0;
  	}
      }
  
    /* Assumed size arrays are always contiguous.  */
    if (dv->rank > 0 && dv->dim[dv->rank - 1].extent == -1)
!     return 1;
  
    /* If an array is not contiguous the memory stride is different to the element
     * length. */
*************** int CFI_is_contiguous (const CFI_cdesc_t
*** 447,461 ****
        if (i == 0 && dv->dim[i].sm == (CFI_index_t)dv->elem_len)
  	continue;
        else if (i > 0
! 	       && dv->dim[i].sm == (CFI_index_t)(dv->elem_len
  				   * dv->dim[i - 1].extent))
  	continue;
  
!       return CFI_FAILURE;
      }
  
    /* Array sections are guaranteed to be contiguous by the previous test.  */
!   return CFI_SUCCESS;
  }
  
  
--- 447,461 ----
        if (i == 0 && dv->dim[i].sm == (CFI_index_t)dv->elem_len)
  	continue;
        else if (i > 0
! 	       && dv->dim[i].sm == (CFI_index_t)(dv->dim[i - 1].sm
  				   * dv->dim[i - 1].extent))
  	continue;
  
!       return 0;
      }
  
    /* Array sections are guaranteed to be contiguous by the previous test.  */
!   return 1;
  }
  
  
*************** int CFI_section (CFI_cdesc_t *result, co
*** 670,676 ****
  	}
        int idx = i - aux;
        result->dim[idx].lower_bound = lower[i];
!       result->dim[idx].extent = upper[i] - lower[i] + 1;
        result->dim[idx].sm = stride[i] * source->dim[i].sm;
        /* Adjust 'lower' for the base address offset.  */
        lower[idx] = lower[idx] - source->dim[i].lower_bound;
--- 670,676 ----
  	}
        int idx = i - aux;
        result->dim[idx].lower_bound = lower[i];
!       result->dim[idx].extent = 1 + (upper[i] - lower[i])/stride[i];
        result->dim[idx].sm = stride[i] * source->dim[i].sm;
        /* Adjust 'lower' for the base address offset.  */
        lower[idx] = lower[idx] - source->dim[i].lower_bound;
