exp_util.adb: Minor code reorganization (use N_Short_Circuit)

2009-07-10  Robert Dewar  <dewar@adacore.com>

	* exp_util.adb: Minor code reorganization (use N_Short_Circuit)

	* exp_ch4.adb: Add ??? comment for conditional expressions on limited
	types.

	* checks.adb (In_Declarative_Region_Of_Subprogram_Body): New procedure,
	replaces Safe_To_Capture_In_Parameter_Value, and properly handles the
	case of conditional expressions that may not be elaborated.

	* sem_util.adb (Safe_To_Capture_Value): Properly handle case of
	conditional expression where we may not execute then then or else
	branches.

From-SVN: r149468

gcc/ada/ChangeLog

+2009-07-10  Robert Dewar  <dewar@adacore.com>
+
+	* exp_util.adb: Minor code reorganization (use N_Short_Circuit)
+
+	* exp_ch4.adb: Add ??? comment for conditional expressions on limited
+	types.
+
+	* checks.adb (In_Declarative_Region_Of_Subprogram_Body): New procedure,
+	replaces Safe_To_Capture_In_Parameter_Value, and properly handles the
+	case of conditional expressions that may not be elaborated.
+
+	* sem_util.adb (Safe_To_Capture_Value): Properly handle case of
+	conditional expression where we may not execute then then or else
+	branches.
+
 2009-07-10  Arnaud Charlet  <charlet@adacore.com>
 
 	* i-cexten.ads (bool): New type.

gcc/ada/checks.adb

@@ -5253,31 +5253,31 @@ package body Checks is
       Loc : constant Source_Ptr := Sloc (N);
       Typ : constant Entity_Id  := Etype (N);
 
-      function In_Declarative_Region_Of_Subprogram_Body return Boolean;
-      --  Determine whether node N, a reference to an *in* parameter, is
-      --  inside the declarative region of the current subprogram body.
+      function Safe_To_Capture_In_Parameter_Value return Boolean;
+      --  Determines if it is safe to capture Known_Non_Null status for an
+      --  the entity referenced by node N. The caller ensures that N is indeed
+      --  an entity name. It is safe to capture the non-null status for an IN
+      --  parameter when the reference occurs within a declaration that is sure
+      --  to be executed as part of the declarative region.
 
       procedure Mark_Non_Null;
       --  After installation of check, if the node in question is an entity
       --  name, then mark this entity as non-null if possible.
 
-      ----------------------------------------------
-      -- In_Declarative_Region_Of_Subprogram_Body --
-      ----------------------------------------------
-
-      function In_Declarative_Region_Of_Subprogram_Body return Boolean is
+      function Safe_To_Capture_In_Parameter_Value return Boolean is
          E     : constant Entity_Id := Entity (N);
          S     : constant Entity_Id := Current_Scope;
          S_Par : Node_Id;
 
       begin
-         pragma Assert (Ekind (E) = E_In_Parameter);
+         if Ekind (E) /= E_In_Parameter then
+            return False;
+         end if;
 
          --  Two initial context checks. We must be inside a subprogram body
          --  with declarations and reference must not appear in nested scopes.
 
-         if (Ekind (S) /= E_Function
-             and then Ekind (S) /= E_Procedure)
+         if (Ekind (S) /= E_Function and then Ekind (S) /= E_Procedure)
            or else Scope (E) /= S
          then
             return False;
@@ -5303,6 +5303,26 @@ package body Checks is
             N_Decl := Empty;
             while Present (P) loop
 
+               --  If we have a short circuit form, and we are within the right
+               --  hand expression, we return false, since the right hand side
+               --  is not guaranteed to be elaborated.
+
+               if Nkind (P) in N_Short_Circuit
+                 and then N = Right_Opnd (P)
+               then
+                  return False;
+               end if;
+
+               --  Similarly, if we are in a conditional expression and not
+               --  part of the condition, then we return False, since neither
+               --  the THEN or ELSE expressions will always be elaborated.
+
+               if Nkind (P) = N_Conditional_Expression
+                 and then N /= First (Expressions (P))
+               then
+                  return False;
+               end if;
+
                --  While traversing the parent chain, we find that N
                --  belongs to a statement, thus it may never appear in
                --  a declarative region.
@@ -5313,6 +5333,8 @@ package body Checks is
                   return False;
                end if;
 
+               --  If we are at a declaration, record it and exit
+
                if Nkind (P) in N_Declaration
                  and then Nkind (P) not in N_Subprogram_Specification
                then
@@ -5329,7 +5351,7 @@ package body Checks is
 
             return List_Containing (N_Decl) = Declarations (S_Par);
          end;
-      end In_Declarative_Region_Of_Subprogram_Body;
+      end Safe_To_Capture_In_Parameter_Value;
 
       -------------------
       -- Mark_Non_Null --
@@ -5350,13 +5372,14 @@ package body Checks is
             --  safe to capture the value, or in the case of an IN parameter,
             --  which is a constant, if the check we just installed is in the
             --  declarative region of the subprogram body. In this latter case,
-            --  a check is decisive for the rest of the body, since we know we
-            --  must complete all declarations before executing the body.
+            --  a check is decisive for the rest of the body if the expression
+            --  is sure to be elaborated, since we know we have to elaborate
+            --  all declarations before executing the body.
+
+            --  Couldn't this always be part of Safe_To_Capture_Value ???
 
             if Safe_To_Capture_Value (N, Entity (N))
-              or else
-                (Ekind (Entity (N)) = E_In_Parameter
-                   and then In_Declarative_Region_Of_Subprogram_Body)
+              or else Safe_To_Capture_In_Parameter_Value
             then
                Set_Is_Known_Non_Null (Entity (N));
             end if;

gcc/ada/exp_ch4.adb

@@ -3987,8 +3987,7 @@ package body Exp_Ch4 is
 
          else pragma Assert (Expr_Value_E (Right) = Standard_False);
             Remove_Side_Effects (Left);
-            Rewrite
-              (N, New_Occurrence_Of (Standard_False, Loc));
+            Rewrite (N, New_Occurrence_Of (Standard_False, Loc));
          end if;
       end if;
 
@@ -4028,6 +4027,21 @@ package body Exp_Ch4 is
 
       --  and replace the conditional expression by a reference to Cnn
 
+      --  ??? Note: this expansion is wrong for limited types, since it does
+      --  a copy of a limited value. The proper fix would be to do the
+      --  following expansion:
+
+      --      Cnn : access typ;
+      --      if cond then
+      --         <<then actions>>
+      --         Cnn := then-expr'Unrestricted_Access;
+      --      else
+      --         <<else actions>>
+      --         Cnn := else-expr'Unrestricted_Access;
+      --      end if;
+
+      --  and replace the conditional expresion by a reference to Cnn.all ???
+
       if Present (Then_Actions (N)) or else Present (Else_Actions (N)) then
          Cnn := Make_Defining_Identifier (Loc, New_Internal_Name ('C'));
 

gcc/ada/exp_util.adb

@@ -255,9 +255,8 @@ package body Exp_Util is
             --  to reset its type, since Standard.Boolean is just fine, and
             --  such operations always do Adjust_Condition on their operands.
 
-            elsif KP in N_Op_Boolean
-              or else KP = N_And_Then
-              or else KP = N_Or_Else
+            elsif     KP in N_Op_Boolean
+              or else KP in N_Short_Circuit
               or else KP = N_Op_Not
             then
                return;
@@ -2305,7 +2304,7 @@ package body Exp_Util is
             --  Nothing special needs to be done for the left operand since
             --  in that case the actions are executed unconditionally.
 
-            when N_And_Then | N_Or_Else =>
+            when N_Short_Circuit =>
                if N = Right_Opnd (P) then
 
                   --  We are now going to either append the actions to the
@@ -4395,12 +4394,10 @@ package body Exp_Util is
             --  are side effect free. For this purpose binary operators
             --  include membership tests and short circuit forms
 
-            when N_Binary_Op       |
-                 N_Membership_Test |
-                 N_And_Then        |
-                 N_Or_Else         =>
+            when N_Binary_Op | N_Membership_Test | N_Short_Circuit =>
                return Side_Effect_Free (Left_Opnd  (N))
-                 and then Side_Effect_Free (Right_Opnd (N));
+                        and then
+                      Side_Effect_Free (Right_Opnd (N));
 
             --  An explicit dereference is side effect free only if it is
             --  a side effect free prefixed reference.

gcc/ada/sem_util.adb

@@ -7155,7 +7155,7 @@ package body Sem_Util is
          when N_Assignment_Statement =>
             return N = Name (P);
 
-            --  Function call arguments are never lvalues
+            --  Function call arguments are never Lvalues
 
          when N_Function_Call =>
             return False;
@@ -7241,7 +7241,7 @@ package body Sem_Util is
             end;
 
          --  Test for appearing in a conversion that itself appears
-         --  in an lvalue context, since this should be an lvalue.
+         --  in an Lvalue context, since this should be an Lvalue.
 
          when N_Type_Conversion =>
             return Known_To_Be_Assigned (P);
@@ -7276,8 +7276,8 @@ package body Sem_Util is
             return N = Prefix (P)
               and then Name_Implies_Lvalue_Prefix (Attribute_Name (P));
 
-         --  For an expanded name, the name is an lvalue if the expanded name
-         --  is an lvalue, but the prefix is never an lvalue, since it is just
+         --  For an expanded name, the name is an Lvalue if the expanded name
+         --  is an Lvalue, but the prefix is never an Lvalue, since it is just
          --  the scope where the name is found.
 
          when N_Expanded_Name        =>
@@ -7304,7 +7304,7 @@ package body Sem_Util is
             end if;
 
          --  For an indexed component or slice, the index or slice bounds is
-         --  never an Lvalue. The prefix is an lvalue if the indexed component
+         --  never an Lvalue. The prefix is an Lvalue if the indexed component
          --  or slice is an Lvalue, except if it is an access type, where we
          --  have an implicit dereference.
 
@@ -7414,7 +7414,7 @@ package body Sem_Util is
             end;
 
          --  Test for appearing in a conversion that itself appears in an
-         --  lvalue context, since this should be an lvalue.
+         --  Lvalue context, since this should be an Lvalue.
 
          when N_Type_Conversion =>
             return May_Be_Lvalue (P);
@@ -9819,10 +9819,12 @@ package body Sem_Util is
 
          P := Parent (N);
          while Present (P) loop
-            if Nkind (P) = N_If_Statement
+            if         Nkind (P) = N_If_Statement
               or else  Nkind (P) = N_Case_Statement
-              or else (Nkind (P) = N_And_Then and then Desc = Right_Opnd (P))
-              or else (Nkind (P) = N_Or_Else and then Desc = Right_Opnd (P))
+              or else (Nkind (P) in N_Short_Circuit
+                         and then Desc = Right_Opnd (P))
+              or else (Nkind (P) = N_Conditional_Expression
+                         and then Desc /= First (Expressions (P)))
               or else  Nkind (P) = N_Exception_Handler
               or else  Nkind (P) = N_Selective_Accept
               or else  Nkind (P) = N_Conditional_Entry_Call