Index: sem_prag.adb =================================================================== --- sem_prag.adb (revision 197760) +++ sem_prag.adb (working copy) @@ -7833,6 +7833,7 @@ 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,22 +7847,16 @@ 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 | Name_Invariant => @@ -7882,28 +7877,52 @@ 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 @@ 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 @@ -- 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 @@ -- 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 @@ -- 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 @@ 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 @@ 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; Index: sem_prag.ads =================================================================== --- sem_prag.ads (revision 197743) +++ sem_prag.ads (working copy) @@ -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 @@ -- 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 Index: sem.ads =================================================================== --- sem.ads (revision 197743) +++ sem.ads (working copy) @@ -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 Index: exp_ch4.adb =================================================================== --- exp_ch4.adb (revision 197760) +++ exp_ch4.adb (working copy) @@ -6796,28 +6796,8 @@ 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. + Expand_Concatenate (Cnode, Opnds); - 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; - exit Outer when Cnode = N; Cnode := Parent (Cnode); end loop Outer; @@ -11397,7 +11377,6 @@ function Is_Checked_Storage_Pool (P : Entity_Id) return Boolean is T : Entity_Id; - begin if No (P) then return False;