From: Ed Schonberg <schonberg@adacore.com>
Date: Thu, 11 Jan 2018 08:54:17 +0000 (+0000)
Subject: [Ada] Spurious error on referene to subcoponrnt in dynamic predicate
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=a2fd4f0efe04ccf7052b367b407de4c92acfa795;p=gcc.git

[Ada] Spurious error on referene to subcoponrnt in dynamic predicate

This patch fixes a visibility error in the expression for a dynamic predicate
of a record type, when the expression contains a reference to a subcomponent
of the record given by a selected component whose prefix is the name of the
enclosing component.

Executing

   gnatmake -q -gnata main
   ./main

must yield:

   TGV OK
   Amtrak broken, as usual

----
with Text_IO; use Text_IO;
with Recpred; use Recpred;
procedure Main is
   TGV : Train_Data;
   Amtrak : Train_Data;
begin
  TGV  := (20, (10,10));
  Put_Line ("TGV OK");

  begin
     Amtrak := (30, (40, 40));
  exception
     when Others =>
        Put_Line ("Amtrak broken, as usual");
  end;
end;
----
package Recpred is

   type Train_Position is record
      TTD : Integer;
      VSS : Integer;
   end record;

   type Train_Data is record
      MA             : Integer;
      Front_Position : Train_Position;
   end record
     with Dynamic_Predicate => MA >= Front_Position.TTD;

end Recpred;

2018-01-11  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_ch13.adb (Replace_Type_Ref): Handle properly reference to a
	subcomponent of the current entity when building the body for a dynamic
	predicate function for a record with composite subcomponents.

From-SVN: r256514
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 8559dc97c41..e81b9bf1ee6 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+2018-01-11  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch13.adb (Replace_Type_Ref): Handle properly reference to a
+	subcomponent of the current entity when building the body for a dynamic
+	predicate function for a record with composite subcomponents.
+
 2018-01-11  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* exp_aggr.adb (Convert_Aggr_In_Object_Decl): Update the call to
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index b26d99f8511..a9e8855e9a6 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2017, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2018, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -12684,17 +12684,26 @@ package body Sem_Ch13 is
                return Skip;
             end if;
 
-         --  Case of selected component (which is what a qualification looks
-         --  like in the unanalyzed tree, which is what we have.
+         --  Case of selected component, which may be a subcomponent of the
+         --  current instance, or an expanded name which is still unanalyzed.
 
          elsif Nkind (N) = N_Selected_Component then
 
             --  If selector name is not our type, keep going (we might still
             --  have an occurrence of the type in the prefix).
+            --  If it is a subcomponent of the current entity, add prefix.
 
             if Nkind (Selector_Name (N)) /= N_Identifier
               or else Chars (Selector_Name (N)) /= TName
             then
+               if Nkind (Prefix (N)) = N_Identifier then
+                  Comp := Visible_Component (Chars (Prefix (N)));
+
+                  if Present (Comp) then
+                     Add_Prefix (Prefix (N), Comp);
+                  end if;
+               end if;
+
                return OK;
 
             --  Selector name is our type, check qualification