[multiple changes]

2014-02-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* 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  <schonberg@adacore.com>

	* sem_attr.adb: Add guard to preserve all errors.

2014-02-20  Vincent Celier  <celier@adacore.com>

	* 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  <schonberg@adacore.com>

	* 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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 68e414c..68bd269 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,35 @@
 2014-02-20  Hristian Kirtchev  <kirtchev@adacore.com>
 
+       * 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  <schonberg@adacore.com>
+
+       * sem_attr.adb: Add guard to preserve all errors.
+
+2014-02-20  Vincent Celier  <celier@adacore.com>
+
+       * 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  <schonberg@adacore.com>
+
+       * 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  <kirtchev@adacore.com>
+
        * sem_prag.adb (Add_Item_To_Name_Buffer): New routine.
        (Analyze_Contract_Case): Remove the use of
        "may". Replace "aspect Contract_Cases" to avoid categorization

diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 10b280c..df1f3f2 100644 (file)
--- 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);
+      --          <original loop statements>
+      --       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 f8a22cc..9146dc6 100644 (file)
--- 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 9b765f4..e5ea4ce 100644 (file)
--- 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 a7d543e..1136783 100644 (file)
--- 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 4f18ec1..c9ac972 100644 (file)
--- 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;