2009-06-22 Robert Dewar <dewar@adacore.com>

	* sinput.adb, sinput.ads (Expr_First_Char, Expr_Last_Char): Replaced
	by Sloc_Range.

	* freeze.adb: Minor comment updates

	* s-valrea.adb (Bad_Based_Value): New procedure
	(Scan_Real): Raise exceptions with messages

2009-06-22  Matthew Gingell  <gingell@adacore.com>

	* adaint.h: Complete previous change.

2009-06-22  Thomas Quinot  <quinot@adacore.com>

	* exp_ch7.ads, exp_ch3.adb: Minor reformatting

2009-06-22  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Check_Overriding_Indicator): When style checks are
	enabled, emit warning when a non-controlling argument of the overriding
	operation appears out of place vis-a-vis of the formal of the
	overridden operation.



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

9 files changed, 189 insertions, 291 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index bce68717b4b..80e21d13a5a 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,28 @@
+2009-06-22  Robert Dewar  <dewar@adacore.com>
+
+	* sinput.adb, sinput.ads (Expr_First_Char, Expr_Last_Char): Replaced
+	by Sloc_Range.
+
+	* freeze.adb: Minor comment updates
+
+	* s-valrea.adb (Bad_Based_Value): New procedure
+	(Scan_Real): Raise exceptions with messages
+
+2009-06-22  Matthew Gingell  <gingell@adacore.com>
+
+	* adaint.h: Complete previous change.
+
+2009-06-22  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_ch7.ads, exp_ch3.adb: Minor reformatting
+
+2009-06-22  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch6.adb (Check_Overriding_Indicator): When style checks are
+	enabled, emit warning when a non-controlling argument of the overriding
+	operation appears out of place vis-a-vis of the formal of the
+	overridden operation.
+
 2009-06-22  Vincent Celier  <celier@adacore.com>
 
 	* gnatcmd.adb (Check_Files): Close temporary files after all file names
diff --git a/gcc/ada/adaint.h b/gcc/ada/adaint.h
index a5243f1eef4..e8fb40bc4a9 100644
--- a/gcc/ada/adaint.h
+++ b/gcc/ada/adaint.h
@@ -58,6 +58,7 @@
 #define FOPEN fopen
 #define STAT stat
 #define FSTAT fstat
+#define LSTAT lstat
 #define STRUCT_STAT struct stat
 #endif
 
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index e8030d9c196..458f300b8dd 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -1854,7 +1854,7 @@ package body Exp_Ch3 is
          --  Take a copy of Exp to ensure that later copies of this component
          --  declaration in derived types see the original tree, not a node
          --  rewritten during expansion of the init_proc. If the copy contains
-         --  itypes, the scope of the new itypes is the init.proc being built.
+         --  itypes, the scope of the new itypes is the init_proc being built.
 
          Exp := New_Copy_Tree (Exp, New_Scope => Proc_Id);
 
@@ -1885,7 +1885,7 @@ package body Exp_Ch3 is
          end if;
 
          --  Adjust the component if controlled except if it is an aggregate
-         --  that will be expanded inline
+         --  that will be expanded inline.
 
          if Kind = N_Qualified_Expression then
             Kind := Nkind (Expression (N));
diff --git a/gcc/ada/exp_ch7.ads b/gcc/ada/exp_ch7.ads
index b6c3ff26c24..a7c5cd7ba5a 100644
--- a/gcc/ada/exp_ch7.ads
+++ b/gcc/ada/exp_ch7.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2009, 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- --
@@ -75,8 +75,8 @@ package Exp_Ch7 is
    --  E is an entity representing a controlled object, a controlled type or a
    --  scope. If Ref is not empty, it is a reference to a controlled record,
    --  the closest Final list is in the controller component of the record
-   --  containing Ref otherwise this function returns a reference to the final
-   --  list attached to the closest dynamic scope (that can be E itself)
+   --  containing Ref, otherwise this function returns a reference to the final
+   --  list attached to the closest dynamic scope (which can be E itself),
    --  creating this final list if necessary.
 
    function Has_New_Controlled_Component (E : Entity_Id) return Boolean;
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 5fc02c3608c..e68086cdc98 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -2451,7 +2451,7 @@ package body Freeze is
                           and then Convention (E) = Convention_C
                         then
                            Error_Msg_N
-                             ("?& is a tagged type which does not "
+                             ("?& involves a tagged type which does not "
                               & "correspond to any C type!", Formal);
 
                         --  Check wrong convention subprogram pointer
@@ -2600,15 +2600,30 @@ package body Freeze is
                         end if;
                      end if;
 
-                     --  VM functions returning unconstrained arrays are
-                     --  correctly handled with the .NET/JVM compilers. Don't
-                     --  display this warning in those cases.
+                     --  Give warning for suspicous return of a result of an
+                     --  unconstrained array type in a foreign convention
+                     --  function.
 
-                     if Is_Array_Type (R_Type)
+                     if Has_Foreign_Convention (E)
+
+                       --  We are looking for a return of unconstrained array
+
+                       and then Is_Array_Type (R_Type)
                        and then not Is_Constrained (R_Type)
+
+                       --  Exclude imported routines, the warning does not
+                       --  belong on the import, but on the routine definition.
+
                        and then not Is_Imported (E)
+
+                       --  Exclude VM case, since both .NET and JVM can handle
+                       --  return of unconstrained arrays without a problem.
+
                        and then VM_Target = No_VM
-                       and then Has_Foreign_Convention (E)
+
+                       --  Check that general warning is enabled, and that it
+                       --  is not suppressed for this particular case.
+
                        and then Warn_On_Export_Import
                        and then not Has_Warnings_Off (E)
                        and then not Has_Warnings_Off (R_Type)
@@ -5047,14 +5062,24 @@ package body Freeze is
             elsif Is_Generic_Type (Etype (E)) then
                null;
 
-            --  VM functions returning unconstrained arrays are
-            --  correctly handled with the .NET/JVM compilers. Don't
-            --  display this warning in those cases.
+            --  Display warning if returning unconstrained array
 
             elsif Is_Array_Type (Retype)
               and then not Is_Constrained (Retype)
+
+              --  Exclude cases where descriptor mechanism is set, since the
+              --  VMS descriptor mechanisms allow such unconstrained returns.
+
               and then Mechanism (E) not in Descriptor_Codes
+
+              --  Check appropriate warning is enabled (should we check for
+              --  Warnings (Off) on specific entities here, probably so???)
+
               and then Warn_On_Export_Import
+
+               --  Exclude the VM case, since return of unconstrained arrays
+               --  is properly handled in both the JVM and .NET cases.
+
               and then VM_Target = No_VM
             then
                Error_Msg_N
@@ -5084,9 +5109,9 @@ package body Freeze is
          end if;
       end if;
 
-      --  For VMS, descriptor mechanisms for parameters are allowed only
-      --  for imported/exported subprograms.  Moreover, the NCA descriptor
-      --  is not allowed for parameters of exported subprograms.
+      --  For VMS, descriptor mechanisms for parameters are allowed only for
+      --  imported/exported subprograms. Moreover, the NCA descriptor is not
+      --  allowed for parameters of exported subprograms.
 
       if OpenVMS_On_Target then
          if Is_Exported (E) then
diff --git a/gcc/ada/s-valrea.adb b/gcc/ada/s-valrea.adb
index 847777249e5..2e8306aabdc 100644
--- a/gcc/ada/s-valrea.adb
+++ b/gcc/ada/s-valrea.adb
@@ -89,6 +89,10 @@ package body System.Val_Real is
       --  necessarily required in a case like this where the result is not
       --  a machine number, but it is certainly a desirable behavior.
 
+      procedure Bad_Based_Value;
+      pragma No_Return (Bad_Based_Value);
+      --  Raise exception for bad based value
+
       procedure Scanf;
       --  Scans integer literal value starting at current character position.
       --  For each digit encountered, Uval is multiplied by 10.0, and the new
@@ -98,6 +102,16 @@ package body System.Val_Real is
       --  return P points past the last character. On entry, the current
       --  character is known to be a digit, so a numeral is definitely present.
 
+      ---------------------
+      -- Bad_Based_Value --
+      ---------------------
+
+      procedure Bad_Based_Value is
+      begin
+         raise Constraint_Error with
+           "invalid based literal for 'Value";
+      end Bad_Based_Value;
+
       -----------
       -- Scanf --
       -----------
@@ -181,7 +195,8 @@ package body System.Val_Real is
       --  Any other initial character is an error
 
       else
-         raise Constraint_Error;
+         raise Constraint_Error with
+           "invalid character in 'Value string";
       end if;
 
       --  Deal with based case
@@ -219,7 +234,7 @@ package body System.Val_Real is
 
             loop
                if P > Max then
-                  raise Constraint_Error;
+                  Bad_Based_Value;
 
                elsif Str (P) in Digs then
                   Digit := Character'Pos (Str (P)) - Character'Pos ('0');
@@ -233,7 +248,7 @@ package body System.Val_Real is
                     Character'Pos (Str (P)) - (Character'Pos ('a') - 10);
 
                else
-                  raise Constraint_Error;
+                  Bad_Based_Value;
                end if;
 
                --  Save up trailing zeroes after the decimal point
@@ -267,7 +282,7 @@ package body System.Val_Real is
                P := P + 1;
 
                if P > Max then
-                  raise Constraint_Error;
+                  Bad_Based_Value;
 
                elsif Str (P) = '_' then
                   Scan_Underscore (Str, P, Ptr, Max, True);
@@ -282,7 +297,7 @@ package body System.Val_Real is
                      After_Point := 1;
 
                      if P > Max then
-                        raise Constraint_Error;
+                        Bad_Based_Value;
                      end if;
                   end if;
 
@@ -358,7 +373,7 @@ package body System.Val_Real is
       --  Here is where we check for a bad based number
 
       if Bad_Base then
-         raise Constraint_Error;
+         Bad_Based_Value;
 
       --  If OK, then deal with initial minus sign, note that this processing
       --  is done even if Uval is zero, so that -0.0 is correctly interpreted.
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index b1f202c3652..d49ab79a43d 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -4374,6 +4374,48 @@ package body Sem_Ch6 is
          return;
       end if;
 
+      --  The overriding operation is type conformant with the overridden one,
+      --  but the names of the formals are not required to match. If the names
+      --  appear permuted in the overriding operation  this is a possible
+      --  source of confusion that is worth diagnosing. Controlling formals
+      --  often carry names that reflect the type, and it is not worthwhile
+      --  requiring that their names match.
+
+      if Style_Check
+        and then Present (Overridden_Subp)
+        and then Nkind (Subp) /= N_Defining_Operator_Symbol
+      then
+         declare
+            Form1 : Entity_Id;
+            Form2 : Entity_Id;
+
+         begin
+            Form1 := First_Formal (Subp);
+            Form2 := First_Formal (Overridden_Subp);
+
+            if Present (Form1) then
+               Form1 := Next_Formal (Form1);
+               Form2 := Next_Formal (Form2);
+            end if;
+
+            while Present (Form1) loop
+               if not Is_Controlling_Formal (Form1)
+                 and then Present (Next_Formal (Form2))
+                 and then Chars (Form1) = Chars (Next_Formal (Form2))
+               then
+                  Error_Msg_Node_2 := Alias (Overridden_Subp);
+                  Error_Msg_Sloc := Sloc (Error_Msg_Node_2);
+                  Error_Msg_NE ("& does not match corresponding formal of&#",
+                     Form1, Form1);
+                  exit;
+               end if;
+
+               Next_Formal (Form1);
+               Next_Formal (Form2);
+            end loop;
+         end;
+      end if;
+
       if Present (Overridden_Subp) then
          if Must_Not_Override (Spec) then
             Error_Msg_Sloc := Sloc (Overridden_Subp);
diff --git a/gcc/ada/sinput.adb b/gcc/ada/sinput.adb
index 020e69df26d..9f5637d0a32 100644
--- a/gcc/ada/sinput.adb
+++ b/gcc/ada/sinput.adb
@@ -37,7 +37,6 @@ with Debug;    use Debug;
 with Opt;      use Opt;
 with Output;   use Output;
 with Tree_IO;  use Tree_IO;
-with Sinfo;    use Sinfo;
 with System;   use System;
 with Widechar; use Widechar;
 
@@ -240,246 +239,6 @@ package body Sinput is
       return;
    end Build_Location_String;
 
-   ---------------------
-   -- Expr_First_Char --
-   ---------------------
-
-   function Expr_First_Char (Expr : Node_Id) return Source_Ptr is
-
-      function First_Char (Expr : Node_Id; PC : Nat) return Source_Ptr;
-      --  Internal recursive function used to traverse the expression tree.
-      --  Returns the source pointer corresponding to the first location of
-      --  the subexpression N, followed by backing up the given (PC) number of
-      --  preceding left parentheses.
-
-      ----------------
-      -- First_Char --
-      ----------------
-
-      function First_Char (Expr : Node_Id; PC : Nat) return Source_Ptr is
-         N     : constant Node_Id   := Original_Node (Expr);
-         Count : constant Nat       := PC + Paren_Count (N);
-         Kind  : constant N_Subexpr := Nkind (N);
-         Loc   : Source_Ptr;
-
-      begin
-         case Kind is
-            when N_And_Then  |
-                 N_In        |
-                 N_Not_In    |
-                 N_Or_Else   |
-                 N_Binary_Op  =>
-               return First_Char (Left_Opnd (N), Count);
-
-            when N_Attribute_Reference  |
-                 N_Expanded_Name        |
-                 N_Explicit_Dereference |
-                 N_Indexed_Component    |
-                 N_Reference            |
-                 N_Selected_Component   |
-                 N_Slice                =>
-               return First_Char (Prefix (N), Count);
-
-            when N_Function_Call =>
-               return First_Char (Sinfo.Name (N), Count);
-
-            when N_Qualified_Expression |
-                 N_Type_Conversion      =>
-               return First_Char (Subtype_Mark (N), Count);
-
-            when N_Range =>
-               return First_Char (Low_Bound (N), Count);
-
-            --  Nodes that should not appear in original expression trees
-
-            when N_Procedure_Call_Statement  |
-                 N_Raise_xxx_Error           |
-                 N_Subprogram_Info           |
-                 N_Unchecked_Expression      |
-                 N_Unchecked_Type_Conversion |
-                 N_Conditional_Expression    =>
-               raise Program_Error;
-
-            --  Cases where the Sloc points to the start of the tokem, but we
-            --  still need to handle the sequence of left parentheses.
-
-            when N_Identifier          |
-                 N_Operator_Symbol     |
-                 N_Character_Literal   |
-                 N_Integer_Literal     |
-                 N_Null                |
-                 N_Unary_Op            |
-                 N_Aggregate           |
-                 N_Allocator           |
-                 N_Extension_Aggregate |
-                 N_Real_Literal        |
-                 N_String_Literal      =>
-
-               Loc := Sloc (N);
-
-               --  Skip past parens
-
-               --  This is not right, it does not deal with skipping comments
-               --  and probably also has wide character problems ???
-
-               if Count > 0 then
-                  declare
-                     SFI : constant Source_File_Index :=
-                             Get_Source_File_Index (Loc);
-                     Src : constant Source_Buffer_Ptr := Source_Text (SFI);
-                     Fst : constant Source_Ptr        := Source_First (SFI);
-
-                  begin
-                     for J in 1 .. Count loop
-                        loop
-                           exit when Loc = Fst;
-                           Loc := Loc - 1;
-                           exit when Src (Loc) >= ' ';
-                        end loop;
-
-                        exit when Src (Loc) /= '(';
-                     end loop;
-                  end;
-               end if;
-
-               return Loc;
-         end case;
-      end First_Char;
-
-   --  Start of processing for Expr_First_Char
-
-   begin
-      pragma Assert (Nkind (Expr) in N_Subexpr);
-      return First_Char (Expr, 0);
-   end Expr_First_Char;
-
-   --------------------
-   -- Expr_Last_Char --
-   --------------------
-
-   function Expr_Last_Char (Expr : Node_Id) return Source_Ptr is
-
-      function Last_Char (Expr : Node_Id; PC : Nat) return Source_Ptr;
-      --  Internal recursive function used to traverse the expression tree.
-      --  Returns the source pointer corresponding to the last location of
-      --  the subexpression N, followed by ztepping to the last of the given
-      --  number of right parentheses.
-
-      ---------------
-      -- Last_Char --
-      ---------------
-
-      function Last_Char (Expr : Node_Id; PC : Nat) return Source_Ptr is
-         N     : constant Node_Id   := Original_Node (Expr);
-         Count : constant Nat       := PC + Paren_Count (N);
-         Kind  : constant N_Subexpr := Nkind (N);
-         Loc   : Source_Ptr;
-
-      begin
-         case Kind is
-            when N_And_Then  |
-                 N_In        |
-                 N_Not_In    |
-                 N_Or_Else   |
-                 N_Binary_Op  =>
-               return Last_Char (Right_Opnd (N), Count);
-
-            when N_Attribute_Reference  |
-                 N_Expanded_Name        |
-                 N_Explicit_Dereference |
-                 N_Indexed_Component    |
-                 N_Reference            |
-                 N_Selected_Component   |
-                 N_Slice                =>
-               return Last_Char (Prefix (N), Count);
-
-            when N_Function_Call =>
-               return Last_Char (Sinfo.Name (N), Count);
-
-            when N_Qualified_Expression |
-                 N_Type_Conversion      =>
-               return Last_Char (Subtype_Mark (N), Count);
-
-            when N_Range =>
-               return Last_Char (Low_Bound (N), Count);
-
-            --  Nodes that should not appear in original expression trees
-
-            when N_Procedure_Call_Statement  |
-                 N_Raise_xxx_Error           |
-                 N_Subprogram_Info           |
-                 N_Unchecked_Expression      |
-                 N_Unchecked_Type_Conversion |
-                 N_Conditional_Expression    =>
-               raise Program_Error;
-
-            --  Cases where the Sloc points to the start of the token, but we
-            --  still need to handle the sequence of left parentheses.
-
-            when N_Identifier          |
-                 N_Operator_Symbol     |
-                 N_Character_Literal   |
-                 N_Integer_Literal     |
-                 N_Null                |
-                 N_Unary_Op            |
-                 N_Aggregate           |
-                 N_Allocator           |
-                 N_Extension_Aggregate |
-                 N_Real_Literal        |
-                 N_String_Literal      =>
-
-               Loc := Sloc (N);
-
-               --  Now we have two tasks, first we are pointing to the start
-               --  of the token below, second, we need to skip parentheses.
-
-               --  Skipping to the end of a token is not easy, we can't just
-               --  skip to a space, since we may have e.g. X*YAR+Z, and if we
-               --  are finding the end of the subexpression X*YAR, we don't
-               --  want to skip past the +Z. Also we have to worry about
-               --  skipping comments, and about wide characters ???
-
-               declare
-                  SFI : constant Source_File_Index :=
-                          Get_Source_File_Index (Loc);
-                  Src : constant Source_Buffer_Ptr := Source_Text (SFI);
-                  Lst : constant Source_Ptr        := Source_Last (SFI);
-
-               begin
-                  --  Scan through first blank character, to get to the end
-                  --  of this token. As noted above that's not really right???
-
-                  loop
-                     exit when Loc = Lst or else Src (Loc + 1) <= ' ';
-                     Loc := Loc + 1;
-                  end loop;
-
-                  --  Skip past parens, but this also ignores comments ???
-
-                  if Count > 0 then
-                     for J in 1 .. Count loop
-                        loop
-                           exit when Loc = Lst;
-                           Loc := Loc + 1;
-                           exit when Src (Loc) >= ' ';
-                        end loop;
-
-                        exit when Src (Loc) /= ')';
-                     end loop;
-                  end if;
-               end;
-
-               return Loc;
-         end case;
-      end Last_Char;
-
-   --  Start of processing for Expr_Last_Char
-
-   begin
-      pragma Assert (Nkind (Expr) in N_Subexpr);
-      return Last_Char (Expr, 0);
-   end Expr_Last_Char;
-
    -----------------------
    -- Get_Column_Number --
    -----------------------
@@ -525,8 +284,7 @@ package body Sinput is
    -----------------------------
 
    function Get_Logical_Line_Number
-     (P    : Source_Ptr)
-      return Logical_Line_Number
+     (P : Source_Ptr) return Logical_Line_Number
    is
       SFR : Source_File_Record
               renames Source_File.Table (Get_Source_File_Index (P));
@@ -546,8 +304,7 @@ package body Sinput is
    ------------------------------
 
    function Get_Physical_Line_Number
-     (P    : Source_Ptr)
-      return Physical_Line_Number
+     (P : Source_Ptr) return Physical_Line_Number
    is
       Sfile : Source_File_Index;
       Table : Lines_Table_Ptr;
@@ -711,7 +468,6 @@ package body Sinput is
 
    begin
       S := P;
-
       while S > Sfirst
         and then Src (S - 1) /= CR
         and then Src (S - 1) /= LF
@@ -723,9 +479,8 @@ package body Sinput is
    end Line_Start;
 
    function Line_Start
-     (L    : Physical_Line_Number;
-      S    : Source_File_Index)
-      return Source_Ptr
+     (L : Physical_Line_Number;
+      S : Source_File_Index) return Source_Ptr
    is
    begin
       return Source_File.Table (S).Lines_Table (L);
@@ -794,8 +549,7 @@ package body Sinput is
 
    function Physical_To_Logical
      (Line : Physical_Line_Number;
-      S    : Source_File_Index)
-      return Logical_Line_Number
+      S    : Source_File_Index) return Logical_Line_Number
    is
       SFR : Source_File_Record renames Source_File.Table (S);
 
@@ -935,6 +689,44 @@ package body Sinput is
       end;
    end Skip_Line_Terminators;
 
+   ----------------
+   -- Sloc_Range --
+   ----------------
+
+   procedure Sloc_Range (Expr : Node_Id; Min, Max : out Source_Ptr) is
+
+      function Process (N : Node_Id) return Traverse_Result;
+      --  Process function for traversing the expression tree
+
+      procedure Traverse is new Traverse_Proc (Process);
+
+      -------------
+      -- Process --
+      -------------
+
+      function Process (N : Node_Id) return Traverse_Result is
+      begin
+         if Sloc (N) < Min then
+            if Sloc (N) > No_Location then
+               Min := Sloc (N);
+            end if;
+         elsif Sloc (N) > Max then
+            if Sloc (N) > No_Location then
+               Max := Sloc (N);
+            end if;
+         end if;
+
+         return OK;
+      end Process;
+
+   --  Start of processing for Sloc_Range
+
+   begin
+      Min := Sloc (Expr);
+      Max := Sloc (Expr);
+      Traverse (Expr);
+   end Sloc_Range;
+
    -------------------
    -- Source_Offset --
    -------------------
@@ -943,7 +735,6 @@ package body Sinput is
       Sindex : constant Source_File_Index := Get_Source_File_Index (S);
       Sfirst : constant Source_Ptr :=
                  Source_File.Table (Sindex).Source_First;
-
    begin
       return Nat (S - Sfirst);
    end Source_Offset;
@@ -1368,7 +1159,6 @@ package body Sinput is
       else
          return Source_File.Table (S).Source_Last;
       end if;
-
    end Source_Last;
 
    function Source_Text (S : SFI) return Source_Buffer_Ptr is
@@ -1378,7 +1168,6 @@ package body Sinput is
       else
          return Source_File.Table (S).Source_Text;
       end if;
-
    end Source_Text;
 
    function Template (S : SFI) return SFI is
diff --git a/gcc/ada/sinput.ads b/gcc/ada/sinput.ads
index c679e24d84b..945d26e7d4a 100644
--- a/gcc/ada/sinput.ads
+++ b/gcc/ada/sinput.ads
@@ -471,14 +471,6 @@ package Sinput is
    --  ASCII.NUL, with Name_Length indicating the length not including the
    --  terminating Nul.
 
-   function Expr_First_Char (Expr : Node_Id) return Source_Ptr;
-   --  Given a node for a subexpression, returns the source location of the
-   --  first character of the expression.
-
-   function Expr_Last_Char (Expr : Node_Id) return Source_Ptr;
-   --  Given a node for a subexpression, returns the source location of the
-   --  last character of the expression.
-
    function Get_Column_Number (P : Source_Ptr) return Column_Number;
    --  The ones-origin column number of the specified Source_Ptr value is
    --  determined and returned. Tab characters if present are assumed to
@@ -571,12 +563,12 @@ package Sinput is
    procedure Skip_Line_Terminators
      (P        : in out Source_Ptr;
       Physical : out Boolean);
-   --  On entry, P points to a line terminator that has been encountered, which
-   --  is one of FF,LF,VT,CR or a wide character sequence whose value is in
-   --  category Separator,Line or Separator,Paragraph. P points just past the
-   --  character that was scanned. The purpose of this routine is to
-   --  distinguish physical and logical line endings. A physical line ending is
-   --  one of:
+   --  On entry, P points to a line terminator that has been encountered,
+   --  which is one of FF,LF,VT,CR or a wide character sequence whose value is
+   --  in category Separator,Line or Separator,Paragraph. P points just past
+   --  the character that was scanned. The purpose of this routine is to
+   --  distinguish physical and logical line endings. A physical line ending
+   --  is one of:
    --
    --     CR on its own (MAC System 7)
    --     LF on its own (Unix and unix-like systems)
@@ -603,6 +595,15 @@ package Sinput is
    --  makes sure that the lines table for the current source file has an
    --  appropriate entry for the start of the new physical line.
 
+   procedure Sloc_Range (Expr : Node_Id; Min, Max : out Source_Ptr);
+   --  Given a node for a subexpression, returns the minimum and maximum source
+   --  locations of any node in the expression subtree. This is not quite the
+   --  same as the locations of the first and last token in the expresion
+   --  because parentheses at the outer level do not have a recorded Sloc.
+   --
+   --  Note: if the tree for the expression contains no "real" Sloc values,
+   --  i.e. values > No_Location, then both Min and Max are set to Sloc (Expr).
+
    function Source_Offset (S : Source_Ptr) return Nat;
    --  Returns the zero-origin offset of the given source location from the
    --  start of its corresponding unit. This is used for creating canonical