[multiple changes]

2012-10-02  Bob Duff  <duff@adacore.com>

	* checks.adb (Apply_Predicate_Check): Disable check in -gnatc mode.

2012-10-02  Vincent Pucci  <pucci@adacore.com>

	* sem_ch6.adb (Analyze_Function_Call): Dimension propagation
	for function calls moved to Analyze_Dimension_Call.
	* sem_dim.adb (Analyze_Dimension_Call): Properly propagate the
	dimensions from the returned type for function calls.

2012-10-02  Vincent Celier  <celier@adacore.com>

	* gnatcmd.adb: Take into account any configuration pragma file
	in the project files for gnat pretty/stub/metric.

2012-10-02  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Check_Indexing_Functions): Refine several tests
	on the legality of indexing aspects: Constant_Indexing functions
	do not have to return a reference type, and given an indexing
	aspect Func, not all overloadings of Func in the current scope
	need to be indexing functions.

2012-10-02  Vasiliy Fofanov  <fofanov@adacore.com>

	* gnat_ugn.texi: Adjust docs for overflow checks to be VMS-friendly.

2012-10-02  Vincent Celier  <celier@adacore.com>

	* switch-m.adb (Normalize_Compiler_Switches): Recognize switches
	-gnatox and -gnatoxx when x=0/1/2/3.

From-SVN: r191960

8 files changed, 214 insertions, 125 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index addb48f..79f37c7 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,36 @@
+2012-10-02  Bob Duff  <duff@adacore.com>
+
+	* checks.adb (Apply_Predicate_Check): Disable check in -gnatc mode.
+
+2012-10-02  Vincent Pucci  <pucci@adacore.com>
+
+	* sem_ch6.adb (Analyze_Function_Call): Dimension propagation
+	for function calls moved to Analyze_Dimension_Call.
+	* sem_dim.adb (Analyze_Dimension_Call): Properly propagate the
+	dimensions from the returned type for function calls.
+
+2012-10-02  Vincent Celier  <celier@adacore.com>
+
+	* gnatcmd.adb: Take into account any configuration pragma file
+	in the project files for gnat pretty/stub/metric.
+
+2012-10-02  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch13.adb (Check_Indexing_Functions): Refine several tests
+	on the legality of indexing aspects: Constant_Indexing functions
+	do not have to return a reference type, and given an indexing
+	aspect Func, not all overloadings of Func in the current scope
+	need to be indexing functions.
+
+2012-10-02  Vasiliy Fofanov  <fofanov@adacore.com>
+
+	* gnat_ugn.texi: Adjust docs for overflow checks to be VMS-friendly.
+
+2012-10-02  Vincent Celier  <celier@adacore.com>
+
+	* switch-m.adb (Normalize_Compiler_Switches): Recognize switches
+	-gnatox and -gnatoxx when x=0/1/2/3.
+
 2012-10-02  Vincent Pucci  <pucci@adacore.com>
 
 	* sem_ch4.adb (Analyze_Indexed_Component_Form): Dimension
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 7810421..12a0cef 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -2459,11 +2459,15 @@ package body Checks is
          else
             --  If the predicate is a static predicate and the operand is
             --  static, the predicate must be evaluated statically. If the
-            --  evaluation fails this is a static constraint error.
+            --  evaluation fails this is a static constraint error. This check
+            --  is disabled in -gnatc mode, because the compiler is incapable
+            --  of evaluating static expressions in that case.
 
             if Is_OK_Static_Expression (N) then
                if Present (Static_Predicate (Typ)) then
-                  if Eval_Static_Predicate_Check (N, Typ) then
+                  if Operating_Mode < Generate_Code or else
+                    Eval_Static_Predicate_Check (N, Typ)
+                  then
                      return;
                   else
                      Error_Msg_NE
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index a35d91e..1d58dc4 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -4346,7 +4346,7 @@ an assertion.
 Enable numeric overflow checking (which is not normally enabled by
 default). Note that division by zero is a separate check that is not
 controlled by this switch (division by zero checking is on by default).
-The checking mode is set to CHECKED (equivalent to @option{-gnato11}).
+The checking mode is set to CHECKED (equivalent to @option{^-gnato11^/OVERFLOW_CHECKS=11^}).
 
 @item -gnatp
 @cindex @option{-gnatp} (@command{gcc})
diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb
index ab4ddcc..7e54753 100644
--- a/gcc/ada/gnatcmd.adb
+++ b/gcc/ada/gnatcmd.adb
@@ -2311,10 +2311,15 @@ begin
                     (new String'("-gnatem=" & Get_Name_String (M_File)));
                end if;
 
-               --  For gnatcheck, also indicate a global configuration pragmas
-               --  file and, if -U is not used, a local one.
-
-               if The_Command = Check then
+               --  For gnatcheck, gnatpp, gnatstub and gnatmetric, also
+               --  indicate a global configuration pragmas file and, if -U
+               --  is not used, a local one.
+
+               if The_Command = Check  or else
+                  The_Command = Pretty or else
+                  The_Command = Stub   or else
+                  The_Command = Metric
+               then
                   declare
                      Pkg  : constant Prj.Package_Id :=
                               Prj.Util.Value_Of
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index c21468f..d365dc7 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1919,7 +1919,7 @@ package body Sem_Ch13 is
       procedure Check_Indexing_Functions;
       --  Check that the function in Constant_Indexing or Variable_Indexing
       --  attribute has the proper type structure. If the name is overloaded,
-      --  check that all interpretations are legal.
+      --  check that some interpretation is legal.
 
       procedure Check_Iterator_Functions;
       --  Check that there is a single function in Default_Iterator attribute
@@ -2070,6 +2070,7 @@ package body Sem_Ch13 is
       ------------------------------
 
       procedure Check_Indexing_Functions is
+         Indexing_Found : Boolean;
 
          procedure Check_One_Function (Subp : Entity_Id);
          --  Check one possible interpretation
@@ -2085,29 +2086,38 @@ package body Sem_Ch13 is
                                    Aspect_Iterator_Element);
 
          begin
-            if not Check_Primitive_Function (Subp) then
+            if not Check_Primitive_Function (Subp)
+              and then not Is_Overloaded (Expr)
+            then
                Error_Msg_NE
                  ("aspect Indexing requires a function that applies to type&",
-                   Subp, Ent);
+                    Subp, Ent);
             end if;
 
             --  An indexing function must return either the default element of
-            --  the container, or a reference type.
+            --  the container, or a reference type. For variable indexing it
+            --  must be latter.
 
             if Present (Default_Element) then
                Analyze (Default_Element);
                if Is_Entity_Name (Default_Element)
                  and then Covers (Entity (Default_Element), Etype (Subp))
                then
+                  Indexing_Found := True;
                   return;
                end if;
             end if;
 
-            --  Otherwise the return type must be a reference type.
+            --  For variable_indexing the return type must be a reference type.
 
-            if not Has_Implicit_Dereference (Etype (Subp)) then
+            if Attr = Name_Variable_Indexing
+              and then not Has_Implicit_Dereference (Etype (Subp))
+            then
                Error_Msg_N
                  ("function for indexing must return a reference type", Subp);
+
+            else
+               Indexing_Found := True;
             end if;
          end Check_One_Function;
 
@@ -2129,6 +2139,7 @@ package body Sem_Ch13 is
                It : Interp;
 
             begin
+               Indexing_Found := False;
                Get_First_Interp (Expr, I, It);
                while Present (It.Nam) loop
 
@@ -2142,6 +2153,11 @@ package body Sem_Ch13 is
 
                   Get_Next_Interp (I, It);
                end loop;
+               if not Indexing_Found then
+                  Error_Msg_NE (
+                   "aspect Indexing requires a function that applies to type&",
+                     Expr, Ent);
+               end if;
             end;
          end if;
       end Check_Indexing_Functions;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index dd2a8b8..6d82598 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -500,10 +500,6 @@ package body Sem_Ch6 is
       end if;
 
       Analyze_Call (N);
-
-      --  Propagate the dimensions from the returned type, if necessary
-
-      Analyze_Dimension (N);
    end Analyze_Function_Call;
 
    -----------------------------
diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb
index 0d41bda..ca7f3b2 100644
--- a/gcc/ada/sem_dim.adb
+++ b/gcc/ada/sem_dim.adb
@@ -1507,151 +1507,160 @@ package body Sem_Dim is
       --  so far by the compiler in this routine.
 
    begin
-      --  Aspect is an Ada 2012 feature. Nothing to do here if the list of
-      --  actuals is empty.Note that there is no need to check dimensions for
-      --  calls that don't come from source.
+      --  Aspect is an Ada 2012 feature. Note that there is no need to check
+      --  dimensions for calls that don't come from source.
 
       if Ada_Version < Ada_2012
         or else not Comes_From_Source (N)
-        or else Is_Empty_List (Actuals)
       then
          return;
       end if;
 
-      --  Special processing for elementary functions
-
-      --  For Sqrt call, the resulting dimensions equal to half the dimensions
-      --  of the actual. For all other elementary calls, this routine check
-      --  that every actual is dimensionless.
-
-      if Nkind (N) = N_Function_Call then
-         Elementary_Function_Calls : declare
-            Dims_Of_Call : Dimension_Type;
-            Ent          : Entity_Id := Nam;
+      --  Check the dimensions of the actuals, if any
 
-            function Is_Elementary_Function_Entity
-              (Sub_Id : Entity_Id) return Boolean;
-            --  Given Sub_Id, the original subprogram entity, return True if
-            --  call is to an elementary function
-            --  (see Ada.Numerics.Generic_Elementary_Functions).
+      if not Is_Empty_List (Actuals) then
+         --  Special processing for elementary functions
 
-            -----------------------------------
-            -- Is_Elementary_Function_Entity --
-            -----------------------------------
+         --  For Sqrt call, the resulting dimensions equal to half the
+         --  dimensions of the actual. For all other elementary calls, this
+         --  routine check that every actual is dimensionless.
 
-            function Is_Elementary_Function_Entity
-              (Sub_Id : Entity_Id) return Boolean
-            is
-               Loc : constant Source_Ptr := Sloc (Sub_Id);
+         if Nkind (N) = N_Function_Call then
+            Elementary_Function_Calls : declare
+               Dims_Of_Call : Dimension_Type;
+               Ent          : Entity_Id := Nam;
 
-            begin
-               --  Is function entity in
-               --  Ada.Numerics.Generic_Elementary_Functions?
+               function Is_Elementary_Function_Entity
+                 (Sub_Id : Entity_Id) return Boolean;
+               --  Given Sub_Id, the original subprogram entity, return True if
+               --  call is to an elementary function
+               --  (see Ada.Numerics.Generic_Elementary_Functions).
 
-               return
-                 Loc > No_Location
-                   and then
-                     Is_RTU
-                       (Cunit_Entity (Get_Source_Unit (Loc)),
-                         Ada_Numerics_Generic_Elementary_Functions);
-            end Is_Elementary_Function_Entity;
+               -----------------------------------
+               -- Is_Elementary_Function_Entity --
+               -----------------------------------
 
-         --  Start of processing for Elementary_Function_Calls
+               function Is_Elementary_Function_Entity
+                 (Sub_Id : Entity_Id) return Boolean
+               is
+                  Loc : constant Source_Ptr := Sloc (Sub_Id);
 
-         begin
-            --  Get the original subprogram entity following the renaming chain
+               begin
+                  --  Is function entity in
+                  --  Ada.Numerics.Generic_Elementary_Functions?
 
-            if Present (Alias (Ent)) then
-               Ent := Alias (Ent);
-            end if;
+                  return
+                    Loc > No_Location
+                      and then
+                        Is_RTU
+                          (Cunit_Entity (Get_Source_Unit (Loc)),
+                            Ada_Numerics_Generic_Elementary_Functions);
+               end Is_Elementary_Function_Entity;
 
-            --  Check the call is an Elementary function call
+            --  Start of processing for Elementary_Function_Calls
 
-            if Is_Elementary_Function_Entity (Ent) then
+            begin
+               --  Get the original subprogram entity following the renaming
+               --  chain.
 
-               --  Sqrt function call case
+               if Present (Alias (Ent)) then
+                  Ent := Alias (Ent);
+               end if;
 
-               if Chars (Ent) = Name_Sqrt then
-                  Dims_Of_Call := Dimensions_Of (First_Actual (N));
+               --  Check the call is an Elementary function call
 
-                  --  Eavluates the resulting dimensions (i.e. half the
-                  --  dimensions of the actual).
+               if Is_Elementary_Function_Entity (Ent) then
+                  --  Sqrt function call case
 
-                  if Exists (Dims_Of_Call) then
-                     for Position in Dims_Of_Call'Range loop
-                        Dims_Of_Call (Position) :=
-                          Dims_Of_Call (Position) *
-                            Rational'(Numerator   => 1,
-                                      Denominator => 2);
-                     end loop;
+                  if Chars (Ent) = Name_Sqrt then
+                     Dims_Of_Call := Dimensions_Of (First_Actual (N));
 
-                     Set_Dimensions (N, Dims_Of_Call);
-                  end if;
+                     --  Evaluates the resulting dimensions (i.e. half the
+                     --  dimensions of the actual).
 
-               --  All other elementary functions case. Note that every actual
-               --  here should be dimensionless.
+                     if Exists (Dims_Of_Call) then
+                        for Position in Dims_Of_Call'Range loop
+                           Dims_Of_Call (Position) :=
+                             Dims_Of_Call (Position) *
+                               Rational'(Numerator   => 1,
+                                         Denominator => 2);
+                        end loop;
 
-               else
-                  Actual := First_Actual (N);
-                  while Present (Actual) loop
-                     if Exists (Dimensions_Of (Actual)) then
+                        Set_Dimensions (N, Dims_Of_Call);
+                     end if;
 
-                        --  Check if error has already been encountered so far
+                  --  All other elementary functions case. Note that every
+                  --  actual here should be dimensionless.
 
-                        if not Error_Detected then
-                           Error_Msg_NE ("dimensions mismatch in call of&",
-                                         N, Name (N));
-                           Error_Detected := True;
+                  else
+                     Actual := First_Actual (N);
+                     while Present (Actual) loop
+                        if Exists (Dimensions_Of (Actual)) then
+
+                           --  Check if error has already been encountered so
+                           --  far.
+
+                           if not Error_Detected then
+                              Error_Msg_NE ("dimensions mismatch in call of&",
+                                            N, Name (N));
+                              Error_Detected := True;
+                           end if;
+
+                           Error_Msg_N ("\expected dimension [], found " &
+                                        Dimensions_Msg_Of (Actual),
+                                        Actual);
                         end if;
 
-                        Error_Msg_N ("\expected dimension [], found " &
-                                     Dimensions_Msg_Of (Actual),
-                                     Actual);
-                     end if;
+                        Next_Actual (Actual);
+                     end loop;
+                  end if;
 
-                     Next_Actual (Actual);
-                  end loop;
-               end if;
+                  --  Nothing more to do for elementary functions
 
-               --  Nothing more to do for elementary functions
+                  return;
+               end if;
+            end Elementary_Function_Calls;
+         end if;
 
-               return;
-            end if;
-         end Elementary_Function_Calls;
-      end if;
+         --  General case. Check, for each parameter, the dimensions of the
+         --  actual and its corresponding formal match. Otherwise, complain.
 
-      --  General case. Check, for each parameter, the dimensions of the actual
-      --  and its corresponding formal match. Otherwise, complain.
+         Actual := First_Actual (N);
+         Formal := First_Formal (Nam);
 
-      Actual  := First_Actual (N);
-      Formal  := First_Formal (Nam);
+         while Present (Formal) loop
+            Formal_Typ     := Etype (Formal);
+            Dims_Of_Formal := Dimensions_Of (Formal_Typ);
 
-      while Present (Formal) loop
-         Formal_Typ     := Etype (Formal);
-         Dims_Of_Formal := Dimensions_Of (Formal_Typ);
+            --  If the formal is not dimensionless, check dimensions of formal
+            --  and actual match. Otherwise, complain.
 
-         --  If the formal is not dimensionless, check dimensions of formal and
-         --  actual match. Otherwise, complain.
+            if Exists (Dims_Of_Formal)
+              and then Dimensions_Of (Actual) /= Dims_Of_Formal
+            then
+               --  Check if an error has already been encountered so far
 
-         if Exists (Dims_Of_Formal)
-           and then Dimensions_Of (Actual) /= Dims_Of_Formal
-         then
-            --  Check if an error has already been encountered so far
+               if not Error_Detected then
+                  Error_Msg_NE ("dimensions mismatch in& call", N, Name (N));
+                  Error_Detected := True;
+               end if;
 
-            if not Error_Detected then
-               Error_Msg_NE ("dimensions mismatch in& call", N, Name (N));
-               Error_Detected := True;
+               Error_Msg_N ("\expected dimension " &
+                            Dimensions_Msg_Of (Formal_Typ) & ", found " &
+                            Dimensions_Msg_Of (Actual),
+                            Actual);
             end if;
 
-            Error_Msg_N ("\expected dimension " &
-                         Dimensions_Msg_Of (Formal_Typ) & ", found " &
-                         Dimensions_Msg_Of (Actual),
-                         Actual);
-         end if;
+            Next_Actual (Actual);
+            Next_Formal (Formal);
+         end loop;
+      end if;
 
-         Next_Actual (Actual);
-         Next_Formal (Formal);
-      end loop;
+      --  For function calls, propagate the dimensions from the returned type
+
+      if Nkind (N) = N_Function_Call then
+         Analyze_Dimension_Has_Etype (N);
+      end if;
    end Analyze_Dimension_Call;
 
    ---------------------------------------------
diff --git a/gcc/ada/switch-m.adb b/gcc/ada/switch-m.adb
index d082c90..0d769dc 100644
--- a/gcc/ada/switch-m.adb
+++ b/gcc/ada/switch-m.adb
@@ -236,9 +236,9 @@ package body Switch.M is
                   --  One-letter switches
 
                   when 'a' | 'A' | 'b' | 'B' | 'c' | 'C' | 'E' | 'f' |
-                       'F' | 'g' | 'h' | 'H' | 'I' | 'L' | 'N' | 'o' |
-                       'p' | 'P' | 'q' | 'Q' | 'r' | 's' | 'S' | 't' |
-                       'u' | 'U' | 'v' | 'x' | 'X' | 'Z' =>
+                       'F' | 'g' | 'h' | 'H' | 'I' | 'L' | 'N' | 'p' |
+                       'P' | 'q' | 'Q' | 'r' | 's' | 'S' | 't' | 'u' |
+                       'U' | 'v' | 'x' | 'X' | 'Z' =>
                      Storing (First_Stored) := C;
                      Add_Switch_Component
                        (Storing (Storing'First .. First_Stored));
@@ -441,6 +441,32 @@ package body Switch.M is
                      Add_Switch_Component
                        (Storing (Storing'First .. Last_Stored));
 
+                  --  -gnato may be -gnatox or -gnatoxx, with x=0/1/2/3
+
+                  when 'o' =>
+                     Last_Stored := First_Stored;
+                     Storing (Last_Stored) := 'o';
+                     Ptr := Ptr + 1;
+
+                     if Ptr <= Max
+                       and then Switch_Chars (Ptr) in '0' .. '3'
+                     then
+                        Last_Stored := Last_Stored + 1;
+                        Storing (Last_Stored) := Switch_Chars (Ptr);
+                        Ptr := Ptr + 1;
+
+                        if Ptr <= Max
+                          and then Switch_Chars (Ptr) in '0' .. '3'
+                        then
+                           Last_Stored := Last_Stored + 1;
+                           Storing (Last_Stored) := Switch_Chars (Ptr);
+                           Ptr := Ptr + 1;
+                        end if;
+                     end if;
+
+                     Add_Switch_Component
+                       (Storing (Storing'First .. Last_Stored));
+
                   --  -gnatR may be followed by '0', '1', '2' or '3',
                   --  then by 's'