From patchwork Sun Nov 11 12:23:16 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 198251 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 A50702C008F for ; Sun, 11 Nov 2012 23:23:44 +1100 (EST) Comment: DKIM? See http://www.dkim.org DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d=gcc.gnu.org; s=default; x=1353241425; h=Comment: DomainKey-Signature:Received:Received:Received:Received:Received: Message-ID:Date:From:User-Agent:MIME-Version:To:CC:Subject: References:In-Reply-To:Content-Type:Mailing-List:Precedence: List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender: Delivered-To; bh=8/EsAyT9WOBcAzZTzg1snKziBhU=; b=ciZq29eLPUv2vkH K2vpTPVk+W7xezSpZYM7veyXDk8henwUr+k1CmXhvda9yiu3s7d9ED8md+aVkRCS dnmjnwXOc6JApg+ER+ssPc6lFpLMKX/BMvfQI9WJUdBYpmI97i13UG/t88vttPa3 79xUAgSZjGGY1kaw6tvmXrINKOHA= Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:Received:Message-ID:Date:From:User-Agent:MIME-Version:To:CC:Subject:References:In-Reply-To:Content-Type:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=GOz6vcuMTPbCF8nmsi7ETJT/k4+SM5pE1u4+FIm3g/qVlTBEBw0e0Me27HP2tS GfHRfiRsrgGEGhWWYV3WWdRf4RuAG3/Qbkv2nhdVes4ySd6rNZWx65dmIhvRZYG6 Nq1lt7LthBan/F+tpngotfiKiM+bpmNubEkhx7oQy9GRk=; Received: (qmail 32763 invoked by alias); 11 Nov 2012 12:23:32 -0000 Received: (qmail 32703 invoked by uid 22791); 11 Nov 2012 12:23:29 -0000 X-SWARE-Spam-Status: No, hits=-2.6 required=5.0 tests=AWL, BAYES_00, KHOP_RCVD_UNTRUST, KHOP_THREADED, RCVD_IN_DNSWL_LOW, RCVD_IN_HOSTKARMA_NO, RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from cc-smtpout1.netcologne.de (HELO cc-smtpout1.netcologne.de) (89.1.8.211) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Sun, 11 Nov 2012 12:23:23 +0000 Received: from cc-smtpin1.netcologne.de (cc-smtpin1.netcologne.de [89.1.8.201]) by cc-smtpout1.netcologne.de (Postfix) with ESMTP id 665931240C; Sun, 11 Nov 2012 13:23:20 +0100 (CET) Received: from [192.168.0.106] (xdsl-78-35-181-48.netcologne.de [78.35.181.48]) by cc-smtpin1.netcologne.de (Postfix) with ESMTPSA id E4AD911DB8; Sun, 11 Nov 2012 13:23:17 +0100 (CET) Message-ID: <509F98B4.3030301@netcologne.de> Date: Sun, 11 Nov 2012 13:23:16 +0100 From: Thomas Koenig User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:16.0) Gecko/20121025 Thunderbird/16.0.2 MIME-Version: 1.0 To: Steven Bosscher CC: "fortran@gcc.gnu.org" , gcc-patches Subject: Re: *ping* [patch, fortran] PR 30146, errors for INTENT(OUT) and INTENT(INOUT) for DO loop variables References: <509271EA.2040003@netcologne.de> <509E5DE0.60500@netcologne.de> In-Reply-To: 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 Hi Steven, > On Sat, Nov 10, 2012 at 3:00 PM, Thomas Koenig wrote: >> I wrote: >> >>> after the dicsussion on c.l.f, it become clear that passing a DO loop >>> variable to an INTENT(OUT) or INTENT(INOUT) dummy argument is an error. >>> The attached patch throws an error for both cases. > > But should we really isse an error for INTENT(INOUT)? IMHO a warning > suffices, with maybe an error only for strict (i.e. non-GNU) standard > settings. This was the result of a discussion on c.l.f. The summary can be found http://groups.google.com/group/comp.lang.fortran/msg/7107f24b8980fad3?hl=de Basically, passing an index variable to an INTENT(INOUT) variable violates a requirement on the program, and than an error would be the best course of action. >>> I chose to issue the errors as a front-end pass because we cannot check >>> for formal arguments during parsing (where the other checks are >>> implemented). >>> >>> Regression-tested. OK for trunk? >> >> >> Ping ** 1.4285 ? > > You don't have to list do_list twice in the ChangeLog, you probably > wanted one of those to be do_level ;-) OK. > >>> + do_list = XNEWVEC(gfc_code *, do_size); > > Taste nit: Why not just toss do_list, do_level, and do_size around as > a function argument, instead of making them global variable? Just > define a struct containing them and pass it around via the "data" > argument for gfc_code_walker should work, I think. The problem is with do_level. This could be incremented in do_warn, but we only know when to decrement it in gfc_code_walker (because there is no EXEC_ENDDO). So, we need a static variable in any case. The rest is a question of taste. If we need one static variable, I think we might as well use some other static variables. The only alternative I thought about was using a VEC, but frankly the documentation on that left me baffled as to how to implement this. > IMHO names like "do_warn" and "do_list" are not very descriptive, if > not to say confusing. do_* names are used elsewhere in the compiler > for functions that perform ("do") a task, whereas your do_* functions > are for the Fortran DO construct. I'd prefer different names. Changed to doloop_*. > >>> + to an INTENt(OUT) or INTENT(INOUT) dummy variable. */ > > s/INTENt/INTENT/ Fixed. > >>> + /* Withot a formal arglist, there is only unknown INTENT, > > s/Withot/Without/ > > >>> + for (i=0; i > for (i = 0; i < do_level; i++) > > >>> + "inside loop beginning at %L as INTENT(OUT) " > > Extraneous space after loop. Fixed. > How do you handle OPTIONAL args? As far as I have been able to determine, they work: ig25@linux-fd1f:~/Krempel/Do> cat optional.f90 module opt implicit none contains subroutine opt_in(a,b) integer, intent(in), optional :: a integer, intent(out) :: b end subroutine opt_in end module opt program main use opt implicit none integer :: i do i=1,10 call opt_in(b=i) end do end program main ig25@linux-fd1f:~/Krempel/Do> gfortran optional.f90 optional.f90:14.18: call opt_in(b=i) 1 optional.f90:13.11: do i=1,10 2 Fehler: Variable 'i' at (1) set to undefined value inside loop beginning at (2) as INTENT(OUT) argument to subroutine 'opt_in' Or were you thinking of another case? Attached is the new version of the patch, regression-tested. Thanks for the review! OK for trunk? Thomas 2012-11-11 Thomas Koenig PR fortran/30146 * frontend-passes.c (do_warn): New function. (doloop_list): New static variable. (doloop_size): New static variable. (doloop_level): New static variable. (gfc_run_passes): Call doloop_warn. (doloop_code): New function. (doloop_function): New function. (gfc_code_walker): Keep track of DO level. 2012-11-11 Thomas Koenig PR fortran/30146 * gfortran.dg/do_check_6.f90: New test. Index: frontend-passes.c =================================================================== --- frontend-passes.c (Revision 192894) +++ frontend-passes.c (Arbeitskopie) @@ -39,6 +39,7 @@ static bool optimize_trim (gfc_expr *); static bool optimize_lexical_comparison (gfc_expr *); static void optimize_minmaxloc (gfc_expr **); static bool empty_string (gfc_expr *e); +static void doloop_warn (gfc_namespace *); /* How deep we are inside an argument list. */ @@ -76,12 +77,30 @@ static bool in_omp_workshare; static int iterator_level; -/* Entry point - run all passes for a namespace. So far, only an - optimization pass is run. */ +/* Keep track of DO loop levels. */ +static gfc_code **doloop_list; +static int doloop_size, doloop_level; + +/* Vector of gfc_expr * to keep track of DO loops. */ + +struct my_struct *evec; + +/* Entry point - run all passes for a namespace. */ + void gfc_run_passes (gfc_namespace *ns) { + + /* Warn about dubious DO loops where the index might + change. */ + + doloop_size = 20; + doloop_level = 0; + doloop_list = XNEWVEC(gfc_code *, doloop_size); + doloop_warn (ns); + XDELETEVEC (doloop_list); + if (gfc_option.flag_frontend_optimize) { expr_size = 20; @@ -1225,6 +1244,160 @@ optimize_minmaxloc (gfc_expr **e) mpz_set_ui (a->expr->value.integer, 1); } +/* Callback function for code checking that we do not pass a DO variable to an + INTENT(OUT) or INTENT(INOUT) dummy variable. */ + +static int +doloop_code (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED, + void *data ATTRIBUTE_UNUSED) +{ + gfc_code *co; + int i; + gfc_formal_arglist *f; + gfc_actual_arglist *a; + + co = *c; + + switch (co->op) + { + case EXEC_DO: + + /* Grow the temporary storage if necessary. */ + if (doloop_level >= doloop_size) + { + doloop_size = 2 * doloop_size; + doloop_list = XRESIZEVEC (gfc_code *, doloop_list, doloop_size); + } + + /* Mark the DO loop variable if there is one. */ + if (co->ext.iterator && co->ext.iterator->var) + doloop_list[doloop_level] = co; + else + doloop_list[doloop_level] = NULL; + break; + + case EXEC_CALL: + f = co->symtree->n.sym->formal; + + /* Withot a formal arglist, there is only unknown INTENT, + which we don't check for. */ + if (f == NULL) + break; + + a = co->ext.actual; + + while (a && f) + { + for (i=0; iext.iterator->var->symtree->n.sym; + + if (a->expr && a->expr->symtree + && a->expr->symtree->n.sym == do_sym) + { + if (f->sym->attr.intent == INTENT_OUT) + gfc_error_now("Variable '%s' at %L set to undefined value " + "inside loop beginning at %L as INTENT(OUT) " + "argument to subroutine '%s'", do_sym->name, + &a->expr->where, &doloop_list[i]->loc, + co->symtree->n.sym->name); + else if (f->sym->attr.intent == INTENT_INOUT) + gfc_error_now("Variable '%s' at %L not definable inside loop " + "beginning at %L as INTENT(INOUT) argument to " + "subroutine '%s'", do_sym->name, + &a->expr->where, &doloop_list[i]->loc, + co->symtree->n.sym->name); + } + } + a = a->next; + f = f->next; + } + break; + + default: + break; + } + return 0; +} + +/* Callback function for functions checking that we do not pass a DO variable + to an INTENT(OUT) or INTENT(INOUT) dummy variable. */ + +static int +do_function (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, + void *data ATTRIBUTE_UNUSED) +{ + gfc_formal_arglist *f; + gfc_actual_arglist *a; + gfc_expr *expr; + int i; + + expr = *e; + if (expr->expr_type != EXPR_FUNCTION) + return 0; + + /* Intrinsic functions don't modify their arguments. */ + + if (expr->value.function.isym) + return 0; + + f = expr->symtree->n.sym->formal; + + /* Without a formal arglist, there is only unknown INTENT, + which we don't check for. */ + if (f == NULL) + return 0; + + a = expr->value.function.actual; + + while (a && f) + { + for (i=0; iext.iterator->var->symtree->n.sym; + + if (a->expr && a->expr->symtree + && a->expr->symtree->n.sym == do_sym) + { + if (f->sym->attr.intent == INTENT_OUT) + gfc_error_now("Variable '%s' at %L set to undefined value " + "inside loop beginning at %L as INTENT(OUT) " + "argument to function '%s'", do_sym->name, + &a->expr->where, &doloop_list[i]->loc, + expr->symtree->n.sym->name); + else if (f->sym->attr.intent == INTENT_INOUT) + gfc_error_now("Variable '%s' at %L not definable inside loop " + "beginning at %L as INTENT(INOUT) argument to " + "function '%s'", do_sym->name, + &a->expr->where, &doloop_list[i]->loc, + expr->symtree->n.sym->name); + } + } + a = a->next; + f = f->next; + } + + return 0; +} + +static void +doloop_warn (gfc_namespace *ns) +{ + gfc_code_walker (&ns->code, doloop_code, do_function, NULL); +} + + #define WALK_SUBEXPR(NODE) \ do \ { \ @@ -1383,6 +1556,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code break; case EXEC_DO: + doloop_level ++; WALK_SUBEXPR (co->ext.iterator->var); WALK_SUBEXPR (co->ext.iterator->start); WALK_SUBEXPR (co->ext.iterator->end); @@ -1601,6 +1775,9 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code if (co->op == EXEC_FORALL) forall_level --; + if (co->op == EXEC_DO) + doloop_level --; + in_omp_workshare = saved_in_omp_workshare; } }