+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
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;
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;
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;
(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
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;
(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;
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;
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);
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;
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;
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
(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;
-- 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
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;
------------------------------
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
-- 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
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);
projects / gcc.git / commitdiff