add tests for `file` module predicates

reproduce failing `directory_exists/1` with working directory passed as first argument
reproduce failing `delete_directory/1` with ./test directory passed as first argument
reproduce failing `file_size/1` with 2 bytes files passed as first argument
reproduce failing `file_exists/1` with existing file passed as first argument
reproduce failing `file_modification_time/1`, `file_access_time/1` and `file_creation_time/1` with existing file passed as first argument
reproduce failing `directory_files/2` with existing directory passed as first argument
reproduce failing `delete_file/1` with existing file passed as first argument
reproduce failing `make_directory/1` with non-existing directory passed as first argument
reproduce failing `make_directory_path/1` with non-existing path passed as first argument
reproduce failing `path_canonical/2` with non-canonical path passed as first argument
reproduce failing `rename_file/2` with existing file passed as first argument, target file as second arg
revised `directory_exists/1` test case
renamed test files, test directories
use `path_segments/2`, remove path separators
do not write file size to current output
revised `directory_files/2` test
revised `path_canonical/2` test
revised `file_exists/1` test
removed hardcoded expected size
extracted hardcoded directory argument
remove path prefix containing path separator
revised expected ls cmd exit code so that it is platform-agnostic

Signed-off-by: Thierry Marianne <[email protected]>

diff --git a/tests-pl/issue_delete_directory.pl b/tests-pl/issue_delete_directory.pl
new file mode 100644 (file)
index 0000000..6e422d9
--- /dev/null
+++ b/tests-pl/issue_delete_directory.pl
@@ -0,0 +1,30 @@
+:- use_module(library(files)).
+:- use_module(library(iso_ext)).
+:- use_module(library(lists)).
+:- use_module(library(os), [setenv/2, getenv/2, shell/2]).
+
+check :-
+    act(TargetDir),
+    ground(TargetDir).
+
+act(TargetDir) :-
+    getenv("TARGET_DIRECTORY", TargetDir),
+       delete_directory(TargetDir),
+       append(["ls ", TargetDir], ListFilesCmd),
+       shell(ListFilesCmd, 0),
+       throw(system_error).
+act(TargetDir) :-
+    getenv("TARGET_DIRECTORY", TargetDir),
+       append(["ls ", TargetDir], ListFilesCmd),
+       \+ shell(ListFilesCmd, 0),
+    write(directory_deleted).
+
+main :-
+    call_cleanup(
+       (setenv("TARGET_DIRECTORY", "delete_directory_test"),
+        shell("mkdir delete_directory_test", 0),
+        check),
+        shell("test -d delete_directory_test && rmdir delete_directory_test || true", 0)
+    ).
+
+:- initialization(main).

diff --git a/tests-pl/issue_delete_file.pl b/tests-pl/issue_delete_file.pl
new file mode 100644 (file)
index 0000000..b75a2e6
--- /dev/null
+++ b/tests-pl/issue_delete_file.pl
@@ -0,0 +1,30 @@
+:- use_module(library(files)).
+:- use_module(library(iso_ext)).
+:- use_module(library(lists)).
+:- use_module(library(os), [setenv/2, getenv/2, shell/2]).
+
+check :-
+    act(TargetFile),
+    ground(TargetFile).
+
+act(TargetFile) :-
+    getenv("TARGET_FILE", TargetFile),
+       delete_file(TargetFile),
+       append(["ls ", TargetFile], ListFilesCmd),
+       shell(ListFilesCmd, 0),
+       throw(system_error).
+act(TargetFile) :-
+    getenv("TARGET_FILE", TargetFile),
+       append(["ls ", TargetFile], ListFilesCmd),
+       \+ shell(ListFilesCmd, 0),
+    write(file_deleted).
+
+main :-
+    call_cleanup(
+       (setenv("TARGET_FILE", "delete_file_test"),
+        shell("touch delete_file_test", 0),
+        check),
+        shell("test -e delete_file_test && rm delete_file_test || true", 0)
+    ).
+
+:- initialization(main).

diff --git a/tests-pl/issue_directory_exists.pl b/tests-pl/issue_directory_exists.pl
new file mode 100644 (file)
index 0000000..8302add
--- /dev/null
+++ b/tests-pl/issue_directory_exists.pl
@@ -0,0 +1,20 @@
+:- use_module(library(files)).
+:- use_module(library(os), [setenv/2, getenv/2]).
+
+check :-
+    act(TargetDir),
+    ground(TargetDir).
+
+act(TargetDir) :-
+    getenv("TARGET_DIRECTORY", TargetDir),
+       \+ directory_exists(TargetDir),
+       throw(existence_error(directory,TargetDir)).
+act(TargetDir) :-
+    getenv("TARGET_DIRECTORY", TargetDir),
+    directory_exists(TargetDir).
+
+main :-
+       setenv("TARGET_DIRECTORY", "."),
+       check.
+
+:- initialization(main).

diff --git a/tests-pl/issue_directory_files.pl b/tests-pl/issue_directory_files.pl
new file mode 100644 (file)
index 0000000..2f5a8e3
--- /dev/null
+++ b/tests-pl/issue_directory_files.pl
@@ -0,0 +1,30 @@
+:- use_module(library(files)).
+:- use_module(library(iso_ext)).
+:- use_module(library(lists)).
+:- use_module(library(os), [setenv/2, getenv/2, shell/2]).
+
+check :-
+    act(TargetDirectory, Files),
+    ground(TargetDirectory),
+    length(Files, N),
+    write(N).
+
+act(TargetDirectory, Files) :-
+    getenv("TARGET_DIRECTORY", TargetDirectory),
+    directory_files(TargetDirectory, Files).
+
+main :-
+    path_segments(Path, ["directory_files_test_parent", "directory_files_test_file"]),
+    call_cleanup(
+       (setenv("TARGET_DIRECTORY", "directory_files_test_parent"),
+        shell("test -d directory_files_test_parent || mkdir directory_files_test_parent", 0),
+        append(["test -e ", Path, " || touch ", Path], Cmd),
+        shell(Cmd, 0),
+        check),
+       (append(["rm -f ", Path, " || true"], Cmd1),
+        shell(Cmd1, 0),
+        shell("rmdir directory_files_test_parent || true", 0),
+        shell("ls directory_files_test_parent", 1))
+    ).
+
+:- initialization(main).

diff --git a/tests-pl/issue_file_copy.pl b/tests-pl/issue_file_copy.pl
new file mode 100644 (file)
index 0000000..21b404e
--- /dev/null
+++ b/tests-pl/issue_file_copy.pl
@@ -0,0 +1,36 @@
+:- use_module(library(files)).
+:- use_module(library(iso_ext)).
+:- use_module(library(lists)).
+:- use_module(library(os), [setenv/2, getenv/2, shell/2]).
+
+check :-
+    act(Source, Destination),
+    ground(Source),
+    ground(Destination).
+
+act(Source, Destination) :-
+    getenv("SOURCE", Source),
+    getenv("DESTINATION", Destination),
+       append("ls ", Source, Cmd),
+       shell(Cmd, 0),
+       file_copy(Source, Destination),
+       append("ls ", Destination, Cmd),
+       \+ shell(Cmd, 0),
+       throw(existence_error(directory,Destination)).
+act(Source, Destination) :-
+    getenv("SOURCE", Source),
+    getenv("DESTINATION", Destination),
+       append("ls ", Destination, Cmd),
+       shell(Cmd, 0),
+    write(file_copied).
+
+main :-
+    call_cleanup(
+       (setenv("SOURCE", "file_copy_test_source"),
+        setenv("DESTINATION", "file_copy_test_destination"),
+        shell("touch file_copy_test_source", 0),
+        check),
+        shell("rm -f file_copy_test_source file_copy_test_destination", 0)
+    ).
+
+:- initialization(main).

diff --git a/tests-pl/issue_file_exists.pl b/tests-pl/issue_file_exists.pl
new file mode 100644 (file)
index 0000000..27a72c5
--- /dev/null
+++ b/tests-pl/issue_file_exists.pl
@@ -0,0 +1,25 @@
+:- use_module(library(files)).
+:- use_module(library(iso_ext)).
+:- use_module(library(os), [setenv/2, getenv/2, shell/2]).
+
+check :-
+    act(TargetFile),
+    ground(TargetFile).
+
+act(TargetFile) :-
+    getenv("TARGET_FILE", TargetFile),
+    \+ file_exists(TargetFile),
+       throw(existence_error(file,TargetFile)).
+act(TargetFile) :-
+    getenv("TARGET_FILE", TargetFile),
+    file_exists(TargetFile).
+
+main :-
+    call_cleanup(
+       (setenv("TARGET_FILE", "file_exists_test"),
+        shell("touch file_exists_test", 0),
+        check),
+        shell("rm -f file_exists_test", 0)
+    ).
+
+:- initialization(main).

diff --git a/tests-pl/issue_file_size.pl b/tests-pl/issue_file_size.pl
new file mode 100644 (file)
index 0000000..ef654e5
--- /dev/null
+++ b/tests-pl/issue_file_size.pl
@@ -0,0 +1,23 @@
+:- use_module(library(files)).
+:- use_module(library(iso_ext)).
+:- use_module(library(lists)).
+:- use_module(library(os), [setenv/2, getenv/2, shell/2]).
+
+check :-
+    act(TargetFile, Size),
+    ground(TargetFile),
+    integer(Size).
+
+act(TargetFile, Size) :-
+    getenv("TARGET_FILE", TargetFile),
+       file_size(TargetFile, Size).
+
+main :-
+    call_cleanup(
+       (setenv("TARGET_FILE", "file_size_test"),
+        shell("echo '1' > file_size_test", 0),
+        check),
+        shell("rm -f file_size_test", 0)
+    ).
+
+:- initialization(main).

diff --git a/tests-pl/issue_file_time.pl b/tests-pl/issue_file_time.pl
new file mode 100644 (file)
index 0000000..98e05ac
--- /dev/null
+++ b/tests-pl/issue_file_time.pl
@@ -0,0 +1,26 @@
+:- use_module(library(files)).
+:- use_module(library(iso_ext)).
+:- use_module(library(lists)).
+:- use_module(library(os), [setenv/2, getenv/2, shell/2]).
+
+check(Time) :-
+    act(TargetFile, Time),
+    ground(TargetFile),
+    ground(Time).
+
+act(TargetFile, Time) :-
+    getenv("TARGET_FILE", TargetFile),
+    (   file_access_time(TargetFile, Time)
+    ;   file_creation_time(TargetFile, Time)
+    ;   file_modification_time(TargetFile, Time) ).
+
+main :-
+    call_cleanup(
+       (setenv("TARGET_FILE", "file_time_test"),
+        shell("touch file_time_test", 0),
+        findall(T, check(T), Ts),
+        length(Ts, 3)),
+        shell("rm -f file_time_test", 0)
+    ).
+
+:- initialization(main).

diff --git a/tests-pl/issue_make_directory.pl b/tests-pl/issue_make_directory.pl
new file mode 100644 (file)
index 0000000..79ba064
--- /dev/null
+++ b/tests-pl/issue_make_directory.pl
@@ -0,0 +1,29 @@
+:- use_module(library(files)).
+:- use_module(library(iso_ext)).
+:- use_module(library(lists)).
+:- use_module(library(os), [setenv/2, getenv/2, shell/2]).
+
+check :-
+    act(TargetDir),
+    ground(TargetDir).
+
+act(TargetDir) :-
+    getenv("TARGET_DIRECTORY", TargetDir),
+       make_directory(TargetDir),
+       append(["ls ", TargetDir], ListFilesCmd),
+       \+ shell(ListFilesCmd, 0),
+       throw(system_error).
+act(TargetDir) :-
+    getenv("TARGET_DIRECTORY", TargetDir),
+       append(["ls ", TargetDir], ListFilesCmd),
+       shell(ListFilesCmd, 0),
+    write(directory_made).
+
+main :-
+    call_cleanup(
+       (setenv("TARGET_DIRECTORY", "make_directory_test"),
+        check),
+        shell("test -d make_directory_test && rmdir make_directory_test || true", 0)
+    ).
+
+:- initialization(main).

diff --git a/tests-pl/issue_make_directory_path.pl b/tests-pl/issue_make_directory_path.pl
new file mode 100644 (file)
index 0000000..f8d1ace
--- /dev/null
+++ b/tests-pl/issue_make_directory_path.pl
@@ -0,0 +1,30 @@
+:- use_module(library(files)).
+:- use_module(library(iso_ext)).
+:- use_module(library(lists)).
+:- use_module(library(os), [setenv/2, getenv/2, shell/2]).
+
+check :-
+    act(TargetPath),
+    ground(TargetPath).
+
+act(TargetPath) :-
+    getenv("TARGET_DIRECTORY", TargetPath),
+       make_directory_path(TargetPath),
+       append(["ls ", TargetPath], ListFilesCmd),
+       \+ shell(ListFilesCmd, 0),
+       throw(system_error).
+act(TargetPath) :-
+    getenv("TARGET_DIRECTORY", TargetPath),
+       append(["ls ", TargetPath], ListFilesCmd),
+       shell(ListFilesCmd, 0),
+    write(directory_path_made).
+
+main :-
+    call_cleanup(
+       (setenv("TARGET_DIRECTORY", "make_directory_test/subdir"),
+        check),
+       (shell("test -d make_directory_test/subdir && rmdir make_directory_test/subdir || true", 0),
+        shell("test -d make_directory_test && rmdir make_directory_test || true", 0))
+    ).
+
+:- initialization(main).

diff --git a/tests-pl/issue_path_canonical.pl b/tests-pl/issue_path_canonical.pl
new file mode 100644 (file)
index 0000000..fc048b2
--- /dev/null
+++ b/tests-pl/issue_path_canonical.pl
@@ -0,0 +1,27 @@
+:- use_module(library(files)).
+:- use_module(library(iso_ext)).
+:- use_module(library(os), [setenv/2, getenv/2, shell/2]).
+
+check :-
+    act(Dir),
+    ground(Dir).
+
+act(Dir) :-
+    getenv("TARGET_PATH", Dir),
+       \+ path_canonical(Dir, _CanonicalPath),
+       throw(system_error).
+act(Dir) :-
+    getenv("TARGET_PATH", Dir),
+       path_canonical(Dir, _CanonicalPath),
+    write(path_canonicalized).
+
+main :-
+    path_segments(Path, ["path_canonical_test", "..", "path_canonical_test"]),
+    call_cleanup(
+       (setenv("TARGET_PATH", Path),
+        shell("mkdir path_canonical_test", 0),
+        check),
+       shell("test -d path_canonical_test && rmdir path_canonical_test || true", 0)
+    ).
+
+:- initialization(main).

diff --git a/tests-pl/issue_rename_file.pl b/tests-pl/issue_rename_file.pl
new file mode 100644 (file)
index 0000000..b86d1d4
--- /dev/null
+++ b/tests-pl/issue_rename_file.pl
@@ -0,0 +1,32 @@
+:- use_module(library(files)).
+:- use_module(library(iso_ext)).
+:- use_module(library(lists)).
+:- use_module(library(os), [setenv/2, getenv/2, shell/2]).
+
+check :-
+    act(Source, Destination),
+    ground(Source),
+    ground(Destination).
+
+act(Source, Destination) :-
+    getenv("SOURCE", Source),
+    getenv("DESTINATION", Destination),
+    \+ rename_file(Source, Destination),
+    throw(system_error).
+act(Source, Destination) :-
+    getenv("SOURCE", Source),
+    getenv("DESTINATION", Destination),
+    append(["ls ", Destination], Cmd),
+    shell(Cmd, 0),
+    write(file_renamed).
+
+main :-
+    call_cleanup(
+       (setenv("SOURCE", "rename_file_test"),
+        setenv("DESTINATION", "rename_file_test_renamed"),
+        shell("touch rename_file_test", 0),
+        check),
+        shell("rm -f rename_file_test_renamed || rm -f rename_file_test", 0)
+    ).
+
+:- initialization(main).

diff --git a/tests/scryer/issues.rs b/tests/scryer/issues.rs
index 34768866bc15246da0ae4dc0f3ca033ba3bfe4db..a0c01554b768cadf55047a43b80248fc4fecbbd8 100644 (file)
--- a/tests/scryer/issues.rs
+++ b/tests/scryer/issues.rs
@@ -52,6 +52,90 @@ fn issue2725_dcg_without_module() {
     load_module_test("tests-pl/issue2725.pl", "");
 }
 
+#[serial]
+#[test]
+#[cfg_attr(miri, ignore = "it takes too long to run")]
+fn issue_delete_directory() {
+    load_module_test("tests-pl/issue_delete_directory.pl", "directory_deleted");
+}
+
+#[serial]
+#[test]
+#[cfg_attr(miri, ignore = "it takes too long to run")]
+fn issue_delete_file() {
+    load_module_test("tests-pl/issue_delete_file.pl", "file_deleted");
+}
+
+#[serial]
+#[test]
+#[cfg_attr(miri, ignore = "it takes too long to run")]
+fn issue_directory_exists() {
+    load_module_test("tests-pl/issue_directory_exists.pl", "");
+}
+
+#[serial]
+#[test]
+#[cfg_attr(miri, ignore = "it takes too long to run")]
+fn issue_directory_files() {
+    load_module_test("tests-pl/issue_directory_files.pl", "1");
+}
+
+#[serial]
+#[test]
+#[cfg_attr(miri, ignore = "it takes too long to run")]
+fn issue_file_copy() {
+    load_module_test("tests-pl/issue_file_copy.pl", "file_copied");
+}
+
+#[serial]
+#[test]
+#[cfg_attr(miri, ignore = "it takes too long to run")]
+fn issue_file_exists() {
+    load_module_test("tests-pl/issue_file_exists.pl", "");
+}
+
+#[serial]
+#[test]
+#[cfg_attr(miri, ignore = "it takes too long to run")]
+fn issue_file_size() {
+    load_module_test("tests-pl/issue_file_size.pl", "");
+}
+
+#[serial]
+#[test]
+#[cfg_attr(miri, ignore = "it takes too long to run")]
+fn issue_file_time() {
+    load_module_test("tests-pl/issue_file_time.pl", "");
+}
+
+#[serial]
+#[test]
+#[cfg_attr(miri, ignore = "it takes too long to run")]
+fn issue_make_directory() {
+    load_module_test("tests-pl/issue_make_directory.pl", "directory_made");
+}
+
+#[serial]
+#[test]
+#[cfg_attr(miri, ignore = "it takes too long to run")]
+fn issue_make_directory_path() {
+    load_module_test("tests-pl/issue_make_directory_path.pl", "directory_path_made");
+}
+
+#[serial]
+#[test]
+#[cfg_attr(miri, ignore = "it takes too long to run")]
+fn issue_path_canonical() {
+    load_module_test("tests-pl/issue_path_canonical.pl", "path_canonicalized");
+}
+
+#[serial]
+#[test]
+#[cfg_attr(miri, ignore = "it takes too long to run")]
+fn issue_rename_file() {
+    load_module_test("tests-pl/issue_rename_file.pl", "file_renamed");
+}
+
 #[test]
 #[cfg(feature = "http")]
 #[cfg(not(target_arch = "wasm32"))]