+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.
C : Count_Type;
begin
- if Capacity = 0 then
- C := Source.Length;
+ 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;
- elsif Capacity >= Source.Length then
+ C := Source.Length;
+ else
C := Capacity;
-
- elsif Checks then
- raise Capacity_Error
- with "Requested capacity is less than Source length";
end if;
return Target : Map do
C : Count_Type;
begin
- if Capacity = 0 then
- C := Source.Length;
+ 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;
- elsif Capacity >= Source.Length then
+ C := Source.Length;
+ else
C := Capacity;
-
- elsif Checks then
- raise Capacity_Error
- with "Requested capacity is less than Source length";
end if;
return Target : Set do
C : Count_Type;
begin
- if Capacity = 0 then
- C := Source.Length;
+ 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;
- elsif Capacity >= Source.Length then
+ C := Source.Length;
+ else
C := Capacity;
-
- elsif Checks then
- raise Capacity_Error with
- "Requested capacity is less than Source length";
end if;
return Target : Vector do
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
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;
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
Pop_Scope;
Restore_Scope_Stack (List);
Ghost_Mode := Save_Ghost_Mode;
+ Style_Max_Line_Length := Save_Max_Line;
end Do_Analyze;
-- Local variables
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.
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
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;
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
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
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
-- 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.
-- Subtype_Mark (Node4)
-- Expression (Node3) expression or aggregate
-- plus fields for expression
+ -- Is_Qualified_Universal_Literal (Flag4-Sem)
--------------------
-- 4.8 Allocator --
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
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
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);
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);
projects / gcc.git / commitdiff