← Back to branch summary

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

« back to all changes in this revision

Viewing changes to clcs/unused/test2.lisp

  • 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:
clcs/unused/test2.lisp
 
1
(in-package "conditions")
 
2
 
 
3
(define-condition internal-unbound-variable 
 
4
    (#+(or clos pcl) internal-error unbound-variable)
 
5
  #-(or clos pcl)
 
6
  ((function-name nil))
 
7
  #+(or clos pcl)
 
8
  ()
 
9
  #-(or clos pcl)(:conc-name %%internal-unbound-variable-)
 
10
  #-(or clos pcl)(:REPORT (LAMBDA (CONDITION STREAM)
 
11
                            (when (internal-error-function-name condition)
 
12
                              (format stream "Error in ~S [or a callee]: "
 
13
                                      (internal-error-function-name condition)))
 
14
                            (FORMAT STREAM "The variable ~S is unbound."
 
15
                                    (CELL-ERROR-NAME CONDITION)))))
 
16
 
 
17
 
 
18
#-(or pcl clos)
 
19
(defun internal-error-function-name (condition)
 
20
  (etypecase condition
 
21
    (internal-error                
 
22
     (%%internal-simple-error-function-name condition))
 
23
    (internal-simple-error         
 
24
     (%%internal-simple-error-function-name condition))
 
25
    (internal-type-error 
 
26
     (%%internal-type-error-function-name condition))
 
27
    (internal-simple-program-error
 
28
     (%%internal-simple-program-error-function-name condition))
 
29
    (internal-simple-control-error
 
30
     (%%internal-simple-control-error-function-name condition))
 
31
    (internal-unbound-variable  
 
32
     (%%internal-unbound-variable-function-name condition))
 
33
    (internal-undefined-function 
 
34
     (%%internal-undefined-function-function-name condition))
 
35
    (internal-end-of-file        
 
36
     (%%internal-end-of-file-function-name condition))
 
37
    (internal-simple-file-error  
 
38
     (%%internal-simple-file-error-function-name condition))
 
39
    (internal-simple-stream-error 
 
40
     (%%internal-simple-stream-error-function-name condition))))
 
41