aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2013-04-12 15:04:59 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2013-04-12 15:04:59 +0200
commit2eb87017420b4608b8540c46f329cf9c264e1c39 (patch)
tree1f32cbed376b2fe44e39b273fd884713fced3dcb /gcc/ada
parent9686dbc79e2904ce4047003d78e30c7056321151 (diff)
downloadgcc-2eb87017420b4608b8540c46f329cf9c264e1c39.zip
gcc-2eb87017420b4608b8540c46f329cf9c264e1c39.tar.gz
gcc-2eb87017420b4608b8540c46f329cf9c264e1c39.tar.bz2
[multiple changes]
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. From-SVN: r197905
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog12
-rw-r--r--gcc/ada/a-cfdlli.ads6
-rw-r--r--gcc/ada/g-socket.adb4
-rw-r--r--gcc/ada/s-fileio.adb4
-rw-r--r--gcc/ada/sem_attr.adb52
-rw-r--r--gcc/ada/sem_prag.adb50
6 files changed, 114 insertions, 14 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1976278..0f68e47 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,17 @@
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.
diff --git a/gcc/ada/a-cfdlli.ads b/gcc/ada/a-cfdlli.ads
index 994589f..1078c1f 100644
--- a/gcc/ada/a-cfdlli.ads
+++ b/gcc/ada/a-cfdlli.ads
@@ -49,11 +49,7 @@
-- 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;
diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb
index 8079e80..e186258 100644
--- a/gcc/ada/g-socket.adb
+++ b/gcc/ada/g-socket.adb
@@ -733,7 +733,9 @@ package body GNAT.Sockets is
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;
diff --git a/gcc/ada/s-fileio.adb b/gcc/ada/s-fileio.adb
index 32f0c90..64b8992 100644
--- a/gcc/ada/s-fileio.adb
+++ b/gcc/ada/s-fileio.adb
@@ -696,8 +696,8 @@ package body System.File_IO is
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 =>
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 4b1845a..8880012 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -4262,7 +4262,7 @@ package body Sem_Attr is
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,
@@ -4302,6 +4302,30 @@ package body Sem_Attr is
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;
@@ -4654,7 +4678,7 @@ package body Sem_Attr is
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,
@@ -4695,6 +4719,30 @@ package body Sem_Attr is
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",
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index fd67596..230e44b 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -248,6 +248,31 @@ package body Sem_Prag is
------------------------------
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.
@@ -258,10 +283,27 @@ package body Sem_Prag is
-- 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.