Skip to content

R
riscv-gcc-1
Commit fbe627af by Robert Dewar Committed by Arnaud Charlet
Options

g-comlin.ads, [...]: Add new warning for renaming of function return objects 

2007-04-20  Robert Dewar  <dewar@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>

	* g-comlin.ads, g-comlin.adb: 
	Add new warning for renaming of function return objects

	* opt.adb (Tree_Write, Tree_Read): Use proper expressions for size
	(Tree_Read): Use size of object instead of type'object_size, since the
	latter is incorrect for packed array types.
	(Tree_Write): Same fix

	* opt.ads: Add new warning for renaming of function return objects
	(Generating_Code): New boolean variable used to indicate that the
	frontend as finished its work and has called the backend to process
	the tree and generate the object file.
	(GCC_Version): Is now private
	(Static_Dispatch_Tables): New constant declaration.
	(Overflow_Checks_Unsuppressed): New flag.
	(Process_Suppress_Unsuppress): Set Overflow_Checks_Unsuppressed.
	(List_Closure): New flag for gnatbind (-R)
	Zero_Formatting: New flag for gnatbind (-Z)
	(Special_Exception_Package_Used): New flag.
	(Warn_On_Unrepped_Components): New flag.

	* sem_ch8.adb (Check_Library_Unit_Renaming): Check that the renamed
	unit is a compilation unit, rather than relying on its scope, so that
	Standard can be renamed.
	(Analyze_Object_Renaming): Add new warning for renaming of function
	return objects.
	Also reject attempt to rename function return object in Ada 83 mode.
	(Attribute_Renaming): In case of tagged types, add the body of the
	generated function to the freezing actions of the type.
	(Find_Type): A protected type is visible right after the reserved word
	"is" is encountered in its type declaration. Set the entity and type
	rather than emitting an error message.
	(New_Scope): Properly propagate Discard_Names to inner scopes
	(Check_Nested_Access): New procedure.
	(Has_Nested_Access, Set_Has_Nested_Access): New procedures.
	(Find_Direct_Name, Note_Possible_Modification): Use Check_Nested_Access.

	* sem_warn.ads, sem_warn.adb: Improvements to infinite loop warning
	Add new warning for renaming of function return objects
	(Check_References): Suppress warnings for objects whose type or
	base type has Warnings suppressed.
	(Set_Dot_Warning_Switch): Add processing for -gnatw.c/C
	(Set_Warning_Switch): Include new -gnatwc in -gnatwa

From-SVN: r125414
parent f24f72e8
Showing with 96 additions and 37 deletions
gcc/ada/g-comlin.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1999-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1999-2007, 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- --
......@@ -32,7 +32,7 @@
------------------------------------------------------------------------------
with Ada.Command_Line;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with GNAT.OS_Lib; use GNAT.OS_Lib;
package body GNAT.Command_Line is
......@@ -142,9 +142,9 @@ package body GNAT.Command_Line is
use GNAT.Directory_Operations;
type Pointer is access all Expansion_Iterator;
It : constant Pointer := Iterator'Unrestricted_Access;
S : String (1 .. 1024);
Last : Natural;
It : constant Pointer := Iterator'Unrestricted_Access;
Current : Depth := It.Current_Depth;
NL : Positive;
......@@ -304,8 +304,8 @@ package body GNAT.Command_Line is
if Do_Expansion then
declare
Arg : String renames CL.Argument (Current_Argument - 1);
Index : Positive := Arg'First;
Arg : constant String := CL.Argument (Current_Argument - 1);
Index : Positive := Arg'First;
begin
while Index <= Arg'Last loop
......@@ -381,7 +381,7 @@ package body GNAT.Command_Line is
end if;
declare
Arg : String renames CL.Argument (Current_Argument);
Arg : constant String := CL.Argument (Current_Argument);
Index_Switches : Natural := 0;
Max_Length : Natural := 0;
Index : Natural;
......@@ -780,9 +780,9 @@ package body GNAT.Command_Line is
is
Directory_Separator : Character;
pragma Import (C, Directory_Separator, "__gnat_dir_separator");
First : Positive := Pattern'First;
Pat : String := Pattern;
First : Positive := Pattern'First;
Pat : String := Pattern;
begin
Canonical_Case_File_Name (Pat);
......@@ -838,7 +838,6 @@ package body GNAT.Command_Line is
exit when Iterator.Maximum_Depth = Max_Depth;
end if;
end loop;
end Start_Expansion;
begin
......
gcc/ada/g-comlin.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1999-2005, AdaCore --
-- Copyright (C) 1999-2007, AdaCore --
-- --
-- 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- --
......@@ -322,7 +322,6 @@ private
Maximum_Depth : Depth := 1;
-- The maximum depth of directories, reflecting the number of directory
-- separators in the pattern.
end record;
end GNAT.Command_Line;
gcc/ada/opt.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2007, 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- --
......@@ -37,6 +37,9 @@ with Tree_IO; use Tree_IO;
package body Opt is
SU : constant := Storage_Unit;
-- Shorthand for System.Storage_Unit
----------------------------------
-- Register_Opt_Config_Switches --
----------------------------------
......@@ -169,10 +172,10 @@ package body Opt is
Tree_Read_Char (Identifier_Character_Set);
Tree_Read_Int (Maximum_File_Name_Length);
Tree_Read_Data (Suppress_Options'Address,
Suppress_Array'Object_Size / Storage_Unit);
(Suppress_Options'Size + SU - 1) / SU);
Tree_Read_Bool (Verbose_Mode);
Tree_Read_Data (Warning_Mode'Address,
Warning_Mode_Type'Object_Size / Storage_Unit);
(Warning_Mode'Size + SU - 1) / SU);
Tree_Read_Int (Ada_Version_Config_Val);
Tree_Read_Int (Ada_Version_Explicit_Config_Val);
Tree_Read_Int (Assertions_Enabled_Config_Val);
......@@ -198,23 +201,23 @@ package body Opt is
begin
Tree_Read_Data
(Tmp'Address, Tree_Version_String_Len);
GNAT.Strings.Free (Tree_Version_String);
System.Strings.Free (Tree_Version_String);
Free (Tree_Version_String);
Tree_Version_String := new String'(Tmp);
end;
Tree_Read_Data (Distribution_Stub_Mode'Address,
Distribution_Stub_Mode_Type'Object_Size / Storage_Unit);
(Distribution_Stub_Mode'Size + SU - 1) / Storage_Unit);
Tree_Read_Bool (Inline_Active);
Tree_Read_Bool (Inline_Processing_Required);
Tree_Read_Bool (List_Units);
Tree_Read_Bool (Configurable_Run_Time_Mode);
Tree_Read_Data (Operating_Mode'Address,
Operating_Mode_Type'Object_Size / Storage_Unit);
(Operating_Mode'Size + SU - 1) / Storage_Unit);
Tree_Read_Bool (Suppress_Checks);
Tree_Read_Bool (Try_Semantics);
Tree_Read_Data (Wide_Character_Encoding_Method'Address,
WC_Encoding_Method'Object_Size / Storage_Unit);
(Wide_Character_Encoding_Method'Size + SU - 1) / SU);
Tree_Read_Bool (Upper_Half_Encoding);
Tree_Read_Bool (Force_ALI_Tree_File);
end Tree_Read;
......@@ -233,10 +236,10 @@ package body Opt is
Tree_Write_Char (Identifier_Character_Set);
Tree_Write_Int (Maximum_File_Name_Length);
Tree_Write_Data (Suppress_Options'Address,
Suppress_Array'Object_Size / Storage_Unit);
(Suppress_Options'Size + SU - 1) / SU);
Tree_Write_Bool (Verbose_Mode);
Tree_Write_Data (Warning_Mode'Address,
Warning_Mode_Type'Object_Size / Storage_Unit);
(Warning_Mode'Size + SU - 1) / Storage_Unit);
Tree_Write_Int (Ada_Version_Type'Pos (Ada_Version_Config));
Tree_Write_Int (Ada_Version_Type'Pos (Ada_Version_Explicit_Config));
Tree_Write_Int (Boolean'Pos (Assertions_Enabled_Config));
......@@ -246,20 +249,19 @@ package body Opt is
Tree_Write_Bool (Enable_Overflow_Checks);
Tree_Write_Bool (Full_List);
Tree_Write_Int (Int (Version_String'Length));
Tree_Write_Data (Version_String'Address,
Version_String'Length);
Tree_Write_Data (Version_String'Address, Version_String'Length);
Tree_Write_Data (Distribution_Stub_Mode'Address,
Distribution_Stub_Mode_Type'Object_Size / Storage_Unit);
(Distribution_Stub_Mode'Size + SU - 1) / SU);
Tree_Write_Bool (Inline_Active);
Tree_Write_Bool (Inline_Processing_Required);
Tree_Write_Bool (List_Units);
Tree_Write_Bool (Configurable_Run_Time_Mode);
Tree_Write_Data (Operating_Mode'Address,
Operating_Mode_Type'Object_Size / Storage_Unit);
(Operating_Mode'Size + SU - 1) / SU);
Tree_Write_Bool (Suppress_Checks);
Tree_Write_Bool (Try_Semantics);
Tree_Write_Data (Wide_Character_Encoding_Method'Address,
WC_Encoding_Method'Object_Size / Storage_Unit);
(Wide_Character_Encoding_Method'Size + SU - 1) / SU);
Tree_Write_Bool (Upper_Half_Encoding);
Tree_Write_Bool (Force_ALI_Tree_File);
end Tree_Write;
......
gcc/ada/opt.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2007, 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- --
......@@ -39,8 +39,8 @@
with Hostparm; use Hostparm;
with Types; use Types;
with System.Strings; use System.Strings;
with System.WCh_Con; use System.WCh_Con;
with GNAT.Strings; use GNAT.Strings;
package Opt is
......@@ -386,6 +386,11 @@ package Opt is
-- Set to True if -gnato (enable overflow checks) switch is set,
-- but not -gnatp.
Overflow_Checks_Unsuppressed : Boolean := False;
-- GNAT
-- Set to True if at least one pragma Unsuppress
-- (All_Checks|Overflow_Checks) has been processed.
Error_Msg_Line_Length : Nat := 0;
-- GNAT
-- Records the error message line length limit. If this is set to zero,
......@@ -510,16 +515,15 @@ package Opt is
-- the name is of the form .xxx, then to name.xxx where name is the source
-- file name with extension stripped.
function get_gcc_version return Int;
pragma Import (C, get_gcc_version, "get_gcc_version");
GCC_Version : constant Nat := get_gcc_version;
-- GNATMAKE
-- Indicates which version of gcc is in use (2 = 2.8.1, 3 = 3.x)
Generating_Code : Boolean := False;
-- GNAT
-- True if the frontend finished its work and has called the backend to
-- processs the tree and generate the object file.
Global_Discard_Names : Boolean := False;
-- GNAT, GNATBIND
-- Set true if a pragma Discard_Names applies to the current unit
-- True if a pragma Discard_Names appeared as a configuration pragma for
-- the current compilation unit.
GNAT_Mode : Boolean := False;
-- GNAT
......@@ -633,6 +637,10 @@ package Opt is
-- GNAT
-- List units in the active library for a compilation (-gnatu switch)
List_Closure : Boolean := False;
-- GNATBIND
-- List all sources in the closure of a main (-R gnatbind switch)
List_Dependencies : Boolean := False;
-- GNATMAKE
-- When True gnatmake verifies that the objects are up to date and
......@@ -668,7 +676,7 @@ package Opt is
-- before preprocessing occurs. Set to True by switch -s of gnatprep
-- or -s in preprocessing data file for the compiler.
type Create_Repinfo_File_Proc is access procedure (Src : File_Name_Type);
type Create_Repinfo_File_Proc is access procedure (Src : String);
type Write_Repinfo_Line_Proc is access procedure (Info : String);
type Close_Repinfo_File_Proc is access procedure;
-- Types used for procedure addresses below
......@@ -753,6 +761,12 @@ package Opt is
-- GNATMAKE
-- Set to True if minimal recompilation mode requested
Special_Exception_Package_Used : Boolean := False;
-- GNAT
-- Set to True if either of the unit GNAT.Most_Recent_Exception or
-- GNAT.Exception_Traces is with'ed. Used to inhibit transformation of
-- local raise statements into gotos in the presence of either package.
Multiple_Unit_Index : Int;
-- GNAT
-- This is set non-zero if the current unit is being compiled in multiple
......@@ -1186,6 +1200,11 @@ package Opt is
-- Set to True to generate warnings for redundant constructs (e.g. useless
-- assignments/conversions). The default is that this warning is disabled.
Warn_On_Object_Renames_Function : Boolean := False;
-- GNAT
-- Set to True to generate warnings when a function result is renamed as
-- an object. The default is that this warning is disabled.
Warn_On_Reverse_Bit_Order : Boolean := True;
-- GNAT
-- Set to True to generate warning (informational) messages for component
......@@ -1203,6 +1222,12 @@ package Opt is
-- Set to True to generate warnings for unrecognized pragmas. The default
-- is that this warning is enabled.
Warn_On_Unrepped_Components : Boolean := False;
-- GNAT
-- Set to True to generate warnings for the case of components of record
-- which have a record representation clause but this component does not
-- have a component clause. The default is that this warning is disabled.
type Warning_Mode_Type is (Suppress, Normal, Treat_As_Error);
Warning_Mode : Warning_Mode_Type := Normal;
-- GNAT, GNATBIND
......@@ -1226,6 +1251,11 @@ package Opt is
-- GNAT
-- Set if cross-referencing is enabled (i.e. xref info in ALI files)
Zero_Formatting : Boolean := False;
-- GNATBIND
-- Do no formatting (no title, no leading spaces, no empty lines) in
-- auxiliary outputs (-e, -K, -l, -R).
----------------------------
-- Configuration Settings --
----------------------------
......@@ -1362,6 +1392,15 @@ package Opt is
-- Other Global Flags --
------------------------
Static_Dispatch_Tables : constant Boolean;
-- This flag indicates if the backend supports generation of statically
-- allocated dispatch tables. If it is True, then the front end will
-- generate static aggregates for dispatch tables that contain forward
-- references to addresses of subprograms not seen yet, and the back end
-- must be prepared to handle this case. If it is False, then the front
-- end generates assignments to initialize the dispatch table, and there
-- are no such forward references.
Expander_Active : Boolean := False;
-- A flag that indicates if expansion is active (True) or deactivated
-- (False). When expansion is deactivated all calls to expander routines
......@@ -1431,4 +1470,20 @@ private
Use_VADS_Size : Boolean;
end record;
-- The following declarations are for GCC version dependent flags. We do
-- not let client code in the compiler test GCC_Version directly, but
-- instead use deferred constants for relevant feature tags.
function get_gcc_version return Int;
pragma Import (C, get_gcc_version, "get_gcc_version");
GCC_Version : constant Nat := get_gcc_version;
-- GNATMAKE
-- Indicates which version of gcc is in use (3 = 3.x, 4 = 4.x). Note that
-- gcc 2.8.1 (which used to be a value of 2) is no longer supported.
Static_Dispatch_Tables : constant Boolean := GCC_Version >= 4;
-- GCC version 4 can handle the static dispatch tables, but not version 3.
-- Also we need -funit-at-a-time, which should also be tested here ???
end Opt;
gcc/ada/sem_warn.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1999-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1999-2007, 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- --
......@@ -120,7 +120,11 @@ package Sem_Warn is
----------------------------
procedure Check_Code_Statement (N : Node_Id);
-- Peform warning checks on a code statement node
-- Perform warning checks on a code statement node
procedure Check_Infinite_Loop_Warning (Loop_Statement : Node_Id);
-- N is the node for a loop statement. This procedure checks if a warning
-- should be given for a possible infinite loop, and if so issues it.
procedure Warn_On_Known_Condition (C : Node_Id);
-- C is a node for a boolean expression resluting from a relational
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment