[multiple changes]

2014-01-31  Robert Dewar  <dewar@adacore.com>

	* exp_ch9.adb, s-tassta.adb, s-tposen.adb, s-tposen.ads: Minor
	reformatting.

2014-01-31  Tristan Gingold  <gingold@adacore.com>

	* exp_disp.adb: Add a historic note.

2014-01-31  Robert Dewar  <dewar@adacore.com>

	* sem_warn.adb (Warn_On_Useless_Assignments): Add call to
	Process_Deferred_References.

2014-01-31  Yannick Moy  <moy@adacore.com>

	* erroutc.adb (Validate_Specific_Warnings): Do not issue a message for
	ineffective pragma Warnings(Off) in GNATprove_Mode.

From-SVN: r207351

8 files changed, 97 insertions, 67 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 82247a0..aa97665 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,22 @@
+2014-01-31  Robert Dewar  <dewar@adacore.com>
+
+	* exp_ch9.adb, s-tassta.adb, s-tposen.adb, s-tposen.ads: Minor
+	reformatting.
+
+2014-01-31  Tristan Gingold  <gingold@adacore.com>
+
+	* exp_disp.adb: Add a historic note.
+
+2014-01-31  Robert Dewar  <dewar@adacore.com>
+
+	* sem_warn.adb (Warn_On_Useless_Assignments): Add call to
+	Process_Deferred_References.
+
+2014-01-31  Yannick Moy  <moy@adacore.com>
+
+	* erroutc.adb (Validate_Specific_Warnings): Do not issue a message for
+	ineffective pragma Warnings(Off) in GNATprove_Mode.
+
 2014-01-31  Bob Duff  <duff@adacore.com>
 
 	* s-taskin.ads: Minor comment fix.
diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index 6924ce2..f70fc60 100644
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.adb
@@ -1318,6 +1318,13 @@ package body Erroutc is
 
                elsif not SWE.Used
 
+                 --  Do not issue this warning in GNATprove_Mode, as not
+                 --  all warnings may be generated in this mode, and pragma
+                 --  Warnings(Off) may correspond to warnings generated by the
+                 --  formal verification backend instead of frontend warnings.
+
+                 and then not GNATprove_Mode
+
                  --  Do not issue this warning for -Wxxx messages since the
                  --  back-end doesn't report the information.
 
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 078e836..1f9e05b 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -4723,7 +4723,6 @@ package body Exp_Ch9 is
 
             Actual := First_Actual (N);
             Formal := First_Formal (Ent);
-
             while Present (Actual) loop
 
                --  If it is a by_copy_type, copy it to a new variable. The
@@ -4786,7 +4785,7 @@ package body Exp_Ch9 is
                   Append_To (Plist,
                     Make_Attribute_Reference (Loc,
                       Attribute_Name => Name_Unchecked_Access,
-                    Prefix =>
+                    Prefix           =>
                       New_Reference_To (Defining_Identifier (N_Node), Loc)));
 
                else
@@ -4834,9 +4833,9 @@ package body Exp_Ch9 is
             Pdecl :=
               Make_Object_Declaration (Loc,
                 Defining_Identifier => P,
-                Object_Definition =>
+                Object_Definition   =>
                   New_Reference_To (Designated_Type (Ent_Acc), Loc),
-                Expression =>
+                Expression          =>
                   Make_Aggregate (Loc, Expressions => Plist));
 
             Parm3 :=
@@ -5064,8 +5063,8 @@ package body Exp_Ch9 is
          else
             if Present (Handled_Statement_Sequence (N)) then
 
-               --  The call goes at the start of the statement sequence
-               --  after the start of exception range label if one is present.
+               --  The call goes at the start of the statement sequence after
+               --  the start of exception range label if one is present.
 
                declare
                   Stm : Node_Id;
@@ -5106,7 +5105,7 @@ package body Exp_Ch9 is
             else
                Set_Handled_Statement_Sequence (N,
                   Make_Handled_Sequence_Of_Statements (Loc,
-                     Statements => New_List (Call)));
+                    Statements => New_List (Call)));
             end if;
          end if;
 
@@ -5151,13 +5150,13 @@ package body Exp_Ch9 is
 
               Statements => New_List (
 
-               --  Init (Args);
+                --  Init (Args);
 
                 Make_Procedure_Call_Statement (Loc,
-                  Name => New_Reference_To (Init, Loc),
+                  Name                   => New_Reference_To (Init, Loc),
                   Parameter_Associations => Args),
 
-               --  Activate_Tasks (_Chain);
+                --  Activate_Tasks (_Chain);
 
                 Make_Procedure_Call_Statement (Loc,
                   Name => New_Reference_To (RTE (RE_Activate_Tasks), Loc),
@@ -5212,7 +5211,7 @@ package body Exp_Ch9 is
 
             Make_Object_Declaration (Loc,
               Defining_Identifier => Chain,
-              Aliased_Present => True,
+              Aliased_Present     => True,
               Object_Definition   =>
                 New_Reference_To (RTE (RE_Activation_Chain), Loc))),
 
@@ -5245,15 +5244,13 @@ package body Exp_Ch9 is
 
       if Comes_From_Source (T) then
          Spec_Id :=
-           Make_Defining_Identifier (Loc,
-             Chars => New_External_Name (Chars (T), "TB"));
+           Make_Defining_Identifier (Loc, New_External_Name (Chars (T), "TB"));
 
       --  Case of anonymous task type, suffix B
 
       else
          Spec_Id :=
-           Make_Defining_Identifier (Loc,
-             Chars => New_External_Name (Chars (T), 'B'));
+           Make_Defining_Identifier (Loc, New_External_Name (Chars (T), 'B'));
       end if;
 
       Set_Is_Internal (Spec_Id);
@@ -5382,7 +5379,7 @@ package body Exp_Ch9 is
 
             Append_To (Cdecls,
               Make_Component_Declaration (Loc,
-                Defining_Identifier =>
+                Defining_Identifier  =>
                   Make_Defining_Identifier (Loc, Chars (Efam)),
 
                 Component_Definition =>
@@ -5393,12 +5390,12 @@ package body Exp_Ch9 is
                         Subtype_Mark =>
                           New_Occurrence_Of (Efam_Type, Loc),
 
-                        Constraint  =>
+                        Constraint   =>
                           Make_Index_Or_Discriminant_Constraint (Loc,
                             Constraints => New_List (
                               New_Occurrence_Of
                                 (Etype (Discrete_Subtype_Definition
-                                  (Parent (Efam))), Loc)))))));
+                                          (Parent (Efam))), Loc)))))));
 
          end if;
 
@@ -5528,9 +5525,7 @@ package body Exp_Ch9 is
             --  assume that it can be called from an inner task, and therefore
             --  cannot treat it as a local reference.
 
-            elsif Is_Overloadable (Scop)
-              and then In_Open_Scopes (T)
-            then
+            elsif Is_Overloadable (Scop) and then In_Open_Scopes (T) then
                return False;
 
             else
@@ -5558,7 +5553,7 @@ package body Exp_Ch9 is
 
          return
            Make_Selected_Component (Loc,
-             Prefix =>
+             Prefix        =>
                Unchecked_Convert_To (Corresponding_Record_Type (Dtyp),
                  Make_Explicit_Dereference (Loc, N)),
              Selector_Name => Make_Identifier (Loc, Sel));
@@ -5820,8 +5815,8 @@ package body Exp_Ch9 is
       if Restriction_Active (No_Task_Hierarchy) = False then
          Call := Build_Runtime_Call (Sloc (N), RE_Enter_Master);
 
-         --  The block may have no declarations, and nevertheless be a task
-         --  master, if it contains a call that may return an object that
+         --  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
@@ -5993,10 +5988,10 @@ package body Exp_Ch9 is
                   Next (Alt);
                end loop;
 
-               --  If we are the first accept statement, then we have to create
-               --  the Ann variable, as for the stand alone case, except that
-               --  it is inserted before the selective accept. Similarly, a
-               --  label for requeue expansion must be declared.
+               --  If this is the first accept statement, then we have to
+               --  create the Ann variable, as for the stand alone case, except
+               --  that it is inserted before the selective accept. Similarly,
+               --  a label for requeue expansion must be declared.
 
                if N = Accept_Statement (Alt) then
                   Ann := Make_Temporary (Loc, 'A');
@@ -6008,7 +6003,7 @@ package body Exp_Ch9 is
 
                   Insert_Before_And_Analyze (Sel_Acc, Adecl);
 
-               --  If we are not the first accept statement, then find the Ann
+               --  If this is not the first accept statement, then find the Ann
                --  variable allocated by the first accept and use it.
 
                else
@@ -6227,7 +6222,7 @@ package body Exp_Ch9 is
       --  The Ravenscar profile restricts barriers to simple variables declared
       --  within the protected object. We also allow Boolean constants, since
       --  these appear in several published examples and are also allowed by
-      --  the Aonix compiler.
+      --  other compilers.
 
       --  Note that after analysis variables in this context will be replaced
       --  by the corresponding prival, that is to say a renaming of a selected
@@ -6300,8 +6295,8 @@ package body Exp_Ch9 is
       while Present (Tasknm) loop
          Count := Count + 1;
 
-         --  A task interface class-wide type object is being aborted.
-         --  Retrieve its _task_id by calling a dispatching routine.
+         --  A task interface class-wide type object is being aborted. Retrieve
+         --  its _task_id by calling a dispatching routine.
 
          if Ada_Version >= Ada_2005
            and then Ekind (Etype (Tasknm)) = E_Class_Wide_Type
@@ -6349,14 +6344,14 @@ package body Exp_Ch9 is
    -- Expand_N_Accept_Statement --
    -------------------------------
 
-   --  This procedure handles expansion of accept statements that stand
-   --  alone, i.e. they are not part of an accept alternative. The expansion
-   --  of accept statement in accept alternatives is handled by the routines
+   --  This procedure handles expansion of accept statements that stand alone,
+   --  i.e. they are not part of an accept alternative. The expansion of
+   --  accept statement in accept alternatives is handled by the routines
    --  Expand_N_Accept_Alternative and Expand_N_Selective_Accept. The
    --  following description applies only to stand alone accept statements.
 
-   --  If there is no handled statement sequence, or only null statements,
-   --  then this is called a trivial accept, and the expansion is:
+   --  If there is no handled statement sequence, or only null statements, then
+   --  this is called a trivial accept, and the expansion is:
 
    --    Accept_Trivial (entry-index)
 
@@ -6399,7 +6394,7 @@ package body Exp_Ch9 is
    --  an accept statement has no declarative part). In particular, if the
    --  expander is active, the first such declaration is the declaration of
    --  the Accept_Params_Ptr entity (see Sem_Ch9.Analyze_Accept_Statement).
-   --
+
    --  The two blocks are merged into a single block if the inner block has
    --  no exception handlers, but otherwise two blocks are required, since
    --  exceptions might be raised in the exception handlers of the inner
@@ -6443,7 +6438,6 @@ package body Exp_Ch9 is
 
          begin
             D := First (Declarations (N));
-
             while Present (D) loop
                Next_D := Next (D);
                if Nkind (D) = N_Object_Renaming_Declaration then
@@ -6806,8 +6800,8 @@ package body Exp_Ch9 is
 
    --  The job is to convert this to the asynchronous form
 
-   --  If the trigger is a delay statement, it will have been expanded into a
-   --  call to one of the GNARL delay procedures. This routine will convert
+   --  If the trigger is a delay statement, it will have been expanded into
+   --  a call to one of the GNARL delay procedures. This routine will convert
    --  this into a protected entry call on a delay object and then continue
    --  processing as for a protected entry call trigger. This requires
    --  declaring a Delay_Block object and adding a pointer to this object to
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index b0660fc..33275d5 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -3522,6 +3522,13 @@ package body Exp_Disp is
             --  the wrapped parameters, D is the delay amount, M is the delay
             --  mode and F is the status flag.
 
+            --  Historically, there was also an implementation for single
+            --  entry protected types (in s-tposen). However, it was removed
+            --  by also testing for no No_Select_Statements restriction in
+            --  Exp_Utils.Corresponding_Runtime_Package. This simplified the
+            --  implementation of s-tposen, which was initially created for
+            --  the Ravenscar profile.
+
             case Corresponding_Runtime_Package (Conc_Typ) is
                when System_Tasking_Protected_Objects_Entries =>
                   Append_To (Stmts,
diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb
index 4925906..58e8f98 100644
--- a/gcc/ada/s-tassta.adb
+++ b/gcc/ada/s-tassta.adb
@@ -150,14 +150,14 @@ package body System.Tasking.Stages is
       C : Task_Id;
       P : Task_Id;
 
-      --  Each task C will take care of its own dependents, so there is no need
-      --  to worry about them here. In fact, it would be wrong to abort
+      --  Each task C will take care of its own dependents, so there is no
+      --  need to worry about them here. In fact, it would be wrong to abort
       --  indirect dependents here, because we can't distinguish between
-      --  duplicate master ids. For example, suppose we have three nested task
-      --  bodies T1,T2,T3. And suppose T1 also calls P which calls Q (and both
-      --  P and Q are task masters). Q will have the same master id as
-      --  Master_of_Task of T3. Previous versions of this would abort T3 when Q
-      --  calls Complete_Master, which was completely wrong.
+      --  duplicate master ids. For example, suppose we have three nested
+      --  task bodies T1,T2,T3. And suppose T1 also calls P which calls Q (and
+      --  both P and Q are task masters). Q will have the same master id as
+      --  Master_of_Task of T3. Previous versions of this would abort T3 when
+      --  Q calls Complete_Master, which was completely wrong.
 
    begin
       C := All_Tasks_List;
diff --git a/gcc/ada/s-tposen.adb b/gcc/ada/s-tposen.adb
index 697ee9d..4487c5e 100644
--- a/gcc/ada/s-tposen.adb
+++ b/gcc/ada/s-tposen.adb
@@ -54,7 +54,7 @@ pragma Style_Checks (All_Checks);
 
 pragma Polling (Off);
 --  Turn off polling, we do not want polling to take place during tasking
---  operations. It can cause  infinite loops and other problems.
+--  operations. It can cause infinite loops and other problems.
 
 pragma Suppress (All_Checks);
 --  Why is this required ???
@@ -84,10 +84,9 @@ package body System.Tasking.Protected_Objects.Single_Entry is
 
    procedure Wakeup_Entry_Caller (Entry_Call : Entry_Call_Link);
    pragma Inline (Wakeup_Entry_Caller);
-   --  This is called at the end of service of an entry call,
-   --  to abort the caller if he is in an abortable part, and
-   --  to wake up the caller if he is on Entry_Caller_Sleep.
-   --  Call it holding the lock of Entry_Call.Self.
+   --  This is called at the end of service of an entry call, to abort the
+   --  caller if he is in an abortable part, and to wake up the caller if he
+   --  is on Entry_Caller_Sleep. Call it holding the lock of Entry_Call.Self.
 
    procedure Wait_For_Completion (Entry_Call : Entry_Call_Link);
    pragma Inline (Wait_For_Completion);
@@ -100,17 +99,16 @@ package body System.Tasking.Protected_Objects.Single_Entry is
      (Self_ID : Task_Id;
       Entry_Call : Entry_Call_Link);
    pragma Inline (Check_Exception);
-   --  Raise any pending exception from the Entry_Call.
-   --  This should be called at the end of every compiler interface procedure
-   --  that implements an entry call.
-   --  The caller should not be holding any locks, or there will be deadlock.
+   --  Raise any pending exception from the Entry_Call. This should be called
+   --  at the end of every compiler interface procedure that implements an
+   --  entry call. The caller should not be holding any locks, or there will
+   --  be deadlock.
 
    procedure PO_Do_Or_Queue
      (Object     : Protection_Entry_Access;
       Entry_Call : Entry_Call_Link);
-   --  This procedure executes or queues an entry call, depending
-   --  on the status of the corresponding barrier. It assumes that the
-   --  specified object is locked.
+   --  This procedure executes or queues an entry call, depending on the status
+   --  of the corresponding barrier. The specified object is assumed locked.
 
    ---------------------
    -- Check_Exception --
@@ -140,9 +138,9 @@ package body System.Tasking.Protected_Objects.Single_Entry is
    -- Send_Program_Error --
    ------------------------
 
-   procedure Send_Program_Error (Entry_Call : Entry_Call_Link)
-   is
+   procedure Send_Program_Error (Entry_Call : Entry_Call_Link) is
       Caller : constant Task_Id := Entry_Call.Self;
+
    begin
       Entry_Call.Exception_To_Raise := Program_Error'Identity;
 
@@ -192,7 +190,6 @@ package body System.Tasking.Protected_Objects.Single_Entry is
       pragma Assert
         (Caller.Common.State /= Terminated and then
          Caller.Common.State /= Unactivated);
-
       Entry_Call.State := Done;
       STPO.Wakeup (Caller, Entry_Caller_Sleep);
    end Wakeup_Entry_Caller;
@@ -207,7 +204,8 @@ package body System.Tasking.Protected_Objects.Single_Entry is
 
    procedure Exceptional_Complete_Single_Entry_Body
      (Object : Protection_Entry_Access;
-      Ex     : Ada.Exceptions.Exception_Id) is
+      Ex     : Ada.Exceptions.Exception_Id)
+   is
    begin
       Object.Call_In_Progress.Exception_To_Raise := Ex;
    end Exceptional_Complete_Single_Entry_Body;
@@ -235,7 +233,8 @@ package body System.Tasking.Protected_Objects.Single_Entry is
    -- Lock_Entry --
    ----------------
 
-   --  Compiler interface only.
+   --  Compiler interface only
+
    --  Do not call this procedure from within the run-time system.
 
    procedure Lock_Entry (Object : Protection_Entry_Access) is
@@ -391,7 +390,8 @@ package body System.Tasking.Protected_Objects.Single_Entry is
    -----------------------------------
 
    function Protected_Single_Entry_Caller
-     (Object : Protection_Entry) return Task_Id is
+     (Object : Protection_Entry) return Task_Id
+   is
    begin
       return Object.Call_In_Progress.Self;
    end Protected_Single_Entry_Caller;
diff --git a/gcc/ada/s-tposen.ads b/gcc/ada/s-tposen.ads
index b2713bd..3bb0aa8 100644
--- a/gcc/ada/s-tposen.ads
+++ b/gcc/ada/s-tposen.ads
@@ -228,7 +228,7 @@ package System.Tasking.Protected_Objects.Single_Entry is
       Uninterpreted_Data  : System.Address);
    --  Make a protected entry call to the specified object
    --
-   --  Pend a protected entry call on the protected object represented by
+   --  Pends a protected entry call on the protected object represented by
    --  Object. A pended call is not queued; it may be executed immediately
    --  or queued, depending on the state of the entry barrier.
    --
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index cca8c06..6193a8f 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -4244,7 +4244,10 @@ package body Sem_Warn is
 
    procedure Warn_On_Useless_Assignments (E : Entity_Id) is
       Ent : Entity_Id;
+
    begin
+      Process_Deferred_References;
+
       if Warn_On_Modified_Unread
         and then In_Extended_Main_Source_Unit (E)
       then