Re: [Patch, fortran] PR49213 - [OOP] gfortran rejects structure constructor expression
Hi Harald,
I'll change to gfc_charlen_type_node.
Thanks for your patience in reviewing this patch :-)
Cheers
Paul
On Tue, 27 Jun 2023 at 20:27, Harald Anlauf wrote:
>
> Hi Paul,
>
> this is much better now.
>
> I have only a minor comment left: in the calculation of the
> size of a character string you are using an intermediate
> gfc_array_index_type, whereas I have learned to use
> gfc_charlen_type_node now, which seems like the natural
> type here.
>
> OK for trunk, and thanks for your patience!
>
> Harald
>
>
> On 6/27/23 12:30, Paul Richard Thomas via Gcc-patches wrote:
> > Hi Harald,
> >
> > Let's try again :-)
> >
> > OK for trunk?
> >
> > Regards
> >
> > Paul
> >
> > Fortran: Enable class expressions in structure constructors [PR49213]
> >
> > 2023-06-27 Paul Thomas
> >
> > gcc/fortran
> > PR fortran/49213
> > * expr.cc (gfc_is_ptr_fcn): Remove reference to class_pointer.
> > * 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 (get_symbol_decl): Remove extraneous line.
> > * trans-expr.cc (alloc_scalar_allocatable_subcomponent): Obtain
> > size of intrinsic and character expressions.
> > (gfc_trans_subcomponent_assign): Expand assignment to class
> > components to include intrinsic and character expressions.
> >
> > gcc/testsuite/
> > PR fortran/49213
> > * gfortran.dg/pr49213.f90 : New test
> >
> > On Sat, 24 Jun 2023 at 20:50, Harald Anlauf wrote:
> >>
> >> Hi Paul!
> >>
> >> On 6/24/23 15:18, Paul Richard Thomas via Gcc-patches wrote:
> >>> I have included the adjustment to 'gfc_is_ptr_fcn' and eliminating the
> >>> extra blank line, introduced by my last patch. I played safe and went
> >>> exclusively for class functions with attr.class_pointer set on the
> >>> grounds that these have had all the accoutrements checked and built
> >>> (ie. class_ok). I am still not sure if this is necessary or not.
> >>
> >> maybe it is my fault, but I find the version in the patch confusing:
> >>
> >> @@ -816,7 +816,7 @@ 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 && gfc_expr_attr (e).pointer)
> >> || (e->ts.type == BT_CLASS
> >> && CLASS_DATA (e)->attr.class_pointer));
> >>}
> >>
> >> The caller 'gfc_is_ptr_fcn' has e->expr_type == EXPR_FUNCTION, so
> >> gfc_expr_attr (e) boils down to:
> >>
> >> if (e->value.function.esym && e->value.function.esym->result)
> >> {
> >>gfc_symbol *sym = e->value.function.esym->result;
> >>attr = sym->attr;
> >>if (sym->ts.type == BT_CLASS && sym->attr.class_ok)
> >> {
> >>attr.dimension = CLASS_DATA (sym)->attr.dimension;
> >>attr.pointer = CLASS_DATA (sym)->attr.class_pointer;
> >>attr.allocatable = CLASS_DATA (sym)->attr.allocatable;
> >> }
> >> }
> >> ...
> >> else if (e->symtree)
> >> attr = gfc_variable_attr (e, NULL);
> >>
> >> So I thought this should already do what you want if you do
> >>
> >> gfc_is_ptr_fcn (gfc_expr *e)
> >> {
> >> return e != NULL && e->expr_type == EXPR_FUNCTION && gfc_expr_attr
> >> (e).pointer;
> >> }
> >>
> >> or what am I missing? The additional checks in gfc_expr_attr are
> >> there to avoid ICEs in case CLASS_DATA (sym) has issues, and we all
> >> know Gerhard who showed that he is an expert in exploiting this.
> >>
> >> To sum up, I'd prefer to use the safer form if it works. If it
> >> doesn't, I would expect a latent issue.
> >>
> >> The rest of the code looked good to me, but I was suspicious about
> >> the handling of CHARACTER.
> >>
> >> Nasty as I am, I modified the testcase to use character(kind=4)
> >> instead of kind=1 (see attached). This either fails here (stop 10),
> >> or if I activate the marked line
> >>
> >> !cont = tContainer('hello!') ! ### ICE! ###
> >>
> >> I get an ICE.
> >>
> >> Can you have another look?
> >>
> >> Thanks,
> >> Harald
> >>
> >>>
> >>
> >>> OK for trunk?
> >>>
> >>> Paul
> >>>
> >>> Fortran: Enable class expressions in structure constructors [PR49213]
> >>>
> >>> 2023-06-24 Paul Thomas
> >>>
> >>> gcc/fortran
> >>> PR fortran/49213
> >>> * expr.cc (gfc_is_ptr_fcn): Guard pointer attribute to exclude
> >>> class expressions.
> >>> * 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 (get_symbol_decl): Remove extraneous line.
> >>> * trans-expr.cc (alloc_scalar_allocatable_subcomponent): Obtain
> >>> size of intrinsic and character expressions.
> >>> (gfc_trans_subcomponent_assign): Expand assignment to class
> >>> components to include intrinsic and character exp
[Patch fortran] PR89645 - No IMPLICIT type error with: ASSOCIATE( X => function() )
This is a heads up for a patch that has not been exercised enough as yet.
It works rather better and with less pain than I expected.
The testcase is really that of PR99065 but I thought that I should
give Ian Harvey prior credit for PR89645. Both appear in the meta-bug
PR87477.
I'll do the exercising before a proper submission.
Regards
Paul
Change89645.Logs
Description: Binary data
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 30631abd788..b316901ef8f 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2927,6 +2927,11 @@ typedef struct gfc_association_list
locus where;
gfc_expr *target;
+
+ /* Used for guessing the derived type of an associate name, whose selector
+ is a sibling derived type function that has not yet been parsed. */
+ gfc_symbol *derived_types;
+ unsigned guessed_type:1;
}
gfc_association_list;
#define gfc_get_association_list() XCNEW (gfc_association_list)
@@ -3478,6 +3483,7 @@ bool gfc_add_component (gfc_symbol *, const char *, gfc_component **);
gfc_symbol *gfc_use_derived (gfc_symbol *);
gfc_component *gfc_find_component (gfc_symbol *, const char *, bool, bool,
gfc_ref **);
+int gfc_find_derived_types (gfc_symbol *, gfc_namespace *, const char *);
gfc_st_label *gfc_get_st_label (int);
void gfc_free_st_label (gfc_st_label *);
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index 0bb440b85a9..00a5e74dce1 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -2057,6 +2057,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
bool unknown;
bool inquiry;
bool intrinsic;
+ bool guessed_type;
locus old_loc;
char sep;
@@ -2181,6 +2182,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
}
primary->ts = sym->ts;
+ guessed_type = sym->assoc && sym->assoc->guessed_type;
if (equiv_flag)
return MATCH_YES;
@@ -2194,7 +2196,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
inquiry = false;
if (m == MATCH_YES && sep == '%'
&& primary->ts.type != BT_CLASS
- && primary->ts.type != BT_DERIVED)
+ && (primary->ts.type != BT_DERIVED || guessed_type))
{
match mm;
old_loc = gfc_current_locus;
@@ -2209,7 +2211,8 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
gfc_set_default_type (sym, 0, sym->ns);
/* See if there is a usable typespec in the "no IMPLICIT type" error. */
- if (sym->ts.type == BT_UNKNOWN && m == MATCH_YES)
+ if ((sym->ts.type == BT_UNKNOWN || guessed_type)
+ && m == MATCH_YES)
{
bool permissible;
@@ -2228,6 +2231,31 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
sym->ts = tgt_expr->ts;
}
+ /* If this hasn't done the trick and the target expression is a function,
+ then this must be a derived type if 'name' matches an accessible type
+ both in this namespace and the as yet unparsed sibling function. */
+ if (tgt_expr && tgt_expr->expr_type == EXPR_FUNCTION
+ && (sym->ts.type == BT_UNKNOWN || guessed_type)
+ && gfc_find_derived_types (sym, gfc_current_ns, name))
+ {
+ sym->assoc->guessed_type = 1;
+ /* The first returned type is as good as any at this stage. */
+ gfc_symbol **dts = &sym->assoc->derived_types;
+ tgt_expr->ts.type = BT_DERIVED;
+ tgt_expr->ts.kind = 0;
+ tgt_expr->ts.u.derived = *dts;
+ sym->ts = tgt_expr->ts;
+ /* Delete the dt list to prevent interference with trans-type.cc's
+ treatment of derived type decls, even if this process has to be
+ done again for another primary expression. */
+ while (*dts && (*dts)->dt_next)
+ {
+ gfc_symbol **tmp = &(*dts)->dt_next;
+ *dts = NULL;
+ dts = tmp;
+ }
+ }
+
if (sym->ts.type == BT_UNKNOWN)
{
gfc_error ("Symbol %qs at %C has no IMPLICIT type", sym->name);
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 37a9e8fa0ae..272e102ca77 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -2402,6 +2402,65 @@ bad:
}
+/* Find all derived types in the uppermost namespace that have a component
+ a component called name and stash them in the assoc field of an
+ associate name variable.
+ This is used to guess the derived type of an associate name, whose selector
+ is a sibling derived type function that has not yet been parsed. Either
+ the derived type is use associated in both contained and sibling procedures
+ or it appears in the uppermost namespace. */
+
+static int cts = 0;
+static void
+find_derived_types (gfc_symbol *sym, gfc_symtree *st, const char *name,
+ bool contained)
+{
+ if (st->n.sym && st->n.sym->attr.flavor == FL_DERIVED
+ && ((contained && st->n.sym->attr.use_assoc) || !contained)
+ && gfc_find_component (st->n.sym, name, true, true, NULL))
+{
+ /* Do the stashing. */
+ cts++;
+ if (sym->assoc->derived_type
[PATCH, part3, committed] Fortran: ABI for scalar CHARACTER(LEN=1),VALUE dummy argument [PR110360]
Dear all,
the previous patches to this PR unfortunately caused a regression,
seen on Power big-endian systems/-m32 (pr110419), and while trying
to investigate on x86 also showed a regression (ICE) on cases that
were not covered in the testsuite before.
The original fix did not properly handle the dereferencing of
string arguments that were not constant, and it was lacking the
truncation of strings to length one that is needed when passing
a character on the stack.
This patch has been regtested on x86_64-pc-linux-gnu,
and the extended testcase was scrutinized with -m64 and -m32.
Pushed after discussion in the PR with Mikael as
commit r14-2171-g8736d6b14a4dfdfb58c80ccd398981b0fb5d00aa
https://gcc.gnu.org/g:8736d6b14a4dfdfb58c80ccd398981b0fb5d00aa
Will keep the PR open as long as the issues on Power big-endian
are not confirmed resolved.
Thanks,
Harald
From 8736d6b14a4dfdfb58c80ccd398981b0fb5d00aa Mon Sep 17 00:00:00 2001
From: Harald Anlauf
Date: Wed, 28 Jun 2023 22:16:18 +0200
Subject: [PATCH] Fortran: ABI for scalar CHARACTER(LEN=1),VALUE dummy argument
[PR110360]
gcc/fortran/ChangeLog:
PR fortran/110360
* trans-expr.cc (gfc_conv_procedure_call): For non-constant string
argument passed to CHARACTER(LEN=1),VALUE dummy, ensure proper
dereferencing and truncation of string to length 1.
gcc/testsuite/ChangeLog:
PR fortran/110360
* gfortran.dg/value_9.f90: Add tests for intermediate regression.
---
gcc/fortran/trans-expr.cc | 15 ++-
gcc/testsuite/gfortran.dg/value_9.f90 | 23 +++
2 files changed, 33 insertions(+), 5 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index ad0cdf902ba..30946ba3f63 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6395,7 +6395,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
/* ABI: actual arguments to CHARACTER(len=1),VALUE
dummy arguments are actually passed by value.
- Constant strings are truncated to length 1.
+ Strings are truncated to length 1.
The BIND(C) case is handled elsewhere. */
if (fsym->ts.type == BT_CHARACTER
&& !fsym->ts.is_c_interop
@@ -6405,10 +6405,15 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
(fsym->ts.u.cl->length->value.integer, 1) == 0))
{
if (e->expr_type != EXPR_CONSTANT)
- parmse.expr = gfc_string_to_single_character
- (build_int_cst (gfc_charlen_type_node, 1),
- parmse.expr,
- e->ts.kind);
+ {
+ tree slen1 = build_int_cst (gfc_charlen_type_node, 1);
+ gfc_conv_string_parameter (&parmse);
+ parmse.expr = gfc_string_to_single_character (slen1,
+ parmse.expr,
+ e->ts.kind);
+ /* Truncate resulting string to length 1. */
+ parmse.string_length = slen1;
+ }
else if (e->value.character.length > 1)
{
e->value.character.length = 1;
diff --git a/gcc/testsuite/gfortran.dg/value_9.f90 b/gcc/testsuite/gfortran.dg/value_9.f90
index f6490645e27..1a2fa80ed0d 100644
--- a/gcc/testsuite/gfortran.dg/value_9.f90
+++ b/gcc/testsuite/gfortran.dg/value_9.f90
@@ -9,7 +9,12 @@ program p
character (kind=4), allocatable :: ca4
character (kind=4), pointer :: cp4
character(len=:,kind=4), allocatable :: cd4
+ character:: c = "1"
+ character (kind=4) :: c4 = 4_"4"
+ character(len=3) :: d = "210"
+ character(len=3,kind=4) :: d4 = 4_"321"
integer :: a = 65
+ integer :: l = 2
allocate (ca, cp, ca4, cp4)
! Check len=1 actual argument cases first
@@ -20,15 +25,21 @@ program p
call val ("A",char(a))
call val ("A",mychar(65))
call val ("A",mychar(a))
+ call val ("1",c)
+ call val ("1",(c))
call val4 (4_"C",4_"C")
call val4 (4_"A",char(65,kind=4))
call val4 (4_"A",char(a, kind=4))
+ call val4 (4_"4",c4)
+ call val4 (4_"4",(c4))
call val (ca,ca)
call val (cp,cp)
call val (cd,cd)
+ call val (ca,(ca))
call val4 (ca4,ca4)
call val4 (cp4,cp4)
call val4 (cd4,cd4)
+ call val4 (cd4,(cd4))
call sub ("S")
call sub4 (4_"T")
@@ -37,6 +48,18 @@ program p
call val4 (4_"V**",4_"V//")
call sub ( "WTY")
call sub4 (4_"ZXV")
+ call val ( "234", d)
+ call val4 (4_"345", d4 )
+ call val ( "234", (d) )
+ call val4 (4_"345", (d4) )
+ call val ( "234", d (1:2))
+ call val4 (4_"345", d4(1:2))
+ call val ( "234", d (1:l))
+ call val4 (4_"345", d4(1:l))
+ call val ("1",c // d)
+ call val ("1",trim (c // d))
+ call val4 (4_"4",c4 // d4)
+ call val4 (4_"4",trim (c4 // d4))
cd = "gkl"; cd4 = 4_"hmn"
call val (cd,cd)
call val4 (cd4,cd4)
--
2.35.3
Re: PR82943 - Suggested patch to fix
Hi Alex, welcome to the gfortran community. It is great that you are trying to get actively involved. You already did quite a few things right: patches shall be sent to the gcc-patches ML, but Fortran reviewers usually notice them only where they are copied to the fortran ML. There are some general recommendations on the formatting of C code, like indentation, of the patches, and of the commit log entries. Regarding coding standards, see https://www.gnu.org/prep/standards/ . Regarding testcases, a recommendation is to have a look at existing testcases, e.g. in gcc/testsuite/gfortran.dg/, and then decide if the testcase shall test the compile-time or run-time behaviour, and add the necessary dejagnu directives. You should also verify if your patch passes regression testing. For changes to gfortran, it is usually sufficient to run make check-fortran -j where is the number of parallel tests. You would need to report also the platform where you tested on. There is also a legal issue to consider before non-trivial patches can be accepted for incorporation: https://gcc.gnu.org/contribute.html#legal If your patch is accepted and if you do not have write-access to the repository, one of the maintainers will likely take care of it. If you become a regular contributor, you will probably want to consider getting write access. Cheers, Harald On 6/24/23 19:17, Alexander Westbrooks via Gcc-patches wrote: Hello, I am new to the GFortran community. Over the past two weeks I created a patch that should fix PR82943 for GFortran. I have attached it to this email. The patch allows the code below to compile successfully. I am working on creating test cases next, but I am new to the process so it may take me some time. After I make test cases, do I email them to you as well? Do I need to make a pull-request on github in order to get the patch reviewed? Thank you, Alexander Westbrooks module testmod public :: foo type, public :: tough_lvl_0(a, b) integer, kind :: a = 1 integer, len :: b contains procedure :: foo end type type, public, EXTENDS(tough_lvl_0) :: tough_lvl_1 (c) integer, len :: c contains procedure :: bar end type type, public, EXTENDS(tough_lvl_1) :: tough_lvl_2 (d) integer, len :: d contains procedure :: foobar end type contains subroutine foo(this) class(tough_lvl_0(1,*)), intent(inout) :: this end subroutine subroutine bar(this) class(tough_lvl_1(1,*,*)), intent(inout) :: this end subroutine subroutine foobar(this) class(tough_lvl_2(1,*,*,*)), intent(inout) :: this end subroutine end module PROGRAM testprogram USE testmod TYPE(tough_lvl_0(1,5)) :: test_pdt_0 TYPE(tough_lvl_1(1,5,6)) :: test_pdt_1 TYPE(tough_lvl_2(1,5,6,7)) :: test_pdt_2 CALL test_pdt_0%foo() CALL test_pdt_1%foo() CALL test_pdt_1%bar() CALL test_pdt_2%foo() CALL test_pdt_2%bar() CALL test_pdt_2%foobar() END PROGRAM testprogram
Possible problems with OpenMP task parallelism
I've been starting to try using OpenMP task parallelism, but I'm running into some issues. I'm not sufficiently experienced with task parallelism in OpenMP to know if I'm misunderstanding how it should work, or if there's a compiler bug. Here's an example code (highly simplified from the actual code I'm working on): module taskerMod type :: tasker integer :: depth=-1 contains final ::taskerDestruct procedure :: compute => taskerCompute end type tasker contains subroutine taskerDestruct(self) !$ use :: OMP_Lib implicit none type(tasker), intent(inout) :: self write (0,*) "DESTRUCT FROM DEPTH ",self%depth !$ ," : ",omp_get_thread_num() return end subroutine taskerDestruct recursive subroutine taskerCompute(self) !$ use :: OMP_Lib implicit none class(tasker), intent(inout) :: self !$omp atomic self%depth=self%depth+1 write (0,*) "DEPTH ",self%depth !$ ," : ",omp_get_thread_num() if (self%depth < 3) then !$omp task untied call self%compute() !$omp end task end if return end subroutine taskerCompute end module taskerMod program testTasks use :: taskerMod implicit none type(tasker) :: tasker_ tasker_=tasker(0) !$omp parallel !$omp single !$omp taskgroup !$omp task untied call tasker_%compute() !$omp end task !$omp end taskgroup !$omp end single !$omp end parallel end program testTasks Compiling without OpenMP results in the expected behavior: $ gfortran test.F90 $ ./a.out DESTRUCT FROM DEPTH -1 DEPTH1 DEPTH2 DEPTH3 There's a call to the finalizer for the tasker class (on assignment), and then it simply reports the 3 levels of recursion that I've set it to go through. But, if I compile with OpenMP and run just a single thread (the same problem occurs with multiple threads also): $ gfortran test.F90 -fopenmp $ ./a.out DESTRUCT FROM DEPTH -1 DEPTH1 DEPTH2 DESTRUCT FROM DEPTH2 DEPTH3 DESTRUCT FROM DEPTH3 I now see cal
