Changeset 15004
- Timestamp:
- 05/15/17 20:37:26 (7 years ago)
- Location:
- trunk/abcl
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/compiler-error.lisp
r14018 r15004 41 41 (defvar *compiler-error-context* nil) 42 42 43 (define-condition compiler-error (error) )44 (define-condition internal-compiler-error (compiler-error) )45 (define-condition compiler-unsupported-feature-error (compiler-error) )43 (define-condition compiler-error (error) ()) 44 (define-condition internal-compiler-error (compiler-error) ()) 45 (define-condition compiler-unsupported-feature-error (compiler-error) ()) 46 46 47 47 (defun compiler-style-warn (format-control &rest format-arguments) -
trunk/abcl/src/org/armedbear/lisp/destructuring-bind.lisp
r14133 r15004 142 142 (when (eq keyword (car remaining)) 143 143 (return t)))) 144 145 (defun dot-length (cons) 146 (do ((rest cons (cdr rest)) 147 (length 0 (1+ length))) 148 ((or (null rest) (atom rest)) length))) 144 149 145 150 (defun parse-defmacro-lambda-list … … 194 199 env-arg-used t)) 195 200 (t 196 (defmacro-error "&ENVIRONMENT" error-kindname))))201 (defmacro-error "&ENVIRONMENT" name)))) 197 202 ((or (eq var '&rest) (eq var '&body)) 198 203 (cond ((and (cdr rest-of-args) (symbolp (cadr rest-of-args))) … … 210 215 destructuring-lambda-list sub name error-kind error-fun))) 211 216 (t 212 (defmacro-error (symbol-name var) error-kindname))))217 (defmacro-error (symbol-name var) name)))) 213 218 ((eq var '&optional) 214 219 (setq now-processing :optionals)) … … 280 285 (t 281 286 (error "non-symbol in lambda-list: ~S" var))))) 282 ;; Generate code to check the number of arguments, unless dotted 283 ;; in which case length will not work. 284 (unless restp 285 (push `(unless (<= ,minimum 286 (length ,path-0) 287 ,@(unless restp 288 (list maximum))) 289 ,(if (eq error-fun 'error) 290 `(arg-count-error ',error-kind ',name ,path-0 291 ',lambda-list ,minimum 292 ,(unless restp maximum)) 293 `(,error-fun 'arg-count-error 294 :kind ',error-kind 295 ,@(when name `(:name ',name)) 296 :argument ,path-0 297 :lambda-list ',lambda-list 298 :minimum ,minimum 299 ,@(unless restp `(:maximum ,maximum))))) 300 *arg-tests*)) 287 ;; Generate code to check the number of arguments. 288 (push `(unless (<= ,minimum 289 (dot-length ,path-0) 290 ,@(unless restp 291 (list maximum))) 292 ,(if (eq error-fun 'error) 293 `(arg-count-error ',error-kind ',name ,path-0 294 ',lambda-list ,minimum 295 ,(unless restp maximum)) 296 `(,error-fun 'arg-count-error 297 :kind ',error-kind 298 ,@(when name `(:name ',name)) 299 :argument ,path-0 300 :lambda-list ',lambda-list 301 :minimum ,minimum 302 ,@(unless restp `(:maximum ,maximum))))) 303 *arg-tests*) 301 304 (if keys 302 305 (let ((problem (gensym "KEY-PROBLEM-")) -
trunk/abcl/src/org/armedbear/lisp/gray-streams.lisp
r14914 r15004 217 217 s) 218 218 219 (defclass fundamental-input-stream (fundamental-stream) )219 (defclass fundamental-input-stream (fundamental-stream) ()) 220 220 221 221 (defmethod gray-input-character-stream-p (s) ;; # fb 1.01 … … 227 227 t) 228 228 229 (defclass fundamental-output-stream (fundamental-stream) )229 (defclass fundamental-output-stream (fundamental-stream) ()) 230 230 231 231 (defmethod gray-input-stream-p ((s fundamental-output-stream)) … … 239 239 (typep s 'fundamental-output-stream)) 240 240 241 (defclass fundamental-character-stream (fundamental-stream) )241 (defclass fundamental-character-stream (fundamental-stream) ()) 242 242 243 243 (defmethod gray-stream-element-type ((s fundamental-character-stream)) … … 245 245 'character) 246 246 247 (defclass fundamental-binary-stream (fundamental-stream) )247 (defclass fundamental-binary-stream (fundamental-stream) ()) 248 248 249 249 (defgeneric stream-read-byte (stream)) … … 251 251 252 252 (defclass fundamental-character-input-stream 253 (fundamental-input-stream fundamental-character-stream) )253 (fundamental-input-stream fundamental-character-stream) ()) 254 254 255 255 (defgeneric stream-read-char (stream)) … … 293 293 294 294 (defclass fundamental-character-output-stream 295 (fundamental-output-stream fundamental-character-stream) )295 (fundamental-output-stream fundamental-character-stream) ()) 296 296 297 297 (defgeneric stream-write-char (stream character)) … … 387 387 388 388 (defclass fundamental-binary-input-stream 389 (fundamental-input-stream fundamental-binary-stream) )389 (fundamental-input-stream fundamental-binary-stream) ()) 390 390 391 391 (defclass fundamental-binary-output-stream 392 (fundamental-output-stream fundamental-binary-stream) )392 (fundamental-output-stream fundamental-binary-stream) ()) 393 393 394 394 (defmethod stream-read-sequence ((stream fundamental-binary-input-stream) -
trunk/abcl/test/lisp/abcl/misc-tests.lisp
r14857 r15004 119 119 (get-output-stream-string stream))) 120 120 T) 121 122 (deftest destructuring-bind.1 123 (signals-error (destructuring-bind (a b &rest c) '(1) (list a b)) 'program-error) 124 T) 125 126 (deftest destructuring-bind.2 127 (signals-error (destructuring-bind (a . b) '() (list a b)) 'program-error) 128 T) 129 130 (deftest destructuring-bind.3 131 (destructuring-bind (a . b) '(1) (list a b)) 132 (1 NIL))
Note: See TracChangeset
for help on using the changeset viewer.