+2014-10-31 Ed Schonberg <schonberg@adacore.com>
+
+ * freeze.adb (Freeze_Record_Type): Do not check component size
+ if its type is generic.
+
+2014-10-31 Bob Duff <duff@adacore.com>
+
+ * gnat_rm.texi: Fix documentation w.r.t -gnatw.w.
+
+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.
+
+2014-10-31 Eric Botcazou <ebotcazou@adacore.com>
+
+ * inline.adb (Back_End_Cannot_Inline): Delete.
+ (Add_Inlined_Subprogram): Do not call it.
+
2014-10-31 Ed Schonberg <schonberg@adacore.com>
* exp_ch3.ads (Make_Tag_Assignment): New function, used to
elsif CodePeer_Mode then
null;
+ -- Omit check if component has a generic type. This can
+ -- happen in an instantiation within a generic in ASIS
+ -- mode, where we force freeze actions without full
+ -- expansion.
+
+ elsif Is_Generic_Type (Etype (Comp)) then
+ null;
+
-- Do the check
elsif not
@end smallexample
@noindent
-In this usage, the pattern string must match in the Off and On pragmas,
-and at least one matching warning must be suppressed.
+In this usage, the pattern string must match in the Off and On
+pragmas, and (if @option{-gnatw.w} is given) at least one matching
+warning must be suppressed.
Note: to write a string that will match any warning, use the string
-@code{"***"}. It will not work to use a single asterisk or two asterisks
-since this looks like an operator name. This form with three asterisks
-is similar in effect to specifying @code{pragma Warnings (Off)} except that a
-matching @code{pragma Warnings (On, "***")} will be required. This can be
+@code{"***"}. It will not work to use a single asterisk or two
+asterisks since this looks like an operator name. This form with three
+asterisks is similar in effect to specifying @code{pragma Warnings
+(Off)} except (if @option{-gnatw.w} is given) that a matching
+@code{pragma Warnings (On, "***")} will be required. This can be
helpful in avoiding forgetting to turn warnings back on.
Note: the debug flag -gnatd.i (@code{/NOWARNINGS_PRAGMAS} in VMS) can be
E : constant Entity_Id := Inlined.Table (Index).Name;
Pack : constant Entity_Id := Get_Code_Unit_Entity (E);
- function Back_End_Cannot_Inline (Subp : Entity_Id) return Boolean;
- -- There are various conditions under which back-end inlining cannot
- -- be done reliably:
- --
- -- a) If a body has handlers, it must not be inlined, because this
- -- may violate program semantics, and because in zero-cost exception
- -- mode it will lead to undefined symbols at link time.
- --
- -- b) If a body contains inlined function instances, it cannot be
- -- inlined under ZCX because the numeric suffix generated by gigi
- -- will be different in the body and the place of the inlined call.
- --
- -- This procedure must be carefully coordinated with the back end.
-
procedure Register_Backend_Inlined_Subprogram (Subp : Entity_Id);
-- Append Subp to the list of subprograms inlined by the backend
-- Append Subp to the list of subprograms that cannot be inlined by
-- the backend.
- ----------------------------
- -- Back_End_Cannot_Inline --
- ----------------------------
-
- function Back_End_Cannot_Inline (Subp : Entity_Id) return Boolean is
- Decl : constant Node_Id := Unit_Declaration_Node (Subp);
- Body_Ent : Entity_Id;
- Ent : Entity_Id;
-
- begin
- if Nkind (Decl) = N_Subprogram_Declaration
- and then Present (Corresponding_Body (Decl))
- then
- Body_Ent := Corresponding_Body (Decl);
- else
- return False;
- end if;
-
- -- If subprogram is marked Inline_Always, inlining is mandatory
-
- if Has_Pragma_Inline_Always (Subp) then
- return False;
- end if;
-
- if Present
- (Exception_Handlers
- (Handled_Statement_Sequence
- (Unit_Declaration_Node (Corresponding_Body (Decl)))))
- then
- return True;
- end if;
-
- Ent := First_Entity (Body_Ent);
- while Present (Ent) loop
- if Is_Subprogram (Ent)
- and then Is_Generic_Instance (Ent)
- then
- return True;
- end if;
-
- Next_Entity (Ent);
- end loop;
-
- return False;
- end Back_End_Cannot_Inline;
-
-----------------------------------------
-- Register_Backend_Inlined_Subprogram --
-----------------------------------------
and then not Is_Nested (E)
and then not Has_Initialized_Type (E)
then
- if Back_End_Cannot_Inline (E) then
- Set_Is_Inlined (E, False);
- Register_Backend_Not_Inlined_Subprogram (E);
+ Register_Backend_Inlined_Subprogram (E);
+ if No (Last_Inlined) then
+ Set_First_Inlined_Subprogram (Cunit (Main_Unit), E);
else
- Register_Backend_Inlined_Subprogram (E);
-
- if No (Last_Inlined) then
- Set_First_Inlined_Subprogram (Cunit (Main_Unit), E);
- else
- Set_Next_Inlined_Subprogram (Last_Inlined, E);
- end if;
-
- Last_Inlined := E;
+ Set_Next_Inlined_Subprogram (Last_Inlined, E);
end if;
+
+ Last_Inlined := E;
else
Register_Backend_Not_Inlined_Subprogram (E);
end if;
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;
-- 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
-- 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;
-- 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
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;
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
-- 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
projects / gcc.git / commitdiff