Merge branch 'instrument_expr_func' into 'master'

Add instrumentation for expression functions

Closes #143

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

src/test-skeleton-source_table.adb

@@ -71,6 +71,10 @@ package body Test.Skeleton.Source_Table is
       Corresponding_Body : String_Access := null;
       --  Set in Stub Mode for package specs.
 
+      Theoretical_Body   : String_Access := null;
+      --  Set for creating an instrumented body in case a bodyless spec would
+      --  nned a body due to expression functions.
+
       Stub_Data_Base_Spec : String_Access;
       Stub_Data_Base_Body : String_Access;
       --  Different projects in the hierarchy may have different naming
@@ -259,11 +263,14 @@ package body Test.Skeleton.Source_Table is
             New_SF_Record.Inst_Dir := new String'
               (Display_Full_Name
                  (P.Object_Dir / (+(To_Lower (P.Name) & Instr_Suffix))));
-            if Given_File /= Other_File
-              and then Is_Regular_File (Other_File.Display_Full_Name)
-            then
-               New_SF_Record.Corresponding_Body :=
-                 new String'(Other_File.Display_Full_Name);
+            if Given_File /= Other_File then
+               if Is_Regular_File (Other_File.Display_Full_Name) then
+                  New_SF_Record.Corresponding_Body :=
+                    new String'(Other_File.Display_Full_Name);
+               else
+                  New_SF_Record.Theoretical_Body :=
+                    new String'(Other_File.Display_Full_Name);
+               end if;
             end if;
          end;
       end if;
@@ -585,6 +592,28 @@ package body Test.Skeleton.Source_Table is
       end if;
    end Get_Source_Body;
 
+   ---------------------------
+   -- Get_Source_Instr_Body --
+   ---------------------------
+
+   function Get_Source_Instr_Body (Source_Name : String) return String
+   is
+      SN : constant String :=
+        Normalize_Pathname
+          (Name           => Source_Name,
+           Resolve_Links  => False,
+           Case_Sensitive => False);
+      SFR : SF_Record;
+   begin
+      SFR := Source_File_Table.Element (SF_Table, SN);
+
+      if SFR.Theoretical_Body = null then
+         return "";
+      else
+         return SFR.Theoretical_Body.all;
+      end if;
+   end Get_Source_Instr_Body;
+
    -----------------------------
    --  Get_Source_Output_Dir  --
    -----------------------------

src/test-skeleton-source_table.ads

@@ -117,6 +117,7 @@ package Test.Skeleton.Source_Table is
    function Get_Source_Project_Name    (Source_Name : String) return String;
    function Get_Source_Unit_Name       (Source_Name : String) return String;
    function Get_Source_Instr_Dir       (Source_Name : String) return String;
+   function Get_Source_Instr_Body      (Source_Name : String) return String;
 
    procedure Mark_Sourse_Stubbed (Source_Name : String);
    function Source_Stubbed (Source_Name : String) return Boolean;

testsuite/tests/test/instrument_expr_func/gnattest/tests/p-test_data-tests-n2-n23-test_data-tests.adb

@@ -0,0 +1,62 @@
+--  This package has been generated automatically by GNATtest.
+--  You are allowed to add your code to the bodies of test routines.
+--  Such changes will be kept during further regeneration of this file.
+--  All code placed outside of test routine bodies will be lost. The
+--  code intended to set up and tear down the test environment should be
+--  placed into P.Test_Data.Tests.N2.N23.Test_Data.
+
+with AUnit.Assertions; use AUnit.Assertions;
+with System.Assertions;
+
+--  begin read only
+--  id:2.2/00/
+--
+--  This section can be used to add with clauses if necessary.
+--
+--  end read only
+
+--  begin read only
+--  end read only
+package body P.Test_Data.Tests.N2.N23.Test_Data.Tests is
+
+--  begin read only
+--  id:2.2/01/
+--
+--  This section can be used to add global variables and other elements.
+--
+--  end read only
+
+--  begin read only
+--  end read only
+
+--  begin read only
+   procedure Test_Expr_Nested_no_package_Body_2 (Gnattest_T : in out Test);
+   procedure Test_Expr_Nested_no_package_Body_2_66da08 (Gnattest_T : in out Test) renames Test_Expr_Nested_no_package_Body_2;
+--  id:2.2/66da0802ea936761/Expr_Nested_no_package_Body_2/1/0/
+   procedure Test_Expr_Nested_no_package_Body_2 (Gnattest_T : in out Test) is
+   --  p.ads:23:10:Expr_Nested_no_package_Body_2
+--  end read only
+
+      pragma Unreferenced (Gnattest_T);
+
+   begin
+
+      AUnit.Assertions.Assert
+        (P.N2.N23.Expr_Nested_no_package_Body_2 (997) = 1000,
+         "worng Expr_Nested_no_package_Body");
+
+--  begin read only
+   end Test_Expr_Nested_no_package_Body_2;
+--  end read only
+
+--  begin read only
+--  id:2.2/02/
+--
+--  This section can be used to add elaboration code for the global state.
+--
+begin
+--  end read only
+   null;
+--  begin read only
+--  end read only
+end P.Test_Data.Tests.N2.N23.Test_Data.Tests;

testsuite/tests/test/instrument_expr_func/gnattest/tests/p-test_data-tests.adb

@@ -0,0 +1,104 @@
+--  This package has been generated automatically by GNATtest.
+--  You are allowed to add your code to the bodies of test routines.
+--  Such changes will be kept during further regeneration of this file.
+--  All code placed outside of test routine bodies will be lost. The
+--  code intended to set up and tear down the test environment should be
+--  placed into P.Test_Data.
+
+with AUnit.Assertions; use AUnit.Assertions;
+with System.Assertions;
+
+--  begin read only
+--  id:2.2/00/
+--
+--  This section can be used to add with clauses if necessary.
+--
+--  end read only
+
+--  begin read only
+--  end read only
+package body P.Test_Data.Tests is
+
+--  begin read only
+--  id:2.2/01/
+--
+--  This section can be used to add global variables and other elements.
+--
+--  end read only
+
+--  begin read only
+--  end read only
+
+--  begin read only
+   procedure Test_Expr (Gnattest_T : in out Test);
+   procedure Test_Expr_617926 (Gnattest_T : in out Test) renames Test_Expr;
+--  id:2.2/6179266ae349cdc0/Expr/1/0/
+   procedure Test_Expr (Gnattest_T : in out Test) is
+   --  p.ads:3:4:Expr
+--  end read only
+
+      pragma Unreferenced (Gnattest_T);
+
+   begin
+
+      AUnit.Assertions.Assert
+        (Expr (100) = 1000,
+         "wrong expr");
+
+--  begin read only
+   end Test_Expr;
+--  end read only
+
+
+--  begin read only
+   procedure Test_Expr_Private_Body (Gnattest_T : in out Test);
+   procedure Test_Expr_Private_Body_30624e (Gnattest_T : in out Test) renames Test_Expr_Private_Body;
+--  id:2.2/30624e53e675d71b/Expr_Private_Body/1/0/
+   procedure Test_Expr_Private_Body (Gnattest_T : in out Test) is
+   --  p.ads:6:4:Expr_Private_Body
+--  end read only
+
+      pragma Unreferenced (Gnattest_T);
+
+   begin
+
+      AUnit.Assertions.Assert
+        (Expr_Private_Body (107) = 104,
+         "wrong expr2");
+
+--  begin read only
+   end Test_Expr_Private_Body;
+--  end read only
+
+
+--  begin read only
+   procedure Test_Package_Needs_Body (Gnattest_T : in out Test);
+   procedure Test_Package_Needs_Body_1c64ee (Gnattest_T : in out Test) renames Test_Package_Needs_Body;
+--  id:2.2/1c64eefbe84ddedf/Package_Needs_Body/1/0/
+   procedure Test_Package_Needs_Body (Gnattest_T : in out Test) is
+   --  p.ads:8:4:Package_Needs_Body
+--  end read only
+
+      pragma Unreferenced (Gnattest_T);
+
+   begin
+
+      AUnit.Assertions.Assert
+        (True,
+         "Test not implemented.");
+
+--  begin read only
+   end Test_Package_Needs_Body;
+--  end read only
+
+--  begin read only
+--  id:2.2/02/
+--
+--  This section can be used to add elaboration code for the global state.
+--
+begin
+--  end read only
+   null;
+--  begin read only
+--  end read only
+end P.Test_Data.Tests;

testsuite/tests/test/instrument_expr_func/gnattest/tests/q-test_data-tests-nesting_2-nesting_2_1-test_data-tests.adb

@@ -0,0 +1,62 @@
+--  This package has been generated automatically by GNATtest.
+--  You are allowed to add your code to the bodies of test routines.
+--  Such changes will be kept during further regeneration of this file.
+--  All code placed outside of test routine bodies will be lost. The
+--  code intended to set up and tear down the test environment should be
+--  placed into Q.Test_Data.Tests.Nesting_2.Nesting_2_1.Test_Data.
+
+with AUnit.Assertions; use AUnit.Assertions;
+with System.Assertions;
+
+--  begin read only
+--  id:2.2/00/
+--
+--  This section can be used to add with clauses if necessary.
+--
+--  end read only
+
+--  begin read only
+--  end read only
+package body Q.Test_Data.Tests.Nesting_2.Nesting_2_1.Test_Data.Tests is
+
+--  begin read only
+--  id:2.2/01/
+--
+--  This section can be used to add global variables and other elements.
+--
+--  end read only
+
+--  begin read only
+--  end read only
+
+--  begin read only
+   procedure Test_F5 (Gnattest_T : in out Test);
+   procedure Test_F5_354a5c (Gnattest_T : in out Test) renames Test_F5;
+--  id:2.2/354a5c8e2ee02230/F5/1/0/
+   procedure Test_F5 (Gnattest_T : in out Test) is
+   --  q.ads:10:10:F5
+--  end read only
+
+      pragma Unreferenced (Gnattest_T);
+
+   begin
+
+      AUnit.Assertions.Assert
+        (Q.Nesting_2.Nesting_2_1.F5 (111) = 777,
+         "wrong F5");
+
+--  begin read only
+   end Test_F5;
+--  end read only
+
+--  begin read only
+--  id:2.2/02/
+--
+--  This section can be used to add elaboration code for the global state.
+--
+begin
+--  end read only
+   null;
+--  begin read only
+--  end read only
+end Q.Test_Data.Tests.Nesting_2.Nesting_2_1.Test_Data.Tests;

testsuite/tests/test/instrument_expr_func/gnattest/tests/q-test_data-tests.adb

@@ -0,0 +1,62 @@
+--  This package has been generated automatically by GNATtest.
+--  You are allowed to add your code to the bodies of test routines.
+--  Such changes will be kept during further regeneration of this file.
+--  All code placed outside of test routine bodies will be lost. The
+--  code intended to set up and tear down the test environment should be
+--  placed into Q.Test_Data.
+
+with AUnit.Assertions; use AUnit.Assertions;
+with System.Assertions;
+
+--  begin read only
+--  id:2.2/00/
+--
+--  This section can be used to add with clauses if necessary.
+--
+--  end read only
+
+--  begin read only
+--  end read only
+package body Q.Test_Data.Tests is
+
+--  begin read only
+--  id:2.2/01/
+--
+--  This section can be used to add global variables and other elements.
+--
+--  end read only
+
+--  begin read only
+--  end read only
+
+--  begin read only
+   procedure Test_Inc (Gnattest_T : in out Test);
+   procedure Test_Inc_4f8b9f (Gnattest_T : in out Test) renames Test_Inc;
+--  id:2.2/4f8b9f38b0ce8c74/Inc/1/0/
+   procedure Test_Inc (Gnattest_T : in out Test) is
+   --  q.ads:2:4:Inc
+--  end read only
+
+      pragma Unreferenced (Gnattest_T);
+
+   begin
+
+      AUnit.Assertions.Assert
+        (Inc (100000) = 100001,
+         "wrong inc");
+
+--  begin read only
+   end Test_Inc;
+--  end read only
+
+--  begin read only
+--  id:2.2/02/
+--
+--  This section can be used to add elaboration code for the global state.
+--
+begin
+--  end read only
+   null;
+--  begin read only
+--  end read only
+end Q.Test_Data.Tests;

testsuite/tests/test/instrument_expr_func/p.adb

@@ -0,0 +1,15 @@
+package body P is
+
+   procedure Package_Needs_Body (X : in out Integer) is
+   begin
+      null;
+   end Package_Needs_Body;
+
+   package body N1 is
+      procedure Nested_Needs_Body is
+      begin
+         null;
+      end Nested_Needs_Body;
+   end N1;
+
+end P;