From de179f4c43c398a2e50ac80b3bbc6854a00ae85c Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Tue, 3 Sep 1991 17:35:19 +0000 Subject: [PATCH] Fixed FORMAT transform to warn if there are to many or too few args. --- compiler/srctran.lisp | 63 ++++++++++++++++++++++++------------------- 1 file changed, 35 insertions(+), 28 deletions(-) diff --git a/compiler/srctran.lisp b/compiler/srctran.lisp index 417214ef5..31d47bd7c 100644 --- a/compiler/srctran.lisp +++ b/compiler/srctran.lisp @@ -7,12 +7,10 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.27 1991/02/20 14:59:43 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.28 1991/09/03 17:35:19 ram Exp $") ;;; ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.27 1991/02/20 14:59:43 ram Exp $ -;;; ;;; This file contains macro-like source transformations which convert ;;; uses of certain functions into the canonical form desired within the ;;; compiler. ### and other IR1 transforms and stuff. Some code adapted from @@ -1398,6 +1396,11 @@ ;; Write out the final part of the string. (forms `(write-string ,(subseq control index end) ,@stream-form)) + (when args + (compiler-warning "~R extra format argument~:P. Ignoring..." + (length args)) + (forms `(progn ,@args))) + (return `(lambda (stream control ,@arg-vars) (declare (ignorable stream control)) ,@(forms) @@ -1414,30 +1417,34 @@ ,@stream-form))) ;; Get the format directive. - (forms - (case (schar control (1+ command-index)) - ((#\b #\B) `(let ((*print-base* 2)) - (princ ,(pop args) ,@stream-form))) - ((#\o #\O) `(let ((*print-base* 8)) - (princ ,(pop args) ,@stream-form))) - ((#\d #\D) `(let ((*print-base* 10)) - (princ ,(pop args) ,@stream-form))) - ((#\x #\X) `(let ((*print-base* 16)) - (princ ,(pop args) ,@stream-form))) - ((#\a #\A) `(princ ,(pop args) ,@stream-form)) - ((#\s #\S) `(prin1 ,(pop args) ,@stream-form)) - (#\% `(terpri ,@stream-form)) - (#\& `(fresh-line ,@stream-form)) - (#\| `(write-char #\form ,@stream-form)) - (#\~ `(write-char #\~ ,@stream-form)) - (#\newline - (let ((new-pos (position-if-not - #'lisp::whitespace-char-p - control - :start (+ command-index 2)))) - (if new-pos - (setq command-index (- new-pos 2))))) - (t - (give-up)))) + (flet ((next-arg () + (unless args + (abort-transform "Missing FORMAT argument.")) + (pop args))) + (forms + (case (schar control (1+ command-index)) + ((#\b #\B) `(let ((*print-base* 2)) + (princ ,(next-arg) ,@stream-form))) + ((#\o #\O) `(let ((*print-base* 8)) + (princ ,(next-arg) ,@stream-form))) + ((#\d #\D) `(let ((*print-base* 10)) + (princ ,(next-arg) ,@stream-form))) + ((#\x #\X) `(let ((*print-base* 16)) + (princ ,(next-arg) ,@stream-form))) + ((#\a #\A) `(princ ,(next-arg) ,@stream-form)) + ((#\s #\S) `(prin1 ,(next-arg) ,@stream-form)) + (#\% `(terpri ,@stream-form)) + (#\& `(fresh-line ,@stream-form)) + (#\| `(write-char #\form ,@stream-form)) + (#\~ `(write-char #\~ ,@stream-form)) + (#\newline + (let ((new-pos (position-if-not + #'lisp::whitespace-char-p + control + :start (+ command-index 2)))) + (if new-pos + (setq command-index (- new-pos 2))))) + (t + (give-up))))) (setq index (+ command-index 2))))))) -- GitLab