racketcs: add support for -m flag

pkgs/racket-test/tests/racket/place-channel-fd3.rkt

@@ -41,6 +41,6 @@
       (error "output did not match expected pattern: "
              (get-output-bytes s))))
 
-  (check "tcp" "socket dup failed")
+  (check "tcp" "socket dup failed|error during dup of file descriptor")
-  (check "stdio" "port dup failed"))
+  (check "stdio" "port dup failed|error during dup of file descriptor"))
 

racket/src/cs/main.sps

@@ -24,6 +24,10 @@
                module-declared?
                module->language-info
                module-path-index-join
+               identifier-binding
+               namespace-datum-introduce
+               datum->kernel-syntax
+               namespace-variable-value
                version
                exit
                compile-keep-source-locations!
@@ -279,6 +283,12 @@
                          (eval (read (open-input-string expr))))
                        loads))
                 (flags-loop rest-args (see saw 'non-config)))]
+             [("-m" "--main")
+              (set! loads
+                    (cons
+                     (lambda () (call-main))
+                     loads))
+              (flags-loop (cdr args) (see saw 'non-config))]
              [("-i" "--repl") 
               (set! repl? #t)
               (set! version? #t)
@@ -363,6 +373,18 @@
                 ;; Non-flag argument
                 (finish args saw)])])))))
 
+   (define (call-main)
+     (let ([m (namespace-datum-introduce 'main)])
+       (unless (identifier-binding m)
+         (namespace-variable-value 'main #f
+                                   (lambda ()
+                                     (error "main: not defined or required into the top-level environment"))))
+       (call-with-values (lambda () (eval (datum->kernel-syntax
+                                           (cons m (vector->list remaining-command-line-arguments)))))
+         (lambda results
+           (let ([p (|#%app| current-print)])
+             (for-each (lambda (v) (|#%app| p v)) results))))))
+
    ;; Set up GC logging
    (define-values (struct:gc-info make-gc-info gc-info? gc-info-ref gc-info-set!)
      (make-struct-type 'gc-info #f 10 0 #f null 'prefab #f '(0 1 2 3 4 5 6 7 8 9)))

racket/src/expander/main.rkt

@@ -101,6 +101,7 @@
          namespace-attach-module
          namespace-attach-module-declaration
          namespace-mapped-symbols
+         namespace-variable-value
          
          module-path-index?
          module-path-index-join

racket/src/io/port/fd-port.rkt

@@ -369,7 +369,7 @@
   (define new-fd (rktio_dup rktio fd))
   (when (rktio-error? new-fd)
     (end-atomic)
-    (raise-rktio-error 'place-channel-put new-fd "error during duping file descriptor"))
+    (raise-rktio-error 'place-channel-put new-fd "error during dup of file descriptor"))
   (define fd-dup (box (rktio_fd_detach rktio new-fd)))
   (unsafe-add-global-finalizer fd-dup (lambda ()
                                         (define fd (unbox fd-dup))