[multiple changes]

2009-04-20  Pascal Obry  <obry@adacore.com>

	* a-direct.adb (To_Lower_If_Case_Insensitive): Removed.
	Remove all calls to To_Lower_If_Case_Insensitive to preserve
	the pathname original casing.

2009-04-20  Robert Dewar  <dewar@adacore.com>

	* g-trasym.adb: Minor reformatting

	* s-os_lib.adb: Minor reformatting

	* sem.adb: Minor reformatting
	Minor code reorganization

	* sem_ch3.adb: Minor reformatting

	* sem_ch4.adb: Minor reformatting

	* sem_ch8.adb: Minor reformatting

	* sem_type.adb: Minor reformatting

From-SVN: r146412

gcc/ada/ChangeLog

+2009-04-20  Pascal Obry  <obry@adacore.com>
+
+	* a-direct.adb (To_Lower_If_Case_Insensitive): Removed.
+	Remove all calls to To_Lower_If_Case_Insensitive to preserve
+	the pathname original casing.
+
+2009-04-20  Robert Dewar  <dewar@adacore.com>
+
+	* g-trasym.adb: Minor reformatting
+
+	* s-os_lib.adb: Minor reformatting
+
+	* sem.adb: Minor reformatting
+	Minor code reorganization
+
+	* sem_ch3.adb: Minor reformatting
+
+	* sem_ch4.adb: Minor reformatting
+
+	* sem_ch8.adb: Minor reformatting
+
+	* sem_type.adb: Minor reformatting
+
 2009-04-20  Javier Miranda  <miranda@adacore.com>
 
 	* sem_disp.adb (Find_Dispatching_Type): For subprograms internally

gcc/ada/a-direct.adb

@@ -93,20 +93,15 @@ package body Ada.Directories is
    --  Get the next entry in a directory, setting Entry_Fetched if successful
    --  or resetting Is_Valid if not.
 
-   procedure To_Lower_If_Case_Insensitive (S : in out String);
-   --  Put S in lower case if file and path names are case-insensitive
-
    ---------------
    -- Base_Name --
    ---------------
 
    function Base_Name (Name : String) return String is
-      Simple : String := Simple_Name (Name);
+      Simple : constant String := Simple_Name (Name);
       --  Simple'First is guaranteed to be 1
 
    begin
-      To_Lower_If_Case_Insensitive (Simple);
-
       --  Look for the last dot in the file name and return the part of the
       --  file name preceding this last dot. If the first dot is the first
       --  character of the file name, the base name is the empty string.
@@ -198,7 +193,6 @@ package body Ada.Directories is
             Last := Last + Extension'Length;
          end if;
 
-         To_Lower_If_Case_Insensitive (Result (1 .. Last));
          return Result (1 .. Last);
       end if;
    end Compose;
@@ -287,7 +281,6 @@ package body Ada.Directories is
                      return Containing_Directory (Current_Directory);
 
                   else
-                     To_Lower_If_Case_Insensitive (Result (1 .. Last));
                      return Result (1 .. Last);
                   end if;
                end;
@@ -448,11 +441,9 @@ package body Ada.Directories is
       Local_Get_Current_Dir (Buffer'Address, Path_Len'Address);
 
       declare
-         Cur : String := Normalize_Pathname (Buffer (1 .. Path_Len));
+         Cur : constant String := Normalize_Pathname (Buffer (1 .. Path_Len));
 
       begin
-         To_Lower_If_Case_Insensitive (Cur);
-
          if Cur'Length > 1 and then Cur (Cur'Last) = Dir_Separator then
             return Cur (1 .. Cur'Last - 1);
          else
@@ -790,10 +781,9 @@ package body Ada.Directories is
          --  Use System.OS_Lib.Normalize_Pathname
 
          declare
-            Value : String := Normalize_Pathname (Name);
+            Value : constant String := Normalize_Pathname (Name);
             subtype Result is String (1 .. Value'Length);
          begin
-            To_Lower_If_Case_Insensitive (Value);
             return Result (Value);
          end;
       end if;
@@ -1061,18 +1051,14 @@ package body Ada.Directories is
 
    function Simple_Name (Name : String) return String is
 
-      function Simple_Name_CI (Path : String) return String;
-      --  This function does the job. The difference between Simple_Name_CI
-      --  and Simple_Name (the parent function) is that the former is case
-      --  sensitive, while the latter is not. Path and Suffix are adjusted
-      --  appropriately before calling Simple_Name_CI under platforms where
-      --  the file system is not case sensitive.
+      function Simple_Name_Internal (Path : String) return String;
+      --  This function does the job
 
-      --------------------
-      -- Simple_Name_CI --
-      --------------------
+      --------------------------
+      -- Simple_Name_Internal --
+      --------------------------
 
-      function Simple_Name_CI (Path : String) return String is
+      function Simple_Name_Internal (Path : String) return String is
          Cut_Start : Natural :=
                        Strings.Fixed.Index
                          (Path, Dir_Seps, Going => Strings.Backward);
@@ -1093,11 +1079,7 @@ package body Ada.Directories is
          Cut_End := Path'Last;
 
          Check_For_Standard_Dirs : declare
-            Offset : constant Integer := Path'First - Name'First;
-            BN     : constant String  :=
-                       Name (Cut_Start - Offset .. Cut_End - Offset);
-            --  Here we use Simple_Name.Name to keep the original casing
-
+            BN               : constant String := Path (Cut_Start .. Cut_End);
             Has_Drive_Letter : constant Boolean :=
                                  System.OS_Lib.Path_Separator /= ':';
             --  If Path separator is not ':' then we are on a DOS based OS
@@ -1120,7 +1102,7 @@ package body Ada.Directories is
                return BN;
             end if;
          end Check_For_Standard_Dirs;
-      end Simple_Name_CI;
+      end Simple_Name_Internal;
 
    --  Start of processing for Simple_Name
 
@@ -1133,23 +1115,12 @@ package body Ada.Directories is
       else
          --  Build the value to return with lower bound 1
 
-         if Is_Path_Name_Case_Sensitive then
-            declare
-               Value : constant String := Simple_Name_CI (Name);
-               subtype Result is String (1 .. Value'Length);
-            begin
-               return Result (Value);
-            end;
-
-         else
-            declare
-               Value : constant String :=
-                         Simple_Name_CI (Characters.Handling.To_Lower (Name));
-               subtype Result is String (1 .. Value'Length);
-            begin
-               return Result (Value);
-            end;
-         end if;
+         declare
+            Value : constant String := Simple_Name_Internal (Name);
+            subtype Result is String (1 .. Value'Length);
+         begin
+            return Result (Value);
+         end;
       end if;
    end Simple_Name;
 
@@ -1233,7 +1204,10 @@ package body Ada.Directories is
       --  Check the pattern
 
       begin
-         Pat := Compile (Pattern, Glob => True);
+         Pat := Compile
+           (Pattern,
+            Glob           => True,
+            Case_Sensitive => Is_Path_Name_Case_Sensitive);
       exception
          when Error_In_Regexp =>
             Free (Search.Value);
@@ -1264,17 +1238,4 @@ package body Ada.Directories is
       Search.Value.Is_Valid := True;
    end Start_Search;
 
-   ----------------------------------
-   -- To_Lower_If_Case_Insensitive --
-   ----------------------------------
-
-   procedure To_Lower_If_Case_Insensitive (S : in out String) is
-   begin
-      if not Is_Path_Name_Case_Sensitive then
-         for J in S'Range loop
-            S (J) := To_Lower (S (J));
-         end loop;
-      end if;
-   end To_Lower_If_Case_Insensitive;
-
 end Ada.Directories;

gcc/ada/g-trasym.adb

@@ -77,7 +77,7 @@ package body GNAT.Traceback.Symbolic is
       --  This is the procedure version of the Ada aware addr2line.  It places
       --  in BUF a string representing the symbolic translation of the N_ADDRS
       --  raw addresses provided in ADDRS, looked up in debug information from
-      --  FILENAME.  LEN points to an integer which contains the size of the
+      --  FILENAME. LEN points to an integer which contains the size of the
       --  BUF buffer at input and the result length at output.
       --
       --  This procedure is provided by libaddr2line on targets that support

gcc/ada/s-os_lib.adb

@@ -1833,7 +1833,8 @@ package body System.OS_Lib is
 
                --  By default, the drive letter on Windows is in upper case
 
-               if On_Windows and then Path_Len >= 2
+               if On_Windows
+                 and then Path_Len >= 2
                  and then Buffer (2) = ':'
                then
                   System.Case_Util.To_Upper (Buffer (1 .. 1));

gcc/ada/sem.adb

@@ -83,8 +83,8 @@ package body Sem is
 
    procedure Write_Unit_Info
      (Unit_Num : Unit_Number_Type;
-      Item : Node_Id;
-      Prefix : String := "");
+      Item     : Node_Id;
+      Prefix   : String := "");
    --  Print out debugging information about the unit
 
    -------------
@@ -1359,10 +1359,15 @@ package body Sem is
    --  Start of processing for Semantics
 
    begin
-      if Debug_Unit_Walk and then Already_Analyzed then
-         Write_Str ("(done)");
-         Write_Unit_Info (Get_Cunit_Unit_Number (Comp_Unit), Unit (Comp_Unit),
-                          Prefix => "--> ");
+      if Debug_Unit_Walk then
+         if Already_Analyzed then
+            Write_Str ("(done)");
+         end if;
+
+         Write_Unit_Info
+           (Get_Cunit_Unit_Number (Comp_Unit),
+            Unit (Comp_Unit),
+            Prefix => "--> ");
          Indent;
       end if;
 
@@ -1378,11 +1383,11 @@ package body Sem is
       --  Cleaner might be to do the kludge at the point of excluding the
       --  pragma (do not exclude for renamings ???)
 
-      GNAT_Mode :=
-        GNAT_Mode
-          or else Is_Predefined_File_Name
-                    (Unit_File_Name (Current_Sem_Unit),
-                     Renamings_Included => False);
+      if Is_Predefined_File_Name
+           (Unit_File_Name (Current_Sem_Unit), Renamings_Included => False)
+      then
+         GNAT_Mode := True;
+      end if;
 
       if Generic_Main then
          Expander_Mode_Save_And_Set (False);
@@ -1416,8 +1421,8 @@ package body Sem is
          end if;
 
          --  Do analysis, and then append the compilation unit onto the
-         --  Comp_Unit_List, if appropriate. This is done after analysis, so if
-         --  this unit depends on some others, they have already been
+         --  Comp_Unit_List, if appropriate. This is done after analysis, so
+         --  if this unit depends on some others, they have already been
          --  appended. We ignore bodies, except for the main unit itself. We
          --  have also to guard against ill-formed subunits that have an
          --  improper context.
@@ -1428,7 +1433,7 @@ package body Sem is
             null;
 
          elsif Present (Comp_Unit)
-           and then  Nkind (Unit (Comp_Unit)) in N_Proper_Body
+           and then Nkind (Unit (Comp_Unit)) in N_Proper_Body
            and then not In_Extended_Main_Source_Unit (Comp_Unit)
          then
             null;
@@ -1436,7 +1441,9 @@ package body Sem is
          else
             pragma Assert (not Ignore_Comp_Units);
 
-            if No (Comp_Unit_List) then  --  Initialize if first time
+            --  Initialize if first time
+
+            if No (Comp_Unit_List) then
                Comp_Unit_List := New_Elmt_List;
             end if;
 
@@ -1474,11 +1481,17 @@ package body Sem is
       Restore_Opt_Config_Switches (Save_Config_Switches);
       Expander_Mode_Restore;
 
-      if Debug_Unit_Walk and then Already_Analyzed then
+      if Debug_Unit_Walk then
          Outdent;
-         Write_Str ("(done)");
-         Write_Unit_Info (Get_Cunit_Unit_Number (Comp_Unit), Unit (Comp_Unit),
-                          Prefix => "<-- ");
+
+         if Already_Analyzed then
+            Write_Str ("(done)");
+         end if;
+
+         Write_Unit_Info
+           (Get_Cunit_Unit_Number (Comp_Unit),
+            Unit (Comp_Unit),
+            Prefix => "<-- ");
       end if;
    end Semantics;
 
@@ -1545,11 +1558,15 @@ package body Sem is
 
             declare
                Unit_Num : constant Unit_Number_Type :=
-                 Get_Cunit_Unit_Number (CU);
+                            Get_Cunit_Unit_Number (CU);
             begin
-               Write_Unit_Info (Unit_Num, Item);
+               if Debug_Unit_Walk then
+                  Write_Unit_Info (Unit_Num, Item);
+               end if;
+
+               --  ??? why is this commented out
+               --  ???pragma Assert (not Seen (Unit_Num));
 
-               pragma Assert (not Seen (Unit_Num));
                Seen (Unit_Num) := True;
             end;
 
@@ -1649,11 +1666,13 @@ package body Sem is
             Write_Line ("Ignored units:");
 
             Indent;
+
             for Unit_Num in Seen'Range loop
                if not Seen (Unit_Num) then
                   Write_Unit_Info (Unit_Num, Unit (Cunit (Unit_Num)));
                end if;
             end loop;
+
             Outdent;
          end if;
       end if;
@@ -1670,29 +1689,27 @@ package body Sem is
 
    procedure Write_Unit_Info
      (Unit_Num : Unit_Number_Type;
-      Item : Node_Id;
-      Prefix : String := "")
+      Item     : Node_Id;
+      Prefix   : String := "")
    is
    begin
-      if Debug_Unit_Walk then
-         Write_Str (Prefix);
-         Write_Unit_Name (Unit_Name (Unit_Num));
-         Write_Str (", unit ");
-         Write_Int (Int (Unit_Num));
-         Write_Str (", ");
-         Write_Int (Int (Item));
+      Write_Str (Prefix);
+      Write_Unit_Name (Unit_Name (Unit_Num));
+      Write_Str (", unit ");
+      Write_Int (Int (Unit_Num));
+      Write_Str (", ");
+      Write_Int (Int (Item));
+      Write_Str ("=");
+      Write_Str (Node_Kind'Image (Nkind (Item)));
+
+      if Item /= Original_Node (Item) then
+         Write_Str (", orig = ");
+         Write_Int (Int (Original_Node (Item)));
          Write_Str ("=");
-         Write_Str (Node_Kind'Image (Nkind (Item)));
-
-         if Item /= Original_Node (Item) then
-            Write_Str (", orig = ");
-            Write_Int (Int (Original_Node (Item)));
-            Write_Str ("=");
-            Write_Str (Node_Kind'Image (Nkind (Original_Node (Item))));
-         end if;
-
-         Write_Eol;
+         Write_Str (Node_Kind'Image (Nkind (Original_Node (Item))));
       end if;
+
+      Write_Eol;
    end Write_Unit_Info;
 
 end Sem;

gcc/ada/sem_ch3.adb

@@ -5922,9 +5922,9 @@ package body Sem_Ch3 is
             --  This is the unusual case where a type completed by a private
             --  derivation occurs within a package nested in a child unit, and
             --  the parent is declared in an ancestor. In this case, the full
-            --  view of the parent type will become visible in the body of the
-            --  enclosing child, and only then will the current type be
-            --   possibly non-private. We build a underlying full view that
+            --  view of the parent type will become visible in the body of
+            --  the enclosing child, and only then will the current type be
+            --  possibly non-private. We build a underlying full view that
             --  will be installed when the enclosing child body is compiled.
 
             Full_Der :=

gcc/ada/sem_ch4.adb

@@ -5874,7 +5874,6 @@ package body Sem_Ch4 is
             begin
                Actual := Next (First_Actual (Call));
                Index  := First_Index (Arr_Type);
-
                while Present (Actual) and then Present (Index) loop
                   if not Has_Compatible_Type (Actual, Etype (Index)) then
                      Arr_Type := Empty;

gcc/ada/sem_ch8.adb

@@ -788,7 +788,7 @@ package body Sem_Ch8 is
                I    : Interp_Index;
                It   : Interp;
                Typ  : Entity_Id := Empty;
-               Seen : Boolean := False;
+               Seen : Boolean   := False;
 
             begin
                Get_First_Interp (Nam, I, It);
@@ -799,8 +799,9 @@ package body Sem_Ch8 is
 
                   if Ekind (It.Typ) = Ekind (T) then
                      if Ekind (T) = E_Anonymous_Access_Subprogram_Type
-                       and then Type_Conformant
-                         (Designated_Type (T), Designated_Type (It.Typ))
+                       and then
+                         Type_Conformant
+                           (Designated_Type (T), Designated_Type (It.Typ))
                      then
                         if not Seen then
                            Seen := True;
@@ -810,8 +811,8 @@ package body Sem_Ch8 is
                         end if;
 
                      elsif Ekind (T) = E_Anonymous_Access_Type
-                       and then Covers
-                         (Designated_Type (T), Designated_Type (It.Typ))
+                       and then
+                         Covers (Designated_Type (T), Designated_Type (It.Typ))
                      then
                         if not Seen then
                            Seen := True;

gcc/ada/sem_type.adb

@@ -1688,26 +1688,28 @@ package body Sem_Type is
         and then Present (Access_Definition (Parent (N)))
       then
          if Ekind (It1.Typ) = E_Anonymous_Access_Type
-           or else Ekind (It1.Typ) = E_Anonymous_Access_Subprogram_Type
+              or else
+            Ekind (It1.Typ) = E_Anonymous_Access_Subprogram_Type
          then
             if Ekind (It2.Typ) = Ekind (It1.Typ) then
 
                --  True ambiguity
 
                return No_Interp;
+
             else
                return It1;
             end if;
 
          elsif Ekind (It2.Typ) = E_Anonymous_Access_Type
-           or else Ekind (It2.Typ) = E_Anonymous_Access_Subprogram_Type
+                 or else
+               Ekind (It2.Typ) = E_Anonymous_Access_Subprogram_Type
          then
             return It2;
 
-         else
-
-            --  No legal interpretation.
+         --  No legal interpretation
 
+         else
             return No_Interp;
          end if;