<commit_before>#lang racket/base

(require rackunit rackunit/text-ui racket/file
         mzlib/etc racket/port
         compiler/compiler racket/promise
         racket/match mzlib/compile
         racket/promise
         "unit-tests/all-tests.rkt"
         "unit-tests/test-utils.rkt"
         "optimizer/run.rkt"
         "places.rkt" "send-places.rkt")

(define (scheme-file? s)
  (regexp-match ".*[.](rkt|ss|scm)$" (path->string s)))

(define-namespace-anchor a)

(define (exn-matches . args)
  (values
   (lambda (val)
     (and (exn? val)
          (for/and ([e args])
                   (cond [(procedure? e) (e val)]
                         [(number? e)
                          (and (exn:fail:syntax? val)
                               (= e (length (exn:fail:syntax-exprs val))))]
                         [(or (string? e) (regexp? e))
                          (regexp-match e (exn-message val))]
                         [else (error 'exn-pred "bad argument" e)]))))
   args))

(define (cfile file)
  ((compile-zos #f) (list file) 'auto))

(define (exn-pred p)
  (let ([sexp (with-handlers
                  ([exn:fail? (lambda _ #f)])
                (call-with-input-file*
                 p
                 (lambda (prt)
                   (read-line prt 'any) (read prt))))])
    (match sexp
      [(list-rest 'exn-pred e)
       (eval `(exn-matches . ,e) (namespace-anchor->namespace a))]
      [_
       (exn-matches ".*Type Checker.*" exn:fail:syntax?)])))

(define (mk-tests dir test #:error [error? #f])
  (lambda ()
    (define path (build-path (this-expression-source-directory) dir))
    (define prms
      (for/list ([p (directory-list path)]
                 #:when (scheme-file? p)
		 ;; skip backup files
		 #:when (not (regexp-match #rx".*~" (path->string p))))
        (define p* (build-path path p))
        (define prm (list path p 
                          (if (places)
                              (run-in-other-place p* error?)
                              (delay 
                                (parameterize ([read-accept-reader #t]
                                               [current-load-relative-directory path]
                                               [current-directory path]
                                               [current-output-port (open-output-nowhere)])
                                  (dr p))))))
        prm))
    (define tests
      (for/list ([e prms])
        (match-define (list path p prm) e)
        (test-suite
         (path->string p)
         (test
          (build-path path p)
          (λ ()
            (when (verbose?)
              (log-warning (format "TR tests: waiting for ~a ~a" dir p)))
            (force prm))))))
    (make-test-suite dir tests)))

(define succ-tests (mk-tests "succeed"
                             (lambda (p thnk) 
                               (check-not-exn thnk))))
(define fail-tests (mk-tests "fail"
                             (lambda (p thnk)
                               (define-values (pred info) (exn-pred p))
                               (parameterize ([error-display-handler void])
                                 (with-check-info
                                  (['predicates info])
                                  (check-exn pred thnk))))
                             #:error #t))

(define (int-tests)
  (test-suite "Integration tests"
              (succ-tests)
              (fail-tests)))

(define (compile-benchmarks)
  (define (find dir)
    (for/list ([d (directory-list dir)]
               #:when (scheme-file? d))
      d))
  (define shootout (collection-path "tests" "racket" "benchmarks" "shootout" "typed"))
  (define common (collection-path "tests" "racket" "benchmarks" "common" "typed"))
  (define (mk path)
    (make-test-suite (path->string path)
                     (for/list ([p (find path)])
                       (parameterize ([current-load-relative-directory
                                       (path->complete-path path)]
                                      [current-directory path])
                         (test-suite (path->string p)
                                     (check-not-exn (λ () (cfile (build-path path p)))))))))
  (test-suite "compiling"
              (mk shootout)
              (delete-directory/files (build-path shootout "compiled"))
              (mk common)
              (delete-directory/files (build-path common "compiled"))))


(define (just-one p*)
  (define-values (path p b) (split-path p*))
  (define f<commit_msg>Make benchmarks not delete compiled code.<commit_after>#lang racket/base

(require rackunit rackunit/text-ui racket/file
         mzlib/etc racket/port
         compiler/compiler racket/promise
         racket/match syntax/modcode
         racket/promise
         "unit-tests/all-tests.rkt"
         "unit-tests/test-utils.rkt"
         "optimizer/run.rkt"
         "places.rkt" "send-places.rkt")

(define (scheme-file? s)
  (regexp-match ".*[.](rkt|ss|scm)$" (path->string s)))

(define-namespace-anchor a)

(define (exn-matches . args)
  (values
   (lambda (val)
     (and (exn? val)
          (for/and ([e args])
                   (cond [(procedure? e) (e val)]
                         [(number? e)
                          (and (exn:fail:syntax? val)
                               (= e (length (exn:fail:syntax-exprs val))))]
                         [(or (string? e) (regexp? e))
                          (regexp-match e (exn-message val))]
                         [else (error 'exn-pred "bad argument" e)]))))
   args))


(define (exn-pred p)
  (let ([sexp (with-handlers
                  ([exn:fail? (lambda _ #f)])
                (call-with-input-file*
                 p
                 (lambda (prt)
                   (read-line prt 'any) (read prt))))])
    (match sexp
      [(list-rest 'exn-pred e)
       (eval `(exn-matches . ,e) (namespace-anchor->namespace a))]
      [_
       (exn-matches ".*Type Checker.*" exn:fail:syntax?)])))

(define (mk-tests dir test #:error [error? #f])
  (lambda ()
    (define path (build-path (this-expression-source-directory) dir))
    (define prms
      (for/list ([p (directory-list path)]
                 #:when (scheme-file? p)
		 ;; skip backup files
		 #:when (not (regexp-match #rx".*~" (path->string p))))
        (define p* (build-path path p))
        (define prm (list path p 
                          (if (places)
                              (run-in-other-place p* error?)
                              (delay 
                                (parameterize ([read-accept-reader #t]
                                               [current-load-relative-directory path]
                                               [current-directory path]
                                               [current-output-port (open-output-nowhere)])
                                  (dr p))))))
        prm))
    (define tests
      (for/list ([e prms])
        (match-define (list path p prm) e)
        (test-suite
         (path->string p)
         (test
          (build-path path p)
          (λ ()
            (when (verbose?)
              (log-warning (format "TR tests: waiting for ~a ~a" dir p)))
            (force prm))))))
    (make-test-suite dir tests)))

(define succ-tests (mk-tests "succeed"
                             (lambda (p thnk) 
                               (check-not-exn thnk))))
(define fail-tests (mk-tests "fail"
                             (lambda (p thnk)
                               (define-values (pred info) (exn-pred p))
                               (parameterize ([error-display-handler void])
                                 (with-check-info
                                  (['predicates info])
                                  (check-exn pred thnk))))
                             #:error #t))

(define (int-tests)
  (test-suite "Integration tests"
              (succ-tests)
              (fail-tests)))

(define (compile-benchmarks)
  (define shootout (collection-path "tests" "racket" "benchmarks" "shootout" "typed"))
  (define common (collection-path "tests" "racket" "benchmarks" "common" "typed"))
  (define (mk dir)
    (make-test-suite (path->string dir)
                     (for/list ([file (in-list (directory-list dir))]
                                #:when (scheme-file? file))
                       (test-suite (path->string file)
                                   (check-not-exn (λ ()
                                     (get-module-code (build-path dir file)
                                       #:choose (lambda (src zo so) 'src))))))))
  (test-suite "compiling"
              (mk shootout)
              (mk common)))


(define (just-one p*)
  (define-values (path p b) (split-path p*))
  (define f
{'fraction_non_alphanumeric': 0.13811208766122587, 'fraction_numerical': 0.0, 'mean_word_length': 1.317989417989418, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 16, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 28, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2497709', 'n_tokens_mistral': 2605, 'n_tokens_neox': 2469, 'n_words': 625}