Commit 3c777b50 by Arnaud Charlet

[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
parent 7188885e
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> 2015-10-20 Bob Duff <duff@adacore.com>
* output.adb (Write_Int): Work with negative numbers in order to avoid * output.adb (Write_Int): Work with negative numbers in order to avoid
......
...@@ -380,6 +380,7 @@ GNATRTL_NONTASKING_OBJS= \ ...@@ -380,6 +380,7 @@ GNATRTL_NONTASKING_OBJS= \
directio$(objext) \ directio$(objext) \
g-arrspl$(objext) \ g-arrspl$(objext) \
g-awk$(objext) \ g-awk$(objext) \
g-binenv$(objext) \
g-bubsor$(objext) \ g-bubsor$(objext) \
g-busora$(objext) \ g-busora$(objext) \
g-busorg$(objext) \ g-busorg$(objext) \
......
...@@ -35,6 +35,7 @@ with Osint; use Osint; ...@@ -35,6 +35,7 @@ with Osint; use Osint;
with Osint.B; use Osint.B; with Osint.B; use Osint.B;
with Output; use Output; with Output; use Output;
with Rident; use Rident; with Rident; use Rident;
with Stringt; use Stringt;
with Table; use Table; with Table; use Table;
with Targparm; use Targparm; with Targparm; use Targparm;
with Types; use Types; with Types; use Types;
...@@ -43,6 +44,7 @@ with System.OS_Lib; use System.OS_Lib; ...@@ -43,6 +44,7 @@ with System.OS_Lib; use System.OS_Lib;
with System.WCh_Con; use System.WCh_Con; with System.WCh_Con; use System.WCh_Con;
with GNAT.Heap_Sort_A; use GNAT.Heap_Sort_A; with GNAT.Heap_Sort_A; use GNAT.Heap_Sort_A;
with GNAT.HTable;
package body Bindgen is package body Bindgen is
...@@ -89,6 +91,9 @@ package body Bindgen is ...@@ -89,6 +91,9 @@ package body Bindgen is
Lib_Final_Built : Boolean := False; Lib_Final_Built : Boolean := False;
-- Flag indicating whether the finalize_library rountine has been built -- 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"; CodePeer_Wrapper_Name : constant String := "call_main_subprogram";
-- For CodePeer, introduce a wrapper subprogram which calls the -- For CodePeer, introduce a wrapper subprogram which calls the
-- user-defined main subprogram. -- user-defined main subprogram.
...@@ -124,6 +129,22 @@ package body Bindgen is ...@@ -124,6 +129,22 @@ package body Bindgen is
Table_Increment => 200, Table_Increment => 200,
Table_Name => "PSD_Pragma_Settings"); 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 -- -- Run-Time Globals --
---------------------- ----------------------
...@@ -246,6 +267,9 @@ package body Bindgen is ...@@ -246,6 +267,9 @@ package body Bindgen is
procedure Gen_Adafinal; procedure Gen_Adafinal;
-- Generate the Adafinal procedure -- Generate the Adafinal procedure
procedure Gen_Bind_Env_String;
-- Generate the bind environment buffer
procedure Gen_CodePeer_Wrapper; procedure Gen_CodePeer_Wrapper;
-- For CodePeer, generate wrapper which calls user-defined main subprogram -- For CodePeer, generate wrapper which calls user-defined main subprogram
...@@ -369,6 +393,10 @@ package body Bindgen is ...@@ -369,6 +393,10 @@ package body Bindgen is
-- First writes its argument (using Set_String (S)), then writes out the -- First writes its argument (using Set_String (S)), then writes out the
-- contents of statement buffer up to Last, and reset Last to 0 -- 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 -- -- Gen_Adafinal --
------------------ ------------------
...@@ -594,6 +622,9 @@ package body Bindgen is ...@@ -594,6 +622,9 @@ package body Bindgen is
WBI (" Leap_Seconds_Support : Integer;"); WBI (" Leap_Seconds_Support : Integer;");
WBI (" pragma Import (C, Leap_Seconds_Support, " & WBI (" pragma Import (C, Leap_Seconds_Support, " &
"""__gl_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 -- Import entry point for elaboration time signal handler
-- installation, and indication of if it's been called previously. -- installation, and indication of if it's been called previously.
...@@ -663,6 +694,8 @@ package body Bindgen is ...@@ -663,6 +694,8 @@ package body Bindgen is
& """__gnat_freeze_dispatching_domains"");"); & """__gnat_freeze_dispatching_domains"");");
end if; end if;
-- Start of processing for Adainit
WBI (" begin"); WBI (" begin");
WBI (" if Is_Elaborated then"); WBI (" if Is_Elaborated then");
WBI (" return;"); WBI (" return;");
...@@ -793,6 +826,10 @@ package body Bindgen is ...@@ -793,6 +826,10 @@ package body Bindgen is
Set_String (";"); Set_String (";");
Write_Statement_Buffer; Write_Statement_Buffer;
if Bind_Env_String_Built then
WBI (" Bind_Env_Addr := Bind_Env'Address;");
end if;
-- Generate call to Install_Handler -- Generate call to Install_Handler
WBI (""); WBI ("");
...@@ -897,6 +934,62 @@ package body Bindgen is ...@@ -897,6 +934,62 @@ package body Bindgen is
WBI (""); WBI ("");
end Gen_Adainit; 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 -- -- Gen_CodePeer_Wrapper --
-------------------------- --------------------------
...@@ -2279,13 +2372,18 @@ package body Bindgen is ...@@ -2279,13 +2372,18 @@ package body Bindgen is
WBI (""); WBI ("");
end if; 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 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;"); WBI (" Is_Elaborated : Boolean := False;");
-- Generate bind environment string
Gen_Bind_Env_String;
end if; end if;
WBI (""); WBI ("");
...@@ -2656,6 +2754,15 @@ package body Bindgen is ...@@ -2656,6 +2754,15 @@ package body Bindgen is
return False; return False;
end Has_Finalizer; 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 -- -- Lt_Linker_Option --
---------------------- ----------------------
...@@ -2754,6 +2861,25 @@ package body Bindgen is ...@@ -2754,6 +2861,25 @@ package body Bindgen is
end loop; end loop;
end Resolve_Binder_Options; 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 -- -- Set_Boolean --
----------------- -----------------
...@@ -2945,6 +3071,17 @@ package body Bindgen is ...@@ -2945,6 +3071,17 @@ package body Bindgen is
Set_Int (Unum); Set_Int (Unum);
end Set_Unit_Number; 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 -- -- Write_Statement_Buffer --
---------------------------- ----------------------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -37,4 +37,8 @@ package Bindgen is ...@@ -37,4 +37,8 @@ package Bindgen is
procedure Gen_Output_File (Filename : String); procedure Gen_Output_File (Filename : String);
-- Filename is the full path name of the binder output file -- 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; end Bindgen;
...@@ -4,9 +4,9 @@ ...@@ -4,9 +4,9 @@
-- -- -- --
-- B I N D U S G -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -228,6 +228,10 @@ package body Bindusg is ...@@ -228,6 +228,10 @@ package body Bindusg is
Write_Line (" -v Verbose mode. Error messages, " & Write_Line (" -v Verbose mode. Error messages, " &
"header, summary output to stdout"); "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 -- Line for -w switch
Write_Line (" -wx Warning mode. (x=s/e for " & Write_Line (" -wx Warning mode. (x=s/e for " &
......
------------------------------------------------------------------------------
-- --
-- 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;
------------------------------------------------------------------------------
-- --
-- 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;
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -560,7 +560,16 @@ begin ...@@ -560,7 +560,16 @@ begin
Shared_Libgnat := (Shared_Libgnat_Default = SHARED); Shared_Libgnat := (Shared_Libgnat_Default = SHARED);
end; 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 -- First, scan to detect --version and/or --help
...@@ -616,14 +625,6 @@ begin ...@@ -616,14 +625,6 @@ begin
Osint.Add_Default_Search_Dirs; 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 -- Acquire target parameters
Targparm.Get_Target_Parameters; Targparm.Get_Target_Parameters;
......
...@@ -238,6 +238,7 @@ package body Impunit is ...@@ -238,6 +238,7 @@ package body Impunit is
("g-alvevi", F), -- GNAT.Altivec.Vector_Views ("g-alvevi", F), -- GNAT.Altivec.Vector_Views
("g-arrspl", F), -- GNAT.Array_Split ("g-arrspl", F), -- GNAT.Array_Split
("g-awk ", F), -- GNAT.AWK ("g-awk ", F), -- GNAT.AWK
("g-binenv", F), -- GNAT.Bind_Environment
("g-boubuf", F), -- GNAT.Bounded_Buffers ("g-boubuf", F), -- GNAT.Bounded_Buffers
("g-boumai", F), -- GNAT.Bounded_Mailboxes ("g-boumai", F), -- GNAT.Bounded_Mailboxes
("g-bubsor", F), -- GNAT.Bubble_Sort ("g-bubsor", F), -- GNAT.Bubble_Sort
......
...@@ -93,7 +93,9 @@ extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *); ...@@ -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 *); extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *);
#endif #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_priority = -1;
int __gl_main_cpu = -1; int __gl_main_cpu = -1;
int __gl_time_slice_val = -1; int __gl_time_slice_val = -1;
...@@ -111,6 +113,7 @@ int __gl_detect_blocking = 0; ...@@ -111,6 +113,7 @@ int __gl_detect_blocking = 0;
int __gl_default_stack_size = -1; int __gl_default_stack_size = -1;
int __gl_leap_seconds_support = 0; int __gl_leap_seconds_support = 0;
int __gl_canonical_streams = 0; int __gl_canonical_streams = 0;
char *__gl_bind_env_addr = NULL;
/* This value is not used anymore, but kept for bootstrapping purpose. */ /* This value is not used anymore, but kept for bootstrapping purpose. */
int __gl_zero_cost_exceptions = 0; int __gl_zero_cost_exceptions = 0;
......
...@@ -18580,9 +18580,12 @@ package body Sem_Prag is ...@@ -18580,9 +18580,12 @@ package body Sem_Prag is
-- purposes of legality checks and removal of ignored Ghost code. -- purposes of legality checks and removal of ignored Ghost code.
Mark_Pragma_As_Ghost (N, Ent); Mark_Pragma_As_Ghost (N, Ent);
Set_Is_Pure (Ent);
Set_Has_Pragma_Pure (Ent); if not Debug_Flag_U then
Set_Suppress_Elaboration_Warnings (Ent); Set_Is_Pure (Ent);
Set_Has_Pragma_Pure (Ent);
Set_Suppress_Elaboration_Warnings (Ent);
end if;
end Pure; end Pure;
------------------- -------------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -23,6 +23,7 @@ ...@@ -23,6 +23,7 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Bindgen;
with Debug; use Debug; with Debug; use Debug;
with Osint; use Osint; with Osint; use Osint;
with Opt; use Opt; with Opt; use Opt;
...@@ -417,6 +418,26 @@ package body Switch.B is ...@@ -417,6 +418,26 @@ package body Switch.B is
Ptr := Ptr + 1; Ptr := Ptr + 1;
Verbose_Mode := True; 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 -- Processing for w switch
when 'w' => when 'w' =>
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment