@@ -1389,11 +1389,42 @@ module Write_disk = struct
13891389 | Error e -> raise_user_error_on_check_existance path e
13901390 ;;
13911391
1392+ let rec safely_copy_lock_dir_when_dst_non_existant ~dst src =
1393+ match check_existing_lock_dir src with
1394+ | Error e -> raise_user_error_on_check_existance src e
1395+ | Ok `Non_existant -> ()
1396+ | Ok `Is_existing_lock_dir ->
1397+ (match Path. readdir_unsorted_with_kinds src with
1398+ | Error e ->
1399+ User_error. raise
1400+ [ Pp. textf " Failed to list %s with error:" (Path. to_string_maybe_quoted src)
1401+ ; Unix_error.Detailed. pp e
1402+ ]
1403+ | Ok children ->
1404+ List. iter children ~f: (fun (name , kind ) ->
1405+ let child_src = Path. relative src name in
1406+ let child_dst = Path. relative dst name in
1407+ match kind with
1408+ | Unix. S_DIR ->
1409+ Path. mkdir_p child_dst;
1410+ safely_copy_lock_dir_when_dst_non_existant ~dst: child_dst child_src
1411+ | Unix. S_REG ->
1412+ Path. mkdir_p dst;
1413+ Io. copy_file ~src: child_src ~dst: child_dst ()
1414+ | _ -> assert false ))
1415+ ;;
1416+
13921417 (* Does the same checks as [safely_remove_lock_dir_if_exists_thunk] but it raises an
13931418 error if the lock dir already exists. [dst] is the new file name *)
13941419 let safely_rename_lock_dir_thunk ~dst src =
13951420 match check_existing_lock_dir src, check_existing_lock_dir dst with
1396- | Ok `Is_existing_lock_dir , Ok `Non_existant -> fun () -> Path. rename src dst
1421+ | Ok `Is_existing_lock_dir , Ok `Non_existant ->
1422+ fun () ->
1423+ (match Path. rename src dst with
1424+ | () -> ()
1425+ | exception Unix. Unix_error (Unix. EXDEV, _ , _ ) ->
1426+ safely_copy_lock_dir_when_dst_non_existant ~dst src;
1427+ Path. rm_rf src)
13971428 | Ok `Non_existant , Ok `Non_existant -> Fun. const ()
13981429 | _ , Ok `Is_existing_lock_dir ->
13991430 let error_reason_pp =
0 commit comments