From patchwork Thu Oct 27 23:27:10 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Steve Kargl X-Patchwork-Id: 122263 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 6D9451007D8 for ; Fri, 28 Oct 2011 10:27:35 +1100 (EST) Received: (qmail 3776 invoked by alias); 27 Oct 2011 23:27:32 -0000 Received: (qmail 3758 invoked by uid 22791); 27 Oct 2011 23:27:31 -0000 X-SWARE-Spam-Status: No, hits=-2.2 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; Thu, 27 Oct 2011 23:27:11 +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 p9RNRACx027008; Thu, 27 Oct 2011 16:27:10 -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 p9RNRAGa027002; Thu, 27 Oct 2011 16:27:10 -0700 (PDT) (envelope-from sgk) Date: Thu, 27 Oct 2011 16:27:10 -0700 From: Steve Kargl To: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org Subject: [PATCH] PR fortran/50573 -- Fix checking of dshift{lr} arguments Message-ID: <20111027232710.GA17693@troutmask.apl.washington.edu> Mime-Version: 1.0 Content-Disposition: inline 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 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? 2011-10-27 Steven G. Kargl PR fortran/50573 * check.c (gfc_check_dshift): Tighten the checks on I, J, and SHIFT. If I or J is a BOZ, convert to the kind type of the other. 2011-10-27 Steven G. Kargl PR fortran/50573 * gfortran.dg/dshift_3.f90: New test. Index: fortran/check.c =================================================================== --- fortran/check.c (revision 180567) +++ fortran/check.c (working copy) @@ -934,7 +934,7 @@ null_arg: gfc_try gfc_check_atan_2 (gfc_expr *y, gfc_expr *x) { - /* gfc_notify_std would be a wast of time as the return value + /* gfc_notify_std would be a waste of time as the return value is seemingly used only for the generic resolution. The error will be: Too many arguments. */ if ((gfc_option.allow_std & GFC_STD_F2008) == 0) @@ -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; } @@ -2710,6 +2727,16 @@ gfc_check_nearest (gfc_expr *x, gfc_expr if (type_check (s, 1, BT_REAL) == FAILURE) return FAILURE; + if (s->expr_type == EXPR_CONSTANT) + { + if (mpfr_sgn (s->value.real) == 0) + { + gfc_error ("Argument 'S' of NEAREST at %L shall not be zero", + &s->where); + return FAILURE; + } + } + return SUCCESS; } 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