tests/alien.impure.lisp

   1 ;;;; This file is for compiler tests which have side effects (e.g.
   2 ;;;; executing DEFUN) but which don't need any special side-effecting
   3 ;;;; environmental stuff (e.g. DECLAIM of particular optimization
   4 ;;;; settings). Similar tests which *do* expect special settings may
   5 ;;;; be in files compiler-1.impure.lisp, compiler-2.impure.lisp, etc.
   6
   7 ;;;; This software is part of the SBCL system. See the README file for
   8 ;;;; more information.
   9 ;;;;
  10 ;;;; While most of SBCL is derived from the CMU CL system, the test
  11 ;;;; files (like this one) were written from scratch after the fork
  12 ;;;; from CMU CL.
  13 ;;;;
  14 ;;;; This software is in the public domain and is provided with
  15 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
  16 ;;;; more information.
  17
  18 (cl:in-package :cl-user)
  19
  20 ;;; In sbcl-0.6.10, Douglas Brebner reported that (SETF EXTERN-ALIEN)
  21 ;;; was messed up so badly that trying to execute expressions like
  22 ;;; this signalled an error.
  23 (setf (sb-alien:extern-alien "current_control_stack_pointer" sb-alien:unsigned)
  24       (sb-alien:extern-alien "current_control_stack_pointer" sb-alien:unsigned))
  25
  26 ;;; bug 133, fixed in 0.7.0.5: Somewhere in 0.pre7.*, C void returns
  27 ;;; were broken ("unable to use values types here") when
  28 ;;; auto-PROCLAIM-of-return-value was added to DEFINE-ALIEN-ROUTINE.
  29 (sb-alien:define-alien-routine ("free" free) void (ptr (* t) :in))
  30
  31 ;;; Types of alien functions were being incorrectly DECLAIMED when
  32 ;;; docstrings were included in the definition until sbcl-0.7.6.15.
  33 (sb-alien:define-alien-routine ("getenv" ftype-correctness) c-string
  34   "docstring"
  35   (name c-string))
  36
  37 (multiple-value-bind (function warningsp failurep)
  38     (compile nil '(lambda () (ftype-correctness)))
  39   (assert warningsp))
  40
  41 (multiple-value-bind (function warningsp failurep)
  42     (compile nil '(lambda () (ftype-correctness "FOO")))
  43   (assert (not warningsp)))
  44
  45 (multiple-value-bind (function warningsp failurep)
  46     (compile nil '(lambda () (ftype-correctness "FOO" "BAR")))
  47   (assert warningsp))
  48
  49 ;;; success
  50 (quit :unix-status 104)