More informative error message by failure of TRUENAME. The extended syntax is allowed in pathnames as a hack to allow using ':' in file names.

This commit is contained in:
jjgarcia 2005-10-24 08:37:42 +00:00
parent c91a860688
commit 4d67d21bbf
3 changed files with 9 additions and 4 deletions

View file

@ -693,12 +693,14 @@ coerce_to_file_pathname(cl_object pathname)
{
pathname = coerce_to_physical_pathname(pathname);
pathname = cl_merge_pathnames(1, pathname);
#if 0
#if !defined(cygwin) && !defined(mingw32) && !defined(_MSC_VER)
if (pathname->pathname.device != Cnil)
FEerror("Device ~S not yet supported.", 1,
pathname->pathname.device);
if (pathname->pathname.host != Cnil)
FEerror("Access to remote files not yet supported.", 0);
#endif
#endif
return pathname;
}

View file

@ -161,12 +161,12 @@ si_readlink(cl_object filename) {
* current directory
*/
cl_object
cl_truename(cl_object pathname)
cl_truename(cl_object orig_pathname)
{
cl_object dir;
cl_object previous = current_dir();
pathname = coerce_to_file_pathname(pathname);
cl_object pathname = coerce_to_file_pathname(orig_pathname);
assert_non_wild_pathname(pathname);
if (pathname->pathname.directory == Cnil)
pathname = merge_pathnames(previous, pathname, @':newest');
@ -184,7 +184,7 @@ cl_truename(cl_object pathname)
filename = si_coerce_to_filename(pathname);
kind = file_kind(filename->string.self, FALSE);
if (kind == Cnil) {
FEcannot_open(pathname);
FEcannot_open(orig_pathname);
#ifdef HAVE_LSTAT
} else if (kind == @':link') {
filename = si_readlink(filename);

View file

@ -547,7 +547,10 @@ returns with NIL."
(define-condition file-error (error)
((pathname :INITARG :PATHNAME :READER file-error-pathname))
(:REPORT (lambda (condition stream)
(format stream "Filesystem error with pathname ~S.~%Either the file cannot be accessed or the pathname is not a valid one."
(format stream "Filesystem error with pathname ~S.~%Either
1) the file does not exist, or
2) we are not allow to access the file, or
3) the pathname points to a broken symbolic link."
(file-error-pathname condition)))))
(define-condition package-error (error)