diff mbox

[fortran] PR50981 correctly handle absent arrays as actual argument to elemental procedures

Message ID 4F380B06.5050304@sfr.fr
State New
Headers show

Commit Message

Mikael Morin Feb. 12, 2012, 6:55 p.m. UTC 
Hello,

there was no specific handling for absent arrays passed as argument to 
elemental procedures.  So, because of scalarisation, we were passing an 
array element reference of a NULL pointer which was failing.

These patches add a conditional to pass NULL when the data pointer is 
NULL.  Normally, it would be best to have the conditional moved out of 
the loop.  However, for fear of combinatorial explosion and to avoid 
extra complexity when there is more than one optional argument, I have 
left the conditional in the loop, and hope that the middle-end will do 
the right thing.


The first patch moves the recently added `can_be_null_ref' field out of 
the scalar-only part of the data union in the gfc_ss_info struct, and 
also moves the code setting it out of the scalar-only block in 
gfc_walk_elemental_function_args.
The second patch adds the conditional in gfc_conv_procedure_call.  We 
need to make sure to save the value of se->ss, as gfc_conv_tmp_array_ref 
or gfc_conv_expr_reference will advance it to the next in the chain. 
Otherwise nothing special.

Regression tested on x86_64-unknown-freebsd9.0.  OK for trunk?

Mikael
2012-02-12  Mikael Morin  <mikael@gcc.gnu.org>

	* trans.h (struct gfc_ss_info): Move can_be_null_ref component from
	the data::scalar subcomponent to the toplevel.
	* trans-expr.c (gfc_conv_expr): Update component reference. 
	* trans-array.c (gfc_add_loop_ss_code): Ditto.
	(gfc_walk_elemental_function_args): Ditto.  Move the conditional setting
	the field out of the scalar-only block.
2012-02-12  Mikael Morin  <mikael@gcc.gnu.org>

	* trans-expr.c (gfc_conv_procedure_call): Save se->ss's value. 
	Handle the case of unallocated arrays passed to elemental procedures.
2012-02-12  Mikael Morin  <mikael@gcc.gnu.org>

	* gfortran.dg/elemental_optional_args_5.f03: Add array checks.
diff mbox

Patch

Index: elemental_optional_args_5.f03
===================================================================
--- elemental_optional_args_5.f03	(révision 184142)
+++ elemental_optional_args_5.f03	(copie de travail)
@@ -69,7 +69,52 @@  if (s /= 5*2) call abort()
 if (any (v /= [5*2, 5*2])) call abort()
 
 
+! ARRAY COMPONENTS: Non alloc/assoc
 
+v = [9, 33]
+
+call sub1 (v, x%a2, .false.)
+!print *, v
+if (any (v /= [9, 33])) call abort()
+
+call sub1 (v, x%p2, .false.)
+!print *, v
+if (any (v /= [9, 33])) call abort()
+
+
+! ARRAY COMPONENTS: alloc/assoc
+
+allocate (x%a2(2), x%p2(2))
+x%a2(:) = [84, 82]
+x%p2    = [35, 58]
+
+call sub1 (v, x%a2, .true.)
+!print *, v
+if (any (v /= [84*2, 82*2])) call abort()
+
+call sub1 (v, x%p2, .true.)
+!print *, v
+if (any (v /= [35*2, 58*2])) call abort()
+
+
+! =============== sub_t ==================
+! SCALAR DT: Non alloc/assoc
+
+s = 3
+v = [9, 33]
+
+call sub_t (s, ta, .false.)
+call sub_t (v, ta, .false.)
+!print *, s, v
+if (s /= 3) call abort()
+if (any (v /= [9, 33])) call abort()
+
+call sub_t (s, tp, .false.)
+call sub_t (v, tp, .false.)
+!print *, s, v
+if (s /= 3) call abort()
+if (any (v /= [9, 33])) call abort()
+
 contains
 
   elemental subroutine sub1 (x, y, alloc)
@@ -82,5 +127,15 @@  contains
       x = y*2
   end subroutine sub1
 
+  elemental subroutine sub_t(x, y, alloc)
+    integer, intent(inout) :: x
+    type(t), intent(in), optional :: y
+    logical, intent(in) :: alloc
+    if (alloc .neqv. present (y)) &
+      x = -99
+    if (present(y)) &
+      x = y%a*2
+  end subroutine sub_t
+
 end