OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

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.

From-SVN: r177140
This commit is contained in:
Arnaud Charlet 2011-08-02 14:48:37 +02:00
parent aa1e353a7a
commit 499769ec33
13 changed files with 610 additions and 521 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
gcc/ada/ChangeLog
View File

@ -1,3 +1,30 @@
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

7
gcc/ada/opt.ads
View File

@ -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

45
gcc/ada/prepcomp.adb
View File

@ -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;

6
gcc/ada/prepcomp.ads
View File

@ -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

1
gcc/ada/sem_ch13.adb
View File

@ -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;

11
gcc/ada/sem_ch3.adb
View File

@ -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;

1
gcc/ada/sem_prag.adb
View File

@ -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

423
gcc/ada/sem_warn.adb
View File

@ -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 --
-----------------------------

36
gcc/ada/sem_warn.ads
View File

@ -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 --
------------------------------------------

45
gcc/ada/switch-c.adb
View File

@ -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

6
gcc/ada/switch-c.ads
View File

@ -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

453
gcc/ada/warnsw.adb Normal file
View File

@ -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;

70
gcc/ada/warnsw.ads Normal file
View File

@ -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;