Merge branch 'sync/fix_memory_corruption' into 'master'

Keep gpr_project alive when creating an analysis context from it

See merge request eng/libadalang/libadalang!1414

extensions/ocaml_api/module_struct

@@ -166,7 +166,9 @@ module GPRProject = struct
       gpr_project : analysis_context =
     if tab_stop < 1 then
       raise (Invalid_argument "Invalid tab_stop (positive integer expected)") ;
-    let c_context = AnalysisContextStruct.allocate_analysis_context () in
+    let c_context =
+      AnalysisContextStruct.allocate_analysis_context ~keep:gpr_project ()
+    in
     gpr_project_initialize_context
       gpr_project
       c_context

testsuite/tests/ocaml_api/project_unit_provider/p.gpr

@@ -1,5 +1,5 @@
 project P is
-   type Src_Dir_Type is ("src1", "src2");
+   type Src_Dir_Type is ("src1", "src2", "src3");
    Src_Dir : Src_Dir_Type := external ("SRC_DIR");
    for Source_Dirs use (Src_Dir);
 end P;

testsuite/tests/ocaml_api/project_unit_provider/src3/a.ads

@@ -0,0 +1,5 @@
+with B;
+
+package A is
+   X : Integer := B.Y;
+end A;

testsuite/tests/ocaml_api/project_unit_provider/src3/b.ads

@@ -0,0 +1,3 @@
+package B is
+   Y : Integer := 42;
+end B;

testsuite/tests/ocaml_api/project_unit_provider/test.ml

@@ -1,5 +1,11 @@
 open Libadalang
 
+let value_exn = function
+  | Some x ->
+      x
+  | None ->
+      raise (Invalid_argument "Some expected, got None")
+
 let format_exc_message msg =
   (* For exceptions with no explicit message (e.g. Invalid_Project exceptions
    * from gnatcoll-projects.adb), hide the line number, which is out of our
@@ -67,4 +73,37 @@ let test_src src_dir =
     (Format.pp_print_list pp_node)
     matching_nodes
 
-let () = test_src "src1" ; test_src "src2"
+let analysis_context () =
+  let open GPRProject in
+  let gpr = load ~scenario_vars:[("SRC_DIR", "src3")] "p.gpr" in
+  create_analysis_context gpr
+
+let test_gpr_project_context () =
+  let ctx = analysis_context () in
+  (* At this point gpr is out of scope, call GC.full_major to hopefully trigger
+     a valgrind issue in case gpr has been gced (we want it to stay alive
+     because the context uses it *)
+  Gc.full_major () ;
+  let u = AnalysisContext.get_from_file ctx "src3/a.ads" in
+  let root =
+    match AnalysisUnit.root u with
+    | Some n ->
+        n
+    | None ->
+        Format.printf "@[<v>Cannot get root node for file a.ads@ @]" ;
+        exit 1
+  in
+  let name =
+    AdaNode.find ObjectDecl root
+    |> ObjectDecl.f_default_expr
+    |> value_exn
+    |> AdaNode.as_a Name
+    |> value_exn
+  in
+  let ref = Name.p_referenced_decl name |> value_exn in
+  Format.printf "%s referenced_decl is %s@."
+    (AdaNode.image name)
+    (AdaNode.image ref)
+
+
+let () = test_src "src1" ; test_src "src2"; test_gpr_project_context ()

testsuite/tests/ocaml_api/project_unit_provider/test.out

@@ -12,3 +12,4 @@ For SRC_DIR=src1
 For SRC_DIR=src2
 <SubtypeIndication p2.ads:5:8-5:22> resolves to:
   <ConcreteTypeDecl ["Record_Type"] p1.ads:3:4-5:15>
+<DottedName a.ads:4:19-4:22> referenced_decl is <ObjectDecl ["Y"] b.ads:2:4-2:22>