diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index b0c0044d..5fc4088b 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -1986,10 +1986,7 @@ impl Machine { #[inline(always)] pub(crate) fn directory_files(&mut self) -> CallResult { - if let Some(dir) = self - .machine_st - .value_to_str_like(self.machine_st.registers[1]) - { + if let Some(dir) = self.machine_st.value_to_str_like(self.deref_register(1)) { let str = dir.as_str(); let path = std::path::Path::new(&*str); let mut files = Vec::new(); @@ -2039,10 +2036,7 @@ impl Machine { #[inline(always)] pub(crate) fn file_size(&mut self) { - if let Some(file) = self - .machine_st - .value_to_str_like(self.machine_st.registers[1]) - { + if let Some(file) = self.machine_st.value_to_str_like(self.deref_register(1)) { let len = Number::arena_from( fs::metadata(&*file.as_str()).unwrap().len(), &mut self.machine_st.arena, @@ -2064,10 +2058,7 @@ impl Machine { #[inline(always)] pub(crate) fn file_exists(&mut self) { - if let Some(file) = self - .machine_st - .value_to_str_like(self.machine_st.registers[1]) - { + if let Some(file) = self.machine_st.value_to_str_like(self.deref_register(1)) { let file_str = file.as_str(); if !std::path::Path::new(&*file_str).exists() @@ -2082,10 +2073,7 @@ impl Machine { #[inline(always)] pub(crate) fn directory_exists(&mut self) { - if let Some(dir) = self - .machine_st - .value_to_str_like(self.machine_st.registers[1]) - { + if let Some(dir) = self.machine_st.value_to_str_like(self.deref_register(1)) { let dir_str = dir.as_str(); if !std::path::Path::new(&*dir_str).exists() @@ -2100,10 +2088,7 @@ impl Machine { #[inline(always)] pub(crate) fn file_time(&mut self) { - if let Some(file) = self - .machine_st - .value_to_str_like(self.machine_st.registers[1]) - { + if let Some(file) = self.machine_st.value_to_str_like(self.deref_register(1)) { let which = cell_as_atom!(self.deref_register(2)); if let Ok(md) = fs::metadata(&*file.as_str()) { @@ -2139,10 +2124,7 @@ impl Machine { #[inline(always)] pub(crate) fn make_directory(&mut self) { - if let Some(dir) = self - .machine_st - .value_to_str_like(self.machine_st.registers[1]) - { + if let Some(dir) = self.machine_st.value_to_str_like(self.deref_register(1)) { match fs::create_dir(&*dir.as_str()) { Ok(_) => {} _ => { @@ -2156,10 +2138,7 @@ impl Machine { #[inline(always)] pub(crate) fn make_directory_path(&mut self) { - if let Some(dir) = self - .machine_st - .value_to_str_like(self.machine_st.registers[1]) - { + if let Some(dir) = self.machine_st.value_to_str_like(self.deref_register(1)) { match fs::create_dir_all(&*dir.as_str()) { Ok(_) => {} _ => { @@ -2173,10 +2152,7 @@ impl Machine { #[inline(always)] pub(crate) fn delete_file(&mut self) { - if let Some(file) = self - .machine_st - .value_to_str_like(self.machine_st.registers[1]) - { + if let Some(file) = self.machine_st.value_to_str_like(self.deref_register(1)) { match fs::remove_file(&*file.as_str()) { Ok(_) => {} _ => { @@ -2188,14 +2164,8 @@ impl Machine { #[inline(always)] pub(crate) fn rename_file(&mut self) { - if let Some(file) = self - .machine_st - .value_to_str_like(self.machine_st.registers[1]) - { - if let Some(renamed) = self - .machine_st - .value_to_str_like(self.machine_st.registers[2]) - { + if let Some(file) = self.machine_st.value_to_str_like(self.deref_register(1)) { + if let Some(renamed) = self.machine_st.value_to_str_like(self.deref_register(2)) { if fs::rename(&*file.as_str(), &*renamed.as_str()).is_ok() { return; } @@ -2207,14 +2177,8 @@ impl Machine { #[inline(always)] pub(crate) fn file_copy(&mut self) { - if let Some(file) = self - .machine_st - .value_to_str_like(self.machine_st.registers[1]) - { - if let Some(copied) = self - .machine_st - .value_to_str_like(self.machine_st.registers[2]) - { + if let Some(file) = self.machine_st.value_to_str_like(self.deref_register(1)) { + if let Some(copied) = self.machine_st.value_to_str_like(self.deref_register(2)) { if fs::copy(&*file.as_str(), &*copied.as_str()).is_ok() { return; } @@ -2226,10 +2190,7 @@ impl Machine { #[inline(always)] pub(crate) fn delete_directory(&mut self) { - if let Some(dir) = self - .machine_st - .value_to_str_like(self.machine_st.registers[1]) - { + if let Some(dir) = self.machine_st.value_to_str_like(self.deref_register(1)) { match fs::remove_dir(&*dir.as_str()) { Ok(_) => {} _ => { @@ -2283,10 +2244,7 @@ impl Machine { #[inline(always)] pub(crate) fn path_canonical(&mut self) -> CallResult { - if let Some(path) = self - .machine_st - .value_to_str_like(self.machine_st.registers[1]) - { + if let Some(path) = self.machine_st.value_to_str_like(self.deref_register(1)) { if let Ok(canonical) = fs::canonicalize(&*path.as_str()) { let cs = match canonical.to_str() { Some(s) => s, 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..cb321746 100644 --- a/tests/scryer/issues.rs +++ b/tests/scryer/issues.rs @@ -52,6 +52,93 @@ 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"))]