Attached is a small coarray fix, solving two issues:
- For -fcoarray=single, nonallocatable coarrays are nonpointer - but
currently they get set the "restrict" qualifier. (With -fcoarray=lib,
nonallocatble coarrays are always pointers.)
Fixed by not setting "restricted" in this case.
- The pointer association status may not be checked/modified on remote
images. And remote (de)allocate is also invalid. However, some of those
constraint checks were missing
OK for the trunk?
Tobias
2011-05-27 Tobias Burnus <bur...@net-b.de>
PR fortran/18918
* check.c (gfc_check_associated, gfc_check_null): Add coindexed check.
* match.c (gfc_match_nullify): Ditto.
* resolve.c (resolve_deallocate_expr): Ditto.
* trans-types.c (gfc_get_nodesc_array_type): Don't set restricted
for nonpointers.
2011-05-27 Tobias Burnus <bur...@net-b.de>
PR fortran/18918
* gfortran.dg/coarray_22.f90: New.
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 8641142..544253c 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -875,6 +875,15 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target)
return FAILURE;
}
+ /* F2008, C1242. */
+ if (attr1.pointer && gfc_is_coindexed (pointer))
+ {
+ gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be "
+ "conindexed", gfc_current_intrinsic_arg[0]->name,
+ gfc_current_intrinsic, &pointer->where);
+ return FAILURE;
+ }
+
/* Target argument is optional. */
if (target == NULL)
return SUCCESS;
@@ -902,6 +911,15 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target)
return FAILURE;
}
+ /* F2008, C1242. */
+ if (attr1.pointer && gfc_is_coindexed (target))
+ {
+ gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be "
+ "conindexed", gfc_current_intrinsic_arg[1]->name,
+ gfc_current_intrinsic, &target->where);
+ return FAILURE;
+ }
+
t = SUCCESS;
if (same_type_check (pointer, 0, target, 1) == FAILURE)
t = FAILURE;
@@ -2651,6 +2669,15 @@ gfc_check_null (gfc_expr *mold)
return FAILURE;
}
+ /* F2008, C1242. */
+ if (gfc_is_coindexed (mold))
+ {
+ gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be "
+ "conindexed", gfc_current_intrinsic_arg[0]->name,
+ gfc_current_intrinsic, &mold->where);
+ return FAILURE;
+ }
+
return SUCCESS;
}
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 9c4f5f6..94b9a59 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1543,13 +1543,12 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed,
if (as->rank == 0)
{
if (packed != PACKED_STATIC || gfc_option.coarray == GFC_FCOARRAY_LIB)
- type = build_pointer_type (type);
+ {
+ type = build_pointer_type (type);
- if (restricted)
- type = build_qualified_type (type, TYPE_QUAL_RESTRICT);
+ if (restricted)
+ type = build_qualified_type (type, TYPE_QUAL_RESTRICT);
- if (packed != PACKED_STATIC || gfc_option.coarray == GFC_FCOARRAY_LIB)
- {
GFC_ARRAY_TYPE_P (type) = 1;
TYPE_LANG_SPECIFIC (type) = TYPE_LANG_SPECIFIC (TREE_TYPE (type));
}
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 75f2a7f..f275239 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -3194,6 +3194,13 @@ gfc_match_nullify (void)
if (gfc_check_do_variable (p->symtree))
goto cleanup;
+ /* F2008, C1242. */
+ if (gfc_is_coindexed (p))
+ {
+ gfc_error ("Pointer object at %C shall not be conindexed");
+ goto cleanup;
+ }
+
/* build ' => NULL() '. */
e = gfc_get_null_expr (&gfc_current_locus);
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 3483bc7..4b18529 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -6494,6 +6494,13 @@ resolve_deallocate_expr (gfc_expr *e)
return FAILURE;
}
+ /* F2008, C644. */
+ if (gfc_is_coindexed (e))
+ {
+ gfc_error ("Coindexed allocatable object at %L", &e->where);
+ return FAILURE;
+ }
+
if (pointer
&& gfc_check_vardef_context (e, true, _("DEALLOCATE object")) == FAILURE)
return FAILURE;
--- /dev/null 2011-05-27 07:14:06.059892443 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray_22.f90 2011-05-27 08:03:48.000000000 +0200
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+! Constraint checks for invalid access of remote pointers
+! (Accessing the value is ok, checking/changing association
+! status is invalid)
+!
+! PR fortran/18918
+!
+type t
+ integer, pointer :: ptr => null()
+end type t
+type(t) :: x[*], y[*]
+
+if (associated(x%ptr)) stop 0
+if (associated(x%ptr,y%ptr)) stop 0
+
+if (associated(x[1]%ptr)) stop 0 ! { dg-error "shall not be conindexed" }
+if (associated(x%ptr,y[1]%ptr)) stop 0 ! { dg-error "shall not be conindexed" }
+
+nullify (x%ptr)
+nullify (x[1]%ptr) ! { dg-error "shall not be conindexed" }
+
+x%ptr => null(x%ptr)
+x%ptr => null(x[1]%ptr) ! { dg-error "shall not be conindexed" }
+x[1]%ptr => null(x%ptr) ! { dg-error "shall not have a coindex" }
+
+allocate(x%ptr)
+deallocate(x%ptr)
+
+allocate(x[1]%ptr) ! { dg-error "Coindexed allocatable object" }
+deallocate(x[1]%ptr) ! { dg-error "Coindexed allocatable object" }
+end
