From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 31934 invoked by alias); 11 Nov 2008 21:05:03 -0000 Received: (qmail 31821 invoked by uid 22791); 11 Nov 2008 21:05:00 -0000 X-Spam-Check-By: sourceware.org Received: from mx1.redhat.com (HELO mx1.redhat.com) (66.187.233.31) by sourceware.org (qpsmtpd/0.31) with ESMTP; Tue, 11 Nov 2008 21:04:23 +0000 Received: from int-mx1.corp.redhat.com (int-mx1.corp.redhat.com [172.16.52.254]) by mx1.redhat.com (8.13.8/8.13.8) with ESMTP id mABL1a3w010965; Tue, 11 Nov 2008 16:01:36 -0500 Received: from tyan-ft48-01.lab.bos.redhat.com (tyan-ft48-01.lab.bos.redhat.com [10.16.42.4]) by int-mx1.corp.redhat.com (8.13.1/8.13.1) with ESMTP id mABL1aW0018082; Tue, 11 Nov 2008 16:01:36 -0500 Received: (from jakub@localhost) by tyan-ft48-01.lab.bos.redhat.com (8.14.2/8.14.2/Submit) id mABL1Zkp012078; Tue, 11 Nov 2008 22:01:35 +0100 Date: Tue, 11 Nov 2008 21:38:00 -0000 From: Jakub Jelinek To: Brooks Moses Cc: Tobias Burnus , gcc-patches@gcc.gnu.org, fortran@gcc.gnu.org Subject: Re: [PATCH] Fold VIEW_CONVERT_EXPR generated by Fortran FE a lot (PR target/35366) Message-ID: <20081111210135.GJ3572@tyan-ft48-01.lab.bos.redhat.com> Reply-To: Jakub Jelinek References: <20081111131749.GZ3572@tyan-ft48-01.lab.bos.redhat.com> <4919A8A4.8000001@physik.uni-muenchen.de> <20081111161100.GE3572@tyan-ft48-01.lab.bos.redhat.com> <4919B110.6060400@physik.uni-muenchen.de> <20081111165200.GF3572@tyan-ft48-01.lab.bos.redhat.com> <4919BA80.3060602@physik.uni-muenchen.de> <20081111174931.GG3572@tyan-ft48-01.lab.bos.redhat.com> <4919DB52.4070609@net-b.de> <4919E2F1.5040507@codesourcery.com> MIME-Version: 1.0 Content-Type: text/plain; charset=us-ascii Content-Disposition: inline In-Reply-To: <4919E2F1.5040507@codesourcery.com> User-Agent: Mutt/1.5.18 (2008-05-17) X-IsSubscribed: yes Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org X-SW-Source: 2008-11/txt/msg00476.txt.bz2 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 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