Changeset 14365


Ignore:
Timestamp:
Oct 15, 2010, 3:15:03 AM (9 years ago)
Author:
gb
Message:

Admit that the macro CCL::REPORT-BAD-ARG has accepted exactly 2 arguments
for the last 20+ years. If the second argument (the typespec) is quoted,
warn at macroexpand time if it looks suspicious.

Fix a handful of cases that were detected by that change. In one
case, introduce a predicate so that EXPT can complain about an
argument whose realpart isn't positive via a SATISFIES type specifier.

Location:
trunk/source
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-0/l0-float.lisp

    r14224 r14365  
    819819
    820820
     821(defun positive-realpart-p (n)
     822  (> (realpart n) 0))
    821823
    822824(defun expt (b e)
     
    826828         (if (minusp e) (/ 1 (%integer-power b (- e))) (%integer-power b e)))
    827829        ((zerop b)
    828          (if (plusp (realpart e)) b (report-bad-arg e '(number (0) *))))
     830         (if (plusp (realpart e)) b (report-bad-arg e '(satisfies positive-realpart-p))))
    829831        ((and (realp b) (plusp b) (realp e))
    830832         (if (or (typep b 'double-float)
  • trunk/source/level-1/l1-clos-boot.lisp

    r14262 r14365  
    31993199           (setq old-wrapper (gf.instance.class-wrapper instance)))
    32003200         (unless old-wrapper
    3201            (report-bad-arg instance '(or standard-instance funcallable-standard-object))))
     3201           (report-bad-arg instance '(or standard-object funcallable-standard-object))))
    32023202       (when (eql 0 (%wrapper-instance-slots old-wrapper)) ; is it really obsolete?
    32033203         (let* ((class (%wrapper-class old-wrapper))
  • trunk/source/level-1/l1-streams.lisp

    r14255 r14365  
    64306430              (setf (fill-pointer displaced) newpos)))
    64316431          newpos)
    6432         (report-bad-arg newpos `(integer 0 `(,(- (the fixnum (io-buffer-limit outbuf)) origin)))))
     6432        (report-bad-arg newpos `(integer 0 (,(- (the fixnum (io-buffer-limit outbuf)) origin)))))
    64336433      (the fixnum (- (the fixnum (io-buffer-idx outbuf)) origin)))))
    64346434
     
    65856585          (setf (io-buffer-idx inbuf) (the fixnum (+ origin (the fixnum newpos))))
    65866586          newpos)
    6587         (report-bad-arg newpos `(integer 0 `(,(- (the fixnum (io-buffer-limit inbuf)) origin)))))
     6587        (report-bad-arg newpos `(integer 0 (,(- (the fixnum (io-buffer-limit inbuf)) origin)))))
    65886588      (the fixnum (- (the fixnum (io-buffer-idx inbuf)) origin)))))
    65896589
  • trunk/source/lib/macros.lisp

    r14362 r14365  
    264264          ,@(if ret `((progn (setq ,varsym nil) ,ret))))))))
    265265
    266 (defmacro report-bad-arg (&rest args)
    267   `(values (%badarg ,@args)))
     266(defmacro report-bad-arg (&whole w thing typespec &environment env)
     267  (when (quoted-form-p typespec)
     268    (unless (ignore-errors (specifier-type-if-known (cadr typespec) env))
     269      (warn "Unknown type specifier ~s in ~s." (cadr typespec) w)))
     270  `(values (%badarg ,thing ,typespec)))
    268271
    269272(defmacro %cons-restart (name action report interactive test)
Note: See TracChangeset for help on using the changeset viewer.