2012-06-18 Tobias Burnus <burnus@net-b.de>

        PR fortran/53526
        * check.c (gfc_check_move_alloc): Reject coindexed actual
        * arguments
        and those with different corank.

2012-06-18  Tobias Burnus  <burnus@net-b.de>

        PR fortran/53526
        * gfortran.dg/coarray_27.f90: New.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@188747 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a70ed85..6469d67 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2012-06-18  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/53526
+       * check.c (gfc_check_move_alloc): Reject coindexed actual arguments
+       and those with different corank.
+
 2012-06-17  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/53691

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 9be8f66..7d505d5 100644 (file)
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1,5 +1,6 @@
 /* Check functions
-   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,
+   2011, 2012
    Free Software Foundation, Inc.
    Contributed by Andy Vaught & Katherine Holcomb
 
@@ -2728,17 +2729,29 @@ gfc_check_move_alloc (gfc_expr *from, gfc_expr *to)
     return FAILURE;
   if (allocatable_check (from, 0) == FAILURE)
     return FAILURE;
+  if (gfc_is_coindexed (from))
+    {
+      gfc_error ("The FROM argument to MOVE_ALLOC at %L shall not be "
+                "coindexed", &from->where);
+      return FAILURE;
+    }
 
   if (variable_check (to, 1, false) == FAILURE)
     return FAILURE;
   if (allocatable_check (to, 1) == FAILURE)
     return FAILURE;
+  if (gfc_is_coindexed (to))
+    {
+      gfc_error ("The TO argument to MOVE_ALLOC at %L shall not be "
+                "coindexed", &to->where);
+      return FAILURE;
+    }
 
   if (from->ts.type == BT_CLASS && to->ts.type == BT_DERIVED)
     {
       gfc_error ("The TO arguments in MOVE_ALLOC at %L must be "
                 "polymorphic if FROM is polymorphic",
-                &from->where);
+                &to->where);
       return FAILURE;
     }
 
@@ -2747,20 +2760,26 @@ gfc_check_move_alloc (gfc_expr *from, gfc_expr *to)
 
   if (to->rank != from->rank)
     {
-      gfc_error ("the '%s' and '%s' arguments of '%s' intrinsic at %L must "
-                "have the same rank %d/%d", gfc_current_intrinsic_arg[0]->name,
-                gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
-                &to->where,  from->rank, to->rank);
+      gfc_error ("The FROM and TO arguments of the MOVE_ALLOC intrinsic at %L "
+                "must have the same rank %d/%d", &to->where,  from->rank,
+                to->rank);
+      return FAILURE;
+    }
+
+  /* IR F08/0040; cf. 12-006A.  */
+  if (gfc_get_corank (to) != gfc_get_corank (from))
+    {
+      gfc_error ("The FROM and TO arguments of the MOVE_ALLOC intrinsic at %L "
+                "must have the same corank %d/%d", &to->where,
+                gfc_get_corank (from), gfc_get_corank (to));
       return FAILURE;
     }
 
   if (to->ts.kind != from->ts.kind)
     {
-      gfc_error ("the '%s' and '%s' arguments of '%s' intrinsic at %L must "
-                "be of the same kind %d/%d",
-                gfc_current_intrinsic_arg[0]->name,
-                gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
-                &to->where, from->ts.kind, to->ts.kind);
+      gfc_error ("The FROM and TO arguments of the MOVE_ALLOC intrinsic at %L"
+                " must be of the same kind %d/%d", &to->where, from->ts.kind,
+                to->ts.kind);
       return FAILURE;
     }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 5c37425..c1b129a 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,7 +1,12 @@
+2012-06-18  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/53526
+       * gfortran.dg/coarray_27.f90: New.
+
 2012-06-18  Joey Ye <Joey.Ye@arm.com>
-            Greta Yorsh  <Greta.Yorsh@arm.com>
+           Greta Yorsh  <Greta.Yorsh@arm.com>
 
-        * gcc.target/arm/epilog-1.c: New test.
+       * gcc.target/arm/epilog-1.c: New test.
 
 2012-06-18  Richard Guenther  <rguenther@suse.de>
 

diff --git a/gcc/testsuite/gfortran.dg/coarray_27.f90 b/gcc/testsuite/gfortran.dg/coarray_27.f90
new file mode 100644 (file)
index 0000000..de9cfad
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_27.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+! Coarray/coindex checks for MOVE_ALLOC
+!
+integer, allocatable :: a(:), b(:)[:,:], c(:)[:,:]
+
+type t
+  integer, allocatable :: d(:)
+end type t
+type(t) :: x[*]
+class(t), allocatable :: y[:], z[:], u
+
+
+call move_alloc (A, b) ! { dg-error "must have the same corank" }
+call move_alloc (c, A) ! { dg-error "must have the same corank" }
+call move_alloc (b, c) ! OK - same corank
+
+call move_alloc (u, y) ! { dg-error "must have the same corank" }
+call move_alloc (z, u) ! { dg-error "must have the same corank" }
+call move_alloc (y, z) ! OK - same corank
+
+
+call move_alloc (x%d, a)  ! OK
+call move_alloc (a, x%d)  ! OK
+call move_alloc (x[1]%d, a) ! { dg-error "The FROM argument to MOVE_ALLOC at .1. shall not be coindexed" }
+call move_alloc (a, x[1]%d) ! { dg-error "The TO argument to MOVE_ALLOC at .1. shall not be coindexed" }
+
+call move_alloc (y%d, a)  ! OK
+call move_alloc (a, y%d)  ! OK
+call move_alloc (y[1]%d, a) ! { dg-error "The FROM argument to MOVE_ALLOC at .1. shall not be coindexed" }
+call move_alloc (a, y[1]%d) ! { dg-error "The TO argument to MOVE_ALLOC at .1. shall not be coindexed" }
+
+end