Commit b1d12996 by Arnaud Charlet

[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
parent fcadacf7
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> 2014-01-27 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb: sem_ch6.adb (Set_Actual_Subtypes): If the type * 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 ...@@ -229,6 +229,10 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
P : List (C); P : List (C);
begin begin
if 0 < Capacity and then Capacity < Source.Capacity then
raise Capacity_Error;
end if;
N := 1; N := 1;
while N <= Source.Capacity loop while N <= Source.Capacity loop
P.Nodes (N).Prev := Source.Nodes (N).Prev; P.Nodes (N).Prev := Source.Nodes (N).Prev;
......
...@@ -84,7 +84,8 @@ package Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -84,7 +84,8 @@ package Ada.Containers.Formal_Doubly_Linked_Lists is
procedure Assign (Target : in out List; Source : List) with procedure Assign (Target : in out List; Source : List) with
Pre => Target.Capacity >= Length (Source); 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 function Element
(Container : List; (Container : List;
......
...@@ -207,6 +207,10 @@ package body Ada.Containers.Formal_Hashed_Maps is ...@@ -207,6 +207,10 @@ package body Ada.Containers.Formal_Hashed_Maps is
Cu : Cursor; Cu : Cursor;
begin begin
if 0 < Capacity and then Capacity < Source.Capacity then
raise Capacity_Error;
end if;
Target.Length := Source.Length; Target.Length := Source.Length;
Target.Free := Source.Free; Target.Free := Source.Free;
......
...@@ -100,7 +100,7 @@ package Ada.Containers.Formal_Hashed_Maps is ...@@ -100,7 +100,7 @@ package Ada.Containers.Formal_Hashed_Maps is
(Source : Map; (Source : Map;
Capacity : Count_Type := 0) return Map Capacity : Count_Type := 0) return Map
with with
Pre => Capacity >= Source.Capacity; Pre => Capacity = 0 or else Capacity >= Source.Capacity;
-- Copy returns a container stricty equal to Source. It must have -- Copy returns a container stricty equal to Source. It must have
-- the same cursors associated with each element. Therefore: -- the same cursors associated with each element. Therefore:
-- - capacity=0 means use container.capacity as capacity of target -- - capacity=0 means use container.capacity as capacity of target
......
...@@ -233,6 +233,10 @@ package body Ada.Containers.Formal_Hashed_Sets is ...@@ -233,6 +233,10 @@ package body Ada.Containers.Formal_Hashed_Sets is
Cu : Cursor; Cu : Cursor;
begin begin
if 0 < Capacity and then Capacity < Source.Capacity then
raise Capacity_Error;
end if;
Target.Length := Source.Length; Target.Length := Source.Length;
Target.Free := Source.Free; Target.Free := Source.Free;
......
...@@ -106,7 +106,7 @@ package Ada.Containers.Formal_Hashed_Sets is ...@@ -106,7 +106,7 @@ package Ada.Containers.Formal_Hashed_Sets is
(Source : Set; (Source : Set;
Capacity : Count_Type := 0) return Set Capacity : Count_Type := 0) return Set
with with
Pre => Capacity >= Source.Capacity; Pre => Capacity = 0 or else Capacity >= Source.Capacity;
function Element function Element
(Container : Set; (Container : Set;
......
...@@ -283,6 +283,10 @@ package body Ada.Containers.Formal_Ordered_Maps is ...@@ -283,6 +283,10 @@ package body Ada.Containers.Formal_Ordered_Maps is
N : Count_Type; N : Count_Type;
begin 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 return Target : Map (Count_Type'Max (Source.Capacity, Capacity)) do
if Length (Source) > 0 then if Length (Source) > 0 then
Target.Length := Source.Length; Target.Length := Source.Length;
......
...@@ -92,7 +92,7 @@ package Ada.Containers.Formal_Ordered_Maps is ...@@ -92,7 +92,7 @@ package Ada.Containers.Formal_Ordered_Maps is
Pre => Target.Capacity >= Length (Source); Pre => Target.Capacity >= Length (Source);
function Copy (Source : Map; Capacity : Count_Type := 0) return Map with 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 function Key (Container : Map; Position : Cursor) return Key_Type with
Pre => Has_Element (Container, Position); Pre => Has_Element (Container, Position);
......
...@@ -320,6 +320,10 @@ package body Ada.Containers.Formal_Ordered_Sets is ...@@ -320,6 +320,10 @@ package body Ada.Containers.Formal_Ordered_Sets is
Target : Set (Count_Type'Max (Source.Capacity, Capacity)); Target : Set (Count_Type'Max (Source.Capacity, Capacity));
begin begin
if 0 < Capacity and then Capacity < Source.Capacity then
raise Capacity_Error;
end if;
if Length (Source) > 0 then if Length (Source) > 0 then
Target.Length := Source.Length; Target.Length := Source.Length;
Target.Root := Source.Root; Target.Root := Source.Root;
......
...@@ -94,7 +94,7 @@ package Ada.Containers.Formal_Ordered_Sets is ...@@ -94,7 +94,7 @@ package Ada.Containers.Formal_Ordered_Sets is
Pre => Target.Capacity >= Length (Source); Pre => Target.Capacity >= Length (Source);
function Copy (Source : Set; Capacity : Count_Type := 0) return Set with 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 function Element
(Container : Set; (Container : Set;
......
...@@ -301,10 +301,10 @@ package body Ada.Containers.Formal_Vectors is ...@@ -301,10 +301,10 @@ package body Ada.Containers.Formal_Vectors is
begin begin
if Capacity = 0 then if Capacity = 0 then
C := LS; C := LS;
elsif Capacity >= LS then elsif Capacity >= LS and then Capacity in Capacity_Range then
C := Capacity; C := Capacity;
else else
raise Constraint_Error; raise Capacity_Error;
end if; end if;
return Target : Vector (C) do return Target : Vector (C) do
......
...@@ -125,7 +125,7 @@ package Ada.Containers.Formal_Vectors is ...@@ -125,7 +125,7 @@ package Ada.Containers.Formal_Vectors is
(Source : Vector; (Source : Vector;
Capacity : Count_Type := 0) return Vector Capacity : Count_Type := 0) return Vector
with with
Pre => Length (Source) <= Capacity; Pre => Length (Source) <= Capacity and then Capacity in Capacity_Range;
function To_Cursor function To_Cursor
(Container : Vector; (Container : Vector;
......
...@@ -3943,6 +3943,7 @@ package body Sem_Ch4 is ...@@ -3943,6 +3943,7 @@ package body Sem_Ch4 is
-- searches have failed. When the match is found (it always will be), -- 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 -- the Etype of both N and Sel are set from this component, and the
-- entity of Sel is set to reference this component. -- 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; function Has_Mode_Conformant_Spec (Comp : Entity_Id) return Boolean;
-- It is known that the parent of N denotes a subprogram call. Comp -- It is known that the parent of N denotes a subprogram call. Comp
...@@ -3971,9 +3972,7 @@ package body Sem_Ch4 is ...@@ -3971,9 +3972,7 @@ package body Sem_Ch4 is
Next_Component (Comp); Next_Component (Comp);
end loop; end loop;
-- This must succeed because code was legal in the generic -- Need comment on what is going on when we fall through ???
raise Program_Error;
end Find_Component_In_Instance; end Find_Component_In_Instance;
------------------------------ ------------------------------
...@@ -4607,27 +4606,47 @@ package body Sem_Ch4 is ...@@ -4607,27 +4606,47 @@ package body Sem_Ch4 is
Analyze_Selected_Component (N); Analyze_Selected_Component (N);
return; return;
-- Similarly, if this is the actual for a formal derived type, the -- Similarly, if this is the actual for a formal derived type, or
-- component inherited from the generic parent may not be visible -- a derived type thereof, the component inherited from the generic
-- in the actual, but the selected component is legal. -- 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 elsif In_Instance and then Is_Tagged_Type (Prefix_Type) then
and then Is_Generic_Actual_Type (Prefix_Type) declare
and then Present (Full_View (Prefix_Type)) Par : Entity_Id := Prefix_Type;
then begin
Find_Component_In_Instance -- Climb up derivation chain to generic actual subtype
(Generic_Parent_Type (Parent (Prefix_Type)));
return; 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, if Present (Par) and then Is_Generic_Actual_Type (Par) then
-- but the generic is declared in a child unit of the parent, and -- Now look for component in ancestor types
-- an additional step is needed to retrieve the proper scope.
elsif In_Instance Par := Generic_Parent_Type (Declaration_Node (Par));
and then Present (Parent_Subtype (Etype (Base_Type (Prefix_Type)))) loop
then Find_Component_In_Instance (Par);
Find_Component_In_Instance exit when Present (Entity (Sel))
(Parent_Subtype (Etype (Base_Type (Prefix_Type)))); 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; return;
-- Component not found, specialize error message when appropriate -- Component not found, specialize error message when appropriate
......
...@@ -6287,7 +6287,10 @@ package body Sem_Res is ...@@ -6287,7 +6287,10 @@ package body Sem_Res is
-- Check comparison on unordered enumeration -- Check comparison on unordered enumeration
if Bad_Unordered_Enumeration_Reference (N, Etype (L)) then 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; end if;
-- Evaluate the relation (note we do this after the above check since -- Evaluate the relation (note we do this after the above check since
...@@ -8830,7 +8833,9 @@ package body Sem_Res is ...@@ -8830,7 +8833,9 @@ package body Sem_Res is
and then not First_Last_Ref and then not First_Last_Ref
then 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; end if;
Check_Unset_Reference (L); Check_Unset_Reference (L);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment