From b1d1299619601466bc024da9e962fbfbcae1fe22 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 27 Jan 2014 17:58:19 +0100 Subject: [PATCH] [multiple changes] 2014-01-27 Robert Dewar * sem_res.adb (Resolve_Comparison_Op): Add type name/location to unordered msg. (Resolve_Range): Add type name/location to unordered msg. 2014-01-27 Claire Dross * a-cofove.adb/s (Copy): Add precondition so that Copy (Source, Capacity) is only called with Capacity >= Length (Source) and Capacity in Capacity_Range. * a-cfdlli.adb/s, a-cfhase.adb/s, a-cfhama.adb/s, a-cforse.adb/s, a-cforma.adb/s (Copy): Add precondition so that Copy (Source, Capacity) is only called with Capacity >= Source.Capacity. Raise Capacity_Error in the code is this is not the case. 2014-01-27 Thomas Quinot * sem_ch4.adb (Analyze_Selected_Component): Fix handling of selected component in an instance where the component of the actual is not visibile at instantiation. From-SVN: r207146 --- gcc/ada/ChangeLog | 22 ++++++++++++++++ gcc/ada/a-cfdlli.adb | 4 +++ gcc/ada/a-cfdlli.ads | 3 ++- gcc/ada/a-cfhama.adb | 4 +++ gcc/ada/a-cfhama.ads | 2 +- gcc/ada/a-cfhase.adb | 4 +++ gcc/ada/a-cfhase.ads | 2 +- gcc/ada/a-cforma.adb | 4 +++ gcc/ada/a-cforma.ads | 2 +- gcc/ada/a-cforse.adb | 4 +++ gcc/ada/a-cforse.ads | 2 +- gcc/ada/a-cofove.adb | 4 +-- gcc/ada/a-cofove.ads | 2 +- gcc/ada/sem_ch4.adb | 61 +++++++++++++++++++++++++++++--------------- gcc/ada/sem_res.adb | 9 +++++-- 15 files changed, 98 insertions(+), 31 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a57ac289ef9..237c3e0aa0a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,25 @@ +2014-01-27 Robert Dewar + + * sem_res.adb (Resolve_Comparison_Op): Add type name/location + to unordered msg. + (Resolve_Range): Add type name/location to unordered msg. + +2014-01-27 Claire Dross + + * a-cofove.adb/s (Copy): Add precondition so that Copy (Source, + Capacity) is only called with Capacity >= Length (Source) and + Capacity in Capacity_Range. + * a-cfdlli.adb/s, a-cfhase.adb/s, a-cfhama.adb/s, a-cforse.adb/s, + a-cforma.adb/s (Copy): Add precondition so that Copy (Source, Capacity) + is only called with Capacity >= Source.Capacity. Raise Capacity_Error + in the code is this is not the case. + +2014-01-27 Thomas Quinot + + * sem_ch4.adb (Analyze_Selected_Component): Fix handling of + selected component in an instance where the component of the + actual is not visibile at instantiation. + 2014-01-27 Ed Schonberg * sem_ch6.adb: sem_ch6.adb (Set_Actual_Subtypes): If the type diff --git a/gcc/ada/a-cfdlli.adb b/gcc/ada/a-cfdlli.adb index 34668bdd2d5..982c1b7d2f7 100644 --- a/gcc/ada/a-cfdlli.adb +++ b/gcc/ada/a-cfdlli.adb @@ -229,6 +229,10 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is P : List (C); begin + if 0 < Capacity and then Capacity < Source.Capacity then + raise Capacity_Error; + end if; + N := 1; while N <= Source.Capacity loop P.Nodes (N).Prev := Source.Nodes (N).Prev; diff --git a/gcc/ada/a-cfdlli.ads b/gcc/ada/a-cfdlli.ads index 660eb18e302..54f1886d297 100644 --- a/gcc/ada/a-cfdlli.ads +++ b/gcc/ada/a-cfdlli.ads @@ -84,7 +84,8 @@ package Ada.Containers.Formal_Doubly_Linked_Lists is procedure Assign (Target : in out List; Source : List) with Pre => Target.Capacity >= Length (Source); - function Copy (Source : List; Capacity : Count_Type := 0) return List; + function Copy (Source : List; Capacity : Count_Type := 0) return List with + Pre => Capacity = 0 or else Capacity >= Source.Capacity; function Element (Container : List; diff --git a/gcc/ada/a-cfhama.adb b/gcc/ada/a-cfhama.adb index 3ab4af23e78..938423894c2 100644 --- a/gcc/ada/a-cfhama.adb +++ b/gcc/ada/a-cfhama.adb @@ -207,6 +207,10 @@ package body Ada.Containers.Formal_Hashed_Maps is Cu : Cursor; begin + if 0 < Capacity and then Capacity < Source.Capacity then + raise Capacity_Error; + end if; + Target.Length := Source.Length; Target.Free := Source.Free; diff --git a/gcc/ada/a-cfhama.ads b/gcc/ada/a-cfhama.ads index 5366655753e..71eed2b0e4d 100644 --- a/gcc/ada/a-cfhama.ads +++ b/gcc/ada/a-cfhama.ads @@ -100,7 +100,7 @@ package Ada.Containers.Formal_Hashed_Maps is (Source : Map; Capacity : Count_Type := 0) return Map with - Pre => Capacity >= Source.Capacity; + Pre => Capacity = 0 or else Capacity >= Source.Capacity; -- Copy returns a container stricty equal to Source. It must have -- the same cursors associated with each element. Therefore: -- - capacity=0 means use container.capacity as capacity of target diff --git a/gcc/ada/a-cfhase.adb b/gcc/ada/a-cfhase.adb index 451ec32a886..96f0d05c057 100644 --- a/gcc/ada/a-cfhase.adb +++ b/gcc/ada/a-cfhase.adb @@ -233,6 +233,10 @@ package body Ada.Containers.Formal_Hashed_Sets is Cu : Cursor; begin + if 0 < Capacity and then Capacity < Source.Capacity then + raise Capacity_Error; + end if; + Target.Length := Source.Length; Target.Free := Source.Free; diff --git a/gcc/ada/a-cfhase.ads b/gcc/ada/a-cfhase.ads index d470e1b8a9f..a3fc63dc036 100644 --- a/gcc/ada/a-cfhase.ads +++ b/gcc/ada/a-cfhase.ads @@ -106,7 +106,7 @@ package Ada.Containers.Formal_Hashed_Sets is (Source : Set; Capacity : Count_Type := 0) return Set with - Pre => Capacity >= Source.Capacity; + Pre => Capacity = 0 or else Capacity >= Source.Capacity; function Element (Container : Set; diff --git a/gcc/ada/a-cforma.adb b/gcc/ada/a-cforma.adb index ac763918283..33cd101badc 100644 --- a/gcc/ada/a-cforma.adb +++ b/gcc/ada/a-cforma.adb @@ -283,6 +283,10 @@ package body Ada.Containers.Formal_Ordered_Maps is N : Count_Type; begin + if 0 < Capacity and then Capacity < Source.Capacity then + raise Capacity_Error; + end if; + return Target : Map (Count_Type'Max (Source.Capacity, Capacity)) do if Length (Source) > 0 then Target.Length := Source.Length; diff --git a/gcc/ada/a-cforma.ads b/gcc/ada/a-cforma.ads index 00cd3989d52..a9426764560 100644 --- a/gcc/ada/a-cforma.ads +++ b/gcc/ada/a-cforma.ads @@ -92,7 +92,7 @@ package Ada.Containers.Formal_Ordered_Maps is Pre => Target.Capacity >= Length (Source); function Copy (Source : Map; Capacity : Count_Type := 0) return Map with - Pre => Capacity >= Source.Capacity; + Pre => Capacity = 0 or else Capacity >= Source.Capacity; function Key (Container : Map; Position : Cursor) return Key_Type with Pre => Has_Element (Container, Position); diff --git a/gcc/ada/a-cforse.adb b/gcc/ada/a-cforse.adb index 22e92220b9d..1b202f03b1b 100644 --- a/gcc/ada/a-cforse.adb +++ b/gcc/ada/a-cforse.adb @@ -320,6 +320,10 @@ package body Ada.Containers.Formal_Ordered_Sets is Target : Set (Count_Type'Max (Source.Capacity, Capacity)); begin + if 0 < Capacity and then Capacity < Source.Capacity then + raise Capacity_Error; + end if; + if Length (Source) > 0 then Target.Length := Source.Length; Target.Root := Source.Root; diff --git a/gcc/ada/a-cforse.ads b/gcc/ada/a-cforse.ads index 0116e8f2791..e935be5e457 100644 --- a/gcc/ada/a-cforse.ads +++ b/gcc/ada/a-cforse.ads @@ -94,7 +94,7 @@ package Ada.Containers.Formal_Ordered_Sets is Pre => Target.Capacity >= Length (Source); function Copy (Source : Set; Capacity : Count_Type := 0) return Set with - Pre => Capacity >= Source.Capacity; + Pre => Capacity = 0 or else Capacity >= Source.Capacity; function Element (Container : Set; diff --git a/gcc/ada/a-cofove.adb b/gcc/ada/a-cofove.adb index 6789f712af8..93372e1c5cb 100644 --- a/gcc/ada/a-cofove.adb +++ b/gcc/ada/a-cofove.adb @@ -301,10 +301,10 @@ package body Ada.Containers.Formal_Vectors is begin if Capacity = 0 then C := LS; - elsif Capacity >= LS then + elsif Capacity >= LS and then Capacity in Capacity_Range then C := Capacity; else - raise Constraint_Error; + raise Capacity_Error; end if; return Target : Vector (C) do diff --git a/gcc/ada/a-cofove.ads b/gcc/ada/a-cofove.ads index 2c451fb8ebc..313165c49c6 100644 --- a/gcc/ada/a-cofove.ads +++ b/gcc/ada/a-cofove.ads @@ -125,7 +125,7 @@ package Ada.Containers.Formal_Vectors is (Source : Vector; Capacity : Count_Type := 0) return Vector with - Pre => Length (Source) <= Capacity; + Pre => Length (Source) <= Capacity and then Capacity in Capacity_Range; function To_Cursor (Container : Vector; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 1512a7ad240..51e7f090b19 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -3943,6 +3943,7 @@ package body Sem_Ch4 is -- searches have failed. When the match is found (it always will be), -- the Etype of both N and Sel are set from this component, and the -- entity of Sel is set to reference this component. + -- ??? no longer true that a match is found ??? function Has_Mode_Conformant_Spec (Comp : Entity_Id) return Boolean; -- It is known that the parent of N denotes a subprogram call. Comp @@ -3971,9 +3972,7 @@ package body Sem_Ch4 is Next_Component (Comp); end loop; - -- This must succeed because code was legal in the generic - - raise Program_Error; + -- Need comment on what is going on when we fall through ??? end Find_Component_In_Instance; ------------------------------ @@ -4607,27 +4606,47 @@ package body Sem_Ch4 is Analyze_Selected_Component (N); return; - -- Similarly, if this is the actual for a formal derived type, the - -- component inherited from the generic parent may not be visible - -- in the actual, but the selected component is legal. + -- Similarly, if this is the actual for a formal derived type, or + -- a derived type thereof, the component inherited from the generic + -- parent may not be visible in the actual, but the selected + -- component is legal. Climb up the derivation chain of the generic + -- parent type until we find the proper ancestor type. - elsif Ekind (Prefix_Type) = E_Record_Subtype_With_Private - and then Is_Generic_Actual_Type (Prefix_Type) - and then Present (Full_View (Prefix_Type)) - then - Find_Component_In_Instance - (Generic_Parent_Type (Parent (Prefix_Type))); - return; + elsif In_Instance and then Is_Tagged_Type (Prefix_Type) then + declare + Par : Entity_Id := Prefix_Type; + begin + -- Climb up derivation chain to generic actual subtype + + while not Is_Generic_Actual_Type (Par) loop + if Ekind (Par) = E_Record_Type then + Par := Parent_Subtype (Par); + exit when No (Par); + else + exit when Par = Etype (Par); + Par := Etype (Par); + end if; + end loop; - -- Finally, the formal and the actual may be private extensions, - -- but the generic is declared in a child unit of the parent, and - -- an additional step is needed to retrieve the proper scope. + if Present (Par) and then Is_Generic_Actual_Type (Par) then + -- Now look for component in ancestor types - elsif In_Instance - and then Present (Parent_Subtype (Etype (Base_Type (Prefix_Type)))) - then - Find_Component_In_Instance - (Parent_Subtype (Etype (Base_Type (Prefix_Type)))); + Par := Generic_Parent_Type (Declaration_Node (Par)); + loop + Find_Component_In_Instance (Par); + exit when Present (Entity (Sel)) + or else Par = Etype (Par); + Par := Etype (Par); + end loop; + end if; + end; + + -- The search above must have eventually succeeded, since the + -- selected component was legal in the generic. + + if No (Entity (Sel)) then + raise Program_Error; + end if; return; -- Component not found, specialize error message when appropriate diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 7e2e55cff74..aff4b47926a 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -6287,7 +6287,10 @@ package body Sem_Res is -- Check comparison on unordered enumeration if Bad_Unordered_Enumeration_Reference (N, Etype (L)) then - Error_Msg_N ("comparison on unordered enumeration type?U?", N); + Error_Msg_Sloc := Sloc (Etype (L)); + Error_Msg_NE + ("comparison on unordered enumeration type& declared#?U?", + N, Etype (L)); end if; -- Evaluate the relation (note we do this after the above check since @@ -8830,7 +8833,9 @@ package body Sem_Res is and then not First_Last_Ref then - Error_Msg ("subrange of unordered enumeration type?U?", Sloc (N)); + Error_Msg_Sloc := Sloc (Typ); + Error_Msg_NE + ("subrange of unordered enumeration type& declared#?U?", N, Typ); end if; Check_Unset_Reference (L); -- 2.30.2