re PR target/35366 (gfortran.dg/equiv_7.f90 fails with -m64 -Os on powerpc-apple-darwin9)

PR target/35366
	PR fortran/33759
	* fold-const.c (native_encode_string): New function.
	(native_encode_expr): Use it for STRING_CST.

	* trans-const.c (gfc_conv_constant_to_tree): Warn when
	converting an integer outside of LOGICAL's range to
	LOGICAL.
	* trans-intrinsic.c (gfc_conv_intrinsic_function,
	gfc_conv_intrinsic_array_transfer, gfc_conv_intrinsic_transfer):
	Use INTEGER_TYPE instead of BOOLEAN_TYPE for TRANSFER as
	argument of another TRANSFER.

	* gfortran.dg/hollerith.f90: Don't assume a 32-bit value
	stored into logical variable will be preserved.
	* gfortran.dg/transfer_simplify_4.f90: Remove undefined
	cases.  Run at all optimization levels.  Add a couple of
	new tests.
	* gfortran.dg/hollerith5.f90: New test.
	* gfortran.dg/hollerith_legacy.f90: Add dg-warning.

From-SVN: r141790

gcc/ChangeLog

@@ -1,3 +1,9 @@
+2008-11-12  Jakub Jelinek  <jakub@redhat.com>
+
+	PR target/35366
+	* fold-const.c (native_encode_string): New function.
+	(native_encode_expr): Use it for STRING_CST.
+
 2008-11-12  DJ Delorie  <dj@redhat.com>
 
 	* config/m32c/cond.md (cond_to_int peephole2): Don't eliminate the

gcc/fold-const.c

@@ -7315,6 +7315,37 @@ native_encode_vector (const_tree expr, unsigned char *ptr, int len)
 }
 
 
+/* Subroutine of native_encode_expr.  Encode the STRING_CST
+   specified by EXPR into the buffer PTR of length LEN bytes.
+   Return the number of bytes placed in the buffer, or zero
+   upon failure.  */
+
+static int
+native_encode_string (const_tree expr, unsigned char *ptr, int len)
+{
+  tree type = TREE_TYPE (expr);
+  HOST_WIDE_INT total_bytes;
+
+  if (TREE_CODE (type) != ARRAY_TYPE
+      || TREE_CODE (TREE_TYPE (type)) != INTEGER_TYPE
+      || GET_MODE_BITSIZE (TYPE_MODE (TREE_TYPE (type))) != BITS_PER_UNIT
+      || !host_integerp (TYPE_SIZE_UNIT (type), 0))
+    return 0;
+  total_bytes = tree_low_cst (TYPE_SIZE_UNIT (type), 0);
+  if (total_bytes > len)
+    return 0;
+  if (TREE_STRING_LENGTH (expr) < total_bytes)
+    {
+      memcpy (ptr, TREE_STRING_POINTER (expr), TREE_STRING_LENGTH (expr));
+      memset (ptr + TREE_STRING_LENGTH (expr), 0,
+	      total_bytes - TREE_STRING_LENGTH (expr));
+    }
+  else
+    memcpy (ptr, TREE_STRING_POINTER (expr), total_bytes);
+  return total_bytes;
+}
+
+
 /* Subroutine of fold_view_convert_expr.  Encode the INTEGER_CST,
    REAL_CST, COMPLEX_CST or VECTOR_CST specified by EXPR into the
    buffer PTR of length LEN bytes.  Return the number of bytes
@@ -7337,6 +7368,9 @@ native_encode_expr (const_tree expr, unsigned char *ptr, int len)
     case VECTOR_CST:
       return native_encode_vector (expr, ptr, len);
 
+    case STRING_CST:
+      return native_encode_string (expr, ptr, len);
+
     default:
       return 0;
     }

gcc/fortran/ChangeLog

@@ -1,3 +1,15 @@
+2008-11-12  Jakub Jelinek  <jakub@redhat.com>
+
+	PR target/35366
+	PR fortran/33759
+	* trans-const.c (gfc_conv_constant_to_tree): Warn when
+	converting an integer outside of LOGICAL's range to
+	LOGICAL.
+	* trans-intrinsic.c (gfc_conv_intrinsic_function,
+	gfc_conv_intrinsic_array_transfer, gfc_conv_intrinsic_transfer):
+	Use INTEGER_TYPE instead of BOOLEAN_TYPE for TRANSFER as
+	argument of another TRANSFER.
+
 2008-11-12  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/38065

gcc/fortran/trans-const.c

@@ -281,13 +281,19 @@ gfc_conv_constant_to_tree (gfc_expr * expr)
 
     case BT_LOGICAL:
       if (expr->representation.string)
-	return fold_build1 (VIEW_CONVERT_EXPR,
+	{
-			    gfc_get_logical_type (expr->ts.kind),
+	  tree tmp = fold_build1 (VIEW_CONVERT_EXPR,
-			    gfc_build_string_const (expr->representation.length,
+				  gfc_get_int_type (expr->ts.kind),
-						    expr->representation.string));
+				  gfc_build_string_const (expr->representation.length,
+							  expr->representation.string));
+	  if (!integer_zerop (tmp) && !integer_onep (tmp))
+	    gfc_warning ("Assigning value other than 0 or 1 to LOGICAL"
+			 " has undefined result at %L", &expr->where);
+	  return fold_convert (gfc_get_logical_type (expr->ts.kind), tmp);
+	}
       else
 	return build_int_cst (gfc_get_logical_type (expr->ts.kind),
-			    expr->value.logical);
+			      expr->value.logical);
 
     case BT_COMPLEX:
       if (expr->representation.string)

gcc/fortran/trans-intrinsic.c

@@ -3707,6 +3707,14 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
       mold_type = gfc_get_element_type (TREE_TYPE (argse.expr));
     }
 
+  if (strcmp (expr->value.function.name, "__transfer_in_transfer") == 0)
+    {
+      /* If this TRANSFER is nested in another TRANSFER, use a type
+	 that preserves all bits.  */
+      if (arg->expr->ts.type == BT_LOGICAL)
+	mold_type = gfc_get_int_type (arg->expr->ts.kind);
+    }
+
   if (arg->expr->ts.type == BT_CHARACTER)
     {
       tmp = size_of_string_in_bytes (arg->expr->ts.kind, argse.string_length);
@@ -3835,6 +3843,13 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr)
 
   arg = arg->next;
   type = gfc_typenode_for_spec (&expr->ts);
+  if (strcmp (expr->value.function.name, "__transfer_in_transfer") == 0)
+    {
+      /* If this TRANSFER is nested in another TRANSFER, use a type
+	 that preserves all bits.  */
+      if (expr->ts.type == BT_LOGICAL)
+	type = gfc_get_int_type (expr->ts.kind);
+    }
 
   if (expr->ts.type == BT_CHARACTER)
     {
@@ -4750,20 +4765,30 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       break;
 
     case GFC_ISYM_TRANSFER:
-      if (se->ss)
+      if (se->ss && se->ss->useflags)
 	{
-	  if (se->ss->useflags)
+	  /* Access the previously obtained result.  */
-	    {
+	  gfc_conv_tmp_array_ref (se);
-	      /* Access the previously obtained result.  */
+	  gfc_advance_se_ss_chain (se);
-	      gfc_conv_tmp_array_ref (se);
-	      gfc_advance_se_ss_chain (se);
-	      break;
-	    }
-	  else
-	    gfc_conv_intrinsic_array_transfer (se, expr);
 	}
       else
-	gfc_conv_intrinsic_transfer (se, expr);
+	{
+	  /* Ensure double transfer through LOGICAL preserves all
+	     the needed bits.  */
+	  gfc_expr *source = expr->value.function.actual->expr;
+	  if (source->expr_type == EXPR_FUNCTION
+	      && source->value.function.esym == NULL
+	      && source->value.function.isym != NULL
+	      && source->value.function.isym->id == GFC_ISYM_TRANSFER
+	      && source->ts.type == BT_LOGICAL
+	      && expr->ts.type != source->ts.type)
+	    source->value.function.name = "__transfer_in_transfer";
+
+	  if (se->ss)
+	    gfc_conv_intrinsic_array_transfer (se, expr);
+	  else
+	    gfc_conv_intrinsic_transfer (se, expr);
+	}
       break;
 
     case GFC_ISYM_TTYNAM:

gcc/testsuite/ChangeLog

@@ -1,5 +1,15 @@
 2008-11-12  Jakub Jelinek  <jakub@redhat.com>
 
+	PR target/35366
+	PR fortran/33759
+	* gfortran.dg/hollerith.f90: Don't assume a 32-bit value
+	stored into logical variable will be preserved.
+	* gfortran.dg/transfer_simplify_4.f90: Remove undefined
+	cases.  Run at all optimization levels.  Add a couple of
+	new tests.
+	* gfortran.dg/hollerith5.f90: New test.
+	* gfortran.dg/hollerith_legacy.f90: Add dg-warning.
+
 	PR c++/35334
 	* gcc.dg/pr35334.c: New test.
 	* g++.dg/other/error29.C: New test.

gcc/testsuite/gfortran.dg/hollerith.f90

@@ -8,7 +8,7 @@ character z1(4)
 character*4 z2(2,2)
 character*80 line
 integer i
-logical l
+integer j
 real r
 character*8 c
 
@@ -20,15 +20,15 @@ data z2/4h(i7),'xxxx','xxxx','xxxx'/
 
 z2 (1,2) = 4h(i8)
 i = 4hHell
-l = 4Ho wo
+j = 4Ho wo
 r = 4Hrld! 
-write (line, '(3A4)') i, l, r
+write (line, '(3A4)') i, j, r
 if (line .ne. 'Hello world!') call abort
 i = 2Hab
+j = 2Hab
 r = 2Hab
-l = 2Hab
 c = 2Hab
-write (line, '(3A4, 8A)') i, l, r, c
+write (line, '(3A4, 8A)') i, j, r, c
 if (line .ne. 'ab  ab  ab  ab      ') call abort
 
 write(line, '(4A8, "!")' ) x

gcc/testsuite/gfortran.dg/hollerith5.f90

@@ -0,0 +1,8 @@
+       ! { dg-do compile }
+       implicit none
+       logical b
+       b = 4Habcd ! { dg-warning "has undefined result" }
+       end
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 4 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 4 }

gcc/testsuite/gfortran.dg/hollerith_legacy.f90

@@ -21,13 +21,13 @@ data z2/4h(i7),'xxxx','xxxx','xxxx'/
 
 z2 (1,2) = 4h(i8)
 i = 4hHell
-l = 4Ho wo
+l = 4Ho wo	! { dg-warning "has undefined result" }
 r = 4Hrld! 
 write (line, '(3A4)') i, l, r
 if (line .ne. 'Hello world!') call abort
 i = 2Hab
 r = 2Hab
-l = 2Hab
+l = 2Hab	! { dg-warning "has undefined result" }
 c = 2Hab
 write (line, '(3A4, 8A)') i, l, r, c
 if (line .ne. 'ab  ab  ab  ab      ') call abort

gcc/testsuite/gfortran.dg/transfer_simplify_4.f90

@@ -1,30 +1,39 @@
 ! { dg-do run }
-! { dg-options "-O0" }
 ! Tests that the in-memory representation of a transferred variable
 ! propagates properly.
 !
   implicit none
 
   integer, parameter :: ip1 = 42
-  logical, parameter :: ap1 = transfer(ip1, .true.)
+  integer, parameter :: ip2 = transfer(transfer(ip1, .true.), 0)
-  integer, parameter :: ip2 = transfer(ap1, 0)
+  integer :: i, ai(4)
+  logical :: b
 
-  logical :: a
+  if (ip2 .ne. ip1) call abort ()
-  integer :: i
   
   i = transfer(transfer(ip1, .true.), 0)
   if (i .ne. ip1) call abort ()
 
-  i = transfer(ap1, 0)
+  i = 42
-  if (i .ne. ip1) call abort ()
+  i = transfer(transfer(i, .true.), 0)
-  
-  a = transfer(ip1, .true.)
-  i = transfer(a, 0)
   if (i .ne. ip1) call abort ()
 
-  i = ip1
+  b = transfer(transfer(.true., 3.1415), .true.)
-  a = transfer(i, .true.)
+  if (.not.b) call abort ()
-  i = transfer(a, 0)
-  if (i .ne. ip1) call abort ()
 
+  b = transfer(transfer(.false., 3.1415), .true.)
+  if (b) call abort ()
+
+  i = 0
+  b = transfer(i, .true.)
+  ! The standard doesn't guarantee here that b will be .false.,
+  ! though in gfortran for all targets it will.
+
+  ai = (/ 42, 42, 42, 42 /)
+  ai = transfer (transfer (ai, .false., 4), ai)
+  if (any(ai .ne. 42)) call abort
+
+  ai = transfer (transfer ((/ 42, 42, 42, 42 /), &
+&                          (/ .false., .false., .false., .false. /)), ai)
+  if (any(ai .ne. 42)) call abort
 end