[Ada] Expr. func. with private formal rejected in nested Ghost package
authorGary Dismukes <dismukes@adacore.com>
Thu, 4 Jul 2019 08:06:49 +0000 (08:06 +0000)
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Thu, 4 Jul 2019 08:06:49 +0000 (08:06 +0000)
The compiler prematurely freezes a private type that is the type of a
formal parameter of an expression function declared within a nested,
inactivated Ghost package, resulting is an error complaining that the
private type must be fully defined at that point. This is fixed by
testing for Ignored_Ghost_Entity in the condition guarding the code that
performs Mask_Unfrozen_Types for an expression function without a
separate declaration, ensuring that the expression function's profile
isn't frozen prematurely.

2019-07-04  Gary Dismukes  <dismukes@adacore.com>

gcc/ada/

* sem_ch6.adb (Analyze_Subprogram_Body_Helper): The special
treatment of calling Mask_Unfrozen_Types must also be done in
the case of an Ignored_Ghost_Entity, because Expander_Active is
False in that case.

gcc/testsuite/

* gnat.dg/ghost5.adb, gnat.dg/ghost5.ads,
gnat.dg/ghost5_parent.ads: New testcase.

From-SVN: r273065

gcc/ada/ChangeLog
gcc/ada/sem_ch6.adb
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/ghost5.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/ghost5.ads [new file with mode: 0644]
gcc/testsuite/gnat.dg/ghost5_parent.ads [new file with mode: 0644]

index f5c2927..5eb10d2 100644 (file)
@@ -1,3 +1,10 @@
+2019-07-04  Gary Dismukes  <dismukes@adacore.com>
+
+       * sem_ch6.adb (Analyze_Subprogram_Body_Helper): The special
+       treatment of calling Mask_Unfrozen_Types must also be done in
+       the case of an Ignored_Ghost_Entity, because Expander_Active is
+       False in that case.
+
 2019-07-04  Yannick Moy  <moy@adacore.com>
 
        * sem_prag.adb (Check_Library_Level_Entity): Update for new rule
index cf1b0e7..d238b9d 100644 (file)
@@ -3689,7 +3689,7 @@ package body Sem_Ch6 is
          --  generated. Freeze nodes, if any, are inserted before the current
          --  body. These freeze actions are also needed in ASIS mode and in
          --  Compile_Only mode to enable the proper back-end type annotations.
-         --  They are necessary in any case to insure order of elaboration
+         --  They are necessary in any case to ensure proper elaboration order
          --  in gigi.
 
          if Nkind (N) = N_Subprogram_Body
@@ -3698,13 +3698,16 @@ package body Sem_Ch6 is
            and then Serious_Errors_Detected = 0
            and then (Expander_Active
                       or else ASIS_Mode
-                      or else Operating_Mode = Check_Semantics)
+                      or else Operating_Mode = Check_Semantics
+                      or else Is_Ignored_Ghost_Entity (Spec_Id))
          then
             --  The body generated for an expression function that is not a
             --  completion is a freeze point neither for the profile nor for
             --  anything else. That's why, in order to prevent any freezing
             --  during analysis, we need to mask types declared outside the
             --  expression (and in an outer scope) that are not yet frozen.
+            --  This also needs to be done in the case of an ignored Ghost
+            --  expression function, where the expander isn't active.
 
             Set_Is_Frozen (Spec_Id);
             Mask_Types := Mask_Unfrozen_Types (Spec_Id);
index 3502e68..dd1aa0d 100644 (file)
@@ -1,3 +1,8 @@
+2019-07-04  Gary Dismukes  <dismukes@adacore.com>
+
+       * gnat.dg/ghost5.adb, gnat.dg/ghost5.ads,
+       gnat.dg/ghost5_parent.ads: New testcase.
+
 2019-07-04  Yannick Moy  <moy@adacore.com>
 
        * gnat.dg/spark3.adb: New testcase.
diff --git a/gcc/testsuite/gnat.dg/ghost5.adb b/gcc/testsuite/gnat.dg/ghost5.adb
new file mode 100644 (file)
index 0000000..8aad8d4
--- /dev/null
@@ -0,0 +1,5 @@
+--  { dg-do compile }
+
+package body Ghost5 is
+   procedure Foo is null;
+end Ghost5;
diff --git a/gcc/testsuite/gnat.dg/ghost5.ads b/gcc/testsuite/gnat.dg/ghost5.ads
new file mode 100644 (file)
index 0000000..f58ff39
--- /dev/null
@@ -0,0 +1,5 @@
+with Ghost5_Parent;
+generic
+package Ghost5 is
+   procedure Foo;
+end Ghost5;
diff --git a/gcc/testsuite/gnat.dg/ghost5_parent.ads b/gcc/testsuite/gnat.dg/ghost5_parent.ads
new file mode 100644 (file)
index 0000000..cab7f31
--- /dev/null
@@ -0,0 +1,14 @@
+package Ghost5_Parent is
+
+   type Priv is private;
+
+   package Nested with Ghost is
+      function Func1 (X : Priv) return Boolean is (True); -- Error flagged here
+      function Func2 (X : Priv) return Boolean is (False);
+   end Nested;
+
+private
+
+    type Priv is new Integer;
+
+end Ghost5_Parent;