diff mbox

[Fortran] Reject coarrays in MOVE_ALLOC

Message ID 4FC5E3DB.5020804@net-b.de
State New
Headers show

Commit Message

Tobias Burnus May 30, 2012, 9:09 a.m. UTC 
This patch rejects actual arguments to MOVE_ALLOC which are coindexed or 
have a corank.

Build and regtested on x86-64-linux.
OK for the trunk?

Tobias

Comments

Paul Richard Thomas May 30, 2012, 11:18 a.m. UTC | #1 
Dear Tobias,

That's OK for trunk.

Thanks

Paul

On 30 May 2012 11:09, Tobias Burnus <burnus@net-b.de> wrote:
> This patch rejects actual arguments to MOVE_ALLOC which are coindexed or
> have a corank.
>
> Build and regtested on x86-64-linux.
> OK for the trunk?
>
> Tobias
diff mbox

Patch

2012-05-30  Tobias Burnus  <burnus@net-b.de>

	* check.c (gfc_check_move_alloc): Reject coindexed actual arguments
	and those with corank.

2012-05-30  Tobias Burnus  <burnus@net-b.de>
	
	* gfortran.dg/coarray_27.f90: New.

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index afeb653..f685848 100644
--- 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,41 @@  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 (gfc_expr_attr (from).codimension)
+    {
+      gfc_error ("The FROM argument to MOVE_ALLOC at %L shall not have "
+		 "a codimension", &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 (gfc_expr_attr (to).codimension)
+    {
+      gfc_error ("The TO argument to MOVE_ALLOC at %L shall not have "
+		 "a codimension", &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;
     }
 
--- /dev/null	2012-05-29 08:59:25.267676082 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray_27.f90	2012-05-30 10:53:05.000000000 +0200
@@ -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 "The TO argument to MOVE_ALLOC at .1. shall not have a codimension" }
+call move_alloc (c, A) ! { dg-error "The FROM argument to MOVE_ALLOC at .1. shall not have a codimension" }
+call move_alloc (b, c) ! { dg-error "The FROM argument to MOVE_ALLOC at .1. shall not have a codimension" }
+
+call move_alloc (u, y) ! { "The TO argument to MOVE_ALLOC at .1. shall not have a codimension" }
+call move_alloc (z, u) ! { "The FROM argument to MOVE_ALLOC at .1. shall not have a codimension" }
+call move_alloc (y, z) ! { "The FROM argument to MOVE_ALLOC at .1. shall not have a codimension" }
+
+
+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