diff options
| author | Bradley Lucier <lucier@math.purdue.edu> | 2024-02-15 14:01:28 -0500 |
|---|---|---|
| committer | Bradley Lucier <lucier@math.purdue.edu> | 2024-02-15 14:01:28 -0500 |
| commit | 0e034f100104d981eca1e88049ba753f83d284cc (patch) | |
| tree | 61f21af6d374e5f73e4e3d50321e1cb182bc7783 | |
| parent | 72d24f7478dcd3a6481831831d29f20f43973794 (diff) | |
Mimic https://github.com/gambit/gambit/commit/e25a37038106d87416419130f41654f42742651f to fix mismatched vector arg lengths
| -rw-r--r-- | lib/gambit/vector/vector.scm | 8 | ||||
| -rw-r--r-- | tests/unit-tests/07-vector/vector_any.scm | 5 | ||||
| -rw-r--r-- | tests/unit-tests/07-vector/vector_every.scm | 5 | ||||
| -rw-r--r-- | tests/unit-tests/07-vector/vector_fold.scm | 3 | ||||
| -rw-r--r-- | tests/unit-tests/07-vector/vector_fold_right.scm | 3 |
5 files changed, 18 insertions, 6 deletions
diff --git a/lib/gambit/vector/vector.scm b/lib/gambit/vector/vector.scm index 6c9e9180..695c104c 100644 --- a/lib/gambit/vector/vector.scm +++ b/lib/gambit/vector/vector.scm @@ -298,8 +298,8 @@ (if (fx> len-arg max-len) (loop (cdr lst) (cons arg rev-x-y) + min-len len-arg - max-len arg-num (fx+ arg-num 1)) (loop (cdr lst) @@ -400,8 +400,8 @@ (if (fx> len-arg max-len) (loop (cdr lst) (cons arg rev-x-y) + min-len len-arg - max-len arg-num (fx+ arg-num 1)) (loop (cdr lst) @@ -497,8 +497,8 @@ (if (fx> len-arg max-len) (loop (cdr lst) (cons arg rev-x-y) + min-len len-arg - max-len arg-num (fx+ arg-num 1)) (loop (cdr lst) @@ -595,8 +595,8 @@ (if (fx> len-arg max-len) (loop (cdr lst) (cons arg rev-x-y) + min-len len-arg - max-len arg-num (fx+ arg-num 1)) (loop (cdr lst) diff --git a/tests/unit-tests/07-vector/vector_any.scm b/tests/unit-tests/07-vector/vector_any.scm index cde00d93..57e49e4d 100644 --- a/tests/unit-tests/07-vector/vector_any.scm +++ b/tests/unit-tests/07-vector/vector_any.scm @@ -8,7 +8,7 @@ (define vect3 '#(11 22 33)) (define (inc x) (+ x 1)) -(define (add x y) (+ x y)) +(define add +) (check-equal? (vector-any + vect0 vect2) #f) (check-equal? (vector-any + vect1 vect2) 22) @@ -21,3 +21,6 @@ (check-tail-exn wrong-number-of-arguments-exception? (lambda () (vector-any))) (check-tail-exn wrong-number-of-arguments-exception? (lambda () (vector-any inc))) + +(set! ##allow-length-mismatch? #f) +(check-tail-exn length-mismatch-exception? (lambda () (vector-any add '#(1) '#(1 2) '#(1)))) diff --git a/tests/unit-tests/07-vector/vector_every.scm b/tests/unit-tests/07-vector/vector_every.scm index 315db002..2bfb1f51 100644 --- a/tests/unit-tests/07-vector/vector_every.scm +++ b/tests/unit-tests/07-vector/vector_every.scm @@ -8,7 +8,7 @@ (define vect3 '#(11 22 33)) (define (inc x) (+ x 1)) -(define (add x y) (+ x y)) +(define add +) (check-equal? (vector-every + vect0 vect2) #t) (check-equal? (vector-every + vect1 vect2) 22) @@ -21,3 +21,6 @@ (check-tail-exn wrong-number-of-arguments-exception? (lambda () (vector-every))) (check-tail-exn wrong-number-of-arguments-exception? (lambda () (vector-every inc))) + +(set! ##allow-length-mismatch? #f) +(check-tail-exn length-mismatch-exception? (lambda () (vector-every add '#(1) '#(1 2) '#(1)))) diff --git a/tests/unit-tests/07-vector/vector_fold.scm b/tests/unit-tests/07-vector/vector_fold.scm index b4b99756..0c0a5670 100644 --- a/tests/unit-tests/07-vector/vector_fold.scm +++ b/tests/unit-tests/07-vector/vector_fold.scm @@ -24,3 +24,6 @@ (check-tail-exn wrong-number-of-arguments-exception? (lambda () (vector-fold))) (check-tail-exn wrong-number-of-arguments-exception? (lambda () (vector-fold xcons))) (check-tail-exn wrong-number-of-arguments-exception? (lambda () (vector-fold xcons 0))) + +(set! ##allow-length-mismatch? #f) +(check-tail-exn length-mismatch-exception? (lambda () (vector-fold + 0 '#(1) '#(1 2) '#(1)))) diff --git a/tests/unit-tests/07-vector/vector_fold_right.scm b/tests/unit-tests/07-vector/vector_fold_right.scm index 593bd9cb..bc415331 100644 --- a/tests/unit-tests/07-vector/vector_fold_right.scm +++ b/tests/unit-tests/07-vector/vector_fold_right.scm @@ -12,3 +12,6 @@ (check-tail-exn wrong-number-of-arguments-exception? (lambda () (vector-fold-right))) (check-tail-exn wrong-number-of-arguments-exception? (lambda () (vector-fold-right xcons))) (check-tail-exn wrong-number-of-arguments-exception? (lambda () (vector-fold-right xcons 0))) + +(set! ##allow-length-mismatch? #f) +(check-tail-exn length-mismatch-exception? (lambda () (vector-fold-right + 0 '#(1) '#(1 2) '#(1)))) |