From patchwork Wed May 18 08:43:18 2022 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: 54137 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 998BC385740B for ; Wed, 18 May 2022 08:59:47 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 998BC385740B DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1652864387; bh=/NmBhP9CPNA7GJdenJqUdBJn/X/bgTtFPSfq1CrclKs=; h=Date:To:Subject:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:Cc:From; b=JBKRIhek3qMThL71M6gRamLA7YIMJLdVRgVrI8A4hCmoayQYMbdTJ18Mjwlf7jryi o2y72mzwAnl13dOEtb4BvWw7G+hyLjw1L3wfVQ+O+VIP92MIaB3tyywq7ABSlwEk5T E+z2BnbyqsGQc5Qbooq3sGfaBxeY04havulF1/ao= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x333.google.com (mail-wm1-x333.google.com [IPv6:2a00:1450:4864:20::333]) by sourceware.org (Postfix) with ESMTPS id 91717385740B for ; Wed, 18 May 2022 08:43:19 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 91717385740B Received: by mail-wm1-x333.google.com with SMTP id i20-20020a05600c355400b0039456976dcaso1970854wmq.1 for ; Wed, 18 May 2022 01:43:19 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:date:from:to:cc:subject:message-id:mime-version :content-disposition; bh=/NmBhP9CPNA7GJdenJqUdBJn/X/bgTtFPSfq1CrclKs=; b=C9jiDUKhWb7aEQGuyCG9pGC3yJSbYI5+E1eP8y4chB/6A/0EB1X2ADM9u3xXizSztq 7fMe1Q+g6IDicgtDJYBOrPMqGxMeEbsvsXCHdNxuHu2q1xl6rv1MFUciBYdCd2RGEPUT QeG6KzKsHTW8bRsaQrWC00UJvPPaoyvEJ89dPxDsS0rLau/ZsUdCik0H9N9j5aky0ayI U7qA29JZjp7WwUfajV91dEDq586svNqpQUFq3IweqF9l3kU7KbJjWZicC3DRiyYXPObJ JCHDVG1JVuLIA4ZysNEpXKPIgKvq+476LzsCGQhOP/KCA+5/Q/ppalRRe3cVZrcJpGLL vHHg== X-Gm-Message-State: AOAM530emGG274FtwD/SbbUHu8n935EejvQIOwz3YCTrQE+5JPwJ0aru 3xFq775DI6tL7CQyyPIB218dAni/loXPBQ== X-Google-Smtp-Source: ABdhPJwD+pQL1Uz7EWPGKi40Z6HCIf6qcEkdTo6DO4bNdl4CqUH6jCGOSh5tlp8cyI98RPw5A5Ux/A== X-Received: by 2002:a05:600c:4f53:b0:394:6a35:79ac with SMTP id m19-20020a05600c4f5300b003946a3579acmr35755552wmq.36.1652863399145; Wed, 18 May 2022 01:43:19 -0700 (PDT) Received: from adacore.com ([45.147.211.82]) by smtp.gmail.com with ESMTPSA id l27-20020adfa39b000000b0020c6a524fd5sm1560068wrb.99.2022.05.18.01.43.18 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 18 May 2022 01:43:18 -0700 (PDT) Date: Wed, 18 May 2022 08:43:18 +0000 To: gcc-patches@gcc.gnu.org Subject: [Ada] Crash building VSS with compiler built with assertions Message-ID: <20220518084318.GA3345731@adacore.com> MIME-Version: 1.0 Content-Disposition: inline X-Spam-Status: No, score=-13.3 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) 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-Patchwork-Original-From: Pierre-Marie de Rodat via Gcc-patches From: Pierre-Marie de Rodat Reply-To: Pierre-Marie de Rodat Cc: Javier Miranda Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" When a tagged type T has aspect String_Literal, a derived type defines a null extension T2, and the context to resolve the use of an object of type T2 where the string literal is applicable is a class-wide type the frontend crashes trying to evaluate if the object is a null extension. This problem does not reproduce when the compiler is built with assertions disabled. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * sem_ch6.adb (Find_Corresponding_Spec): Avoid calling Is_Null_Extension with a class-wide type entity. (Overrides_Visible_Function): Handle alias entities. * sem_res.adb (Has_Applicable_User_Defined_Literal): Conversion not needed if the result type of the call is class-wide or if the result type matches the context type. * sem_util.ads (Is_Null_Extension): Adding documentation. (Is_Null_Extension_Of): Adding documentation. * sem_util.adb (Is_Null_Extension): Adding assertion. (Is_Null_Extension_Of): Adding assertions. 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 @@ -9867,7 +9867,8 @@ package body Sem_Ch6 is and then Ada_Version >= Ada_2005 and then not Comes_From_Source (E) and then Has_Controlling_Result (E) - and then Is_Null_Extension (Etype (E)) + and then (not Is_Class_Wide_Type (Etype (E)) + and then Is_Null_Extension (Etype (E))) and then Comes_From_Source (Spec) then Set_Has_Completion (E, False); @@ -11265,7 +11266,8 @@ package body Sem_Ch6 is function Overrides_Private_Part_Op return Boolean is Over_Decl : constant Node_Id := - Unit_Declaration_Node (Overridden_Operation (S)); + Unit_Declaration_Node + (Ultimate_Alias (Overridden_Operation (S))); Subp_Decl : constant Node_Id := Unit_Declaration_Node (S); begin diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -559,7 +559,12 @@ package body Sem_Res is Set_Etype (Call, Etype (Callee)); - if Base_Type (Etype (Call)) /= Base_Type (Typ) then + -- Conversion not needed if the result type of the call is class-wide + -- or if the result type matches the context type. + + if not Is_Class_Wide_Type (Typ) + and then Base_Type (Etype (Call)) /= Base_Type (Typ) + then -- Conversion may be needed in case of an inherited -- aspect of a derived type. For a null extension, we -- use a null extension aggregate instead because the diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -19279,6 +19279,8 @@ package body Sem_Util is Type_Decl : Node_Id; Type_Def : Node_Id; begin + pragma Assert (not Is_Class_Wide_Type (T)); + if Ignore_Privacy then Type_Decl := Parent (Underlying_Type (Base_Type (T))); else @@ -19311,7 +19313,10 @@ package body Sem_Util is := Underlying_Type (Base_Type (Ancestor)); Descendant_Type : Entity_Id := Underlying_Type (Base_Type (Descendant)); begin + pragma Assert (not Is_Class_Wide_Type (Descendant)); + pragma Assert (not Is_Class_Wide_Type (Ancestor)); pragma Assert (Descendant_Type /= Ancestor_Type); + while Descendant_Type /= Ancestor_Type loop if not Is_Null_Extension (Descendant_Type, Ignore_Privacy => True) diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -2209,12 +2209,14 @@ package Sem_Util is -- Given a tagged type, returns True if argument is a type extension -- that introduces no new components (discriminant or nondiscriminant). -- Ignore_Privacy should be True for use in implementing dynamic semantics. + -- Cannot be called with class-wide types. function Is_Null_Extension_Of (Descendant, Ancestor : Entity_Id) return Boolean; -- Given two tagged types, the first a descendant of the second, -- returns True if every component of Descendant is inherited -- (directly or indirectly) from Ancestor. Privacy is ignored. + -- Cannot be called with class-wide types. function Is_Null_Record_Definition (Record_Def : Node_Id) return Boolean; -- Returns True for an N_Record_Definition node that has no user-defined