Make known bugs executable.

pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/known-bugs.rkt

@@ -1,172 +1,160 @@
-#lang typed/racket
+#lang racket/base
 
-(require racket/flonum racket/fixnum racket/unsafe/ops)
+(require
+  rackunit
+  racket/sandbox
+  racket/flonum racket/fixnum racket/unsafe/ops
+  racket/math
+  syntax/srcloc
+  (for-syntax
+    racket/base
+    syntax/parse))
 
-;; List of cases where the TR optimizer changes the semantics of programs.
-;; These give different results in optimized TR and in untyped Racket.
-;; Mostly found using random testing.
+(provide tests)
 
-;; is:        +inf.0+nan.0i
-;; should be: +inf.0-0.0i
-(/
- (cosh (tanh (min 0)))
- (sqr (make-polar 9.8813129168249e-324 5.64234687795904e-184)))
-(/
- 1.0
- (sqr 9.8813129168249e-324+0.0i))
-(/ 1.0 0.0+0.0i)
 
-;; is:        +nan.0+nan.0i
-;; should be: +nan.0+0.0i
-(/
- (*
-  (max 3/11 3/2 -0.0f0)
-  (unsafe-fl* (real->double-flonum 0.0034637533f0) (real->double-flonum 2)))
- (*
-  0.47415978f0
-  (max (exact-round 0) (exact-round 2) (exact-round 1.3396765f0))
-  (make-rectangular +inf.0 -2.6138428f-05)))
+(define (mk-eval lang)
+  (call-with-trusted-sandbox-configuration
+   (λ ()
+     (parameterize ([sandbox-memory-limit 300])
+       (make-evaluator lang)))))
+(define racket-eval (mk-eval 'racket))
+(define tr-eval     (mk-eval 'typed/racket))
 
-;; is:        +nan.0+nan.0i
-;; should be: -0.0+nan.0i
-(- (/ (ceiling 1.4821969375237e-323) (make-rectangular 1/3 -inf.0)))
-
-;; is:        +inf.0+nan.0i
-;; should be: +inf.0-26.76011085510254i
-(+
- (make-rectangular 2.8794524657050558e-173 -26.76011f0)
- (max (sub1 (exact-round -0.0)))
- (*
-  (fltruncate (real->double-flonum 3))
-  (abs (real->double-flonum -9.194802638300139))
-  (real->double-flonum +inf.f)))
-
-;; is:        +nan.0+nan.0i
-;; should be: +nan.0+0.0i
-(/
- (* (fltruncate (real->double-flonum -0.0961751594300051)))
- (make-polar
-  (unsafe-flmin (real->double-flonum 0) (real->double-flonum 9))
-  (-
-   (real->double-flonum 1.797693134862315e+308)
-   (real->double-flonum 4.557755020079188e-100)
-   (real->double-flonum -1.7568234f0))))
-
-;; is:        +nan.0+nan.0i
-;; should be: 0.0+nan.0i
-(/ (make-rectangular (+ (real->double-flonum 7/12)) 1.7976931348623157e+308))
-
-;; is:        +inf.0+nan.0i
-;; should be: +inf.0+8.162406973444716e+297i
-(+
- (truncate
-  (bitwise-xor
-   (exact-round 3.4584595208887e-323)
-   (exact-round 41.25529f0)
-   (exact-round 5)))
- (abs (exact-round 1.0117665851393622))
- (/
-  (make-rectangular -inf.0 -1.7976931348623157e+308)
-  (+ -22024056634.94161 -3.141574f0 0.0)))
-
-;; is:        -inf.0+nan.0i
-;; should be: -inf.0-0.042647640432547915i
-(/
- (make-rectangular
-  (max (real->double-flonum +inf.f) (real->double-flonum 2))
-  (min (real->double-flonum 9) (real->double-flonum 1)))
- -23.447956f0)
-
-;; is:        -15.99999536766402+0.31099018454551697i
-;; should be: -15.999995231628418+0.31099018454551697i
-(-
- (* 6/11 (/ 1.2125638f0 142778.6f0))
- (sqr (* -4))
- (make-rectangular
-  (unsafe-fl* (real->double-flonum 1) (real->double-flonum 0))
-  (min (real->double-flonum -0.31099018f0))))
-
-;; is:        +inf.0+nan.0i
-;; should be: +inf.0+1.976262583365e-322i
-(/
- (+ (sqr 6.1239376f0) (make-rectangular -inf.f -2.4703282292062e-323))
- (max -1/8))
-
-;; is:        +nan.0+nan.0i
-;; should be: +nan.0+inf.0i
-(-
- (* -1 (+ 2 -1.863321008013001) (/ +nan.0 -3 -0.2859221f0))
- (bitwise-xor
-  (exact-round -2.5171401615688167e-250)
-  (exact-round 9/5)
-  (add1 (exact-round 0)))
- (sinh (/ (make-rectangular 1.7976931348623155e+308 -13/21) 2)))
-
-;; is:        +nan.0+nan.0i
-;; should be: -inf.0-inf.0i
-(/ (cosh (make-rectangular +inf.0 -1.7082773f0)) 8)
-
-;; is:        +nan.0+nan.0i
-;; should be: +nan.0-0.0i
-(/
- (make-rectangular
-  -1.0020975423559487e+94
-  (*
-   (real->double-flonum 9.8813129168249e-324)
-   (real->double-flonum -5/7)
-   (real->double-flonum -3))))
+(define-syntax bad-opt
+  (syntax-parser
+    [(_ exp:expr)
+     #`(test-case #,(format "~a" (syntax->datum #'exp))
+         (define r-value (racket-eval #'exp))
+         (define tr-value (tr-eval #'exp))
+         (with-check-info (['r-value r-value]
+                           ['tr-value tr-value]
+                           ['location (build-source-location-list (quote-syntax exp))])
+           (when (equal? r-value tr-value)
+             (fail-check "Known bug no longer exists."))))]))
 
+;; TODO add this as a test
 ;; type-before = Single-Flonum-Complex
 ;; type-after = Float-Complex
 ;; redex-check: <collects>/tests/typed-racket/tr-random-testing.rkt:258
 ;; counterexample found after 499 attempts:
-(log (make-rectangular -inf.f -inf.f))
+;(log (make-rectangular -inf.f -inf.f))
 
-;; is:        9.5+inf.0i
-;; should be: 9.5+inf.0i
-(/
- (make-rectangular
-  (- (real->double-flonum 9) (real->double-flonum -1/2))
-  +inf.0)
- (flexpt
-  (abs (real->double-flonum 1.2370933818061895e+67))
-  (real->double-flonum 0.0f0))
- (cos (min (exact-round 6.65203545785633) (exact-round -2.6796508f-29))))
+(define tests
+  (test-suite "Known bugs"
+    (bad-opt (/ (cosh (tanh (min 0)))
+                (sqr (make-polar 9.8813129168249e-324 5.64234687795904e-184))))
+    (bad-opt (/ 1.0 (sqr 9.8813129168249e-324+0.0i)))
+    (bad-opt (/ 1.0 0.0+0.0i))
 
-;; is:        +nan.0+nan.0i
-;; should be: -1.0+nan.0i
-(sub1 (/ (make-rectangular -5.5945454f0 -inf.0)))
+    (bad-opt
+      (/
+       (*
+        (max 3/11 3/2 -0.0f0)
+        (unsafe-fl* (real->double-flonum 0.0034637533f0) (real->double-flonum 2)))
+       (*
+        0.47415978f0
+        (max (exact-round 0) (exact-round 2) (exact-round 1.3396765f0))
+        (make-rectangular +inf.0 -2.6138428f-05))))
 
-;; is:        -inf.0+nan.0i
-;; should be: -inf.0+3.449695564532713i
-(*
- (make-rectangular -inf.0 2.360318017838172)
- (* 1 (max (exact-round 1)))
- 19/13)
+    (bad-opt (- (/ (ceiling 1.4821969375237e-323) (make-rectangular 1/3 -inf.0))))
 
-;; is:        +nan.0+nan.0i
-;; should be: 0.0+nan.0i
-(/ (make-rectangular 1 +inf.0))
-(/ (make-rectangular 1.0 +inf.0))
+    (bad-opt
+      (+
+       (make-rectangular 2.8794524657050558e-173 -26.76011f0)
+       (max (sub1 (exact-round -0.0)))
+       (*
+        (fltruncate (real->double-flonum 3))
+        (abs (real->double-flonum -9.194802638300139))
+        (real->double-flonum +inf.f))))
 
-;; is:        1.0+0.0
-;; should be: +inf.0+0.0
-(+
-  (exp 1.7976931348623151e+308)
-  0.0+0.0i)
+    (bad-opt
+      (/
+       (* (fltruncate (real->double-flonum -0.0961751594300051)))
+       (make-polar
+        (unsafe-flmin (real->double-flonum 0) (real->double-flonum 9))
+        (-
+         (real->double-flonum 1.797693134862315e+308)
+         (real->double-flonum 4.557755020079188e-100)
+         (real->double-flonum -1.7568234f0)))))
 
-;; is:        1.0+0.0i
-;; should be: 1.0-0.0i
-(conjugate 1.0+0.0i)
+    (bad-opt (/ (make-rectangular (+ (real->double-flonum 7/12)) 1.7976931348623157e+308)))
 
-;; is:        +nan.0+nan.0i
-;; should be: 1.0+1.0i
-(* (expt 10 500) (expt 10 -500) 1.0+1.0i)
 
-;; is:        +nan.0+1.0i
-;; should be: 1.0+1.0i
-(+ (expt 10 501) (expt -10 501) 1.0+1.0i)
+    (bad-opt
+      (+
+       (truncate
+        (bitwise-xor
+         (exact-round 3.4584595208887e-323)
+         (exact-round 41.25529f0)
+         (exact-round 5)))
+       (abs (exact-round 1.0117665851393622))
+       (/
+        (make-rectangular -inf.0 -1.7976931348623157e+308)
+        (+ -22024056634.94161 -3.141574f0 0.0))))
 
-;; is:        0.0+0.0i
-;; should be: -0.0-0.0i
-(- (+ 0 0) 0.0+0.0i)
+    (bad-opt
+      (/
+       (make-rectangular
+        (max (real->double-flonum +inf.f) (real->double-flonum 2))
+        (min (real->double-flonum 9) (real->double-flonum 1)))
+       -23.447956f0))
+
+    (bad-opt
+      (-
+       (* 6/11 (/ 1.2125638f0 142778.6f0))
+       (sqr (* -4))
+       (make-rectangular
+        (unsafe-fl* (real->double-flonum 1) (real->double-flonum 0))
+        (min (real->double-flonum -0.31099018f0)))))
+
+    (bad-opt
+      (/
+        (+ (sqr 6.1239376f0) (make-rectangular -inf.f -2.4703282292062e-323))
+        (max -1/8)))
+
+    (bad-opt
+      (-
+       (* -1 (+ 2 -1.863321008013001) (/ +nan.0 -3 -0.2859221f0))
+       (bitwise-xor
+        (exact-round -2.5171401615688167e-250)
+        (exact-round 9/5)
+        (add1 (exact-round 0)))
+       (sinh (/ (make-rectangular 1.7976931348623155e+308 -13/21) 2))))
+
+    (bad-opt
+      (/ (cosh (make-rectangular +inf.0 -1.7082773f0)) 8))
+
+    (bad-opt
+      (/
+       (make-rectangular
+        -1.0020975423559487e+94
+        (*
+         (real->double-flonum 9.8813129168249e-324)
+         (real->double-flonum -5/7)
+         (real->double-flonum -3)))))
+
+    (bad-opt (sub1 (/ (make-rectangular -5.5945454f0 -inf.0))))
+
+    (bad-opt
+      (*
+       (make-rectangular -inf.0 2.360318017838172)
+       (* 1 (max (exact-round 1)))
+       19/13))
+
+    (bad-opt (/ (make-rectangular 1 +inf.0)))
+    (bad-opt (/ (make-rectangular 1.0 +inf.0)))
+
+    (bad-opt (+ (exp 1.7976931348623151e+308) 0.0+0.0i))
+
+    (bad-opt (* (expt 10 500) (expt 10 -500) 1.0+1.0i))
+
+    (bad-opt (+ (expt 10 501) (expt -10 501) 1.0+1.0i))
+
+
+
+    (bad-opt (- (+ 0 0) 0.0+0.0i))))
+
+(module+ main
+  (require rackunit/text-ui)
+  (void (run-tests tests)))