From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-pg1-x52a.google.com (mail-pg1-x52a.google.com [IPv6:2607:f8b0:4864:20::52a]) by sourceware.org (Postfix) with ESMTPS id C26583858433; Tue, 19 Mar 2024 17:33:42 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org C26583858433 Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmail.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org C26583858433 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2607:f8b0:4864:20::52a ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1710869627; cv=none; b=I7xdS3yuRdcrV8DDu0EWvpvgdqduT6SEk0L18EZT2BxrKI5uyCDZhjBIURRKeik6QO0Qqx2n03lFPEG3WyQWOKQZZXGRWptH/dsFEtBAhZ6rSO3NeVMGujOyg8cv8A4y7l2Nn+nFIAa9bmkHxU8WLcN94GyURMG7cGh7Yq+i+bg= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1710869627; c=relaxed/simple; bh=fZbMEgNY8NqGWlHskPICHXgadz9iGYPIKjKv6oJyulw=; h=DKIM-Signature:MIME-Version:From:Date:Message-ID:Subject:To; b=mKsFv8nVenrMTEd8lh1ZqxI4sa3oVF4aheJOYEOO6KU1M0wA0pfmfqca6LOozXzMo3fXwxkcEVgR66E9ZY59iNbJG5g78g8+Utln9pE9GR90GHPoSvk5wVJ5DsU3s0EA7dNWg7N0g0K+yB4zuv3KgWH/Kn3V1azaq75z0VgHY0g= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-pg1-x52a.google.com with SMTP id 41be03b00d2f7-5dbd519bde6so4317265a12.1; Tue, 19 Mar 2024 10:33:42 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1710869621; x=1711474421; darn=gcc.gnu.org; h=cc:to:subject:message-id:date:from:in-reply-to:references :mime-version:from:to:cc:subject:date:message-id:reply-to; bh=/7Z8vmdMNaM/kxetlakKp/4laZuWHAArihuFkrZP4VM=; b=LOXbfIbJcaOOkqLPDABgoOY+YeHWWB/YDBikWmgWK6YBfHtwnBFS+f2bhhixACQcrv BpzZ4NqKJpORbuk/wTactvVTA3TkMF7aWaypKyhs1R53lV56brEOs/Mj2MhxsejTGa80 x5rplY3DdSr5fza/bI9qOEifPDiZYhcN+PiOYXHxu7W5iJH9aoLciCywgH3H/OLtgkJd EOWNG9qepoRRTL69KiLX435SQJ5LD2CJQVmYrIU6jY4hPzCSkAX5Vo0smauRvzaMsGgI ENA/It8Ok9XoNRf93E0MWsoKy+14MRP3SR0k9XsBp2pG89rQGoqNBrsD6/jU+pj4By5/ bCVw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1710869621; x=1711474421; h=cc:to:subject:message-id:date:from:in-reply-to:references :mime-version:x-gm-message-state:from:to:cc:subject:date:message-id :reply-to; bh=/7Z8vmdMNaM/kxetlakKp/4laZuWHAArihuFkrZP4VM=; b=H0soE86ri+xMK3nRVC2L4/ZhuPstwG0E9rptYCK/7vhipRWAltzW5VOq63SmzojJF8 84Phh1NZeop2yu3F6g/nZrZHCGjm1tKhYzRhW5xAvd4M+1EKMRSEAUrMovb1s2/taRgz 9vwGMVkWfLdy8EZBYLkG5L9lNHye1PQeSRhgTUGjX/OQATg5ogDMJOQOYkMIjN+Ue6HK iI3FcY9a/xaz3IE5a8m5aUVHigK3zrIhRNSWfMRVIh0/fPG1g2JVrBSFD4L+e/O25Gyr Xeo4eOOV/HXHNOG0Fbzjo3+vxHuw8ZhSuCxzFlG1af0V9imOyef4dBfSzuOkKhmlLbkV SUEA== X-Forwarded-Encrypted: i=1; AJvYcCXF4dglXtKoguar7KoqoqivTpYvVpmoWAZCCBS/7gf5PgCWeWyivwOMRzlh2D82UpLenZlZbc8AqXjqSTDOJfq6uLsbyLYHLg== X-Gm-Message-State: AOJu0YxDtqQE+z9jSuQGRa9HkZ1k6jGMM+Q/D6mfPvvU1xkIZQpBy5Ka SAnf6fFBTcEs+WwLFRp0oti6/hRAMqdGz3uuksZ5Pkf9vg5qqub0/CmYbodEh4Mdwkm8yR/2BMW +b1crC7WQNba7kZ10EBnGulFT0wty4U7t X-Google-Smtp-Source: AGHT+IGAzFlbdVB+piFWGB0NFrgc/ibvYEjfVns5diETfJvb2t9/L4PNB63wM3UInloYvXgP2LUNGn1ODBajLP5pdB4= X-Received: by 2002:a17:90a:f3c8:b0:29b:9c92:a287 with SMTP id ha8-20020a17090af3c800b0029b9c92a287mr3352604pjb.36.1710869621447; Tue, 19 Mar 2024 10:33:41 -0700 (PDT) MIME-Version: 1.0 References: <20240319154918.272178-1-mikael@gcc.gnu.org> <20240319154918.272178-3-mikael@gcc.gnu.org> In-Reply-To: <20240319154918.272178-3-mikael@gcc.gnu.org> From: Paul Richard Thomas Date: Tue, 19 Mar 2024 17:33:30 +0000 Message-ID: Subject: Re: [PATCH v3 2/2] fortran: Fix specification expression error with dummy procedures [PR111781] To: Mikael Morin Cc: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org Content-Type: multipart/alternative; boundary="0000000000000b2c3c061406e02c" X-Spam-Status: No, score=-7.3 required=5.0 tests=BAYES_00,DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,DKIM_VALID_EF,FREEMAIL_FROM,GIT_PATCH_0,HTML_MESSAGE,RCVD_IN_DNSWL_NONE,SPF_HELO_NONE,SPF_PASS,TXREP,T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org List-Id: --0000000000000b2c3c061406e02c Content-Type: text/plain; charset="UTF-8" Content-Transfer-Encoding: quoted-printable Hi Mikael, This is very good. I am pleased to see global variables disappear and I like the new helper functions. As before, OK for mainline and, if you wish, 13-branch. Thanks Paul On Tue, 19 Mar 2024 at 15:49, Mikael Morin wrote: > This fixes a spurious invalid variable in specification expression error. > The error was caused on the testcase from the PR by two different bugs. > First, the call to is_parent_of_current_ns was unable to recognize > correct host association and returned false. Second, an ad-hoc > condition coming next was using a global variable previously improperly > restored to false (instead of restoring it to its initial value). The > latter happened on the testcase because one dummy argument was a procedur= e, > and checking that argument what causing a check of all its arguments with > the (improper) reset of the flag at the end, and that preceded the check = of > the next argument. > > For the first bug, the wrong result of is_parent_of_current_ns is fixed by > correcting the namespaces that function deals with, both the one passed > as argument and the current one tracked in the gfc_current_ns global. Two > new functions are introduced to select the right namespace. > > Regarding the second bug, the problematic condition is removed, together > with the formal_arg_flag associated with it. Indeed, that condition was > (wrongly) allowing local variables to be used in array bounds of dummy > arguments. > > PR fortran/111781 > > gcc/fortran/ChangeLog: > > * symbol.cc (gfc_get_procedure_ns, gfc_get_spec_ns): New function= s. > * gfortran.h (gfc_get_procedure_ns, gfc_get_spec ns): Declare the= m. > (gfc_is_formal_arg): Remove. > * expr.cc (check_restricted): Remove special case allowing local > variable in dummy argument bound expressions. Use gfc_get_spec_ns > to get the right namespace. > * resolve.cc (gfc_is_formal_arg, formal_arg_flag): Remove. > (gfc_resolve_formal_arglist): Set gfc_current_ns. Quit loop and > restore gfc_current_ns instead of early returning. > (resolve_symbol): Factor common array spec resolution code to... > (resolve_symbol_array_spec): ... this new function. Additionnally > set and restore gfc_current_ns. > > gcc/testsuite/ChangeLog: > > * gfortran.dg/spec_expr_8.f90: New test. > * gfortran.dg/spec_expr_9.f90: New test. > --- > gcc/fortran/expr.cc | 8 +-- > gcc/fortran/gfortran.h | 4 +- > gcc/fortran/resolve.cc | 77 +++++++++++------------ > gcc/fortran/symbol.cc | 58 +++++++++++++++++ > gcc/testsuite/gfortran.dg/spec_expr_8.f90 | 24 +++++++ > gcc/testsuite/gfortran.dg/spec_expr_9.f90 | 19 ++++++ > 6 files changed, 140 insertions(+), 50 deletions(-) > create mode 100644 gcc/testsuite/gfortran.dg/spec_expr_8.f90 > create mode 100644 gcc/testsuite/gfortran.dg/spec_expr_9.f90 > > diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc > index e4b1e8307e3..9a042cd7040 100644 > --- a/gcc/fortran/expr.cc > +++ b/gcc/fortran/expr.cc > @@ -3514,19 +3514,13 @@ check_restricted (gfc_expr *e) > if (!check_references (e->ref, &check_restricted)) > break; > > - /* gfc_is_formal_arg broadcasts that a formal argument list is bei= ng > - processed in resolve.cc(resolve_formal_arglist). This is done so > - that host associated dummy array indices are accepted (PR23446). > - This mechanism also does the same for the specification > expressions > - of array-valued functions. */ > if (e->error > || sym->attr.in_common > || sym->attr.use_assoc > || sym->attr.dummy > || sym->attr.implied_index > || sym->attr.flavor =3D=3D FL_PARAMETER > - || is_parent_of_current_ns (sym->ns) > - || (gfc_is_formal_arg () && (sym->ns =3D=3D gfc_current_ns))) > + || is_parent_of_current_ns (gfc_get_spec_ns (sym))) > { > t =3D true; > break; > diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h > index c7039730fad..26aa56b3358 100644 > --- a/gcc/fortran/gfortran.h > +++ b/gcc/fortran/gfortran.h > @@ -3612,6 +3612,9 @@ bool gfc_is_associate_pointer (gfc_symbol*); > gfc_symbol * gfc_find_dt_in_generic (gfc_symbol *); > gfc_formal_arglist *gfc_sym_get_dummy_args (gfc_symbol *); > > +gfc_namespace * gfc_get_procedure_ns (gfc_symbol *); > +gfc_namespace * gfc_get_spec_ns (gfc_symbol *); > + > /* intrinsic.cc -- true if working in an init-expr, false otherwise. */ > extern bool gfc_init_expr_flag; > > @@ -3821,7 +3824,6 @@ bool gfc_resolve_iterator (gfc_iterator *, bool, > bool); > bool find_forall_index (gfc_expr *, gfc_symbol *, int); > bool gfc_resolve_index (gfc_expr *, int); > bool gfc_resolve_dim_arg (gfc_expr *); > -bool gfc_is_formal_arg (void); > bool gfc_resolve_substring (gfc_ref *, bool *); > void gfc_resolve_substring_charlen (gfc_expr *); > gfc_expr *gfc_expr_to_initialize (gfc_expr *); > diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc > index c5ae826bd6e..50d51b06c92 100644 > --- a/gcc/fortran/resolve.cc > +++ b/gcc/fortran/resolve.cc > @@ -72,9 +72,6 @@ static bool first_actual_arg =3D false; > > static int omp_workshare_flag; > > -/* True if we are processing a formal arglist. The corresponding function > - resets the flag each time that it is read. */ > -static bool formal_arg_flag =3D false; > > /* True if we are resolving a specification expression. */ > static bool specification_expr =3D false; > @@ -89,12 +86,6 @@ static bitmap_obstack labels_obstack; > static bool inquiry_argument =3D false; > > > -bool > -gfc_is_formal_arg (void) > -{ > - return formal_arg_flag; > -} > - > /* Is the symbol host associated? */ > static bool > is_sym_host_assoc (gfc_symbol *sym, gfc_namespace *ns) > @@ -285,7 +276,8 @@ gfc_resolve_formal_arglist (gfc_symbol *proc) > sym->attr.always_explicit =3D 1; > } > > - formal_arg_flag =3D true; > + gfc_namespace *orig_current_ns =3D gfc_current_ns; > + gfc_current_ns =3D gfc_get_procedure_ns (proc); > > for (f =3D proc->formal; f; f =3D f->next) > { > @@ -306,17 +298,18 @@ gfc_resolve_formal_arglist (gfc_symbol *proc) > &proc->declared_at); > continue; > } > - else if (sym->attr.procedure && sym->attr.if_source !=3D IFSRC_DECL > + > + if (sym->attr.procedure && sym->attr.if_source !=3D IFSRC_DECL > && !resolve_procedure_interface (sym)) > - return; > + break; > > if (strcmp (proc->name, sym->name) =3D=3D 0) > - { > - gfc_error ("Self-referential argument " > - "%qs at %L is not allowed", sym->name, > - &proc->declared_at); > - return; > - } > + { > + gfc_error ("Self-referential argument " > + "%qs at %L is not allowed", sym->name, > + &proc->declared_at); > + break; > + } > > if (sym->attr.if_source !=3D IFSRC_UNKNOWN) > gfc_resolve_formal_arglist (sym); > @@ -533,7 +526,8 @@ gfc_resolve_formal_arglist (gfc_symbol *proc) > } > } > } > - formal_arg_flag =3D false; > + > + gfc_current_ns =3D orig_current_ns; > } > > > @@ -16206,6 +16200,26 @@ resolve_pdt (gfc_symbol* sym) > } > > > +/* Resolve the symbol's array spec. */ > + > +static bool > +resolve_symbol_array_spec (gfc_symbol *sym, int check_constant) > +{ > + gfc_namespace *orig_current_ns =3D gfc_current_ns; > + gfc_current_ns =3D gfc_get_spec_ns (sym); > + > + bool saved_specification_expr =3D specification_expr; > + specification_expr =3D true; > + > + bool result =3D gfc_resolve_array_spec (sym->as, check_constant); > + > + specification_expr =3D saved_specification_expr; > + gfc_current_ns =3D orig_current_ns; > + > + return result; > +} > + > + > /* Do anything necessary to resolve a symbol. Right now, we just > assume that an otherwise unknown symbol is a variable. This sort > of thing commonly happens for symbols in module. */ > @@ -16220,7 +16234,6 @@ resolve_symbol (gfc_symbol *sym) > gfc_component *c; > symbol_attribute class_attr; > gfc_array_spec *as; > - bool saved_specification_expr; > > if (sym->resolve_symbol_called >=3D 1) > return; > @@ -16385,16 +16398,7 @@ resolve_symbol (gfc_symbol *sym) > } > } > else if (mp_flag && sym->attr.flavor =3D=3D FL_PROCEDURE && > sym->attr.function) > - { > - bool saved_specification_expr =3D specification_expr; > - bool saved_formal_arg_flag =3D formal_arg_flag; > - > - specification_expr =3D true; > - formal_arg_flag =3D true; > - gfc_resolve_array_spec (sym->result->as, false); > - formal_arg_flag =3D saved_formal_arg_flag; > - specification_expr =3D saved_specification_expr; > - } > + resolve_symbol_array_spec (sym->result, false); > > /* For a CLASS-valued function with a result variable, affirm that it > has > been resolved also when looking at the symbol 'sym'. */ > @@ -16961,18 +16965,7 @@ resolve_symbol (gfc_symbol *sym) > > check_constant =3D sym->attr.in_common && !sym->attr.pointer && > !sym->error; > > - /* Set the formal_arg_flag so that check_conflict will not throw > - an error for host associated variables in the specification > - expression for an array_valued function. */ > - if ((sym->attr.function || sym->attr.result) && sym->as) > - formal_arg_flag =3D true; > - > - saved_specification_expr =3D specification_expr; > - specification_expr =3D true; > - gfc_resolve_array_spec (sym->as, check_constant); > - specification_expr =3D saved_specification_expr; > - > - formal_arg_flag =3D false; > + resolve_symbol_array_spec (sym, check_constant); > > /* Resolve formal namespaces. */ > if (sym->formal_ns && sym->formal_ns !=3D gfc_current_ns > diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc > index 16adb2a7efb..3a3b6de5cec 100644 > --- a/gcc/fortran/symbol.cc > +++ b/gcc/fortran/symbol.cc > @@ -5408,3 +5408,61 @@ gfc_sym_get_dummy_args (gfc_symbol *sym) > > return dummies; > } > + > + > +/* Given a procedure, returns the associated namespace. > + The resulting NS should match the condition NS->PROC_NAME =3D=3D SYM.= */ > + > +gfc_namespace * > +gfc_get_procedure_ns (gfc_symbol *sym) > +{ > + if (sym->formal_ns > + && sym->formal_ns->proc_name =3D=3D sym) > + return sym->formal_ns; > + > + /* The above should have worked in most cases. If it hasn't, try some > other > + heuristics, eventually returning SYM->NS. */ > + if (gfc_current_ns->proc_name =3D=3D sym) > + return gfc_current_ns; > + > + /* For contained procedures, the symbol's NS field is the > + hosting namespace, not the procedure namespace. */ > + if (sym->attr.flavor =3D=3D FL_PROCEDURE && sym->attr.contained) > + for (gfc_namespace *ns =3D sym->ns->contained; ns; ns =3D ns->siblin= g) > + if (ns->proc_name =3D=3D sym) > + return ns; > + > + if (sym->formal) > + for (gfc_formal_arglist *f =3D sym->formal; f !=3D nullptr; f =3D f-= >next) > + if (f->sym) > + { > + gfc_namespace *ns =3D f->sym->ns; > + if (ns && ns->proc_name =3D=3D sym) > + return ns; > + } > + > + return sym->ns; > +} > + > + > +/* Given a symbol, returns the namespace in which the symbol is specifie= d. > + In most cases, it is the namespace hosting the symbol. This is the > case > + for variables. For functions, however, it is the function namespace > + itself. This specification namespace is used to check conformance of > + array spec bound expressions. */ > + > +gfc_namespace * > +gfc_get_spec_ns (gfc_symbol *sym) > +{ > + if (sym->attr.flavor =3D=3D FL_PROCEDURE > + && sym->attr.function) > + { > + if (sym->result =3D=3D sym) > + return gfc_get_procedure_ns (sym); > + /* Generic and intrinsic functions can have a null result. */ > + else if (sym->result !=3D nullptr) > + return sym->result->ns; > + } > + > + return sym->ns; > +} > diff --git a/gcc/testsuite/gfortran.dg/spec_expr_8.f90 > b/gcc/testsuite/gfortran.dg/spec_expr_8.f90 > new file mode 100644 > index 00000000000..77e14156497 > --- /dev/null > +++ b/gcc/testsuite/gfortran.dg/spec_expr_8.f90 > @@ -0,0 +1,24 @@ > +! { dg-do compile } > +! > +! PR fortran/111781 > +! We used to reject the example below because the dummy procedure g was > +! setting the current namespace without properly restoring it, which bro= ke > +! the specification expression check for the dimension of A later on. > +! > +! Contributed by Rasmus Vikhamar-Sandberg < > rasmus.vikhamar-sandberg@uit.no> > + > +program example > + implicit none > + integer :: n > + > +contains > + > + subroutine f(g,A) > + real, intent(out) :: A(n) > + interface > + pure real(8) function g(x) > + real(8), intent(in) :: x > + end function > + end interface > + end subroutine > +end program > diff --git a/gcc/testsuite/gfortran.dg/spec_expr_9.f90 > b/gcc/testsuite/gfortran.dg/spec_expr_9.f90 > new file mode 100644 > index 00000000000..9024909b4e9 > --- /dev/null > +++ b/gcc/testsuite/gfortran.dg/spec_expr_9.f90 > @@ -0,0 +1,19 @@ > +! { dg-do compile } > +! > +! PR fortran/111781 > +! Used to fail with Error: Variable =E2=80=98n=E2=80=99 cannot appear in= the > +! expression at (1) for line 16. > +! > +program is_it_valid > + dimension y(3) > + integer :: n =3D 3 > + interface > + function func(x) > + import > + dimension func(n) > + end function > + end interface > + y=3Dfunc(1.0) > + print *, y > + stop > +end > -- > 2.43.0 > > --0000000000000b2c3c061406e02c--