From 3ec78e11471c898328053884ac328cb898f91144 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Fri, 12 May 2023 14:06:07 +0200 Subject: [PATCH] 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. --- gcc/ada/contracts.adb | 3 +++ gcc/ada/sem_prag.adb | 20 ++++++++++++++++++-- 2 files changed, 21 insertions(+), 2 deletions(-) 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. -- 2.47.2