Hello Andre,

comments below (out of order, sorry).

Le 29/05/2015 13:46, Andre Vehreschild a écrit :
> Hi Mikael,
> 
> comments inline below:
> 
> On Thu, 28 May 2015 20:06:57 +0200
> Mikael Morin <mikael.mo...@sfr.fr> wrote:
> 
>> Le 28/05/2015 17:29, Andre Vehreschild a écrit :
>>> *************** resolve_allocate_expr (gfc_expr *e, gfc_
>>> *** 7103,7112 ****
>>> --- 7103,7123 ----
>>>     if (!ref2 || ref2->type != REF_ARRAY || ref2->u.ar.type == AR_FULL
>>>         || (dimension && ref2->u.ar.dimen == 0))
>>>       {
>>> +       /* F08:C633.  */
>>> +       if (code->expr3)
>>> +   {
>>> +     if (!gfc_notify_std (GFC_STD_F2008, "Array specification
>>> required "
>>> +                          "in ALLOCATE statement at %L", &e->where))
>>> +       goto failure;
>>> +     *array_alloc_wo_spec = true;
>>> +   }
>>> +       else
>>> +   {
>>>       gfc_error ("Array specification required in ALLOCATE statement "
>>>                  "at %L", &e->where);
>>>       goto failure;
>>>     }
>>> +     }
>>>   
>>>     /* Make sure that the array section reference makes sense in the
>>>        context of an ALLOCATE specification.  */
>> I think we can be a little be more user friendly with the gfc_notify_std
>> error message.
>> Something like:
>> ALLOCATE without array spec at %L
>> ALLOCATE with array bounds determined from SOURCE or MOLD at %L
> 
> I didn't want to mess with the error messages to prevent issues for
> translations. So how is the policy on this? 
> 
I'm not aware of any policy regarding translations.
With a message like:
        fortran 2008: array specification required ...
I don't see how the user can understand that the array specification is
_not_ required with fortran 2008, regardless of translations.
I'm rather in favour of not having misleading diagnostic, even if
correctly translated.

--------

>>> *************** gfc_array_init_size (tree descriptor, in
>>> *** 5076,5085 ****
>>>   
>>>         /* Set upper bound.  */
>>>         gfc_init_se (&se, NULL);
>>>         gcc_assert (ubound);
>>>         gfc_conv_expr_type (&se, ubound, gfc_array_index_type);
>>>         gfc_add_block_to_block (pblock, &se.pre);
>>> ! 
>>>         gfc_conv_descriptor_ubound_set (descriptor_block, descriptor,
>>>                                   gfc_rank_cst[n], se.expr);
>>>         conv_ubound = se.expr;
>>> --- 5087,5111 ----
>>>   
>>>         /* Set upper bound.  */
>>>         gfc_init_se (&se, NULL);
>>> +       if (expr3_desc != NULL_TREE)
>>> +   {
>>> +     /* Set the upper bound to be (desc.ubound - desc.lbound)+ 1.  */
>>> +     tmp = fold_build2_loc (input_location, MINUS_EXPR,
>>> +                            gfc_array_index_type,
>>> +                            gfc_conv_descriptor_ubound_get (
>>> +                              expr3_desc, gfc_rank_cst[n]),
>>> +                            gfc_conv_descriptor_lbound_get (
>>> +                              expr3_desc, gfc_rank_cst[n]));
>>> +     se.expr = fold_build2_loc (input_location, PLUS_EXPR,
>>> +                                gfc_array_index_type, tmp,
>>> +                                gfc_index_one_node);
>>> +   }
>>> +       else
>>> +   {
>>>       gcc_assert (ubound);
>>>       gfc_conv_expr_type (&se, ubound, gfc_array_index_type);
>>>       gfc_add_block_to_block (pblock, &se.pre);
>>> !   }
>>>         gfc_conv_descriptor_ubound_set (descriptor_block, descriptor,
>>>                                   gfc_rank_cst[n], se.expr);
>>>         conv_ubound = se.expr;
>> Your one-based-ness problem was here, wasn't it?
> 
> Correct.
> 
>> I would rather copy directly lbound and ubound from expr3_desc to
>> descriptor.
> 
> It was that way in the previous version of the patch, which does *not* work 
> any
> longer. When gfc_trans_allocate () is responsible for the creating a temporary
> variable for the source=-expression, then it does so using zero based
> expressions. 
> 
>> If the source has non-one-based bounds, the above would produce wrong
>> bounds.
> 
> Counterexample? Note, the expr3_desc is guaranteed to be an artificial 
> variable
> created by conv_expr_descriptor, aka zero-based.
> 
here is a counterexample.

          integer, dimension(:), allocatable :: a, b

          allocate (a(0:3))
          allocate (b, source = a)
          print *, lbound(a, 1), ubound(a, 1)
          print *, lbound(b, 1), ubound(b, 1)
        end

output:
        0       3
        1       4


I think that if you set se.expr with
ubound with gfc_conv_descriptor_ubound_get(...) instead of what you do
above, and se.expr with gfc_conv_descriptor_lbound_get(...) instead of
gfc_index_one_node in the hunk before, it should work.

--------

> <snipp>
> 
>>> *************** gfc_trans_allocate (gfc_code * code)
>>> *** 5229,5235 ****
>>>         }
>>>       else
>>>         tmp = se.expr;
>>> !     if (!code->expr3->mold)
>>>         expr3 = tmp;
>>>       else
>>>         expr3_tmp = tmp;
>>> --- 5240,5248 ----
>>>         }
>>>       else
>>>         tmp = se.expr;
>>> !     if (code->ext.alloc.arr_spec_from_expr3)
>>> !       expr3_desc = tmp;
>>> !     else if (!code->expr3->mold)
>>>         expr3 = tmp;
>>>       else
>>>         expr3_tmp = tmp;
>> Couldn't expr3 be reused?
>> We had code->expr3, expr3, expr3rhs, and now this is adding expr3_desc,
>> and (below) inexpr3. :-(
> 
> Of course can we use just two variables for all expressions. I have removed 
> the
> expr3_tmp, inexpr3 and expr3_desc and introduced a e3_is enumeration, which
> stores which kind the expr3 is, aka unset, source, mold, desc. This makes the
> code simpler at some places.
> 
I have thought some more about the code not distinguishing source vs mold.
It seems to me that it makes sense to _not_ distinguish, and what you do
with e3_is == E3_MOLD seems bogus to me.  For example:

> @@ -5391,6 +5398,12 @@ gfc_trans_allocate (gfc_code * code)
>       }
>        gcc_assert (expr3_esize);
>        expr3_esize = fold_convert (sizetype, expr3_esize);
> +      if (e3_is == E3_MOLD)
> +     {
> +       /* The expr3 is no longer valid after this point.  */
> +       expr3 = NULL_TREE;
> +       e3_is = E3_UNSET;
> +     }
>      }
>    else if (code->ext.alloc.ts.type != BT_UNKNOWN)
>      {
You forget about the descriptor you have just created?!?

--------

About e3_is, I'm not very fond of it, and I think it can be replaced
using...
> +      e3_is = expr3 != NULL_TREE ?
> +         (code->ext.alloc.arr_spec_from_expr3 ?
> +            E3_DESC
> +          : (code->expr3->mold ? E3_MOLD : E3_SOURCE))
> +       : E3_UNSET;
>  
... the conditions defining it above directly.
That is replace e3_is == E3_DESC with
code->ext.alloc.arr_spec_from_expr3, etc.

--------

> @@ -5035,6 +5036,11 @@ gfc_array_init_size (tree descriptor, int rank, int 
> corank, tree * poffset,
>  
>    or_expr = boolean_false_node;
>  
> +  /* When expr3_desc is set, use its rank, because we want to allocate an
> +     array with the array_spec coming from source=.  */
> +  if (expr3_desc != NULL_TREE)
> +    rank = GFC_TYPE_ARRAY_RANK (TREE_TYPE (expr3_desc));
> +
>    for (n = 0; n < rank; n++)
>      {
>        tree conv_lbound;
This overrides the rank passed as argument.
Instead of this, calculate the correct rank...

> @@ -5338,10 +5392,11 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, 
> tree status, tree errmsg,
>    overflow = integer_zero_node;
>  
>    gfc_init_block (&set_descriptor_block);
> -  size = gfc_array_init_size (se->expr, ref->u.ar.as->rank,
> +  size = gfc_array_init_size (se->expr, alloc_w_e3_arr_spec ? expr->rank
> +                                                        : ref->u.ar.as->rank,
... here.  Wasn't it correct already by the way?

--------

> @@ -5174,25 +5174,26 @@ gfc_trans_allocate (gfc_code * code)
>       {
>         if (!code->expr3->mold
>             || code->expr3->ts.type == BT_CHARACTER
> -           || vtab_needed)
> +           || vtab_needed
> +           || code->ext.alloc.arr_spec_from_expr3)
>           {
>             /* Convert expr3 to a tree.  */
>             gfc_init_se (&se, NULL);
> -           /* For all "simple" expression just get the descriptor or the
> -              reference, respectively, depending on the rank of the expr.  */
> -           if (code->expr3->rank != 0)
> +           /* For all "simple" expression just get the descriptor
> +              or the reference, respectively, depending on the
> +              rank of the expr.  */
> +           if (code->ext.alloc.arr_spec_from_expr3 || code->expr3->rank != 0)
Hum, why this change?
Are there cases where arr_spec_from_expr3 is set and code->expr3->rank == 0?
And do you really want to call gfc_conv_expr_descriptor in such a case?

>               gfc_conv_expr_descriptor (&se, code->expr3);
>             else
>               gfc_conv_expr_reference (&se, code->expr3);
> -           if (!code->expr3->mold)
> -             expr3 = se.expr;
> -           else
> -             expr3_tmp = se.expr;
> +           /* Create a temp variable only for component refs.  */
> +           temp_var_needed = TREE_CODE (se.expr) == COMPONENT_REF;
Why only component refs?

>             expr3_len = se.string_length;
>             gfc_add_block_to_block (&block, &se.pre);
>             gfc_add_block_to_block (&post, &se.post);
>           }
> -       /* else expr3 = NULL_TREE set above.  */
> +       else
> +         se.expr = NULL_TREE;
>       }
>        else
>       {

--------

> diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
> index 9be8a42..3916836 100644
> --- a/gcc/fortran/trans-expr.c
> +++ b/gcc/fortran/trans-expr.c
> @@ -5328,7 +5328,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
>        if (e && (e->ts.type == BT_DERIVED || e->ts.type == BT_CLASS)
>           && e->ts.u.derived->attr.alloc_comp
>           && !(e->symtree && e->symtree->n.sym->attr.pointer)
> -         && (e->expr_type != EXPR_VARIABLE && !e->rank))
> +         && e->expr_type != EXPR_VARIABLE && !e->rank)
>          {
>         int parm_rank;
>         tmp = build_fold_indirect_ref_loc (input_location,
You don't change it, so don't touch it.

> Attached is a new version of the patch. This one fails
> allocate_with_source_3.f90 on runtime, where I don't see the issue currently.
> May be you have some luck and time. If not I will investigate on Monday.
> 
I haven't looked at it yet.  Tomorrow maybe.

Thanks for your patience so far.

Mikael

Reply via email to