[multiple changes]

2016-04-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch12.adb (Copy_Generic_Node): Handle the special
	qualification installed for universal literals that act as
	operands in binary or unary operators.	(Qualify_Operand): Mark
	the qualification to signal the instantiation mechanism how to
	handle global reference propagation.
	* sinfo.adb (Is_Qualified_Universal_Literal): New routine.
	(Set_Is_Qualified_Universal_Literal): New routine.
	* sinfo.ads New attribute Is_Qualified_Universal_Literal along
	with occurrences in nodes.
	(Is_Qualified_Universal_Literal):
	New routine along with pragma Inline.
	(Set_Is_Qualified_Universal_Literal): New routine along with
	pragma Inline.

2016-04-20  Ed Schonberg  <schonberg@adacore.com>

	* sem.adb (Do_Analyze): Save and restore Style_Max_Line_Length
	so that the corresponding checks are preserved across compilations
	that include System.Constants in their context.

2016-04-20  Gary Dismukes  <dismukes@adacore.com>

	* sem_type.adb: Minor typo fix and reformatting.
	* a-conhel.ads: Update comment.

2016-04-20  Bob Duff  <duff@adacore.com>

	* a-cihama.adb, a-cihase.adb, a-coinve.adb (Copy): Rewrite the
	code so it doesn't trigger an "uninit var" warning.

From-SVN: r235256
This commit is contained in:
Arnaud Charlet 2016-04-20 12:29:26 +02:00
parent 71129dded1
commit 06f6c43f5c
10 changed files with 121 additions and 27 deletions

View File

@ -1,3 +1,35 @@
2016-04-20 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch12.adb (Copy_Generic_Node): Handle the special
qualification installed for universal literals that act as
operands in binary or unary operators. (Qualify_Operand): Mark
the qualification to signal the instantiation mechanism how to
handle global reference propagation.
* sinfo.adb (Is_Qualified_Universal_Literal): New routine.
(Set_Is_Qualified_Universal_Literal): New routine.
* sinfo.ads New attribute Is_Qualified_Universal_Literal along
with occurrences in nodes.
(Is_Qualified_Universal_Literal):
New routine along with pragma Inline.
(Set_Is_Qualified_Universal_Literal): New routine along with
pragma Inline.
2016-04-20 Ed Schonberg <schonberg@adacore.com>
* sem.adb (Do_Analyze): Save and restore Style_Max_Line_Length
so that the corresponding checks are preserved across compilations
that include System.Constants in their context.
2016-04-20 Gary Dismukes <dismukes@adacore.com>
* sem_type.adb: Minor typo fix and reformatting.
* a-conhel.ads: Update comment.
2016-04-20 Bob Duff <duff@adacore.com>
* a-cihama.adb, a-cihase.adb, a-coinve.adb (Copy): Rewrite the
code so it doesn't trigger an "uninit var" warning.
2016-04-20 Hristian Kirtchev <kirtchev@adacore.com>
* sem_attr.ads Add new table Universal_Type_Attribute.

View File

@ -274,15 +274,15 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
C : Count_Type;
begin
if Capacity = 0 then
if Capacity < Source.Length then
if Checks and then Capacity /= 0 then
raise Capacity_Error
with "Requested capacity is less than Source length";
end if;
C := Source.Length;
elsif Capacity >= Source.Length then
else
C := Capacity;
elsif Checks then
raise Capacity_Error
with "Requested capacity is less than Source length";
end if;
return Target : Map do

View File

@ -264,15 +264,15 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
C : Count_Type;
begin
if Capacity = 0 then
if Capacity < Source.Length then
if Checks and then Capacity /= 0 then
raise Capacity_Error
with "Requested capacity is less than Source length";
end if;
C := Source.Length;
elsif Capacity >= Source.Length then
else
C := Capacity;
elsif Checks then
raise Capacity_Error
with "Requested capacity is less than Source length";
end if;
return Target : Set do

View File

@ -376,15 +376,15 @@ package body Ada.Containers.Indefinite_Vectors is
C : Count_Type;
begin
if Capacity = 0 then
if Capacity < Source.Length then
if Checks and then Capacity /= 0 then
raise Capacity_Error
with "Requested capacity is less than Source length";
end if;
C := Source.Length;
elsif Capacity >= Source.Length then
else
C := Capacity;
elsif Checks then
raise Capacity_Error with
"Requested capacity is less than Source length";
end if;
return Target : Vector do

View File

@ -55,8 +55,6 @@ package Ada.Containers.Helpers is
package Generic_Implementation is
-- Generic package used in the implementation of containers.
-- ???????????????????Currently used by Vectors; not yet by all other
-- containers.
-- This needs to be generic so that the 'Enabled attribute will return
-- the value that is relevant at the point where a container generic is

View File

@ -53,6 +53,7 @@ with Sem_Prag; use Sem_Prag;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
with Stand; use Stand;
with Stylesw; use Stylesw;
with Uintp; use Uintp;
with Uname; use Uname;
@ -1316,6 +1317,13 @@ package body Sem is
procedure Do_Analyze is
Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode;
-- Generally style checks are preserved across compilations, with
-- one exception: s-oscons.ads, which allows arbitrary long lines
-- unconditionally, and has no restore mechanism, because it is
-- intended as a lowest-level Pure package.
Save_Max_Line : constant Int := Style_Max_Line_Length;
List : Elist_Id;
begin
@ -1346,6 +1354,7 @@ package body Sem is
Pop_Scope;
Restore_Scope_Stack (List);
Ghost_Mode := Save_Ghost_Mode;
Style_Max_Line_Length := Save_Max_Line;
end Do_Analyze;
-- Local variables

View File

@ -7293,6 +7293,20 @@ package body Sem_Ch12 is
Set_Entity (New_N, Entity (Assoc));
Check_Private_View (N);
-- The node is a reference to a global type and acts as the
-- subtype mark of a qualified expression created in order
-- to aid resolution of accidental overloading in instances.
-- Since N is a reference to a type, the Associated_Node of
-- N denotes an entity rather than another identifier. See
-- Qualify_Universal_Operands for details.
elsif Nkind (N) = N_Identifier
and then Nkind (Parent (N)) = N_Qualified_Expression
and then Subtype_Mark (Parent (N)) = N
and then Is_Qualified_Universal_Literal (Parent (N))
then
Set_Entity (New_N, Assoc);
-- The name in the call may be a selected component if the
-- call has not been analyzed yet, as may be the case for
-- pre/post conditions in a generic unit.
@ -13982,6 +13996,7 @@ package body Sem_Ch12 is
Loc : constant Source_Ptr := Sloc (Opnd);
Typ : constant Entity_Id := Etype (Actual);
Mark : Node_Id;
Qual : Node_Id;
begin
-- Qualify the operand when it is of a universal type. Note that
@ -14007,10 +14022,19 @@ package body Sem_Ch12 is
Mark := Qualify_Type (Loc, Typ);
end if;
Rewrite (Opnd,
Qual :=
Make_Qualified_Expression (Loc,
Subtype_Mark => Mark,
Expression => Relocate_Node (Opnd)));
Expression => Relocate_Node (Opnd));
-- Mark the qualification to distinguish it from other source
-- constructs and signal the instantiation mechanism that this
-- node requires special processing. See Copy_Generic_Node for
-- details.
Set_Is_Qualified_Universal_Literal (Qual);
Rewrite (Opnd, Qual);
end if;
end Qualify_Operand;

View File

@ -1481,8 +1481,8 @@ package body Sem_Type is
elsif Rop_Typ = F2_Typ then
return Matching_Types (Lop_Typ, F1_Typ);
-- Otherwise this is not a good match bechause each operand-formal
-- pair is compatible only on base type basis which is not specific
-- Otherwise this is not a good match because each operand-formal
-- pair is compatible only on base-type basis, which is not specific
-- enough.
else

View File

@ -1982,6 +1982,14 @@ package body Sinfo is
return Flag7 (N);
end Is_Protected_Subprogram_Body;
function Is_Qualified_Universal_Literal
(N : Node_Id) return Boolean is
begin
pragma Assert (False
or else NT (N).Nkind = N_Qualified_Expression);
return Flag4 (N);
end Is_Qualified_Universal_Literal;
function Is_Static_Coextension
(N : Node_Id) return Boolean is
begin
@ -5229,6 +5237,14 @@ package body Sinfo is
Set_Flag7 (N, Val);
end Set_Is_Protected_Subprogram_Body;
procedure Set_Is_Qualified_Universal_Literal
(N : Node_Id; Val : Boolean := True) is
begin
pragma Assert (False
or else NT (N).Nkind = N_Qualified_Expression);
Set_Flag4 (N, Val);
end Set_Is_Qualified_Universal_Literal;
procedure Set_Is_Static_Coextension
(N : Node_Id; Val : Boolean := True) is
begin

View File

@ -1710,6 +1710,12 @@ package Sinfo is
-- handler to make sure that the associated protected object is unlocked
-- when the subprogram completes.
-- Is_Qualified_Universal_Literal (Flag4-Sem)
-- Present in N_Qualified_Expression nodes. Set when the qualification is
-- converting a universal literal to a specific type. Such qualifiers aid
-- the resolution of accidental overloading of binary or unary operators
-- which may occur in instances.
-- Is_Static_Coextension (Flag14-Sem)
-- Present in N_Allocator nodes. Set if the allocator is a coextension
-- of an object allocated on the stack rather than the heap.
@ -4542,6 +4548,7 @@ package Sinfo is
-- Subtype_Mark (Node4)
-- Expression (Node3) expression or aggregate
-- plus fields for expression
-- Is_Qualified_Universal_Literal (Flag4-Sem)
--------------------
-- 4.8 Allocator --
@ -9399,6 +9406,9 @@ package Sinfo is
function Is_Protected_Subprogram_Body
(N : Node_Id) return Boolean; -- Flag7
function Is_Qualified_Universal_Literal
(N : Node_Id) return Boolean; -- Flag4
function Is_Static_Coextension
(N : Node_Id) return Boolean; -- Flag14
@ -10437,6 +10447,9 @@ package Sinfo is
procedure Set_Is_Protected_Subprogram_Body
(N : Node_Id; Val : Boolean := True); -- Flag7
procedure Set_Is_Qualified_Universal_Literal
(N : Node_Id; Val : Boolean := True); -- Flag4
procedure Set_Is_Static_Coextension
(N : Node_Id; Val : Boolean := True); -- Flag14
@ -12819,6 +12832,7 @@ package Sinfo is
pragma Inline (Is_Power_Of_2_For_Shift);
pragma Inline (Is_Prefixed_Call);
pragma Inline (Is_Protected_Subprogram_Body);
pragma Inline (Is_Qualified_Universal_Literal);
pragma Inline (Is_Static_Coextension);
pragma Inline (Is_Static_Expression);
pragma Inline (Is_Subprogram_Descriptor);
@ -13160,6 +13174,7 @@ package Sinfo is
pragma Inline (Set_Is_Power_Of_2_For_Shift);
pragma Inline (Set_Is_Prefixed_Call);
pragma Inline (Set_Is_Protected_Subprogram_Body);
pragma Inline (Set_Is_Qualified_Universal_Literal);
pragma Inline (Set_Is_Static_Coextension);
pragma Inline (Set_Is_Static_Expression);
pragma Inline (Set_Is_Subprogram_Descriptor);