From c2092deb7f2a90a56c44db0439ef60309e1e2d75 Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Mon, 16 Jul 2012 20:58:04 +0000 Subject: [PATCH] re PR fortran/53824 (ICE with ALLOCATE of coarrays) MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit 2012-07-16 Thomas König PR fortran/53824 * resolve.c (resolve_allocate_deallocate): If both start indices are NULL, skip the test for equality. 2012-07-16 Thomas König PR fortran/53824 * gfortran.dg/coarray_allocate_1.f90: New test. From-SVN: r189549 --- gcc/fortran/ChangeLog | 6 ++ gcc/fortran/resolve.c | 11 ++- gcc/testsuite/ChangeLog | 5 + .../gfortran.dg/coarray_allocate_1.f90 | 95 +++++++++++++++++++ 4 files changed, 112 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/coarray_allocate_1.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 5759d1b2fa0c..c080e5afd935 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2012-07-16 Thomas König + + PR fortran/53824 + * resolve.c (resolve_allocate_deallocate): If both + start indices are NULL, skip the test for equality. + 2012-07-16 Steven Bosscher * f95-lang.c: Include dumpfile.h instead of tree-dump.h. diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 03f74df88fa1..ab79460cc0cc 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -7326,8 +7326,8 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn) } } - /* Check that an allocate-object appears only once in the statement. - FIXME: Checking derived types is disabled. */ + /* Check that an allocate-object appears only once in the statement. */ + for (p = code->ext.alloc.list; p; p = p->next) { pe = p->expr; @@ -7377,9 +7377,10 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn) { gfc_array_ref *par = &(pr->u.ar); gfc_array_ref *qar = &(qr->u.ar); - if (gfc_dep_compare_expr (par->start[0], - qar->start[0]) != 0) - break; + if ((par->start[0] != NULL || qar->start[0] != NULL) + && gfc_dep_compare_expr (par->start[0], + qar->start[0]) != 0) + break; } } else diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 12cf1cab2f16..1eebfa4d3bbc 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2012-07-16 Thomas König + + PR fortran/53824 + * gfortran.dg/coarray_allocate_1.f90: New test. + 2012-07-16 Andrew Pinski * gcc.c-torture/execute/bswap-1.c: New testcase. diff --git a/gcc/testsuite/gfortran.dg/coarray_allocate_1.f90 b/gcc/testsuite/gfortran.dg/coarray_allocate_1.f90 new file mode 100644 index 000000000000..b2f3136f0882 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_allocate_1.f90 @@ -0,0 +1,95 @@ +! { dg-do compile } +! { dg-options "-fcoarray=single" } +! PR 53824 - this used to ICE. +! Original test case by Vladimír Fuka +program Jac + implicit none + + integer,parameter:: KND=KIND(1.0) + + type Domain + real(KND),dimension(:,:,:),allocatable:: A,B + integer :: n=64,niter=20000,blockit=1000 + integer :: starti,endi + integer :: startj,endj + integer :: startk,endk + integer,dimension(:),allocatable :: startsi,startsj,startsk + integer,dimension(:),allocatable :: endsi,endsj,endsk + end type + + type(Domain),allocatable :: D[:,:,:] +! real(KND),codimension[*] :: sumA,sumB,diffAB + integer i,j,k,ncom + integer nims,nxims,nyims,nzims + integer im,iim,jim,kim + character(20):: ch + + nims = num_images() + nxims = nint(nims**(1./3.)) + nyims = nint(nims**(1./3.)) + nzims = nims / (nxims*nyims) + + im = this_image() + if (im==1) write(*,*) "n: [",nxims,nyims,nzims,"]" + + kim = (im-1) / (nxims*nyims) + 1 + jim = ((im-1) - (kim-1)*(nxims*nyims)) / nxims + 1 + iim = (im-1) - (kim-1)*(nxims*nyims) - (jim-1)*(nxims) + 1 + + write (*,*) im,"[",iim,jim,kim,"]" + + allocate(D[nxims,nyims,*]) + + ncom=command_argument_count() + if (command_argument_count() >=2) then + call get_command_argument(1,value=ch) + read (ch,*) D%n + call get_command_argument(2,value=ch) + read (ch,*) D%niter + call get_command_argument(3,value=ch) + read (ch,*) D%blockit + end if + + allocate(D%startsi(nxims)) + allocate(D%startsj(nyims)) + allocate(D%startsk(nzims)) + allocate(D%endsi(nxims)) + allocate(D%endsj(nyims)) + allocate(D%endsk(nzims)) + + D%startsi(1) = 1 + do i=2,nxims + D%startsi(i) = D%startsi(i-1) + D%n/nxims + end do + D%endsi(nxims) = D%n + D%endsi(1:nxims-1) = D%startsi(2:nxims) - 1 + + D%startsj(1) = 1 + do j=2,nyims + D%startsj(j) = D%startsj(j-1) + D%n/nyims + end do + D%endsj(nyims) = D%n + D%endsj(1:nyims-1) = D%startsj(2:nyims) - 1 + + D%startsk(1) = 1 + do k=2,nzims + D%startsk(k) = D%startsk(k-1) + D%n/nzims + end do + D%endsk(nzims) = D%n + D%endsk(1:nzims-1) = D%startsk(2:nzims) - 1 + + D%starti = D%startsi(iim) + D%endi = D%endsi(iim) + D%startj = D%startsj(jim) + D%endj = D%endsj(jim) + D%startk = D%startsk(kim) + D%endk = D%endsk(kim) + + write(*,*) D%startsi,D%endsi + write(*,*) D%startsj,D%endsj + write(*,*) D%startsk,D%endsk + + !$hmpp JacKernel allocate, args[A,B].size={0:D%n+1,0:D%n+1,0:D%n+1} + allocate(D%A(D%starti-1:D%endi+1,D%startj-1:D%endj+1,D%startk-1:D%endk+1),& + D%B(D%starti-1:D%endi+1,D%startj-1:D%endj+1,D%startk-1:D%endk+1)) +end program Jac -- 2.39.5