diff --git a/src/classes/Class.c b/src/classes/Class.c index d79f107..b3cf660 100644 --- a/src/classes/Class.c +++ b/src/classes/Class.c @@ -1212,6 +1212,8 @@ struct LT_Class_MethodReflectionBaton { LT_IdentitySet* seen; }; +static LT_Value class_all_methods_as_list(LT_Class* klass); + static LT_Value class_method_descriptor(LT_Class* klass, LT_Value selector){ LT_Value callable; @@ -1311,12 +1313,18 @@ LT_PRIMITIVE_HEAD(class_method_inspection){ LT_Value cursor = arguments; LT_Value self; LT_Value methods; + LT_Value base_inspection_value; + LT_ObjectInspection* base_inspection; LT_ListBuilder* contents = LT_ListBuilder_new(); + LT_Class* klass; + LT_Value name; + LT_Value description; (void)tail_call_unwind_marker; LT_OBJECT_ARG(cursor, self); LT_ARG_END(cursor); - methods = class_direct_methods_as_list(LT_Class_from_object(self)); + klass = LT_Class_from_object(self); + methods = class_all_methods_as_list(klass); while (methods != LT_NIL){ LT_Value method = LT_car(methods); LT_ListBuilder_append( @@ -1326,9 +1334,20 @@ LT_PRIMITIVE_HEAD(class_method_inspection){ LT_ListBuilder_append(contents, method); methods = LT_cdr(methods); } - return LT_Object_inspection_with_contents( - self, - "Methods:", + base_inspection_value = LT_Object_inspection(self); + base_inspection = LT_ObjectInspection_from_value(base_inspection_value); + name = (LT_Value)(uintptr_t)LT_String_new_cstr( + LT_sprintf( + "Class %s", + LT_Symbol_name(LT_Symbol_from_value(klass->name)) + ) + ); + description = LT_ObjectInspection_description(base_inspection); + return LT_ObjectInspection_new( + name, + description, + LT_ObjectInspection_slots(base_inspection), + (LT_Value)(uintptr_t)LT_String_new_cstr("Methods:"), LT_ListBuilder_value(contents) ); } diff --git a/src/classes/Object.c b/src/classes/Object.c index fe36c36..742be53 100644 --- a/src/classes/Object.c +++ b/src/classes/Object.c @@ -242,6 +242,15 @@ LT_Value LT_Object_inspection_with_contents(LT_Value object, description = klass->documentation == LT_NIL ? (LT_Value)(uintptr_t)LT_String_new_cstr("") : klass->documentation; + if (LT_Class_lookup_method( + klass, + LT_Symbol_new_in(LT_PACKAGE_KEYWORD, "documentation") + ) != LT_INVALID){ + description = LT_SEND(object, "documentation"); + if (description == LT_NIL){ + description = (LT_Value)(uintptr_t)LT_String_new_cstr(""); + } + } for (i = 0; i < klass->slot_count; i++){ LT_ListBuilder_append(slots, klass->slots[i].name); LT_ListBuilder_append( diff --git a/src/debugger/debugger.c b/src/debugger/debugger.c index bcd86e4..7156ec6 100644 --- a/src/debugger/debugger.c +++ b/src/debugger/debugger.c @@ -37,6 +37,8 @@ typedef struct { LT_Value contents; } InspectorContext; +static void inspector_print(InspectorContext* context); + static _Thread_local unsigned int debugger_level = 0; static LT_Value return_to_debugger_tag = LT_NIL; @@ -105,13 +107,46 @@ LT_DEFINE_PRIMITIVE( return object; } -void LT_Debugger_define_inspect(LT_Environment* environment){ +LT_DEFINE_PRIMITIVE( + inspect_star_primitive, + "ListTalk:inspect*", + "(object)", + "Print an object inspection without entering the interactive inspector." +){ + LT_Value cursor = arguments; + LT_Value object; + InspectorContext context; + (void)invocation_context_kind; + (void)invocation_context_data; + (void)tail_call_unwind_marker; + + LT_OBJECT_ARG(cursor, object); + LT_ARG_END(cursor); + context.object = object; + context.slots = LT_NIL; + context.contents = LT_NIL; + inspector_print(&context); + return object; +} + +static void debugger_bind_inspect_primitives(LT_Environment* environment, + LT_Package* package){ LT_Environment_bind( environment, - LT_Symbol_new_in(LT_PACKAGE_LISTTALK, "inspect"), + LT_Symbol_new_in(package, "inspect"), LT_Primitive_from_static(&inspect_primitive), LT_ENV_BINDING_FLAG_CONSTANT ); + LT_Environment_bind( + environment, + LT_Symbol_new_in(package, "inspect*"), + LT_Primitive_from_static(&inspect_star_primitive), + LT_ENV_BINDING_FLAG_CONSTANT + ); +} + +void LT_Debugger_define_inspect(LT_Environment* environment){ + debugger_bind_inspect_primitives(environment, LT_PACKAGE_LISTTALK); } LT_Value LT_Debugger_get_hook(void){ @@ -466,11 +501,9 @@ void LT_Debugger_break(LT_Value condition, LT_Value debugger_hook){ condition, LT_ENV_BINDING_FLAG_CONSTANT ); - LT_Environment_bind( + debugger_bind_inspect_primitives( context.environment, - LT_Symbol_new_in(LT_PACKAGE_LISTTALK_DEBUG, "inspect"), - LT_Primitive_from_static(&inspect_primitive), - LT_ENV_BINDING_FLAG_CONSTANT + LT_PACKAGE_LISTTALK_DEBUG ); LT_Environment_bind( context.environment, diff --git a/tests/c_api_test.c b/tests/c_api_test.c index 4847e75..37d0ed6 100644 --- a/tests/c_api_test.c +++ b/tests/c_api_test.c @@ -599,6 +599,26 @@ static int test_specialized_object_inspection_contents(void){ LT_Value environment_inspection; LT_Value class_inspection; LT_Value class_contents; + LT_Value primitive = LT_Primitive_from_static( + &primitive_test_object_class_name_method + ); + LT_Value primitive_inspection = LT_SEND(primitive, "inspection"); + + if (expect( + strcmp( + LT_String_value_cstr( + LT_String_from_value( + LT_ObjectInspection_description( + LT_ObjectInspection_from_value(primitive_inspection) + ) + ) + ), + "Test helper method: return receiver class name." + ) == 0, + "Object inspection obtains description through documentation protocol" + )){ + return 1; + } if (expect( inspection_contents_at(list_inspection, LT_SmallInteger_new(0)) @@ -628,10 +648,44 @@ static int test_specialized_object_inspection_contents(void){ class_contents = LT_ObjectInspection_contents( LT_ObjectInspection_from_value(class_inspection) ); - return expect( + if (expect( + strcmp( + LT_String_value_cstr( + LT_String_from_value( + LT_ObjectInspection_name( + LT_ObjectInspection_from_value(class_inspection) + ) + ) + ), + "Class Pair" + ) == 0, + "Class inspection uses the inspected class name" + )){ + return 1; + } + if (expect( + LT_ObjectInspection_description( + LT_ObjectInspection_from_value(class_inspection) + ) == LT_Pair_class.documentation, + "Class inspection uses the inspected class documentation" + )){ + return 1; + } + if (expect( class_contents != LT_NIL && LT_MethodDescriptor_p(LT_car(LT_cdr(class_contents))), - "Class inspection exposes direct method descriptors" + "Class inspection exposes method descriptors" + )){ + return 1; + } + return expect( + LT_MethodDescriptor_p( + inspection_contents_at( + class_inspection, + LT_Symbol_new_in(LT_PACKAGE_KEYWORD, "class") + ) + ), + "Class inspection includes inherited methods" ); } diff --git a/tests/listtalk_cli_test.py b/tests/listtalk_cli_test.py index a507ad8..216f0c8 100644 --- a/tests/listtalk_cli_test.py +++ b/tests/listtalk_cli_test.py @@ -102,13 +102,15 @@ def run_interactive_syntax_error_case(exe): def run_interactive_inspect_binding_case(exe): completed = subprocess.run( [exe], - input="(primitive? inspect)\n", + input="(list (primitive? inspect) (primitive? inspect*))\n", check=False, stdout=subprocess.PIPE, stderr=subprocess.PIPE, text=True, ) - if completed.returncode != 0 or not completed.stdout.rstrip().endswith("#true"): + if completed.returncode != 0 or not completed.stdout.rstrip().endswith( + "(#true #true)" + ): sys.stderr.write( "FAIL: interactive REPL did not bind ListTalk:inspect\n{0}{1}".format( completed.stdout,