Commit 5524a227 authored by Daniel Kochmański's avatar Daniel Kochmański
Browse files

Merge branch 'pathname-encoding' into 'develop'

Handle non-ascii characters in pathnames

Closes #549 and #609

See merge request embeddable-common-lisp/ecl!258
parents 89fd8c53 7431e694
......@@ -29,7 +29,10 @@
* Pending changes since 21.2.1
** Enhancements
- Add hook functions for cl:ed via ext:*ed-functions* list
- Support for non-ascii characters in pathnames. Pathname encoding defaults
to utf-8 on Unix and may be changed using ~ext:*default-external-format*~
(Windows always uses the utf-16 format provided by the OS).
- Add hook functions for cl:ed via ext:*ed-functions* list)
* 21.2.1 changes since 20.4.24
** Announcement
Dear Community,
......
......@@ -233,7 +233,7 @@ c\cut$(EXE): $(top_srcdir)\util\cut.c
$(TARGETS): $(UCDDAT) ecl_min$(EXE) compile.lsp sysfun.lsp BUILD-STAMP
set ECLDIR=./
ecl_min < compile.lsp
ecl_min compile
BUILD-STAMP: Makefile
date /t > $@
......
......@@ -109,14 +109,14 @@ copy_object_file(cl_object original)
*/
#if defined(ECL_MS_WINDOWS_HOST)
ecl_disable_interrupts();
err = !CopyFile(original->base_string.self, copy->base_string.self, 0);
err = !ecl_CopyFile(ecl_filename_self(original), ecl_filename_self(copy), 0);
ecl_enable_interrupts();
if (err) {
FEwin32_error("Error when copying file from~&~3T~A~&to~&~3T~A",
2, original, copy);
}
#else
err = Null(si_copy_file(original, copy));
err = Null(si_copy_file(ecl_decode_filename(original,ECL_NIL), copy));
if (err) {
FEerror("Error when copying file from~&~3T~A~&to~&~3T~A",
2, original, copy);
......@@ -125,12 +125,12 @@ copy_object_file(cl_object original)
#ifdef cygwin
{
cl_object new_copy = @".dll";
new_copy = si_base_string_concatenate(2, copy, new_copy);
cl_rename_file(2, copy, new_copy);
new_copy = ecl_concatenate_filename(copy, new_copy);
cl_rename_file(2, ecl_decode_filename(copy,ECL_NIL), ecl_decode_filename(new_copy,ECL_NIL));
copy = new_copy;
}
ecl_disable_interrupts();
err = chmod(copy->base_string.self, S_IRWXU) < 0;
err = ecl_chmod(ecl_filename_self(copy), S_IRWXU) < 0;
ecl_enable_interrupts();
if (err) {
FElibc_error("Unable to give executable permissions to ~A",
......@@ -176,7 +176,7 @@ static void
dlopen_wrapper(cl_object block)
{
cl_object filename = block->cblock.name;
char *filename_string = (char*)filename->base_string.self;
ecl_filename_char *filename_string = ecl_filename_self(filename);
#ifdef HAVE_DLFCN_H
block->cblock.handle = dlopen(filename_string, RTLD_NOW|RTLD_GLOBAL);
#endif
......@@ -196,7 +196,7 @@ dlopen_wrapper(cl_object block)
}}
#endif
#if defined(ECL_MS_WINDOWS_HOST)
block->cblock.handle = LoadLibrary(filename_string);
block->cblock.handle = ecl_LoadLibrary(filename_string);
#endif
if (block->cblock.handle == NULL)
set_library_error(block);
......@@ -286,7 +286,7 @@ ecl_library_open(cl_object filename, bool force_reload) {
bool self_destruct = 0;
/* Coerces to a file name but does not merge with cwd */
filename = coerce_to_physical_pathname(filename);
filename = si_coerce_to_physical_pathname(filename);
filename = ecl_namestring(filename,
ECL_NAMESTRING_TRUNCATE_IF_ERROR |
ECL_NAMESTRING_FORCE_BASE_STRING);
......@@ -438,7 +438,7 @@ ecl_library_close(cl_object block) {
} ECL_WITH_GLOBAL_LOCK_END;
if (block != ECL_NIL && block->cblock.self_destruct) {
if (!Null(block->cblock.name)) {
unlink((char*)block->cblock.name->base_string.self);
ecl_unlink(ecl_filename_self(block->cblock.name));
}
}
return success;
......
......@@ -2594,12 +2594,12 @@ cl_synonym_stream_symbol(cl_object strm)
#endif
static int
safe_open(const char *filename, int flags, ecl_mode_t mode)
safe_open(const ecl_filename_char *filename, int flags, ecl_mode_t mode)
{
const cl_env_ptr the_env = ecl_process_env();
int output;
ecl_disable_interrupts_env(the_env);
output = open(filename, flags, mode);
output = ecl_open(filename, flags, mode);
ecl_enable_interrupts_env(the_env);
return output;
}
......@@ -2616,12 +2616,12 @@ safe_close(int f)
}
static FILE *
safe_fdopen(int fildes, const char *mode)
safe_fdopen(int fildes, const ecl_filename_char *mode)
{
const cl_env_ptr the_env = ecl_process_env();
FILE *output;
ecl_disable_interrupts_env(the_env);
output = fdopen(fildes, mode);
output = ecl_fdopen(fildes, mode);
ecl_enable_interrupts_env(the_env);
return output;
}
......@@ -4323,7 +4323,7 @@ cl_object
ecl_make_stream_from_fd(cl_object fname, int fd, enum ecl_smmode smm,
cl_fixnum byte_size, int flags, cl_object external_format)
{
char *mode; /* file open mode */
ecl_filename_char *mode; /* file open mode */
FILE *fp; /* file pointer */
switch(smm) {
case ecl_smm_input:
......@@ -5461,7 +5461,7 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists,
/* FILENAME is used only to access the actual file while a stream
remembers the original pathname FN. -- jd 2020-03-27 */
cl_object filename = si_coerce_to_filename(fn);
char *fname = (char*)filename->base_string.self;
ecl_filename_char *fname = ecl_filename_self(filename);
if (if_does_not_exist == @':create') {
open_flags |= O_CREAT;
......
......@@ -217,7 +217,7 @@ si_load_bytecodes(cl_object source, cl_object verbose, cl_object print, cl_objec
}
/* INV: coerce_to_file_pathname() creates a fresh new pathname object */
source = cl_merge_pathnames(1, source);
pathname = coerce_to_file_pathname(source);
pathname = si_coerce_to_file_pathname(source);
pntype = pathname->pathname.type;
filename = ECL_NIL;
......@@ -244,8 +244,8 @@ si_load_bytecodes(cl_object source, cl_object verbose, cl_object print, cl_objec
/* If filename already has an extension, make sure
that the file exists */
cl_object kind;
filename = si_coerce_to_filename(pathname);
kind = si_file_kind(filename, ECL_T);
filename = pathname;
kind = si_file_kind(pathname, ECL_T);
if (kind != @':file' && kind != @':special') {
filename = ECL_NIL;
} else {
......
......@@ -634,14 +634,13 @@ cl_boot(int argc, char **argv)
GC_enable();
/*
* Initialize default pathnames
* Set *default-pathname-defaults* to a temporary fake value. We
* will fix this when we have access to the condition system to
* allow for error recovery when we can't parse the output of
* getcwd.
*/
#if 1
ECL_SET(@'*default-pathname-defaults*', si_getcwd(0));
#else
ECL_SET(@'*default-pathname-defaults*',
ecl_make_pathname(ECL_NIL, ECL_NIL, ECL_NIL, ECL_NIL, ECL_NIL, ECL_NIL, @':local'));
#endif
#ifdef ECL_THREADS
ECL_SET(@'mp::*current-process*', env->own_process);
......@@ -779,6 +778,12 @@ cl_boot(int argc, char **argv)
ecl_init_module(OBJNULL,init_lib_LSP);
ECL_HANDLER_CASE_BEGIN(env, ecl_list1(@'ext::stream-decoding-error')) {
ECL_SET(@'*default-pathname-defaults*', si_getcwd(0));
} ECL_HANDLER_CASE(1, c) {
_ecl_funcall3(@'warn', @"Cannot initialize *DEFAULT-PATHNAME-DEFAULTS* with the current directory:~%~A~%", c);
} ECL_HANDLER_CASE_END;
if (cl_fboundp(@'ext::make-encoding') != ECL_NIL) {
maybe_fix_console_stream(cl_core.standard_input);
maybe_fix_console_stream(cl_core.standard_output);
......
......@@ -843,16 +843,16 @@ cl_logical_pathname(cl_object x)
@)
/*
* coerce_to_file_pathname(P) converts P to a physical pathname,
* for a file which is accesible in our filesystem.
* si_coerce_to_file_pathname(P) converts P to a physical pathname,
* for a file which is accessible in our filesystem.
* INV: Wildcards are allowed.
* INV: A fresh new copy of the pathname is created.
* INV: The pathname is absolute.
*/
cl_object
coerce_to_file_pathname(cl_object pathname)
si_coerce_to_file_pathname(cl_object pathname)
{
pathname = coerce_to_physical_pathname(pathname);
pathname = si_coerce_to_physical_pathname(pathname);
pathname = cl_merge_pathnames(1, pathname);
#if 0
#if !defined(cygwin) && !defined(ECL_MS_WINDOWS_HOST)
......@@ -871,11 +871,11 @@ coerce_to_file_pathname(cl_object pathname)
}
/*
* coerce_to_physical_pathname(P) converts P to a physical pathname,
* si_coerce_to_physical_pathname(P) converts P to a physical pathname,
* performing the appropriate transformation if P was a logical pathname.
*/
cl_object
coerce_to_physical_pathname(cl_object x)
si_coerce_to_physical_pathname(cl_object x)
{
x = cl_pathname(x);
if (x->pathname.logical)
......@@ -884,9 +884,9 @@ coerce_to_physical_pathname(cl_object x)
}
/*
* si_coerce_to_filename(P) converts P to a physical pathname and then to
* a namestring. The output must always be a new simple-string which can
* be used by the C library.
* si_coerce_to_filename(P) converts P to a physical pathname and then
* to a properly encoded namestring. The output is a new simple-string
* or vector of utf-16 characters which can be used by the C library.
* INV: No wildcards are allowed.
*/
cl_object
......@@ -896,7 +896,7 @@ si_coerce_to_filename(cl_object pathname_orig)
/* We always go through the pathname representation and thus
* cl_namestring() always outputs a fresh new string */
pathname = coerce_to_file_pathname(pathname_orig);
pathname = si_coerce_to_file_pathname(pathname_orig);
if (cl_wild_pathname_p(1,pathname) != ECL_NIL)
cl_error(3, @'file-error', @':pathname', pathname_orig);
namestring = ecl_namestring(pathname,
......@@ -1000,16 +1000,38 @@ ecl_namestring(cl_object x, int flags)
{
bool logical;
cl_object l, y;
cl_object buffer, host;
cl_object buffer_string, buffer, host;
bool truncate_if_unreadable = flags & ECL_NAMESTRING_TRUNCATE_IF_ERROR;
x = cl_pathname(x);
/* INV: Pathnames can only be created by mergin, parsing namestrings
/* INV: Pathnames can only be created by merging, parsing namestrings
* or using ecl_make_pathname(). In all of these cases ECL will complain
* at creation time if the pathname has wrong components.
*/
buffer = ecl_make_string_output_stream(128, 1);
#ifdef ECL_UNICODE
if (flags & ECL_NAMESTRING_FORCE_BASE_STRING) {
# ifdef ECL_MS_WINDOWS_HOST
buffer_string = si_make_vector(@'ext::byte16', /* element-type */
ecl_make_fixnum(128), /* size */
ECL_T, /* adjustable */
ecl_make_fixnum(0), /* fillp */
ECL_NIL, /* displaced */
ECL_NIL); /* displaced-offset */
buffer = si_make_sequence_output_stream(3, buffer_string,
@':external-format', @':ucs-2');
# else
buffer_string = ecl_alloc_adjustable_base_string(128);
buffer = si_make_sequence_output_stream(1, buffer_string);
# endif
} else {
buffer_string = ecl_alloc_adjustable_extended_string(128);
buffer = si_make_string_output_stream_from_string(buffer_string);
}
#else
buffer_string = ecl_alloc_adjustable_base_string(128);
buffer = si_make_string_output_stream_from_string(buffer_string);
#endif
logical = x->pathname.logical;
host = x->pathname.host;
if (logical) {
......@@ -1132,18 +1154,17 @@ ecl_namestring(cl_object x, int flags)
return ECL_NIL;
}
}
buffer = cl_get_output_stream_string(buffer);
#ifdef ECL_UNICODE
if (ECL_EXTENDED_STRING_P(buffer) &&
(flags & ECL_NAMESTRING_FORCE_BASE_STRING)) {
unlikely_if (!ecl_fits_in_base_string(buffer))
FEerror("The filesystem does not accept filenames "
"with extended characters: ~S",
1, buffer);
buffer = si_copy_to_simple_base_string(buffer);
if (flags & ECL_NAMESTRING_FORCE_BASE_STRING) {
#endif
/* add null terminator */
ecl_write_char('\0', buffer);
buffer_string->base_string.fillp--;
buffer_string->base_string.dim--;
#ifdef ECL_UNICODE
}
#endif
return buffer;
return buffer_string;
}
cl_object
......@@ -1530,7 +1551,7 @@ coerce_to_from_pathname(cl_object x, cl_object host)
@
/* Check that host is a valid host name */
if (ecl_unlikely(!ECL_STRINGP(host)))
FEwrong_type_nth_arg(@[si::pathname-translations], 1, host, @[string]);
FEwrong_type_nth_arg(@[si::pathname-translations], 1, host, @[string]);
host = cl_string_upcase(1, host);
len = ecl_length(host);
parse_word(host, is_null, WORD_LOGICAL, 0, len, &parsed_len);
......
......@@ -1168,9 +1168,11 @@ cl_symbols[] = {
{SYS_ "CLEAR-COMPILER-PROPERTIES" ECL_FUN("cl_identity", cl_identity, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "COERCE-TO-BASE-STRING" ECL_FUN("si_coerce_to_base_string", si_coerce_to_base_string, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "COERCE-TO-EXTENDED-STRING" ECL_FUN("si_coerce_to_extended_string", si_coerce_to_extended_string, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "COERCE-TO-FILE-PATHNAME" ECL_FUN("si_coerce_to_file_pathname", si_coerce_to_file_pathname, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "COERCE-TO-FILENAME" ECL_FUN("si_coerce_to_filename", si_coerce_to_filename, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "COERCE-TO-FUNCTION" ECL_FUN("si_coerce_to_function", si_coerce_to_function, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "COERCE-TO-PACKAGE" ECL_FUN("si_coerce_to_package", si_coerce_to_package, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "COERCE-TO-PHYSICAL-PATHNAME" ECL_FUN("si_coerce_to_physical_pathname", si_coerce_to_physical_pathname, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "COPY-TO-SIMPLE-BASE-STRING" ECL_FUN("si_copy_to_simple_base_string", si_copy_to_simple_base_string, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "COMPILED-FUNCTION-BLOCK" ECL_FUN("si_compiled_function_block", si_compiled_function_block, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{EXT_ "COMPILED-FUNCTION-NAME" ECL_FUN("si_compiled_function_name", si_compiled_function_name, 1) ECL_VAR(EXT_ORDINARY, OBJNULL)},
......
This diff is collapsed.
......@@ -185,7 +185,7 @@ the environment variable TMPDIR to a different value." template))
(let ((ld-flags (split-program-options *ld-shared-flags*)))
#+msvc
(setf ld-flags
(let ((implib (si::coerce-to-filename
(let ((implib (brief-namestring
(compile-file-pathname o-pathname :type :lib))))
;; MSVC linker options are added at the end, after the
;; /link flag, because they are not processed by the
......@@ -203,7 +203,7 @@ the environment variable TMPDIR to a different value." template))
(let ((ld-flags (split-program-options *ld-bundle-flags*)))
#+msvc
(setf ld-flags
(let ((implib (si::coerce-to-filename
(let ((implib (brief-namestring
(compile-file-pathname o-pathname :type :import-library))))
;; MSVC linker options are added at the end, after the
;; /link flag, because they are not processed by the
......@@ -492,9 +492,9 @@ output = si_safe_eval(2, ecl_read_from_cstring(lisp_code), ECL_NIL);
;;
(let* ((tmp-names (safe-mkstemp #P"TMP:ECLINIT"))
(tmp-name (first tmp-names))
(c-name (si::coerce-to-filename
(c-name (brief-namestring
(compile-file-pathname tmp-name :type :c)))
(o-name (si::coerce-to-filename
(o-name (brief-namestring
(compile-file-pathname tmp-name :type :object)))
submodules
c-file)
......@@ -679,9 +679,9 @@ compiled successfully, returns the pathname of the compiled file"
#+dlopen
(unless system-p
(push o-pathname to-delete)
(bundle-cc (si::coerce-to-filename output-file)
(bundle-cc (brief-namestring output-file)
init-name
(list (si::coerce-to-filename o-pathname)))))
(list (brief-namestring o-pathname)))))
(if (setf true-output-file (probe-file output-file))
(cmpprogress "~&;;; Finished compiling ~a.~%;;;~%"
(namestring input-pathname))
......@@ -787,9 +787,9 @@ after compilation."
(data-c-dump data-pathname)
(compiler-cc c-pathname o-pathname)
(bundle-cc (si::coerce-to-filename so-pathname)
(bundle-cc (brief-namestring so-pathname)
init-name
(list (si::coerce-to-filename o-pathname)))
(list (brief-namestring o-pathname)))
(cmp-delete-file c-pathname)
(cmp-delete-file h-pathname)
(cmp-delete-file o-pathname)
......
......@@ -37,10 +37,12 @@
;; because it breaks down when using paths such as
;; c:/docume~1/juanjo/locals~1/temp/foo.tmp. enough-namestring would
;; return /docume~1/juanjo/locals~1/temp/foo.tmp which is not found
(when (wild-pathname-p path)
(error "Cannot coerce ~A to a physical filename~%" path))
#+windows
(namestring (si::coerce-to-filename path))
(namestring (si::coerce-to-file-pathname path))
#-windows
(enough-namestring (si::coerce-to-filename path)))
(enough-namestring (si::coerce-to-file-pathname path)))
(defun normalize-build-target-name (target)
(ecase target
......
......@@ -1406,8 +1406,8 @@ extern ECL_API cl_object cl_wild_pathname_p _ECL_ARGS((cl_narg narg, cl_object p
extern ECL_API cl_object ecl_make_pathname(cl_object host, cl_object device, cl_object directory, cl_object name, cl_object type, cl_object version, cl_object scase);
extern ECL_API cl_object ecl_parse_namestring(cl_object s, cl_index start, cl_index end, cl_index *ep, cl_object default_host);
extern ECL_API cl_object coerce_to_physical_pathname(cl_object x);
extern ECL_API cl_object coerce_to_file_pathname(cl_object pathname);
extern ECL_API cl_object si_coerce_to_physical_pathname(cl_object x);
extern ECL_API cl_object si_coerce_to_file_pathname(cl_object pathname);
#define ECL_NAMESTRING_TRUNCATE_IF_ERROR 1
#define ECL_NAMESTRING_FORCE_BASE_STRING 2
extern ECL_API cl_object ecl_namestring(cl_object pname, int truncate_if_impossible);
......@@ -1923,8 +1923,6 @@ extern ECL_API cl_object cl_user_homedir_pathname _ECL_ARGS((cl_narg narg, ...))
extern ECL_API cl_object si_mkstemp(cl_object templ);
extern ECL_API cl_object si_rmdir(cl_object directory);
extern ECL_API cl_object ecl_cstring_to_pathname(char *s);
extern ECL_API int ecl_backup_open(const char *filename, int option, int mode);
extern ECL_API cl_object ecl_file_len(int f);
extern ECL_API cl_object ecl_homedir_pathname(cl_object user);
extern ECL_API cl_object si_get_library_pathname(void);
......
......@@ -220,19 +220,6 @@ extern enum ecl_ffi_tag ecl_foreign_type_code(cl_object type);
/* file.d */
/*
* POSIX specifies that the "b" flag is ignored. This is good, because
* under MSDOS and Apple's OS we need to open text files in binary mode,
* so that we get both the carriage return and the linefeed characters.
* Otherwise, it would be complicated to implement file-position and
* seek operations.
*/
#define OPEN_R "rb"
#define OPEN_W "wb"
#define OPEN_RW "r+b"
#define OPEN_A "ab"
#define OPEN_RA "a+b"
/* Windows does not have this flag (POSIX thing) */
#ifndef O_CLOEXEC
#define O_CLOEXEC 0
......@@ -501,6 +488,123 @@ extern cl_object mp_get_rwlock_read_wait(cl_object lock);
extern cl_object mp_get_rwlock_write_wait(cl_object lock);
#endif
/* unixfsys.d */
/* Filename encodings: on Unix we use ordinary chars encoded in a user
* specified format (usually utf8), while on Windows we use a wchar_t
* type.
*
* Naming conventions:
* fstr: null-terminated raw C array with element type char or wchar_t
* filename: Lisp base string or vector with element type byte16,
* also null-terminated
*/
#if defined(ECL_MS_WINDOWS_HOST) && defined(ECL_UNICODE)
#include <wchar.h>
typedef wchar_t ecl_filename_char;
#define ecl_fstrlen(x) wcslen(x)
#define ecl_fstrcpy(x,y) wcscpy(x,y)
#define ecl_fstrcat(x,y) wcscat(x,y)
#define ecl_fstr(x) L ## x /* wchar_t string constructor prefixed with L */
cl_object ecl_make_simple_filename(const ecl_filename_char *x, cl_fixnum size);
#define ecl_make_constant_filename(x,y) ecl_make_simple_filename(x,y)
cl_object ecl_alloc_filename(cl_index len, cl_object adjustable);
#define ecl_alloc_adjustable_filename(len) ecl_alloc_filename(len, ECL_T)
#define ecl_alloc_simple_filename(len) ecl_alloc_filename(len, ECL_NIL)
cl_object ecl_concatenate_filename(cl_object x, cl_object y);
#define ecl_filename_self(x) ((ecl_filename_char*)((x)->vector.self.b16))
#define ecl_chdir _wchdir
#define ecl_stat _wstat64
#define ecl_fstat _fstat64
typedef struct __stat64 ecl_stat_struct;
#define ecl_getcwd _wgetcwd
#define ecl_access _waccess
#define ecl_unlink _wunlink
#define ecl_rename _wrename
#define ecl_open _wopen
#define ecl_fopen _wfopen
#define ecl_fdopen _wfdopen
#define ecl_rmdir _wrmdir
#define ecl_mkdir _wmkdir
#define ecl_chmod _wchmod
#define ecl_getenv _wgetenv
#define ecl_GetFileAttributes GetFileAttributesW
#define ecl_MoveFile MoveFileW
#define ecl_MoveFileEx MoveFileExW
#define ecl_DeleteFile DeleteFileW
#define ecl_FindFirstFile FindFirstFileW
#define ecl_FindNextFile FindNextFileW
#define ecl_WIN32_FIND_DATA WIN32_FIND_DATAW
#define ecl_GetTempFileName GetTempFileNameW
#define ecl_CopyFile CopyFileW
#define ecl_LoadLibrary LoadLibraryW
#define ecl_GetModuleFileName GetModuleFileNameW
#else
typedef char ecl_filename_char;
#define ecl_fstrlen(x) strlen(x)
#define ecl_fstrcpy(x,y) strcpy(x,y)
#define ecl_fstrcat(x,y) strcat(x,y)
#define ecl_fstr(x) x
#define ecl_make_simple_filename(x,y) ecl_make_simple_base_string((char *)x,y)
#define ecl_make_constant_filename(x,y) ecl_make_constant_base_string((char *)x,y)
#define ecl_alloc_adjustable_filename(len) ecl_alloc_adjustable_base_string(len)
#define ecl_alloc_simple_filename(len) ecl_alloc_simple_base_string(len)
#define ecl_concatenate_filename(x,y) si_base_string_concatenate(2,x,y)
#define ecl_filename_self(x) ((ecl_filename_char*)((x)->base_string.self))
#define ecl_chdir chdir
#define ecl_stat stat
#define ecl_fstat fstat
typedef struct stat ecl_stat_struct;
#define ecl_getcwd getcwd
#define ecl_access access
#define ecl_unlink unlink
#define ecl_rename rename
#define ecl_open open
#define ecl_fopen fopen
#define ecl_fdopen fdopen
#define ecl_rmdir rmdir
#define ecl_mkdir mkdir
#define ecl_chmod chmod
#define ecl_getenv getenv
#define ecl_GetFileAttributes GetFileAttributesA
#define ecl_MoveFile MoveFileA
#define ecl_MoveFileEx MoveFileExA
#define ecl_DeleteFile DeleteFileA
#define ecl_FindFirstFile FindFirstFileA
#define ecl_FindNextFile FindNextFileA
#define ecl_WIN32_FIND_DATA WIN32_FIND_DATAA
#define ecl_GetTempFileName GetTempFileNameA
#define ecl_CopyFile CopyFileA
#define ecl_LoadLibrary LoadLibraryA
#define ecl_GetModuleFileName GetModuleFileNameA
#endif
/*
* POSIX specifies that the "b" flag is ignored. This is good, because
* under MSDOS and Apple's OS we need to open text files in binary mode,
* so that we get both the carriage return and the linefeed characters.
* Otherwise, it would be complicated to implement file-position and
* seek operations.
*/
#define OPEN_R ecl_fstr("rb")
#define OPEN_W ecl_fstr("wb")
#define OPEN_RW ecl_fstr("r+b")
#define OPEN_A ecl_fstr("ab")
#define OPEN_RA ecl_fstr("a+b")
int ecl_backup_open(const ecl_filename_char *filename, int option, int mode);
cl_object ecl_decode_filename(cl_object x, cl_object len);
cl_object ecl_encode_filename(cl_object x, cl_object len);
/* unixint.d */
#define ECL_PI_D 3.14159265358979323846264338327950288
......
......@@ -303,7 +303,8 @@ the one used internally by ECL compiled files."
#-unicode
(warn "EXT:LOAD-ENCODING not available when ECL is built without support for Unicode")
#+unicode
(let ((filename (make-pathname :name (symbol-name name) :defaults "sys:encodings;")))
(let ((ext:*default-external-format* t) ; circularity: processing filenames needs encodings itself
(filename (make-pathname :name (symbol-name name) :defaults "sys:encodings;")))
(cond ((probe-file filename)
(load filename :verbose nil)
name)
......
......@@ -67,3 +67,66 @@
"(defun unicode.0004 (x¹ y²)
(+ x¹ y²))")
(is (= 7 (unicode.0004 5 2))))
;;; Date: 2021-02-28
;;; From: Marius Gerbershagen
;;; Description:
;;;
;;; Check that various pathname functions work correctly with
;;; unicode characters
;;;
(test unicode.0005.pathnames
;; ensure-directories-exist
(multiple-value-bind (pathspec created)
(ensure-directories-exist #P"рецепты/")
(is (equal pathspec #P"рецепты/")))
(let ((files '(#P"рецепты/Spätzle-mit-Soß.txt"
#P"рецепты/Kartoffelklöße.txt"
#P"рецепты/Thüringer-Klöße.txt")))
;; open, truename
(with-open-file (s (first files) :if-does-not-exist :create :if-exists :supersede :direction :output)
(is (equal (truename s) (merge-pathnames (first files)))))
(with-open-file (s (second files) :if-does-not-exist :create :if-exists :supersede :direction :output)
(is (equal (truename s) (merge-pathnames (second files)))))
;; ext:copy-file
(is (ext:copy-file (second files) (third files)))
;; directory
(is (equal (sort (directory "рецепты/*.txt") #'string< :key #'pathname-name)
(sort (mapcar #'merge-pathnames files) #'string< :key #'pathname-name)))
(is (equal (sort (directory "рецепты/*löße.txt") #'string< :key #'pathname-name)
(mapcar #'merge-pathnames (rest files))))
;; probe-file