mirror of git://gcc.gnu.org/git/gcc.git
[multiple changes]
2014-01-27 Robert Dewar <dewar@adacore.com> * 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 <dross@adacore.com> * 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 <quinot@adacore.com> * 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
This commit is contained in:
parent
fcadacf7bf
commit
b1d1299619
|
|
@ -1,3 +1,25 @@
|
|||
2014-01-27 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* 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 <dross@adacore.com>
|
||||
|
||||
* 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 <quinot@adacore.com>
|
||||
|
||||
* 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 <schonberg@adacore.com>
|
||||
|
||||
* sem_ch6.adb: sem_ch6.adb (Set_Actual_Subtypes): If the type
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
-- 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.
|
||||
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;
|
||||
|
||||
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))));
|
||||
if Present (Par) and then Is_Generic_Actual_Type (Par) then
|
||||
-- Now look for component in ancestor types
|
||||
|
||||
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
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
Loading…
Reference in New Issue