From patchwork Sun Oct 30 22:02:35 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Steve Kargl X-Patchwork-Id: 122688 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id EC03EB6F76 for ; Mon, 31 Oct 2011 09:02:56 +1100 (EST) Received: (qmail 5787 invoked by alias); 30 Oct 2011 22:02:52 -0000 Received: (qmail 5774 invoked by uid 22791); 30 Oct 2011 22:02:51 -0000 X-SWARE-Spam-Status: No, hits=-2.6 required=5.0 tests=AWL, BAYES_00, RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from troutmask.apl.washington.edu (HELO troutmask.apl.washington.edu) (128.95.76.21) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Sun, 30 Oct 2011 22:02:36 +0000 Received: from troutmask.apl.washington.edu (localhost.apl.washington.edu [127.0.0.1]) by troutmask.apl.washington.edu (8.14.5/8.14.5) with ESMTP id p9UM2alu040365; Sun, 30 Oct 2011 15:02:36 -0700 (PDT) (envelope-from sgk@troutmask.apl.washington.edu) Received: (from sgk@localhost) by troutmask.apl.washington.edu (8.14.5/8.14.5/Submit) id p9UM2ZVe040364; Sun, 30 Oct 2011 15:02:35 -0700 (PDT) (envelope-from sgk) Date: Sun, 30 Oct 2011 15:02:35 -0700 From: Steve Kargl To: Tobias Burnus Cc: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org Subject: Re: [PATCH] PR fortran/50573 -- Fix checking of dshift{lr} arguments Message-ID: <20111030220235.GA40305@troutmask.apl.washington.edu> References: <20111027232710.GA17693@troutmask.apl.washington.edu> <4EAA411E.6010700@net-b.de> Mime-Version: 1.0 Content-Disposition: inline In-Reply-To: <4EAA411E.6010700@net-b.de> User-Agent: Mutt/1.4.2.3i Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org On Fri, Oct 28, 2011 at 07:43:58AM +0200, Tobias Burnus wrote: > Am 28.10.2011 01:27, schrieb Steve Kargl: > >The attached patch tightens the checking of the arguments > >of the dshiftl and dshiftr argument. It also does a kind > >type conversion when either I or J is a BOZ to the kind > >type of the non-BOZ I or J. > > > >OK for trunk? > > OK with a changelog entry for the NEAREST change. And thanks for the patch. > > Could you also update the manual? > http://gcc.gnu.org/onlinedocs/gfortran/DSHIFTL.html > Here's the patch I committed. The NEAREST stuff was committed in a prevous commit, and I've updated the docs. 2011-10-30 Steven G. Kargl PR fortran/50573 * check.c (gfc_check_dshift): Update argument checking for BOZ. Update checking SHIFT against BITSIZE of I or J. * intrinsic.texi: Update docs for DSHIFTL and DSHIFTR. 2011-10-30 Steven G. Kargl PR fortran/50573 * gfortran.dg/dshift_3.f90: New test. Index: fortran/check.c =================================================================== --- fortran/check.c (revision 180622) +++ fortran/check.c (working copy) @@ -1483,7 +1483,14 @@ gfc_check_dshift (gfc_expr *i, gfc_expr if (type_check (j, 1, BT_INTEGER) == FAILURE) return FAILURE; - if (same_type_check (i, 0, j, 1) == FAILURE) + if (i->is_boz && j->is_boz) + { + gfc_error ("'I' at %L and 'J' at %L cannot both be BOZ literal " + "constants", &i->where, &j->where); + return FAILURE; + } + + if (!i->is_boz && !j->is_boz && same_type_check (i, 0, j, 1) == FAILURE) return FAILURE; if (type_check (shift, 2, BT_INTEGER) == FAILURE) @@ -1492,8 +1499,18 @@ gfc_check_dshift (gfc_expr *i, gfc_expr if (nonnegative_check ("SHIFT", shift) == FAILURE) return FAILURE; - if (less_than_bitsize1 ("I", i, "SHIFT", shift, true) == FAILURE) - return FAILURE; + if (i->is_boz) + { + if (less_than_bitsize1 ("J", j, "SHIFT", shift, true) == FAILURE) + return FAILURE; + i->ts.kind = j->ts.kind; + } + else + { + if (less_than_bitsize1 ("I", i, "SHIFT", shift, true) == FAILURE) + return FAILURE; + j->ts.kind = i->ts.kind; + } return SUCCESS; } Index: fortran/intrinsic.texi =================================================================== --- fortran/intrinsic.texi (revision 180622) +++ fortran/intrinsic.texi (working copy) @@ -3794,22 +3794,27 @@ Elemental function @item @emph{Arguments}: @multitable @columnfractions .15 .70 -@item @var{I} @tab Shall be of type @code{INTEGER}. -@item @var{J} @tab Shall be of type @code{INTEGER}, and of the same kind -as @var{I}. -@item @var{SHIFT} @tab Shall be of type @code{INTEGER}. +@item @var{I} @tab Shall be of type @code{INTEGER} or a BOZ constant. +@item @var{J} @tab Shall be of type @code{INTEGER} or a BOZ constant. +If both @var{I} and @var{J} have integer type, then they shall have +the same kind type parameter. @var{I} and @var{J} shall not both be +BOZ constants. +@item @var{SHIFT} @tab Shall be of type @code{INTEGER}. It shall +be nonnegative. If @var{I} is not a BOZ constant, then @var{SHIFT} +shall be less than or equal to @code{BIT_SIZE(I)}; otherwise, +@var{SHIFT} shall be less than or equal to @code{BIT_SIZE(J)}. @end multitable @item @emph{Return value}: -The return value has same type and kind as @var{I}. +If either @var{I} or @var{J} is a BOZ constant, it is first converted +as if by the intrinsic function @code{INT} to an integer type with the +kind type parameter of the other. @item @emph{See also}: @ref{DSHIFTR} - @end table - @node DSHIFTR @section @code{DSHIFTR} --- Combined right shift @fnindex DSHIFTR @@ -3834,22 +3839,27 @@ Elemental function @item @emph{Arguments}: @multitable @columnfractions .15 .70 -@item @var{I} @tab Shall be of type @code{INTEGER}. -@item @var{J} @tab Shall be of type @code{INTEGER}, and of the same kind -as @var{I}. -@item @var{SHIFT} @tab Shall be of type @code{INTEGER}. +@item @var{I} @tab Shall be of type @code{INTEGER} or a BOZ constant. +@item @var{J} @tab Shall be of type @code{INTEGER} or a BOZ constant. +If both @var{I} and @var{J} have integer type, then they shall have +the same kind type parameter. @var{I} and @var{J} shall not both be +BOZ constants. +@item @var{SHIFT} @tab Shall be of type @code{INTEGER}. It shall +be nonnegative. If @var{I} is not a BOZ constant, then @var{SHIFT} +shall be less than or equal to @code{BIT_SIZE(I)}; otherwise, +@var{SHIFT} shall be less than or equal to @code{BIT_SIZE(J)}. @end multitable @item @emph{Return value}: -The return value has same type and kind as @var{I}. +If either @var{I} or @var{J} is a BOZ constant, it is first converted +as if by the intrinsic function @code{INT} to an integer type with the +kind type parameter of the other. @item @emph{See also}: @ref{DSHIFTL} - @end table - @node DTIME @section @code{DTIME} --- Execution time subroutine (or function) @fnindex DTIME Index: testsuite/gfortran.dg/dshift_3.f90 =================================================================== --- testsuite/gfortran.dg/dshift_3.f90 (revision 0) +++ testsuite/gfortran.dg/dshift_3.f90 (revision 0) @@ -0,0 +1,34 @@ +! { dg-do compile } +! PR fortran/50753 +subroutine foo(i, j, k) + + implicit none + + integer(4), intent(in) :: i, j + integer(8), intent(in) :: k + + print *, dshiftl(i, j, 134) ! { dg-error "must be less than or equal" } + print *, dshiftl(z'FFF', j, 134) ! { dg-error "must be less than or equal" } + print *, dshiftl(i, j, -10) ! { dg-error "must be nonnegative" } + print *, dshiftl(z'FFF', z'EEE', 10) ! { dg-error "cannot both be" } + print *, dshiftl(z'FFF', j, 10) + print *, dshiftl(i, z'EEE', 10) + print *, dshiftl(i, j, 10) + print *, dshiftl(i, k, 10) ! { dg-error "must be the same type and kind" } + print *, dshiftl(k, j, 10) ! { dg-error "must be the same type and kind" } + print *, dshiftl(i, j, k) + print *, dshiftl(i, j, z'd') + + print *, dshiftr(i, j, 134) ! { dg-error "must be less than or equal" } + print *, dshiftr(z'FFF', j, 134) ! { dg-error "must be less than or equal" } + print *, dshiftr(i, j, -10) ! { dg-error "must be nonnegative" } + print *, dshiftr(z'FFF', z'EEE', 10) ! { dg-error "cannot both be" } + print *, dshiftr(z'FFF', j, 10) + print *, dshiftr(i, z'EEE', 10) + print *, dshiftr(i, j, 10) + print *, dshiftr(i, k, 10) ! { dg-error "must be the same type and kind" } + print *, dshiftr(k, j, 10) ! { dg-error "must be the same type and kind" } + print *, dshiftr(i, j, k) + print *, dshiftr(i, j, z'd') + +end subroutine foo