From f9b119d1922396f5fd5695d595d9125fd7ed2faa Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Emma=20Bast=C3=A5s?= <emma.bastas@protonmail.com>
Date: Tue, 25 Mar 2025 13:21:12 +0100
Subject: [PATCH 01/10] Mege concurrent-invocations
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

fixes #957

Squashed commit of the following:

commit 998ebba0c55cdd681e8575c1cc8d951e699c1907
Author: Emma Bastås <emma.bastas@protonmail.com>
Date:   Tue Mar 25 13:17:38 2025 +0100

    Remove nix flake

commit b35852a94fb3cb2444ed973b7f9c28b46964e93d
Author: Emma Bastås <emma.bastas@protonmail.com>
Date:   Tue Mar 25 13:09:34 2025 +0100

    Use fpm_lock in fpm commands

commit 0f72adccb1c4bdf4c9b49b6336b550fb705fb2f0
Author: Emma Bastås <emma.bastas@protonmail.com>
Date:   Tue Mar 25 11:40:27 2025 +0100

    Better unitest fixtures

commit 49dbf5e2d4ace90b98dda959f903af41b42f94ed
Author: Emma Bastås <emma.bastas@protonmail.com>
Date:   Mon Mar 24 18:48:55 2025 +0100

    Fix memory issues

commit 45d8b1454d99277fad78fb26def34773d41d01b0
Author: Emma Bastås <emma.bastas@protonmail.com>
Date:   Mon Mar 24 16:39:59 2025 +0100

    Fix a typo

commit 0d86b10c76b6594d7363e6b2b697b08c9eccb92d
Author: Emma Bastås <emma.bastas@protonmail.com>
Date:   Mon Mar 24 16:39:31 2025 +0100

    Add implementation notes

commit b90dad7fdbd0c9c66700732c5af0f5919bb0ea64
Author: Emma Bastås <emma.bastas@protonmail.com>
Date:   Mon Mar 24 16:16:14 2025 +0100

    Remove lock-files with atexit

commit 4b6fea47f3771e280f89538f5435cb6e2b510b19
Author: Emma Bastås <emma.bastas@protonmail.com>
Date:   Sun Mar 23 16:20:13 2025 +0100

    Simplify logic

commit 66ff71676e3b8f5f744b146d9f6515e16c1b83fe
Author: Emma Bastås <emma.bastas@protonmail.com>
Date:   Fri Mar 21 15:49:02 2025 +0100

    All tests pass on Linux and Windows!!

commit 019ffc96ee4c9b0d388271543ff295a77eebd192
Author: Emma Bastås <emma.bastas@protonmail.com>
Date:   Fri Mar 21 15:42:57 2025 +0100

    Almost everthing works

commit b7e2c1af4589a427e925fb98068cecf598cb2366
Author: Emma Bastås <emma.bastas@protonmail.com>
Date:   Fri Mar 21 11:54:29 2025 +0100

    Implement for Windows.

commit 588fcf7f5674dfd92b9bfd485222f71ca1e49db0
Author: Emma Bastås <emma.bastas@protonmail.com>
Date:   Fri Mar 21 11:54:00 2025 +0100

    Kill processes without resorting to C.

commit 688a38d5e7076fb1f71cbd33fe828691058d3443
Author: Emma Bastås <emma.bastas@protonmail.com>
Date:   Wed Mar 19 20:08:17 2025 +0100

    More documentation and comments

commit f39ef3ef5ca498920212c1470808cef6ee385032
Author: Emma Bastås <emma.bastas@protonmail.com>
Date:   Wed Mar 19 18:03:10 2025 +0100

    Handle more errors properly

commit b831f652b26166e7f2c124ec9634214f0fb3b527
Author: Emma Bastås <emma.bastas@protonmail.com>
Date:   Wed Mar 19 17:13:05 2025 +0100

    Add a unit test

commit fd7ffb8f5e8d76bb60545c79ac3c0a14c8dd4abd
Author: Emma Bastås <emma.bastas@protonmail.com>
Date:   Wed Mar 19 17:00:27 2025 +0100

    Reap child process after kill

commit 6f12e87f7d9a92e10efc51922b3d6ba27646c85a
Author: Emma Bastås <emma.bastas@protonmail.com>
Date:   Wed Mar 19 17:00:11 2025 +0100

    Change some comments

commit 757300003dacc095724885ccbedb2a5f98006b9e
Author: Emma Bastås <emma.bastas@protonmail.com>
Date:   Wed Mar 19 16:59:54 2025 +0100

    Implement a process_alive function

commit 26eb598ab124c338e38751a61bf5a8c21a412a21
Author: Emma Bastås <emma.bastas@protonmail.com>
Date:   Wed Mar 19 15:02:36 2025 +0100

    Fail test early if package-locking fails

commit 107dcec984d3a34b7dc340e82f189b30acdf27f2
Author: Emma Bastås <emma.bastas@protonmail.com>
Date:   Wed Mar 19 14:56:32 2025 +0100

    Make it better

commit 82e9224c458ad899660ed94866c87161cde8111c
Author: Emma Bastås <emma.bastas@protonmail.com>
Date:   Sat Mar 15 17:59:40 2025 +0100

    Add tests

commit e1169ca897df690309941d83872447515656234d
Author: Emma Bastås <emma.bastas@protonmail.com>
Date:   Sat Mar 15 17:58:04 2025 +0100

    WIP: Pid in lock-file + error handling

commit 903ec6fc758d50944a95acdf10a7bc7237ed5834
Author: Emma Bastås <emma.bastas@protonmail.com>
Date:   Sat Mar 1 18:59:32 2025 +0100

    Start work on package locking

commit 65f0905a4ed6f043eaabdb2d08bfd4f9654e161e
Author: Emma Bastås <emma.bastas@protonmail.com>
Date:   Sat Mar 1 13:42:46 2025 +0100

    TODO: Remove. nix dev enviroment
---
 src/fpm.f90                 |  31 ++++
 src/fpm/cmd/export.f90      |   7 +
 src/fpm/cmd/install.f90     |   7 +
 src/fpm/cmd/publish.f90     |  12 ++
 src/fpm/cmd/update.f90      |   7 +
 src/fpm_lock.c              |  88 ++++++++++
 src/fpm_lock.f90            | 330 ++++++++++++++++++++++++++++++++++++
 test/fpm_test/main.f90      |   2 +
 test/fpm_test/test_lock.f90 | 185 ++++++++++++++++++++
 9 files changed, 669 insertions(+)
 create mode 100644 src/fpm_lock.c
 create mode 100644 src/fpm_lock.f90
 create mode 100644 test/fpm_test/test_lock.f90

diff --git a/src/fpm.f90 b/src/fpm.f90
index 561fb4e5e9..03211ae594 100644
--- a/src/fpm.f90
+++ b/src/fpm.f90
@@ -9,6 +9,7 @@ module fpm
 use fpm_dependency, only : new_dependency_tree
 use fpm_filesystem, only: is_dir, join_path, list_files, exists, &
                    basename, filewrite, mkdir, run, os_delete_dir
+use fpm_lock, only: fpm_lock_acquire, fpm_lock_release
 use fpm_model, only: fpm_model_t, srcfile_t, show_model, fortran_features_t, &
                     FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, FPM_SCOPE_DEP, &
                     FPM_SCOPE_APP, FPM_SCOPE_EXAMPLE, FPM_SCOPE_TEST
@@ -436,6 +437,11 @@ subroutine cmd_build(settings)
 
 integer :: i
 
+call fpm_lock_acquire(error)
+if (allocated(error)) then
+    call fpm_stop(1, '*cmd_build* Lock error: '//error%message)
+end if
+
 call get_package_data(package, "fpm.toml", error, apply_defaults=.true.)
 if (allocated(error)) then
     call fpm_stop(1,'*cmd_build* Package error: '//error%message)
@@ -467,6 +473,11 @@ subroutine cmd_build(settings)
     call build_package(targets,model,verbose=settings%verbose)
 endif
 
+call fpm_lock_release(error)
+if (allocated(error)) then
+    call fpm_stop(1, '*cmd_build* Lock error: '//error%message)
+end if
+
 end subroutine cmd_build
 
 subroutine cmd_run(settings,test)
@@ -487,6 +498,11 @@ subroutine cmd_run(settings,test)
     integer, allocatable :: stat(:),target_ID(:)
     character(len=:),allocatable :: line
 
+    call fpm_lock_acquire(error)
+    if (allocated(error)) then
+        call fpm_stop(1, '*cmd_run* Lock error: '//error%message)
+    end if
+
     call get_package_data(package, "fpm.toml", error, apply_defaults=.true.)
     if (allocated(error)) then
         call fpm_stop(1, '*cmd_run* Package error: '//error%message)
@@ -616,6 +632,11 @@ subroutine cmd_run(settings,test)
 
     end if
 
+    call fpm_lock_release(error)
+    if (allocated(error)) then
+        call fpm_stop(1, '*cmd_run* Lock error: '//error%message)
+    end if
+
     contains
 
     subroutine compact_list_all()
@@ -684,6 +705,11 @@ subroutine cmd_clean(settings)
     type(fpm_global_settings) :: global_settings
     type(error_t), allocatable :: error
 
+    call fpm_lock_acquire(error)
+    if (allocated(error)) then
+        call fpm_stop(1, '*cmd_clean* Lock error: '//error%message)
+    end if
+
     ! Clear registry cache
     if (settings%registry_cache) then
         call get_global_settings(global_settings, error) 
@@ -708,6 +734,11 @@ subroutine cmd_clean(settings)
     else
         write (stdout, '(A)') "fpm: No build directory found."
     end if
+
+    call fpm_lock_release(error)
+    if (allocated(error)) then
+        call fpm_stop(1, '*cmd_clean* Lock error: '//error%message)
+     end if
 end subroutine cmd_clean
 
 !> Sort executables by namelist ID, and trim unused values
diff --git a/src/fpm/cmd/export.f90 b/src/fpm/cmd/export.f90
index d2ec0dbaf1..a3885f8ce4 100644
--- a/src/fpm/cmd/export.f90
+++ b/src/fpm/cmd/export.f90
@@ -3,6 +3,7 @@ module fpm_cmd_export
   use fpm_dependency, only : dependency_tree_t, new_dependency_tree
   use fpm_error, only : error_t, fpm_stop
   use fpm_filesystem, only : join_path
+  use fpm_lock, only : fpm_lock_acquire, fpm_lock_release
   use fpm_manifest, only : package_config_t, get_package_data
   use fpm_toml, only: name_is_json
   use fpm_model, only: fpm_model_t
@@ -25,6 +26,9 @@ subroutine cmd_export(settings)
     integer :: ii
     character(len=:), allocatable :: filename
 
+    call fpm_lock_acquire(error)
+    call handle_error(error)
+
     if (len_trim(settings%dump_manifest)<=0 .and. &
         len_trim(settings%dump_model)<=0 .and. &
         len_trim(settings%dump_dependencies)<=0) then
@@ -69,6 +73,9 @@ subroutine cmd_export(settings)
         call handle_error(error)
     end if
 
+    call fpm_lock_release(error)
+    call handle_error(error)
+
   end subroutine cmd_export
 
   !> Error handling for this command
diff --git a/src/fpm/cmd/install.f90 b/src/fpm/cmd/install.f90
index 559cd81b55..26654749b6 100644
--- a/src/fpm/cmd/install.f90
+++ b/src/fpm/cmd/install.f90
@@ -5,6 +5,7 @@ module fpm_cmd_install
   use fpm_command_line, only : fpm_install_settings
   use fpm_error, only : error_t, fatal_error, fpm_stop
   use fpm_filesystem, only : join_path, list_files
+  use fpm_lock, only : fpm_lock_acquire, fpm_lock_release
   use fpm_installer, only : installer_t, new_installer
   use fpm_manifest, only : package_config_t, get_package_data
   use fpm_model, only : fpm_model_t, FPM_SCOPE_APP, FPM_SCOPE_TEST
@@ -32,6 +33,9 @@ subroutine cmd_install(settings)
     logical :: installable
     integer :: ntargets
 
+    call fpm_lock_acquire(error)
+    call handle_error(error)
+
     call get_package_data(package, "fpm.toml", error, apply_defaults=.true.)
     call handle_error(error)
     
@@ -85,6 +89,9 @@ subroutine cmd_install(settings)
         
     end if
 
+  call fpm_lock_release(error)
+  call handle_error(error)
+
   end subroutine cmd_install
 
   subroutine install_info(unit, verbose, targets, ntargets)
diff --git a/src/fpm/cmd/publish.f90 b/src/fpm/cmd/publish.f90
index 225e83f923..1ceb28d28a 100644
--- a/src/fpm/cmd/publish.f90
+++ b/src/fpm/cmd/publish.f90
@@ -4,6 +4,7 @@
 !> The token can be obtained from the registry website. It can be used as `fpm publish --token <token>`.
 module fpm_cmd_publish
   use fpm_command_line, only: fpm_publish_settings
+  use fpm_lock, only : fpm_lock_acquire, fpm_lock_release
   use fpm_manifest, only: package_config_t, get_package_data
   use fpm_model, only: fpm_model_t
   use fpm_error, only: error_t, fpm_stop
@@ -35,6 +36,11 @@ subroutine cmd_publish(settings)
     type(downloader_t) :: downloader
     integer :: i
 
+    call fpm_lock_acquire(error)
+    if (allocated(error)) then
+        call fpm_stop(1, '*cmd_publish* Lock error: '//error%message)
+    end if
+
     ! Get package data to determine package version.
     call get_package_data(package, 'fpm.toml', error, apply_defaults=.true.)
     if (allocated(error)) call fpm_stop(1, '*cmd_build* Package error: '//error%message)
@@ -106,6 +112,12 @@ subroutine cmd_publish(settings)
     call downloader%upload_form(official_registry_base_url//'/packages', upload_data, settings%verbose, error)
     call delete_file(tmp_file)
     if (allocated(error)) call fpm_stop(1, '*cmd_publish* Upload error: '//error%message)
+
+    call fpm_lock_release(error)
+    if (allocated(error)) then
+        call fpm_stop(1, '*cmd_publish* Lock error: '//error%message)
+    end if
+
   end
 
   subroutine print_upload_data(upload_data)
diff --git a/src/fpm/cmd/update.f90 b/src/fpm/cmd/update.f90
index c1f09e07c6..1d9dc90e58 100644
--- a/src/fpm/cmd/update.f90
+++ b/src/fpm/cmd/update.f90
@@ -3,6 +3,7 @@ module fpm_cmd_update
   use fpm_dependency, only : dependency_tree_t, new_dependency_tree
   use fpm_error, only : error_t, fpm_stop
   use fpm_filesystem, only : exists, mkdir, join_path, delete_file, filewrite
+  use fpm_lock, only : fpm_lock_acquire, fpm_lock_release
   use fpm_manifest, only : package_config_t, get_package_data
   use fpm_toml, only: name_is_json
   implicit none
@@ -22,6 +23,9 @@ subroutine cmd_update(settings)
     integer :: ii
     character(len=:), allocatable :: cache
 
+    call fpm_lock_acquire(error)
+    call handle_error(error)
+
     call get_package_data(package, "fpm.toml", error, apply_defaults=.true.)
     call handle_error(error)
 
@@ -63,6 +67,9 @@ subroutine cmd_update(settings)
         call handle_error(error)
     end if
 
+    call fpm_lock_release(error)
+    call handle_error(error)
+
   end subroutine cmd_update
 
   !> Error handling for this command
diff --git a/src/fpm_lock.c b/src/fpm_lock.c
new file mode 100644
index 0000000000..e89bf03faa
--- /dev/null
+++ b/src/fpm_lock.c
@@ -0,0 +1,88 @@
+#include <errno.h>
+#include <fcntl.h>
+#include <string.h>
+#include <stdlib.h>
+
+#ifndef _WIN32
+
+#include <unistd.h>
+
+#else
+
+#include <io.h>
+#include <sys\stat.h>
+
+#define open _open
+
+#endif
+
+// @brief A thread-safe version of strerror using malloc.
+// @param errnum
+char *my_strerror(int errnum) {
+    const int BUFSIZE = 256;
+    char *buf = malloc(BUFSIZE);
+
+// POSIX strerror_r and Windows strerror_s are both thread-safe versions of
+// strerror with the same interface except for the order of the arguments.
+#ifndef _WIN32
+    int stat = strerror_r(errnum, buf, BUFSIZE);
+#else
+    int stat = strerror_s(buf, BUFSIZE, errnum);
+#endif
+    if (stat != 0) {
+        const char *MSG = "Unknown error";
+        memcpy(buf, MSG, strlen(MSG));
+    }
+
+    return buf;
+}
+
+/// @brief Create a file if it doesn't already exist in an atomic manner.
+/// @param path
+/// @param iostat Zero if file was successfully created, nonzero otherwise.
+/// @param iomsg Points to an error message if an error occurred, NULL otherwise.
+/// @param exsits Zero if the file didn't exist already, nonzero otherwise.
+void c_create(char *path, int *iostat, char **iomsg, int *exists) {
+    int fd = open(path,
+                  O_RDONLY | O_CREAT | O_EXCL,
+                  S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH);
+
+    if (fd == -1 && errno != EEXIST) {  // Some unexpected error occurred.
+        *iostat = 1;
+        *iomsg = my_strerror(errno);
+        return;
+    }
+
+    if (fd == -1 && errno == EEXIST) {  // The lock-file already exists.
+        *exists = 1;
+    }
+
+    if (fd != -1) {  // The lock-file was created.
+        *exists = 0;
+
+        int stat = close(fd);
+        if (stat == -1) {
+            *iostat = 1;
+            *iomsg = my_strerror(errno);
+            return;
+        }
+    }
+
+    *iostat = 0;
+    *iomsg = NULL;
+}
+
+// @brief Remove a file/directory in an atomic manner.
+// @param path
+// @param iostat
+// @param iomsg
+void c_remove(char *path, int *iostat, char **iomsg) {
+    int stat = remove(path);
+    if (stat == -1) {
+        *iostat = 1;
+        *iomsg = my_strerror(errno);
+        return;
+    }
+    *iostat = 0;
+    *iomsg = NULL;
+}
diff --git a/src/fpm_lock.f90 b/src/fpm_lock.f90
new file mode 100644
index 0000000000..d73ff70165
--- /dev/null
+++ b/src/fpm_lock.f90
@@ -0,0 +1,330 @@
+!> Lock package directories before working on them.
+!>
+!># Synopsis
+!>
+!> Use the functions [[fpm_lock_acquire]] and [[fpm_lock_release]] to "lock" a
+!> `fpm` package directory to prevent issues when multiple `fpm` process want
+!> to work on the same package at the same time. Here's an example of how this
+!> module is used in the rest of the codebase:
+!>
+!>```fortran
+!> !> Entry point for the update subcommand
+!>subroutine cmd_update(settings)
+!> type(error_t), allocatable :: error
+!> fpm_lock_acquire(error)
+!> ! Do things here
+!> fpm_lock_release(error)
+!>end subroutine cmd_update
+!>```
+!>
+!># Background
+!>
+!> This module exists to fix a buggy behavior that exists in many package
+!> managers (however, most users never experience issues with it).
+!>
+!> The buggy behaviors is that when many `fpm` processes try to work on the same
+!> package at the same time the different processes sort of step on one another
+!> an it leads to problems, for instance two processes might try to compile the
+!> same file  at the same time.
+!>
+!> Also see this issue:
+!> [https://github.com/fortran-lang/fpm/issues/957](https://github.com/fortran-lang/fpm/issues/957)
+!> for some
+!> more details.
+!>
+!> What we need is for an `fpm` process \(A\) to see if another `fpm` process
+!> \(B\) is already working on a package, and if so, wait for \(B\) to finish
+!> that work before \(A\) steps in. The way we do this is with so-called
+!> *lock-files*. Basically \(B\) creates a special file named
+!> `.fpm-package-lock` in the package directory so that \(A\) will see that this
+!> file exists and wait for it to be deleted by \(B\), when that is done it
+!> means that the package directory is free, and so \(A\) now creates
+!> `.fpm-package-lock` itself and does it's thing, after \(A\) is done it
+!> deletes the lock-file again.
+!>
+!> That's pretty much the gist of it. It's complicated somewhat by the fact that
+!> we need to consider certain rare cases (what if the program crashes and
+!> leaves the lock-file behind for instance). Also, the lock-file operations
+!> have to be what's called "atomic". For instance, consider this non-atomic way
+!> of creating a lock-file: (in pseudocode)
+!>```
+!>1)   if file_exists('.fpm-package-lock') then
+!>         wait_for_file_to_be_deleted('.fpm-package-lock')
+!>2)   create_file('.fpm-package-lock')
+!>3)   do_something()
+!>4)   delete_file('.fpm-package-lock')
+!>```
+!> The problem with this code is that `.fpm-packge-lock` may be created by some
+!> other process after the check on line (1), but before line (2) has executed,
+!> and then it's not very clear what will happen, both processes might think
+!> that they are have acquired a lock on the package directory. A better piece
+!> of code could be:
+!>```
+!>error = create_file('.fpm-package-lock')
+!>if error == ALREADY_EXISTS then
+!>    create_this_file_again_after_deletion('.fpm-package-lock')
+!>do_something()
+!>delete_file('.fpm-package-lock')
+!>```
+
+! IMPLEMENTATION NOTES(@emmabastas)
+!
+! There are many ways to lock a directory, and the approach we're using here
+! is maybe the simplest: If `.fpm-package-lock` exists in the package directory
+! then the directory is locked, if we manage to create `.fpm-package-lock` then
+! we have the lock.
+!
+! The problem with this approach is that if `fpm` doesn't terminate normally, or
+! maybe if there's some bug we might leave the lock-file behind, and later fpm
+! process might wait indefinitely for the package to be unlocked with no way
+! of knowing that the file was left behind by accident.
+!
+! The approach taken here is to simply print a warning/info message to the user
+! about the lock-file, and that they can remove it manually if they suspect it's
+! been left behind by accident, this is how `git` does it.
+!
+! (RANT STARTS HERE)
+!
+! A common attempt at improving this situation might be to write the PID +
+! process start time into the lock-file, that way other processes can verify
+! that the lock-file wasn't left behind on accident. However this adds quite a
+! bit of complexity to the code, and it is very difficult / maybe even
+! impossible to do without race-conditions: There is no atomic way to tell the
+! OS to:
+!    > Open this file for reading with a shared lock in case it exists and
+!    > if it doesn't exists then create the file with for writing with an
+!    > exclusive lock.
+! Even if we we're able to do it there is a conceptual flaw: Distributed file
+! systems. If the package lives on another machine that you're accessing through
+! something like NFS then you'll end up writing your PID to a file living on
+! another machine that's not running the process, and so processes on that
+! machine can't know whether the lock is valid or not.
+!
+! Now we might turn to actual OS file-locking primitives such as `fcntl` on UNIX
+! and `LockFile` on Windows. This is again a step-up in complexity, and I don't
+! know about `LockFile` but `fcntl` is fraught with problems:
+! https://chris.improbable.org/2010/12/16/everything-you-never-wanted-to-know-about-file-locking/
+!
+! My conclusion is that anything more advanced than the current implementation
+! might just not be worth it, but I'm happy to be proven wrong! :-)
+
+module fpm_lock
+
+use :: fpm_error, only : error_t, fatal_error
+use :: fpm_os, only : get_current_directory
+use :: fpm_filesystem, only : join_path
+use, intrinsic :: iso_fortran_env, only : stderr => error_unit
+use iso_c_binding, only : c_int, c_char, c_null_char, c_ptr, c_funptr, &
+                          c_funloc, c_f_pointer
+use fpm_strings, only: f_string
+
+
+implicit none
+private
+public :: fpm_lock_acquire, fpm_lock_acquire_noblock, fpm_lock_release
+
+logical :: has_lock = .false.
+logical :: has_atexit_handler = .false.
+
+interface
+    ! This function is defined in `fpm_lock.c`.
+    subroutine c_create(path, iostat, iomsg, exists) bind(c, name='c_create')
+        import c_int, c_char, c_ptr
+        character(kind=c_char), intent(in)  :: path(*)
+        integer(kind=c_int),    intent(out) :: iostat
+        type(c_ptr),            intent(out) :: iomsg
+        integer(kind=c_int),    intent(out) :: exists
+    end subroutine c_create
+
+    ! This function is defined in `fpm_lock.c`.
+    subroutine c_remove(path, iostat, iomsg) bind(c, name='c_remove')
+        import c_int, c_char, c_ptr
+        character(kind=c_char), intent(in)  :: path(*)
+        integer(kind=c_int),    intent(out) :: iostat
+        type(c_ptr),            intent(out) :: iomsg
+    end subroutine c_remove
+
+    ! atexit is a standard C90 function.
+    subroutine atexit(fptr) bind(c, name='atexit')
+        import c_funptr
+        type(c_funptr), value :: fptr
+    end subroutine atexit
+
+    ! free is also standard C.
+    subroutine c_free(ptr) BIND(C, name='free')
+        import
+        type(c_ptr), value :: ptr
+    end subroutine c_free
+end interface
+
+contains
+
+! This routine is called when fpm terminates normally and is used to remove
+! the .fpm-package-lock in case we created it.
+!
+! Of note is that this only works when fpm is terminated "normally", meaning
+! if a user manually kills the process this function won't be called.
+subroutine atexit_cleanup()
+    type(error_t), allocatable :: error
+    call fpm_lock_release(error)
+    ! If there is an error there isn't all that much for us to do, we're exiting
+    ! the program after all.
+end subroutine atexit_cleanup
+
+!> Like [[fpm_lock_acquire]] but it some other process already has a lock it
+!> returns immediately instead of waiting indefinitely.
+subroutine fpm_lock_acquire_noblock(error, success)
+    !> Error handling
+    type(error_t), allocatable, intent(out) :: error
+
+    !> `.true.` if a package lock was acquired, `.false.` otherwise.
+    logical, optional, intent(out) :: success
+
+    ! unit for open lock-file.
+    integer :: lock_unit
+
+    ! Error status and message.
+    integer :: iostat
+    character(:), allocatable :: iomsg
+    character(len=1), pointer :: c_iomsg(:)
+    type(c_ptr) :: c_iomsg_ptr
+
+    ! Did the lock-file exist already or not.
+    integer :: exists
+
+    if (has_lock) then
+        call fatal_error (error, &
+            "Tried locking package directory when it's already locked")
+        if (present(success)) success = .false.
+        return
+    end if
+
+    ! NOTE(@emmabastas) as far as I can tell there is no atomic way to tell
+    ! Fortran to "create this file and let me know if it already exists", I
+    ! initially thought that the snippet bellow would do the trick but I think
+    ! that
+    !   * status='unknown' makes the open operation implementation-defined.
+    !   * status='replace' gives no way of telling if the file existed already
+    !     or not.
+    !
+    !open(file='.fpm-package-lock', &
+    !     action='read', &
+    !     status='unknown', &
+    !     newunit=lock_unit, &
+    !     iostat=iostat, &
+    !     iomsg=iomsg)
+    !inquire(unit=lock_unit, exist=exists)
+
+    call c_create('.fpm-package-lock'//c_null_char, iostat, c_iomsg_ptr, exists)
+
+    ! An error occurred when opening the file.
+    if (iostat /= 0) then
+        if (present(success)) success = .false.
+
+        ! Convert C pointer to Fortran pointer.
+        call c_f_pointer(c_iomsg_ptr, c_iomsg, [1024])
+        ! Convert Fortran pointer to Fortran string.
+        iomsg = f_string(c_iomsg)
+        !iomsg = f_string(c_iomsg_ptr)
+        call fatal_error(error, "Error trying to delete lock-file: "//iomsg)
+
+        call c_free(c_iomsg_ptr)
+        return
+    end if
+
+    ! The lock-file already exists, so some other process probably has the lock.
+    if (exists /= 0) then
+        if (present(success)) success = .false.
+        return
+    end if
+
+    ! At this point we have the lock.
+    has_lock = .true.
+    if (present(success)) success = .true.
+
+    ! Setup the atexit handler
+    call atexit(c_funloc(atexit_cleanup))
+end subroutine fpm_lock_acquire_noblock
+
+!> Try to acquire a lock on the current package directory. If some other process
+!> already has a lock this function blocks until it can get the lock.
+!> @note
+!> You cannot use this function multiple times without calling
+!> [[fpm_lock_release]] first.
+!> @endnote
+subroutine fpm_lock_acquire(error)
+    !> Error handling
+    type(error_t), allocatable, intent(out) :: error
+
+    logical :: got_lock
+
+    character(len=:), allocatable :: cwd
+    character(len=:), allocatable :: lockfile_path
+
+    call get_current_directory(cwd, error)
+    if (allocated(error)) return
+
+    lockfile_path = join_path(cwd, '.fpm-pakage-lock')
+
+    call fpm_lock_acquire_noblock(error, success=got_lock)
+    if (allocated(error)) return
+
+    if (.not. got_lock) then
+        write(stderr, *) "Warning: file "//lockfile_path//" exists."
+        write(stderr, *) ""
+        write(stderr, *) "Another process seams to be working on this package"
+        write(stderr, *) "already and this process will wait for .fpm-package-lock"
+        write(stderr, *) "to be removed before proceeding. If you think that a"
+        write(stderr, *) "previous process crashed/terminated without removing"
+        write(stderr, *) ".fpm-package-lock then you can try removing it manually."
+        write(stderr, *)
+        write(stderr, *) "If the problem persists then please file a bug report"
+        write(stderr, *) "at https://github.com/fortran-lang/fpm/issues"
+    end if
+
+    do while (.not. got_lock)
+        call sleep(1) ! not very sophisticated but it works :-)
+        call fpm_lock_acquire_noblock(error, success=got_lock)
+        if (allocated(error)) return
+    end do
+end subroutine fpm_lock_acquire
+
+!> Release a lock on the current package directory
+!> @note
+!> You can only release a lock if you acquired it with [[fpm_lock_acquire]]
+!> first.
+!> @endnote
+subroutine fpm_lock_release(error)
+    !> Error handling
+    type(error_t), allocatable, intent(out) :: error
+
+    integer :: lock_unit
+
+    integer :: iostat
+    character(:), allocatable :: iomsg
+    character(len=1), pointer :: c_iomsg(:)
+    type(c_ptr) :: c_iomsg_ptr
+
+    if (.not. has_lock) then
+        call fatal_error(error, &
+            "Tried unlocking package directory when it wasn't locked")
+        return
+    end if
+
+    has_lock = .false.
+
+    call c_remove('.fpm-package-lock'//c_null_char, iostat, c_iomsg_ptr)
+
+    if (iostat /= 0) then
+        ! Convert C pointer to Fortran pointer.
+        call c_f_pointer(c_iomsg_ptr, c_iomsg, [1024])
+        ! Convert Fortran pointer to Fortran string.
+        iomsg = f_string(c_iomsg)
+        !iomsg = f_string(c_iomsg_ptr)
+        call fatal_error(error, "Error trying to delete lock-file: "//iomsg)
+
+        call c_free(c_iomsg_ptr)
+    end if
+end subroutine fpm_lock_release
+
+end module fpm_lock
diff --git a/test/fpm_test/main.f90 b/test/fpm_test/main.f90
index d272761f93..895d8a9aef 100644
--- a/test/fpm_test/main.f90
+++ b/test/fpm_test/main.f90
@@ -6,6 +6,7 @@ program fpm_testing
     use test_compiler, only : collect_compiler
     use test_manifest, only : collect_manifest
     use test_filesystem, only : collect_filesystem
+    use test_lock, only : collect_lock
     use test_source_parsing, only : collect_source_parsing
     use test_module_dependencies, only : collect_module_dependencies
     use test_package_dependencies, only : collect_package_dependencies
@@ -27,6 +28,7 @@ program fpm_testing
         & new_testsuite("fpm_toml", collect_toml), &        
         & new_testsuite("fpm_manifest", collect_manifest), &
         & new_testsuite("fpm_filesystem", collect_filesystem), &
+        & new_testsuite("fpm_lock", collect_lock), &
         & new_testsuite("fpm_source_parsing", collect_source_parsing), &
         & new_testsuite("fpm_module_dependencies", collect_module_dependencies), &
         & new_testsuite("fpm_package_dependencies", collect_package_dependencies), &
diff --git a/test/fpm_test/test_lock.f90 b/test/fpm_test/test_lock.f90
new file mode 100644
index 0000000000..8ff49ea716
--- /dev/null
+++ b/test/fpm_test/test_lock.f90
@@ -0,0 +1,185 @@
+module test_lock
+
+    use testsuite, only : new_unittest, unittest_t, test_failed
+    use fpm_error, only : error_t, fatal_error
+    use fpm_filesystem, only : run, exists
+    use fpm_lock, only : fpm_lock_acquire, fpm_lock_acquire_noblock, &
+                         fpm_lock_release
+
+    implicit none
+    private
+    public :: collect_lock
+
+contains
+
+    !> Collect unit tests.
+    subroutine collect_lock(tests)
+
+        !> Unit tests to collect.
+        type(unittest_t), allocatable, intent(out) :: tests(:)
+
+        tests = [ &
+            & new_unittest('acquire-leaves-lockfile', acquire_leaves_lockfile), &
+            & new_unittest('aquire-release-leaves-nothing', acquire_release_leaves_nothing), &
+            & new_unittest('acquire-release-acquire-release', acquire_release_acquire_release), &
+            & new_unittest('double-acquire', double_acquire, should_fail=.true.), &
+            & new_unittest('release', release, should_fail=.true.), &
+            & new_unittest('acquire-release-release', acquire_release_release, should_fail=.true.), &
+            & new_unittest('acquire-existing-lockfile-valid', acquire_existing_lockfile_valid), &
+            & new_unittest('acquire-blocks', acquire_blocks) &
+        ]
+    end subroutine collect_lock
+
+    !> Setup before each unittest
+    subroutine setup()
+        type(error_t), allocatable :: dummy_error
+        call fpm_lock_release(dummy_error)
+        call run ('rm -f .fpm-package-lock')
+    end subroutine setup
+
+    !> Cleanup after each unit test
+    subroutine cleanup()
+        type(error_t), allocatable :: dummy_error
+        call fpm_lock_release(dummy_error)
+        call run ('touch .fpm-package-lock')
+    end subroutine cleanup
+
+    !> Helper function to acquire a lock, and if that fails an error is raised.
+    subroutine acquire_lock(error)
+        type(error_t), allocatable, intent(out) :: error
+        logical :: success
+
+        call fpm_lock_acquire_noblock(error, success)
+        if (allocated(error)) return
+        if (.not. success) then
+            call test_failed(error, "lock-file acquire failed")
+        end if
+    end subroutine acquire_lock
+
+    !> A simple fpm_lock_acquire_noblock creates a lock-file.
+    subroutine acquire_leaves_lockfile(error)
+        type(error_t), allocatable, intent(out) :: error
+        logical :: success
+
+        call setup()
+
+        call acquire_lock(error)
+        if (allocated(error)) return
+        if (.not. exists('.fpm-package-lock')) then
+            call test_failed(error, "lock-file wasn't created")
+        end if
+
+        call cleanup()
+
+    end subroutine acquire_leaves_lockfile
+
+    !> fpm_lock_release removes the lock-file.
+    subroutine acquire_release_leaves_nothing(error)
+        type(error_t), allocatable, intent(out) :: error
+        logical :: success
+
+        call setup()
+
+        call acquire_lock(error)
+        if (allocated(error)) return
+
+        call fpm_lock_release(error)
+        if (allocated(error)) return
+        if (exists('.fpm-package-lock')) then
+            call test_failed(error, "lock-file wasn't removed")
+        end if
+
+        call cleanup()
+    end subroutine acquire_release_leaves_nothing
+
+    !> subsequent locks and releases work.
+    subroutine acquire_release_acquire_release (error)
+        type(error_t), allocatable, intent(out) :: error
+
+        call setup()
+
+        call acquire_lock(error)
+        if (allocated(error)) return
+
+        call fpm_lock_release(error)
+        if (allocated(error)) return
+
+        call acquire_lock(error)
+        if (allocated(error)) return
+
+        call fpm_lock_release(error)
+        if (allocated(error)) return
+
+        call cleanup()
+    end subroutine acquire_release_acquire_release
+
+    !> Double acquire should cause an error.
+    subroutine double_acquire(error)
+        type(error_t), allocatable, intent(out) :: error
+
+        call setup()
+
+        call fpm_lock_acquire_noblock(error)
+        call fpm_lock_acquire_noblock(error)
+
+        call cleanup()
+    end subroutine double_acquire
+
+    !> Release without acquire should cause an error.
+    subroutine release(error)
+        type(error_t), allocatable, intent(out) :: error
+
+        call cleanup()
+
+        call fpm_lock_release(error)
+
+        call cleanup()
+    end subroutine release
+
+    !> One release to much should cause and error
+    subroutine acquire_release_release(error)
+        type(error_t), allocatable, intent(out) :: error
+
+        call setup()
+
+        call fpm_lock_acquire_noblock(error)
+        call fpm_lock_release(error)
+        call fpm_lock_release(error)
+    end subroutine acquire_release_release
+
+    !> If a lock-file already exists then we shoudln't acquire a lock.
+    subroutine acquire_existing_lockfile_valid(error)
+        type(error_t), allocatable, intent(out) :: error
+        logical :: success
+
+        call setup()
+
+        ! Some other process acquires a lock.
+        call run('touch .fpm-package-lock')
+
+        ! We expect this to not succeed, (but no errors should be raised).
+        call fpm_lock_acquire_noblock(error, success=success)
+        if (allocated(error)) return
+        if (success) then
+            call test_failed(error, "Expected package lock to fail")
+        end if
+
+        call cleanup()
+    end subroutine acquire_existing_lockfile_valid
+
+    !> A blocking acquire should resume when the lock-file is deleted.
+    subroutine acquire_blocks(error)
+        type(error_t), allocatable, intent(out) :: error
+
+        call setup()
+
+        ! Some other process acquires a lock to work on the package briefly.
+        call run('touch .fpm-package-lock && sleep 1 && rm .fpm-package-lock')
+
+        ! Our blocking acquire should wait for a bit and then go through
+        call fpm_lock_acquire(error)
+        if (allocated(error)) return
+
+        call cleanup()
+    end subroutine
+end module test_lock

From 810c98c3770479425d01c73c8b5b012199d4a26f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Emma=20Bast=C3=A5s?= <emma.bastas@protonmail.com>
Date: Thu, 3 Apr 2025 12:24:47 +0200
Subject: [PATCH 02/10] Make a shell command run async

---
 test/fpm_test/test_lock.f90 | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/test/fpm_test/test_lock.f90 b/test/fpm_test/test_lock.f90
index 8ff49ea716..e028b9e1e8 100644
--- a/test/fpm_test/test_lock.f90
+++ b/test/fpm_test/test_lock.f90
@@ -174,7 +174,7 @@ subroutine acquire_blocks(error)
         call setup()
 
         ! Some other process acquires a lock to work on the package briefly.
-        call run('touch .fpm-package-lock && sleep 1 && rm .fpm-package-lock')
+        call run('touch .fpm-package-lock && sleep 1 && rm .fpm-package-lock &')
 
         ! Our blocking acquire should wait for a bit and then go through
         call fpm_lock_acquire(error)

From 1d3301df9567f0cdcecd369501509d5546df9015 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Emma=20Bast=C3=A5s?= <emma.bastas@protonmail.com>
Date: Thu, 3 Apr 2025 14:34:37 +0200
Subject: [PATCH 03/10] Remove has_atexit

Also it wasn't even used in the first place, although it should have been.
---
 src/fpm_lock.f90 | 1 -
 1 file changed, 1 deletion(-)

diff --git a/src/fpm_lock.f90 b/src/fpm_lock.f90
index d73ff70165..383c35bcf1 100644
--- a/src/fpm_lock.f90
+++ b/src/fpm_lock.f90
@@ -124,7 +124,6 @@ module fpm_lock
 public :: fpm_lock_acquire, fpm_lock_acquire_noblock, fpm_lock_release
 
 logical :: has_lock = .false.
-logical :: has_atexit_handler = .false.
 
 interface
     ! This function is defined in `fpm_lock.c`.

From f1f14e49319554209f2a33ac5595ebe419c14fe3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Emma=20Bast=C3=A5s?= <emma.bastas@protonmail.com>
Date: Thu, 3 Apr 2025 14:51:20 +0200
Subject: [PATCH 04/10] Remove has_lock

Also change some unittests to account for this removal
---
 src/fpm_lock.f90            | 18 --------------
 test/fpm_test/test_lock.f90 | 47 +++++++++++++++++++++++++++++++++----
 2 files changed, 42 insertions(+), 23 deletions(-)

diff --git a/src/fpm_lock.f90 b/src/fpm_lock.f90
index 383c35bcf1..ddf0bad2ea 100644
--- a/src/fpm_lock.f90
+++ b/src/fpm_lock.f90
@@ -123,8 +123,6 @@ module fpm_lock
 private
 public :: fpm_lock_acquire, fpm_lock_acquire_noblock, fpm_lock_release
 
-logical :: has_lock = .false.
-
 interface
     ! This function is defined in `fpm_lock.c`.
     subroutine c_create(path, iostat, iomsg, exists) bind(c, name='c_create')
@@ -191,13 +189,6 @@ subroutine fpm_lock_acquire_noblock(error, success)
     ! Did the lock-file exist already or not.
     integer :: exists
 
-    if (has_lock) then
-        call fatal_error (error, &
-            "Tried locking package directory when it's already locked")
-        if (present(success)) success = .false.
-        return
-    end if
-
     ! NOTE(@emmabastas) as far as I can tell there is no atomic way to tell
     ! Fortran to "create this file and let me know if it already exists", I
     ! initially thought that the snippet bellow would do the trick but I think
@@ -238,7 +229,6 @@ subroutine fpm_lock_acquire_noblock(error, success)
     end if
 
     ! At this point we have the lock.
-    has_lock = .true.
     if (present(success)) success = .true.
 
     ! Setup the atexit handler
@@ -304,14 +294,6 @@ subroutine fpm_lock_release(error)
     character(len=1), pointer :: c_iomsg(:)
     type(c_ptr) :: c_iomsg_ptr
 
-    if (.not. has_lock) then
-        call fatal_error(error, &
-            "Tried unlocking package directory when it wasn't locked")
-        return
-    end if
-
-    has_lock = .false.
-
     call c_remove('.fpm-package-lock'//c_null_char, iostat, c_iomsg_ptr)
 
     if (iostat /= 0) then
diff --git a/test/fpm_test/test_lock.f90 b/test/fpm_test/test_lock.f90
index e028b9e1e8..f9952a8ee4 100644
--- a/test/fpm_test/test_lock.f90
+++ b/test/fpm_test/test_lock.f90
@@ -22,11 +22,13 @@ subroutine collect_lock(tests)
             & new_unittest('acquire-leaves-lockfile', acquire_leaves_lockfile), &
             & new_unittest('aquire-release-leaves-nothing', acquire_release_leaves_nothing), &
             & new_unittest('acquire-release-acquire-release', acquire_release_acquire_release), &
-            & new_unittest('double-acquire', double_acquire, should_fail=.true.), &
+            & new_unittest('double-acquire', double_acquire), &
             & new_unittest('release', release, should_fail=.true.), &
             & new_unittest('acquire-release-release', acquire_release_release, should_fail=.true.), &
             & new_unittest('acquire-existing-lockfile-valid', acquire_existing_lockfile_valid), &
-            & new_unittest('acquire-blocks', acquire_blocks) &
+            & new_unittest('acquire-blocks', acquire_blocks), &
+            & new_unittest('release-rouge-remove', release_rouge_remove) &
+
         ]
     end subroutine collect_lock
 
@@ -113,14 +115,22 @@ subroutine acquire_release_acquire_release (error)
         call cleanup()
     end subroutine acquire_release_acquire_release
 
-    !> Double acquire should cause an error.
+    !> Double acquire should not work the second time.
     subroutine double_acquire(error)
         type(error_t), allocatable, intent(out) :: error
+        logical :: success
 
         call setup()
 
         call fpm_lock_acquire_noblock(error)
-        call fpm_lock_acquire_noblock(error)
+        if (allocated(error)) return
+
+        call fpm_lock_acquire_noblock(error, success)
+        if (allocated(error)) return
+
+        if (success) then
+            call test_failed(error, "Expected lock to not succeed.")
+        end if
 
         call cleanup()
     end subroutine double_acquire
@@ -129,7 +139,7 @@ end subroutine double_acquire
     subroutine release(error)
         type(error_t), allocatable, intent(out) :: error
 
-        call cleanup()
+        call setup()
 
         call fpm_lock_release(error)
 
@@ -182,4 +192,31 @@ subroutine acquire_blocks(error)
 
         call cleanup()
     end subroutine
+
+    !> If some other process removes our lock-file then fpm_lock_release should
+    !> give an error.
+    subroutine release_rouge_remove(error)
+        type(error_t), allocatable, intent(out) :: error
+        type(error_t), allocatable :: dummy_error
+        logical success
+
+        call setup()
+
+        call fpm_lock_acquire_noblock(error, success)
+        if (allocated(error)) return
+        if (.not. success) then
+            call test_failed(error, "lock-file acquire failed")
+        end if
+
+        ! Some reouge process removes the lock-file
+        call run('rm .fpm-package-lock')
+
+        call fpm_lock_release(dummy_error)
+        if (.not. allocated(dummy_error)) then
+            call test_failed(error, &
+                "Expected fpm_lock_release to fail, but it succeeded")
+        end if
+
+        call cleanup()
+    end subroutine
 end module test_lock

From 2abe27dfcd732454911da93d9170b9bf1e1fa0bd Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Emma=20Bast=C3=A5s?= <emma.bastas@protonmail.com>
Date: Thu, 3 Apr 2025 15:56:05 +0200
Subject: [PATCH 05/10] Replace `c_remove` with Fortran instrinsics

---
 src/fpm_lock.c   | 15 ---------------
 src/fpm_lock.f90 | 41 +++++++++++++++++++----------------------
 2 files changed, 19 insertions(+), 37 deletions(-)

diff --git a/src/fpm_lock.c b/src/fpm_lock.c
index e89bf03faa..0b4a40e732 100644
--- a/src/fpm_lock.c
+++ b/src/fpm_lock.c
@@ -71,18 +71,3 @@ void c_create(char *path, int *iostat, char **iomsg, int *exists) {
     *iostat = 0;
     *iomsg = NULL;
 }
-
-// @brief Remove a file/directory in an atomic manner.
-// @param path
-// @param iostat
-// @param iomsg
-void c_remove(char *path, int *iostat, char **iomsg) {
-    int stat = remove(path);
-    if (stat == -1) {
-        *iostat = 1;
-        *iomsg = my_strerror(errno);
-        return;
-    }
-    *iostat = 0;
-    *iomsg = NULL;
-}
diff --git a/src/fpm_lock.f90 b/src/fpm_lock.f90
index ddf0bad2ea..19f29b16d5 100644
--- a/src/fpm_lock.f90
+++ b/src/fpm_lock.f90
@@ -112,7 +112,7 @@ module fpm_lock
 
 use :: fpm_error, only : error_t, fatal_error
 use :: fpm_os, only : get_current_directory
-use :: fpm_filesystem, only : join_path
+use :: fpm_filesystem, only : join_path, delete_file
 use, intrinsic :: iso_fortran_env, only : stderr => error_unit
 use iso_c_binding, only : c_int, c_char, c_null_char, c_ptr, c_funptr, &
                           c_funloc, c_f_pointer
@@ -133,14 +133,6 @@ subroutine c_create(path, iostat, iomsg, exists) bind(c, name='c_create')
         integer(kind=c_int),    intent(out) :: exists
     end subroutine c_create
 
-    ! This function is defined in `fpm_lock.c`.
-    subroutine c_remove(path, iostat, iomsg) bind(c, name='c_remove')
-        import c_int, c_char, c_ptr
-        character(kind=c_char), intent(in)  :: path(*)
-        integer(kind=c_int),    intent(out) :: iostat
-        type(c_ptr),            intent(out) :: iomsg
-    end subroutine c_remove
-
     ! atexit is a standard C90 function.
     subroutine atexit(fptr) bind(c, name='atexit')
         import c_funptr
@@ -287,24 +279,29 @@ subroutine fpm_lock_release(error)
     !> Error handling
     type(error_t), allocatable, intent(out) :: error
 
-    integer :: lock_unit
-
+    integer :: unit
     integer :: iostat
-    character(:), allocatable :: iomsg
-    character(len=1), pointer :: c_iomsg(:)
-    type(c_ptr) :: c_iomsg_ptr
+    character(len=256) :: iomsg
 
-    call c_remove('.fpm-package-lock'//c_null_char, iostat, c_iomsg_ptr)
+    open(file='.fpm-package-lock', &
+              action='read', &
+              status='old', &
+              newunit=unit, &
+              iostat=iostat, &
+              iomsg=iomsg)
 
     if (iostat /= 0) then
-        ! Convert C pointer to Fortran pointer.
-        call c_f_pointer(c_iomsg_ptr, c_iomsg, [1024])
-        ! Convert Fortran pointer to Fortran string.
-        iomsg = f_string(c_iomsg)
-        !iomsg = f_string(c_iomsg_ptr)
-        call fatal_error(error, "Error trying to delete lock-file: "//iomsg)
+        call fatal_error(error, "Error opening lock-file for deletion: "//iomsg)
+        return
+    end if
 
-        call c_free(c_iomsg_ptr)
+    close(unit=unit, &
+          status='delete', &
+          iostat=iostat)
+
+    if (iostat /= 0) then
+        call fatal_error(error, "Error closing lock-file")
+        return
     end if
 end subroutine fpm_lock_release
 

From deffb4b83bc898397385c5adb1109e27da03ab54 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Emma=20Bast=C3=A5s?= <emma.bastas@protonmail.com>
Date: Thu, 3 Apr 2025 16:20:02 +0200
Subject: [PATCH 06/10] Replace `c_create` with Fortran instrinsics

---
 src/fpm_lock.c   | 73 ------------------------------------------------
 src/fpm_lock.f90 | 72 +++++++++++++----------------------------------
 2 files changed, 20 insertions(+), 125 deletions(-)
 delete mode 100644 src/fpm_lock.c

diff --git a/src/fpm_lock.c b/src/fpm_lock.c
deleted file mode 100644
index 0b4a40e732..0000000000
--- a/src/fpm_lock.c
+++ /dev/null
@@ -1,73 +0,0 @@
-#include <errno.h>
-#include <fcntl.h>
-#include <string.h>
-#include <stdlib.h>
-
-#ifndef _WIN32
-
-#include <unistd.h>
-
-#else
-
-#include <io.h>
-#include <sys\stat.h>
-
-#define open _open
-
-#endif
-
-// @brief A thread-safe version of strerror using malloc.
-// @param errnum
-char *my_strerror(int errnum) {
-    const int BUFSIZE = 256;
-    char *buf = malloc(BUFSIZE);
-
-// POSIX strerror_r and Windows strerror_s are both thread-safe versions of
-// strerror with the same interface except for the order of the arguments.
-#ifndef _WIN32
-    int stat = strerror_r(errnum, buf, BUFSIZE);
-#else
-    int stat = strerror_s(buf, BUFSIZE, errnum);
-#endif
-    if (stat != 0) {
-        const char *MSG = "Unknown error";
-        memcpy(buf, MSG, strlen(MSG));
-    }
-
-    return buf;
-}
-
-/// @brief Create a file if it doesn't already exist in an atomic manner.
-/// @param path
-/// @param iostat Zero if file was successfully created, nonzero otherwise.
-/// @param iomsg Points to an error message if an error occurred, NULL otherwise.
-/// @param exsits Zero if the file didn't exist already, nonzero otherwise.
-void c_create(char *path, int *iostat, char **iomsg, int *exists) {
-    int fd = open(path,
-                  O_RDONLY | O_CREAT | O_EXCL,
-                  S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH);
-
-    if (fd == -1 && errno != EEXIST) {  // Some unexpected error occurred.
-        *iostat = 1;
-        *iomsg = my_strerror(errno);
-        return;
-    }
-
-    if (fd == -1 && errno == EEXIST) {  // The lock-file already exists.
-        *exists = 1;
-    }
-
-    if (fd != -1) {  // The lock-file was created.
-        *exists = 0;
-
-        int stat = close(fd);
-        if (stat == -1) {
-            *iostat = 1;
-            *iomsg = my_strerror(errno);
-            return;
-        }
-    }
-
-    *iostat = 0;
-    *iomsg = NULL;
-}
diff --git a/src/fpm_lock.f90 b/src/fpm_lock.f90
index 19f29b16d5..b903606628 100644
--- a/src/fpm_lock.f90
+++ b/src/fpm_lock.f90
@@ -114,9 +114,7 @@ module fpm_lock
 use :: fpm_os, only : get_current_directory
 use :: fpm_filesystem, only : join_path, delete_file
 use, intrinsic :: iso_fortran_env, only : stderr => error_unit
-use iso_c_binding, only : c_int, c_char, c_null_char, c_ptr, c_funptr, &
-                          c_funloc, c_f_pointer
-use fpm_strings, only: f_string
+use iso_c_binding, only : c_funptr, c_funloc
 
 
 implicit none
@@ -124,26 +122,11 @@ module fpm_lock
 public :: fpm_lock_acquire, fpm_lock_acquire_noblock, fpm_lock_release
 
 interface
-    ! This function is defined in `fpm_lock.c`.
-    subroutine c_create(path, iostat, iomsg, exists) bind(c, name='c_create')
-        import c_int, c_char, c_ptr
-        character(kind=c_char), intent(in)  :: path(*)
-        integer(kind=c_int),    intent(out) :: iostat
-        type(c_ptr),            intent(out) :: iomsg
-        integer(kind=c_int),    intent(out) :: exists
-    end subroutine c_create
-
     ! atexit is a standard C90 function.
     subroutine atexit(fptr) bind(c, name='atexit')
         import c_funptr
         type(c_funptr), value :: fptr
     end subroutine atexit
-
-    ! free is also standard C.
-    subroutine c_free(ptr) BIND(C, name='free')
-        import
-        type(c_ptr), value :: ptr
-    end subroutine c_free
 end interface
 
 contains
@@ -174,53 +157,38 @@ subroutine fpm_lock_acquire_noblock(error, success)
 
     ! Error status and message.
     integer :: iostat
-    character(:), allocatable :: iomsg
-    character(len=1), pointer :: c_iomsg(:)
-    type(c_ptr) :: c_iomsg_ptr
+    character(len=256) :: iomsg
 
     ! Did the lock-file exist already or not.
     integer :: exists
 
-    ! NOTE(@emmabastas) as far as I can tell there is no atomic way to tell
-    ! Fortran to "create this file and let me know if it already exists", I
-    ! initially thought that the snippet bellow would do the trick but I think
-    ! that
-    !   * status='unknown' makes the open operation implementation-defined.
-    !   * status='replace' gives no way of telling if the file existed already
-    !     or not.
-    !
-    !open(file='.fpm-package-lock', &
-    !     action='read', &
-    !     status='unknown', &
-    !     newunit=lock_unit, &
-    !     iostat=iostat, &
-    !     iomsg=iomsg)
-    !inquire(unit=lock_unit, exist=exists)
-
-    call c_create('.fpm-package-lock'//c_null_char, iostat, c_iomsg_ptr, exists)
-
-    ! An error occurred when opening the file.
+    open(file='.fpm-package-lock', &
+         action='read', &
+         status='new', &
+         newunit=lock_unit, &
+         iostat=iostat, &
+         iomsg=iomsg)
+
+    ! If there was an error we asume it's because the lock-file already exists
+    ! (but there could be other reasons too)
     if (iostat /= 0) then
         if (present(success)) success = .false.
-
-        ! Convert C pointer to Fortran pointer.
-        call c_f_pointer(c_iomsg_ptr, c_iomsg, [1024])
-        ! Convert Fortran pointer to Fortran string.
-        iomsg = f_string(c_iomsg)
-        !iomsg = f_string(c_iomsg_ptr)
-        call fatal_error(error, "Error trying to delete lock-file: "//iomsg)
-
-        call c_free(c_iomsg_ptr)
         return
     end if
 
-    ! The lock-file already exists, so some other process probably has the lock.
-    if (exists /= 0) then
+    ! At this point we have the lock.
+
+    ! Close the unit without removing the lock-file
+    close(unit=lock_unit, &
+          status='keep', &
+          iostat=iostat)
+
+    if (iostat /= 0) then
         if (present(success)) success = .false.
+        call fatal_error(error, "Error closing lock-file")
         return
     end if
 
-    ! At this point we have the lock.
     if (present(success)) success = .true.
 
     ! Setup the atexit handler

From df04d147180e71128b288ff41ce1b04e25998ad7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Emma=20Bast=C3=A5s?= <emma.bastas@protonmail.com>
Date: Mon, 21 Apr 2025 16:46:17 +0200
Subject: [PATCH 07/10] Remove unused `exists` variable

---
 src/fpm_lock.f90 | 3 ---
 1 file changed, 3 deletions(-)

diff --git a/src/fpm_lock.f90 b/src/fpm_lock.f90
index b903606628..9a058fb9cf 100644
--- a/src/fpm_lock.f90
+++ b/src/fpm_lock.f90
@@ -159,9 +159,6 @@ subroutine fpm_lock_acquire_noblock(error, success)
     integer :: iostat
     character(len=256) :: iomsg
 
-    ! Did the lock-file exist already or not.
-    integer :: exists
-
     open(file='.fpm-package-lock', &
          action='read', &
          status='new', &

From 327bc060baedcd757d6d182b2a3a8ece14e4653d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Emma=20Bast=C3=A5s?= <emma.bastas@protonmail.com>
Date: Mon, 21 Apr 2025 17:02:10 +0200
Subject: [PATCH 08/10] Temporarily remove atexit handler

---
 src/fpm_lock.f90 | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/fpm_lock.f90 b/src/fpm_lock.f90
index 9a058fb9cf..9a5cf8d3f9 100644
--- a/src/fpm_lock.f90
+++ b/src/fpm_lock.f90
@@ -189,7 +189,7 @@ subroutine fpm_lock_acquire_noblock(error, success)
     if (present(success)) success = .true.
 
     ! Setup the atexit handler
-    call atexit(c_funloc(atexit_cleanup))
+    !call atexit(c_funloc(atexit_cleanup))
 end subroutine fpm_lock_acquire_noblock
 
 !> Try to acquire a lock on the current package directory. If some other process

From c3f56063851a2a4d66873957ea5c8fd793a77cfc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Emma=20Bast=C3=A5s?= <emma.bastas@protonmail.com>
Date: Mon, 21 Apr 2025 17:02:39 +0200
Subject: [PATCH 09/10] Remove unnecessary fpm_lock_release

  + Fix typo
---
 test/fpm_test/test_lock.f90 | 7 +------
 1 file changed, 1 insertion(+), 6 deletions(-)

diff --git a/test/fpm_test/test_lock.f90 b/test/fpm_test/test_lock.f90
index f9952a8ee4..221933c60c 100644
--- a/test/fpm_test/test_lock.f90
+++ b/test/fpm_test/test_lock.f90
@@ -28,21 +28,16 @@ subroutine collect_lock(tests)
             & new_unittest('acquire-existing-lockfile-valid', acquire_existing_lockfile_valid), &
             & new_unittest('acquire-blocks', acquire_blocks), &
             & new_unittest('release-rouge-remove', release_rouge_remove) &
-
         ]
     end subroutine collect_lock
 
     !> Setup before each unittest
     subroutine setup()
-        type(error_t), allocatable :: dummy_error
-        call fpm_lock_release(dummy_error)
         call run ('rm -f .fpm-package-lock')
     end subroutine setup
 
     !> Cleanup after each unit test
     subroutine cleanup()
-        type(error_t), allocatable :: dummy_error
-        call fpm_lock_release(dummy_error)
         call run ('touch .fpm-package-lock')
     end subroutine cleanup
 
@@ -208,7 +203,7 @@ subroutine release_rouge_remove(error)
             call test_failed(error, "lock-file acquire failed")
         end if
 
-        ! Some reouge process removes the lock-file
+        ! Some rouge process removes the lock-file
         call run('rm .fpm-package-lock')
 
         call fpm_lock_release(dummy_error)

From 76703e64e580f6cf91a856b4dd7cbb18dcd394fd Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Emma=20Bast=C3=A5s?= <emma.bastas@protonmail.com>
Date: Mon, 21 Apr 2025 17:04:01 +0200
Subject: [PATCH 10/10] Fix a race-condition

---
 test/fpm_test/test_lock.f90 | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/test/fpm_test/test_lock.f90 b/test/fpm_test/test_lock.f90
index 221933c60c..864c3da034 100644
--- a/test/fpm_test/test_lock.f90
+++ b/test/fpm_test/test_lock.f90
@@ -179,7 +179,8 @@ subroutine acquire_blocks(error)
         call setup()
 
         ! Some other process acquires a lock to work on the package briefly.
-        call run('touch .fpm-package-lock && sleep 1 && rm .fpm-package-lock &')
+        call run('touch .fpm-package-lock')
+        call run('sleep 0.5 && rm .fpm-package-lock &')
 
         ! Our blocking acquire should wait for a bit and then go through
         call fpm_lock_acquire(error)