+2016-04-18 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_aggr.adb (Resolve_Record_Aggregate): If
+ Warn_On_Redundant_Constructs is enabled, report a redundant box
+ association that does not cover any components, as it done for
+ redundant others associations in case statements.
+
+2016-04-18 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_prag.adb (Collect_Inherited_Class_Wide_Conditions):
+ Analyze the generated Check pragma for an inherited condition so
+ that it does not freeze the dispatching type of the primitive
+ operation, because it is pre-analyzed at the point of the
+ subprogram declaration (and not in the subprogram body, as is
+ done during regular expansion).
+
+2016-04-18 Vincent Celier <celier@adacore.com>
+
+ * ali.ads: Increase the range of all _Id types to 100 millions.
+
+2016-04-18 Gary Dismukes <dismukes@adacore.com>
+
+ * sem_warn.adb (Check_References): Change warning to suggest
+ using pragma Export rather than saying "volatile has no effect".
+
+2016-04-18 Bob Duff <duff@adacore.com>
+
+ * g-souinf.ads (Compilation_ISO_Date): New function to return
+ the current date in ISO form.
+ * exp_intr.adb (Expand_Source_Info, Add_Source_Info): Expand
+ a call to Compilation_ISO_Date into a string literal containing
+ the current date in ISO form.
+ * exp_intr.ads (Add_Source_Info): Improve documentation.
+ * sem_intr.adb (Check_Intrinsic_Subprogram): Recognize
+ Compilation_ISO_Date.
+ * snames.ads-tmpl (Name_Compilation_ISO_Date): New Name_Id.
+
2016-04-18 Eric Botcazou <ebotcazou@adacore.com>
* layout.adb (Set_Elem_Alignment): Extend setting of alignment
-- Id Types --
--------------
- -- The various entries are stored in tables with distinct subscript ranges.
- -- The following type definitions show the ranges used for the subscripts
- -- (Id values) for the various tables.
-
- type ALI_Id is range 0 .. 999_999;
+ type ALI_Id is range 0 .. 99_999_999;
-- Id values used for ALIs table entries
- type Unit_Id is range 1_000_000 .. 1_999_999;
+ type Unit_Id is range 0 .. 99_999_999;
-- Id values used for Unit table entries
- type With_Id is range 2_000_000 .. 2_999_999;
+ type With_Id is range 0 .. 99_999_999;
-- Id values used for Withs table entries
- type Arg_Id is range 3_000_000 .. 3_999_999;
+ type Arg_Id is range 0 .. 99_999_999;
-- Id values used for argument table entries
- type Sdep_Id is range 4_000_000 .. 4_999_999;
+ type Sdep_Id is range 0 .. 99_999_999;
-- Id values used for Sdep table entries
- type Source_Id is range 5_000_000 .. 5_999_999;
+ type Source_Id is range 0 .. 99_999_999;
-- Id values used for Source table entries
- type Interrupt_State_Id is range 6_000_000 .. 6_999_999;
+ type Interrupt_State_Id is range 0 .. 99_999_999;
-- Id values used for Interrupt_State table entries
- type Priority_Specific_Dispatching_Id is range 7_000_000 .. 7_999_999;
+ type Priority_Specific_Dispatching_Id is range 0 .. 99_999_999;
-- Id values used for Priority_Specific_Dispatching table entries
--------------------
-- System.Address_To_Access_Conversions.
procedure Expand_Source_Info (N : Node_Id; Nam : Name_Id);
- -- Rewrite the node by the appropriate string or positive constant.
- -- Nam can be one of the following:
- -- Name_File - expand string name of source file
- -- Name_Line - expand integer line number
- -- Name_Source_Location - expand string of form file:line
- -- Name_Enclosing_Entity - expand string name of enclosing entity
- -- Name_Compilation_Date - expand string with compilation date
- -- Name_Compilation_Time - expand string with compilation time
+ -- Rewrite the node as the appropriate string literal or positive
+ -- constant. Nam is the name of one of the intrinsics declared in
+ -- GNAT.Source_Info; see g-souinf.ads for documentation of these
+ -- intrinsics.
procedure Write_Entity_Name (E : Entity_Id);
-- Recursive procedure to construct string for qualified name of enclosing
Write_Entity_Name (Ent);
+ when Name_Compilation_ISO_Date =>
+ Name_Buffer (1 .. 10) := Opt.Compilation_Time (1 .. 10);
+ Name_Len := 10;
+
when Name_Compilation_Date =>
declare
subtype S13 is String (1 .. 3);
Name_Line,
Name_Source_Location,
Name_Enclosing_Entity,
+ Name_Compilation_ISO_Date,
Name_Compilation_Date,
Name_Compilation_Time)
then
------------------------
procedure Expand_Source_Info (N : Node_Id; Nam : Name_Id) is
+ -- ???There is duplicated code here (see Add_Source_Info)
+
Loc : constant Source_Ptr := Sloc (N);
Ent : Entity_Id;
Write_Entity_Name (Ent);
+ when Name_Compilation_ISO_Date =>
+ Name_Buffer (1 .. 10) := Opt.Compilation_Time (1 .. 10);
+ Name_Len := 10;
+
when Name_Compilation_Date =>
declare
subtype S13 is String (1 .. 3);
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2015, 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- --
package Exp_Intr is
procedure Add_Source_Info (Loc : Source_Ptr; Nam : Name_Id);
- -- Append a string to Name_Buffer depending on Nam
- -- Name_File - append name of source file
- -- Name_Line - append line number
- -- Name_Source_Location - append source location (file:line)
- -- Name_Enclosing_Entity - append name of enclosing entity
- -- Name_Compilation_Date - append compilation date
- -- Name_Compilation_Time - append compilation time
- -- The caller must set Name_Buffer and Name_Len before the call. Loc is
- -- passed to provide location information where it is needed.
+ -- Append a string to Name_Buffer depending on Nam, which is the name of
+ -- one of the intrinsics declared in GNAT.Source_Info; see g-souinf.ads for
+ -- documentation of these intrinsics. The caller must set Name_Buffer and
+ -- Name_Len before the call. Loc is passed to provide location information
+ -- where it is needed.
procedure Expand_Intrinsic_Call (N : Node_Id; E : Entity_Id);
-- N is either a function call node, a procedure call statement node, or
-- --
-- S p e c --
-- --
--- Copyright (C) 2000-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 2000-2015, 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- --
-- package itself. This is useful in identifying and logging information
-- from within generic templates.
+ function Compilation_ISO_Date return String with
+ Import, Convention => Intrinsic;
+ -- Returns date of compilation as a static string "yyyy-mm-dd".
+
function Compilation_Date return String with
Import, Convention => Intrinsic;
-- Returns date of compilation as a static string "mmm dd yyyy". This is
--
-- This variable is updated as a side effect of function Get_Value.
+ Box_Node : Node_Id;
Is_Box_Present : Boolean := False;
- Others_Box : Boolean := False;
+ Others_Box : Integer := 0;
+
-- Ada 2005 (AI-287): Variables used in case of default initialization
-- to provide a functionality similar to Others_Etype. Box_Present
-- indicates that the component takes its default initialization;
- -- Others_Box indicates that at least one component takes its default
- -- initialization. Similar to Others_Etype, they are also updated as a
+ -- Others_Box counts the number of components of the current aggregate
+ -- (which may be a sub-aggregate of a larger one) that are default-
+ -- initialized. A value of One indicates that an others_box is present.
+ -- Any larger value indicates that the others_box is not redundant.
+ -- These variables, similar to Others_Etype, are also updated as a
-- side effect of function Get_Value.
+ -- Box_Node is used to place a warning on a redundant others_box.
procedure Add_Association
(Component : Entity_Id;
-- checks when the default includes function calls.
if Box_Present (Assoc) then
- Others_Box := True;
+ Others_Box := Others_Box + 1;
Is_Box_Present := True;
if Expander_Active then
-- any component.
elsif Box_Present (Assoc) then
- Others_Box := True;
+ Others_Box := 1;
+ Box_Node := Assoc;
end if;
else
Comp_Elmt := First_Elmt (Components);
while Present (Comp_Elmt) loop
- if Ekind (Node (Comp_Elmt)) /= E_Discriminant
+ if
+ Ekind (Node (Comp_Elmt)) /= E_Discriminant
then
Process_Component (Node (Comp_Elmt));
end if;
-- Ada 2005 (AI-287): others choice may have expression or box
- if No (Others_Etype) and then not Others_Box then
+ if No (Others_Etype) and then Others_Box = 0 then
Error_Msg_N
("OTHERS must represent at least one component", Selectr);
+
+ elsif Others_Box = 1 and then Warn_On_Redundant_Constructs then
+ Error_Msg_N ("others choice is redundant?", Box_Node);
+ Error_Msg_N ("\previous choices cover all components?",
+ Box_Node);
end if;
exit Verification;
Name_Line,
Name_Source_Location,
Name_Enclosing_Entity,
+ Name_Compilation_ISO_Date,
Name_Compilation_Date,
Name_Compilation_Time)
then
procedure Collect_Inherited_Class_Wide_Conditions (Subp : Entity_Id) is
Parent_Subp : constant Entity_Id := Overridden_Operation (Subp);
Prags : constant Node_Id := Contract (Parent_Subp);
- Prag : Node_Id;
- New_Prag : Node_Id;
- Installed : Boolean;
+ Prag : Node_Id;
+ New_Prag : Node_Id;
+ Installed : Boolean;
+ In_Spec_Expr : Boolean;
begin
Installed := False;
and then Class_Present (Prag)
then
-- The generated pragma must be analyzed in the context of
- -- the subprogram, to make its formals visible.
+ -- the subprogram, to make its formals visible. In addition,
+ -- we must inhibit freezing and full analysis because the
+ -- controlling type of the subprogram is not frozen yet, and
+ -- may have further primitives.
if not Installed then
Installed := True;
Push_Scope (Subp);
Install_Formals (Subp);
+ In_Spec_Expr := In_Spec_Expression;
+ In_Spec_Expression := True;
end if;
New_Prag :=
Build_Pragma_Check_Equivalent (Prag, Subp, Parent_Subp);
Insert_After (Unit_Declaration_Node (Subp), New_Prag);
Preanalyze (New_Prag);
+
+ -- Prevent further analysis in subsequent processing of the
+ -- current list of declarations
+
+ Set_Analyzed (New_Prag);
end if;
Prag := Next_Pragma (Prag);
end loop;
if Installed then
+ In_Spec_Expression := In_Spec_Expr;
End_Scope;
end if;
end if;
-- A special case, if this variable is volatile and not
-- imported, it is not helpful to tell the programmer
-- to mark the variable as constant, since this would be
- -- illegal by virtue of RM C.6(13).
+ -- illegal by virtue of RM C.6(13). Instead we suggest
+ -- using pragma Export (can't be Import because of the
+ -- initial value).
if (Is_Volatile (E1) or else Has_Volatile_Components (E1))
and then not Is_Imported (E1)
then
Error_Msg_N
- ("?k?& is not modified, volatile has no effect!", E1);
+ ("?k?& is not modified, " &
+ "consider pragma Export for volatile variable!",
+ E1);
-- Another special case, Exception_Occurrence, this catches
-- the case of exception choice (and a bit more too, but not
-- convention name. So is To_Address, which is a GNAT attribute.
First_Intrinsic_Name : constant Name_Id := N + $;
+ Name_Compilation_ISO_Date : constant Name_Id := N + $;
Name_Compilation_Date : constant Name_Id := N + $;
Name_Compilation_Time : constant Name_Id := N + $;
Name_Divide : constant Name_Id := N + $;
projects / gcc.git / commitdiff