[m-rev.] for review: library changes for `mmc --make' on Windows

Fergus Henderson fjh at cs.mu.OZ.AU
Wed Jun 18 22:42:56 AEST 2003


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("/") = "/"
and on Windows,
	dir.dirname("C:\") = "C:\"
	dir.basename("C:\") = "\"

> +++ library/Mmakefile	13 Jun 2003 16:27:01 -0000
> @@ -340,9 +340,20 @@
>  endif	# GRADE != il && GRADE != java
>  #-----------------------------------------------------------------------------#
>  
> -# Ensure we recompile library__version if VERSION is changed.
> +# 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

The comment here is misleading -- it refers to library__version,
which does not appear to be at all relevant to dir.m.

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

Likewise, it should also be explicitly documented what happens if
PathName ends in a path separator.

> +	% 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?

On Windows, "\foo\bar" is relative to the current drive.  

> +	% 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();".]

> +%-----------------------------------------------------------------------------%
> +	% 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.

> +:- 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".

> +:- 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.


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

> +:- 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).
> +
> +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])
>  	;
> +		FileName = strip_repeated_dir_separators_2(FileName0,
> +				[C | RevFileName])
> +	).

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

> +:- 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:".

> +	% 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.

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

> +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?

> +% The .NET library function System.IO.Directory.CreateDirectory()
> +% creates the entire path in one call.

s/.NET/.NET CLI/

> +:- pragma foreign_proc("C#",
> +	dir__make_directory(DirName::in, Res::out,
> +			_IO0::di, _IO::uo),
> +	[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
> +"{
> +    try {
> +        // CreateDirectory doesn't fail if a file with the same
> +        // name as the directory being created already exists.
> +        if (System.IO.File.Exists(DirName)) {
> +            mercury.dir.mercury_code.ML_make_mkdir_res_error(
> +                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,

s/. ML/.ML/

> +:- pred dir__make_directory_2(string::in, io__res::out,
> +		io__state::di, io__state::uo) is det.
> +
> +:- 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],
> +"{
> +#if defined(MR_WIN32)
> +	int error;
> +
> +	if (CreateDirectory(DirName, NULL)) {
> +		Result = ML_make_mkdir_res_ok();
> +	} else if ((error = GetLastError()) == ERROR_ALREADY_EXISTS) {
> +		ML_make_mkdir_res_exists(error, DirName, &Result);
> +	} else {
> +		ML_make_mkdir_res_error(error, &Result);
> +	}
> +#elif defined(MR_HAVE_MKDIR)
> +	if (mkdir(DirName, 0777) == 0) {
> +		Result = ML_make_mkdir_res_ok();
> +	# ifdef EEXIST
> +	} else if (errno == EEXIST) {
> +		ML_make_mkdir_res_exists(errno, DirName, &Result);
> +	# endif /* EEXIST */

s/<tab># ifdef/  #ifdef/
s/<tab># endif/  #endif/

> +		% 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.

> +/* For realpath */

s/realpath/realpath()/

> +:- type dir__pos ---> dir__pos.
> +:- pragma foreign_type("C", dir__pos, "ML_DIR_POS").
> +:- pragma foreign_type("il", dir__pos,
> +		"class [mscorlib]System.Collections.IEnumerator").
> +
> +:- pred can_implement_dir_foldl is semidet.
> +
> +can_implement_dir_foldl :- semidet_fail.
> +:- 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)
> +	SUCCESS_INDICATOR = MR_TRUE;
> +#elif defined(MR_WIN32)
> +	SUCCESS_INDICATOR = MR_TRUE;
> +#else		
> +	SUCCESS_INDICATOR = MR_FALSE;
> +#endif
> +").
> +:- pragma foreign_proc("C#",
> +	can_implement_dir_foldl,
> +	[will_not_call_mercury, promise_pure, thread_safe],
> +	"SUCCESS_INDICATOR = true;"
> +).
> +
> +	% Win32 doesn't allow us to open a directory without
> +	% returning the first item.
> +:- pred dir__open(string, io__result({dir__pos, string}),
> +		io__state, io__state).
> +:- mode dir__open(in, out, di, uo) is det.
> +
> +dir__open(DirName, Res, !IO) :-
> +	( can_implement_dir_foldl ->
> +		dir__open_2(DirName, Res, !IO)
> +	;
> +		Res = error(
> +	io__make_io_error("dir.foldl2 not implemented on this platform"))
> +	).
> +
> +
> +:- pred dir__open_2(string, io__result({dir__pos, string}),
> +		io__state, io__state).
> +:- mode dir__open_2(in, out, di, uo) is det.
> +
> +:- pragma foreign_proc("C",
> +	dir__open_2(DirName::in, Result::out, IO0::di, IO::uo),
> +	[may_call_mercury, promise_pure, tabled_for_io, thread_safe],
> +"{
> +#if defined(MR_WIN32)
> +	WIN32_FIND_DATA file_data;
> +	ML_DIR_POS Pos;
> +	LPTSTR FirstFileName;
> +	char *dir_pattern;
> +	int dir_pattern_len;
> +	int is_readable;
> +
> +	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'.

> +		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) {
> +			int error = GetLastError();
> +			if (error = ERROR_NO_MORE_FILES) {
> +				Result = ML_make_dir_open_result_eof();
> +			} else {
> +				ML_make_dir_open_result_error(error, &Result);
> +			}
> +		} else {
> +			ML_make_win32_dir_open_result_ok(Pos,
> +				(MR_Word) file_data.cFileName, &Result);
> +		}
> +		MR_free_heap(dir_pattern);
> +	}
> +
> +#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).

> +	% 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 ;-)

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

> +:- 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?

> +:- 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?

> +:- 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)?

> +:- 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?

> +:- 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.

>  :- 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.
> @@ -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?

> +% 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)?

> +:- pragma foreign_proc("C#", file_type_implemented,
> +	[will_not_call_mercury, promise_pure, thread_safe],
> +	"SUCCESS_INDICATOR = true;"
> +).
> +
> +:- pred io__file_type_2(int, string, io__res(io__file_type),
> +		io__state, io__state).
> +:- mode io__file_type_2(in, in, out, di, uo) is det.
> +
> +:- pragma foreign_proc("C",
> +	io__file_type_2(FollowSymLinks::in, FileName::in,
> +		Result::out, IO0::di, IO::uo),
> +	[may_call_mercury, promise_pure, tabled_for_io, thread_safe],
> +"{
> +#ifdef MR_HAVE_STAT
> +	struct stat s;
> +	int stat_result;
> +
> +	if (FollowSymLinks == 1) {
> +		stat_result = stat(FileName, &s);
> +	} else {
> +		#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.

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

Relying on native code APIs will prevent the Mercury standard library
from being verifiable, so it should be avoided whenever possible.

> +% 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.

> +:- 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

	#ifdef _WIN32
	  #define MR_BROKEN_STAT
	#endif

in runtime/mercury_conf_param.h.

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

> +/*
> +** 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.

> +** This is defined as a macro rather than a C function
> +** to avoid worrying about the `hp' register being
> +** invalidated by the function call.
> +** It also needs to be a macro because MR_incr_hp_atomic_msg()
> +** stringizes the procname argument.
> +*/
> +#ifdef MR_WIN32
> +
> +#include <windows.h>
> +
> +#define ML_maybe_make_win32_err_msg(was_error, error, msg, procname, error_msg) \\
> +	do {								\\
> +		size_t total_len;					\\
> +		MR_Word tmp;						\\
> +									\\
> +		if (was_error) {					\\
> +			LPVOID err_buf;					\\
> +			MR_bool free_err_buf = MR_TRUE;			\\
> +			if (!FormatMessage(				\\
> +				FORMAT_MESSAGE_ALLOCATE_BUFFER		\\
> +				| FORMAT_MESSAGE_FROM_SYSTEM		\\
> +				| FORMAT_MESSAGE_IGNORE_INSERTS,	\\
> +				NULL,					\\
> +				error,					\\
> +				MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), \\
> +				(LPTSTR) &err_buf,			\\
> +				0,					\\
> +				NULL))					\\
> +			{						\\
> +				free_err_buf = MR_FALSE;		\\
> +				err_buf = ""could not retrieve error message""; \\
> +			}						\\
> +			total_len = strlen(msg) + strlen((char *)err_buf); \\
> +			MR_incr_hp_atomic_msg(tmp,			\\
> +				(total_len + sizeof(MR_Word))		\\
> +					/ sizeof(MR_Word),		\\
> +				procname,				\\
> +				""string:string/0"");			\\
> +			(error_msg) = (char *)tmp;			\\
> +			strcpy((error_msg), msg);			\\
> +			strcat((error_msg), (char *)err_buf);		\\
> +			if (free_err_buf) {				\\
> +				LocalFree(err_buf);			\\
> +			}						\\
> +		} else {						\\
> +			(error_msg) = NULL;				\\
> +		}							\\
> +	} while(0)
> +
> +#else /* !MR_WIN32 */
> +
> +#define ML_maybe_make_win32_err_msg(was_error, error, msg, procname, error_msg) \\
> +	MR_fatal_error(""ML_maybe_make_win32_err_msg called on non-Windows platform"")
> +
> +#endif /* !MR_WIN32 */
> +
>  ").
>  
>  io__remove_file(FileName, Result, IO0, IO) :-
> @@ -5769,7 +6549,7 @@
>  	[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
>  "{
>  	RetVal = remove(FileName);
> -	ML_maybe_make_err_msg(RetVal != 0, ""remove failed: "",
> +	ML_maybe_make_err_msg(RetVal != 0, errno, ""remove failed: "",
>  		MR_PROC_LABEL, RetStr);
>  	MR_update_io(IO0, IO);
>  }").
> @@ -5812,7 +6592,7 @@
>  	[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
>  "{
>  	RetVal = rename(OldFileName, NewFileName);
> -	ML_maybe_make_err_msg(RetVal != 0, ""rename failed: "",
> +	ML_maybe_make_err_msg(RetVal != 0, errno, ""rename failed: "",
>  		MR_PROC_LABEL, RetStr);
>  	MR_update_io(IO0, IO);
>  }").
> @@ -5837,6 +6617,129 @@
>  		RetStr = e.Message;
>  	}
>  }").
> +
> +io__have_symlinks :- semidet_fail.
> +
> +:- pragma foreign_proc("C", io__have_symlinks,
> +		[will_not_call_mercury, promise_pure, thread_safe],
> +"
> +#if defined(MR_HAVE_SYMLINK) && defined(MR_HAVE_READLINK)
> +	SUCCESS_INDICATOR = MR_TRUE;
> +#else
> +	SUCCESS_INDICATOR = MR_FALSE;
> +#endif
> +").
> +
> +io__make_symlink(FileName, LinkFileName, Result) -->
> +	( { io__have_symlinks } ->
> +		io__make_symlink_2(FileName, LinkFileName, Status),
> +		( { Status = 0 } ->
> +			io__make_err_msg("io.make_symlink failed: ", Msg),
> +			{ Result = error(make_io_error(Msg)) }
> +		;
> +			{ Result = ok }
> +		)
> +	;
> +		{ Result = error(make_io_error(
> +			"io.make_symlink not supported on this platform")) }
> +	).
> +
> +:- pred io__make_symlink_2(string::in, string::in, int::out,
> +		io__state::di, io__state::uo) is det.
> +
> +:- pragma foreign_proc("C",
> +	io__make_symlink_2(FileName::in, LinkFileName::in,
> +		Status::out, IO0::di, IO::uo), 
> +	[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
> +"{
> +#ifdef MR_HAVE_SYMLINK
> +	Status = (symlink(FileName, LinkFileName) == 0);
> +#else
> +	Status = 0;
> +#endif
> +	MR_update_io(IO0, IO);
> +}").
> +
> +io__follow_symlink(FileName, Result) -->
> +	( { io__have_symlinks } ->
> +		io__follow_symlink_2(FileName, TargetFileName, Status, Error),
> +		( { Status = 0 } ->
> +			io__make_err_msg(Error,
> +				"io.follow_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")) }
> +	).
> +
> +:- pred io__follow_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,
> +		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().

> +			num_chars = readlink(FileName, buffer2, PATH_MAX);
> +			if (num_chars == buffer_size2) {
> +				MR_free(buffer2);
> +				buffer2 = NULL;
> +				continue;

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.

> +			} 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;
> +			}

Is there a missing "break;" in the "else" case?

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

> +dir__dirname("foo") = ".".
> +dir__basename("C:\") = _ failed.
> +dir__basename("C:\foo") = "foo".

Please repeat all the tests of split_name for dirname and basename.

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?

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

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
The University of Melbourne         |  of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
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