https://gcc.gnu.org/g:c16e4ecd8fdc2230a313fe795333fa97652ba19f
commit r14-10886-gc16e4ecd8fdc2230a313fe795333fa97652ba19f
Author: Paul Thomas <pa...@gcc.gnu.org>
Date: Tue Nov 5 15:54:45 2024 +0000
Fortran: Fix regressions with intent(out) class[PR115070, PR115348].
2024-11-05 Paul Thomas <pa...@gcc.gnu.org>
gcc/fortran
PR fortran/115070
PR fortran/115348
* trans-expr.cc (gfc_trans_class_init_assign): If all the
components of the default initializer are null for a scalar,
build an empty statement to prevent prior declarations from
disappearing.
gcc/testsuite/
PR fortran/115070
* gfortran.dg/ieee/pr115070.f90: New test.
PR fortran/115348
* gfortran.dg/pr115348.f90: New test.
Diff:
---
gcc/fortran/trans-expr.cc | 29 ++++++++++++++----------
gcc/testsuite/gfortran.dg/ieee/pr115070.f90 | 28 +++++++++++++++++++++++
gcc/testsuite/gfortran.dg/pr115348.f90 | 35 +++++++++++++++++++++++++++++
3 files changed, 80 insertions(+), 12 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 3a5a41401858..f182ea2ee1cd 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -1723,10 +1723,12 @@ gfc_trans_class_init_assign (gfc_code *code)
{
stmtblock_t block;
tree tmp;
+ bool cmp_flag = true;
gfc_se dst,src,memsz;
gfc_expr *lhs, *rhs, *sz;
gfc_component *cmp;
gfc_symbol *sym;
+ gfc_ref *ref;
gfc_start_block (&block);
@@ -1744,24 +1746,25 @@ gfc_trans_class_init_assign (gfc_code *code)
rhs->rank = 0;
/* Check def_init for initializers. If this is an INTENT(OUT) dummy with all
- default initializer components NULL, return NULL_TREE and use the passed
- value as required by F2018(8.5.10). */
+ default initializer components NULL, use the passed value even though
+ F2018(8.5.10) asserts that it should considered to be undefined. This is
+ needed for consistency with other brands. */
sym = code->expr1->expr_type == EXPR_VARIABLE ? code->expr1->symtree->n.sym
: NULL;
if (code->op != EXEC_ALLOCATE
&& sym && sym->attr.dummy
&& sym->attr.intent == INTENT_OUT)
{
- if (!lhs->ref && lhs->symtree->n.sym->attr.dummy)
+ ref = rhs->ref;
+ while (ref && ref->next)
+ ref = ref->next;
+ cmp = ref->u.c.component->ts.u.derived->components;
+ for (; cmp; cmp = cmp->next)
{
- cmp = rhs->ref->next->u.c.component->ts.u.derived->components;
- for (; cmp; cmp = cmp->next)
- {
- if (cmp->initializer)
- break;
- else if (!cmp->next)
- return NULL_TREE;
- }
+ if (cmp->initializer)
+ break;
+ else if (!cmp->next)
+ cmp_flag = false;
}
}
@@ -1775,7 +1778,7 @@ gfc_trans_class_init_assign (gfc_code *code)
gfc_add_full_array_ref (lhs, tmparr);
tmp = gfc_trans_class_array_init_assign (rhs, lhs, code->expr1);
}
- else
+ else if (cmp_flag)
{
/* Scalar initialization needs the _data component. */
gfc_add_data_component (lhs);
@@ -1805,6 +1808,8 @@ gfc_trans_class_init_assign (gfc_code *code)
tmp, build_empty_stmt (input_location));
}
}
+ else
+ tmp = build_empty_stmt (input_location);
if (code->expr1->symtree->n.sym->attr.dummy
&& (code->expr1->symtree->n.sym->attr.optional
diff --git a/gcc/testsuite/gfortran.dg/ieee/pr115070.f90
b/gcc/testsuite/gfortran.dg/ieee/pr115070.f90
new file mode 100644
index 000000000000..9378f770e2c6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ieee/pr115070.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+!
+! Test the fix for PR115070
+!
+! Contributed by Sebastien Bardeau <bard...@iram.fr>
+!
+module my_mod
+ type my_type
+ integer :: a
+ contains
+ final :: myfinal
+ end type my_type
+contains
+ subroutine my_sub(obs)
+ use ieee_arithmetic
+ class(my_type), intent(out) :: obs
+ end subroutine my_sub
+ subroutine myfinal (arg)
+ type (my_type) :: arg
+ print *, arg%a
+ end
+end module my_mod
+
+ use my_mod
+ type (my_type) :: z
+ z%a = 42
+ call my_sub (z)
+end
diff --git a/gcc/testsuite/gfortran.dg/pr115348.f90
b/gcc/testsuite/gfortran.dg/pr115348.f90
new file mode 100644
index 000000000000..bc644b2f1c0c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr115348.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! { dg-options "-fcheck=recursion" }
+!
+! Test the fix for pr115348.
+!
+! Contributed by Maxime van den Bossche <maxime.vandenboss...@kuleuven.be>
+!
+module mymodule
+ implicit none
+
+ type mytype
+ integer :: mynumber
+ contains
+ procedure :: myroutine
+ end type mytype
+
+ contains
+
+ subroutine myroutine(self)
+ class(mytype), intent(out) :: self
+
+ self%mynumber = 1
+ end subroutine myroutine
+end module mymodule
+
+
+program myprogram
+ use mymodule, only: mytype
+ implicit none
+
+ type(mytype) :: myobject
+
+ call myobject%myroutine()
+ print *, myobject%mynumber
+end program myprogram
