Merge branch 'topic/backport/25.2/230-ada_2022' into '25.2'

TGen: Allow users to set Ada language version in the generated projects

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

Author: leocreuse

src/test-actions.adb

@@ -217,6 +217,9 @@ package body Test.Actions is
 
       Test.Common.Instrument := Arg (Cmd, Dump_Test_Inputs);
 
+      Test.Common.Lang_Version :=
+        Utils.Command_Lines.Common.Ada_Version_Switches.Arg (Cmd);
+
       if Arg (Cmd, Passed_Tests) /= null then
          if Arg (Cmd, Passed_Tests).all = "hide" then
             Test.Common.Show_Passed_Tests := False;
@@ -874,6 +877,15 @@ package body Test.Actions is
             & GNAT.OS_Lib.Directory_Separator & "tgen"
             & GNAT.OS_Lib.Directory_Separator & "templates"));
 
+      TGen.Libgen.Set_Minimum_Lang_Version
+        (Test.Common.TGen_Libgen_Ctx,
+         (case Test.Common.Lang_Version is
+             when Ada_83 |
+                  Ada_95 |
+                  Ada_2005 |
+                  Ada_2012 => TGen.Libgen.Ada_12,
+             when Ada_2022 => TGen.Libgen.Ada_22));
+
       if Arg (Cmd, Gen_Test_Vectors) then
          Test.Common.Generate_Test_Vectors := True;
          Test.Common.Request_Lib_Support;

src/test-common.ads

@@ -43,6 +43,8 @@ with Langkit_Support.Slocs; use Langkit_Support.Slocs;
 
 with TGen.Libgen;
 
+with Utils.Command_Lines.Common; use Utils.Command_Lines.Common;
+
 package Test.Common is
 
    package String_Set is new
@@ -449,6 +451,10 @@ package Test.Common is
 
    Instr_Suffix : constant String := "-gnattest-instr";
    --  Suffix for object subdirs containing instrumented sources
+
+   Lang_Version : Ada_Version_Type := Ada_2012;
+   --  Language version to be inserted in the pragma in stub helper units.
+
 private
 
    Need_Lib_Support : Lib_Support_Status := Not_Needed;

src/test-generation.adb

@@ -207,6 +207,8 @@ package body Test.Generation is
       if Debug_Flag_1 then
          Build_Args.Append ("-g");
          Build_Args.Append ("-O0");
+         Build_Args.Append ("-bargs");
+         Build_Args.Append ("-Es");
       end if;
       Run (Build_Args, "Build of the test generation harness");
 

src/test-stub.adb

@@ -51,7 +51,8 @@ with Ada.Strings; use Ada.Strings;
 with Ada.Strings.Fixed; use Ada.Strings.Fixed;
 with Ada.Characters.Handling; use Ada.Characters.Handling;
 
-with Utils.Command_Lines; use Utils.Command_Lines;
+with Utils.Command_Lines;        use Utils.Command_Lines;
+with Utils.Command_Lines.Common;
 with Utils.Environment;
 
 package body Test.Stub is
@@ -282,10 +283,13 @@ package body Test.Stub is
    --  Puts header of generated stub explaining where user code should be put
 
    procedure Put_Import_Section
-     (Markered_Data : in out Markered_Data_Maps.Map;
-      Add_Import    :        Boolean := False;
-      Add_Pragma_05 :        Boolean := False);
+     (Markered_Data        : in out Markered_Data_Maps.Map;
+      Add_Import           :        Boolean := False;
+      Add_Language_Version :        Boolean := False);
    --  Puts or regenerates markered section for with clauses
+   --
+   --  The included version is the one defined through the Ada_Version_Switch
+   --  argument, if defined, or Ada_2012 otherwise.
 
    procedure Put_Lines (MD : Markered_Data_Type; Comment_Out : Boolean);
 
@@ -786,10 +790,11 @@ package body Test.Stub is
    ------------------------
 
    procedure Put_Import_Section
-     (Markered_Data : in out Markered_Data_Maps.Map;
-      Add_Import    :        Boolean := False;
-      Add_Pragma_05 :        Boolean := False)
+     (Markered_Data        : in out Markered_Data_Maps.Map;
+      Add_Import           :        Boolean := False;
+      Add_Language_Version :        Boolean := False)
    is
+      use Utils.Command_Lines.Common;
       ID : constant Markered_Data_Id :=
         (Import_MD,
          new String'(""),
@@ -834,8 +839,17 @@ package body Test.Stub is
             S_Put (3, "with Ada.Real_Time;");
             New_Line_Count;
          end if;
-         if Add_Pragma_05 then
-            S_Put (0, "pragma Ada_2005;");
+         if Add_Language_Version then
+            S_Put
+              (0,
+               "pragma "
+               & (case Test.Common.Lang_Version is
+                    when Ada_83   => "Ada_83",
+                    when Ada_95   => "Ada_95",
+                    when Ada_2005 => "Ada_2005",
+                    when Ada_2012 => "Ada_2012",
+                    when Ada_2022 => "Ada_2022")
+               & ";");
             New_Line_Count;
          end if;
       end if;
@@ -3585,7 +3599,7 @@ package body Test.Stub is
       Create (Tmp_File_Name);
       Reset_Line_Counter;
 
-      Put_Import_Section (Markered_Subp_Data, Add_Pragma_05 => True);
+      Put_Import_Section (Markered_Subp_Data, Add_Language_Version => True);
 
       S_Put
         (0,

src/tgen/tgen-libgen.adb

@@ -113,6 +113,12 @@ package body TGen.Libgen is
    --  Include all the types in Source in the correct package key in Dest. All
    --  anonymous types are ignored.
 
+   function Lang_Version_To_Attr
+     (Version : Ada_Language_Version) return String;
+   --  Return the corresponding string to be added to the
+   --  Compiler.Default_Switches attribute. This will return the empty string
+   --  if Version is Unspecified.
+
    ----------------------
    -- Replace_Standard --
    ----------------------
@@ -922,11 +928,19 @@ package body TGen.Libgen is
          Put_Line (Prj_File, "   package Compiler is");
          Put_Line (Prj_File, "      case Build_Mode is");
          Put_Line (Prj_File, "         when ""dev"" =>");
-         Put_Line (Prj_File, "            for Default_Switches (""Ada"") use"
-                   & " (""-g"", ""-gnatg"", ""-gnatyN"", ""-gnatws"");");
+         Put (Prj_File, "            for Default_Switches (""Ada"") use"
+                   & " (""-g"", ""-gnatg"", ""-gnatyN"", ""-gnatws""");
+         if Ctx.Lang_Version /= Unspecified then
+            Put (Prj_File, ", " & Lang_Version_To_Attr (Ctx.Lang_Version));
+         end if;
+         Put_Line (Prj_File, ");");
          Put_Line (Prj_File, "         when ""prod"" =>");
          Put_Line (Prj_File, "            for Default_Switches (""Ada"") use"
-                   & " (""-gnatg"", ""-gnatyN"", ""-gnatws"");");
+                   & " (""-gnatg"", ""-gnatyN"", ""-gnatws""");
+         if Ctx.Lang_Version /= Unspecified then
+            Put (Prj_File, ", " & Lang_Version_To_Attr (Ctx.Lang_Version));
+         end if;
+         Put_Line (Prj_File, ");");
          Put_Line (Prj_File, "      end case;");
          Put_Line (Prj_File, "   end Compiler;");
          New_Line (Prj_File);
@@ -1320,6 +1334,11 @@ package body TGen.Libgen is
       Put_Line (Prj_File, "project TGen_Generation_Harness is");
       Put_Line (Prj_File, "   for Main use (""generation_main.adb"");");
       Put_Line (Prj_File, "   for Object_Dir use ""obj"";");
+      Put_Line (Prj_File, "package Compiler is");
+      Put (Prj_File, "   for Default_Switches (""Ada"") use (");
+      Put (Prj_File, Lang_Version_To_Attr (Ctx.Lang_Version) & ");");
+      Ada.Text_IO.Put_Line (Prj_File, "end Compiler;");
+
       Put_Line (Prj_File, "end TGen_Generation_Harness;");
       Close (Prj_File);
 
@@ -1371,4 +1390,25 @@ package body TGen.Libgen is
       TGen.Marshalling.Set_Array_Size_Limit (Limit);
    end Set_Array_Size_Limit;
 
+   ------------------------------
+   -- Set_Minimum_Lang_Version --
+   ------------------------------
+
+   procedure Set_Minimum_Lang_Version
+     (Ctx : in out Libgen_Context; Version : Ada_Language_Version) is
+   begin
+      Ctx.Lang_Version := Version;
+   end Set_Minimum_Lang_Version;
+
+   --------------------------
+   -- Lang_Version_To_Attr --
+   --------------------------
+
+   function Lang_Version_To_Attr
+     (Version : Ada_Language_Version) return String is
+     (case Version is
+         when Unspecified => "",
+         when Ada_12      => """-gnat2012""",
+         when Ada_22      => """-gnat2022""");
+
 end TGen.Libgen;

src/tgen/tgen-libgen.ads

@@ -50,6 +50,9 @@ package TGen.Libgen is
       Test_Generation_Part => True,
       Wrappers_Part        => True];
 
+   type Ada_Language_Version is (Unspecified, Ada_12, Ada_22);
+   --  Ada language versions
+
    type Libgen_Context is private;
 
    function Create
@@ -160,6 +163,16 @@ package TGen.Libgen is
    --  Supported_Subprogram to ensure consistency of the array limit used in
    --  all the marshallers, otherwise Constraint_Error is raised.
 
+   procedure Set_Minimum_Lang_Version
+     (Ctx : in out Libgen_Context; Version : Ada_Language_Version);
+   --  Set the desired language version to be used in project compilation
+   --  switches. Note that if not set, no languages version switches will be
+   --  added to the generated project files.
+   --
+   --  TGen also requires at least an Ada_2012 compiler to be available, so
+   --  setting a version lower than that will result in -gnat12 being used in
+   --  the compiler switches, instead of the specified language version.
+
 private
    use TGen.Strings;
    use TGen.Context;
@@ -226,6 +239,10 @@ private
       Array_Index_Types : Typ_Set;
       --  Set of types used to instantiate array index constraints
 
+      Lang_Version : Ada_Language_Version := Unspecified;
+      --  Language version to be used in the compilation switches of the
+      --  generated projects. If Unspecified, no language version switch will
+      --  be added to the projects.
    end record;
 
 end TGen.Libgen;

src/utils-command_lines-common.ads

@@ -78,11 +78,11 @@ package Utils.Command_Lines.Common is
      Common_Boolean_Switches.Set_Shorthands
        ([Syntax_Only => +"-so"]);
 
-   type Ada_Version_Type is (Ada_83, Ada_95, Ada_2005, Ada_2012);
+   type Ada_Version_Type is (Ada_83, Ada_95, Ada_2005, Ada_2012, Ada_2022);
 
    package Ada_Version_Switches is new Enum_Switches
      (Common_Descriptor, Ada_Version_Type,
-      Default => Ada_Version_Type'Last);
+      Default => Ada_2012);
    --  These switches are ignored. The tools are tolerant of using newer
    --  reserved words, such as "interface", as identifiers, so we don't need to
    --  know the version.
@@ -91,7 +91,8 @@ package Utils.Command_Lines.Common is
      ([Ada_83 => +"-gnat83",
        Ada_95 => +"-gnat95",
        Ada_2005 => +"-gnat2005",
-       Ada_2012 => +"-gnat2012"]);
+       Ada_2012 => +"-gnat2012",
+       Ada_2022 => +"-gnat2022"]);
 
    package Ada_Version_Shorthands_2 is new Ada_Version_Switches.Set_Shorthands
      ([Ada_2005 => +"-gnat05",

testsuite/tests/test/195-repeated-pragmas/test.out

@@ -5,7 +5,7 @@
 --
 --  end read only
 
-pragma Ada_2005;
+pragma Ada_2012;
 --  begin read only
 --  end read only
 
@@ -33,7 +33,7 @@ end Input.Stub_Data;
 --
 --  end read only
 
-pragma Ada_2005;
+pragma Ada_2012;
 --  begin read only
 --  end read only
 

testsuite/tests/test/37-stub-ada-version/dep.adb

@@ -0,0 +1,6 @@
+package body Dep is
+
+   function Get_Acc (X : aliased Integer) return Int_Acc is
+     (X'Unrestricted_Access);
+
+end Dep;

testsuite/tests/test/37-stub-ada-version/dep.ads

@@ -0,0 +1,7 @@
+package Dep is
+
+   type Int_Acc is access all Integer;
+
+   function Get_Acc (X : aliased Integer) return Int_Acc;
+
+end Dep;