adjust contract test suite to do more provide/contract => contract-out

rewriting in order to test contract-out more

collects/tests/racket/contract-test.rktl

@@ -73,7 +73,7 @@
          (let ([for-each-eval (lambda (l) (for-each eval l))]) for-each-eval)
          (list ',expression '(void))))
       (let ([new-expression (rewrite-out expression)])
-        (unless (equal? new-expression expression)
+        (when new-expression
           (contract-eval
            `(,test
              (void)
@@ -88,6 +88,7 @@
           (list ',(rewrite expression k) '(void))))))
 
   (define (test/spec-passed/result name expression result)
+    (parameterize ([compile-enforce-module-constants #f])
       (printf "testing: ~s\n" name)
       (contract-eval `(,test ',result eval ',expression))
       (let/ec k
@@ -95,45 +96,73 @@
          `(,test
            ',result
            eval
-          ',(rewrite expression k)))))
+           ',(rewrite expression k))))
+      (let ([new-expression (rewrite-out expression)])
+        (when new-expression
+          (printf "testing contract-out rewritten: ~s\n" name)
+          (contract-eval
+           `(,test
+             ',result
+             eval
+             ',new-expression))))))
 
   ;; rewrites `provide/contract' to use `contract-out'
   (define (rewrite-out orig-exp)
+    (define rewrote? #f)
+    (define maybe-rewritten?
       (let loop ([exp orig-exp])
         (match exp
           [`(module ,modname ,lang ,bodies ...)
            (define at-beginning '())
+           (define at-end '())
            
-         ;; remove (and save) the provide/contract declarations
+           ;; remove (and save) the provide/contract & contract-out
+           ;; declarations, switching their senses
            (define removed-bodies
              (apply
               append
               (for/list ([body (in-list bodies)])
                 (match body
                   [`(provide/contract . ,args)
+                   (set! rewrote? #t)
                    (set! at-beginning (cons `(provide (contract-out . ,args))
                                             at-beginning))
                    (list)]
+                  [`(provide (contract-out . ,args))
+                   (set! rewrote? #t)
+                   (set! at-end (cons `(provide/contract . ,args)
+                                      at-end))
+                   (list)]
                   [else
                    (list body)]))))
            
            ;; insert the provide/contract (rewrite to contract-out) after the
            ;; first require that has 'contract' in it
            (define inserted-bodies
+             (if (equal? lang 'racket)
+                 (append (reverse at-beginning)
+                         removed-bodies)
                  (apply
                   append
                   (for/list ([body (in-list removed-bodies)])
                     (match body
-                [`(require ,(? (λ (x) (and (symbol? x) (regexp-match #rx"contract" (symbol->string x)))) mod))
+                      [`(require . ,(? (λ (l)
+                                         (for/or ([x (in-list l)])
+                                           (and (symbol? x)
+                                                (regexp-match #rx"contract" (symbol->string x)))))))
                        (cons body (reverse at-beginning))]
                       [else
-                 (list body)]))))
+                       (list body)])))))
            
-         `(module ,modname ,lang ,@inserted-bodies)]
+           `(module ,modname ,lang 
+              (void) ;; always insert this to work around bug in 'provide'
+              ,@inserted-bodies ,@(reverse at-end))]
           [(? list?)
            (map loop exp)]
           [else exp])))
     
+    (and rewrote? maybe-rewritten?))
+
   ;; rewrites `contract' to use opt/c. If there is a module definition in there, we skip that test.
   (define (rewrite exp k)
     (let loop ([exp exp])