Merge pull request #3095 from thierrymarianne/derefering-registers-in-files-module-instructions-functions

Dereferencing registers in `files` module instructions functions

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,

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).

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).

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).

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).

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).

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).

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).

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).

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).

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).

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).

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).

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"))]