From 06f6c43f5c0d8df09010ec690b237bc62e3b6d02 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 20 Apr 2016 12:29:26 +0200 Subject: [PATCH] [multiple changes] 2016-04-20 Hristian Kirtchev * 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 * 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 * sem_type.adb: Minor typo fix and reformatting. * a-conhel.ads: Update comment. 2016-04-20 Bob Duff * 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 --- gcc/ada/ChangeLog | 32 ++++++++++++++++++++++++++++++++ gcc/ada/a-cihama.adb | 14 +++++++------- gcc/ada/a-cihase.adb | 14 +++++++------- gcc/ada/a-coinve.adb | 14 +++++++------- gcc/ada/a-conhel.ads | 2 -- gcc/ada/sem.adb | 9 +++++++++ gcc/ada/sem_ch12.adb | 28 ++++++++++++++++++++++++++-- gcc/ada/sem_type.adb | 4 ++-- gcc/ada/sinfo.adb | 16 ++++++++++++++++ gcc/ada/sinfo.ads | 15 +++++++++++++++ 10 files changed, 121 insertions(+), 27 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 16b6a580c2e..98c7d3f9b6c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,35 @@ +2016-04-20 Hristian Kirtchev + + * 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 + + * 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 + + * sem_type.adb: Minor typo fix and reformatting. + * a-conhel.ads: Update comment. + +2016-04-20 Bob Duff + + * 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 * sem_attr.ads Add new table Universal_Type_Attribute. diff --git a/gcc/ada/a-cihama.adb b/gcc/ada/a-cihama.adb index f81bfc8a7d7..3c05aac5b49 100644 --- a/gcc/ada/a-cihama.adb +++ b/gcc/ada/a-cihama.adb @@ -274,15 +274,15 @@ package body Ada.Containers.Indefinite_Hashed_Maps is 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 diff --git a/gcc/ada/a-cihase.adb b/gcc/ada/a-cihase.adb index ea7ee2211b4..6d913cbdeec 100644 --- a/gcc/ada/a-cihase.adb +++ b/gcc/ada/a-cihase.adb @@ -264,15 +264,15 @@ package body Ada.Containers.Indefinite_Hashed_Sets is 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 diff --git a/gcc/ada/a-coinve.adb b/gcc/ada/a-coinve.adb index ba0f6932471..230607c1974 100644 --- a/gcc/ada/a-coinve.adb +++ b/gcc/ada/a-coinve.adb @@ -376,15 +376,15 @@ package body Ada.Containers.Indefinite_Vectors is 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 diff --git a/gcc/ada/a-conhel.ads b/gcc/ada/a-conhel.ads index 74e51518fb0..008ef8a869d 100644 --- a/gcc/ada/a-conhel.ads +++ b/gcc/ada/a-conhel.ads @@ -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 diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index a6061ead8c5..345cc0e819f 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -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 diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index bd7a6a412ae..e6d5af5f216 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -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; diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index 00405ab238b..5aaaa60bf1d 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -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 diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index 3ea7a6add27..f8ed04c9ed6 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -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 diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index f86eea3da1e..561c112bebe 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -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); -- 2.30.2