@@ -937,9 +937,9 @@ end subroutine link
937
937
938
938
939
939
! > Create an archive
940
- ! > @todo An OMP critical section is added for Windows OS,
941
- ! > which may be related to a bug in Mingw64-openmp and is expected to be resolved in the future,
942
- ! > see issue #707 and #708 .
940
+ ! > @todo For Windows OS, use the local `delete_file_win32` in stead of `delete_file`.
941
+ ! > This may be related to a bug in Mingw64-openmp and is expected to be resolved in the future,
942
+ ! > see issue #707, #708 and #808 .
943
943
subroutine make_archive (self , output , args , log_file , stat )
944
944
! > Instance of the archiver object
945
945
class(archiver_t), intent (in ) :: self
@@ -953,16 +953,27 @@ subroutine make_archive(self, output, args, log_file, stat)
953
953
integer , intent (out ) :: stat
954
954
955
955
if (self% use_response_file) then
956
- ! $omp critical
957
956
call write_response_file(output// " .resp" , args)
958
957
call run(self% ar // output // " @" // output// " .resp" , echo= self% echo, &
959
958
& verbose= self% verbose, redirect= log_file, exitstat= stat)
960
- call delete_file (output// " .resp" )
961
- ! $omp end critical
959
+ call delete_file_win32 (output// " .resp" )
960
+
962
961
else
963
962
call run(self% ar // output // " " // string_cat(args, " " ), &
964
963
& echo= self% echo, verbose= self% verbose, redirect= log_file, exitstat= stat)
965
964
end if
965
+
966
+ contains
967
+ subroutine delete_file_win32 (file )
968
+ character (len=* ), intent (in ) :: file
969
+ logical :: exist
970
+ integer :: unit, iostat
971
+ inquire (file= file, exist= exist)
972
+ if (exist) then
973
+ open (file= file, newunit= unit)
974
+ close (unit, status= ' delete' , iostat= iostat)
975
+ end if
976
+ end subroutine delete_file_win32
966
977
end subroutine make_archive
967
978
968
979
@@ -976,7 +987,7 @@ subroutine write_response_file(name, argv)
976
987
977
988
integer :: iarg, io
978
989
979
- open (file= name, newunit= io)
990
+ open (file= name, newunit= io, status = ' replace ' )
980
991
do iarg = 1 , size (argv)
981
992
write (io, ' (a)' ) unix_path(argv(iarg)% s)
982
993
end do
0 commit comments