Merge branch 'eyraud/315' into 'master'

Fix detection of non-instrumentable expression function

Closes #315 and #344

See merge request eng/das/cov/gnatcoverage!622

Closes eng/das/cov/gnatcoverage#315
Closes eng/das/cov/gnatcoverage#344

Author: Jugst3r

testsuite/tests/instr-cov/expr_func/prim2/main.adb renamed to testsuite/tests/instr-cov/expr_func/completion/main.adb

@@ -2,8 +2,7 @@ pragma Ada_2012;
 with Pak; use Pak;
 
 procedure Main is
-   Obj  : T := Make (True);
-   Obj2 : TT := Make (False);
+   T_Instance  : T := Make (True);
 begin
    null;
 end Main;

testsuite/tests/instr-cov/expr_func/completion/pak.ads

@@ -0,0 +1,19 @@
+pragma Ada_2012;
+
+package Pak is
+
+   type T is private;
+
+   function Make (Cond : Boolean) return T;
+
+private
+   type T is tagged record
+      X : Integer;
+   end record;
+   function Make (Cond : Boolean) return T is (T'(X => (if Cond then 1 else 2)));
+
+   type TT is new T with record
+      Y : Integer;
+   end record;
+   overriding function Make (Cond : Boolean) return TT is (TT'(X => 3, Y => 4));
+end Pak;

testsuite/tests/instr-cov/expr_func/completion/test.py

@@ -0,0 +1,39 @@
+"""
+Regression test: check that gnatcov does not instrument expression function
+that are a primitive of a tagged type T when the controlling parameter is the
+return type, and when the expression function is a completion.
+
+gnatcov used to instrument such expression function, which resulted in
+introducing a new primitive (the wrapper generated for MC/DC instrumentation),
+which was not defined for derived types.
+"""
+
+from SCOV.minicheck import build_run_and_coverage, check_xcov_reports
+from SUITE.context import thistest
+from SUITE.cutils import Wdir
+from SUITE.gprutils import GPRswitches
+from SUITE.tutils import gprfor
+
+
+tmp = Wdir("tmp_")
+
+build_run_and_coverage(
+    gprsw=GPRswitches(root_project=gprfor(srcdirs=[".."], mains=["main.adb"])),
+    covlevel="stmt+uc_mcdc",
+    mains=["main"],
+    extra_coverage_args=["-axcov", "--output-dir=xcov"],
+    trace_mode="src",
+    tolerate_instrument_messages=(
+        "cannot instrument an expression function which"
+    ),
+)
+
+check_xcov_reports(
+    "xcov",
+    {
+        "main.adb.xcov": {"+": {5, 7}},
+        "pak.ads.xcov": {"+": {5, 10, 11, 12, 15, 16, 17}, "?": {13, 18}},
+    },
+)
+
+thistest.result()

testsuite/tests/instr-cov/expr_func/prim/p.gpr

@@ -1,37 +1,39 @@
 """
-Check that we properly instrument expression functions that are primitives
-of tagged types for MC/DC.
+Check that gnatcov correctly processes expression functions that are primitives
+of tagged types for MC/DC, e.g. it warns about them, and they are reported as
+uninstrumented in the coverage report.
 """
 
-import os
-import os.path
-
 from SCOV.minicheck import build_run_and_coverage, check_xcov_reports
 from SUITE.context import thistest
 from SUITE.cutils import Wdir
 from SUITE.gprutils import GPRswitches
+from SUITE.tutils import gprfor
 
 
-p_gpr = os.path.abspath("p.gpr")
-obj_dir = os.path.abspath("obj")
-
 tmp = Wdir("tmp_")
 
 build_run_and_coverage(
-    gprsw=GPRswitches(root_project=p_gpr),
+    gprsw=GPRswitches(root_project=gprfor(srcdirs=[".."], mains=["main.adb"])),
     covlevel="stmt+uc_mcdc",
     mains=["main"],
     extra_coverage_args=["-axcov", "--output-dir=xcov"],
-    gpr_obj_dir=obj_dir,
-    gpr_exe_dir=obj_dir,
     trace_mode="src",
+    tolerate_instrument_messages=(
+        "cannot instrument an expression function which"
+    ),
 )
 
-# TODO: update coverage expectations once compiler bug
-# has been fixed and XFAIL is removed.
-
 check_xcov_reports(
-    "xcov", {"main.adb.xcov": {"+": {4, 5, 7, 12, 14, 17, 19, 21, 22, 23, 24}}}
+    "xcov",
+    {
+        "main.adb.xcov": {"+": {6}},
+        "pak.ads.xcov": {
+            "+": {4, 5, 6, 13, 14, 15},
+            "-": {8, 10},
+            "?": {11, 16},
+        },
+    },
 )
 
 thistest.result()

testsuite/tests/instr-cov/expr_func/prim/test.opt

@@ -3023,8 +3023,13 @@ package body Instrument.Ada_Unit is
       if Common_Nodes.Ctrl_Type.Is_Null then
          return False;
       end if;
-      return Common_Nodes.N_Spec.F_Subp_Returns.P_Designated_Type_Decl
-             = Common_Nodes.Ctrl_Type;
+
+      --  Always compare the full views, to avoid an equality mismatch when
+      --  e.g. comparing the full view against an incomplete view.
+
+      return
+        Common_Nodes.N_Spec.F_Subp_Returns.P_Designated_Type_Decl.P_Full_View
+          = Common_Nodes.Ctrl_Type.P_Full_View;
    exception
       when Exc : Property_Error =>
       Report (UIC,