[multiple changes]

2012-10-03  Gary Dismukes  <dismukes@adacore.com>

	* sem_ch6.adb: Minor typo fix.

2012-10-03  Robert Dewar  <dewar@adacore.com>

	* checks.adb (Apply_Arithmetic_Overflow_Minimized_Eliminated):
	Set Top_Level properly (to False) for operand of range of
	membership test.
	* exp_ch4.adb (Expand_Membership_Minimize_Eliminate_Overflow):
	Fix crash with -gnato3 and membership operations.
	(Expand_Membership_Minimize_Eliminate_Overflow): Fix error message
	and wrong results for -gnato3 large expression and predicated
	subtype.
	(Expand_Membership_Minimize_Eliminate_Overflow): Use
	expression action node to avoid using insert actions (bombs in
	some cases).
	(Expand_Compare_Minimize_Eliminate_Overflow): Use expression action
	node to avoid using insert actions (bombs in some cases).

2012-10-03  Javier Miranda  <miranda@adacore.com>

	* exp_disp.adb (Set_CPP_Constructors_Old): Handle constructor of
	untagged type that has all its parameters with defaults and hence it
	covers the default constructor.

From-SVN: r192027

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1722033..9c8bab6 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,29 @@
+2012-10-03  Gary Dismukes  <dismukes@adacore.com>
+
+       * sem_ch6.adb: Minor typo fix.
+
+2012-10-03  Robert Dewar  <dewar@adacore.com>
+
+       * checks.adb (Apply_Arithmetic_Overflow_Minimized_Eliminated):
+       Set Top_Level properly (to False) for operand of range of
+       membership test.
+       * exp_ch4.adb (Expand_Membership_Minimize_Eliminate_Overflow):
+       Fix crash with -gnato3 and membership operations.
+       (Expand_Membership_Minimize_Eliminate_Overflow): Fix error message
+       and wrong results for -gnato3 large expression and predicated
+       subtype.
+       (Expand_Membership_Minimize_Eliminate_Overflow): Use
+       expression action node to avoid using insert actions (bombs in
+       some cases).
+       (Expand_Compare_Minimize_Eliminate_Overflow): Use expression action
+       node to avoid using insert actions (bombs in some cases).
+
+2012-10-03  Javier Miranda  <miranda@adacore.com>
+
+       * exp_disp.adb (Set_CPP_Constructors_Old): Handle constructor of
+       untagged type that has all its parameters with defaults and hence it
+       covers the default constructor.
+
 2012-10-03  Yannick Moy  <moy@adacore.com>
 
        * checks.adb, sem_prag.adb, s-bignum.ads: Minor typo fixes.

diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index a70deeb..3e9ee56 100644 (file)
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -1101,17 +1101,16 @@ package body Checks is
 
       --  In all these cases, we will process at the higher level (and then
       --  this node will be processed during the downwards recursion that
-      --  is part of the processing in Minimize_Eliminate_Overflow_Checks.
+      --  is part of the processing in Minimize_Eliminate_Overflow_Checks).
 
       if Is_Signed_Integer_Arithmetic_Op (P)
-        or else Nkind (Op) in N_Membership_Test
-        or else Nkind (Op) in N_Op_Compare
+        or else Nkind (P) in N_Membership_Test
+        or else Nkind (P) in N_Op_Compare
 
         --  We may also be a range operand in a membership test
 
-        or else (Nkind (Op) = N_Range
-                  and then Nkind (Parent (Op)) in N_Membership_Test)
-
+        or else (Nkind (P) = N_Range
+                  and then Nkind (Parent (P)) in N_Membership_Test)
       then
          return;
       end if;

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index dc5a299..223feac 100644 (file)
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -2308,6 +2308,9 @@ package body Exp_Ch4 is
    procedure Expand_Compare_Minimize_Eliminate_Overflow (N : Node_Id) is
       Loc : constant Source_Ptr := Sloc (N);
 
+      Result_Type : constant Entity_Id := Etype (N);
+      --  Capture result type (could be a derived boolean type)
+
       Llo, Lhi : Uint;
       Rlo, Rhi : Uint;
 
@@ -2452,22 +2455,22 @@ package body Exp_Ch4 is
                   Right := Convert_To_Bignum (Right);
                end if;
 
-               --  We need a sequence that looks like
-
-               --    Bnn : Boolean;
-
-               --    declare
-               --       M : Mark_Id := SS_Mark;
-               --    begin
-               --       Bnn := Big_xx (Left, Right); (xx = EQ, NT etc)
-               --       SS_Release (M);
-               --    end;
+               --  We rewrite our node with:
 
-               --  This block is inserted (using Insert_Actions), and then the
-               --  node is replaced with a reference to Bnn.
+               --    do
+               --       Bnn : Result_Type;
+               --       declare
+               --          M : Mark_Id := SS_Mark;
+               --       begin
+               --          Bnn := Big_xx (Left, Right); (xx = EQ, NT etc)
+               --          SS_Release (M);
+               --       end;
+               --    in
+               --       Bnn
+               --    end
 
                declare
-                  Blk : constant Node_Id  := Make_Bignum_Block (Loc);
+                  Blk : constant Node_Id   := Make_Bignum_Block (Loc);
                   Bnn : constant Entity_Id := Make_Temporary (Loc, 'B', N);
                   Ent : RE_Id;
 
@@ -2481,7 +2484,7 @@ package body Exp_Ch4 is
                      when N_Op_Ne => Ent := RE_Big_NE;
                   end case;
 
-                  --  Insert assignment to Bnn
+                  --  Insert assignment to Bnn into the bignum block
 
                   Insert_Before
                     (First (Statements (Handled_Statement_Sequence (Blk))),
@@ -2493,19 +2496,18 @@ package body Exp_Ch4 is
                              New_Occurrence_Of (RTE (Ent), Loc),
                            Parameter_Associations => New_List (Left, Right))));
 
-                  --  Insert actions (declaration of Bnn and block)
-
-                  Insert_Actions (N, New_List (
-                    Make_Object_Declaration (Loc,
-                      Defining_Identifier => Bnn,
-                      Object_Definition   =>
-                        New_Occurrence_Of (Standard_Boolean, Loc)),
-                    Blk));
-
-                  --  Rewrite node with reference to Bnn
+                  --  Now do the rewrite with expression actions
 
-                  Rewrite (N, New_Occurrence_Of (Bnn, Loc));
-                  Analyze_And_Resolve (N);
+                  Rewrite (N,
+                    Make_Expression_With_Actions (Loc,
+                      Actions    => New_List (
+                        Make_Object_Declaration (Loc,
+                          Defining_Identifier => Bnn,
+                          Object_Definition   =>
+                            New_Occurrence_Of (Result_Type, Loc)),
+                        Blk),
+                      Expression => New_Occurrence_Of (Bnn, Loc)));
+                  Analyze_And_Resolve (N, Result_Type);
                end;
             end;
 
@@ -3736,6 +3738,9 @@ package body Exp_Ch4 is
       --  Despite the name, this routine applies only to N_In, not to
       --  N_Not_In. The latter is always rewritten as not (X in Y).
 
+      Result_Type : constant Entity_Id := Etype (N);
+      --  Capture result type, may be a derived boolean type
+
       Loc : constant Source_Ptr := Sloc (N);
       Lop : constant Node_Id    := Left_Opnd (N);
       Rop : constant Node_Id    := Right_Opnd (N);
@@ -3801,35 +3806,42 @@ package body Exp_Ch4 is
             declare
                Blk    : constant Node_Id   := Make_Bignum_Block (Loc);
                Bnn    : constant Entity_Id := Make_Temporary (Loc, 'B', N);
+               L      : constant Entity_Id :=
+                          Make_Defining_Identifier (Loc, Name_uL);
                Lopnd  : constant Node_Id   := Convert_To_Bignum (Lop);
                Lbound : constant Node_Id   :=
                           Convert_To_Bignum (Low_Bound (Rop));
                Hbound : constant Node_Id   :=
                           Convert_To_Bignum (High_Bound (Rop));
 
-            --  Now we insert code that looks like
-
-            --    Bnn : Boolean;
-
-            --    declare
-            --       M : Mark_Id := SS_Mark;
-            --       L : Bignum  := Lopnd;
-            --    begin
-            --       Bnn := Big_GE (L, Lbound) and then Big_LE (L, Hbound)
-            --       SS_Release (M);
-            --    end;
-
-            --  and rewrite the membership test as a reference to Bnn
+            --  Now we rewrite the membership test node to look like
+
+            --    do
+            --       Bnn : Result_Type;
+            --       declare
+            --          M : Mark_Id := SS_Mark;
+            --          L : Bignum  := Lopnd;
+            --       begin
+            --          Bnn := Big_GE (L, Lbound) and then Big_LE (L, Hbound)
+            --          SS_Release (M);
+            --       end;
+            --    in
+            --       Bnn
+            --    end
 
             begin
+               --  Insert declaration of L into declarations of bignum block
+
                Insert_After
                  (Last (Declarations (Blk)),
                   Make_Object_Declaration (Loc,
-                    Defining_Identifier => Bnn,
+                    Defining_Identifier => L,
                     Object_Definition   =>
                       New_Occurrence_Of (RTE (RE_Bignum), Loc),
                     Expression          => Lopnd));
 
+               --  Insert assignment to Bnn into expressions of bignum block
+
                Insert_Before
                  (First (Statements (Handled_Statement_Sequence (Blk))),
                   Make_Assignment_Statement (Loc,
@@ -3840,22 +3852,29 @@ package body Exp_Ch4 is
                           Make_Function_Call (Loc,
                             Name                   =>
                               New_Occurrence_Of (RTE (RE_Big_GE), Loc),
-                            Parameter_Associations => New_List (Lbound)),
+                            Parameter_Associations => New_List (
+                              New_Occurrence_Of (L, Loc),
+                              Lbound)),
                         Right_Opnd =>
                           Make_Function_Call (Loc,
                             Name                   =>
-                              New_Occurrence_Of (RTE (RE_Big_GE), Loc),
-                            Parameter_Associations => New_List (Hbound)))));
+                              New_Occurrence_Of (RTE (RE_Big_LE), Loc),
+                            Parameter_Associations => New_List (
+                              New_Occurrence_Of (L, Loc),
+                              Hbound)))));
 
-               Insert_Actions (N, New_List (
-                 Make_Object_Declaration (Loc,
-                   Defining_Identifier => Bnn,
-                   Object_Definition   =>
-                     New_Occurrence_Of (Standard_Boolean, Loc)),
-                 Blk));
+               --  Now rewrite the node
 
-               Rewrite (N, New_Occurrence_Of (Bnn, Loc));
-               Analyze_And_Resolve (N);
+               Rewrite (N,
+                 Make_Expression_With_Actions (Loc,
+                   Actions    => New_List (
+                     Make_Object_Declaration (Loc,
+                       Defining_Identifier => Bnn,
+                       Object_Definition   =>
+                         New_Occurrence_Of (Result_Type, Loc)),
+                     Blk),
+                   Expression => New_Occurrence_Of (Bnn, Loc)));
+               Analyze_And_Resolve (N, Result_Type);
                return;
             end;
 
@@ -3876,12 +3895,16 @@ package body Exp_Ch4 is
 
             else
                Convert_To_And_Rewrite (LLIB, Lop);
-               Analyze_And_Resolve (Lop, LLIB, Suppress => All_Checks);
+               Set_Analyzed (Lop, False);
+               Analyze_And_Resolve (Lop, LLIB);
+
+               --  For the right operand, avoid unnecessary recursion into
+               --  this routine, we know that overflow is not possible.
 
                Convert_To_And_Rewrite (LLIB, Low_Bound (Rop));
                Convert_To_And_Rewrite (LLIB, High_Bound (Rop));
                Set_Analyzed (Rop, False);
-               Analyze_And_Resolve (Rop, LLIB, Suppress => All_Checks);
+               Analyze_And_Resolve (Rop, LLIB, Suppress => Overflow_Check);
             end if;
 
             --  Now the three operands are of the same signed integer type,
@@ -3909,29 +3932,34 @@ package body Exp_Ch4 is
 
          elsif Is_RTE (Etype (Lop), RE_Bignum) then
 
-            --  For X in T, we want to insert code that looks like
+            --  For X in T, we want to rewrite our node as
 
-            --    Bnn : Boolean;
+            --    do
+            --       Bnn : Result_Type;
 
-            --    declare
-            --       M   : Mark_Id := SS_Mark;
-            --       Lnn : Long_Long_Integer'Base
-            --       Nnn : Bignum;
+            --       declare
+            --          M   : Mark_Id := SS_Mark;
+            --          Lnn : Long_Long_Integer'Base
+            --          Nnn : Bignum;
 
-            --    begin
-            --      Nnn := X;
+            --       begin
+            --         Nnn := X;
 
-            --      if not Bignum_In_LLI_Range (Nnn) then
-            --         Bnn := False;
-            --      else
-            --         Lnn := From_Bignum (Nnn);
-            --         Bnn := Lnn in T'Base and then T'Base (Lnn) in T;
-            --      end if;
+            --         if not Bignum_In_LLI_Range (Nnn) then
+            --            Bnn := False;
+            --         else
+            --            Lnn := From_Bignum (Nnn);
+            --            Bnn :=
+            --              Lnn in LLIB (T'Base'First) .. LLIB (T'Base'Last)
+            --                and then T'Base (Lnn) in T;
+            --         end if;
             --
-            --       SS_Release (M);
-            --    end;
+            --          SS_Release (M);
+            --       end
+            --   in
+            --       Bnn
+            --   end
 
-            --  And then rewrite the original membership as a reference to Bnn.
             --  A bit gruesome, but here goes.
 
             declare
@@ -3939,10 +3967,12 @@ package body Exp_Ch4 is
                Bnn : constant Entity_Id := Make_Temporary (Loc, 'B', N);
                Lnn : constant Entity_Id := Make_Temporary (Loc, 'L', N);
                Nnn : constant Entity_Id := Make_Temporary (Loc, 'N', N);
+               T   : constant Entity_Id := Etype (Rop);
+               TB  : constant Entity_Id := Base_Type (T);
                Nin : Node_Id;
 
             begin
-               --  The last membership test is marked to prevent recursion
+               --  Mark the last membership operation to prevent recursion
 
                Nin :=
                  Make_In (Loc,
@@ -3976,12 +4006,14 @@ package body Exp_Ch4 is
 
                     Make_If_Statement (Loc,
                       Condition =>
-                        Make_Function_Call (Loc,
-                          Name =>
-                            New_Occurrence_Of
-                              (RTE (RE_Bignum_In_LLI_Range), Loc),
-                          Parameter_Associations => New_List (
-                            New_Occurrence_Of (Nnn, Loc))),
+                        Make_Op_Not (Loc,
+                          Right_Opnd =>
+                            Make_Function_Call (Loc,
+                              Name                   =>
+                                New_Occurrence_Of
+                                  (RTE (RE_Bignum_In_LLI_Range), Loc),
+                              Parameter_Associations => New_List (
+                                New_Occurrence_Of (Nnn, Loc)))),
 
                       Then_Statements => New_List (
                         Make_Assignment_Statement (Loc,
@@ -4000,27 +4032,42 @@ package body Exp_Ch4 is
                                   New_Occurrence_Of (Nnn, Loc)))),
 
                         Make_Assignment_Statement (Loc,
-                          Name => New_Occurrence_Of (Bnn, Loc),
+                          Name       => New_Occurrence_Of (Bnn, Loc),
                           Expression =>
                             Make_And_Then (Loc,
-                              Left_Opnd =>
+                              Left_Opnd  =>
                                 Make_In (Loc,
-                                  Left_Opnd  =>
-                                    New_Occurrence_Of (Lnn, Loc),
+                                  Left_Opnd  => New_Occurrence_Of (Lnn, Loc),
                                   Right_Opnd =>
-                                    New_Occurrence_Of
-                                      (Base_Type (Etype (Rop)), Loc)),
+                                    Make_Range (Loc,
+                                      Low_Bound  =>
+                                        Convert_To (LLIB,
+                                          Make_Attribute_Reference (Loc,
+                                            Attribute_Name => Name_First,
+                                            Prefix         =>
+                                              New_Occurrence_Of (TB, Loc))),
+
+                                      High_Bound =>
+                                        Convert_To (LLIB,
+                                          Make_Attribute_Reference (Loc,
+                                            Attribute_Name => Name_Last,
+                                            Prefix         =>
+                                              New_Occurrence_Of (TB, Loc))))),
+
                               Right_Opnd => Nin))))));
 
-               Insert_Actions (N, New_List (
-                 Make_Object_Declaration (Loc,
-                   Defining_Identifier => Bnn,
-                   Object_Definition   =>
-                     New_Occurrence_Of (Standard_Boolean, Loc)),
-                 Blk));
+               --  Now we can do the rewrite
 
-               Rewrite (N, New_Occurrence_Of (Bnn, Loc));
-               Analyze_And_Resolve (N);
+               Rewrite (N,
+                 Make_Expression_With_Actions (Loc,
+                   Actions    => New_List (
+                     Make_Object_Declaration (Loc,
+                       Defining_Identifier => Bnn,
+                       Object_Definition   =>
+                         New_Occurrence_Of (Result_Type, Loc)),
+                     Blk),
+                   Expression => New_Occurrence_Of (Bnn, Loc)));
+               Analyze_And_Resolve (N, Result_Type);
                return;
             end;
 
@@ -4030,11 +4077,15 @@ package body Exp_Ch4 is
          else
             pragma Assert (Base_Type (Etype (Lop)) = LLIB);
 
-            --  We rewrite the membership test as
+            --  We rewrite the membership test as (where T is the type with
+            --  the predicate, i.e. the type of the right operand)
 
-            --    Lop in T'Base and then T'Base (Lop) in T
+            --    Lop in LLIB (T'Base'First) .. LLIB (T'Base'Last)
+            --      and then T'Base (Lop) in T
 
             declare
+               T   : constant Entity_Id := Etype (Rop);
+               TB  : constant Entity_Id := Base_Type (T);
                Nin : Node_Id;
 
             begin
@@ -4042,24 +4093,32 @@ package body Exp_Ch4 is
 
                Nin :=
                  Make_In (Loc,
-                   Left_Opnd =>
-                     Convert_To (Base_Type (Etype (Rop)),
-                       Duplicate_Subexpr (Lop)),
-                   Right_Opnd => New_Occurrence_Of (Etype (Rop), Loc));
+                   Left_Opnd  => Convert_To (TB, Duplicate_Subexpr (Lop)),
+                   Right_Opnd => New_Occurrence_Of (T, Loc));
                Set_No_Minimize_Eliminate (Nin);
 
                --  Now do the rewrite
 
                Rewrite (N,
                  Make_And_Then (Loc,
-                   Left_Opnd =>
+                   Left_Opnd  =>
                      Make_In (Loc,
                        Left_Opnd  => Lop,
                        Right_Opnd =>
-                         New_Occurrence_Of (Base_Type (Etype (Lop)), Loc)),
+                         Make_Range (Loc,
+                           Low_Bound  =>
+                             Convert_To (LLIB,
+                               Make_Attribute_Reference (Loc,
+                                 Attribute_Name => Name_First,
+                                 Prefix => New_Occurrence_Of (TB, Loc))),
+                           High_Bound =>
+                             Convert_To (LLIB,
+                               Make_Attribute_Reference (Loc,
+                                 Attribute_Name => Name_Last,
+                                 Prefix => New_Occurrence_Of (TB, Loc))))),
                    Right_Opnd => Nin));
-
-               Analyze_And_Resolve (N, Restype, Suppress => All_Checks);
+               Set_Analyzed (N, False);
+               Analyze_And_Resolve (N, Restype);
             end;
          end if;
       end if;

diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 53ef628..6db86e1 100644 (file)
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -8459,6 +8459,8 @@ package body Exp_Disp is
          P     : Node_Id;
          Parms : List_Id;
 
+         Covers_Default_Constructor : Entity_Id := Empty;
+
       begin
          --  Look for the constructor entities
 
@@ -8490,7 +8492,8 @@ package body Exp_Disp is
                            Make_Defining_Identifier (Loc,
                              Chars (Defining_Identifier (P))),
                          Parameter_Type =>
-                           New_Copy_Tree (Parameter_Type (P))));
+                           New_Copy_Tree (Parameter_Type (P)),
+                         Expression => New_Copy_Tree (Expression (P))));
                      Next (P);
                   end loop;
                end if;
@@ -8508,6 +8511,17 @@ package body Exp_Disp is
                Set_Convention     (Init, Convention_CPP);
                Set_Is_Public      (Init);
                Set_Has_Completion (Init);
+
+               --  If this constructor has parameters and all its parameters
+               --  have defaults then it covers the default constructor. The
+               --  semantic analyzer ensures that only one constructor with
+               --  defaults covers the default constructor.
+
+               if Present (Parameter_Specifications (Parent (E)))
+                 and then Needs_No_Actuals (E)
+               then
+                  Covers_Default_Constructor := Init;
+               end if;
             end if;
 
             Next_Entity (E);
@@ -8519,6 +8533,49 @@ package body Exp_Disp is
          if not Found then
             Set_Is_Abstract_Type (Typ);
          end if;
+
+         --  Handle constructor that has all its parameters with defaults and
+         --  hence it covers the default constructor. We generate a wrapper IP
+         --  which calls the covering constructor.
+
+         if Present (Covers_Default_Constructor) then
+            declare
+               Body_Stmts        : List_Id;
+               Wrapper_Id        : Entity_Id;
+               Wrapper_Body_Node : Node_Id;
+            begin
+               Loc := Sloc (Covers_Default_Constructor);
+
+               Body_Stmts := New_List (
+                 Make_Procedure_Call_Statement (Loc,
+                   Name => New_Reference_To (Covers_Default_Constructor, Loc),
+                   Parameter_Associations => New_List (
+                     Make_Identifier (Loc, Name_uInit))));
+
+               Wrapper_Id := Make_Defining_Identifier (Loc,
+                 Make_Init_Proc_Name (Typ));
+
+               Wrapper_Body_Node :=
+                 Make_Subprogram_Body (Loc,
+                   Specification =>
+                     Make_Procedure_Specification (Loc,
+                       Defining_Unit_Name => Wrapper_Id,
+                       Parameter_Specifications => New_List (
+                         Make_Parameter_Specification (Loc,
+                           Defining_Identifier =>
+                             Make_Defining_Identifier (Loc, Name_uInit),
+                           Parameter_Type =>
+                             New_Reference_To (Typ, Loc)))),
+                   Declarations => No_List,
+                   Handled_Statement_Sequence =>
+                     Make_Handled_Sequence_Of_Statements (Loc,
+                       Statements => Body_Stmts,
+                       Exception_Handlers => No_List));
+
+               Discard_Node (Wrapper_Body_Node);
+               Set_Init_Proc (Typ, Wrapper_Id);
+            end;
+         end if;
       end Set_CPP_Constructors_Old;
 
       --  Local variables

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 4990f43..4988661 100644 (file)
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -5764,7 +5764,7 @@ package body Sem_Ch6 is
                     and then TSS_Name /= TSS_Stream_Output
                   then
                      --  Here we have a definite conformance error. It is worth
-                     --  special casesing the error message for the case of a
+                     --  special casing the error message for the case of a
                      --  controlling formal (which excludes null).
 
                      if Is_Controlling_Formal (New_Formal) then