[multiple changes]

2011-12-21  Vincent Celier  <celier@adacore.com>

	* prj-nmsc.adb (Report_No_Sources): Remove argument Lang. Report
	no sources even for languages that are not allowed.
	(Add_Source): Get the source even when the language is not allowed.

2011-12-21  Robert Dewar  <dewar@adacore.com>

	* sem_ch6.adb (Process_Formals): Add defensive code.

2011-12-21  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch7.adb, sem_ch13.adb (Analyze_Package_Specification): Build the
	invariant procedure of a type declaration that is a completion and has
	aspect specifications.
	(Build_Invariant_Procedure): If the procedure is built for a
	type declaration that is a completion, analyze body expliitly
	because all private declarations have been already analyzed.

2011-12-21  Claire Dross  <dross@adacore.com>

	* a-cfdlli.adb, a-cfhase.adb, a-cforma.adb, a-cforse.adb,
	a-cofove.adb: Minor reformating on formal containers

2011-12-21  Vincent Celier  <celier@adacore.com>

	* makeutl.adb (Mains.Complete_Mains.Do_Complete): Remove
	any main that is not in the list of restricted languages.
	(Insert_Project_Sources.Do_Insert): Only add sources of languages
	in the list of restricted languages.

2011-12-21  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Valid_Conversion): A type conversion is valid when
	the target type is an anonymous access type and the operand is a
	rewriting of an allocator. The conversion is typically inserted
	when the designated type is an interface.

2011-12-21  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch9.adb (Establish_Task_Master): If the enclosing block
	has no declarations, create new declarative list for it.

2011-12-21  Matthew Heaney  <heaney@adacore.com>

	* a-rbtgbk.adb (Generic_Conditional_Insert): Fixed incorrect comment.

From-SVN: r182586

14 files changed, 180 insertions, 75 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index be29ee2..64de1d4 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,50 @@
+2011-12-21  Vincent Celier  <celier@adacore.com>
+
+	* prj-nmsc.adb (Report_No_Sources): Remove argument Lang. Report
+	no sources even for languages that are not allowed.
+	(Add_Source): Get the source even when the language is not allowed.
+
+2011-12-21  Robert Dewar  <dewar@adacore.com>
+
+	* sem_ch6.adb (Process_Formals): Add defensive code.
+
+2011-12-21  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch7.adb, sem_ch13.adb (Analyze_Package_Specification): Build the
+	invariant procedure of a type declaration that is a completion and has
+	aspect specifications.
+	(Build_Invariant_Procedure): If the procedure is built for a
+	type declaration that is a completion, analyze body expliitly
+	because all private declarations have been already analyzed.
+
+2011-12-21  Claire Dross  <dross@adacore.com>
+
+	* a-cfdlli.adb, a-cfhase.adb, a-cforma.adb, a-cforse.adb,
+	a-cofove.adb: Minor reformating on formal containers
+
+2011-12-21  Vincent Celier  <celier@adacore.com>
+
+	* makeutl.adb (Mains.Complete_Mains.Do_Complete): Remove
+	any main that is not in the list of restricted languages.
+	(Insert_Project_Sources.Do_Insert): Only add sources of languages
+	in the list of restricted languages.
+
+2011-12-21  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_res.adb (Valid_Conversion): A type conversion is valid when
+	the target type is an anonymous access type and the operand is a
+	rewriting of an allocator. The conversion is typically inserted
+	when the designated type is an interface.
+
+2011-12-21  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch9.adb (Establish_Task_Master): If the enclosing block
+	has no declarations, create new declarative list for it.
+
+2011-12-21  Matthew Heaney  <heaney@adacore.com>
+
+	* a-rbtgbk.adb (Generic_Conditional_Insert): Fixed incorrect comment.
+
 2011-12-21  Yannick Moy  <moy@adacore.com>
 
 	* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Do not
diff --git a/gcc/ada/a-cfdlli.adb b/gcc/ada/a-cfdlli.adb
index 80e6fc0..404c663 100644
--- a/gcc/ada/a-cfdlli.adb
+++ b/gcc/ada/a-cfdlli.adb
@@ -1403,15 +1403,7 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
       pragma Assert
         (Vet (Container, Position), "bad cursor in Replace_Element");
 
-      declare
-         N : Node_Array renames Container.Nodes;
-      begin
-         N (Position.Node).Element := New_Item;
-      end;
-
-      --  Above is peculiar, why not simply
-      --  Container.Nodes (Position.Node).Element := New_Item ???
-
+      Container.Nodes (Position.Node).Element := New_Item;
    end Replace_Element;
 
    ----------------------
diff --git a/gcc/ada/a-cfhase.adb b/gcc/ada/a-cfhase.adb
index 164433e..fe6706b 100644
--- a/gcc/ada/a-cfhase.adb
+++ b/gcc/ada/a-cfhase.adb
@@ -1471,7 +1471,6 @@ package body Ada.Containers.Formal_Hashed_Sets is
       --  Start of processing for Union
 
    begin
-
       if Target'Address = Source'Address then
          return;
       end if;
@@ -1646,7 +1645,6 @@ package body Ada.Containers.Formal_Hashed_Sets is
          X : Count_Type;
 
       begin
-
          Key_Keys.Delete_Key_Sans_Free (Container, Key, X);
 
          if X = 0 then
@@ -1768,7 +1766,6 @@ package body Ada.Containers.Formal_Hashed_Sets is
          N    : Nodes_Type renames Container.Nodes;
 
       begin
-
          if Position.Node = 0 then
             raise Constraint_Error with
               "Position cursor equals No_Element";
diff --git a/gcc/ada/a-cforma.adb b/gcc/ada/a-cforma.adb
index d102a3d..ce361a1 100644
--- a/gcc/ada/a-cforma.adb
+++ b/gcc/ada/a-cforma.adb
@@ -1025,7 +1025,6 @@ package body Ada.Containers.Formal_Ordered_Maps is
                                              Element : Element_Type))
    is
    begin
-
       if not Has_Element (Container, Position) then
          raise Constraint_Error with
            "Position cursor of Query_Element has no element";
diff --git a/gcc/ada/a-cforse.adb b/gcc/ada/a-cforse.adb
index 794b47b..9872f2c 100644
--- a/gcc/ada/a-cforse.adb
+++ b/gcc/ada/a-cforse.adb
@@ -452,11 +452,7 @@ package body Ada.Containers.Formal_Ordered_Sets is
       pragma Assert (Vet (Container, Position.Node),
                      "bad cursor in Element");
 
-      declare
-         N : Tree_Types.Nodes_Type renames Container.Nodes;
-      begin
-         return N (Position.Node).Element;
-      end;
+      return Container.Nodes (Position.Node).Element;
    end Element;
 
    -------------------------
diff --git a/gcc/ada/a-cofove.adb b/gcc/ada/a-cofove.adb
index 3533c2a..8900e05 100644
--- a/gcc/ada/a-cofove.adb
+++ b/gcc/ada/a-cofove.adb
@@ -540,7 +540,6 @@ package body Ada.Containers.Formal_Vectors is
       Last : constant Index_Type := Last_Index (Container);
 
    begin
-
       K := Count_Type (Int (Index) - Int (No_Index));
       for Indx in Index .. Last loop
          if Get_Element (Container, K) = Item then
@@ -628,7 +627,6 @@ package body Ada.Containers.Formal_Vectors is
 
       procedure Merge (Target, Source : in out Vector) is
       begin
-
          declare
             TA : Elements_Array renames Target.Elements;
             SA : Elements_Array renames Source.Elements;
@@ -1326,7 +1324,6 @@ package body Ada.Containers.Formal_Vectors is
       N : constant Count_Type := Length (Source);
 
    begin
-
       if Target'Address = Source'Address then
          return;
       end if;
@@ -1543,7 +1540,6 @@ package body Ada.Containers.Formal_Vectors is
       New_Item  : Element_Type)
    is
    begin
-
       if Index > Container.Last then
          raise Constraint_Error with "Index is out of range";
       end if;
@@ -1568,7 +1564,6 @@ package body Ada.Containers.Formal_Vectors is
       New_Item  : Element_Type)
    is
    begin
-
       if not Position.Valid then
          raise Constraint_Error with "Position cursor has no element";
       end if;
@@ -1932,7 +1927,6 @@ package body Ada.Containers.Formal_Vectors is
       L : Natural renames Container.Lock;
 
    begin
-
       if Index > Container.Last then
          raise Constraint_Error with "Index is out of range";
       end if;
diff --git a/gcc/ada/a-rbtgbk.adb b/gcc/ada/a-rbtgbk.adb
index b12ae84..e270abf 100644
--- a/gcc/ada/a-rbtgbk.adb
+++ b/gcc/ada/a-rbtgbk.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, 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- --
@@ -140,8 +140,22 @@ package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Keys is
       N : Nodes_Type renames Tree.Nodes;
 
    begin
-      Y := 0;
+      --  This is a "conditional" insertion, meaning that the insertion request
+      --  can "fail" in the sense that no new node is created. If the Key is
+      --  equivalent to an existing node, then we return the existing node and
+      --  Inserted is set to False. Otherwise, we allocate a new node (via
+      --  Insert_Post) and Inserted is set to True.
+
+      --  Note that we are testing for equivalence here, not equality. Key must
+      --  be strictly less than its next neighbor, and strictly greater than
+      --  its previous neighbor, in order for the conditional insertion to
+      --  succeed.
+
+      --  We search the tree to find the nearest neighbor of Key, which is
+      --  either the smallest node greater than Key (Inserted is True), or the
+      --  largest node less or equivalent to Key (Inserted is False).
 
+      Y := 0;
       X := Tree.Root;
       Inserted := True;
       while X /= 0 loop
@@ -150,33 +164,50 @@ package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Keys is
          X := (if Inserted then Ops.Left (N (X)) else Ops.Right (N (X)));
       end loop;
 
-      --  If Inserted is True, then this means either that Tree is
-      --  empty, or there was a least one node (strictly) greater than
-      --  Key. Otherwise, it means that Key is equal to or greater than
-      --  every node.
-
       if Inserted then
+
+         --  Either Tree is empty, or Key is less than Y. If Y is the first
+         --  node in the tree, then there are no other nodes that we need to
+         --  search for, and we insert a new node into the tree.
+
          if Y = Tree.First then
             Insert_Post (Tree, Y, True, Node);
             return;
          end if;
 
+         --  Y is the next nearest-neighbor of Key. We know that Key is not
+         --  equivalent to Y (because Key is strictly less than Y), so we move
+         --  to the previous node, the nearest-neighbor just smaller or
+         --  equivalent to Key.
+
          Node := Ops.Previous (Tree, Y);
 
       else
+         --  Y is the previous nearest-neighbor of Key. We know that Key is not
+         --  less than Y, which means either that Key is equivalent to Y, or
+         --  greater than Y.
+
          Node := Y;
       end if;
 
-      --  Here Node has a value that is less than or equal to Key. We
-      --  now have to resolve whether Key is equal to or greater than
-      --  Node, which determines whether the insertion succeeds.
+      --  Key is equivalent to or greater than Node. We must resolve which is
+      --  the case, to determine whether the conditional insertion succeeds.
 
       if Is_Greater_Key_Node (Key, N (Node)) then
+
+         --  Key is strictly greater than Node, which means that Key is not
+         --  equivalent to Node. In this case, the insertion succeeds, and we
+         --  insert a new node into the tree.
+
          Insert_Post (Tree, Y, Inserted, Node);
          Inserted := True;
          return;
       end if;
 
+      --  Key is equivalent to Node. This is a conditional insertion, so we do
+      --  not insert a new node in this case. We return the existing node and
+      --  report that no insertion has occurred.
+
       Inserted := False;
    end Generic_Conditional_Insert;
 
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 8305278..8cd39b9 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -5086,10 +5086,21 @@ package body Exp_Ch9 is
 
    procedure Establish_Task_Master (N : Node_Id) is
       Call : Node_Id;
+
    begin
       if Restriction_Active (No_Task_Hierarchy) = False then
          Call := Build_Runtime_Call (Sloc (N), RE_Enter_Master);
-         Prepend_To (Declarations (N), Call);
+
+         --  The block may have no declarations, and nevertheless be a task
+         --  master, if it contains a call that may return an object that
+         --  contains tasks.
+
+         if No (Declarations (N)) then
+            Set_Declarations (N, New_List (Call));
+         else
+            Prepend_To (Declarations (N), Call);
+         end if;
+
          Analyze (Call);
       end if;
    end Establish_Task_Master;
diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb
index f09c0ad..119bcbd 100644
--- a/gcc/ada/makeutl.adb
+++ b/gcc/ada/makeutl.adb
@@ -1539,6 +1539,8 @@ package body Makeutl is
          procedure Do_Complete
            (Project : Project_Id; Tree : Project_Tree_Ref)
          is
+            J : Integer;
+
          begin
             if Mains.Number_Of_Mains (Tree) > 0
               or else Mains.Count_Of_Mains_With_No_Tree > 0
@@ -1547,7 +1549,8 @@ package body Makeutl is
                --  files we will be adding extra files at the end, and there's
                --  no need to process them in turn.
 
-               for J in reverse Names.First .. Names.Last loop
+               J := Names.Last;
+               loop
                   declare
                      File        : Main_Info       := Names.Table (J);
                      Main_Id     : File_Name_Type  := File.File;
@@ -1637,35 +1640,47 @@ package body Makeutl is
                         end if;
 
                         if Source /= No_Source then
+                           if not Is_Allowed_Language
+                                    (Source.Language.Name)
+                           then
+                              --  Remove any main that is not in the list of
+                              --  restricted languages.
 
-                           --  If we have found a multi-unit source file but
-                           --  did not specify an index initially, we'll need
-                           --  to compile all the units from the same source
-                           --  file.
+                              Names.Table (J .. Names.Last - 1) :=
+                                Names.Table (J + 1 .. Names.Last);
+                              Names.Set_Last (Names.Last - 1);
 
-                           if Source.Index /= 0 and then File.Index = 0 then
-                              Add_Multi_Unit_Sources (File.Tree, Source);
-                           end if;
+                           else
+                              --  If we have found a multi-unit source file but
+                              --  did not specify an index initially, we'll
+                              --  need to compile all the units from the same
+                              --  source file.
 
-                           --  Now update the original Main, otherwise it will
-                           --  be reported as not found.
+                              if Source.Index /= 0 and then File.Index = 0 then
+                                 Add_Multi_Unit_Sources (File.Tree, Source);
+                              end if;
 
-                           Debug_Output
-                             ("found main in project", Source.Project.Name);
-                           Names.Table (J).File    := Source.File;
-                           Names.Table (J).Project := Source.Project;
+                              --  Now update the original Main, otherwise it
+                              --  will be reported as not found.
 
-                           if Names.Table (J).Tree = null then
-                              Names.Table (J).Tree := File.Tree;
+                              Debug_Output
+                                ("found main in project", Source.Project.Name);
+                              Names.Table (J).File    := Source.File;
+                              Names.Table (J).Project := Source.Project;
 
-                              Builder_Data (File.Tree).Number_Of_Mains :=
-                                Builder_Data (File.Tree).Number_Of_Mains + 1;
-                              Mains.Count_Of_Mains_With_No_Tree :=
-                                Mains.Count_Of_Mains_With_No_Tree - 1;
-                           end if;
+                              if Names.Table (J).Tree = null then
+                                 Names.Table (J).Tree := File.Tree;
 
-                           Names.Table (J).Source  := Source;
-                           Names.Table (J).Index   := Source.Index;
+                                 Builder_Data (File.Tree).Number_Of_Mains :=
+                                   Builder_Data (File.Tree).Number_Of_Mains
+                                                                         + 1;
+                                 Mains.Count_Of_Mains_With_No_Tree :=
+                                   Mains.Count_Of_Mains_With_No_Tree - 1;
+                              end if;
+
+                              Names.Table (J).Source  := Source;
+                              Names.Table (J).Index   := Source.Index;
+                           end if;
 
                         elsif File.Location /= No_Location then
 
@@ -1684,6 +1699,9 @@ package body Makeutl is
                         end if;
                      end if;
                   end;
+
+                  J := J - 1;
+                  exit when J < Names.First;
                end loop;
             end if;
 
@@ -2781,10 +2799,11 @@ package body Makeutl is
                Source := Prj.Element (Iter);
                exit when Source = No_Source;
 
-               if Is_Compilable (Source)
+               if Is_Allowed_Language (Source.Language.Name)
+                 and then Is_Compilable (Source)
                  and then
                    (All_Projects
-                    or else Is_Extending (Project, Source.Project))
+                     or else Is_Extending (Project, Source.Project))
                  and then not Source.Locally_Removed
                  and then Source.Replaced_By = No_Source
                  and then
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index 3e86850..c3cb4b6 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -486,7 +486,6 @@ package body Prj.Nmsc is
 
    procedure Report_No_Sources
      (Project      : Project_Id;
-      Lang         : Name_Id;
       Lang_Name    : String;
       Data         : Tree_Processing_Data;
       Location     : Source_Ptr;
@@ -643,13 +642,6 @@ package body Prj.Nmsc is
       Source_To_Replace : Source_Id := No_Source;
 
    begin
-      --  Nothing to do if the language is not one of the restricted ones
-
-      if not Is_Allowed_Language (Lang_Id.Name) then
-         Id := No_Source;
-         return;
-      end if;
-
       --  Check if the same file name or unit is used in the prj tree
 
       Add_Src := True;
@@ -7809,7 +7801,6 @@ package body Prj.Nmsc is
                   if Source = No_Source then
                      Report_No_Sources
                        (Project.Project,
-                        Language.Name,
                         Get_Name_String (Language.Display_Name),
                         Data,
                         Project.Source_List_File_Location,
@@ -8256,15 +8247,13 @@ package body Prj.Nmsc is
 
    procedure Report_No_Sources
      (Project      : Project_Id;
-      Lang         : Name_Id;
       Lang_Name    : String;
       Data         : Tree_Processing_Data;
       Location     : Source_Ptr;
       Continuation : Boolean := False)
    is
    begin
-      if Is_Allowed_Language (Lang) then
-         case Data.Flags.When_No_Sources is
+      case Data.Flags.When_No_Sources is
          when Silent =>
             null;
 
@@ -8283,8 +8272,7 @@ package body Prj.Nmsc is
                   Error_Msg (Data.Flags, Msg, Location, Project);
                end if;
             end;
-         end case;
-      end if;
+      end case;
    end Report_No_Sources;
 
    ----------------------
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index e6b016d..6ffe9f2 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -4738,6 +4738,14 @@ package body Sem_Ch13 is
             --  (this is an error that will be caught elsewhere);
 
             Append_To (Private_Decls, PBody);
+
+            --  If the invariant appears on the full view of a type, the
+            --  analysis of the private part is complete, and we must
+            --  analyze the new body explicitly.
+
+            if In_Private_Part (Current_Scope) then
+               Analyze (PBody);
+            end if;
          end if;
       end if;
    end Build_Invariant_Procedure;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 1df3737..4286c0d 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -9552,6 +9552,12 @@ package body Sem_Ch6 is
             Num_Out_Params := Num_Out_Params + 1;
          end if;
 
+         --  Skip remaining processing if formal type was in error
+
+         if Etype (Formal) = Any_Type or else Error_Posted (Formal) then
+            goto Next_Parameter;
+         end if;
+
          --  Force call by reference if aliased
 
          if Is_Aliased (Formal) then
@@ -9573,6 +9579,7 @@ package body Sem_Ch6 is
             Set_Mechanism (Formal, By_Reference);
          end if;
 
+      <<Next_Parameter>>
          Next (Param_Spec);
       end loop;
 
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index 2f87cf0..094837b 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -1378,6 +1378,16 @@ package body Sem_Ch7 is
               ("full view of & does not have preelaborable initialization", E);
          end if;
 
+         --  An invariant may appear on a full view of a type
+
+         if Is_Type (E)
+           and then Has_Private_Declaration (E)
+           and then Nkind (Parent (E)) = N_Full_Type_Declaration
+           and then Has_Aspects (Parent (E))
+         then
+            Build_Invariant_Procedure (E, N);
+         end if;
+
          Next_Entity (E);
       end loop;
 
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index f172485..c25a305 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -10719,7 +10719,13 @@ package body Sem_Res is
          --  check is not enforced when within an instance body, since the
          --  RM requires such cases to be caught at run time.
 
-         if Ekind (Target_Type) /= E_Anonymous_Access_Type then
+         --  If the operand is a rewriting of an allocator no check is needed
+         --  because there are no accessibility issues.
+
+         if Nkind (Original_Node (N)) = N_Allocator then
+            null;
+
+         elsif Ekind (Target_Type) /= E_Anonymous_Access_Type then
             if Type_Access_Level (Opnd_Type) >
                Deepest_Type_Access_Level (Target_Type)
             then