diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2016-04-21 10:25:59 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2016-04-21 10:25:59 +0000 |
commit | d4fbac2f55e8157b73f2707250e64a813cad6337 (patch) | |
tree | 68509cb2929b2c9f2bd7f6f5b3cdfe4fb462ba06 /gcc | |
parent | ee91a8d2e0f3a4ffbff991d0d1e7b9d3893ed53b (diff) | |
download | gcc-d4fbac2f55e8157b73f2707250e64a813cad6337.tar.gz |
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().
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@235330 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/ChangeLog | 38 | ||||
-rw-r--r-- | gcc/ada/exp_aggr.adb | 7 | ||||
-rw-r--r-- | gcc/ada/sem_ch10.adb | 16 | ||||
-rw-r--r-- | gcc/ada/sem_ch12.adb | 15 | ||||
-rw-r--r-- | gcc/ada/sem_ch3.adb | 2 | ||||
-rw-r--r-- | gcc/ada/sem_ch4.adb | 45 | ||||
-rw-r--r-- | gcc/ada/sem_ch6.adb | 186 | ||||
-rw-r--r-- | gcc/ada/sem_res.adb | 38 | ||||
-rw-r--r-- | gcc/ada/tracebak.c | 3 |
9 files changed, 261 insertions, 89 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3dcc02d1672..05f1f2bb559 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,41 @@ +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 diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index c6b6210fd28..19ecdad9745 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -6061,6 +6061,13 @@ package body Exp_Aggr is 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 diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index da5aba8c1b9..c872abed6ae 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -5637,10 +5637,10 @@ package body Sem_Ch10 is 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 @@ -5668,16 +5668,16 @@ package body Sem_Ch10 is 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; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 1d4d5c0bdf6..699ad690892 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -13105,18 +13105,23 @@ package body Sem_Ch12 is -- 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; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 0560a69f564..bbb10ac4edf 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -5074,7 +5074,7 @@ package body Sem_Ch3 is -- 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. diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 6ba51e8f3d8..5b463cbd29a 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -7537,27 +7537,54 @@ package body Sem_Ch4 is 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; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 1a996da0db8..6c5e56a666c 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -6482,45 +6482,48 @@ package body Sem_Ch6 is 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 @@ -6529,18 +6532,23 @@ package body Sem_Ch6 is -- 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 @@ -6552,11 +6560,11 @@ package body Sem_Ch6 is -- 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 @@ -6580,39 +6588,115 @@ package body Sem_Ch6 is -- 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 diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 8957287dbfd..c6effa379de 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -2248,17 +2248,25 @@ package body Sem_Res is 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; @@ -2292,17 +2300,17 @@ package body Sem_Res is 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&)!", @@ -11836,9 +11844,11 @@ package body Sem_Res is "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_ diff --git a/gcc/ada/tracebak.c b/gcc/ada/tracebak.c index dceac0d443b..7b1849bdf03 100644 --- a/gcc/ada/tracebak.c +++ b/gcc/ada/tracebak.c @@ -354,9 +354,10 @@ extern void __runnit(); /* thread entry point. */ #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 |