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

        * trans-openmp.c (gfc_omp_clause_dtor,
        * gfc_trans_omp_array_reduction):
        Update call to gfc_trans_dealloc_allocated.
        * trans.c (gfc_allocate_using_malloc): Fix spacing.
        (gfc_allocate_allocatable): For gfc_allocate_using_lib, jump to
        label_finish when an error occurs.
        (gfc_deallocate_with_status): Call caf_deregister for -fcoarray=lib.
        * trans.h (gfc_allocate_allocatable,
        * gfc_deallocate_with_status):
        Update prototype.
        (gfor_fndecl_caf_deregister): New tree symbol.
        * trans-expr.c (gfc_conv_procedure_call): Update
        gfc_deallocate_with_status and gfc_trans_dealloc_allocated calls.
        * trans-array.c (gfc_array_allocate,
        * gfc_trans_dealloc_allocated,
        structure_alloc_comps, gfc_trans_deferred_array): Ditto.
        (gfc_array_deallocate): Handle coarrays with -fcoarray=lib.
        * trans-array.h (gfc_array_deallocate, gfc_array_allocate,
        gfc_trans_dealloc_allocated): Update prototypes.
        * trans-stmt.c (gfc_trans_sync): Fix indentation.
        (gfc_trans_allocate): Fix errmsg padding and label handling.
        (gfc_trans_deallocate): Ditto and handle -fcoarray=lib.
        * expr.c (gfc_is_coarray): Fix algorithm for BT_CLASS.
        * libgfortran.h (GFC_STAT_STOPPED_IMAGE): Use large value
        to avoid other stats accidentally matching this one.
        * trans-decl.c (gfor_fndecl_caf_deregister): New global var.
        (gfc_build_builtin_function_decls): Fix prototype decl of caf_register
        and add decl for caf_deregister.
        (gfc_trans_deferred_vars): Handle CAF vars with -fcoarrays=lib.
        * trans-intrinsic.c (conv_intrinsic_move_alloc): Update call to
        gfc_deallocate_with_status.

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

        * caf/single.c (_gfortran_caf_register,
        * _gfortran_caf_deregister):
        Fix token handling.
        * caf/mpi.c  (_gfortran_caf_register, _gfortran_caf_deregister):
        * Ditto.
        * caf/libcaf.h (STAT_STOPPED_IMAGE): Sync with libgfortran.h.
        (_gfortran_caf_register, _gfortran_caf_deregister): Update prototype.

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

        * gfortran.dg/deallocate_stat_2.f90: New.
        * coarray/allocate_errgmsg.f90: New.
        * gfortran.dg/coarray_lib_alloc_1.f90: New.
        * gfortran.dg/coarray_lib_alloc_2.f90: New.
        * coarray/subobject_1.f90: Fix for num_images > 1.
        * gfortran.dg/deallocate_stat.f90: Update due to changed
        stat= handling.

From-SVN: r182951

7 files changed, 128 insertions, 8 deletions

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d503014..aeef955 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,13 @@
+2012-01-06  Tobias Burnus <burnus@net-b.de>
+
+	* gfortran.dg/deallocate_stat_2.f90: New.
+	* coarray/allocate_errgmsg.f90: New.
+	* gfortran.dg/coarray_lib_alloc_1.f90: New.
+	* gfortran.dg/coarray_lib_alloc_2.f90: New.
+	* coarray/subobject_1.f90: Fix for num_images > 1.
+	* gfortran.dg/deallocate_stat.f90: Update due to changed
+	stat= handling.
+
 2012-01-06  Andrew Stubbs  <ams@codesourcery.com>
 
 	* gcc.target/arm/headmerge-2.c: Adjust scan pattern.
diff --git a/gcc/testsuite/gfortran.dg/coarray/allocate_errgmsg.f90 b/gcc/testsuite/gfortran.dg/coarray/allocate_errgmsg.f90
new file mode 100644
index 0000000..e5a1954
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/allocate_errgmsg.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+!
+! Check handling of errmsg.
+!
+implicit none
+integer, allocatable :: a[:], b(:)[:], c, d(:)
+integer :: stat
+character(len=300) :: str
+
+allocate(a[*], b(1)[*], c, d(2), stat=stat)
+
+str = repeat('X', len(str))
+allocate(a[*], stat=stat, errmsg=str)
+!print *, stat, trim(str)
+if (stat == 0 .or. str /= "Attempt to allocate an allocated object") &
+  call abort ()
+
+str = repeat('Y', len(str))
+allocate(b(2)[*], stat=stat, errmsg=str)
+!print *, stat, trim(str)
+if (stat == 0 .or. str /= "Attempt to allocate an allocated object") &
+  call abort ()
+
+str = repeat('Q', len(str))
+allocate(c, stat=stat, errmsg=str)
+!print *, stat, trim(str)
+if (stat == 0 .or. str /= "Attempt to allocate an allocated object") &
+  call abort ()
+
+str = repeat('P', len(str))
+allocate(d(3), stat=stat, errmsg=str)
+!print *, stat, trim(str)
+if (stat == 0 .or. str /= "Attempt to allocate an allocated object") &
+  call abort ()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/coarray/subobject_1.f90 b/gcc/testsuite/gfortran.dg/coarray/subobject_1.f90
index 0253686..028c24a 100644
--- a/gcc/testsuite/gfortran.dg/coarray/subobject_1.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/subobject_1.f90
@@ -24,20 +24,20 @@
   b%a%i = 7
   if (b%a%i /= 7) call abort
   if (any (lcobound(b%a) /= (/ lb /))) call abort
-  if (ucobound(b%a, dim=1) /= this_image() + lb - 1) call abort
+  if (ucobound(b%a, dim=1) /= num_images() + lb - 1) call abort
   if (any (lcobound(b%a%i) /= (/ lb /))) call abort
-  if (ucobound(b%a%i, dim=1) /= this_image() + lb - 1) call abort
+  if (ucobound(b%a%i, dim=1) /= num_images() + lb - 1) call abort
   allocate(c%a(la)[lc:*])
   c%a%i = init
   if (any(c%a%i /= init)) call abort
   if (any (lcobound(c%a) /= (/ lc /))) call abort
-  if (ucobound(c%a, dim=1) /= this_image() + lc - 1) call abort
+  if (ucobound(c%a, dim=1) /= num_images() + lc - 1) call abort
   if (any (lcobound(c%a%i) /= (/ lc /))) call abort
-  if (ucobound(c%a%i, dim=1) /= this_image() + lc - 1) call abort
+  if (ucobound(c%a%i, dim=1) /= num_images() + lc - 1) call abort
   if (c%a(2)%i /= init(2)) call abort
   if (any (lcobound(c%a(2)) /= (/ lc /))) call abort
-  if (ucobound(c%a(2), dim=1) /= this_image() + lc - 1) call abort
+  if (ucobound(c%a(2), dim=1) /= num_images() + lc - 1) call abort
   if (any (lcobound(c%a(2)%i) /= (/ lc /))) call abort
-  if (ucobound(c%a(2)%i, dim=1) /= this_image() + lc - 1) call abort
+  if (ucobound(c%a(2)%i, dim=1) /= num_images() + lc - 1) call abort
   deallocate(b%a, c%a)
 end
diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_alloc_1.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_alloc_1.f90
new file mode 100644
index 0000000..c0d06a4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_lib_alloc_1.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=lib -fdump-tree-original" }
+!
+! Allocate/deallocate with libcaf.
+!
+
+ integer(4), allocatable :: xx[:], yy(:)[:]
+ integer :: stat
+ character(len=200) :: errmsg
+ allocate(xx[*], stat=stat, errmsg=errmsg)
+ allocate(yy(2)[*], stat=stat, errmsg=errmsg)
+ deallocate(xx,yy,stat=stat, errmsg=errmsg)
+ end
+
+! { dg-final { scan-tree-dump-times "_gfortran_caf_register .4, 1, &xx.token, &stat.., &errmsg, 200.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_register .8, 1, &yy.token, &stat.., &errmsg, 200.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx.token, &stat.., &errmsg, 200.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy.token, &stat.., &errmsg, 200.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy.token, 0B, 0B, 0.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx.token, 0B, 0B, 0.;" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90
new file mode 100644
index 0000000..3aaff1e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=lib -fdump-tree-original" }
+!
+! Allocate/deallocate with libcaf.
+!
+
+ type t
+ end type t
+ class(t), allocatable :: xx[:], yy(:)[:]
+ integer :: stat
+ character(len=200) :: errmsg
+ allocate(xx[*], stat=stat, errmsg=errmsg)
+ allocate(yy(2)[*], stat=stat, errmsg=errmsg)
+ deallocate(xx,yy,stat=stat, errmsg=errmsg)
+ end
+
+! { dg-final { scan-tree-dump-times "_gfortran_caf_register .1, 1, &xx._data.token, &stat.., &errmsg, 200.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_register .1, 1, &yy._data.token, &stat.., &errmsg, 200.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, &stat.., &errmsg, 200.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, &stat.., &errmsg, 200.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, 0B, 0B, 0.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, 0B, 0B, 0.;" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/deallocate_stat.f90 b/gcc/testsuite/gfortran.dg/deallocate_stat.f90
index b691f21..b2ba95c 100644
--- a/gcc/testsuite/gfortran.dg/deallocate_stat.f90
+++ b/gcc/testsuite/gfortran.dg/deallocate_stat.f90
@@ -69,9 +69,9 @@ program deallocate_stat
    i = 13
    deallocate(a1, stat=i) ;         if (i /= 0) call abort
    deallocate(a2, a1, stat=i) ;     if (i /= 1) call abort
-   deallocate(a1, a3, a2, stat=i) ; if (i /= 2) call abort
+   deallocate(a1, a3, a2, stat=i) ; if (i /= 1) call abort
    deallocate(b4, stat=i) ;         if (i /= 0) call abort
    deallocate(b4, b5, stat=i) ;     if (i /= 1) call abort
-   deallocate(b4, b5, b6, stat=i) ; if (i /= 2) call abort
+   deallocate(b4, b5, b6, stat=i) ; if (i /= 1) call abort
 
 end program deallocate_stat
diff --git a/gcc/testsuite/gfortran.dg/deallocate_stat_2.f90 b/gcc/testsuite/gfortran.dg/deallocate_stat_2.f90
new file mode 100644
index 0000000..e93f446
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/deallocate_stat_2.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+!
+! Check that the error is properly diagnosed and the strings are correctly padded.
+!
+integer, allocatable :: A, B(:)
+integer :: stat
+character(len=5) :: sstr
+character(len=200) :: str
+
+str = repeat('X', len(str))
+deallocate(a, stat=stat, errmsg=str)
+!print *, stat, trim(str)
+if (stat == 0 .or. str /= "Attempt to deallocate an unallocated object") call abort()
+
+str = repeat('Y', len(str))
+deallocate(b, stat=stat, errmsg=str)
+!print *, stat, trim(str)
+if (stat == 0 .or. str /= "Attempt to deallocate an unallocated object") call abort()
+
+sstr = repeat('Q', len(sstr))
+deallocate(a, stat=stat, errmsg=sstr)
+!print *, stat, trim(sstr)
+if (stat == 0 .or. sstr /= "Attem") call abort()
+
+sstr = repeat('P', len(sstr))
+deallocate(b, stat=stat, errmsg=sstr)
+!print *, stat, trim(sstr)
+if (stat == 0 .or. sstr /= "Attem") call abort()
+
+end