From 685137ca7db8493acea6015213c6ee997e6eff23 Mon Sep 17 00:00:00 2001 From: dtc <dtc> Date: Fri, 19 Jun 1998 15:09:22 +0000 Subject: [PATCH] Fix the argument passing to the '/ format directive function; problem noticed by Sam Steingold. --- code/format.lisp | 41 ++++++++++++++++++++++------------------- 1 file changed, 22 insertions(+), 19 deletions(-) diff --git a/code/format.lisp b/code/format.lisp index 1673ddca5..a15b6e984 100644 --- a/code/format.lisp +++ b/code/format.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (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 @@ (def-format-directive #\/ (string start end colonp atsignp params) (let ((symbol (extract-user-function-name string start end))) (collect ((param-names) (bindings)) - (dolist (param params) - (let ((param-name (gensym))) - (param-names param-name) - (bindings `(,param-name - ,(case param - (:arg (expand-next-arg)) - (:remaining '(length args)) - (t param)))))) - `(let ,(bindings) - (,symbol stream ,(expand-next-arg) ,colonp ,atsignp - ,@(param-names)))))) + (dolist (param-and-offset params) + (let ((offset (car param-and-offset)) + (param (cdr param-and-offset))) + (let ((param-name (gensym))) + (param-names param-name) + (bindings `(,param-name + ,(case param + (:arg (expand-next-arg)) + (:remaining '(length args)) + (t param))))))) + `(let ,(bindings) + (,symbol stream ,(expand-next-arg) ,colonp ,atsignp + ,@(param-names)))))) (def-format-interpreter #\/ (string start end colonp atsignp params) (let ((symbol (extract-user-function-name string start end))) (collect ((args)) - (dolist (param params) - (case param - (:arg (args (next-arg))) - (:remaining (args (length args))) - (t (args param)))) - (apply (fdefinition symbol) stream (next-arg) - colonp atsignp (args))))) + (dolist (param-and-offset params) + (let ((offset (car param-and-offset)) + (param (cdr param-and-offset))) + (case param + (:arg (args (next-arg))) + (:remaining (args (length args))) + (t (args param))))) + (apply (fdefinition symbol) stream (next-arg) colonp atsignp (args))))) (defun extract-user-function-name (string start end) (let ((slash (position #\/ string :start start :end (1- end) -- GitLab