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

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