adaint.c: New function __gnat_get_env_vars_case_sensitive...

2010-09-09  Vincent Celier  <celier@adacore.com>

	* adaint.c: New function __gnat_get_env_vars_case_sensitive, returns 0
	for VMS and Windows, and 1 for all other platforms.
	* adaint.h: New function __gnat_get_env_vars_case_sensitive
	* osint.ads, osint.adb (Canonical_Case_Env_Var_Name): New procedure.
	* prj-ext.adb (Add): Call Canonical_Case_Env_Var_Name instead of
	Canonical_Case_File_Name, as we are dealing with environment variables,
	not files.

From-SVN: r164069

gcc/ada/ChangeLog

+2010-09-09  Vincent Celier  <celier@adacore.com>
+
+	* adaint.c: New function __gnat_get_env_vars_case_sensitive, returns 0
+	for VMS and Windows, and 1 for all other platforms.
+	* adaint.h: New function __gnat_get_env_vars_case_sensitive
+	* osint.ads, osint.adb (Canonical_Case_Env_Var_Name): New procedure.
+	* prj-ext.adb (Add): Call Canonical_Case_Env_Var_Name instead of
+	Canonical_Case_File_Name, as we are dealing with environment variables,
+	not files.
+
 2010-09-09  Robert Dewar  <dewar@adacore.com>
 
 	* sem_util.adb: Minor reformatting

gcc/ada/adaint.c

@@ -586,6 +586,18 @@ __gnat_get_file_names_case_sensitive (void)
 #endif
 }
 
+/* Return nonzero if environment variables are case sensitive.  */
+
+int
+__gnat_get_env_vars_case_sensitive (void)
+{
+#if defined (VMS) || defined (WINNT)
+ return 0;
+#else
+ return 1;
+#endif
+}
+
 char
 __gnat_get_default_identifier_character_set (void)
 {

gcc/ada/adaint.h

@@ -6,7 +6,7 @@
  *                                                                          *
  *                              C Header File                               *
  *                                                                          *
- *          Copyright (C) 1992-2009, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2010, 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- *
@@ -101,6 +101,7 @@ extern void   __gnat_to_gm_time			   (OS_Time *, int *, int *,
 extern int    __gnat_get_maximum_file_name_length  (void);
 extern int    __gnat_get_switches_case_sensitive   (void);
 extern int    __gnat_get_file_names_case_sensitive (void);
+extern int    __gnat_get_env_vars_case_sensitive   (void);
 extern char   __gnat_get_default_identifier_character_set (void);
 extern void   __gnat_get_current_dir		   (char *, int *);
 extern void   __gnat_get_object_suffix_ptr         (int *,

gcc/ada/osint.adb

@@ -696,15 +696,33 @@ package body Osint is
       if not File_Names_Case_Sensitive then
          for J in S'Range loop
             if S (J) in 'A' .. 'Z' then
-               S (J) := Character'Val (
-                          Character'Pos (S (J)) +
-                          Character'Pos ('a')   -
-                          Character'Pos ('A'));
+               S (J) :=
+                 Character'Val
+                   (Character'Pos (S (J)) +
+                     (Character'Pos ('a') - Character'Pos ('A')));
             end if;
          end loop;
       end if;
    end Canonical_Case_File_Name;
 
+   ---------------------------------
+   -- Canonical_Case_Env_Var_Name --
+   ---------------------------------
+
+   procedure Canonical_Case_Env_Var_Name (S : in out String) is
+   begin
+      if not Env_Vars_Case_Sensitive then
+         for J in S'Range loop
+            if S (J) in 'A' .. 'Z' then
+               S (J) := Character'Val (
+                 Character'Pos (S (J)) +
+                   Character'Pos ('a')   -
+                   Character'Pos ('A'));
+            end if;
+         end loop;
+      end if;
+   end Canonical_Case_Env_Var_Name;
+
    ---------------------------
    -- Create_File_And_Check --
    ---------------------------

gcc/ada/osint.ads

@@ -94,6 +94,23 @@ package Osint is
    --  this call converts the given string to canonical all lower case form,
    --  so that two file names compare equal if they refer to the same file.
 
+   function Get_Env_Vars_Case_Sensitive return Int;
+   pragma Import (C, Get_Env_Vars_Case_Sensitive,
+                  "__gnat_get_env_vars_case_sensitive");
+   Env_Vars_Case_Sensitive : constant Boolean :=
+                                 Get_File_Names_Case_Sensitive /= 0;
+   --  Set to indicate whether the operating system convention is for
+   --  environment variable names to be case sensitive (e.g., in Unix, set
+   --  True), or non case sensitive (e.g., in Windows, set False).
+
+   procedure Canonical_Case_Env_Var_Name (S : in out String);
+   --  Given an environment variable name, converts it to canonical case form.
+   --  For systems where environment variable names are case sensitive, this
+   --  procedure has no effect. If environment variable names are not case
+   --  sensitive, then this call converts the given string to canonical all
+   --  lower case form, so that two environment variable names compare equal if
+   --  they refer to the same environment variable.
+
    function Number_Of_Files return Int;
    --  Gives the total number of filenames found on the command line
 

gcc/ada/prj-ext.adb

@@ -60,7 +60,7 @@ package body Prj.Ext is
       The_Value := Name_Find;
       Name_Len := External_Name'Length;
       Name_Buffer (1 .. Name_Len) := External_Name;
-      Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+      Canonical_Case_Env_Var_Name (Name_Buffer (1 .. Name_Len));
       The_Key := Name_Find;
       Name_To_Name_HTable.Set (Tree.External_References, The_Key, The_Value);
    end Add;
@@ -327,7 +327,7 @@ package body Prj.Ext is
       Name      : String := Get_Name_String (External_Name);
 
    begin
-      Canonical_Case_File_Name (Name);
+      Canonical_Case_Env_Var_Name (Name);
       Name_Len := Name'Length;
       Name_Buffer (1 .. Name_Len) := Name;
       The_Value :=