[multiple changes]

2015-05-27  Robert Dewar  <dewar@adacore.com>

	* sem_aux.adb: Minor rewording.

2015-05-27  Bob Duff  <duff@adacore.com>

	* exp_prag.adb (Expand_Pragma_Abort_Defer): Make
	pragma Abort_Defer do nothing if Abort_Allowed is False.

2015-05-27  Arnaud Charlet  <charlet@adacore.com>

	* exp_ch9.adb, sem_util.adb, sem_util.ads, s-stposu.adb, s-spsufi.ads,
	sem_elab.ads, g-comlin.ads, errout.ads, exp_ch6.adb, sem_ch4.adb,
	opt.ads, s-bignum.adb, output.ads, sem_ch13.adb, erroutc.ads,
	sem_disp.ads, exp_ch3.adb: Minor fixes of duplicate words in comments.

2015-05-27  Doug Rupp  <rupp@adacore.com>

	* adaint.c (__gnat_tmp_name) [vxworks]: Robustify and use for rtp as
	well as kernel.

2015-05-27  Pierre-Marie de Rodat  <derodat@adacore.com>

	* par_sco.adb (Process_Decision): Store sloc to
	condition/pragmas SCOs associations into a temporary table before
	moving them to the SCO_Raw_Hash_Table so that we can back them
	out just like we do for SCO entries that are simple decisions
	in an expression context.

From-SVN: r223754

gcc/ada/ChangeLog

@@ -1,3 +1,32 @@
+2015-05-27  Robert Dewar  <dewar@adacore.com>
+
+	* sem_aux.adb: Minor rewording.
+
+2015-05-27  Bob Duff  <duff@adacore.com>
+
+	* exp_prag.adb (Expand_Pragma_Abort_Defer): Make
+	pragma Abort_Defer do nothing if Abort_Allowed is False.
+
+2015-05-27  Arnaud Charlet  <charlet@adacore.com>
+
+	* exp_ch9.adb, sem_util.adb, sem_util.ads, s-stposu.adb, s-spsufi.ads,
+	sem_elab.ads, g-comlin.ads, errout.ads, exp_ch6.adb, sem_ch4.adb,
+	opt.ads, s-bignum.adb, output.ads, sem_ch13.adb, erroutc.ads,
+	sem_disp.ads, exp_ch3.adb: Minor fixes of duplicate words in comments.
+
+2015-05-27  Doug Rupp  <rupp@adacore.com>
+
+	* adaint.c (__gnat_tmp_name) [vxworks]: Robustify and use for rtp as
+	well as kernel.
+
+2015-05-27  Pierre-Marie de Rodat  <derodat@adacore.com>
+
+	* par_sco.adb (Process_Decision): Store sloc to
+	condition/pragmas SCOs associations into a temporary table before
+	moving them to the SCO_Raw_Hash_Table so that we can back them
+	out just like we do for SCO entries that are simple decisions
+	in an expression context.
+
 2015-05-27  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_ch6.adb (Process_Formals): A non-private formal type that

gcc/ada/adaint.c

@@ -1170,23 +1170,37 @@ __gnat_tmp_name (char *tmp_filename)
     sprintf (tmp_filename, "%s/gnat-XXXXXX", tmpdir);
 
   close (mkstemp(tmp_filename));
-#elif defined (__vxworks) && !(defined (__RTP__) || defined (VTHREADS))
+#elif defined (__vxworks) && !defined (VTHREADS)
-  int             index;
+  int index;
-  char *          pos;
+  char *pos;
-  ushort_t        t;
+  char *savepos;
   static ushort_t seed = 0; /* used to generate unique name */
 
-  /* generate unique name */
+  /* Generate a unique name.  */
   strcpy (tmp_filename, "tmp");
 
-  /* fill up the name buffer from the last position */
   index = 5;
-  pos = tmp_filename + strlen (tmp_filename) + index;
+  savepos = pos = tmp_filename + strlen (tmp_filename) + index;
   *pos = '\0';
 
-  seed++;
+  while (1)
-  for (t = seed; 0 <= --index; t >>= 3)
+    {
-      *--pos = '0' + (t & 07);
+      FILE *f;
+      ushort_t t;
+
+      /* Fill up the name buffer from the last position.  */
+      seed++;
+      for (t = seed; 0 <= --index; t >>= 3)
+        *--pos = '0' + (t & 07);
+
+      /* Check to see if its unique, if not bump the seed and try again.  */
+      f = fopen (tmp_filename, "r");
+      if (f == NULL)
+        break;
+      fclose (f);
+      pos = savepos;
+      index = 5;
+    }
 #else
   tmpnam (tmp_filename);
 #endif

gcc/ada/errout.ads

@@ -837,7 +837,7 @@ package Errout is
    --  pragma, or the null string if no reason is given. Config is True for the
    --  configuration pragma case (where there is no requirement for a matching
    --  OFF pragma). Used is set True to disable the check that the warning
-   --  actually has has the effect of suppressing a warning.
+   --  actually has the effect of suppressing a warning.
 
    procedure Set_Specific_Warning_On
      (Loc : Source_Ptr;

gcc/ada/erroutc.ads

@@ -552,7 +552,7 @@ package Erroutc is
    --  pragma, or the null string if no reason is given. Config is True for the
    --  configuration pragma case (where there is no requirement for a matching
    --  OFF pragma). Used is set True to disable the check that the warning
-   --  actually has has the effect of suppressing a warning.
+   --  actually has the effect of suppressing a warning.
 
    procedure Set_Specific_Warning_On
      (Loc : Source_Ptr;
@@ -580,7 +580,7 @@ package Erroutc is
    --  which generates a warning range for the whole source file). This routine
    --  only deals with the general ON/OFF case, not specific warnings. The
    --  returned result is No_String if warnings are not suppressed. If warnings
-   --  are suppressed for the given location, then then corresponding Reason
+   --  are suppressed for the given location, then corresponding Reason
    --  parameter from the pragma is returned (or the null string if no Reason
    --  parameter was present).
 

gcc/ada/exp_ch3.adb

@@ -5177,7 +5177,7 @@ package body Exp_Ch3 is
            and then not Is_Value_Type (Typ)
          then
             --  Do not initialize the components if No_Default_Initialization
-            --  applies as the the actual restriction check will occur later
+            --  applies as the actual restriction check will occur later
             --  when the object is frozen as it is not known yet whether the
             --  object is imported or not.
 

gcc/ada/exp_ch6.adb

@@ -8992,7 +8992,7 @@ package body Exp_Ch6 is
          Freeze_Expression (Ptr_Typ_Freeze_Ref);
       end;
 
-      --  If the the object is a return object of an enclosing build-in-place
+      --  If the object is a return object of an enclosing build-in-place
       --  function, then the implicit build-in-place parameters of the
       --  enclosing function are simply passed along to the called function.
       --  (Unfortunately, this won't cover the case of extension aggregates

gcc/ada/exp_ch9.adb

@@ -4284,7 +4284,7 @@ package body Exp_Ch9 is
             Append (Unprot_Call, Stmts);
          end if;
 
-         --  Historical note: Previously, call the the cleanup was inserted
+         --  Historical note: Previously, call to the cleanup was inserted
          --  here. This is now done by Build_Protected_Subprogram_Call_Cleanup,
          --  which is also shared by the 'not Exc_Safe' path.
 
@@ -12153,7 +12153,7 @@ package body Exp_Ch9 is
 
    --  3) Ada 2005 (AI-345): When T.E is a dispatching procedure call, there
    --     is no delay and the triggering statements are executed. We first
-   --     determine the kind of of the triggering call and then execute a
+   --     determine the kind of the triggering call and then execute a
    --     synchronized operation or a direct call.
 
    --    declare

gcc/ada/exp_prag.adb

@@ -251,41 +251,51 @@ package body Exp_Prag is
    --    end;
 
    procedure Expand_Pragma_Abort_Defer (N : Node_Id) is
-      Loc  : constant Source_Ptr := Sloc (N);
-      Stm  : Node_Id;
-      Stms : List_Id;
-      HSS  : Node_Id;
-      Blk  : constant Entity_Id :=
-               New_Internal_Entity (E_Block, Current_Scope, Sloc (N), 'B');
-      AUD : constant Entity_Id := RTE (RE_Abort_Undefer_Direct);
-
    begin
-      Stms := New_List (Build_Runtime_Call (Loc, RE_Abort_Defer));
+      --  Abort_Defer has no useful effect if Abort's are not allowed
-      loop
-         Stm := Remove_Next (N);
-         exit when No (Stm);
-         Append (Stm, Stms);
-      end loop;
 
-      HSS :=
+      if not Abort_Allowed then
-        Make_Handled_Sequence_Of_Statements (Loc,
+         return;
-          Statements  => Stms,
+      end if;
-          At_End_Proc => New_Occurrence_Of (AUD, Loc));
 
-      --  Present the Abort_Undefer_Direct function to the backend so that it
+      --  Normal case where abort is possible
-      --  can inline the call to the function.
 
-      Add_Inlined_Body (AUD, N);
+      declare
+         Loc  : constant Source_Ptr := Sloc (N);
+         Stm  : Node_Id;
+         Stms : List_Id;
+         HSS  : Node_Id;
+         Blk  : constant Entity_Id :=
+                  New_Internal_Entity (E_Block, Current_Scope, Sloc (N), 'B');
+         AUD  : constant Entity_Id := RTE (RE_Abort_Undefer_Direct);
 
-      Rewrite (N,
+      begin
-        Make_Block_Statement (Loc,
+         Stms := New_List (Build_Runtime_Call (Loc, RE_Abort_Defer));
-          Handled_Statement_Sequence => HSS));
+         loop
+            Stm := Remove_Next (N);
+            exit when No (Stm);
+            Append (Stm, Stms);
+         end loop;
 
-      Set_Scope (Blk, Current_Scope);
+         HSS :=
-      Set_Etype (Blk, Standard_Void_Type);
+           Make_Handled_Sequence_Of_Statements (Loc,
-      Set_Identifier (N, New_Occurrence_Of (Blk, Sloc (N)));
+             Statements  => Stms,
-      Expand_At_End_Handler (HSS, Blk);
+             At_End_Proc => New_Occurrence_Of (AUD, Loc));
-      Analyze (N);
+
+         --  Present the Abort_Undefer_Direct function to the backend so that
+         --  it can inline the call to the function.
+
+         Add_Inlined_Body (AUD, N);
+
+         Rewrite (N,
+           Make_Block_Statement (Loc, Handled_Statement_Sequence => HSS));
+
+         Set_Scope (Blk, Current_Scope);
+         Set_Etype (Blk, Standard_Void_Type);
+         Set_Identifier (N, New_Occurrence_Of (Blk, Sloc (N)));
+         Expand_At_End_Handler (HSS, Blk);
+         Analyze (N);
+      end;
    end Expand_Pragma_Abort_Defer;
 
    --------------------------

gcc/ada/g-comlin.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                     Copyright (C) 1999-2014, AdaCore                     --
+--                     Copyright (C) 1999-2015, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -502,7 +502,7 @@ package GNAT.Command_Line is
    -- Expansion of command line arguments --
    -----------------------------------------
 
-   --  These subprograms take care of of expanding globbing patterns on the
+   --  These subprograms take care of expanding globbing patterns on the
    --  command line. On Unix, such expansion is done by the shell before your
    --  application is called. But on Windows you must do this expansion
    --  yourself.

gcc/ada/opt.ads

@@ -2144,7 +2144,7 @@ package Opt is
    ---------------------------
 
    --  The following array would more reasonably be located in Err_Vars or
-   --  Errour, but but we put them here to deal with licensing issues (we need
+   --  Errour, but we put them here to deal with licensing issues (we need
    --  this to have the GPL exception licensing, since these variables and
    --  subprograms are accessed from units with this licensing).
 

gcc/ada/output.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, 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- --
@@ -60,7 +60,7 @@ package Output is
    --  Sets subsequent output to call procedure P. If P is null, then the call
    --  cancels the effect of a previous call, reverting the output to standard
    --  error or standard output depending on the mode at the time of previous
-   --  call. Any exception generated by by calls to P is simply propagated to
+   --  call. Any exception generated by calls to P is simply propagated to
    --  the caller of the routine causing the write operation.
 
    procedure Cancel_Special_Output;

gcc/ada/par_sco.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2009-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 2009-2015, 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- --
@@ -495,6 +495,32 @@ package body Par_SCO is
       --  table. We use it for backing out a simple decision in an expression
       --  context that contains only NOT operators.
 
+      Mark_Hash : Nat;
+      --  Likewise for the putative SCO_Raw_Hash_Table entries: see below
+
+      type Hash_Entry is record
+         Sloc      : Source_Ptr;
+         SCO_Index : Nat;
+      end record;
+      --  We must register all conditions/pragmas in SCO_Raw_Hash_Table.
+      --  However we cannot register them in the same time we are adding the
+      --  corresponding SCO entries to the raw table since we may discard them
+      --  later on. So instead we put all putative conditions into Hash_Entries
+      --  (see below) and register them once we are sure we keep them.
+      --
+      --  This data structure holds the conditions/pragmas to register in
+      --  SCO_Raw_Hash_Table.
+
+      package Hash_Entries is new Table.Table (
+        Table_Component_Type => Hash_Entry,
+        Table_Index_Type     => Nat,
+        Table_Low_Bound      => 1,
+        Table_Initial        => 10,
+        Table_Increment      => 10,
+        Table_Name           => "Hash_Entries");
+      --  Hold temporarily (i.e. free'd before returning) the Hash_Entry before
+      --  they are registered in SCO_Raw_Hash_Table.
+
       X_Not_Decision : Boolean;
       --  This flag keeps track of whether a decision sequence in the SCO table
       --  contains only NOT operators, and is for an expression context (T=X).
@@ -581,7 +607,7 @@ package body Par_SCO is
                To   => No_Location,
                Last => False);
 
-            SCO_Raw_Hash_Table.Set (Sloc (N), SCO_Raw_Table.Last);
+            Hash_Entries.Append ((Sloc (N), SCO_Raw_Table.Last));
 
             Output_Decision_Operand (L);
             Output_Decision_Operand (Right_Opnd (N));
@@ -608,7 +634,7 @@ package body Par_SCO is
             From => FSloc,
             To   => LSloc,
             Last => False);
-         SCO_Raw_Hash_Table.Set (FSloc, SCO_Raw_Table.Last);
+         Hash_Entries.Append ((FSloc, SCO_Raw_Table.Last));
       end Output_Element;
 
       -------------------
@@ -684,7 +710,7 @@ package body Par_SCO is
          --  pragma, enter a hash table entry now.
 
          if T = 'a' then
-            SCO_Raw_Hash_Table.Set (Loc, SCO_Raw_Table.Last);
+            Hash_Entries.Append ((Loc, SCO_Raw_Table.Last));
          end if;
       end Output_Header;
 
@@ -736,6 +762,7 @@ package body Par_SCO is
 
                   X_Not_Decision := T = 'X' and then Nkind (N) = N_Op_Not;
                   Mark := SCO_Raw_Table.Last;
+                  Mark_Hash := Hash_Entries.Last;
                   Output_Header (T);
 
                   --  Output the decision
@@ -748,6 +775,7 @@ package body Par_SCO is
 
                   if X_Not_Decision then
                      SCO_Raw_Table.Set_Last (Mark);
+                     Hash_Entries.Set_Last (Mark_Hash);
 
                   --  Otherwise, set Last in last table entry to mark end
 
@@ -800,6 +828,8 @@ package body Par_SCO is
          return;
       end if;
 
+      Hash_Entries.Init;
+
       --  See if we have simple decision at outer level and if so then
       --  generate the decision entry for this simple decision. A simple
       --  decision is a boolean expression (which is not a logical operator
@@ -817,6 +847,16 @@ package body Par_SCO is
       end if;
 
       Traverse (N);
+
+      --  Now we have the definitive set of SCO entries, register them in the
+      --  corresponding hash table.
+
+      for I in 1 .. Hash_Entries.Last loop
+         SCO_Raw_Hash_Table.Set
+           (Hash_Entries.Table (I).Sloc,
+            Hash_Entries.Table (I).SCO_Index);
+      end loop;
+      Hash_Entries.Free;
    end Process_Decisions;
 
    -----------

gcc/ada/s-bignum.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2012-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 2012-2015, 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- --
@@ -881,7 +881,7 @@ package body System.Bignums is
 
             --  D3 (continued). Now test if qhat >= b or v2*qhat > (rhat,uj+2):
             --  if so, decrease qhat by 1, increase rhat by v1, and repeat this
-            --  test if rhat < b. [The test on v2 determines at at high speed
+            --  test if rhat < b. [The test on v2 determines at high speed
             --  most of the cases in which the trial value qhat is one too
             --  large, and eliminates all cases where qhat is two too large.]
 

gcc/ada/s-spsufi.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2011-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 2011-2015, 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- --
@@ -41,7 +41,7 @@ package System.Storage_Pools.Subpools.Finalization is
    procedure Finalize_And_Deallocate (Subpool : in out Subpool_Handle);
    --  This routine performs the following actions:
    --    1) Finalize all objects chained on the subpool's master
-   --    2) Remove the the subpool from the owner's list of subpools
+   --    2) Remove the subpool from the owner's list of subpools
    --    3) Deallocate the doubly linked list node associated with the subpool
    --    4) Call Deallocate_Subpool
 

gcc/ada/s-stposu.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2011-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 2011-2015, 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- --
@@ -541,7 +541,7 @@ package body System.Storage_Pools.Subpools is
          --  Perform the following actions:
 
          --    1) Finalize all objects chained on the subpool's master
-         --    2) Remove the the subpool from the owner's list of subpools
+         --    2) Remove the subpool from the owner's list of subpools
          --    3) Deallocate the doubly linked list node associated with the
          --       subpool.
          --    4) Call Deallocate_Subpool

gcc/ada/sem_aux.adb

@@ -249,9 +249,9 @@ package body Sem_Aux is
       --  Call may be on a private type with unknown discriminants, in which
       --  case Ent is Empty, and as per the spec, we return Empty in this case.
 
-      --  Historical note: The revious assertion that Ent is a discriminant
+      --  Historical note: The assertion in previous versions that Ent is a
-      --  was overly cautious and prevented application of this function in
+      --  discriminant was overly cautious and prevented convenient application
-      --  SPARK applications.
+      --  of this function in the gnatprove context.
 
       return Ent;
    end First_Discriminant;

gcc/ada/sem_ch13.adb

@@ -6496,7 +6496,7 @@ package body Sem_Ch13 is
          return;
       end if;
 
-      --  We know we have a first subtype, now possibly go the the anonymous
+      --  We know we have a first subtype, now possibly go the anonymous
       --  base type to determine whether Rectype is a record extension.
 
       Recdef := Type_Definition (Declaration_Node (Base_Type (Rectype)));
@@ -8661,7 +8661,7 @@ package body Sem_Ch13 is
             SId : constant Entity_Id :=
                     Make_Defining_Identifier (Loc,
                       Chars => New_External_Name (Chars (Typ), "Predicate"));
-            --  The entity for the the function spec
+            --  The entity for the function spec
 
             SIdB : constant Entity_Id :=
               Make_Defining_Identifier (Loc,
@@ -8744,7 +8744,7 @@ package body Sem_Ch13 is
                SId : constant Entity_Id :=
                  Make_Defining_Identifier (Loc,
                    Chars => New_External_Name (Chars (Typ), "PredicateM"));
-               --  The entity for the the function spec
+               --  The entity for the function spec
 
                SIdB : constant Entity_Id :=
                  Make_Defining_Identifier (Loc,

gcc/ada/sem_ch4.adb

@@ -3880,7 +3880,7 @@ package body Sem_Ch4 is
       --    for some X => (if P then Q [else True])
 
       --  any value for X that makes P False results in the if expression being
-      --  trivially True, and so also results in the the quantified expression
+      --  trivially True, and so also results in the quantified expression
       --  being trivially True.
 
       if Warn_On_Suspicious_Contract

gcc/ada/sem_disp.ads

@@ -50,7 +50,7 @@ package Sem_Disp is
    --  Empty we are in the overriding case. If the tagged type associated with
    --  Subp is a concurrent type (case that occurs when the type is declared in
    --  a generic because the analysis of generics disables generation of the
-   --  corresponding record) then this routine does does not add Subp to the
+   --  corresponding record) then this routine does not add Subp to the
    --  list of primitive operations but leaves Subp decorated as dispatching
    --  operation to enable checks associated with the Object.Operation notation
 

gcc/ada/sem_elab.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1997-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1997-2015, 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- --
@@ -51,7 +51,7 @@ package Sem_Elab is
    --  In addition, in SPARK mode, we are checking for a variable reference in
    --  another package, which requires an explicit Elaborate_All pragma.
 
-   --  The only references that we need to look at at the outer level are
+   --  The only references that we need to look at the outer level are
    --  references that occur in elaboration code. There are two cases. The
    --  reference can be at the outer level of elaboration code, or it can
    --  be within another unit, e.g. the elaboration code of a subprogram.

gcc/ada/sem_util.adb

@@ -16300,7 +16300,7 @@ package body Sem_Util is
 
    function Policy_In_Effect (Policy : Name_Id) return Name_Id is
       function Policy_In_List (List : Node_Id) return Name_Id;
-      --  Determine the the mode of a policy in a N_Pragma list
+      --  Determine the mode of a policy in a N_Pragma list
 
       --------------------
       -- Policy_In_List --

gcc/ada/sem_util.ads

@@ -455,7 +455,7 @@ package Sem_Util is
    --  2012 stand-alone object of an anonymous access type, then return the
    --  static accesssibility level of the object. In that case, the dynamic
    --  accessibility level of the object may take on values in a range. The low
-   --  bound of of that range is returned by Type_Access_Level; this function
+   --  bound of that range is returned by Type_Access_Level; this function
    --  yields the high bound of that range. Also differs from Type_Access_Level
    --  in the case of a descendant of a generic formal type (returns Int'Last
    --  instead of 0).