[multiple changes]

2012-10-29  Robert Dewar  <dewar@adacore.com>

	* sem_ch5.adb (Analyze_Loop_Statement): Add warning for identical
	inner/outer ranges.

2012-10-29  Robert Dewar  <dewar@adacore.com>

	* einfo.ads: Change terminology "present" to "defined" in talking
	about whether a given field is defined for a given entity kind.

2012-10-29  Bob Duff  <duff@adacore.com>

	* atree.ads: Minor comment fix.

2012-10-29  Bob Duff  <duff@adacore.com>

	* sem_ch13.adb (Replace_Type_Reference): Set_Comes_From_Source.
	Otherwise, the node is ignored by ASIS.
	* sem_ch5.adb: Minor reformatting.

2012-10-29  Thomas Quinot  <quinot@adacore.com>

	* exp_attr.adb, exp_dist.adb, exp_dist.ads (Build_To_Any_Call): Pass
	an explicit Loc parameter to set the source location of generated
	nodes.

2012-10-29  Tristan Gingold  <gingold@adacore.com>

	* exp_ch9.adb (Build_Task_Activation_Call): Do nothing on
	restricted profile.
	* bindgen.adb (System_Tasking_Restricted_Stages_Used): New variable.
	(Gen_Adainit): Declare and call Activate_Tasks when the above variable
	is set.
	(Resolve_Binder_Options): Set the variable.
	* rtsfind.ads (RE_Activate_Restricted_Tasks): Removed (now unused).
	* s-tarest.adb (Tasks_Activation_Chain): New variable.
	(Activate_Restricted_Tasks): Removed, and replaced by ...
	(Activate_Tasks): New procedure, to activate all tasks at
	the end of elaboration.
	(Create_Restricted_Tasks): Chain parameter is now unreferenced.	Put
	the created task on the Tasks_Activation_Chain list.
	* s-tarest.ads (Activate_Restricted_Tasks): Removed.
	(Activate_Tasks): Added.

2012-10-29  Gary Dismukes  <dismukes@adacore.com>

	* sem_res.adb (Resolve_If_Expression): Compare subtype of the 'then'
	expression against the subtype of the expression rather than comparing
	base types, same as is already done for the 'else' expression.

From-SVN: r192918

gcc/ada/ChangeLog

+2012-10-29  Robert Dewar  <dewar@adacore.com>
+
+	* sem_ch5.adb (Analyze_Loop_Statement): Add warning for identical
+	inner/outer ranges.
+
+2012-10-29  Robert Dewar  <dewar@adacore.com>
+
+	* einfo.ads: Change terminology "present" to "defined" in talking
+	about whether a given field is defined for a given entity kind.
+
+2012-10-29  Bob Duff  <duff@adacore.com>
+
+	* atree.ads: Minor comment fix.
+
+2012-10-29  Bob Duff  <duff@adacore.com>
+
+	* sem_ch13.adb (Replace_Type_Reference): Set_Comes_From_Source.
+	Otherwise, the node is ignored by ASIS.
+	* sem_ch5.adb: Minor reformatting.
+
+2012-10-29  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_attr.adb, exp_dist.adb, exp_dist.ads (Build_To_Any_Call): Pass
+	an explicit Loc parameter to set the source location of generated
+	nodes.
+
+2012-10-29  Tristan Gingold  <gingold@adacore.com>
+
+	* exp_ch9.adb (Build_Task_Activation_Call): Do nothing on
+	restricted profile.
+	* bindgen.adb (System_Tasking_Restricted_Stages_Used): New variable.
+	(Gen_Adainit): Declare and call Activate_Tasks when the above variable
+	is set.
+	(Resolve_Binder_Options): Set the variable.
+	* rtsfind.ads (RE_Activate_Restricted_Tasks): Removed (now unused).
+	* s-tarest.adb (Tasks_Activation_Chain): New variable.
+	(Activate_Restricted_Tasks): Removed, and replaced by ...
+	(Activate_Tasks): New procedure, to activate all tasks at
+	the end of elaboration.
+	(Create_Restricted_Tasks): Chain parameter is now unreferenced.	Put
+	the created task on the Tasks_Activation_Chain list.
+	* s-tarest.ads (Activate_Restricted_Tasks): Removed.
+	(Activate_Tasks): Added.
+
+2012-10-29  Gary Dismukes  <dismukes@adacore.com>
+
+	* sem_res.adb (Resolve_If_Expression): Compare subtype of the 'then'
+	expression against the subtype of the expression rather than comparing
+	base types, same as is already done for the 'else' expression.
+
 2012-10-29  Steve Baird  <baird@adacore.com>
 
 	* sem_ch13.adb (Analyze_Attribute_Definition_Clause): If CodePeer_Mode

gcc/ada/atree.ads

@@ -767,7 +767,7 @@ package Atree is
    --  Note that this routine is very rarely used, since usually the
    --  default mechanism provided sets the right value, but in some
    --  unusual cases, the value needs to be reset (e.g. when a source
-   --  node is copied, and the copy must not have Comes_From_Source set.
+   --  node is copied, and the copy must not have Comes_From_Source set).
 
    procedure Set_Has_Aspects (N : Node_Id; Val : Boolean := True);
    pragma Inline (Set_Has_Aspects);

gcc/ada/bindgen.adb

@@ -78,6 +78,12 @@ package body Bindgen is
    --  disallow the creation of new dispatching domains just before calling
    --  the main procedure from the environment task.
 
+   System_Tasking_Restricted_Stages_Used : Boolean := False;
+   --  Flag indicating whether the unit System.Tasking.Restricted.Stages is in
+   --  the closure of the partition. This is set by Resolve_Binder_Options,
+   --  and it used to call a routine to active all the tasks at the end of
+   --  the elaboration.
+
    Lib_Final_Built : Boolean := False;
    --  Flag indicating whether the finalize_library rountine has been built
 
@@ -534,6 +540,12 @@ package body Bindgen is
             WBI ("");
          end if;
 
+         if System_Tasking_Restricted_Stages_Used then
+            WBI ("      procedure Activate_Tasks;");
+            WBI ("      pragma Import (C, Activate_Tasks," &
+                 " ""__gnat_activate_tasks"");");
+         end if;
+
          WBI ("   begin");
 
          if Main_Priority /= No_Main_Priority then
@@ -625,6 +637,14 @@ package body Bindgen is
          WBI ("      pragma Import (C, Handler_Installed, " &
               """__gnat_handler_installed"");");
 
+         --  Import task activation procedure for ravenscar
+
+         if System_Tasking_Restricted_Stages_Used then
+            WBI ("      procedure Activate_Tasks;");
+            WBI ("      pragma Import (C, Activate_Tasks," &
+                 " ""__gnat_activate_tasks"");");
+         end if;
+
          --  The import of the soft link which performs library-level object
          --  finalization is not needed for VM targets; regular Ada is used in
          --  that case. For restricted run-time libraries (ZFP and Ravenscar)
@@ -945,6 +965,10 @@ package body Bindgen is
          WBI ("      Freeze_Dispatching_Domains;");
       end if;
 
+      if System_Tasking_Restricted_Stages_Used then
+         WBI ("      Activate_Tasks;");
+      end if;
+
       --  Case of main program is CIL function or procedure
 
       if VM_Target = CLI_Target
@@ -2863,6 +2887,12 @@ package body Bindgen is
          if OpenVMS_On_Target and then Name_Buffer (1 .. 5) = "dec%s" then
             With_DECGNAT := True;
          end if;
+
+         --  Likewise for the use of restricted tasking
+
+         if Name_Buffer (1 .. 34) = "system.tasking.restricted.stages%s" then
+            System_Tasking_Restricted_Stages_Used := True;
+         end if;
       end loop;
    end Resolve_Binder_Options;
 

gcc/ada/exp_attr.adb

@@ -5141,7 +5141,8 @@ package body Exp_Attr is
       begin
          Rewrite (N,
            Build_To_Any_Call
-             (Convert_To (P_Type,
+             (Loc,
+              Convert_To (P_Type,
               Relocate_Node (First (Exprs))), Decls));
          Insert_Actions (N, Decls);
          Analyze_And_Resolve (N, RTE (RE_Any));

gcc/ada/exp_ch9.adb

@@ -4817,6 +4817,13 @@ package body Exp_Ch9 is
       P     : Node_Id;
 
    begin
+      --  On restricted profile, all the tasks will be activated at the end
+      --  of the elaboration (Sequential elaboration policy).
+
+      if Restricted_Profile then
+         return;
+      end if;
+
       --  Get the activation chain entity. Except in the case of a package
       --  body, this is in the node that was passed. For a package body, we
       --  have to find the corresponding package declaration node.
@@ -4835,11 +4842,7 @@ package body Exp_Ch9 is
       end if;
 
       if Present (Chain) then
-         if Restricted_Profile then
-            Name := New_Reference_To (RTE (RE_Activate_Restricted_Tasks), Loc);
-         else
-            Name := New_Reference_To (RTE (RE_Activate_Tasks), Loc);
-         end if;
+         Name := New_Reference_To (RTE (RE_Activate_Tasks), Loc);
 
          Call :=
            Make_Procedure_Call_Statement (Loc,

gcc/ada/exp_dist.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -144,13 +144,14 @@ package Exp_Dist is
    --  declaration is appended to Decls.
 
    function Build_To_Any_Call
-     (N     : Node_Id;
+     (Loc   : Source_Ptr;
+      N     : Node_Id;
       Decls : List_Id) return Node_Id;
    --  Build call to To_Any attribute function with expression as actual
-   --  parameter. Decls is the declarations list for an appropriate
-   --  enclosing scope of the point where the call will be inserted; if
-   --  the To_Any attribute for Typ needs to be generated at this point,
-   --  its declaration is appended to Decls.
+   --  parameter. Loc is the reference location for generated nodes, Decls is
+   --  the declarations list for an appropriate enclosing scope of the point
+   --  where the call will be inserted; if the To_Any attribute for Typ needs
+   --  to be generated at this point, its declaration is appended to Decls.
 
    function Build_TypeCode_Call
      (Loc   : Source_Ptr;

gcc/ada/rtsfind.ads

@@ -1756,7 +1756,6 @@ package Rtsfind is
      RE_Timed_Task_Entry_Call,           -- System.Tasking.Rendezvous
      RE_Timed_Selective_Wait,            -- System.Tasking.Rendezvous
 
-     RE_Activate_Restricted_Tasks,       -- System.Tasking.Restricted.Stages
      RE_Complete_Restricted_Activation,  -- System.Tasking.Restricted.Stages
      RE_Create_Restricted_Task,          -- System.Tasking.Restricted.Stages
      RE_Complete_Restricted_Task,        -- System.Tasking.Restricted.Stages
@@ -3042,7 +3041,6 @@ package Rtsfind is
      RE_Timed_Task_Entry_Call            => System_Tasking_Rendezvous,
      RE_Timed_Selective_Wait             => System_Tasking_Rendezvous,
 
-     RE_Activate_Restricted_Tasks        => System_Tasking_Restricted_Stages,
      RE_Complete_Restricted_Activation   => System_Tasking_Restricted_Stages,
      RE_Create_Restricted_Task           => System_Tasking_Restricted_Stages,
      RE_Complete_Restricted_Task         => System_Tasking_Restricted_Stages,

gcc/ada/s-tarest.adb

@@ -70,6 +70,9 @@ package body System.Tasking.Restricted.Stages is
    use Task_Primitives.Operations;
    use Task_Info;
 
+   Tasks_Activation_Chain : Task_Id;
+   --  Chain of all the tasks to activate
+
    Global_Task_Lock : aliased System.Task_Primitives.RTS_Lock;
    --  This is a global lock; it is used to execute in mutual exclusion
    --  from all other tasks. It is only used by Task_Lock and Task_Unlock.
@@ -298,9 +301,9 @@ package body System.Tasking.Restricted.Stages is
    -- Restricted GNARLI --
    -----------------------
 
-   -------------------------------
-   -- Activate_Restricted_Tasks --
-   -------------------------------
+   --------------------
+   -- Activate_Tasks --
+   --------------------
 
    --  Note that locks of activator and activated task are both locked here.
    --  This is necessary because C.State and Self.Wait_Count have to be
@@ -308,9 +311,7 @@ package body System.Tasking.Restricted.Stages is
    --  created before the activated task. That satisfies our
    --  in-order-of-creation ATCB locking policy.
 
-   procedure Activate_Restricted_Tasks
-     (Chain_Access : Activation_Chain_Access)
-   is
+   procedure Activate_Tasks is
       Self_ID       : constant Task_Id := STPO.Self;
       C             : Task_Id;
       Activate_Prio : System.Any_Priority;
@@ -332,8 +333,7 @@ package body System.Tasking.Restricted.Stages is
       --  Activate all the tasks in the chain. Creation of the thread of
       --  control was deferred until activation. So create it now.
 
-      C := Chain_Access.T_ID;
-
+      C := Tasks_Activation_Chain;
       while C /= null loop
          if C.Common.State /= Terminated then
             pragma Assert (C.Common.State = Unactivated);
@@ -384,8 +384,8 @@ package body System.Tasking.Restricted.Stages is
 
       --  Remove the tasks from the chain
 
-      Chain_Access.T_ID := null;
-   end Activate_Restricted_Tasks;
+      Tasks_Activation_Chain := null;
+   end Activate_Tasks;
 
    ------------------------------------
    -- Complete_Restricted_Activation --
@@ -466,6 +466,8 @@ package body System.Tasking.Restricted.Stages is
       Task_Image    : String;
       Created_Task  : Task_Id)
    is
+      pragma Unreferenced (Chain);
+
       Self_ID       : constant Task_Id := STPO.Self;
       Base_Priority : System.Any_Priority;
       Base_CPU      : System.Multiprocessors.CPU_Range;
@@ -558,8 +560,8 @@ package body System.Tasking.Restricted.Stages is
       --  may be used by the operation of Ada code within the task.
 
       SSL.Create_TSD (Created_Task.Common.Compiler_Data);
-      Created_Task.Common.Activation_Link := Chain.T_ID;
-      Chain.T_ID := Created_Task;
+      Created_Task.Common.Activation_Link := Tasks_Activation_Chain;
+      Tasks_Activation_Chain := Created_Task;
    end Create_Restricted_Task;
 
    ---------------------------

gcc/ada/s-tarest.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  S p e c                                 --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL 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- --
@@ -175,20 +175,11 @@ package System.Tasking.Restricted.Stages is
    --
    --  This procedure can raise Storage_Error if the task creation fails
 
-   procedure Activate_Restricted_Tasks
-     (Chain_Access : Activation_Chain_Access);
-   --  Compiler interface only. Do not call from within the RTS.
-   --  This must be called by the creator of a chain of one or more new tasks,
-   --  to activate them. The chain is a linked list that up to this point is
-   --  only known to the task that created them, though the individual tasks
-   --  are already in the All_Tasks_List.
-   --
-   --  The compiler builds the chain in LIFO order (as a stack). Another
-   --  version of this procedure had code to reverse the chain, so as to
-   --  activate the tasks in the order of declaration. This might be nice, but
-   --  it is not needed if priority-based scheduling is supported, since all
-   --  the activated tasks synchronize on the activators lock before they start
-   --  activating and so they should start activating in priority order.
+   procedure Activate_Tasks;
+   pragma Export (C, Activate_Tasks, "__gnat_activate_tasks");
+   --  Binder interface only. Do not call from within the RTS. This must be
+   --  called an the end of the elaboration to activate all tasks, in order
+   --  to implement the sequential elaboration policy.
 
    procedure Complete_Restricted_Activation;
    --  Compiler interface only. Do not call from within the RTS. This should be
@@ -217,7 +208,7 @@ package System.Tasking.Restricted.Stages is
    --     restricted_terminated (t1._task_id)
 
    procedure Finalize_Global_Tasks;
-   --  This is needed to support the compiler interface; it will only be called
+   --  This is needed to support the compiler interface. It will only be called
    --  by the Environment task in the binder generated file (by adafinal).
    --  Instead, it will cause the Environment to block forever, since none of
    --  the dependent tasks are expected to terminate

gcc/ada/sem_ch13.adb

@@ -5032,7 +5032,8 @@ package body Sem_Ch13 is
          ----------------------------
 
          procedure Replace_Type_Reference (N : Node_Id) is
-            --  Use the Sloc of the usage name below, not the defining name
+            --  See comments in Add_Predicates.Replace_Type_Reference regarding
+            --  Sloc and Comes_From_Source.
          begin
             --  Invariant'Class, replace with T'Class (obj)
 
@@ -5055,6 +5056,8 @@ package body Sem_Ch13 is
                Set_Entity (N, Object_Entity);
                Set_Etype  (N, Typ);
             end if;
+
+            Set_Comes_From_Source (N, True);
          end Replace_Type_Reference;
 
       --  Start of processing for Add_Invariants
@@ -5442,6 +5445,11 @@ package body Sem_Ch13 is
 
             Set_Entity (N, Object_Entity);
             Set_Etype (N, Typ);
+
+            --  We want to treat the node as if it comes from source, so that
+            --  ASIS will not ignore it
+
+            Set_Comes_From_Source (N, True);
          end Replace_Type_Reference;
 
       --  Start of processing for Add_Predicates

gcc/ada/sem_ch5.adb

@@ -2626,6 +2626,56 @@ package body Sem_Ch5 is
       Push_Scope (Ent);
       Analyze_Iteration_Scheme (Iter);
 
+      --  Check for following case which merits a warning if the type E of is
+      --  a multi-dimensional array (and no explicit subscript ranges present).
+
+      --      for J in E'Range
+      --         for K in E'Range
+
+      if Present (Iter)
+        and then Present (Loop_Parameter_Specification (Iter))
+      then
+         declare
+            LPS : constant Node_Id := Loop_Parameter_Specification (Iter);
+            DSD : constant Node_Id :=
+                    Original_Node (Discrete_Subtype_Definition (LPS));
+         begin
+            if Nkind (DSD) = N_Attribute_Reference
+              and then Attribute_Name (DSD) = Name_Range
+              and then No (Expressions (DSD))
+            then
+               declare
+                  Typ : constant Entity_Id := Etype (Prefix (DSD));
+               begin
+                  if Is_Array_Type (Typ)
+                    and then Number_Dimensions (Typ) > 1
+                    and then Nkind (Parent (N)) = N_Loop_Statement
+                    and then Present (Iteration_Scheme (Parent (N)))
+                  then
+                     declare
+                        OIter : constant Node_Id :=
+                          Iteration_Scheme (Parent (N));
+                        OLPS  : constant Node_Id :=
+                          Loop_Parameter_Specification (OIter);
+                        ODSD  : constant Node_Id :=
+                          Original_Node (Discrete_Subtype_Definition (OLPS));
+                     begin
+                        if Nkind (ODSD) = N_Attribute_Reference
+                          and then Attribute_Name (ODSD) = Name_Range
+                          and then No (Expressions (ODSD))
+                          and then Etype (Prefix (ODSD)) = Typ
+                        then
+                           Error_Msg_Sloc := Sloc (ODSD);
+                           Error_Msg_N
+                             ("inner range same as outer range#?", DSD);
+                        end if;
+                     end;
+                  end if;
+               end;
+            end if;
+         end;
+      end if;
+
       --  Analyze the statements of the body except in the case of an Ada 2012
       --  iterator with the expander active. In this case the expander will do
       --  a rewrite of the loop into a while loop. We will then analyze the

gcc/ada/sem_res.adb

@@ -7155,12 +7155,13 @@ package body Sem_Res is
       Resolve (Then_Expr, Typ);
       Then_Typ := Etype (Then_Expr);
 
-      --  When the "then" expression is of a scalar type different from the
-      --  result type, then insert a conversion to ensure the generation of
-      --  a constraint check.
+      --  When the "then" expression is of a scalar subtype different from the
+      --  result subtype, then insert a conversion to ensure the generation of
+      --  a constraint check. The same is done for the else part below, again
+      --  comparing subtypes rather than base types.
 
       if Is_Scalar_Type (Then_Typ)
-        and then Base_Type (Then_Typ) /= Base_Type (Typ)
+        and then Then_Typ /= Typ
       then
          Rewrite (Then_Expr, Convert_To (Typ, Then_Expr));
          Analyze_And_Resolve (Then_Expr, Typ);