Re: [PATCH] Fortran: fix crash with bounds check writing array section [PR117791]

2024-11-29 Thread Andreas Schwab
../../gcc/fortran/trans-io.cc: In function 'tree_node* 
gfc_trans_transfer(gfc_code*)':
../../gcc/fortran/trans-io.cc:2662:24: error: enumeration value 'EXPR_UNKNOWN' 
not handled in switch [-Werror=switch]
 2662 | switch (ref->u.ar.start[n]->expr_type)
  |^
../../gcc/fortran/trans-io.cc:2662:24: error: enumeration value 'EXPR_CONSTANT' 
not handled in switch [-Werror=switch]
../../gcc/fortran/trans-io.cc:2662:24: error: enumeration value 'EXPR_VARIABLE' 
not handled in switch [-Werror=switch]
../../gcc/fortran/trans-io.cc:2662:24: error: enumeration value 
'EXPR_SUBSTRING' not handled in switch [-Werror=switch]
../../gcc/fortran/trans-io.cc:2662:24: error: enumeration value 
'EXPR_STRUCTURE' not handled in switch [-Werror=switch]
../../gcc/fortran/trans-io.cc:2662:24: error: enumeration value 'EXPR_ARRAY' 
not handled in switch [-Werror=switch]
../../gcc/fortran/trans-io.cc:2662:24: error: enumeration value 'EXPR_NULL' not 
handled in switch [-Werror=switch]
../../gcc/fortran/trans-io.cc:2662:24: error: enumeration value 'EXPR_COMPCALL' 
not handled in switch [-Werror=switch]
../../gcc/fortran/trans-io.cc:2662:24: error: enumeration value 'EXPR_PPC' not 
handled in switch [-Werror=switch]
cc1plus: all warnings being treated as errors
make[3]: *** [Makefile:1203: fortran/trans-io.o] Error 1

-- 
Andreas Schwab, sch...@linux-m68k.org
GPG Key fingerprint = 7578 EB47 D4E5 4D69 2510  2552 DF73 E780 A9DA AEC1
"And now for something completely different."


Re: [PATCH] Fortran: fix crash with bounds check writing array section [PR117791]

2024-11-29 Thread Tobias Burnus

H Harald, hi Paul,

Harald Anlauf wrote:

Pushed as r15-5766 .


This caused a build fail; see also: https://gcc.gnu.org/PR117843

It looks as if a 'default: break;' is missing.

…/gcc/fortran/trans-io.cc: In function 'tree_node* 
gfc_trans_transfer(gfc_code*)':
…/gcc/fortran/trans-io.cc:2662:24: error: enumeration value 
'EXPR_UNKNOWN' not handled in switch [-Werror=switch]

 2662 | switch (ref->u.ar.start[n]->expr_type)
  |^

Tobias


[PUSHED] fortran: Add default to switch in gfc_trans_transfer [PR117843]

2024-11-29 Thread Andrew Pinski
This fixes a bootstrap failure due to a warning on enum values not being
handled. In this case, it is just checking two values and the rest should
are not handled so adding a default case fixes the issue.

Pushed as obvious.

PR fortran/117843
gcc/fortran/ChangeLog:

* trans-io.cc (gfc_trans_transfer): Add default case.

Signed-off-by: Andrew Pinski 
---
 gcc/fortran/trans-io.cc | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/gcc/fortran/trans-io.cc b/gcc/fortran/trans-io.cc
index 906dd7c6eb6..9b0b8cfdff9 100644
--- a/gcc/fortran/trans-io.cc
+++ b/gcc/fortran/trans-io.cc
@@ -2664,6 +2664,8 @@ gfc_trans_transfer (gfc_code * code)
  case EXPR_FUNCTION:
  case EXPR_OP:
goto scalarize;
+ default:
+   break;
  }
  }
}
-- 
2.43.0



[Patch, fortran] PR102689 revisited - Segfault with RESHAPE of CLASS as actual argument

2024-11-29 Thread Paul Richard Thomas
Hi All,

This patch was originally pushed as r15-2739. Subsequently memory faults
were found and so the patch was reverted. At the time, I could find where
the problem lay. This morning I had another look and found it almost
immediately :-)

The fix is the 'gfc_resize_class_size_with_len' in the chunk '@@ -1595,14
+1629,51 @@ gfc_trans_create_temp_array '. Without it,, half as much memory
as needed was being provided by the allocation and so accesses were
occurring outside the allocated space. Valgrind now reports no errors.

Regression tests with flying colours - OK for mainline?

Paul
diff --git a/gcc/fortran/class.cc b/gcc/fortran/class.cc
index 59ac0d97e08..64a0e726eeb 100644
--- a/gcc/fortran/class.cc
+++ b/gcc/fortran/class.cc
@@ -884,11 +884,21 @@ static void
 add_proc_comp (gfc_symbol *vtype, const char *name, gfc_typebound_proc *tb)
 {
   gfc_component *c;
-
+  bool is_abstract = false;
 
   c = gfc_find_component (vtype, name, true, true, NULL);
 
-  if (tb->non_overridable && !tb->overridden && c)
+  /* If the present component typebound proc is abstract, the new version
+ should unconditionally be tested if it is a suitable replacement.  */
+  if (c && c->tb && c->tb->u.specific
+  && c->tb->u.specific->n.sym->attr.abstract)
+is_abstract = true;
+
+  /* Pass on the new tb being not overridable if a component is found and
+ either there is not an overridden specific or the present component
+ tb is abstract. This ensures that possible, viable replacements are
+ loaded.  */
+  if (tb->non_overridable && !tb->overridden && !is_abstract && c)
 return;
 
   if (c == NULL)
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 0d3845f9ce3..afed8db7852 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -3229,8 +3229,8 @@ static bool check_pure_function (gfc_expr *e)
   const char *name = NULL;
   code_stack *stack;
   bool saw_block = false;
-  
-  /* A BLOCK construct within a DO CONCURRENT construct leads to 
+
+  /* A BLOCK construct within a DO CONCURRENT construct leads to
  gfc_do_concurrent_flag = 0 when the check for an impure function
  occurs.  Check the stack to see if the source code has a nested
  BLOCK construct.  */
@@ -16305,10 +16305,6 @@ resolve_fl_derived (gfc_symbol *sym)
   && sym->ns->proc_name
   && sym->ns->proc_name->attr.flavor == FL_MODULE
   && sym->attr.access != ACCESS_PRIVATE
-  && !(sym->attr.extension
-	   && sym->attr.zero_comp
-	   && !sym->f2k_derived->tb_sym_root
-	   && !sym->f2k_derived->tb_uop_root)
   && !(sym->attr.vtype || sym->attr.pdt_template))
 {
   gfc_symbol *vtab = gfc_find_derived_vtab (sym);
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index a458af322ce..870f2920ddc 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1325,23 +1325,28 @@ get_array_ref_dim_for_loop_dim (gfc_ss *ss, int loop_dim)
is a class expression.  */
 
 static tree
-get_class_info_from_ss (stmtblock_t * pre, gfc_ss *ss, tree *eltype)
+get_class_info_from_ss (stmtblock_t * pre, gfc_ss *ss, tree *eltype,
+			gfc_ss **fcnss)
 {
+  gfc_ss *loop_ss = ss->loop->ss;
   gfc_ss *lhs_ss;
   gfc_ss *rhs_ss;
+  gfc_ss *fcn_ss = NULL;
   tree tmp;
   tree tmp2;
   tree vptr;
-  tree rhs_class_expr = NULL_TREE;
+  tree class_expr = NULL_TREE;
   tree lhs_class_expr = NULL_TREE;
   bool unlimited_rhs = false;
   bool unlimited_lhs = false;
   bool rhs_function = false;
+  bool unlimited_arg1 = false;
   gfc_symbol *vtab;
+  tree cntnr = NULL_TREE;
 
   /* The second element in the loop chain contains the source for the
- temporary; ie. the rhs of the assignment.  */
-  rhs_ss = ss->loop->ss->loop_chain;
+ class temporary created in gfc_trans_create_temp_array.  */
+  rhs_ss = loop_ss->loop_chain;
 
   if (rhs_ss != gfc_ss_terminator
   && rhs_ss->info
@@ -1350,28 +1355,58 @@ get_class_info_from_ss (stmtblock_t * pre, gfc_ss *ss, tree *eltype)
   && rhs_ss->info->data.array.descriptor)
 {
   if (rhs_ss->info->expr->expr_type != EXPR_VARIABLE)
-	rhs_class_expr
+	class_expr
 	  = gfc_get_class_from_expr (rhs_ss->info->data.array.descriptor);
   else
-	rhs_class_expr = gfc_get_class_from_gfc_expr (rhs_ss->info->expr);
+	class_expr = gfc_get_class_from_gfc_expr (rhs_ss->info->expr);
   unlimited_rhs = UNLIMITED_POLY (rhs_ss->info->expr);
   if (rhs_ss->info->expr->expr_type == EXPR_FUNCTION)
 	rhs_function = true;
 }
 
+  /* Usually, ss points to the function. When the function call is an actual
+ argument, it is instead rhs_ss because the ss chain is shifted by one.  */
+  *fcnss = fcn_ss = rhs_function ? rhs_ss : ss;
+
+  /* If this is a transformational function with a class result, the info
+ class_container field points to the class container of arg1.  */
+  if (class_expr != NULL_TREE
+  && fcn_ss->info && fcn_ss->info->expr
+  && fcn_ss->info->expr->expr_type == EXPR_FUNCTION
+  && fcn_s

Re: [PUSHED] fortran: Add default to switch in gfc_trans_transfer [PR117843]

2024-11-29 Thread Harald Anlauf

Thanks, Andrew, for fixing this!

I did not get any reports from the pre-commit testers; I only
saw the fallout later.

And sorry for breaking bootstrap!

Harald

Am 29.11.24 um 10:16 schrieb Andrew Pinski:

This fixes a bootstrap failure due to a warning on enum values not being
handled. In this case, it is just checking two values and the rest should
are not handled so adding a default case fixes the issue.

Pushed as obvious.

PR fortran/117843
gcc/fortran/ChangeLog:

* trans-io.cc (gfc_trans_transfer): Add default case.

Signed-off-by: Andrew Pinski 
---
  gcc/fortran/trans-io.cc | 2 ++
  1 file changed, 2 insertions(+)

diff --git a/gcc/fortran/trans-io.cc b/gcc/fortran/trans-io.cc
index 906dd7c6eb6..9b0b8cfdff9 100644
--- a/gcc/fortran/trans-io.cc
+++ b/gcc/fortran/trans-io.cc
@@ -2664,6 +2664,8 @@ gfc_trans_transfer (gfc_code * code)
  case EXPR_FUNCTION:
  case EXPR_OP:
goto scalarize;
+ default:
+   break;
  }
  }
}




Re: [Patch, fortran] PR102689 revisited - Segfault with RESHAPE of CLASS as actual argument

2024-11-29 Thread Harald Anlauf

Hi Paul,

the patch seems to contain stuff that has already been pushed
(gcc/testsuite/gfortran.dg/pr117768.f90, and the chunks in
class.cc and resolve.cc).  Can you please check?

Cheers,
Harald

Am 29.11.24 um 17:34 schrieb Paul Richard Thomas:

Hi All,

This patch was originally pushed as r15-2739. Subsequently memory faults
were found and so the patch was reverted. At the time, I could find where
the problem lay. This morning I had another look and found it almost
immediately :-)

The fix is the 'gfc_resize_class_size_with_len' in the chunk '@@ -1595,14
+1629,51 @@ gfc_trans_create_temp_array '. Without it,, half as much memory
as needed was being provided by the allocation and so accesses were
occurring outside the allocated space. Valgrind now reports no errors.

Regression tests with flying colours - OK for mainline?

Paul





Re: [Patch, fortran] PR102689 revisited - Segfault with RESHAPE of CLASS as actual argument

2024-11-29 Thread Paul Richard Thomas
Hi Harald,

Sorry about that - it was the standard HEAD versus HEAD~ mistake.

Thanks for pointing it out.

Paul


On Fri, 29 Nov 2024 at 17:31, Harald Anlauf  wrote:

> Hi Paul,
>
> the patch seems to contain stuff that has already been pushed
> (gcc/testsuite/gfortran.dg/pr117768.f90, and the chunks in
> class.cc and resolve.cc).  Can you please check?
>
> Cheers,
> Harald
>
> Am 29.11.24 um 17:34 schrieb Paul Richard Thomas:
> > Hi All,
> >
> > This patch was originally pushed as r15-2739. Subsequently memory faults
> > were found and so the patch was reverted. At the time, I could find where
> > the problem lay. This morning I had another look and found it almost
> > immediately :-)
> >
> > The fix is the 'gfc_resize_class_size_with_len' in the chunk '@@ -1595,14
> > +1629,51 @@ gfc_trans_create_temp_array '. Without it,, half as much
> memory
> > as needed was being provided by the allocation and so accesses were
> > occurring outside the allocated space. Valgrind now reports no errors.
> >
> > Regression tests with flying colours - OK for mainline?
> >
> > Paul
> >
>
>
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index a458af322ce..870f2920ddc 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1325,23 +1325,28 @@ get_array_ref_dim_for_loop_dim (gfc_ss *ss, int loop_dim)
is a class expression.  */
 
 static tree
-get_class_info_from_ss (stmtblock_t * pre, gfc_ss *ss, tree *eltype)
+get_class_info_from_ss (stmtblock_t * pre, gfc_ss *ss, tree *eltype,
+			gfc_ss **fcnss)
 {
+  gfc_ss *loop_ss = ss->loop->ss;
   gfc_ss *lhs_ss;
   gfc_ss *rhs_ss;
+  gfc_ss *fcn_ss = NULL;
   tree tmp;
   tree tmp2;
   tree vptr;
-  tree rhs_class_expr = NULL_TREE;
+  tree class_expr = NULL_TREE;
   tree lhs_class_expr = NULL_TREE;
   bool unlimited_rhs = false;
   bool unlimited_lhs = false;
   bool rhs_function = false;
+  bool unlimited_arg1 = false;
   gfc_symbol *vtab;
+  tree cntnr = NULL_TREE;
 
   /* The second element in the loop chain contains the source for the
- temporary; ie. the rhs of the assignment.  */
-  rhs_ss = ss->loop->ss->loop_chain;
+ class temporary created in gfc_trans_create_temp_array.  */
+  rhs_ss = loop_ss->loop_chain;
 
   if (rhs_ss != gfc_ss_terminator
   && rhs_ss->info
@@ -1350,28 +1355,58 @@ get_class_info_from_ss (stmtblock_t * pre, gfc_ss *ss, tree *eltype)
   && rhs_ss->info->data.array.descriptor)
 {
   if (rhs_ss->info->expr->expr_type != EXPR_VARIABLE)
-	rhs_class_expr
+	class_expr
 	  = gfc_get_class_from_expr (rhs_ss->info->data.array.descriptor);
   else
-	rhs_class_expr = gfc_get_class_from_gfc_expr (rhs_ss->info->expr);
+	class_expr = gfc_get_class_from_gfc_expr (rhs_ss->info->expr);
   unlimited_rhs = UNLIMITED_POLY (rhs_ss->info->expr);
   if (rhs_ss->info->expr->expr_type == EXPR_FUNCTION)
 	rhs_function = true;
 }
 
+  /* Usually, ss points to the function. When the function call is an actual
+ argument, it is instead rhs_ss because the ss chain is shifted by one.  */
+  *fcnss = fcn_ss = rhs_function ? rhs_ss : ss;
+
+  /* If this is a transformational function with a class result, the info
+ class_container field points to the class container of arg1.  */
+  if (class_expr != NULL_TREE
+  && fcn_ss->info && fcn_ss->info->expr
+  && fcn_ss->info->expr->expr_type == EXPR_FUNCTION
+  && fcn_ss->info->expr->value.function.isym
+  && fcn_ss->info->expr->value.function.isym->transformational)
+{
+  cntnr = ss->info->class_container;
+  unlimited_arg1
+	   = UNLIMITED_POLY (fcn_ss->info->expr->value.function.actual->expr);
+}
+
   /* For an assignment the lhs is the next element in the loop chain.
  If we have a class rhs, this had better be a class variable
- expression!  */
+ expression!  Otherwise, the class container from arg1 can be used
+ to set the vptr and len fields of the result class container.  */
   lhs_ss = rhs_ss->loop_chain;
-  if (lhs_ss != gfc_ss_terminator
-  && lhs_ss->info
-  && lhs_ss->info->expr
+  if (lhs_ss && lhs_ss != gfc_ss_terminator
+  && lhs_ss->info && lhs_ss->info->expr
   && lhs_ss->info->expr->expr_type ==EXPR_VARIABLE
   && lhs_ss->info->expr->ts.type == BT_CLASS)
 {
   tmp = lhs_ss->info->data.array.descriptor;
   unlimited_lhs = UNLIMITED_POLY (rhs_ss->info->expr);
 }
+  else if (cntnr != NULL_TREE)
+{
+  tmp = gfc_class_vptr_get (class_expr);
+  gfc_add_modify (pre, tmp, fold_convert (TREE_TYPE (tmp),
+	  gfc_class_vptr_get (cntnr)));
+  if (unlimited_rhs)
+	{
+	  tmp = gfc_class_len_get (class_expr);
+	  if (unlimited_arg1)
+	gfc_add_modify (pre, tmp, gfc_class_len_get (cntnr));
+	}
+  tmp = NULL_TREE;
+}
   else
 tmp = NULL_TREE;
 
@@ -1379,35 +1414,33 @@ get_class_info_from_ss (stmtblock_t * pre, gfc_ss *ss, tree *eltype)
   if (tmp != NULL_TREE && lhs_ss->loop_chain == gfc_ss_terminator)
 lhs_class_expr = gf