<commit_before>#lang racket/base
(provide test-files!
         make-cover-environment
         get-test-coverage
         current-cover-environment environment?
         environment-compile environment-namespace
         coverage-wrapper-map
         run-file! 
         kernelize-namespace!)

#|

This module, and its partner strace.rkt implement code coverage.  In essence code coverage consists
of a protocol for between this file and all covered files, with the loger begin the communication
channel.

This module maintains a mapping between src locations in files to be covered and positions in a set
of vectors. The annotation in strace.rkt its given (mutable) access to this mapping, and an empty
set of vectors. During compilation the annotator will fill in the vector mapping and allocate the
vectors.

At annotate-module load time the module will log a request for its vector across using a pre-known
log topic combined with a key unique to each coverage environment. This module will log a responce
on a different pre-known key (combined with the same unique key). The data in this responce will be
the file->vector mapping.


Thus, In essence this module has three responsibilites:
1. setup a listening thread to responde to the protocol described above.
2. compile and run all test modules with the annotator and a coverage environment
3. interperet the coverage vectors into something useable.

|#

(require (for-syntax racket/base))
(require racket/dict
         syntax/modcode
         racket/function
         syntax/modread
         syntax/modresolve
         syntax/parse
         racket/bool
         racket/runtime-path
         racket/match
         racket/path
         racket/syntax
         rackunit/log
         racket/list
         racket/port
         racket/set
         custom-load
         "private/shared.rkt"
         "private/file-utils.rkt"
         "private/format-utils.rkt"
         "strace.rkt")

;; An environment has:
;; a `namespace`
;; a handler for `current-compile`
;; a function that will annoate expanded code, given a file name
;; a topic for logs to be reiceved on. Must be unique for every environment
;; a hash map from srcloc to (List filename index)
;; a hash map from filename to [Vector bool]. Each vector location maps to a srcloc
;;   via the table in coverage-srcloc-mapping
(struct environment (namespace compile ann-top topic
                               coverage-srcloc-mapping
                               coverage-vector-mapping))
;; A special structure used for communicating information about programs that call `exit`
;; `code` is the exit code that `exit` was called with
(struct an-exit (code))

;;; ---------------------- Running Files ---------------------------------
(define current-live-files (make-parameter #f))

;; Test files and build coverage map
;; returns true if no tests reported as failed, and no files errored.
(define (test-files! #:submod [submod-names 'test] #:env [env (current-cover-environment)]
                     #:dont-compile [dont-compile null]
                     . files)
  (parameterize ([current-cover-environment env])
    (define abs
      (for/list ([p (in-list files)])
        (if (list? p)
            (cons (->absolute (car p)) (cdr p))
            (->absolute p))))
    (define abs-names
      (for/list ([p (in-list abs)])
        (match p
          [(cons p _) p]
          [_ p])))
    (define excludes (map ->absolute dont-compile))
    (define cover-load/use-compiled (make-cover-load/use-compiled abs-names))
    (define tests-failed
      (parameterize* ([current-load/use-compiled cover-load/use-compiled]
                      [current-namespace (get-namespace)]
                      [current-live-files (list->set abs-names)])
        (with-cover-loggers
         (define-values (_ t1 t2 t3)
           (time-apply
            (lambda ()
              (for ([f (in-list abs-names)]
                    #:unless (member f excludes))
                (log-cover-info "instrumenting: ~a" f)
                (compile-file f)))
            null))
         (log-cover-benchmark-info "compile: ~a" (list t1 t2 t3))
         (define-values (result t11 t22 t33)
           (time-apply
            (lambda ()
              (for*/fold ([tests-failed #f])
                         ([f (in-list abs)]
                          [submod-name (in-list (if (list? submod-names)
                                                    submod-names
                                                    (list submod-names)))])
                (log-cover-info "running file: ~a" f)
                (define failed? (handle-file f submod-name))
                (or failed? tests-failed)))
            null))
         (log-cover-benchmark-info "run: ~a" (list t1 t2 t3))
         result)))
    (log-cover-debug "ran ~s\n" files)
    (not tests-failed)))

(define-syntax-rule (with-cover-loggers e ...)
  (with-cover-loggersf (lambda () e ...)))

(define (with-cover-loggersf f)
  (with-intercepted-logging/receiver
   (cover-give-file-mapping)
   f
   (make-log-receiver
    (current-logger)
    'info
    (format-symbol "~a~a" (get-topic) 'cover-internal-request-vector-mapping))))
  

;; we dont care what the msg content is, just send the vector back
(define (cover-give-file-mapping)
  (define topic (format-symbol "~a~a" (get-topic) 'cover-internal-send-vector-mapping))
  (lambda (_)
    (log-message (current-logger)
                 'info
                 topic<commit_msg>log correct value<commit_after>#lang racket/base
(provide test-files!
         make-cover-environment
         get-test-coverage
         current-cover-environment environment?
         environment-compile environment-namespace
         coverage-wrapper-map
         run-file! 
         kernelize-namespace!)

#|

This module, and its partner strace.rkt implement code coverage.  In essence code coverage consists
of a protocol for between this file and all covered files, with the loger begin the communication
channel.

This module maintains a mapping between src locations in files to be covered and positions in a set
of vectors. The annotation in strace.rkt its given (mutable) access to this mapping, and an empty
set of vectors. During compilation the annotator will fill in the vector mapping and allocate the
vectors.

At annotate-module load time the module will log a request for its vector across using a pre-known
log topic combined with a key unique to each coverage environment. This module will log a responce
on a different pre-known key (combined with the same unique key). The data in this responce will be
the file->vector mapping.


Thus, In essence this module has three responsibilites:
1. setup a listening thread to responde to the protocol described above.
2. compile and run all test modules with the annotator and a coverage environment
3. interperet the coverage vectors into something useable.

|#

(require (for-syntax racket/base))
(require racket/dict
         syntax/modcode
         racket/function
         syntax/modread
         syntax/modresolve
         syntax/parse
         racket/bool
         racket/runtime-path
         racket/match
         racket/path
         racket/syntax
         rackunit/log
         racket/list
         racket/port
         racket/set
         custom-load
         "private/shared.rkt"
         "private/file-utils.rkt"
         "private/format-utils.rkt"
         "strace.rkt")

;; An environment has:
;; a `namespace`
;; a handler for `current-compile`
;; a function that will annoate expanded code, given a file name
;; a topic for logs to be reiceved on. Must be unique for every environment
;; a hash map from srcloc to (List filename index)
;; a hash map from filename to [Vector bool]. Each vector location maps to a srcloc
;;   via the table in coverage-srcloc-mapping
(struct environment (namespace compile ann-top topic
                               coverage-srcloc-mapping
                               coverage-vector-mapping))
;; A special structure used for communicating information about programs that call `exit`
;; `code` is the exit code that `exit` was called with
(struct an-exit (code))

;;; ---------------------- Running Files ---------------------------------
(define current-live-files (make-parameter #f))

;; Test files and build coverage map
;; returns true if no tests reported as failed, and no files errored.
(define (test-files! #:submod [submod-names 'test] #:env [env (current-cover-environment)]
                     #:dont-compile [dont-compile null]
                     . files)
  (parameterize ([current-cover-environment env])
    (define abs
      (for/list ([p (in-list files)])
        (if (list? p)
            (cons (->absolute (car p)) (cdr p))
            (->absolute p))))
    (define abs-names
      (for/list ([p (in-list abs)])
        (match p
          [(cons p _) p]
          [_ p])))
    (define excludes (map ->absolute dont-compile))
    (define cover-load/use-compiled (make-cover-load/use-compiled abs-names))
    (define tests-failed
      (parameterize* ([current-load/use-compiled cover-load/use-compiled]
                      [current-namespace (get-namespace)]
                      [current-live-files (list->set abs-names)])
        (with-cover-loggers
         (define-values (_ t1 t2 t3)
           (time-apply
            (lambda ()
              (for ([f (in-list abs-names)]
                    #:unless (member f excludes))
                (log-cover-info "instrumenting: ~a" f)
                (compile-file f)))
            null))
         (log-cover-benchmark-info "compile: ~a" (list t1 t2 t3))
         (define-values (result t11 t22 t33)
           (time-apply
            (lambda ()
              (for*/fold ([tests-failed #f])
                         ([f (in-list abs)]
                          [submod-name (in-list (if (list? submod-names)
                                                    submod-names
                                                    (list submod-names)))])
                (log-cover-info "running file: ~a" f)
                (define failed? (handle-file f submod-name))
                (or failed? tests-failed)))
            null))
         (log-cover-benchmark-info "run: ~a" (list t11 t22 t33))
         result)))
    (log-cover-debug "ran ~s\n" files)
    (not tests-failed)))

(define-syntax-rule (with-cover-loggers e ...)
  (with-cover-loggersf (lambda () e ...)))

(define (with-cover-loggersf f)
  (with-intercepted-logging/receiver
   (cover-give-file-mapping)
   f
   (make-log-receiver
    (current-logger)
    'info
    (format-symbol "~a~a" (get-topic) 'cover-internal-request-vector-mapping))))
  

;; we dont care what the msg content is, just send the vector back
(define (cover-give-file-mapping)
  (define topic (format-symbol "~a~a" (get-topic) 'cover-internal-send-vector-mapping))
  (lambda (_)
    (log-message (current-logger)
                 'info
                 topic
{'fraction_non_alphanumeric': 0.1089515466739666, 'fraction_numerical': 0.0035587188612099642, 'mean_word_length': 2.079516718179264, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 13, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 8, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2100246', 'n_tokens_mistral': 3056, 'n_tokens_neox': 2946, 'n_words': 1047}