exp_ch4.adb (Expand_Concatenate): Remove wrapping in expression-with-actions node.

2013-04-11  Robert Dewar  <dewar@adacore.com>

	* exp_ch4.adb (Expand_Concatenate): Remove wrapping in
	expression-with-actions node. No longer needed given fix to
	sem_prag and caused loss of some useful warnings.
	* sem.ads: Minor reformatting.
	* sem_prag.adb (Check_Disabled): Removed, to be replaced by not
	Check_Enabled. These two routines were curiously incompatible
	causing confusion.
	(Analyze_Pragma, case Check): Make sure we do
	not expand the string argument if the check is disabled. Avoid
	use of Check_Disabled, which resulted in missing analysis in
	some cases.
	* sem_prag.ads (Check_Disabled): Removed, to be replaced by not
	Check_Enabled. These two routines were curiously incompatible
	causing confusion.

From-SVN: r197761

gcc/ada/ChangeLog

+2013-04-11  Robert Dewar  <dewar@adacore.com>
+
+	* exp_ch4.adb (Expand_Concatenate): Remove wrapping in
+	expression-with-actions node. No longer needed given fix to
+	sem_prag and caused loss of some useful warnings.
+	* sem.ads: Minor reformatting.
+	* sem_prag.adb (Check_Disabled): Removed, to be replaced by not
+	Check_Enabled. These two routines were curiously incompatible
+	causing confusion.
+	(Analyze_Pragma, case Check): Make sure we do
+	not expand the string argument if the check is disabled. Avoid
+	use of Check_Disabled, which resulted in missing analysis in
+	some cases.
+	* sem_prag.ads (Check_Disabled): Removed, to be replaced by not
+	Check_Enabled. These two routines were curiously incompatible
+	causing confusion.
+
 2013-04-11  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* exp_ch4.adb (Process_Transient_Object): Use

gcc/ada/exp_ch4.adb

@@ -6796,27 +6796,7 @@ package body Exp_Ch4 is
             Append (Right_Opnd (Cnode), Opnds);
          end loop Inner;
 
-         --  Wrap the node to concatenate into an expression actions node to
-         --  keep it nicely packaged. This is useful in the case of an assert
-         --  pragma with a concatenation where we want to be able to delete
-         --  the concatenation and all its expansion stuff.
-
-         declare
-            Cnod : constant Node_Id   := Relocate_Node (Cnode);
-            Typ  : constant Entity_Id := Base_Type (Etype (Cnode));
-
-         begin
-            --  Note: use Rewrite rather than Replace here, so that for example
-            --  Why_Not_Static can find the original concatenation node OK!
-
-            Rewrite (Cnode,
-              Make_Expression_With_Actions (Sloc (Cnode),
-                Actions    => New_List (Make_Null_Statement (Sloc (Cnode))),
-                Expression => Cnod));
-
-            Expand_Concatenate (Cnod, Opnds);
-            Analyze_And_Resolve (Cnode, Typ);
-         end;
+         Expand_Concatenate (Cnode, Opnds);
 
          exit Outer when Cnode = N;
          Cnode := Parent (Cnode);
@@ -11397,7 +11377,6 @@ package body Exp_Ch4 is
 
       function Is_Checked_Storage_Pool (P : Entity_Id) return Boolean is
          T : Entity_Id;
-
       begin
          if No (P) then
             return False;

gcc/ada/sem.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -177,7 +177,7 @@
 --  repeatedly (for instance in the above aggregate "new Thing (Function_Call)"
 --  needs to be called 100 times.)
 
---  The reason why this mechanism does not work is that, the expanded code for
+--  The reason why this mechanism does not work is that the expanded code for
 --  the children is typically inserted above the parent and thus when the
 --  father gets expanded no re-evaluation takes place. For instance in the case
 --  of aggregates if "new Thing (Function_Call)" is expanded before of the

gcc/ada/sem_prag.adb

@@ -7833,6 +7833,7 @@ package body Sem_Prag is
             Expr  : Node_Id;
             Eloc  : Source_Ptr;
             Cname : Name_Id;
+            Str   : Node_Id;
 
             Check_On : Boolean;
             --  Set True if category of assertions referenced by Name enabled
@@ -7846,21 +7847,15 @@ package body Sem_Prag is
 
             if Arg_Count = 3 then
                Check_Optional_Identifier (Arg3, Name_Message);
-               Analyze_And_Resolve (Get_Pragma_Arg (Arg3), Standard_String);
+               Str := Get_Pragma_Arg (Arg3);
             end if;
 
             Check_Arg_Is_Identifier (Arg1);
-
-            --  Completely ignore if disabled
-
-            if Check_Disabled (Chars (Get_Pragma_Arg (Arg1))) then
-               Rewrite (N, Make_Null_Statement (Loc));
-               Analyze (N);
-               return;
-            end if;
-
             Cname := Chars (Get_Pragma_Arg (Arg1));
             Check_On := Check_Enabled (Cname);
+            Expr := Get_Pragma_Arg (Arg2);
+
+            --  Deal with SCO generation
 
             case Cname is
                when Name_Predicate |
@@ -7882,28 +7877,52 @@ package body Sem_Prag is
                   end if;
             end case;
 
-            --  If expansion is active and the check is not enabled then we
-            --  rewrite the Check as:
+            --  Deal with analyzing the string argument.
+
+            if Arg_Count = 3 then
+
+               --  If checks are not on we don't want any expansion (since
+               --  such expansion would not get properly deleted) but
+               --  we do want to analyze (to get proper references).
+               --  The Preanalyze_And_Resolve routine does just what we want
+
+               if not Check_On then
+                  Preanalyze_And_Resolve (Str, Standard_String);
+
+                  --  Otherwise we need a proper analysis and expansion
+
+               else
+                  Analyze_And_Resolve (Str, Standard_String);
+               end if;
+            end if;
+
+            --  Now you might think we could just do the same with the
+            --  Boolean expression if checks are off (and expansion is on)
+            --  and then rewrite the check as a null
+            --  statement. This would work but we would lose the useful
+            --  warnings about an assertion being bound to fail even if
+            --  assertions are turned off.
+
+            --  So instead we wrap the boolean expression in an if statement
+            --  that looks like:
 
             --    if False and then condition then
             --       null;
             --    end if;
 
-            --  The reason we do this rewriting during semantic analysis rather
-            --  than as part of normal expansion is that we cannot analyze and
-            --  expand the code for the boolean expression directly, or it may
-            --  cause insertion of actions that would escape the attempt to
-            --  suppress the check code.
+            --  The reason we do this rewriting during semantic analysis
+            --  rather than as part of normal expansion is that we cannot
+            --  analyze and expand the code for the boolean expression
+            --  directly, or it may cause insertion of actions that would
+            --  escape the attempt to suppress the check code.
 
             --  Note that the Sloc for the if statement corresponds to the
-            --  argument condition, not the pragma itself. The reason for this
-            --  is that we may generate a warning if the condition is False at
-            --  compile time, and we do not want to delete this warning when we
-            --  delete the if statement.
+            --  argument condition, not the pragma itself. The reason for
+            --  this is that we may generate a warning if the condition is
+            --  False at compile time, and we do not want to delete this
+            --  warning when we delete the if statement.
 
-            Expr := Get_Pragma_Arg (Arg2);
-
-            if Expander_Active and then not Check_On then
+            if Expander_Active and not Check_On then
                Eloc := Sloc (Expr);
 
                Rewrite (N,
@@ -7915,9 +7934,12 @@ package body Sem_Prag is
                    Then_Statements => New_List (
                      Make_Null_Statement (Eloc))));
 
+               In_Assertion_Expr := In_Assertion_Expr + 1;
                Analyze (N);
+               In_Assertion_Expr := In_Assertion_Expr - 1;
 
-            --  Check is active
+            --  Check is active or expansion not active. In these cases we can
+            --  just go ahead and analyze the boolean with no worries.
 
             else
                In_Assertion_Expr := In_Assertion_Expr + 1;
@@ -8314,7 +8336,7 @@ package body Sem_Prag is
 
             --  Completely ignore if disabled
 
-            if Check_Disabled (Pname) then
+            if not Check_Enabled (Pname) then
                Rewrite (N, Make_Null_Statement (Loc));
                Analyze (N);
                return;
@@ -12401,7 +12423,7 @@ package body Sem_Prag is
 
             --  Completely ignore if disabled
 
-            if Check_Disabled (Pname) then
+            if not Check_Enabled (Pname) then
                Rewrite (N, Make_Null_Statement (Loc));
                Analyze (N);
                return;
@@ -12474,7 +12496,7 @@ package body Sem_Prag is
 
             --  Completely ignore if disabled
 
-            if Check_Disabled (Pname) then
+            if not Check_Enabled (Pname) then
                Rewrite (N, Make_Null_Statement (Loc));
                Analyze (N);
                return;
@@ -16390,40 +16412,6 @@ package body Sem_Prag is
       when Pragma_Exit => null;
    end Analyze_Pragma;
 
-   --------------------
-   -- Check_Disabled --
-   --------------------
-
-   function Check_Disabled (Nam : Name_Id) return Boolean is
-      PP : Node_Id;
-
-   begin
-      --  Loop through entries in check policy list
-
-      PP := Opt.Check_Policy_List;
-      loop
-         --  If there are no specific entries that matched, then nothing is
-         --  disabled, so return False.
-
-         if No (PP) then
-            return False;
-
-         --  Here we have an entry see if it matches
-
-         else
-            declare
-               PPA : constant List_Id := Pragma_Argument_Associations (PP);
-            begin
-               if Nam = Chars (Get_Pragma_Arg (First (PPA))) then
-                  return Chars (Get_Pragma_Arg (Last (PPA))) = Name_Disable;
-               else
-                  PP := Next_Pragma (PP);
-               end if;
-            end;
-         end if;
-      end loop;
-   end Check_Disabled;
-
    -------------------
    -- Check_Enabled --
    -------------------
@@ -16455,7 +16443,7 @@ package body Sem_Prag is
                   case (Chars (Get_Pragma_Arg (Last (PPA)))) is
                      when Name_On | Name_Check =>
                         return True;
-                     when Name_Off | Name_Ignore =>
+                     when Name_Off | Name_Disable | Name_Ignore =>
                         return False;
                      when others =>
                         raise Program_Error;

gcc/ada/sem_prag.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -54,13 +54,6 @@ package Sem_Prag is
    --  of the expressions in the pragma as "spec expressions" (see section
    --  in Sem "Handling of Default and Per-Object Expressions...").
 
-   function Check_Disabled (Nam : Name_Id) return Boolean;
-   --  This function is used in connection with pragmas Assertion, Check,
-   --  Precondition, and Postcondition, to determine if Check pragmas (or
-   --  corresponding Assert, Precondition, or Postcondition pragmas) are
-   --  currently disabled (as set by a Check_Policy or Assertion_Policy pragma
-   --  with the Disable argument).
-
    function Check_Enabled (Nam : Name_Id) return Boolean;
    --  This function is used in connection with pragmas Assertion, Check,
    --  Precondition, and Postcondition, to determine if Check pragmas (or