From: Piotr Trojanek <trojanek@adacore.com>
Date: Fri, 12 May 2023 12:06:07 +0000 (+0200)
Subject: ada: Accept aspect Always_Terminates on packages
X-Git-Tag: basepoints/gcc-15~8288
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=3ec78e11471c898328053884ac328cb898f91144;p=thirdparty%2Fgcc.git

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 0e87cee3ef50..26bc4b397358 100644
--- 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 b1e4439b9f25..bcae43ff59d2 100644
--- 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.