From: Ed Schonberg <schonberg@adacore.com>
Date: Mon, 20 Jun 2016 12:27:05 +0000 (+0000)
Subject: sem_ch13.adb (Visible_Component): New procedure...
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=9e3be36e465b0699d161e1e1ff9a78fd216c2c60;p=gcc.git

sem_ch13.adb (Visible_Component): New procedure...

2016-06-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Visible_Component): New procedure, subsidiary
	of Replace_Type_References_ Generic, to determine whether an
	identifier in a predicate or invariant expression is a visible
	component of the type to which the predicate or invariant
	applies. Implements the visibility rule stated in RM 13.1.1
	(12/3).

From-SVN: r237599
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5f5bd60253f..0f7c8352082 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+2016-06-20  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch13.adb (Visible_Component): New procedure, subsidiary
+	of Replace_Type_References_ Generic, to determine whether an
+	identifier in a predicate or invariant expression is a visible
+	component of the type to which the predicate or invariant
+	applies. Implements the visibility rule stated in RM 13.1.1
+	(12/3).
+
 2016-06-20  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* s-regpat.adb, sem_prag.adb, pprint.adb, sem_ch13.adb: Minor
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 009bf3235f4..9d2a0bdd25a 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -12298,17 +12298,44 @@ package body Sem_Ch13 is
       --  Processes a single node in the traversal procedure below, checking
       --  if node N should be replaced, and if so, doing the replacement.
 
+      function Visible_Component (Comp : Name_Id) return Entity_Id;
+      --  Given an identifier in the expression, check whether there is a
+      --  discriminant or component of the type that is directy visible, and
+      --  rewrite it as the corresponding selected component of the formal of
+      --  the subprogram. The entity is located by a sequential search, which
+      --  seems acceptable given the typical size of component lists and check
+      --  expressions. Possible optimization ???
+
       ----------------------
       -- Replace_Type_Ref --
       ----------------------
 
       function Replace_Type_Ref (N : Node_Id) return Traverse_Result is
-         S : Entity_Id;
-         P : Node_Id;
+         Loc : constant Source_Ptr := Sloc (N);
+         C   : Entity_Id;
+         S   : Entity_Id;
+         P   : Node_Id;
 
-      begin
-         --  Case of identifier
+         procedure Add_Prefix (Ref : Node_Id; Comp : Entity_Id);
+         --  Add the proper prefix to a reference to a component of the
+         --  type when it is not already a selected component.
+
+         ----------------
+         -- Add_Prefix --
+         ----------------
 
+         procedure Add_Prefix (Ref : Node_Id; Comp : Entity_Id) is
+         begin
+            Rewrite (Ref,
+              Make_Selected_Component (Loc,
+                Prefix => New_Occurrence_Of (T, Loc),
+                Selector_Name => New_Occurrence_Of (Comp, Loc)));
+            Replace_Type_Reference (Prefix (Ref));
+         end Add_Prefix;
+
+      --  Start of processing for Replace_Type_Ref
+
+      begin
          if Nkind (N) = N_Identifier then
 
             --  If not the type name, check whether it is a reference to some
@@ -12323,6 +12350,33 @@ package body Sem_Ch13 is
                   Freeze_Before (Freeze_Node (T), Current_Entity (N));
                end if;
 
+               --  The components of the type are directly visible and can
+               --  be referenced without a prefix.
+
+               if Nkind (Parent (N)) = N_Selected_Component then
+                  null;
+
+               --  In expression C (I), C may be a directly visible function
+               --  or a visible component that has an array type. Disambiguate
+               --  by examining the component type.
+
+               elsif Nkind (Parent (N)) = N_Indexed_Component
+                 and then N = Prefix (Parent (N))
+               then
+                  C := Visible_Component (Chars (N));
+
+                  if Present (C) and then Is_Array_Type (Etype (C)) then
+                     Add_Prefix (N, C);
+                  end if;
+
+               else
+                  C := Visible_Component (Chars (N));
+
+                  if Present (C) then
+                     Add_Prefix (N, C);
+                  end if;
+               end if;
+
                return Skip;
 
             --  Otherwise do the replacement and we are done with this node
@@ -12397,6 +12451,32 @@ package body Sem_Ch13 is
          end if;
       end Replace_Type_Ref;
 
+      -----------------------
+      -- Visible_Component --
+      -----------------------
+
+      function Visible_Component (Comp : Name_Id) return Entity_Id is
+         E : Entity_Id;
+      begin
+         if Ekind (T) /= E_Record_Type then
+            return Empty;
+
+         else
+            E := First_Entity (T);
+            while Present (E) loop
+               if Comes_From_Source (E)
+                 and then Chars (E) = Comp
+               then
+                  return E;
+               end if;
+
+               Next_Entity (E);
+            end loop;
+
+            return Empty;
+         end if;
+      end Visible_Component;
+
       procedure Replace_Type_Refs is new Traverse_Proc (Replace_Type_Ref);
 
    begin