From patchwork Thu Sep 9 09:35:25 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 64265 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 A9706B6EF0 for ; Thu, 9 Sep 2010 19:35:51 +1000 (EST) Received: (qmail 24126 invoked by alias); 9 Sep 2010 09:35:48 -0000 Received: (qmail 23930 invoked by uid 22791); 9 Sep 2010 09:35:43 -0000 X-SWARE-Spam-Status: No, hits=-1.8 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) (212.99.106.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Thu, 09 Sep 2010 09:35:28 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id E6FE4CB0230; Thu, 9 Sep 2010 11:35:25 +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 NI2te6M9rmM9; Thu, 9 Sep 2010 11:35:25 +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 D407CCB021E; Thu, 9 Sep 2010 11:35:25 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id B417CD9BA8; Thu, 9 Sep 2010 11:35:25 +0200 (CEST) Date: Thu, 9 Sep 2010 11:35:25 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Robert Dewar Subject: [Ada] Fix missed cases for No_Wide_Characters restriction Message-ID: <20100909093525.GA23732@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 patch fixes a number of missed checks for the No_Wide_Characters restriction. The following comprehensive test case now gets properly flagged on every expected line: Compiling: no_wide_characters.adb 1. pragma Restrictions (No_Wide_Characters); 2. procedure No_Wide_Characters is 3. W_Char_1 : Wide_Character := 'a'; -- FLAG | >>> violation of restriction "No_Wide_Characters" at line 1 4. W_String_1 : Wide_String := "a"; -- FLAG | >>> violation of restriction "No_Wide_Characters" at line 1 5. 6. subtype My_Wide_Character is Wide_Character; -- FLAG | >>> violation of restriction "No_Wide_Characters" at line 1 7. subtype My_Wide_String is Wide_String (1 .. 5); -- FLAG | >>> violation of restriction "No_Wide_Characters" at line 1 8. 9. W_Char_2 : My_Wide_Character := 'a'; -- FLAG | >>> violation of restriction "No_Wide_Characters" at line 1 10. W_String_2 : My_Wide_String := "12345"; -- FLAG | >>> violation of restriction "No_Wide_Characters" at line 1 11. 12. type My_Array_1 13. is array (Wide_Character'First .. -- FLAG | >>> violation of restriction "No_Wide_Characters" at line 1 14. Wide_Character'Last) of Integer; -- FLAG | >>> violation of restriction "No_Wide_Characters" at line 1 15. 16. procedure Proc 17. (W_Ch : Standard.Wide_Character; -- FLAG | >>> violation of restriction "No_Wide_Characters" at line 1 18. W_Str : Wide_String) -- FLAG | >>> violation of restriction "No_Wide_Characters" at line 1 19. is 20. begin 21. null; 22. end; 23. 24. function Fun_W_Ch 25. (Ch : Character) 26. return Standard.Wide_Character -- FLAG | >>> violation of restriction "No_Wide_Characters" at line 1 27. is 28. begin 29. return '["1234"]'; -- FLAG | >>> violation of restriction "No_Wide_Characters" at line 1 30. end; 31. 32. function Fun_W_Str 33. (Str : String) 34. return Wide_String -- FLAG | >>> violation of restriction "No_Wide_Characters" at line 1 35. is 36. begin 37. return "["1234"]"; -- FLAG | >>> violation of restriction "No_Wide_Characters" at line 1 38. end; 39. 40. type R is ('a', '["1234"]'); -- FLAG | >>> violation of restriction "No_Wide_Characters" at line 1 41. 42. begin 43. null; 44. end No_Wide_Characters; 44 lines: 15 errors As a side effect the list of possible restrictions now accurately includes No_Wide_Characters if and only if this is correct. Tested on x86_64-pc-linux-gnu, committed on trunk 2010-09-09 Robert Dewar * restrict.ads, restrict.adb (Check_Wide_Character_Restriction): New procedure. * sem_ch3.adb: Use Check_Wide_Character_Restriction (Enumeration_Type_Declaration): Check violation of No_Wide_Characters * sem_ch8.adb (Find_Direct_Name): Check violation of No_Wide_Characters (Find_Expanded_Name): Check violation of No_Wide_Characters Index: sem_ch3.adb =================================================================== --- sem_ch3.adb (revision 164000) +++ sem_ch3.adb (working copy) @@ -2960,13 +2960,7 @@ package body Sem_Ch3 is -- Check No_Wide_Characters restriction - if T = Standard_Wide_Character - or else T = Standard_Wide_Wide_Character - or else Root_Type (T) = Standard_Wide_String - or else Root_Type (T) = Standard_Wide_Wide_String - then - Check_Restriction (No_Wide_Characters, Object_Definition (N)); - end if; + Check_Wide_Character_Restriction (T, Object_Definition (N)); -- Indicate this is not set in source. Certainly true for constants, -- and true for variables so far (will be reset for a variable if and @@ -13677,8 +13671,20 @@ package body Sem_Ch3 is Generate_Definition (L); Set_Convention (L, Convention_Intrinsic); + -- Case of character literal + if Nkind (L) = N_Defining_Character_Literal then Set_Is_Character_Type (T, True); + + -- Check violation of No_Wide_Characters + + if Restriction_Active (No_Wide_Characters) then + Get_Name_String (Chars (L)); + + if Name_Len >= 3 and then Name_Buffer (1 .. 2) = "QW" then + Check_Restriction (No_Wide_Characters, L); + end if; + end if; end if; Ev := Ev + 1; @@ -14211,13 +14217,7 @@ package body Sem_Ch3 is -- Check No_Wide_Characters restriction - if Typ = Standard_Wide_Character - or else Typ = Standard_Wide_Wide_Character - or else Typ = Standard_Wide_String - or else Typ = Standard_Wide_Wide_String - then - Check_Restriction (No_Wide_Characters, S); - end if; + Check_Wide_Character_Restriction (Typ, S); return Typ; end Find_Type_Of_Subtype_Indic; Index: restrict.adb =================================================================== --- restrict.adb (revision 164000) +++ restrict.adb (working copy) @@ -25,6 +25,7 @@ with Atree; use Atree; with Casing; use Casing; +with Einfo; use Einfo; with Errout; use Errout; with Debug; use Debug; with Fname; use Fname; @@ -396,6 +397,29 @@ package body Restrict is end loop; end Check_Restriction_No_Dependence; + -------------------------------------- + -- Check_Wide_Character_Restriction -- + -------------------------------------- + + procedure Check_Wide_Character_Restriction (E : Entity_Id; N : Node_Id) is + begin + if Restriction_Active (No_Wide_Characters) + and then Comes_From_Source (N) + then + declare + T : constant Entity_Id := Root_Type (E); + begin + if T = Standard_Wide_Character or else + T = Standard_Wide_String or else + T = Standard_Wide_Wide_Character or else + T = Standard_Wide_Wide_String + then + Check_Restriction (No_Wide_Characters, N); + end if; + end; + end if; + end Check_Wide_Character_Restriction; + ---------------------------------------- -- Cunit_Boolean_Restrictions_Restore -- ---------------------------------------- Index: restrict.ads =================================================================== --- restrict.ads (revision 164000) +++ restrict.ads (working copy) @@ -239,6 +239,12 @@ package Restrict is -- mechanism (e.g. a special pragma) to handle this case, but there are -- only six cases, and it is not worth the effort to do something general. + procedure Check_Wide_Character_Restriction (E : Entity_Id; N : Node_Id); + -- This procedure checks if the No_Wide_Character restriction is active, + -- and if so, if N Comes_From_Source, and the root type of E is one of + -- [Wide_]Wide_Character or [Wide_]Wide_String, then the restriction + -- violation is recorded, and an appropriate message given. + function Cunit_Boolean_Restrictions_Save return Save_Cunit_Boolean_Restrictions; -- This function saves the compilation unit restriction settings, and Index: sem_ch8.adb =================================================================== --- sem_ch8.adb (revision 164000) +++ sem_ch8.adb (working copy) @@ -454,8 +454,9 @@ package body Sem_Ch8 is -- private with on E. procedure Find_Expanded_Name (N : Node_Id); - -- Selected component is known to be expanded name. Verify legality of - -- selector given the scope denoted by prefix. + -- The input is a selected component is known to be expanded name. Verify + -- legality of selector given the scope denoted by prefix, and change node + -- N into a expanded name with a properly set Entity field. function Find_Renamed_Entity (N : Node_Id; @@ -4411,6 +4412,10 @@ package body Sem_Ch8 is <> begin + -- Check violation of No_Wide_Characters restriction + + Check_Wide_Character_Restriction (E, N); + -- When distribution features are available (Get_PCS_Name /= -- Name_No_DSA), a remote access-to-subprogram type is converted -- into a record type holding whatever information is needed to @@ -4960,6 +4965,10 @@ package body Sem_Ch8 is Set_Etype (N, Get_Full_View (Etype (Id))); end if; + -- Check for violation of No_Wide_Characters + + Check_Wide_Character_Restriction (Id, N); + -- If the Ekind of the entity is Void, it means that all homonyms are -- hidden from all visibility (RM 8.3(5,14-20)). @@ -7330,8 +7339,8 @@ package body Sem_Ch8 is and then Scope (Id) /= Scope (Prev) and then Used_As_Generic_Actual (Scope (Prev)) and then Used_As_Generic_Actual (Scope (Id)) - and then List_Containing (Current_Use_Clause (Scope (Prev))) /= - List_Containing (Current_Use_Clause (Scope (Id))) + and then not In_Same_List (Current_Use_Clause (Scope (Prev)), + Current_Use_Clause (Scope (Id))) then Set_Is_Potentially_Use_Visible (Prev, False); Append_Elmt (Prev, Hidden_By_Use_Clause (N));