public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [Ada] Spurious compile failure with nested packages
@ 2017-04-25  9:24 Arnaud Charlet
  0 siblings, 0 replies; 2+ messages in thread
From: Arnaud Charlet @ 2017-04-25  9:24 UTC (permalink / raw)
  To: gcc-patches; +Cc: Justin Squirek

[-- Attachment #1: Type: text/plain, Size: 504 bytes --]

This patch adds a predicate to verify that entities within an inner package
do not rely on library unit level private types in cases where the full view of
said private types are unseen.

Tested on x86_64-pc-linux-gnu, committed on trunk

2017-04-25  Justin Squirek  <squirek@adacore.com>

	* sem_ch3.adb (Analyze_Declarations): Minor
	correction to comments, move out large conditional and scope
	traversal into a predicate.
	(Uses_Unseen_Lib_Unit_Priv): Predicate function made from extracted
	logic.


[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 8826 bytes --]

Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb	(revision 247152)
+++ sem_ch3.adb	(working copy)
@@ -2195,6 +2195,10 @@
       --  Utility to resolve the expressions of aspects at the end of a list of
       --  declarations.
 
+      function Uses_Unseen_Lib_Unit_Priv (Pkg : Entity_Id) return Boolean;
+      --  Check if an inner package has entities within it that rely on library
+      --  level private types where the full view has not been seen.
+
       -----------------
       -- Adjust_Decl --
       -----------------
@@ -2480,6 +2484,40 @@
          end loop;
       end Resolve_Aspects;
 
+      -------------------------------
+      -- Uses_Unseen_Lib_Unit_Priv --
+      -------------------------------
+
+      function Uses_Unseen_Lib_Unit_Priv (Pkg : Entity_Id) return Boolean is
+         Curr : Entity_Id;
+
+      begin
+         --  Avoid looking through scopes that do not meet the precondition of
+         --  Pkg not being within a library unit spec.
+
+         if not Is_Compilation_Unit (Pkg)
+           and then not Is_Generic_Instance (Pkg)
+           and then not In_Package_Body (Enclosing_Lib_Unit_Entity (Pkg))
+         then
+            --  Loop through all entities in the current scope to identify
+            --  an entity that depends on a private type.
+
+            Curr := First_Entity (Pkg);
+            loop
+               if Nkind (Curr) in N_Entity
+                 and then Depends_On_Private (Curr)
+               then
+                  return True;
+               end if;
+
+               exit when Last_Entity (Current_Scope) = Curr;
+               Curr := Next_Entity (Curr);
+            end loop;
+         end if;
+
+         return False;
+      end Uses_Unseen_Lib_Unit_Priv;
+
       --  Local variables
 
       Context     : Node_Id   := Empty;
@@ -2489,10 +2527,6 @@
       Body_Seen : Boolean := False;
       --  Flag set when the first body [stub] is encountered
 
-      Ignore_Freezing : Boolean;
-      --  Flag set when deciding to freeze an expression function in the
-      --  current scope.
-
    --  Start of processing for Analyze_Declarations
 
    begin
@@ -2631,89 +2665,57 @@
          --  care to attach the bodies at a proper place in the tree so as to
          --  not cause unwanted freezing at that point.
 
-         elsif not Analyzed (Next_Decl) and then Is_Body (Next_Decl) then
+         --  It is also necessary to check for a case where both an expression
+         --  function is used and the current scope depends on an unseen
+         --  private type from a library unit, otherwise premature freezing of
+         --  the private type will occur.
 
-            --  Check for an edge case that may cause premature freezing of
-            --  a private type. If there is a type which depends on another
-            --  private type from an enclosing package that is in the same
-            --  scope as a non-completing expression function then we cannot
-            --  freeze here.
+         elsif not Analyzed (Next_Decl) and then Is_Body (Next_Decl)
+           and then ((Nkind (Next_Decl) /= N_Subprogram_Body
+                      or else not Was_Expression_Function (Next_Decl))
+                     or else not Uses_Unseen_Lib_Unit_Priv (Current_Scope))
+         then
+            --  When a controlled type is frozen, the expander generates stream
+            --  and controlled-type support routines. If the freeze is caused
+            --  by the stand-alone body of Initialize, Adjust, or Finalize, the
+            --  expander will end up using the wrong version of these routines,
+            --  as the body has not been processed yet. To remedy this, detect
+            --  a late controlled primitive and create a proper spec for it.
+            --  This ensures that the primitive will override its inherited
+            --  counterpart before the freeze takes place.
 
-            Ignore_Freezing := False;
+            --  If the declaration we just processed is a body, do not attempt
+            --  to examine Next_Decl as the late primitive idiom can only apply
+            --  to the first encountered body.
 
-            if Nkind (Next_Decl) = N_Subprogram_Body
-              and then Was_Expression_Function (Next_Decl)
-              and then not Is_Compilation_Unit (Current_Scope)
-              and then not Is_Generic_Instance (Current_Scope)
-              and then not In_Package_Body
-                             (Enclosing_Lib_Unit_Entity (Current_Scope))
-            then
-               --  Loop through all entities in the current scope to identify
-               --  an instance of the edge case outlined above and ignore
-               --  freezing if it is detected.
+            --  The spec of the late primitive is not generated in ASIS mode to
+            --  ensure a consistent list of primitives that indicates the true
+            --  semantic structure of the program (which is not relevant when
+            --  generating executable code).
 
-               declare
-                  Curr : Entity_Id := First_Entity (Current_Scope);
-               begin
-                  loop
-                     if Nkind (Curr) in N_Entity
-                       and then Depends_On_Private (Curr)
-                     then
-                        Ignore_Freezing := True;
-                        exit;
-                     end if;
+            --  ??? A cleaner approach may be possible and/or this solution
+            --  could be extended to general-purpose late primitives, TBD.
 
-                     exit when Last_Entity (Current_Scope) = Curr;
-                     Curr := Next_Entity (Curr);
-                  end loop;
-               end;
-            end if;
+            if not ASIS_Mode
+              and then not Body_Seen
+              and then not Is_Body (Decl)
+            then
+               Body_Seen := True;
 
-            if not Ignore_Freezing then
-
-               --  When a controlled type is frozen, the expander generates
-               --  stream and controlled-type support routines. If the freeze
-               --  is caused by the stand-alone body of Initialize, Adjust, or
-               --  Finalize, the expander will end up using the wrong version
-               --  of these routines, as the body has not been processed yet.
-               --  To remedy this, detect a late controlled primitive and
-               --  create a proper spec for it. This ensures that the primitive
-               --  will override its inherited counterpart before the freeze
-               --  takes place.
-
-               --  If the declaration we just processed is a body, do not
-               --  attempt to examine Next_Decl as the late primitive idiom can
-               --  only apply to the first encountered body.
-
-               --  The spec of the late primitive is not generated in ASIS mode
-               --  to ensure a consistent list of primitives that indicates the
-               --  true semantic structure of the program (which is not
-               --  relevant when generating executable code).
-
-               --  ??? A cleaner approach may be possible and/or this solution
-               --  could be extended to general-purpose late primitives, TBD.
-
-               if not ASIS_Mode
-                 and then not Body_Seen
-                 and then not Is_Body (Decl)
-               then
-                  Body_Seen := True;
-
-                  if Nkind (Next_Decl) = N_Subprogram_Body then
-                     Handle_Late_Controlled_Primitive (Next_Decl);
-                  end if;
+               if Nkind (Next_Decl) = N_Subprogram_Body then
+                  Handle_Late_Controlled_Primitive (Next_Decl);
                end if;
+            end if;
 
-               Adjust_Decl;
+            Adjust_Decl;
 
-               --  The generated body of an expression function does not
-               --  freeze, unless it is a completion, in which case only the
-               --  expression itself freezes. This is handled when the body
-               --  itself is analyzed (see Freeze_Expr_Types, sem_ch6.adb).
+            --  The generated body of an expression function does not freeze,
+            --  unless it is a completion, in which case only the expression
+            --  itself freezes. This is handled when the body itself is
+            --  analyzed (see Freeze_Expr_Types, sem_ch6.adb).
 
-               Freeze_All (Freeze_From, Decl);
-               Freeze_From := Last_Entity (Current_Scope);
-            end if;
+            Freeze_All (Freeze_From, Decl);
+            Freeze_From := Last_Entity (Current_Scope);
          end if;
 
          Decl := Next_Decl;

^ permalink raw reply	[flat|nested] 2+ messages in thread

* [Ada] Spurious compile failure with nested packages
@ 2017-04-25  9:01 Arnaud Charlet
  0 siblings, 0 replies; 2+ messages in thread
From: Arnaud Charlet @ 2017-04-25  9:01 UTC (permalink / raw)
  To: gcc-patches; +Cc: Justin Squirek

[-- Attachment #1: Type: text/plain, Size: 1788 bytes --]

This patch adds another condition to an edge case used to delay expression
function freezing (P804-015). The offending package is within the body of a
library-level unit where this edge-case does not apply. By adding a condition
that only delays freezing of expression functions if we are in a library-level
spec we can avoid spurious disambiguation errors.

------------
-- Source --
------------

--  pkg.ads

package Pkg is
   pragma Elaborate_Body;
end;

--  pkg.adb

with Ada.Containers.Vectors;
package body Pkg is
   package SubPkg1 is
      type T1 is private;
      function Foo (T : T1) return Boolean is (True);
      subtype ST1 is T1 with Dynamic_Predicate => Foo (ST1);
   private
      type T1 is null record;
   end;

   package SubPkg2 is
      type T2 is private;
      function Foo (T : T2) return Boolean is (True);
   private
      package V2 is new Ada.Containers.Vectors
        (Positive, SubPkg1.ST1, SubPkg1."=");
      type T2 is record
         SubPkg1 : V2.Vector;
      end record;
   end;

   type C is record
      Count : Natural;
   end record;
   type CA is array (1 .. 3) of C;

   package VC is new Ada.Containers.Vectors (Positive, CA);
   V : VC.Vector;

   procedure Bar is
   begin
      for P in V.Iterate loop
         for X of V (P) loop
            X.Count := X.Count - 1;
         end loop;
      end loop;
   end;
end;

----------------------------
-- Compilation and output --
----------------------------

$ gcc -c pkg.adb
pkg.adb:15:07: warning: in instantiation at a-convec.ads:375
pkg.adb:15:07: warning: component of "Elements_Array" padded by 8 bits

Tested on x86_64-pc-linux-gnu, committed on trunk

2017-04-25  Justin Squirek  <squirek@adacore.com>

	* sem_ch3.adb (Analyze_Declarations): Add
	additional condition for edge case.


[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 652 bytes --]

Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb	(revision 247146)
+++ sem_ch3.adb	(working copy)
@@ -2646,6 +2646,8 @@
               and then Was_Expression_Function (Next_Decl)
               and then not Is_Compilation_Unit (Current_Scope)
               and then not Is_Generic_Instance (Current_Scope)
+              and then not In_Package_Body
+                             (Enclosing_Lib_Unit_Entity (Current_Scope))
             then
                --  Loop through all entities in the current scope to identify
                --  an instance of the edge case outlined above and ignore

^ permalink raw reply	[flat|nested] 2+ messages in thread

end of thread, other threads:[~2017-04-25  9:22 UTC | newest]

Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2017-04-25  9:24 [Ada] Spurious compile failure with nested packages Arnaud Charlet
  -- strict thread matches above, loose matches on Subject: below --
2017-04-25  9:01 Arnaud Charlet

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).