From 8880426d05f9bf038fb0e735da6914cfd1ec8b55 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 20 Feb 2014 15:19:23 +0100 Subject: [PATCH] [multiple changes] 2014-02-20 Hristian Kirtchev * sem_prag.adb (Usage_Error): Remove local constant Typ. Remove the specialized diagnostics for unconstrained or tagged items as those are not part of the explicit input set of the related subprogram and should not be flagged. 2014-02-20 Ed Schonberg * sem_attr.adb: Add guard to preserve all errors. 2014-02-20 Vincent Celier * switch-m.adb (Normalize_Compiler_Switches): Take into account switches that are recorded in ALI files: -gnateA, -gnateE, -gnateF, -gnateinn, -gnateu, -gnateV and -gnateY. 2014-02-20 Ed Schonberg * sem_ch5.adb (Analyze_Iterator_Specification): Check legality of an element iterator form over a formal container with an Iterable aspect. * exp_ch5.adb (Build_Formal_Container_Iteration): Utility to create declaration and loop statements for both forms of container iterators. (Expand_Formal_Container_Element_Iterator): New procedure to handle loops of the form "for E of C" when C is a formal container. (Expand_Formal_Container_Iterator): Code cleanup. From-SVN: r207953 --- gcc/ada/ChangeLog | 30 ++++++ gcc/ada/exp_ch5.adb | 223 +++++++++++++++++++++++++++++++++---------- gcc/ada/sem_attr.adb | 6 +- gcc/ada/sem_ch5.adb | 56 ++++++----- gcc/ada/sem_prag.adb | 56 +++-------- gcc/ada/switch-m.adb | 23 ++--- 6 files changed, 266 insertions(+), 128 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 68e414c1043..68bd2691710 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,33 @@ +2014-02-20 Hristian Kirtchev + + * sem_prag.adb (Usage_Error): Remove local + constant Typ. Remove the specialized diagnostics for unconstrained + or tagged items as those are not part of the explicit input set + of the related subprogram and should not be flagged. + +2014-02-20 Ed Schonberg + + * sem_attr.adb: Add guard to preserve all errors. + +2014-02-20 Vincent Celier + + * switch-m.adb (Normalize_Compiler_Switches): Take into account + switches that are recorded in ALI files: -gnateA, -gnateE, + -gnateF, -gnateinn, -gnateu, -gnateV and -gnateY. + +2014-02-20 Ed Schonberg + + * sem_ch5.adb (Analyze_Iterator_Specification): Check legality + of an element iterator form over a formal container with an + Iterable aspect. + * exp_ch5.adb (Build_Formal_Container_Iteration): Utility + to create declaration and loop statements for both forms of + container iterators. + (Expand_Formal_Container_Element_Iterator): New procedure + to handle loops of the form "for E of C" when C is a formal + container. + (Expand_Formal_Container_Iterator): Code cleanup. + 2014-02-20 Hristian Kirtchev * sem_prag.adb (Add_Item_To_Name_Buffer): New routine. diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 10b280c8e28..df1f3f2d384 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -62,6 +62,16 @@ with Validsw; use Validsw; package body Exp_Ch5 is + procedure Build_Formal_Container_Iteration + (N : Node_Id; + Container : Entity_Id; + Cursor : Entity_Id; + Init : out Node_Id; + Advance : out Node_Id; + New_Loop : out Node_Id); + -- Utility to create declarations and loop statement for both forms + -- of formal container iterators. + function Change_Of_Representation (N : Node_Id) return Boolean; -- Determine if the right hand side of assignment N is a type conversion -- which requires a change of representation. Called only for the array @@ -103,10 +113,15 @@ package body Exp_Ch5 is -- clause (this last case is required because holes in the tagged type -- might be filled with components from child types). - procedure Expand_Formal_Container_Loop (Typ : Entity_Id; N : Node_Id); + procedure Expand_Formal_Container_Loop (N : Node_Id); -- Use the primitives specified in an Iterable aspect to expand a loop -- over a so-called formal container, primarily for SPARK usage. + procedure Expand_Formal_Container_Element_Loop (N : Node_Id); + -- Same, for an iterator of the form " For E of C". In this case the + -- iterator provides the name of the element, and the cursor is generated + -- internally. + procedure Expand_Iterator_Loop (N : Node_Id); -- Expand loop over arrays and containers that uses the form "for X of C" -- with an optional subtype mark, or "for Y in C". @@ -124,6 +139,72 @@ package body Exp_Ch5 is -- are not 'part of the value' and must not be changed upon assignment. N -- is the original Assignment node. + -------------------------------------- + -- Build_Formal_Container_iteration -- + -------------------------------------- + + procedure Build_Formal_Container_Iteration + (N : Node_Id; + Container : Entity_Id; + Cursor : Entity_Id; + Init : out Node_Id; + Advance : out Node_Id; + New_Loop : out Node_Id) + 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); + Has_Element_Op : constant Entity_Id := + Get_Iterable_Type_Primitive (Typ, Name_Has_Element); + begin + -- Declaration for Cursor + + Init := + Make_Object_Declaration (Loc, + Defining_Identifier => Cursor, + Object_Definition => New_Occurrence_Of (Etype (First_Op), Loc), + Expression => + Make_Function_Call (Loc, + Name => New_Occurrence_Of (First_Op, Loc), + Parameter_Associations => + New_List (New_Occurrence_Of (Container, Loc)))); + + -- Statement that advances cursor in loop + + Advance := + Make_Assignment_Statement (Loc, + Name => New_Occurrence_Of (Cursor, Loc), + Expression => + Make_Function_Call (Loc, + Name => New_Occurrence_Of (Next_Op, Loc), + Parameter_Associations => + New_List + (New_Occurrence_Of (Container, Loc), + New_Occurrence_Of (Cursor, Loc)))); + + -- Iterator is rewritten as a while_loop + + New_Loop := + Make_Loop_Statement (Loc, + Iteration_Scheme => + Make_Iteration_Scheme (Loc, + Condition => + Make_Function_Call (Loc, + Name => + New_Occurrence_Of (Has_Element_Op, Loc), + Parameter_Associations => + New_List + (New_Occurrence_Of (Container, Loc), + New_Occurrence_Of (Cursor, Loc)))), + Statements => Stats, + End_Label => Empty); + end Build_Formal_Container_Iteration; + ------------------------------ -- Change_Of_Representation -- ------------------------------ @@ -2660,29 +2741,21 @@ package body Exp_Ch5 is -- Expand_Formal_Container_Loop -- ---------------------------------- - procedure Expand_Formal_Container_Loop (Typ : Entity_Id; N : Node_Id) is + procedure Expand_Formal_Container_Loop (N : Node_Id) is Isc : constant Node_Id := Iteration_Scheme (N); I_Spec : constant Node_Id := Iterator_Specification (Isc); Cursor : constant Entity_Id := Defining_Identifier (I_Spec); Container : constant Node_Id := Entity (Name (I_Spec)); Stats : constant List_Id := Statements (N); - Loc : constant Source_Ptr := Sloc (N); - First_Op : constant Entity_Id := - Get_Iterable_Type_Primitive (Typ, Name_First); - Next_Op : constant Entity_Id := - Get_Iterable_Type_Primitive (Typ, Name_Next); - Has_Element_Op : constant Entity_Id := - Get_Iterable_Type_Primitive (Typ, Name_Has_Element); - - Advance : Node_Id; - Init : Node_Id; - New_Loop : Node_Id; + Advance : Node_Id; + Init : Node_Id; + New_Loop : Node_Id; begin -- The expansion resembles the one for Ada containers, but the - -- primitives mention the the domain of iteration explicitly, and - -- First applied to the container yields a cursor directly. + -- primitives mention the domain of iteration explicitly, and + -- function First applied to the container yields a cursor directly. -- Cursor : Cursor_type := First (Container); -- while Has_Element (Cursor, Container) loop @@ -2690,50 +2763,100 @@ package body Exp_Ch5 is -- Cursor := Next (Container, Cursor); -- end loop; - Init := - Make_Object_Declaration (Loc, - Defining_Identifier => Cursor, - Object_Definition => New_Occurrence_Of (Etype (First_Op), Loc), - Expression => - Make_Function_Call (Loc, - Name => New_Occurrence_Of (First_Op, Loc), - Parameter_Associations => - New_List (New_Occurrence_Of (Container, Loc)))); + Build_Formal_Container_Iteration + (N, Container, Cursor, Init, Advance, New_Loop); Set_Ekind (Cursor, E_Variable); + Insert_Action (N, Init); + + Append_To (Stats, Advance); + + Rewrite (N, New_Loop); + Analyze (New_Loop); + end Expand_Formal_Container_Loop; + + ------------------------------------------ + -- Expand_Formal_Container_Element_Loop -- + ------------------------------------------ + + procedure Expand_Formal_Container_Element_Loop (N : Node_Id) is + Loc : constant Source_Ptr := Sloc (N); + Isc : constant Node_Id := Iteration_Scheme (N); + I_Spec : constant Node_Id := Iterator_Specification (Isc); + Element : constant Entity_Id := Defining_Identifier (I_Spec); + Container : constant Node_Id := Entity (Name (I_Spec)); + Container_Typ : constant Entity_Id := Base_Type (Etype (Container)); + Stats : constant List_Id := Statements (N); + Cursor : constant Entity_Id := + Make_Defining_Identifier (Loc, + Chars => New_External_Name (Chars (Element), 'C')); + Elmt_Decl : Node_Id; + Elmt_Ref : Node_Id; + + Element_Op : constant Entity_Id := + Get_Iterable_Type_Primitive + (Container_Typ, Name_Element); + + Advance : Node_Id; + Init : Node_Id; + New_Loop : Node_Id; + + begin + -- For an element iterator, the Element aspect must be present, + -- (this is checked during analysis) and the expansion takes the form: + + -- Cursor : Cursor_type := First (Container); + -- Elmt : Element_Type; + -- while Has_Element (Cursor, Container) loop + -- Elmt := Element (Container, Cursor); + -- + -- Cursor := Next (Container, Cursor); + -- end loop; + + Build_Formal_Container_Iteration + (N, Container, Cursor, Init, Advance, New_Loop); + + Set_Ekind (Cursor, E_Variable); Insert_Action (N, Init); - Advance := - Make_Assignment_Statement (Loc, - Name => New_Occurrence_Of (Cursor, Loc), - Expression => - Make_Function_Call (Loc, - Name => New_Occurrence_Of (Next_Op, Loc), - Parameter_Associations => - New_List + -- Declaration for Element. + + Elmt_Decl := Make_Object_Declaration (Loc, + Defining_Identifier => Element, + Object_Definition => New_Occurrence_Of (Etype (Element_Op), Loc)); + + -- The element is only modified in expanded code, so it appears as + -- unassigned to the warning machinery. We must suppress this spurious + -- warning explicitly. + + Set_Warnings_Off (Element); + + Elmt_Ref := Make_Assignment_Statement (Loc, + Name => New_Occurrence_Of (Element, Loc), + Expression => + Make_Function_Call (Loc, + Name => New_Occurrence_Of (Element_Op, Loc), + Parameter_Associations => + New_List (New_Occurrence_Of (Container, Loc), New_Occurrence_Of (Cursor, Loc)))); + Prepend (Elmt_Ref, Stats); Append_To (Stats, Advance); - New_Loop := - Make_Loop_Statement (Loc, - Iteration_Scheme => - Make_Iteration_Scheme (Loc, - Condition => - Make_Function_Call (Loc, - Name => - New_Occurrence_Of (Has_Element_Op, Loc), - Parameter_Associations => - New_List - (New_Occurrence_Of (Container, Loc), - New_Occurrence_Of (Cursor, Loc)))), - Statements => Stats, - End_Label => Empty); + -- The loop is rewritten as a block, to hold the declaration for the + -- element. + + New_Loop := Make_Block_Statement (Loc, + Declarations => New_List (Elmt_Decl), + Handled_Statement_Sequence => + Make_Handled_Sequence_Of_Statements (Loc, + Statements => New_List (New_Loop))); + Rewrite (N, New_Loop); Analyze (New_Loop); - end Expand_Formal_Container_Loop; + end Expand_Formal_Container_Element_Loop; ----------------------------- -- Expand_N_Goto_Statement -- @@ -3052,7 +3175,11 @@ package body Exp_Ch5 is return; elsif Has_Aspect (Container_Typ, Aspect_Iterable) then - Expand_Formal_Container_Loop (Container_Typ, N); + if Of_Present (I_Spec) then + Expand_Formal_Container_Element_Loop (N); + else + Expand_Formal_Container_Loop (N); + end if; return; end if; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index f8a22ccbf2d..9146dc68e25 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -6310,8 +6310,12 @@ package body Sem_Attr is -- Verify that all choices in an association denote -- components of the same type. - if No (Comp_Type) then + if No (Etype (Comp)) then + null; + + elsif No (Comp_Type) then Comp_Type := Base_Type (Etype (Comp)); + elsif Comp_Type /= Base_Type (Etype (Comp)) then Error_Msg_N ("components in choice list must have same type", diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 9b765f48993..e5ea4cefe1e 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -1857,39 +1857,45 @@ package body Sem_Ch5 is Set_Ekind (Def_Id, E_Loop_Parameter); if Of_Present (N) then + if Has_Aspect (Typ, Aspect_Iterable) then + if No (Get_Iterable_Type_Primitive (Typ, Name_Element)) then + Error_Msg_N ("Missing Element primitive for iteration", N); + end if; - -- The type of the loop variable is the Iterator_Element aspect of - -- the container type. + -- For a predefined container, The type of the loop variable is + -- the Iterator_Element aspect of the container type. - declare - Element : constant Entity_Id := + else + declare + Element : constant Entity_Id := Find_Value_Of_Aspect (Typ, Aspect_Iterator_Element); - begin - if No (Element) then - Error_Msg_NE ("cannot iterate over&", N, Typ); - return; - else - Set_Etype (Def_Id, Entity (Element)); + begin + if No (Element) then + Error_Msg_NE ("cannot iterate over&", N, Typ); + return; + else + Set_Etype (Def_Id, Entity (Element)); - -- If subtype indication was given, verify that it matches - -- element type of container. + -- If subtype indication was given, verify that it + -- matches element type of container. - if Present (Subt) - and then Bas /= Base_Type (Etype (Def_Id)) - then - Error_Msg_N - ("subtype indication does not match element type", - Subt); - end if; + if Present (Subt) + and then Bas /= Base_Type (Etype (Def_Id)) + then + Error_Msg_N + ("subtype indication does not match element type", + Subt); + end if; - -- If the container has a variable indexing aspect, the - -- element is a variable and is modifiable in the loop. + -- If the container has a variable indexing aspect, the + -- element is a variable and is modifiable in the loop. - if Has_Aspect (Typ, Aspect_Variable_Indexing) then - Set_Ekind (Def_Id, E_Variable); + if Has_Aspect (Typ, Aspect_Variable_Indexing) then + Set_Ekind (Def_Id, E_Variable); + end if; end if; - end if; - end; + end; + end if; else -- For an iteration of the form IN, the name must denote an diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index a7d543e51ed..113678301a0 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -1235,64 +1235,34 @@ package body Sem_Prag is ----------------- procedure Usage_Error (Item : Node_Id; Item_Id : Entity_Id) is - Typ : constant Entity_Id := Etype (Item_Id); Error_Msg : Name_Id; begin - Name_Len := 0; - -- Input case if Is_Input then - Add_Item_To_Name_Buffer (Item_Id); - Add_Str_To_Name_Buffer - (" & must appear in at least one input dependence list " - & "(SPARK RM 6.1.5(8))"); - - Error_Msg := Name_Find; - Error_Msg_NE (Get_Name_String (Error_Msg), Item, Item_Id); - - -- Refine the error message for unconstrained parameters and - -- variables by giving the reason for the illegality. - - if Ekind (Item_Id) = E_Out_Parameter then - - -- Unconstrained arrays must appear as inputs because their - -- bounds must be read. - - if Is_Array_Type (Typ) - and then not Is_Constrained (Typ) - then - Error_Msg_NE - ("\\type & is an unconstrained array", Item, Typ); - Error_Msg_N ("\\array bounds must be read", Item); - -- Unconstrained discriminated records must appear as inputs - -- because their discriminants and constrained flag must be - -- read. + -- Unconstrained and tagged items are not part of the explicit + -- input set of the related subprogram, they do not have to be + -- present in a dependence relation and should not be flagged. - elsif Is_Record_Type (Typ) - and then Has_Discriminants (Typ) - and then not Is_Constrained (Typ) - then - Error_Msg_NE - ("\\type & is an unconstrained discriminated record", - Item, Typ); - Error_Msg_N - ("\\discriminants and constrained flag must be read", - Item); + if not Is_Unconstrained_Or_Tagged_Item (Item_Id) then + Name_Len := 0; - -- Not clear if there are other cases. Anyway, we will - -- simply ignore any other cases. + Add_Item_To_Name_Buffer (Item_Id); + Add_Str_To_Name_Buffer + (" & must appear in at least one input dependence list " + & "(SPARK RM 6.1.5(8))"); - else - null; - end if; + Error_Msg := Name_Find; + Error_Msg_NE (Get_Name_String (Error_Msg), Item, Item_Id); end if; -- Output case else + Name_Len := 0; + Add_Item_To_Name_Buffer (Item_Id); Add_Str_To_Name_Buffer (" & must appear in exactly one output dependence list " diff --git a/gcc/ada/switch-m.adb b/gcc/ada/switch-m.adb index 4f18ec11c54..c9ac972dda7 100644 --- a/gcc/ada/switch-m.adb +++ b/gcc/ada/switch-m.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2013, 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- -- @@ -310,6 +310,10 @@ package body Switch.M is else case Switch_Chars (Ptr) is + when 'A' => + Ptr := Ptr + 1; + Add_Switch_Component ("-gnateA"); + when 'D' => Storing (First_Stored + 1 .. First_Stored + Max - Ptr + 1) := @@ -319,16 +323,17 @@ package body Switch.M is First_Stored + Max - Ptr + 1)); Ptr := Max + 1; - when 'G' => - Ptr := Ptr + 1; - Add_Switch_Component ("-gnateG"); - - when 'I' => + when 'E' | 'F' | 'G' | 'S' | 'u' | 'V' | 'Y' => + Add_Switch_Component + ("-gnate" & Switch_Chars (Ptr)); Ptr := Ptr + 1; + when 'i' | 'I' => declare - First : constant Positive := Ptr - 1; + First : constant Positive := Ptr; begin + Ptr := Ptr + 1; + if Ptr <= Max and then Switch_Chars (Ptr) = '=' then @@ -376,10 +381,6 @@ package body Switch.M is return; - when 'S' => - Ptr := Ptr + 1; - Add_Switch_Component ("-gnateS"); - when others => Last := 0; return; -- 2.30.2