[multiple changes]

2014-02-25  Robert Dewar  <dewar@adacore.com>

	* einfo.ads, einfo.adb (Has_Shift_Operator): New flag.
	* gnat_rm.texi: Document pragma Provide_Shift_Operators.
	* interfac.ads: Minor code reorganization (add pragma
	Compiler_Unit_Warning).
	* par-prag.adb: Add dummy entry for Provide_Shift_Operators.
	* sem_ch3.adb (Build_Derived_Numeric_Type): Copy
	Has_Shift_Operator flag.
	* sem_intr.adb (Check_Intrinsic_Subprogram): Make sure
	Check_Shift is always called (Check_Shift): Set Has_Shift_Operator.
	* sem_prag.adb: Implement pragma Provide_Shift_Operators.
	* snames.ads-tmpl: Add entries for pragma Provide_Shift_Operators
	Add entry for Name_Amount.
	* checks.adb (Selected_Range_Checks): When checking for a null
	range, make sure we use the base type, and not the subtype for
	deciding a range is null.
	* sem_ch5.adb (Analyze_Loop_Parameter_Specification): Check
	for suspicious loop bound which is outside the range of the
	loop subtype.
	* gnat_ugn.texi: Add documentation section "Determining the
	Chosen Elaboration Order"
	* sem_ch13.adb (UC_Entry): Add field Act_Unit
	(Validate_Unchecked_Conversion): Store Act_Unit
	(Validate_Unchecked_Conversions): Test Warnings_Off in Act_Unit
	* treepr.adb: Minor reformatting.

2014-02-25  Arnaud Charlet  <charlet@adacore.com>

	* usage.adb: Minor: fix typo.

From-SVN: r208138

16 files changed, 493 insertions, 51 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index bfd1657f..91cf5ae 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,36 @@
 2014-02-25  Robert Dewar  <dewar@adacore.com>
 
+	* einfo.ads, einfo.adb (Has_Shift_Operator): New flag.
+	* gnat_rm.texi: Document pragma Provide_Shift_Operators.
+	* interfac.ads: Minor code reorganization (add pragma
+	Compiler_Unit_Warning).
+	* par-prag.adb: Add dummy entry for Provide_Shift_Operators.
+	* sem_ch3.adb (Build_Derived_Numeric_Type): Copy
+	Has_Shift_Operator flag.
+	* sem_intr.adb (Check_Intrinsic_Subprogram): Make sure
+	Check_Shift is always called (Check_Shift): Set Has_Shift_Operator.
+	* sem_prag.adb: Implement pragma Provide_Shift_Operators.
+	* snames.ads-tmpl: Add entries for pragma Provide_Shift_Operators
+	Add entry for Name_Amount.
+	* checks.adb (Selected_Range_Checks): When checking for a null
+	range, make sure we use the base type, and not the subtype for
+	deciding a range is null.
+	* sem_ch5.adb (Analyze_Loop_Parameter_Specification): Check
+	for suspicious loop bound which is outside the range of the
+	loop subtype.
+	* gnat_ugn.texi: Add documentation section "Determining the
+	Chosen Elaboration Order"
+	* sem_ch13.adb (UC_Entry): Add field Act_Unit
+	(Validate_Unchecked_Conversion): Store Act_Unit
+	(Validate_Unchecked_Conversions): Test Warnings_Off in Act_Unit
+	* treepr.adb: Minor reformatting.
+
+2014-02-25  Arnaud Charlet  <charlet@adacore.com>
+
+	* usage.adb: Minor: fix typo.
+
+2014-02-25  Robert Dewar  <dewar@adacore.com>
+
 	* lib.ads, s-bitops.adb, s-bitops.ads, s-conca5.adb, gnat_rm.texi,
 	s-conca5.ads, s-conca7.adb, s-conca7.ads, s-crc32.adb, s-crc32.ads,
 	s-conca9.adb, s-conca9.ads, g-dyntab.adb, s-crtl.ads, g-dyntab.ads,
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index ad4b5b7..75be5b2 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -9157,8 +9157,12 @@ package body Checks is
                     Make_And_Then (Loc,
                       Left_Opnd =>
                         Make_Op_Ge (Loc,
-                          Left_Opnd  => Duplicate_Subexpr_No_Checks (HB),
-                          Right_Opnd => Duplicate_Subexpr_No_Checks (LB)),
+                          Left_Opnd  =>
+                            Convert_To (Base_Type (Etype (HB)),
+                              Duplicate_Subexpr_No_Checks (HB)),
+                          Right_Opnd =>
+                            Convert_To (Base_Type (Etype (LB)),
+                              Duplicate_Subexpr_No_Checks (LB))),
                       Right_Opnd => Cond);
                end;
             end if;
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 01ec45a..076cf7b 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -557,12 +557,12 @@ package body Einfo is
    --    Is_Discriminant_Check_Function  Flag264
    --    SPARK_Pragma_Inherited          Flag265
    --    SPARK_Aux_Pragma_Inherited      Flag266
+   --    Has_Shift_Operator              Flag267
 
    --    (unused)                        Flag1
    --    (unused)                        Flag2
    --    (unused)                        Flag3
 
-   --    (unused)                        Flag267
    --    (unused)                        Flag268
    --    (unused)                        Flag269
    --    (unused)                        Flag270
@@ -1667,6 +1667,12 @@ package body Einfo is
       return Flag143 (Id);
    end Has_Recursive_Call;
 
+   function Has_Shift_Operator (Id : E) return B is
+   begin
+      pragma Assert (Is_Integer_Type (Id));
+      return Flag267 (Base_Type (Id));
+   end Has_Shift_Operator;
+
    function Has_Size_Clause (Id : E) return B is
    begin
       return Flag29 (Id);
@@ -4372,6 +4378,12 @@ package body Einfo is
       Set_Flag143 (Id, V);
    end Set_Has_Recursive_Call;
 
+   procedure Set_Has_Shift_Operator (Id : E; V : B := True) is
+   begin
+      pragma Assert (Is_Integer_Type (Id) and then Is_Base_Type (Id));
+      Set_Flag267 (Id, V);
+   end Set_Has_Shift_Operator;
+
    procedure Set_Has_Size_Clause (Id : E; V : B := True) is
    begin
       Set_Flag29 (Id, V);
@@ -8203,6 +8215,7 @@ package body Einfo is
       W ("Has_RACW",                        Flag214 (Id));
       W ("Has_Record_Rep_Clause",           Flag65  (Id));
       W ("Has_Recursive_Call",              Flag143 (Id));
+      W ("Has_Shift_Operator",              Flag267 (Id));
       W ("Has_Size_Clause",                 Flag29  (Id));
       W ("Has_Small_Clause",                Flag67  (Id));
       W ("Has_Specified_Layout",            Flag100 (Id));
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index a9106b2..91f59b4 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -1826,6 +1826,10 @@ package Einfo is
 --       is detected while analyzing the body. Used to activate some error
 --       checks for infinite recursion.
 
+--    Has_Shift_Operator (Flag267) [base type only]
+--       Defined in integer types. Set in the base type of an integer type for
+--       which at least one of the shift operators is defined.
+
 --    Has_Size_Clause (Flag29)
 --       Defined in entities for types and objects. Set if a size clause is
 --       defined for the entity. Used to prevent multiple Size clauses for a
@@ -5644,6 +5648,7 @@ package Einfo is
    --    Static_Predicate                    (List25)
    --    Non_Binary_Modulus                  (Flag58)   (base type only)
    --    Has_Biased_Representation           (Flag139)
+   --    Has_Shift_Operator                  (Flag267)  (base type only)
    --    Type_Low_Bound                      (synth)
    --    Type_High_Bound                     (synth)
    --    (plus type attributes)
@@ -5940,6 +5945,7 @@ package Einfo is
    --    Scalar_Range                        (Node20)
    --    Static_Predicate                    (List25)
    --    Has_Biased_Representation           (Flag139)
+   --    Has_Shift_Operator                  (Flag267)  (base type only)
    --    Type_Low_Bound                      (synth)
    --    Type_High_Bound                     (synth)
    --    (plus type attributes)
@@ -6465,6 +6471,7 @@ package Einfo is
    function Has_RACW                            (Id : E) return B;
    function Has_Record_Rep_Clause               (Id : E) return B;
    function Has_Recursive_Call                  (Id : E) return B;
+   function Has_Shift_Operator                  (Id : E) return B;
    function Has_Size_Clause                     (Id : E) return B;
    function Has_Small_Clause                    (Id : E) return B;
    function Has_Specified_Layout                (Id : E) return B;
@@ -7088,6 +7095,7 @@ package Einfo is
    procedure Set_Has_RACW                        (Id : E; V : B := True);
    procedure Set_Has_Record_Rep_Clause           (Id : E; V : B := True);
    procedure Set_Has_Recursive_Call              (Id : E; V : B := True);
+   procedure Set_Has_Shift_Operator              (Id : E; V : B := True);
    procedure Set_Has_Size_Clause                 (Id : E; V : B := True);
    procedure Set_Has_Small_Clause                (Id : E; V : B := True);
    procedure Set_Has_Specified_Layout            (Id : E; V : B := True);
@@ -7825,6 +7833,7 @@ package Einfo is
    pragma Inline (Has_RACW);
    pragma Inline (Has_Record_Rep_Clause);
    pragma Inline (Has_Recursive_Call);
+   pragma Inline (Has_Shift_Operator);
    pragma Inline (Has_Size_Clause);
    pragma Inline (Has_Small_Clause);
    pragma Inline (Has_Specified_Layout);
@@ -8296,6 +8305,7 @@ package Einfo is
    pragma Inline (Set_Has_RACW);
    pragma Inline (Set_Has_Record_Rep_Clause);
    pragma Inline (Set_Has_Recursive_Call);
+   pragma Inline (Set_Has_Shift_Operator);
    pragma Inline (Set_Has_Size_Clause);
    pragma Inline (Set_Has_Small_Clause);
    pragma Inline (Set_Has_Specified_Layout);
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 5a3d762..2090c62 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -224,6 +224,7 @@ Implementation Defined Pragmas
 * Pragma Profile::
 * Pragma Profile_Warnings::
 * Pragma Propagate_Exceptions::
+* Pragma Provide_Shift_Operators::
 * Pragma Psect_Object::
 * Pragma Pure_05::
 * Pragma Pure_12::
@@ -1056,6 +1057,7 @@ consideration, the use of these pragmas should be minimized.
 * Pragma Profile::
 * Pragma Profile_Warnings::
 * Pragma Propagate_Exceptions::
+* Pragma Provide_Shift_Operators::
 * Pragma Psect_Object::
 * Pragma Pure_05::
 * Pragma Pure_12::
@@ -5852,6 +5854,25 @@ It is retained for compatibility
 purposes. It used to be used in connection with optimization of
 a now-obsolete mechanism for implementation of exceptions.
 
+@node Pragma Provide_Shift_Operators
+@unnumberedsec Pragma Provide_Shift_Operators
+@cindex Shift operators
+@findex Provide_Shift_Operators
+@noindent
+Syntax:
+
+@smallexample @c ada
+pragma Provide_Shift_Operators (integer_first_subtype_LOCAL_NAME);
+@end smallexample
+
+@noindent
+This pragma can be applied to a first subtype local name that specifies
+either an unsigned or signed type. It has the effect of providing the
+five shift operators (Shift_Left, Shift_Right, Shift_Right_Arithmetic,
+Rotate_Left and Rotate_Right) for the given type. It is equivalent to
+including the function declarations for these five operators, together
+with the pragma Import (Intrinsic, ...) statements.
+
 @node Pragma Psect_Object
 @unnumberedsec Pragma Psect_Object
 @findex Psect_Object
@@ -13685,8 +13706,7 @@ type (signed or modular), as in this example:
 @smallexample @c ada
    function Shift_Left
      (Value  : T;
-      Amount : Natural)
-      return   T;
+      Amount : Natural) return T;
 @end smallexample
 
 @noindent
@@ -13699,6 +13719,10 @@ The result type must be the same as the type of @code{Value}.
 The shift amount must be Natural.
 The formal parameter names can be anything.
 
+A more convenient way of providing these shift operators is to use
+the Provide_Shift_Operators pragma, which provides the function declarations
+and corresponding pragma Import's for all five shift functions.
+
 @node Source_Location
 @section Source_Location
 @cindex Source_Location
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 6fc86ab..54a0a5c 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -25049,6 +25049,7 @@ elaboration code in your own application).
 * Elaboration for Dispatching Calls::
 * Summary of Procedures for Elaboration Control::
 * Other Elaboration Order Considerations::
+* Determining the Chosen Elaboration Order::
 @end menu
 
 @noindent
@@ -26891,6 +26892,145 @@ difference, by looking at the two elaboration orders that are chosen,
 and figuring out which is correct, and then adding the necessary
 @code{Elaborate} or @code{Elaborate_All} pragmas to ensure the desired order.
 
+@node Determining the Chosen Elaboration Order
+@section Determining the Chosen Elaboration Order
+@noindent
+
+To see the elaboration order that the binder chooses, you can look at
+the last part of the b~xxx.adb binder output file. Here is an example:
+
+@smallexample @c ada
+System.Soft_Links'Elab_Body;
+E14 := True;
+System.Secondary_Stack'Elab_Body;
+E18 := True;
+System.Exception_Table'Elab_Body;
+E24 := True;
+Ada.Io_Exceptions'Elab_Spec;
+E67 := True;
+Ada.Tags'Elab_Spec;
+Ada.Streams'Elab_Spec;
+E43 := True;
+Interfaces.C'Elab_Spec;
+E69 := True;
+System.Finalization_Root'Elab_Spec;
+E60 := True;
+System.Os_Lib'Elab_Body;
+E71 := True;
+System.Finalization_Implementation'Elab_Spec;
+System.Finalization_Implementation'Elab_Body;
+E62 := True;
+Ada.Finalization'Elab_Spec;
+E58 := True;
+Ada.Finalization.List_Controller'Elab_Spec;
+E76 := True;
+System.File_Control_Block'Elab_Spec;
+E74 := True;
+System.File_Io'Elab_Body;
+E56 := True;
+Ada.Tags'Elab_Body;
+E45 := True;
+Ada.Text_Io'Elab_Spec;
+Ada.Text_Io'Elab_Body;
+E07 := True;
+@end smallexample
+
+@noindent
+Here Elab_Spec elaborates the spec
+and Elab_Body elaborates the body. The assignments to the Exx flags
+flag that the corresponding body is now elaborated.
+
+You can also ask the binder to generate a more
+readable list of the elaboration order using the
+@code{-l} switch when invoking the binder. Here is
+an example of the output generated by this switch:
+
+@smallexample
+ada (spec)
+interfaces (spec)
+system (spec)
+system.case_util (spec)
+system.case_util (body)
+system.concat_2 (spec)
+system.concat_2 (body)
+system.concat_3 (spec)
+system.concat_3 (body)
+system.htable (spec)
+system.parameters (spec)
+system.parameters (body)
+system.crtl (spec)
+interfaces.c_streams (spec)
+interfaces.c_streams (body)
+system.restrictions (spec)
+system.restrictions (body)
+system.standard_library (spec)
+system.exceptions (spec)
+system.exceptions (body)
+system.storage_elements (spec)
+system.storage_elements (body)
+system.secondary_stack (spec)
+system.stack_checking (spec)
+system.stack_checking (body)
+system.string_hash (spec)
+system.string_hash (body)
+system.htable (body)
+system.strings (spec)
+system.strings (body)
+system.traceback (spec)
+system.traceback (body)
+system.traceback_entries (spec)
+system.traceback_entries (body)
+ada.exceptions (spec)
+ada.exceptions.last_chance_handler (spec)
+system.soft_links (spec)
+system.soft_links (body)
+ada.exceptions.last_chance_handler (body)
+system.secondary_stack (body)
+system.exception_table (spec)
+system.exception_table (body)
+ada.io_exceptions (spec)
+ada.tags (spec)
+ada.streams (spec)
+interfaces.c (spec)
+interfaces.c (body)
+system.finalization_root (spec)
+system.finalization_root (body)
+system.memory (spec)
+system.memory (body)
+system.standard_library (body)
+system.os_lib (spec)
+system.os_lib (body)
+system.unsigned_types (spec)
+system.stream_attributes (spec)
+system.stream_attributes (body)
+system.finalization_implementation (spec)
+system.finalization_implementation (body)
+ada.finalization (spec)
+ada.finalization (body)
+ada.finalization.list_controller (spec)
+ada.finalization.list_controller (body)
+system.file_control_block (spec)
+system.file_io (spec)
+system.file_io (body)
+system.val_uns (spec)
+system.val_util (spec)
+system.val_util (body)
+system.val_uns (body)
+system.wch_con (spec)
+system.wch_con (body)
+system.wch_cnv (spec)
+system.wch_jis (spec)
+system.wch_jis (body)
+system.wch_cnv (body)
+system.wch_stw (spec)
+system.wch_stw (body)
+ada.tags (body)
+ada.exceptions (body)
+ada.text_io (spec)
+ada.text_io (body)
+text_io (spec)
+gdbstr (body)
+@end smallexample
 
 @c **********************************
 @node Overflow Check Handling in GNAT
diff --git a/gcc/ada/interfac.ads b/gcc/ada/interfac.ads
index 57033a9..fe6bb0f 100644
--- a/gcc/ada/interfac.ads
+++ b/gcc/ada/interfac.ads
@@ -33,6 +33,8 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+pragma Compiler_Unit_Warning;
+
 package Interfaces is
    pragma Pure;
 
diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb
index 5182d7c..14560ea 100644
--- a/gcc/ada/par-prag.adb
+++ b/gcc/ada/par-prag.adb
@@ -1278,6 +1278,7 @@ begin
            Pragma_Profile                        |
            Pragma_Profile_Warnings               |
            Pragma_Propagate_Exceptions           |
+           Pragma_Provide_Shift_Operators        |
            Pragma_Psect_Object                   |
            Pragma_Pure                           |
            Pragma_Pure_05                        |
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index d8c71d7..1f8d73f 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -199,9 +199,10 @@ package body Sem_Ch13 is
    --  already have modified all Sloc values if the -gnatD option is set.
 
    type UC_Entry is record
-      Eloc   : Source_Ptr; -- node used for posting warnings
-      Source : Entity_Id;  -- source type for unchecked conversion
-      Target : Entity_Id;  -- target type for unchecked conversion
+      Eloc     : Source_Ptr; -- node used for posting warnings
+      Source   : Entity_Id;  -- source type for unchecked conversion
+      Target   : Entity_Id;  -- target type for unchecked conversion
+      Act_Unit : Entity_Id;  -- actual function instantiated
    end record;
 
    package Unchecked_Conversions is new Table.Table (
@@ -11700,9 +11701,10 @@ package body Sem_Ch13 is
 
       if Warn_On_Unchecked_Conversion then
          Unchecked_Conversions.Append
-           (New_Val => UC_Entry'(Eloc   => Sloc (N),
-                                 Source => Source,
-                                 Target => Target));
+           (New_Val => UC_Entry'(Eloc     => Sloc (N),
+                                 Source   => Source,
+                                 Target   => Target,
+                                 Act_Unit => Act_Unit));
 
          --  If both sizes are known statically now, then back end annotation
          --  is not required to do a proper check but if either size is not
@@ -11757,14 +11759,21 @@ package body Sem_Ch13 is
          declare
             T : UC_Entry renames Unchecked_Conversions.Table (N);
 
-            Eloc   : constant Source_Ptr := T.Eloc;
-            Source : constant Entity_Id  := T.Source;
-            Target : constant Entity_Id  := T.Target;
+            Eloc     : constant Source_Ptr := T.Eloc;
+            Source   : constant Entity_Id  := T.Source;
+            Target   : constant Entity_Id  := T.Target;
+            Act_Unit : constant Entity_Id  := T.Act_Unit;
 
             Source_Siz : Uint;
             Target_Siz : Uint;
 
          begin
+            --  Skip if function marked as warnings off
+
+            if Warnings_Off (Act_Unit) then
+               goto Continue;
+            end if;
+
             --  This validation check, which warns if we have unequal sizes for
             --  unchecked conversion, and thus potentially implementation
             --  dependent semantics, is one of the few occasions on which we
@@ -11904,6 +11913,9 @@ package body Sem_Ch13 is
                end;
             end if;
          end;
+
+      <<Continue>>
+         null;
       end loop;
    end Validate_Unchecked_Conversions;
 
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index e7c9167..ad7d880 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -6401,6 +6401,11 @@ package body Sem_Ch3 is
          end if;
       end if;
 
+      if Is_Integer_Type (Parent_Type) then
+         Set_Has_Shift_Operator
+           (Implicit_Base, Has_Shift_Operator (Parent_Type));
+      end if;
+
       --  The type of the bounds is that of the parent type, and they
       --  must be converted to the derived type.
 
@@ -14807,7 +14812,7 @@ package body Sem_Ch3 is
       if Parent_Type = Any_Type
         or else Etype (Parent_Type) = Any_Type
         or else (Is_Class_Wide_Type (Parent_Type)
-                   and then Etype (Parent_Type) = T)
+                  and then Etype (Parent_Type) = T)
       then
          --  If Parent_Type is undefined or illegal, make new type into a
          --  subtype of Any_Type, and set a few attributes to prevent cascaded
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index b864433..1e7c4c2 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -2488,9 +2488,9 @@ package body Sem_Ch5 is
         or else Etype (Id) = Any_Type
         or else
           (Present (Etype (Id))
-             and then Is_Itype (Etype (Id))
-             and then Nkind (Parent (Loop_Nod)) = N_Expression_With_Actions
-             and then Nkind (Original_Node (Parent (Loop_Nod))) =
+            and then Is_Itype (Etype (Id))
+            and then Nkind (Parent (Loop_Nod)) = N_Expression_With_Actions
+            and then Nkind (Original_Node (Parent (Loop_Nod))) =
                                                    N_Quantified_Expression)
       then
          Set_Etype (Id, Etype (DS));
@@ -2517,19 +2517,33 @@ package body Sem_Ch5 is
          end;
       end if;
 
-      --  Check for null or possibly null range and issue warning. We suppress
-      --  such messages in generic templates and instances, because in practice
-      --  they tend to be dubious in these cases. The check applies as well to
-      --  rewritten array element loops where a null range may be detected
-      --  statically.
+      --  Case where we have a range or a subtype, get type bounds
 
-      if Nkind (DS) = N_Range then
+      if Nkind_In (DS, N_Range, N_Subtype_Indication)
+        and then not Error_Posted (DS)
+        and then Etype (DS) /= Any_Type
+        and then Is_Discrete_Type (Etype (DS))
+      then
          declare
-            L : constant Node_Id := Low_Bound  (DS);
-            H : constant Node_Id := High_Bound (DS);
+            L : Node_Id;
+            H : Node_Id;
 
          begin
-            --  If range of loop is null, issue warning
+            if Nkind (DS) = N_Range then
+               L := Low_Bound  (DS);
+               H := High_Bound (DS);
+            else
+               L :=
+                 Type_Low_Bound  (Underlying_Type (Etype (Subtype_Mark (DS))));
+               H :=
+                 Type_High_Bound (Underlying_Type (Etype (Subtype_Mark (DS))));
+            end if;
+
+            --  Check for null or possibly null range and issue warning. We
+            --  suppress such messages in generic templates and instances,
+            --  because in practice they tend to be dubious in these cases. The
+            --  check applies as well to rewritten array element loops where a
+            --  null range may be detected statically.
 
             if Compile_Time_Compare (L, H, Assume_Valid => True) = GT then
 
@@ -2610,6 +2624,65 @@ package body Sem_Ch5 is
                   Error_Msg_N ("\??bounds may be wrong way round", DS);
                end if;
             end if;
+
+            --  Check if either bound is known to be outside the range of the
+            --  loop parameter type, this is e.g. the case of a loop from
+            --  20..X where the type is 1..19.
+
+            --  Such a loop is dubious since either it raises CE or it executes
+            --  zero times, and that cannot be useful!
+
+            if Etype (DS) /= Any_Type
+              and then not Error_Posted (DS)
+              and then Nkind (DS) = N_Subtype_Indication
+              and then Nkind (Constraint (DS)) = N_Range_Constraint
+            then
+               declare
+                  LLo : constant Node_Id :=
+                          Low_Bound  (Range_Expression (Constraint (DS)));
+                  LHi : constant Node_Id :=
+                          High_Bound (Range_Expression (Constraint (DS)));
+
+                  Bad_Bound : Node_Id := Empty;
+                  --  Suspicious loop bound
+
+               begin
+                  --  At this stage L, H are the bounds of the type, and LLo
+                  --  Lhi are the low bound and high bound of the loop.
+
+                  if Compile_Time_Compare (LLo, L, Assume_Valid => True) = LT
+                       or else
+                     Compile_Time_Compare (LLo, H, Assume_Valid => True) = GT
+                  then
+                     Bad_Bound := LLo;
+                  end if;
+
+                  if Compile_Time_Compare (LHi, L, Assume_Valid => True) = LT
+                       or else
+                     Compile_Time_Compare (LHi, H, Assume_Valid => True) = GT
+                  then
+                     Bad_Bound := LHi;
+                  end if;
+
+                  if Present (Bad_Bound) then
+                     Error_Msg_N
+                       ("suspicious loop bound out of range of "
+                        & "loop subtype??", Bad_Bound);
+                     Error_Msg_N
+                       ("\loop executes zero times or raises "
+                        & "Constraint_Error??", Bad_Bound);
+                  end if;
+               end;
+            end if;
+
+         --  This declare block is about warnings, if we get an exception while
+         --  testing for warnings, we simply abandon the attempt silently. This
+         --  most likely occurs as the result of a previous error, but might
+         --  just be an obscure case we have missed. In either case, not giving
+         --  the warning is perfectly acceptable.
+
+         exception
+            when others => null;
          end;
       end if;
 
diff --git a/gcc/ada/sem_intr.adb b/gcc/ada/sem_intr.adb
index 4682d25..5fb7442 100644
--- a/gcc/ada/sem_intr.adb
+++ b/gcc/ada/sem_intr.adb
@@ -328,6 +328,14 @@ package body Sem_Intr is
       then
          Errint ("unrecognized intrinsic subprogram", E, N);
 
+      --  Shift cases. We allow user specification of intrinsic shift operators
+      --  for any numeric types.
+
+      elsif Nam_In (Nam, Name_Rotate_Left, Name_Rotate_Right, Name_Shift_Left,
+                         Name_Shift_Right, Name_Shift_Right_Arithmetic)
+      then
+         Check_Shift (E, N);
+
       --  We always allow intrinsic specifications in language defined units
       --  and in expanded code. We assume that the GNAT implementors know what
       --  they are doing, and do not write or generate junk use of intrinsic.
@@ -339,13 +347,7 @@ package body Sem_Intr is
       then
          null;
 
-      --  Shift cases. We allow user specification of intrinsic shift
-      --  operators for any numeric types.
-
-      elsif Nam_In (Nam, Name_Rotate_Left, Name_Rotate_Right, Name_Shift_Left,
-                         Name_Shift_Right, Name_Shift_Right_Arithmetic)
-      then
-         Check_Shift (E, N);
+      --  Exception  functions
 
       elsif Nam_In (Nam, Name_Exception_Information,
                          Name_Exception_Message,
@@ -353,9 +355,13 @@ package body Sem_Intr is
       then
          Check_Exception_Function (E, N);
 
+      --  Intrinsic operators
+
       elsif Nkind (E) = N_Defining_Operator_Symbol then
          Check_Intrinsic_Operator (E, N);
 
+      --  Source_Location and navigation functions
+
       elsif Nam_In (Nam, Name_File, Name_Line, Name_Source_Location,
                          Name_Enclosing_Entity)
       then
@@ -439,6 +445,8 @@ package body Sem_Intr is
            ("first argument of shift must match return type", Ptyp1, N);
          return;
       end if;
+
+      Set_Has_Shift_Operator (Base_Type (Typ1));
    end Check_Shift;
 
    ------------
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index c7dd634..d61c02b 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -14948,7 +14948,7 @@ package body Sem_Prag is
 
             elsif K = N_Object_Declaration
               or else (K = N_Component_Declaration
-                       and then Original_Record_Component (E) = E)
+                        and then Original_Record_Component (E) = E)
             then
                if Rep_Item_Too_Late (E, N) then
                   return;
@@ -15514,7 +15514,6 @@ package body Sem_Prag is
          --  Ada.Interrupts.Interrupt_ID.
 
          when Pragma_Interrupt_State => Interrupt_State : declare
-
             Int_Id : constant Entity_Id := RTE (RE_Interrupt_ID);
             --  This is the entity Ada.Interrupts.Interrupt_ID;
 
@@ -18472,6 +18471,123 @@ package body Sem_Prag is
                   "and has no effect?j?", N);
             end if;
 
+         -----------------------------
+         -- Provide_Shift_Operators --
+         -----------------------------
+
+         --  pragma Provide_Shift_Operators (integer_subtype_LOCAL_NAME);
+
+         when Pragma_Provide_Shift_Operators =>
+         Provide_Shift_Operators : declare
+            Ent : Entity_Id;
+
+            procedure Declare_Shift_Operator (Nam : Name_Id);
+            --  Insert declaration and pragma Instrinsic for named shift op
+
+            ----------------------------
+            -- Declare_Shift_Operator --
+            ----------------------------
+
+            procedure Declare_Shift_Operator (Nam : Name_Id) is
+               Func   : Node_Id;
+               Import : Node_Id;
+
+            begin
+               Func :=
+                 Make_Subprogram_Declaration (Loc,
+                   Make_Function_Specification (Loc,
+                     Defining_Unit_Name       =>
+                       Make_Defining_Identifier (Loc, Chars => Nam),
+
+                     Result_Definition        =>
+                       Make_Identifier (Loc, Chars => Chars (Ent)),
+
+                     Parameter_Specifications => New_List (
+                       Make_Parameter_Specification (Loc,
+                         Defining_Identifier  =>
+                           Make_Defining_Identifier (Loc, Name_Value),
+                         Parameter_Type       =>
+                           Make_Identifier (Loc, Chars => Chars (Ent))),
+
+                       Make_Parameter_Specification (Loc,
+                         Defining_Identifier  =>
+                           Make_Defining_Identifier (Loc, Name_Amount),
+                         Parameter_Type       =>
+                           New_Occurrence_Of (Standard_Natural, Loc)))));
+
+               Import :=
+                 Make_Pragma (Loc,
+                   Pragma_Identifier => Make_Identifier (Loc, Name_Import),
+                   Pragma_Argument_Associations => New_List (
+                     Make_Pragma_Argument_Association (Loc,
+                       Expression => Make_Identifier (Loc, Name_Intrinsic)),
+                     Make_Pragma_Argument_Association (Loc,
+                       Expression => Make_Identifier (Loc, Nam))));
+
+               Insert_After (N, Import);
+               Insert_After (N, Func);
+            end Declare_Shift_Operator;
+
+         --  Start of processing for Provide_Shift_Operators
+
+         begin
+            GNAT_Pragma;
+            Check_Arg_Count (1);
+            Check_Arg_Is_Local_Name (Arg1);
+
+            Arg1 := Get_Pragma_Arg (Arg1);
+
+            --  We must have an entity name
+
+            if not Is_Entity_Name (Arg1) then
+               Error_Pragma_Arg
+                 ("pragma % must apply to integer first subtype", Arg1);
+            end if;
+
+            --  If no Entity, means there was a prior error so ignore
+
+            if Present (Entity (Arg1)) then
+               Ent := Entity (Arg1);
+
+               --  Apply error checks
+
+               if not Is_First_Subtype (Ent) then
+                  Error_Pragma_Arg
+                    ("cannot apply pragma %",
+                     "\& is not a first subtype",
+                     Arg1);
+
+               elsif not Is_Integer_Type (Ent) then
+                  Error_Pragma_Arg
+                    ("cannot apply pragma %",
+                     "\& is not an integer type",
+                     Arg1);
+
+               elsif Has_Shift_Operator (Ent) then
+                  Error_Pragma_Arg
+                    ("cannot apply pragma %",
+                     "\& already has declared shift operators",
+                     Arg1);
+
+               elsif Is_Frozen (Ent) then
+                  Error_Pragma_Arg
+                    ("pragma % appears too late",
+                     "\& is already frozen",
+                     Arg1);
+               end if;
+
+               --  Now declare the operators. We do this during analysis rather
+               --  than expansion, since we want the operators available if we
+               --  are operating in -gnatc or ASIS mode.
+
+               Declare_Shift_Operator (Name_Rotate_Left);
+               Declare_Shift_Operator (Name_Rotate_Right);
+               Declare_Shift_Operator (Name_Shift_Left);
+               Declare_Shift_Operator (Name_Shift_Right);
+               Declare_Shift_Operator (Name_Shift_Right_Arithmetic);
+            end if;
+         end Provide_Shift_Operators;
+
          ------------------
          -- Psect_Object --
          ------------------
@@ -25675,6 +25791,7 @@ package body Sem_Prag is
       Pragma_Profile                        =>  0,
       Pragma_Profile_Warnings               =>  0,
       Pragma_Propagate_Exceptions           => -1,
+      Pragma_Provide_Shift_Operators        => -1,
       Pragma_Psect_Object                   => -1,
       Pragma_Pure                           => -1,
       Pragma_Pure_05                        => -1,
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index 173f734..876ac04 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -585,6 +585,7 @@ package Snames is
    --  correctly recognize and process Priority. Priority is a standard Ada 95
    --  pragma.
 
+   Name_Provide_Shift_Operators        : constant Name_Id := N + $; -- GNAT
    Name_Psect_Object                   : constant Name_Id := N + $; -- VMS
    Name_Pure                           : constant Name_Id := N + $;
    Name_Pure_05                        : constant Name_Id := N + $; -- GNAT
@@ -686,6 +687,7 @@ package Snames is
 
    --  Other special names used in processing pragmas
 
+   Name_Amount                         : constant Name_Id := N + $;
    Name_As_Is                          : constant Name_Id := N + $;
    Name_Assertion                      : constant Name_Id := N + $;
    Name_Assertions                     : constant Name_Id := N + $;
@@ -1889,6 +1891,7 @@ package Snames is
       Pragma_Preelaborate,
       Pragma_Preelaborate_05,
       Pragma_Pre_Class,
+      Pragma_Provide_Shift_Operators,
       Pragma_Psect_Object,
       Pragma_Pure,
       Pragma_Pure_05,
diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb
index 0bfc6e3..0cce75f 100644
--- a/gcc/ada/treepr.adb
+++ b/gcc/ada/treepr.adb
@@ -1701,7 +1701,6 @@ package body Treepr is
          Print_Node_Subtree (Cunit (Main_Unit));
          Write_Eol;
       end if;
-
    end Tree_Dump;
 
    -----------------
@@ -1956,13 +1955,13 @@ package body Treepr is
             then
                return;
 
-            --  Otherwise we can visit the list. Note that we don't bother
-            --  to do the parent test that we did for the node case, because
-            --  it just does not happen that lists are referenced more than
-            --  one place in the tree. We aren't counting on this being the
-            --  case to generate valid output, it is just that we don't need
-            --  in practice to worry about listing the list at a place that
-            --  is inconvenient.
+            --  Otherwise we can visit the list. Note that we don't bother to
+            --  do the parent test that we did for the node case, because it
+            --  just does not happen that lists are referenced more than one
+            --  place in the tree. We aren't counting on this being the case
+            --  to generate valid output, it is just that we don't need in
+            --  practice to worry about listing the list at a place that is
+            --  inconvenient.
 
             else
                Visit_List (List_Id (D), New_Prefix);
@@ -2024,9 +2023,9 @@ package body Treepr is
       else
          if Serial_Number (Int (N)) < Next_Serial_Number then
 
-            --  Here we have already visited the node, but if it is in
-            --  a list, we still want to print the reference, so that
-            --  it is clear that it belongs to the list.
+            --  Here we have already visited the node, but if it is in a list,
+            --  we still want to print the reference, so that it is clear that
+            --  it belongs to the list.
 
             if Is_List_Member (N) then
                Print_Str (Prefix_Str);
@@ -2109,9 +2108,9 @@ package body Treepr is
          --  indentations coming from this effect.
 
          --  To prevent this, what we do is to control references via
-         --  Next_Entity only from the first entity on a given scope
-         --  chain, and we keep them all at the same level. Of course
-         --  if an entity has already been referenced it is not printed.
+         --  Next_Entity only from the first entity on a given scope chain,
+         --  and we keep them all at the same level. Of course if an entity
+         --  has already been referenced it is not printed.
 
          if Present (Next_Entity (N))
            and then Present (Scope (N))
diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb
index af8fd77..0b50555 100644
--- a/gcc/ada/usage.adb
+++ b/gcc/ada/usage.adb
@@ -211,7 +211,7 @@ begin
    --  Line for -gnatei switch
 
    Write_Switch_Char ("einn");
-   Write_Line ("Set maximumum number of instantiations to nn");
+   Write_Line ("Set maximum number of instantiations to nn");
 
    --  Line for -gnateI switch