[Bug fortran/92887] [F2008] Passing nullified/disassociated pointer or unalloc allocatable to OPTIONAL + VALUE dummy fails

["mikael at gcc dot gnu.org" <gcc-bugzilla@gcc.gnu.org>]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=92887

Mikael Morin <mikael at gcc dot gnu.org> changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
                 CC|                            |mikael at gcc dot gnu.org

--- Comment #5 from Mikael Morin <mikael at gcc dot gnu.org> ---
(In reply to anlauf from comment #4)
> 
> I'll need broader feedback, so unless someone adds to this pr, I'll submit
> the present patch - with testcases - to get attention.
> 
Here you go:

> diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
> index 45a984b6bdb..d9dcc11e5bd 100644
> --- a/gcc/fortran/trans-expr.cc
> +++ b/gcc/fortran/trans-expr.cc

> @@ -6396,7 +6399,28 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
>  			&& fsym->ts.type != BT_CLASS
>  			&& fsym->ts.type != BT_DERIVED)
>  		      {
> -			if (e->expr_type != EXPR_VARIABLE
> +			/* F2018:15.5.2.12 Argument presence and
> +			   restrictions on arguments not present.  */
> +			if (e->expr_type == EXPR_VARIABLE
> +			    && (e->symtree->n.sym->attr.allocatable
> +				|| e->symtree->n.sym->attr.pointer))

Beware of expressions like derived%alloc_comp or derived%pointer_comp which
don't match the above.

> +			  {
> +			    gfc_se argse;
> +			    gfc_init_se (&argse, NULL);
> +			    argse.want_pointer = 1;
> +			    gfc_conv_expr (&argse, e);
> +			    tmp = fold_convert (TREE_TYPE (argse.expr),
> +						null_pointer_node);
> +			    tmp = fold_build2_loc (input_location, NE_EXPR,
> +						   logical_type_node,
> +						   argse.expr, tmp);
> +			    vec_safe_push (optionalargs,
> +					   fold_convert (boolean_type_node,
> +							 tmp));
> +			    need_temp = true;
> +			    cond_temp = tmp;
> +			    }
> +			else if (e->expr_type != EXPR_VARIABLE
>  			    || !e->symtree->n.sym->attr.optional
>  			    || e->ref != NULL)
>  			  vec_safe_push (optionalargs, boolean_true_node);

> @@ -7072,6 +7096,42 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
>  	    }
>  	}
>  
> +      /* F2023:15.5.3, 15.5.4: Actual argument expressions are evaluated
> +	 before they are associated and a procedure is executed.  */
> +      if (e && e->expr_type != EXPR_VARIABLE && !gfc_is_constant_expr (e))
> +	{
> +	  /* Create temporary except for functions returning pointers that
> +	     can appear in a variable definition context.  */

Maybe explain *why* we have to create a temporary, that is some data references
may become  undefined by the procedure call (intent(out) dummies) so we have to
evaluate values depending on them beforehand (PR 92178).

> +	  if (e->expr_type != EXPR_FUNCTION
> +	      || !(gfc_expr_attr (e).pointer || gfc_expr_attr (e).proc_pointer))

Merge with the outer condition?

> +	    need_temp = true;
> +	}
> +
> +      if (need_temp)
> +	{
> +	  if (cond_temp == NULL_TREE)
> +	    parmse.expr = gfc_evaluate_now (parmse.expr, &parmse.pre);

I'm not sure about this.  The condition to set need_temp looks quite general
(especially it matches non-scalar cases, doesn't it?), but
gfc_conv_expr_reference should already take care of creating a variable, so
that a temporary is missing only for value dummies, I think.  I would rather
move this to the place specific to value dummies.

I think this PR is only about scalars with basic types, is there the same
problem with derived types?  with classes?
I guess arrays are different as they are always by reference?

> +	  else

I would rather move the else part to the place above where cond_temp is set, so
that the code is easier to follow.

> +	    {
> +	      /* "Conditional temporary" to handle variables that possibly
> +		 cannot be dereferenced.  Use null value as fallback.  */
> +	      tree dflt_temp;
> +	      gcc_assert (e->ts.type != BT_DERIVED && e->ts.type != BT_CLASS);
> +	      gcc_assert (e->rank == 0);
> +	      dflt_temp = gfc_create_var (TREE_TYPE (parmse.expr), "temp");
> +	      TREE_STATIC (dflt_temp) = 1;
> +	      TREE_CONSTANT (dflt_temp) = 1;
> +	      TREE_READONLY (dflt_temp) = 1;
> +	      DECL_INITIAL (dflt_temp) = build_zero_cst (TREE_TYPE (dflt_temp));
> +	      parmse.expr = fold_build3_loc (input_location, COND_EXPR,
> +					     TREE_TYPE (parmse.expr),
> +					     cond_temp,
> +					     parmse.expr, dflt_temp);
> +	      parmse.expr = gfc_evaluate_now (parmse.expr, &parmse.pre);
> +	    }
> +	}
> +
> +
>        if (fsym && need_interface_mapping && e)
>  	gfc_add_interface_mapping (&mapping, fsym, &parmse, e);
>