From patchwork Thu Jan 11 09:10:09 2018 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: 858953 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-470799-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="Zadp0nLV"; 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 3zHKpl50j3z9t3m for ; Thu, 11 Jan 2018 20:10:23 +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=LCrc3eO4VDnUbBAvdJsKER6zMBXg+0LnNfONI3cOnn8o/7cYU+ x1ZZ96e5qfF4WmlzDDgCCTC2gW3OoFNz1QkiGjmDtaRkVZQy5JASMvakzsVo6wMf VwDZ188S9l+UVmMV/ktrDj9wIwbD6qmHWQ6ErknZ2aEaWDvUgXJoOE1o8= 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=iI8Qc+YPRcEPZt1ahAdpAzRW4iU=; b=Zadp0nLVOF+oySJ3GDSf v1oR5oZaXQ/hVTgXo0TYMyxihFDE+24CocANre5FWvN1w8pczc5Sd7s38E4qw5Rq Ow+vhgZefc4kocTZC0KgJQqCMbf6PtV+iwkTIoY9vuGY1bSuSk8SGarMZHFPOMxX ViflcW7XEYh8tQIvHzVGyuU= Received: (qmail 70063 invoked by alias); 11 Jan 2018 09:10:14 -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 69816 invoked by uid 89); 11 Jan 2018 09:10:12 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-11.9 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=Hx-languages-length:3685 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; Thu, 11 Jan 2018 09:10:10 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 7EEFA117BC3; Thu, 11 Jan 2018 04:10:09 -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 2rnyofPTXSqB; Thu, 11 Jan 2018 04:10:09 -0500 (EST) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 6E5B7117BBE; Thu, 11 Jan 2018 04:10:09 -0500 (EST) Received: by tron.gnat.com (Postfix, from userid 4862) id 6D42350B; Thu, 11 Jan 2018 04:10:09 -0500 (EST) Date: Thu, 11 Jan 2018 04:10:09 -0500 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Bob Duff Subject: [Ada] Null procedures not allowed in protected definitions Message-ID: <20180111091009.GA103335@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-IsSubscribed: yes The syntax rules do not allow null procedures in protected definitions. This patch fixes a bug that accidentally allowed them. Tested on x86_64-pc-linux-gnu, committed on trunk 2018-01-11 Bob Duff gcc/ada/ * par-ch9.adb (P_Protected_Operation_Declaration_Opt): Give an error if a null procedure occurs in a protected definition. gcc/testsuite/ * gnat.dg/protected_null.adb: New testcase. --- gcc/ada/par-ch9.adb +++ gcc/ada/par-ch9.adb @@ -782,6 +782,8 @@ package body Ch9 is return Decl; end P_Entry_Or_Subprogram_With_Indicator; + Result : Node_Id := Empty; + -- Start of processing for P_Protected_Operation_Declaration_Opt begin @@ -789,50 +791,70 @@ package body Ch9 is -- is skipped. loop - if Token = Tok_Pragma then - return P_Pragma; + case Token is + when Tok_Pragma => + Result := P_Pragma; + exit; - elsif Token = Tok_Not or else Token = Tok_Overriding then - return P_Entry_Or_Subprogram_With_Indicator; + when Tok_Not | Tok_Overriding => + Result := P_Entry_Or_Subprogram_With_Indicator; + exit; - elsif Token = Tok_Entry then - return P_Entry_Declaration; + when Tok_Entry => + Result := P_Entry_Declaration; + exit; - elsif Token = Tok_Function or else Token = Tok_Procedure then - return P_Subprogram (Pf_Decl_Pexp); + when Tok_Function | Tok_Procedure => + Result := P_Subprogram (Pf_Decl_Pexp); + exit; - elsif Token = Tok_Identifier then - L := New_List; - P := Token_Ptr; - Skip_Declaration (L); + when Tok_Identifier => + L := New_List; + P := Token_Ptr; + Skip_Declaration (L); - if Nkind (First (L)) = N_Object_Declaration then - Error_Msg - ("component must be declared in private part of " & - "protected type", P); - else - Error_Msg - ("illegal declaration in protected definition", P); - end if; + if Nkind (First (L)) = N_Object_Declaration then + Error_Msg + ("component must be declared in private part of " & + "protected type", P); + else + Error_Msg + ("illegal declaration in protected definition", P); + end if; + -- Continue looping - elsif Token in Token_Class_Declk then - Error_Msg_SC ("illegal declaration in protected definition"); - Resync_Past_Semicolon; + when Tok_For => + Error_Msg_SC + ("representation clause not allowed in protected definition"); + Resync_Past_Semicolon; + -- Continue looping - -- Return now to avoid cascaded messages if next declaration - -- is a valid component declaration. + when others => + if Token in Token_Class_Declk then + Error_Msg_SC ("illegal declaration in protected definition"); + Resync_Past_Semicolon; - return Error; + -- Return now to avoid cascaded messages if next declaration + -- is a valid component declaration. - elsif Token = Tok_For then - Error_Msg_SC - ("representation clause not allowed in protected definition"); - Resync_Past_Semicolon; + Result := Error; + end if; - else - return Empty; - end if; + exit; + end case; end loop; + + if Nkind (Result) = N_Subprogram_Declaration + and then Nkind (Specification (Result)) = + N_Procedure_Specification + and then Null_Present (Specification (Result)) + then + Error_Msg_N + ("protected operation cannot be a null procedure", + Null_Statement (Specification (Result))); + end if; + + return Result; end P_Protected_Operation_Declaration_Opt; -------------------------------------- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/protected_null.adb @@ -0,0 +1,15 @@ +-- { dg-do compile } + +procedure Proc is + protected Po is + procedure P is null; -- { dg-error " protected operation cannot be a null procedure" } + end Po; + protected body Po is + procedure P is + begin + null; + end P; + end Po; +begin + null; +end;