[m-rev.] for review: library changes for `mmc --make' on Windows
Simon Taylor
stayl at cs.mu.OZ.AU
Tue Jul 15 00:16:54 AEST 2003
On 18-Jun-2003, Fergus Henderson <fjh at cs.mu.OZ.AU> wrote:
> On 15-Jun-2003, Simon Taylor <stayl at cs.mu.OZ.AU> wrote:
> >
> > Library changes required to make the compiler work on Windows
> > without Cygwin. (Compiler changes to come separately).
> >
> > library/dir.m:
> > Handle Windows-style paths.
>
> Great, thanks for that.
>
> But I do have quite a few comments on your patch.
>
> > Change the determinism of dir.basename and dir.split_name.
> > dir.basename now fails for root directories (a new function
> > dir.basename_det calls error/1 rather than failing).
> > dir.split_name fails for root directories or if the pathname
> > passed doesn't contain a directory separator.
>
> Hmm... I'd prefer to avoid changes that break backwards compatibility
> unless there is a strong reason for them.
>
> Any particular reason not to just have,
> on Unix,
> dir.dirname("/") = "/"
> dir.basename("/") = "/"
I addressed this in my reply to Peter Moulder.
> > Index: library/dir.m
> ...
> > -% Main author: fjh.
> > +% Main author: fjh, stayl.
>
> s/author/authors/
>
> > + % dir__split_name(PathName, DirName, BaseName).
> > + % Split a filename into a directory part and a filename part.
> > + % Fails for root directories or relative filenames not
> > + % containing a directory separator.
> > +:- pred dir__split_name(string::in, string::out, string::out) is semidet.
>
> Since there appear to be differences of opinions about whether the
> directory part (DirName) should include a trailing directory separator,
> this should be explicitly documented (and tested in the test suite).
> IMHO DirName should not include a trailing separator.
That's a pain when there are operating systems for which the
trailing slash is sometimes significant ("C:" vs "C:\"). Leaving
the trailing slash intact shouldn't cause any harm.
> Likewise, it should also be explicitly documented what happens if
> PathName ends in a path separator.
Done.
> > + % Is the path name syntactically an absolute path
> > + % (doesn't check whether the path exists).
> > +:- pred dir__path_name_is_absolute(string::in) is semidet.
>
> It would help to define exactly what you mean by "absolute path".
> What is this routine supposed to do for "\foo\bar" on Windows?
> Is "\foo\bar" an absolute path?
Done. "\foo\bar" is an absolute path.
> > + % Make the given directory, and all parent directories.
> > + % This will also succeed if the directory already exists
> > + % and is readable and writable by the current user.
> > +:- pred dir__make_directory(string, io__res, io__state, io__state).
> > +:- mode dir__make_directory(in, out, di, uo) is det.
>
> This functionality is a bit too high-level. While I agree that this
> functionality is useful, if we're going to add this, then I think
> we should also add a procedure to just make a single directory,
> without attempting to make any of the parent directories.
>
> [For the .NET CLI, I think you can create a directory without creating
> all the subdirectories using "(new System.IO.DirectoryInfo(path)).Create();".]
When is this useful?
> > +%-----------------------------------------------------------------------------%
> > + % FoldlPred(DirName, BaseName, FileType, Continue, !Data, !IO).
> > +:- type dir__foldl_pred(T) == pred(string, string, io__file_type, bool,
> > + T, T, io__state, io__state).
> > +:- inst dir__foldl_pred == (pred(in, in, in, out, in, out, di, uo) is det).
> > +
> > + % dir__foldl2(P, DirName, InitialData, Result, !IO).
> > + %
> > + % Apply `P' to all direct subdirectories of the given directory.
> > +:- pred dir__foldl2(dir__foldl_pred(T), string,
> > + T, io__maybe_partial_res(T), io__state, io__state).
> > +:- mode dir__foldl2(in(dir__foldl_pred), in, in, out, di, uo) is det.
> > +
> > + % dir__recursive_foldl2(P, DirName, FollowSymLinks,
> > + % InitialData, Result, !IO).
> > + %
> > + % Apply `P' to all direct and indirect subdirectories
> > + % of the given directory.
> > + % If `FollowSymLinks' is `yes', process the directories
> > + % referenced by symbolic links in subdirectories of DirName.
> > +:- pred dir__recursive_foldl2(dir__foldl_pred(T), string, bool,
> > + T, io__maybe_partial_res(T), io__state, io__state).
> > +:- mode dir__recursive_foldl2(in(dir__foldl_pred),
> > + in, in, in, out, di, uo) is det.
>
> The documentation is a bit sparse here. The documentation doesn't
> explain what values dir.foldl2 or dir.recursive_foldl2 will pass to P,
> or what it will do with the values returned from P. The meaning of the
> "Continue" argument is not explained. The FileType argument seems to be
> pointless: the docs say that P will only be applied to directories,
> so FileType should always be "directory". The documentation doesn't specify
> the order in which the files or directories will be processed; if the
> intent is to leave this deliberately unspecified, then it should be
> explicitly stated as such.
Fixed.
> > +:- pred dir__split_name_2(list(char)::in, string::out, string::out) is semidet.
> > +
> > +dir__split_name_2(FileNameList0, DirName, BaseName) :-
>
> Some comments explaining what this predicate
> is supposed to do would be very helpful.
>
> Also, the variable name "FileNameList" is confusing -- it brings to mind a
> list of file names. I suggest instead using either "FileNameChars" or
> "FileNameCharList".
Done.
> > +:- pred dir__split_name_3(list(char)::in, string::out, string::out) is semidet.
>
>
> Some comments explaining what this predicate
> is supposed to do would be very helpful.
Done.
> > +% .NET provides functions to split directory names in a
> > +% system-dependent manner.
>
> s/.NET/The .NET CLI/
>
> (The brand name ".NET" just means "Everything Microsoft did last summer",
> and as such it should be avoided in technical documents.)
Done.
> > +:- pragma foreign_proc("C#",
> > + dir__split_name_dotnet(FileName::in, DirName::out, BaseName::out),
> > + [may_call_mercury, promise_pure, thread_safe],
> > +"
> > + try {
> > + DirName = System.IO.Path.GetDirectoryName(FileName);
> > + if (DirName == null) {
> > + SUCCESS_INDICATOR = false;
> > + } else if (DirName == System.String.Empty) {
> > + SUCCESS_INDICATOR = true;
> > + DirName = mercury.dir.mercury_code.ML_this_directory();
> > + BaseName = FileName;
> > + } else {
> > + BaseName = System.IO.Path.GetFileName(FileName);
> > + SUCCESS_INDICATOR = (BaseName != null);
> > + }
> > + } catch (System.Exception e) {
> > + SUCCESS_INDICATOR = false;
> > + }
> > +").
>
> Is this really pure?
>
> For example,
?
> > +:- func strip_repeated_dir_separators(list(char)) = list(char).
> > +
> > +strip_repeated_dir_separators(FileName0) =
> > (
> > + % Windows allows paths of the form "\\server\share".
> > + use_windows_paths,
> > + FileName0 = [dir__directory_separator | FileName1]
> > ->
> > + [dir__directory_separator |
> > + strip_repeated_dir_separators_2(FileName1, [])]
> > + ;
> > + strip_repeated_dir_separators_2(FileName0, [])
> > + ).
>
> > +:- func strip_repeated_dir_separators_2(list(char), list(char)) = list(char).
...
> That would IMHO be simpler (not to mention more efficient) written as follows:
>
> strip_repeated_dir_separators_2([], RevFileName) = reverse(RevFileName).
> strip_repeated_dir_separators_2([C | FileName], RevFileName) =
> strip_repeated_dir_separators_2(FileName,
> (if C = dir__directory_separator, FileName = [C | _] then
> RevFileName
> else
> [C | RevFileName]
> )).
Done.
> > +:- pred is_root_directory(list(char)::in) is semidet.
> > +is_root_directory(FileName) :-
>
> It would help to document what this is supposed to do for corner cases
> such as "C:".
C: is a relative path, so that's clearly not a root directory.
> > + % Win32 should really provide a function to do this.
> > + % XXX Handle Unicode file names.
> > +:- pred strip_leading_win32_root_directory(list(char)::in,
> > + list(char)::out) is semidet.
> > +
> > +strip_leading_win32_root_directory(!FileName) :-
> > + ( strip_leading_win32_drive_spec(!FileName) ->
> > + true
>
> A drive specification (e.g. "C:") is not the same thing as a root
> directory (e.g. "C:\"), so this code appears to be doing the wrong thing.
>
> > + % Check for `C:\'.
> > +:- pred strip_leading_win32_drive_spec(list(char)::in,
> > + list(char)::out) is semidet.
>
> The comment here doesn't match the predicate name,
> and doesn't explain what the meaning of the output argument is.
Fixed.
> > +strip_leading_win32_drive_spec([Letter, ':' | !.FileName], !:FileName) :-
> > + char__is_alpha(Letter),
> > + ( !.FileName = [dir__directory_separator | !:FileName] ->
> > + true
> > + ;
> > + true
> > + ).
>
> That seems to be stripping both "C:" and "C:\", which matches
> neither the predicate name not the comment.
Done.
> > +dir__make_directory(PathName, Result, !IO) :-
> > + ( can_implement_make_directory ->
> > + DirName = dir__dirname(PathName),
> > + ( DirName = dir__this_directory ->
> > + ParentAccessResult = ok
> > + ;
> > + io__check_file_accessibility(DirName, [],
> > + ParentAccessResult, !IO)
> > + ),
>
> Why the special case for this_directory here?
this_directory doesn't need to be created -- any errors will
be caught when making the specified directory.
> > +% The .NET library function System.IO.Directory.CreateDirectory()
> > +% creates the entire path in one call.
>
> s/.NET/.NET CLI/
Done.
> > + mercury.dir.mercury_code. ML_check_dir_accessibility(DirName,
>
> s/. ML/.ML/
Done.
> > + # ifdef EEXIST
> > + } else if (errno == EEXIST) {
> > + ML_make_mkdir_res_exists(errno, DirName, &Result);
> > + # endif /* EEXIST */
>
> s/<tab># ifdef/ #ifdef/
> s/<tab># endif/ #endif/
Done.
> > + % We need to close the directory if an exception is
> > + % thrown to avoid resource leaks.
> > + promise_only_solution_io(
> > + try_io_det(
> > + (pred({Res, Pos1, Cont}::out,
> > + !.IO::di, !:IO::uo) is det :-
> > + dir__foldl2_process_entries(SymLinkParent,
> > + P, DirName, ok(FirstEntry), ParentIds,
> > + Recursive, FollowLinks, Cont,
> > + T0, Res, Pos0, Pos1, !IO)
> > + )), ExcpResult, !IO),
>
> Rather than adding try_io_det and wrapping that inside
> promise_only_solution_io, I think it would be better to add a try_finally
> routine, analagous to "try ... finally ..." in Java.
Done.
> > +/* For realpath */
>
> s/realpath/realpath()/
Removed.
> > +
> > + ML_check_dir_readable(DirName, &is_readable, &Result);
> > + if (is_readable) {
> > + dir_pattern_len = strlen(DirName);
> > + MR_allocate_aligned_string_msg(dir_pattern,
> > + dir_pattern_len + 2, MR_PROC_LABEL);
>
> See the documentation for MR_allocate_aligned_string_msg():
>
> ** BEWARE: this may modify `MR_hp', so it must only be called from
> ** places where `MR_hp' is valid.
>
> IIRC modifying MR_hp is not valid in code declared `may_call_mercury'.
It now uses MR_malloc.
> > +#elif defined(MR_HAVE_OPENDIR) && defined(MR_HAVE_READDIR) && defined(MR_HAVE_CLOSEDIR)
>
> That line is longer than 80 columns, and should be wrapped
> (using backslash-newline for the line continuations).
Done.
> > + % This is needed because the heap pointer is not valid in
> > + % the may_call_mercury foreign proc for dir.open_2.
>
> OK, now I'm completely mystified. I don't know what is happening here,
> but whatever it is, it is IMHO way too subtle ;-)
Clarified.
> > Index: library/io.m
> ...
> > +:- pred io__have_symlinks is semidet.
> > + % Does the platform support symbolic links.
>
> What about systems that don't themselves support symbolic links,
> but which can access network file systems that do?
>
> Does this predicate indicate whether any files might be symlinks.
Clarified.
> > +:- pred io__make_symlink(string, string, io__res, io__state, io__state).
> > +:- mode io__make_symlink(in, in, out, di, uo) is det.
> > + % io__make_symlink(FileName, LinkFileName, Result, IO0, IO)
> > + % attempts to make `LinkFileName' be a symbolic link to `FileName'.
>
> If FileName is a relative path, is it interpreted relative to the
> current directory, or relative to the directory name of LinkFileName?
Fixed.
> > +:- pred io__follow_symlink(string, io__res(string), io__state, io__state).
> > +:- mode io__follow_symlink(in, out, di, uo) is det.
> > + % io__follow_symlink(FileName, Result, IO0, IO) returns
> > + % `ok(LinkTarget)' if FileName is a symbolic link pointing
> > + % to LinkTarget, and `error(Error)' otherwise.
>
> Can filename be a relative path, and if so, should it be interpreted
> relative to the current directory, or relative to the directory name
> of LinkFileName?
Fixed.
> > +:- type io__access_type
> > + ---> read
> > + ; write
> > + ; execute
> > + .
> > +
> > +:- pred io__check_file_accessibility(string, list(access_type),
> > + io__res, io__state, io__state).
>
> Shouldn't that be a set(access_type)?
It could be, but it really doesn't matter.
> > +:- mode io__check_file_accessibility(in, in, out, di, uo) is det.
> > + % io__check_file_accessibility(FileName, AccessTypes, Result)
> > + % Check whether the current user can access the given file.
>
> What's the meaning of the AccessTypes argument?
Fixed.
> > +:- pred io__file_type(bool, string, io__res(file_type), io__state, io__state).
> > +:- mode io__file_type(in, in, out, di, uo) is det.
> > + % io__file_type(FollowSymLinks, FileName, TypeResult)
> > + % finds the type of the given file.
> > + % This predicate will only work on systems which provide
> > + % the POSIX C library function stat(). On other systems the
> > + % returned result will always be bound to error/1.
>
> This documentation is overly specific to POSIX-based implementation.
> Implementations on systems which do not provide stat()
> should not be prohibited from making io__file_type work,
> but the documentation above implies that they are.
Fixed.
> > @@ -1301,6 +1403,62 @@
> > %-----------------------------------------------------------------------------%
> > :- interface.
> >
> > +% For use by dir.m:
> > +
> > + % A system-dependent error indication.
> > + % For C, this is the value of errno or the result of
> > + % GetLastError() on Win32.
> > +:- type io__system_error.
>
> How do you know which?
Fixed.
> > +% io__file_id(FileName, FileId).
> > +%
> > +% Return a unique identifier for the given file.
> > +% XXX On Cygwin sometimes two files will have the same file_id.
> > +% This is because MS-Windows does not use inodes, so Cygwin
> > +% hashes the absolute file name.
>
> What does this do on plain Windows (without Cygwin)?
Documented.
> > + #ifdef MR_HAVE_LSTAT
> > + stat_result = lstat(FileName, &s);
> > + #else
> > + stat_result = stat(FileName, &s);
> > + #endif
> > + }
>
> The #if here is not properly indented. Likewise in the code that follows.
Fixed.
> > +:- pragma foreign_decl("MC++",
> > +"
> > +#include <io.h> /* for access() */
> > +#include <errno.h>
> > +#include <string.h> /* for strerror() */
> > +
> > +").
> > +
> > +% The .NET class library doesn't provide any way to check the
> > +% accessibility of a file without opening it, so instead we
> > +% use the POSIX access() function, which is also supported by
> > +% Windows.
>
> I think it would be better to just open the file (and immediately close it).
This code was wrong -- it doesn't invoke the .NET security checks, so
it might succeed even if the process didn't have permission to access
the file system. I've mostly fixed the problems, but it's difficult to
do properly for directories. This is really a fault in the .NET class
library.
> > +% Can we retrieve inodes on this system.
> > +:- type file_id
> > + ---> file_id(device :: int, inode :: int).
>
> I don't understand how the comment relates to the type.
It doesn't.
> > +:- pragma foreign_proc("C", have_file_ids,
> > + [promise_pure, will_not_call_mercury, thread_safe],
> > +"
> > +#if defined(MR_WIN32) || !defined(MR_HAVE_STAT)
> > + /* Win32 returns junk in the st_ino field of `struct stat'. */
> > + SUCCESS_INDICATOR = MR_FALSE;
> > +#else
> > + SUCCESS_INDICATOR = MR_TRUE;
> > +#endif
>
> Using MR_WIN32 is not really the right test here.
> Having MR_WIN32 defined is supposed to mean that the system supports
> the Win32 API, but if it does, that doesn't necessarily mean that
> it has a broken stat(). Consider a hypothetical Unix implementation
> that also supports the Win32 API (e.g. using Wine).
>
> It would be better to use a new configuration parameter, called say
> MR_BROKEN_STAT, and then add
Done.
> > @@ -5549,12 +6255,17 @@
> > { Result = yes(Dir) }
> > ;
> > { Result = no },
> > - { Dir = "/tmp" }
> > + { dir__use_windows_paths ->
> > + Dir = "C:\\windows\\temp"
> > + ;
> > + Dir = "/tmp"
> > + }
> > ),
> > io__make_temp(Dir, "mtmp", Name).
>
> Hard-coding "C:\windows\temp" is not the right thing to do here.
>
> Also, it doesn't match the documentation for io__make_temp//1.
Fixed.
> > +/*
> > +** ML_maybe_make_win32_err_msg(was_error, error, msg, procname, error_msg):
> > +** if `was_error' is true, then append `msg' and the string
> > +** returned by the Win32 API function FormatMessage() for the
> > +** last error to give `error_msg'; otherwise, set `error_msg' to NULL.
> > +** Aborts if MR_WIN32 is not defined.
> > +**
> > +** WARNING: this must only be called when the `hp' register is valid.
> > +** That means it must only be called from procedures declared
> > +** `[will_not_call_mercury, promise_pure]'.
>
> promise_pure has nothing to do with it.
Cut and paste error, fixed.
> > +:- pragma foreign_proc("C",
> > + io__follow_symlink_2(FileName::in, TargetFileName::out,
> > + Status::out, Error::out, IO0::di, IO::uo),
> > + [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
> > +"{
> > +#ifdef MR_HAVE_READLINK
> > + #ifndef PATH_MAX
> > + #define PATH_MAX 256
> > + #endif
> > + int num_chars;
> > + char *buffer2 = NULL;
> > + int buffer_size2 = PATH_MAX;
> > + char buffer[PATH_MAX + 1];
> > +
> > + /* readlink() does not null-terminate the buffer */
> > + num_chars = readlink(FileName, buffer, PATH_MAX);
> > +
> > + if (num_chars == PATH_MAX) {
> > + while (1) {
> > + buffer_size2 *= 2;
> > + if (buffer2 != NULL) {
> > + MR_free(buffer2);
> > + }
> > + buffer2 = MR_NEW_ARRAY(char, buffer_size2);
>
> The check for NULL here is unnecessary; free() and by extension MR_free()
> are defined to do nothing in the case when the argument is NULL.
>
> In fact, rather than calling MR_free() and then MR_NEW_ARRAY(),
> you can just call MR_RESIZE_ARRAY().
...
> The call to MR_free() and the setting of buffer2 to NULL seem to be
> unnecessary, since the buffer will already be deallocated by the
> code above (either MR_free() in your original code or
> MR_RESIZE_ARRAY() after my suggested changes).
...
> Then, the loop might look nicer as a "do ... while" loop
> rather than a "while(1) ... if (...) continue" loop.
All done.
> > +++ tests/hard_coded/dir_test.exp 14 Jun 2003 08:42:00 -0000
> > @@ -0,0 +1,38 @@
> > +Directory separator is '\'.
> ...
> > +dir__split_name("C:\", _, _) failed.
>
> Please test "C:" too.
Done.
> > +dir__dirname("foo") = ".".
> > +dir__basename("C:\") = _ failed.
> > +dir__basename("C:\foo") = "foo".
>
> Please repeat all the tests of split_name for dirname and basename.
Done.
> Why are there three different .exp* files for this test case?
> Two I can understand, one for Windows-style paths and one for
> Unix-style paths, but why the third?
> Could you post a diff of the two different Windows-style versions?
The difference is only in trailing directory separators on directories --
the .NET CLI strips them, my code doesn't. Given that in some circumstances
trailing separators are significant (C: vs C:\), I think it's better not
to try to strip them.
--- dir_test.exp 2003-07-13 20:29:02.000000000 +1000
+++ dir_test.exp2 2003-07-13 20:29:02.000000000 +1000
@@ -1,6 +1,6 @@
Directory separator is '\'.
-dir__split_name("\\server\share\foo", "\\server\share\", "foo").
-dir__dirname("\\server\share\foo") = "\\server\share\".
+dir__split_name("\\server\share\foo", "\\server\share", "foo").
+dir__dirname("\\server\share\foo") = "\\server\share".
dir__basename("\\server\share\foo") = "foo".
dir__path_name_is_absolute("\\server\share\foo").
@@ -44,13 +44,13 @@
dir__basename("") = "".
dir__path_name_is_absolute("") failed
-dir__split_name("foo\\bar\", "foo\", "bar").
-dir__dirname("foo\\bar\") = "foo\".
+dir__split_name("foo\\bar\", "foo", "bar").
+dir__dirname("foo\\bar\") = "foo".
dir__basename("foo\\bar\") = "bar".
dir__path_name_is_absolute("foo\\bar\") failed
-dir__split_name("foo\bar\", "foo\", "bar").
-dir__dirname("foo\bar\") = "foo\".
+dir__split_name("foo\bar\", "foo", "bar").
+dir__dirname("foo\bar\") = "foo".
dir__basename("foo\bar\") = "bar".
dir__path_name_is_absolute("foo\bar\") failed
@@ -64,8 +64,8 @@
dir__basename("/foo") = "foo".
dir__path_name_is_absolute("/foo").
-dir__split_name("/foo//bar///", "\foo\", "bar").
-dir__dirname("/foo//bar///") = "\foo\".
+dir__split_name("/foo//bar///", "\foo", "bar").
+dir__dirname("/foo//bar///") = "\foo".
dir__basename("/foo//bar///") = "bar".
dir__path_name_is_absolute("/foo//bar///").
@@ -84,8 +84,8 @@
dir__basename("/") = _ failed.
dir__path_name_is_absolute("/").
-dir__split_name("foo/bar", "foo\", "bar").
-dir__dirname("foo/bar") = "foo\".
+dir__split_name("foo/bar", "foo", "bar").
+dir__dirname("foo/bar") = "foo".
dir__basename("foo/bar") = "bar".
dir__path_name_is_absolute("foo/bar") failed
> > Index: tests/hard_coded/dir_test.m
> > +main -->
> > + io__write_string("Directory separator is '"),
> > + io__write_char(dir__directory_separator),
> > + io__write_string("'.\n"),
> > + ( { dir__use_windows_paths } ->
> > + test_split_name("\\\\server\\share\\foo"),
> > + test_split_name("\\\\server\\share"),
> > + test_split_name("\\\\server\\share\\\\"),
> > + test_split_name("C:\\foo"),
> > + test_split_name("C:\\"),
> > + test_split_name(""),
> > + test_split_name("foo\\\\bar\\"),
> > + test_split_name("foo\\bar\\"),
> > + test_split_name("foo"),
> > + test_dirname("foo"),
> > + test_basename("C:\\"),
> > + test_basename("C:\\foo")
> > + ;
> > + test_split_name("/foo"),
> > + test_split_name("/foo//bar///"),
> > + test_split_name("//foo//bar/"),
> > + test_split_name("//foo//"),
> > + test_split_name("/"),
> > + test_split_name(""),
> > + test_split_name("foo/bar"),
> > + test_split_name("foo"),
> > + test_dirname("foo"),
> > + test_basename("/"),
> > + test_basename("/foo")
> > + ),
>
> I think it would be better to run both sets of tests for both systems,
> i.e. test the results for both Unix-style and Windows-style paths
> regardless of whether use_windows_paths is true or false.
Done.
Simon.
Estimated hours taken: 120
Branches: main
Library changes required to make the compiler work on Windows
without Cygwin. (Compiler changes to come separately).
library/dir.m:
Handle Windows-style paths.
Change the determinism of dir.basename and dir.split_name.
dir.basename now fails for root directories (a new function
dir.basename_det calls error/1 rather than failing).
dir.split_name fails for root directories or if the pathname
passed doesn't contain a directory separator.
Add predicates dir.make_directory and dir.path_name_is_absolute.
Add a multi predicate dir.is_directory separator which
returns all separators for the platform (including '/' on
Windows), not just the standard one.
Add a function dir.parent_directory (returns "..").
Add dir.foldl2 and dir.recursive_foldl2, to iterate through
the entries in a directory (and maybe its subdirectories).
Change '/' to correctly handle Windows paths of the form
"C:"/"foo" and "\"/"foo".
Don't add repated directory separators in '/'.
library/io.m:
Add io.file_type and io.check_file_accessibility.
Add predicates to deal with symlinks -- io.have_symlinks,
io.make_symlink and io.follow_symlink.
Add io.file_id for use by dir.foldl2 to detect
symlink loops. This is a bit low level, so it's
not included in the user documentation.
Add io.(binary_)input_stream_foldl2_io_maybe_stop, which
is like io.(binary_)input_stream_foldl2_io, but allows
stopping part of the way through. This is useful for
implementing `diff'-like functionality to replace
mercury_update_interface.
Use Windows-style paths when generating temporary file
names on Windows.
Add versions of the predicates to generate error messages
to handle Win32 errors.
Add versions of the predicates to generate error messages
which take a system error code, rather than looking up
errno. This simplifies things where the error we
are interested in was not from the last system call.
library/exception.m:
Add a predicate finally/6 which performs the same function
as the `finally' clause in languages such as C# and Java.
Add predicates try_det, try_io_det and try_store_det,
which only have one mode so they are more convenient
to pass to promise_only solution.
library/Mmakefile:
Add dependencies on runtime/mercury_conf.h for files which
use the MR_HAVE_* macros.
library/string.m:
Add a function version of string__index.
NEWS:
Document the new predicates and functions and the change
of determinism of dir.split_name and dir.basename.
configure.in:
runtime/mercury_conf.h.in:
Test for lstat, mkdir, symlink and readlink.
runtime/mercury_conf_param.h:
Add a macro MR_BROKEN_ST_INO, which is true if the st_ino
field of `struct stat' is garbage. Currently defined iff
MR_WIN32 is defined.
compiler/compile_target_code.m:
compiler/modules.m:
compiler/options_file.m:
compiler/prog_io.m:
compiler/source_file_map.m:
Changes required by the change of determinism of
dir.split_name and dir.basename.
tests/hard_coded/Mmakefile:
tests/hard_coded/dir_test.{m,exp,exp2,exp3}:
Test case.
diff -u NEWS NEWS
--- NEWS
+++ NEWS
@@ -32,6 +32,7 @@
* We've added some new predicates and functions to the dir module:
basename_det/1,
expand_braces/1,
+ is_directory_separator/1,
make_directory/4,
foldl2/6,
parent_directory/0,
@@ -45,6 +46,9 @@
file_type/4,
input_stream_foldl2_io_maybe_stop/{6,7},
binary_input_stream_foldl2_io_maybe_stop/{6,7}.
+* exception.m now contains a predicate finally/6 which can be used to
+ ensure that resources are released whether a called closure exits
+ normally or throws an exception.
Portability improvements:
* Nothing yet.
@@ -113,6 +117,7 @@
* We've added some new predicates and functions to the dir module:
basename_det/1,
expand_braces/1,
+ is_directory_separator/1,
make_directory/4,
foldl2/6,
parent_directory/0,
@@ -132,6 +137,10 @@
to exception.m. These predicates have only one mode, so it's more
convenient to pass them to promise_only_solution.
+* exception.m now contains a predicate finally/6 which can be used to
+ ensure that resources are released whether a called closure exits
+ normally or throws an exception.
+
* Several new functions have been added to the string module, namely
elem/2, unsafe_elem/2, chomp/1, lstrip/1, lstrip/2, rstrip/1, rstrip/2,
strip/1, prefix_length/2, and suffix_length/2.
diff -u library/Mmakefile library/Mmakefile
--- library/Mmakefile
+++ library/Mmakefile
@@ -340,21 +340,11 @@
endif # GRADE != il && GRADE != java
#-----------------------------------------------------------------------------#
-# Ensure we recompile library__version if VERSION or the MR_HAVE_*
-# macros are changed.
-$(os_subdir)deconstruct.$O \
-$(os_subdir)deconstruct.pic_o \
-$(os_subdir)library.$O \
-$(os_subdir)library.pic_o \
-$(os_subdir)dir.$O \
-$(os_subdir)dir.pic_o \
-$(os_subdir)float.$O \
-$(os_subdir)float.pic_o \
-$(os_subdir)io.$O \
-$(os_subdir)io.pic_o \
-$(os_subdir)time.$O \
-$(os_subdir)time.pic_o \
- : $(RUNTIME_DIR)/mercury_conf.h
+# Rebuild all the object files if the configuration macros or VERSION
+# have changed. Only some source files use the configuration macros,
+# but these uses may leak into other object files with inter-module
+# optimization.
+$(mer_std.os): $(RUNTIME_DIR)/mercury_conf.h
# The object files in this directory depend on many of the header files
# in the runtime. However, changes to many of these header files require
diff -u library/dir.m library/dir.m
--- library/dir.m
+++ library/dir.m
@@ -5,7 +5,7 @@
%---------------------------------------------------------------------------%
% File: dir.m.
-% Main author: fjh, stayl.
+% Main authors: fjh, stayl.
% Filename and directory handling.
% Stability: high.
@@ -19,12 +19,21 @@
% predicates to isolate system dependencies
- % Returns the separator between components of a pathname --
- % '/' on Unix systems and '\' on Microsoft Windows systems.
+ % Returns the default separator between components of a pathname --
+ % '/' on Unix systems and '\\' on Microsoft Windows systems.
:- func dir__directory_separator = character.
:- pred dir__directory_separator(character).
:- mode dir__directory_separator(out) is det.
-:- mode dir__directory_separator(in) is semidet.
+
+ % Is the character a directory separator.
+ % On Microsoft Windows systems this will succeed for '/'
+ % as well as '\\'.
+ % Note that the predicates and functions in this module may
+ % change directory separators in paths passed to them
+ % to the normal separator for the platform.
+:- pred dir__is_directory_separator(character).
+:- mode dir__is_directory_separator(in) is semidet.
+:- mode dir__is_directory_separator(out) is multi.
% Returns ".".
:- func dir__this_directory = string.
@@ -39,25 +48,39 @@
% dir__split_name(PathName, DirName, BaseName).
% Split a filename into a directory part and a filename part.
% Fails for root directories or relative filenames not
- % containing a directory separator.
+ % containing directory information.
+ % Trailing slashes are removed from PathName before splitting.
+ % DirName may have a trailing slash.
:- pred dir__split_name(string::in, string::out, string::out) is semidet.
% dir__basename(PathName) = BaseName.
% Returns the non-directory part of a filename.
- % Fails when given a root directory.
+ % Fails when given a root directory, "." or "..".
+ % Trailing slashes in PathName are removed first.
:- func dir__basename(string) = string is semidet.
:- pred dir__basename(string::in, string::out) is semidet.
- % As above, but throw an exception when given a root directory.
+ % As above, but throw an exception instead of failing.
:- func dir__basename_det(string) = string.
- % dir__basename(PathName) = BaseName.
+ % dir__dirname(PathName) = DirName.
% Returns the directory part of a filename.
-:- func dir__dirname(string) = string is det.
+ % Returns PathName if it specifies a root directory.
+ % Returns `dir__this_directory' when given a filename
+ % without any directory information (e.g. "foo").
+ % Returns PathName for Windows paths such as "X:"
+ % (the current directory on drive `X').
+ % Trailing slashes in PathName are removed first.
+ % DirName may have a trailing slash.
+:- func dir__dirname(string) = string.
:- pred dir__dirname(string::in, string::out) is det.
% Is the path name syntactically an absolute path
% (doesn't check whether the path exists).
+ % On Unix systems, this means that the path starts with '/'.
+ % On Microsoft Windows systems a root directory starts
+ % with a drive root (e.g. 'C:\', '\') or a UNC share
+ % root (e.g. \\server\share\).
:- pred dir__path_name_is_absolute(string::in) is semidet.
% Given a directory name and a filename, return the pathname of that
@@ -76,13 +99,21 @@
%-----------------------------------------------------------------------------%
% FoldlPred(DirName, BaseName, FileType, Continue, !Data, !IO).
+ %
+ % A predicate passed to dir__foldl2 to process each entry in
+ % a directory.
+ % Processing will stop if Continue is bound to `no'.
:- type dir__foldl_pred(T) == pred(string, string, io__file_type, bool,
T, T, io__state, io__state).
:- inst dir__foldl_pred == (pred(in, in, in, out, in, out, di, uo) is det).
% dir__foldl2(P, DirName, InitialData, Result, !IO).
%
- % Apply `P' to all direct subdirectories of the given directory.
+ % Apply `P' to all files and directories in the given directory.
+ % Directories are not processed recursively.
+ % Processing will stop if the boolean (Continue) output of P is bound
+ % to `no'.
+ % The order in which the entries are processed is system dependent.
:- pred dir__foldl2(dir__foldl_pred(T), string,
T, io__maybe_partial_res(T), io__state, io__state).
:- mode dir__foldl2(in(dir__foldl_pred), in, in, out, di, uo) is det.
@@ -90,10 +121,11 @@
% dir__recursive_foldl2(P, DirName, FollowSymLinks,
% InitialData, Result, !IO).
%
- % Apply `P' to all direct and indirect subdirectories
- % of the given directory.
- % If `FollowSymLinks' is `yes', process the directories
- % referenced by symbolic links in subdirectories of DirName.
+ % As above, but recursively process subdirectories.
+ % Subdirectories are processed depth-first, processing
+ % the directory itself before its contents.
+ % If `FollowSymLinks' is `yes', recursively process the
+ % directories referenced by symbolic links.
:- pred dir__recursive_foldl2(dir__foldl_pred(T), string, bool,
T, io__maybe_partial_res(T), io__state, io__state).
:- mode dir__recursive_foldl2(in(dir__foldl_pred),
@@ -144,9 +176,23 @@
Sep = System.IO.Path.DirectorySeparatorChar;
").
+dir__is_directory_separator(Char) :-
+ ( Char = dir__directory_separator
+ ; Char = dir__alt_directory_separator, Char \= dir__directory_separator
+ ).
+
+:- func dir__alt_directory_separator = char.
+
+dir__alt_directory_separator = ('/').
+:- pragma foreign_proc("C#", dir__alt_directory_separator = (Sep::out),
+ [promise_pure, will_not_call_mercury, thread_safe],
+"
+ Sep = System.IO.Path.AltDirectorySeparatorChar;
+").
+
use_windows_paths :- dir__directory_separator = ('\\').
-:- pragma export((dir__this_directory = out), "ML_this_directory").
+:- pragma export((dir__this_directory = out), "ML_dir_this_directory").
dir__this_directory = ".".
dir__parent_directory = "..".
@@ -160,76 +206,119 @@
).
dir__basename(FileName) = BaseName :-
- FileNameList = strip_repeated_dir_separators(
+ FileNameChars = canonicalize_path_chars(
string__to_char_list(FileName)),
- ( dir__is_root_directory(FileNameList) ->
- fail
- ; dir__split_name_2(FileNameList, _, BaseName0) ->
+ \+ dir__is_root_directory(FileNameChars),
+ \+ (
+ % Current directory on the given drive.
+ use_windows_paths,
+ FileNameChars = [Drive, (':')],
+ char__is_alpha(Drive)
+ ),
+
+ FileNameWithoutSlash = remove_trailing_dir_separator(FileNameChars),
+ FileNameWithoutSlash \= string__to_char_list(dir__this_directory),
+ FileNameWithoutSlash \= string__to_char_list(dir__parent_directory),
+ ( dir__split_name_2(FileNameChars, _, BaseName0) ->
BaseName = BaseName0
;
BaseName = FileName
).
dir__dirname(FileName) = DirName :-
- FileNameList = strip_repeated_dir_separators(
+ FileNameChars = canonicalize_path_chars(
string__to_char_list(FileName)),
- ( dir__is_root_directory(FileNameList) ->
+ (
+ dir__is_root_directory(FileNameChars)
+ ->
DirName = FileName
- ; dir__split_name_2(FileNameList, DirName0, _) ->
+ ;
+ % Current directory on the given drive.
+ use_windows_paths,
+ FileNameChars = [Drive, (':')],
+ char__is_alpha(Drive)
+ ->
+ DirName = FileName
+ ;
+ dir__split_name_2(FileNameChars, DirName0, _)
+ ->
DirName = DirName0
;
+ remove_trailing_dir_separator(FileNameChars) =
+ string__to_char_list(dir__parent_directory)
+ ->
+ DirName = dir__parent_directory
+ ;
DirName = dir__this_directory
).
dir__split_name(FileName, DirName, BaseName) :-
- FileNameList = strip_repeated_dir_separators(
+ FileNameChars = canonicalize_path_chars(
string__to_char_list(FileName)),
- \+ is_root_directory(FileNameList),
- dir__split_name_2(FileNameList, DirName, BaseName).
+ \+ is_root_directory(FileNameChars),
+ dir__split_name_2(FileNameChars, DirName, BaseName).
+ % Check that the filename is not empty or dir__this_directory,
+ % pass the directory off to any backend-specific implementations,
+ % or if none exist, invoke split_name_3 to split the filename using
+ % Mercury code.
+ % This assumes that the caller has already checked whether the
+ % directory is a root directory.
:- pred dir__split_name_2(list(char)::in, string::out, string::out) is semidet.
-dir__split_name_2(FileNameList0, DirName, BaseName) :-
+dir__split_name_2(FileNameChars0, DirName, BaseName) :-
+ FileNameChars0 \= [],
+ FileNameWithoutSlash = remove_trailing_dir_separator(FileNameChars0),
+ FileNameWithoutSlash \= string__to_char_list(dir__this_directory),
+ FileNameWithoutSlash \= string__to_char_list(dir__parent_directory),
( io__have_dotnet ->
- % Remove any trailing separator (System.IO.Path.GetFileName()
- % returns the empty string if the path ends in a separator).
- (
- list__split_last(FileNameList0, FileNameList1,
- dir__directory_separator)
- ->
- FileNameList = FileNameList1
- ;
- FileNameList = FileNameList0
- ),
- dir__split_name_dotnet(string__from_char_list(FileNameList),
+ % System.IO.Path.GetFileName() returns the empty string
+ % if the path ends in a separator).
+ dir__split_name_dotnet(
+ string__from_char_list(FileNameWithoutSlash),
DirName, BaseName)
;
- dir__split_name_3(FileNameList0, DirName, BaseName)
+ dir__split_name_3(FileNameChars0, DirName, BaseName)
).
:- pred dir__split_name_3(list(char)::in, string::out, string::out) is semidet.
-dir__split_name_3(FileNameList, DirName, BaseName) :-
+dir__split_name_3(FileNameChars, DirName, BaseName) :-
% Remove any trailing separator.
- RevFileNameList0 = reverse(FileNameList),
- ( RevFileNameList0 = [dir__directory_separator | RevFileNameList1] ->
- RevFileNameList = RevFileNameList1
+ RevFileNameChars0 = reverse(FileNameChars),
+ ( RevFileNameChars0 = [dir__directory_separator | RevFileNameChars1] ->
+ RevFileNameChars = RevFileNameChars1
;
- RevFileNameList = RevFileNameList0
+ RevFileNameChars = RevFileNameChars0
),
- list__takewhile(isnt(unify(dir__directory_separator)),
- RevFileNameList, RevBaseName, RevDirName),
- RevBaseName \= [],
- RevDirName \= [],
- BaseName = string__from_rev_char_list(RevBaseName),
- DirName = string__from_rev_char_list(RevDirName).
+ (
+ list__takewhile(isnt(unify(dir__directory_separator)),
+ RevFileNameChars, RevBaseName, RevDirName),
+ RevBaseName \= [],
+ RevDirName \= []
+ ->
+ BaseName = string__from_rev_char_list(RevBaseName),
+ DirName = string__from_rev_char_list(RevDirName)
+ ;
+ % Check for relative paths of the form `C:foo'.
+ use_windows_paths,
+ FileNameChars = [Drive, (':') | BaseNameChars],
+ char__is_alpha(Drive),
+ BaseNameChars = [BaseNameFirst | _],
+ BaseNameFirst \= dir__directory_separator
+ ->
+ BaseName = string__from_char_list(BaseNameChars),
+ DirName = string__from_char_list([Drive, (':')])
+ ;
+ fail
+ ).
:- pred dir__split_name_dotnet(string::in,
string::out, string::out) is semidet.
dir__split_name_dotnet(_, "", "") :- semidet_fail.
-% .NET provides functions to split directory names in a
+% The .NET CLI provides functions to split directory names in a
% system-dependent manner.
:- pragma foreign_proc("C#",
dir__split_name_dotnet(FileName::in, DirName::out, BaseName::out),
@@ -237,50 +326,69 @@
"
try {
DirName = System.IO.Path.GetDirectoryName(FileName);
- if (DirName == null) {
+ if (DirName == null || DirName == System.String.Empty) {
+ BaseName = null;
SUCCESS_INDICATOR = false;
- } else if (DirName == System.String.Empty) {
- SUCCESS_INDICATOR = true;
- DirName = mercury.dir.mercury_code.ML_this_directory();
- BaseName = FileName;
} else {
BaseName = System.IO.Path.GetFileName(FileName);
SUCCESS_INDICATOR = (BaseName != null);
}
} catch (System.Exception e) {
+ BaseName = null;
+ DirName = null;
SUCCESS_INDICATOR = false;
}
").
-:- func strip_repeated_dir_separators(list(char)) = list(char).
+ % Convert alternative path separators to the normal path
+ % separator for the platform, and remove repeated path
+ % separators.
+:- func canonicalize_path_chars(list(char)) = list(char).
-strip_repeated_dir_separators(FileName0) =
+canonicalize_path_chars(FileName0) =
(
% Windows allows paths of the form "\\server\share".
use_windows_paths,
- FileName0 = [dir__directory_separator | FileName1]
+ FileName0 = [Char1 | FileName1],
+ is_directory_separator(Char1)
->
[dir__directory_separator |
- strip_repeated_dir_separators_2(FileName1, [])]
+ canonicalize_path_chars_2(FileName1, [])]
;
- strip_repeated_dir_separators_2(FileName0, [])
+ canonicalize_path_chars_2(FileName0, [])
).
-:- func strip_repeated_dir_separators_2(list(char), list(char)) = list(char).
+:- func canonicalize_path_chars_2(list(char), list(char)) = list(char).
-strip_repeated_dir_separators_2([], RevFileName) = reverse(RevFileName).
-strip_repeated_dir_separators_2([C | FileName0],
- RevFileName) = FileName :-
- ( C = dir__directory_separator ->
- list__takewhile(unify(dir__directory_separator),
- FileName0, _, FileName1),
- FileName = strip_repeated_dir_separators_2(FileName1,
- [C | RevFileName])
+canonicalize_path_chars_2([], RevFileName) = reverse(RevFileName).
+canonicalize_path_chars_2([C0 | FileName0], RevFileName0) =
+ canonicalize_path_chars_2(FileName0, RevFileName) :-
+ % Convert all directory separators to the standard
+ % separator for the platform.
+ C = ( is_directory_separator(C0) -> directory_separator ; C0 ),
+ (
+ C = directory_separator,
+ FileName0 = [C2 | _],
+ dir__is_directory_separator(C2)
+ ->
+ RevFileName = RevFileName0
;
- FileName = strip_repeated_dir_separators_2(FileName0,
- [C | RevFileName])
+ RevFileName = [C | RevFileName0]
).
+:- func remove_trailing_dir_separator(list(char)) = list(char).
+
+remove_trailing_dir_separator(Chars) =
+ ( if
+ list__split_last(Chars, Chars1, Sep),
+ dir__is_directory_separator(Sep)
+ then
+ Chars1
+ else
+ Chars
+ ).
+
+ % Assumes repeated directory separators have been removed.
:- pred is_root_directory(list(char)::in) is semidet.
is_root_directory(FileName) :-
@@ -292,58 +400,98 @@
FileName = [dir__directory_separator]
).
- % Win32 should really provide a function to do this.
+ % strip_leading_win32_root_directory(FileName, FileNameMinusRoot)
+ %
% XXX Handle Unicode file names.
:- pred strip_leading_win32_root_directory(list(char)::in,
list(char)::out) is semidet.
strip_leading_win32_root_directory(!FileName) :-
- ( strip_leading_win32_drive_spec(!FileName) ->
+ ( strip_leading_win32_drive_root_directory(!FileName) ->
+ true
+ ; strip_leading_win32_unc_root_directory(!FileName) ->
true
;
- strip_leading_win32_unc_root_directory(!FileName)
+ strip_leading_win32_current_drive_root_directory(!FileName)
).
- % Check for `C:\'.
-:- pred strip_leading_win32_drive_spec(list(char)::in,
+ % Check for `X:\'.
+:- pred strip_leading_win32_drive_root_directory(list(char)::in,
list(char)::out) is semidet.
-strip_leading_win32_drive_spec([Letter, ':' | !.FileName], !:FileName) :-
- char__is_alpha(Letter),
- ( !.FileName = [dir__directory_separator | !:FileName] ->
- true
- ;
- true
+strip_leading_win32_drive_root_directory(
+ [Letter, ':', dir__directory_separator| !.FileName],
+ !:FileName) :-
+ char__is_alpha(Letter).
+
+ % Check for `\foo...'.
+:- pred strip_leading_win32_current_drive_root_directory(list(char)::in,
+ list(char)::out) is semidet.
+
+strip_leading_win32_current_drive_root_directory(
+ [dir__directory_separator | !.FileName], !:FileName) :-
+ ( !.FileName = []
+ ; !.FileName = [Char2 | !:FileName], Char2 \= dir__directory_separator
).
- % Check for `\\server\share\'.
+ % Check for `\\server\' or `\\server\share\'.
:- pred strip_leading_win32_unc_root_directory(list(char)::in,
list(char)::out) is semidet.
strip_leading_win32_unc_root_directory([Sep, Sep | !.FileName], !:FileName) :-
Sep = dir__directory_separator,
list__takewhile(isnt(unify(Sep)), !.FileName,
- Server, [Sep | !:FileName]),
+ Server, !:FileName),
Server \= [],
- list__takewhile(isnt(unify(Sep)), !.FileName,
- Share, !:FileName),
- Share \= [],
- ( !.FileName = [Sep | !:FileName]
- ; !.FileName = []
+ (
+ !.FileName = []
+ ;
+ !.FileName = [Sep | !:FileName],
+ (
+ !.FileName = []
+ ;
+ !.FileName = [_|_],
+ list__takewhile(isnt(unify(Sep)), !.FileName,
+ Share, !:FileName),
+ Share \= [],
+ ( !.FileName = [Sep | !:FileName]
+ ; !.FileName = []
+ )
+ )
).
:- pred is_dotnet_root_directory(string::in) is semidet.
-is_dotnet_root_directory(_) :-
- error("dir.is_dotnet_root_directory called for non-.NET backend").
+is_dotnet_root_directory(FileName) :-
+ dir__path_name_is_absolute(FileName),
+ (
+ is_dotnet_root_directory_2(FileName)
+ ;
+ % For reasons known only to Microsoft,
+ % trailing slashes are significant.
+ FileNameLen = length(FileName),
+ (
+ is_directory_separator(
+ string__unsafe_index(FileName, FileNameLen - 1))
+ ->
+ is_dotnet_root_directory_2(
+ string__left(FileName, FileNameLen - 1))
+ ;
+ fail
+ )
+ ).
+
+:- pred is_dotnet_root_directory_2(string::in) is semidet.
+
+is_dotnet_root_directory_2(_) :-
+ error("dir.is_dotnet_root_directory called for non-.NET CLI backend").
-:- pragma foreign_proc("C#", is_dotnet_root_directory(FileName::in),
+:- pragma foreign_proc("C#", is_dotnet_root_directory_2(FileName::in),
[will_not_call_mercury, promise_pure, thread_safe],
"{
try {
SUCCESS_INDICATOR =
- (System.IO.Path.IsPathRooted(FileName) &&
- (System.IO.Path.GetDirectoryName(FileName) == null));
+ (System.IO.Path.GetDirectoryName(FileName) == null);
} catch (System.Exception e) {
SUCCESS_INDICATOR = false;
}
@@ -352,16 +500,49 @@
%-----------------------------------------------------------------------------%
dir__path_name_is_absolute(FileName) :-
- ( use_windows_paths ->
+ ( have_dotnet ->
+ dotnet_path_name_is_absolute(FileName)
+ ; use_windows_paths ->
strip_leading_win32_root_directory(
- strip_repeated_dir_separators(
+ canonicalize_path_chars(
string__to_char_list(FileName)),
_)
;
string__index(FileName, 0, dir__directory_separator)
).
-:- pragma foreign_proc("C#", dir__path_name_is_absolute(FileName::in),
+:- pred dir__dotnet_path_name_is_absolute(string::in) is semidet.
+
+dir__dotnet_path_name_is_absolute(FileName) :-
+ dir__dotnet_path_name_is_absolute_2(FileName),
+
+ % The .NET CLI function System.IO.Path.IsPathRooted succeeds for
+ % paths such as `C:', which specifies a directory relative to the
+ % current directory on drive C.
+ \+ (
+ use_windows_paths,
+ FileNameLen = length(FileName),
+ ( FileNameLen >= 2 ->
+ char__is_alpha(string__unsafe_index(FileName, 0)),
+ string__unsafe_index(FileName, 1) = (':'),
+ ( FileNameLen > 2 ->
+ string__unsafe_index(FileName, 2)
+ \= directory_separator `with_type` char
+ ;
+ true
+ )
+ ;
+ fail
+ )
+ ).
+
+:- pred dir__dotnet_path_name_is_absolute_2(string::in) is semidet.
+
+dir__dotnet_path_name_is_absolute_2(_) :-
+ error(
+ "dir.dotnet_path_name_is_absolute_2 called for non-.NET CLI backend").
+
+:- pragma foreign_proc("C#", dir__dotnet_path_name_is_absolute_2(FileName::in),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"
try {
@@ -373,42 +554,73 @@
%-----------------------------------------------------------------------------%
-dir__make_path_name(DirName, FileName) = PathName :-
+dir__make_path_name(DirName, FileName) = DirName/FileName.
+
+DirName/FileName =
+ ( if
+ (
+ % Check for construction of relative paths of the form "C:foo".
+ use_windows_paths,
+ length(DirName) = 2,
+ char__is_alpha(string__unsafe_index(DirName, 0)),
+ string__unsafe_index(DirName, 1) = (':')
+ ;
+ % Don't introduce duplicate directory separators.
+ % On Windows \\foo (a UNC server specification) is
+ % not equivalent to \foo (the directory X:\foo, where
+ % X is the current drive).
+ string__unsafe_index(DirName,
+ string__length(DirName) - 1) =
+ dir__directory_separator `with_type` char
+ )
+ then
+ DirName ++ FileName
+ else
% Using string__append_list has a fixed overhead of six
% words, whereas using two string__appends back to back
% would have a memory overhead proportional to the size
% of the string copied twice. We prefer the former because
% it is bounded.
- string__append_list([DirName,
- string__char_to_string(dir__directory_separator),
- FileName], PathName).
-
-DirName / FileName = dir__make_path_name(DirName, FileName).
+ string__append_list([DirName,
+ string__char_to_string(dir__directory_separator),
+ FileName])
+ ).
%-----------------------------------------------------------------------------%
dir__make_directory(PathName, Result, !IO) :-
( can_implement_make_directory ->
DirName = dir__dirname(PathName),
- ( DirName = dir__this_directory ->
- ParentAccessResult = ok
- ;
- io__check_file_accessibility(DirName, [],
- ParentAccessResult, !IO)
- ),
- (
- ParentAccessResult = ok,
+ ( PathName = DirName ->
+ % We've been asked to make a root directory --
+ % the mkdir will fail.
dir__make_directory_2(PathName, Result, !IO)
;
- ParentAccessResult = error(_),
- dir__make_directory(DirName, ParentResult, !IO),
- (
- ParentResult = ok,
- dir__make_directory_2(PathName,
- Result, !IO)
+ ( DirName = dir__this_directory ->
+ % Just go ahead and attempt to make the
+ % directory -- if the current directory
+ % is not accessible, the mkdir will fail.
+ dir__make_directory_2(PathName, Result, !IO)
;
- ParentResult = error(_),
- Result = ParentResult
+ io__check_file_accessibility(DirName, [],
+ ParentAccessResult, !IO),
+ (
+ ParentAccessResult = ok,
+ dir__make_directory_2(PathName,
+ Result, !IO)
+ ;
+ ParentAccessResult = error(_),
+ dir__make_directory(DirName,
+ ParentResult, !IO),
+ (
+ ParentResult = ok,
+ dir__make_directory_2(PathName,
+ Result, !IO)
+ ;
+ ParentResult = error(_),
+ Result = ParentResult
+ )
+ )
)
)
;
@@ -416,7 +628,7 @@
"dir.make_directory not implemented on this platform"))
).
-% The .NET library function System.IO.Directory.CreateDirectory()
+% The .NET CLI library function System.IO.Directory.CreateDirectory()
% creates the entire path in one call.
:- pragma foreign_proc("C#",
dir__make_directory(DirName::in, Res::out,
@@ -431,7 +643,7 @@
new System.Exception(""a file with that name already exists""),
ref Res);
} else if (System.IO.Directory.Exists(DirName)) {
- mercury.dir.mercury_code. ML_check_dir_accessibility(DirName,
+ mercury.dir.mercury_code.ML_check_dir_accessibility(DirName,
ref Res);
} else {
System.IO.Directory.CreateDirectory(DirName);
@@ -464,6 +676,10 @@
:- pred dir__make_directory_2(string::in, io__res::out,
io__state::di, io__state::uo) is det.
+:- pragma promise_pure(dir__make_directory_2/4).
+dir__make_directory_2(_::in, _::out, _::di, _::uo) :-
+ private_builtin__sorry("dir__make_directory").
+
:- pragma foreign_proc("C",
dir__make_directory_2(DirName::in, Result::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
@@ -481,14 +697,14 @@
#elif defined(MR_HAVE_MKDIR)
if (mkdir(DirName, 0777) == 0) {
Result = ML_make_mkdir_res_ok();
- # ifdef EEXIST
+ #ifdef EEXIST
} else if (errno == EEXIST) {
ML_make_mkdir_res_exists(errno, DirName, &Result);
- # endif /* EEXIST */
+ #endif /* EEXIST */
} else {
ML_make_mkdir_res_error(errno, &Result);
}
-#else
+#else /* !MR_WIN32 && !MR_HAVE_MKDIR */
MR_fatal_error(""dir.make_directory_2 called but not supported"");
#endif
IO = IO0;
@@ -565,46 +781,31 @@
LoopRes = ok(no),
dir__open(DirName, OpenResult, !IO),
(
- OpenResult = ok({Pos0, FirstEntry}),
+ OpenResult = ok({Dir, FirstEntry}),
- % We need to close the directory if an exception is
- % thrown to avoid resource leaks.
- promise_only_solution_io(
- try_io_det(
- (pred({Res, Pos1, Cont}::out,
- !.IO::di, !:IO::uo) is det :-
- dir__foldl2_process_entries(SymLinkParent,
- P, DirName, ok(FirstEntry), ParentIds,
- Recursive, FollowLinks, Cont,
- T0, Res, Pos0, Pos1, !IO)
- )), ExcpResult, !IO),
- (
- ExcpResult = succeeded({Result1, Pos, Continue0}),
- dir__close(Pos, CloseResult, !IO),
+ % We need to close the directory if an exception is
+ % thrown to avoid resource leaks.
+ Cleanup = dir__close(Dir),
+ exception__finally(
+ (pred({Res, Cont}::out, !.IO::di, !:IO::uo) is det :-
+ dir__foldl2_process_entries(Dir, SymLinkParent,
+ P, DirName, ok(FirstEntry), ParentIds,
+ Recursive, FollowLinks, Cont,
+ T0, Res, !IO)
+ ), {DirRes, Continue}, Cleanup, CleanupRes, !IO),
+ (
+ DirRes = ok(T),
(
- CloseResult = ok,
- Continue = Continue0,
- Result = Result1
+ CleanupRes = ok,
+ Result = DirRes
;
- CloseResult = error(Error),
- Continue = no,
- ( Result1 = ok(_), Result = error(T0, Error)
- ; Result1 = error(_, _), Result = Result1
- )
+ CleanupRes = error(Error),
+ Result = error(T, Error)
)
- ;
- ExcpResult = failed,
- error("dir.foldl2 cannot fail, but it has.")
- ;
- ExcpResult = exception(_),
- % XXX This is a bit dodgy because Pos0 is dead here,
- % but we know dir.read_entry() destructively updates
- % the position, so it should be OK. The position
- % isn't allocated on the Mercury heap, so accurate GC
- % won't move it.
- dir__close(Pos0, _, !IO),
- rethrow(ExcpResult)
- )
+ ;
+ DirRes = error(_, _),
+ Result = DirRes
+ )
;
OpenResult = eof,
Continue = yes,
@@ -631,18 +832,17 @@
make_io_error("dir.foldl2 not implemented on this platform"))
).
-:- pred dir__foldl2_process_entries(bool, dir__foldl_pred(T),
+:- pred dir__foldl2_process_entries(dir__stream, bool, dir__foldl_pred(T),
string, io__result(string), list(file_id), bool, bool,
- bool, T, io__maybe_partial_res(T), dir__pos, dir__pos,
- io__state, io__state).
-:- mode dir__foldl2_process_entries(in, in(dir__foldl_pred),
- in, in, in, in, in, out, in, out, in, out, di, uo) is det.
-
-dir__foldl2_process_entries(_, _, _, error(Error), _, _, _, no,
- T0, error(T0, Error), !Pos, !IO).
-dir__foldl2_process_entries(_, _, _, eof, _, _, _, yes, T0, ok(T0), !Pos, !IO).
-dir__foldl2_process_entries(SymLinkParent, P, DirName, ok(FileName), ParentIds,
- Recursive, FollowLinks, Continue, T0, Res, !Pos, !IO) :-
+ bool, T, io__maybe_partial_res(T), io__state, io__state).
+:- mode dir__foldl2_process_entries(in, in, in(dir__foldl_pred),
+ in, in, in, in, in, out, in, out, di, uo) is det.
+
+dir__foldl2_process_entries(_, _, _, _, error(Error), _, _, _, no,
+ T0, error(T0, Error), !IO).
+dir__foldl2_process_entries(_, _, _, _, eof, _, _, _, yes, T0, ok(T0), !IO).
+dir__foldl2_process_entries(Dir, SymLinkParent, P, DirName, ok(FileName),
+ ParentIds, Recursive, FollowLinks, Continue, T0, Res, !IO) :-
PathName = DirName/FileName,
io__file_type(no, PathName, FileTypeRes, !IO),
(
@@ -674,10 +874,10 @@
Res1 = ok(T1)
),
( Continue2 = yes, Res1 = ok(T) ->
- dir__read_entry(EntryResult, !Pos, !IO),
- dir__foldl2_process_entries(SymLinkParent, P, DirName,
+ dir__read_entry(Dir, EntryResult, !IO),
+ dir__foldl2_process_entries(Dir, SymLinkParent, P, DirName,
EntryResult, ParentIds, Recursive, FollowLinks,
- Continue, T, Res, !Pos, !IO)
+ Continue, T, Res, !IO)
;
Continue = no,
Res = Res1
@@ -730,12 +930,10 @@
#include ""mercury_string.h""
#include ""mercury_types.h""
-#ifdef MR_WIN32
+#if defined(MR_WIN32) && defined(MR_HAVE_WINDOWS_H)
#include <windows.h>
#endif
-/* For realpath */
-#include <stdlib.h>
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
@@ -748,24 +946,21 @@
#include <dirent.h>
#endif
-/* For PATH_MAX */
-#include <limits.h>
-#ifdef MR_HAVE_SYS_PARAM_H
- #include <sys/param.h>
-#endif
-
#if defined(MR_WIN32)
- typedef HANDLE ML_DIR_POS;
+ typedef HANDLE ML_DIR_STREAM;
#elif defined(MR_HAVE_READDIR)
- typedef DIR * ML_DIR_POS;
+ typedef DIR * ML_DIR_STREAM;
#else
- typedef MR_Integer ML_DIR_POS;
+ typedef MR_Integer ML_DIR_STREAM;
#endif
").
-:- type dir__pos ---> dir__pos.
-:- pragma foreign_type("C", dir__pos, "ML_DIR_POS").
-:- pragma foreign_type("il", dir__pos,
+ % A dir__stream should be treated like an io__input_stream,
+ % except using dir__read_entry, rather than io__read_char.
+ % dir__streams must be closed to avoid resource leaks.
+:- type dir__stream ---> dir__stream.
+:- pragma foreign_type("C", dir__stream, "ML_DIR_STREAM").
+:- pragma foreign_type("il", dir__stream,
"class [mscorlib]System.Collections.IEnumerator").
:- pred can_implement_dir_foldl is semidet.
@@ -774,7 +969,8 @@
:- pragma foreign_proc("C", can_implement_dir_foldl,
[will_not_call_mercury, promise_pure, thread_safe],
"
-#if defined(MR_HAVE_OPENDIR) && defined(MR_HAVE_READDIR) && defined(MR_HAVE_CLOSEDIR)
+#if defined(MR_HAVE_OPENDIR) && defined(MR_HAVE_READDIR) && \\
+ defined(MR_HAVE_CLOSEDIR)
SUCCESS_INDICATOR = MR_TRUE;
#elif defined(MR_WIN32)
SUCCESS_INDICATOR = MR_TRUE;
@@ -790,7 +986,7 @@
% Win32 doesn't allow us to open a directory without
% returning the first item.
-:- pred dir__open(string, io__result({dir__pos, string}),
+:- pred dir__open(string, io__result({dir__stream, string}),
io__state, io__state).
:- mode dir__open(in, out, di, uo) is det.
@@ -803,7 +999,7 @@
).
-:- pred dir__open_2(string, io__result({dir__pos, string}),
+:- pred dir__open_2(string, io__result({dir__stream, string}),
io__state, io__state).
:- mode dir__open_2(in, out, di, uo) is det.
@@ -813,7 +1009,7 @@
"{
#if defined(MR_WIN32)
WIN32_FIND_DATA file_data;
- ML_DIR_POS Pos;
+ ML_DIR_STREAM Dir;
LPTSTR FirstFileName;
char *dir_pattern;
int dir_pattern_len;
@@ -822,15 +1018,14 @@
ML_check_dir_readable(DirName, &is_readable, &Result);
if (is_readable) {
dir_pattern_len = strlen(DirName);
- MR_allocate_aligned_string_msg(dir_pattern,
- dir_pattern_len + 2, MR_PROC_LABEL);
+ dir_pattern = MR_malloc(dir_pattern_len + 2);
strcpy(dir_pattern, DirName);
dir_pattern[dir_pattern_len] = '\\\\';
dir_pattern[dir_pattern_len + 1] = '*';
dir_pattern[dir_pattern_len + 2] = '\\0';
- Pos = FindFirstFile(dir_pattern, &file_data);
- if (Pos == INVALID_HANDLE_VALUE) {
+ Dir = FindFirstFile(dir_pattern, &file_data);
+ if (Dir == INVALID_HANDLE_VALUE) {
int error = GetLastError();
if (error = ERROR_NO_MORE_FILES) {
Result = ML_make_dir_open_result_eof();
@@ -838,20 +1033,21 @@
ML_make_dir_open_result_error(error, &Result);
}
} else {
- ML_make_win32_dir_open_result_ok(Pos,
+ ML_make_win32_dir_open_result_ok(Dir,
(MR_Word) file_data.cFileName, &Result);
}
- MR_free_heap(dir_pattern);
+ MR_free(dir_pattern);
}
-#elif defined(MR_HAVE_OPENDIR) && defined(MR_HAVE_READDIR) && defined(MR_HAVE_CLOSEDIR)
- ML_DIR_POS Pos;
+#elif defined(MR_HAVE_OPENDIR) && defined(MR_HAVE_READDIR) && \\
+ defined(MR_HAVE_CLOSEDIR)
+ ML_DIR_STREAM Dir;
- Pos = opendir(DirName);
- if (Pos == NULL) {
+ Dir = opendir(DirName);
+ if (Dir == NULL) {
ML_make_dir_open_result_error(errno, &Result);
} else {
- ML_dir_read_first_entry(Pos, &Result);
+ ML_dir_read_first_entry(Dir, &Result);
}
#else /* !MR_WIN32 && !(MR_HAVE_OPENDIR etc.) */
@@ -865,10 +1061,10 @@
[may_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
try {
- System.Collections.IEnumerator Pos =
+ System.Collections.IEnumerator Dir =
System.IO.Directory.GetFileSystemEntries(DirName).
GetEnumerator();
- mercury.dir.mercury_code.ML_dir_read_first_entry(Pos,
+ mercury.dir.mercury_code.ML_dir_read_first_entry(Dir,
ref Result);
} catch (System.Exception e) {
mercury.dir.mercury_code.ML_make_dir_open_result_error(e,
@@ -876,7 +1072,7 @@
}
}").
-:- pred dir__check_dir_readable(string, int, io__result({dir__pos, string}),
+:- pred dir__check_dir_readable(string, int, io__result({dir__stream, string}),
io__state, io__state).
:- mode dir__check_dir_readable(in, out, out, di, uo) is det.
:- pragma export(dir__check_dir_readable(in, out, out, di, uo),
@@ -911,62 +1107,64 @@
Result = error(Msg)
).
-:- pred dir__read_first_entry(dir__pos, io__result({dir__pos, string}),
+:- pred dir__read_first_entry(dir__stream, io__result({dir__stream, string}),
io__state, io__state).
:- mode dir__read_first_entry(in, out, di, uo) is det.
:- pragma export(dir__read_first_entry(in, out, di, uo),
"ML_dir_read_first_entry").
-dir__read_first_entry(Pos0, Result, !IO) :-
- dir__read_entry(EntryResult, Pos0, Pos, !IO),
+dir__read_first_entry(Dir, Result, !IO) :-
+ dir__read_entry(Dir, EntryResult, !IO),
(
EntryResult = ok(FirstEntry),
- Result = ok({Pos, FirstEntry})
+ Result = ok({Dir, FirstEntry})
;
EntryResult = eof,
- dir__close(Pos, CloseResult, !IO),
- ( CloseResult = ok, Result = eof
- ; CloseResult = error(Msg), Result = error(Msg)
- )
+ Result = eof
;
EntryResult = error(Msg),
Result = error(Msg)
).
-:- pred make_win32_dir_open_result_ok(dir__pos::in, c_pointer::in,
- io__result({dir__pos, string})::out,
+:- pred make_win32_dir_open_result_ok(dir__stream::in, c_pointer::in,
+ io__result({dir__stream, string})::out,
io__state::di, io__state::uo) is det.
:- pragma export(make_win32_dir_open_result_ok(in, in, out, di, uo),
"ML_make_win32_dir_open_result_ok").
-make_win32_dir_open_result_ok(Pos0, FirstFilePtr, Result, !IO) :-
+make_win32_dir_open_result_ok(Dir, FirstFilePtr, Result, !IO) :-
FirstFile0 = copy_c_string(FirstFilePtr),
(
( FirstFile0 = dir__this_directory
; FirstFile0 = dir__parent_directory
)
->
- dir__read_entry(ReadResult, Pos0, Pos, !IO),
+ dir__read_entry(Dir, ReadResult, !IO),
(
ReadResult = ok(FirstFile),
- Result = ok({Pos, FirstFile})
+ Result = ok({Dir, FirstFile})
;
ReadResult = eof,
- dir__close(Pos, CloseRes, !IO),
+ dir__close(Dir, CloseRes, !IO),
( CloseRes = ok, Result = eof
; CloseRes = error(Error), Result = error(Error)
)
;
ReadResult = error(Error),
- dir__close(Pos, _, !IO),
+ dir__close(Dir, _, !IO),
Result = error(Error)
)
;
- Result = ok({Pos0, FirstFile0})
+ Result = ok({Dir, FirstFile0})
).
% This is needed because the heap pointer is not valid in
- % the may_call_mercury foreign proc for dir.open_2.
+ % the `may_call_mercury' foreign proc for dir.open_2.
+ % Instead, we pass it as a c_pointer to copy_c_string,
+ % which doesn't call Mercury, so the heap pointer is valid.
+ % Passing it as a c_pointer avoids having the accurate
+ % garbage collector attempt to copy a potentially unaligned
+ % string.
:- func copy_c_string(c_pointer) = string.
copy_c_string(_) = _ :-
error(
@@ -977,14 +1175,14 @@
"MR_make_aligned_string_copy(Str, (char *) Ptr);").
-:- func make_dir_open_result_eof = io__result({dir__pos, string}).
+:- func make_dir_open_result_eof = io__result({dir__stream, string}).
:- pragma export((make_dir_open_result_eof = out),
"ML_make_dir_open_result_eof").
make_dir_open_result_eof = eof.
:- pred make_dir_open_result_error(io__system_error::in,
- io__result({dir__pos, string})::out,
+ io__result({dir__stream, string})::out,
io__state::di, io__state::uo) is det.
:- pragma export(make_dir_open_result_error(in, out, di, uo),
"ML_make_dir_open_result_error").
@@ -992,11 +1190,11 @@
make_dir_open_result_error(Error, error(io__make_io_error(Msg))) -->
io__make_err_msg(Error, "dir.foldl2: opening directory failed: ", Msg).
-:- pred dir__close(dir__pos, io__res, io__state, io__state).
+:- pred dir__close(dir__stream, io__res, io__state, io__state).
:- mode dir__close(in, out, di, uo) is det.
-dir__close(Pos, Res, !IO) :-
- dir__close_2(Pos, Status, Error, !IO),
+dir__close(Dir, Res, !IO) :-
+ dir__close_2(Dir, Status, Error, !IO),
( Status = 0 ->
io__make_maybe_win32_err_msg(Error,
"dir.foldl2: closing directory failed: ", Msg, !IO),
@@ -1005,19 +1203,19 @@
Res = ok
).
-:- pred dir__close_2(dir__pos, int, io__system_error, io__state, io__state).
+:- pred dir__close_2(dir__stream, int, io__system_error, io__state, io__state).
:- mode dir__close_2(in, out, out, di, uo) is det.
:- pragma foreign_proc("C",
- dir__close_2(Pos::in, Status::out, Error::out, IO0::di, IO::uo),
+ dir__close_2(Dir::in, Status::out, Error::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
IO = IO0;
#if defined(MR_WIN32)
- Status = FindClose(Pos);
+ Status = FindClose(Dir);
Error = GetLastError();
#elif defined(MR_HAVE_CLOSEDIR)
- Status = (closedir(Pos) == 0);
+ Status = (closedir(Dir) == 0);
Error = errno;
#else
MR_fatal_error(""dir.open called but not supported"");
@@ -1025,7 +1223,7 @@
}").
:- pragma foreign_proc("C#",
- dir__close_2(_Pos::in, Status::out, Error::out, _IO0::di, _IO::uo),
+ dir__close_2(_Dir::in, Status::out, Error::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
/* Nothing to do. */
@@ -1033,12 +1231,11 @@
Status = 1;
}").
-:- pred dir__read_entry(io__result(string),
- dir__pos, dir__pos, io__state, io__state).
-:- mode dir__read_entry(out, in, out, di, uo) is det.
+:- pred dir__read_entry(dir__stream, io__result(string), io__state, io__state).
+:- mode dir__read_entry(in, out, di, uo) is det.
-dir__read_entry(Res, !Pos, !IO) :-
- dir__read_entry_2(Status, Error, FileName, !Pos, !IO),
+dir__read_entry(Dir, Res, !IO) :-
+ dir__read_entry_2(Dir, Status, Error, FileName, !IO),
(
Status = 0
->
@@ -1054,28 +1251,27 @@
; FileName = dir__parent_directory
)
->
- dir__read_entry(Res, !Pos, !IO)
+ dir__read_entry(Dir, Res, !IO)
;
Res = ok(FileName)
).
- % dir__read_entry(Status, Error, FileName, !Pos, !IO).
+ % dir__read_entry_2(Dir, Status, Error, FileName, !IO).
% Status is -1 for EOF, 0 for error, 1 for success.
-:- pred dir__read_entry_2(int, io__system_error, string, dir__pos, dir__pos,
+:- pred dir__read_entry_2(dir__stream, int, io__system_error, string,
io__state, io__state).
-:- mode dir__read_entry_2(out, out, out, in, out, di, uo) is det.
+:- mode dir__read_entry_2(in, out, out, out, di, uo) is det.
:- pragma foreign_proc("C",
- dir__read_entry_2(Status::out, Error::out, FileName::out,
- Pos0::in, Pos::out, IO0::di, IO::uo),
+ dir__read_entry_2(Dir::in, Status::out, Error::out, FileName::out,
+ IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
#if defined(MR_WIN32)
WIN32_FIND_DATA file_data;
- Pos = Pos0;
IO = IO0;
- if (FindNextFile(Pos, &file_data)) {
+ if (FindNextFile(Dir, &file_data)) {
Status = 1;
MR_make_aligned_string_copy(FileName,
file_data.cFileName);
@@ -1088,10 +1284,9 @@
#elif defined(MR_HAVE_READDIR) && defined(MR_HAVE_CLOSEDIR)
struct dirent *dir_entry;
- Pos = Pos0;
IO = IO0;
errno = 0;
- dir_entry = readdir(Pos);
+ dir_entry = readdir(Dir);
if (dir_entry == NULL) {
Error = errno;
FileName = NULL;
@@ -1109,17 +1304,16 @@
}").
:- pragma foreign_proc("C#",
- dir__read_entry_2(Status::out, Error::out, FileName::out,
- Pos0::in, Pos::out, _IO0::di, _IO::uo),
+ dir__read_entry_2(Dir::in, Status::out, Error::out, FileName::out,
+ _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
- Pos = Pos0;
try {
- if (Pos.MoveNext()) {
- // .NET returns path names qualified with
+ if (Dir.MoveNext()) {
+ // The .NET CLI returns path names qualified with
// the directory name passed to dir.open.
FileName = System.IO.Path.GetFileName(
- (string) Pos.Current);
+ (string) Dir.Current);
Status = 1;
} else {
FileName = null;
@@ -1128,7 +1322,6 @@
Error = null;
} catch (System.Exception e) {
Error = e;
- Pos = null;
FileName = null;
Status = 0;
}
diff -u library/exception.m library/exception.m
--- library/exception.m
+++ library/exception.m
@@ -174,6 +174,24 @@
:- func rethrow(exception_result(T)) = _.
:- mode rethrow(in(bound(exception(ground)))) = out is erroneous.
+%
+% finally(P, PRes, Cleanup, CleanupRes, IO0, IO).
+% Call P and ensure that Cleanup is called afterwards,
+% no matter whether P succeeds or throws an exception.
+% PRes is bound to the output of P.
+% CleanupRes is bound to the output of Cleanup.
+% A exception thrown by P will be rethrown after Cleanup
+% is called, unless Cleanup throws an exception.
+% This predicate performs the same function as the `finally'
+% clause (`try {...} finally {...}') in languages such as Java.
+:- pred finally(pred(T, io__state, io__state), T,
+ pred(io__res, io__state, io__state), io__res,
+ io__state, io__state).
+:- mode finally(pred(out, di, uo) is det, out,
+ pred(out, di, uo) is det, out, di, uo) is det.
+:- mode finally(pred(out, di, uo) is cc_multi, out,
+ pred(out, di, uo) is cc_multi, out, di, uo) is cc_multi.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -307,6 +325,63 @@
rethrow(ExceptionResult) = _ :-
rethrow(ExceptionResult).
+:- pragma promise_pure(finally/6).
+finally(P::(pred(out, di, uo) is det), PRes::out,
+ Cleanup::(pred(out, di, uo) is det), CleanupRes::out,
+ !.IO::di, !:IO::uo) :-
+ promise_only_solution_io(
+ (pred(Res::out, !.IO::di, !:IO::uo) is cc_multi :-
+ finally_2(P, Cleanup, Res, !IO)
+ ), {PRes, CleanupRes}, !IO).
+finally(P::(pred(out, di, uo) is cc_multi), PRes::out,
+ Cleanup::(pred(out, di, uo) is cc_multi), CleanupRes::out,
+ !.IO::di, !:IO::uo) :-
+ finally_2(P, Cleanup, {PRes, CleanupRes}, !IO).
+
+:- pred finally_2(pred(T, io__state, io__state),
+ pred(io__res, io__state, io__state), {T, io__res},
+ io__state, io__state).
+:- mode finally_2(pred(out, di, uo) is det,
+ pred(out, di, uo) is det, out, di, uo) is cc_multi.
+:- mode finally_2(pred(out, di, uo) is cc_multi,
+ pred(out, di, uo) is cc_multi, out, di, uo) is cc_multi.
+
+finally_2(P, Cleanup, {PRes, CleanupRes}, !IO) :-
+ try_io(P, ExcpResult, !IO),
+ (
+ ExcpResult = succeeded(PRes),
+ Cleanup(CleanupRes, !IO)
+ ;
+ ExcpResult = exception(_),
+ Cleanup(_, !IO),
+ % The io__state resulting from Cleanup can't
+ % possibly be used, so we have to trick the
+ % compiler into not removing the call.
+ ( use(!.IO) ->
+ rethrow(ExcpResult)
+ ;
+ error("exception.finally_2")
+ )
+ ).
+
+:- pred use(T).
+:- mode use(in) is semidet.
+
+:- pragma foreign_proc("C",
+ use(_T::in),
+ [will_not_call_mercury, promise_pure, thread_safe],
+ "SUCCESS_INDICATOR = MR_TRUE;").
+:- pragma foreign_proc("C#",
+ use(_T::in),
+ [will_not_call_mercury, promise_pure, thread_safe],
+ "SUCCESS_INDICATOR = true;").
+:- pragma foreign_proc("Java",
+ use(_T::in),
+ [will_not_call_mercury, promise_pure, thread_safe],
+ "SUCCESS_INDICATOR = true;").
+
+%-----------------------------------------------------------------------------%
+
:- pred wrap_success(pred(T), exception_result(T)) is det.
:- mode wrap_success(pred(out) is det, out) is det.
:- mode wrap_success(pred(out) is semidet, out) is semidet.
diff -u library/io.m library/io.m
--- library/io.m
+++ library/io.m
@@ -1159,9 +1159,12 @@
% io__make_temp(Name, IO0, IO) creates an empty file
% whose name which is different to the name of any existing file.
% Name is bound to the name of the file.
- % The file will reside in /tmp if the TMPDIR environment variable
- % is not set, or in the directory specified by TMPDIR if it
- % is set.
+ % On Microsoft Windows systems, the file will reside in the current
+ % directory if the TMP environment variable is not set, or in the
+ % directory specified by TMP if it is set.
+ % On other systems, the file will reside in /tmp if the TMPDIR
+ % environment variable is not set, or in the directory specified
+ % by TMPDIR if it is set.
% It is the responsibility of the program to delete the file
% when it is no longer needed.
@@ -1196,18 +1199,23 @@
% deleted and replaced with the file previously named `OldFileName'.
:- pred io__have_symlinks is semidet.
- % Does the platform support symbolic links.
+ % Can this platform read and create symbolic links.
:- pred io__make_symlink(string, string, io__res, io__state, io__state).
:- mode io__make_symlink(in, in, out, di, uo) is det.
% io__make_symlink(FileName, LinkFileName, Result, IO0, IO)
% attempts to make `LinkFileName' be a symbolic link to `FileName'.
+ % If `FileName' is a relative path, it is interpreted relative
+ % to the directory containing `LinkFileName'.
-:- pred io__follow_symlink(string, io__res(string), io__state, io__state).
-:- mode io__follow_symlink(in, out, di, uo) is det.
- % io__follow_symlink(FileName, Result, IO0, IO) returns
- % `ok(LinkTarget)' if FileName is a symbolic link pointing
- % to LinkTarget, and `error(Error)' otherwise.
+:- pred io__read_symlink(string, io__res(string), io__state, io__state).
+:- mode io__read_symlink(in, out, di, uo) is det.
+ % io__read_symlink(FileName, Result, IO0, IO) returns
+ % `ok(LinkTarget)' if `FileName' is a symbolic link pointing
+ % to `LinkTarget', and `error(Error)' otherwise.
+ % If `LinkTarget' is a relative path, it should be interpreted
+ % relative the directory containing `FileName', not the current
+ % directory.
:- type io__access_type
---> read
@@ -1219,7 +1227,10 @@
io__res, io__state, io__state).
:- mode io__check_file_accessibility(in, in, out, di, uo) is det.
% io__check_file_accessibility(FileName, AccessTypes, Result)
- % Check whether the current user can access the given file.
+ % Check whether the current process can perform the operations
+ % given in `AccessTypes' on `FileName'.
+ % XXX When using the .NET CLI, this predicate will sometimes
+ % report that a directory is writable when in fact it is not.
:- type io__file_type
---> regular_file
@@ -1239,18 +1250,12 @@
:- mode io__file_type(in, in, out, di, uo) is det.
% io__file_type(FollowSymLinks, FileName, TypeResult)
% finds the type of the given file.
- % This predicate will only work on systems which provide
- % the POSIX C library function stat(). On other systems the
- % returned result will always be bound to error/1.
:- pred io__file_modification_time(string, io__res(time_t),
io__state, io__state).
:- mode io__file_modification_time(in, out, di, uo) is det.
% io__file_modification_time(FileName, TimeResult)
% finds the last modification time of the given file.
- % This predicate will only work on systems which provide
- % the POSIX C library function stat(). On other systems the
- % returned result will always be bound to error/1.
%-----------------------------------------------------------------------------%
@@ -1406,8 +1411,7 @@
% For use by dir.m:
% A system-dependent error indication.
- % For C, this is the value of errno or the result of
- % GetLastError() on Win32.
+ % For C, this is the value of errno.
:- type io__system_error.
:- pragma foreign_type(c, io__system_error, "MR_Integer").
:- pragma foreign_type(il, io__system_error,
@@ -1448,10 +1452,15 @@
% io__file_id(FileName, FileId).
%
-% Return a unique identifier for the given file.
+% Return a unique identifier for the given file (after following
+% symlinks in FileName).
% XXX On Cygwin sometimes two files will have the same file_id.
% This is because MS-Windows does not use inodes, so Cygwin
% hashes the absolute file name.
+% On Windows without Cygwin this will always return error(_).
+% That doesn't matter, because this function is only used for
+% checking for symlink loops in dir.foldl2, but plain Windows
+% doesn't support symlinks.
:- type file_id.
:- pred io__file_id(string, io__res(file_id), io__state, io__state).
:- mode io__file_id(in, out, di, uo) is det.
@@ -1507,7 +1516,7 @@
:- implementation.
:- import_module map, dir, term, term_io, varset, require, benchmarking, array.
-:- import_module bool, int, parser, exception.
+:- import_module bool, enum, int, parser, exception.
:- use_module table_builtin.
:- use_module rtti_implementation.
@@ -2364,9 +2373,9 @@
stat_result = stat(FileName, &s);
} else {
#ifdef MR_HAVE_LSTAT
- stat_result = lstat(FileName, &s);
+ stat_result = lstat(FileName, &s);
#else
- stat_result = stat(FileName, &s);
+ stat_result = stat(FileName, &s);
#endif
}
@@ -2374,96 +2383,96 @@
MR_Word type;
#if defined(S_ISREG)
- if (S_ISREG(s.st_mode)) {
- type = ML_file_type_regular();
- } else
+ if (S_ISREG(s.st_mode)) {
+ type = ML_file_type_regular();
+ } else
#elif defined(S_IFMT) && defined(S_IFREG)
- if ((s.st_mode & S_IFMT) == S_IFREG) {
- type = ML_file_type_regular();
- } else
+ if ((s.st_mode & S_IFMT) == S_IFREG) {
+ type = ML_file_type_regular();
+ } else
#endif
#if defined(S_ISDIR)
- if (S_ISDIR(s.st_mode)) {
- type = ML_file_type_directory();
- } else
+ if (S_ISDIR(s.st_mode)) {
+ type = ML_file_type_directory();
+ } else
#elif defined(S_IFMT) && defined(S_IFDIR)
- if ((s.st_mode & S_IFMT) == S_IFDIR) {
- type = ML_file_type_directory();
- } else
+ if ((s.st_mode & S_IFMT) == S_IFDIR) {
+ type = ML_file_type_directory();
+ } else
#endif
#if defined(S_ISBLK)
- if (S_ISBLK(s.st_mode)) {
- type = ML_file_type_block_device();
- } else
+ if (S_ISBLK(s.st_mode)) {
+ type = ML_file_type_block_device();
+ } else
#elif defined(S_IFMT) && defined(S_IFBLK)
- if ((s.st_mode & S_IFMT) == S_IFBLK) {
- type = ML_file_type_block_device();
- } else
+ if ((s.st_mode & S_IFMT) == S_IFBLK) {
+ type = ML_file_type_block_device();
+ } else
#endif
#if defined(S_ISCHR)
- if (S_ISCHR(s.st_mode)) {
- type = ML_file_type_character_device();
- } else
+ if (S_ISCHR(s.st_mode)) {
+ type = ML_file_type_character_device();
+ } else
#elif defined(S_IFMT) && defined(S_IFCHR)
- if ((s.st_mode & S_IFMT) == S_IFCHR) {
- type = ML_file_type_character_device();
- } else
+ if ((s.st_mode & S_IFMT) == S_IFCHR) {
+ type = ML_file_type_character_device();
+ } else
#endif
#if defined(S_ISFIFO)
- if (S_ISFIFO(s.st_mode)) {
- type = ML_file_type_fifo();
- } else
+ if (S_ISFIFO(s.st_mode)) {
+ type = ML_file_type_fifo();
+ } else
#elif defined(S_IFMT) && defined(S_IFIFO)
- if ((s.st_mode & S_IFMT) == S_IFIFO) {
- type = ML_file_type_fifo();
- } else
+ if ((s.st_mode & S_IFMT) == S_IFIFO) {
+ type = ML_file_type_fifo();
+ } else
#endif
#if defined(S_ISLNK)
- if (S_ISLNK(s.st_mode)) {
- type = ML_file_type_symbolic_link();
- } else
+ if (S_ISLNK(s.st_mode)) {
+ type = ML_file_type_symbolic_link();
+ } else
#elif defined(S_IFMT) && defined(S_IFLNK)
- if ((s.st_mode & S_IFMT) == S_IFLNK) {
- type = ML_file_type_symbolic_link();
- } else
+ if ((s.st_mode & S_IFMT) == S_IFLNK) {
+ type = ML_file_type_symbolic_link();
+ } else
#endif
#if defined(S_ISSOCK)
- if (S_ISSOCK(s.st_mode)) {
- type = ML_file_type_socket();
- } else
+ if (S_ISSOCK(s.st_mode)) {
+ type = ML_file_type_socket();
+ } else
#elif defined(S_IFMT) && defined(S_IFSOCK)
- if ((s.st_mode & S_IFMT) == S_IFSOCK) {
- type = ML_file_type_socket();
- } else
+ if ((s.st_mode & S_IFMT) == S_IFSOCK) {
+ type = ML_file_type_socket();
+ } else
#endif
#ifdef S_TYPEISMQ
- if (S_TYPEISMQ(&s)) {
- type = ML_file_type_message_queue();
- } else
+ if (S_TYPEISMQ(&s)) {
+ type = ML_file_type_message_queue();
+ } else
#endif
#ifdef S_TYPEISSEM
- if (S_TYPEISSEM(&s)) {
- type = ML_file_type_semaphore();
- } else
+ if (S_TYPEISSEM(&s)) {
+ type = ML_file_type_semaphore();
+ } else
#endif
#ifdef S_TYPEISSHM
- if (S_TYPEISSHM(&s)) {
- type = ML_file_type_shared_memory();
- } else
+ if (S_TYPEISSHM(&s)) {
+ type = ML_file_type_shared_memory();
+ } else
#endif
- {
- type = ML_file_type_unknown();
- }
+ {
+ type = ML_file_type_unknown();
+ }
Result = ML_make_io_res_1_ok_file_type(type);
} else {
@@ -2554,8 +2563,20 @@
%-----------------------------------------------------------------------------%
+io__check_file_accessibility(FileName, AccessTypes, Result) -->
+ ( { have_dotnet } ->
+ io__check_file_accessibility_dotnet(FileName, AccessTypes,
+ Result)
+ ;
+ io__check_file_accessibility_2(FileName, AccessTypes, Result)
+ ).
+
+:- pred io__check_file_accessibility_2(string, list(access_type),
+ io__res, io__state, io__state).
+:- mode io__check_file_accessibility_2(in, in, out, di, uo) is det.
+
:- pragma foreign_proc("C",
- io__check_file_accessibility(FileName::in, AccessTypes::in,
+ io__check_file_accessibility_2(FileName::in, AccessTypes::in,
Result::out, IO0::di, IO::uo),
[may_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
@@ -2605,60 +2626,145 @@
IO = IO0;
}").
-:- pragma foreign_decl("MC++",
-"
-#include <io.h> /* for access() */
-#include <errno.h>
-#include <string.h> /* for strerror() */
+ % The .NET CLI doesn't provide an equivalent of access(), so
+ % we have to try to open the file to see if it is accessible.
+:- pred io__check_file_accessibility_dotnet(string::in, list(access_type)::in,
+ io__res::out, io__state::di, io__state::uo) is det.
+
+io__check_file_accessibility_dotnet(FileName, AccessTypes, Result, !IO) :-
+ CheckRead0 = pred_to_bool(access_types_includes_read(AccessTypes)),
+ CheckWrite = pred_to_bool(access_types_includes_write(AccessTypes)),
+
+ CheckExec = pred_to_bool(access_types_includes_execute(AccessTypes)),
+ % We need to be able to read a file to execute it.
+ CheckRead = bool__or(CheckRead0, CheckExec),
-").
+ io__file_type(yes, FileName, FileTypeRes, !IO),
+ (
+ FileTypeRes = ok(FileType),
+ ( FileType = directory ->
+ check_directory_accessibility_dotnet(FileName,
+ to_int(CheckRead), to_int(CheckWrite),
+ Result, !IO)
+ ;
+ ( CheckRead = yes ->
+ io__open_input(FileName, InputRes, !IO),
+ (
+ InputRes = ok(InputStream),
+ io__close_input(InputStream, !IO),
+ CheckReadRes = ok
+ ;
+ InputRes = error(InputError),
+ CheckReadRes = error(InputError)
+ )
+ ;
+ CheckReadRes = ok
+ ),
+ ( CheckReadRes = ok, CheckWrite = yes ->
+ io__open_append(FileName, OutputRes, !IO),
+ (
+ OutputRes = ok(OutputStream),
+ io__close_output(OutputStream, !IO),
+ CheckWriteRes = ok
+ ;
+ OutputRes = error(OutputError),
+ CheckWriteRes = error(OutputError)
+ )
+ ;
+ CheckWriteRes = CheckReadRes
+ ),
+ (
+ CheckWriteRes = ok,
+
+ % Unix programs need to check whether the
+ % execute bit is set for the directory, but
+ % we can't actually execute the directory.
+ FileType \= directory,
+ CheckExec = yes
+ ->
+ have_dotnet_exec_permission(Result, !IO)
+ ;
+ Result = CheckWriteRes
+ )
+ )
+ ;
+ FileTypeRes = error(FileTypeError),
+ Result = error(FileTypeError)
+ ).
-% The .NET class library doesn't provide any way to check the
-% accessibility of a file without opening it, so instead we
-% use the POSIX access() function, which is also supported by
-% Windows.
-% We use MC++ here rather than C# because it's easier to
-% access system functions (it would be difficult to access
-% `errno' from C#).
-:- pragma foreign_proc("MC++",
- io__check_file_accessibility(FileName::in, AccessTypes::in,
- Result::out, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe],
+:- pred have_dotnet_exec_permission(io__res, io__state, io__state).
+:- mode have_dotnet_exec_permission(out, di, uo) is det.
+
+have_dotnet_exec_permission(_, !IO) :-
+ error(
+ "io.have_dotnet_exec_permission invoked for non-.NET CLI backend").
+
+:- pragma foreign_proc("C#",
+ have_dotnet_exec_permission(Result::out, _IO0::di, _IO::uo),
+ [promise_pure, may_call_mercury, thread_safe],
"{
- int mode = 0;
+ try {
+ // We need unrestricted permissions to execute
+ // unmanaged code.
+ (new System.Security.Permissions.SecurityPermission(
+ System.Security.Permissions.SecurityPermissionFlag.AllFlags)).
+ Demand();
+ Result = mercury.io.mercury_code.ML_make_io_res_0_ok();
+ } catch (System.Exception e) {
+ mercury.io.mercury_code.ML_make_io_res_0_error(e,
+ ""execute permission check failed: "", ref Result);
+ }
- if (mercury::io::mercury_code::ML_access_types_includes_execute(
- AccessTypes))
- {
- mode |= 1;
- }
- if (mercury::io::mercury_code::ML_access_types_includes_write(
- AccessTypes))
- {
- mode |= 2;
- }
- if (mercury::io::mercury_code::ML_access_types_includes_read(
- AccessTypes))
- {
- mode |= 4;
- }
+}").
- char __nogc *c_filename = static_cast<char*>(
- System::Runtime::InteropServices::Marshal::
- StringToHGlobalAnsi(FileName).ToPointer());
+:- pred check_directory_accessibility_dotnet(string::in, int::in, int::in,
+ io__res::out, io__state::di, io__state::uo) is det.
- int access_result = access(c_filename, mode);
- System::Runtime::InteropServices::Marshal::FreeCoTaskMem(c_filename);
- if (access_result == 0) {
- Result = mercury::io::mercury_code::ML_make_io_res_0_ok();
- } else {
- char __nogc *error_string = strerror(errno);
- System::String *error_msg =
- System::Runtime::InteropServices::Marshal::PtrToStringAnsi(
- static_cast<System::IntPtr>(error_string));
- Result = mercury::io::mercury_code::ML_make_io_res_0_error_msg(
- System::String::Concat(""file not accessible: "",
- error_msg));
+check_directory_accessibility_dotnet(_, _, _, _, _, _) :-
+ error(
+"io.check_directory_accessibility_dotnet called for non-.NET CLI backend").
+
+:- pragma foreign_proc("C#",
+ check_directory_accessibility_dotnet(FileName::in, CheckRead::in,
+ CheckWrite::in, Result::out, _IO0::di, _IO::uo),
+ [promise_pure, may_call_mercury, tabled_for_io, thread_safe],
+"{
+ try {
+ if (CheckRead != 0) {
+ // XXX This is less efficient than I would like.
+ // Unfortunately the .NET CLI has no function
+ // corresponding to access() or opendir().
+ System.IO.Directory.GetFileSystemEntries(FileName);
+ }
+ if (CheckWrite != 0) {
+ // This will fail if the .NET CLI security regime
+ // we're operating under doesn't allow writing
+ // to the file. Even if this succeeds, the file
+ // system may disallow write access.
+ System.IO.Directory.SetLastAccessTime(FileName,
+ System.DateTime.Now);
+
+ // XXX This isn't quite right.
+ // Just because the directory isn't read-only
+ // doesn't mean we have permission to write to it.
+ // The only way to test whether a directory is
+ // writable is to write a file to it.
+ // The ideal way to do that would be io__make_temp,
+ // but currently the .NET backend version of that
+ // ignores the directory passed to it.
+ System.IO.FileAttributes attrs =
+ System.IO.File.GetAttributes(FileName);
+ if ((attrs & System.IO.FileAttributes.ReadOnly) ==
+ System.IO.FileAttributes.ReadOnly)
+ {
+ throw (new
+ System.Exception(""file is read-only""));
+ }
+ }
+ Result = mercury.io.mercury_code.ML_make_io_res_0_ok();
+ } catch (System.Exception e) {
+ mercury.io.mercury_code.ML_make_io_res_0_error(e,
+ ""permission check failed: "", ref Result);
}
}").
@@ -2708,7 +2814,6 @@
%-----------------------------------------------------------------------------%
-% Can we retrieve inodes on this system.
:- type file_id
---> file_id(device :: int, inode :: int).
@@ -2752,11 +2857,12 @@
#endif
}").
+% Can we retrieve inode numbers on this system.
have_file_ids :- semidet_fail.
:- pragma foreign_proc("C", have_file_ids,
[promise_pure, will_not_call_mercury, thread_safe],
"
-#if defined(MR_WIN32) || !defined(MR_HAVE_STAT)
+#if defined(MR_BROKEN_STAT_ST_INO) || !defined(MR_HAVE_STAT)
/* Win32 returns junk in the st_ino field of `struct stat'. */
SUCCESS_INDICATOR = MR_FALSE;
#else
@@ -4469,7 +4575,7 @@
stream = System::IO::File::Open(filename, mode, access, share);
- } catch (System::IO::IOException* e) {
+ } catch (System::Exception* e) {
MR_io_exception = e;
}
@@ -6250,13 +6356,14 @@
% We need to do an explicit check of TMPDIR because not all
% systems check TMPDIR for us (eg Linux #$%*@&).
io__make_temp(Name) -->
- io__get_environment_var("TMPDIR", Result),
+ { Var = ( dir__use_windows_paths -> "TMP" ; "TMPDIR" ) },
+ io__get_environment_var(Var, Result),
(
{ Result = yes(Dir) }
;
{ Result = no },
{ dir__use_windows_paths ->
- Dir = "C:\\windows\\temp"
+ Dir = dir__this_directory
;
Dir = "/tmp"
}
@@ -6472,7 +6579,7 @@
**
** WARNING: this must only be called when the `hp' register is valid.
** That means it must only be called from procedures declared
-** `[will_not_call_mercury, promise_pure]'.
+** `[will_not_call_mercury]'.
**
** This is defined as a macro rather than a C function
** to avoid worrying about the `hp' register being
@@ -6660,26 +6767,26 @@
MR_update_io(IO0, IO);
}").
-io__follow_symlink(FileName, Result) -->
+io__read_symlink(FileName, Result) -->
( { io__have_symlinks } ->
- io__follow_symlink_2(FileName, TargetFileName, Status, Error),
+ io__read_symlink_2(FileName, TargetFileName, Status, Error),
( { Status = 0 } ->
io__make_err_msg(Error,
- "io.follow_symlink failed: ", Msg),
+ "io.read_symlink failed: ", Msg),
{ Result = error(make_io_error(Msg)) }
;
{ Result = ok(TargetFileName) }
)
;
{ Result = error(make_io_error(
- "io.follow_symlink not supported on this platform")) }
+ "io.read_symlink not supported on this platform")) }
).
-:- pred io__follow_symlink_2(string::in, string::out, int::out,
+:- pred io__read_symlink_2(string::in, string::out, int::out,
io__system_error::out, io__state::di, io__state::uo) is det.
:- pragma foreign_proc("C",
- io__follow_symlink_2(FileName::in, TargetFileName::out,
+ io__read_symlink_2(FileName::in, TargetFileName::out,
Status::out, Error::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
@@ -6696,33 +6803,21 @@
num_chars = readlink(FileName, buffer, PATH_MAX);
if (num_chars == PATH_MAX) {
- while (1) {
+ do {
buffer_size2 *= 2;
- if (buffer2 != NULL) {
- MR_free(buffer2);
- }
- buffer2 = MR_NEW_ARRAY(char, buffer_size2);
+ buffer2 = MR_RESIZE_ARRAY(buffer2, char, buffer_size2);
num_chars = readlink(FileName, buffer2, PATH_MAX);
- if (num_chars == buffer_size2) {
- MR_free(buffer2);
- buffer2 = NULL;
- continue;
- } else if (num_chars == -1) {
- Error = errno;
- MR_free(buffer2);
- buffer2 = NULL;
- TargetFileName = MR_make_string_const("""");
- Status = 0;
- break;
- } else {
- buffer2[num_chars] = '\\0';
- MR_make_aligned_string_copy(TargetFileName,
- buffer2);
- MR_free(buffer2);
- buffer2 = NULL;
- Status = 1;
- }
+ } while (num_chars == buffer_size2);
+ if (num_chars == -1) {
+ Error = errno;
+ TargetFileName = MR_make_string_const("""");
+ Status = 0;
+ } else {
+ buffer2[num_chars] = '\\0';
+ MR_make_aligned_string_copy(TargetFileName, buffer2);
+ Status = 1;
}
+ MR_free(buffer2);
} else if (num_chars == -1) {
TargetFileName = MR_make_string_const("""");
Error = errno;
only in patch2:
--- runtime/mercury_conf_param.h 12 Jun 2003 15:38:26 -0000 1.71
+++ runtime/mercury_conf_param.h 24 Jun 2003 16:15:20 -0000
@@ -693,12 +693,16 @@
** MR_WIN32_GETSYSTEMINFO -- Is GetSystemInfo() available?
**
** MR_WIN32_VIRTUAL_ALLOC -- Is VirtualAlloc() available?
+**
+** MR_BROKEN_ST_INO - Is the st_ino field of `struct stat' junk.
+** Windows doesn't fill in this field correctly.
*/
#if _WIN32
#define MR_WIN32
#define MR_WIN32_GETSYSTEMINFO
#define MR_WIN32_VIRTUAL_ALLOC
#define MR_WIN32_GETPROCESSTIMES
+ #define MR_BROKEN_ST_INO
#endif
/*---------------------------------------------------------------------------*/
--- tests/hard_coded/dir_test.m.old 2003-07-14 22:59:08.000000000 +1000
+++ tests/hard_coded/dir_test.m 2003-07-13 20:29:02.000000000 +1000
@@ -14,32 +14,26 @@
io__write_string("Directory separator is '"),
io__write_char(dir__directory_separator),
io__write_string("'.\n"),
- ( { dir__use_windows_paths } ->
- test_split_name("\\\\server\\share\\foo"),
- test_split_name("\\\\server\\share"),
- test_split_name("\\\\server\\share\\\\"),
- test_split_name("C:\\foo"),
- test_split_name("C:\\"),
- test_split_name(""),
- test_split_name("foo\\\\bar\\"),
- test_split_name("foo\\bar\\"),
- test_split_name("foo"),
- test_dirname("foo"),
- test_basename("C:\\"),
- test_basename("C:\\foo")
- ;
- test_split_name("/foo"),
- test_split_name("/foo//bar///"),
- test_split_name("//foo//bar/"),
- test_split_name("//foo//"),
- test_split_name("/"),
- test_split_name(""),
- test_split_name("foo/bar"),
- test_split_name("foo"),
- test_dirname("foo"),
- test_basename("/"),
- test_basename("/foo")
- ),
+
+ run_test("\\\\server\\share\\foo"),
+ run_test("\\\\server\\share"),
+ run_test("\\\\server\\share\\\\"),
+ run_test("C:\\foo"),
+ run_test("C:\\foo\\"),
+ run_test("C:\\"),
+ run_test("C:"),
+ run_test("\\"),
+ run_test(""),
+ run_test("foo\\\\bar\\"),
+ run_test("foo\\bar\\"),
+ run_test("foo"),
+
+ run_test("/foo"),
+ run_test("/foo//bar///"),
+ run_test("//foo//bar/"),
+ run_test("//foo//"),
+ run_test("/"),
+ run_test("foo/bar"),
io__write_string("checking whether `unwritable' is readable..."),
io__check_file_accessibility("unwritable", [read], ReadResult),
@@ -75,16 +69,6 @@
io__write(Type2),
io__nl,
- ( { dir__path_name_is_absolute(Dir1) } ->
- io__write_string("Error: path_name_is_absolute("),
- io__write(Dir1),
- io__write_string(") succeeded\n")
- ;
- io__write_string("path_name_is_absolute("),
- io__write(Dir1),
- io__write_string(") failed as expected\n")
- ),
-
% Create some dummy files
touch_file(Dir1/"foo"),
touch_file(Dir1/"baz"),
@@ -112,7 +96,7 @@
io__make_symlink(dir__parent_directory, Dir1/"parent")),
test1("following symlink",
- io__follow_symlink(Dir1/"bar"), LinkTarget),
+ io__read_symlink(Dir1/"bar"), LinkTarget),
io__write_string(Dir1/"bar"),
io__write_string(" points to "),
io__write_string(LinkTarget),
@@ -212,6 +196,15 @@
{ error(Msg ++ " " ++ io__error_message(Error)) }
).
+:- pred run_test(string::in, io__state::di, io__state::uo) is det.
+
+run_test(PathName) -->
+ test_split_name(PathName),
+ test_dirname(PathName),
+ test_basename(PathName),
+ test_path_name_is_absolute(PathName),
+ io__nl.
+
:- pred test_split_name(string::in, io__state::di, io__state::uo) is det.
test_split_name(PathName) -->
@@ -251,6 +244,19 @@
io__write_string("_ failed.\n")
).
+:- pred test_path_name_is_absolute(string::in,
+ io__state::di, io__state::uo) is det.
+
+test_path_name_is_absolute(PathName) -->
+ io__write_string("dir__path_name_is_absolute("""),
+ io__write_string(PathName),
+ io__write_string(""")"),
+ ( { dir__path_name_is_absolute(PathName) } ->
+ io__write_string(".\n")
+ ;
+ io__write_string(" failed\n")
+ ).
+
:- pred touch_file(string::in, io__state::di, io__state::uo) is det.
touch_file(FileName) -->
tests/hard_coded/dir_test.exp:
==============================
Directory separator is '\'.
dir__split_name("\\server\share\foo", "\\server\share\", "foo").
dir__dirname("\\server\share\foo") = "\\server\share\".
dir__basename("\\server\share\foo") = "foo".
dir__path_name_is_absolute("\\server\share\foo").
dir__split_name("\\server\share", _, _) failed.
dir__dirname("\\server\share") = "\\server\share".
dir__basename("\\server\share") = _ failed.
dir__path_name_is_absolute("\\server\share").
dir__split_name("\\server\share\\", _, _) failed.
dir__dirname("\\server\share\\") = "\\server\share\\".
dir__basename("\\server\share\\") = _ failed.
dir__path_name_is_absolute("\\server\share\\").
dir__split_name("C:\foo", "C:\", "foo").
dir__dirname("C:\foo") = "C:\".
dir__basename("C:\foo") = "foo".
dir__path_name_is_absolute("C:\foo").
dir__split_name("C:\foo\", "C:\", "foo").
dir__dirname("C:\foo\") = "C:\".
dir__basename("C:\foo\") = "foo".
dir__path_name_is_absolute("C:\foo\").
dir__split_name("C:\", _, _) failed.
dir__dirname("C:\") = "C:\".
dir__basename("C:\") = _ failed.
dir__path_name_is_absolute("C:\").
dir__split_name("C:", _, _) failed.
dir__dirname("C:") = "C:".
dir__basename("C:") = _ failed.
dir__path_name_is_absolute("C:") failed
dir__split_name("\", _, _) failed.
dir__dirname("\") = "\".
dir__basename("\") = _ failed.
dir__path_name_is_absolute("\").
dir__split_name("", _, _) failed.
dir__dirname("") = ".".
dir__basename("") = "".
dir__path_name_is_absolute("") failed
dir__split_name("foo\\bar\", "foo\", "bar").
dir__dirname("foo\\bar\") = "foo\".
dir__basename("foo\\bar\") = "bar".
dir__path_name_is_absolute("foo\\bar\") failed
dir__split_name("foo\bar\", "foo\", "bar").
dir__dirname("foo\bar\") = "foo\".
dir__basename("foo\bar\") = "bar".
dir__path_name_is_absolute("foo\bar\") failed
dir__split_name("foo", _, _) failed.
dir__dirname("foo") = ".".
dir__basename("foo") = "foo".
dir__path_name_is_absolute("foo") failed
dir__split_name("/foo", "\", "foo").
dir__dirname("/foo") = "\".
dir__basename("/foo") = "foo".
dir__path_name_is_absolute("/foo").
dir__split_name("/foo//bar///", "\foo\", "bar").
dir__dirname("/foo//bar///") = "\foo\".
dir__basename("/foo//bar///") = "bar".
dir__path_name_is_absolute("/foo//bar///").
dir__split_name("//foo//bar/", _, _) failed.
dir__dirname("//foo//bar/") = "//foo//bar/".
dir__basename("//foo//bar/") = _ failed.
dir__path_name_is_absolute("//foo//bar/").
dir__split_name("//foo//", _, _) failed.
dir__dirname("//foo//") = "//foo//".
dir__basename("//foo//") = _ failed.
dir__path_name_is_absolute("//foo//").
dir__split_name("/", _, _) failed.
dir__dirname("/") = "/".
dir__basename("/") = _ failed.
dir__path_name_is_absolute("/").
dir__split_name("foo/bar", "foo\", "bar").
dir__dirname("foo/bar") = "foo\".
dir__basename("foo/bar") = "bar".
dir__path_name_is_absolute("foo/bar") failed
checking whether `unwritable' is readable...ok
unwritable file found to be unwritable
make_directory succeeded
make_directory succeeded
file_type succeeded
type of test_dir\d1 is directory
file_type 2 succeeded
type of dir_test.m is regular_file
touching file succeeded
touching file succeeded
touching file succeeded
touching file succeeded
creating directory with same name as ordinary file failed (as expected).
symlinks not available on this platform
dir__foldl2 succeeded
Files in test_dir:
test_dir\d1, test_dir\quark, test_dir\queeg
dir__recursive_foldl2 (no symlinks) succeeded
Files in test_dir (recursive, not following symlinks):
test_dir\d1, test_dir\d1\foo, test_dir\d1\baz, test_dir\quark, test_dir\queeg
dir__recursive_foldl2 (symlinks) succeeded
Files in test_dir (recursive, following symlinks:
test_dir\d1, test_dir\d1\foo, test_dir\d1\baz, test_dir\quark, test_dir\queeg
dir.recursive_foldl2(list_files, "dir_test.m", ...) failed as expected.
tests/hard_coded/dir_test.exp2:
===============================
Directory separator is '\'.
dir__split_name("\\server\share\foo", "\\server\share", "foo").
dir__dirname("\\server\share\foo") = "\\server\share".
dir__basename("\\server\share\foo") = "foo".
dir__path_name_is_absolute("\\server\share\foo").
dir__split_name("\\server\share", _, _) failed.
dir__dirname("\\server\share") = "\\server\share".
dir__basename("\\server\share") = _ failed.
dir__path_name_is_absolute("\\server\share").
dir__split_name("\\server\share\\", _, _) failed.
dir__dirname("\\server\share\\") = "\\server\share\\".
dir__basename("\\server\share\\") = _ failed.
dir__path_name_is_absolute("\\server\share\\").
dir__split_name("C:\foo", "C:\", "foo").
dir__dirname("C:\foo") = "C:\".
dir__basename("C:\foo") = "foo".
dir__path_name_is_absolute("C:\foo").
dir__split_name("C:\foo\", "C:\", "foo").
dir__dirname("C:\foo\") = "C:\".
dir__basename("C:\foo\") = "foo".
dir__path_name_is_absolute("C:\foo\").
dir__split_name("C:\", _, _) failed.
dir__dirname("C:\") = "C:\".
dir__basename("C:\") = _ failed.
dir__path_name_is_absolute("C:\").
dir__split_name("C:", _, _) failed.
dir__dirname("C:") = "C:".
dir__basename("C:") = _ failed.
dir__path_name_is_absolute("C:") failed
dir__split_name("\", _, _) failed.
dir__dirname("\") = "\".
dir__basename("\") = _ failed.
dir__path_name_is_absolute("\").
dir__split_name("", _, _) failed.
dir__dirname("") = ".".
dir__basename("") = "".
dir__path_name_is_absolute("") failed
dir__split_name("foo\\bar\", "foo", "bar").
dir__dirname("foo\\bar\") = "foo".
dir__basename("foo\\bar\") = "bar".
dir__path_name_is_absolute("foo\\bar\") failed
dir__split_name("foo\bar\", "foo", "bar").
dir__dirname("foo\bar\") = "foo".
dir__basename("foo\bar\") = "bar".
dir__path_name_is_absolute("foo\bar\") failed
dir__split_name("foo", _, _) failed.
dir__dirname("foo") = ".".
dir__basename("foo") = "foo".
dir__path_name_is_absolute("foo") failed
dir__split_name("/foo", "\", "foo").
dir__dirname("/foo") = "\".
dir__basename("/foo") = "foo".
dir__path_name_is_absolute("/foo").
dir__split_name("/foo//bar///", "\foo", "bar").
dir__dirname("/foo//bar///") = "\foo".
dir__basename("/foo//bar///") = "bar".
dir__path_name_is_absolute("/foo//bar///").
dir__split_name("//foo//bar/", _, _) failed.
dir__dirname("//foo//bar/") = "//foo//bar/".
dir__basename("//foo//bar/") = _ failed.
dir__path_name_is_absolute("//foo//bar/").
dir__split_name("//foo//", _, _) failed.
dir__dirname("//foo//") = "//foo//".
dir__basename("//foo//") = _ failed.
dir__path_name_is_absolute("//foo//").
dir__split_name("/", _, _) failed.
dir__dirname("/") = "/".
dir__basename("/") = _ failed.
dir__path_name_is_absolute("/").
dir__split_name("foo/bar", "foo", "bar").
dir__dirname("foo/bar") = "foo".
dir__basename("foo/bar") = "bar".
dir__path_name_is_absolute("foo/bar") failed
checking whether `unwritable' is readable...ok
unwritable file found to be unwritable
make_directory succeeded
make_directory succeeded
file_type succeeded
type of test_dir\d1 is directory
file_type 2 succeeded
type of dir_test.m is regular_file
touching file succeeded
touching file succeeded
touching file succeeded
touching file succeeded
creating directory with same name as ordinary file failed (as expected).
symlinks not available on this platform
dir__foldl2 succeeded
Files in test_dir:
test_dir\d1, test_dir\quark, test_dir\queeg
dir__recursive_foldl2 (no symlinks) succeeded
Files in test_dir (recursive, not following symlinks):
test_dir\d1, test_dir\d1\foo, test_dir\d1\baz, test_dir\quark, test_dir\queeg
dir__recursive_foldl2 (symlinks) succeeded
Files in test_dir (recursive, following symlinks:
test_dir\d1, test_dir\d1\foo, test_dir\d1\baz, test_dir\quark, test_dir\queeg
dir.recursive_foldl2(list_files, "dir_test.m", ...) failed as expected.
tests/hard_coded/dir_test.exp3:
===============================
Directory separator is '/'.
dir__split_name("\\server\share\foo", _, _) failed.
dir__dirname("\\server\share\foo") = ".".
dir__basename("\\server\share\foo") = "\\server\share\foo".
dir__path_name_is_absolute("\\server\share\foo") failed
dir__split_name("\\server\share", _, _) failed.
dir__dirname("\\server\share") = ".".
dir__basename("\\server\share") = "\\server\share".
dir__path_name_is_absolute("\\server\share") failed
dir__split_name("\\server\share\\", _, _) failed.
dir__dirname("\\server\share\\") = ".".
dir__basename("\\server\share\\") = "\\server\share\\".
dir__path_name_is_absolute("\\server\share\\") failed
dir__split_name("C:\foo", _, _) failed.
dir__dirname("C:\foo") = ".".
dir__basename("C:\foo") = "C:\foo".
dir__path_name_is_absolute("C:\foo") failed
dir__split_name("C:\foo\", _, _) failed.
dir__dirname("C:\foo\") = ".".
dir__basename("C:\foo\") = "C:\foo\".
dir__path_name_is_absolute("C:\foo\") failed
dir__split_name("C:\", _, _) failed.
dir__dirname("C:\") = ".".
dir__basename("C:\") = "C:\".
dir__path_name_is_absolute("C:\") failed
dir__split_name("C:", _, _) failed.
dir__dirname("C:") = ".".
dir__basename("C:") = "C:".
dir__path_name_is_absolute("C:") failed
dir__split_name("\", _, _) failed.
dir__dirname("\") = ".".
dir__basename("\") = "\".
dir__path_name_is_absolute("\") failed
dir__split_name("", _, _) failed.
dir__dirname("") = ".".
dir__basename("") = "".
dir__path_name_is_absolute("") failed
dir__split_name("foo\\bar\", _, _) failed.
dir__dirname("foo\\bar\") = ".".
dir__basename("foo\\bar\") = "foo\\bar\".
dir__path_name_is_absolute("foo\\bar\") failed
dir__split_name("foo\bar\", _, _) failed.
dir__dirname("foo\bar\") = ".".
dir__basename("foo\bar\") = "foo\bar\".
dir__path_name_is_absolute("foo\bar\") failed
dir__split_name("foo", _, _) failed.
dir__dirname("foo") = ".".
dir__basename("foo") = "foo".
dir__path_name_is_absolute("foo") failed
dir__split_name("/foo", "/", "foo").
dir__dirname("/foo") = "/".
dir__basename("/foo") = "foo".
dir__path_name_is_absolute("/foo").
dir__split_name("/foo//bar///", "/foo/", "bar").
dir__dirname("/foo//bar///") = "/foo/".
dir__basename("/foo//bar///") = "bar".
dir__path_name_is_absolute("/foo//bar///").
dir__split_name("//foo//bar/", "/foo/", "bar").
dir__dirname("//foo//bar/") = "/foo/".
dir__basename("//foo//bar/") = "bar".
dir__path_name_is_absolute("//foo//bar/").
dir__split_name("//foo//", "/", "foo").
dir__dirname("//foo//") = "/".
dir__basename("//foo//") = "foo".
dir__path_name_is_absolute("//foo//").
dir__split_name("/", _, _) failed.
dir__dirname("/") = "/".
dir__basename("/") = _ failed.
dir__path_name_is_absolute("/").
dir__split_name("foo/bar", "foo/", "bar").
dir__dirname("foo/bar") = "foo/".
dir__basename("foo/bar") = "bar".
dir__path_name_is_absolute("foo/bar") failed
checking whether `unwritable' is readable...ok
unwritable file found to be unwritable
make_directory succeeded
make_directory succeeded
file_type succeeded
type of test_dir/d1 is directory
file_type 2 succeeded
type of dir_test.m is regular_file
touching file succeeded
touching file succeeded
touching file succeeded
touching file succeeded
creating directory with same name as ordinary file failed (as expected).
making symlink 1 succeeded
making symlink 2 succeeded
making symlink 3 succeeded
following symlink succeeded
test_dir/d1/bar points to baz
file_type 3 succeeded
type of test_dir/d1/bar is symbolic_link
dir__foldl2 succeeded
Files in test_dir:
test_dir/d1, test_dir/d2, test_dir/quark, test_dir/queeg
dir__recursive_foldl2 (no symlinks) succeeded
Files in test_dir (recursive, not following symlinks):
test_dir/d1, test_dir/d1/bar, test_dir/d1/baz, test_dir/d1/foo, test_dir/d1/parent, test_dir/d2, test_dir/quark, test_dir/queeg
dir__recursive_foldl2 (symlinks) succeeded
Files in test_dir (recursive, following symlinks:
test_dir/d1, test_dir/d1/bar, test_dir/d1/baz, test_dir/d1/foo, test_dir/d1/parent, test_dir/d2, test_dir/d2/bar, test_dir/d2/baz, test_dir/d2/foo, test_dir/d2/parent, test_dir/quark, test_dir/queeg
dir.recursive_foldl2(list_files, "dir_test.m", ...) failed as expected.
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list