From patchwork Wed Aug 14 09:53:11 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: 1146888 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-506901-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="aj3G5J1x"; 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 467lJk29Bzz9sDQ for ; Wed, 14 Aug 2019 19:53:23 +1000 (AEST) 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=AOCA1qn1/2Ya6crwemRwS1DrSxwPc8j1NJgAQIKuwGttPA9PtL MXuRcbQUB909sWUqBsiKVtDCe+Suuhn0XD0nrro3uFH+dHrQdCIi6rmnlCKAy3NU wUfuRn2S/pseh9d6C7a0RNtQ9CD2aOlUmFEZIz2kn5bJTOLmyr7iNyid8= 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=1mG+OQ6vA7zcwrPrnRnAd0P4zm0=; b=aj3G5J1xiMFA5ozTWZ34 6bmr8Ff+UNovby8p+rYF4wBY9BOqb9z8GtbbyZ5nH6PmHBF6rf/fP585enTqu9av An3HypGc7Ene7Qzvs/0Yu55jjhIDhZVqOAx6QRVP66bkESjqDM09WWvC47bi3tkw BkraJSuv4FgGp2Cv1moGI10= Received: (qmail 72932 invoked by alias); 14 Aug 2019 09:53:15 -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 72913 invoked by uid 89); 14 Aug 2019 09:53:14 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-11.0 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.1 spammy= 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, 14 Aug 2019 09:53:13 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id E987256065; Wed, 14 Aug 2019 05:53:11 -0400 (EDT) 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 tSP3+cgxWHZT; Wed, 14 Aug 2019 05:53:11 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id D5B0811626C; Wed, 14 Aug 2019 05:53:11 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id D1CBE6CC; Wed, 14 Aug 2019 05:53:11 -0400 (EDT) Date: Wed, 14 Aug 2019 05:53:11 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Gary Dismukes Subject: [Ada] Illegal selection of first object in a task type's body not detected Message-ID: <20190814095311.GA51842@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-IsSubscribed: yes The compiler was improperly allowing selection of an object declared within a task body when the prefix was of the task type, specifically in the case where the object was the very first declared in the body (selections of later body declarations were being flagged). The flag Is_Private_Op was only set at the point of the first "private" declaration of the type in cases where the first declaration's name didn't match the selector. Tested on x86_64-pc-linux-gnu, committed on trunk 2019-08-14 Gary Dismukes gcc/ada/ * sem_ch4.adb (Analyze_Selected_Component): In the case where the prefix is of a concurrent type, and the selected entity matching the selector is the first private declaration of the type (such as the first local variable in a task's body), set Is_Private_Op. gcc/testsuite/ * gnat.dg/task5.adb: New testcase. --- gcc/ada/sem_ch4.adb +++ gcc/ada/sem_ch4.adb @@ -4994,7 +4994,15 @@ package body Sem_Ch4 is if Comp = First_Private_Entity (Type_To_Use) then if Etype (Sel) /= Any_Type then - -- We have a candiate + -- If the first private entity's name matches, then treat + -- it as a private op: needed for the error check for + -- illegal selection of private entities further below. + + if Chars (Comp) = Chars (Sel) then + Is_Private_Op := True; + end if; + + -- We have a candidate, so exit the loop exit; --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/task5.adb @@ -0,0 +1,26 @@ +procedure Task5 is + + task type T is + entry E (V1, V2 : Integer); + end T; + + T_Obj : T; + + task body T is + V1 : Integer; + V2 : Integer; + V3 : Integer; + begin + accept E (V1, V2 : Integer) do + T.V1 := V1; + T.V2 := V2; + + T_Obj.V1 := V1; -- { dg-error "invalid reference to private operation of some object of type \"T\"" } + T_Obj.V2 := V2; -- { dg-error "invalid reference to private operation of some object of type \"T\"" } + T_Obj.V3 := V3; -- { dg-error "invalid reference to private operation of some object of type \"T\"" } + end E; + end T; + +begin + null; +end Task5;