Merge pull request #491 from LKedward/backend-grace

Catch execute_command_line errors and print useful messages

3 files changed, 69 insertions, 17 deletions

diff --git a/src/fpm.f90 b/src/fpm.f90
index 3310a3f..c670378 100644
--- a/src/fpm.f90
+++ b/src/fpm.f90
@@ -298,6 +298,7 @@ subroutine cmd_run(settings,test)
     type(build_target_t), pointer :: exe_target
     type(srcfile_t), pointer :: exe_source
     integer :: run_scope
+    integer, allocatable :: stat(:)
     character(len=:),allocatable :: line
     logical :: toomany
 
@@ -418,18 +419,31 @@ subroutine cmd_run(settings,test)
          call compact_list()
     else
 
+        allocate(stat(size(executables)))
         do i=1,size(executables)
             if (exists(executables(i)%s)) then
                 if(settings%runner .ne. ' ')then
-                    call run(settings%runner//' '//executables(i)%s//" "//settings%args,echo=settings%verbose)
+                    call run(settings%runner//' '//executables(i)%s//" "//settings%args, &
+                             echo=settings%verbose, exitstat=stat(i))
                 else
-                    call run(executables(i)%s//" "//settings%args,echo=settings%verbose)
+                    call run(executables(i)%s//" "//settings%args,echo=settings%verbose, &
+                             exitstat=stat(i))
                 endif
             else
                 write(stderr,*)'fpm::run<ERROR>',executables(i)%s,' not found'
                 stop 1
             end if
         end do
+
+        if (any(stat /= 0)) then
+            do i=1,size(stat)
+                if (stat(i) /= 0) then
+                    write(*,*) '<ERROR> Execution failed for "',basename(executables(i)%s),'"'
+                end if
+            end do
+            stop 1
+        end if
+
     endif
     contains
     subroutine compact_list_all()
diff --git a/src/fpm_backend.f90 b/src/fpm_backend.f90
index 99b6be8..8628ec4 100644
--- a/src/fpm_backend.f90
+++ b/src/fpm_backend.f90
@@ -28,7 +28,7 @@
 module fpm_backend
 
 use fpm_environment, only: run, get_os_type, OS_WINDOWS
-use fpm_filesystem, only: dirname, join_path, exists, mkdir, unix_path
+use fpm_filesystem, only: basename, dirname, join_path, exists, mkdir, unix_path
 use fpm_model, only: fpm_model_t
 use fpm_targets, only: build_target_t, build_target_ptr, FPM_TARGET_OBJECT, &
                        FPM_TARGET_C_OBJECT, FPM_TARGET_ARCHIVE, FPM_TARGET_EXECUTABLE
@@ -48,7 +48,8 @@ subroutine build_package(targets,model)
 
     integer :: i, j
     type(build_target_ptr), allocatable :: queue(:)
-    integer, allocatable :: schedule_ptr(:)
+    integer, allocatable :: schedule_ptr(:), stat(:)
+    logical :: build_failed, skip_current
 
     ! Need to make output directory for include (mod) files
     if (.not.exists(join_path(model%output_directory,model%package_name))) then
@@ -65,17 +66,44 @@ subroutine build_package(targets,model)
     ! Construct build schedule queue
     call schedule_targets(queue, schedule_ptr, targets)
 
+    ! Initialise build status flags
+    allocate(stat(size(queue)))
+    stat(:) = 0
+    build_failed = .false.
+
     ! Loop over parallel schedule regions
     do i=1,size(schedule_ptr)-1
 
         ! Build targets in schedule region i
-        !$omp parallel do default(shared) schedule(dynamic,1)
+        !$omp parallel do default(shared) private(skip_current) schedule(dynamic,1)
         do j=schedule_ptr(i),(schedule_ptr(i+1)-1)
 
-            call build_target(model,queue(j)%ptr)
+            ! Check if build already failed
+            !$omp atomic read
+            skip_current = build_failed
+            
+            if (.not.skip_current) then
+                call build_target(model,queue(j)%ptr,stat(j))
+            end if
+
+            ! Set global flag if this target failed to build
+            if (stat(j) /= 0) then
+                !$omp atomic write
+                build_failed = .true.
+            end if
 
         end do
 
+        ! Check if this schedule region failed: exit with message if failed
+        if (build_failed) then
+            do j=1,size(stat)
+                if (stat(j) /= 0) then
+                    write(*,*) '<ERROR> Compilation failed for object "',basename(queue(j)%ptr%output_file),'"'
+                end if
+            end do
+            stop 1
+        end if
+
     end do
 
 end subroutine build_package
@@ -223,9 +251,10 @@ end subroutine schedule_targets
 !>
 !> If successful, also caches the source file digest to disk.
 !>
-subroutine build_target(model,target)
+subroutine build_target(model,target,stat)
     type(fpm_model_t), intent(in) :: model
     type(build_target_t), intent(in), target :: target
+    integer, intent(out) :: stat
 
     integer :: ilib, fh
     character(:), allocatable :: link_flags
@@ -238,32 +267,34 @@ subroutine build_target(model,target)
 
     case (FPM_TARGET_OBJECT)
         call run(model%fortran_compiler//" -c " // target%source%file_name // target%compile_flags &
-              // " -o " // target%output_file)
+              // " -o " // target%output_file, echo=.true., exitstat=stat)
 
     case (FPM_TARGET_C_OBJECT)
         call run(model%c_compiler//" -c " // target%source%file_name // target%compile_flags &
-                // " -o " // target%output_file)
+                // " -o " // target%output_file, echo=.true., exitstat=stat)
 
     case (FPM_TARGET_EXECUTABLE)
 
         call run(model%fortran_compiler// " " // target%compile_flags &
-              //" "//target%link_flags// " -o " // target%output_file)
+              //" "//target%link_flags// " -o " // target%output_file, echo=.true., exitstat=stat)
 
     case (FPM_TARGET_ARCHIVE)
 
         select case (get_os_type())
         case (OS_WINDOWS)
             call write_response_file(target%output_file//".resp" ,target%link_objects)
-            call run(model%archiver // target%output_file // " @" // target%output_file//".resp")
+            call run(model%archiver // target%output_file // " @" // target%output_file//".resp", &
+                     echo=.true., exitstat=stat)
 
         case default
-            call run(model%archiver // target%output_file // " " // string_cat(target%link_objects," "))
+            call run(model%archiver // target%output_file // " " // string_cat(target%link_objects," "), &
+                     echo=.true., exitstat=stat)
 
         end select
 
     end select
 
-    if (allocated(target%source)) then
+    if (stat == 0 .and. allocated(target%source)) then
         open(newunit=fh,file=target%output_file//'.digest',status='unknown')
         write(fh,*) target%source%digest
         close(fh)
diff --git a/src/fpm_environment.f90 b/src/fpm_environment.f90
index a3c073f..cf76250 100644
--- a/src/fpm_environment.f90
+++ b/src/fpm_environment.f90
@@ -137,9 +137,10 @@ contains
     end function os_is_unix
 
     !> echo command string and pass it to the system for execution
-    subroutine run(cmd,echo)
+    subroutine run(cmd,echo,exitstat)
         character(len=*), intent(in) :: cmd
         logical,intent(in),optional  :: echo
+        integer, intent(out),optional  :: exitstat
         logical :: echo_local
         integer :: stat
 
@@ -151,10 +152,16 @@ contains
         if(echo_local) print *, '+ ', cmd
 
         call execute_command_line(cmd, exitstat=stat)
-        if (stat /= 0) then
-            print *, 'Command failed'
-            error stop
+
+        if (present(exitstat)) then
+            exitstat = stat
+        else
+            if (stat /= 0) then
+                print *, 'Command failed'
+                error stop
+            end if
         end if
+
     end subroutine run
 
     !> get named environment variable value. It it is blank or