From: Pierre-Marie de Rodat Date: Mon, 9 Oct 2017 20:36:41 +0000 (+0000) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=367601d1238a0b997ec9321ab2c58e5557d972c2;p=gcc.git [multiple changes] 2017-10-09 Javier Miranda * sem_ch3.adb (Replace_Components): Browse the list of discriminants, not components. 2017-10-09 Hristian Kirtchev * sem_elab.adb (Static_Elaboration_Checks): Elaboration requirements are verified only in the static model. 2017-10-09 Ed Schonberg * sem_ch5.adb (Analyze_Iterator_Specification, Check_Reverse_Iteration): Check that the domain of iteration supports reverse iteration when it is a formal container. This requires the presence of a Previous primitive in the Iterable aspect. * sem_ch13.adb (Resolve_Iterable_Operation): Verify legality of primitives Last and Previous to support reverse iteration over formal containers. (Validate_Iterable_Aspect): Add check for reverse iteration operations. * exp_ch5.adb (Build_Formal_Container_Iteration): Add proper expansion for reverse iteration using primitives Last and Previous in generated loop. 2017-10-09 Ed Schonberg * sem_util.adb (Subprogram_Name): If this is a child unit, use the name of the Defining_Program_Unit_Name, which is an identifier, in order to construct the string for the fully qualified name. From-SVN: r253567 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 99d0702f022..2e799e1ef1d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,33 @@ +2017-10-09 Javier Miranda + + * sem_ch3.adb (Replace_Components): Browse the list of discriminants, + not components. + +2017-10-09 Hristian Kirtchev + + * sem_elab.adb (Static_Elaboration_Checks): Elaboration requirements + are verified only in the static model. + +2017-10-09 Ed Schonberg + + * sem_ch5.adb (Analyze_Iterator_Specification, + Check_Reverse_Iteration): Check that the domain of iteration supports + reverse iteration when it is a formal container. This requires the + presence of a Previous primitive in the Iterable aspect. + * sem_ch13.adb (Resolve_Iterable_Operation): Verify legality of + primitives Last and Previous to support reverse iteration over formal + containers. + (Validate_Iterable_Aspect): Add check for reverse iteration operations. + * exp_ch5.adb (Build_Formal_Container_Iteration): Add proper expansion + for reverse iteration using primitives Last and Previous in generated + loop. + +2017-10-09 Ed Schonberg + + * sem_util.adb (Subprogram_Name): If this is a child unit, use the name + of the Defining_Program_Unit_Name, which is an identifier, in order to + construct the string for the fully qualified name. + 2017-10-09 Justin Squirek * sem_ch3.adb: Rename Uses_Unseen_Priv into diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index d760739d057..d7587eb7aec 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -178,14 +178,27 @@ package body Exp_Ch5 is Loc : constant Source_Ptr := Sloc (N); Stats : constant List_Id := Statements (N); Typ : constant Entity_Id := Base_Type (Etype (Container)); - First_Op : constant Entity_Id := - Get_Iterable_Type_Primitive (Typ, Name_First); - Next_Op : constant Entity_Id := - Get_Iterable_Type_Primitive (Typ, Name_Next); + + First_Op : Entity_Id; + Next_Op : Entity_Id; Has_Element_Op : constant Entity_Id := Get_Iterable_Type_Primitive (Typ, Name_Has_Element); begin + -- Use the proper set of primitives depending on the direction of + -- iteration. The legality of a reverse iteration has been checked + -- during analysis. + + if Reverse_Present (Iterator_Specification (Iteration_Scheme (N))) then + First_Op := Get_Iterable_Type_Primitive (Typ, Name_Last); + Next_Op := Get_Iterable_Type_Primitive (Typ, Name_Previous); + + else + First_Op := Get_Iterable_Type_Primitive (Typ, Name_First); + Next_Op := Get_Iterable_Type_Primitive (Typ, Name_Next); + null; + end if; + -- Declaration for Cursor Init := @@ -198,7 +211,7 @@ package body Exp_Ch5 is Parameter_Associations => New_List ( Convert_To_Iterable_Type (Container, Loc)))); - -- Statement that advances cursor in loop + -- Statement that advances (in the right direction) cursor in loop Advance := Make_Assignment_Statement (Loc, diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 5220e5df457..701aa088ae9 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -13200,9 +13200,12 @@ package body Sem_Ch13 is Ent := Entity (N); F1 := First_Formal (Ent); - if Nam = Name_First then - -- First (Container) => Cursor + if Nam = Name_First + or else Nam = Name_Last + then + + -- First or Last (Container) => Cursor if Etype (Ent) /= Cursor then Error_Msg_N ("primitive for First must yield a curosr", N); @@ -13221,6 +13224,19 @@ package body Sem_Ch13 is Error_Msg_N ("no match for Next iterable primitive", N); end if; + elsif Nam = Name_Previous then + + -- Previous (Container, Cursor) => Cursor + + F2 := Next_Formal (F1); + + if Etype (F2) /= Cursor + or else Etype (Ent) /= Cursor + or else Present (Next_Formal (F2)) + then + Error_Msg_N ("no match for Previous iterable primitive", N); + end if; + elsif Nam = Name_Has_Element then -- Has_Element (Container, Cursor) => Boolean @@ -14022,6 +14038,7 @@ package body Sem_Ch13 is Cursor : constant Entity_Id := Get_Cursor_Type (ASN, Typ); First_Id : Entity_Id; + Last_Id : Entity_Id; Next_Id : Entity_Id; Has_Element_Id : Entity_Id; Element_Id : Entity_Id; @@ -14034,6 +14051,7 @@ package body Sem_Ch13 is end if; First_Id := Empty; + Last_Id := Empty; Next_Id := Empty; Has_Element_Id := Empty; Element_Id := Empty; @@ -14054,6 +14072,14 @@ package body Sem_Ch13 is Resolve_Iterable_Operation (Expr, Cursor, Typ, Name_First); First_Id := Entity (Expr); + elsif Chars (Prim) = Name_Last then + Resolve_Iterable_Operation (Expr, Cursor, Typ, Name_Last); + Last_Id := Entity (Expr); + + elsif Chars (Prim) = Name_Previous then + Resolve_Iterable_Operation (Expr, Cursor, Typ, Name_Previous); + Last_Id := Entity (Expr); + elsif Chars (Prim) = Name_Next then Resolve_Iterable_Operation (Expr, Cursor, Typ, Name_Next); Next_Id := Entity (Expr); @@ -14082,7 +14108,9 @@ package body Sem_Ch13 is elsif No (Has_Element_Id) then Error_Msg_N ("match for Has_Element primitive not found", ASN); - elsif No (Element_Id) then + elsif No (Element_Id) + or else No (Last_Id) + then null; -- Optional. end if; end Validate_Iterable_Aspect; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 61d1140e9b0..dd0ff2a9b02 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -21991,7 +21991,7 @@ package body Sem_Ch3 is exit; end if; - Next_Component (Comp); + Next_Discriminant (Comp); end loop; elsif Nkind (N) = N_Component_Declaration then diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 03876afafc4..b06bff77cff 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -1937,12 +1937,19 @@ package body Sem_Ch5 is procedure Check_Reverse_Iteration (Typ : Entity_Id) is begin - if Reverse_Present (N) - and then not Is_Array_Type (Typ) - and then not Is_Reversible_Iterator (Typ) - then - Error_Msg_NE - ("container type does not support reverse iteration", N, Typ); + if Reverse_Present (N) then + if Is_Array_Type (Typ) + or else Is_Reversible_Iterator (Typ) + or else + (Present (Find_Aspect (Typ, Aspect_Iterable)) + and then Present + (Get_Iterable_Type_Primitive (Typ, Name_Previous))) + then + null; + else + Error_Msg_NE + ("container type does not support reverse iteration", N, Typ); + end if; end if; end Check_Reverse_Iteration; @@ -2303,6 +2310,7 @@ package body Sem_Ch5 is ("missing Element primitive for iteration", N); else Set_Etype (Def_Id, Etype (Elt)); + Check_Reverse_Iteration (Typ); end if; end; diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 909a50090fc..5ba6938cf97 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -5516,12 +5516,18 @@ package body Sem_Elab is Req_Met := False; + -- Elaboration requirements are verified only when the static model is + -- in effect because this diagnostic is graph-dependent. + + if not Static_Elaboration_Checks then + return; + -- If the target is within the main unit, either at the source level or -- through an instantiation, then there is no real requirement to meet -- because the main unit cannot force its own elaboration by means of an -- Elaborate[_All] pragma. Treat this case as valid coverage. - if In_Extended_Main_Code_Unit (Target_Id) then + elsif In_Extended_Main_Code_Unit (Target_Id) then Req_Met := True; -- Otherwise the target resides in an external unit diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 0ae717cfccd..2e64e826301 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -23257,7 +23257,16 @@ package body Sem_Util is return "unknown subprogram"; end if; - Append_Entity_Name (Buf, Ent); + if Nkind (Ent) = N_Defining_Program_Unit_Name then + + -- If the subprogram is a child unit, use its simple name to + -- start the construction of the fully qualified name. + + Append_Entity_Name (Buf, Defining_Identifier (Ent)); + + else + Append_Entity_Name (Buf, Ent); + end if; return +Buf; end Subprogram_Name;