* a-cfdlli.ads, g-socket.adb, s-fileio.adb: Minor reformatting.
2013-04-12 Yannick Moy <moy@adacore.com>
* sem_attr.adb (Analyze_Attribute): Update analyse of
Attribute_Old and Attribute_Result so they are allowed in the
right-hand-side of an association in a Contract_Cases pragma.
* sem_prag.adb (Analyze_CTC_In_Decl_Part): Add pre-analysis of
the expressions in a Contract_Cases pragma.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@197905
138bc75d-0d04-0410-961f-
82ee72b054a4
2013-04-12 Robert Dewar <dewar@adacore.com>
+ * a-cfdlli.ads, g-socket.adb, s-fileio.adb: Minor reformatting.
+
+2013-04-12 Yannick Moy <moy@adacore.com>
+
+ * sem_attr.adb (Analyze_Attribute): Update analyse of
+ Attribute_Old and Attribute_Result so they are allowed in the
+ right-hand-side of an association in a Contract_Cases pragma.
+ * sem_prag.adb (Analyze_CTC_In_Decl_Part): Add pre-analysis of
+ the expressions in a Contract_Cases pragma.
+
+2013-04-12 Robert Dewar <dewar@adacore.com>
+
* sem.ads, opt.ads: Minor comment edits.
* sem_warn.adb, sem_ch6.adb: Minor reformatting.
-- function Left (Container : List; Position : Cursor) return List;
-- function Right (Container : List; Position : Cursor) return List;
--- See detailed specifications for these subprograms
-
--- private with Ada.Streams;
--- private with Ada.Finalization;
--- with Ada.Iterator_Interfaces;
+-- See subprogram specifications that follow for details
generic
type Element_Type is private;
end if;
end if;
- -- Wait for socket to become available for writing
+ -- Wait for socket to become available for writing (unless the Timeout
+ -- is zero, in which case we consider that it has already expired, and
+ -- we do not need to wait at all).
if Timeout = 0.0 then
Status := Expired;
Klen := KImage'Length;
To_Lower (KImage);
- if Index + Klen - 1 <= Form'Last and then
- Form (Index .. Index + Klen - 1) = KImage
+ if Index + Klen - 1 <= Form'Last
+ and then Form (Index .. Index + Klen - 1) = KImage
then
case Parm is
when Force_Record_Mode =>
if In_Spec_Expression then
- -- Check in postcondition or Ensures clause
+ -- Check in postcondition, Test_Case or Contract_Cases
Prag := N;
while not Nkind_In (Prag, N_Pragma,
end if;
end;
+ elsif Get_Pragma_Id (Prag) = Pragma_Contract_Cases then
+ declare
+ Aggr : constant Node_Id :=
+ Expression (First (Pragma_Argument_Associations (Prag)));
+ Arg : Node_Id;
+
+ begin
+ Arg := N;
+ while Arg /= Prag and Parent (Parent (Arg)) /= Aggr loop
+ Arg := Parent (Arg);
+ end loop;
+
+ -- At this point, Parent (Arg) should be a
+ -- N_Component_Association. Attribute Old is only allowed in
+ -- the expression part of this association.
+
+ if Nkind (Parent (Arg)) /= N_Component_Association
+ or else Arg /= Expression (Parent (Arg))
+ then
+ Error_Attr
+ ("% attribute misplaced inside contract cases", P);
+ end if;
+ end;
+
elsif Get_Pragma_Id (Prag) /= Pragma_Postcondition then
Error_Attr ("% attribute can only appear in postcondition", P);
end if;
Error_Attr;
end if;
- -- Check in postcondition or Ensures clause of function
+ -- Check in postcondition, Test_Case or Contract_Cases of function
Prag := N;
while not Nkind_In (Prag, N_Pragma,
end if;
end;
+ elsif Get_Pragma_Id (Prag) = Pragma_Contract_Cases then
+ declare
+ Aggr : constant Node_Id :=
+ Expression (First (Pragma_Argument_Associations (Prag)));
+ Arg : Node_Id;
+
+ begin
+ Arg := N;
+ while Arg /= Prag and Parent (Parent (Arg)) /= Aggr loop
+ Arg := Parent (Arg);
+ end loop;
+
+ -- At this point, Parent (Arg) should be a
+ -- N_Component_Association. Attribute Result is only
+ -- allowed in the expression part of this association.
+
+ if Nkind (Parent (Arg)) /= N_Component_Association
+ or else Arg /= Expression (Parent (Arg))
+ then
+ Error_Attr
+ ("% attribute misplaced inside contract cases", P);
+ end if;
+ end;
+
elsif Get_Pragma_Id (Prag) /= Pragma_Postcondition then
Error_Attr
("% attribute can only appear in postcondition of function",
------------------------------
procedure Analyze_CTC_In_Decl_Part (N : Node_Id; S : Entity_Id) is
+
+ procedure Analyze_Contract_Cases (Aggr : Node_Id);
+ -- Pre-analyze the guard and consequence expressions of a Contract_Cases
+ -- pragma/aspect aggregate expression.
+
+ procedure Analyze_Contract_Cases (Aggr : Node_Id) is
+ Case_Guard : Node_Id;
+ Conseq : Node_Id;
+ Post_Case : Node_Id;
+ begin
+ Post_Case := First (Component_Associations (Aggr));
+ while Present (Post_Case) loop
+ Case_Guard := First (Choices (Post_Case));
+ Conseq := Expression (Post_Case);
+
+ -- Preanalyze the boolean expression, we treat this as a spec
+ -- expression (i.e. similar to a default expression).
+
+ Preanalyze_Assert_Expression (Case_Guard, Standard_Boolean);
+ Preanalyze_Assert_Expression (Conseq, Standard_Boolean);
+
+ Next (Post_Case);
+ end loop;
+ end Analyze_Contract_Cases;
+
begin
-- Install formals and push subprogram spec onto scope stack so that we
-- can see the formals from the pragma.
-- Preanalyze the boolean expressions, we treat these as spec
-- expressions (i.e. similar to a default expression).
- Preanalyze_CTC_Args
- (N,
- Get_Requires_From_CTC_Pragma (N),
- Get_Ensures_From_CTC_Pragma (N));
+ if Pragma_Name (N) = Name_Test_Case
+ or else Pragma_Name (N) = Name_Contract_Case
+ then
+ Preanalyze_CTC_Args
+ (N,
+ Get_Requires_From_CTC_Pragma (N),
+ Get_Ensures_From_CTC_Pragma (N));
+
+ elsif Pragma_Name (N) = Name_Contract_Cases then
+ Analyze_Contract_Cases
+ (Expression (First (Pragma_Argument_Associations (N))));
+
+ -- In ASIS mode, for a pragma generated from a source aspect, also
+ -- analyze the original aspect expression.
+
+ if ASIS_Mode
+ and then Present (Corresponding_Aspect (N))
+ then
+ Analyze_Contract_Cases (Expression (Corresponding_Aspect (N)));
+ end if;
+ end if;
-- Remove the subprogram from the scope stack now that the pre-analysis
-- of the expressions in the contract case or test case is done.
OSDN Git Service
