← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/ansi-aux-macros.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
ansi-tests/ansi-aux-macros.lsp
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Wed Jul  2 07:05:41 2003
 
4
;;;; Contains: Macros used in ansi-aux and elsewhere.
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
(declaim (optimize (safety 3)))
 
9
 
 
10
;;; Macros to avoid annoying sbcl warning notes
 
11
 
 
12
(defmacro handler-case (form &rest cases)
 
13
  `(let () (cl:handler-case ,form ,@cases)))
 
14
 
 
15
(defmacro handler-bind (handlers &rest body)
 
16
  `(let () (cl:handler-bind ,handlers (normally (progn ,@body)))))
 
17
 
 
18
;;; Macros for avoiding dead code warnings
 
19
 
 
20
(defvar *should-always-be-true* t)
 
21
 
 
22
(declaim (notinline should-never-be-called))
 
23
 
 
24
(defun should-never-be-called () nil)
 
25
 
 
26
(defmacro normally (form &optional (default-form
 
27
                                     '(should-never-be-called)))
 
28
  `(if *should-always-be-true* ,form ,default-form))
 
29
 
 
30
;;; Macro to ignore errors, but report them anyway
 
31
 
 
32
(defparameter *report-and-ignore-errors-break* nil
 
33
  "When true, REPORT-AND-IGNORE-ERRORS breaks instead of discarding the error condition.")
 
34
 
 
35
(defmacro report-and-ignore-errors (&body body)
 
36
  `(eval-when (:load-toplevel :compile-toplevel :execute)
 
37
     (#+sbcl let #+sbcl () #-sbcl progn
 
38
       (handler-case
 
39
        (progn ,@body)
 
40
        (error (condition)
 
41
               (princ condition)
 
42
               (terpri)
 
43
               (when *report-and-ignore-errors-break* (break))
 
44
               (values nil condition))))))
 
45
 
 
46