Merge pull request #896 from pyrmont/bugfix.run-context-current-file

Only set :current-file in run-context if source is a path

src/boot/boot.janet

@@ -2263,7 +2263,7 @@
     * `:chunks` - callback to read into a buffer - default is getline
     * `:on-parse-error` - callback when parsing fails - default is bad-parse
     * `:env` - the environment to compile against - default is the current env
-    * `:source` - string path of source for better errors - default is "<anonymous>"
+    * `:source` - source path for better errors (use keywords for non-paths) - default is :<anonymous>
     * `:on-compile-error` - callback when compilation fails - default is bad-compile
     * `:on-compile-warning` - callback for any linting error - default is warn-compile
     * `:evaluator` - callback that executes thunks. Signature is (evaluator thunk source env where)
@@ -2295,13 +2295,13 @@
   (default on-compile-warning warn-compile)
   (default on-parse-error bad-parse)
   (default evaluator (fn evaluate [x &] (x)))
+  (default default-where :<anonymous>)
   (default guard :ydt)
 
   (var where default-where)
 
-  (if where
-    (put env :current-file where)
-    (set where "<anonymous>"))
+  (if (string? where)
+    (put env :current-file where))
 
   # Evaluate 1 source form in a protected manner
   (def lints @[])
@@ -2380,13 +2380,10 @@
         (buffer/clear buf))
 
       [:source new-where]
-      (if (string? new-where)
-        (do
-          (set where new-where)
-          (put env :current-file new-where))
-        (do
-          (set where default-where)
-          (put env :current-file nil)))
+      (do
+        (set where new-where)
+        (if (string? new-where)
+          (put env :current-file new-where)))
 
       (do
         (var pindex 0)
@@ -2447,14 +2444,14 @@
                              (if-not (= (fiber/status f) :dead)
                                (error val))
                              (set returnval val))
-                :source "eval-string"})
+                :source :eval-string})
   returnval)
 
 (defn eval
   ``Evaluates a form in the current environment. If more control over the
   environment is needed, use `run-context`.``
   [form]
-  (def res (compile form (fiber/getenv (fiber/current)) "eval"))
+  (def res (compile form (fiber/getenv (fiber/current)) :eval))
   (if (= (type res) :function)
     (res)
     (error (get res :error))))
@@ -2616,7 +2613,7 @@
 
 (defn dofile
   `Evaluate a file, file path, or stream and return the resulting environment. :env, :expander,
-  :evaluator, :read, and :parser are passed through to the underlying
+  :source, :evaluator, :read, and :parser are passed through to the underlying
   run-context call. If exit is true, any top level errors will trigger a
   call to (os/exit 1) after printing the error.`
   [path &keys
@@ -2634,7 +2631,6 @@
   (def path-is-file (= f path))
   (default env (make-env))
   (def spath (string path))
-  (put env :current-file (or src (if-not path-is-file spath)))
   (put env :source (or src (if-not path-is-file spath path)))
   (var exit-error nil)
   (var exit-fiber nil)
@@ -2678,7 +2674,7 @@
                   :expander expander
                   :read read
                   :parser parser
-                  :source (or src (if path-is-file "<anonymous>" spath))}))
+                  :source (or src (if path-is-file :<anonymous> spath))}))
   (if-not path-is-file (:close f))
   (when exit-error
     (if exit-fiber
@@ -3381,7 +3377,7 @@
                 :on-status (or onsignal (make-onsignal env 1))
                 :parser parser
                 :read read
-                :source "repl"}))
+                :source :repl}))
 
 ###
 ###
@@ -3676,7 +3672,7 @@
 
   (if (or should-repl no-file)
     (if
-      compile-only (flycheck stdin :source "stdin" :exit exit-on-error)
+      compile-only (flycheck stdin :source :stdin :exit exit-on-error)
       (do
         (if-not quiet
           (print "Janet " janet/version "-" janet/build " " (os/which) "/" (os/arch) " - '(doc)' for help"))

src/core/compile.c

@@ -958,7 +958,14 @@ JANET_CORE_FN(cfun,
     }
     const uint8_t *source = NULL;
     if (argc >= 3) {
-        source = janet_getstring(argv, 2);
+        Janet x = argv[2];
+        if (janet_checktype(x, JANET_STRING)) {
+            source = janet_unwrap_string(x);
+        } else if (janet_checktype(x, JANET_KEYWORD)) {
+            source = janet_unwrap_keyword(x);
+        } else {
+            janet_panic_type(x, 2, JANET_TFLAG_STRING | JANET_TFLAG_KEYWORD);
+        }
     }
     JanetArray *lints = (argc >= 4) ? janet_getarray(argv, 3) : NULL;
     JanetCompileResult res = janet_compile_lint(argv[0], env, source, lints);