From patchwork Wed Dec 18 07:28:00 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 1212011 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-516189-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="C69mTsRs"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 47d6870KN0z9sRv for ; Wed, 18 Dec 2019 18:29:10 +1100 (AEDT) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=DL6EDIeyfbKvBGZ2de0Qyb31DcoCWG3SlQm9aHGukTRRPEuv8N QE6yMJuU6Q9AF3CPrq+LkOMFpiRb+3ZxH/jIO8hTUggJr+29HdvI6mTOITD9yc3t nzEqzUvWS5ytowWZU+/fko3qPm2kEEmpIPSZJ5vC1+WR/iY/Tpti7Nfc4= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; s= default; bh=818E01tViuQlxBsKgNprhPHd6N8=; b=C69mTsRsVxVYG//VNPUp u0XYQfSR5/z+7allTw6S/9r6N1g4jeIIS8eTPHyaEg3wbFvoyi5kRkfz4tGIMX+C z8/ErLHTSWKoehYkSPCgNzs4MPjja2bgneZoPhipYsh38Jn3G623+Z4JQZeUKPWm SdPq9sNxNeY4b/lbodPtg9U= Received: (qmail 28927 invoked by alias); 18 Dec 2019 07:28:08 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 28782 invoked by uid 89); 18 Dec 2019 07:28:07 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-13.4 required=5.0 tests=BAYES_50, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.1 spammy=sk:Analyze, sem_ch13adb, sem_ch13.adb, Etype X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 18 Dec 2019 07:28:04 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 301641165F8; Wed, 18 Dec 2019 02:28:00 -0500 (EST) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id Aq-UELY6srmP; Wed, 18 Dec 2019 02:28:00 -0500 (EST) Received: from tron.gnat.com (tron.gnat.com [IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294]) by rock.gnat.com (Postfix) with ESMTP id 129AB116143; Wed, 18 Dec 2019 02:28:00 -0500 (EST) Received: by tron.gnat.com (Postfix, from userid 4862) id 118EC19A; Wed, 18 Dec 2019 02:28:00 -0500 (EST) Date: Wed, 18 Dec 2019 02:28:00 -0500 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] AI12-0282: shared variable control aspects on formal types Message-ID: <20191218072800.GA102837@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-IsSubscribed: yes Ada202X allows some aspects related to shared variable control to appear on formal type declarations. These aspects represent new enforceable parts of the contract between generic units and instantiations. Tested on x86_64-pc-linux-gnu, committed on trunk 2019-12-18 Ed Schonberg gcc/ada/ * par-ch12.adb (P_Formal_Derived_Type_Definition): In Ada_2020 the keyword WITH can indicate the start of aspect specifications and not a private type extension. * sem_ch12.adb (Analyze_Formal_Type): Indicate that it is a first subtype. (Instantiate_Type): New procedure Check_Shared_Variable_Control_Aspects to verify matching rules between formal and actual types. Note that an array type with aspect Atomic_Components is considered compatible with an array type whose component type is Atomic, even though the array types do not carry the same aspect. * sem_ch13.adb (Analyze_One_Aspect): Allow shared variable control aspects to appear on formal types. (Rep_Item_Too_Early): Exclude aspects on formal types. * sem_prag.adb (Mark_Type): Handle properly pragmas that come from aspects on formal types. (Analyze_Pragma, case Atomic_Components): Handle formal types. --- gcc/ada/par-ch12.adb +++ gcc/ada/par-ch12.adb @@ -971,9 +971,16 @@ package body Ch12 is end if; if Token = Tok_With then - Scan; -- past WITH - Set_Private_Present (Def_Node, True); - T_Private; + + if Ada_Version >= Ada_2020 and Token /= Tok_Private then + -- Formal type has aspect specifications, parsed later. + return Def_Node; + + else + Scan; -- past WITH + Set_Private_Present (Def_Node, True); + T_Private; + end if; elsif Token = Tok_Tagged then Scan; --- gcc/ada/sem_ch12.adb +++ gcc/ada/sem_ch12.adb @@ -3410,7 +3410,11 @@ package body Sem_Ch12 is raise Program_Error; end case; + -- A formal type declaration declares a type and its first + -- subtype. + Set_Is_Generic_Type (T); + Set_Is_First_Subtype (T); if Has_Aspects (N) then Analyze_Aspect_Specifications (N, T); @@ -12178,6 +12182,10 @@ package body Sem_Ch12 is Loc : Source_Ptr; Subt : Entity_Id; + procedure Check_Shared_Variable_Control_Aspects; + -- Ada_2020: Verify that shared variable control aspects (RM C.6) + -- that may be specified for a formal type are obeyed by the actual. + procedure Diagnose_Predicated_Actual; -- There are a number of constructs in which a discrete type with -- predicates is illegal, e.g. as an index in an array type declaration. @@ -12202,6 +12210,79 @@ package body Sem_Ch12 is -- Check that base types are the same and that the subtypes match -- statically. Used in several of the above. + -------------------------------------------- + -- Check_Shared_Variable_Control_Aspects -- + -------------------------------------------- + + -- Ada_2020: Verify that shared variable control aspects (RM C.6) + -- that may be specified for the formal are obeyed by the actual. + + procedure Check_Shared_Variable_Control_Aspects is + begin + if Ada_Version >= Ada_2020 then + if Is_Atomic (A_Gen_T) and then not Is_Atomic (Act_T) then + Error_Msg_NE + ("actual for& must be an atomic type", Actual, A_Gen_T); + end if; + + if Is_Volatile (A_Gen_T) and then not Is_Volatile (Act_T) then + Error_Msg_NE + ("actual for& must be a Volatile type", Actual, A_Gen_T); + end if; + + if + Is_Independent (A_Gen_T) and then not Is_Independent (Act_T) + then + Error_Msg_NE + ("actual for& must be an Independent type", Actual, A_Gen_T); + end if; + + -- We assume that an array type whose atomic component type + -- is Atomic is equivalent to an array type with the explicit + -- aspect Has_Atomic_Components. This is a reasonable inference + -- from the intent of AI12-0282, and makes it legal to use an + -- actual that does not have the identical aspect as the formal. + + if Has_Atomic_Components (A_Gen_T) + and then not Has_Atomic_Components (Act_T) + then + if Is_Array_Type (Act_T) + and then Is_Atomic (Component_Type (Act_T)) + then + null; + + else + Error_Msg_NE + ("actual for& must have atomic components", + Actual, A_Gen_T); + end if; + end if; + + if Has_Independent_Components (A_Gen_T) + and then not Has_Independent_Components (Act_T) + then + Error_Msg_NE + ("actual for& must have independent components", + Actual, A_Gen_T); + end if; + + if Has_Volatile_Components (A_Gen_T) + and then not Has_Volatile_Components (Act_T) + then + if Is_Array_Type (Act_T) + and then Is_Volatile (Component_Type (Act_T)) + then + null; + + else + Error_Msg_NE + ("actual for& must have volatile components", + Actual, A_Gen_T); + end if; + end if; + end if; + end Check_Shared_Variable_Control_Aspects; + --------------------------------- -- Diagnose_Predicated_Actual -- --------------------------------- @@ -12820,12 +12901,21 @@ package body Sem_Ch12 is -- Perform atomic/volatile checks (RM C.6(12)). Note that AI05-0218-1 -- removes the second instance of the phrase "or allow pass by copy". - if Is_Atomic (Act_T) and then not Is_Atomic (Ancestor) then + -- In Ada_2020 the aspect may be specified explicitly for the formal + -- regardless of whether an ancestor obeys it. + + if Is_Atomic (Act_T) + and then not Is_Atomic (Ancestor) + and then not Is_Atomic (A_Gen_T) + then Error_Msg_N ("cannot have atomic actual type for non-atomic formal type", Actual); - elsif Is_Volatile (Act_T) and then not Is_Volatile (Ancestor) then + elsif Is_Volatile (Act_T) + and then not Is_Volatile (Ancestor) + and then not Is_Volatile (A_Gen_T) + then Error_Msg_N ("cannot have volatile actual type for non-volatile formal type", Actual); @@ -13504,6 +13594,8 @@ package body Sem_Ch12 is end if; end if; + Check_Shared_Variable_Control_Aspects; + if Error_Posted (Act_T) then null; else --- gcc/ada/sem_ch13.adb +++ gcc/ada/sem_ch13.adb @@ -2131,12 +2131,27 @@ package body Sem_Ch13 is Aspect); end if; - -- Not allowed for formal type declarations + -- Not allowed for formal type declarations in previous + -- versions of the language. Allowed for them only for + -- shared variable control aspects. if Nkind (N) = N_Formal_Type_Declaration then - Error_Msg_N - ("aspect % not allowed for formal type declaration", - Aspect); + if Ada_Version < Ada_2020 then + Error_Msg_N + ("aspect % not allowed for formal type declaration", + Aspect); + + elsif A_Id /= Aspect_Atomic + and then A_Id /= Aspect_Volatile + and then A_Id /= Aspect_Independent + and then A_Id /= Aspect_Atomic_Components + and then A_Id /= Aspect_Independent_Components + and then A_Id /= Aspect_Volatile_Components + then + Error_Msg_N + ("aspect % not allowed for formal type declaration", + Aspect); + end if; end if; end if; @@ -12837,8 +12852,13 @@ package body Sem_Ch13 is and then (Nkind (N) /= N_Pragma or else Get_Pragma_Id (N) /= Pragma_Convention) then - Error_Msg_N ("representation item not allowed for generic type", N); - return True; + if Ada_Version < Ada_2020 then + Error_Msg_N + ("representation item not allowed for generic type", N); + return True; + else + return False; + end if; end if; -- Otherwise check for incomplete type --- gcc/ada/sem_prag.adb +++ gcc/ada/sem_prag.adb @@ -7562,13 +7562,19 @@ package body Sem_Prag is -- Attribute belongs on the base type. If the view of the type is -- currently private, it also belongs on the underlying type. + -- In Ada_2020, the pragma can apply to a formal type, for which + -- there may be no underlying type. + if Prag_Id = Pragma_Atomic or else Prag_Id = Pragma_Shared or else Prag_Id = Pragma_Volatile_Full_Access then Set_Atomic_VFA (Ent); Set_Atomic_VFA (Base_Type (Ent)); - Set_Atomic_VFA (Underlying_Type (Ent)); + + if not Is_Generic_Type (Ent) then + Set_Atomic_VFA (Underlying_Type (Ent)); + end if; end if; -- Atomic/Shared/Volatile_Full_Access imply Independent @@ -7576,10 +7582,13 @@ package body Sem_Prag is if Prag_Id /= Pragma_Volatile then Set_Is_Independent (Ent); Set_Is_Independent (Base_Type (Ent)); - Set_Is_Independent (Underlying_Type (Ent)); - if Prag_Id = Pragma_Independent then - Record_Independence_Check (N, Base_Type (Ent)); + if not Is_Generic_Type (Ent) then + Set_Is_Independent (Underlying_Type (Ent)); + + if Prag_Id = Pragma_Independent then + Record_Independence_Check (N, Base_Type (Ent)); + end if; end if; end if; @@ -7588,10 +7597,13 @@ package body Sem_Prag is if Prag_Id /= Pragma_Independent then Set_Is_Volatile (Ent); Set_Is_Volatile (Base_Type (Ent)); - Set_Is_Volatile (Underlying_Type (Ent)); + + if not Is_Generic_Type (Ent) then + Set_Is_Volatile (Underlying_Type (Ent)); + Set_Treat_As_Volatile (Underlying_Type (Ent)); + end if; Set_Treat_As_Volatile (Ent); - Set_Treat_As_Volatile (Underlying_Type (Ent)); end if; -- Apply Volatile to the composite type's individual components, @@ -14076,6 +14088,9 @@ package body Sem_Prag is Ekind (E) = E_Variable) and then Nkind (Object_Definition (D)) = N_Constrained_Array_Definition) + or else + (Ada_Version >= Ada_2020 + and then Nkind (D) = N_Formal_Type_Declaration) then -- The flag is set on the base type, or on the object @@ -14090,6 +14105,7 @@ package body Sem_Prag is Check_Atomic_VFA (Component_Type (Etype (E)), VFA => False); end if; + Set_Has_Atomic_Components (E); Set_Has_Independent_Components (E); end if;