mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 17:33:38 +00:00
25b4b67403
library/io.file.m:
library/io.m:
Move two sections of io.m, the "file handling predicates" section
and the "handling temporary files" section to the new submodule io.file.m.
Leave behind in io.m "forwarding predicates", predicates that do nothing
except call the moved predicates in io.file.m, to provide backward
compatibility. But do mark the forwarding predicates as obsolete,
to tell people to update their (at their leisure, since the obsoleteness
warning can be turned off).
Also leave behind in io.m the definitions of the two types used
by some parameters of some of the moved predicates. Document the reason
why this is done.
library/MODULES_DOC:
List the new module among the documented modules.
NEWS:
Announce the changes.
browser/browse.m:
browser/interactive_query.m:
browser/listing.m:
compiler/analysis.file.m:
compiler/compile_target_code.m:
compiler/export.m:
compiler/fact_table.m:
compiler/file_util.m:
compiler/handle_options.m:
compiler/make.build.m:
compiler/make.module_dep_file.m:
compiler/make.module_target.m:
compiler/make.program_target.m:
compiler/make.util.m:
compiler/mercury_compile_main.m:
compiler/module_cmds.m:
compiler/parse_module.m:
compiler/passes_aux.m:
compiler/prog_event.m:
compiler/recompilation.check.m:
compiler/write_deps_file.m:
compiler/write_module_interface_files.m:
deep_profiler/conf.m:
deep_profiler/mdprof_cgi.m:
library/dir.m:
mdbcomp/program_representation.m:
ssdb/ssdb.m:
Call the file operation predicates directly in io.file.m, not indirectly
through io.m.
In two modules, add a #include of fcntl.h in C code. These modules contain
C code that needs this #include, but until now, they got it via a copy
in an automatically generated C header file of a foreign_decl pragma
in io.m that contained that #include. This diff moves that foreign_decl
to io.file.m, removing that crutch.
tests/debugger/browser_test.m:
tests/hard_coded/bit_buffer_test.m:
tests/hard_coded/bitmap_test.m:
tests/hard_coded/construct_bug.m:
tests/hard_coded/dir_fold.m:
tests/hard_coded/dir_test.m:
tests/hard_coded/read_binary_int16.m:
tests/hard_coded/read_binary_int32.m:
tests/hard_coded/read_binary_int64.m:
tests/hard_coded/read_binary_uint16.m:
tests/hard_coded/read_binary_uint32.m:
tests/hard_coded/read_binary_uint64.m:
tests/hard_coded/read_bitmap_size.m:
tests/hard_coded/remove_file.m:
tests/hard_coded/write_binary.m:
tests/hard_coded/write_binary_int8.m:
tests/hard_coded/write_binary_multibyte_int.m:
tests/hard_coded/write_binary_uint8.m:
Call the file operation predicates directly in io.file.m, not indirectly
through io.m.
341 lines
11 KiB
Mathematica
341 lines
11 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ts=4 sw=4 et ft=mercury
|
|
%---------------------------------------------------------------------------%
|
|
% The .exp file is for Windows.
|
|
% The .exp2 file is for Unix like systems.
|
|
% The .exp3 file is for Cygwin.
|
|
% The .exp4 file is for the Java grade (on Unix like systems).
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module dir_test.
|
|
:- interface.
|
|
|
|
:- import_module io.
|
|
|
|
:- pred main(io::di, io::uo) is cc_multi.
|
|
|
|
:- implementation.
|
|
|
|
:- import_module bool.
|
|
:- import_module dir.
|
|
:- import_module exception.
|
|
:- import_module io.file.
|
|
:- import_module list.
|
|
:- import_module require.
|
|
:- import_module string.
|
|
:- import_module univ.
|
|
|
|
main(!IO) :-
|
|
io.write_string("Directory separator is '", !IO),
|
|
io.write_char(dir.directory_separator, !IO),
|
|
io.write_string("'.\n", !IO),
|
|
|
|
run_test("\\\\server\\share\\foo", !IO),
|
|
run_test("\\\\server\\share", !IO),
|
|
run_test("\\\\server\\share\\\\", !IO),
|
|
run_test("C:\\foo", !IO),
|
|
run_test("C:\\foo\\", !IO),
|
|
run_test("C:\\", !IO),
|
|
run_test("C:", !IO),
|
|
run_test("\\", !IO),
|
|
run_test("", !IO),
|
|
run_test("foo\\\\bar\\", !IO),
|
|
run_test("foo\\bar\\", !IO),
|
|
run_test("foo", !IO),
|
|
|
|
run_test("/foo", !IO),
|
|
run_test("/foo//bar///", !IO),
|
|
run_test("//foo//bar/", !IO),
|
|
run_test("//foo//", !IO),
|
|
run_test("/", !IO),
|
|
run_test("//", !IO),
|
|
run_test("foo/bar", !IO),
|
|
|
|
test_make_path_name("C:", "foo", !IO),
|
|
test_make_path_name("C:\\", "foo", !IO),
|
|
test_make_path_name("C:", "C:", !IO),
|
|
test_make_path_name("C:", "C:\\foo", !IO),
|
|
test_make_path_name(".", "/foo", !IO),
|
|
test_make_path_name(".", "\\foo", !IO),
|
|
test_make_path_name("foo", "bar/baz", !IO),
|
|
test_make_path_name("foo/", "bar/baz", !IO),
|
|
|
|
io.write_string("checking whether `unwritable' is readable...", !IO),
|
|
io.file.check_file_accessibility("unwritable", [read], ReadResult, !IO),
|
|
io.write_line(ReadResult, !IO),
|
|
|
|
io.file.check_file_accessibility("unwritable", [read, write],
|
|
WriteResult, !IO),
|
|
( if WriteResult = ok then
|
|
io.write_string("Error: unwritable file found to be writable\n", !IO)
|
|
else
|
|
io.write_string("unwritable file found to be unwritable\n", !IO)
|
|
),
|
|
|
|
% Execute permissions are not handled correctly on all platforms so
|
|
% just check that it doesn't crash.
|
|
io.file.check_file_accessibility("unwritable", [execute],
|
|
_ExecuteResult, !IO),
|
|
|
|
dir.current_directory(CwdResult, !IO),
|
|
(
|
|
CwdResult = ok(Cwd),
|
|
io.write_string("current_directory succeeded: ", !IO),
|
|
io.write_string(dir.det_basename(Cwd), !IO),
|
|
io.nl(!IO)
|
|
;
|
|
CwdResult = error(Error),
|
|
io.write_string("current_directory failed: ", !IO),
|
|
io.write_string(io.error_message(Error), !IO),
|
|
io.nl(!IO)
|
|
),
|
|
|
|
Dir1 = "test_dir"/"d1",
|
|
test0("make_directory", dir.make_directory(Dir1), !IO),
|
|
% Test making a directory that already exists.
|
|
test0("make_directory", dir.make_directory(Dir1), !IO),
|
|
|
|
Dir2 = "test_dir"/"d2",
|
|
dir.make_single_directory(Dir2/"d2", Dir2Res, !IO),
|
|
(
|
|
Dir2Res = ok,
|
|
io.write_string("Error: dir.make_single_directory succeeded " ++
|
|
"but parent doesn't exist.\n", !IO)
|
|
;
|
|
Dir2Res = error(_),
|
|
io.write_string("dir.make_single_directory " ++
|
|
"with non-existent parent failed as expected.\n", !IO)
|
|
),
|
|
|
|
test0("make_single_directory", dir.make_single_directory(Dir2), !IO),
|
|
test0("make_single_directory 2",
|
|
dir.make_single_directory(Dir2/"d2"), !IO),
|
|
|
|
test1("file_type", io.file.file_type(yes, Dir1), Type, !IO),
|
|
io.write_string("type of ", !IO),
|
|
io.write_string(Dir1, !IO),
|
|
io.write_string(" is ", !IO),
|
|
io.write_line(Type, !IO),
|
|
|
|
test1("file_type 2", io.file.file_type(yes, "dir_test.m"), Type2, !IO),
|
|
io.write_string("type of ", !IO),
|
|
io.write_string("dir_test.m", !IO),
|
|
io.write_string(" is ", !IO),
|
|
io.write_line(Type2, !IO),
|
|
|
|
% Create some dummy files
|
|
touch_file(Dir1/"foo", !IO),
|
|
touch_file(Dir1/"baz", !IO),
|
|
touch_file("test_dir"/"quark", !IO),
|
|
touch_file("test_dir"/"queeg", !IO),
|
|
|
|
dir.make_directory(Dir1/"foo", MkdirRes, !IO),
|
|
(
|
|
MkdirRes = ok,
|
|
io.write_string(
|
|
"Error: creating directory with same name as ordinary file succeeded.\n", !IO)
|
|
;
|
|
MkdirRes = error(_),
|
|
io.write_string("creating directory with same name " ++
|
|
"as ordinary file failed (as expected).\n", !IO)
|
|
),
|
|
|
|
( if io.file.have_symlinks then
|
|
test0("making symlink 1",
|
|
io.file.make_symlink("baz", Dir1/"bar"), !IO),
|
|
test0("making symlink 2",
|
|
io.file.make_symlink("d1", "test_dir"/"d3"), !IO),
|
|
|
|
% Make a loop.
|
|
test0("making symlink 3",
|
|
io.file.make_symlink(dir.parent_directory, Dir1/"parent"), !IO),
|
|
|
|
test1("following symlink",
|
|
io.file.read_symlink(Dir1/"bar"), LinkTarget, !IO),
|
|
io.write_string(Dir1/"bar", !IO),
|
|
io.write_string(" points to ", !IO),
|
|
io.write_string(LinkTarget, !IO),
|
|
io.nl(!IO),
|
|
|
|
test1("file_type 3", io.file.file_type(no, Dir1/"bar"), Type3, !IO),
|
|
io.write_string("type of ", !IO),
|
|
io.write_string(Dir1/"bar", !IO),
|
|
io.write_string(" is ", !IO),
|
|
io.write_line(Type3, !IO)
|
|
else
|
|
io.write_string("symlinks not available on this platform\n", !IO)
|
|
),
|
|
|
|
testp("dir.foldl2",
|
|
dir.foldl2(list_files, "test_dir", []), TestDirFiles, !IO),
|
|
io.write_string("Files in test_dir:\n", !IO),
|
|
io.write_list(sort(TestDirFiles), ", ", io.write_string, !IO),
|
|
io.nl(!IO),
|
|
|
|
testp("dir.recursive_foldl2 (no symlinks)",
|
|
dir.recursive_foldl2(list_files, "test_dir", no, []),
|
|
NoFollowFiles, !IO),
|
|
io.write_string(
|
|
"Files in test_dir (recursive, not following symlinks):\n", !IO),
|
|
io.write_list(sort(NoFollowFiles), ", ", io.write_string, !IO),
|
|
io.nl(!IO),
|
|
|
|
testp("dir.recursive_foldl2 (symlinks)",
|
|
dir.recursive_foldl2(list_files, "test_dir", yes, []),
|
|
FollowFiles, !IO),
|
|
io.write_string(
|
|
"Files in test_dir (recursive, following symlinks:\n", !IO),
|
|
io.write_list(sort(FollowFiles), ", ", io.write_string, !IO),
|
|
io.nl(!IO),
|
|
|
|
dir.recursive_foldl2(list_files, "dir_test.m", yes, [], Res, !IO),
|
|
(
|
|
Res = ok(_),
|
|
io.write_string("Error: dir.recursive_foldl2(list_files, " ++
|
|
"""dir_test.m"", ...) succeeded.\n", !IO)
|
|
;
|
|
Res = error(_, _),
|
|
io.write_string("dir.recursive_foldl2(list_files, " ++
|
|
"""dir_test.m"", ...) failed as expected.\n", !IO)
|
|
).
|
|
|
|
:- type test0 == pred(io.res, io, io).
|
|
:- inst test0 == (pred(out, di, uo) is det).
|
|
|
|
:- pred test0(string::in, test0::in(test0), io::di, io::uo) is det.
|
|
|
|
test0(Msg, P, !IO) :-
|
|
P(Res, !IO),
|
|
(
|
|
Res = ok,
|
|
io.write_string(Msg, !IO),
|
|
io.write_string(" succeeded\n", !IO)
|
|
;
|
|
Res = error(Error),
|
|
error(Msg ++ " " ++ io.error_message(Error))
|
|
).
|
|
|
|
:- type test1(T) == pred(io.res(T), io, io).
|
|
:- inst test1 == (pred(out, di, uo) is det).
|
|
|
|
:- pred test1(string::in, test1(T)::in(test0), T::out, io::di, io::uo) is det.
|
|
|
|
test1(Msg, P, T, !IO) :-
|
|
P(Res, !IO),
|
|
(
|
|
Res = ok(T),
|
|
io.write_string(Msg, !IO),
|
|
io.write_string(" succeeded\n", !IO)
|
|
;
|
|
Res = error(Error),
|
|
error(Msg ++ " " ++ io.error_message(Error))
|
|
).
|
|
|
|
:- type testp(T) == pred(io.maybe_partial_res(T), io, io).
|
|
:- inst testp == (pred(out, di, uo) is det).
|
|
|
|
:- pred testp(string::in, testp(T)::in(testp), T::out, io::di, io::uo) is det.
|
|
|
|
testp(Msg, P, T, !IO) :-
|
|
P(Res, !IO),
|
|
(
|
|
Res = ok(T),
|
|
io.write_string(Msg, !IO),
|
|
io.write_string(" succeeded\n", !IO)
|
|
;
|
|
Res = error(_, Error),
|
|
error(Msg ++ " " ++ io.error_message(Error))
|
|
).
|
|
|
|
:- pred run_test(string::in, io::di, io::uo) is cc_multi.
|
|
|
|
run_test(PathName, !IO) :-
|
|
test_split_name(PathName, !IO),
|
|
test_dirname(PathName, !IO),
|
|
test_basename(PathName, !IO),
|
|
test_path_name_is_absolute(PathName, !IO),
|
|
test_path_name_is_root_directory(PathName, !IO),
|
|
io.nl(!IO).
|
|
|
|
:- pred test_split_name(string::in, io::di, io::uo) is cc_multi.
|
|
|
|
test_split_name(PathName, !IO) :-
|
|
io.format("dir.split_name(""%s"", ",
|
|
[s(PathName)], !IO),
|
|
( if dir.split_name(PathName, DirName, FileName) then
|
|
io.format("""%s"", ""%s"").\n",
|
|
[s(DirName), s(FileName)], !IO),
|
|
test_make_path_name(DirName, FileName, !IO)
|
|
else
|
|
io.write_string("_, _) failed.\n", !IO)
|
|
).
|
|
|
|
:- pred test_dirname(string::in, io::di, io::uo) is det.
|
|
|
|
test_dirname(PathName, !IO) :-
|
|
io.format("dir.dirname(""%s"") = ""%s"".\n",
|
|
[s(PathName), s(dir.dirname(PathName))], !IO).
|
|
|
|
:- pred test_basename(string::in, io::di, io::uo) is det.
|
|
|
|
test_basename(PathName, !IO) :-
|
|
io.write_string("dir.basename(""", !IO),
|
|
io.write_string(PathName, !IO),
|
|
io.write_string(""") = ", !IO),
|
|
( if BaseName = dir.basename(PathName) then
|
|
io.write_string("""", !IO),
|
|
io.write_string(BaseName, !IO),
|
|
io.write_string(""".\n", !IO)
|
|
else
|
|
io.write_string("_ failed.\n", !IO)
|
|
).
|
|
|
|
:- pred test_path_name_is_absolute(string::in, io::di, io::uo) is det.
|
|
|
|
test_path_name_is_absolute(PathName, !IO) :-
|
|
io.format("dir.path_name_is_absolute(""%s"")",
|
|
[s(PathName)], !IO),
|
|
( if dir.path_name_is_absolute(PathName) then
|
|
io.write_string(".\n", !IO)
|
|
else
|
|
io.write_string(" failed\n", !IO)
|
|
).
|
|
|
|
:- pred test_path_name_is_root_directory(string::in, io::di, io::uo) is det.
|
|
|
|
test_path_name_is_root_directory(PathName, !IO) :-
|
|
io.format("dir.path_name_is_root_directory(""%s"")",
|
|
[s(PathName)], !IO),
|
|
( if dir.path_name_is_root_directory(PathName) then
|
|
io.write_string(".\n", !IO)
|
|
else
|
|
io.write_string(" failed\n", !IO)
|
|
).
|
|
|
|
:- pred test_make_path_name(string::in, string::in, io::di, io::uo)
|
|
is cc_multi.
|
|
|
|
test_make_path_name(DirName, FileName, !IO) :-
|
|
io.format("\"%s\"/\"%s\"", [s(DirName), s(FileName)], !IO),
|
|
try((pred(R::out) is det :- R = DirName/FileName), Res),
|
|
(
|
|
Res = succeeded(Path),
|
|
io.format(" = ""%s"".\n", [s(Path)], !IO)
|
|
;
|
|
Res = exception(Excp),
|
|
io.write_string(" threw exception: ", !IO),
|
|
io.write_line(univ_value(Excp), !IO)
|
|
).
|
|
|
|
:- pred touch_file(string::in, io::di, io::uo) is det.
|
|
|
|
touch_file(FileName, !IO) :-
|
|
test1("touching file", io.open_output(FileName), FileStream, !IO),
|
|
io.close_output(FileStream, !IO).
|
|
|
|
:- pred list_files `with_type` dir.foldl_pred(list(string))
|
|
`with_inst` dir.foldl_pred.
|
|
|
|
list_files(DirName, BaseName, _FileType, yes, Files,
|
|
[DirName/BaseName | Files], !IO).
|