[multiple changes]

2015-10-20  Thomas Quinot  <quinot@adacore.com>

	* Makefile.rtl: add the following...
	* g-binenv.ads, g-binenv.adb: New unit providing runtime access
	to bind time captured values ("bind environment")
	* init.c: declare new global variable __gl_bind_env_addr.
	* bindgen.ads, bindgen.adb (Set_Bind_Env): record a bind
	environment key=value pair.
	(Gen_Bind_Env_String): helper to produce the bind environment data
	called  in the binder generated file.
	(Gen_Output_File_Ada): Call the above (Gen_Adainit): Set
	__gl_bind_env_addr accordingly.
	* switch-b.adb: Support for command line switch -V (user interface
	to set a build environment key=value pair)
	* bindusg.adb: Document the above

2015-10-20  Vincent Celier  <celier@adacore.com>

	* sem_prag.adb (Analyse_Pragma: Pragma Pure): Do not set the
	entity as Pure if Debug_Flag_U is set.

From-SVN: r229031

gcc/ada/ChangeLog

+2015-10-20  Thomas Quinot  <quinot@adacore.com>
+
+	* Makefile.rtl: add the following...
+	* g-binenv.ads, g-binenv.adb: New unit providing runtime access
+	to bind time captured values ("bind environment")
+	* init.c: declare new global variable __gl_bind_env_addr.
+	* bindgen.ads, bindgen.adb (Set_Bind_Env): record a bind
+	environment key=value pair.
+	(Gen_Bind_Env_String): helper to produce the bind environment data
+	called  in the binder generated file.
+	(Gen_Output_File_Ada): Call the above (Gen_Adainit): Set
+	__gl_bind_env_addr accordingly.
+	* switch-b.adb: Support for command line switch -V (user interface
+	to set a build environment key=value pair)
+	* bindusg.adb: Document the above
+
+2015-10-20  Vincent Celier  <celier@adacore.com>
+
+	* sem_prag.adb (Analyse_Pragma: Pragma Pure): Do not set the
+	entity as Pure if Debug_Flag_U is set.
+
 2015-10-20  Bob Duff  <duff@adacore.com>
 
 	* output.adb (Write_Int): Work with negative numbers in order to avoid

gcc/ada/Makefile.rtl

@@ -380,6 +380,7 @@ GNATRTL_NONTASKING_OBJS= \
   directio$(objext) \
   g-arrspl$(objext) \
   g-awk$(objext) \
+  g-binenv$(objext) \
   g-bubsor$(objext) \
   g-busora$(objext) \
   g-busorg$(objext) \

gcc/ada/bindgen.adb

@@ -35,6 +35,7 @@ with Osint;    use Osint;
 with Osint.B;  use Osint.B;
 with Output;   use Output;
 with Rident;   use Rident;
+with Stringt;  use Stringt;
 with Table;    use Table;
 with Targparm; use Targparm;
 with Types;    use Types;
@@ -43,6 +44,7 @@ with System.OS_Lib;  use System.OS_Lib;
 with System.WCh_Con; use System.WCh_Con;
 
 with GNAT.Heap_Sort_A; use GNAT.Heap_Sort_A;
+with GNAT.HTable;
 
 package body Bindgen is
 
@@ -89,6 +91,9 @@ package body Bindgen is
    Lib_Final_Built : Boolean := False;
    --  Flag indicating whether the finalize_library rountine has been built
 
+   Bind_Env_String_Built : Boolean := False;
+   --  Flag indicating whether a bind environment string has been built
+
    CodePeer_Wrapper_Name : constant String := "call_main_subprogram";
    --  For CodePeer, introduce a wrapper subprogram which calls the
    --  user-defined main subprogram.
@@ -124,6 +129,22 @@ package body Bindgen is
      Table_Increment      => 200,
      Table_Name           => "PSD_Pragma_Settings");
 
+   ----------------------------
+   -- Bind_Environment Table --
+   ----------------------------
+
+   subtype Header_Num is Int range 0 .. 36;
+
+   function Hash (Nam : Name_Id) return Header_Num;
+
+   package Bind_Environment is new GNAT.HTable.Simple_HTable
+     (Header_Num => Header_Num,
+      Element    => Name_Id,
+      No_Element => No_Name,
+      Key        => Name_Id,
+      Hash       => Hash,
+      Equal      => "=");
+
    ----------------------
    -- Run-Time Globals --
    ----------------------
@@ -246,6 +267,9 @@ package body Bindgen is
    procedure Gen_Adafinal;
    --  Generate the Adafinal procedure
 
+   procedure Gen_Bind_Env_String;
+   --  Generate the bind environment buffer
+
    procedure Gen_CodePeer_Wrapper;
    --  For CodePeer, generate wrapper which calls user-defined main subprogram
 
@@ -369,6 +393,10 @@ package body Bindgen is
    --  First writes its argument (using Set_String (S)), then writes out the
    --  contents of statement buffer up to Last, and reset Last to 0
 
+   procedure Write_Bind_Line (S : String);
+   --  Write S (an LF-terminated string) to the binder file (for use with
+   --  Set_Special_Output).
+
    ------------------
    -- Gen_Adafinal --
    ------------------
@@ -594,6 +622,9 @@ package body Bindgen is
          WBI ("      Leap_Seconds_Support : Integer;");
          WBI ("      pragma Import (C, Leap_Seconds_Support, " &
               """__gl_leap_seconds_support"");");
+         WBI ("      Bind_Env_Addr : System.Address;");
+         WBI ("      pragma Import (C, Bind_Env_Addr, " &
+              """__gl_bind_env_addr"");");
 
          --  Import entry point for elaboration time signal handler
          --  installation, and indication of if it's been called previously.
@@ -663,6 +694,8 @@ package body Bindgen is
                  & """__gnat_freeze_dispatching_domains"");");
          end if;
 
+         --  Start of processing for Adainit
+
          WBI ("   begin");
          WBI ("      if Is_Elaborated then");
          WBI ("         return;");
@@ -793,6 +826,10 @@ package body Bindgen is
          Set_String (";");
          Write_Statement_Buffer;
 
+         if Bind_Env_String_Built then
+            WBI ("      Bind_Env_Addr := Bind_Env'Address;");
+         end if;
+
          --  Generate call to Install_Handler
 
          WBI ("");
@@ -897,6 +934,62 @@ package body Bindgen is
       WBI ("");
    end Gen_Adainit;
 
+   -------------------------
+   -- Gen_Bind_Env_String --
+   -------------------------
+
+   procedure Gen_Bind_Env_String is
+      KN, VN : Name_Id := No_Name;
+      Amp    : Character;
+
+      procedure Write_Name_With_Len (Nam : Name_Id);
+      --  Write Nam as a string literal, prefixed with one
+      --  character encoding Nam's length.
+
+      -------------------------
+      -- Write_Name_With_Len --
+      -------------------------
+
+      procedure Write_Name_With_Len (Nam : Name_Id) is
+      begin
+         Get_Name_String (Nam);
+
+         Start_String;
+         Store_String_Char (Character'Val (Name_Len));
+         Store_String_Chars (Name_Buffer (1 .. Name_Len));
+
+         Write_String_Table_Entry (End_String);
+      end Write_Name_With_Len;
+
+   --  Start of processing for Gen_Bind_Env_String
+
+   begin
+      Bind_Environment.Get_First (KN, VN);
+      if VN = No_Name then
+         return;
+      end if;
+
+      Set_Special_Output (Write_Bind_Line'Access);
+
+      WBI ("   Bind_Env : aliased constant String :=");
+      Amp := ' ';
+      while VN /= No_Name loop
+         Write_Str ("     " & Amp & ' ');
+         Write_Name_With_Len (KN);
+         Write_Str (" & ");
+         Write_Name_With_Len (VN);
+         Write_Eol;
+
+         Bind_Environment.Get_Next (KN, VN);
+         Amp := '&';
+      end loop;
+      WBI ("     & ASCII.NUL;");
+
+      Set_Special_Output (null);
+
+      Bind_Env_String_Built := True;
+   end Gen_Bind_Env_String;
+
    --------------------------
    -- Gen_CodePeer_Wrapper --
    --------------------------
@@ -2279,13 +2372,18 @@ package body Bindgen is
             WBI ("");
          end if;
 
-         --  The B.1 (39) implementation advice says that the adainit/adafinal
-         --  routines should be idempotent. Generate a flag to ensure that.
-         --  This is not needed if we are suppressing the standard library
-         --  since it would never be referenced.
-
          if not Suppress_Standard_Library_On_Target then
+
+            --  The B.1(39) implementation advice says that the adainit
+            --  and adafinal routines should be idempotent. Generate a flag to
+            --  ensure that. This is not needed if we are suppressing the
+            --  standard library since it would never be referenced.
+
             WBI ("   Is_Elaborated : Boolean := False;");
+
+            --  Generate bind environment string
+
+            Gen_Bind_Env_String;
          end if;
 
          WBI ("");
@@ -2656,6 +2754,15 @@ package body Bindgen is
       return False;
    end Has_Finalizer;
 
+   ----------
+   -- Hash --
+   ----------
+
+   function Hash (Nam : Name_Id) return Header_Num is
+   begin
+      return Int (Nam - Names_Low_Bound) rem Header_Num'Last;
+   end Hash;
+
    ----------------------
    -- Lt_Linker_Option --
    ----------------------
@@ -2754,6 +2861,25 @@ package body Bindgen is
       end loop;
    end Resolve_Binder_Options;
 
+   ------------------
+   -- Set_Bind_Env --
+   ------------------
+
+   procedure Set_Bind_Env (Key, Value : String) is
+   begin
+      --  The lengths of Key and Value are stored as single bytes
+
+      if Key'Length > 255 then
+         Osint.Fail ("bind environment key """ & Key & """ too long");
+      end if;
+
+      if Value'Length > 255 then
+         Osint.Fail ("bind environment value """ & Value & """ too long");
+      end if;
+
+      Bind_Environment.Set (Name_Find_Str (Key), Name_Find_Str (Value));
+   end Set_Bind_Env;
+
    -----------------
    -- Set_Boolean --
    -----------------
@@ -2945,6 +3071,17 @@ package body Bindgen is
       Set_Int (Unum);
    end Set_Unit_Number;
 
+   ---------------------
+   -- Write_Bind_Line --
+   ---------------------
+
+   procedure Write_Bind_Line (S : String) is
+   begin
+      --  Need to strip trailing LF from S
+
+      WBI (S (S'First .. S'Last - 1));
+   end Write_Bind_Line;
+
    ----------------------------
    -- Write_Statement_Buffer --
    ----------------------------

gcc/ada/bindgen.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, 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- --
@@ -37,4 +37,8 @@ package Bindgen is
    procedure Gen_Output_File (Filename : String);
    --  Filename is the full path name of the binder output file
 
+   procedure Set_Bind_Env (Key, Value : String);
+   --  Add (Key, Value) pair to bind environment. These associations
+   --  are made available at run time using System.Bind_Environment.
+
 end Bindgen;

gcc/ada/bindusg.adb

@@ -4,9 +4,9 @@
 --                                                                          --
 --                             B I N D U S G                                --
 --                                                                          --
---                                B o d y                                   --
+--                                 B o d y                                  --
 --                                                                          --
---          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- --
@@ -228,6 +228,10 @@ package body Bindusg is
       Write_Line ("  -v        Verbose mode. Error messages, " &
                   "header, summary output to stdout");
 
+      --  Line for -V switch
+
+      Write_Line ("  -Vkey=val Record bind-time variable key " &
+                  "with value val");
       --  Line for -w switch
 
       Write_Line ("  -wx       Warning mode. (x=s/e for " &

gcc/ada/g-binenv.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
+--                                                                          --
+--                  G N A T . B I N D _ E N V I R O N M E N T               --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--             Copyright (C) 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNARL was developed by the GNARL team at Florida State University.       --
+-- Extensive contributions were provided by AdaCore.                        --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with System;
+
+package body GNAT.Bind_Environment is
+
+   ---------
+   -- Get --
+   ---------
+
+   function Get (Key : String) return String is
+      use type System.Address;
+
+      Bind_Env_Addr : System.Address;
+      pragma Import (C, Bind_Env_Addr, "__gl_bind_env_addr");
+      --  Variable provided by init.c/s-init.ads, and initialized by
+      --  the binder generated file.
+
+      Bind_Env : String (Positive);
+      for Bind_Env'Address use Bind_Env_Addr;
+      pragma Import (Ada, Bind_Env);
+      --  Import Bind_Env string from binder file. Note that we import
+      --  it here as a string with maximum boundaries. The "real" end
+      --  of the string is indicated by a NUL byte.
+
+      Index, KLen, VLen : Integer;
+
+   begin
+      if Bind_Env_Addr = System.Null_Address then
+         return "";
+      end if;
+
+      Index := Bind_Env'First;
+      loop
+         --  Index points to key length
+
+         VLen := 0;
+         KLen := Character'Pos (Bind_Env (Index));
+         exit when KLen = 0;
+
+         Index := Index + KLen + 1;
+
+         --  Index points to value length
+
+         VLen := Character'Pos (Bind_Env (Index));
+         exit when Bind_Env (Index - KLen .. Index - 1) = Key;
+
+         Index := Index + VLen + 1;
+      end loop;
+
+      return Bind_Env (Index + 1 .. Index + VLen);
+   end Get;
+
+end GNAT.Bind_Environment;

gcc/ada/g-binenv.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
+--                                                                          --
+--                  G N A T . B I N D _ E N V I R O N M E N T               --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--             Copyright (C) 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNARL was developed by the GNARL team at Florida State University.       --
+-- Extensive contributions were provided by AdaCore.                        --
+--                                                                          --
+------------------------------------------------------------------------------
+
+package GNAT.Bind_Environment is
+
+   pragma Pure;
+
+   function Get (Key : String) return String;
+   --  Return the value associated with Key at bind time,
+   --  or an empty string if not found.
+
+end GNAT.Bind_Environment;

gcc/ada/gnatbind.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          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- --
@@ -560,7 +560,16 @@ begin
       Shared_Libgnat := (Shared_Libgnat_Default = SHARED);
    end;
 
-   --  Scan the switches and arguments
+   --  Carry out package initializations. These are initializations which
+   --  might logically be performed at elaboration time, and we decide to be
+   --  consistent. Like elaboration, the order in which these calls are made
+   --  is in some cases important.
+
+   Csets.Initialize;
+   Snames.Initialize;
+
+   --  Scan the switches and arguments. Note that Snames must already be
+   --  initialized (for processing of the -V switch).
 
    --  First, scan to detect --version and/or --help
 
@@ -616,14 +625,6 @@ begin
 
    Osint.Add_Default_Search_Dirs;
 
-   --  Carry out package initializations. These are initializations which
-   --  might logically be performed at elaboration time, and we decide to be
-   --  consistent. Like elaboration, the order in which these calls are made
-   --  is in some cases important.
-
-   Csets.Initialize;
-   Snames.Initialize;
-
    --  Acquire target parameters
 
    Targparm.Get_Target_Parameters;

gcc/ada/impunit.adb

@@ -238,6 +238,7 @@ package body Impunit is
     ("g-alvevi", F),  -- GNAT.Altivec.Vector_Views
     ("g-arrspl", F),  -- GNAT.Array_Split
     ("g-awk   ", F),  -- GNAT.AWK
+    ("g-binenv", F),  -- GNAT.Bind_Environment
     ("g-boubuf", F),  -- GNAT.Bounded_Buffers
     ("g-boumai", F),  -- GNAT.Bounded_Mailboxes
     ("g-bubsor", F),  -- GNAT.Bubble_Sort

gcc/ada/init.c

@@ -93,7 +93,9 @@ extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *);
 extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *);
 #endif
 
-/* Global values computed by the binder.  */
+/* Global values computed by the binder.  Note that these variables are
+   declared here, not in the binder file, to avoid having unresolved
+   references in the shared libgnat.  */
 int   __gl_main_priority                 = -1;
 int   __gl_main_cpu                      = -1;
 int   __gl_time_slice_val                = -1;
@@ -111,6 +113,7 @@ int   __gl_detect_blocking               = 0;
 int   __gl_default_stack_size            = -1;
 int   __gl_leap_seconds_support          = 0;
 int   __gl_canonical_streams             = 0;
+char *__gl_bind_env_addr                 = NULL;
 
 /* This value is not used anymore, but kept for bootstrapping purpose.  */
 int   __gl_zero_cost_exceptions          = 0;

gcc/ada/sem_prag.adb

@@ -18580,9 +18580,12 @@ package body Sem_Prag is
             --  purposes of legality checks and removal of ignored Ghost code.
 
             Mark_Pragma_As_Ghost (N, Ent);
-            Set_Is_Pure (Ent);
-            Set_Has_Pragma_Pure (Ent);
-            Set_Suppress_Elaboration_Warnings (Ent);
+
+            if not Debug_Flag_U then
+               Set_Is_Pure (Ent);
+               Set_Has_Pragma_Pure (Ent);
+               Set_Suppress_Elaboration_Warnings (Ent);
+            end if;
          end Pure;
 
          -------------------

gcc/ada/switch-b.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2001-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-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- --
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Bindgen;
 with Debug;  use Debug;
 with Osint;  use Osint;
 with Opt;    use Opt;
@@ -417,6 +418,26 @@ package body Switch.B is
             Ptr := Ptr + 1;
             Verbose_Mode := True;
 
+         --  Processing for V switch
+
+         when 'V' =>
+            declare
+               Eq : Integer;
+            begin
+               Ptr := Ptr + 1;
+               Eq := Ptr;
+               while Eq <= Max and then Switch_Chars (Eq) /= '=' loop
+                  Eq := Eq + 1;
+               end loop;
+               if Eq = Ptr or else Eq = Max then
+                  Bad_Switch (Switch_Chars);
+               end if;
+               Bindgen.Set_Bind_Env
+                 (Key   => Switch_Chars (Ptr .. Eq - 1),
+                  Value => Switch_Chars (Eq + 1 .. Max));
+               Ptr := Max + 1;
+            end;
+
          --  Processing for w switch
 
          when 'w' =>