Changeset 71

Timestamp:

May 29, 2012, 11:04:01 AM (13 years ago)

Author:

g7moreau

Message:

• Add exit functional return code

Location:

trunk/signal-checkpoint

Files:

• signal_checkpoint.F90 (modified) (8 diffs)
• test_sgck1.f90 (modified) (1 diff)

trunk/signal-checkpoint/signal_checkpoint.F90

@@ -1 +1 @@
 !--------------------------------------------------------------!
 ! 2012/04/20 (C) Gabriel Moreau
-! Licence LGPLv2 or letter
+! Licence LGPLv2 or latter
 ! $Id$
 !--------------------------------------------------------------!
@@ -12 +12 @@
 
 implicit none
+save
 private
-
-integer, external :: signal_checkpoint_trap_callback_intel_
-external          :: signal_checkpoint_trap_callback_gfortran_
 
 integer, parameter :: SIGHUP  =  1  ! Signal HUP
@@ -25 +23 @@
 
 ! False public, only for trap procedure
-integer, public :: INTERNAL_RECEIVED_COUNT_ = 0  ! Global Counter
-integer, public :: INTERNAL_ERROR_ON_EXIT_  = 0
-integer, public :: INTERNAL_SIGNAL_EXIT_    = 0
+integer :: INTERNAL_RECEIVED_COUNT_ = 0  ! Global Counter
+integer :: INTERNAL_ERROR_ON_EXIT_  = 0
 
 public :: SIGHUP
@@ -48 +45 @@
    logical, intent(in), optional :: EXIT
 
-
 #ifdef __INTEL_COMPILER
    integer :: ERR
 
    if (present(EXIT)) then
-      INTERNAL_SIGNAL_EXIT_ = SIG_NUM
+      ERR = signal(SIG_NUM, trap_callback_intel_exit_, -1)
+   else
+      ERR = signal(SIG_NUM, trap_callback_intel_count_, -1)
    end if
-
-   ERR = signal(SIG_NUM, signal_checkpoint_trap_callback_intel_, -1)
 #endif
 
@@ -63 +59 @@
 
    if (present(EXIT)) then
-      INTERNAL_SIGNAL_EXIT_ = SIG_NUM
+      call signal(SIG_NUM, trap_callback_exit_)
+   else
+
+      call signal(SIG_NUM, trap_callback_count_)
    end if
-
-   call signal(SIG_NUM, signal_checkpoint_trap_callback_gfortran_)
 #endif
 
@@ -76 +73 @@
    logical :: IS_RECEIVED
 
-   IS_RECEIVED = (INTERNAL_RECEIVED_COUNT_ > 0)
+   IS_RECEIVED = ( INTERNAL_RECEIVED_COUNT_ > 0 )
 end function
 
@@ -96 +93 @@
 
 !--------------------------------------------------------------!
-end module
 !--------------------------------------------------------------!
 
+subroutine trap_callback_count_ !(SIG_NUM)
+   !integer, intent(in) :: SIG_NUM
 
-!--------------------------------------------------------------!
-! Internal trap procedure and function
-! Must be external to be C compatible
-!--------------------------------------------------------------!
-
-subroutine signal_checkpoint_trap_callback_gfortran_ (SIG_NUM)
-   use Signal_Checkpoint
-   integer, intent(in) :: SIG_NUM
-
-!       print *, "SIG1 : ", SIG_NUM
-!  if (SIG_NUM == INTERNAL_SIGNAL_EXIT_) then
-!      print *, "SIG2 : ", INTERNAL_SIGNAL_EXIT_
-!      INTERNAL_ERROR_ON_EXIT_ = 1
-!      print *, "SIG3 : ", INTERNAL_SIGNAL_EXIT_
-!   end if
    INTERNAL_RECEIVED_COUNT_ = INTERNAL_RECEIVED_COUNT_ + 1
 end subroutine
@@ -120 +103 @@
 !--------------------------------------------------------------!
 
-function signal_checkpoint_trap_callback_intel_ (SIG_NUM) result (ONE)
-   use Signal_Checkpoint
+subroutine trap_callback_exit_ !(SIG_NUM)
+   !integer, intent(in) :: SIG_NUM
+
+   INTERNAL_ERROR_ON_EXIT_ = 1
+   call trap_callback_count_
+end subroutine
+
+!--------------------------------------------------------------!
+
+function trap_callback_intel_exit_ (SIG_NUM) result (ONE)
    integer, intent(in) :: SIG_NUM
    integer :: ONE
 
-!   if (SIG_NUM == INTERNAL_SIGNAL_EXIT_) then
-!      INTERNAL_ERROR_ON_EXIT_ = 1
-!   end if
-   INTERNAL_RECEIVED_COUNT_ = INTERNAL_RECEIVED_COUNT_ + 1
+   call trap_callback_exit_
    ONE = 1
-end
+end function
 
 !--------------------------------------------------------------!
+
+function trap_callback_intel_count_ (SIG_NUM) result (ONE)
+   integer, intent(in) :: SIG_NUM
+   integer :: ONE
+
+   call trap_callback_count_
+   ONE = 1
+end function
+
 !--------------------------------------------------------------!
+end module
+!--------------------------------------------------------------!

trunk/signal-checkpoint/test_sgck1.f90

@@ -36 +36 @@
 
    if (signal_checkpoint_ask_for_exit_code()) then
-      stop 1
+     print *, "stop with exit code 1"
+     stop 1
    end if
 end program