From ca6d6e10d5bf8c224e02de36960225c7a1bd31f0 Mon Sep 17 00:00:00 2001 From: "Tarn W. Burton" Date: Fri, 6 Jan 2023 11:21:55 -0500 Subject: [PATCH 1/2] Add tests for illegal format directive parameters --- src/tests/normal-tests/mixed.lsp | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/src/tests/normal-tests/mixed.lsp b/src/tests/normal-tests/mixed.lsp index c189acb2a..b52c7bf1d 100644 --- a/src/tests/normal-tests/mixed.lsp +++ b/src/tests/normal-tests/mixed.lsp @@ -466,3 +466,16 @@ (is (eql (realpart (log -2s0 2l0)) 1l0)) (is (eql (log 2d0 2l0) 1l0)) (is (eql (realpart (log -2d0 2l0)) 1l0))) + +;;; Created: 2023-01-07 +;;; Contains: tests checking for illegal format parameters that occur +;;; after at signs or colons. +(test mix.0025.illegal-format-parameters + (signals error (format nil "a~@4A" nil)) + (signals error (format nil "a~:4A" nil)) + (signals error (format nil "a~:@4A" nil)) + (signals error (format nil "a~@:4A" nil)) + (is (equal (format nil "a~4@A" nil) "a NIL")) + (is (equal (format nil "a~4:A" nil) "a() ")) + (is (equal (format nil "a~4:@A" nil) "a ()")) + (is (equal (format nil "a~4@:A" nil) "a ()"))) -- GitLab From eeb91e80058b7c82aad54d755c87cdd865829e93 Mon Sep 17 00:00:00 2001 From: "Tarn W. Burton" Date: Fri, 6 Jan 2023 11:27:22 -0500 Subject: [PATCH 2/2] Avoid parsing parameters after colon or at sign --- src/lsp/format.lsp | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp index cc2ab7780..07ca0c08e 100644 --- a/src/lsp/format.lsp +++ b/src/lsp/format.lsp @@ -273,7 +273,8 @@ (schar string posn)))) (loop (let ((char (get-char))) - (cond ((or (char<= #\0 char #\9) (char= char #\+) (char= char #\-)) + (cond ((and (not colonp) (not atsignp) + (or (char<= #\0 char #\9) (char= char #\+) (char= char #\-))) (multiple-value-bind (param new-posn) (parse-integer string :start posn :junk-allowed t) @@ -285,7 +286,8 @@ (decf posn)) (t (return))))) - ((or (char= char #\v) (char= char #\V)) + ((and (not colonp) (not atsignp) + (or (char= char #\v) (char= char #\V))) (push (cons posn :arg) params) (incf posn) (case (get-char) @@ -294,7 +296,8 @@ (decf posn)) (t (return)))) - ((char= char #\#) + ((and (not colonp) (not atsignp) + (char= char #\#)) (push (cons posn :remaining) params) (incf posn) (case (get-char) @@ -303,13 +306,15 @@ (decf posn)) (t (return)))) - ((char= char #\') + ((and (not colonp) (not atsignp) + (char= char #\')) (incf posn) (push (cons posn (get-char)) params) (incf posn) (unless (char= (get-char) #\,) (decf posn))) - ((char= char #\,) + ((and (not colonp) (not atsignp) + (char= char #\,)) (push (cons posn nil) params)) ((char= char #\:) (if colonp -- GitLab