2010-10-22 Arnaud Charlet <charlet@adacore.com>

	* a-locale.adb: Minor code clean up.

2010-10-22  Thomas Quinot  <quinot@adacore.com>

	* exp_ch4.adb: Minor code reorganization and factoring.

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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 7b62fc2..5e656f9 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,11 @@
+2010-10-22  Arnaud Charlet  <charlet@adacore.com>
+
+       * a-locale.adb: Minor code clean up.
+
+2010-10-22  Thomas Quinot  <quinot@adacore.com>
+
+       * exp_ch4.adb: Minor code reorganization and factoring.
+
 2010-10-22  Thomas Quinot  <quinot@adacore.com>
 
        * exp_ch5.adb, sem_ch5.adb, sinfo.ads, snames.ads-tmpl, par-ch5.adb:

diff --git a/gcc/ada/a-locale.adb b/gcc/ada/a-locale.adb
index 64c5125..d56970c 100644 (file)
--- a/gcc/ada/a-locale.adb
+++ b/gcc/ada/a-locale.adb
@@ -45,7 +45,7 @@ package body Ada.Locales is
       pragma Import (C, C_Get_Language_Code);
       F : Lower_4;
    begin
-      C_Get_Language_Code (F (1)'Address);
+      C_Get_Language_Code (F'Address);
       return Language_Code (F (1 .. 3));
    end Language;
 
@@ -58,7 +58,7 @@ package body Ada.Locales is
       pragma Import (C, C_Get_Country_Code);
       F : Upper_4;
    begin
-      C_Get_Country_Code (F (1)'Address);
+      C_Get_Country_Code (F'Address);
       return Country_Code (F (1 .. 2));
    end Country;
 

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 31a43db..4450a1e 100644 (file)
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -4398,17 +4398,23 @@ package body Exp_Ch4 is
 
       procedure Substitute_Valid_Check is
       begin
-         Rewrite (N,
-           Make_Attribute_Reference (Loc,
-             Prefix         => Relocate_Node (Lop),
-             Attribute_Name => Name_Valid));
+         --  Don't do this for type with predicates, since we don't care in
+         --  this case if it gets optimized away, the critical test is the
+         --  call to the predicate function
 
-         Analyze_And_Resolve (N, Restyp);
+         if not Has_Predicates (Ltyp) then
+            Rewrite (N,
+              Make_Attribute_Reference (Loc,
+                Prefix         => Relocate_Node (Lop),
+                Attribute_Name => Name_Valid));
 
-         Error_Msg_N ("?explicit membership test may be optimized away", N);
-         Error_Msg_N -- CODEFIX
-           ("\?use ''Valid attribute instead", N);
-         return;
+            Analyze_And_Resolve (N, Restyp);
+
+            Error_Msg_N ("?explicit membership test may be optimized away", N);
+            Error_Msg_N -- CODEFIX
+              ("\?use ''Valid attribute instead", N);
+            return;
+         end if;
       end Substitute_Valid_Check;
 
    --  Start of processing for Expand_N_In
@@ -4682,7 +4688,10 @@ package body Exp_Ch4 is
             --  type if they come from the original type definition. Also this
             --  way we get all the processing above for an explicit range.
 
-            elsif Is_Scalar_Type (Typ) then
+            --  Don't do this for a type with predicates, since we would lose
+            --  the predicate from this rewriting (test goes to base type).
+
+            elsif Is_Scalar_Type (Typ) and then not Has_Predicates (Typ) then
                Rewrite (Rop,
                  Make_Range (Loc,
                    Low_Bound =>
@@ -7426,79 +7435,72 @@ package body Exp_Ch4 is
    -- Expand_N_Quantified_Expression --
    ------------------------------------
 
-   procedure Expand_N_Quantified_Expression (N : Node_Id) is
-      Loc      : constant Source_Ptr := Sloc (N);
-      Cond     : constant Node_Id    := Condition (N);
+   --  We expand:
 
-      Actions  : List_Id;
-      Decl     : Node_Id;
-      I_Scheme : Node_Id;
-      Test     : Node_Id;
-      Tnn      : Entity_Id;
+   --    for all X in range => Cond
 
-      --  We expand:
+   --  into:
 
-      --      for all X in range => Cond
+   --        T := True;
+   --        for X in range loop
+   --           if not Cond then
+   --              T := False;
+   --              exit;
+   --           end if;
+   --        end loop;
 
-      --  into:
+   --  Conversely, an existentially quantified expression:
 
-      --        R := True;
-      --        for all X in range loop
-      --           if not Cond then
-      --              R := False;
-      --              exit;
-      --           end if;
-      --        end loop;
+   --    for some X in range => Cond
 
-      --  Conversely, an existentially quantified expression becomes:
+   --  becomes:
 
-      --        R := False;
-      --        for all X in range loop
-      --           if Cond then
-      --              R := True;
-      --              exit;
-      --           end if;
-      --        end loop;
+   --        T := False;
+   --        for X in range loop
+   --           if Cond then
+   --              T := True;
+   --              exit;
+   --           end if;
+   --        end loop;
 
-      --  In both cases, the iteration may be over a container, in which
-      --  case it is given by an iterator specification, not a loop.
+   --  In both cases, the iteration may be over a container in which case it is
+   --  given by an iterator specification, not a loop parameter specification.
+
+   procedure Expand_N_Quantified_Expression (N : Node_Id) is
+      Loc          : constant Source_Ptr := Sloc (N);
+      Is_Universal : constant Boolean := All_Present (N);
+      Actions      : constant List_Id := New_List;
+      Tnn          : constant Entity_Id := Make_Temporary (Loc, 'T', N);
+      Cond         : Node_Id;
+      Decl         : Node_Id;
+      I_Scheme     : Node_Id;
+      Test         : Node_Id;
 
    begin
-      Actions := New_List;
-      Tnn := Make_Temporary (Loc, 'T');
       Decl :=
         Make_Object_Declaration (Loc,
           Defining_Identifier => Tnn,
-          Object_Definition   => New_Occurrence_Of (Standard_Boolean, Loc));
-
+          Object_Definition   => New_Occurrence_Of (Standard_Boolean, Loc),
+          Expression          =>
+            New_Occurrence_Of (Boolean_Literals (Is_Universal), Loc));
       Append_To (Actions, Decl);
 
-      if All_Present (N) then
-         Set_Expression (Decl, New_Occurrence_Of (Standard_True, Loc));
+      Cond := Relocate_Node (Condition (N));
 
-         Test :=
-           Make_If_Statement (Loc,
-             Condition       =>
-                Make_Op_Not (Loc, Relocate_Node (Cond)),
-             Then_Statements => New_List (
-               Make_Assignment_Statement (Loc,
-                 Name       => New_Occurrence_Of (Tnn, Loc),
-                 Expression => New_Occurrence_Of (Standard_False, Loc)),
-               Make_Exit_Statement (Loc)));
-
-      else
-         Set_Expression (Decl, New_Occurrence_Of (Standard_False, Loc));
-
-         Test :=
-           Make_If_Statement (Loc,
-             Condition       => Relocate_Node (Cond),
-             Then_Statements => New_List (
-               Make_Assignment_Statement (Loc,
-                 Name       => New_Occurrence_Of (Tnn, Loc),
-                 Expression => New_Occurrence_Of (Standard_True, Loc)),
-               Make_Exit_Statement (Loc)));
+      if Is_Universal then
+         Cond := Make_Op_Not (Loc, Cond);
       end if;
 
+      Test :=
+        Make_Implicit_If_Statement (N,
+          Condition       => Cond,
+          Then_Statements => New_List (
+            Make_Assignment_Statement (Loc,
+              Name       => New_Occurrence_Of (Tnn, Loc),
+              Expression =>
+                New_Occurrence_Of (Boolean_Literals (not Is_Universal), Loc)),
+            Make_Exit_Statement (Loc)));
+
       if Present (Loop_Parameter_Specification (N)) then
          I_Scheme :=
            Make_Iteration_Scheme (Loc,
@@ -7513,11 +7515,11 @@ package body Exp_Ch4 is
       Append_To (Actions,
         Make_Loop_Statement (Loc,
           Iteration_Scheme => I_Scheme,
-              Statements                   => New_List (Test),
-              End_Label                    => Empty));
+          Statements       => New_List (Test),
+          End_Label        => Empty));
 
-      --  The components of the scheme have already been analyzed, and the
-      --  loop index declaration has been processed.
+      --  The components of the scheme have already been analyzed, and the loop
+      --  parameter declaration has been processed.
 
       Set_Analyzed (Iteration_Scheme (Last (Actions)));