diff options
author | Tobias Burnus <burnus@net-b.de> | 2011-04-21 10:29:41 +0200 |
---|---|---|
committer | Tobias Burnus <burnus@gcc.gnu.org> | 2011-04-21 10:29:41 +0200 |
commit | e85df92e7d3da03b3f893d378c5c64ceee1de7e1 (patch) | |
tree | b514a69d9477f0713ee2f0a57c3fb1fac297f08f /gcc | |
parent | 470f5b53a29f5310b0e3782a06f18430de836fd2 (diff) | |
download | gcc-e85df92e7d3da03b3f893d378c5c64ceee1de7e1.zip gcc-e85df92e7d3da03b3f893d378c5c64ceee1de7e1.tar.gz gcc-e85df92e7d3da03b3f893d378c5c64ceee1de7e1.tar.bz2 |
re PR fortran/18918 (Eventually support Fortran 2008's coarrays [co-arrays])
2011-04-21 Tobias Burnus <burnus@net-b.de>
PR fortran/18918
* array.c (gfc_match_array_spec): Fix maximal rank(+corank) check.
2011-04-21 Tobias Burnus <burnus@net-b.de>
PR fortran/18918
* gfortran.dg/coarray_18.f90: New.
From-SVN: r172812
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/fortran/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/fortran/array.c | 9 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/coarray_18.f90 | 39 |
4 files changed, 57 insertions, 1 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 9e949b3..25ef329 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2011-04-21 Tobias Burnus <burnus@net-b.de> + + PR fortran/18918 + * array.c (gfc_match_array_spec): Fix maximal rank(+corank) check. + 2011-04-20 Jim Meyering <meyering@redhat.com> * expr.c (free_expr0): Remove useless if-before-free. diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c index e93cf9b..1394e17 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.c @@ -576,6 +576,13 @@ coarray: goto cleanup; } + if (as->rank >= GFC_MAX_DIMENSIONS) + { + gfc_error ("Array specification at %C has more than %d " + "dimensions", GFC_MAX_DIMENSIONS); + goto cleanup; + } + for (;;) { as->corank++; @@ -644,7 +651,7 @@ coarray: goto cleanup; } - if (as->corank >= GFC_MAX_DIMENSIONS) + if (as->rank + as->corank >= GFC_MAX_DIMENSIONS) { gfc_error ("Array specification at %C has more than %d " "dimensions", GFC_MAX_DIMENSIONS); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 07a0a6b..ae5daf2 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2011-04-21 Tobias Burnus <burnus@net-b.de> + + PR fortran/18918 + * gfortran.dg/coarray_18.f90: New. + 2011-04-20 Jason Merrill <jason@redhat.com> * g++.dg/cpp0x/initlist47.C: New. diff --git a/gcc/testsuite/gfortran.dg/coarray_18.f90 b/gcc/testsuite/gfortran.dg/coarray_18.f90 new file mode 100644 index 0000000..474e939 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_18.f90 @@ -0,0 +1,39 @@ +! { dg-do compile } +! { dg-options "-fcoarray=single" } +! +! Prevent ICE when exceeding the maximal number of allowed +! dimensions (normal + codimensions). +! +! Fortran 2008 allows (co)arrays with 15 ranks +! Currently, gfortran only supports 7, cf. PR 37577 +! Thus, the program is valid Fortran 2008 ... +! +! See also general coarray PR 18918 +! +! Test case taken from Leibniz-Rechenzentrum (LRZ)'s +! fortran_tests with thanks to Reinhold Bader. +! + +program ar + implicit none + integer :: ic(2)[*] + integer :: id(2,2)[2,*] + integer :: ie(2,2,2)[2,2,*] + integer :: ig(2,2,2,2)[2,2,2,*] ! { dg-error "has more than 7 dimensions" } + integer :: ih(2,2,2,2,2)[2,2,2,2,*] ! { dg-error "has more than 7 dimensions" } + integer :: ij(2,2,2,2,2,2)[2,2,2,2,2,*] ! { dg-error "has more than 7 dimensions" } + integer :: ik(2,2,2,2,2,2,2)[2,2,2,2,2,2,*] ! { dg-error "has more than 7 dimensions" } + integer :: il[2,2,2,2,2,2,2,*] ! { dg-error "has more than 7 dimensions" } + integer :: im[2,2,2,2,2,2,2,2,*] ! { dg-error "has more than 7 dimensions" } + integer :: in[2,2,2,2,2,2,2,2,2,*] ! { dg-error "has more than 7 dimensions" } + integer :: io[2,2,2,2,2,2,2,2,2,2,*] ! { dg-error "has more than 7 dimensions" } + real :: x2(2,2,4)[2,*] + complex :: c2(4,2)[2,*] + double precision :: d2(1,5,9)[2,*] + character(len=1) :: ch2(2)[2,*] + character(len=2) :: ch22(-5:4)[2,*] + logical :: l2(17)[2,*] + if (this_image() == 1) then + write(*,*) 'OK' + end if +end program |