[multiple changes]

2015-01-06  Robert Dewar  <dewar@adacore.com>

	* s-taskin.ads, s-traces.ads: Minor reformatting.
	* exp_util.adb: Minor typo fix.

2015-01-06  Vincent Celier  <celier@adacore.com>

	* gnatls.adb (Search_RTS): Invoke Initialize_Default_Project_Path
	with the runtime name.
	* prj-env.adb (Initialize_Default_Project_Path): When both
	Target_Name and Runtime_Name are not empty string, add to the
	project path the two directories .../lib/gnat and .../share/gpr
	related to the runtime.
	* prj-env.ads (Initialize_Default_Project_Path): New String
	parameter Runtime_Name, defaulted to the empty string.

2015-01-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* frontend.adb: Guard against the case where a configuration
	pragma may be split into multiple pragmas and the original
	rewritten as a null statement.
	* sem_prag.adb (Analyze_Pragma): Insert a brand new Check_Policy
	pragma using Insert_Before rather than Insert_Action. This
	takes care of the configuration pragma case where Insert_Action
	would fail.

2015-01-06  Bob Duff  <duff@adacore.com>

	* a-coboho.ads (Element_Access): Add "pragma
	No_Strict_Aliasing (Element_Access);". This is needed because
	we are unchecked-converting from Address to Element_Access.
	* a-cofove.ads, a-cofove.adb (Elems,Elemsc): Fix bounds of the
	result to be 1.

2015-01-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_res.adb (Resolve_Actuals): Remove the
	restriction which prohibits volatile actual parameters with
	enabled external propery Async_Writers to act appear in procedure
	calls where the corresponding formal is of mode OUT.

From-SVN: r219222

13 files changed, 181 insertions, 101 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 02968d7..562b619 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,44 @@
+2015-01-06  Robert Dewar  <dewar@adacore.com>
+
+	* s-taskin.ads, s-traces.ads: Minor reformatting.
+	* exp_util.adb: Minor typo fix.
+
+2015-01-06  Vincent Celier  <celier@adacore.com>
+
+	* gnatls.adb (Search_RTS): Invoke Initialize_Default_Project_Path
+	with the runtime name.
+	* prj-env.adb (Initialize_Default_Project_Path): When both
+	Target_Name and Runtime_Name are not empty string, add to the
+	project path the two directories .../lib/gnat and .../share/gpr
+	related to the runtime.
+	* prj-env.ads (Initialize_Default_Project_Path): New String
+	parameter Runtime_Name, defaulted to the empty string.
+
+2015-01-06  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* frontend.adb: Guard against the case where a configuration
+	pragma may be split into multiple pragmas and the original
+	rewritten as a null statement.
+	* sem_prag.adb (Analyze_Pragma): Insert a brand new Check_Policy
+	pragma using Insert_Before rather than Insert_Action. This
+	takes care of the configuration pragma case where Insert_Action
+	would fail.
+
+2015-01-06  Bob Duff  <duff@adacore.com>
+
+	* a-coboho.ads (Element_Access): Add "pragma
+	No_Strict_Aliasing (Element_Access);". This is needed because
+	we are unchecked-converting from Address to Element_Access.
+	* a-cofove.ads, a-cofove.adb (Elems,Elemsc): Fix bounds of the
+	result to be 1.
+
+2015-01-06  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_res.adb (Resolve_Actuals): Remove the
+	restriction which prohibits volatile actual parameters with
+	enabled external propery Async_Writers to act appear in procedure
+	calls where the corresponding formal is of mode OUT.
+
 2015-01-05  Jakub Jelinek  <jakub@redhat.com>
 
 	* gnat_ugn.texi: Bump @copying's copyright year.
diff --git a/gcc/ada/a-coboho.ads b/gcc/ada/a-coboho.ads
index 244c4d4..7e6933e 100644
--- a/gcc/ada/a-coboho.ads
+++ b/gcc/ada/a-coboho.ads
@@ -99,4 +99,9 @@ private
    --  the 'Address of an array points to the first element, thus losing the
    --  bounds.
 
+   pragma No_Strict_Aliasing (Element_Access);
+   --  Needed because we are unchecked-converting from Address to
+   --  Element_Access (see package body), which is a violation of the
+   --  normal aliasing rules enforced by gcc.
+
 end Ada.Containers.Bounded_Holders;
diff --git a/gcc/ada/a-cofove.adb b/gcc/ada/a-cofove.adb
index df02dc0..9cfd132 100644
--- a/gcc/ada/a-cofove.adb
+++ b/gcc/ada/a-cofove.adb
@@ -45,10 +45,9 @@ is
    procedure Free is
       new Ada.Unchecked_Deallocation (Elements_Array, Elements_Array_Ptr);
 
-   type Maximal_Array_Ptr is access all Elements_Array (Capacity_Range)
+   type Maximal_Array_Ptr is access all Elements_Array (Array_Index)
      with Storage_Size => 0;
-   type Maximal_Array_Ptr_Const is access constant
-     Elements_Array (Capacity_Range)
+   type Maximal_Array_Ptr_Const is access constant Elements_Array (Array_Index)
        with Storage_Size => 0;
 
    function Elems (Container : in out Vector) return Maximal_Array_Ptr;
@@ -111,7 +110,7 @@ is
          Reserve_Capacity
            (Container,
             Capacity_Range'Max (Capacity (Container) * Growth_Factor,
-                            Capacity_Range (New_Length)));
+                                Capacity_Range (New_Length)));
       end if;
 
       if Container.Last = Index_Type'Last then
@@ -381,7 +380,7 @@ is
       is
          procedure Sort is
            new Generic_Array_Sort
-             (Index_Type   => Capacity_Range,
+             (Index_Type   => Array_Index,
               Element_Type => Element_Type,
               Array_Type   => Elements_Array,
               "<"          => "<");
diff --git a/gcc/ada/a-cofove.ads b/gcc/ada/a-cofove.ads
index 0f02017..9e91bc8 100644
--- a/gcc/ada/a-cofove.ads
+++ b/gcc/ada/a-cofove.ads
@@ -246,7 +246,8 @@ private
    pragma Inline (Replace_Element);
    pragma Inline (Contains);
 
-   type Elements_Array is array (Capacity_Range range <>) of Element_Type;
+   subtype Array_Index is Capacity_Range range 1 .. Capacity_Range'Last;
+   type Elements_Array is array (Array_Index range <>) of Element_Type;
    function "=" (L, R : Elements_Array) return Boolean is abstract;
 
    type Elements_Array_Ptr is access all Elements_Array;
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 3810022..f1f6b52 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -2961,7 +2961,7 @@ package body Exp_Util is
 
    begin
       --  If parser detected no address clause for the identifier in question,
-      --  then then answer is a quick NO, without the need for a search.
+      --  then the answer is a quick NO, without the need for a search.
 
       if not Get_Name_Table_Boolean (Chars (Id)) then
          return Empty;
diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb
index 5cea4db..7d24ae0 100644
--- a/gcc/ada/frontend.adb
+++ b/gcc/ada/frontend.adb
@@ -339,10 +339,10 @@ begin
 
      and then not Fatal_Error (Main_Unit)
    then
-      --  Pragmas that require some semantic activity, such as
-      --  Interrupt_State, cannot be processed until the main unit
-      --  is installed, because they require a compilation unit on
-      --  which to attach with_clauses, etc. So analyze them now.
+      --  Pragmas that require some semantic activity, such as Interrupt_State,
+      --  cannot be processed until the main unit is installed, because they
+      --  require a compilation unit on which to attach with_clauses, etc. So
+      --  analyze them now.
 
       declare
          Prag : Node_Id;
@@ -350,7 +350,14 @@ begin
       begin
          Prag := First (Config_Pragmas);
          while Present (Prag) loop
-            if Delay_Config_Pragma_Analyze (Prag) then
+
+            --  Guard against the case where a configuration pragma may be
+            --  split into multiple pragmas and the original rewritten as a
+            --  null statement.
+
+            if Nkind (Prag) = N_Pragma
+              and then Delay_Config_Pragma_Analyze (Prag)
+            then
                Analyze_Pragma (Prag);
             end if;
 
diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb
index 80875b5..6ef23a2 100644
--- a/gcc/ada/gnatls.adb
+++ b/gcc/ada/gnatls.adb
@@ -1225,6 +1225,10 @@ procedure Gnatls is
       if Src_Path /= null and then Lib_Path /= null then
          Add_Search_Dirs (Src_Path, Include);
          Add_Search_Dirs (Lib_Path, Objects);
+         Initialize_Default_Project_Path
+           (Prj_Path,
+            Target_Name => Sdefault.Target_Name.all,
+            Runtime_Name => Name);
          return;
       end if;
 
@@ -1237,7 +1241,9 @@ procedure Gnatls is
       --  Try to find the RTS on the project path. First setup the project path
 
       Initialize_Default_Project_Path
-        (Prj_Path, Target_Name => Sdefault.Target_Name.all);
+        (Prj_Path,
+         Target_Name => Sdefault.Target_Name.all,
+         Runtime_Name => Name);
 
       Rts_Full_Path := Get_Runtime_Path (Prj_Path, Name);
 
diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb
index 7dbb4ce..dd60df9 100644
--- a/gcc/ada/prj-env.adb
+++ b/gcc/ada/prj-env.adb
@@ -1873,8 +1873,9 @@ package body Prj.Env is
    -------------------------------------
 
    procedure Initialize_Default_Project_Path
-     (Self        : in out Project_Search_Path;
-      Target_Name : String)
+     (Self         : in out Project_Search_Path;
+      Target_Name  : String;
+      Runtime_Name : String := "")
    is
       Add_Default_Dir : Boolean := Target_Name /= "-";
       First           : Positive;
@@ -1894,6 +1895,24 @@ package body Prj.Env is
       --  The path name(s) of directories where project files may reside.
       --  May be empty.
 
+      Prefix : String_Ptr;
+      Runtime : String_Ptr;
+
+      procedure Add_Target;
+
+      procedure Add_Target is
+      begin
+         Add_Str_To_Name_Buffer
+           (Path_Separator & Prefix.all & Target_Name);
+
+         --  Note: Target_Name has a trailing / when it comes from
+         --  Sdefault.
+
+         if Name_Buffer (Name_Len) /= '/' then
+            Add_Char_To_Name_Buffer (Directory_Separator);
+         end if;
+      end Add_Target;
+
    begin
       if Is_Initialized (Self) then
          return;
@@ -2051,73 +2070,81 @@ package body Prj.Env is
       --  Set the initial value of Current_Project_Path
 
       if Add_Default_Dir then
-         declare
-            Prefix : String_Ptr;
-
-         begin
-            if Sdefault.Search_Dir_Prefix = null then
-
-               --  gprbuild case
+         if Sdefault.Search_Dir_Prefix = null then
 
-               Prefix := new String'(Executable_Prefix_Path);
-
-            else
-               Prefix := new String'(Sdefault.Search_Dir_Prefix.all
-                                     & ".." & Dir_Separator
-                                     & ".." & Dir_Separator
-                                     & ".." & Dir_Separator
-                                     & ".." & Dir_Separator);
-            end if;
+            --  gprbuild case
 
-            if Prefix.all /= "" then
-               if Target_Name /= "" then
+            Prefix := new String'(Executable_Prefix_Path);
 
-                  --  $prefix/$target/lib/gnat
-
-                  Add_Str_To_Name_Buffer
-                    (Path_Separator & Prefix.all & Target_Name);
-
-                  --  Note: Target_Name has a trailing / when it comes from
-                  --  Sdefault.
-
-                  if Name_Buffer (Name_Len) /= '/' then
-                     Add_Char_To_Name_Buffer (Directory_Separator);
-                  end if;
+         else
+            Prefix := new String'(Sdefault.Search_Dir_Prefix.all
+                                  & ".." & Dir_Separator
+                                  & ".." & Dir_Separator
+                                  & ".." & Dir_Separator
+                                  & ".." & Dir_Separator);
+         end if;
 
-                  Add_Str_To_Name_Buffer
-                    ("lib" & Directory_Separator & "gnat");
+         if Prefix.all /= "" then
+            if Target_Name /= "" then
 
-                  --  $prefix/$target/share/gpr
+               if Runtime_Name /= "" then
+                  if Base_Name (Runtime_Name) = Runtime_Name then
 
-                  Add_Str_To_Name_Buffer
-                    (Path_Separator & Prefix.all & Target_Name);
+                     --  $prefix/$target/$runtime/lib/gnat
+                     Add_Target;
+                     Add_Str_To_Name_Buffer
+                       (Runtime_Name & Directory_Separator &
+                          "lib" & Directory_Separator & "gnat");
 
-                  --  Note: Target_Name has a trailing / when it comes from
-                  --  Sdefault.
+                     --  $prefix/$target/$runtime/share/gpr
+                     Add_Target;
+                     Add_Str_To_Name_Buffer
+                       (Runtime_Name & Directory_Separator &
+                          "share" & Directory_Separator & "gpr");
 
-                  if Name_Buffer (Name_Len) /= '/' then
-                     Add_Char_To_Name_Buffer (Directory_Separator);
+                  else
+                     Runtime :=
+                       new String'(Normalize_Pathname (Runtime_Name));
+
+                     --  $runtime_dir/lib/gnat
+                     Add_Str_To_Name_Buffer
+                       (Path_Separator & Runtime.all & Directory_Separator &
+                        "lib" & Directory_Separator & "gnat");
+
+                     --  $runtime_dir/share/gpr
+                     Add_Str_To_Name_Buffer
+                       (Path_Separator & Runtime.all & Directory_Separator &
+                        "share" & Directory_Separator & "gpr");
                   end if;
-
-                  Add_Str_To_Name_Buffer
-                    ("share" & Directory_Separator & "gpr");
                end if;
 
-               --  $prefix/share/gpr
+               --  $prefix/$target/lib/gnat
 
+               Add_Target;
                Add_Str_To_Name_Buffer
-                 (Path_Separator & Prefix.all & "share"
-                  & Directory_Separator & "gpr");
+                 ("lib" & Directory_Separator & "gnat");
 
-               --  $prefix/lib/gnat
+               --  $prefix/$target/share/gpr
 
+               Add_Target;
                Add_Str_To_Name_Buffer
-                 (Path_Separator & Prefix.all & "lib"
-                  & Directory_Separator & "gnat");
+                 ("share" & Directory_Separator & "gpr");
             end if;
 
-            Free (Prefix);
-         end;
+            --  $prefix/share/gpr
+
+            Add_Str_To_Name_Buffer
+              (Path_Separator & Prefix.all & "share"
+               & Directory_Separator & "gpr");
+
+            --  $prefix/lib/gnat
+
+            Add_Str_To_Name_Buffer
+              (Path_Separator & Prefix.all & "lib"
+               & Directory_Separator & "gnat");
+         end if;
+
+         Free (Prefix);
       end if;
 
       Self.Path := new String'(Name_Buffer (1 .. Name_Len));
diff --git a/gcc/ada/prj-env.ads b/gcc/ada/prj-env.ads
index f070a75..a7617af 100644
--- a/gcc/ada/prj-env.ads
+++ b/gcc/ada/prj-env.ads
@@ -171,14 +171,16 @@ package Prj.Env is
    No_Project_Search_Path : constant Project_Search_Path;
 
    procedure Initialize_Default_Project_Path
-     (Self        : in out Project_Search_Path;
-      Target_Name : String);
-   --  Initialize Self. It will then contain the default project path on the
-   --  given target (including directories specified by the environment
-   --  variables GPR_PROJECT_PATH_FILE, GPR_PROJECT_PATH and ADA_PROJECT_PATH).
-   --  If one of the directory or Target_Name is "-", then the path contains
-   --  only those directories specified by the environment variables (except
-   --  "-"). This does nothing if Self has already been initialized.
+     (Self         : in out Project_Search_Path;
+      Target_Name  : String;
+      Runtime_Name : String := "");
+   --  Initialize Self. It will then contain the default project path on
+   --  the given target and runtime (including directories specified by the
+   --  environment variables GPR_PROJECT_PATH_FILE, GPR_PROJECT_PATH and
+   --  ADA_PROJECT_PATH). If one of the directory or Target_Name is "-", then
+   --  the path contains only those directories specified by the environment
+   --  variables (except "-"). This does nothing if Self has already been
+   --  initialized.
 
    procedure Copy (From : Project_Search_Path; To : out Project_Search_Path);
    --  Copy From into To
diff --git a/gcc/ada/s-taskin.ads b/gcc/ada/s-taskin.ads
index b12af37..f48d98d 100644
--- a/gcc/ada/s-taskin.ads
+++ b/gcc/ada/s-taskin.ads
@@ -670,7 +670,7 @@ package System.Tasking is
       --  System-specific attributes of the task as specified by the
       --  Task_Info pragma.
 
-      Analyzer  : System.Stack_Usage.Stack_Analyzer;
+      Analyzer : System.Stack_Usage.Stack_Analyzer;
       --  For storing information used to measure the stack usage
 
       Global_Task_Lock_Nesting : Natural;
diff --git a/gcc/ada/s-traces.ads b/gcc/ada/s-traces.ads
index 7481982..89c7cc4 100644
--- a/gcc/ada/s-traces.ads
+++ b/gcc/ada/s-traces.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  S p e c                                 --
 --                                                                          --
---          Copyright (C) 2001-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-2014, 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- --
@@ -33,8 +33,7 @@
 
 --  Warning : NO dependencies to tasking should be created here
 
---  This package, and all its children are used to implement debug
---  information
+--  This package and all its children are used to implement debug information
 
 --  A new primitive, Send_Trace_Info (Id : Trace_T; 'data') is introduced.
 --  Trace_T is an event identifier, 'data' are the information to pass
@@ -50,7 +49,7 @@
 --  corresponding Send_Trace_Info procedure. It may be required for some
 --  target to modify Send_Trace (e.g. VxWorks).
 
---  To add a new target, just adapt System.Traces.Send to your own purposes
+--  To add a new target, just adapt System.Traces.Send as needed
 
 package System.Traces is
    pragma Preelaborate;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 75f430c..58acefd 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -11017,10 +11017,10 @@ package body Sem_Prag is
          --  processing is required here.
 
          when Pragma_Assertion_Policy => Assertion_Policy : declare
-            LocP   : Source_Ptr;
-            Policy : Node_Id;
             Arg    : Node_Id;
             Kind   : Name_Id;
+            LocP   : Source_Ptr;
+            Policy : Node_Id;
 
          begin
             Ada_2005_Pragma;
@@ -11102,12 +11102,17 @@ package body Sem_Prag is
                   Check_Arg_Is_One_Of
                     (Arg, Name_Check, Name_Disable, Name_Ignore);
 
-                  --  We rewrite the Assertion_Policy pragma as a series of
-                  --  Check_Policy pragmas:
+                  --  Rewrite the Assertion_Policy pragma as a series of
+                  --  Check_Policy pragmas of the form:
 
                   --    Check_Policy (Kind, Policy);
 
-                  Insert_Action (N,
+                  --  Note: the insertion of the pragmas cannot be done with
+                  --  Insert_Action because in the configuration case, there
+                  --  are no scopes on the scope stack and the mechanism will
+                  --  fail.
+
+                  Insert_Before_And_Analyze (N,
                     Make_Pragma (LocP,
                       Chars                        => Name_Check_Policy,
                       Pragma_Argument_Associations => New_List (
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 8b0f658..df88d43 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -4630,31 +4630,19 @@ package body Sem_Res is
                --  first place.
 
                if Ekind (Nam) = E_Procedure
+                 and then Ekind (F) = E_In_Parameter
                  and then Is_Entity_Name (A)
                  and then Present (Entity (A))
                  and then Ekind (Entity (A)) = E_Variable
                then
                   A_Id := Entity (A);
 
-                  if Ekind (F) = E_In_Parameter then
-                     if Async_Readers_Enabled (A_Id) then
-                        Property_Error (A, A_Id, Name_Async_Readers);
-                     elsif Effective_Reads_Enabled (A_Id) then
-                        Property_Error (A, A_Id, Name_Effective_Reads);
-                     elsif Effective_Writes_Enabled (A_Id) then
-                        Property_Error (A, A_Id, Name_Effective_Writes);
-                     end if;
-
-                  elsif Ekind (F) = E_Out_Parameter
-                    and then Async_Writers_Enabled (A_Id)
-                  then
-                     Error_Msg_Name_1 := Name_Async_Writers;
-                     Error_Msg_NE
-                       ("external variable & with enabled property % cannot "
-                        & "appear as actual in procedure call "
-                        & "(SPARK RM 7.1.3(11))", A, A_Id);
-                     Error_Msg_N
-                       ("\\corresponding formal parameter has mode Out", A);
+                  if Async_Readers_Enabled (A_Id) then
+                     Property_Error (A, A_Id, Name_Async_Readers);
+                  elsif Effective_Reads_Enabled (A_Id) then
+                     Property_Error (A, A_Id, Name_Effective_Reads);
+                  elsif Effective_Writes_Enabled (A_Id) then
+                     Property_Error (A, A_Id, Name_Effective_Writes);
                   end if;
                end if;
             end if;