* [Patch, fortran] PR50981 correctly handle absent arrays as actual argument to elemental procedures
@ 2012-02-12 19:08 Mikael Morin
0 siblings, 0 replies; 2+ messages in thread
From: Mikael Morin @ 2012-02-12 19:08 UTC (permalink / raw)
To: gfortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 1149 bytes --]
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
[-- Attachment #2: elemental_optional_array-1.CL --]
[-- Type: text/plain, Size: 392 bytes --]
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.
[-- Attachment #3: elemental_optional_array-1.patch --]
[-- Type: text/x-patch, Size: 2732 bytes --]
diff --git a/trans-array.c b/trans-array.c
index bbe5afe..b54c95b 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -2448,7 +2448,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
case GFC_SS_REFERENCE:
/* Scalar argument to elemental procedure. */
gfc_init_se (&se, NULL);
- if (ss_info->data.scalar.can_be_null_ref)
+ if (ss_info->can_be_null_ref)
{
/* If the actual argument can be absent (in other words, it can
be a NULL reference), don't try to evaluate it; pass instead
@@ -8493,17 +8493,18 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
newss = gfc_get_scalar_ss (head, arg->expr);
newss->info->type = type;
- if (dummy_arg != NULL
- && dummy_arg->sym->attr.optional
- && arg->expr->expr_type == EXPR_VARIABLE
- && (gfc_expr_attr (arg->expr).optional
- || gfc_expr_attr (arg->expr).allocatable
- || gfc_expr_attr (arg->expr).pointer))
- newss->info->data.scalar.can_be_null_ref = true;
}
else
scalar = 0;
+ if (dummy_arg != NULL
+ && dummy_arg->sym->attr.optional
+ && arg->expr->expr_type == EXPR_VARIABLE
+ && (gfc_expr_attr (arg->expr).optional
+ || gfc_expr_attr (arg->expr).allocatable
+ || gfc_expr_attr (arg->expr).pointer))
+ newss->info->can_be_null_ref = true;
+
head = newss;
if (!tail)
{
diff --git a/trans-expr.c b/trans-expr.c
index ec21838..5bca3d6 100644
--- a/trans-expr.c
+++ b/trans-expr.c
@@ -5457,7 +5457,7 @@ gfc_conv_expr (gfc_se * se, gfc_expr * expr)
se->expr = ss_info->data.scalar.value;
/* If the reference can be NULL, the value field contains the reference,
not the value the reference points to (see gfc_add_loop_ss_code). */
- if (ss_info->data.scalar.can_be_null_ref)
+ if (ss_info->can_be_null_ref)
se->expr = build_fold_indirect_ref_loc (input_location, se->expr);
se->string_length = ss_info->string_length;
diff --git a/trans.h b/trans.h
index e685a84..8beefe1 100644
--- a/trans.h
+++ b/trans.h
@@ -198,9 +198,6 @@ typedef struct gfc_ss_info
struct
{
tree value;
- /* Tells whether the reference can be null in the GFC_SS_REFERENCE case.
- Used to handle elemental procedures' optional arguments. */
- bool can_be_null_ref;
}
scalar;
@@ -223,6 +220,11 @@ typedef struct gfc_ss_info
/* Suppresses precalculation of scalars in WHERE assignments. */
unsigned where:1;
+
+ /* Tells whether the SS is for an actual argument which can be a NULL
+ reference. In other words, the associated dummy argument is OPTIONAL.
+ Used to handle elemental procedures. */
+ bool can_be_null_ref;
}
gfc_ss_info;
[-- Attachment #4: elemental_optional_array-2.CL --]
[-- Type: text/plain, Size: 186 bytes --]
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.
[-- Attachment #5: elemental_optional_array-2.patch --]
[-- Type: text/x-patch, Size: 1975 bytes --]
diff --git a/trans-expr.c b/trans-expr.c
index 5bca3d6..18ce1a7 100644
--- a/trans-expr.c
+++ b/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)
[-- Attachment #6: elemental_optional_array-tests.CL --]
[-- Type: text/plain, Size: 114 bytes --]
2012-02-12 Mikael Morin <mikael@gcc.gnu.org>
* gfortran.dg/elemental_optional_args_5.f03: Add array checks.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #7: elemental_optional_array-tests.patch --]
[-- Type: text/x-patch; name="elemental_optional_array-tests.patch", Size: 1587 bytes --]
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
^ permalink raw reply [flat|nested] 2+ messages in thread
* Re: [Patch, fortran] PR50981 correctly handle absent arrays as actual argument to elemental procedures
@ 2012-02-13 9:35 Tobias Burnus
0 siblings, 0 replies; 2+ messages in thread
From: Tobias Burnus @ 2012-02-13 9:35 UTC (permalink / raw)
To: Mikael Morin; +Cc: fortran, gcc-patches
Mikael Morin wrote:
> 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.
> Regression tested on x86_64-unknown-freebsd9.0. OK for trunk?
OK. Thanks for the patch.
Tobias
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2012-02-13 8:23 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2012-02-12 19:08 [Patch, fortran] PR50981 correctly handle absent arrays as actual argument to elemental procedures Mikael Morin
2012-02-13 9:35 Tobias Burnus
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).