This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
Re: [PATCH] Fold VIEW_CONVERT_EXPR <type, STRING_CST> generated by Fortran FE a lot (PR target/35366)
On Tue, Nov 11, 2008 at 11:54:25AM -0800, Brooks Moses wrote:
> Tobias Burnus wrote, at 11/11/2008 11:21 AM:
> > The only real problem are Hollerith variables. Here, preserving the bit
> > pattern is crucial. As written before, I think the number of
> > still-in-use programs which use this Fortran-66-only features with
> > LOGICAL variables is very small. However, as (if?) they still exist,
> > some solution needs to be found.
> >
> > (My preferred solution is to stick by default to the current middle-end
> > representation any print a warning or error for assignments of Hollerith
> > constants to logical variables; having a compiler flag to uses
> > internally integer values instead of booleans would be a bonus [I don't
> > see ad hoc how much work this would be].)
>
> I agree. I can see no sensible reason why anyone would have combined
> Hollerith values with LOGICAL variables, and thus see no reason to
> suppose that such code exists. As such, I think it's reasonable to
> print an error if someone tries to do such a thing, and then not worry
> about implementations and compiler flags unless someone happens to
> complain about the error and provides a good reason why they can't
> change their code.
So would the following be acceptable? It will warn both for
logical l
l = 4Hfoob
and
l = transfer (42, .true.)
BTW, even the unmodified gfortran.dg/transfer_simplify_4.f90 tests
fails with vanilla 4.3 or trunk when compiled with -O1 and above,
so claiming we support all of those transfers that way and actually
supporting them only at -O0 is weird. The middle-end hunk hasn't
changed, so I only need Fortran approval...
2008-11-11 Jakub Jelinek <jakub@redhat.com>
PR target/35366
* 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.
* 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.
--- gcc/fold-const.c.jj 2008-10-29 18:49:06.000000000 +0100
+++ gcc/fold-const.c 2008-11-11 20:33:49.000000000 +0100
@@ -7315,6 +7315,37 @@ native_encode_vector (const_tree expr, u
}
+/* 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, uns
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/trans-const.c.jj 2008-09-30 16:56:44.000000000 +0200
+++ gcc/fortran/trans-const.c 2008-11-11 21:50:16.000000000 +0100
@@ -281,13 +281,25 @@ gfc_conv_constant_to_tree (gfc_expr * ex
case BT_LOGICAL:
if (expr->representation.string)
- return fold_build1 (VIEW_CONVERT_EXPR,
- gfc_get_logical_type (expr->ts.kind),
- gfc_build_string_const (expr->representation.length,
- expr->representation.string));
+ {
+ tree tmp = fold_build1 (VIEW_CONVERT_EXPR,
+ gfc_get_int_type (expr->ts.kind),
+ gfc_build_string_const (expr->representation.length,
+ expr->representation.string));
+ if (TREE_CODE (tmp) == INTEGER_CST)
+ {
+ if (!integer_zerop (tmp) && !integer_onep (tmp))
+ gfc_warning ("Assigning value other than 0 or 1 to LOGICAL"
+ " at %L has undefined result", &expr->where);
+ }
+ else
+ gfc_warning ("Assigning value other than 0 or 1 to LOGICAL"
+ " at %L might have undefined result", &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/testsuite/gfortran.dg/hollerith.f90.jj 2008-09-30 16:56:06.000000000 +0200
+++ gcc/testsuite/gfortran.dg/hollerith.f90 2008-11-11 13:52:38.000000000 +0100
@@ -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
r = 2Hab
-l = 2Hab
+j = 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/transfer_simplify_4.f90.jj 2008-09-30 16:56:06.000000000 +0200
+++ gcc/testsuite/gfortran.dg/transfer_simplify_4.f90 2008-11-11 21:39:07.000000000 +0100
@@ -6,25 +6,9 @@
implicit none
integer, parameter :: ip1 = 42
- logical, parameter :: ap1 = transfer(ip1, .true.)
- integer, parameter :: ip2 = transfer(ap1, 0)
-
- logical :: a
+ integer, parameter :: ip2 = transfer(transfer(ip1, .true.), 0)
integer :: i
i = transfer(transfer(ip1, .true.), 0)
if (i .ne. ip1) call abort ()
-
- i = transfer(ap1, 0)
- if (i .ne. ip1) call abort ()
-
- a = transfer(ip1, .true.)
- i = transfer(a, 0)
- if (i .ne. ip1) call abort ()
-
- i = ip1
- a = transfer(i, .true.)
- i = transfer(a, 0)
- if (i .ne. ip1) call abort ()
-
end
Jakub