haikuprojects/haikuports
1
0
Fork 0
mirror of https://github.com/yann64/haikuports.git synced 2026-04-16 08:40:06 +02:00
Code Issues Packages Projects Releases Wiki Activity
Files
d1494deec257e85a72c54c623d0d43fc58eacf10
haikuports/dev-lisp/sbcl/patches/sbcl-2.2.4.patchset
Estevan Castilho 79d6f4c204 sbcl: miscellaneous fixes, test routine (#8753) 
Among the changes are fixes for test suite hangs and failures, uiop
misbehavior and a hang on stack overflow.
2023-05-29 15:14:00 -04:00

407 lines
14 KiB
Plaintext
Raw Blame History

From 21453c4c6795acf63cc918ce59d89bda121f028f Mon Sep 17 00:00:00 2001
From: Al Hoang <3811822-hoanga@users.noreply.gitlab.com>
Date: Sun, 8 May 2022 23:06:29 -0500
Subject: updated haiku patch
diff --git a/contrib/sb-bsd-sockets/sockets.lisp b/contrib/sb-bsd-sockets/sockets.lisp
index 18e94cc..0b74411 100644
--- a/contrib/sb-bsd-sockets/sockets.lisp
+++ b/contrib/sb-bsd-sockets/sockets.lisp
@@ -345,7 +345,9 @@ request an input stream and get an output stream in response\)."
(define-socket-condition sockint::EOPNOTSUPP operation-not-supported-error)
(define-socket-condition sockint::EPERM operation-not-permitted-error)
(define-socket-condition sockint::EPROTONOSUPPORT protocol-not-supported-error)
-(define-socket-condition sockint::ESOCKTNOSUPPORT socket-type-not-supported-error)
+;; haiku hack
+#+haiku (define-socket-condition -4025 socket-type-not-supported-error)
+#-haiku (define-socket-condition sockint::ESOCKTNOSUPPORT socket-type-not-supported-error)
(define-socket-condition sockint::ENETUNREACH network-unreachable-error)
(define-socket-condition sockint::ENOTCONN not-connected-error)
(define-socket-condition sockint::EAFNOSUPPORT address-family-not-supported)
diff --git a/contrib/sb-bsd-sockets/tests.lisp b/contrib/sb-bsd-sockets/tests.lisp
index dddf316..46ac26e 100644
--- a/contrib/sb-bsd-sockets/tests.lisp
+++ b/contrib/sb-bsd-sockets/tests.lisp
@@ -82,6 +82,7 @@
;; here, not socket-type-not-supported-error or
;; protocol-not-supported-error.
((or #+darwin socket-error
+ #+haiku address-family-not-supported
operation-not-supported-error
socket-type-not-supported-error
protocol-not-supported-error)
@@ -100,6 +101,7 @@
;; protocol-not-supported-error.
((or
#+darwin socket-error
+ #+haiku address-family-not-supported
operation-not-supported-error
protocol-not-supported-error
socket-type-not-supported-error)
@@ -497,7 +499,7 @@
;; translates into an END-OF-FILE on the other end, no matter which
;; end performs the shutdown and independent of the element-type of
;; the stream.
-#+ipv4-support
+#+(and ipv4-support (not haiku))
(macrolet
((define-shutdown-test (name who-shuts-down who-reads element-type direction)
`(deftest ,name
diff --git a/contrib/sb-posix/constants.lisp b/contrib/sb-posix/constants.lisp
index 4c991ef..bdc6092 100644
--- a/contrib/sb-posix/constants.lisp
+++ b/contrib/sb-posix/constants.lisp
@@ -274,10 +274,11 @@
#-(and linux largefile) "struct dirent"
#-(or win32 android) (:ino-t ino "ino_t" "d_ino")
#+android ((unsigned 64) ino "unsigned long long" "d_ino")
- (:c-string name "char *" "d_name"
- ;; FIXME: sunos should really have :distrust-length
- ;; t, but this is currently broken. -- Jim Wise 2010-08-31
- :distrust-length nil)) t)
+ ))
+ ;;(:c-string name "char *" "d_name"
+ ;; ;; FIXME: sunos should really have :distrust-length
+ ;; ;; t, but this is currently broken. -- Jim Wise 2010-08-31
+ ;; :distrust-length nil)) t)
;; password database
#-(or android win32)
diff --git a/contrib/sb-posix/posix-tests.lisp b/contrib/sb-posix/posix-tests.lisp
index 0a642bd..da1b357 100644
--- a/contrib/sb-posix/posix-tests.lisp
+++ b/contrib/sb-posix/posix-tests.lisp
@@ -168,6 +168,8 @@
#+win32
#.sb-posix::einval)
+;; disable for haiku
+#-haiku
(deftest rmdir.error.3
(handler-case
(sb-posix:rmdir #-win32 "/" #+win32 (sb-ext:posix-getenv "windir"))
@@ -179,11 +181,11 @@
#.sb-posix:eisdir
#+win32
#.sb-posix::eacces
- #+win32
+ #+(or win32 haiku)
#.sb-posix::enotempty
#+sunos
#.sb-posix::einval
- #-(or darwin openbsd win32 sunos)
+ #-(or darwin openbsd win32 sunos haiku)
#.sb-posix::ebusy)))) t)
(deftest rmdir.error.4
@@ -235,7 +237,7 @@
(logand mode (logior sb-posix::s-iread sb-posix::s-iwrite sb-posix::s-iexec)))
#.(logior sb-posix::s-iread sb-posix::s-iwrite sb-posix::s-iexec))
-#-(or (and darwin x86) win32)
+#-(or (and darwin x86) win32 haiku)
(deftest stat.2
(eql
(sb-posix::stat-mode (sb-posix:stat "/"))
@@ -428,7 +430,7 @@
sb-posix::o-nonblock))
t)
-#-(or win32 netbsd) ; fix: cant handle c-vargs
+#-(or win32 netbsd haiku) ; fix: cant handle c-vargs
(deftest fcntl.flock.1
(locally (declare (sb-ext:muffle-conditions sb-ext:compiler-note))
(let ((flock (make-instance 'sb-posix:flock
@@ -520,7 +522,9 @@
(sb-posix:closedir dir))))
nil)
-#-(and darwin x86)
+;;#-(and darwin x86)
+;; disable on haiku
+#-haiku
(deftest readdir.1
(let ((dir (sb-posix:opendir "/")))
(unwind-protect
@@ -533,7 +537,8 @@
(sb-posix:closedir dir)))
t)
-#-darwin
+;; disable on haiku as well
+#-(or darwin haiku)
(deftest readdir/dirent-name
(let ((dir (sb-posix:opendir *current-directory*)))
(unwind-protect
@@ -579,7 +584,7 @@
(not (sb-posix:getpwuid 0))
nil)
-#-(or android win32)
+#-(or android win32 haiku)
(deftest pwent.2
;; make sure that we found something
(not (sb-posix:getpwnam "root"))
@@ -652,7 +657,7 @@
(plusp (sb-posix:time))
t)
-#-(or (and darwin x86) win32)
+#-(or (and darwin x86) win32 haiku)
(macrolet ((test (name posix-fun)
`(deftest ,name
(let ((file (merge-pathnames #p"utimes.1" *test-directory*))
@@ -700,6 +705,8 @@
#.(concatenate 'string "/" (make-string 255 :initial-element #\a)))
;; The error tests are in the order of exposition from SUSv3.
+ ;; TERRIBLE
+ #-haiku
(deftest readlink.error.1
(let* ((subdir-pathname (merge-pathnames
(make-pathname
@@ -719,6 +726,8 @@
(sb-posix:unlink link-pathname)
(sb-posix:rmdir subdir-pathname))))
#.sb-posix:eacces)
+ ;; TERRIBLE
+ #-haiku
(deftest readlink.error.2
(let* ((non-link-pathname (make-pathname :name "readlink.error.2"
:defaults *test-directory*))
@@ -749,6 +758,8 @@
#.sb-posix:eloop)
;; Note: PATH_MAX and NAME_MAX need not be defined, and may vary, so
;; failure of this test is not too meaningful.
+ ;; TERRIBLE
+ #-haiku
(deftest readlink.error.4
(let ((pathname
(make-pathname :name (make-string 257 ;NAME_MAX plus some, maybe
diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index 65cfeea..1d09ded 100644
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -970,10 +970,20 @@ avoiding atexit(3) hooks, etc. Otherwise exit(2) is called."
(it-interval (struct timeval)) ; timer interval
(it-value (struct timeval)))) ; current value
+#-haiku
(defconstant itimer-real 0)
+#-haiku
(defconstant itimer-virtual 1)
+#-haiku
(defconstant itimer-prof 2)
+#+haiku
+(defconstant itimer-real 1)
+#+haiku
+(defconstant itimer-virtual 2)
+#+haiku
+(defconstant itimer-prof 3)
+
#-win32
(defun unix-getitimer (which)
"UNIX-GETITIMER returns the INTERVAL and VALUE slots of one of
diff --git a/src/runtime/run-program.c b/src/runtime/run-program.c
index 01a9f81..de74553 100644
--- a/src/runtime/run-program.c
+++ b/src/runtime/run-program.c
@@ -32,7 +32,7 @@
#include <termios.h>
#include <errno.h>
#include <dirent.h>
-#include <sys/syscall.h>
+//#include <sys/syscall.h>
#include "interr.h" // for lose()
#ifdef LISP_FEATURE_OPENBSD
--
2.37.3
From e20e02f6c33bc74f28680833322ae8a6e75c6400 Mon Sep 17 00:00:00 2001
From: Estevan Castilho <estevan.cps@gmail.com>
Date: Sun, 28 May 2023 20:26:45 +0000
Subject: UIOP: don't remove :HAIKU from *FEATURES*
Haiku is in the same position as macOS, where it should have both
:OS-UNIX and it's own keyword in *FEATURES*, but UIOP inadvertedly
removes all other keywords once OS-UNIX-P returns true. A similar fix
is already on ASDF upstream.
diff --git a/contrib/asdf/uiop.lisp b/contrib/asdf/uiop.lisp
index 6e23972..baf0e13 100644
--- a/contrib/asdf/uiop.lisp
+++ b/contrib/asdf/uiop.lisp
@@ -1859,7 +1859,7 @@ except on ABCL where it might change between FASL compilation and runtime."
(:os-windows . os-windows-p)
(:genera . os-genera-p) (:os-oldmac . os-oldmac-p)
(:haiku . os-haiku-p))
- :when (and (or (not o) (eq feature :os-macosx)) (funcall detect))
+ :when (and (or (not o) (eq feature :os-macosx) (eq feature :os-haiku)) (funcall detect))
:do (setf o feature) (pushnew feature *features*)
:else :do (setf *features* (remove feature *features*))
:finally
--
2.37.3
From 4c02550e5095d891969c4ce3e23ca3eec37ec80a Mon Sep 17 00:00:00 2001
From: Estevan Castilho <estevan.cps@gmail.com>
Date: Sun, 28 May 2023 20:28:30 +0000
Subject: Setup an alternate stack for signal handling in Haiku
Otherwise we just segfault forever when a stack overflow occurs.
diff --git a/src/runtime/x86-64-haiku-os.c b/src/runtime/x86-64-haiku-os.c
index 7d2c183..3e6fb4c 100644
--- a/src/runtime/x86-64-haiku-os.c
+++ b/src/runtime/x86-64-haiku-os.c
@@ -2,9 +2,23 @@
#include "gencgc-alloc-region.h"
#include "thread.h"
#include "genesis/thread.h"
+#include "interr.h" /* for lose() */
#include <signal.h>
+#include <errno.h>
int arch_os_thread_init(struct thread __attribute__((unused)) *thread) {
+ stack_t sigstack;
+#ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
+ /* Signal handlers are run on the control stack, so if it is exhausted
+ * we had better use an alternate stack for whatever signal tells us
+ * we've exhausted it */
+ sigstack.ss_sp = calc_altstack_base(thread);
+ sigstack.ss_flags = 0;
+ sigstack.ss_size = calc_altstack_size(thread);
+ if(sigaltstack(&sigstack,0)<0) {
+ lose("Cannot sigaltstack: %s",strerror(errno));
+ }
+#endif
return 1;
}
--
2.37.3
From e5abb82629b84b33807401eb8c8af4018aefa7e9 Mon Sep 17 00:00:00 2001
From: Estevan Castilho <estevan.cps@gmail.com>
Date: Sun, 28 May 2023 20:30:03 +0000
Subject: Mark TRACE :ENCAPSULATE NIL tests as broken on Haiku
They just seem to hang while segfaulting forever. No attempt has been
made to debug this.
diff --git a/tests/debug.impure.lisp b/tests/debug.impure.lisp
index fd8e4af..4f305e8 100644
--- a/tests/debug.impure.lisp
+++ b/tests/debug.impure.lisp
@@ -108,7 +108,7 @@
;;; bug 379
(with-test (:name (trace :encapsulate nil)
:fails-on (or (and :ppc (not :linux)) :arm64)
- :broken-on (or :freebsd))
+ :broken-on (or :freebsd :haiku))
(let ((output (with-traced-function (trace-this :encapsulate nil)
(assert (eq 'ok (trace-this))))))
(assert (search "TRACE-THIS" output))
@@ -116,7 +116,7 @@
(with-test (:name (trace :encapsulate nil :recursive)
:fails-on (or (and :ppc (not :linux)) :arm64)
- :broken-on (or :freebsd))
+ :broken-on (or :freebsd :haiku))
(let ((output (with-traced-function (trace-fact :encapsulate nil)
(assert (= 120 (trace-fact 5))))))
(assert (search "TRACE-FACT" output))
--
2.37.3
From f23833f7f94d7389a928de25b9fb480267c91c15 Mon Sep 17 00:00:00 2001
From: Estevan Castilho <estevan.cps@gmail.com>
Date: Sun, 28 May 2023 20:32:37 +0000
Subject: Don't assume env is under /usr/bin
On Haiku, it is under /bin instead, and runtime_loader dynamically
patches script shebangs during load time; so we try getting the
location from PATH instead.
diff --git a/tests/run-program.test.sh b/tests/run-program.test.sh
index 3a08741..54389ac 100755
--- a/tests/run-program.test.sh
+++ b/tests/run-program.test.sh
@@ -22,8 +22,14 @@ export SOMETHING_IN_THE_ENVIRONMENT
PATH=/some/path/that/does/not/exist:${PATH}
export PATH
+# Haiku notably has the env binary on /bin/env, and dynamically
+# patches shebangs referring to /usr/bin/env on runtime_loader. This,
+# of course, doesn't apply to us, so get the actual location from PATH.
+BIN_ENV="$(command -v env || echo /usr/bin/env)"
+
# This should probably be broken up into separate pieces.
-run_sbcl --eval "(defvar *exit-ok* $EXIT_LISP_WIN)" <<'EOF'
+run_sbcl --eval "(defvar *exit-ok* $EXIT_LISP_WIN)" \
+ --eval "(defvar *bin-env* \"$BIN_ENV\")" <<'EOF'
;; test that $PATH is searched
(assert (zerop (sb-ext:process-exit-code
(sb-ext:run-program "true" () :search t :wait t))))
@@ -38,7 +44,7 @@ run_sbcl --eval "(defvar *exit-ok* $EXIT_LISP_WIN)" <<'EOF'
;; Unix environment strings are ordinarily passed with SBCL convention
;; (instead of CMU CL alist-of-keywords convention).
(let ((string (with-output-to-string (stream)
- (sb-ext:run-program "/usr/bin/env" ()
+ (sb-ext:run-program *bin-env* ()
:output stream
:environment '("FEEFIE=foefum")))))
(assert (equal string "FEEFIE=foefum
@@ -67,7 +73,7 @@ run_sbcl --eval "(defvar *exit-ok* $EXIT_LISP_WIN)" <<'EOF'
(let* ((sb-impl::*default-external-format* :latin-1)
(sb-alien::*default-c-string-external-format* :latin-1)
(string (with-output-to-string (stream)
- (sb-ext:run-program "/usr/bin/env" ()
+ (sb-ext:run-program *bin-env* ()
:output stream)))
(expected (apply #'concatenate
'string
--
2.37.3
From 377f3ad9d5f154dfb011dded46104ef2df14b731 Mon Sep 17 00:00:00 2001
From: Estevan Castilho <estevan.cps@gmail.com>
Date: Sun, 28 May 2023 20:34:28 +0000
Subject: Include missing header, optionally install the SEGV handler on Haiku
diff --git a/src/runtime/haiku-os.c b/src/runtime/haiku-os.c
index f56d06a..74065bc 100644
--- a/src/runtime/haiku-os.c
+++ b/src/runtime/haiku-os.c
@@ -3,6 +3,7 @@
#include "interrupt.h"
#include "arch.h" // for arch_get_bad_addr
#include "interrupt.h" // for sig_stop_for_gc_handler
+#include "gc-internal.h" // for gencgc_handle_wp_violation
#include <image.h>
#include <stdio.h>
@@ -78,7 +79,9 @@ sigsegv_handler(int signal, siginfo_t *info, os_context_t *context)
void
os_install_interrupt_handlers(void)
{
- ll_install_handler(SIGSEGV, sigsegv_handler);
+ if (INSTALL_SIG_MEMORY_FAULT_HANDLER) {
+ ll_install_handler(SIGSEGV, sigsegv_handler);
+ }
}
int pthread_getattr_np(pthread_t thread, pthread_attr_t *attr)
--
2.37.3
Reference in New Issue View Git Blame Copy Permalink