diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 12 | ||||
| -rw-r--r-- | gcc/ada/a-cfdlli.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/g-socket.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/s-fileio.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.adb | 52 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 50 |
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. |