mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-05-10 17:41:10 -07:00
Merge branch 'bugfix-rc'
This commit is contained in:
commit
74780fa2cd
18 changed files with 109 additions and 51 deletions
15
CHANGELOG
15
CHANGELOG
|
|
@ -27,7 +27,20 @@
|
|||
install ECL on the preferred destination (specified with "--prefix"
|
||||
parameter given to configure script).
|
||||
|
||||
* Pending changes since 26.3.27
|
||||
* Pending changes since 26.5.5
|
||||
|
||||
* 26.5.5 changes since 26.3.27
|
||||
|
||||
- bugfix: MAKE-PACKAGE destructively modified defining form's cons cells of
|
||||
the package local nicknames, breaking package literals in bytecmp (#839)
|
||||
|
||||
- bugfix: the first environment is now always page-aligned by using the
|
||||
same allocation mechanism as all subsequent envs (#828)
|
||||
|
||||
- bugfix: allow loading concatenated fasc files (#842)
|
||||
|
||||
- bugfix: defclass does not redefine existing classes at compile time with
|
||||
forward-referenced classes (#843)
|
||||
|
||||
* 26.3.27 changes since 24.5.10
|
||||
|
||||
|
|
|
|||
25
src/c/load.d
25
src/c/load.d
|
|
@ -157,21 +157,22 @@ si_load_bytecodes(cl_object source, cl_object verbose, cl_object print, cl_objec
|
|||
cl_index bds_ndx = ecl_progv(env, ECL_CONS_CAR(progv_list),
|
||||
ECL_CONS_CDR(progv_list));
|
||||
forms = read_forms(strm, ECL_T);
|
||||
ecl_bds_unwind(env, bds_ndx);
|
||||
}
|
||||
while (!Null(forms)) {
|
||||
if (ECL_LISTP(forms)) {
|
||||
cl_object x = ECL_CONS_CAR(forms);
|
||||
forms = ECL_CONS_CDR(forms);
|
||||
if (ecl_t_of(x) == t_bytecodes) {
|
||||
_ecl_funcall1(x);
|
||||
if (Null(forms)) {
|
||||
forms = read_forms(strm, ECL_NIL);
|
||||
|
||||
while (!Null(forms)) {
|
||||
if (ECL_LISTP(forms)) {
|
||||
cl_object x = ECL_CONS_CAR(forms);
|
||||
forms = ECL_CONS_CDR(forms);
|
||||
if (ecl_t_of(x) == t_bytecodes) {
|
||||
_ecl_funcall1(x);
|
||||
if (Null(forms)) {
|
||||
forms = read_forms(strm, ECL_NIL);
|
||||
}
|
||||
continue;
|
||||
}
|
||||
continue;
|
||||
}
|
||||
FEerror("Corrupt bytecodes file ~S", 1, source);
|
||||
}
|
||||
FEerror("Corrupt bytecodes file ~S", 1, source);
|
||||
ecl_bds_unwind(env, bds_ndx);
|
||||
}
|
||||
{
|
||||
cl_object x;
|
||||
|
|
|
|||
|
|
@ -49,7 +49,6 @@
|
|||
/******************************* EXPORTS ******************************/
|
||||
|
||||
const char *ecl_self;
|
||||
static struct cl_env_struct first_env;
|
||||
|
||||
/************************ GLOBAL INITIALIZATION ***********************/
|
||||
|
||||
|
|
@ -419,7 +418,7 @@ struct cl_core_struct cl_core = {
|
|||
|
||||
.system_properties = ECL_NIL,
|
||||
|
||||
.first_env = &first_env,
|
||||
.first_env = NULL,
|
||||
#ifdef ECL_THREADS
|
||||
.processes = ECL_NIL,
|
||||
#endif
|
||||
|
|
@ -498,6 +497,9 @@ cl_boot(int argc, char **argv)
|
|||
setbuf(stdin, stdin_buf);
|
||||
setbuf(stdout, stdout_buf);
|
||||
#endif
|
||||
|
||||
/* The first environment must be available at all times. */
|
||||
cl_core.first_env = _ecl_alloc_env(NULL);
|
||||
init_process();
|
||||
|
||||
ARGC = argc;
|
||||
|
|
|
|||
|
|
@ -203,10 +203,10 @@ process_package_list(cl_object packages)
|
|||
}
|
||||
|
||||
static cl_object
|
||||
process_local_nicknames_list(cl_object local_nicknames)
|
||||
process_local_nicknames_tree(cl_object local_nicknames)
|
||||
{
|
||||
cl_object l, nl;
|
||||
local_nicknames = cl_copy_list(local_nicknames);
|
||||
local_nicknames = cl_copy_tree(local_nicknames);
|
||||
for (l = local_nicknames; l != ECL_NIL; l = ECL_CONS_CDR(l)) {
|
||||
nl = ECL_CONS_CAR(l);
|
||||
ECL_RPLACA(nl, cl_string(ECL_CONS_CAR(nl)));
|
||||
|
|
@ -227,7 +227,7 @@ ecl_make_package(cl_object name, cl_object nicknames,
|
|||
name = cl_string(name);
|
||||
nicknames = process_nicknames(nicknames);
|
||||
use_list = process_package_list(use_list);
|
||||
local_nicknames = process_local_nicknames_list(local_nicknames);
|
||||
local_nicknames = process_local_nicknames_tree(local_nicknames);
|
||||
|
||||
ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN(env) {
|
||||
if (ecl_option_values[ECL_OPT_BOOTED]) {
|
||||
|
|
@ -833,7 +833,8 @@ ecl_shadow(cl_object s, cl_object p)
|
|||
p->pack.internal = _ecl_sethash(s, p->pack.internal, x);
|
||||
x->symbol.hpack = p;
|
||||
}
|
||||
p->pack.shadowings = CONS(x, p->pack.shadowings);
|
||||
if (!ecl_member_eq(x, p->pack.shadowings))
|
||||
p->pack.shadowings = CONS(x, p->pack.shadowings);
|
||||
} ECL_WITH_GLOBAL_ENV_WRLOCK_END;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -281,7 +281,7 @@ ecl_stack_frame_open(cl_env_ptr env, cl_object f, cl_index size)
|
|||
|
||||
/* Some clang versions miscompile the following function on x86_64.
|
||||
* Temporarily turn off optimizations here. */
|
||||
#if defined(__clang__) && __clang_major__ >= 17 && __clang_major__ <= 19 && defined(__x86_64__)
|
||||
#if defined(__clang__) && __clang_major__ >= 17 && __clang_major__ <= 22 && defined(__x86_64__)
|
||||
[[clang::optnone]]
|
||||
#endif
|
||||
void
|
||||
|
|
@ -341,7 +341,7 @@ ecl_stack_frame_push_values(cl_object f)
|
|||
|
||||
/* Some clang versions miscompile the following function on x86_64.
|
||||
* Temporarily turn off optimizations here. */
|
||||
#if defined(__clang__) && __clang_major__ >= 17 && __clang_major__ <= 19 && defined(__x86_64__)
|
||||
#if defined(__clang__) && __clang_major__ >= 17 && __clang_major__ <= 22 && defined(__x86_64__)
|
||||
[[clang::optnone]]
|
||||
#endif
|
||||
cl_object
|
||||
|
|
|
|||
|
|
@ -2043,6 +2043,7 @@ cl_symbols[] = {
|
|||
{EXT_ "ALLOW-WITH-INTERRUPTS" ECL_FUN(NULL, NULL, -1) ECL_VAR(MP_CONSTANT, OBJNULL)},
|
||||
|
||||
{SYS_ "*QUIT-TAG*" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_SPECIAL, OBJNULL)},
|
||||
{SYS_ "*BREAK-LOCALS*" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_SPECIAL, ECL_NIL)},
|
||||
|
||||
{EXT_ "ARRAY-RAW-DATA" ECL_FUN("si_array_raw_data", si_array_raw_data, 1) ECL_VAR(EXT_ORDINARY, OBJNULL)},
|
||||
|
||||
|
|
|
|||
|
|
@ -18,13 +18,15 @@
|
|||
;;; We cannot use the functions CREATE-STANDARD-CLASS and others because SLOTS,
|
||||
;;; DIRECT-SLOTS, etc are empty and therefore SLOT-VALUE does not work.
|
||||
|
||||
(defun make-empty-standard-class (name &key (metaclass 'standard-class)
|
||||
direct-superclasses direct-slots index)
|
||||
(defun make-empty-standard-class
|
||||
(name &key (metaclass 'standard-class)
|
||||
direct-superclasses direct-slots index
|
||||
(size #.(length +standard-class-slots+)))
|
||||
(declare (optimize speed (safety 0)))
|
||||
(let* ((the-metaclass (and metaclass (gethash metaclass si::*class-name-hash-table*)))
|
||||
(let* ((the-metaclass
|
||||
(and metaclass (gethash metaclass si::*class-name-hash-table*)))
|
||||
(class (or (gethash name si::*class-name-hash-table*)
|
||||
(si:allocate-raw-instance nil the-metaclass
|
||||
#.(length +standard-class-slots+)))))
|
||||
(si:allocate-raw-instance nil the-metaclass size))))
|
||||
(with-early-accessors (+standard-class-slots+)
|
||||
(when (eq name 'standard-class)
|
||||
(defconstant +the-standard-class+ class)
|
||||
|
|
|
|||
|
|
@ -377,6 +377,7 @@
|
|||
:direct-slots #.+structure-class-slots+)
|
||||
(structure-object
|
||||
:metaclass structure-class
|
||||
:direct-superclasses (t))
|
||||
:direct-superclasses (t)
|
||||
:size #.(length +structure-class-slots+))
|
||||
)))
|
||||
|
||||
|
|
|
|||
|
|
@ -636,7 +636,8 @@
|
|||
(def-inline cl:integerp :always (t) :bool "@0;ECL_FIXNUMP(#0)||ECL_BIGNUMP(#0)")
|
||||
(def-inline cl:floatp :always (t) :bool "floatp(#0)")
|
||||
(def-inline cl:characterp :always (t) :bool "ECL_CHARACTERP(#0)")
|
||||
(def-inline si:base-char-p :always (character) :bool "ECL_BASE_CHAR_P(#0)")
|
||||
(def-inline si:base-char-p :always (t) :bool "ECL_BASE_CHAR_P(#0)")
|
||||
(def-inline si:base-char-p :always (character) :bool "ECL_BASE_CHAR_CODE_P(#0)")
|
||||
(def-inline cl:stringp :always (t) :bool "@0;ECL_STRINGP(#0)")
|
||||
(def-inline si:base-string-p :always (t) :bool "@0;ECL_BASE_STRING_P(#0)")
|
||||
(def-inline cl:bit-vector-p :always (t) :bool "@0;ECL_BIT_VECTOR_P(#0)")
|
||||
|
|
|
|||
|
|
@ -121,9 +121,12 @@
|
|||
(si:put-sysprop var 'CMP-TYPE type1))
|
||||
(warn "The variable name ~s is not a symbol." var))))
|
||||
|
||||
;;; FIXME implement file-local global compiler environment for BCMP compiler and
|
||||
;;; unify compiler environment functions with CCMP.
|
||||
(defun si:proclaim-class (name class &optional (env c::*cmp-env-root*))
|
||||
"Add a class definition to the global compiler environment."
|
||||
(si:create-type-name name)
|
||||
(ext:with-backend
|
||||
:c/c++ (cmp-env-register-type name class c::*cmp-env-root*)
|
||||
#-ecl-min :bytecodes #-ecl-min (setf (find-class name) class)))
|
||||
(if *compiler-in-use*
|
||||
(cmp-env-register-type name class c::*cmp-env-root*)
|
||||
(or (find-class name nil)
|
||||
(setf (find-class name) class))))
|
||||
|
|
|
|||
|
|
@ -206,7 +206,7 @@ after compilation."
|
|||
((typep (setf def (fdefinition name)) 'standard-generic-function)
|
||||
(warn "COMPILE can not compile generic functions yet")
|
||||
(return-from compile (values def t nil)))
|
||||
((null (setq form (function-lambda-expression def)))
|
||||
((null (multiple-value-setq (form lexenv) (function-lambda-expression def)))
|
||||
(warn "We have lost the original function definition for ~s. Compilation to C failed"
|
||||
name)
|
||||
(return-from compile (values def t nil)))
|
||||
|
|
|
|||
18
src/configure
vendored
18
src/configure
vendored
|
|
@ -1,7 +1,7 @@
|
|||
#! /bin/sh
|
||||
# From configure.ac Revision.
|
||||
# Guess values for system-dependent variables and create Makefiles.
|
||||
# Generated by GNU Autoconf 2.72 for ecl 26.3.27.
|
||||
# Generated by GNU Autoconf 2.72 for ecl 26.5.5.
|
||||
#
|
||||
#
|
||||
# Copyright (C) 1992-1996, 1998-2017, 2020-2023 Free Software Foundation,
|
||||
|
|
@ -602,8 +602,8 @@ MAKEFLAGS=
|
|||
# Identity of this package.
|
||||
PACKAGE_NAME='ecl'
|
||||
PACKAGE_TARNAME='ecl'
|
||||
PACKAGE_VERSION='26.3.27'
|
||||
PACKAGE_STRING='ecl 26.3.27'
|
||||
PACKAGE_VERSION='26.5.5'
|
||||
PACKAGE_STRING='ecl 26.5.5'
|
||||
PACKAGE_BUGREPORT=''
|
||||
PACKAGE_URL=''
|
||||
|
||||
|
|
@ -1404,7 +1404,7 @@ if test "$ac_init_help" = "long"; then
|
|||
# Omit some internal or obsolete options to make the list less imposing.
|
||||
# This message is too long to be a string in the A/UX 3.1 sh.
|
||||
cat <<_ACEOF
|
||||
'configure' configures ecl 26.3.27 to adapt to many kinds of systems.
|
||||
'configure' configures ecl 26.5.5 to adapt to many kinds of systems.
|
||||
|
||||
Usage: $0 [OPTION]... [VAR=VALUE]...
|
||||
|
||||
|
|
@ -1474,7 +1474,7 @@ fi
|
|||
|
||||
if test -n "$ac_init_help"; then
|
||||
case $ac_init_help in
|
||||
short | recursive ) echo "Configuration of ecl 26.3.27:";;
|
||||
short | recursive ) echo "Configuration of ecl 26.5.5:";;
|
||||
esac
|
||||
cat <<\_ACEOF
|
||||
|
||||
|
|
@ -1656,7 +1656,7 @@ fi
|
|||
test -n "$ac_init_help" && exit $ac_status
|
||||
if $ac_init_version; then
|
||||
cat <<\_ACEOF
|
||||
ecl configure 26.3.27
|
||||
ecl configure 26.5.5
|
||||
generated by GNU Autoconf 2.72
|
||||
|
||||
Copyright (C) 2023 Free Software Foundation, Inc.
|
||||
|
|
@ -2258,7 +2258,7 @@ cat >config.log <<_ACEOF
|
|||
This file contains any messages produced by compilers while
|
||||
running configure, to aid debugging if configure makes a mistake.
|
||||
|
||||
It was created by ecl $as_me 26.3.27, which was
|
||||
It was created by ecl $as_me 26.5.5, which was
|
||||
generated by GNU Autoconf 2.72. Invocation command line was
|
||||
|
||||
$ $0$ac_configure_args_raw
|
||||
|
|
@ -12386,7 +12386,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
|
|||
# report actual input values of CONFIG_FILES etc. instead of their
|
||||
# values after options handling.
|
||||
ac_log="
|
||||
This file was extended by ecl $as_me 26.3.27, which was
|
||||
This file was extended by ecl $as_me 26.5.5, which was
|
||||
generated by GNU Autoconf 2.72. Invocation command line was
|
||||
|
||||
CONFIG_FILES = $CONFIG_FILES
|
||||
|
|
@ -12450,7 +12450,7 @@ ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\
|
|||
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
|
||||
ac_cs_config='$ac_cs_config_escaped'
|
||||
ac_cs_version="\\
|
||||
ecl config.status 26.3.27
|
||||
ecl config.status 26.5.5
|
||||
configured by $0, generated by GNU Autoconf 2.72,
|
||||
with options \\"\$ac_cs_config\\"
|
||||
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ dnl AUTOCONF configuration for ECL
|
|||
dnl Giuseppe Attardi 25.1.1994
|
||||
dnl
|
||||
|
||||
AC_INIT([ecl],[26.3.27],[])
|
||||
AC_INIT([ecl],[26.5.5],[])
|
||||
AC_REVISION([$Revision$])
|
||||
AC_CONFIG_SRCDIR([bare.lsp.in])
|
||||
AC_CONFIG_AUX_DIR([gmp])
|
||||
|
|
|
|||
|
|
@ -36,13 +36,16 @@ Builds a new function which accepts any number of arguments but always outputs N
|
|||
(ext:fill-array-with-elt *subtypep-cache* nil 0 nil)
|
||||
(ext:fill-array-with-elt *upgraded-array-element-type-cache* nil 0 nil))
|
||||
|
||||
;;; FIXME implement file-local global compiler environment for BCMP compiler and
|
||||
;;; unify compiler environment functions with CCMP.
|
||||
(defun proclaim-class (name class &optional env)
|
||||
"Add a class definition to the global compiler environment."
|
||||
(declare (ignore env))
|
||||
;; Default implementation for the bytecodes compiler which doesn't
|
||||
;; have a separate file-local compiler environment.
|
||||
;; Default implementation for the bytecodes compiler which doesn't have a
|
||||
;; separate file-local compiler environment.
|
||||
(si:create-type-name name)
|
||||
(setf (find-class name) class))
|
||||
(or (find-class name nil)
|
||||
(setf (find-class name) class)))
|
||||
|
||||
(defun create-type-name (name)
|
||||
(when (member name *alien-declarations*)
|
||||
|
|
|
|||
|
|
@ -24,8 +24,8 @@
|
|||
(:file "foreign-interface" :if-feature :ffi)
|
||||
(:file "metaobject-protocol" :if-feature :clos)
|
||||
(:file "ieee-fp" :if-feature :ieee-floating-point)
|
||||
(:file "package-extensions")
|
||||
(:file "hash-tables")
|
||||
(:file "packages")
|
||||
(:file "hash-tables")
|
||||
(:file "external-formats" :if-feature :unicode)
|
||||
(:file "unicode" :if-feature :unicode)
|
||||
(:file "complex")
|
||||
|
|
|
|||
|
|
@ -21,7 +21,7 @@
|
|||
|
||||
;;;; Declare the suites
|
||||
(suite 'make-check
|
||||
'(executable ieee-fp eprocess package-ext hash-tables ansi+ mixed
|
||||
'(executable ieee-fp eprocess packages hash-tables ansi+ mixed
|
||||
cmp emb ffi mop run-program mp complex wscl #+unicode unicode
|
||||
#+clos clos))
|
||||
|
||||
|
|
|
|||
|
|
@ -2712,3 +2712,15 @@
|
|||
(with-compiler ("empty-file-0115.lsp" :load t))))
|
||||
(delete-file "empty-file-0115.lsp")
|
||||
(delete-file ofile)))
|
||||
|
||||
;;; Date 2026-04-16
|
||||
;;; Description
|
||||
;;;
|
||||
;;; Bytecodes compiler has problems with storing local packages nicknames.
|
||||
;;; Error: "Cannot print object #<EXT package> readably."
|
||||
;;;
|
||||
(deftest cmp.0116.local-nicknames ()
|
||||
(with-compiler ("local-nicknames-0116.lsp")
|
||||
`(defpackage "ZET"
|
||||
(:use)
|
||||
(:local-nicknames ("E" "EXT")))))
|
||||
|
|
|
|||
|
|
@ -3,12 +3,13 @@
|
|||
|
||||
;;;; Author: Daniel Kochmański
|
||||
;;;; Created: 2016-11-09
|
||||
;;;; Contains: PACKAGE extension tests
|
||||
;;;; Easter: Trump won the election today, we're doomed...
|
||||
;;;; Contains: PACKAGE tests
|
||||
;;;; Easter: Trump won the election today, we're screwed...
|
||||
;;;; ([2026-03-30] told you so :-)
|
||||
|
||||
(in-package :cl-test)
|
||||
|
||||
(suite 'package-ext)
|
||||
(suite 'packages)
|
||||
|
||||
(defmacro with-fresh-package (name &body body)
|
||||
`(progn
|
||||
|
|
@ -198,3 +199,20 @@
|
|||
(ignore-errors (delete-package :eu.turtleware.pack2))
|
||||
(ignore-errors (delete-package :eu.turtle.pack1))
|
||||
(ignore-errors (delete-package :eu.turtle.pack2)))
|
||||
|
||||
;;; Reported by: Gábor Melis
|
||||
;;; Created: 2026-03-30
|
||||
;;; Description
|
||||
;;;
|
||||
;;; :shadow option may lead to duplicates in package-shadowing-symbols
|
||||
(deftest packages.0001.shadow-duplicates ()
|
||||
(dotimes (x 3)
|
||||
(defpackage "PACKAGES.0001.TTT"
|
||||
(:shadow "CONS")
|
||||
(:shadowing-import-from "EXT" "GC")
|
||||
(:use "CL")))
|
||||
(let ((shadowed-symbols (package-shadowing-symbols "PACKAGES.0001.TTT"))
|
||||
(expected-symbols (list 'ext::gc
|
||||
(find-symbol "CONS" "PACKAGES.0001.TTT"))))
|
||||
(is (= 2 (length shadowed-symbols)))
|
||||
(is (null (set-difference shadowed-symbols expected-symbols)))))
|
||||
Loading…
Add table
Add a link
Reference in a new issue