From: Thierry Marianne Date: Fri, 19 Sep 2025 20:40:45 +0000 (+0200) Subject: add tests for `file` module predicates X-Git-Tag: v0.10.0~1^2~2 X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=12db664bd94a9c9f00d3eef8341b15067b2fae05;p=scryer-prolog.git 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 --- diff --git a/tests-pl/issue_delete_directory.pl b/tests-pl/issue_delete_directory.pl new file mode 100644 index 00000000..6e422d94 --- /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 index 00000000..b75a2e69 --- /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 index 00000000..8302addf --- /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 index 00000000..2f5a8e34 --- /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 index 00000000..21b404ea --- /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 index 00000000..27a72c5d --- /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 index 00000000..ef654e5b --- /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 index 00000000..98e05ac4 --- /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 index 00000000..79ba0648 --- /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 index 00000000..f8d1ace6 --- /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 index 00000000..fc048b22 --- /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 index 00000000..b86d1d47 --- /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 34768866..a0c01554 100644 --- 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"))]