From de753399b6dd27c3c61ef3ba4225ca50a65c56fb Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 9 Oct 2018 15:07:31 -0600
Subject: [PATCH] racketcs: add support for `-m` flag

---
 .../tests/racket/place-channel-fd3.rkt        |  4 ++--
 racket/src/cs/main.sps                        | 22 +++++++++++++++++++
 racket/src/expander/main.rkt                  |  1 +
 racket/src/io/port/fd-port.rkt                |  2 +-
 4 files changed, 26 insertions(+), 3 deletions(-)

diff --git a/pkgs/racket-test/tests/racket/place-channel-fd3.rkt b/pkgs/racket-test/tests/racket/place-channel-fd3.rkt
index 8dfac563af..a4dde9dd3f 100644
--- a/pkgs/racket-test/tests/racket/place-channel-fd3.rkt
+++ b/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 "stdio" "port dup failed"))
+  (check "tcp" "socket dup failed|error during dup of file descriptor")
+  (check "stdio" "port dup failed|error during dup of file descriptor"))
 
diff --git a/racket/src/cs/main.sps b/racket/src/cs/main.sps
index b073c1e166..3edf1bb0d3 100644
--- a/racket/src/cs/main.sps
+++ b/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)))
diff --git a/racket/src/expander/main.rkt b/racket/src/expander/main.rkt
index 19880a3d24..4ad70c6f7b 100644
--- a/racket/src/expander/main.rkt
+++ b/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
diff --git a/racket/src/io/port/fd-port.rkt b/racket/src/io/port/fd-port.rkt
index f088ba4751..be41937975 100644
--- a/racket/src/io/port/fd-port.rkt
+++ b/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))