fix a bug that inhibited online compilation from writing out .zo files

when it compiles required files

Now that this is fixed, the compilation manager will be (once again)
active when doing online compilation, so if the "Populate compiled
directories" checkbox is check (which it is by default) in the details
section of the language dialog, then online compilation will, as it
compiles your file, write out .zo files that will also be used by the
Run button.

The actual fix to this bug is the change in expanding-place.rkt (and
all it really does is move the setting of the
current-load/use-compiled and current-load parameters earlier so that
CM sees only the modified parameter settings and so doesn't give up on
compilation.

The rest of the changes are a test case (and change to drracket to
support the test case)

collects/drracket/private/expanding-place.rkt

@@ -97,6 +97,24 @@
          (define sema (make-semaphore 0))
          (ep-log-info "expanding-place.rkt: 02 setting basic parameters")
          (set-basic-parameters/no-gui)
+         
+         (define loaded-paths '())
+         (define original-path (make-parameter #f))
+         (current-load/use-compiled
+          (let ([ol (current-load/use-compiled)])
+            (λ (path mod-name)
+              (parameterize ([original-path path])
+                (ol path mod-name)))))
+         (current-load
+          (let ([cl (current-load)])
+            (λ (path mod-name)
+              (set! loaded-paths
+                    (cons (or (current-module-declare-source)
+                              (original-path)
+                              path)
+                          loaded-paths))
+              (cl path mod-name))))
+         
          (ep-log-info "expanding-place.rkt: 03 setting module language parameters")
          (set-module-language-parameters settings
                                          module-language-parallel-lock-client
@@ -110,7 +128,6 @@
          (ep-log-info "expanding-place.rkt: 05 installing security guard")
          (install-security-guard) ;; must come after the call to set-module-language-parameters
          (ep-log-info "expanding-place.rkt: 06 setting uncaught-exception-handler")
-         (define loaded-paths '())
          (uncaught-exception-handler
           (λ (exn)
             (parameterize ([current-custodian orig-cust])
@@ -143,24 +160,9 @@
          (define io-sema (make-semaphore 0))
          (when log-io?
            (thread (λ () (catch-and-log in io-sema))))
-         (define original-path (make-parameter #f))
          (define expanded 
            (parameterize ([current-output-port out]
-                          [current-error-port out]
-                          [current-load/use-compiled
-                           (let ([ol (current-load/use-compiled)])
-                             (λ (path mod-name)
-                               (parameterize ([original-path path])
-                                 (ol path mod-name))))]
-                          [current-load
-                           (let ([cl (current-load)])
-                             (λ (path mod-name)
-                               (set! loaded-paths
-                                     (cons (or (current-module-declare-source)
-                                               (original-path)
-                                               path)
-                                           loaded-paths))
-                               (cl path mod-name)))])
+                          [current-error-port out])
              (expand transformed-stx)))
          (when log-io?
            (close-output-port out)

collects/drracket/private/local-member-names.rkt

@@ -29,3 +29,23 @@
 ;; online check syntax has finished
 (define-local-member-name
   get-online-expansion-colors)
+
+
+
+;; used by the module language  
+(define-local-member-name
+  frame-show-bkg-running
+  set-expand-error/status
+  update-frame-expand-error
+  expand-error-next
+  expand-error-prev
+  hide-module-language-error-panel
+  fetch-data-to-send
+  clear-old-error
+  set-bottom-bar-status
+  
+  get-oc-status
+  set-oc-status
+  
+  set-dep-paths
+  set-dirty-if-dep)

collects/drracket/private/module-language.rkt

@@ -27,6 +27,23 @@
          "rectangle-intersect.rkt"
          framework/private/logging-timer)
 
+;; submodule to make these accessible to the test suite
+(module oc-status-structs racket/base
+  ;; the online compilation state for individual tabs
+  ;; oc-state is either:
+  ;;   (clean symbol? string? (listof (vector number? number?)))
+  ;;   (dirty boolean?)
+  ;;   (running symbol? string?)
+  (struct clean (error-type error-message error-locs) #:transparent)
+  (struct dirty (timer-pending?) #:transparent)
+  (struct running (sym str) #:transparent)
+  
+  (provide (struct-out clean)
+           (struct-out dirty)
+           (struct-out running)))
+
+(require (submod "." oc-status-structs))
+
 #|
 ;; this code tracks which lines have been executed 
 ;; for use while (manually) testing the oc state machine
@@ -883,23 +900,6 @@
                              filename))))))]
         [else #f])))
   
-  (define-local-member-name
-    frame-show-bkg-running
-    set-expand-error/status
-    update-frame-expand-error
-    expand-error-next
-    expand-error-prev
-    hide-module-language-error-panel
-    fetch-data-to-send
-    clear-old-error
-    set-bottom-bar-status
-    
-    get-oc-status
-    set-oc-status
-    
-    set-dep-paths
-    set-dirty-if-dep)
-  
   (define online-expansion-logger (make-logger 'online-expansion-state-machine (current-logger)))
   (define-syntax-rule
     (define/oc-log (id . args) . body)
@@ -1702,15 +1702,6 @@
       (super-new [stretchable-width #f] [stretchable-height #f])))
 
   
-  ;; the online compilation state for individual tabs
-  ;; oc-state is either:
-  ;;   (clean symbol? string? (listof (vector number? number?)))
-  ;;   (dirty boolean?)
-  ;;   (running symbol? string?)
-  (struct clean (error-type error-message error-locs) #:transparent)
-  (struct dirty (timer-pending?) #:transparent)
-  (struct running (sym str) #:transparent)
-  
   ;; get-current-oc-state : -> (or/c tab #f) (or/c tab #f) (listof tab) (listof tab)
   ;; the tabs in the results are only those that are in the module language
   (define (get-current-oc-state)

collects/tests/drracket/online-compilation-zo-creation.rkt

@@ -0,0 +1,44 @@
+#lang racket/base
+(require "private/drracket-test-util.rkt"
+         racket/file
+         drracket/private/local-member-names
+         racket/class
+         racket/path
+         (submod drracket/private/module-language oc-status-structs))
+(fire-up-drracket-and-run-tests 
+ (λ ()
+   (define tmp-dir (make-temporary-file "online-compilation-zo-creation~a" 'directory))
+   (define x.rkt (build-path tmp-dir "x.rkt"))
+   (define y.rkt (build-path tmp-dir "y.rkt"))
+   (call-with-output-file x.rkt
+     (λ (port)
+       (fprintf port "#lang racket/base\n")
+       (fprintf port "~s\n" `(require "y.rkt")))
+     #:exists 'truncate)
+   (call-with-output-file y.rkt
+     (λ (port)
+       (fprintf port "#lang racket/base\n"))
+     #:exists 'truncate)
+   (define drs-frame (wait-for-drracket-frame))
+   (queue-callback/res
+    (λ ()
+      (send (send drs-frame get-definitions-text) load-file x.rkt)))
+   (poll-until
+    (λ ()
+      (queue-callback/res
+       (λ ()
+         (clean? (send (send drs-frame get-current-tab) get-oc-status))))))
+   
+   (define compiled-dir-files
+     (cond
+       [(directory-exists? (build-path tmp-dir "compiled"))
+        (for/list ([file (in-directory (build-path tmp-dir "compiled"))])
+          (path->string (find-relative-path tmp-dir file)))]
+       [else
+        '()]))
+   (define expected-file "compiled/drracket/errortrace/y_rkt.zo")
+   (unless (member expected-file compiled-dir-files)
+     (eprintf "expected to find ~s in compiled dir but it contained ~s\n"
+              expected-file compiled-dir-files))
+   
+   (delete-directory/files tmp-dir)))