From patchwork Thu Aug 29 13:07:45 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 1978432 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=efyKSnal; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4WvhWG5Y8qz1yfn for ; Thu, 29 Aug 2024 23:11:38 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 922443861005 for ; Thu, 29 Aug 2024 13:11:36 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x32a.google.com (mail-wm1-x32a.google.com [IPv6:2a00:1450:4864:20::32a]) by sourceware.org (Postfix) with ESMTPS id 1CE02386102F for ; Thu, 29 Aug 2024 13:08:19 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 1CE02386102F Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 1CE02386102F Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::32a ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1724936903; cv=none; b=J9aOxlO/JjdoAcWrjufQnnOwdA8edOVdm08aO2Uo3wNgtGEXBN/M4dtm66AJrvE1RgiASPLtNr4ylMBOCFAkHVCaQQjzLgtLE2TfdfZFSZzVMJzFUnB14iPrtG/q3pYyO8LEi+AKyrkGpHOrztL+ReauQkTVPc7nfLcEQR7cjRE= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1724936903; c=relaxed/simple; bh=cyKh/81NSDNkY4hBd2u575Nu0QgbQVZsVAsZs0T0O2U=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=WmbRjUyFBCsgroX9pNB68k7lASWfm2ri1cpw/W6ZHta0tsLjd+x4YKten8/UdhOE80aWI9qhKP1KN2NLHLNgdinW/m/+D0M6t58HegeiY+Lcu/pD0KNW7N95iuB2UoGmo1Ar4bkpVTE1FESv+RwAPeJ6XyWTN+m/mu0vmiiTZNg= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-wm1-x32a.google.com with SMTP id 5b1f17b1804b1-429e29933aaso5515225e9.0 for ; Thu, 29 Aug 2024 06:08:19 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1724936898; x=1725541698; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=k3ktjsOBZOnBbiCo4uBm9PI/1wsaKN2f13I/QAFCfyo=; b=efyKSnalaFjOY9T9nDpT0wrkRLim7O1BinBT0Z1SArIP+sj1dJu5o/ooEej7f1qLO1 PrbyWoMEQ76hI/aB4u8jBWQ+PgjAqcwmv8NxX6k+88Lpd+RCV2pJCDxE5Hh7XpsX/Zfd bGF9w49vgYm/OKnAcdbWjfFdl/4u52U5gNhGMOFbBlSdweChwxeJ2e4R0WL8Qp6TAVuF QOq6/MepftHYF7jZVZrsYQuVhQOSyMg6Xa5uqkkAWUKorN2po81fgbKuNAkeVHG+LvZw rF7abtmO5PEo6CaPk2GR7fzDAlud3oLDIOyrRgW7FfgJi6pGPywIzDrYEtIE9UQoI7o1 DX1g== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1724936898; x=1725541698; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=k3ktjsOBZOnBbiCo4uBm9PI/1wsaKN2f13I/QAFCfyo=; b=KFALlfKDUUetmXItZJbeoClAL3yTQ3j+rE0RSfdgN6ncPjYR642LRu8UBZj0yaBwsD tT8A6LmL2B/v3xy3DtMFEJAOtZplmi0lFKhlLWNT4b2uTCaKBntFqpqhUeimaiw4ddA3 ZXpmgf4M0UjL7kWTIzKLOldXmE2gCHFg4jyn5XCRij3eikawdHQywJ6iQZOjGi9/favV Rl1CBWxYrQbdS+FCHblEvj3bBwZrAkmka7jgxYVN9NGyPa+hOY2ss/F7t6Wo7SIURyDv oshzg2E0BWenqxpSdRlD0ADGw1rQvjq3omM09M/i/8k6Wr+rnKUMDo2+3PIIhLkok9JR poVA== X-Gm-Message-State: AOJu0Yx2JG+ZeBB/BpvhmcdXYmCa/yao5ICjHtQ8PRBsYgE9QgY8033n TglCJ+Mh/t7lAOF51cHfLXvHtwOvHlfczf3ds8x78XRNlX1n/41onyW1U7J364NV8aP4Cf3oMCg = X-Google-Smtp-Source: AGHT+IFCggbTgsObFZs9aQQxhCuYhbPcJSAG6BJJzYzSS4rHLK372krpDAJVsOTJvUw3owfJt9c83A== X-Received: by 2002:a05:600c:1e10:b0:426:6822:855 with SMTP id 5b1f17b1804b1-42bb27b33c7mr19451225e9.36.1724936897561; Thu, 29 Aug 2024 06:08:17 -0700 (PDT) Received: from poulhies-Precision-5550.lan ([2001:861:3382:1a90:5e2c:51b0:ac4a:92ca]) by smtp.gmail.com with ESMTPSA id 5b1f17b1804b1-42bb6deb2f5sm17074605e9.2.2024.08.29.06.08.16 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 29 Aug 2024 06:08:16 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Steve Baird Subject: [COMMITTED 15/17] ada: Missing legality check when type completed Date: Thu, 29 Aug 2024 15:07:45 +0200 Message-ID: <20240829130750.1651060-15-poulhies@adacore.com> X-Mailer: git-send-email 2.45.2 In-Reply-To: <20240829130750.1651060-1-poulhies@adacore.com> References: <20240829130750.1651060-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.8 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.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org From: Steve Baird Refine previous fix to better handle tagged cases. gcc/ada/ * sem_ch6.adb (Check_Discriminant_Conformance): Immediately after calling Is_Immutably_Limited_Type, perform an additional test that one might reasonably imagine would instead have been part of Is_Immutably_Limited_Type. The new test is a call to a new function Has_Tagged_Limited_Partial_View whose implementation includes a call to Incomplete_Or_Partial_View, which cannot be easily be called from Is_Immutably_Limited_Type (because sem_aux, which is in the closure of the binder, cannot easily "with" sem_util). * sem_aux.adb (Is_Immutably_Limited): Include N_Derived_Type_Definition case when testing Limited_Present flag. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_aux.adb | 8 ++++---- gcc/ada/sem_ch6.adb | 26 ++++++++++++++++++++++++++ 2 files changed, 30 insertions(+), 4 deletions(-) diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index 9903a2b6a16..5edf6675474 100644 --- a/gcc/ada/sem_aux.adb +++ b/gcc/ada/sem_aux.adb @@ -1118,12 +1118,12 @@ package body Sem_Aux is elsif Is_Private_Type (Btype) then - -- If Ent occurs in the completion of a limited private type, then - -- look for the word "limited" in the full view. + -- If Ent occurs in the completion of a private type, then + -- look for the word "limited" in the full view. if Nkind (Parent (Ent)) = N_Full_Type_Declaration - and then Nkind (Type_Definition (Parent (Ent))) = - N_Record_Definition + and then Nkind (Type_Definition (Parent (Ent))) in + N_Record_Definition | N_Derived_Type_Definition and then Limited_Present (Type_Definition (Parent (Ent))) then return True; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 86d784543f3..076fb89c7b5 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -6432,6 +6432,25 @@ package body Sem_Ch6 is OldD : constant Boolean := Present (Expression (Parent (Old_Discr))); + function Has_Tagged_Limited_Partial_View + (Typ : Entity_Id) return Boolean; + -- Returns True iff Typ has a tagged limited partial view. + + ------------------------------------- + -- Has_Tagged_Limited_Partial_View -- + ------------------------------------- + + function Has_Tagged_Limited_Partial_View + (Typ : Entity_Id) return Boolean + is + Priv : constant Entity_Id := Incomplete_Or_Partial_View (Typ); + begin + return Present (Priv) + and then not Is_Incomplete_Type (Priv) + and then Is_Tagged_Type (Priv) + and then Limited_Present (Parent (Priv)); + end Has_Tagged_Limited_Partial_View; + begin if NewD or OldD then @@ -6463,6 +6482,13 @@ package body Sem_Ch6 is N_Access_Definition and then not Is_Immutably_Limited_Type (Defining_Identifier (N)) + + -- Check for a case that would be awkward to handle in + -- Is_Immutably_Limited_Type (because sem_aux can't + -- "with" sem_util). + + and then not Has_Tagged_Limited_Partial_View + (Defining_Identifier (N)) then Error_Msg_N ("(Ada 2005) default value for access discriminant "