Fix instances of loop repeat .. for .. pattern

Strictly speaking the variable clauses introduced by `for` must
precede the main clause introduced by `repeat`.  By placing the repeat
after the for, the semantics of the loop are changed observably in the
presence of a `finally` clause, which will see the effect of one extra
step of the iteration variable (and, if the step has side-effects,
those side-effects happen one more time).
This commit is contained in:
Christophe Rhodes 2022-03-24 11:09:30 +00:00
parent 9a5810a532
commit 24538741ad
18 changed files with 40 additions and 39 deletions

View file

@ -215,8 +215,8 @@
;; receivers (or only senders) are shot
;; dead, there's still one that survives to
;; properly end the test.
(loop repeat 99
for victim = (nth (random n) threads)
(loop for victim = (nth (random n) threads)
repeat 99
do (kill-thread victim)
(sleep (random 0.0001)))))
(values

View file

@ -28,8 +28,8 @@
(inst mov rax-tn 7)
(zeroize rdx-tn)
;; Zero the header
(loop repeat 8
for i from (+ 512 24) by 8
(loop for i from (+ 512 24) by 8
repeat 8
do
(inst mov (ea i rsp-tn) rdx-tn))
(inst xsave (ea 24 rsp-tn))

View file

@ -82,8 +82,8 @@
(zerop length))
(decf length))
(setf pc (sap+ pc 4))
(let ((args (loop repeat length
with index = 0
(let ((args (loop with index = 0
repeat length
collect (sb-c:sap-read-var-integerf pc index))))
(values error-number
(if (= first-offset zr-offset)

View file

@ -26,7 +26,8 @@
(let ((length (error-length error-number)))
(declare (type (unsigned-byte 8) length))
(values error-number
(loop repeat length with index = 0
(loop with index = 0
repeat length
collect (sb-c:sap-read-var-integerf sap index))
trap-number))))

View file

@ -106,8 +106,8 @@
(n-names (sap-ref-32 export-data 24))
(functions-sap (sap+ image-base (sap-ref-32 export-data 28)))
(names-sap (sap+ image-base (sap-ref-32 export-data 32))))
(loop repeat (min n-functions n-names)
for offset from 0 by #.sb-vm::n-word-bytes
(loop for offset from 0 by #.sb-vm::n-word-bytes
repeat (min n-functions n-names)
collect
(cons
(sap-int (sap+ image-base (sap-ref-32 functions-sap offset)))

View file

@ -361,8 +361,9 @@ and a pointer to the arguments."
(incf words-processed)
(incf offset n-word-bytes))
(when gprs
(loop repeat words
(loop
for gpr = (pop gprs)
repeat words
when gpr do
(inst sw gpr nsp-tn offset)
do

View file

@ -536,10 +536,10 @@
)
(t
(loop with gprs = (mapcar #'make-gpr '(3 4))
repeat n-return-area-words
for gpr = (pop gprs)
for offset from (- return-area-pos)
by n-word-bytes
repeat n-return-area-words
do
(unless gpr
(bug "Out of return registers in alien-callback trampoline."))

View file

@ -447,10 +447,10 @@
)
(t
(loop with gprs = (mapcar #'make-gpr '(3 4))
repeat n-return-area-words
for gpr = (pop gprs)
for offset from (- return-area-pos)
by n-word-bytes
repeat n-return-area-words
do
(unless gpr
(bug "Out of return registers in alien-callback trampoline."))

View file

@ -127,9 +127,9 @@
(declare (dynamic-extent args))
;; Construct the concatenation of the required arguments in
;; ORIG-ARGS and CNM-ARGS in ARGS.
(loop repeat nreq
for rest1 on args
(loop for rest1 on args
for arg in orig-args
repeat nreq
do (setf (car rest1) arg)
finally (loop for rest2 on (rest rest1)
for arg in cnm-args

View file

@ -52,7 +52,7 @@ node [shape=record];~%")
(let (tree (prev-op :delete))
(setf (fill-pointer keys) 0)
(loop
repeat n-ops for event from 0 do
for event from 0 repeat n-ops do
(assert (= (avl-count tree) (length keys)))
(let ((op
(if (< (random 10) 5)

View file

@ -270,8 +270,8 @@
(macrolet ((macro ()
`((lambda (x)
(declare (number x))
',@ (loop repeat 10000
for cons = (list 1) then (list cons)
',@ (loop for cons = (list 1) then (list cons)
repeat 10000
finally (return cons)))
t)))
(macro)))

View file

@ -3877,8 +3877,8 @@
(let* ((start (get-internal-run-time))
(iterations 0)
(fun (if times
(loop repeat times
for result = (checked-compile lambda)
(loop for result = (checked-compile lambda)
repeat times
finally (return result))
(loop for result = (checked-compile lambda)
do (incf iterations)

View file

@ -230,8 +230,7 @@
(if p
(canon (concatenate 'string (subseq s 0 p) (subseq s (1+ p))))
s))))
(loop repeat 1000
for length = (random 32)
(loop for length = (random 32)
for native-namestring = (coerce
(loop repeat length
collect
@ -240,11 +239,11 @@
'simple-base-string)
for pathname = (native-pathname native-namestring)
for nnn = (native-namestring pathname)
repeat 1000
do (setf native-namestring (canon native-namestring))
(unless (string= nnn native-namestring)
(error "1: wanted ~S, got ~S" native-namestring nnn)))
(loop repeat 1000
for native-namestring = (with-output-to-string (s)
(loop for native-namestring = (with-output-to-string (s)
(write-string "mu" s)
(loop
(let ((r (random 1.0)))
@ -262,6 +261,7 @@
s))))))
for pathname = (native-pathname native-namestring)
for tricky-nnn = (native-namestring pathname)
repeat 1000
do (setf native-namestring (canon native-namestring))
(unless (string= tricky-nnn native-namestring)
(error "2: wanted ~S, got ~S" native-namestring tricky-nnn))))))

View file

@ -598,8 +598,8 @@
for val = (info :variable :macro-expansion name)
do (assert (eql (or val 0) count))))))
;; Try it when names are symbols or "simple" 2-list names
(run (coerce (loop repeat 50
for sym = (gensym)
(run (coerce (loop for sym = (gensym)
repeat 50
nconc (list `(setf ,sym) sym))
'vector))
;; For hairy names, the tricky piece is in the rehash algorithm,

View file

@ -245,7 +245,7 @@
(defparameter *l* nil)
(defun construct (n)
(setq *l* (make-ordered-list :key-type 'fixnum))
(loop repeat n for key from 10 by 10 do (lfl-insert *l* key (make-foo :a key))))
(loop for key from 10 by 10 repeat n do (lfl-insert *l* key (make-foo :a key))))
(defun scan-lfl-gens (deletep &aux page-indices)
(do ((node (get-next (list-head *l*)) ; can't delete the dummy node (list head)

View file

@ -428,7 +428,7 @@
(assert-no-signal
(compile nil '(lambda ()
(declare (optimize speed))
(loop repeat (+ 1 5) for baz = 'this then 'that
(loop for baz = 'this then 'that repeat (+ 1 5)
do (print baz))))))
(with-test (:name :loop-default-init-type)

View file

@ -601,15 +601,15 @@
(oops))
(loop for f = most-positive-single-float then (/ f 2.0)
while (> f 0.0)
do (loop repeat 10
for fr = (random f)
do (loop for fr = (random f)
repeat 10
do (unless (eql fr (read-from-string (prin1-to-string fr)))
(push fr oops)
(return))))
(loop for f = most-negative-single-float then (/ f 2.0)
while (< f -0.0)
do (loop repeat 10
for fr = (- (random (- f)))
do (loop for fr = (- (random (- f)))
repeat 10
do (unless (eql fr (read-from-string (prin1-to-string fr)))
(push fr oops)
(return))))
@ -625,16 +625,16 @@
;; FIXME skipping denormalized floats due to bug 793774.
(loop for f = most-positive-double-float then (/ f 2d0)
while (> f 0d0)
do (loop repeat 10
for fr = (random f)
do (loop for fr = (random f)
repeat 10
do (unless (float-denormalized-p fr)
(unless (eql fr (read-from-string (prin1-to-string fr)))
(push fr oops)
(return)))))
(loop for f = most-negative-double-float then (/ f 2d0)
while (< f -0d0)
do (loop repeat 10
for fr = (- (random (- f)))
do (loop for fr = (- (random (- f)))
repeat 10
do (unless (float-denormalized-p fr)
(unless (eql fr (read-from-string (prin1-to-string fr)))
(push fr oops)

View file

@ -59,11 +59,10 @@
"Turns something like 0.pre7.14.flaky4.13 (see version.lisp-expr)
into an acceptable form for WIX (up to four dot-separated numbers)."
(with-output-to-string (output)
(loop repeat 4
with position = 0
(loop with position = 0
for separator = "" then "."
for next-digit = (position-if #'digit-char-p horrible-thing
:start position)
for next-digit = (position-if #'digit-char-p horrible-thing :start position)
repeat 4
while next-digit
do (multiple-value-bind (number end)
(parse-integer horrible-thing :start next-digit :junk-allowed t)