From 499769ec33c515c433e407ee25729018457ed295 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 2 Aug 2011 14:48:37 +0200 Subject: [PATCH] [multiple changes] 2011-08-02 Javier Miranda * sem_ch3.adb (Check_Anonymous_Access_Components): Create extra formals associated with anonymous access to subprograms. 2011-08-02 Geert Bosch * opt.ads (Preprocessing_Symbol_Defs): Move from Prepcomp.Symbol_Definitions. (Preprocessing_Symbol_Last): Move from Prepcomp.Last_Definition. * prepcomp.adb (Symbol_Definitions, Last_Definition): Move to opt.ads (Add_Symbol_Definition): Move to switch-c.adb (Process_Command_Line_Symbol_Definitions): Adjust references to above. * prepcomp.ads: Remove dependency on Ada.Unchecked_Deallocation. (Add_Symbol_Definition): Move to switch-c.adb. * sem_ch13.adb, sem_prag.adb: Add dependency on Warnsw. * sem_warn.adb (Set_Dot_Warning_Switch, Set_GNAT_Mode_Warnings, Set_Warning_Switch): Move to warnsw.adb. * sem_warn.ads (Warn_On_Record_Holes, Warn_On_Overridden_Size, Set_Dot_Warning_Switch, Set_GNAT_Mode_Warnings, Set_Warning_Switch): Move to warnsw.adb. * switch-c.adb: Replace dependency on Prepcomp and Sem_Warn by Warnsw. (Add_Symbol_Definition): Moved from Prepcomp. * switch-c.ads: Update copyright notice. Use String_List instead of Argument_List, removing dependency on System.OS_Lib. From-SVN: r177140 --- gcc/ada/ChangeLog | 27 +++ gcc/ada/opt.ads | 7 + gcc/ada/prepcomp.adb | 45 +---- gcc/ada/prepcomp.ads | 6 +- gcc/ada/sem_ch13.adb | 1 + gcc/ada/sem_ch3.adb | 11 +- gcc/ada/sem_prag.adb | 1 + gcc/ada/sem_warn.adb | 423 ---------------------------------------- gcc/ada/sem_warn.ads | 36 ---- gcc/ada/switch-c.adb | 45 ++++- gcc/ada/switch-c.ads | 6 +- gcc/ada/warnsw.adb | 453 +++++++++++++++++++++++++++++++++++++++++++ gcc/ada/warnsw.ads | 70 +++++++ 13 files changed, 610 insertions(+), 521 deletions(-) create mode 100644 gcc/ada/warnsw.adb create mode 100644 gcc/ada/warnsw.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f478f3c2007..0d78dae154e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,30 @@ +2011-08-02 Javier Miranda + + * sem_ch3.adb (Check_Anonymous_Access_Components): Create extra formals + associated with anonymous access to subprograms. + +2011-08-02 Geert Bosch + + * opt.ads + (Preprocessing_Symbol_Defs): Move from Prepcomp.Symbol_Definitions. + (Preprocessing_Symbol_Last): Move from Prepcomp.Last_Definition. + * prepcomp.adb (Symbol_Definitions, Last_Definition): Move to opt.ads + (Add_Symbol_Definition): Move to switch-c.adb + (Process_Command_Line_Symbol_Definitions): Adjust references to above. + * prepcomp.ads: Remove dependency on Ada.Unchecked_Deallocation. + (Add_Symbol_Definition): Move to switch-c.adb. + * sem_ch13.adb, sem_prag.adb: Add dependency on Warnsw. + * sem_warn.adb + (Set_Dot_Warning_Switch, Set_GNAT_Mode_Warnings, Set_Warning_Switch): + Move to warnsw.adb. + * sem_warn.ads (Warn_On_Record_Holes, Warn_On_Overridden_Size, + Set_Dot_Warning_Switch, Set_GNAT_Mode_Warnings, Set_Warning_Switch): + Move to warnsw.adb. + * switch-c.adb: Replace dependency on Prepcomp and Sem_Warn by Warnsw. + (Add_Symbol_Definition): Moved from Prepcomp. + * switch-c.ads: Update copyright notice. Use String_List instead of + Argument_List, removing dependency on System.OS_Lib. + 2011-08-02 Yannick Moy * sem_ch3.adb (Analyze_Object_Declaration): issue an error in formal diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 3f3b8725699..bd97c0df807 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -1077,6 +1077,13 @@ package Opt is -- GNAT -- Set by switch -gnatep=. The file name of the preprocessing data file. + Preprocessing_Symbol_Defs : String_List_Access := new String_List (1 .. 4); + -- An extensible array to temporarily stores symbol definitions specified + -- on the command line with -gnateD switches. + + Preprocessing_Symbol_Last : Natural := 0; + -- Index of last symbol definition in array Symbol_Definitions + Print_Generated_Code : Boolean := False; -- GNAT -- Set to True to enable output of generated code in source form. This diff --git a/gcc/ada/prepcomp.adb b/gcc/ada/prepcomp.adb index 62f962aa40a..2da21df3c42 100644 --- a/gcc/ada/prepcomp.adb +++ b/gcc/ada/prepcomp.adb @@ -23,8 +23,6 @@ -- -- ------------------------------------------------------------------------------ -with Ada.Unchecked_Deallocation; - with Errout; use Errout; with Lib.Writ; use Lib.Writ; with Opt; use Opt; @@ -55,20 +53,6 @@ package body Prepcomp is No_Mapping : Prep.Symbol_Table.Instance; pragma Warnings (On); - type String_Ptr is access String; - type String_Array is array (Positive range <>) of String_Ptr; - type String_Array_Ptr is access String_Array; - - procedure Free is - new Ada.Unchecked_Deallocation (String_Array, String_Array_Ptr); - - Symbol_Definitions : String_Array_Ptr := new String_Array (1 .. 4); - -- An extensible array to temporarily stores symbol definitions specified - -- on the command line with -gnateD switches. - - Last_Definition : Natural := 0; - -- Index of last symbol definition in array Symbol_Definitions - type Preproc_Data is record Mapping : Symbol_Table.Instance; File_Name : File_Name_Type := No_File; @@ -161,31 +145,6 @@ package body Prepcomp is end loop; end Add_Dependencies; - --------------------------- - -- Add_Symbol_Definition -- - --------------------------- - - procedure Add_Symbol_Definition (Def : String) is - begin - -- If Symbol_Definitions is not large enough, double it - - if Last_Definition = Symbol_Definitions'Last then - declare - New_Symbol_Definitions : constant String_Array_Ptr := - new String_Array (1 .. 2 * Last_Definition); - - begin - New_Symbol_Definitions (Symbol_Definitions'Range) := - Symbol_Definitions.all; - Free (Symbol_Definitions); - Symbol_Definitions := New_Symbol_Definitions; - end; - end if; - - Last_Definition := Last_Definition + 1; - Symbol_Definitions (Last_Definition) := new String'(Def); - end Add_Symbol_Definition; - ------------------- -- Check_Symbols -- ------------------- @@ -740,12 +699,12 @@ package body Prepcomp is -- The command line definitions have been stored temporarily in -- array Symbol_Definitions. - for Index in 1 .. Last_Definition loop + for Index in 1 .. Preprocessing_Symbol_Last loop -- Check each symbol definition, fail immediately if syntax is not -- correct. Check_Command_Line_Symbol_Definition - (Definition => Symbol_Definitions (Index).all, + (Definition => Preprocessing_Symbol_Defs (Index).all, Data => Symbol_Data); Found := False; diff --git a/gcc/ada/prepcomp.ads b/gcc/ada/prepcomp.ads index 5e747a14877..1dc6205d68e 100644 --- a/gcc/ada/prepcomp.ads +++ b/gcc/ada/prepcomp.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2002-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- -- @@ -33,10 +33,6 @@ package Prepcomp is -- Add dependencies on the preprocessing data file and the -- preprocessing definition files, if any. - procedure Add_Symbol_Definition (Def : String); - -- Add a symbol definition from the command line. - -- Fail if definition is illegal. - procedure Check_Symbols; -- Check if there are preprocessing symbols on the command line and -- set preprocessing if there are some: all files are preprocessed with diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 60851e496b3..dadb7b1b530 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -60,6 +60,7 @@ with Targparm; use Targparm; with Ttypes; use Ttypes; with Tbuild; use Tbuild; with Urealp; use Urealp; +with Warnsw; use Warnsw; with GNAT.Heap_Sort_G; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 5e937249b58..36563286d87 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -18760,7 +18760,7 @@ package body Sem_Ch3 is -- an access_to_object or an access_to_subprogram. if Present (Acc_Def) then - if Nkind (Acc_Def) = N_Access_Function_Definition then + if Nkind (Acc_Def) = N_Access_Function_Definition then Type_Def := Make_Access_Function_Definition (Loc, Parameter_Specifications => @@ -18799,10 +18799,15 @@ package body Sem_Ch3 is Insert_Before (Typ_Decl, Decl); Analyze (Decl); - -- If an access to object, Preserve entity of designated type, + -- If an access to subprogram, create the extra formals + + if Present (Acc_Def) then + Create_Extra_Formals (Designated_Type (Anon_Access)); + + -- If an access to object, preserve entity of designated type, -- for ASIS use, before rewriting the component definition. - if No (Acc_Def) then + else declare Desig : Entity_Id; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 3bb93684358..27264662c46 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -84,6 +84,7 @@ with Uintp; use Uintp; with Uname; use Uname; with Urealp; use Urealp; with Validsw; use Validsw; +with Warnsw; use Warnsw; package body Sem_Prag is diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 9388c662900..fdd32ba0ba4 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -3034,429 +3034,6 @@ package body Sem_Warn is end if; end Referenced_As_Out_Parameter_Check_Spec; - ---------------------------- - -- Set_Dot_Warning_Switch -- - ---------------------------- - - function Set_Dot_Warning_Switch (C : Character) return Boolean is - begin - case C is - when 'a' => - Warn_On_Assertion_Failure := True; - - when 'A' => - Warn_On_Assertion_Failure := False; - - when 'b' => - Warn_On_Biased_Representation := True; - - when 'B' => - Warn_On_Biased_Representation := False; - - when 'c' => - Warn_On_Unrepped_Components := True; - - when 'C' => - Warn_On_Unrepped_Components := False; - - when 'e' => - Address_Clause_Overlay_Warnings := True; - Check_Unreferenced := True; - Check_Unreferenced_Formals := True; - Check_Withs := True; - Constant_Condition_Warnings := True; - Elab_Warnings := True; - Implementation_Unit_Warnings := True; - Ineffective_Inline_Warnings := True; - List_Inherited_Aspects := True; - Warn_On_Ada_2005_Compatibility := True; - Warn_On_Ada_2012_Compatibility := True; - Warn_On_All_Unread_Out_Parameters := True; - Warn_On_Assertion_Failure := True; - Warn_On_Assumed_Low_Bound := True; - Warn_On_Bad_Fixed_Value := True; - Warn_On_Biased_Representation := True; - Warn_On_Constant := True; - Warn_On_Deleted_Code := True; - Warn_On_Dereference := True; - Warn_On_Export_Import := True; - Warn_On_Hiding := True; - Warn_On_Modified_Unread := True; - Warn_On_No_Value_Assigned := True; - Warn_On_Non_Local_Exception := True; - Warn_On_Object_Renames_Function := True; - Warn_On_Obsolescent_Feature := True; - Warn_On_Overlap := True; - Warn_On_Overridden_Size := True; - Warn_On_Parameter_Order := True; - Warn_On_Questionable_Missing_Parens := True; - Warn_On_Record_Holes := True; - Warn_On_Redundant_Constructs := True; - Warn_On_Reverse_Bit_Order := True; - Warn_On_Unchecked_Conversion := True; - Warn_On_Unordered_Enumeration_Type := True; - Warn_On_Unrecognized_Pragma := True; - Warn_On_Unrepped_Components := True; - Warn_On_Warnings_Off := True; - - when 'g' => - Set_GNAT_Mode_Warnings; - - when 'h' => - Warn_On_Record_Holes := True; - - when 'H' => - Warn_On_Record_Holes := False; - - when 'i' => - Warn_On_Overlap := True; - - when 'I' => - Warn_On_Overlap := False; - - when 'l' => - List_Inherited_Aspects := True; - - when 'L' => - List_Inherited_Aspects := False; - - when 'm' => - Warn_On_Suspicious_Modulus_Value := True; - - when 'M' => - Warn_On_Suspicious_Modulus_Value := False; - - when 'o' => - Warn_On_All_Unread_Out_Parameters := True; - - when 'O' => - Warn_On_All_Unread_Out_Parameters := False; - - when 'p' => - Warn_On_Parameter_Order := True; - - when 'P' => - Warn_On_Parameter_Order := False; - - when 'r' => - Warn_On_Object_Renames_Function := True; - - when 'R' => - Warn_On_Object_Renames_Function := False; - - when 's' => - Warn_On_Overridden_Size := True; - - when 'S' => - Warn_On_Overridden_Size := False; - - when 'u' => - Warn_On_Unordered_Enumeration_Type := True; - - when 'U' => - Warn_On_Unordered_Enumeration_Type := False; - - when 'v' => - Warn_On_Reverse_Bit_Order := True; - - when 'V' => - Warn_On_Reverse_Bit_Order := False; - - when 'w' => - Warn_On_Warnings_Off := True; - - when 'W' => - Warn_On_Warnings_Off := False; - - when 'x' => - Warn_On_Non_Local_Exception := True; - - when 'X' => - Warn_On_Non_Local_Exception := False; - No_Warn_On_Non_Local_Exception := True; - - when others => - return False; - end case; - - return True; - end Set_Dot_Warning_Switch; - - ---------------------------- - -- Set_GNAT_Mode_Warnings -- - ---------------------------- - - procedure Set_GNAT_Mode_Warnings is - begin - Address_Clause_Overlay_Warnings := True; - Check_Unreferenced := True; - Check_Unreferenced_Formals := True; - Check_Withs := True; - Constant_Condition_Warnings := True; - Elab_Warnings := False; - Implementation_Unit_Warnings := False; - Ineffective_Inline_Warnings := True; - List_Inherited_Aspects := False; - Warn_On_Ada_2005_Compatibility := True; - Warn_On_Ada_2012_Compatibility := True; - Warn_On_All_Unread_Out_Parameters := False; - Warn_On_Assertion_Failure := True; - Warn_On_Assumed_Low_Bound := True; - Warn_On_Bad_Fixed_Value := True; - Warn_On_Biased_Representation := True; - Warn_On_Constant := True; - Warn_On_Deleted_Code := False; - Warn_On_Dereference := False; - Warn_On_Export_Import := True; - Warn_On_Hiding := False; - Warn_On_Modified_Unread := True; - Warn_On_No_Value_Assigned := True; - Warn_On_Non_Local_Exception := False; - Warn_On_Object_Renames_Function := False; - Warn_On_Obsolescent_Feature := True; - Warn_On_Questionable_Missing_Parens := True; - Warn_On_Redundant_Constructs := True; - Warn_On_Reverse_Bit_Order := False; - Warn_On_Object_Renames_Function := True; - Warn_On_Unchecked_Conversion := True; - Warn_On_Unordered_Enumeration_Type := False; - Warn_On_Unrecognized_Pragma := True; - Warn_On_Unrepped_Components := False; - Warn_On_Warnings_Off := False; - end Set_GNAT_Mode_Warnings; - - ------------------------ - -- Set_Warning_Switch -- - ------------------------ - - function Set_Warning_Switch (C : Character) return Boolean is - begin - case C is - when 'a' => - Check_Unreferenced := True; - Check_Unreferenced_Formals := True; - Check_Withs := True; - Constant_Condition_Warnings := True; - Implementation_Unit_Warnings := True; - Ineffective_Inline_Warnings := True; - List_Inherited_Aspects := True; - Warn_On_Ada_2005_Compatibility := True; - Warn_On_Ada_2012_Compatibility := True; - Warn_On_Assertion_Failure := True; - Warn_On_Assumed_Low_Bound := True; - Warn_On_Bad_Fixed_Value := True; - Warn_On_Biased_Representation := True; - Warn_On_Constant := True; - Warn_On_Export_Import := True; - Warn_On_Modified_Unread := True; - Warn_On_No_Value_Assigned := True; - Warn_On_Non_Local_Exception := True; - Warn_On_Object_Renames_Function := True; - Warn_On_Obsolescent_Feature := True; - Warn_On_Parameter_Order := True; - Warn_On_Questionable_Missing_Parens := True; - Warn_On_Redundant_Constructs := True; - Warn_On_Reverse_Bit_Order := True; - Warn_On_Unchecked_Conversion := True; - Warn_On_Unrecognized_Pragma := True; - Warn_On_Unrepped_Components := True; - - when 'A' => - Address_Clause_Overlay_Warnings := False; - Check_Unreferenced := False; - Check_Unreferenced_Formals := False; - Check_Withs := False; - Constant_Condition_Warnings := False; - Elab_Warnings := False; - Implementation_Unit_Warnings := False; - Ineffective_Inline_Warnings := False; - List_Inherited_Aspects := False; - Warn_On_Ada_2005_Compatibility := False; - Warn_On_Ada_2012_Compatibility := False; - Warn_On_All_Unread_Out_Parameters := False; - Warn_On_Assertion_Failure := False; - Warn_On_Assumed_Low_Bound := False; - Warn_On_Bad_Fixed_Value := False; - Warn_On_Biased_Representation := False; - Warn_On_Constant := False; - Warn_On_Deleted_Code := False; - Warn_On_Dereference := False; - Warn_On_Export_Import := False; - Warn_On_Hiding := False; - Warn_On_Modified_Unread := False; - Warn_On_No_Value_Assigned := False; - Warn_On_Non_Local_Exception := False; - Warn_On_Object_Renames_Function := False; - Warn_On_Obsolescent_Feature := False; - Warn_On_Overlap := False; - Warn_On_Overridden_Size := False; - Warn_On_Parameter_Order := False; - Warn_On_Record_Holes := False; - Warn_On_Questionable_Missing_Parens := False; - Warn_On_Redundant_Constructs := False; - Warn_On_Reverse_Bit_Order := False; - Warn_On_Unchecked_Conversion := False; - Warn_On_Unordered_Enumeration_Type := False; - Warn_On_Unrecognized_Pragma := False; - Warn_On_Unrepped_Components := False; - Warn_On_Warnings_Off := False; - - No_Warn_On_Non_Local_Exception := True; - - when 'b' => - Warn_On_Bad_Fixed_Value := True; - - when 'B' => - Warn_On_Bad_Fixed_Value := False; - - when 'c' => - Constant_Condition_Warnings := True; - - when 'C' => - Constant_Condition_Warnings := False; - - when 'd' => - Warn_On_Dereference := True; - - when 'D' => - Warn_On_Dereference := False; - - when 'e' => - Warning_Mode := Treat_As_Error; - - when 'f' => - Check_Unreferenced_Formals := True; - - when 'F' => - Check_Unreferenced_Formals := False; - - when 'g' => - Warn_On_Unrecognized_Pragma := True; - - when 'G' => - Warn_On_Unrecognized_Pragma := False; - - when 'h' => - Warn_On_Hiding := True; - - when 'H' => - Warn_On_Hiding := False; - - when 'i' => - Implementation_Unit_Warnings := True; - - when 'I' => - Implementation_Unit_Warnings := False; - - when 'j' => - Warn_On_Obsolescent_Feature := True; - - when 'J' => - Warn_On_Obsolescent_Feature := False; - - when 'k' => - Warn_On_Constant := True; - - when 'K' => - Warn_On_Constant := False; - - when 'l' => - Elab_Warnings := True; - - when 'L' => - Elab_Warnings := False; - - when 'm' => - Warn_On_Modified_Unread := True; - - when 'M' => - Warn_On_Modified_Unread := False; - - when 'n' => - Warning_Mode := Normal; - - when 'o' => - Address_Clause_Overlay_Warnings := True; - - when 'O' => - Address_Clause_Overlay_Warnings := False; - - when 'p' => - Ineffective_Inline_Warnings := True; - - when 'P' => - Ineffective_Inline_Warnings := False; - - when 'q' => - Warn_On_Questionable_Missing_Parens := True; - - when 'Q' => - Warn_On_Questionable_Missing_Parens := False; - - when 'r' => - Warn_On_Redundant_Constructs := True; - - when 'R' => - Warn_On_Redundant_Constructs := False; - - when 's' => - Warning_Mode := Suppress; - - when 't' => - Warn_On_Deleted_Code := True; - - when 'T' => - Warn_On_Deleted_Code := False; - - when 'u' => - Check_Unreferenced := True; - Check_Withs := True; - Check_Unreferenced_Formals := True; - - when 'U' => - Check_Unreferenced := False; - Check_Withs := False; - Check_Unreferenced_Formals := False; - - when 'v' => - Warn_On_No_Value_Assigned := True; - - when 'V' => - Warn_On_No_Value_Assigned := False; - - when 'w' => - Warn_On_Assumed_Low_Bound := True; - - when 'W' => - Warn_On_Assumed_Low_Bound := False; - - when 'x' => - Warn_On_Export_Import := True; - - when 'X' => - Warn_On_Export_Import := False; - - when 'y' => - Warn_On_Ada_2005_Compatibility := True; - Warn_On_Ada_2012_Compatibility := True; - - when 'Y' => - Warn_On_Ada_2005_Compatibility := False; - Warn_On_Ada_2012_Compatibility := False; - - when 'z' => - Warn_On_Unchecked_Conversion := True; - - when 'Z' => - Warn_On_Unchecked_Conversion := False; - - when others => - return False; - end case; - - return True; - end Set_Warning_Switch; - ----------------------------- -- Warn_On_Known_Condition -- ----------------------------- diff --git a/gcc/ada/sem_warn.ads b/gcc/ada/sem_warn.ads index eb756ed627a..cd075f8b890 100644 --- a/gcc/ada/sem_warn.ads +++ b/gcc/ada/sem_warn.ads @@ -33,26 +33,6 @@ with Types; use Types; package Sem_Warn is - ------------------- - -- Warning Flags -- - ------------------- - - -- These flags are activated or deactivated by -gnatw switches and control - -- whether warnings of a given class will be generated or not. - - -- Note: most of these flags are still in opt, but the plan is to move them - -- here as time goes by. - - Warn_On_Record_Holes : Boolean := False; - -- Warn when explicit record component clauses leave uncovered holes (gaps) - -- in a record layout. Off by default, set by -gnatw.h (but not -gnatwa). - - Warn_On_Overridden_Size : Boolean := False; - -- Warn when explicit record component clause or array component_size - -- clause specifies a size that overrides a size for the type which was - -- set with an explicit size clause. Off by default, set by -gnatw.s (but - -- not -gnatwa). - ------------------------ -- Warnings Off Table -- ------------------------ @@ -85,22 +65,6 @@ package Sem_Warn is procedure Initialize; -- Initialize this package for new compilation - function Set_Warning_Switch (C : Character) return Boolean; - -- This function sets the warning switch or switches corresponding to the - -- given character. It is used to process a -gnatw switch on the command - -- line, or a character in a string literal in pragma Warnings. Returns - -- True for valid warning character C, False for invalid character. - - function Set_Dot_Warning_Switch (C : Character) return Boolean; - -- This function sets the warning switch or switches corresponding to the - -- given character preceded by a dot. Used to process a -gnatw. switch on - -- the command line or .C in a string literal in pragma Warnings. Returns - -- True for valid warning character C, False for invalid character. - - procedure Set_GNAT_Mode_Warnings; - -- This is called in -gnatg mode to set the warnings for gnat mode. It is - -- also used to set the proper warning statuses for -gnatw.g. - ------------------------------------------ -- Routines to Handle Unused References -- ------------------------------------------ diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index a4423dc3143..bda476bdf97 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -23,16 +23,18 @@ -- -- ------------------------------------------------------------------------------ +-- This package is for switch processing and should not depend on higher level +-- packages such as those for the scanner, parser, etc. Doing so may cause +-- circularities, especially for back ends using Adabkend. + with Debug; use Debug; with Lib; use Lib; with Osint; use Osint; with Opt; use Opt; -with Prepcomp; use Prepcomp; with Validsw; use Validsw; -with Sem_Warn; use Sem_Warn; with Stylesw; use Stylesw; +with Warnsw; use Warnsw; -with System.Strings; with System.WCh_Con; use System.WCh_Con; package body Switch.C is @@ -40,9 +42,12 @@ package body Switch.C is RTS_Specified : String_Access := null; -- Used to detect multiple use of --RTS= flag + procedure Add_Symbol_Definition (Def : String); + -- Add a symbol definition from the command line + function Switch_Subsequently_Cancelled (C : String; - Args : Argument_List; + Args : String_List; Arg_Rank : Positive) return Boolean; -- This function is called from Scan_Front_End_Switches. It determines if -- the switch currently being scanned is followed by a switch of the form @@ -50,13 +55,39 @@ package body Switch.C is -- and Scan_Front_End_Switches will cancel the effect of the switch. If -- no such switch is found, False is returned. + --------------------------- + -- Add_Symbol_Definition -- + --------------------------- + + procedure Add_Symbol_Definition (Def : String) is + begin + -- If Preprocessor_Symbol_Defs is not large enough, double its size + + if Preprocessing_Symbol_Last = Preprocessing_Symbol_Defs'Last then + declare + New_Symbol_Definitions : constant String_List_Access := + new String_List (1 .. 2 * Preprocessing_Symbol_Last); + + begin + New_Symbol_Definitions (Preprocessing_Symbol_Defs'Range) := + Preprocessing_Symbol_Defs.all; + Free (Preprocessing_Symbol_Defs); + Preprocessing_Symbol_Defs := New_Symbol_Definitions; + end; + end if; + + Preprocessing_Symbol_Last := Preprocessing_Symbol_Last + 1; + Preprocessing_Symbol_Defs (Preprocessing_Symbol_Last) + := new String'(Def); + end Add_Symbol_Definition; + ----------------------------- -- Scan_Front_End_Switches -- ----------------------------- procedure Scan_Front_End_Switches (Switch_Chars : String; - Args : Argument_List; + Args : String_List; Arg_Rank : Positive) is First_Switch : Boolean := True; @@ -1157,11 +1188,9 @@ package body Switch.C is function Switch_Subsequently_Cancelled (C : String; - Args : Argument_List; + Args : String_List; Arg_Rank : Positive) return Boolean is - use type System.Strings.String_Access; - begin -- Loop through arguments following the current one diff --git a/gcc/ada/switch-c.ads b/gcc/ada/switch-c.ads index 1595858a28d..a8327813ac6 100644 --- a/gcc/ada/switch-c.ads +++ b/gcc/ada/switch-c.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-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- -- @@ -29,13 +29,13 @@ -- switches that are recognized. In addition, package Debug documents -- the otherwise undocumented debug switches that are also recognized. -with System.OS_Lib; use System.OS_Lib; +with System.Strings; use System.Strings; package Switch.C is procedure Scan_Front_End_Switches (Switch_Chars : String; - Args : Argument_List; + Args : String_List; Arg_Rank : Positive); -- Procedures to scan out front end switches stored in the given string. -- The first character is known to be a valid switch character, and there diff --git a/gcc/ada/warnsw.adb b/gcc/ada/warnsw.adb new file mode 100644 index 00000000000..c226f3bf48c --- /dev/null +++ b/gcc/ada/warnsw.adb @@ -0,0 +1,453 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- W A R N S W -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 1999-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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING3. If not, go to -- +-- http://www.gnu.org/licenses for a complete copy of the license. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +with Opt; use Opt; + +package body Warnsw is + + ---------------------------- + -- Set_Dot_Warning_Switch -- + ---------------------------- + + function Set_Dot_Warning_Switch (C : Character) return Boolean is + begin + case C is + when 'a' => + Warn_On_Assertion_Failure := True; + + when 'A' => + Warn_On_Assertion_Failure := False; + + when 'b' => + Warn_On_Biased_Representation := True; + + when 'B' => + Warn_On_Biased_Representation := False; + + when 'c' => + Warn_On_Unrepped_Components := True; + + when 'C' => + Warn_On_Unrepped_Components := False; + + when 'e' => + Address_Clause_Overlay_Warnings := True; + Check_Unreferenced := True; + Check_Unreferenced_Formals := True; + Check_Withs := True; + Constant_Condition_Warnings := True; + Elab_Warnings := True; + Implementation_Unit_Warnings := True; + Ineffective_Inline_Warnings := True; + List_Inherited_Aspects := True; + Warn_On_Ada_2005_Compatibility := True; + Warn_On_Ada_2012_Compatibility := True; + Warn_On_All_Unread_Out_Parameters := True; + Warn_On_Assertion_Failure := True; + Warn_On_Assumed_Low_Bound := True; + Warn_On_Bad_Fixed_Value := True; + Warn_On_Biased_Representation := True; + Warn_On_Constant := True; + Warn_On_Deleted_Code := True; + Warn_On_Dereference := True; + Warn_On_Export_Import := True; + Warn_On_Hiding := True; + Warn_On_Modified_Unread := True; + Warn_On_No_Value_Assigned := True; + Warn_On_Non_Local_Exception := True; + Warn_On_Object_Renames_Function := True; + Warn_On_Obsolescent_Feature := True; + Warn_On_Overlap := True; + Warn_On_Overridden_Size := True; + Warn_On_Parameter_Order := True; + Warn_On_Questionable_Missing_Parens := True; + Warn_On_Record_Holes := True; + Warn_On_Redundant_Constructs := True; + Warn_On_Reverse_Bit_Order := True; + Warn_On_Unchecked_Conversion := True; + Warn_On_Unordered_Enumeration_Type := True; + Warn_On_Unrecognized_Pragma := True; + Warn_On_Unrepped_Components := True; + Warn_On_Warnings_Off := True; + + when 'g' => + Set_GNAT_Mode_Warnings; + + when 'h' => + Warn_On_Record_Holes := True; + + when 'H' => + Warn_On_Record_Holes := False; + + when 'i' => + Warn_On_Overlap := True; + + when 'I' => + Warn_On_Overlap := False; + + when 'l' => + List_Inherited_Aspects := True; + + when 'L' => + List_Inherited_Aspects := False; + + when 'm' => + Warn_On_Suspicious_Modulus_Value := True; + + when 'M' => + Warn_On_Suspicious_Modulus_Value := False; + + when 'o' => + Warn_On_All_Unread_Out_Parameters := True; + + when 'O' => + Warn_On_All_Unread_Out_Parameters := False; + + when 'p' => + Warn_On_Parameter_Order := True; + + when 'P' => + Warn_On_Parameter_Order := False; + + when 'r' => + Warn_On_Object_Renames_Function := True; + + when 'R' => + Warn_On_Object_Renames_Function := False; + + when 's' => + Warn_On_Overridden_Size := True; + + when 'S' => + Warn_On_Overridden_Size := False; + + when 'u' => + Warn_On_Unordered_Enumeration_Type := True; + + when 'U' => + Warn_On_Unordered_Enumeration_Type := False; + + when 'v' => + Warn_On_Reverse_Bit_Order := True; + + when 'V' => + Warn_On_Reverse_Bit_Order := False; + + when 'w' => + Warn_On_Warnings_Off := True; + + when 'W' => + Warn_On_Warnings_Off := False; + + when 'x' => + Warn_On_Non_Local_Exception := True; + + when 'X' => + Warn_On_Non_Local_Exception := False; + No_Warn_On_Non_Local_Exception := True; + + when others => + return False; + end case; + + return True; + end Set_Dot_Warning_Switch; + + ---------------------------- + -- Set_GNAT_Mode_Warnings -- + ---------------------------- + + procedure Set_GNAT_Mode_Warnings is + begin + Address_Clause_Overlay_Warnings := True; + Check_Unreferenced := True; + Check_Unreferenced_Formals := True; + Check_Withs := True; + Constant_Condition_Warnings := True; + Elab_Warnings := False; + Implementation_Unit_Warnings := False; + Ineffective_Inline_Warnings := True; + List_Inherited_Aspects := False; + Warn_On_Ada_2005_Compatibility := True; + Warn_On_Ada_2012_Compatibility := True; + Warn_On_All_Unread_Out_Parameters := False; + Warn_On_Assertion_Failure := True; + Warn_On_Assumed_Low_Bound := True; + Warn_On_Bad_Fixed_Value := True; + Warn_On_Biased_Representation := True; + Warn_On_Constant := True; + Warn_On_Deleted_Code := False; + Warn_On_Dereference := False; + Warn_On_Export_Import := True; + Warn_On_Hiding := False; + Warn_On_Modified_Unread := True; + Warn_On_No_Value_Assigned := True; + Warn_On_Non_Local_Exception := False; + Warn_On_Object_Renames_Function := False; + Warn_On_Obsolescent_Feature := True; + Warn_On_Questionable_Missing_Parens := True; + Warn_On_Redundant_Constructs := True; + Warn_On_Reverse_Bit_Order := False; + Warn_On_Object_Renames_Function := True; + Warn_On_Unchecked_Conversion := True; + Warn_On_Unordered_Enumeration_Type := False; + Warn_On_Unrecognized_Pragma := True; + Warn_On_Unrepped_Components := False; + Warn_On_Warnings_Off := False; + end Set_GNAT_Mode_Warnings; + + ------------------------ + -- Set_Warning_Switch -- + ------------------------ + + function Set_Warning_Switch (C : Character) return Boolean is + begin + case C is + when 'a' => + Check_Unreferenced := True; + Check_Unreferenced_Formals := True; + Check_Withs := True; + Constant_Condition_Warnings := True; + Implementation_Unit_Warnings := True; + Ineffective_Inline_Warnings := True; + List_Inherited_Aspects := True; + Warn_On_Ada_2005_Compatibility := True; + Warn_On_Ada_2012_Compatibility := True; + Warn_On_Assertion_Failure := True; + Warn_On_Assumed_Low_Bound := True; + Warn_On_Bad_Fixed_Value := True; + Warn_On_Biased_Representation := True; + Warn_On_Constant := True; + Warn_On_Export_Import := True; + Warn_On_Modified_Unread := True; + Warn_On_No_Value_Assigned := True; + Warn_On_Non_Local_Exception := True; + Warn_On_Object_Renames_Function := True; + Warn_On_Obsolescent_Feature := True; + Warn_On_Parameter_Order := True; + Warn_On_Questionable_Missing_Parens := True; + Warn_On_Redundant_Constructs := True; + Warn_On_Reverse_Bit_Order := True; + Warn_On_Unchecked_Conversion := True; + Warn_On_Unrecognized_Pragma := True; + Warn_On_Unrepped_Components := True; + + when 'A' => + Address_Clause_Overlay_Warnings := False; + Check_Unreferenced := False; + Check_Unreferenced_Formals := False; + Check_Withs := False; + Constant_Condition_Warnings := False; + Elab_Warnings := False; + Implementation_Unit_Warnings := False; + Ineffective_Inline_Warnings := False; + List_Inherited_Aspects := False; + Warn_On_Ada_2005_Compatibility := False; + Warn_On_Ada_2012_Compatibility := False; + Warn_On_All_Unread_Out_Parameters := False; + Warn_On_Assertion_Failure := False; + Warn_On_Assumed_Low_Bound := False; + Warn_On_Bad_Fixed_Value := False; + Warn_On_Biased_Representation := False; + Warn_On_Constant := False; + Warn_On_Deleted_Code := False; + Warn_On_Dereference := False; + Warn_On_Export_Import := False; + Warn_On_Hiding := False; + Warn_On_Modified_Unread := False; + Warn_On_No_Value_Assigned := False; + Warn_On_Non_Local_Exception := False; + Warn_On_Object_Renames_Function := False; + Warn_On_Obsolescent_Feature := False; + Warn_On_Overlap := False; + Warn_On_Overridden_Size := False; + Warn_On_Parameter_Order := False; + Warn_On_Record_Holes := False; + Warn_On_Questionable_Missing_Parens := False; + Warn_On_Redundant_Constructs := False; + Warn_On_Reverse_Bit_Order := False; + Warn_On_Unchecked_Conversion := False; + Warn_On_Unordered_Enumeration_Type := False; + Warn_On_Unrecognized_Pragma := False; + Warn_On_Unrepped_Components := False; + Warn_On_Warnings_Off := False; + + No_Warn_On_Non_Local_Exception := True; + + when 'b' => + Warn_On_Bad_Fixed_Value := True; + + when 'B' => + Warn_On_Bad_Fixed_Value := False; + + when 'c' => + Constant_Condition_Warnings := True; + + when 'C' => + Constant_Condition_Warnings := False; + + when 'd' => + Warn_On_Dereference := True; + + when 'D' => + Warn_On_Dereference := False; + + when 'e' => + Warning_Mode := Treat_As_Error; + + when 'f' => + Check_Unreferenced_Formals := True; + + when 'F' => + Check_Unreferenced_Formals := False; + + when 'g' => + Warn_On_Unrecognized_Pragma := True; + + when 'G' => + Warn_On_Unrecognized_Pragma := False; + + when 'h' => + Warn_On_Hiding := True; + + when 'H' => + Warn_On_Hiding := False; + + when 'i' => + Implementation_Unit_Warnings := True; + + when 'I' => + Implementation_Unit_Warnings := False; + + when 'j' => + Warn_On_Obsolescent_Feature := True; + + when 'J' => + Warn_On_Obsolescent_Feature := False; + + when 'k' => + Warn_On_Constant := True; + + when 'K' => + Warn_On_Constant := False; + + when 'l' => + Elab_Warnings := True; + + when 'L' => + Elab_Warnings := False; + + when 'm' => + Warn_On_Modified_Unread := True; + + when 'M' => + Warn_On_Modified_Unread := False; + + when 'n' => + Warning_Mode := Normal; + + when 'o' => + Address_Clause_Overlay_Warnings := True; + + when 'O' => + Address_Clause_Overlay_Warnings := False; + + when 'p' => + Ineffective_Inline_Warnings := True; + + when 'P' => + Ineffective_Inline_Warnings := False; + + when 'q' => + Warn_On_Questionable_Missing_Parens := True; + + when 'Q' => + Warn_On_Questionable_Missing_Parens := False; + + when 'r' => + Warn_On_Redundant_Constructs := True; + + when 'R' => + Warn_On_Redundant_Constructs := False; + + when 's' => + Warning_Mode := Suppress; + + when 't' => + Warn_On_Deleted_Code := True; + + when 'T' => + Warn_On_Deleted_Code := False; + + when 'u' => + Check_Unreferenced := True; + Check_Withs := True; + Check_Unreferenced_Formals := True; + + when 'U' => + Check_Unreferenced := False; + Check_Withs := False; + Check_Unreferenced_Formals := False; + + when 'v' => + Warn_On_No_Value_Assigned := True; + + when 'V' => + Warn_On_No_Value_Assigned := False; + + when 'w' => + Warn_On_Assumed_Low_Bound := True; + + when 'W' => + Warn_On_Assumed_Low_Bound := False; + + when 'x' => + Warn_On_Export_Import := True; + + when 'X' => + Warn_On_Export_Import := False; + + when 'y' => + Warn_On_Ada_2005_Compatibility := True; + Warn_On_Ada_2012_Compatibility := True; + + when 'Y' => + Warn_On_Ada_2005_Compatibility := False; + Warn_On_Ada_2012_Compatibility := False; + + when 'z' => + Warn_On_Unchecked_Conversion := True; + + when 'Z' => + Warn_On_Unchecked_Conversion := False; + + when others => + return False; + end case; + + return True; + end Set_Warning_Switch; + +end Warnsw; diff --git a/gcc/ada/warnsw.ads b/gcc/ada/warnsw.ads new file mode 100644 index 00000000000..1aa34929427 --- /dev/null +++ b/gcc/ada/warnsw.ads @@ -0,0 +1,70 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- W A R N S W -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 1999-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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING3. If not, go to -- +-- http://www.gnu.org/licenses for a complete copy of the license. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This unit contains the routines used to handle setting of warning options. + +package Warnsw is + + ------------------- + -- Warning Flags -- + ------------------- + + -- These flags are activated or deactivated by -gnatw switches and control + -- whether warnings of a given class will be generated or not. + + -- Note: most of these flags are still in opt, but the plan is to move them + -- here as time goes by. + + Warn_On_Record_Holes : Boolean := False; + -- Warn when explicit record component clauses leave uncovered holes (gaps) + -- in a record layout. Off by default, set by -gnatw.h (but not -gnatwa). + + Warn_On_Overridden_Size : Boolean := False; + -- Warn when explicit record component clause or array component_size + -- clause specifies a size that overrides a size for the typen which was + -- set with an explicit size clause. Off by default, set by -gnatw.s (but + -- not -gnatwa). + + ----------------- + -- Subprograms -- + ----------------- + + function Set_Warning_Switch (C : Character) return Boolean; + -- This function sets the warning switch or switches corresponding to the + -- given character. It is used to process a -gnatw switch on the command + -- line, or a character in a string literal in pragma Warnings. Returns + -- True for valid warning character C, False for invalid character. + + function Set_Dot_Warning_Switch (C : Character) return Boolean; + -- This function sets the warning switch or switches corresponding to the + -- given character preceded by a dot. Used to process a -gnatw. switch on + -- the command line or .C in a string literal in pragma Warnings. Returns + -- True for valid warning character C, False for invalid character. + + procedure Set_GNAT_Mode_Warnings; + -- This is called in -gnatg mode to set the warnings for gnat mode. It is + -- also used to set the proper warning statuses for -gnatw.g. + +end Warnsw; -- 2.30.2