[multiple changes]

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.

From-SVN: r148782

gcc/ada/ChangeLog

+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

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
 

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));

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;

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

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.

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);

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