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

Message ID 20180111091122.GA105192@adacore.com
State New
Headers show
Series
  • [Ada] Spurious error on referene to subcoponrnt in dynamic predicate
Related show

Commit Message

Pierre-Marie de Rodat Jan. 11, 2018, 9:11 a.m.
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;

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

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.

Patch

--- gcc/ada/sem_ch13.adb
+++ 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