[multiple changes]

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

	* prj-proc.adb: Minor comment spelling error fix.
	* osint.ads (Env_Vars_Case_Sensitive): Use function
	Get_Env_Vars_Case_Sensitive, not Get_File_Names_Case_Sensitive to
	compute value.

2010-09-09  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Resolve_Equality_Op): Implement Ada2012 rule for
	resolution of conditional expressions whose dependent expressions are
	anonymous access types.

2010-09-09  Robert Dewar  <dewar@adacore.com>

	* a-ststio.adb: Minor code reorganization.
	* s-direio.adb, prj.adb, prj-nmsc.adb, sem_type.adb: Remove redundant
	conversion.
	* types.ads: Minor reformatting.
	* binde.adb, vms_conv.adb, gnatls.adb, s-strxdr.adb, uintp.adb: Remove
	redundant conversions.
	* output.adb: Minor reformatting.
	* sem_ch8.adb (Find_Type): Test for redundant base applies to user
	types.
	* opt.ads: Add pragma Ordered for Verbosity_Level.
	* prj.ads: Add pragma Ordered for type Verbosity.

From-SVN: r164072

19 files changed, 119 insertions, 55 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 54bd5d9..2c0de6f 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,32 @@
 2010-09-09  Vincent Celier  <celier@adacore.com>
 
+	* prj-proc.adb: Minor comment spelling error fix.
+	* osint.ads (Env_Vars_Case_Sensitive): Use function
+	Get_Env_Vars_Case_Sensitive, not Get_File_Names_Case_Sensitive to
+	compute value.
+
+2010-09-09  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_res.adb (Resolve_Equality_Op): Implement Ada2012 rule for
+	resolution of conditional expressions whose dependent expressions are
+	anonymous access types.
+
+2010-09-09  Robert Dewar  <dewar@adacore.com>
+
+	* a-ststio.adb: Minor code reorganization.
+	* s-direio.adb, prj.adb, prj-nmsc.adb, sem_type.adb: Remove redundant
+	conversion.
+	* types.ads: Minor reformatting.
+	* binde.adb, vms_conv.adb, gnatls.adb, s-strxdr.adb, uintp.adb: Remove
+	redundant conversions.
+	* output.adb: Minor reformatting.
+	* sem_ch8.adb (Find_Type): Test for redundant base applies to user
+	types.
+	* opt.ads: Add pragma Ordered for Verbosity_Level.
+	* prj.ads: Add pragma Ordered for type Verbosity.
+
+2010-09-09  Vincent Celier  <celier@adacore.com>
+
 	* osint.adb (Canonical_Case_File_Name): Use procedure To_Lower in
 	System.Case_Util
 	(Canonical_Case_Env_Var_Name): Ditto
diff --git a/gcc/ada/a-ststio.adb b/gcc/ada/a-ststio.adb
index f394989..c5da571 100644
--- a/gcc/ada/a-ststio.adb
+++ b/gcc/ada/a-ststio.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          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- --
@@ -147,7 +147,7 @@ package body Ada.Streams.Stream_IO is
    function End_Of_File (File : File_Type) return Boolean is
    begin
       FIO.Check_Read_Status (AP (File));
-      return Count (File.Index) > Size (File);
+      return File.Index > Size (File);
    end End_Of_File;
 
    -----------
@@ -175,7 +175,7 @@ package body Ada.Streams.Stream_IO is
    function Index (File : File_Type) return Positive_Count is
    begin
       FIO.Check_File_Open (AP (File));
-      return Count (File.Index);
+      return File.Index;
    end Index;
 
    -------------
diff --git a/gcc/ada/binde.adb b/gcc/ada/binde.adb
index f468190..0dc6521 100644
--- a/gcc/ada/binde.adb
+++ b/gcc/ada/binde.adb
@@ -614,7 +614,7 @@ package body Binde is
             Write_Str ("  decrementing Num_Pred for unit ");
             Write_Unit_Name (Units.Table (U).Uname);
             Write_Str (" new value = ");
-            Write_Int (Int (UNR.Table (U).Num_Pred));
+            Write_Int (UNR.Table (U).Num_Pred);
             Write_Eol;
          end if;
 
@@ -1152,7 +1152,7 @@ package body Binde is
                   Write_Str
                     ("    Elaborate_Body = True, Num_Pred for body = ");
                   Write_Int
-                    (Int (UNR.Table (Corresponding_Body (U)).Num_Pred));
+                    (UNR.Table (Corresponding_Body (U)).Num_Pred);
                else
                   Write_Str
                     ("    Elaborate_Body = False");
@@ -1243,8 +1243,7 @@ package body Binde is
                      goto Next_With;
                   end if;
 
-                  Withed_Unit :=
-                    Unit_Id (Unit_Id_Of (Withs.Table (W).Uname));
+                  Withed_Unit := Unit_Id_Of (Withs.Table (W).Uname);
 
                   --  Pragma Elaborate_All case, for this we use the recursive
                   --  Elab_All_Links procedure to establish the links.
diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb
index 98088d0..b684ebb 100644
--- a/gcc/ada/gnatls.adb
+++ b/gcc/ada/gnatls.adb
@@ -1362,13 +1362,11 @@ procedure Gnatls is
 
                declare
                   Src_Path_Name : constant String_Ptr :=
-                                    String_Ptr
-                                      (Get_RTS_Search_Dir
-                                        (Argv (7 .. Argv'Last), Include));
+                                    Get_RTS_Search_Dir
+                                      (Argv (7 .. Argv'Last), Include);
                   Lib_Path_Name : constant String_Ptr :=
-                                    String_Ptr
-                                      (Get_RTS_Search_Dir
-                                        (Argv (7 .. Argv'Last), Objects));
+                                    Get_RTS_Search_Dir
+                                      (Argv (7 .. Argv'Last), Objects);
 
                begin
                   if Src_Path_Name /= null
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 4107b0c..ac893a1 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -1306,6 +1306,7 @@ package Opt is
    --  information sent to standard output, also header, copyright and summary)
 
    type Verbosity_Level_Type is (None, Low, Medium, High);
+   pragma Ordered (Verbosity_Level_Type);
    Verbosity_Level : Verbosity_Level_Type := High;
    --  GNATMAKE, GPRMAKE
    --  Modified by gnatmake or gprmake switches -v, -vl, -vm, -vh. Indicates
diff --git a/gcc/ada/osint.ads b/gcc/ada/osint.ads
index ebb1fb1..9ec26bf 100644
--- a/gcc/ada/osint.ads
+++ b/gcc/ada/osint.ads
@@ -98,7 +98,7 @@ package Osint is
    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;
+                                 Get_Env_Vars_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).
diff --git a/gcc/ada/output.adb b/gcc/ada/output.adb
index 8210d3f..5ac6801 100644
--- a/gcc/ada/output.adb
+++ b/gcc/ada/output.adb
@@ -129,8 +129,9 @@ package body Output is
 
             else
                declare
-                  Indented_Buffer : constant String
-                    := (1 .. Cur_Indentation => ' ') & Buffer (1 .. Len);
+                  Indented_Buffer : constant String :=
+                                      (1 .. Cur_Indentation => ' ') &
+                                                          Buffer (1 .. Len);
                begin
                   Write_Buffer (Indented_Buffer);
                end;
@@ -138,9 +139,10 @@ package body Output is
 
          exception
             when Write_Error =>
-               --  If there are errors with standard error, just quit.
-               --  Otherwise, set the output to standard error before reporting
-               --  a failure and quitting.
+
+               --  If there are errors with standard error just quit. Otherwise
+               --  set the output to standard error before reporting a failure
+               --  and quitting.
 
                if Current_FD /= Standerr then
                   Current_FD := Standerr;
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index 63b24b3..1a7e4c5 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -5505,7 +5505,7 @@ package body Prj.Nmsc is
             Element := Data.Tree.String_Elements.Table (Current);
             if Element.Value /= No_Name then
                Element.Value :=
-                 Name_Id (Canonical_Case_File_Name (Name_Id (Element.Value)));
+                 Name_Id (Canonical_Case_File_Name (Element.Value));
                Data.Tree.String_Elements.Table (Current) := Element;
             end if;
 
@@ -6519,7 +6519,7 @@ package body Prj.Nmsc is
 
                   if not Found then
                      Error_Msg_Name_1 := Name_Id (Source.Display_File);
-                     Error_Msg_Name_2 := Name_Id (Source.Unit.Name);
+                     Error_Msg_Name_2 := Source.Unit.Name;
                      Error_Or_Warning
                        (Data.Flags, Data.Flags.Missing_Source_Files,
                         "source file %% for unit %% not found",
diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb
index 65d0190..2b94067 100644
--- a/gcc/ada/prj-proc.adb
+++ b/gcc/ada/prj-proc.adb
@@ -346,7 +346,7 @@ package body Prj.Proc is
          Var := In_Tree.Variable_Elements.Table (V1);
          V1  := Var.Next;
 
-         --  Do not copy the value of attribute inker_Options if Restricted
+         --  Do not copy the value of attribute Linker_Options if Restricted
 
          if Restricted and then Var.Name = Snames.Name_Linker_Options then
             Var.Value.Values := Nil_String;
diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb
index 17d544f..59acced 100644
--- a/gcc/ada/prj.adb
+++ b/gcc/ada/prj.adb
@@ -247,16 +247,10 @@ package body Prj is
             return No_File;
 
          when Makefile =>
-            return
-              File_Name_Type
-                (Extend_Name
-                   (Source_File_Name, Makefile_Dependency_Suffix));
+            return Extend_Name (Source_File_Name, Makefile_Dependency_Suffix);
 
          when ALI_File =>
-            return
-              File_Name_Type
-                (Extend_Name
-                   (Source_File_Name, ALI_Dependency_Suffix));
+            return Extend_Name (Source_File_Name, ALI_Dependency_Suffix);
       end case;
    end Dependency_Name;
 
diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads
index 146d530..c353cca 100644
--- a/gcc/ada/prj.ads
+++ b/gcc/ada/prj.ads
@@ -820,6 +820,7 @@ package Prj is
       Equal      => "=");
 
    type Verbosity is (Default, Medium, High);
+   pragma Ordered (Verbosity);
    --  Verbosity when parsing GNAT Project Files
    --    Default is default (very quiet, if no errors).
    --    Medium is more verbose.
diff --git a/gcc/ada/s-direio.adb b/gcc/ada/s-direio.adb
index dee00cd..ef4c3ea 100644
--- a/gcc/ada/s-direio.adb
+++ b/gcc/ada/s-direio.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          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- --
@@ -127,7 +127,7 @@ package body System.Direct_IO is
    function End_Of_File (File : File_Type) return Boolean is
    begin
       FIO.Check_Read_Status (AP (File));
-      return Count (File.Index) > Size (File);
+      return File.Index > Size (File);
    end End_Of_File;
 
    -----------
@@ -137,7 +137,7 @@ package body System.Direct_IO is
    function Index (File : File_Type) return Positive_Count is
    begin
       FIO.Check_File_Open (AP (File));
-      return Count (File.Index);
+      return File.Index;
    end Index;
 
    ----------
diff --git a/gcc/ada/s-strxdr.adb b/gcc/ada/s-strxdr.adb
index 4fca719..86e190a 100644
--- a/gcc/ada/s-strxdr.adb
+++ b/gcc/ada/s-strxdr.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---         Copyright (C) 1996-2009, Free Software Foundation, Inc.          --
+--         Copyright (C) 1996-2010, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GARLIC 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- --
@@ -1466,7 +1466,7 @@ package body System.Stream_Attributes is
          Exponent   := Long_Unsigned (E + E_Bias);
          F          := Long_Long_Float'Scaling (F, F_Size - HFS);
          Fraction_1 := Long_Long_Unsigned (Long_Long_Float'Floor (F));
-         F          := Long_Long_Float (F - Long_Long_Float (Fraction_1));
+         F          := F - Long_Long_Float (Fraction_1);
          F          := Long_Long_Float'Scaling (F, HFS);
          Fraction_2 := Long_Long_Unsigned (Long_Long_Float'Floor (F));
       end if;
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index ef72d3f..b61eeab 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -5766,9 +5766,8 @@ package body Sem_Ch8 is
                     ("prefix of Base attribute must be scalar type",
                       Prefix (N));
 
-               elsif Sloc (Typ) = Standard_Location
+               elsif Warn_On_Redundant_Constructs
                  and then Base_Type (Typ) = Typ
-                 and then Warn_On_Redundant_Constructs
                then
                   Error_Msg_NE -- CODEFIX
                     ("?redundant attribute, & is its own base type", N, Typ);
@@ -5777,8 +5776,8 @@ package body Sem_Ch8 is
                T := Base_Type (Typ);
 
                --  Rewrite attribute reference with type itself (see similar
-               --  processing in Analyze_Attribute, case Base). Preserve
-               --  prefix if present, for other legality checks.
+               --  processing in Analyze_Attribute, case Base). Preserve prefix
+               --  if present, for other legality checks.
 
                if Nkind (Prefix (N)) = N_Expanded_Name then
                   Rewrite (N,
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 80b8479..fc138f4 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -6391,12 +6391,41 @@ package body Sem_Res is
       R : constant Node_Id   := Right_Opnd (N);
       T : Entity_Id := Find_Unique_Type (L, R);
 
+      procedure Check_Conditional_Expression (Cond : Node_Id);
+      --  The resolution rule for conditional expressions requires that each
+      --  such must have a unique type. This means that if several dependent
+      --  expressions are of a non-null anonymous access type, and the context
+      --  does not impose an expected type (as can be the case in an equality
+      --  operation) the expression must be rejected.
+
       function Find_Unique_Access_Type return Entity_Id;
       --  In the case of allocators, make a last-ditch attempt to find a single
       --  access type with the right designated type. This is semantically
       --  dubious, and of no interest to any real code, but c48008a makes it
       --  all worthwhile.
 
+      ----------------------------------
+      -- Check_Conditional_Expression --
+      ----------------------------------
+
+      procedure Check_Conditional_Expression (Cond : Node_Id) is
+         Then_Expr : Node_Id;
+         Else_Expr : Node_Id;
+
+      begin
+         if Nkind (Cond) = N_Conditional_Expression then
+            Then_Expr := Next (First (Expressions (Cond)));
+            Else_Expr := Next (Then_Expr);
+
+            if Nkind (Then_Expr) /= N_Null
+              and then Nkind (Else_Expr) /= N_Null
+            then
+               Error_Msg_N
+                 ("cannot determine type of conditional expression", Cond);
+            end if;
+         end if;
+      end Check_Conditional_Expression;
+
       -----------------------------
       -- Find_Unique_Access_Type --
       -----------------------------
@@ -6470,6 +6499,22 @@ package body Sem_Res is
                Set_Etype (N, Any_Type);
                return;
             end if;
+
+         --  Conditional expressions must have a single type, and if the
+         --  context does not impose one the dependent expressions cannot
+         --  be anonymous access types.
+
+         elsif Ada_Version >= Ada_2012
+           and then Ekind_In (Etype (L),
+             E_Anonymous_Access_Type,
+               E_Anonymous_Access_Subprogram_Type)
+
+           and then Ekind_In (Etype (R),
+             E_Anonymous_Access_Type,
+               E_Anonymous_Access_Subprogram_Type)
+         then
+            Check_Conditional_Expression (L);
+            Check_Conditional_Expression (R);
          end if;
 
          Resolve (L, T);
diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
index 3f253fa..711421c 100644
--- a/gcc/ada/sem_type.adb
+++ b/gcc/ada/sem_type.adb
@@ -3222,7 +3222,7 @@ package body Sem_Type is
       Write_Str (" Index: ");
       Write_Int (Int (Interp_Map.Table (Map_Ptr).Index));
       Write_Str (" Next:  ");
-      Write_Int (Int (Interp_Map.Table (Map_Ptr).Next));
+      Write_Int (Interp_Map.Table (Map_Ptr).Next);
       Write_Eol;
    end Write_Interp_Ref;
 
diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads
index 5d7784d..1568290 100644
--- a/gcc/ada/types.ads
+++ b/gcc/ada/types.ads
@@ -251,13 +251,13 @@ package Types is
    --    Universal integers (type Uint)
    --    Universal reals (type Ureal)
 
-   --  In most contexts, the strongly typed interface determines which of
-   --  these types is present. However, there are some situations (involving
-   --  untyped traversals of the tree), where it is convenient to be easily
-   --  able to distinguish these values. The underlying representation in all
-   --  cases is an integer type Union_Id, and we ensure that the range of
-   --  the various possible values for each of the above types is disjoint
-   --  so that this distinction is possible.
+   --  In most contexts, the strongly typed interface determines which of these
+   --  types is present. However, there are some situations (involving untyped
+   --  traversals of the tree), where it is convenient to be easily able to
+   --  distinguish these values. The underlying representation in all cases is
+   --  an integer type Union_Id, and we ensure that the range of the various
+   --  possible values for each of the above types is disjoint so that this
+   --  distinction is possible.
 
    type Union_Id is new Int;
    --  The type in the tree for a union of possible ID values
diff --git a/gcc/ada/uintp.adb b/gcc/ada/uintp.adb
index 29ffe23..713e0b1 100644
--- a/gcc/ada/uintp.adb
+++ b/gcc/ada/uintp.adb
@@ -2204,9 +2204,7 @@ package body Uintp is
            and then
          Int (Right) <= Int (Uint_Max_Simple_Mul)
       then
-         return
-           UI_From_Int
-             (Int (Direct_Val (Left)) * Int (Direct_Val (Right)));
+         return UI_From_Int (Direct_Val (Left) * Direct_Val (Right));
       end if;
 
       --  Otherwise we have the general case (Algorithm M in Knuth)
diff --git a/gcc/ada/vms_conv.adb b/gcc/ada/vms_conv.adb
index e9aba49..b806053 100644
--- a/gcc/ada/vms_conv.adb
+++ b/gcc/ada/vms_conv.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1996-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1996-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- --
@@ -314,16 +314,16 @@ package body VMS_Conv is
       loop
          declare
             Dir : constant String_Access :=
-                    String_Access (Get_Next_Dir_In_Path (Object_Dir_Name));
+                    Get_Next_Dir_In_Path (Object_Dir_Name);
          begin
             exit when Dir = null;
             Object_Dirs := Object_Dirs + 1;
             Object_Dir (Object_Dirs) :=
               new String'("-L" &
                           To_Canonical_Dir_Spec
-                          (To_Host_Dir_Spec
-                           (Normalize_Directory_Name (Dir.all).all,
-                            True).all, True).all);
+                            (To_Host_Dir_Spec
+                              (Normalize_Directory_Name (Dir.all).all,
+                               True).all, True).all);
          end;
       end loop;