From patchwork Thu Aug 5 08:57:03 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 60939 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 43F001007D1 for ; Thu, 5 Aug 2010 18:57:26 +1000 (EST) Received: (qmail 335 invoked by alias); 5 Aug 2010 08:57:18 -0000 Received: (qmail 319 invoked by uid 22791); 5 Aug 2010 08:57:14 -0000 X-SWARE-Spam-Status: No, hits=-0.9 required=5.0 tests=AWL, BAYES_40, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (212.99.106.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Thu, 05 Aug 2010 08:57:06 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 447E0CB0242; Thu, 5 Aug 2010 10:57:04 +0200 (CEST) Received: from mel.act-europe.fr ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id rIMMEqqVTdJx; Thu, 5 Aug 2010 10:57:04 +0200 (CEST) Received: from saumur.act-europe.fr (saumur.act-europe.fr [10.10.0.183]) by mel.act-europe.fr (Postfix) with ESMTP id 2F554CB026E; Thu, 5 Aug 2010 10:57:04 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id A0C99D9BB4; Thu, 5 Aug 2010 10:57:03 +0200 (CEST) Date: Thu, 5 Aug 2010 10:57:03 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Gary Dismukes Subject: [Ada] Error wrongly given for nested tagged types when No_Task_Hierarchy applies Message-ID: <20100805085703.GA8812@adacore.com> Mime-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.9i X-IsSubscribed: yes 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 The compiler should not reject a nested task type when the restriction No_Task_Hierarchy applies, since only nested task objects violate the restriction. We now issue warnings on both task and protected types declared at nested levels when the respective restrictions No_Task_Hierarchy or No_Local_Protected_Objects apply. Also, allocators of nested access types designating task and protected types are now flagged when the appropriate restriction applies. When the test given below is compiled, the following errors and warnings must be issued: restrict_nested_task_prot.adb:6:04: violation of restriction "No_Task_Hierarchy" at line 1 restrict_nested_task_prot.adb:13:04: warning: objects of this type will violate "No_Task_Hierarchy" at line 1 restrict_nested_task_prot.adb:20:04: violation of restriction "No_Task_Hierarchy" at line 1 restrict_nested_task_prot.adb:24:20: violation of restriction "No_Task_Hierarchy" at line 1 restrict_nested_task_prot.adb:27:14: violation of restriction "No_Local_Protected_Objects" at line 2 restrict_nested_task_prot.adb:33:04: warning: objects of this type will violate "No_Local_Protected_Objects" at line 2 restrict_nested_task_prot.adb:39:04: violation of restriction "No_Local_Protected_Objects" at line 2 restrict_nested_task_prot.adb:43:20: violation of restriction "No_Local_Protected_Objects" at line 2 --- pragma Restrictions (No_Task_Hierarchy); pragma Restrictions (No_Local_Protected_Objects); procedure Restrict_Nested_Task_Prot is task T; -- ERROR task body T is begin null; end T; task type TT; -- WARNING task body TT is begin null; end TT; TT_Obj : TT; -- ERROR type Acc_TT is access all TT; ATT : Acc_TT := new TT; -- ERROR protected P is -- ERROR end P; protected body P is end P; protected type PT is -- WARNING end PT; protected body PT is end PT; PT_Obj : PT; -- ERROR type Acc_PT is access all PT; APT : Acc_PT := new PT; -- ERROR begin null; end Restrict_Nested_Task_Prot; Tested on x86_64-pc-linux-gnu, committed on trunk 2010-08-05 Gary Dismukes * sem_ch4.adb (Analyze_Allocator): Flag errors on allocators of a nested access type whose designated type has tasks or is a protected object when the restrictions No_Task_Hierarchy or No_Local_Protected_Objects apply. Add ??? comment. * sem_ch9.adb (Analyze_Protected_Type): Give a warning when a protected type is not a library-level type and No_Local_Protected_Objects applies. (Analyze_Task_Type): Give a warning when a task type is not a library-level type and No_Task_Hierarchy applies. Index: sem_ch9.adb =================================================================== --- sem_ch9.adb (revision 162866) +++ sem_ch9.adb (working copy) @@ -1178,6 +1178,27 @@ package body Sem_Ch9 is Analyze (Protected_Definition (N)); + -- In the case where the protected type is declared at a nested level + -- and the No_Local_Protected_Objects restriction applies, issue a + -- warning that objects of the type will violate the restriction. + + if not Is_Library_Level_Entity (T) + and then Comes_From_Source (T) + and then Restrictions.Set (No_Local_Protected_Objects) + then + Error_Msg_Sloc := Restrictions_Loc (No_Local_Protected_Objects); + + if Error_Msg_Sloc = No_Location then + Error_Msg_N + ("objects of this type will violate " & + "`No_Local_Protected_Objects`?", N); + else + Error_Msg_N + ("objects of this type will violate " & + "`No_Local_Protected_Objects`?#", N); + end if; + end if; + -- Protected types with entries are controlled (because of the -- Protection component if nothing else), same for any protected type -- with interrupt handlers. Note that we need to analyze the protected @@ -1970,8 +1991,23 @@ package body Sem_Ch9 is Analyze_Task_Definition (Task_Definition (N)); end if; - if not Is_Library_Level_Entity (T) then - Check_Restriction (No_Task_Hierarchy, N); + -- In the case where the task type is declared at a nested level and the + -- No_Task_Hierarchy restriction applies, issue a warning that objects + -- of the type will violate the restriction. + + if not Is_Library_Level_Entity (T) + and then Comes_From_Source (T) + and then Restrictions.Set (No_Task_Hierarchy) + then + Error_Msg_Sloc := Restrictions_Loc (No_Task_Hierarchy); + + if Error_Msg_Sloc = No_Location then + Error_Msg_N + ("objects of this type will violate `No_Task_Hierarchy`?", N); + else + Error_Msg_N + ("objects of this type will violate `No_Task_Hierarchy`?#", N); + end if; end if; End_Scope; Index: sem_ch4.adb =================================================================== --- sem_ch4.adb (revision 162901) +++ sem_ch4.adb (working copy) @@ -590,6 +590,25 @@ package body Sem_Ch4 is Check_Restriction (No_Tasking, N); Check_Restriction (Max_Tasks, N); Check_Restriction (No_Task_Allocators, N); + + -- Check that an allocator with task parts isn't for a nested access + -- type when restriction No_Task_Hierarchy applies. + + if not Is_Library_Level_Entity (Acc_Type) then + Check_Restriction (No_Task_Hierarchy, N); + end if; + end if; + + -- Check that an allocator of a nested access type doesn't create a + -- protected object when restriction No_Local_Protected_Objects applies. + -- We don't have an equivalent to Has_Task for protected types, so only + -- cases where the designated type itself is a protected type are + -- currently checked. ??? + + if Is_Protected_Type (Designated_Type (Acc_Type)) + and then not Is_Library_Level_Entity (Acc_Type) + then + Check_Restriction (No_Local_Protected_Objects, N); end if; -- If the No_Streams restriction is set, check that the type of the