use std::panic::{AssertUnwindSafe, catch_unwind};
use eclisp::{
Lisp, LispContext, LispError,
clos::{Class, LispClass, Property, with_scoped_object_pointer},
sys,
};
struct Transform {
x: f32,
}
impl LispClass for Transform {
const NAME: &'static str = "transform";
fn class() -> Class<Self> {
Class::new(Self::NAME)
.property(
Property::new("x")
.native_get(transform_x)
.native_set(set_transform_x),
)
.property(Property::new("reentrant").native_get(reentrant_transform_access))
}
}
struct Other;
impl LispClass for Other {
const NAME: &'static str = "other";
fn class() -> Class<Self> {
Class::new(Self::NAME)
}
}
unsafe extern "C" fn transform_x(handle: sys::cl_object) -> sys::cl_object {
let Some(x) = (unsafe { with_scoped_object_pointer::<Transform, _>(handle, |value| value.x) })
else {
return unsafe { sys::eclisp_native_failure_raw() };
};
unsafe { sys::ecl_make_single_float(x) }
}
unsafe extern "C" fn set_transform_x(
handle: sys::cl_object,
value: sys::cl_object,
) -> sys::cl_object {
let mut x = 0.0;
if unsafe { sys::eclisp_as_float(value, &mut x) } == 0 {
return unsafe { sys::eclisp_native_failure_raw() };
}
let Some(()) = (unsafe {
with_scoped_object_pointer::<Transform, _>(handle, |transform| transform.x = x as f32)
}) else {
return unsafe { sys::eclisp_native_failure_raw() };
};
value
}
unsafe extern "C" fn reentrant_transform_access(handle: sys::cl_object) -> sys::cl_object {
let Some(reentrant_was_rejected) = (unsafe {
with_scoped_object_pointer::<Transform, _>(handle, |_| {
with_scoped_object_pointer::<Transform, _>(handle, |_| ()).is_none()
})
}) else {
return unsafe { sys::eclisp_native_failure_raw() };
};
if reentrant_was_rejected {
unsafe { sys::eclisp_t_raw() }
} else {
unsafe { sys::eclisp_native_failure_raw() }
}
}
fn test_defclass(ctx: &LispContext<'_>) -> Result<(), LispError> {
ctx.defclass(Transform::class())?;
let result = ctx.eval("(find-class 'transform)")?;
assert!(!result.is_nil());
let result = ctx.eval("(typep (make-instance 'transform :handle '(0 0)) 'transform)")?;
assert!(result.is_t());
Ok(())
}
fn test_wrap_object(ctx: &LispContext<'_>) -> Result<(), LispError> {
let id = ctx.expose(Transform { x: 10.0 });
let object = ctx.wrap_object("transform", id)?;
assert!(
ctx.call("typep", &[&object, &ctx.eval("'transform")?,])?
.is_t()
);
Ok(())
}
fn test_scoped_object(ctx: &LispContext<'_>) -> Result<(), LispError> {
ctx.defclass(Other::class())?;
ctx.load(
r#"
(defparameter *escaped-transform* nil)
(defmethod move-transform ((obj transform))
(incf (x obj) 5.0))
(defmethod transform-kind ((obj transform))
"transform")
(defun escape-transform (obj)
(setf *escaped-transform* obj))
(defun set-transform-x (obj value)
(setf (x obj) value))
"#,
)?;
let mut transform = Transform { x: 10.0 };
ctx.with(&mut transform, |object| {
let class = ctx.eval("'transform")?;
assert!(ctx.call("typep", &[object, &class])?.is_t());
let actual_class = ctx.call("class-of", &[object])?;
let expected_class = ctx.call("find-class", &[&class])?;
assert!(ctx.call("eq", &[&actual_class, &expected_class])?.is_t());
assert_eq!(
ctx.call("transform-kind", &[object])?.try_as_string()?,
"transform"
);
assert!(ctx.call("reentrant", &[object])?.is_t());
ctx.call("move-transform", &[object])?;
Ok(())
})?;
assert_eq!(transform.x, 15.0);
ctx.with(&mut transform, |object| {
let invalid = ctx.string("invalid")?;
assert!(ctx.call("set-transform-x", &[object, &invalid]).is_err());
Ok(())
})?;
assert_eq!(transform.x, 15.0);
ctx.with(&mut transform, |object| {
ctx.call("escape-transform", &[object])?;
Ok(())
})?;
assert!(ctx.eval("(x *escaped-transform*)").is_err());
let mut second = Transform { x: 20.0 };
ctx.with(&mut second, |second_object| {
assert!(ctx.eval("(x *escaped-transform*)").is_err());
assert_eq!(ctx.call("x", &[second_object])?.try_as_f64()?, 20.0);
Ok(())
})?;
let mut first = Transform { x: 10.0 };
ctx.with(&mut first, |first_object| {
ctx.with(&mut second, |second_object| {
assert_eq!(ctx.call("x", &[first_object])?.try_as_f64()?, 10.0);
assert_eq!(ctx.call("x", &[second_object])?.try_as_f64()?, 20.0);
Ok(())
})
})?;
let unwind = catch_unwind(AssertUnwindSafe(|| {
let _ = ctx.with(&mut first, |object| {
ctx.call("escape-transform", &[object])?;
panic!("test scoped proxy invalidation during unwinding");
#[allow(unreachable_code)]
Ok::<(), LispError>(())
});
}));
assert!(unwind.is_err());
assert!(ctx.eval("(x *escaped-transform*)").is_err());
let result = ctx.with(&mut transform, |object| {
ctx.call("escape-transform", &[object])?;
Err::<(), _>(LispError::RuntimeError("stop".into()))
});
assert!(result.is_err());
assert!(ctx.eval("(x *escaped-transform*)").is_err());
assert!(
ctx.eval("(x (make-instance 'transform :handle nil))")
.is_err()
);
let mut other = Other;
ctx.with(&mut other, |object| {
let handle = ctx.call("%rust-handle", &[object])?;
let class = ctx.eval("'transform")?;
let keyword = ctx.eval(":handle")?;
let forged = ctx.call("make-instance", &[&class, &keyword, &handle])?;
assert!(ctx.call("x", &[&forged]).is_err());
Ok(())
})?;
assert_eq!(ctx.eval("(+ 1 2)")?.try_as_i64()?, 3);
Ok(())
}
fn run(name: &str, lisp: &LispContext<'_>, test: fn(&LispContext<'_>) -> Result<(), LispError>) {
print!("test {name} ... ");
match test(lisp) {
Ok(()) => println!("ok"),
Err(error) => panic!("{name} failed: {error}"),
}
}
fn main() -> Result<(), LispError> {
let lisp = Lisp::new()?;
lisp.enter(|ctx| {
run("defclass", &ctx, test_defclass);
run("wrap_object", &ctx, test_wrap_object);
run("scoped_object", &ctx, test_scoped_object);
});
Ok(())
}