diff mbox series

[fortran] PR115070 (and PR115348) - [13/14/15 Regression] ICE using IEEE_ARITHMETIC in a derived type method with class, intent(out)

Message ID CAGkQGiJqtRUvx+YTb+LfcPLJ_jg3FB1_9HVWvEQS-5v8+s8Qtw@mail.gmail.com
State New
Headers show
Series [fortran] PR115070 (and PR115348) - [13/14/15 Regression] ICE using IEEE_ARITHMETIC in a derived type method with class, intent(out) | expand

Commit Message

Paul Richard Thomas July 15, 2024, 4:10 p.m. UTC
Hi All,

I am not sure that I understand why this bug occurs. The regression was
introduced by my patch that had gfc_trans_class_init_assign return
NULL_TREE, when all the components of the default initializer are NULL.
Note that this only afflicts scalar dummy arguments.

With pr115070:
void my_sub (struct __class_my_mod_My_type_t & restrict obs)
  c_char fpstate.5[33];    // This disappears, when NULL is returned.
  try
    {
      _gfortran_ieee_procedure_entry ((void *) &fpstate.5);

With pr115348:
void myroutine (struct __class_mymodule_Mytype_t & restrict self)
{
  static logical(kind=4) is_recursive.0 = 0;  // This disappears when NULL
is returned
  try
    {
      if (is_recursive.0)

The fix is equally magical in that finishing build_empty_stmt seems to
provide the backend with everything that it needs to retain these
declarations. See the attached patch. If somebody can explain what causes
the problem and why the patch fixes it, I would be very pleased. As far as
I can tell, the tail end of trans_code should have been sufficient to
handle the return of NULL_TREE.

Anyway, work it does and regtests OK. OK for mainline and backporting?

Regards

Paul

Comments

Paul Richard Thomas July 19, 2024, 4:32 p.m. UTC | #1
Hi All,

Ping!

I understand now why this works. The scope of the block is merged and so
all the previous declarations that would otherwise disappear are added,
even by the empty statement.

Regards

Paul


On Mon, 15 Jul 2024 at 17:10, Paul Richard Thomas <
paul.richard.thomas@gmail.com> wrote:

> Hi All,
>
> I am not sure that I understand why this bug occurs. The regression was
> introduced by my patch that had gfc_trans_class_init_assign return
> NULL_TREE, when all the components of the default initializer are NULL.
> Note that this only afflicts scalar dummy arguments.
>
> With pr115070:
> void my_sub (struct __class_my_mod_My_type_t & restrict obs)
>   c_char fpstate.5[33];    // This disappears, when NULL is returned.
>   try
>     {
>       _gfortran_ieee_procedure_entry ((void *) &fpstate.5);
>
> With pr115348:
> void myroutine (struct __class_mymodule_Mytype_t & restrict self)
> {
>   static logical(kind=4) is_recursive.0 = 0;  // This disappears when NULL
> is returned
>   try
>     {
>       if (is_recursive.0)
>
> The fix is equally magical in that finishing build_empty_stmt seems to
> provide the backend with everything that it needs to retain these
> declarations. See the attached patch. If somebody can explain what causes
> the problem and why the patch fixes it, I would be very pleased. As far as
> I can tell, the tail end of trans_code should have been sufficient to
> handle the return of NULL_TREE.
>
> Anyway, work it does and regtests OK. OK for mainline and backporting?
>
> Regards
>
> Paul
>
>
Steve Kargl July 19, 2024, 4:41 p.m. UTC | #2
Thanks for the patch and chasing down the magic.
Path is ok to commit.
diff mbox series

Patch

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 477c2720187..d84ab46897f 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -1789,10 +1789,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);
 
@@ -1810,24 +1812,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;
 	}
     }
 
@@ -1841,7 +1844,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);
@@ -1871,6 +1874,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/pr115070.f90 b/gcc/testsuite/gfortran.dg/pr115070.f90
new file mode 100644
index 00000000000..9378f770e2c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr115070.f90
@@ -0,0 +1,28 @@ 
+! { dg-do compile }
+!
+! Test the fix for PR115070
+!
+! Contributed by Sebastien Bardeau  <bardeau@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 00000000000..bc644b2f1c0
--- /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.vandenbossche@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