Merge branch 'mr/backport/release-24.2-issue-eng/ide/libadalang-tools…

…_145' into '24.2'

[24.2] Backport of eng/ide/libadalang-tools#145

See merge request eng/ide/libadalang-tools!210

src/test-stub.adb

@@ -2535,6 +2535,17 @@ package body Test.Stub is
          Type_Decl := Type_Decl.P_Previous_Part;
       end loop;
 
+      declare
+         Insts : constant Generic_Instantiation_Array :=
+           Type_Decl.P_Generic_Instantiations;
+      begin
+         for Inst of Insts loop
+            if Is_Private (Inst) then
+               return True;
+            end if;
+         end loop;
+      end;
+
       return Is_Private (Type_Decl);
    end Is_Fully_Private;
 

testsuite/tests/test/private_instantiation/generics.gpr

@@ -0,0 +1,2 @@
+project generics is
+end generics;

testsuite/tests/test/private_instantiation/importing.ads

@@ -0,0 +1,4 @@
+with Instantiations;
+package Importing is
+   function One return Integer is (1);
+end Importing;

testsuite/tests/test/private_instantiation/instantiations.adb

@@ -0,0 +1,8 @@
+package body Instantiations is
+
+   procedure Do_Stuff (X : in out Sort_String_3.Array_To_Sort);
+   begin
+      null;
+   end Do_Stuff;
+
+end Instantiations;

testsuite/tests/test/private_instantiation/instantiations.ads

@@ -0,0 +1,17 @@
+with Sorting_Algorithms;
+package Instantiations is
+
+   package Sort_Integers is new Sorting_Algorithms (5, Integer);
+
+   procedure Need_Body (X : in out Integer);
+
+private
+
+   type String_3 is new String (1 .. 3);
+
+   package Sort_String_3 is new Sorting_Algorithms (3, String_3);
+   use type Sort_String_3.Array_To_Sort;
+
+   procedure Do_Stuff (X : in out Sort_String_3.Array_To_Sort);
+
+end Instantiations;

testsuite/tests/test/private_instantiation/sorting_algorithms.adb

@@ -0,0 +1,49 @@
+package body Sorting_Algorithms is
+
+   procedure Swap (L, R : in out Element_Type);
+
+   procedure Swap (L, R : in out Element_Type) is
+      X : Element_Type;
+   begin
+      X := L;
+      L := R;
+      R := X;
+   end Swap;
+
+   procedure Selection_Sort (X : in out Array_To_Sort) is
+      Min_Index : Natural;
+   begin
+      for I in X'First .. X'Last - 1 loop
+
+         Min_Index := I;
+
+         for J in I + 1 .. X'Last loop
+--              if X (J) < X (I) then
+            if X (J) < X (Min_Index) then
+               Min_Index := J;
+            end if;
+         end loop;
+
+         if I /= Min_Index then
+            Swap (X (I), X (Min_Index));
+         end if;
+
+      end loop;
+   end Selection_Sort;
+
+   procedure Bubble_Sort (X : in out Array_To_Sort) is
+      Swapped : Boolean;
+   begin
+      for I in X'First .. X'Last - 1 loop
+         Swapped := False;
+         for J in X'First .. X'Last - 1 loop
+            if X (J + 1) < X (j) then
+               Swap (X (J), X (J + 1));
+               Swapped := True;
+            end if;
+         end loop;
+         exit when not Swapped;
+      end loop;
+   end Bubble_Sort;
+
+end Sorting_Algorithms;

testsuite/tests/test/private_instantiation/sorting_algorithms.ads

@@ -0,0 +1,13 @@
+generic
+   Length : Positive;
+   type Element_Type is private;
+   with function "<" (L, R : Element_Type) return Boolean is <>;
+package Sorting_Algorithms is
+
+   type Array_To_Sort is array (1 .. Length) of Element_Type;
+
+   procedure Selection_Sort (X : in out Array_To_Sort);
+
+   procedure Bubble_Sort (X : in out Array_To_Sort);
+
+end Sorting_Algorithms;

testsuite/tests/test/private_instantiation/test.sh

@@ -0,0 +1,4 @@
+#!/bin/bash
+
+gnattest -q -P generics.gpr --stub importing.ads
+gprbuild -q -P gnattest_stub/harness/test_drivers.gpr

testsuite/tests/test/private_instantiation/test.yaml

@@ -0,0 +1,7 @@
+description:
+    Test checking that parameter type that comes from
+    a generic package instantiated in private part
+    are properly ignored and not put into setter.
+
+driver: shell_script
+