[multiple changes]

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

	* sem_util.adb: Minor code cleanup: test for proper entity instead of
	testing just Chars attribute when checking whether a given scope is
	System.
	* exp_ch4.adb, einfo.adb: Minor reformatting.

2010-06-23  Vincent Celier  <celier@adacore.com>

	PR ada/44633
	* switch-m.adb (Normalize_Compiler_Switches): Take into account
	switches -gnatB, -gnatD=nn, -gnatG (incuding -gnatG=nn), -gnatI,
	-gnatl=file, -gnatS, -gnatjnn, -gnateI=nn and -gnatWx.

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

	* sem_res.adb (Resolve_Membership_Op): If left operand is a mixed mode
	operation with a universal real operand, and the right operand is a
	range with universal bounds, find unique fixed point that may be
	candidate, and warn appropriately.

From-SVN: r161264

6 files changed, 178 insertions, 91 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 45879d571c6..12e60cc7fef 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,24 @@
+2010-06-23  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_util.adb: Minor code cleanup: test for proper entity instead of
+	testing just Chars attribute when checking whether a given scope is
+	System.
+	* exp_ch4.adb, einfo.adb: Minor reformatting.
+
+2010-06-23  Vincent Celier  <celier@adacore.com>
+
+	PR ada/44633
+	* switch-m.adb (Normalize_Compiler_Switches): Take into account
+	switches -gnatB, -gnatD=nn, -gnatG (incuding -gnatG=nn), -gnatI,
+	-gnatl=file, -gnatS, -gnatjnn, -gnateI=nn and -gnatWx.
+
+2010-06-23  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_res.adb (Resolve_Membership_Op): If left operand is a mixed mode
+	operation with a universal real operand, and the right operand is a
+	range with universal bounds, find unique fixed point that may be
+	candidate, and warn appropriately.
+
 2010-06-23  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_res.adb (Resolve_Intrinsic_Operator): Add guards to handle
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 7769ff1b2bd..f1145a1ac07 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -5856,7 +5856,7 @@ package body Einfo is
 
       return Convention (Id) in Foreign_Convention
         or else (Convention (Id) = Convention_Intrinsic
-                 and then Present (Interface_Name (Id)));
+                   and then Present (Interface_Name (Id)));
    end Has_Foreign_Convention;
 
    ---------------------------
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 6a78a935080..cf9f8d78fb4 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -4378,9 +4378,9 @@ package body Exp_Ch4 is
 
       --  Check case of explicit test for an expression in range of its
       --  subtype. This is suspicious usage and we replace it with a 'Valid
-      --  test and give a warning. For floating point types however, this
-      --  is a standard way to check for finite numbers, and using 'Valid
-      --  would typically be a pessimization
+      --  test and give a warning. For floating point types however, this is a
+      --  standard way to check for finite numbers, and using 'Valid vould
+      --  typically be a pessimization.
 
       if Is_Scalar_Type (Etype (Lop))
         and then not Is_Floating_Point_Type (Etype (Lop))
@@ -4420,9 +4420,9 @@ package body Exp_Ch4 is
                         and then Comes_From_Source (N)
                         and then not In_Instance;
             --  This must be true for any of the optimization warnings, we
-            --  clearly want to give them only for source with the flag on.
-            --  We also skip these warnings in an instance since it may be
-            --  the case that different instantiations have different ranges.
+            --  clearly want to give them only for source with the flag on. We
+            --  also skip these warnings in an instance since it may be the
+            --  case that different instantiations have different ranges.
 
             Warn2 : constant Boolean :=
                       Warn1
@@ -4431,8 +4431,8 @@ package body Exp_Ch4 is
             --  For the case where only one bound warning is elided, we also
             --  insist on an explicit range and an integer type. The reason is
             --  that the use of enumeration ranges including an end point is
-            --  common, as is the use of a subtype name, one of whose bounds
-            --  is the same as the type of the expression.
+            --  common, as is the use of a subtype name, one of whose bounds is
+            --  the same as the type of the expression.
 
          begin
             --  If test is explicit x'first .. x'last, replace by valid check
@@ -4477,8 +4477,8 @@ package body Exp_Ch4 is
                return;
             end if;
 
-            --  If we have an explicit range, do a bit of optimization based
-            --  on range analysis (we may be able to kill one or both checks).
+            --  If we have an explicit range, do a bit of optimization based on
+            --  range analysis (we may be able to kill one or both checks).
 
             Lcheck := Compile_Time_Compare (Lop, Lo, Assume_Valid => False);
             Ucheck := Compile_Time_Compare (Lop, Hi, Assume_Valid => False);
@@ -4493,8 +4493,7 @@ package body Exp_Ch4 is
                   Error_Msg_N ("\?value is known to be out of range", N);
                end if;
 
-               Rewrite (N,
-                 New_Reference_To (Standard_False, Loc));
+               Rewrite (N, New_Reference_To (Standard_False, Loc));
                Analyze_And_Resolve (N, Rtyp);
                Set_Is_Static_Expression (N, Static);
 
@@ -4509,8 +4508,7 @@ package body Exp_Ch4 is
                   Error_Msg_N ("\?value is known to be in range", N);
                end if;
 
-               Rewrite (N,
-                 New_Reference_To (Standard_True, Loc));
+               Rewrite (N, New_Reference_To (Standard_True, Loc));
                Analyze_And_Resolve (N, Rtyp);
                Set_Is_Static_Expression (N, Static);
 
@@ -4624,9 +4622,7 @@ package body Exp_Ch4 is
                   --  Update decoration of relocated node referenced by the
                   --  SCIL node.
 
-                  if Generate_SCIL
-                    and then Present (SCIL_Node)
-                  then
+                  if Generate_SCIL and then Present (SCIL_Node) then
                      Set_SCIL_Node (N, SCIL_Node);
                   end if;
                end if;
@@ -4666,12 +4662,10 @@ package body Exp_Ch4 is
                  Make_Raise_Program_Error (Loc,
                    Reason => PE_Unchecked_Union_Restriction));
 
-               --  Prevent Gigi from generating incorrect code by rewriting
-               --  the test as a standard False.
-
-               Rewrite (N,
-                 New_Occurrence_Of (Standard_False, Loc));
+               --  Prevent Gigi from generating incorrect code by rewriting the
+               --  test as False.
 
+               Rewrite (N, New_Occurrence_Of (Standard_False, Loc));
                return;
             end if;
 
@@ -4682,8 +4676,7 @@ package body Exp_Ch4 is
             end if;
 
             if not Is_Constrained (Typ) then
-               Rewrite (N,
-                 New_Reference_To (Standard_True, Loc));
+               Rewrite (N, New_Reference_To (Standard_True, Loc));
                Analyze_And_Resolve (N, Rtyp);
 
             --  For the constrained array case, we have to check the subscripts
@@ -4691,19 +4684,18 @@ package body Exp_Ch4 is
             --  must match in any case).
 
             elsif Is_Array_Type (Typ) then
-
                Check_Subscripts : declare
-                  function Construct_Attribute_Reference
+                  function Build_Attribute_Reference
                     (E   : Node_Id;
                      Nam : Name_Id;
                      Dim : Nat) return Node_Id;
-                  --  Build attribute reference E'Nam(Dim)
+                  --  Build attribute reference E'Nam (Dim)
 
-                  -----------------------------------
-                  -- Construct_Attribute_Reference --
-                  -----------------------------------
+                  -------------------------------
+                  -- Build_Attribute_Reference --
+                  -------------------------------
 
-                  function Construct_Attribute_Reference
+                  function Build_Attribute_Reference
                     (E   : Node_Id;
                      Nam : Name_Id;
                      Dim : Nat) return Node_Id
@@ -4711,11 +4703,11 @@ package body Exp_Ch4 is
                   begin
                      return
                        Make_Attribute_Reference (Loc,
-                         Prefix => E,
+                         Prefix         => E,
                          Attribute_Name => Nam,
-                         Expressions => New_List (
+                         Expressions    => New_List (
                            Make_Integer_Literal (Loc, Dim)));
-                  end Construct_Attribute_Reference;
+                  end Build_Attribute_Reference;
 
                --  Start of processing for Check_Subscripts
 
@@ -4724,21 +4716,21 @@ package body Exp_Ch4 is
                      Evolve_And_Then (Cond,
                        Make_Op_Eq (Loc,
                          Left_Opnd  =>
-                           Construct_Attribute_Reference
+                           Build_Attribute_Reference
                              (Duplicate_Subexpr_No_Checks (Obj),
                               Name_First, J),
                          Right_Opnd =>
-                           Construct_Attribute_Reference
+                           Build_Attribute_Reference
                              (New_Occurrence_Of (Typ, Loc), Name_First, J)));
 
                      Evolve_And_Then (Cond,
                        Make_Op_Eq (Loc,
                          Left_Opnd  =>
-                           Construct_Attribute_Reference
+                           Build_Attribute_Reference
                              (Duplicate_Subexpr_No_Checks (Obj),
                               Name_Last, J),
                          Right_Opnd =>
-                           Construct_Attribute_Reference
+                           Build_Attribute_Reference
                              (New_Occurrence_Of (Typ, Loc), Name_Last, J)));
                   end loop;
 
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index c3e6956235c..33b48d60c31 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -7036,6 +7036,18 @@ package body Sem_Res is
          T := Intersect_Types (L, R);
       end if;
 
+      --  If mixed-mode operations are present and operands are all literal,
+      --  the only interpretation involves Duration, which is probably not
+      --  the intention of the programmer.
+
+      if T = Any_Fixed then
+         T := Unique_Fixed_Point_Type (N);
+
+         if T = Any_Type then
+            return;
+         end if;
+      end if;
+
       Resolve (L, T);
       Check_Unset_Reference (L);
 
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 47e681a428f..6339e3e9c65 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -1770,8 +1770,7 @@ package body Sem_Util is
             --  appear in the target-specific extension to System.
 
             if No (Id)
-              and then Chars (B_Scope) = Name_System
-              and then Scope (B_Scope) = Standard_Standard
+              and then B_Scope = RTU_Entity (System)
               and then Present_System_Aux
             then
                B_Scope := System_Aux_Id;
@@ -7225,7 +7224,7 @@ package body Sem_Util is
             and then Scope (Op) = System_Aux_Id)
            or else
            (True_VMS_Target
-             and then Chars (Scope (Scope (Op))) = Name_System));
+             and then Scope (Scope (Op)) = RTU_Entity (System)));
    end Is_VMS_Operator;
 
    -----------------
diff --git a/gcc/ada/switch-m.adb b/gcc/ada/switch-m.adb
index b549b2cac69..11491d3de42 100644
--- a/gcc/ada/switch-m.adb
+++ b/gcc/ada/switch-m.adb
@@ -215,9 +215,9 @@ package body Switch.M is
 
                   --  One-letter switches
 
-                  when 'a' | 'A' | 'b' | 'c' | 'C' | 'D' | 'E' | 'f' |
-                       'F' | 'g' | 'h' | 'H' | 'l' | 'L' | 'n' | 'N' |
-                       'o' | 'O' | 'p' | 'P' | 'q' | 'Q' | 'r' | 's' |
+                  when 'a' | 'A' | 'b' | 'B' | 'c' | 'C' | 'E' | 'f' |
+                       'F' | 'g' | 'h' | 'H' | 'I' | 'L' | 'n' | 'N' |
+                       'o' | 'p' | 'P' | 'q' | 'Q' | 'r' | 's' | 'S' |
                        't' | 'u' | 'U' | 'v' | 'x' | 'X' | 'Z' =>
                      Storing (First_Stored) := C;
                      Add_Switch_Component
@@ -226,10 +226,14 @@ package body Switch.M is
 
                   --  One-letter switches followed by a positive number
 
-                  when 'k' | 'm' | 'T' =>
+                  when 'D' | 'G' | 'j' | 'k' | 'm' | 'T' =>
                      Storing (First_Stored) := C;
                      Last_Stored := First_Stored;
 
+                     if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
+                        Ptr := Ptr + 1;
+                     end if;
+
                      loop
                         Ptr := Ptr + 1;
                         exit when Ptr > Max
@@ -268,68 +272,93 @@ package body Switch.M is
 
                   when 'e' =>
 
-                     --  Store -gnateD, -gnatep=, -gnateG and -gnateS in the
-                     --  ALI file. The other -gnate switches do not need to be
-                     --  stored.
+                     --  Some of the gnate... switches are not stored
 
                      Storing (First_Stored) := 'e';
                      Ptr := Ptr + 1;
 
-                     if Ptr > Max
-                       or else (Switch_Chars (Ptr) /= 'D'
-                                 and then Switch_Chars (Ptr) /= 'G'
-                                 and then Switch_Chars (Ptr) /= 'p'
-                                 and then Switch_Chars (Ptr) /= 'S')
-                     then
+                     if Ptr > Max then
                         Last := 0;
                         return;
-                     end if;
 
-                     --  Processing for -gnateD
+                     else
+                        case Switch_Chars (Ptr) is
 
-                     if Switch_Chars (Ptr) = 'D' then
-                        Storing (First_Stored + 1 ..
-                                 First_Stored + Max - Ptr + 1) :=
-                          Switch_Chars (Ptr .. Max);
-                        Add_Switch_Component
-                          (Storing (Storing'First ..
-                                      First_Stored + Max - Ptr + 1));
+                           when 'D' =>
+                              Storing (First_Stored + 1 ..
+                                         First_Stored + Max - Ptr + 1) :=
+                                  Switch_Chars (Ptr .. Max);
+                              Add_Switch_Component
+                                (Storing (Storing'First ..
+                                   First_Stored + Max - Ptr + 1));
+                              Ptr := Max + 1;
 
-                     --  Processing for -gnatep=
+                           when 'G' =>
+                              Ptr := Ptr + 1;
+                              Add_Switch_Component ("-gnateG");
 
-                     elsif Switch_Chars (Ptr) = 'p' then
-                        Ptr := Ptr + 1;
+                           when 'I' =>
+                              Ptr := Ptr + 1;
 
-                        if Ptr = Max then
-                           Last := 0;
-                           return;
-                        end if;
+                              declare
+                                 First : constant Positive := Ptr - 1;
+                              begin
+                                 if Ptr <= Max and then
+                                   Switch_Chars (Ptr) = '='
+                                 then
+                                    Ptr := Ptr + 1;
+                                 end if;
+
+                                 while Ptr <= Max and then
+                                       Switch_Chars (Ptr) in '0' .. '9'
+                                 loop
+                                    Ptr := Ptr + 1;
+                                 end loop;
+
+                                 Storing (First_Stored + 1 ..
+                                            First_Stored + Ptr - First) :=
+                                     Switch_Chars (First .. Ptr - 1);
+                                 Add_Switch_Component
+                                   (Storing (Storing'First ..
+                                      First_Stored + Ptr - First));
+                              end;
+
+                           when 'p' =>
+                              Ptr := Ptr + 1;
 
-                        if Switch_Chars (Ptr) = '=' then
-                           Ptr := Ptr + 1;
-                        end if;
+                              if Ptr = Max then
+                                 Last := 0;
+                                 return;
+                              end if;
 
-                        --  To normalize, always put a '=' after -gnatep.
-                        --  Because that could lengthen the switch string,
-                        --  declare a local variable.
+                              if Switch_Chars (Ptr) = '=' then
+                                 Ptr := Ptr + 1;
+                              end if;
 
-                        declare
-                           To_Store : String (1 .. Max - Ptr + 9);
-                        begin
-                           To_Store (1 .. 8) := "-gnatep=";
-                           To_Store (9 .. Max - Ptr + 9) :=
-                             Switch_Chars (Ptr .. Max);
-                           Add_Switch_Component (To_Store);
-                        end;
+                                 --  To normalize, always put a '=' after
+                                 --  -gnatep. Because that could lengthen the
+                                 --  switch string, declare a local variable.
 
-                     elsif Switch_Chars (Ptr) = 'G' then
-                        Add_Switch_Component ("-gnateG");
+                              declare
+                                 To_Store : String (1 .. Max - Ptr + 9);
+                              begin
+                                 To_Store (1 .. 8) := "-gnatep=";
+                                 To_Store (9 .. Max - Ptr + 9) :=
+                                   Switch_Chars (Ptr .. Max);
+                                 Add_Switch_Component (To_Store);
+                              end;
 
-                     elsif Switch_Chars (Ptr) = 'S' then
-                        Add_Switch_Component ("-gnateS");
-                     end if;
+                              return;
 
-                     return;
+                           when 'S' =>
+                              Ptr := Ptr + 1;
+                              Add_Switch_Component ("-gnateS");
+
+                           when others =>
+                              Last := 0;
+                              return;
+                        end case;
+                     end if;
 
                   when 'i' =>
                      Storing (First_Stored) := 'i';
@@ -360,6 +389,20 @@ package body Switch.M is
                         return;
                      end if;
 
+                  --  -gnatl may be -gnatl=<file name>
+
+                  when 'l' =>
+                     Ptr := Ptr + 1;
+
+                     if Ptr > Max or else Switch_Chars (Ptr) /= '=' then
+                        Add_Switch_Component ("-gnatl");
+
+                     else
+                        Add_Switch_Component
+                          ("-gnatl" & Switch_Chars (Ptr .. Max));
+                        return;
+                     end if;
+
                   --  -gnatR may be followed by '0', '1', '2' or '3',
                   --  then by 's'
 
@@ -395,6 +438,26 @@ package body Switch.M is
                      Add_Switch_Component
                        (Storing (Storing'First .. Last_Stored));
 
+                  --  -gnatWx, x = 'h'. 'u', 's', 'e', '8' or 'b'
+
+                  when 'W' =>
+                     Storing (First_Stored) := 'W';
+                     Ptr := Ptr + 1;
+
+                     if Ptr <= Max then
+                        case Switch_Chars (Ptr) is
+                           when 'h' | 'u' | 's' | 'e' | '8' | 'b' =>
+                              Storing (First_Stored + 1) := Switch_Chars (Ptr);
+                              Add_Switch_Component
+                                (Storing (Storing'First .. First_Stored + 1));
+                              Ptr := Ptr + 1;
+
+                           when others =>
+                              Last := 0;
+                              return;
+                        end case;
+                     end if;
+
                   --  Multiple switches
 
                   when 'V' | 'w' | 'y' =>