From patchwork Fri Oct 22 09:15: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: 68814 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 29E40B71D1 for ; Fri, 22 Oct 2010 20:15:26 +1100 (EST) Received: (qmail 26882 invoked by alias); 22 Oct 2010 09:15:19 -0000 Received: (qmail 26835 invoked by uid 22791); 22 Oct 2010 09:15:16 -0000 X-SWARE-Spam-Status: No, hits=-1.5 required=5.0 tests=AWL, BAYES_00, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (194.98.77.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Fri, 22 Oct 2010 09:15:06 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id BDF19CB0223; Fri, 22 Oct 2010 11:15:03 +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 pBEnijNxo2JR; Fri, 22 Oct 2010 11:15:03 +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 AB78ACB01D6; Fri, 22 Oct 2010 11:15:03 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id 8D6B4D9BB4; Fri, 22 Oct 2010 11:15:03 +0200 (CEST) Date: Fri, 22 Oct 2010 11:15:03 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Robert Dewar Subject: [Ada] Check bad use of predicates Message-ID: <20101022091503.GA4358@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 This checks for some disallowed use of subtypes with predicates as shown by the following test compiled with -gnat12 -gnatld7 -gnatj60: 1. package Bad_Predicates is 2. -- This test should get compile-time errors 3. 4. type Color is 5. (Red, Orange, Yellow, Green, 6. Blue, Indigo, Violet); 7. subtype RGB is Color with 8. Predicate => 9. RGB = Red or RGB in Green .. Blue; 10. subtype Other_Color is Color with 11. Predicate => Other_Color not in RGB; 12. 13. subtype Another_Color is Other_Color; 14. 15. type Bad_Array is array 16. (Another_Color range <>) of Character; | >>> subtype "Another_Color" has predicate, not allowed as index subtype 17. -- ERROR: Subtype with predicate not 18. -- allowed as index subtype 19. 20. type OK_Array is array 21. (Color range <>) of Character; 22. 23. subtype Bad_Array_Subtype is 24. OK_Array (Another_Color); | >>> subtype "Another_Color" has predicate, not allowed in index consraint 25. -- ERROR: Subtype with predicate not 26. -- allowed in index_constraint 27. 28. OK : constant OK_Array := (Color => 'x'); 29. 30. Bad_Slice : constant OK_Array := 31. OK (Another_Color); | >>> subtype "Another_Color" has predicate, not allowed in slice 32. -- ERROR: Subtype with predicate not 33. -- allowed in slice 34. 35. protected type Prot is 36. entry Bad_Family 37. (Another_Color) (X : Integer); | >>> subtype "Another_Color" has predicate, not allowed in entry family 38. -- ERROR: Subtype with predicate not 39. -- allowed in entry family 40. end Prot; 41. 42. end Bad_Predicates; Tested on x86_64-pc-linux-gnu, committed on trunk 2010-10-22 Robert Dewar * sem_ch3.adb (Array_Type_Declaration): Error for subtype wi predicate for index type (Constrain_Index): Error of subtype wi predicate in index constraint * sem_ch9.adb (Analyze_Entry_Declaration): Error of subtype wi predicate in entry family. * sem_res.adb (Resolve_Slice): Error of type wi predicate in slice. Index: sem_ch3.adb =================================================================== --- sem_ch3.adb (revision 165804) +++ sem_ch3.adb (working copy) @@ -446,7 +446,7 @@ package body Sem_Ch3 is Related_Id : Entity_Id; Suffix : Character; Suffix_Index : Nat); - -- Process an index constraint in a constrained array declaration. The + -- Process an index constraint S in a constrained array declaration. The -- constraint can be a subtype name, or a range with or without an explicit -- subtype mark. The index is the corresponding index of the unconstrained -- array. The Related_Id and Suffix parameters are used to build the @@ -4424,6 +4424,17 @@ package body Sem_Ch3 is end if; Make_Index (Index, P, Related_Id, Nb_Index); + + -- Check error of subtype with predicate for index type + + if Has_Predicates (Etype (Index)) then + Error_Msg_NE + ("subtype& has predicate, not allowed as index subtype", + Index, Etype (Index)); + end if; + + -- Move to next index + Next_Index (Index); Nb_Index := Nb_Index + 1; end loop; @@ -11332,6 +11343,13 @@ package body Sem_Ch3 is elsif Base_Type (Entity (S)) /= Base_Type (T) then Wrong_Type (S, Base_Type (T)); + + -- Check error of subtype with predicate in index constraint + + elsif Has_Predicates (Entity (S)) then + Error_Msg_NE + ("subtype& has predicate, not allowed in index consraint", + S, Entity (S)); end if; return; Index: sem_ch9.adb =================================================================== --- sem_ch9.adb (revision 165803) +++ sem_ch9.adb (working copy) @@ -879,19 +879,36 @@ package body Sem_Ch9 is Generate_Definition (Def_Id); Tasking_Used := True; + -- Case of no discrete subtype definition + if No (D_Sdef) then Set_Ekind (Def_Id, E_Entry); + + -- Processing for discrete subtype definition present + else Enter_Name (Def_Id); Set_Ekind (Def_Id, E_Entry_Family); Analyze (D_Sdef); Make_Index (D_Sdef, N, Def_Id); + + -- Check subtype with predicate in entry family + + if Has_Predicates (Etype (D_Sdef)) then + Error_Msg_NE + ("subtype& has predicate, not allowed in entry family", + D_Sdef, Etype (D_Sdef)); + end if; end if; + -- Decorate Def_Id + Set_Etype (Def_Id, Standard_Void_Type); Set_Convention (Def_Id, Convention_Entry); Set_Accept_Address (Def_Id, New_Elmt_List); + -- Process formals + if Present (Formals) then Set_Scope (Def_Id, Current_Scope); Push_Scope (Def_Id); Index: sem_res.adb =================================================================== --- sem_res.adb (revision 165803) +++ sem_res.adb (working copy) @@ -8478,7 +8478,16 @@ package body Sem_Res is Set_Slice_Subtype (N); - if Nkind (Drange) = N_Range then + -- Check bad use of type with predicates + + if Has_Predicates (Etype (Drange)) then + Error_Msg_NE + ("subtype& has predicate, not allowed in slice", + Drange, Etype (Drange)); + + -- Otherwise here is where we check suspicious indexes + + elsif Nkind (Drange) = N_Range then Warn_On_Suspicious_Index (Name, Low_Bound (Drange)); Warn_On_Suspicious_Index (Name, High_Bound (Drange)); end if;