+2011-08-02 Javier Miranda <miranda@adacore.com>
+
+ * sem_ch3.adb (Check_Anonymous_Access_Components): Create extra formals
+ associated with anonymous access to subprograms.
+
+2011-08-02 Geert Bosch <bosch@adacore.com>
+
+ * 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 <moy@adacore.com>
* sem_ch3.adb (Analyze_Object_Declaration): issue an error in formal
-- 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
-- --
------------------------------------------------------------------------------
-with Ada.Unchecked_Deallocation;
-
with Errout; use Errout;
with Lib.Writ; use Lib.Writ;
with Opt; use Opt;
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;
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 --
-------------------
-- 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;
-- --
-- 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- --
-- 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
with Ttypes; use Ttypes;
with Tbuild; use Tbuild;
with Urealp; use Urealp;
+with Warnsw; use Warnsw;
with GNAT.Heap_Sort_G;
-- 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 =>
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;
with Uname; use Uname;
with Urealp; use Urealp;
with Validsw; use Validsw;
+with Warnsw; use Warnsw;
package body Sem_Prag 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 --
-----------------------------
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 --
------------------------
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 --
------------------------------------------
-- --
------------------------------------------------------------------------------
+-- 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
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
-- 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;
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
-- --
-- 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- --
-- 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
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
projects / gcc.git / commitdiff