From patchwork Tue May 21 18:05:50 2013 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 245375 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]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (Client CN "localhost", Issuer "www.qmailtoaster.com" (not verified)) by ozlabs.org (Postfix) with ESMTPS id D21C52C00D1 for ; Wed, 22 May 2013 04:06:11 +1000 (EST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:to:subject:content-type; q= dns; s=default; b=w0373giOD/gJ/2XtvyNFh/3sz9ToBBPwcdSTL+e/XdhkrG CrvnZqaVgy8a7wGc0aPHZq/Q8AvdcMlIYypRNB66CmBngHwMFwpTaotR2w5KcmhW OSgFkRcUKWEyYm92cGIGEZGnf6rI8vvkfWNfXsxLdZG4ZXiehkvExfXCtxvYk= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:to:subject:content-type; s= default; bh=bvXXZj3cS4WUKWR9O2fSobmNpxM=; b=Ve54A8iNaT0V7qCSOw/s aFfA77f2sKjjXRNlRlraYvhL5yhtQfaT7bsJ0GdNawpAC0H5+F1FIeN3ECWjfu3M FqQlgb3Efpcmdd3SmasLfmEH312qpT4WpLsfsAJo+Z6+x7bI7bdW+vsDmnjvWiPj PuzsZdUo9fvCWydHEarStHc= Received: (qmail 4221 invoked by alias); 21 May 2013 18:05:56 -0000 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 Received: (qmail 4198 invoked by uid 89); 21 May 2013 18:05:55 -0000 X-Spam-SWARE-Status: No, score=-1.9 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, RCVD_IN_SEMBACKSCATTER autolearn=no version=3.3.1 X-Spam-User: qpsmtpd, 2 recipients Received: from mx02.qsc.de (HELO mx02.qsc.de) (213.148.130.14) by sourceware.org (qpsmtpd/0.84/v0.84-167-ge50287c) with ESMTP; Tue, 21 May 2013 18:05:54 +0000 Received: from archimedes.net-b.de (port-92-195-69-235.dynamic.qsc.de [92.195.69.235]) by mx02.qsc.de (Postfix) with ESMTP id 4D12E24D29; Tue, 21 May 2013 20:05:51 +0200 (CEST) Message-ID: <519BB77E.2070607@net-b.de> Date: Tue, 21 May 2013 20:05:50 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:17.0) Gecko/20130510 Thunderbird/17.0.6 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch, Fortran] PR57338 - add more missing constraint checks for assumed-rank X-Virus-Found: No That's a follow-up the just committed patch - which came too late in some cases. Build and regtested on x86-64-gnu-linux. OK for the trunk? Tobias 2013-05-21 Tobias Burnus PR fortran/57338 * intrinsic.c (do_check): Move some checks to ... (do_ts29113_check): ... this new function. (check_specific, gfc_intrinsic_sub_interface): Call it. 2013-05-21 Tobias Burnus PR fortran/57338 * gfortran.dg/assumed_type_6.f90: New. diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index ddf9d80..3251ebb 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -174,21 +174,14 @@ find_char_conv (gfc_typespec *from, gfc_typespec *to) } -/* Interface to the check functions. We break apart an argument list - and call the proper check function rather than forcing each - function to manipulate the argument list. */ +/* Check TS29113, C407b for assumed type and C535b for assumed-rank, + and a likewise check for NO_ARG_CHECK. */ static bool -do_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg) +do_ts29113_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg) { - gfc_expr *a1, *a2, *a3, *a4, *a5; gfc_actual_arglist *a; - if (arg == NULL) - return (*specific->check.f0) (); - - /* Check TS29113, C407b for assumed type and C535b for assumed-rank, - and a likewise check for NO_ARG_CHECK. */ for (a = arg; a; a = a->next) { if (!a->expr) @@ -242,6 +235,22 @@ do_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg) } } + return true; +} + + +/* Interface to the check functions. We break apart an argument list + and call the proper check function rather than forcing each + function to manipulate the argument list. */ + +static bool +do_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg) +{ + gfc_expr *a1, *a2, *a3, *a4, *a5; + + if (arg == NULL) + return (*specific->check.f0) (); + a1 = arg->expr; arg = arg->next; if (arg == NULL) @@ -4038,11 +4047,18 @@ check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag) || specific->check.f1m == gfc_check_min_max_integer || specific->check.f1m == gfc_check_min_max_real || specific->check.f1m == gfc_check_min_max_double) - return (*specific->check.f1m) (*ap); + { + if (!do_ts29113_check (specific, *ap)) + return false; + return (*specific->check.f1m) (*ap); + } if (!sort_actual (specific->name, ap, specific->formal, &expr->where)) return false; + if (!do_ts29113_check (specific, *ap)) + return false; + if (specific->check.f3ml == gfc_check_minloc_maxloc) /* This is special because we might have to reorder the argument list. */ t = gfc_check_minloc_maxloc (*ap); @@ -4352,6 +4368,9 @@ gfc_intrinsic_sub_interface (gfc_code *c, int error_flag) if (!sort_actual (name, &c->ext.actual, isym->formal, &c->loc)) goto fail; + if (!do_ts29113_check (isym, c->ext.actual)) + goto fail; + if (isym->check.f1 != NULL) { if (!do_check (isym, c->ext.actual)) diff --git a/gcc/testsuite/gfortran.dg/assumed_type_6.f90 b/gcc/testsuite/gfortran.dg/assumed_type_6.f90 new file mode 100644 index 0000000..78ff849 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/assumed_type_6.f90 @@ -0,0 +1,12 @@ +! { dg-do compile } +! +! PR fortran/ +! +! Contributed by Vladimír Fuka +! +function avg(a) + integer :: avg + integer,intent(in) :: a(..) + + avg = sum(a)/size(a) ! { dg-error "Assumed-rank argument at .1. is only permitted as actual argument to intrinsic inquiry functions" } +end function