From 09899a3e155d248e50df27d28f5b4e3a12fb4218 Mon Sep 17 00:00:00 2001 From: Florian Margaine Date: Thu, 7 Sep 2017 21:36:56 +0200 Subject: [PATCH] Fix INCF on a THE variable. The following code: (let ((foo 0)) (incf (the fixnum foo) (bar))) was being expanded into: (let ((foo 0)) (LET* ((#:G133 (BAR)) (#:G132 (THE FIXNUM (+ (THE FIXNUM FOO) (BAR))))) (DECLARE (:READ-ONLY #:G133)) (SETQ FOO (THE FIXNUM #:G132)))) Which is obviously going to call (BAR) twice. If (BAR) has side-effects, then it is going to be buggy. The old define-modify-macro had an issue with out-of-order INCF/DECF, which is why it was replaced with Bruno Haible's macro, which is supposed to improve THE handling. It turns out that the improvement is a bit broken, so we're just fixing this. Fixes #401. --- src/lsp/setf.lsp | 5 +---- src/tests/normal-tests/ansi.lsp | 10 ++++++++++ 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/src/lsp/setf.lsp b/src/lsp/setf.lsp index b7b892e6a..fa912752e 100644 --- a/src/lsp/setf.lsp +++ b/src/lsp/setf.lsp @@ -560,10 +560,7 @@ retrieved by (DOCUMENTATION 'SYMBOL 'FUNCTION)." (LIST* (LIST (CAR STORES) - (IF (AND (LISTP %REFERENCE) (EQ (CAR %REFERENCE) 'THE)) - (LIST 'THE (CADR %REFERENCE) - (LIST* (QUOTE ,function) GETTER ,@varlist ,restvar)) - (LIST* (QUOTE ,function) GETTER (MAPCAR #'CAR ALL-VARS)))) + (LIST* (QUOTE ,function) GETTER (MAPCAR #'CAR ALL-VARS))) (APPEND ALL-VARS LET-LIST))) `(LET* ,(NREVERSE LET-LIST) (DECLARE (:READ-ONLY ,@(mapcar #'first all-vars) diff --git a/src/tests/normal-tests/ansi.lsp b/src/tests/normal-tests/ansi.lsp index 662d0da33..5c442fe35 100644 --- a/src/tests/normal-tests/ansi.lsp +++ b/src/tests/normal-tests/ansi.lsp @@ -47,6 +47,16 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 12.2.* Numbers tests ;; +;;;;;;;;;;;;;;;;;;;;;;;;;; +(test ansi.12.2.incf + (let ((foo 0) + (bar 0)) + (flet ((inc () (incf foo))) + (incf (the fixnum bar) (inc))) + (is (= foo 1)))) + ;;;;;;;;;;;;;;;;;;;;;;;;; ;; 19.* Pathname tests ;; ;;;;;;;;;;;;;;;;;;;;;;;;;