Dear Mikael,

Thank you very much for the review. I'll give consideration to your
remarks over the weekend. You will have guessed from the comment that
I too was uneasy about forcing the break. As for your last remark,
yes, the code rewriting is indeed in the wrong place. It should be
rather easy to accomplish both the checks and defined assignments.

Thanks again

Paul

On 17 September 2015 at 15:43, Mikael Morin <mikael.mo...@sfr.fr> wrote:
> Le 06/09/2015 18:40, Paul Richard Thomas a écrit :
>>
>> It helps to attach the patch :-)
>>
>> Paul
>>
>> On 6 September 2015 at 13:42, Paul Richard Thomas
>> <paul.richard.tho...@gmail.com> wrote:
>>>
>>> Dear All,
>>>
>>> The attached patch more or less implements the assignment of
>>> expressions to the result of a pointer function. To wit:
>>>
>>> my_ptr_fcn (arg1, arg2...) = expr
>>>
>>> arg1 would usually be the target, pointed to by the function. The
>>> patch parses these statements and resolves them into:
>>>
>>> temp_ptr => my_ptr_fcn (arg1, arg2...)
>>> temp_ptr = expr
>>>
>>> I say more or less implemented because I have ducked one of the
>>> headaches here. At the end of the specification block, there is an
>>> ambiguity between statement functions and pointer function
>>> assignments. I do not even try to resolve this ambiguity and require
>>> that there be at least one other type of executable statement before
>>> these beasts. This can undoubtedly be fixed but the effort seems to me
>>> to be unwarranted at the present time.
>>>
>>> This version of the patch extends the coverage of allowed rvalues to
>>> any legal expression. Also, all the problems with error.c have been
>>> dealt with by Manuel's patch.
>>>
>>> I am grateful to Dominique for reminding me of PR40054 and pointing
>>> out PR63921. After a remark of his on #gfortran, I fixed the checking
>>> of the standard to pick up all the offending lines with F2003 and
>>> earlier.
>>>
>>>
>>> Bootstraps and regtests on FC21/x86_64 - OK for trunk?
>>>
> Hello Paul,
>
> I'm mostly concerned about the position where the code rewriting happens.
> Details below.
>
> Mikael
>
>
>>
>> submit_2.diff
>>
>
>> Index: gcc/fortran/parse.c
>> ===================================================================
>> *** gcc/fortran/parse.c (revision 227508)
>> --- gcc/fortran/parse.c (working copy)
>> *************** decode_statement (void)
>> *** 356,362 ****
>> --- 357,371 ----
>>
>>     match (NULL, gfc_match_assignment, ST_ASSIGNMENT);
>>     match (NULL, gfc_match_pointer_assignment, ST_POINTER_ASSIGNMENT);
>> +
>> +   if (in_specification_block)
>> +     {
>>     match (NULL, gfc_match_st_function, ST_STATEMENT_FUNCTION);
>> +     }
>> +   else if (!gfc_notification_std (GFC_STD_F2008))
>> +     {
>> +       match (NULL, gfc_match_ptr_fcn_assign, ST_ASSIGNMENT);
>> +     }
>>
> As match exits the function upon success, I think it makes sense to move
> match (... gfc_match_ptr_fcn_assign ...) out of the else, namely:
>
>   if (in_specification_block)
>     {
>       /* match statement function */
>     }
>
>   /* match pointer fonction assignment */
>
> so that non-ambiguous cases are recognized with gfc_match_ptr_fcn_assign.
> Non-ambiguous cases are for example the ones where one of the function
> arguments is a non-variable, or a variable with a subreference, or when
> there is one keyword argument. Example (rejected with unclassifiable
> statement):
>
> program p
>   integer, parameter :: b = 3
>   integer, target    :: a = 2
>
>   func(arg=b) = 1
>   if (a /= 1) call abort
>
>   func(b + b - 3) = -1
>   if (a /= -1) call abort
>
> contains
>   function func(arg) result(r)
>     integer, pointer :: r
>     integer :: arg
>
>     if (arg == 3) then
>       r => a
>     else
>       r => null()
>     end if
>   end function func
> end program p
>
>
>> Index: gcc/fortran/resolve.c
>> ===================================================================
>> *** gcc/fortran/resolve.c       (revision 227508)
>> --- gcc/fortran/resolve.c       (working copy)
>> *************** generate_component_assignments (gfc_code
>> *** 10133,10138 ****
>> --- 10141,10205 ----
>>   }
>>
>>
>> + /* F2008: Pointer function assignments are of the form:
>> +       ptr_fcn (args) = expr
>> +    This function breaks these assignments into two statements:
>> +       temporary_pointer => ptr_fcn(args)
>> +       temporary_pointer = expr  */
>> +
>> + static bool
>> + resolve_ptr_fcn_assign (gfc_code **code, gfc_namespace *ns)
>> + {
>> +   gfc_expr *tmp_ptr_expr;
>> +   gfc_code *this_code;
>> +   gfc_component *comp;
>> +   gfc_symbol *s;
>> +
>> +   if ((*code)->expr1->expr_type != EXPR_FUNCTION)
>> +     return false;
>> +
>> +   /* Even if standard does not support this feature, continue to build
>> +      the two statements to avoid upsetting frontend_passes.c.  */
>
> I don't mind this, but maybe we should return false at the end, when an
> error has been emitted?
>
>> +   gfc_notify_std (GFC_STD_F2008, "Pointer procedure assignment at "
>> +                 "%L", &(*code)->loc);
>> +
>> +   comp = gfc_get_proc_ptr_comp ((*code)->expr1);
>> +
>> +   if (comp)
>> +     s = comp->ts.interface;
>> +   else
>> +     s = (*code)->expr1->symtree->n.sym;
>> +
>> +   if (s == NULL || !s->result->attr.pointer)
>> +     {
>> +       gfc_error ("F2008: The function result at %L must have "
>> +                "the pointer attribute.", &(*code)->expr1->where);
>> +       /* Return true because we want a break after the call.  */
>
> Hum, I would rather not do this if possible.  Do we really need the break?
>
>> +       return true;
>> +     }
>> +
>> +   tmp_ptr_expr = get_temp_from_expr ((*code)->expr2, ns);
>> +
>> +   /* get_temp_from_expression is set up for ordinary assignments. To
>> that
>> +      end, where array bounds are not known, arrays are made allocatable.
>> +      Change the temporary to a pointer here.  */
>> +   tmp_ptr_expr->symtree->n.sym->attr.pointer = 1;
>> +   tmp_ptr_expr->symtree->n.sym->attr.allocatable = 0;
>> +
>> +   this_code = build_assignment (EXEC_ASSIGN,
>> +                               tmp_ptr_expr, (*code)->expr2,
>> +                               NULL, NULL, (*code)->loc);
>> +   this_code->next = (*code)->next;
>> +   (*code)->next = this_code;
>> +   (*code)->op = EXEC_POINTER_ASSIGN;
>> +   (*code)->expr2 = (*code)->expr1;
>> +   (*code)->expr1 = tmp_ptr_expr;
>> +
>> +   *code = (*code)->next;
>> +   return true;
>> + }
>> +
>> +
>>   /* Given a block of code, recursively resolve everything pointed to by
>> this
>>      code block.  */
>>
>> *************** gfc_resolve_code (gfc_code *code, gfc_na
>> *** 10318,10323 ****
>> --- 10385,10393 ----
>>               && code->expr1->value.function.isym->id == GFC_ISYM_CAF_GET)
>>             remove_caf_get_intrinsic (code->expr1);
>>
>> +         if (resolve_ptr_fcn_assign (&code, ns))
>> +           break;
>> +
>>           if (!gfc_check_vardef_context (code->expr1, false, false, false,
>>                                          _("assignment")))
>>             break;
>
>
> I think the call should be added later in the pipeline, and I suspect the
> break should be removed.
> As it stands, the code bypasses many of the checks we do normally for
> assignments.
> For example, the following is accepted, despite the incompatible ranks.
>
> program p
>   integer, target :: a(3) = 2
>   integer :: b(3, 3) = 1
>   integer :: c
>
>   c = 1
> ! func(b(2, 2)) = b
>   func(c) = b
>
> contains
>   function func(arg) result(r)
>     integer, pointer :: r(:)
>     integer :: arg
>
>     if (arg == 1) then
>       r => a
>     else
>       r => null()
>     end if
>   end function func
> end program p
>
>
> I'm also concerned about defined assignments.
> Combining them with pointer function lhs should be possible, The code
> rewriting just has to happen at the right place. ;-)



-- 
Outside of a dog, a book is a man's best friend. Inside of a dog it's
too dark to read.

Groucho Marx

Reply via email to