re PR fortran/50981 ([OOP] Wrong-code for scalarizing ELEMENTAL call with absent...

fortran/
	PR fortran/50981
	* trans-expr.c (gfc_conv_procedure_call): Save se->ss's value.
	Handle the case of unallocated arrays passed to elemental procedures.

testsuite/
	PR fortran/50981
	* gfortran.dg/elemental_optional_args_5.f03: Add array checks.

From-SVN: r184896

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 961bd4e..005c9bc 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,11 @@
 2012-03-04  Mikael Morin  <mikael@gcc.gnu.org>
 
+       PR fortran/50981
+       * trans-expr.c (gfc_conv_procedure_call): Save se->ss's value. 
+       Handle the case of unallocated arrays passed to elemental procedures.
+
+2012-03-04  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.

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 5fb95b1..83e3c9c 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -3522,12 +3522,16 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
        }
       else if (se->ss && se->ss->info->useflags)
        {
+         gfc_ss *ss;
+
+         ss = se->ss;
+
          /* An elemental function inside a scalarized loop.  */
          gfc_init_se (&parmse, se);
          parm_kind = ELEMENTAL;
 
-         if (se->ss->dimen > 0 && e->expr_type == EXPR_VARIABLE
-             && se->ss->info->data.array.ref == NULL)
+         if (ss->dimen > 0 && e->expr_type == EXPR_VARIABLE
+             && ss->info->data.array.ref == NULL)
            {
              gfc_conv_tmp_array_ref (&parmse);
              if (e->ts.type == BT_CHARACTER)
@@ -3538,6 +3542,29 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
          else
            gfc_conv_expr_reference (&parmse, e);
 
+         /* 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)
+           {
+             tree descriptor_data;
+
+             descriptor_data = ss->info->data.array.data;
+             tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+                                    descriptor_data,
+                                    fold_convert (TREE_TYPE (descriptor_data),
+                                                  null_pointer_node));
+             parmse.expr
+               = fold_build3_loc (input_location, COND_EXPR,
+                                  TREE_TYPE (parmse.expr),
+                                  gfc_unlikely (tmp),
+                                  fold_convert (TREE_TYPE (parmse.expr), 
+                                                null_pointer_node),
+                                  parmse.expr);
+           }
+
          /* The scalarizer does not repackage the reference to a class
             array - instead it returns a pointer to the data element.  */
          if (fsym && fsym->ts.type == BT_CLASS && e->ts.type == BT_CLASS)

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 826f0f0..80ce63f 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2012-03-04  Mikael Morin  <mikael@gcc.gnu.org>
+
+       PR fortran/50981
+       * gfortran.dg/elemental_optional_args_5.f03: Add array checks.
+
 2012-03-04  Georg-Johann Lay  <avr@gjlay.de>
 
        * gcc.dg/torture/pr52402.c: Add dg-require-effective-target

diff --git a/gcc/testsuite/gfortran.dg/elemental_optional_args_5.f03 b/gcc/testsuite/gfortran.dg/elemental_optional_args_5.f03
index 70a27d8..74c1fa0 100644 (file)
--- a/gcc/testsuite/gfortran.dg/elemental_optional_args_5.f03
+++ b/gcc/testsuite/gfortran.dg/elemental_optional_args_5.f03
@@ -69,6 +69,51 @@ 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
 
@@ -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