===================================================================
@@ -2673,17 +2673,29 @@
-- Check_Implicit_Dereference --
--------------------------------
- procedure Check_Implicit_Dereference (Nam : Node_Id; Typ : Entity_Id) is
+ procedure Check_Implicit_Dereference (N : Node_Id; Typ : Entity_Id) is
Disc : Entity_Id;
Desig : Entity_Id;
+ Nam : Node_Id;
begin
+ if Nkind (N) = N_Indexed_Component
+ and then Present (Generalized_Indexing (N))
+ then
+ Nam := Generalized_Indexing (N);
+
+ else
+ Nam := N;
+ end if;
+
if Ada_Version < Ada_2012
or else not Has_Implicit_Dereference (Base_Type (Typ))
then
return;
- elsif not Comes_From_Source (Nam) then
+ elsif not Comes_From_Source (N)
+ and then Nkind (N) /= N_Indexed_Component
+ then
return;
elsif Is_Entity_Name (Nam) and then Is_Type (Entity (Nam)) then
@@ -2695,6 +2707,26 @@
if Has_Implicit_Dereference (Disc) then
Desig := Designated_Type (Etype (Disc));
Add_One_Interp (Nam, Disc, Desig);
+
+ -- If the node is a generalized indexing, add interpretation
+ -- to that node as well, for subsequent resolution.
+
+ if Nkind (N) = N_Indexed_Component then
+ Add_One_Interp (N, Disc, Desig);
+ end if;
+
+ -- If the operation comes from a generic unit and the context
+ -- is a selected component, the selector name may be global
+ -- and set in the instance already. Remove the entity to
+ -- force resolution of the selected component, and the
+ -- generation of an explicit dereference if needed.
+
+ if In_Instance
+ and then Nkind (Parent (Nam)) = N_Selected_Component
+ then
+ Set_Entity (Selector_Name (Parent (Nam)), Empty);
+ end if;
+
exit;
end if;
@@ -16543,11 +16575,21 @@
begin
-- Nothing to do if argument is Empty or has Debug_Info_Off set, which
-- indicates that Debug_Info_Needed is never required for the entity.
+ -- Nothing to do if entity comes from a predefined file. Library files
+ -- are compiled without debug information, but inlined bodies of these
+ -- routines may appear in user code, and debug information on them ends
+ -- up complicating debugging the user code.
if No (T)
or else Debug_Info_Off (T)
then
return;
+
+ elsif In_Inlined_Body
+ and then Is_Predefined_File_Name
+ (Unit_File_Name (Get_Source_Unit (Sloc (T))))
+ then
+ Set_Needs_Debug_Info (T, False);
end if;
-- Set flag in entity itself. Note that we will go through the following
===================================================================
@@ -285,10 +285,12 @@
-- the one containing C2, that is known to refer to the same object (RM
-- 6.4.1(6.17/3)).
- procedure Check_Implicit_Dereference (Nam : Node_Id; Typ : Entity_Id);
+ procedure Check_Implicit_Dereference (N : Node_Id; Typ : Entity_Id);
-- AI05-139-2: Accessors and iterators for containers. This procedure
-- checks whether T is a reference type, and if so it adds an interprettion
- -- to Expr whose type is the designated type of the reference_discriminant.
+ -- to N whose type is the designated type of the reference_discriminant.
+ -- If N is a generalized indexing operation, the interpretation is added
+ -- both to the corresponding function call, and to the indexing node.
procedure Check_Internal_Protected_Use (N : Node_Id; Nam : Entity_Id);
-- Within a protected function, the current object is a constant, and
===================================================================
@@ -7036,7 +7036,6 @@
Loc : constant Source_Ptr := Sloc (N);
C_Type : Entity_Id;
Assoc : List_Id;
- Disc : Entity_Id;
Func : Entity_Id;
Func_Name : Node_Id;
Indexing : Node_Id;
@@ -7149,21 +7148,7 @@
-- discriminant is not the first discriminant.
if Has_Discriminants (Etype (Func)) then
- Disc := First_Discriminant (Etype (Func));
- while Present (Disc) loop
- declare
- Elmt_Type : Entity_Id;
- begin
- if Has_Implicit_Dereference (Disc) then
- Elmt_Type := Designated_Type (Etype (Disc));
- Add_One_Interp (Indexing, Disc, Elmt_Type);
- Add_One_Interp (N, Disc, Elmt_Type);
- exit;
- end if;
- end;
-
- Next_Discriminant (Disc);
- end loop;
+ Check_Implicit_Dereference (N, Etype (Func));
end if;
else
@@ -7194,18 +7179,7 @@
-- Add implicit dereference interpretation
if Has_Discriminants (Etype (It.Nam)) then
- Disc := First_Discriminant (Etype (It.Nam));
- while Present (Disc) loop
- if Has_Implicit_Dereference (Disc) then
- Add_One_Interp
- (Indexing, Disc, Designated_Type (Etype (Disc)));
- Add_One_Interp
- (N, Disc, Designated_Type (Etype (Disc)));
- exit;
- end if;
-
- Next_Discriminant (Disc);
- end loop;
+ Check_Implicit_Dereference (N, Etype (It.Nam));
end if;
exit;
The use of reference types and generalized indexing leads to multiple tree rewritings. When these uses are in a generic unit, the transformations are not propagated to instantiations, and the analysis of the instance must replicate that of the generic to recognize the presence of implicit dereferences. This patch removes some global information from selected components whose prefix involves an implicit dereference, to force the re-analysis and resolution in the instantiation. Executing; gnatmake -q cont cont must yield: 1234 1234 1234 2468 --- with Par; use Par; with Par.Child; with Ada.Finalization; use Ada.Finalization; procedure Cont is use My_Lists; Bunch : List; Ptr : Cursor; package Inst is new Par.Child; use Inst; begin Append (Bunch, R'(Controlled with Kind => 1234)); Try (Bunch, Bunch.First); end; --- with ada.containers.doubly_linked_lists; with Ada.Finalization; use Ada.Finalization; use ada.containers; package Par is type R is new Ada.Finalization.Controlled with record Kind : Integer; end record; package My_Lists is new Doubly_Linked_Lists (R); end Par; --- generic package Par.Child is use My_Lists; procedure Try (Bunch: List; C : Cursor); end Par.Child; -- with Text_IO; use Text_IO; package body Par.Child is use My_Lists; procedure Try (Bunch: List; C : Cursor) is V1 : Integer := Constant_Reference (Bunch, C).Element.Kind; V2 : Integer := Constant_Reference (Bunch, C).Kind; V3 : Integer := Bunch (C).Kind; begin Put_Line (Integer'Image (V1)); Put_Line (Integer'Image (V2)); Put_Line (Integer'Image (V3)); for Elmt of Bunch loop Put_Line (Integer'Image (2 * Elmt.Kind)); end loop; end; end Par.Child; Tested on x86_64-pc-linux-gnu, committed on trunk 2014-10-31 Ed Schonberg <schonberg@adacore.com> * sem_ch4.adb (Try_Container_Indexing): Use Check_Implicit_Dereference. * sem_util.adb (Check_Implicit_Dereference): a) Handle generalized indexing as well as function calls. b) If the context is a selected component and whe are in an instance, remove entity from selector name to force resolution of the node, so that explicit dereferences can be generated in the instance if they were in the generic unit.