re PR fortran/18918 (Eventually support Fortran 2008's coarrays [co-arrays])

2011-05-27  Tobias Burnus  <burnus@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  <burnus@net-b.de>

        PR fortran/18918
        * gfortran.dg/coarray_22.f90: New.

From-SVN: r174364

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 63ff7dbf0b185d24478202a3b88e04e25fe23b88..10ec0b0a102f68c6d227b976f8031287e7cc09e1 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2011-05-27  Tobias Burnus  <burnus@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  <burnus@net-b.de>
 
        PR fortran/48820

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 01651cb5a23baa42f3c782c87241d34cbde33858..70c23e663e1faa029f62a9649ff22a8cbbaaa5e3 100644 (file)
--- 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/match.c b/gcc/fortran/match.c
index 75f2a7fc570923799322e600b81f6397068611a0..f275239bfe5bc1ab536365d73d79875fe5087bf9 100644 (file)
--- 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 3483bc77594b1914654b6dab2609344aebe36650..4b1852939f2d7b881b08c0282c0796af51291fb6 100644 (file)
--- 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;

diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 9c4f5f6d01e64a2ce130290bd348a2b90db14b83..94b9a591c10d316aa3f6d2429956c19853d56aeb 100644 (file)
--- 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/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a8be7cdc30016c1422a3116eb6746a01fc63603d..915cd906aaa122330bd1e87dfcd8c7ebaf73cf81 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2011-05-27  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/18918
+       * gfortran.dg/coarray_22.f90: New.
+
 2011-05-27  Bill Schmidt  <wschmidt@linux.vnet.ibm.com>
 
        PR tree-optimization/46728

diff --git a/gcc/testsuite/gfortran.dg/coarray_22.f90 b/gcc/testsuite/gfortran.dg/coarray_22.f90
new file mode 100644 (file)
index 0000000..b09dfe3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_22.f90
@@ -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