diff mbox

[Fortran] PR71068 - fix ICE on invalid with coindexed DATA

Message ID 20160621141553.GA9633@physik.fu-berlin.de
State New
Headers show

Commit Message

Tobias Burnus June 21, 2016, 2:15 p.m. UTC
Dear all,

the problem comes up with:
   data a(1)[1] /1/
which is invalid. In resolve.c's check_data_variable(), one has:

  if (!gfc_resolve_expr (var->expr))
    return false;
...
  e = var->expr;

  if (e->expr_type != EXPR_VARIABLE)
    gfc_internal_error ("check_data_variable(): Bad expression");

which triggers as resolve_variable() has:

  if (t && flag_coarray == GFC_FCOARRAY_LIB && gfc_is_coindexed (e))
    add_caf_get_intrinsic (e);


The solution is either not to decorate the DATA variable with
caf_get() - or to strip it off for testing. The latter has been
done in this patch. It's not really beautify, but works.

Additionally, I had to add the argument-handling short cut
as otherwise, more and more caf_get() could be added around the
argument, which is both pointless and causes the strip off to
fail.


Build and regtested on x86-64-gnu-linux.
OK for the trunk? Or do you see a more beautiful approach?

Tobias

Comments

Paul Richard Thomas June 21, 2016, 5:46 p.m. UTC | #1
Dear Tobias,

"Beauty is in the eye of the beholder!" It works, it's good :-)

OK for trunk

Thanks for the patch

Paul

PS Why, in principle, can data objects not have co-indices?

On 21 June 2016 at 16:15, Tobias Burnus
<tobias.burnus@physik.fu-berlin.de> wrote:
> Dear all,
>
> the problem comes up with:
>    data a(1)[1] /1/
> which is invalid. In resolve.c's check_data_variable(), one has:
>
>   if (!gfc_resolve_expr (var->expr))
>     return false;
> ...
>   e = var->expr;
>
>   if (e->expr_type != EXPR_VARIABLE)
>     gfc_internal_error ("check_data_variable(): Bad expression");
>
> which triggers as resolve_variable() has:
>
>   if (t && flag_coarray == GFC_FCOARRAY_LIB && gfc_is_coindexed (e))
>     add_caf_get_intrinsic (e);
>
>
> The solution is either not to decorate the DATA variable with
> caf_get() - or to strip it off for testing. The latter has been
> done in this patch. It's not really beautify, but works.
>
> Additionally, I had to add the argument-handling short cut
> as otherwise, more and more caf_get() could be added around the
> argument, which is both pointless and causes the strip off to
> fail.
>
>
> Build and regtested on x86-64-gnu-linux.
> OK for the trunk? Or do you see a more beautiful approach?
>
> Tobias
Tobias Burnus June 21, 2016, 6:21 p.m. UTC | #2
Dear Paul,

Paul Richard Thomas wrote:
> Thanks for the patch
Thanks also from my side.

> PS Why, in principle, can data objects not have co-indices?

I think there is no really fundamental reason, but it doesn't make 
really sense. DATA is an explicit initialization, similar to
   "integer :: i = 5"
and (mostly) has implicitly the SAVE attribute. [5.6.7 @ J3/16-007r1] To 
initialize the variable on a remote image feels odd - especially as each 
image initializes it to the same value.

[Side remark, since I just stumbled over it: "The statement ordering 
rules allow DATA statements to appear anywhere in a program unit after 
the specification statements. The ability to position DATA statements 
amongst executable statements is very rarely used, unnecessary, and a 
potential source of error." (B.3.5 in the section of obsolescent 
features in F2015 (J3/16-007r1).)]

Cheers,

Tobias

>
> On 21 June 2016 at 16:15, Tobias Burnus
> <tobias.burnus@physik.fu-berlin.de> wrote:
>> Dear all,
>>
>> the problem comes up with:
>>     data a(1)[1] /1/
>> which is invalid. In resolve.c's check_data_variable(), one has:
>>
>>    if (!gfc_resolve_expr (var->expr))
>>      return false;
>> ...
>>    e = var->expr;
>>
>>    if (e->expr_type != EXPR_VARIABLE)
>>      gfc_internal_error ("check_data_variable(): Bad expression");
>>
>> which triggers as resolve_variable() has:
>>
>>    if (t && flag_coarray == GFC_FCOARRAY_LIB && gfc_is_coindexed (e))
>>      add_caf_get_intrinsic (e);
>>
>>
>> The solution is either not to decorate the DATA variable with
>> caf_get() - or to strip it off for testing. The latter has been
>> done in this patch. It's not really beautify, but works.
>>
>> Additionally, I had to add the argument-handling short cut
>> as otherwise, more and more caf_get() could be added around the
>> argument, which is both pointless and causes the strip off to
>> fail.
>>
>>
>> Build and regtested on x86-64-gnu-linux.
>> OK for the trunk? Or do you see a more beautiful approach?
>>
>> Tobias
>
>
diff mbox

Patch

	PR fortran/71068
	* resolve.c (resolve_function): Don't resolve caf_get/caf_send.
	(check_data_variable): Strip-off caf_get before checking.

	PR fortran/71068
	* gfortran.dg/coarray/data_1.f90: New.

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 77f8c10..4378313 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2923,6 +2923,13 @@  resolve_function (gfc_expr *expr)
   if (gfc_is_proc_ptr_comp (expr))
     return true;
 
+  /* Avoid re-resolving the arguments of caf_get, which can lead to inserting
+     another caf_get.  */
+  if (sym && sym->attr.intrinsic
+      && (sym->intmod_sym_id == GFC_ISYM_CAF_GET
+	  || sym->intmod_sym_id == GFC_ISYM_CAF_SEND))
+    return true;
+
   if (sym && sym->attr.intrinsic
       && !gfc_resolve_intrinsic (sym, &expr->where))
     return false;
@@ -14495,6 +14502,10 @@  check_data_variable (gfc_data_variable *var, locus *where)
   mpz_init_set_si (offset, 0);
   e = var->expr;
 
+  if (e->expr_type == EXPR_FUNCTION && e->value.function.isym
+      && e->value.function.isym->id == GFC_ISYM_CAF_GET)
+    e = e->value.function.actual->expr;
+
   if (e->expr_type != EXPR_VARIABLE)
     gfc_internal_error ("check_data_variable(): Bad expression");
 
diff --git a/gcc/testsuite/gfortran.dg/coarray/data_1.f90 b/gcc/testsuite/gfortran.dg/coarray/data_1.f90
new file mode 100644
index 0000000..d68ac14
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/data_1.f90
@@ -0,0 +1,11 @@ 
+! { dg-do compile }
+!
+! PR fortran/71068
+!
+! Contributed by Gerhard Steinmetz
+!
+program p
+   integer :: a(2)[*]
+   data a(1)[1] /1/  ! { dg-error "cannot have a coindex" }
+   data a(2)[1] /2/  ! { dg-error "cannot have a coindex" }
+end