2019-02-23 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/89385
	PR fortran/89366
	* decl.c (gfc_verify_c_interop_param): Restriction on string
	length being one is lifted for F2018.
	* trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): For scalar
	characters with intent in, make a temporary and copy the result
	of the expression evaluation into it.
	(gfc_conv_procedure_call): Set a flag for character formal args
	having a character length that is not unity. If the procedure
	is bind C, call gfc_conv_gfc_desc_to_cfi_desc in this case.
	Also, extend bind C calls to unconditionally convert both
	pointers and allocatable expressions.

2019-02-23  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/89385
	* gfortran.dg/ISO_Fortran_binding_1.f90 : Correct test for
	previously incorrect lbound for allocatable expressions. Also
	correct stop values to avoid repetition.
	* gfortran.dg/ISO_Fortran_binding_5.f90 : New test
	* gfortran.dg/ISO_Fortran_binding_5.c : Support previous test.

	PR fortran/89366
	* gfortran.dg/ISO_Fortran_binding_6.f90 : New test
	* gfortran.dg/ISO_Fortran_binding_6.c : Support previous test.
	* gfortran.dg/pr32599.f03 : Set standard to F2008.

2019-02-23  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/89385
	PR fortran/89366
	* runtime/ISO_Fortran_binding.c (cfi_desc_to_gfc_desc) : In the
	interchange between character and derived, the character type
	was being set incorrectly.
	(gfc_desc_to_cfi_desc) : Eliminate the interchange of types in
	this function. Do not add the kind and length information to
	the type field of structures. Lbounds were incorrectly being
	set to zero for allocatable and pointer descriptors. Should
	have been non-pointer, non-allocatables that received this
	treatment.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@269156 138bc75d-0d04-0410-961f-82ee72b054a4

12 files changed, 296 insertions, 28 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 054936b6886f..3b5028cd0c2b 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,18 @@
+2019-02-23  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/89385
+	PR fortran/89366
+	* decl.c (gfc_verify_c_interop_param): Restriction on string
+	length being one is lifted for F2018.
+	* trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): For scalar
+	characters with intent in, make a temporary and copy the result
+	of the expression evaluation into it.
+	(gfc_conv_procedure_call): Set a flag for character formal args
+	having a character length that is not unity. If the procedure
+	is bind C, call gfc_conv_gfc_desc_to_cfi_desc in this case.
+	Also, extend bind C calls to unconditionally convert both
+	pointers and allocatable expressions.
+
 2019-02-23  David Malcolm  <dmalcolm@redhat.com>
 	    Jakub Jelinek  <jakub@redhat.com>
 
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 9d6aa7d25c64..3c8c5ffaaaa1 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1499,12 +1499,13 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
 	      if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT
                   || mpz_cmp_si (cl->length->value.integer, 1) != 0)
 		{
-		  gfc_error ("Character argument %qs at %L "
-			     "must be length 1 because "
-                             "procedure %qs is BIND(C)",
-			     sym->name, &sym->declared_at,
-                             sym->ns->proc_name->name);
-		  retval = false;
+		  if (!gfc_notify_std (GFC_STD_F2018,
+				       "Character argument %qs at %L "
+				       "must be length 1 because "
+				       "procedure %qs is BIND(C)",
+				       sym->name, &sym->declared_at,
+				       sym->ns->proc_name->name))
+		    retval = false;
 		}
 	    }
 
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 223fd14cd7b9..cff3d7c2930f 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -5012,6 +5012,8 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
 				gfc_conv_descriptor_data_get (parmse->expr),
 				size);
 	  gfc_add_expr_to_block (&parmse->pre, tmp);
+
+	  /* The temporary 'ptr' is freed below.  */
 	  gfc_conv_descriptor_data_set (&parmse->pre, parmse->expr, ptr);
 	}
 
@@ -5026,7 +5028,26 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
 
       /* Copy the scalar for INTENT(IN).  */
       if (e->expr_type == EXPR_VARIABLE && fsym->attr.intent == INTENT_IN)
-	parmse->expr = gfc_evaluate_now (parmse->expr, &parmse->pre);
+	{
+	  if (e->ts.type != BT_CHARACTER)
+	    parmse->expr = gfc_evaluate_now (parmse->expr, &parmse->pre);
+	  else
+	    {
+	      /* The temporary string 'ptr' is freed below.  */
+	      tmp = build_pointer_type (TREE_TYPE (parmse->expr));
+	      ptr = gfc_create_var (tmp, "str");
+	      tmp = build_call_expr_loc (input_location,
+				 builtin_decl_explicit (BUILT_IN_MALLOC),
+				 1, parmse->string_length);
+	      tmp = fold_convert (TREE_TYPE (ptr), tmp);
+	      gfc_add_modify (&parmse->pre, ptr, tmp);
+	      tmp = gfc_build_memcpy_call (ptr, parmse->expr,
+					   parmse->string_length);
+	      gfc_add_expr_to_block (&parmse->pre, tmp);
+	      parmse->expr = ptr;
+	    }
+	}
+
       parmse->expr = gfc_conv_scalar_to_descriptor (parmse,
 						    parmse->expr, attr);
     }
@@ -5188,11 +5209,18 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
        arg = arg->next, formal = formal ? formal->next : NULL, ++argc)
     {
       bool finalized = false;
+      bool non_unity_length_string = false;
 
       e = arg->expr;
       fsym = formal ? formal->sym : NULL;
       parm_kind = MISSING;
 
+      if (fsym && fsym->ts.type == BT_CHARACTER && fsym->ts.u.cl
+	  && (!fsym->ts.u.cl->length
+	      || fsym->ts.u.cl->length->expr_type != EXPR_CONSTANT
+	      || mpz_cmp_si (fsym->ts.u.cl->length->value.integer, 1) != 0))
+	non_unity_length_string = true;
+
       /* If the procedure requires an explicit interface, the actual
 	 argument is passed according to the corresponding formal
 	 argument.  If the corresponding formal argument is a POINTER,
@@ -5418,9 +5446,12 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		}
 
 	      else if (sym->attr.is_bind_c && e
-		       && fsym && fsym->attr.dimension
-		       && (fsym->as->type == AS_ASSUMED_RANK
-			   || fsym->as->type == AS_ASSUMED_SHAPE))
+		       && ((fsym && fsym->attr.dimension
+			    && (fsym->attr.pointer
+				|| fsym->attr.allocatable
+				|| fsym->as->type == AS_ASSUMED_RANK
+				|| fsym->as->type == AS_ASSUMED_SHAPE))
+			   || non_unity_length_string))
 		/* Implement F2018, C.12.6.1: paragraph (2).  */
 		gfc_conv_gfc_desc_to_cfi_desc (&parmse, e, fsym);
 
@@ -5865,8 +5896,11 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 
 	      if (sym->attr.is_bind_c && e
 		  && fsym && fsym->attr.dimension
-		  && (fsym->as->type == AS_ASSUMED_RANK
-		      || fsym->as->type == AS_ASSUMED_SHAPE))
+		  && (fsym->attr.pointer
+		      || fsym->attr.allocatable
+		      || fsym->as->type == AS_ASSUMED_RANK
+		      || fsym->as->type == AS_ASSUMED_SHAPE
+		      || non_unity_length_string))
 		/* Implement F2018, C.12.6.1: paragraph (2).  */
 		gfc_conv_gfc_desc_to_cfi_desc (&parmse, e, fsym);
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 4751104d1062..0d1cdecd6df7 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,17 @@
+2019-02-23  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/89385
+	* gfortran.dg/ISO_Fortran_binding_1.f90 : Correct test for
+	previously incorrect lbound for allocatable expressions. Also
+	correct stop values to avoid repetition.
+	* gfortran.dg/ISO_Fortran_binding_5.f90 : New test
+	* gfortran.dg/ISO_Fortran_binding_5.c : Support previous test.
+
+	PR fortran/89366
+	* gfortran.dg/ISO_Fortran_binding_6.f90 : New test
+	* gfortran.dg/ISO_Fortran_binding_6.c : Support previous test.
+	* gfortran.dg/pr32599.f03 : Set standard to F2008.
+
 2019-02-22  David Malcolm  <dmalcolm@redhat.com>
 
 	PR c++/89390
diff --git a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.f90 b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.f90
index 4a11e22884fc..e12b3a06e41f 100644
--- a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.f90
+++ b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.f90
@@ -192,7 +192,9 @@ end subroutine test_CFI_address
     a = [(real(i), i = 1, 100)]
     lower(1) = 10
     strides(1) = 5
-    if (int (sum(a(lower(1)::strides(1))) &
+! Remember, 'a' being non pointer, non-allocatable, the C descriptor
+! lbounds are set to zero.
+    if (int (sum(a(lower(1)+1::strides(1))) &
              - c_section(1, a, lower, strides)) .ne. 0) stop 28
 ! Case (ii) from F2018:18.5.5.7.
     arg(:,1:10) = reshape ([(real(i), i = 1, 100)], [10,10])
@@ -222,7 +224,7 @@ end subroutine test_CFI_address
       end do
     end do
 ! Now do the test.
-    if (int (c_select_part (type_t) - sum_z_5) .ne. 0) stop 28
+    if (int (c_select_part (type_t) - sum_z_5) .ne. 0) stop 30
   end subroutine test_CFI_select_part
 
   subroutine test_CFI_setpointer
@@ -232,13 +234,13 @@ end subroutine test_CFI_address
     integer, dimension(2) :: lbounds = [-1, -2]
 ! The C-function resets the lbounds
     ptr(1:, 1:) => tgt
-    if (c_setpointer (ptr, lbounds) .ne. 0) stop 30
-    if (any (lbound(ptr) .ne. lbounds)) stop 31
+    if (c_setpointer (ptr, lbounds) .ne. 0) stop 31
+    if (any (lbound(ptr) .ne. lbounds)) stop 32
   end subroutine test_CFI_setpointer
 
   subroutine test_assumed_size (arg)
     integer, dimension(2,*) :: arg
 ! The C-function checks contiguousness and that extent[1] == -1.
-    if (c_assumed_size (arg) .ne. 0) stop 32
+    if (c_assumed_size (arg) .ne. 0) stop 33
   end subroutine
 end
diff --git a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_5.c b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_5.c
new file mode 100644
index 000000000000..116f548ad99e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_5.c
@@ -0,0 +1,83 @@
+/* Test fix for PR89385.  */
+
+/* Contributed by Reinhold Bader  <Bader@lrz.de>  */
+
+#include <stdio.h>
+#include <math.h>
+#include "ISO_Fortran_binding.h"
+
+typedef struct {
+  int i;
+  float r[2];
+} cstruct;
+
+
+void Psub(CFI_cdesc_t *this, CFI_cdesc_t *that, int *ierr) {
+    int status = 0;
+    cstruct *cu;
+    float *ct;
+    CFI_dim_t *dim;
+    if (this->elem_len != sizeof(float)) {
+	printf("FAIL: this->elem_len %i\n",(int) this->elem_len);
+	status++;
+    }
+    if (this->type != CFI_type_float) {
+	printf("FAIL: this->type\n");
+	status++;
+    }
+    if (this->rank != 2) {
+	printf("FAIL: this->rank %i\n",this->rank);
+	status++;
+    }
+    if (this->attribute != CFI_attribute_allocatable) {
+	printf("FAIL: this->attribute\n");
+	status++;
+    }
+    dim = this->dim;
+    if (dim[0].lower_bound != 3 || dim[0].extent != 4)  {
+	printf("FAIL: dim[0] %d %d\n", dim[0].lower_bound, dim[0].extent);
+	status++;
+    }
+    if (dim[1].lower_bound != 1 || dim[1].extent != 5)  {
+	printf("FAIL: dim[1] %d %d\n", dim[1].lower_bound, dim[1].extent);
+	status++;
+    }
+
+    if (that->elem_len != sizeof(cstruct)) {
+	printf("FAIL: that->elem_len\n");
+	status++;
+    }
+    if (that->type != CFI_type_struct) {
+	printf("FAIL: that->type %d %d\n", that->type, CFI_type_struct);
+	status++;
+    }
+     if (that->rank != 1) {
+	printf("FAIL: that->rank\n");
+	status++;
+    }
+    if (that->attribute != CFI_attribute_allocatable) {
+	printf("FAIL: that->attribute\n");
+	status++;
+    }
+    dim = that->dim;
+    if (dim[0].lower_bound != 1 || dim[0].extent != 1)  {
+	printf("FAIL: dim[0] %d %d\n" , dim[0].lower_bound, dim[0].extent);
+	status++;
+    }
+    cu = (cstruct *) ((CFI_cdesc_t *) that)->base_addr;
+    if (cu->i != 4 || fabs(cu->r[1] -  2.2) > 1.0e-6) {
+	printf("FAIL: value of that %i %f %f\n",cu->i,cu->r[1],cu->r[2]);
+	status++;
+    }
+
+    ct = (float *) ((CFI_cdesc_t *) this)->base_addr;
+    if ( fabs(ct[5] +  2.0) > 1.0e-6) {
+	printf("FAIL: value of this %f\n",ct[5]);
+	status++;
+    }
+
+
+    *ierr = status;
+
+}
+
diff --git a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_5.f90 b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_5.f90
new file mode 100644
index 000000000000..97c2c5202bb2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_5.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+! { dg-additional-sources ISO_Fortran_binding_5.c }
+!
+! Test fix of PR89385.
+!
+! Contributed by Reinhold Bader  <Bader@lrz.de>
+!
+program allocatable_01
+  use, intrinsic :: iso_c_binding
+  implicit none
+  type, bind(c) :: cstruct
+     integer(c_int) :: i
+     real(c_float) :: r(2)
+  end type cstruct
+  interface
+     subroutine psub(this, that, ierr) bind(c, name='Psub')
+       import :: c_float, cstruct, c_int
+       real(c_float), allocatable :: this(:,:)
+       type(cstruct), allocatable :: that(:)
+       integer(c_int), intent(inout) :: ierr
+     end subroutine psub
+  end interface
+
+  real(c_float), allocatable :: t(:,:)
+  type(cstruct), allocatable :: u(:)
+  integer(c_int) :: ierr
+
+  allocate(t(3:6,5))
+  t = 0.0
+  t(4,2) = -2.0
+  allocate(u(1), source=[ cstruct( 4, [1.1,2.2] ) ] )
+  call psub(t, u, ierr)
+
+  deallocate(t,u)
+  if (ierr .ne. 0) stop ierr
+end program allocatable_01
diff --git a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_6.c b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_6.c
new file mode 100644
index 000000000000..704b27cb28a4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_6.c
@@ -0,0 +1,23 @@
+/* Test fix for PR89366.  */
+
+/* Contributed by Reinhold Bader  <Bader@lrz.de>  */
+
+#include <stdio.h>
+#include <math.h>
+#include "ISO_Fortran_binding.h"
+
+#define DEBUG 0
+
+void process_string(CFI_cdesc_t *this, int *ierr) {
+  char *cstr;
+  cstr = (char *) this->base_addr;
+  *ierr = 0;
+  if (this->rank != 0) {
+    *ierr = 1;
+    return;
+  }
+  if (DEBUG == 1) {
+    printf("elem_len member has value %i %s\n",this->elem_len, cstr);
+  }
+
+}
diff --git a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_6.f90 b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_6.f90
new file mode 100644
index 000000000000..a5b34be62d86
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_6.f90
@@ -0,0 +1,41 @@
+! { dg-do run }
+! { dg-additional-sources ISO_Fortran_binding_6.c }
+!
+! Test fix of PR89366.
+!
+! Contributed by Reinhold Bader  <Bader@lrz.de>
+!
+program assumed_length_01
+  use, intrinsic :: iso_c_binding
+  implicit none
+  integer, parameter :: strlen = 12
+  integer(c_int) :: ierr(3)
+  character(kind=c_char,len=strlen) :: s1
+  character(kind=c_char,len=:), allocatable :: s2
+  character(kind=c_char,len=:), pointer :: s3
+!
+! invoke a C function that processes an assumed length string
+  interface
+     subroutine process_string(this, ierr) BIND(C)
+       import :: c_char, c_int
+       character(kind=c_char,len=*), intent(in) :: this(..)
+       integer(c_int), intent(inout) :: ierr
+     end subroutine process_string
+  end interface
+!
+!
+  ierr = 0
+  s1 = c_char_'wrzlprmft' // c_null_char
+  call process_string(s1, ierr(1))
+  if (ierr(1) /= 0) stop 1
+  s2 = c_char_'wrzlprmft' // c_null_char
+  allocate(s3, source=trim(s1))
+  call process_string(s2, ierr(2))
+  if (ierr(2) /= 0) stop 2
+  call process_string(s3, ierr(3))
+  if (ierr(3) /= 0) stop 3
+  if (sum(abs(ierr)) == 0) write(*,*) 'OK'
+
+  deallocate(s2,s3)
+
+end program assumed_length_01
diff --git a/gcc/testsuite/gfortran.dg/pr32599.f03 b/gcc/testsuite/gfortran.dg/pr32599.f03
index fa8aa68f9289..297b75a7444a 100644
--- a/gcc/testsuite/gfortran.dg/pr32599.f03
+++ b/gcc/testsuite/gfortran.dg/pr32599.f03
@@ -1,26 +1,30 @@
 ! { dg-do compile }
+! { dg-options "-std=f2008" }
+!
 ! PR fortran/32599
-! Verifies that character string arguments to a bind(c) procedure have length 
-! 1, or no len is specified.  
+! Verifies that character string arguments to a bind(c) procedure have length
+! 1, or no len is specified. Note that the C interop extensions in F2018 allow
+! string arguments of length greater than one to be passed to a C descriptor.
+!
 module pr32599
   interface
      subroutine destroy(path) BIND(C) ! { dg-error "must be length 1" }
        use iso_c_binding
        implicit none
-       character(len=*,kind=c_char), intent(IN) :: path 
+       character(len=*,kind=c_char), intent(IN) :: path
      end subroutine destroy
 
      subroutine create(path) BIND(C) ! { dg-error "must be length 1" }
        use iso_c_binding
        implicit none
-       character(len=5,kind=c_char), intent(IN) :: path 
+       character(len=5,kind=c_char), intent(IN) :: path
      end subroutine create
 
      ! This should be valid.
      subroutine create1(path) BIND(C)
        use iso_c_binding
        implicit none
-       character(len=1,kind=c_char), intent(IN) :: path 
+       character(len=1,kind=c_char), intent(IN) :: path
      end subroutine create1
 
      ! This should be valid.
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 9c72dfe9f588..d0a3962ba29a 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,17 @@
+2019-02-23  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/89385
+	PR fortran/89366
+	* runtime/ISO_Fortran_binding.c (cfi_desc_to_gfc_desc) : In the
+	interchange between character and derived, the character type
+	was being set incorrectly.
+	(gfc_desc_to_cfi_desc) : Eliminate the interchange of types in
+	this function. Do not add the kind and length information to
+	the type field of structures. Lbounds were incorrectly being
+	set to zero for allocatable and pointer descriptors. Should
+	have been non-pointer, non-allocatables that received this
+	treatment.
+
 2019-01-30  Uroš Bizjak  <ubizjak@gmail.com>
 
 	PR libfortran/88678
@@ -47,7 +61,7 @@
 
 	PR libfortran/88776
 	* io/open.c (newunit): Free format buffer if the unit specified is for
-	stdin, stdout, or stderr. 
+	stdin, stdout, or stderr.
 
 2019-01-12  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
diff --git a/libgfortran/runtime/ISO_Fortran_binding.c b/libgfortran/runtime/ISO_Fortran_binding.c
index 4161a748b910..6b7b10fb8362 100644
--- a/libgfortran/runtime/ISO_Fortran_binding.c
+++ b/libgfortran/runtime/ISO_Fortran_binding.c
@@ -59,7 +59,7 @@ cfi_desc_to_gfc_desc (gfc_array_void *d, CFI_cdesc_t **s_ptr)
   if (GFC_DESCRIPTOR_TYPE (d) == BT_CHARACTER)
     GFC_DESCRIPTOR_TYPE (d) = BT_DERIVED;
   else if (GFC_DESCRIPTOR_TYPE (d) == BT_DERIVED)
-    GFC_DESCRIPTOR_TYPE (d) = BT_DERIVED;
+    GFC_DESCRIPTOR_TYPE (d) = BT_CHARACTER;
 
   d->dtype.attribute = (signed short)s->attribute;
 
@@ -105,19 +105,20 @@ gfc_desc_to_cfi_desc (CFI_cdesc_t **d_ptr, const gfc_array_void *s)
   d->attribute = (CFI_attribute_t)s->dtype.attribute;
 
   if (GFC_DESCRIPTOR_TYPE (s) == BT_CHARACTER)
-    d->type = CFI_type_struct;
-  else if (GFC_DESCRIPTOR_TYPE (s) == BT_DERIVED)
     d->type = CFI_type_Character;
+  else if (GFC_DESCRIPTOR_TYPE (s) == BT_DERIVED)
+    d->type = CFI_type_struct;
   else
     d->type = (CFI_type_t)GFC_DESCRIPTOR_TYPE (s);
 
-  d->type = (CFI_type_t)(d->type
+  if (GFC_DESCRIPTOR_TYPE (s) != BT_DERIVED)
+    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)
+      if (d->attribute != CFI_attribute_other)
 	d->dim[n].lower_bound = (CFI_index_t)GFC_DESCRIPTOR_LBOUND(s, n);
       else
 	d->dim[n].lower_bound = 0;