From 1fb7c9c13567baabeffa3e36a951d3c86bf06e38 Mon Sep 17 00:00:00 2001
From: Albert Cheng <acheng@hdfgroup.org>
Date: Thu, 21 Apr 2005 13:49:18 -0500
Subject: [svn-r10641] Purpose: Bug fix.

Description:
When there were errors in the test, program still just call MPI_FINALIZE
and failed to attempt to exit with some error code so that calling
programs like make be informed of the exceptions.

Solution:
Call MPI_ABORT if error is detected. Though MPI_ABORT does not
guarantee 100% failure report, it has the best chance.
Also made dimension incompatible as a real error.

Platforms tested:
Did not h5committest but tested in heping PP only since this
is a simple fix.
---
 fortran/testpar/ptesthdf5_fortran.f90 | 27 ++++++++++++++++-----------
 1 file changed, 16 insertions(+), 11 deletions(-)

diff --git a/fortran/testpar/ptesthdf5_fortran.f90 b/fortran/testpar/ptesthdf5_fortran.f90
index 60d449c..0edb0ff 100644
--- a/fortran/testpar/ptesthdf5_fortran.f90
+++ b/fortran/testpar/ptesthdf5_fortran.f90
@@ -22,21 +22,21 @@
 !     USE MPI
         
      IMPLICIT NONE
-     INTEGER :: error        ! Error flags
-     INTEGER :: error_1 = 0  ! Error flags
+     INTEGER :: h5retcode    ! HDF5 call return code
+     INTEGER :: nerrors = 0  ! Error flags
      !
      ! MPI definitions and calls.
      !
-     INTEGER :: mpierror       ! MPI error flag
+     INTEGER :: mpiretcode       ! MPI calls return code
      INTEGER :: comm, info
      INTEGER :: mpi_size, mpi_rank
      LOGICAL :: cleanup = .TRUE.
 !     LOGICAL :: cleanup = .FALSE.
      comm = MPI_COMM_WORLD
      info = MPI_INFO_NULL
-     CALL MPI_INIT(mpierror)
-     CALL MPI_COMM_SIZE(comm, mpi_size, mpierror)
-     CALL MPI_COMM_RANK(comm, mpi_rank, mpierror) 
+     CALL MPI_INIT(mpiretcode)
+     CALL MPI_COMM_SIZE(comm, mpi_size, mpiretcode)
+     CALL MPI_COMM_RANK(comm, mpi_rank, mpiretcode) 
      !
      ! Check that datasets can be divided into equal parts by the processes.
      !
@@ -46,12 +46,13 @@
              write(*,*)  "It must be a factor of ", DIM1, " and ", DIM2
              write(*,*) "Exiting..."
          endif
+	 nerrors = nerrors + 1
          goto 1000
      endif
      !
      ! Initialize FORTRAN predefined datatypes
      !
-     CALL h5open_f(error) 
+     CALL h5open_f(h5retcode) 
      if (mpi_rank .eq. 0) then
          write(*,*) '==========================================='
          write(*,*) '         Parallel Fortran Tests            ' 
@@ -61,8 +62,8 @@
      if (mpi_rank .eq. 0) then 
          write(*,*) 'Writing/reading dataset by hyperslabs'
      endif
-     CALL dataset_wr_by_hyperslabs(cleanup, error_1)
-     if (error_1 .ne. 0 ) write(*,*) 'Process ', mpi_rank, 'reports failure'
+     CALL dataset_wr_by_hyperslabs(cleanup, nerrors)
+     if (nerrors .ne. 0 ) write(*,*) 'Process ', mpi_rank, 'reports failure'
      if (mpi_rank .eq. 0) then
          write(*,*) 
          write(*,*) '==========================================='
@@ -72,10 +73,14 @@
      !
      ! Close FORTRAN predefined datatypes.
      !
-     CALL h5close_f(error)
+     CALL h5close_f(h5retcode)
 
 1000 continue
 
-     CALL MPI_FINALIZE(mpierror)
+     if (nerrors .eq. 0) then
+	 CALL MPI_FINALIZE(mpiretcode)
+     else
+         CALL MPI_ABORT(MPI_COMM_WORLD, 1, mpiretcode)
+     endif
 
      END PROGRAM PHDF5F90TEST
-- 
cgit v0.12