Store Ada stack trace in C API exception structs

Do this to allow access to the Ada stack trace of an exception, even
from the bindings.

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.
     """,

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};
 
 /*

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;
 

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

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)

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);

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 {

testsuite/tests/c_api/general/test.out

@@ -5,5 +5,8 @@ Child 1 of root = <Example main.txt:1:1-1:8>
 Child 2 of root = <Example main.txt:2:1-2:8>
 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