[multiple changes]
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. From-SVN: r235120
This commit is contained in:
Arnaud Charlet
parent
0f6251c7ac
commit
ec3c7387ac
|
|
@ -1,3 +1,40 @@
|
|||
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
|
||||
|
|
|
|||
|
|
@ -42,32 +42,28 @@ package ALI is
|
|||
-- 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
|
||||
|
||||
--------------------
|
||||
|
|
|
|||
|
|
@ -107,14 +107,10 @@ package body Exp_Intr is
|
|||
-- 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
|
||||
|
|
@ -165,6 +161,10 @@ package body Exp_Intr is
|
|||
|
||||
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);
|
||||
|
|
@ -696,6 +696,7 @@ package body Exp_Intr is
|
|||
Name_Line,
|
||||
Name_Source_Location,
|
||||
Name_Enclosing_Entity,
|
||||
Name_Compilation_ISO_Date,
|
||||
Name_Compilation_Date,
|
||||
Name_Compilation_Time)
|
||||
then
|
||||
|
|
@ -851,6 +852,8 @@ package body Exp_Intr is
|
|||
------------------------
|
||||
|
||||
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;
|
||||
|
||||
|
|
@ -891,6 +894,10 @@ package body Exp_Intr is
|
|||
|
||||
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);
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- 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- --
|
||||
|
|
@ -31,15 +31,11 @@ with Types; use Types;
|
|||
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
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- 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- --
|
||||
|
|
@ -79,6 +79,10 @@ package GNAT.Source_Info is
|
|||
-- 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
|
||||
|
|
|
|||
|
|
@ -2972,14 +2972,20 @@ package body Sem_Aggr 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;
|
||||
|
|
@ -3231,7 +3237,7 @@ package body Sem_Aggr is
|
|||
-- 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
|
||||
|
|
@ -3704,7 +3710,8 @@ package body Sem_Aggr is
|
|||
-- any component.
|
||||
|
||||
elsif Box_Present (Assoc) then
|
||||
Others_Box := True;
|
||||
Others_Box := 1;
|
||||
Box_Node := Assoc;
|
||||
end if;
|
||||
|
||||
else
|
||||
|
|
@ -4439,7 +4446,8 @@ package body Sem_Aggr is
|
|||
|
||||
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;
|
||||
|
|
@ -4585,9 +4593,14 @@ package body Sem_Aggr is
|
|||
|
||||
-- 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;
|
||||
|
|
|
|||
|
|
@ -359,6 +359,7 @@ package body Sem_Intr is
|
|||
Name_Line,
|
||||
Name_Source_Location,
|
||||
Name_Enclosing_Entity,
|
||||
Name_Compilation_ISO_Date,
|
||||
Name_Compilation_Date,
|
||||
Name_Compilation_Time)
|
||||
then
|
||||
|
|
|
|||
|
|
@ -26762,9 +26762,10 @@ package body Sem_Prag is
|
|||
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;
|
||||
|
|
@ -26781,24 +26782,35 @@ package body Sem_Prag is
|
|||
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;
|
||||
|
|
|
|||
|
|
@ -1137,13 +1137,17 @@ package body Sem_Warn is
|
|||
-- 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
|
||||
|
|
|
|||
|
|
@ -1204,6 +1204,7 @@ package Snames is
|
|||
-- 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 + $;
|
||||
|
|
|
|||
Loading…
Reference in New Issue