Re: [PATCH] Fortran: passing of optional dummies to elemental procedures [PR113377]

2024-01-24 Thread Harald Anlauf

Hi Mikael,

Am 24.01.24 um 19:46 schrieb Mikael Morin:

Le 23/01/2024 à 21:36, Harald Anlauf a écrit :

Dear all,

here's the second part of a series for the treatment of missing
optional arguments passed to optional dummies, now fixing the
case that the latter procedures are elemental.  Adjustments
were necessary when the missing dummy has the VALUE attribute.

I factored the code for the treatment of VALUE, hoping that the
monster loop in gfc_conv_procedure_call will become slightly
easier to overlook.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?


Looks good, but...


Thanks,
Harald





diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 128add47516..0fac0523670 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc



@@ -6392,12 +6479,23 @@ gfc_conv_procedure_call (gfc_se * se,
gfc_symbol * sym,
 }
 }

+  /* Scalar dummy arguments of intrinsic type with VALUE
attribute.  */
+  if (fsym
+  && fsym->attr.value
+  && !fsym->attr.dimension
+  // && (fsym->ts.type != BT_CHARACTER
+  //   || gfc_length_one_character_type_p (>ts))


... please remove the commented code here.  OK with that change.


Duh!  I completely missed that during cleanup.


The !fsym->attr.dimension condition could be removed as well as we are
in the case of an elemental procedure at this point, but it doesn't harm
if you prefer keeping it.


You're absolutely right.  I've removed it.


Thanks for the patch.


Thanks for the review!

Harald



Mikael


+  && fsym->ts.type != BT_DERIVED
+  && fsym->ts.type != BT_CLASS)
+    conv_dummy_value (, e, fsym, optionalargs);
+
   /* If we are passing an absent array as optional dummy to an
  elemental procedure, make sure that we pass NULL when the data
  pointer is NULL.  We need this extra conditional because of
  scalarization which passes arrays elements to the procedure,
  ignoring the fact that the array can be
absent/unallocated/...  */
-  if (ss->info->can_be_null_ref && ss->info->type !=
GFC_SS_REFERENCE)
+  else if (ss->info->can_be_null_ref
+   && ss->info->type != GFC_SS_REFERENCE)
 {
   tree descriptor_data;








Re: [PATCH] Fortran: passing of optional dummies to elemental procedures [PR113377]

2024-01-24 Thread Mikael Morin

Le 23/01/2024 à 21:36, Harald Anlauf a écrit :

Dear all,

here's the second part of a series for the treatment of missing
optional arguments passed to optional dummies, now fixing the
case that the latter procedures are elemental.  Adjustments
were necessary when the missing dummy has the VALUE attribute.

I factored the code for the treatment of VALUE, hoping that the
monster loop in gfc_conv_procedure_call will become slightly
easier to overlook.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?


Looks good, but...


Thanks,
Harald





diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 128add47516..0fac0523670 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc



@@ -6392,12 +6479,23 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
}
}

+ /* Scalar dummy arguments of intrinsic type with VALUE attribute.  */
+ if (fsym
+ && fsym->attr.value
+ && !fsym->attr.dimension
+ // && (fsym->ts.type != BT_CHARACTER
+ //  || gfc_length_one_character_type_p (>ts))


... please remove the commented code here.  OK with that change.
The !fsym->attr.dimension condition could be removed as well as we are 
in the case of an elemental procedure at this point, but it doesn't harm 
if you prefer keeping it.

Thanks for the patch.

Mikael


+ && fsym->ts.type != BT_DERIVED
+ && fsym->ts.type != BT_CLASS)
+   conv_dummy_value (, e, fsym, optionalargs);
+
  /* If we are passing an absent array as optional dummy to an
 elemental procedure, make sure that we pass NULL when the data
 pointer is NULL.  We need this extra conditional because of
 scalarization which passes arrays elements to the procedure,
 ignoring the fact that the array can be absent/unallocated/...  */
- if (ss->info->can_be_null_ref && ss->info->type != GFC_SS_REFERENCE)
+ else if (ss->info->can_be_null_ref
+  && ss->info->type != GFC_SS_REFERENCE)
{
  tree descriptor_data;





[PATCH] Fortran: passing of optional dummies to elemental procedures [PR113377]

2024-01-23 Thread Harald Anlauf
Dear all,

here's the second part of a series for the treatment of missing
optional arguments passed to optional dummies, now fixing the
case that the latter procedures are elemental.  Adjustments
were necessary when the missing dummy has the VALUE attribute.

I factored the code for the treatment of VALUE, hoping that the
monster loop in gfc_conv_procedure_call will become slightly
easier to overlook.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald

From bd97af4225bf596260610ea37241ee503842435e Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Tue, 23 Jan 2024 21:23:42 +0100
Subject: [PATCH] Fortran: passing of optional dummies to elemental procedures
 [PR113377]

gcc/fortran/ChangeLog:

	PR fortran/113377
	* trans-expr.cc (conv_dummy_value): New.
	(gfc_conv_procedure_call): Factor code for handling dummy arguments
	with the VALUE attribute in the scalar case into conv_dummy_value().
	Reuse and adjust for calling elemental procedures.

gcc/testsuite/ChangeLog:

	PR fortran/113377
	* gfortran.dg/optional_absent_10.f90: New test.
---
 gcc/fortran/trans-expr.cc | 198 +---
 .../gfortran.dg/optional_absent_10.f90| 219 ++
 2 files changed, 333 insertions(+), 84 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/optional_absent_10.f90

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 128add47516..0fac0523670 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6075,6 +6075,105 @@ conv_cond_temp (gfc_se * parmse, gfc_expr * e, tree cond)
 }


+/* Helper function for the handling of (currently) scalar dummy variables
+   with the VALUE attribute.  Argument parmse should already be set up.  */
+static void
+conv_dummy_value (gfc_se * parmse, gfc_expr * e, gfc_symbol * fsym,
+		  vec *& optionalargs)
+{
+  tree tmp;
+
+  gcc_assert (fsym && fsym->attr.value && !fsym->attr.dimension);
+
+  /* Absent actual argument for optional scalar dummy.  */
+  if (e == NULL && fsym->attr.optional && !fsym->attr.dimension)
+{
+  /* For scalar arguments with VALUE attribute which are passed by
+	 value, pass "0" and a hidden argument for the optional status.  */
+  if (fsym->ts.type == BT_CHARACTER)
+	{
+	  /* Pass a NULL pointer for an absent CHARACTER arg and a length of
+	 zero.  */
+	  parmse->expr = null_pointer_node;
+	  parmse->string_length = build_int_cst (gfc_charlen_type_node, 0);
+	}
+  else
+	parmse->expr = fold_convert (gfc_sym_type (fsym),
+ integer_zero_node);
+  vec_safe_push (optionalargs, boolean_false_node);
+
+  return;
+}
+
+  /* gfortran argument passing conventions:
+ actual arguments to CHARACTER(len=1),VALUE
+ dummy arguments are actually passed by value.
+ Strings are truncated to length 1.  */
+  if (gfc_length_one_character_type_p (>ts))
+{
+  if (e->expr_type == EXPR_CONSTANT
+	  && e->value.character.length > 1)
+	{
+	  e->value.character.length = 1;
+	  gfc_conv_expr (parmse, e);
+	}
+
+  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;
+}
+
+  if (fsym->attr.optional
+  && fsym->ts.type != BT_CLASS
+  && fsym->ts.type != BT_DERIVED)
+{
+  /* F2018:15.5.2.12 Argument presence and
+	 restrictions on arguments not present.  */
+  if (e->expr_type == EXPR_VARIABLE
+	  && e->rank == 0
+	  && (gfc_expr_attr (e).allocatable
+	  || gfc_expr_attr (e).pointer))
+	{
+	  gfc_se argse;
+	  tree cond;
+	  gfc_init_se (, NULL);
+	  argse.want_pointer = 1;
+	  gfc_conv_expr (, e);
+	  cond = fold_convert (TREE_TYPE (argse.expr), null_pointer_node);
+	  cond = fold_build2_loc (input_location, NE_EXPR,
+  logical_type_node,
+  argse.expr, cond);
+	  vec_safe_push (optionalargs,
+			 fold_convert (boolean_type_node, cond));
+	  /* Create "conditional temporary".  */
+	  conv_cond_temp (parmse, e, cond);
+	}
+  else if (e->expr_type != EXPR_VARIABLE
+	   || !e->symtree->n.sym->attr.optional
+	   || (e->ref != NULL && e->ref->type != REF_ARRAY))
+	vec_safe_push (optionalargs, boolean_true_node);
+  else
+	{
+	  tmp = gfc_conv_expr_present (e->symtree->n.sym);
+	  if (e->ts.type != BT_CHARACTER && !e->symtree->n.sym->attr.value)
+	parmse->expr
+	  = fold_build3_loc (input_location, COND_EXPR,
+ TREE_TYPE (parmse->expr),
+ tmp, parmse->expr,
+ fold_convert (TREE_TYPE (parmse->expr),
+	   integer_zero_node));
+
+	  vec_safe_push (optionalargs,
+			 fold_convert (boolean_type_node, tmp))