diff --git a/langkit/documentation.py b/langkit/documentation.py index ff8ce8603..c0d9df548 100644 --- a/langkit/documentation.py +++ b/langkit/documentation.py @@ -216,6 +216,10 @@ base_langkit_docs = { 'langkit.exception_type.information': """ Message and context information associated with this exception. """, + 'langkit.exception_type.stack_trace': """ + Native stack trace associated to the exception as a multi-line human + readable trace. This string can be null if no trace is available. + """, 'langkit.invalid_unit_name_error': """ Raised when an invalid unit name is provided. """, diff --git a/langkit/templates/c_api/header_c.mako b/langkit/templates/c_api/header_c.mako index 757cb88f0..7bcae68d5 100644 --- a/langkit/templates/c_api/header_c.mako +++ b/langkit/templates/c_api/header_c.mako @@ -159,6 +159,9 @@ typedef struct { ${c_doc('langkit.exception_type.information')} const char *information; + + ${c_doc('langkit.exception_type.stack_trace')} + const char *stack_trace; } ${exception_type}; /* diff --git a/langkit/templates/c_api/pkg_main_body_ada.mako b/langkit/templates/c_api/pkg_main_body_ada.mako index de48ba591..a4808beef 100644 --- a/langkit/templates/c_api/pkg_main_body_ada.mako +++ b/langkit/templates/c_api/pkg_main_body_ada.mako @@ -17,6 +17,8 @@ pragma Warnings (On, "is an internal GNAT unit"); with System.Memory; use type System.Address; +with GNAT.Traceback.Symbolic; + with GNATCOLL.Iconv; with Langkit_Support.Diagnostics; use Langkit_Support.Diagnostics; @@ -1081,14 +1083,20 @@ package body ${ada_lib_name}.Implementation.C is procedure Set_Last_Exception (Exc : Exception_Occurrence) is begin - Set_Last_Exception (Exception_Identity (Exc), Exception_Message (Exc)); + Set_Last_Exception + (Exception_Identity (Exc), + Exception_Message (Exc), + GNAT.Traceback.Symbolic.Symbolic_Traceback_No_Hex (Exc)); end Set_Last_Exception; ------------------------ -- Set_Last_Exception -- ------------------------ - procedure Set_Last_Exception (Id : Exception_Id; Message : String) is + procedure Set_Last_Exception + (Id : Exception_Id; + Message : String; + Stack_Trace : String := "") is begin -- If it's the first time, allocate room for the exception information @@ -1098,8 +1106,13 @@ package body ${ada_lib_name}.Implementation.C is -- If it is not the first time, free memory allocated for the last -- exception. - elsif Last_Exception.Information /= Null_Ptr then - Free (Last_Exception.Information); + else + if Last_Exception.Information /= Null_Ptr then + Free (Last_Exception.Information); + end if; + if Last_Exception.Stack_Trace /= Null_Ptr then + Free (Last_Exception.Stack_Trace); + end if; end if; -- Get the kind corresponding to Exc @@ -1107,13 +1120,23 @@ package body ${ada_lib_name}.Implementation.C is % for i, e in enumerate(ctx.sorted_exception_types): ${'elsif' if i > 0 else 'if'} Id = ${e.qualname}'Identity then Last_Exception.Kind := ${e.kind_name}; - Last_Exception.Information := New_String (Message); % endfor else Last_Exception.Kind := ${ ctx.exception_types['native_exception'].kind_name }; - Last_Exception.Information := New_String (Message); + end if; + + -- Unconditionally set the exception message + + Last_Exception.Information := New_String (Message); + + -- Set the exception stack trace if one is available + + if Stack_Trace /= "" then + Last_Exception.Stack_Trace := New_String (Stack_Trace); + else + Last_Exception.Stack_Trace := Null_Ptr; end if; end Set_Last_Exception; diff --git a/langkit/templates/c_api/pkg_main_spec_ada.mako b/langkit/templates/c_api/pkg_main_spec_ada.mako index 460888805..8971bf478 100644 --- a/langkit/templates/c_api/pkg_main_spec_ada.mako +++ b/langkit/templates/c_api/pkg_main_spec_ada.mako @@ -112,6 +112,9 @@ package ${ada_lib_name}.Implementation.C is Information : chars_ptr; ${ada_c_doc('langkit.exception_type.information', 6)} + + Stack_Trace : chars_ptr; + ${ada_c_doc('langkit.exception_type.stack_trace', 6)} end record; ${ada_c_doc('langkit.exception_type', 3)} @@ -736,10 +739,16 @@ package ${ada_lib_name}.Implementation.C is -- Free the information contained in Last_Exception and replace it with -- newly allocated information from Exc. - procedure Set_Last_Exception (Id : Exception_Id; Message : String); + procedure Set_Last_Exception + (Id : Exception_Id; + Message : String; + Stack_Trace : String := ""); -- Likewise, but put destructured exception information. This is useful to -- pass messages that are longer than what the Ada runtime accepts (i.e. -- allows to avoid truncated error messages). + -- + -- If Stack_Trace is not an empty string, add it as well in the + -- Last_Exception information. function ${capi.get_name('token_get_kind')} (Token : ${token_type}) return int diff --git a/testsuite/c_support/utils_exec.c b/testsuite/c_support/utils_exec.c index fc8b5c71b..0d7b6aef3 100644 --- a/testsuite/c_support/utils_exec.c +++ b/testsuite/c_support/utils_exec.c @@ -20,6 +20,13 @@ print_exception (bool or_silent) exc_name, exc->information); free (exc_name); + + /* Display whether a stack trace is available (do not display the stack + trace itself to have deterministic test baselines). */ + if (exc->stack_trace != NULL) + { + printf (" A stack trace is available for this exception\n"); + } return true; } else if (! or_silent) diff --git a/testsuite/tests/c_api/general/main.c b/testsuite/tests/c_api/general/main.c index 11177c646..7d5734d66 100644 --- a/testsuite/tests/c_api/general/main.c +++ b/testsuite/tests/c_api/general/main.c @@ -124,6 +124,11 @@ main (void) printf ("Tokens should be equivalent!\n"); } + /* Check that exceptions information are accessible. */ + int res; + foo_foo_node_p_int_prop_error (&root, &res); + print_exception (0); + foo_context_decref (context); free (children); free (tokens); diff --git a/testsuite/tests/c_api/general/test.lkt b/testsuite/tests/c_api/general/test.lkt index f6d2a838f..21c9c62bb 100644 --- a/testsuite/tests/c_api/general/test.lkt +++ b/testsuite/tests/c_api/general/test.lkt @@ -9,6 +9,9 @@ grammar foo_grammar { @abstract class FooNode implements Node[FooNode] { + @exported + fun int_prop_error(): Int = + raise[Int] PropertyError("this is an eror") } class Example: FooNode implements TokenNode { diff --git a/testsuite/tests/c_api/general/test.out b/testsuite/tests/c_api/general/test.out index f833408d1..d079fb295 100644 --- a/testsuite/tests/c_api/general/test.out +++ b/testsuite/tests/c_api/general/test.out @@ -5,5 +5,8 @@ Child 1 of root = Child 2 of root = Start token of the 1 child = "Example" Start token of the 2 child = "Example" +Got an exception (EXCEPTION_PROPERTY_ERROR): + this is an eror + A stack trace is available for this exception main.c: Done. Done