+2012-03-15 Vincent Pucci <pucci@adacore.com>
+
+ * sem_ch4.adb (Analyze_Quantified_Expression):
+ Preanalyze the condition when the quantified expression will be
+ further expanded.
+
+2012-03-15 Yannick Moy <moy@adacore.com>
+
+ * sem_prag.adb, sem_util.adb, sem_util.ads, sem_attr.adb, sem_ch6.adb,
+ sem_warn.adb: Minor refactoring, renaming Case_Pragma in CTC_Pragma,
+ to refer to both Test_Case pragma and Contract_Case pragma (same
+ acronym as in Spec_CTC_List).
+
2012-03-15 Robert Dewar <dewar@adacore.com>
* sem_prag.adb, sem_prag.ads, sem_util.ads, sem_attr.adb, sem_ch6.adb,
then
declare
Arg_Ens : constant Node_Id :=
- Get_Ensures_From_Case_Pragma (Prag);
+ Get_Ensures_From_CTC_Pragma (Prag);
Arg : Node_Id;
begin
with Einfo; use Einfo;
with Elists; use Elists;
with Errout; use Errout;
+with Expander; use Expander;
with Exp_Util; use Exp_Util;
with Fname; use Fname;
with Itypes; use Itypes;
Set_Parent (Iterator_Specification (Iterator), Iterator);
end if;
- Analyze (Condition (N));
+ if Needs_Expansion then
+
+ -- The full analysis will be performed during the expansion of the
+ -- quantified expression, only a preanalysis of the condition needs
+ -- to be done.
+
+ Expander_Mode_Save_And_Set (False);
+ Analyze (Condition (N));
+ Expander_Mode_Restore;
+ else
+ Analyze (Condition (N));
+ end if;
+
End_Scope;
Set_Etype (N, Standard_Boolean);
loop
-- Retrieve the Ensures component of the contract-case, if any
- Arg := Get_Ensures_From_Case_Pragma (Prag);
+ Arg := Get_Ensures_From_CTC_Pragma (Prag);
if Pragma_Name (Prag) = Name_Contract_Case then
-- Copy the Requires and Ensures expressions
Req := New_Copy_Tree
- (Expression (Get_Requires_From_Case_Pragma (Prag)),
+ (Expression (Get_Requires_From_CTC_Pragma (Prag)),
New_Scope => Current_Scope);
Ens := New_Copy_Tree
- (Expression (Get_Ensures_From_Case_Pragma (Prag)),
+ (Expression (Get_Ensures_From_CTC_Pragma (Prag)),
New_Scope => Current_Scope);
-- Build the postcondition (not Requires'Old or else Ensures)
Preanalyze_CTC_Args
(N,
- Get_Requires_From_Case_Pragma (N),
- Get_Ensures_From_Case_Pragma (N));
+ Get_Requires_From_CTC_Pragma (N),
+ Get_Ensures_From_CTC_Pragma (N));
-- Remove the subprogram from the scope stack now that the pre-analysis
-- of the expressions in the contract case or test case is done.
-- same name associated to this subprogram.
declare
- Name : constant String_Id := Get_Name_From_Case_Pragma (N);
+ Name : constant String_Id := Get_Name_From_CTC_Pragma (N);
CTC : Node_Id;
begin
CTC := Spec_CTC_List (Contract (S));
while Present (CTC) loop
- if String_Equal (Name, Get_Name_From_Case_Pragma (CTC)) then
+ if String_Equal (Name, Get_Name_From_CTC_Pragma (CTC)) then
Error_Msg_Sloc := Sloc (CTC);
Error_Pragma ("name for pragma% is already used#");
end if;
end if;
end Get_Enum_Lit_From_Pos;
- ----------------------------------
- -- Get_Ensures_From_Case_Pragma --
- ----------------------------------
+ ---------------------------------
+ -- Get_Ensures_From_CTC_Pragma --
+ ---------------------------------
- function Get_Ensures_From_Case_Pragma (N : Node_Id) return Node_Id is
+ function Get_Ensures_From_CTC_Pragma (N : Node_Id) return Node_Id is
Args : constant List_Id := Pragma_Argument_Associations (N);
Res : Node_Id;
end if;
return Res;
- end Get_Ensures_From_Case_Pragma;
+ end Get_Ensures_From_CTC_Pragma;
------------------------
-- Get_Generic_Entity --
return Entity_Id (Get_Name_Table_Info (Id));
end Get_Name_Entity_Id;
- -------------------------------
- -- Get_Name_From_Case_Pragma --
- -------------------------------
+ ------------------------------
+ -- Get_Name_From_CTC_Pragma --
+ ------------------------------
- function Get_Name_From_Case_Pragma (N : Node_Id) return String_Id is
+ function Get_Name_From_CTC_Pragma (N : Node_Id) return String_Id is
Arg : constant Node_Id :=
Get_Pragma_Arg (First (Pragma_Argument_Associations (N)));
begin
return Strval (Expr_Value_S (Arg));
- end Get_Name_From_Case_Pragma;
+ end Get_Name_From_CTC_Pragma;
-------------------
-- Get_Pragma_Id --
return R;
end Get_Renamed_Entity;
- -----------------------------------
- -- Get_Requires_From_Case_Pragma --
- -----------------------------------
+ ----------------------------------
+ -- Get_Requires_From_CTC_Pragma --
+ ----------------------------------
- function Get_Requires_From_Case_Pragma (N : Node_Id) return Node_Id is
+ function Get_Requires_From_CTC_Pragma (N : Node_Id) return Node_Id is
Args : constant List_Id := Pragma_Argument_Associations (N);
Res : Node_Id;
end if;
return Res;
- end Get_Requires_From_Case_Pragma;
+ end Get_Requires_From_CTC_Pragma;
-------------------------
-- Get_Subprogram_Body --
-- If expression N references a part of an object, return this object.
-- Otherwise return Empty. Expression N should have been resolved already.
- function Get_Ensures_From_Case_Pragma (N : Node_Id) return Node_Id;
+ function Get_Ensures_From_CTC_Pragma (N : Node_Id) return Node_Id;
-- Return the Ensures component of Contract_Case or Test_Case pragma N, or
-- Empty otherwise.
-- is the innermost visible entity with the given name. See the body of
-- Sem_Ch8 for further details on handling of entity visibility.
- function Get_Name_From_Case_Pragma (N : Node_Id) return String_Id;
+ function Get_Name_From_CTC_Pragma (N : Node_Id) return String_Id;
-- Return the Name component of Contract_Case or Test_Case pragma N
- -- Bad name, Case_Pragma is meaningless to me ???
function Get_Pragma_Id (N : Node_Id) return Pragma_Id;
pragma Inline (Get_Pragma_Id);
-- not a renamed entity, returns its argument. It is an error to call this
-- with any other kind of entity.
- function Get_Requires_From_Case_Pragma (N : Node_Id) return Node_Id;
+ function Get_Requires_From_CTC_Pragma (N : Node_Id) return Node_Id;
-- Return the Requires component of Contract_Case or Test_Case pragma N, or
-- Empty otherwise.
or else
Pragma_Name (P) = Name_Test_Case)
and then
- Nod = Get_Ensures_From_Case_Pragma (P)
+ Nod = Get_Ensures_From_CTC_Pragma (P)
then
return True;
end if;
projects / gcc.git / commitdiff