Skip to content
Snippets Groups Projects
Commit 685137ca authored by dtc's avatar dtc
Browse files

Fix the argument passing to the '/ format directive function; problem

noticed by Sam Steingold.
parent 4b4694c6
Branches
Tags
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/format.lisp,v 1.38 1998/06/18 07:09:47 dtc Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/format.lisp,v 1.39 1998/06/19 15:09:22 dtc Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -2351,28 +2351,31 @@ ...@@ -2351,28 +2351,31 @@
(def-format-directive #\/ (string start end colonp atsignp params) (def-format-directive #\/ (string start end colonp atsignp params)
(let ((symbol (extract-user-function-name string start end))) (let ((symbol (extract-user-function-name string start end)))
(collect ((param-names) (bindings)) (collect ((param-names) (bindings))
(dolist (param params) (dolist (param-and-offset params)
(let ((param-name (gensym))) (let ((offset (car param-and-offset))
(param-names param-name) (param (cdr param-and-offset)))
(bindings `(,param-name (let ((param-name (gensym)))
,(case param (param-names param-name)
(:arg (expand-next-arg)) (bindings `(,param-name
(:remaining '(length args)) ,(case param
(t param)))))) (:arg (expand-next-arg))
`(let ,(bindings) (:remaining '(length args))
(,symbol stream ,(expand-next-arg) ,colonp ,atsignp (t param)))))))
,@(param-names)))))) `(let ,(bindings)
(,symbol stream ,(expand-next-arg) ,colonp ,atsignp
,@(param-names))))))
(def-format-interpreter #\/ (string start end colonp atsignp params) (def-format-interpreter #\/ (string start end colonp atsignp params)
(let ((symbol (extract-user-function-name string start end))) (let ((symbol (extract-user-function-name string start end)))
(collect ((args)) (collect ((args))
(dolist (param params) (dolist (param-and-offset params)
(case param (let ((offset (car param-and-offset))
(:arg (args (next-arg))) (param (cdr param-and-offset)))
(:remaining (args (length args))) (case param
(t (args param)))) (:arg (args (next-arg)))
(apply (fdefinition symbol) stream (next-arg) (:remaining (args (length args)))
colonp atsignp (args))))) (t (args param)))))
(apply (fdefinition symbol) stream (next-arg) colonp atsignp (args)))))
(defun extract-user-function-name (string start end) (defun extract-user-function-name (string start end)
(let ((slash (position #\/ string :start start :end (1- end) (let ((slash (position #\/ string :start start :end (1- end)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment