From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from rock.gnat.com (rock.gnat.com [205.232.38.15]) by sourceware.org (Postfix) with ESMTP id A69D3388A830 for ; Thu, 16 Jul 2020 09:20:54 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org A69D3388A830 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=derodat@adacore.com Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id A8CAF5609B; Thu, 16 Jul 2020 05:20:51 -0400 (EDT) X-Virus-Scanned: Debian amavisd-new at gnat.com 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 z8Td2cJ8S9nR; Thu, 16 Jul 2020 05:20:51 -0400 (EDT) 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 8D6B656094; Thu, 16 Jul 2020 05:20:51 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id 8C78E12D; Thu, 16 Jul 2020 05:20:51 -0400 (EDT) Date: Thu, 16 Jul 2020 05:20:51 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Bob Duff Subject: [Ada] Ada2020: AI12-0289 Implicitly null excluding anon access Message-ID: <20200716092051.GA146494@adacore.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="pWyiEgJYm5f9v55/" Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-Spam-Status: No, score=-8.7 required=5.0 tests=BAYES_00, GIT_PATCH_0, JMQ_SPF_NEUTRAL, KAM_DMARC_STATUS, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Thu, 16 Jul 2020 09:20:56 -0000 --pWyiEgJYm5f9v55/ Content-Type: text/plain; charset=us-ascii Content-Disposition: inline This patch implements AI12-0289. In particular, if an untagged type T is completed with a tagged full type, and a parameter whose type is "access T", where T denotes the partial view in the subprogram spec, an explicit "not null" is required. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * sem_ch6.adb (Null_Exclusions_Match): New function to check that the null exclusions match, including in the case addressed by this AI. (Check_Conformance): Remove calls to Comes_From_Source when calling Null_Exclusions_Match. These are not needed, as indicated by an ancient "???" comment. --pWyiEgJYm5f9v55/ Content-Type: text/x-diff; charset=us-ascii Content-Disposition: attachment; filename="patch.diff" diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -5605,10 +5605,11 @@ package body Sem_Ch6 is -- in the message, and also provides the location for posting the -- message in the absence of a specified Err_Loc location. - function Conventions_Match - (Id1 : Entity_Id; - Id2 : Entity_Id) return Boolean; - -- Determine whether the conventions of arbitrary entities Id1 and Id2 + function Conventions_Match (Id1, Id2 : Entity_Id) return Boolean; + -- True if the conventions of entities Id1 and Id2 match. + + function Null_Exclusions_Match (F1, F2 : Entity_Id) return Boolean; + -- True if the null exclusions of two formals of anonymous access type -- match. ----------------------- @@ -5699,6 +5700,50 @@ package body Sem_Ch6 is end if; end Conventions_Match; + --------------------------- + -- Null_Exclusions_Match -- + --------------------------- + + function Null_Exclusions_Match (F1, F2 : Entity_Id) return Boolean is + begin + if not Is_Anonymous_Access_Type (Etype (F1)) + or else not Is_Anonymous_Access_Type (Etype (F2)) + then + return True; + end if; + + -- AI12-0289-1: Case of controlling access parameter; False if the + -- partial view is untagged, the full view is tagged, and no explicit + -- "not null". Note that at this point, we're processing the package + -- body, so private/full types have been swapped. The Sloc test below + -- is to detect the (legal) case where F1 comes after the full type + -- declaration. This part is disabled pre-2005, because "not null" is + -- not allowed on those language versions. + + if Ada_Version >= Ada_2005 + and then Is_Controlling_Formal (F1) + and then not Null_Exclusion_Present (Parent (F1)) + and then not Null_Exclusion_Present (Parent (F2)) + then + declare + D : constant Entity_Id := Directly_Designated_Type (Etype (F1)); + Partial_View_Of_Desig : constant Entity_Id := + Incomplete_Or_Partial_View (D); + begin + return No (Partial_View_Of_Desig) + or else Is_Tagged_Type (Partial_View_Of_Desig) + or else Sloc (D) < Sloc (F1); + end; + + -- Not a controlling parameter, or one or both views have an explicit + -- "not null". + + else + return Null_Exclusion_Present (Parent (F1)) = + Null_Exclusion_Present (Parent (F2)); + end if; + end Null_Exclusions_Match; + -- Local Variables Old_Type : constant Entity_Id := Etype (Old_Id); @@ -5868,25 +5913,14 @@ package body Sem_Ch6 is -- Null exclusion must match - if Null_Exclusion_Present (Parent (Old_Formal)) - /= - Null_Exclusion_Present (Parent (New_Formal)) - then - -- Only give error if both come from source. This should be - -- investigated some time, since it should not be needed ??? - - if Comes_From_Source (Old_Formal) - and then - Comes_From_Source (New_Formal) - then - Conformance_Error - ("\null exclusion for& does not match", New_Formal); + if not Null_Exclusions_Match (Old_Formal, New_Formal) then + Conformance_Error + ("\null exclusion for& does not match", New_Formal); - -- Mark error posted on the new formal to avoid duplicated - -- complaint about types not matching. + -- Mark error posted on the new formal to avoid duplicated + -- complaint about types not matching. - Set_Error_Posted (New_Formal); - end if; + Set_Error_Posted (New_Formal); end if; end if; --pWyiEgJYm5f9v55/--