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. ;-)
