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.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@197905 138bc75d-0d04-0410-961f-82ee72b054a4

6 files changed, 114 insertions, 14 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 197627802ea..0f68e478b2f 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 994589fec5f..1078c1f5a34 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 8079e80b0bd..e186258805a 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 32f0c90e101..64b89926753 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 4b1845ae930..88800127003 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 fd675966cf9..230e44bbc40 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.