+2016-04-21 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_ch3.adb: Code cleanup.
+ * sem_ch6.adb: Code cleanup.
+ (Is_Matching_Limited_View): New routine.
+ (Matches_Limited_With_View): Reimplemented.
+ * sem_ch10.adb (Decorate_Type): Code cleanup.
+
+2016-04-21 Doug Rupp <rupp@adacore.com>
+
+ * tracebak.c (PPC ELF): Add macro defs for lynxos178e.
+
+2016-04-21 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch4.adb (Try_Container_Indexing): If there are overloaded
+ indexing functions, collect all overloadings of the call firts,
+ and then transfer them to indexing node, to prevent interleaving
+ of the set of interpretations of the nodes involved.
+ * sem_res.adb (Resolve): Suppress cascaded errors that report
+ ambiguities when one of the actuals in an overloaded generatlized
+ indexing operation is illegal and has type Any_Type, as is done
+ for similar cascaded errors in subprogram calls.
+ (Valid_Tagged_Conversion): Cleanup conversion checks when one
+ of the types involved is a class-wide subtype.
+
+2016-04-21 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch12.adb (Load_Parent_Of_Generic): When looking for the
+ subprogram declaration within a wrapper package, skip pragmas
+ that may have been generated by aspect specifications on the
+ generic instance.
+
+2016-04-21 Javier Miranda <miranda@adacore.com>
+
+ * exp_aggr.adb (Component_Not_OK_For_Backend): Generating C
+ code return True for array identifiers since the backend needs
+ to initialize such component by means of memcpy().
+
2016-04-21 Arnaud Charlet <charlet@adacore.com>
* a-tasatt.adb, a-tasatt.ads (Fast_Path): Rewritten to avoid reading
then
Static_Components := False;
return True;
+
+ elsif Modify_Tree_For_C
+ and then Nkind (Expr_Q) = N_Identifier
+ and then Is_Array_Type (Etype (Expr_Q))
+ then
+ Static_Components := False;
+ return True;
end if;
if Is_Elementary_Type (Etype (Expr_Q)) then
Set_Ekind (Ent, E_Incomplete_Type);
Set_Etype (Ent, Ent);
- Set_Scope (Ent, Scop);
+ Set_Full_View (Ent, Empty);
Set_Is_First_Subtype (Ent);
+ Set_Scope (Ent, Scop);
Set_Stored_Constraint (Ent, No_Elist);
- Set_Full_View (Ent, Empty);
Init_Size_Align (Ent);
-- A tagged type and its corresponding shadow entity share one common
Set_Parent (CW_Typ, Parent (Ent));
Set_Ekind (CW_Typ, E_Class_Wide_Type);
- Set_Etype (CW_Typ, Ent);
- Set_Scope (CW_Typ, Scop);
- Set_Is_Tagged_Type (CW_Typ);
- Set_Is_First_Subtype (CW_Typ);
- Init_Size_Align (CW_Typ);
- Set_Has_Unknown_Discriminants (CW_Typ);
Set_Class_Wide_Type (CW_Typ, CW_Typ);
+ Set_Etype (CW_Typ, Ent);
Set_Equivalent_Type (CW_Typ, Empty);
Set_From_Limited_With (CW_Typ, From_Limited_With (Ent));
+ Set_Has_Unknown_Discriminants (CW_Typ);
+ Set_Is_First_Subtype (CW_Typ);
+ Set_Is_Tagged_Type (CW_Typ);
Set_Materialize_Entity (CW_Typ, Materialize);
+ Set_Scope (CW_Typ, Scop);
+ Init_Size_Align (CW_Typ);
end if;
end Decorate_Type;
-- The instance_spec is in the wrapper package,
-- usually followed by its local renaming
-- declaration. See Build_Subprogram_Renaming
- -- for details.
+ -- for details. If the instance carries aspects,
+ -- these result in the corresponding pragmas,
+ -- inserted after the subprogram declaration.
+ -- They must be skipped as well when retrieving
+ -- the desired spec. A direct link would be
+ -- more robust ???
declare
Decl : Node_Id :=
(Last (Visible_Declarations
(Specification (Info.Act_Decl))));
begin
- if Nkind (Decl) =
- N_Subprogram_Renaming_Declaration
- then
+ while Nkind_In (Decl,
+ N_Subprogram_Renaming_Declaration, N_Pragma)
+ loop
Decl := Prev (Decl);
- end if;
+ end loop;
Info.Act_Decl := Decl;
end;
-- inherit static and dynamic predicates if any.
-- If declaration has no aspect specifications, inherit predicate
- -- info as well. Unclear how to handle the case of both specified
+ -- info as well. Unclear how to handle the case of both specified
-- and inherited predicates ??? Other inherited aspects, such as
-- invariants, should be OK, but the combination with later pragmas
-- may also require special merging.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Get_First_Interp (Func_Name, I, It);
Set_Etype (Indexing, Any_Type);
+ -- Analyze eacn candidae function with the given actuals
+
while Present (It.Nam) loop
Analyze_One_Call (Indexing, It.Nam, False, Success);
+ Get_Next_Interp (I, It);
+ end loop;
- if Success then
+ -- If there are several successful candidates, resolution will
+ -- be by result. Mark the interpretations of the function name
+ -- itself.
- -- Function in current interpretation is a valid candidate.
- -- Its result type is also a potential type for the
- -- original Indexed_Component node.
+ if Is_Overloaded (Indexing) then
+ Get_First_Interp (Indexing, I, It);
+ while Present (It.Nam) loop
Add_One_Interp (Name (Indexing), It.Nam, It.Typ);
+ Get_Next_Interp (I, It);
+ end loop;
+
+ else
+ Set_Etype (Name (Indexing), Etype (Indexing));
+ end if;
+
+ -- Now add the candidate interpretations to the indexing node
+ -- itself, to be replaced later by the function call.
+
+ if Is_Overloaded (Name (Indexing)) then
+ Get_First_Interp (Name (Indexing), I, It);
+
+ while Present (It.Nam) loop
Add_One_Interp (N, It.Nam, It.Typ);
- -- Add implicit dereference interpretation to original node
+ -- Add dereference interpretation if the result type type
+ -- has implicit reference discriminants.
if Has_Discriminants (Etype (It.Nam)) then
Check_Implicit_Dereference (N, Etype (It.Nam));
end if;
- end if;
- Get_Next_Interp (I, It);
- end loop;
+ Get_Next_Interp (I, It);
+ end loop;
+
+ else
+ Set_Etype (N, Etype (Name (Indexing)));
+ if Has_Discriminants (Etype (N)) then
+ Check_Implicit_Dereference (N, Etype (N));
+ end if;
+ end if;
end;
end if;
Ctype : Conformance_Type;
Get_Inst : Boolean := False) return Boolean
is
- Type_1 : Entity_Id := T1;
- Type_2 : Entity_Id := T2;
- Are_Anonymous_Access_To_Subprogram_Types : Boolean := False;
-
- function Base_Types_Match (T1, T2 : Entity_Id) return Boolean;
- -- If neither T1 nor T2 are generic actual types, or if they are in
- -- different scopes (e.g. parent and child instances), then verify that
- -- the base types are equal. Otherwise T1 and T2 must be on the same
- -- subtype chain. The whole purpose of this procedure is to prevent
- -- spurious ambiguities in an instantiation that may arise if two
- -- distinct generic types are instantiated with the same actual.
-
- function Find_Designated_Type (T : Entity_Id) return Entity_Id;
+ function Base_Types_Match
+ (Typ_1 : Entity_Id;
+ Typ_2 : Entity_Id) return Boolean;
+ -- If neither Typ_1 nor Typ_2 are generic actual types, or if they are
+ -- in different scopes (e.g. parent and child instances), then verify
+ -- that the base types are equal. Otherwise Typ_1 and Typ_2 must be on
+ -- the same subtype chain. The whole purpose of this procedure is to
+ -- prevent spurious ambiguities in an instantiation that may arise if
+ -- two distinct generic types are instantiated with the same actual.
+
+ function Find_Designated_Type (Typ : Entity_Id) return Entity_Id;
-- An access parameter can designate an incomplete type. If the
-- incomplete type is the limited view of a type from a limited_
- -- with_clause, check whether the non-limited view is available. If
- -- it is a (non-limited) incomplete type, get the full view.
-
- function Matches_Limited_With_View (T1, T2 : Entity_Id) return Boolean;
- -- Returns True if and only if either T1 denotes a limited view of T2
- -- or T2 denotes a limited view of T1. This can arise when the limited
- -- with view of a type is used in a subprogram declaration and the
- -- subprogram body is in the scope of a regular with clause for the
- -- same unit. In such a case, the two type entities can be considered
+ -- with_clause, check whether the non-limited view is available.
+ -- If it is a (non-limited) incomplete type, get the full view.
+
+ function Matches_Limited_With_View
+ (Typ_1 : Entity_Id;
+ Typ_2 : Entity_Id) return Boolean;
+ -- Returns True if and only if either Typ_1 denotes a limited view of
+ -- Typ_2 or Typ_2 denotes a limited view of Typ_1. This can arise when
+ -- the limited with view of a type is used in a subprogram declaration
+ -- and the subprogram body is in the scope of a regular with clause for
+ -- the same unit. In such a case, the two type entities are considered
-- identical for purposes of conformance checking.
----------------------
-- Base_Types_Match --
----------------------
- function Base_Types_Match (T1, T2 : Entity_Id) return Boolean is
- BT1 : constant Entity_Id := Base_Type (T1);
- BT2 : constant Entity_Id := Base_Type (T2);
+ function Base_Types_Match
+ (Typ_1 : Entity_Id;
+ Typ_2 : Entity_Id) return Boolean
+ is
+ Base_1 : constant Entity_Id := Base_Type (Typ_1);
+ Base_2 : constant Entity_Id := Base_Type (Typ_2);
begin
- if T1 = T2 then
+ if Typ_1 = Typ_2 then
return True;
- elsif BT1 = BT2 then
+ elsif Base_1 = Base_2 then
-- The following is too permissive. A more precise test should
-- check that the generic actual is an ancestor subtype of the
-- See code in Find_Corresponding_Spec that applies an additional
-- filter to handle accidental amiguities in instances.
- return not Is_Generic_Actual_Type (T1)
- or else not Is_Generic_Actual_Type (T2)
- or else Scope (T1) /= Scope (T2);
+ return
+ not Is_Generic_Actual_Type (Typ_1)
+ or else not Is_Generic_Actual_Type (Typ_2)
+ or else Scope (Typ_1) /= Scope (Typ_2);
- -- If T2 is a generic actual type it is declared as the subtype of
+ -- If Typ_2 is a generic actual type it is declared as the subtype of
-- the actual. If that actual is itself a subtype we need to use its
-- own base type to check for compatibility.
- elsif Ekind (BT2) = Ekind (T2) and then BT1 = Base_Type (BT2) then
+ elsif Ekind (Base_2) = Ekind (Typ_2)
+ and then Base_1 = Base_Type (Base_2)
+ then
return True;
- elsif Ekind (BT1) = Ekind (T1) and then BT2 = Base_Type (BT1) then
+ elsif Ekind (Base_1) = Ekind (Typ_1)
+ and then Base_2 = Base_Type (Base_1)
+ then
return True;
else
-- Find_Designated_Type --
--------------------------
- function Find_Designated_Type (T : Entity_Id) return Entity_Id is
+ function Find_Designated_Type (Typ : Entity_Id) return Entity_Id is
Desig : Entity_Id;
begin
- Desig := Directly_Designated_Type (T);
+ Desig := Directly_Designated_Type (Typ);
if Ekind (Desig) = E_Incomplete_Type then
-- Matches_Limited_With_View --
-------------------------------
- function Matches_Limited_With_View (T1, T2 : Entity_Id) return Boolean is
+ function Matches_Limited_With_View
+ (Typ_1 : Entity_Id;
+ Typ_2 : Entity_Id) return Boolean
+ is
+ function Is_Matching_Limited_View
+ (Typ : Entity_Id;
+ View : Entity_Id) return Boolean;
+ -- Determine whether non-limited view View denotes type Typ in some
+ -- conformant fashion.
+
+ ------------------------------
+ -- Is_Matching_Limited_View --
+ ------------------------------
+
+ function Is_Matching_Limited_View
+ (Typ : Entity_Id;
+ View : Entity_Id) return Boolean
+ is
+ Root_Typ : Entity_Id;
+ Root_View : Entity_Id;
+
+ begin
+ -- The non-limited view directly denotes the type
+
+ if Typ = View then
+ return True;
+
+ -- The type is a subtype of the non-limited view
+
+ elsif Is_Subtype_Of (Typ, View) then
+ return True;
+
+ -- Both the non-limited view and the type denote class-wide types
+
+ elsif Is_Class_Wide_Type (Typ)
+ and then Is_Class_Wide_Type (View)
+ then
+ Root_Typ := Root_Type (Typ);
+ Root_View := Root_Type (View);
+
+ if Root_Typ = Root_View then
+ return True;
+
+ -- An incomplete tagged type and its full view may receive two
+ -- distinct class-wide types when the related package has not
+ -- been analyzed yet.
+
+ -- package Pack is
+ -- type T is tagged; -- CW_1
+ -- type T is tagged null record; -- CW_2
+ -- end Pack;
+
+ -- This is because the package lacks any semantic information
+ -- that may eventually link both views of T. As a consequence,
+ -- a client of the limited view of Pack will see CW_2 while a
+ -- client of the non-limited view of Pack will see CW_1.
+
+ elsif Is_Incomplete_Type (Root_Typ)
+ and then Present (Full_View (Root_Typ))
+ and then Full_View (Root_Typ) = Root_View
+ then
+ return True;
+
+ elsif Is_Incomplete_Type (Root_View)
+ and then Present (Full_View (Root_View))
+ and then Full_View (Root_View) = Root_Typ
+ then
+ return True;
+ end if;
+ end if;
+
+ return False;
+ end Is_Matching_Limited_View;
+
+ -- Start of processing for Matches_Limited_With_View
+
begin
-- In some cases a type imported through a limited_with clause, and
- -- its nonlimited view are both visible, for example in an anonymous
+ -- its non-limited view are both visible, for example in an anonymous
-- access-to-class-wide type in a formal, or when building the body
-- for a subprogram renaming after the subprogram has been frozen.
- -- In these cases Both entities designate the same type. In addition,
+ -- In these cases both entities designate the same type. In addition,
-- if one of them is an actual in an instance, it may be a subtype of
-- the non-limited view of the other.
- if From_Limited_With (T1)
- and then (T2 = Available_View (T1)
- or else Is_Subtype_Of (T2, Available_View (T1)))
+ if From_Limited_With (Typ_1)
+ and then From_Limited_With (Typ_2)
+ and then Available_View (Typ_1) = Available_View (Typ_2)
then
return True;
- elsif From_Limited_With (T2)
- and then (T1 = Available_View (T2)
- or else Is_Subtype_Of (T1, Available_View (T2)))
- then
- return True;
+ elsif From_Limited_With (Typ_1) then
+ return Is_Matching_Limited_View (Typ_2, Available_View (Typ_1));
- elsif From_Limited_With (T1)
- and then From_Limited_With (T2)
- and then Available_View (T1) = Available_View (T2)
- then
- return True;
+ elsif From_Limited_With (Typ_2) then
+ return Is_Matching_Limited_View (Typ_1, Available_View (Typ_2));
else
return False;
end if;
end Matches_Limited_With_View;
+ -- Local variables
+
+ Are_Anonymous_Access_To_Subprogram_Types : Boolean := False;
+
+ Type_1 : Entity_Id := T1;
+ Type_2 : Entity_Id := T2;
+
-- Start of processing for Conforming_Types
begin
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
end loop;
else
- -- Before we issue an ambiguity complaint, check for
- -- the case of a subprogram call where at least one
- -- of the arguments is Any_Type, and if so, suppress
- -- the message, since it is a cascaded error.
-
- if Nkind (N) in N_Subprogram_Call then
+ -- Before we issue an ambiguity complaint, check for the
+ -- case of a subprogram call where at least one of the
+ -- arguments is Any_Type, and if so suppress the message,
+ -- since it is a cascaded error. This can also happen for
+ -- a generalized indexing operation.
+
+ if Nkind (N) in N_Subprogram_Call
+ or else (Nkind (N) = N_Indexed_Component
+ and then Present (Generalized_Indexing (N)))
+ then
declare
A : Node_Id;
E : Node_Id;
begin
+ if Nkind (N) = N_Indexed_Component then
+ Rewrite (N, Generalized_Indexing (N));
+ end if;
+
A := First_Actual (N);
while Present (A) loop
E := A;
exit Interp_Loop;
end if;
- -- Not that special case, so issue message using the
- -- flag Ambiguous to control printing of the header
- -- message only at the start of an ambiguous set.
+ -- Not that special case, so issue message using the flag
+ -- Ambiguous to control printing of the header message
+ -- only at the start of an ambiguous set.
if not Ambiguous then
if Nkind (N) = N_Function_Call
and then Nkind (Name (N)) = N_Explicit_Dereference
then
Error_Msg_N
- ("ambiguous expression "
- & "(cannot resolve indirect call)!", N);
+ ("ambiguous expression (cannot resolve indirect "
+ & "call)!", N);
else
Error_Msg_NE -- CODEFIX
("ambiguous expression (cannot resolve&)!",
"downward conversion of tagged objects not allowed");
-- Ada 2005 (AI-251): The conversion to/from interface types is
- -- always valid
+ -- always valid. The types involved may be class-wide (sub)types.
- elsif Is_Interface (Target_Type) or else Is_Interface (Opnd_Type) then
+ elsif Is_Interface (Etype (Base_Type (Target_Type)))
+ or else Is_Interface (Etype (Base_Type (Opnd_Type)))
+ then
return True;
-- If the operand is a class-wide type obtained through a limited_
#define BASE_SKIP 1
-/*-------------------- PPC ELF (GNU/Linux & VxWorks) ---------------------*/
+/*----------- PPC ELF (GNU/Linux & VxWorks & Lynx178e) -------------------*/
#elif (defined (_ARCH_PPC) && defined (__vxworks)) || \
+ (defined (__powerpc__) && defined (__Lynx__) && defined(__ELF__)) || \
(defined (__linux__) && defined (__powerpc__))
#define USE_GENERIC_UNWINDER
projects / thirdparty / gcc.git / commitdiff
