diff mbox

[fortran] PR fortran/50981 segmentation fault when trying to access absent elemental actual arg

Message ID 4EFF4557.6000403@sfr.fr
State New
Headers show

Commit Message

Mikael Morin Dec. 31, 2011, 5:24 p.m. UTC
Hello, as promised, here is a fix for pr50981.

Currently, for a call to an elemental procedure, every scalar actual
argument is evaluated before the loop containing the function call.
The bug is, we can't evaluate the actual argument if it is a reference
to an absent optional dummy argument, as it will result in a NULL
pointer dereference.  We must pass the reference directly in that case.

To fix this, the call to gfc_conv_expr in gfc_add_loop_ss_code, must be
changed to a call to gfc_conv_expr_reference.  Such a change is
basically a revert of PR43841's fix, so we are back with a missed
optimization bug.  To avoid this we have to do the change only when it
is necessary, i.e. when the dummy argument is optional and the actual
argument is a reference to an optional dummy.  This information is
not available in gfc_add_loop_ss_code, so I make for it a new field
can_be_null_ref in the gfc_ss_info struct: this is the second patch.
Then, the third patch is about setting that field: as the dummy argument
information isn't either available in gfc_walk_elemental_function_args,
a new argument, proc_expr, is added, which holds the reference to the
procedure.  It is of type gfc_expr* so that it can handle direct calls
and type-bound calls equally well.

The first patch is for consistency: gfc_conv_expr should return values,
not references, so the address taking is moved where it is
actually requested (in gfc_conv_expr_reference).

Regression tested on x86_64-unknown-linux-gnu. OK for 4.7/4.6/4.5[/4.4] ?

Mikael.

PS: Greetings for the new year.
2011-12-29  Mikael Morin  <mikael@gcc.gnu.org>

	* trans-expr.c (gfc_conv_expr): Move address taking...
	(gfc_conv_expr_reference): ... here.
2011-12-29  Mikael Morin  <mikael@gcc.gnu.org>

	PR fortran/50981
	* trans.h (struct gfc_ss_info): New field data::scalar::can_be_null_ref
	* trans-array.c: If the reference can be NULL, save the reference
	instead of the value.
	* trans-expr.c (gfc_conv_expr): If we have saved a reference,
	dereference it.
2011-12-29  Mikael Morin  <mikael@gcc.gnu.org>

	PR fortran/50981
	* trans-array.h (gfc_walk_elemental_function_args): New argument.
	* trans-intrinsic.c (gfc_walk_intrinsic_function): Update call.
	* trans-stmt.c (gfc_trans_call): Ditto.
	* trans-array.c (gfc_walk_function_expr): Ditto.
	(gfc_walk_elemental_function_args): Get the dummy argument list
	if possible.  Check that the dummy and the actual argument are both
	optional, and set can_be_null_ref accordingly.
2011-12-29  Mikael Morin  <mikael@gcc.gnu.org>

	* elemental_optional_args_2.f90: New test.

Comments

Tobias Burnus Jan. 2, 2012, 11:20 a.m. UTC | #1
Hello Mikael,

Mikael Morin wrote:
> Regression tested on x86_64-unknown-linux-gnu. OK for 4.7/4.6/4.5[/4.4] ?

OK - thanks for the comprehensive patch explanation and for the patch 
itself.

> +	  else
> +	    {
> +	      /* Otherwise, evaluate the argument out of the loop and pass
> +		 a reference to the value.  */
> +	      gfc_conv_expr (&se, expr);

s/out of/outside/

> +	  if (dummy_arg != NULL
> +	&&  dummy_arg->sym->attr.optional
> +	&&  arg->expr
> +	&&  arg->expr->symtree
> +	&&  arg->expr->symtree->n.sym->attr.optional
> +	&&  arg->expr->ref == NULL)
> +	    newss->info->data.scalar.can_be_null_ref = true;

I wonder whether one needs to take special care for the following 
Fortran 2008 feature: "A null pointer can be used to denote an absent 
nonallocatable nonpoin-
ter optional argument." - I guess, one doesn't.

Tobias
diff mbox

Patch

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 19e081b..f8aece6 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -8295,12 +8295,16 @@  gfc_reverse_ss (gfc_ss * ss)
 }
 
 
-/* Walk the arguments of an elemental function.  */
+/* Walk the arguments of an elemental function.
+   PROC_EXPR is used to check whether an argument is permitted to be absent.  If
+   it is NULL, we don't do the check and the argument is assumed to be present.
+*/
 
 gfc_ss *
 gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
-				  gfc_ss_type type)
+				  gfc_expr *proc_expr, gfc_ss_type type)
 {
+  gfc_formal_arglist *dummy_arg;
   int scalar;
   gfc_ss *head;
   gfc_ss *tail;
@@ -8308,6 +8312,28 @@  gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
 
   head = gfc_ss_terminator;
   tail = NULL;
+
+  if (proc_expr)
+    {
+      gfc_ref *ref;
+
+      /* Normal procedure case.  */
+      dummy_arg = proc_expr->symtree->n.sym->formal;
+
+      /* Typebound procedure case.  */
+      for (ref = proc_expr->ref; ref; ref = ref->next)
+	{
+	  if (ref->type == REF_COMPONENT
+	      && ref->u.c.component->attr.proc_pointer
+	      && ref->u.c.component->ts.interface)
+	    dummy_arg = ref->u.c.component->ts.interface->formal;
+	  else
+	    dummy_arg = NULL;
+	}
+    }
+  else
+    dummy_arg = NULL;
+
   scalar = 1;
   for (; arg; arg = arg->next)
     {
@@ -8321,6 +8347,14 @@  gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
 	  gcc_assert (type == GFC_SS_SCALAR || type == GFC_SS_REFERENCE);
 	  newss = gfc_get_scalar_ss (head, arg->expr);
 	  newss->info->type = type;
+
+	  if (dummy_arg != NULL
+	      && dummy_arg->sym->attr.optional
+	      && arg->expr
+	      && arg->expr->symtree
+	      && arg->expr->symtree->n.sym->attr.optional
+	      && arg->expr->ref == NULL)
+	    newss->info->data.scalar.can_be_null_ref = true;
 	}
       else
 	scalar = 0;
@@ -8332,6 +8366,9 @@  gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
           while (tail->next != gfc_ss_terminator)
             tail = tail->next;
         }
+
+      if (dummy_arg != NULL)
+	dummy_arg = dummy_arg->next;
     }
 
   if (scalar)
@@ -8381,7 +8418,7 @@  gfc_walk_function_expr (gfc_ss * ss, gfc_expr * expr)
      by reference.  */
   if (sym->attr.elemental || (comp && comp->attr.elemental))
     return gfc_walk_elemental_function_args (ss, expr->value.function.actual,
-					     GFC_SS_REFERENCE);
+					     expr, GFC_SS_REFERENCE);
 
   /* Scalar functions are OK as these are evaluated outside the scalarization
      loop.  Pass back and let the caller deal with it.  */
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 340c1a7..19cfac5 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -73,7 +73,7 @@  gfc_ss *gfc_walk_subexpr (gfc_ss *, gfc_expr *);
 gfc_ss *gfc_walk_array_ref (gfc_ss *, gfc_expr *, gfc_ref * ref);
 /* Walk the arguments of an elemental function.  */
 gfc_ss *gfc_walk_elemental_function_args (gfc_ss *, gfc_actual_arglist *,
-					  gfc_ss_type);
+					  gfc_expr *, gfc_ss_type);
 /* Walk an intrinsic function.  */
 gfc_ss *gfc_walk_intrinsic_function (gfc_ss *, gfc_expr *,
 				     gfc_intrinsic_sym *);
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 5c964c1..900d546 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -7145,7 +7145,7 @@  gfc_walk_intrinsic_function (gfc_ss * ss, gfc_expr * expr,
 
   if (isym->elemental)
     return gfc_walk_elemental_function_args (ss, expr->value.function.actual,
-					     GFC_SS_SCALAR);
+					     NULL, GFC_SS_SCALAR);
 
   if (expr->rank == 0)
     return ss;
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 9e903d8..92f7f43 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -348,7 +348,8 @@  gfc_trans_call (gfc_code * code, bool dependency_check,
 
   ss = gfc_ss_terminator;
   if (code->resolved_sym->attr.elemental)
-    ss = gfc_walk_elemental_function_args (ss, code->ext.actual, GFC_SS_REFERENCE);
+    ss = gfc_walk_elemental_function_args (ss, code->ext.actual,
+					   code->expr1, GFC_SS_REFERENCE);
 
   /* Is not an elemental subroutine call with array valued arguments.  */
   if (ss == gfc_ss_terminator)