From patchwork Tue Aug 10 13:51:04 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 61384 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 D2C6DB6F10 for ; Tue, 10 Aug 2010 23:51:39 +1000 (EST) Received: (qmail 17227 invoked by alias); 10 Aug 2010 13:51:31 -0000 Received: (qmail 16672 invoked by uid 22791); 10 Aug 2010 13:51:20 -0000 X-SWARE-Spam-Status: No, hits=-0.5 required=5.0 tests=AWL, BAYES_50, 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; Tue, 10 Aug 2010 13:51:07 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 948BBCB0234; Tue, 10 Aug 2010 15:51: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 H5eztNAHEyTl; Tue, 10 Aug 2010 15:51: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 7FD43CB01D6; Tue, 10 Aug 2010 15:51:04 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id 59FA0D9B31; Tue, 10 Aug 2010 15:51:04 +0200 (CEST) Date: Tue, 10 Aug 2010 15:51:04 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Robert Dewar Subject: [Ada] Fix missing cases for restriction No_Obsolescent_Features Message-ID: <20100810135104.GA7996@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 restriction No_Obsolescent_Features missed the following cases which should be handled: Ada 95 mode: J.1 J.2 J.3 J.6 J.9 Ada 2005 mode: J.10 J.11 J.12 J.13 J.14 this patch corrects all these missing cases The following test program generates error messages for all lines marked with -- J.n (the test should be run in both standard Ada 95 mode and with the -gnat05 switch to select Ada 2005 mode, the latter will flag the lines marked -- J.n (Ada 2005) pragma Restrictions (No_Obsolescent_Features); pragma Restrictions (No_Asynchronous_Control); -- J.13 (Ada 2005) pragma Restrictions (No_Unchecked_Deallocation); -- J.13 (Ada 2005) pragma Restrictions (No_Unchecked_Conversion); -- J.13 (Ada 2005) with Text_IO; -- J.1 with Ada.Characters.Handling; with System.Storage_Elements; procedure Test_Obsolete is package SSE renames System.Storage_Elements; S : String := %aaa%; -- J.2 type My_Fix is delta 0.001 range -100.0 .. 100.0; subtype My_Fix_Subtype is My_Fix delta 0.01; -- J.3 package Inner is type P is private; private type P is (A, B, C); end Inner; B : Boolean := Inner.P'Constrained; -- J.4 C : Character := ASCII.NUL; -- J.5 procedure Raise_Numeric_Error (I : Integer) is begin if I = 0 then raise Numeric_Error; -- J.6 end if; end Raise_Numeric_Error; I : Integer; for I use at SSE.To_Address (16#FFFF_0020#); -- J.7 task type Interrupt_Handler is entry Done; for Done'Address -- J.7.1 use SSE.To_Address (16#FFFF_0000#); end Interrupt_Handler; task body Interrupt_Handler is begin accept Done; end Interrupt_Handler; type Rec is record I : Integer; end record; for Rec use record at mod 8; -- J.8 I at 0 range 0 .. 32; end record; I1 : Integer := Interrupt_Handler'Storage_Size; -- J.9 pragma Suppress (Index_Check, On => S); -- J.10 (Ada 2005) type Incomplete; type Access_Incomplete is access Incomplete'Class; -- J.11 (Ada 2005) type Incomplete is tagged null record; function Local (X : Integer) return Integer; pragma Interface (C, Local); -- J.12 (Ada 2005) B1 : Boolean := Ada.Characters.Handling.Is_Character ('a'); -- J.14 (Ada 2005) function ISC (Item : Wide_Character) return Boolean renames Ada.Characters.Handling.Is_Character; -- J.14 (Ada 2005) type R is access function (Item : Wide_Character) return Boolean; -- J.14 (Ada 2005) RV : R := Ada.Characters.Handling.Is_Character'Access; begin null; end Test_Obsolete; Tested on x86_64-pc-linux-gnu, committed on trunk 2010-08-10 Robert Dewar * a-chahan.ads: Add comments on handling of obsolescent entries. * opt.ads: Add Ada_2005 and Ada_2012 renamings for versions. * restrict.adb (Check_Obsolescent_2005_Entity): New procedure. * restrict.ads (Check_Obsolescent_2005_Entity): New procedure. * sem_attr.adb (Analyze_Access_Attribute): Call Check_Obsolescent_2005_Entity to check for access to obsolescent Ada.Characters.Handling subprogram. (Analyze_Attribute, case Class): Applying Class to untagged incomplete type is obsolescent in Ada 2005. (Analyze_Attribute, case Constrained): Better placement of flag when flagged as obsolescent feature. (Analyze_Attribute, case Storage_Size): Use with tasks is obsolescent * sem_ch10.adb (Analyze_With_Clause): With of renamings such as Text_IO is an obsolescent feature. * sem_ch11.adb (Analyze_Raise_Statement): Numeric_Error is obsolescent feature. * sem_ch8.adb (Analyze_Subprogram_Renaming): Call Check_Obsolescent_2005_Entity to check for renaming obsolete Ada.Characters.Handling subprogram. * sem_prag.adb (Process_Restrictions_Or_Restriction_Warnings): Check for obsolescent restrictions in Ada 2005. (Analyze_Pragma, case Suppress): Entity arg is obsolescent in Ada 2005 (Analyze_Pragma, case Interface): Interface is obsolescent in Ada 2005 * sem_res.adb (Resolve_Call): Call Check_Obsolescent_2005_Entity to check for obsolescent references to Ada.Characters.Handling subprograms Index: sem_ch10.adb =================================================================== --- sem_ch10.adb (revision 163060) +++ sem_ch10.adb (working copy) @@ -2314,12 +2314,35 @@ package body Sem_Ch10 is -- Set True if the unit currently being compiled is an internal unit Save_Style_Check : constant Boolean := Opt.Style_Check; - Save_C_Restrict : constant Save_Cunit_Boolean_Restrictions := - Cunit_Boolean_Restrictions_Save; + Save_C_Restrict : Save_Cunit_Boolean_Restrictions; begin U := Unit (Library_Unit (N)); + -- If this is an internal unit which is a renaming, then this is a + -- violation of No_Obsolescent_Features. + + -- Note: this is not quite right if the user defines one of these units + -- himself, but that's a marginal case, and fixing it is hard ??? + + if Restriction_Active (No_Obsolescent_Features) then + declare + F : constant File_Name_Type := + Unit_File_Name (Get_Source_Unit (U)); + begin + if Is_Predefined_File_Name (F, Renamings_Included => True) + and then not + Is_Predefined_File_Name (F, Renamings_Included => False) + then + Check_Restriction (No_Obsolescent_Features, N); + end if; + end; + end if; + + -- Save current restriction set, does not apply to with'ed unit + + Save_C_Restrict := Cunit_Boolean_Restrictions_Save; + -- Several actions are skipped for dummy packages (those supplied for -- with's where no matching file could be found). Such packages are -- identified by the Sloc value being set to No_Location. @@ -2350,9 +2373,7 @@ package body Sem_Ch10 is -- explicit with'ing of run-time units. if Configurable_Run_Time_Mode - and then - Is_Predefined_File_Name - (Unit_File_Name (Get_Source_Unit (Unit (Library_Unit (N))))) + and then Is_Predefined_File_Name (Unit_File_Name (Get_Source_Unit (U))) then Configurable_Run_Time_Mode := False; Semantics (Library_Unit (N)); Index: sem_prag.adb =================================================================== --- sem_prag.adb (revision 163054) +++ sem_prag.adb (working copy) @@ -4430,6 +4430,19 @@ package body Sem_Prag is Restriction_Warnings (R_Id) := False; end if; + -- Check for obsolescent restrictions in Ada 2005 mode + + if not Warn + and then Ada_Version >= Ada_2005 + and then (R_Id = No_Asynchronous_Control + or else + R_Id = No_Unchecked_Deallocation + or else + R_Id = No_Unchecked_Conversion) + then + Check_Restriction (No_Obsolescent_Features, N); + end if; + -- A very special case that must be processed here: pragma -- Restrictions (No_Exceptions) turns off all run-time -- checking. This is a bit dubious in terms of the formal @@ -4621,6 +4634,12 @@ package body Sem_Prag is -- a specified entity (given as the second argument of the pragma) else + -- This is obsolescent in Ada 2005 mode + + if Ada_Version >= Ada_2005 then + Check_Restriction (No_Obsolescent_Features, Arg2); + end if; + Check_Optional_Identifier (Arg2, Name_On); E_Id := Expression (Arg2); Analyze (E_Id); @@ -8308,6 +8327,14 @@ package body Sem_Prag is Check_At_Most_N_Arguments (4); Process_Import_Or_Interface; + -- In Ada 2005, the permission to use Interface (a reserved word) + -- as a pragma name is considered an obsolescent feature. + + if Ada_Version >= Ada_2005 then + Check_Restriction + (No_Obsolescent_Features, Pragma_Identifier (N)); + end if; + -------------------- -- Interface_Name -- -------------------- Index: sem_res.adb =================================================================== --- sem_res.adb (revision 163054) +++ sem_res.adb (working copy) @@ -5250,7 +5250,7 @@ package body Sem_Res is K : constant Node_Kind := Nkind (Parent (N)); begin if (K = N_Loop_Statement - and then Present (Iteration_Scheme (Parent (N)))) + and then Present (Iteration_Scheme (Parent (N)))) or else K = N_If_Statement or else K = N_Elsif_Part or else K = N_Case_Statement_Alternative @@ -5276,6 +5276,10 @@ package body Sem_Res is end if; end if; + -- Check obsolescent reference to Ada.Characters.Handling subprogram + + Check_Obsolescent_2005_Entity (Nam, Subp); + -- If subprogram name is a predefined operator, it was given in -- functional notation. Replace call node with operator node, so -- that actuals can be resolved appropriately. Index: sem_attr.adb =================================================================== --- sem_attr.adb (revision 163054) +++ sem_attr.adb (working copy) @@ -584,6 +584,10 @@ package body Sem_Attr is Check_For_Eliminated_Subprogram (P, Entity (P)); + -- Check for obsolescent subprogram reference + + Check_Obsolescent_2005_Entity (Entity (P), P); + -- Build the appropriate subprogram type Build_Access_Subprogram_Type (P); @@ -2535,6 +2539,25 @@ package body Sem_Attr is Check_E0; Find_Type (N); + -- Applying Class to untagged incomplete type is obsolescent in Ada + -- 2005. Note that we can't test Is_Tagged_Type here on P_Type, since + -- this flag gets set by Find_Type in this situation. + + if Restriction_Active (No_Obsolescent_Features) + and then Ada_Version >= Ada_2005 + and then Ekind (P_Type) = E_Incomplete_Type + then + declare + DN : constant Node_Id := Declaration_Node (P_Type); + begin + if Nkind (DN) = N_Incomplete_Type_Declaration + and then not Tagged_Present (DN) + then + Check_Restriction (No_Obsolescent_Features, P); + end if; + end; + end if; + ------------------ -- Code_Address -- ------------------ @@ -2612,7 +2635,7 @@ package body Sem_Attr is -- Case from RM J.4(2) of constrained applied to private type if Is_Entity_Name (P) and then Is_Type (Entity (P)) then - Check_Restriction (No_Obsolescent_Features, N); + Check_Restriction (No_Obsolescent_Features, P); if Warn_On_Obsolescent_Feature then Error_Msg_N @@ -4197,6 +4220,10 @@ package body Sem_Attr is if Is_Task_Type (P_Type) then Set_Etype (N, Universal_Integer); + -- Use with tasks is an obsolescent feature + + Check_Restriction (No_Obsolescent_Features, P); + elsif Is_Access_Type (P_Type) then if Ekind (P_Type) = E_Access_Subprogram_Type then Error_Attr_P Index: restrict.adb =================================================================== --- restrict.adb (revision 163054) +++ restrict.adb (working copy) @@ -34,6 +34,7 @@ with Opt; use Opt; with Sinfo; use Sinfo; with Sinput; use Sinput; with Snames; use Snames; +with Stand; use Stand; with Uname; use Uname; package body Restrict is @@ -121,6 +122,46 @@ package body Restrict is Check_Restriction (No_Implicit_Heap_Allocations, N); end Check_No_Implicit_Heap_Alloc; + ----------------------------------- + -- Check_Obsolescent_2005_Entity -- + ----------------------------------- + + procedure Check_Obsolescent_2005_Entity (E : Entity_Id; N : Node_Id) is + function Chars_Is (E : Entity_Id; S : String) return Boolean; + -- Return True iff Chars (E) matches S (given in lower case) + + function Chars_Is (E : Entity_Id; S : String) return Boolean is + Nam : constant Name_Id := Chars (E); + begin + if Length_Of_Name (Nam) /= S'Length then + return False; + else + return Get_Name_String (Nam) = S; + end if; + end Chars_Is; + + -- Start of processing for Check_Obsolescent_2005_Entity + + begin + if Ada_Version >= Ada_2005 + and then Restriction_Active (No_Obsolescent_Features) + and then Chars_Is (Scope (E), "handling") + and then Chars_Is (Scope (Scope (E)), "characters") + and then Chars_Is (Scope (Scope (Scope (E))), "ada") + and then Scope (Scope (Scope (Scope (E)))) = Standard_Standard + then + if Chars_Is (E, "is_character") or else + Chars_Is (E, "is_string") or else + Chars_Is (E, "to_character") or else + Chars_Is (E, "to_string") or else + Chars_Is (E, "to_wide_character") or else + Chars_Is (E, "to_wide_string") + then + Check_Restriction (No_Obsolescent_Features, N); + end if; + end if; + end Check_Obsolescent_2005_Entity; + --------------------------- -- Check_Restricted_Unit -- --------------------------- Index: restrict.ads =================================================================== --- restrict.ads (revision 163054) +++ restrict.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -230,6 +230,15 @@ package Restrict is -- Equivalent to Check_Restriction (No_Implicit_Heap_Allocations, N). -- Provided for easy use by back end, which has to check this restriction. + procedure Check_Obsolescent_2005_Entity (E : Entity_Id; N : Node_Id); + -- This routine checks if the entity E is one of the obsolescent entries + -- in Ada.Characters.Handling in Ada 2005 and No_Obsolescent_Features + -- restriction is active. If so an appropriate message is given. N is + -- the node on which the message is to be placed. It's a bit kludgy to + -- have this highly specialized routine rather than some wonderful general + -- 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. + 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 163054) +++ sem_ch8.adb (working copy) @@ -2467,6 +2467,7 @@ package body Sem_Ch8 is end if; -- A useful warning, suggested by Ada Bug Finder (Ada-Europe 2005) + -- is to warn if an operator is being renamed as a different operator. if Comes_From_Source (N) and then Present (Old_S) @@ -2479,6 +2480,10 @@ package body Sem_Ch8 is New_S, Old_S); end if; + -- Check for renaming of obsolescent subprogram + + Check_Obsolescent_2005_Entity (Entity (Nam), Nam); + -- Another warning or some utility: if the new subprogram as the same -- name as the old one, the old one is not hidden by an outer homograph, -- the new one is not a public symbol, and the old one is otherwise Index: sem_ch11.adb =================================================================== --- sem_ch11.adb (revision 163054) +++ sem_ch11.adb (working copy) @@ -538,6 +538,14 @@ package body Sem_Ch11 is end if; end if; + -- Check obsolescent use of Numeric_Error + + if Exception_Name = Standard_Numeric_Error then + Check_Restriction (No_Obsolescent_Features, Exception_Id); + end if; + + -- Kill last assignment indication + Kill_Current_Values (Last_Assignment_Only => True); end Analyze_Raise_Statement; Index: opt.ads =================================================================== --- opt.ads (revision 163054) +++ opt.ads (working copy) @@ -68,6 +68,10 @@ package Opt is -- Versions of Ada for Ada_Version below. Note that these are ordered, -- so that tests like Ada_Version >= Ada_95 are legitimate and useful. + Ada_2005 : Ada_Version_Type renames Ada_05; + Ada_2012 : Ada_Version_Type renames Ada_12; + -- Renamings with full names (preferred usage) + Ada_Version_Default : constant Ada_Version_Type := Ada_05; pragma Warnings (Off, Ada_Version_Default); -- GNAT Index: a-chahan.ads =================================================================== --- a-chahan.ads (revision 163054) +++ a-chahan.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -95,6 +95,9 @@ package Ada.Characters.Handling is -- to use these routines when creating code that is intended to run in -- either Ada 95 or Ada 2005 mode. + -- We do however have to flag these if the pragma No_Obsolescent_Features + -- restriction is active (see Restrict.Check_Obsolescent_2005_Entity). + function Is_Character (Item : Wide_Character) return Boolean; function Is_String (Item : Wide_String) return Boolean; @@ -108,6 +111,9 @@ package Ada.Characters.Handling is -- to use these routines when creating code that is intended to run in -- either Ada 95 or Ada 2005 mode. + -- We do however have to flag these if the pragma No_Obsolescent_Features + -- restriction is active (see Restrict.Check_Obsolescent_2005_Entity). + function To_Character (Item : Wide_Character; Substitute : Character := ' ') return Character;