PRs 100650 and 49324: intrinsic assignment of reshaped derived type array constructor
I just added a shorter reproducer (below) to PR 100650. Is this also related to PR 49324? Damian % cat reshape-array-constructor.f90 implicit none type foo_t integer, allocatable :: bar(:) end type type(foo_t) foo(2,1) integer :: i, j, n(2,2,1) = reshape([-1,-1,1,1], [2,2,1]) foo = reshape([([(foo_t(merge(0, 1, n(:,i,j) > 0)), i=1,2)], j=1,1)], [2,1]) print *, merge(0, 1, n(:,1,1) > 0), foo(1,1)%bar print *, merge(0, 1, n(:,2,1) > 0), foo(2,1)%bar end % gfortran reshape-array-constructor.f90 % ./a.out 1 1 786120848 65240 0 0 786120848 65240 % gfortran --version GNU Fortran (Homebrew GCC 13.1.0) 13.1.0
Re: [Patch, fortran] PR107900 Select type with intrinsic type inside associate causes ICE / Segmenation fault
Hi Paul,
On 6/20/23 12:54, Paul Richard Thomas via Gcc-patches wrote:
Hi Harald,
Fixing the original testcase in this PR turned out to be slightly more
involved than I expected. However, it resulted in an open door to fix
some other PRs and the attached much larger patch.
This time, I did remember to include the testcases in the .diff :-)
indeed! :-)
I've only had a superficial look so far although it looks very good.
(I have to trust your experience with unlimited polymorphism.)
However, I was wondering about the following helper function:
+bool
+gfc_is_ptr_fcn (gfc_expr *e)
+{
+ return e != NULL && e->expr_type == EXPR_FUNCTION
+ && (gfc_expr_attr (e).pointer
+ || (e->ts.type == BT_CLASS
+ && CLASS_DATA (e)->attr.class_pointer));
+}
+
+
/* Copy a shape array. */
Is there a case where gfc_expr_attr (e).pointer returns false
and you really need the || part? Looking at gfc_expr_attr
and the present context, it might just not be necessary.
I believe that, between the Change.Logs and the comments, it is
reasonably self-explanatory.
OK for trunk?
OK from my side.
Thanks for the patch!
Harald
Regards
Paul
Fortran: Fix some bugs in associate [PR87477]
2023-06-20 Paul Thomas
gcc/fortran
PR fortran/87477
PR fortran/88688
PR fortran/94380
PR fortran/107900
PR fortran/110224
* decl.cc (char_len_param_value): Fix memory leak.
(resolve_block_construct): Remove unnecessary static decls.
* expr.cc (gfc_is_ptr_fcn): New function.
(gfc_check_vardef_context): Use it to permit pointer function
result selectors to be used for associate names in variable
definition context.
* gfortran.h: Prototype for gfc_is_ptr_fcn.
* match.cc (build_associate_name): New function.
(gfc_match_select_type): Use the new function to replace inline
version and to build a new associate name for the case where
the supplied associate name is already used for that purpose.
* resolve.cc (resolve_assoc_var): Call gfc_is_ptr_fcn to allow
associate names with pointer function targets to be used in
variable definition context.
* trans-decl.cc (gfc_get_symbol_decl): Unlimited polymorphic
variables need deferred initialisation of the vptr.
(gfc_trans_deferred_vars): Do the vptr initialisation.
* trans-stmt.cc (trans_associate_var): Ensure that a pointer
associate name points to the target of the selector and not
the selector itself.
gcc/testsuite/
PR fortran/87477
PR fortran/107900
* gfortran.dg/pr107900.f90 : New test
PR fortran/110224
* gfortran.dg/pr110224.f90 : New test
PR fortran/88688
* gfortran.dg/pr88688.f90 : New test
PR fortran/94380
* gfortran.dg/pr94380.f90 : New test
PR fortran/95398
* gfortran.dg/pr95398.f90 : Set -std=f2008, bump the line
numbers in the error tests by two and change the text in two.
Re: [Patch, fortran] PR108961 - Segfault when associating to pointer from C_F_POINTER
Le 20/06/2023 à 18:30, Tobias Burnus a écrit : On 20.06.23 18:19, Paul Richard Thomas via Fortran wrote: Is there a better way to detect a type(c_ptr) formal argument? u.derived->intmod_sym_id == ISOCBINDING_PTR ? && u.derived->from_intmod == INTMOD_ISO_C_BINDING ?
Re: [PATCH v5 3/5] p1689r5: initial support
On Tue, Feb 14, 2023 at 16:50:27 -0500, Jason Merrill wrote:
> On 1/25/23 13:06, Ben Boeckel wrote:
> > - header-unit information fields
> >
> > Header units (including the standard library headers) are 100%
> > unsupported right now because the `-E` mechanism wants to import their
> > BMIs. A new mode (i.e., something more workable than existing `-E`
> > behavior) that mocks up header units as if they were imported purely
> > from their path and content would be required.
>
> I notice that the cpp dependency generation tries (in open_file_failed)
> to continue after encountering a missing file, is that not sufficient
> for header units? Or adjustable to be sufficient?
No. Header units can introduce macros which can be used to modify the
set of modules that are imported. Included headers are "discovered"
dependencies and don't modify the build graph (just add more files that
trigger a rebuild) and can be collected during compilation. Module
dependencies are needed to get the build correct in the first place in
order to:
- order module compilations in the build graph so that imported modules
are ready before anything using them; and
- computing the set of flags needed for telling the compiler where
imported modules' CMI files should be located.
> > - non-utf8 paths
> >
> > The current standard says that paths that are not unambiguously
> > represented using UTF-8 are not supported (because these cases are rare
> > and the extra complication is not worth it at this time). Future
> > versions of the format might have ways of encoding non-UTF-8 paths. For
> > now, this patch just doesn't support non-UTF-8 paths (ignoring the
> > "unambiguously represetable in UTF-8" case).
>
> typo "representable"
Fixed.
> > diff --git a/gcc/c-family/c-opts.cc b/gcc/c-family/c-opts.cc
> > index c68a2a27469..1c14ce3fe8e 100644
> > --- a/gcc/c-family/c-opts.cc
> > +++ b/gcc/c-family/c-opts.cc
> > @@ -77,6 +77,9 @@ static bool verbose;
> > /* Dependency output file. */
> > static const char *deps_file;
> >
> > +/* Enhanced dependency output file. */
>
> Maybe "structured", as in the docs? It isn't really a direct
> enhancement of the makefile dependencies.
Agreed. I'll also add a link to p1689r5 as a comment for what
"structured" means where it is parsed out.
> > + if (cpp_opts->deps.format != DEPS_FMT_NONE)
> > +{
> > + if (!fdeps_file)
> > + fdeps_stream = out_stream;
> > + else if (fdeps_file[0] == '-' && fdeps_file[1] == '\0')
> > + fdeps_stream = stdout;
>
> You probably want to check that deps_stream and fdeps_stream don't end
> up as the same stream.
Hmm. But `stdout` is probably fine to use for both though. Basically:
if (fdeps_stream == out_stream && fdeps_stream != stdout)
make_diagnostic_noise ();
> > @@ -1374,6 +1410,8 @@ handle_deferred_opts (void)
> >
> > if (opt->code == OPT_MT || opt->code == OPT_MQ)
> > deps_add_target (deps, opt->arg, opt->code == OPT_MQ);
> > + else if (opt->code == OPT_fdep_output_)
> > + deps_add_output (deps, opt->arg, true);
>
> How about fdeps_add_target?
Renamed.
> > diff --git a/gcc/c-family/c.opt b/gcc/c-family/c.opt
> > index ef371ca8c26..630781fdf8a 100644
> > --- a/gcc/c-family/c.opt
> > +++ b/gcc/c-family/c.opt
> > @@ -256,6 +256,18 @@ MT
> > C ObjC C++ ObjC++ Joined Separate MissingArgError(missing makefile target
> > after %qs)
> > -MT Add a target that does not require quoting.
> >
> > +fdep-format=
> > +C ObjC C++ ObjC++ NoDriverArg Joined MissingArgError(missing format after
> > %qs)
> > +Format for output dependency information. Supported (\"p1689r5\").
>
> I think we want "structured" here, as well.
Fixed.
> > diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi
> > index 06d77983e30..b61c3ebd3ec 100644
> > --- a/gcc/doc/invoke.texi
> > +++ b/gcc/doc/invoke.texi
> > @@ -2791,6 +2791,21 @@ is @option{-fpermitted-flt-eval-methods=c11}. The
> > default when in a GNU
> > dialect (@option{-std=gnu11} or similar) is
> > @option{-fpermitted-flt-eval-methods=ts-18661-3}.
> >
> > +@item -fdep-file=@var{file}
> > +@opindex fdep-file
> > +Where to write structured dependency information.
> > +
> > +@item -fdep-format=@var{format}
> > +@opindex fdep-format
> > +The format to use for structured dependency information. @samp{p1689r5} is
> > the
> > +only supported format right now. Note that when this argument is
> > specified, the
> > +output of @samp{-MF} is stripped of some information (namely C++ modules)
> > so
> > +that it does not use extended makefile syntax not understood by most tools.
> > +
> > +@item -fdep-output=@var{file}
> > +@opindex fdep-output
> > +Analogous to @option{-MT} but for structured dependency information.
>
> Please add more detail about how these are intended to be used.
Will do.
> > diff --git a/gcc/testsuite/g++.dg/modules/p1689-1.C
> > b/gcc/testsuite/g++.dg/modules/p1689-1.C
> > new file mode 100644
> > index 000..245e30d09ce
Re: [PATCH v5 3/5] p1689r5: initial support
On Mon, Jun 19, 2023 at 17:33:58 -0400, Jason Merrill wrote:
> On 5/12/23 10:24, Ben Boeckel wrote:
> > `file` can be omitted (the `output_stream` will be used then). I *think*
> > I see that adding:
> >
> > %{fdeps_file:-fdeps-file=%{!o:%b.ddi}%{o*:%.ddi%*}}
>
> %{!fdeps-file: but yes.
>
> > would at least do for `-fdeps-file` defaults? I don't know if there's a
> > reasonable default for `-fdeps-target=` though given that this command
> > line has no information about the object file that will be used (`-o` is
> > used for preprocessor output since we're leaning on `-E` here).
>
> I would think it could default to %b.o?
I suppose that could work, yes.
> I had quite a few more comments on the v5 patch that you didn't respond
> to here or address in the v6 patch; did your mail client hide them from you?
Oof. Sorry, I saw large chunks of quoting and apparently assumed the
rest was fine (I usually do aggressive trimming when doing that style of
review). I see them now. Will go through and include in v7.
--Ben
Re: [Patch, fortran] PR108961 - Segfault when associating to pointer from C_F_POINTER
On 20.06.23 18:19, Paul Richard Thomas via Fortran wrote: Is there a better way to detect a type(c_ptr) formal argument? u.derived->intmod_sym_id == ISOCBINDING_PTR ? Tobias - Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
[Patch, fortran] PR108961 - Segfault when associating to pointer from C_F_POINTER
Dear All,
This patch is verging on obvious. The PR was originally, incorrectly
blocking PR87477 and the testcase has remained in my 'associate'
directory. I thought that it is time to get shot of it!
Is there a better way to detect a type(c_ptr) formal argument?
Subject to advice on the question, OK for trunk?
Paul
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 45a984b6bdb..0823efd5abc 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -7353,6 +7353,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
need the length. */
if (parmse.string_length != NULL_TREE
&& !sym->attr.is_bind_c
+ && !(fsym && fsym->ts.type == BT_DERIVED
+ && !strcmp (fsym->ts.u.derived->name, "c_ptr"))
&& !(fsym && UNLIMITED_POLY (fsym)))
vec_safe_push (stringargs, parmse.string_length);
Change.Logs
Description: Binary data
! { dg-do run }
!
! Contributed by Jeffrey Hill
!
module associate_ptr
use iso_c_binding
contains
subroutine c_f_strpointer(cptr, ptr2)
type(c_ptr), target, intent(in) :: cptr
character(kind=c_char,len=4), pointer :: ptr1
character(kind=c_char,len=:), pointer, intent(out) :: ptr2
call c_f_pointer(cptr, ptr1)
if (ptr1 .ne. 'abcd') stop 1
ptr2 => ptr1 ! Failed here
end subroutine
end module
program test_associate_ptr
use associate_ptr
character(kind=c_char, len=1), target :: char_array(7)
character(kind=c_char,len=:), pointer :: ptr2
char_array = ['a', 'b', 'c', 'd', c_null_char, 'e', 'f']
! The first argument was providing a constant hidden string length => segfault
call c_f_strpointer(c_loc(char_array), ptr2)
if (ptr2 .ne. 'abcd') stop 2
end program
[committed] Fortran: Fix parse-dump-tree for OpenMP ALLOCATE clause
A rather obvious fix. The allocator(...) bit showed up with -fdump-parse-tree.
Committed as Rev. r14-1988-g99e3214f582b08
Side remark:
Regarding the example inside the commit log: OpenMP 5.1 permitted derived-type
components. Due to global wording changes, OpenMP 5.2 disabled it for both
the new 'allocators' and for the old 'allocate' directive. This turned out to be
an accidental change and it will be permitted in a future OpenMP version again
(for 'allocators' as the executable form of the 'allocate' directive was
deprecated
and then removed; in GCC, we will have to support it for both for legacy support
reasons). – While n->expr is now support for the dump, it is currently
unreachable
as dt-component parsing is disabled for both allocate and allocators. (To be
changed.)
Tobias
-
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634
München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas
Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht
München, HRB 106955
commit 99e3214f582b08b69b11b53eb3fc73b0919ef4f1
Author: Tobias Burnus
Date: Tue Jun 20 13:46:11 2023 +0200
Fortran: Fix parse-dump-tree for OpenMP ALLOCATE clause
Commit r14-1301-gd64e8e1224708e added u2.allocator to gfc_omp_namelist
for better readability and to permit to use namelist->expr for code
like the following:
!$omp allocators allocate(align(32) : dt%alloc_comp)
allocate (dt%alloc_comp(5))
!$omp allocate(dt%alloc_comp2) align(64)
allocate (dt%alloc_comp2(10))
However, for the parse-tree dump the change was incomplete.
gcc/fortran/ChangeLog:
* dump-parse-tree.cc (show_omp_namelist): Fix dump of the allocator
modifier of OMP_LIST_ALLOCATE.
diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc
index 99c8bdaadce..effcebe9325 100644
--- a/gcc/fortran/dump-parse-tree.cc
+++ b/gcc/fortran/dump-parse-tree.cc
@@ -1370,31 +1370,34 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
fputc (list_type == OMP_LIST_AFFINITY ? ':' : ',', dumpfile);
}
}
ns_iter = n->u2.ns;
}
if (list_type == OMP_LIST_ALLOCATE)
{
- if (n->expr)
+ if (n->u2.allocator)
{
fputs ("allocator(", dumpfile);
show_expr (n->u2.allocator);
fputc (')', dumpfile);
}
if (n->expr && n->u.align)
fputc (',', dumpfile);
if (n->u.align)
{
fputs ("align(", dumpfile);
show_expr (n->u.align);
fputc (')', dumpfile);
}
- if (n->expr || n->u.align)
+ if (n->u2.allocator || n->u.align)
fputc (':', dumpfile);
- fputs (n->sym->name, dumpfile);
+ if (n->expr)
+ show_expr (n->expr);
+ else
+ fputs (n->sym->name, dumpfile);
if (n->next)
fputs (") ALLOCATE(", dumpfile);
continue;
}
if (list_type == OMP_LIST_REDUCTION)
switch (n->u.reduction_op)
{
Re: [Patch] Fortran's gfc_match_char: %S to match symbol with host_assoc
Hi Tobias,
This looks good to me. I'm interested to see it in use :-)
OK for trunk
Paul
On Tue, 20 Jun 2023 at 11:50, Tobias Burnus wrote:
>
> When just matching a symbol, one can use 'gfc_match_symbol (, host_assoc)'
> and has the option to match with and without host association.
>
> However, when matching something more complex via 'gfc_match' like
> "something ( %s ) , " the match uses host_assoc = false.
> While it can be combined ("something (" + symbol + " ) ,"), this requires
> keeping track of the previous location and resetting it.
>
> It seems to be much simply to add a new flag supporting host_assoc = true,
> which this patch does (using '%S'). The advantage is also that when looking
> at the comment or at the "%s" implementation, it is clear that there are two
> variants, making it less likely to choose the wrong matching.
>
> OK for mainline?
>
> Tobias
>
> PS: I will use it in an upcoming OpenMP to parse 'uses_allocators'.
> -
> Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634
> München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas
> Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht
> München, HRB 106955
--
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
Re: [Patch, fortran] PR107900 Select type with intrinsic type inside associate causes ICE / Segmenation fault
Hi Harald,
Fixing the original testcase in this PR turned out to be slightly more
involved than I expected. However, it resulted in an open door to fix
some other PRs and the attached much larger patch.
This time, I did remember to include the testcases in the .diff :-)
I believe that, between the Change.Logs and the comments, it is
reasonably self-explanatory.
OK for trunk?
Regards
Paul
Fortran: Fix some bugs in associate [PR87477]
2023-06-20 Paul Thomas
gcc/fortran
PR fortran/87477
PR fortran/88688
PR fortran/94380
PR fortran/107900
PR fortran/110224
* decl.cc (char_len_param_value): Fix memory leak.
(resolve_block_construct): Remove unnecessary static decls.
* expr.cc (gfc_is_ptr_fcn): New function.
(gfc_check_vardef_context): Use it to permit pointer function
result selectors to be used for associate names in variable
definition context.
* gfortran.h: Prototype for gfc_is_ptr_fcn.
* match.cc (build_associate_name): New function.
(gfc_match_select_type): Use the new function to replace inline
version and to build a new associate name for the case where
the supplied associate name is already used for that purpose.
* resolve.cc (resolve_assoc_var): Call gfc_is_ptr_fcn to allow
associate names with pointer function targets to be used in
variable definition context.
* trans-decl.cc (gfc_get_symbol_decl): Unlimited polymorphic
variables need deferred initialisation of the vptr.
(gfc_trans_deferred_vars): Do the vptr initialisation.
* trans-stmt.cc (trans_associate_var): Ensure that a pointer
associate name points to the target of the selector and not
the selector itself.
gcc/testsuite/
PR fortran/87477
PR fortran/107900
* gfortran.dg/pr107900.f90 : New test
PR fortran/110224
* gfortran.dg/pr110224.f90 : New test
PR fortran/88688
* gfortran.dg/pr88688.f90 : New test
PR fortran/94380
* gfortran.dg/pr94380.f90 : New test
PR fortran/95398
* gfortran.dg/pr95398.f90 : Set -std=f2008, bump the line
numbers in the error tests by two and change the text in two.
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index d09c8bc97d9..844345df77e 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -1086,6 +1086,8 @@ char_len_param_value (gfc_expr **expr, bool *deferred)
p = gfc_copy_expr (*expr);
if (gfc_is_constant_expr (p) && gfc_simplify_expr (p, 1))
gfc_replace_expr (*expr, p);
+ else
+gfc_free_expr (p);
if ((*expr)->expr_type == EXPR_FUNCTION)
{
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index d5cfbe0cc55..c960dfeabd9 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -812,6 +812,16 @@ gfc_has_vector_index (gfc_expr *e)
}
+bool
+gfc_is_ptr_fcn (gfc_expr *e)
+{
+ return e != NULL && e->expr_type == EXPR_FUNCTION
+ && (gfc_expr_attr (e).pointer
+ || (e->ts.type == BT_CLASS
+ && CLASS_DATA (e)->attr.class_pointer));
+}
+
+
/* Copy a shape array. */
mpz_t *
@@ -6470,6 +6480,22 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
}
return false;
}
+ else if (context && gfc_is_ptr_fcn (assoc->target))
+ {
+ if (!gfc_notify_std (GFC_STD_F2018, "%qs at %L associated to "
+ "pointer function target being used in a "
+ "variable definition context (%s)", name,
+ >where, context))
+ return false;
+ else if (gfc_has_vector_index (e))
+ {
+ gfc_error ("%qs at %L associated to vector-indexed target"
+ " cannot be used in a variable definition"
+ " context (%s)",
+ name, >where, context);
+ return false;
+ }
+ }
/* Target must be allowed to appear in a variable definition context. */
if (!gfc_check_vardef_context (assoc->target, pointer, false, false, NULL))
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index a58c60e9828..30631abd788 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3659,6 +3659,7 @@ bool gfc_is_constant_expr (gfc_expr *);
bool gfc_simplify_expr (gfc_expr *, int);
bool gfc_try_simplify_expr (gfc_expr *, int);
bool gfc_has_vector_index (gfc_expr *);
+bool gfc_is_ptr_fcn (gfc_expr *);
gfc_expr *gfc_get_expr (void);
gfc_expr *gfc_get_array_expr (bt type, int kind, locus *);
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index e7be7fddc64..0e4b5440393 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -6377,6 +6377,39 @@ build_class_sym:
}
+/* Build the associate name */
+static int
+build_associate_name (const char *name, gfc_expr **e1, gfc_expr **e2)
+{
+ gfc_expr *expr1 = *e1;
+ gfc_expr *expr2 = *e2;
+ gfc_symbol *sym;
+
+ /* For the case where the associate name is already an associate name. */
+ if (!expr2)
+expr2 = expr1;
+ expr1 = gfc_get_expr ();
+ expr1->expr_type = EXPR_VARIABLE;
+ expr1->where = expr2->where;
+ if (gfc_get_sym_tree (name, NULL, >symtree, false))
+return 1;
+
+ sym = expr1->symtree->n.sym;
+ if (expr2->ts.type == BT_UNKNOWN)
+ sym->attr.untyped = 1;
+ else
+
[Patch] Fortran's gfc_match_char: %S to match symbol with host_assoc
When just matching a symbol, one can use 'gfc_match_symbol (, host_assoc)'
and has the option to match with and without host association.
However, when matching something more complex via 'gfc_match' like
"something ( %s ) , " the match uses host_assoc = false.
While it can be combined ("something (" + symbol + " ) ,"), this requires
keeping track of the previous location and resetting it.
It seems to be much simply to add a new flag supporting host_assoc = true,
which this patch does (using '%S'). The advantage is also that when looking
at the comment or at the "%s" implementation, it is clear that there are two
variants, making it less likely to choose the wrong matching.
OK for mainline?
Tobias
PS: I will use it in an upcoming OpenMP to parse 'uses_allocators'.
-
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634
München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas
Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht
München, HRB 106955
Fortran's gfc_match_char: %S to match symbol with host_assoc
gfc_match ("... %s ...", ...) matches a gfc_symbol but with
host_assoc = 0. This commit adds '%S' as variant which matches
with host_assoc = 1
gcc/fortran/ChangeLog:
* match.cc (gfc_match_char): Match with '%S' a symbol
with host_assoc = 1.
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index e7be7fddc64..a350ebf754e 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -1084,7 +1084,8 @@ gfc_match_char (char c, bool gobble_ws)
%% Literal percent sign
%e Expression, pointer to a pointer is set
- %s Symbol, pointer to the symbol is set
+ %s Symbol, pointer to the symbol is set (host_assoc = 0)
+ %S Symbol, pointer to the symbol is set (host_assoc = 1)
%n Name, character buffer is set to name
%t Matches end of statement.
%o Matches an intrinsic operator, returned as an INTRINSIC enum.
@@ -1151,8 +1152,9 @@ loop:
goto loop;
case 's':
+ case 'S':
vp = va_arg (argp, void **);
- n = gfc_match_symbol ((gfc_symbol **) vp, 0);
+ n = gfc_match_symbol ((gfc_symbol **) vp, c == 'S');
if (n != MATCH_YES)
{
m = n;
