{"size": 13176, "ext": "rktl", "max_stars_repo_path": "pkgs/racket-test-core/tests/racket/flonum.rktl", "max_stars_repo_name": "lkh01/racket", "max_stars_repo_stars_event_min_datetime": "2018-07-05T21:18:24.000Z", "max_stars_repo_stars_event_max_datetime": "2021-06-04T14:48:37.000Z", "max_issues_repo_path": "pkgs/racket-test-core/tests/racket/flonum.rktl", "max_issues_repo_name": "lkh01/racket", "max_issues_repo_issues_event_min_datetime": "2017-05-10T07:33:20.000Z", "max_issues_repo_issues_event_max_datetime": "2018-07-19T15:49:46.000Z", "max_forks_repo_path": "pkgs/racket-test-core/tests/racket/flonum.rktl", "max_forks_repo_name": "lkh01/racket", "max_forks_repo_forks_event_min_datetime": "2016-04-25T11:47:57.000Z", "max_forks_repo_forks_event_max_datetime": "2017-05-09T14:52:48.000Z"}
{"max_stars_count": 4, "max_issues_count": 9, "max_forks_count": 3, "avg_line_length": 35.8043478261, "max_line_length": 112, "alphanum_fraction": 0.5440194293}
(load-relative "loadtest.rktl")

(Section 'flonum)

(require racket/flonum
         scheme/unsafe/ops
         "for-util.rkt")

(define 1nary-table
  (list (list fl- unsafe-fl-)
        (list fl/ unsafe-fl/)

        (list fl>= unsafe-fl>=)
        (list fl> unsafe-fl>)
        (list fl= unsafe-fl=)
        (list fl<= unsafe-fl<=)
        (list fl< unsafe-fl<)
        (list flmin unsafe-flmin)
        (list flmax unsafe-flmax)))

(define 0nary-table
  (list (list fl+ unsafe-fl+)
        (list fl* unsafe-fl*)))

(let ()
  (define (same-results fl unsafe-fl args)
    (test (apply fl args) apply unsafe-fl args))

  (for ([ignore (in-range 0 800)])
    (let ([i (random)]
          [j (random)]
          [k (random)]
          [more-flonums (build-list (random 20) (λ (i) (random)))])
      (for ([line (in-list 0nary-table)])
        (test #t same-results (list-ref line 0) (list-ref line 1) (list))
        (test #t same-results (list-ref line 0) (list-ref line 1) (list i))
        (test #t same-results (list-ref line 0) (list-ref line 1) (list i j)))
      (for ([line (in-list 1nary-table)])
        (test #t same-results (list-ref line 0) (list-ref line 1) (list i))
        (test #t same-results (list-ref line 0) (list-ref line 1) (list i j)))
      (for ([line (in-list (append 0nary-table 1nary-table))])
        (test #t same-results (list-ref line 0) (list-ref line 1) (list i j k))
        (test #t same-results (list-ref line 0) (list-ref line 1) (list i k j))
        (test #t same-results (list-ref line 0) (list-ref line 1) (cons i more-flonums))))))

(define (flonum-close? fl1 fl2)
  (<= (flabs (fl- fl1 fl2))
      1e-8))

;; in-flvector tests.
(let ((flv (flvector 1.0 2.0 3.0)))
  (let ((flv-seq (in-flvector flv)))
    (for ((x (in-flvector flv))
          (xseq flv-seq)
          (i (in-naturals)))
      (test (+ i 1.0) 'in-flvector-fast x)
      (test (+ i 1.0) 'in-flvector-sequence xseq))))

;; for/flvector test
(let ((flv (flvector 1.0 2.0 3.0))
      (flv1 (for/flvector ((i (in-range 3))) (+ i 1.0)))
      (flv2 (for/flvector #:length 3 ((i (in-range 3))) (+ i 1.0))))
  (test flv 'for/flvector flv1)
  (test flv 'for/flvector-fast flv2))

(test (flvector 1.0 2.0 3.0 0.0 0.0)
      'for/flvector-fill
      (for/flvector #:length 5 ([i 3]) (+ i 1.0)))
(test (flvector 1.0 2.0 3.0 -10.0 -10.0)
      'for/flvector-fill
      (for/flvector #:length 5 #:fill -10.0 ([i 3]) (+ i 1.0)))
(test (flvector 1.0 2.0 3.0 0.0 0.0)
      'for/flvector-fill
      (for/flvector #:length 5 ([i 5]) #:break (= i 3) (+ i 1.0)))
(test (flvector 1.0 2.0 3.0 4.0 0.0)
      'for/flvector-fill
      (for/flvector #:length 5 ([i 5]) #:final (= i 3) (+ i 1.0)))

;; for*/flvector test
(let ((flv (flvector 0.0 0.0 0.0 0.0 1.0 2.0 0.0 2.0 4.0))
      (flv1 (for*/flvector ((i (in-range 3)) (j (in-range 3))) (exact->inexact (* 1.0 i j))))
      (flv2 (for*/flvector #:length 9 ((i (in-range 3)) (j (in-range 3))) (exact->inexact (* 1.0 i j)))))
  (test flv 'for*/flvector flv1)
  (test flv 'for*/flvector-fast flv2))

;; Stop when a length is specified, even if the sequence continues:
(test (flvector 0.0 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0)
      'nat
      (for/flvector #:length 10 ([i (in-naturals)]) (exact->inexact i)))
(test (flvector 0.0 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0)
      'nats
      (for*/flvector #:length 10 ([i (in-naturals)] [j (in-naturals)]) (exact->inexact j)))
(test (flvector 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 1.0)
      'nat+5
      (for*/flvector #:length 10 ([i (in-naturals)] [j (in-range 5)]) (exact->inexact i)))


;; Test for both length too long and length too short
(let ((v (make-flvector 3)))
  (flvector-set! v 0 0.0)
  (flvector-set! v 1 1.0)
  (let ((w (for/flvector #:length 3 ((i (in-range 2))) (exact->inexact i))))
    (test v 'for/flvector-short-iter w)))

(let ((v (make-flvector 10)))
  (for* ((i (in-range 3))
         (j (in-range 3)))
    (flvector-set! v (+ j (* i 3)) (+ 1.0 i j)))
  (let ((w (for*/flvector #:length 10 ((i (in-range 3)) (j (in-range 3))) (+ 1.0 i j))))
    (test v 'for*/flvector-short-iter w)))

(test 2 'for/flvector-long-iter
      (flvector-length (for/flvector #:length 2 ((i (in-range 10))) (exact->inexact i))))
(test 5 'for*/flvector-long-iter 
      (flvector-length (for*/flvector #:length 5 ((i (in-range 3)) (j (in-range 3))) (exact->inexact (+ i j)))))

;; Test for many body expressions
(let* ((flv (flvector 1.0 2.0 3.0))
       (flv2 (for/flvector ((i (in-range 3))) 
               (flvector-set! flv i (+ (flvector-ref flv i) 1.0))
               (flvector-ref flv i)))
       (flv3 (for/flvector #:length 3 ((i (in-range 3)))
               (flvector-set! flv i (+ (flvector-ref flv i) 1.0))
               (flvector-ref flv i))))
  (test (flvector 2.0 3.0 4.0) 'for/flvector-many-body flv2)
  (test (flvector 3.0 4.0 5.0) 'for/flvector-length-many-body flv3))

;; flvector-copy test
(let ((v (flvector 0.0 1.0 2.0 3.0)))
  (let ((vc (flvector-copy v)))
    (test (flvector-length v) 'flvector-copy (flvector-length vc))
    (for ((vx (in-flvector v))
          (vcx (in-flvector vc)))
      (test vx 'flvector-copy vcx))
    (flvector-set! vc 2 -10.0)
    (test 2.0 'flvector-copy (flvector-ref v 2))
    (test -10.0 'flvector-copy (flvector-ref vc 2))
    (test '(2.0 3.0) 'flvector-copy (for/list ([i (in-flvector (flvector-copy v 2))]) i))
    (test '(2.0) 'flvector-copy (for/list ([i (in-flvector (flvector-copy v 2 3))]) i))))

;; Check empty clauses
(let ()
  (define vector-iters 0)
  (test (flvector 3.4 0.0 0.0 0.0)
        'no-clauses
        (for/flvector #:length 4 ()
                      (set! vector-iters (+ 1 vector-iters))
                      3.4))
  (test 1 values vector-iters)
  (test (flvector 3.4 0.0 0.0 0.0)
        'no-clauses
        (for*/flvector #:length 4 ()
                       (set! vector-iters (+ 1 vector-iters))
                       3.4))
  (test 2 values vector-iters))

;; Check #:when and #:unless:
(test (flvector 0.0 1.0 2.0 1.0 2.0)
      'when-#t
      (for/flvector #:length 5
                    ([x (in-range 3)]
                     #:when #t
                     [y (in-range 3)])
         (exact->inexact (+ x y))))
(test (flvector 0.0 1.0 2.0 2.0 3.0)
      'when-...
      (for/flvector #:length 5
                    ([x (in-range 3)]
                     #:when (even? x)
                     [y (in-range 3)])
        (exact->inexact (+ x y))))
(test (flvector 0.0 1.0 2.0 1.0 2.0)
      'unless-#f
      (for/flvector #:length 5
                    ([x (in-range 3)]
                     #:unless #f
                     [y (in-range 3)])
        (exact->inexact (+ x y))))
(test (flvector 1.0 2.0 3.0 0.0 0.0)
      'unless-...
      (for/flvector #:length 5
                    ([x (in-range 3)]
                     #:unless (even? x)
                     [y (in-range 3)])
        (exact->inexact (+ x y))))


;; in-flvector tests, copied from for.rktl

(test-sequence [(1.0 2.0 3.0)] (in-flvector (flvector 1.0 2.0 3.0)))
(test-sequence [(2.0 3.0 4.0)] (in-flvector (flvector 1.0 2.0 3.0 4.0) 1))
(test-sequence [(2.0 3.0 4.0)] (in-flvector (flvector 1.0 2.0 3.0 4.0 5.0) 1 4))
(test-sequence [(2.0 4.0 6.0)] (in-flvector (flvector 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0) 1 7 2))
(test-sequence [(8.0 6.0 4.0)] (in-flvector (flvector 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0) 7 1 -2))
(test-sequence [(2.0 4.0 6.0)] (in-flvector (flvector 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0) 1 6 2))
(test-sequence [(8.0 6.0 4.0)] (in-flvector (flvector 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0) 7 2 -2))

;; test malformed in-flvector
(err/rt-test (for/list ([x (in-flvector)]) x))
(err/rt-test (in-flvector))

;; flvector sequence tests

(test-sequence [(1.0 2.0 3.0)] (flvector 1.0 2.0 3.0))
(test '() 'empty-flvector-sequence (for/list ([i (flvector)]) i))

;; Check safety:
(err/rt-test (for/flvector ([i 5]) 8))
(err/rt-test (for/flvector #:length 5 ([i 5]) 8))
(err/rt-test (for/flvector #:length 5 #:fill 0.0 ([i 5]) 8))
(err/rt-test (for/flvector #:length 5 #:fill 0 ([i 5]) 8.0))
(err/rt-test (for/flvector #:length 10 #:fill 0 ([i 5]) 8.0))

;; ----------------------------------------
;; flrandom

(let ([r (make-pseudo-random-generator)]
      [seed (random 100000)])
  (define (reset)
    (parameterize ([current-pseudo-random-generator r])
      (random-seed seed)))
  (test (begin (reset) (random r))
        flrandom
        (begin (reset) r)))

(err/rt-test (flrandom 5.0))

;; ----------------------------------------
;; Check corners of `flexpt':
;;  Tests by Neil T.:

(let ()
  (define-syntax-rule (check-equal? (flexpt v1 v2) b)
    (test b flexpt v1 v2))
  
  ;; 2^53 and every larger flonum is even:
  (define +big-even.0 (expt 2.0 53))
  ;; The largest odd flonum:
  (define +max-odd.0 (- +big-even.0 1.0))

  (define -big-even.0 (- +big-even.0))
  (define -max-odd.0 (- +max-odd.0))

  (check-equal? (flexpt +0.0 +0.0) +1.0)
  (check-equal? (flexpt +0.0 +1.0) +0.0)
  (check-equal? (flexpt +0.0 +3.0) +0.0)
  (check-equal? (flexpt +0.0 +max-odd.0) +0.0)
  (check-equal? (flexpt +0.0 +0.5) +0.0)
  (check-equal? (flexpt +0.0 +1.5) +0.0)
  (check-equal? (flexpt +0.0 +2.0) +0.0)
  (check-equal? (flexpt +0.0 +2.5) +0.0)
  (check-equal? (flexpt +0.0 +big-even.0) +0.0)

  (check-equal? (flexpt -0.0 +0.0) +1.0)
  (check-equal? (flexpt -0.0 +1.0) -0.0)
  (check-equal? (flexpt -0.0 +3.0) -0.0)
  (check-equal? (flexpt -0.0 +max-odd.0) -0.0)
  (check-equal? (flexpt -0.0 +0.5) +0.0)
  (check-equal? (flexpt -0.0 +1.5) +0.0)
  (check-equal? (flexpt -0.0 +2.0) +0.0)
  (check-equal? (flexpt -0.0 +2.5) +0.0)
  (check-equal? (flexpt -0.0 +big-even.0) +0.0)

  (check-equal? (flexpt +1.0 +0.0) +1.0)
  (check-equal? (flexpt +1.0 +0.5) +1.0)
  (check-equal? (flexpt +1.0 +inf.0) +1.0)

  (check-equal? (flexpt -1.0 +0.0) +1.0)
  (check-equal? (flexpt -1.0 +0.5) +nan.0)
  (check-equal? (flexpt -1.0 +inf.0) +1.0)

  (check-equal? (flexpt +0.5 +inf.0) +0.0)
  (check-equal? (flexpt +1.5 +inf.0) +inf.0)

  (check-equal? (flexpt +inf.0 +0.0) +1.0)
  (check-equal? (flexpt +inf.0 +1.0) +inf.0)
  (check-equal? (flexpt +inf.0 +2.0) +inf.0)
  (check-equal? (flexpt +inf.0 +inf.0) +inf.0)

  (check-equal? (flexpt -inf.0 +0.0) +1.0)
  (check-equal? (flexpt -inf.0 +1.0) -inf.0)
  (check-equal? (flexpt -inf.0 +3.0) -inf.0)
  (check-equal? (flexpt -inf.0 +max-odd.0) -inf.0)
  (check-equal? (flexpt -inf.0 +0.5) +inf.0)
  (check-equal? (flexpt -inf.0 +1.5) +inf.0)
  (check-equal? (flexpt -inf.0 +2.0) +inf.0)
  (check-equal? (flexpt -inf.0 +2.5) +inf.0)
  (check-equal? (flexpt -inf.0 +big-even.0) +inf.0)
  (check-equal? (flexpt -inf.0 +inf.0) +inf.0)

  ;; Same tests as above, but with negated y
  ;; This identity should hold for these tests: (flexpt x y) = (/ 1.0 (flexpt x (- y)))

  (check-equal? (flexpt +0.0 -0.0) +1.0)
  (check-equal? (flexpt +0.0 -1.0) +inf.0)
  (check-equal? (flexpt +0.0 -3.0) +inf.0)
  (check-equal? (flexpt +0.0 -max-odd.0) +inf.0)
  (check-equal? (flexpt +0.0 -0.5) +inf.0)
  (check-equal? (flexpt +0.0 -1.5) +inf.0)
  (check-equal? (flexpt +0.0 -2.0) +inf.0)
  (check-equal? (flexpt +0.0 -2.5) +inf.0)
  (check-equal? (flexpt +0.0 -big-even.0) +inf.0)

  (check-equal? (flexpt -0.0 -0.0) +1.0)
  (check-equal? (flexpt -0.0 -1.0) -inf.0)
  (check-equal? (flexpt -0.0 -3.0) -inf.0)
  (check-equal? (flexpt -0.0 -max-odd.0) -inf.0)
  (check-equal? (flexpt -0.0 -0.5) +inf.0)
  (check-equal? (flexpt -0.0 -1.5) +inf.0)
  (check-equal? (flexpt -0.0 -2.0) +inf.0)
  (check-equal? (flexpt -0.0 -2.5) +inf.0)
  (check-equal? (flexpt -0.0 -big-even.0) +inf.0)

  (check-equal? (flexpt +1.0 -0.0) +1.0)
  (check-equal? (flexpt +1.0 -0.5) +1.0)
  (check-equal? (flexpt +1.0 -inf.0) +1.0)

  (check-equal? (flexpt -1.0 -0.0) +1.0)
  (check-equal? (flexpt -1.0 -0.5) +nan.0)
  (check-equal? (flexpt -1.0 -inf.0) +1.0)

  (check-equal? (flexpt +0.5 -inf.0) +inf.0)
  (check-equal? (flexpt +1.5 -inf.0) +0.0)

  (check-equal? (flexpt +inf.0 -0.0) +1.0)
  (check-equal? (flexpt +inf.0 -1.0) +0.0)
  (check-equal? (flexpt +inf.0 -2.0) +0.0)
  (check-equal? (flexpt +inf.0 -inf.0) +0.0)

  (check-equal? (flexpt -inf.0 -0.0) +1.0)
  (check-equal? (flexpt -inf.0 -1.0) -0.0)
  (check-equal? (flexpt -inf.0 -3.0) -0.0)
  (check-equal? (flexpt -inf.0 -max-odd.0) -0.0)
  (check-equal? (flexpt -inf.0 -0.5) +0.0)
  (check-equal? (flexpt -inf.0 -1.5) +0.0)
  (check-equal? (flexpt -inf.0 -2.0) +0.0)
  (check-equal? (flexpt -inf.0 -2.5) +0.0)
  (check-equal? (flexpt -inf.0 -big-even.0) +0.0)
  (check-equal? (flexpt -inf.0 -inf.0) +0.0)

  ;; NaN input

  (check-equal? (flexpt +nan.0 +0.0) +1.0)
  (check-equal? (flexpt +nan.0 -0.0) +1.0)
  (check-equal? (flexpt +1.0 +nan.0) +1.0)
  (check-equal? (flexpt -1.0 +nan.0) +nan.0))

;; ----------------------------------------

(test -inf.0 fllog 0.0)
(test -inf.0 fllog -0.0)
(test +nan.0 fllog -1.0)
(test +nan.0 log (fllog -1.0))

(test -0.0 flsqrt -0.0)
(test +nan.0 log (flsqrt -1.0))

;; ----------------------------------------
;; Make sure `flvector` is not incorrectly constant-folded

(let ([v (flvector 1.0 2.0 3.0)])
  (unsafe-flvector-set! v 0 10.0)
  (test 10.0 'ref (unsafe-flvector-ref v 0)))

;; ----------------------------------------

(report-errs)
