From: Tobias Burnus Date: Mon, 18 Jun 2012 18:14:06 +0000 (+0200) Subject: re PR fortran/53526 ([Coarray] (lib) Properly handle MOVE_ALLOC for coarrays) X-Git-Tag: misc/gccgo-go1_1_2~2296 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=284943b0226b75d81e80cc2713cf0e0044a2d21f;p=thirdparty%2Fgcc.git re PR fortran/53526 ([Coarray] (lib) Properly handle MOVE_ALLOC for coarrays) 2012-06-18 Tobias Burnus PR fortran/53526 * check.c (gfc_check_move_alloc): Reject coindexed actual * arguments and those with different corank. 2012-06-18 Tobias Burnus PR fortran/53526 * gfortran.dg/coarray_27.f90: New. From-SVN: r188747 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a70ed8556aaa..6469d676d394 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2012-06-18 Tobias Burnus + + PR fortran/53526 + * check.c (gfc_check_move_alloc): Reject coindexed actual arguments + and those with different corank. + 2012-06-17 Tobias Burnus PR fortran/53691 diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 9be8f66742b6..7d505d5e9d9d 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,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 5c3742510497..c1b129ab51b6 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,7 +1,12 @@ +2012-06-18 Tobias Burnus + + PR fortran/53526 + * gfortran.dg/coarray_27.f90: New. + 2012-06-18 Joey Ye - Greta Yorsh + Greta Yorsh - * gcc.target/arm/epilog-1.c: New test. + * gcc.target/arm/epilog-1.c: New test. 2012-06-18 Richard Guenther diff --git a/gcc/testsuite/gfortran.dg/coarray_27.f90 b/gcc/testsuite/gfortran.dg/coarray_27.f90 new file mode 100644 index 000000000000..de9cfad8df59 --- /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