From patchwork Fri Aug 29 20:13:20 2014 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Fritz Reese X-Patchwork-Id: 384362 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.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id D5639140077 for ; Sat, 30 Aug 2014 06:13:31 +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 :mime-version:in-reply-to:references:date:message-id:subject :from:to:content-type; q=dns; s=default; b=q7e9OtkKr5XtoFKlXmHE/ /0dJUZNRHa7xE/3qxJShDd1181abanr17WwcaJrqkwfpaBTnQy1xg95xMLSjrdk1 IueQVK70AFJiKoTtyTmLBLfVwvcnuGPtY8lk+7JcTSMPEhLKOBNXnmpG/P8OKXqy ++G5wx5SpQA6rusBCM1nNU= 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 :mime-version:in-reply-to:references:date:message-id:subject :from:to:content-type; s=default; bh=W6i8ac7YXXTZzjk2EkOReP8kUzs =; b=c4iZtkRTNpXVYlk49j2Pe2IbUrABHxFSNKBBxWZUbi3vqeQAXJklVJdAzeC wrxHuHaD01DBufs11umEEqgdvUp58zAoCDjH27yomXVD3ZLw/42+OWnhpTm/CtyC 3EXBlrg+MSAtyKIfpiC6AD7NbpVJVKc938vdlfGcRJlu5kP4= Received: (qmail 32591 invoked by alias); 29 Aug 2014 20:13:24 -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 32572 invoked by uid 89); 29 Aug 2014 20:13:23 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=1.5 required=5.0 tests=AWL, BAYES_00, FREEMAIL_FROM, RCVD_IN_DNSWL_LOW, SPF_PASS autolearn=ham version=3.3.2 X-Spam-User: qpsmtpd, 2 recipients X-HELO: mail-pa0-f42.google.com Received: from mail-pa0-f42.google.com (HELO mail-pa0-f42.google.com) (209.85.220.42) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES128-SHA encrypted) ESMTPS; Fri, 29 Aug 2014 20:13:22 +0000 Received: by mail-pa0-f42.google.com with SMTP id lf10so7264098pab.29 for ; Fri, 29 Aug 2014 13:13:20 -0700 (PDT) MIME-Version: 1.0 X-Received: by 10.68.194.194 with SMTP id hy2mr18249180pbc.149.1409343200496; Fri, 29 Aug 2014 13:13:20 -0700 (PDT) Received: by 10.70.69.230 with HTTP; Fri, 29 Aug 2014 13:13:20 -0700 (PDT) In-Reply-To: References: Date: Fri, 29 Aug 2014 16:13:20 -0400 Message-ID: Subject: Re: [PATCH, Fortran] -fno-automatic with -finit-local prevents initialization of automatics in recursive functions From: Fritz Reese To: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org https://gcc.gnu.org/bugzilla/show_bug.cgi?id=62309 It seems with gcc-4.8.3 -fno-automatic prevents initializers from being applied to automatic variables. The following does not behave as I would expect it to with gcc-4.8.3 on linux-x86-64: function f (x) implicit none integer f, x integer a ! should be SAVEd from -fno-automatic a = a + x ! should increment by y every time f = a return endfunction recursive function g (x) implicit none integer g, x integer b ! should be automatic from recursive b = b + x ! should be set to y every time g = b return endfunction implicit none integer f, g ! Should return static value of a; accumulates x print *, f(3) ! -> 3, ok print *, f(4) ! -> 7, ok print *, f(2) ! -> 2, ok ! Should return automatic value of c; equal to y each time print *, g(3) ! -> garbage, expected 3 print *, g(4) ! -> garbage, expected 4 print *, g(2) ! -> garbage, expected 2 end $ gfortran -fno-automatic -finit-local-zero auto_test.f $ ./a.out 3 7 9 32770 32771 32769 $ According to gfortran's manual page, -fno-automatic should "Treat each program unit (except those marked as RECURSIVE) as if the "SAVE" statement were specified for every local variable [...]". As far as I can tell, -finit-local-zero should still initialize automatic variables in RECURSIVE functions. I believe this is a simple fix; to actually follow the specification set forth in the man page, don't treat symbols in a RECURSIVE namespace as if they are saved in resolve.c (apply_default_init_local): 2014-08-29 Fritz Reese * resolve.c (apply_default_init_local): Don't treat variables in RECURSIVE units as saved. Fritz Reese diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 43eb240..a428633 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -11104,6 +11104,7 @@ apply_default_init_local (gfc_symbol *sym) result variable, which are also nonstatic. */ if (sym->attr.save || sym->ns->save_all || (gfc_option.flag_max_stack_var_size == 0 && !sym->attr.result + && !sym->ns->proc_name->attr.recursive && (!sym->attr.dimension || !is_non_constant_shape_array (sym)))) { /* Don't clobber an existing initializer! */ diff --git a/gcc/testsuite/gfortran.dg/auto_save_2.f90 b/gcc/testsuite/gfortran. new file mode 100644 index 0000000..0d39d48 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/auto_save_2.f90 @@ -0,0 +1,52 @@ +! { dg-do run } +! { dg-options "-fno-automatic -finit-local-zero" } +! +! Make sure variables are saved with -fno-automatic except in +! functions marked RECURSIVE, and that they are still initialized with +! -finit-local-zero. +! + +function f (x) +implicit none + integer f, x + integer a ! should be SAVEd + a = a + x ! should increment by y every time + f = a + return +endfunction + +recursive function g (x) +implicit none + integer g, x + integer b ! should be automatic + b = b + x ! should be set to y every time + g = b + return +endfunction + +implicit none +integer f, g + +! Should return static value of a; accumulates y +if ( f(3) .ne. 3 ) then + call abort () +endif +if ( f(4) .ne. 7 ) then + call abort () +endif +if ( f(2) .ne. 9 ) then + call abort () +endif + +! Should return automatic value of a; equal to y each time +if ( g(3) .ne. 3 ) then + call abort () +endif +if ( g(4) .ne. 4 ) then + call abort () +endif +if ( g(2) .ne. 2 ) then + call abort () +endif + +end