Merge pull request #439 from jscl-project/fix-funcall-error-message

Ensure unboundFunction is bound to the right symbol

Author: davazp

src/boot.lisp

@@ -156,7 +156,9 @@
   (boundp x))
 
 (defun fboundp (x)
-  (fboundp x))
+  (if (functionp x)
+      (error "FBOUNDP - invalid function name ~a." x))
+  (%fboundp x))
 
 (defun eq (x y) (eq x y))
 (defun eql (x y) (eq x y))

src/compiler/compiler.lisp

@@ -1220,8 +1220,8 @@
 (define-builtin boundp (x)
   (convert-to-bool `(!== (get ,x "value") undefined)))
 
-(define-builtin fboundp (x)
-  (convert-to-bool `(!== (get ,x "fvalue") (internal |unboundFunction|))))
+(define-builtin %fboundp (x)
+  (convert-to-bool `(call-internal |fboundp| ,x)))
 
 (define-builtin symbol-value (x)
   `(call-internal |symbolValue| ,x))

src/prelude.js

@@ -59,7 +59,6 @@ internals.forcemv = function(x) {
   return typeof x == 'object' && x !== null && 'multiple-value' in x? x: internals.mv(x);
 };
 
-
 //
 // Workaround the problems with `new` for arbitrary number of
 // arguments. Some primitive constructors (like Date) differ if they
@@ -331,15 +330,21 @@ packages.KEYWORD = {
 
 jscl.CL = packages.CL.exports;
 
-internals.unboundFunction = function () {
-  throw new Error("Function '" + this.name + "' undefined");
+
+
+const UNBOUND = Symbol('UnboundFunction')
+
+internals.makeUnboundFunction = function (symbol) {
+  const fn = ()=>{ throw new Error("Function '" + symbol.name + "' undefined");}
+  fn[UNBOUND] = true;
+  return fn;
 };
 
 internals.Symbol = function(name, package_name){
   this.name = name;
   this.package = package_name;
   this.value = undefined;
-  this.fvalue = internals.unboundFunction;
+  this.fvalue = internals.makeUnboundFunction(this)
   this.stack = [];
 };
 
@@ -352,9 +357,17 @@ internals.symbolValue = function (symbol){
   }
 };
 
+internals.fboundp = function (symbol) {
+  if (symbol instanceof internals.Symbol){
+    return !symbol.fvalue[UNBOUND]
+  } else {
+    throw new Error(`${symbol} is not a symbol`)
+  }
+}
+
 internals.symbolFunction = function (symbol){
   var fn = symbol.fvalue;
-  if (fn === internals.unboundFunction)
+  if (fn[UNBOUND])
     symbol.fvalue();
   return fn;
 };

tests/defstruct.lisp

@@ -113,7 +113,7 @@
 (test
  (mv-eql
   (values
-   (mapcar 'fboundp (list #'sbt-02-a #'sbt-02-p #'copy-sbt-02))
+   (mapcar 'fboundp (list 'sbt-02-a 'sbt-02-p 'copy-sbt-02))
    (sbt-02-con)
    (sbt-02-con :foo 99)
    (sbt-02-a (sbt-02-con :foo 1234)))

tests/variables.lisp

@@ -22,4 +22,8 @@
   (let ((*special-defparameter* 2))
     (test (= (f) 2))))
 
+
+(test (not (fboundp 'abc)))
+
+
 ;;; EOF