2010-06-18 Thomas Quinot <quinot@adacore.com>

	* sem_eval.adb (Test_In_Range): New subprogram, factoring duplicated
	code between...
	(Is_In_Range, Is_Out_Of_Range): Reimplement in terms of call to
	Test_In_Range.

2010-06-18  Robert Dewar  <dewar@adacore.com>

	* sprint.adb: Minor change in output format for expression wi actions.
	* par-ch3.adb: Minor code reorganization.  Minor reformatting.
	* sem_ch5.adb: Minor comment fix.

2010-06-18  Robert Dewar  <dewar@adacore.com>

	* debug.adb: New debug flag -gnatd.L to control
	Back_End_Handles_Limited_Types.
	* exp_ch4.adb (Expand_N_Conditional_Expression): Let back end handle
	limited case if Back_End_Handles_Limited_Types is True.
	(Expand_N_Conditional_Expression): Use N_Expression_With_Actions to
	simplify expansion if Use_Expression_With_Actions is True.
	* gnat1drv.adb (Adjust_Global_Switches): Set
	Back_End_Handles_Limited_Types.
	* opt.ads (Back_End_Handles_Limited_Types): New flag.

2010-06-18  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Rewrite_Operator_As_Call): Do not rewrite user-defined
	intrinsic operator if expansion is not enabled, because in an
	instantiation the original operator must be present to verify the
	legality of the operation.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@160969 138bc75d-0d04-0410-961f-82ee72b054a4

10 files changed, 475 insertions, 298 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index f53ba64bd79..4f6d00292f4 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,35 @@
+2010-06-18  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_eval.adb (Test_In_Range): New subprogram, factoring duplicated
+	code between...
+	(Is_In_Range, Is_Out_Of_Range): Reimplement in terms of call to
+	Test_In_Range.
+
+2010-06-18  Robert Dewar  <dewar@adacore.com>
+
+	* sprint.adb: Minor change in output format for expression wi actions.
+	* par-ch3.adb: Minor code reorganization.  Minor reformatting.
+	* sem_ch5.adb: Minor comment fix.
+
+2010-06-18  Robert Dewar  <dewar@adacore.com>
+
+	* debug.adb: New debug flag -gnatd.L to control
+	Back_End_Handles_Limited_Types.
+	* exp_ch4.adb (Expand_N_Conditional_Expression): Let back end handle
+	limited case if Back_End_Handles_Limited_Types is True.
+	(Expand_N_Conditional_Expression): Use N_Expression_With_Actions to
+	simplify expansion if Use_Expression_With_Actions is True.
+	* gnat1drv.adb (Adjust_Global_Switches): Set
+	Back_End_Handles_Limited_Types.
+	* opt.ads (Back_End_Handles_Limited_Types): New flag.
+
+2010-06-18  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_res.adb (Rewrite_Operator_As_Call): Do not rewrite user-defined
+	intrinsic operator if expansion is not enabled, because in an
+	instantiation the original operator must be present to verify the
+	legality of the operation.
+
 2010-06-18  Robert Dewar  <dewar@adacore.com>
 
 	* exp_disp.adb, sem_ch12.adb: Minor reformatting
diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index ac8ed4a1598..cc1dc5b64a7 100644
--- a/gcc/ada/debug.adb
+++ b/gcc/ada/debug.adb
@@ -76,7 +76,7 @@ package body Debug is
    --  dJ   Output debugging trace info for JGNAT (Java VM version of GNAT)
    --  dK   Kill all error messages
    --  dL   Output trace information on elaboration checking
-   --  dM   Asssume all variables are modified (no current values)
+   --  dM   Assume all variables are modified (no current values)
    --  dN   No file name information in exception messages
    --  dO   Output immediate error messages
    --  dP   Do not check for controlled objects in preelaborable packages
@@ -129,7 +129,7 @@ package body Debug is
    --  d.I  SCIL generation mode
    --  d.J  Parallel SCIL generation mode
    --  d.K
-   --  d.L
+   --  d.L  Depend on back end for limited types in conditional expressions
    --  d.M
    --  d.N
    --  d.O  Dump internal SCO tables
@@ -567,6 +567,11 @@ package body Debug is
    --       This means in particular not writing the same files under the
    --       same directory.
 
+   --  d.L  Normally the front end generates special expansion for conditional
+   --       expressions of a limited type. This debug flag removes this special
+   --       case expansion, leaving it up to the back end to handle conditional
+   --       expressions correctly.
+
    --  d.O  Dump internal SCO tables. Before outputting the SCO information to
    --       the ALI file, the internal SCO tables (SCO_Table/SCO_Unit_Table)
    --       are dumped for debugging purposes.
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index f7c781fe855..821103c79f6 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -3882,7 +3882,7 @@ package body Exp_Ch4 is
    -- Expand_N_Conditional_Expression --
    -------------------------------------
 
-   --  Expand into expression actions if then/else actions present
+   --  Deal with limited types and expression actions
 
    procedure Expand_N_Conditional_Expression (N : Node_Id) is
       Loc    : constant Source_Ptr := Sloc (N);
@@ -3898,26 +3898,11 @@ package body Exp_Ch4 is
       P_Decl : Node_Id;
 
    begin
-      --  If either then or else actions are present, then given:
+      --  If the type is limited or unconstrained, we expand as follows to
+      --  avoid any possibility of improper copies.
 
-      --     if cond then then-expr else else-expr end
-
-      --  we insert the following sequence of actions (using Insert_Actions):
-
-      --      Cnn : typ;
-      --      if cond then
-      --         <<then actions>>
-      --         Cnn := then-expr;
-      --      else
-      --         <<else actions>>
-      --         Cnn := else-expr
-      --      end if;
-
-      --  and replace the conditional expression by a reference to Cnn
-
-      --  If the type is limited or unconstrained, the above expansion is
-      --  not legal, because it involves either an uninitialized object
-      --  or an illegal assignment. Instead, we generate:
+      --  Note: it may be possible to avoid this special processing if the
+      --  back end uses its own mechanisms for handling by-reference types ???
 
       --      type Ptr is access all Typ;
       --      Cnn : Ptr;
@@ -3931,7 +3916,12 @@ package body Exp_Ch4 is
 
       --  and replace the conditional expresion by a reference to Cnn.all.
 
-      if Is_By_Reference_Type (Typ) then
+      --  This special case can be skipped if the back end handles limited
+      --  types properly and ensures that no incorrect copies are made.
+
+      if Is_By_Reference_Type (Typ)
+        and then not Back_End_Handles_Limited_Types
+      then
          Cnn := Make_Temporary (Loc, 'C', N);
 
          P_Decl :=
@@ -3979,40 +3969,82 @@ package body Exp_Ch4 is
       --  associated with either branch.
 
       elsif Present (Then_Actions (N)) or else Present (Else_Actions (N)) then
-         Cnn := Make_Temporary (Loc, 'C', N);
 
-         Decl :=
-           Make_Object_Declaration (Loc,
-             Defining_Identifier => Cnn,
-             Object_Definition   => New_Occurrence_Of (Typ, Loc));
+         --  We have two approaches to handling this. If we are allowed to use
+         --  N_Expression_With_Actions, then we can just wrap the actions into
+         --  the appropriate expression.
+
+         if Use_Expression_With_Actions then
+            if Present (Then_Actions (N)) then
+               Rewrite (Thenx,
+                 Make_Expression_With_Actions (Sloc (Thenx),
+                   Actions    => Then_Actions (N),
+                   Expression => Relocate_Node (Thenx)));
+               Analyze_And_Resolve (Thenx, Typ);
+            end if;
 
-         New_If :=
-           Make_Implicit_If_Statement (N,
-             Condition => Relocate_Node (Cond),
+            if Present (Else_Actions (N)) then
+               Rewrite (Elsex,
+                 Make_Expression_With_Actions (Sloc (Elsex),
+                   Actions    => Else_Actions (N),
+                   Expression => Relocate_Node (Elsex)));
+               Analyze_And_Resolve (Elsex, Typ);
+            end if;
 
-             Then_Statements => New_List (
-               Make_Assignment_Statement (Sloc (Thenx),
-                 Name       => New_Occurrence_Of (Cnn, Sloc (Thenx)),
-                 Expression => Relocate_Node (Thenx))),
+            return;
 
-             Else_Statements => New_List (
-               Make_Assignment_Statement (Sloc (Elsex),
-                 Name       => New_Occurrence_Of (Cnn, Sloc (Elsex)),
-                 Expression => Relocate_Node (Elsex))));
+            --  if we can't use N_Expression_With_Actions nodes, then we insert
+            --  the following sequence of actions (using Insert_Actions):
 
-         Set_Assignment_OK (Name (First (Then_Statements (New_If))));
-         Set_Assignment_OK (Name (First (Else_Statements (New_If))));
+            --      Cnn : typ;
+            --      if cond then
+            --         <<then actions>>
+            --         Cnn := then-expr;
+            --      else
+            --         <<else actions>>
+            --         Cnn := else-expr
+            --      end if;
 
-         New_N := New_Occurrence_Of (Cnn, Loc);
+            --  and replace the conditional expression by a reference to Cnn
 
-      else
-         --  No expansion needed, gigi handles it like a C conditional
-         --  expression.
+         else
+            Cnn := Make_Temporary (Loc, 'C', N);
+
+            Decl :=
+              Make_Object_Declaration (Loc,
+                Defining_Identifier => Cnn,
+                Object_Definition   => New_Occurrence_Of (Typ, Loc));
+
+            New_If :=
+              Make_Implicit_If_Statement (N,
+                Condition       => Relocate_Node (Cond),
+
+                Then_Statements => New_List (
+                  Make_Assignment_Statement (Sloc (Thenx),
+                    Name       => New_Occurrence_Of (Cnn, Sloc (Thenx)),
+                    Expression => Relocate_Node (Thenx))),
+
+                Else_Statements => New_List (
+                  Make_Assignment_Statement (Sloc (Elsex),
+                    Name       => New_Occurrence_Of (Cnn, Sloc (Elsex)),
+                    Expression => Relocate_Node (Elsex))));
 
+            Set_Assignment_OK (Name (First (Then_Statements (New_If))));
+            Set_Assignment_OK (Name (First (Else_Statements (New_If))));
+
+            New_N := New_Occurrence_Of (Cnn, Loc);
+         end if;
+
+         --  If no actions then no expansion needed, gigi will handle it using
+         --  the same approach as a C conditional expression.
+
+      else
          return;
       end if;
 
-      --  Move the SLOC of the parent If statement to the newly created one and
+      --  Fall through here for either the limited expansion, or the case of
+      --  inserting actions for non-limited types. In both these cases, we must
+      --  move the SLOC of the parent If statement to the newly created one and
       --  change it to the SLOC of the expression which, after expansion, will
       --  correspond to what is being evaluated.
 
@@ -4143,7 +4175,8 @@ package body Exp_Ch4 is
          Analyze_And_Resolve (N, Rtyp);
 
          Error_Msg_N ("?explicit membership test may be optimized away", N);
-         Error_Msg_N ("\?use ''Valid attribute instead", N);
+         Error_Msg_N -- CODEFIX
+           ("\?use ''Valid attribute instead", N);
          return;
       end Substitute_Valid_Check;
 
@@ -4267,8 +4300,10 @@ package body Exp_Ch4 is
 
             if Lcheck = LT or else Ucheck = GT then
                if Warn1 then
-                  Error_Msg_N ("?range test optimized away", N);
-                  Error_Msg_N ("\?value is known to be out of range", N);
+                  Error_Msg_N -- CODEFIX???
+                    ("?range test optimized away", N);
+                  Error_Msg_N -- CODEFIX???
+                    ("\?value is known to be out of range", N);
                end if;
 
                Rewrite (N,
@@ -4283,8 +4318,10 @@ package body Exp_Ch4 is
 
             elsif Lcheck in Compare_GE and then Ucheck in Compare_LE then
                if Warn1 then
-                  Error_Msg_N ("?range test optimized away", N);
-                  Error_Msg_N ("\?value is known to be in range", N);
+                  Error_Msg_N -- CODEFIX???
+                    ("?range test optimized away", N);
+                  Error_Msg_N -- CODEFIX???
+                    ("\?value is known to be in range", N);
                end if;
 
                Rewrite (N,
@@ -4300,8 +4337,10 @@ package body Exp_Ch4 is
 
             elsif Lcheck in Compare_GE then
                if Warn2 and then not In_Instance then
-                  Error_Msg_N ("?lower bound test optimized away", Lo);
-                  Error_Msg_N ("\?value is known to be in range", Lo);
+                  Error_Msg_N -- CODEFIX???
+                    ("?lower bound test optimized away", Lo);
+                  Error_Msg_N -- CODEFIX???
+                    ("\?value is known to be in range", Lo);
                end if;
 
                Rewrite (N,
@@ -4318,8 +4357,10 @@ package body Exp_Ch4 is
 
             elsif Ucheck in Compare_LE then
                if Warn2 and then not In_Instance then
-                  Error_Msg_N ("?upper bound test optimized away", Hi);
-                  Error_Msg_N ("\?value is known to be in range", Hi);
+                  Error_Msg_N -- CODEFIX???
+                    ("?upper bound test optimized away", Hi);
+                  Error_Msg_N -- CODEFIX???
+                    ("\?value is known to be in range", Hi);
                end if;
 
                Rewrite (N,
@@ -4343,25 +4384,25 @@ package body Exp_Ch4 is
                --  Result is out of range for valid value
 
                if Lcheck = LT or else Ucheck = GT then
-                  Error_Msg_N
+                  Error_Msg_N -- CODEFIX???
                     ("?value can only be in range if it is invalid", N);
 
                --  Result is in range for valid value
 
                elsif Lcheck in Compare_GE and then Ucheck in Compare_LE then
-                  Error_Msg_N
+                  Error_Msg_N -- CODEFIX???
                     ("?value can only be out of range if it is invalid", N);
 
                --  Lower bound check succeeds if value is valid
 
                elsif Warn2 and then Lcheck in Compare_GE then
-                  Error_Msg_N
+                  Error_Msg_N -- CODEFIX???
                     ("?lower bound check only fails if it is invalid", Lo);
 
                --  Upper bound  check succeeds if value is valid
 
                elsif Warn2 and then Ucheck in Compare_LE then
-                  Error_Msg_N
+                  Error_Msg_N -- CODEFIX???
                     ("?upper bound check only fails for invalid values", Hi);
                end if;
             end if;
@@ -9692,7 +9733,7 @@ package body Exp_Ch4 is
                  and then Is_Integer_Type (Etype (Left_Opnd (N)))
                  and then not Has_Warnings_Off (Etype (Left_Opnd (N)))
                then
-                  Error_Msg_N
+                  Error_Msg_N -- CODEFIX???
                     ("can never be greater than, could replace by ""'=""?", N);
                   Warning_Generated := True;
                end if;
@@ -9717,7 +9758,7 @@ package body Exp_Ch4 is
                  and then Is_Integer_Type (Etype (Left_Opnd (N)))
                  and then not Has_Warnings_Off (Etype (Left_Opnd (N)))
                then
-                  Error_Msg_N
+                  Error_Msg_N -- CODEFIX???
                     ("can never be less than, could replace by ""'=""?", N);
                   Warning_Generated := True;
                end if;
@@ -9755,11 +9796,11 @@ package body Exp_Ch4 is
               and then not In_Instance
             then
                if True_Result then
-                  Error_Msg_N
+                  Error_Msg_N -- CODEFIX???
                     ("condition can only be False if invalid values present?",
                      N);
                elsif False_Result then
-                  Error_Msg_N
+                  Error_Msg_N -- CODEFIX???
                     ("condition can only be True if invalid values present?",
                      N);
                end if;
diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index 899b013dcb0..47f877412b0 100644
--- a/gcc/ada/gnat1drv.adb
+++ b/gcc/ada/gnat1drv.adb
@@ -359,6 +359,30 @@ procedure Gnat1drv is
       else
          Use_Expression_With_Actions := False;
       end if;
+
+      --  Set switch indicating if back end can handle limited types, and
+      --  guarantee that no incorrect copies are made (e.g. in the context
+      --  of a conditional expression).
+
+      --  Debug flag -gnatd.L decisively sets usage on
+
+      if Debug_Flag_Dot_XX then
+         Back_End_Handles_Limited_Types := True;
+
+      --  If no debug flag, usage off for AAMP, VM, SCIL cases
+
+      elsif AAMP_On_Target
+        or else VM_Target /= No_VM
+        or else Generate_SCIL
+      then
+         Back_End_Handles_Limited_Types := False;
+
+         --  Otherwise normal gcc back end, for now still turn flag off by
+         --  default, since we have not verified proper back end handling.
+
+      else
+         Back_End_Handles_Limited_Types := False;
+      end if;
    end Adjust_Global_Switches;
 
    --------------------
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 9d0b2cdcea3..50625ec9a22 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -172,6 +172,15 @@ package Opt is
    --  also set true if certain Unchecked_Conversion instantiations require
    --  checking based on annotated values.
 
+   Back_End_Handles_Limited_Types : Boolean;
+   --  This flag is set true if the back end can properly handle limited or
+   --  other by reference types, and avoid copies. If this flag is False, then
+   --  the front end does special expansion for conditional expressions to make
+   --  sure that no copy occurs. If the flag is True, then the expansion for
+   --  conditional expressions relies on the back end properly handling things.
+   --  Currently the default is False for all cases (set in gnat1drv). The
+   --  default can be modified using -gnatd.L (sets the flag True).
+
    Bind_Alternate_Main_Name : Boolean := False;
    --  GNATBIND
    --  True if main should be called Alternate_Main_Name.all.
@@ -1239,12 +1248,12 @@ package Opt is
    --  Set to True if -h (-gnath for the compiler) switch encountered
    --  requesting usage information
 
-   Use_Expression_With_Actions : Boolean := False;
+   Use_Expression_With_Actions : Boolean;
    --  The N_Expression_With_Actions node has been introduced relatively
    --  recently, and not all back ends are prepared to handle it yet. So
    --  we use this flag to suppress its use during a transitional period.
-   --  Currently the default is False for all cases except the standard
-   --  GCC back end. The default can be modified using -gnatd.X/-gnatd.Y.
+   --  Currently the default is False for all cases (set in gnat1drv).
+   --  The default can be modified using -gnatd.X/-gnatd.Y.
 
    Use_Pragma_Linker_Constructor : Boolean := False;
    --  GNATBIND
diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb
index 1b2683379e3..78aa3d17977 100644
--- a/gcc/ada/par-ch3.adb
+++ b/gcc/ada/par-ch3.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- --
@@ -125,7 +125,7 @@ package body Ch3 is
       elsif Nkind_In (N, N_In, N_Not_In)
         and then Paren_Count (N) = 0
       then
-         Error_Msg_N
+         Error_Msg_N -- CODEFIX???
            ("|this expression must be parenthesized!", N);
          Error_Msg_N
            ("\|since extensions (and set notation) are allowed", N);
@@ -385,7 +385,8 @@ package body Ch3 is
          Scan; -- past = used in place of IS
 
       elsif Token = Tok_Renames then
-         Error_Msg_SC ("RENAMES should be IS");
+         Error_Msg_SC  -- CODEFIX
+           ("RENAMES should be IS");
          Scan; -- past RENAMES used in place of IS
 
       else
@@ -440,7 +441,8 @@ package body Ch3 is
            or else Token = Tok_Record
            or else Token = Tok_Null
          then
-            Error_Msg_AP ("TAGGED expected");
+            Error_Msg_AP -- CODEFIX???
+              ("TAGGED expected");
          end if;
       end if;
 
@@ -455,7 +457,8 @@ package body Ch3 is
       --  Special check for misuse of Aliased
 
       if Token = Tok_Aliased or else Token_Name = Name_Aliased then
-         Error_Msg_SC ("ALIASED not allowed in type definition");
+         Error_Msg_SC -- CODEFIX???
+           ("ALIASED not allowed in type definition");
          Scan; -- past ALIASED
       end if;
 
@@ -677,7 +680,8 @@ package body Ch3 is
                   elsif Abstract_Present
                     and then Prev_Token /= Tok_Tagged
                   then
-                     Error_Msg_SP ("TAGGED expected");
+                     Error_Msg_SP -- CODEFIX???
+                       ("TAGGED expected");
                   end if;
 
                   Typedef_Node := P_Record_Definition;
@@ -812,7 +816,7 @@ package body Ch3 is
                         if Nkind (Typedef_Node) =
                           N_Derived_Type_Definition
                         then
-                           Error_Msg_N
+                           Error_Msg_N -- CODEFIX???
                              ("SYNCHRONIZED not allowed for record extension",
                               Typedef_Node);
                         else
@@ -827,7 +831,8 @@ package body Ch3 is
 
                   else
                      if Token /= Tok_Interface then
-                        Error_Msg_SC ("NEW or INTERFACE expected");
+                        Error_Msg_SC -- CODEFIX???
+                          ("NEW or INTERFACE expected");
                      end if;
 
                      Typedef_Node :=
@@ -918,7 +923,8 @@ package body Ch3 is
             Set_Abstract_Present (Typedef_Node, Abstract_Present);
 
          elsif Abstract_Present then
-            Error_Msg ("ABSTRACT not allowed here, ignored", Abstract_Loc);
+            Error_Msg -- CODEFIX???
+              ("ABSTRACT not allowed here, ignored", Abstract_Loc);
          end if;
 
          Decl_Node := New_Node (N_Full_Type_Declaration, Type_Loc);
@@ -972,7 +978,8 @@ package body Ch3 is
       TF_Is;
 
       if Token = Tok_New then
-         Error_Msg_SC ("NEW ignored (only allowed in type declaration)");
+         Error_Msg_SC  -- CODEFIX
+           ("NEW ignored (only allowed in type declaration)");
          Scan; -- past NEW
       end if;
 
@@ -1034,11 +1041,13 @@ package body Ch3 is
             end if;
 
          else
-            Error_Msg_SP ("NULL expected");
+            Error_Msg_SP -- CODEFIX???
+              ("NULL expected");
          end if;
 
          if Token = Tok_New then
-            Error_Msg ("`NOT NULL` comes after NEW, not before", Not_Loc);
+            Error_Msg -- CODEFIX???
+              ("`NOT NULL` comes after NEW, not before", Not_Loc);
          end if;
 
          return True;
@@ -1090,7 +1099,8 @@ package body Ch3 is
          return Subtype_Mark;
       else
          if Not_Null_Present then
-            Error_Msg_SP ("`NOT NULL` not allowed if constraint given");
+            Error_Msg_SP -- CODEFIX???
+              ("`NOT NULL` not allowed if constraint given");
          end if;
 
          Indic_Node := New_Node (N_Subtype_Indication, Sloc (Subtype_Mark));
@@ -1358,8 +1368,9 @@ package body Ch3 is
       procedure No_List is
       begin
          if Num_Idents > 1 then
-            Error_Msg ("identifier list not allowed for RENAMES",
-                       Sloc (Idents (2)));
+            Error_Msg -- CODEFIX???
+              ("identifier list not allowed for RENAMES",
+               Sloc (Idents (2)));
          end if;
 
          List_OK := False;
@@ -1379,7 +1390,8 @@ package body Ch3 is
             Check_Misspelling_Of (Tok_Renames);
 
             if Token = Tok_Renames then
-               Error_Msg_SP ("|extra "":"" ignored");
+               Error_Msg_SP -- CODEFIX
+                 ("|extra "":"" ignored");
                Scan; -- past RENAMES
                return True;
             else
@@ -1433,7 +1445,8 @@ package body Ch3 is
          Scan; -- past :=
 
          if Token = Tok_Constant then
-            Error_Msg_SP ("colon expected");
+            Error_Msg_SP -- CODEFIX???
+              ("colon expected");
 
          else
             Restore_Scan_State (Scan_State);
@@ -1553,7 +1566,7 @@ package body Ch3 is
 
             if Present (Init_Expr) then
                if Not_Null_Present then
-                  Error_Msg_SP
+                  Error_Msg_SP -- CODEFIX???
                     ("`NOT NULL` not allowed in numeric expression");
                end if;
 
@@ -1604,7 +1617,7 @@ package body Ch3 is
                end if;
 
                if Token = Tok_Renames then
-                  Error_Msg
+                  Error_Msg -- CODEFIX???
                     ("CONSTANT not permitted in renaming declaration",
                      Con_Loc);
                   Scan; -- Past renames
@@ -1720,7 +1733,7 @@ package body Ch3 is
 
                if Token_Is_Renames then
                   if Ada_Version < Ada_05 then
-                     Error_Msg_SP
+                     Error_Msg_SP -- CODEFIX???
                        ("`NOT NULL` not allowed in object renaming");
                      raise Error_Resync;
 
@@ -1750,9 +1763,10 @@ package body Ch3 is
                   --  illegal
 
                   if Token_Is_Renames then
-                     Error_Msg_N ("constraint not allowed in object renaming "
-                                  & "declaration",
-                                  Constraint (Object_Definition (Decl_Node)));
+                     Error_Msg_N -- CODEFIX???
+                       ("constraint not allowed in object renaming "
+                        & "declaration",
+                        Constraint (Object_Definition (Decl_Node)));
                      raise Error_Resync;
                   end if;
                end if;
@@ -1812,7 +1826,7 @@ package body Ch3 is
                --  a constraint on the Type_Node and renames, which is illegal
 
                if Token_Is_Renames then
-                  Error_Msg_N
+                  Error_Msg_N -- CODEFIX???
                     ("constraint not allowed in object renaming declaration",
                      Constraint (Object_Definition (Decl_Node)));
                   raise Error_Resync;
@@ -1965,7 +1979,8 @@ package body Ch3 is
          end loop;
 
          if Token /= Tok_With then
-            Error_Msg_SC ("WITH expected");
+            Error_Msg_SC -- CODEFIX???
+              ("WITH expected");
             raise Error_Resync;
          end if;
       end if;
@@ -1981,7 +1996,7 @@ package body Ch3 is
          T_With; -- past WITH or give error message
 
          if Token = Tok_Limited then
-            Error_Msg_SC
+            Error_Msg_SC -- CODEFIX???
               ("LIMITED keyword not allowed in private extension");
             Scan; -- ignore LIMITED
          end if;
@@ -2107,7 +2122,6 @@ package body Ch3 is
       Range_Node : Node_Id;
       Save_Loc   : Source_Ptr;
 
-
    --  Start of processing for P_Range_Or_Subtype_Mark
 
    begin
@@ -2170,6 +2184,11 @@ package body Ch3 is
             return Expr_Node;
          end if;
 
+      --  Simple expression case
+
+      elsif Expr_Form = EF_Simple and then Allow_Simple_Expression then
+         return Expr_Node;
+
       --  Here we have some kind of error situation. Check for junk parens
       --  then return what we have, caller will deal with other errors.
 
@@ -2177,7 +2196,8 @@ package body Ch3 is
          if Nkind (Expr_Node) in N_Subexpr
            and then Paren_Count (Expr_Node) /= 0
          then
-            Error_Msg ("|parentheses not allowed for subtype mark", Save_Loc);
+            Error_Msg -- CODEFIX???
+              ("|parentheses not allowed for subtype mark", Save_Loc);
             Set_Paren_Count (Expr_Node, 0);
          end if;
 
@@ -2652,7 +2672,8 @@ package body Ch3 is
          end if;
 
          if Aliased_Present then
-            Error_Msg_SP ("ALIASED not allowed here");
+            Error_Msg_SP -- CODEFIX???
+              ("ALIASED not allowed here");
          end if;
 
          Set_Subtype_Indication     (CompDef_Node, Empty);
@@ -3299,7 +3320,8 @@ package body Ch3 is
 
                if Token = Tok_Colon then
                   Restore_Scan_State (Scan_State);
-                  Error_Msg_SC ("component may not follow variant part");
+                  Error_Msg_SC -- CODEFIX???
+                    ("component may not follow variant part");
                   Discard_Junk_Node (P_Component_List);
 
                elsif Token = Tok_Case then
@@ -3392,7 +3414,8 @@ package body Ch3 is
             Set_Defining_Identifier (Decl_Node, Idents (Ident));
 
             if Token = Tok_Constant then
-               Error_Msg_SC ("constant components are not permitted");
+               Error_Msg_SC -- CODEFIX???
+                 ("constant components are not permitted");
                Scan;
             end if;
 
@@ -3420,7 +3443,8 @@ package body Ch3 is
                end if;
 
                if Aliased_Present then
-                  Error_Msg_SP ("ALIASED not allowed here");
+                  Error_Msg_SP -- CODEFIX???
+                    ("ALIASED not allowed here");
                end if;
 
                Set_Subtype_Indication (CompDef_Node, Empty);
@@ -3434,7 +3458,7 @@ package body Ch3 is
                Set_Null_Exclusion_Present (CompDef_Node, Not_Null_Present);
 
                if Token = Tok_Array then
-                  Error_Msg_SC
+                  Error_Msg_SC -- CODEFIX???
                     ("anonymous arrays not allowed as components");
                   raise Error_Resync;
                end if;
@@ -3514,7 +3538,8 @@ package body Ch3 is
          Error_Msg ("discriminant name expected", Sloc (Case_Node));
 
       elsif Paren_Count (Case_Node) /= 0 then
-         Error_Msg ("|discriminant name may not be parenthesized",
+         Error_Msg -- CODEFIX???
+           ("|discriminant name may not be parenthesized",
                     Sloc (Case_Node));
          Set_Paren_Count (Case_Node, 0);
       end if;
@@ -3698,7 +3723,8 @@ package body Ch3 is
          end if;
 
          if Token = Tok_Comma then
-            Error_Msg_SC (""","" should be ""'|""");
+            Error_Msg_SC -- CODEFIX
+              (""","" should be ""'|""");
          else
             exit when Token /= Tok_Vertical_Bar;
          end if;
@@ -3745,8 +3771,9 @@ package body Ch3 is
       end if;
 
       if Abstract_Present then
-         Error_Msg_SP ("ABSTRACT not allowed in interface type definition " &
-                       "(RM 3.9.4(2/2))");
+         Error_Msg_SP -- CODEFIX???
+           ("ABSTRACT not allowed in interface type definition " &
+            "(RM 3.9.4(2/2))");
       end if;
 
       Scan; -- past INTERFACE
@@ -3768,7 +3795,8 @@ package body Ch3 is
 
       else
          if Token /= Tok_And then
-            Error_Msg_AP ("AND expected");
+            Error_Msg_AP -- CODEFIX???
+              ("AND expected");
          else
             Scan; -- past AND
          end if;
@@ -3854,7 +3882,8 @@ package body Ch3 is
             Scan; -- past possible junk subprogram name
 
             if Token = Tok_Left_Paren or else Token = Tok_Semicolon then
-               Error_Msg_SP ("unexpected subprogram name ignored");
+               Error_Msg_SP -- CODEFIX???
+                 ("unexpected subprogram name ignored");
                return;
 
             else
@@ -4035,7 +4064,7 @@ package body Ch3 is
 
          if Token = Tok_All then
             if Ada_Version < Ada_05 then
-               Error_Msg_SP
+               Error_Msg_SP -- CODEFIX???
                  ("ALL is not permitted for anonymous access types");
             end if;
 
@@ -4246,7 +4275,8 @@ package body Ch3 is
 
          when Tok_With =>
             Check_Bad_Layout;
-            Error_Msg_SC ("WITH can only appear in context clause");
+            Error_Msg_SC -- CODEFIX???
+              ("WITH can only appear in context clause");
             raise Error_Resync;
 
          --  BEGIN terminates the scan of a sequence of declarations unless
@@ -4284,7 +4314,8 @@ package body Ch3 is
                   --  Otherwise we saved the semicolon position, so complain
 
                   else
-                     Error_Msg ("|"";"" should be IS", SIS_Semicolon_Sloc);
+                     Error_Msg -- CODEFIX
+                       ("|"";"" should be IS", SIS_Semicolon_Sloc);
                   end if;
 
                   --  The next job is to fix up any declarations that occurred
@@ -4410,7 +4441,8 @@ package body Ch3 is
             if In_Spec then
                Done := True;
             else
-               Error_Msg_SC ("PRIVATE not allowed in body");
+               Error_Msg_SC -- CODEFIX???
+                 ("PRIVATE not allowed in body");
                Scan; -- past PRIVATE
             end if;
 
@@ -4519,17 +4551,17 @@ package body Ch3 is
             Kind = N_Task_Body or else
             Kind = N_Protected_Body
          then
-            Error_Msg
+            Error_Msg -- CODEFIX???
               ("proper body not allowed in package spec", Sloc (Decl));
 
          --  Test for body stub scanned, not acceptable as basic decl item
 
          elsif Kind in N_Body_Stub then
-            Error_Msg
+            Error_Msg -- CODEFIX???
               ("body stub not allowed in package spec", Sloc (Decl));
 
          elsif Kind = N_Assignment_Statement then
-            Error_Msg
+            Error_Msg -- CODEFIX???
               ("assignment statement not allowed in package spec",
                  Sloc (Decl));
          end if;
@@ -4618,7 +4650,8 @@ package body Ch3 is
          --  not allowed in package spec. This message never gets changed.
 
          if In_Spec then
-            Error_Msg_SC ("statement not allowed in package spec");
+            Error_Msg_SC -- CODEFIX???
+              ("statement not allowed in package spec");
 
          --  If in declarative part, then we give the message complaining
          --  about finding a statement when a declaration is expected. This
@@ -4626,7 +4659,8 @@ package body Ch3 is
          --  find that no BEGIN is present.
 
          else
-            Error_Msg_SC ("statement not allowed in declarative part");
+            Error_Msg_SC -- CODEFIX???
+              ("statement not allowed in declarative part");
          end if;
 
          --  Capture message Id. This is used for two purposes, first to
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 5525cd855ec..007376a5e98 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.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- --
@@ -558,7 +558,8 @@ package body Sem_Ch5 is
         and then not Is_Tag_Indeterminate (Rhs)
         and then not Is_Dynamically_Tagged (Rhs)
       then
-         Error_Msg_N ("dynamically tagged expression required!", Rhs);
+         Error_Msg_N -- CODEFIX???
+           ("dynamically tagged expression required!", Rhs);
       end if;
 
       --  Propagate the tag from a class-wide target to the rhs when the rhs
@@ -572,7 +573,7 @@ package body Sem_Ch5 is
               and then Is_Entity_Name (Name (Rhs))
               and then Is_Abstract_Subprogram (Entity (Name (Rhs)))
          then
-            Error_Msg_N
+            Error_Msg_N -- CODEFIX???
               ("call to abstract function must be dispatching", Name (Rhs));
 
          elsif Nkind (Rhs) = N_Qualified_Expression
@@ -581,7 +582,7 @@ package body Sem_Ch5 is
               and then
                 Is_Abstract_Subprogram (Entity (Name (Expression (Rhs))))
          then
-            Error_Msg_N
+            Error_Msg_N -- CODEFIX???
               ("call to abstract function must be dispatching",
                 Name (Expression (Rhs)));
          end if;
@@ -693,10 +694,10 @@ package body Sem_Ch5 is
         and then Nkind (Original_Node (Rhs)) not in N_Op
       then
          if Nkind (Lhs) in N_Has_Entity then
-            Error_Msg_NE
+            Error_Msg_NE -- CODEFIX
               ("?useless assignment of & to itself!", N, Entity (Lhs));
          else
-            Error_Msg_N
+            Error_Msg_N -- CODEFIX
               ("?useless assignment of object to itself!", N);
          end if;
       end if;
@@ -948,7 +949,7 @@ package body Sem_Ch5 is
       --  the case statement has a non static choice.
 
       procedure Process_Statements (Alternative : Node_Id);
-      --  Analyzes all the statements associated to a case alternative.
+      --  Analyzes all the statements associated with a case alternative.
       --  Needed by the generic instantiation below.
 
       package Case_Choices_Processing is new
@@ -1635,10 +1636,11 @@ package body Sem_Ch5 is
                         else
                            --  Both of them are user-defined
 
-                           Error_Msg_N
+                           Error_Msg_N -- CODEFIX???
                              ("ambiguous bounds in range of iteration",
                                R_Copy);
-                           Error_Msg_N ("\possible interpretations:", R_Copy);
+                           Error_Msg_N -- CODEFIX???
+                             ("\possible interpretations:", R_Copy);
                            Error_Msg_NE ("\\} ", R_Copy, Found);
                            Error_Msg_NE ("\\} ", R_Copy, It.Typ);
                            exit;
@@ -1890,7 +1892,7 @@ package body Sem_Ch5 is
                               if Compile_Time_Compare
                                    (L, H, Assume_Valid => False) = GT
                               then
-                                 Error_Msg_N
+                                 Error_Msg_N -- CODEFIX???
                                    ("?loop range is null, "
                                     & "loop will not execute",
                                     DS);
@@ -1944,7 +1946,8 @@ package body Sem_Ch5 is
                                     Intval (Original_Node (H)) = Uint_1)
                         then
                            Error_Msg_N ("?loop range may be null", DS);
-                           Error_Msg_N ("\?bounds may be wrong way round", DS);
+                           Error_Msg_N -- CODEFIX???
+                             ("\?bounds may be wrong way round", DS);
                         end if;
                      end;
                   end if;
@@ -2241,7 +2244,8 @@ package body Sem_Ch5 is
 
                   --  Now issue the warning
 
-                  Error_Msg ("?unreachable code!", Error_Loc);
+                  Error_Msg -- CODEFIX???
+                    ("?unreachable code!", Error_Loc);
                end if;
 
             --  If the unconditional transfer of control instruction is
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 7ef747000d5..1b1307d2158 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -126,6 +126,10 @@ package body Sem_Eval is
    --  This is the actual cache, with entries consisting of node/value pairs,
    --  and the impossible value Node_High_Bound used for unset entries.
 
+   type Range_Membership is (In_Range, Out_Of_Range, Unknown);
+   --  Range membership may either be statically known to be in range or out
+   --  of range, or not statically known. Used for Test_In_Range below.
+
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -210,6 +214,18 @@ package body Sem_Eval is
    --  Same processing, except applies to an expression N with two operands
    --  Op1 and Op2.
 
+   function Test_In_Range
+     (N            : Node_Id;
+      Typ          : Entity_Id;
+      Assume_Valid : Boolean;
+      Fixed_Int    : Boolean;
+      Int_Real     : Boolean) return Range_Membership;
+   --  Common processing for Is_In_Range and Is_Out_Of_Range:
+   --  Returns In_Range or Out_Of_Range if it can be guaranteed at compile time
+   --  that expression N is known to be in or out of range of the subtype Typ.
+   --  If not compile time known, Unknown is returned.
+   --  See documentation of Is_In_Range for complete description of parameters.
+
    procedure To_Bits (U : Uint; B : out Bits);
    --  Converts a Uint value to a bit string of length B'Length
 
@@ -3896,70 +3912,9 @@ package body Sem_Eval is
       Fixed_Int    : Boolean := False;
       Int_Real     : Boolean := False) return Boolean
    is
-      Val  : Uint;
-      Valr : Ureal;
-
-      pragma Warnings (Off, Assume_Valid);
-      --  For now Assume_Valid is unreferenced since the current implementation
-      --  always returns False if N is not a compile time known value, but we
-      --  keep the parameter to allow for future enhancements in which we try
-      --  to get the information in the variable case as well.
-
    begin
-      --  Universal types have no range limits, so always in range
-
-      if Typ = Universal_Integer or else Typ = Universal_Real then
-         return True;
-
-      --  Never in range if not scalar type. Don't know if this can
-      --  actually happen, but our spec allows it, so we must check!
-
-      elsif not Is_Scalar_Type (Typ) then
-         return False;
-
-      --  Never in range unless we have a compile time known value
-
-      elsif not Compile_Time_Known_Value (N) then
-         return False;
-
-      --  General processing with a known compile time value
-
-      else
-         declare
-            Lo       : Node_Id;
-            Hi       : Node_Id;
-            LB_Known : Boolean;
-            UB_Known : Boolean;
-
-         begin
-            Lo := Type_Low_Bound  (Typ);
-            Hi := Type_High_Bound (Typ);
-
-            LB_Known := Compile_Time_Known_Value (Lo);
-            UB_Known := Compile_Time_Known_Value (Hi);
-
-            --  Fixed point types should be considered as such only if flag
-            --  Fixed_Int is set to False.
-
-            if Is_Floating_Point_Type (Typ)
-              or else (Is_Fixed_Point_Type (Typ) and then not Fixed_Int)
-              or else Int_Real
-            then
-               Valr := Expr_Value_R (N);
-
-               return LB_Known and then Valr >= Expr_Value_R (Lo)
-                        and then
-                      UB_Known and then Valr <= Expr_Value_R (Hi);
-
-            else
-               Val := Expr_Value (N);
-
-               return LB_Known and then Val >= Expr_Value (Lo)
-                        and then
-                      UB_Known and then Val <= Expr_Value (Hi);
-            end if;
-         end;
-      end if;
+      return Test_In_Range (N, Typ, Assume_Valid, Fixed_Int, Int_Real)
+               = In_Range;
    end Is_In_Range;
 
    -------------------
@@ -4083,78 +4038,9 @@ package body Sem_Eval is
       Fixed_Int    : Boolean := False;
       Int_Real     : Boolean := False) return Boolean
    is
-      Val  : Uint;
-      Valr : Ureal;
-
-      pragma Warnings (Off, Assume_Valid);
-      --  For now Assume_Valid is unreferenced since the current implementation
-      --  always returns False if N is not a compile time known value, but we
-      --  keep the parameter to allow for future enhancements in which we try
-      --  to get the information in the variable case as well.
-
    begin
-      --  Universal types have no range limits, so always in range
-
-      if Typ = Universal_Integer or else Typ = Universal_Real then
-         return False;
-
-      --  Never out of range if not scalar type. Don't know if this can
-      --  actually happen, but our spec allows it, so we must check!
-
-      elsif not Is_Scalar_Type (Typ) then
-         return False;
-
-      --  Never out of range if this is a generic type, since the bounds
-      --  of generic types are junk. Note that if we only checked for
-      --  static expressions (instead of compile time known values) below,
-      --  we would not need this check, because values of a generic type
-      --  can never be static, but they can be known at compile time.
-
-      elsif Is_Generic_Type (Typ) then
-         return False;
-
-      --  Never out of range unless we have a compile time known value
-
-      elsif not Compile_Time_Known_Value (N) then
-         return False;
-
-      else
-         declare
-            Lo       : Node_Id;
-            Hi       : Node_Id;
-            LB_Known : Boolean;
-            UB_Known : Boolean;
-
-         begin
-            Lo := Type_Low_Bound (Typ);
-            Hi := Type_High_Bound (Typ);
-
-            LB_Known := Compile_Time_Known_Value (Lo);
-            UB_Known := Compile_Time_Known_Value (Hi);
-
-            --  Real types (note that fixed-point types are not treated as
-            --  being of a real type if the flag Fixed_Int is set, since in
-            --  that case they are regarded as integer types).
-
-            if Is_Floating_Point_Type (Typ)
-              or else (Is_Fixed_Point_Type (Typ) and then not Fixed_Int)
-              or else Int_Real
-            then
-               Valr := Expr_Value_R (N);
-
-               return (LB_Known and then Valr < Expr_Value_R (Lo))
-                        or else
-                      (UB_Known and then Expr_Value_R (Hi) < Valr);
-
-            else
-               Val := Expr_Value (N);
-
-               return (LB_Known and then Val < Expr_Value (Lo))
-                        or else
-                      (UB_Known and then Expr_Value (Hi) < Val);
-            end if;
-         end;
-      end if;
+      return Test_In_Range (N, Typ, Assume_Valid, Fixed_Int, Int_Real)
+               = Out_Of_Range;
    end Is_Out_Of_Range;
 
    ---------------------
@@ -4472,12 +4358,12 @@ package body Sem_Eval is
          --  A constrained numeric subtype never matches an unconstrained
          --  subtype, i.e. both types must be constrained or unconstrained.
 
-         --  To understand the requirement for this test, see RM 4.9.1(1). As
-         --  is made clear in RM 3.5.4(11), type Integer, for example is a
-         --  constrained subtype with constraint bounds matching the bounds of
-         --  its corresponding unconstrained base type. In this situation,
-         --  Integer and Integer'Base do not statically match, even though they
-         --  have the same bounds.
+         --  To understand the requirement for this test, see RM 4.9.1(1).
+         --  As is made clear in RM 3.5.4(11), type Integer, for example is
+         --  a constrained subtype with constraint bounds matching the bounds
+         --  of its corresponding unconstrained base type. In this situation,
+         --  Integer and Integer'Base do not statically match, even though
+         --  they have the same bounds.
 
          --  We only apply this test to types in Standard and types that appear
          --  in user programs. That way, we do not have to be too careful about
@@ -4877,6 +4763,125 @@ package body Sem_Eval is
       end if;
    end Test_Expression_Is_Foldable;
 
+   -------------------
+   -- Test_In_Range --
+   -------------------
+
+   function Test_In_Range
+     (N            : Node_Id;
+      Typ          : Entity_Id;
+      Assume_Valid : Boolean;
+      Fixed_Int    : Boolean;
+      Int_Real     : Boolean) return Range_Membership
+   is
+      Val  : Uint;
+      Valr : Ureal;
+
+      pragma Warnings (Off, Assume_Valid);
+      --  For now Assume_Valid is unreferenced since the current implementation
+      --  always returns Unknown if N is not a compile time known value, but we
+      --  keep the parameter to allow for future enhancements in which we try
+      --  to get the information in the variable case as well.
+
+   begin
+      --  Universal types have no range limits, so always in range
+
+      if Typ = Universal_Integer or else Typ = Universal_Real then
+         return In_Range;
+
+      --  Never known if not scalar type. Don't know if this can actually
+      --  happen, but our spec allows it, so we must check!
+
+      elsif not Is_Scalar_Type (Typ) then
+         return Unknown;
+
+      --  Never known if this is a generic type, since the bounds of generic
+      --  types are junk. Note that if we only checked for static expressions
+      --  (instead of compile time known values) below, we would not need this
+      --  check, because values of a generic type can never be static, but they
+      --  can be known at compile time.
+
+      elsif Is_Generic_Type (Typ) then
+         return Unknown;
+
+      --  Never known unless we have a compile time known value
+
+      elsif not Compile_Time_Known_Value (N) then
+         return Unknown;
+
+      --  General processing with a known compile time value
+
+      else
+         declare
+            Lo       : Node_Id;
+            Hi       : Node_Id;
+
+            LB_Known : Boolean;
+            HB_Known : Boolean;
+
+         begin
+            Lo := Type_Low_Bound  (Typ);
+            Hi := Type_High_Bound (Typ);
+
+            LB_Known := Compile_Time_Known_Value (Lo);
+            HB_Known := Compile_Time_Known_Value (Hi);
+
+            --  Fixed point types should be considered as such only if flag
+            --  Fixed_Int is set to False.
+
+            if Is_Floating_Point_Type (Typ)
+              or else (Is_Fixed_Point_Type (Typ) and then not Fixed_Int)
+              or else Int_Real
+            then
+               Valr := Expr_Value_R (N);
+
+               if LB_Known and HB_Known then
+                  if Valr >= Expr_Value_R (Lo)
+                       and then
+                     Valr <= Expr_Value_R (Hi)
+                  then
+                     return In_Range;
+                  else
+                     return Out_Of_Range;
+                  end if;
+
+               elsif (LB_Known and then Valr < Expr_Value_R (Lo))
+                       or else
+                     (HB_Known and then Valr > Expr_Value_R (Hi))
+               then
+                  return Out_Of_Range;
+
+               else
+                  return Unknown;
+               end if;
+
+            else
+               Val := Expr_Value (N);
+
+               if LB_Known and HB_Known then
+                  if Val >= Expr_Value (Lo)
+                       and then
+                     Val <= Expr_Value (Hi)
+                  then
+                     return In_Range;
+                  else
+                     return Out_Of_Range;
+                  end if;
+
+               elsif (LB_Known and then Val < Expr_Value (Lo))
+                       or else
+                     (HB_Known and then Val > Expr_Value (Hi))
+               then
+                  return Out_Of_Range;
+
+               else
+                  return Unknown;
+               end if;
+            end if;
+         end;
+      end if;
+   end Test_In_Range;
+
    --------------
    -- To_Bits --
    --------------
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 7ae5fab45a5..1a2012960d7 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -214,7 +214,8 @@ package body Sem_Res is
    --  to the corresponding predefined operator, with suitable conversions.
 
    procedure Resolve_Intrinsic_Unary_Operator (N : Node_Id; Typ : Entity_Id);
-   --  Ditto, for unary operators (only arithmetic ones)
+   --  Ditto, for unary operators (arithmetic ones and "not" on signed
+   --  integer types for VMS).
 
    procedure Rewrite_Operator_As_Call (N : Node_Id; Nam : Entity_Id);
    --  If an operator node resolves to a call to a user-defined operator,
@@ -273,19 +274,20 @@ package body Sem_Res is
 
    begin
       if Nkind (C) = N_Character_Literal then
-         Error_Msg_N ("ambiguous character literal", C);
+         Error_Msg_N -- CODEFIX???
+           ("ambiguous character literal", C);
 
          --  First the ones in Standard
 
-         Error_Msg_N
+         Error_Msg_N -- CODEFIX???
            ("\\possible interpretation: Character!", C);
-         Error_Msg_N
+         Error_Msg_N -- CODEFIX???
            ("\\possible interpretation: Wide_Character!", C);
 
          --  Include Wide_Wide_Character in Ada 2005 mode
 
          if Ada_Version >= Ada_05 then
-            Error_Msg_N
+            Error_Msg_N -- CODEFIX???
               ("\\possible interpretation: Wide_Wide_Character!", C);
          end if;
 
@@ -293,7 +295,8 @@ package body Sem_Res is
 
          E := Current_Entity (C);
          while Present (E) loop
-            Error_Msg_NE ("\\possible interpretation:}!", C, Etype (E));
+            Error_Msg_NE -- CODEFIX???
+              ("\\possible interpretation:}!", C, Etype (E));
             E := Homonym (E);
          end loop;
       end if;
@@ -633,9 +636,10 @@ package body Sem_Res is
    procedure Check_For_Visible_Operator (N : Node_Id; T : Entity_Id) is
    begin
       if Is_Invisible_Operator (N, T) then
-         Error_Msg_NE
+         Error_Msg_NE -- CODEFIX
            ("operator for} is not directly visible!", N, First_Subtype (T));
-         Error_Msg_N ("use clause would make operation legal!", N);
+         Error_Msg_N -- CODEFIX
+           ("use clause would make operation legal!", N);
       end if;
    end Check_For_Visible_Operator;
 
@@ -1752,7 +1756,8 @@ package body Sem_Res is
            and then Is_Entity_Name (Name (Arg))
            and then Is_Overloaded (Name (Arg))
          then
-            Error_Msg_NE ("ambiguous call to&", Arg, Name (Arg));
+            Error_Msg_NE -- CODEFIX???
+              ("ambiguous call to&", Arg, Name (Arg));
 
             --  Could use comments on what is going on here ???
 
@@ -1761,9 +1766,11 @@ package body Sem_Res is
                Error_Msg_Sloc := Sloc (It.Nam);
 
                if Nkind (Parent (It.Nam)) = N_Full_Type_Declaration then
-                  Error_Msg_N ("interpretation (inherited) #!", Arg);
+                  Error_Msg_N -- CODEFIX???
+                    ("interpretation (inherited) #!", Arg);
                else
-                  Error_Msg_N ("interpretation #!", Arg);
+                  Error_Msg_N -- CODEFIX???
+                    ("interpretation #!", Arg);
                end if;
 
                Get_Next_Interp (I, It);
@@ -2058,7 +2065,7 @@ package body Sem_Res is
                         if Nkind (N) = N_Function_Call
                           and then Nkind (Name (N)) = N_Explicit_Dereference
                         then
-                           Error_Msg_N
+                           Error_Msg_N -- CODEFIX???
                              ("ambiguous expression "
                                & "(cannot resolve indirect call)!", N);
                         else
@@ -2070,7 +2077,7 @@ package body Sem_Res is
                         Ambiguous := True;
 
                         if Nkind (Parent (Seen)) = N_Full_Type_Declaration then
-                           Error_Msg_N
+                           Error_Msg_N -- CODEFIX???
                              ("\\possible interpretation (inherited)#!", N);
                         else
                            Error_Msg_N -- CODEFIX
@@ -2148,19 +2155,19 @@ package body Sem_Res is
                         if  It.Typ = Universal_Fixed
                           and then Scope (It.Nam) = Standard_Standard
                         then
-                           Error_Msg_N
+                           Error_Msg_N -- CODEFIX???
                              ("\\possible interpretation as " &
                                 "universal_fixed operation " &
                                   "(RM 4.5.5 (19))", N);
                         else
-                           Error_Msg_N
+                           Error_Msg_N -- CODEFIX???
                              ("\\possible interpretation (predefined)#!", N);
                         end if;
 
                      elsif
                        Nkind (Parent (It.Nam)) = N_Full_Type_Declaration
                      then
-                        Error_Msg_N
+                        Error_Msg_N -- CODEFIX???
                           ("\\possible interpretation (inherited)#!", N);
                      else
                         Error_Msg_N -- CODEFIX
@@ -2908,7 +2915,7 @@ package body Sem_Res is
                --  Introduce an implicit 'Access in prefix
 
                if not Is_Aliased_View (Act) then
-                  Error_Msg_NE
+                  Error_Msg_NE -- CODEFIX???
                     ("object in prefixed call to& must be aliased"
                          & " (RM-2005 4.3.1 (13))",
                     Prefix (Act), Nam);
@@ -4199,7 +4206,8 @@ package body Sem_Res is
          declare
             Loc : constant Source_Ptr := Sloc (N);
          begin
-            Error_Msg_N ("?allocation from empty storage pool!", N);
+            Error_Msg_N -- CODEFIX???
+              ("?allocation from empty storage pool!", N);
             Error_Msg_N ("\?Storage_Error will be raised at run time!", N);
             Insert_Action (N,
               Make_Raise_Storage_Error (Loc,
@@ -6352,7 +6360,8 @@ package body Sem_Res is
            and then Entity (R) = Standard_True
            and then Comes_From_Source (R)
          then
-            Error_Msg_N ("?comparison with True is redundant!", R);
+            Error_Msg_N -- CODEFIX
+              ("?comparison with True is redundant!", R);
          end if;
 
          Check_Unset_Reference (L);
@@ -6676,6 +6685,13 @@ package body Sem_Res is
       Arg2 : Node_Id;
 
    begin
+      --  We must preserve the original entity in a generic setting, so that
+      --  the legality of the operation can be verified in an instance.
+
+      if not Expander_Active then
+         return;
+      end if;
+
       Op := Entity (N);
       while Scope (Op) /= Standard_Standard loop
          Op := Homonym (Op);
@@ -7365,7 +7381,7 @@ package body Sem_Res is
 
       elsif Typ = Universal_Integer or else Typ = Any_Modular then
          if Parent_Is_Boolean then
-            Error_Msg_N
+            Error_Msg_N -- CODEFIX???
               ("operand of not must be enclosed in parentheses",
                Right_Opnd (N));
          else
@@ -7387,7 +7403,8 @@ package body Sem_Res is
            and then not Is_Boolean_Type (Typ)
            and then Parent_Is_Boolean
          then
-            Error_Msg_N ("?not expression should be parenthesized here!", N);
+            Error_Msg_N -- CODEFIX???
+              ("?not expression should be parenthesized here!", N);
          end if;
 
          --  Warn on double negation if checking redundant constructs
@@ -7398,7 +7415,8 @@ package body Sem_Res is
            and then Root_Type (Typ) = Standard_Boolean
            and then Nkind (Right_Opnd (N)) = N_Op_Not
          then
-            Error_Msg_N ("redundant double negation?", N);
+            Error_Msg_N -- CODEFIX???
+              ("redundant double negation?", N);
          end if;
 
          --  Complete resolution and evaluation of NOT
@@ -8578,7 +8596,8 @@ package body Sem_Res is
 
                if From_With_Type (Opnd) then
                   Error_Msg_Qual_Level := 99;
-                  Error_Msg_NE ("missing WITH clause on package &", N,
+                  Error_Msg_NE -- CODEFIX
+                    ("missing WITH clause on package &", N,
                     Cunit_Entity (Get_Source_Unit (Base_Type (Opnd))));
                   Error_Msg_N
                     ("type conversions require visibility of the full view",
@@ -8590,7 +8609,8 @@ package body Sem_Res is
                       and then Present (Non_Limited_View (Etype (Target))))
                then
                   Error_Msg_Qual_Level := 99;
-                  Error_Msg_NE ("missing WITH clause on package &", N,
+                  Error_Msg_NE -- CODEFIX
+                    ("missing WITH clause on package &", N,
                     Cunit_Entity (Get_Source_Unit (Base_Type (Target))));
                   Error_Msg_N
                     ("type conversions require visibility of the full view",
@@ -8682,7 +8702,7 @@ package body Sem_Res is
          Determine_Range (Right_Opnd (N), OK, Lo, Hi);
 
          if OK and then Hi >= Lo and then Lo >= 0 then
-            Error_Msg_N
+            Error_Msg_N -- CODEFIX
              ("?abs applied to known non-negative value has no effect", N);
          end if;
       end if;
@@ -8820,7 +8840,7 @@ package body Sem_Res is
 
                --  If we fall through warning should be issued
 
-               Error_Msg_N
+               Error_Msg_N -- CODEFIX???
                  ("?unary minus expression should be parenthesized here!", N);
             end if;
          end if;
@@ -9201,9 +9221,12 @@ package body Sem_Res is
 
       procedure Fixed_Point_Error is
       begin
-         Error_Msg_N ("ambiguous universal_fixed_expression", N);
-         Error_Msg_NE ("\\possible interpretation as}", N, T1);
-         Error_Msg_NE ("\\possible interpretation as}", N, T2);
+         Error_Msg_N -- CODEFIX???
+           ("ambiguous universal_fixed_expression", N);
+         Error_Msg_NE -- CODEFIX???
+            ("\\possible interpretation as}", N, T1);
+         Error_Msg_NE -- CODEFIX???
+            ("\\possible interpretation as}", N, T2);
       end Fixed_Point_Error;
 
    --  Start of processing for Unique_Fixed_Point_Type
@@ -10049,7 +10072,8 @@ package body Sem_Res is
          and then Is_Access_Type (Opnd_Type)
       then
          Error_Msg_N ("target type must be general access type!", N);
-         Error_Msg_NE ("add ALL to }!", N, Target_Type);
+         Error_Msg_NE -- CODEFIX
+            ("add ALL to }!", N, Target_Type);
          return False;
 
       else
diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb
index aa8e8802246..a7fc6e72d99 100644
--- a/gcc/ada/sprint.adb
+++ b/gcc/ada/sprint.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- --
@@ -1513,7 +1513,6 @@ package body Sprint is
             Indent_Begin;
             Write_Indent_Str_Sloc ("do");
             Indent_Begin;
-            Write_Indent;
             Sprint_Node_List (Actions (Node));
             Indent_End;
             Write_Indent;