mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
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:
parent
9a5810a532
commit
24538741ad
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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."))
|
||||
|
|
|
|||
|
|
@ -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."))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))))))
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Reference in a new issue