ada: Accept aspect Always_Terminates on packages

The recently added aspect Always_Terminates is now allowed on packages
and generic packages, but only when it has no arguments. The intuitive
meaning is that all subprograms declared in such a package are always
terminating.

gcc/ada/

	* contracts.adb (Add_Contract_Item): Add pragma Always_Terminates to
	package contract.
	* sem_prag.adb (Analyze_Pragma): Accept pragma Always_Terminates on
	packages and generic packages, but only when it has no arguments.

diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb
index 0e87cee3ef50376c92344d501517218b7e1eaaaf..26bc4b39735870139cb802e1660b7eb95bf8f6e4 100644 (file)
--- a/gcc/ada/contracts.adb
+++ b/gcc/ada/contracts.adb
@@ -296,6 +296,9 @@ package body Contracts is
          elsif Prag_Nam = Name_Part_Of and then Is_Generic_Instance (Id) then
             Add_Classification;
 
+         elsif Prag_Nam = Name_Always_Terminates then
+            Add_Contract_Test_Case;
+
          --  The pragma is not a proper contract item
 
          else

diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index b1e4439b9f2594a18bc84cd3ba7198b77a6dc83c..bcae43ff59d2c5ed82c9389c4cbda39656b80b9e 100644 (file)
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -13332,9 +13332,14 @@ package body Sem_Prag is
             Subp_Decl :=
               Find_Related_Declaration_Or_Body (N, Do_Checks => True);
 
-            --  Generic subprogram
+            --  Generic subprogram and package declaration
 
-            if Nkind (Subp_Decl) = N_Generic_Subprogram_Declaration then
+            if Nkind (Subp_Decl) in N_Generic_Declaration then
+               null;
+
+            --  Package declaration
+
+            elsif Nkind (Subp_Decl) = N_Package_Declaration then
                null;
 
             --  Body acts as spec
@@ -13394,6 +13399,17 @@ package body Sem_Prag is
                return;
             end if;
 
+            --  Pragma Always_Terminates applied to packages doesn't allow any
+            --  expression.
+
+            if Is_Package_Or_Generic_Package (Spec_Id)
+              and then Arg_Count /= 0
+            then
+               Error_Msg_N (Fix_Error
+                 ("pragma % applied to package cannot have arguments"), N);
+               return;
+            end if;
+
             --  A pragma that applies to a Ghost entity becomes Ghost for the
             --  purposes of legality checks and removal of ignored Ghost code.