xeinfo.adb: Remove warnings

2007-12-06  Robert Dewar  <dewar@adacore.com>

	* xeinfo.adb: Remove warnings
	* xnmake.adb: Remove warnings
	* xsinfo.adb: Remove warnings
	* xtreeprs.adb: Remove warnings
	* xsnames.adb: Remove warnings

	* a-ngcoar.adb: Fix typo.
	* s-interr.adb: Minor reformatting
	* env.c: Minor reformatting.
	* g-bytswa.adb: Minor reformatting.
	* g-rannum.ads: Minor documentation improvements
	* s-tasinf-mingw.adb: Minor header fix
	* a-clrefi.adb: Minor reformatting
	* g-sttsne.ads: Minor documentation improvement
	* g-sttsne-locking.ads: Minor documentation improvement
	* g-soliop-solaris.ads: Minor documentation improvement
	* g-soliop-mingw.ads: Minor documentation improvement
	* g-soliop.ads: Minor documentation improvement
	* exp_aggr.ads: Minor reformatting
	* debug.adb: Add documentation for the gprbuild debug flags
	* exp_ch2.adb: Use Nkind_In to simplify code throughout
	* exp_pakd.adb: Minor reformatting

	* g-altive.ads, g-alleve.adb: Remove assertions.
	Add comment about minor differences between targets regarding
	floating-point operations.

	* g-thread.adb: Remove pragma unreferenced.
	* lib.ads: Minor reformatting
	* par-ch9.adb: Minor reformatting of error messages
	* sem_case.adb: Minor reformatting
	* s-fileio.adb: Minor reformattinng
	* s-vmexta.ads: Minor typo
	* vxaddr2line.adb: 
	Take into account 'Success' value as per new GNAT warning.

From-SVN: r130870

gcc/ada/a-clrefi.adb

@@ -51,8 +51,7 @@ package body Ada.Command_Line.Response_File is
    type Argument_List_Access is access Argument_List;
    procedure Free is new Ada.Unchecked_Deallocation
      (Argument_List, Argument_List_Access);
-   --  Free only the allocated Argument_List, not the allocated String
-   --  components.
+   --  Free only the allocated Argument_List, not allocated String components
 
    --------------------
    -- Arguments_From --
@@ -76,8 +75,8 @@ package body Ada.Command_Line.Response_File is
       --  if necessary.
 
       procedure Recurse (File_Name : String);
-      --  Get the arguments from the file and call itself recursively if
-      --  one of the argument starts with character '@'.
+      --  Get the arguments from the file and call itself recursively if one of
+      --  the argument starts with character '@'.
 
       ------------------
       -- Add_Argument --
@@ -123,13 +122,13 @@ package body Ada.Command_Line.Response_File is
          First_Char : Positive;
          --  Index of the first character of an argument in Line
 
-         Last_Char  : Natural;
+         Last_Char : Natural;
          --  Index of the last character of an argument in Line
 
          In_String : Boolean;
          --  True when inside a quoted string
 
-         Arg  : Positive;
+         Arg : Positive;
 
          function End_Of_File return Boolean;
          --  True when the end of the response file has been reached
@@ -166,6 +165,7 @@ package body Ada.Command_Line.Response_File is
 
          procedure Get_Line is
             Ch : Character;
+
          begin
             Last := 0;
 
@@ -230,7 +230,6 @@ package body Ada.Command_Line.Response_File is
          if FD = Invalid_FD then
             if Ignore_Non_Existing_Files then
                return;
-
             else
                raise File_Does_Not_Exist;
             end if;
@@ -245,9 +244,11 @@ package body Ada.Command_Line.Response_File is
                  Next => null,
                  Prev => null);
             Last_File  := First_File;
+
          else
             declare
                Current : File_Ptr := First_File;
+
             begin
                loop
                   if Current.Name.all = File_Name then
@@ -303,10 +304,12 @@ package body Ada.Command_Line.Response_File is
 
                Character_Loop :
                while Last_Char <= Last loop
+
                   --  Inside a string, check only for '"'
 
                   if In_String then
                      if Line (Last_Char) = '"' then
+
                         --  Remove the '"'
 
                         Line (Last_Char .. Last - 1) :=
@@ -314,6 +317,7 @@ package body Ada.Command_Line.Response_File is
                         Last := Last - 1;
 
                         --  End of string is end of argument
+
                         if Last_Char > Last or else
                           Line (Last_Char) = ' ' or else
                           Line (Last_Char) = ASCII.HT
@@ -339,6 +343,7 @@ package body Ada.Command_Line.Response_File is
                      end if;
 
                   elsif Last_Char = Last then
+
                      --  An opening '"' at the end of the line is an error
 
                      if Line (Last) = '"' then
@@ -351,6 +356,7 @@ package body Ada.Command_Line.Response_File is
                      end if;
 
                   elsif Line (Last_Char) = '"' then
+
                      --  Entering a quoted string: remove the '"'
 
                      In_String := True;
@@ -359,8 +365,7 @@ package body Ada.Command_Line.Response_File is
                      Last := Last - 1;
 
                   else
-                     --  Outside of quoted strings, white space ends the
-                     --  argument.
+                     --  Outside quoted strings, white space ends the argument
 
                      exit Character_Loop
                           when Line (Last_Char + 1) = ' ' or else
@@ -411,8 +416,8 @@ package body Ada.Command_Line.Response_File is
                      Last_Arg := Last_Arg - 1;
 
                   else
-                     --  Save the current arguments and get those in the
-                     --  new response file.
+                     --  Save the current arguments and get those in the new
+                     --  response file.
 
                      declare
                         Inc_File_Name     : constant String :=
@@ -435,6 +440,7 @@ package body Ada.Command_Line.Response_File is
 
                         begin
                            --  Grow Arguments if it is not large enough
+
                            if Arguments'Last < New_Last_Arg then
                               Last_Arg := Arguments'Last;
                               Free (Arguments);
@@ -504,6 +510,7 @@ package body Ada.Command_Line.Response_File is
 
    exception
       when others =>
+
          --  When an exception occurs, deallocate everything
 
          Free (Arguments);

gcc/ada/a-ngcoar.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---            Copyright (C) 2006, Free Software Foundation, Inc.            --
+--            Copyright (C) 2006-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- --
@@ -748,7 +748,7 @@ package body Ada.Numerics.Generic_Complex_Arrays is
    begin
       if Left'Length (2) /= Right'Length (1) then
          raise Constraint_Error with
-            "incompatible dimensions in matrix-matrix multipication";
+            "incompatible dimensions in matrix-matrix multiplication";
       end if;
 
       gemm (Trans_A => No_Trans'Access,

gcc/ada/debug.adb

@@ -623,14 +623,11 @@ package body Debug is
    --  dx  Force the binder to read (and then ignore) the xref information
    --      in ali files (used to check that read circuit is working OK).
 
-   ------------------------------------------------------------
-   -- Documentation for the Debug Flags used in package Make --
-   ------------------------------------------------------------
-
-   --  Please note that such flags apply to all of Make clients,
-   --  such as gnatmake.
+   --------------------------------------------
+   -- Documentation for gnatmake Debug Flags --
+   --------------------------------------------
 
-   --  dn  Do not delete temporary files creates by Make at the end
+   --  dn  Do not delete temporary files created by gnatmake at the end
    --      of execution, such as temporary config pragma files, mapping
    --      files or project path files.
 
@@ -650,6 +647,18 @@ package body Debug is
    --  dw  Prints the list of units withed by the unit currently explored
    --      during the main loop of Make.Compile_Sources.
 
+   ---------------------------------------------
+   -- Documentation for gprbuild Debug Flags  --
+   ---------------------------------------------
+
+   --  dn  Do not delete temporary files createed by gprbuild at the end
+   --      of execution, such as temporary config pragma files, mapping
+   --      files or project path files.
+
+   --  dt  When a time stamp mismatch has been found for an ALI file,
+   --      display the source file name, the time stamp expected and
+   --      the time stamp found.
+
    --------------------
    -- Set_Debug_Flag --
    --------------------

gcc/ada/env.c

@@ -177,11 +177,12 @@ __gnat_setenv (char *name, char *value)
 
   sprintf (expression, "%s=%s", name, value);
   putenv (expression);
-#if (defined (__FreeBSD__) && (__FreeBSD__ < 7)) || defined (__APPLE__) \
-   || defined (__MINGW32__) ||(defined (__vxworks) && ! defined (__RTP__))
-  /* On some systems like pre-7 FreeBSD, MacOS X and Windows, putenv is making
-     a copy of the expression string so we can free it after the call to
-     putenv */
+#if (defined (__FreeBSD__) && (__FreeBSD__ < 7)) \
+   || defined (__APPLE__) || defined (__MINGW32__) \
+   ||(defined (__vxworks) && ! defined (__RTP__))
+  /* On some systems like FreeBSD 6.x and earlier, MacOS X and Windows,
+     putenv is making a copy of the expression string so we can free
+     it after the call to putenv */
   free (expression);
 #endif
 #endif

gcc/ada/exp_aggr.ads

@@ -40,9 +40,9 @@ package Exp_Aggr is
    --  This procedure performs in-place aggregate assignment.
 
    procedure Convert_Aggr_In_Allocator
-     (Alloc :  Node_Id;
-      Decl  :  Node_Id;
-      Aggr  :  Node_Id);
+     (Alloc : Node_Id;
+      Decl  : Node_Id;
+      Aggr  : Node_Id);
    --  Alloc is the allocator whose expression is the aggregate Aggr.
    --  Decl is an N_Object_Declaration created during allocator expansion.
    --  This procedure perform in-place aggregate assignment into the

gcc/ada/exp_ch2.adb

@@ -433,11 +433,10 @@ package body Exp_Ch2 is
          --  ??? passing a formal as actual for a mode IN formal is
          --  considered as an assignment?
 
-         if Nkind (Parent (N)) = N_Procedure_Call_Statement
-           or else Nkind (Parent (N)) = N_Entry_Call_Statement
-           or else
-             (Nkind (Parent (N)) = N_Assignment_Statement
-                 and then N = Name (Parent (N)))
+         if Nkind_In (Parent (N), N_Procedure_Call_Statement,
+                                  N_Entry_Call_Statement)
+           or else (Nkind (Parent (N)) = N_Assignment_Statement
+                      and then N = Name (Parent (N)))
          then
             return True;
 
@@ -451,9 +450,9 @@ package body Exp_Ch2 is
          --  which case there is an implicit dereference, and the formal itself
          --  is not being assigned to).
 
-         elsif (Nkind (Parent (N)) = N_Selected_Component
-                 or else Nkind (Parent (N)) = N_Indexed_Component
-                 or else Nkind (Parent (N)) = N_Slice)
+         elsif Nkind_In (Parent (N), N_Selected_Component,
+                                     N_Indexed_Component,
+                                     N_Slice)
            and then N = Prefix (Parent (N))
            and then not Is_Access_Type (Etype (N))
            and then In_Assignment_Context (Parent (N))
@@ -697,7 +696,7 @@ package body Exp_Ch2 is
    begin
       --  Simple reference case
 
-      if Nkind (N) = N_Identifier or else Nkind (N) = N_Expanded_Name then
+      if Nkind_In (N, N_Identifier, N_Expanded_Name) then
          if Is_Formal (Entity (N)) then
             return Entity (N);
 

gcc/ada/exp_pakd.adb

@@ -635,8 +635,8 @@ package body Exp_Pakd is
                       Attribute_Name => Name_Pos,
                       Expressions    => New_List (
                         Make_Attribute_Reference (Loc,
-                        Prefix         => New_Occurrence_Of (Styp, Loc),
-                        Attribute_Name => Name_First)))));
+                          Prefix         => New_Occurrence_Of (Styp, Loc),
+                          Attribute_Name => Name_First)))));
          end if;
 
          Set_Paren_Count (Newsub, 1);
@@ -960,23 +960,23 @@ package body Exp_Pakd is
                                Make_Range (Loc,
                                  Low_Bound =>
                                    Make_Attribute_Reference (Loc,
-                                     Prefix =>
+                                     Prefix         =>
                                        New_Occurrence_Of (Indx_Typ, Loc),
                                      Attribute_Name => Name_Pos,
-                                     Expressions => New_List (
+                                     Expressions    => New_List (
                                        Make_Attribute_Reference (Loc,
-                                         Prefix =>
+                                         Prefix         =>
                                            New_Occurrence_Of (Indx_Typ, Loc),
                                          Attribute_Name => Name_First))),
 
                                  High_Bound =>
                                    Make_Attribute_Reference (Loc,
-                                     Prefix =>
+                                     Prefix         =>
                                        New_Occurrence_Of (Indx_Typ, Loc),
                                      Attribute_Name => Name_Pos,
-                                     Expressions => New_List (
+                                     Expressions    => New_List (
                                        Make_Attribute_Reference (Loc,
-                                         Prefix =>
+                                         Prefix         =>
                                            New_Occurrence_Of (Indx_Typ, Loc),
                                          Attribute_Name => Name_Last)))))));
 
@@ -1622,8 +1622,8 @@ package body Exp_Pakd is
                   Name => New_Occurrence_Of (Set_nn, Loc),
                   Parameter_Associations => New_List (
                     Make_Attribute_Reference (Loc,
-                      Attribute_Name => Name_Address,
-                      Prefix         => Obj),
+                      Prefix         => Obj,
+                      Attribute_Name => Name_Address),
                     Subscr,
                     Unchecked_Convert_To (Bits_nn,
                       Convert_To (Ctyp, Rhs)))));
@@ -1881,36 +1881,38 @@ package body Exp_Pakd is
                   Parameter_Associations => New_List (
 
                     Make_Byte_Aligned_Attribute_Reference (Loc,
-                      Attribute_Name => Name_Address,
-                      Prefix         => L),
+                      Prefix         => L,
+                      Attribute_Name => Name_Address),
 
                     Make_Op_Multiply (Loc,
                       Left_Opnd =>
                         Make_Attribute_Reference (Loc,
-                          Prefix =>
+                          Prefix         =>
                             New_Occurrence_Of
                               (Etype (First_Index (Ltyp)), Loc),
                           Attribute_Name => Name_Range_Length),
+
                       Right_Opnd =>
                         Make_Integer_Literal (Loc, Component_Size (Ltyp))),
 
                     Make_Byte_Aligned_Attribute_Reference (Loc,
-                      Attribute_Name => Name_Address,
-                      Prefix         => R),
+                      Prefix         => R,
+                      Attribute_Name => Name_Address),
 
                     Make_Op_Multiply (Loc,
                       Left_Opnd =>
                         Make_Attribute_Reference (Loc,
-                          Prefix =>
+                          Prefix         =>
                             New_Occurrence_Of
                               (Etype (First_Index (Rtyp)), Loc),
                           Attribute_Name => Name_Range_Length),
+
                       Right_Opnd =>
                         Make_Integer_Literal (Loc, Component_Size (Rtyp))),
 
                     Make_Byte_Aligned_Attribute_Reference (Loc,
-                      Attribute_Name => Name_Address,
-                      Prefix => New_Occurrence_Of (Result_Ent, Loc))))));
+                      Prefix => New_Occurrence_Of (Result_Ent, Loc),
+                      Attribute_Name => Name_Address)))));
 
             Rewrite (N,
               New_Occurrence_Of (Result_Ent, Loc));
@@ -2032,8 +2034,8 @@ package body Exp_Pakd is
                   Name => New_Occurrence_Of (Get_nn, Loc),
                   Parameter_Associations => New_List (
                     Make_Attribute_Reference (Loc,
-                      Attribute_Name => Name_Address,
-                      Prefix         => Obj),
+                      Prefix         => Obj,
+                      Attribute_Name => Name_Address),
                     Subscr))));
          end;
       end if;
@@ -2074,8 +2076,8 @@ package body Exp_Pakd is
         Make_Op_Multiply (Loc,
           Left_Opnd =>
             Make_Attribute_Reference (Loc,
-              Attribute_Name => Name_Length,
-              Prefix         => New_Occurrence_Of (Ltyp, Loc)),
+              Prefix         => New_Occurrence_Of (Ltyp, Loc),
+              Attribute_Name => Name_Length),
           Right_Opnd =>
             Make_Integer_Literal (Loc, Component_Size (Ltyp)));
 
@@ -2083,8 +2085,8 @@ package body Exp_Pakd is
         Make_Op_Multiply (Loc,
           Left_Opnd =>
             Make_Attribute_Reference (Loc,
-              Attribute_Name => Name_Length,
-              Prefix         => New_Occurrence_Of (Rtyp, Loc)),
+              Prefix         => New_Occurrence_Of (Rtyp, Loc),
+              Attribute_Name => Name_Length),
           Right_Opnd =>
             Make_Integer_Literal (Loc, Component_Size (Rtyp)));
 
@@ -2125,14 +2127,14 @@ package body Exp_Pakd is
              Name => New_Occurrence_Of (RTE (RE_Bit_Eq), Loc),
              Parameter_Associations => New_List (
                Make_Byte_Aligned_Attribute_Reference (Loc,
-                 Attribute_Name => Name_Address,
-                 Prefix         => L),
+                 Prefix         => L,
+                 Attribute_Name => Name_Address),
 
                LLexpr,
 
                Make_Byte_Aligned_Attribute_Reference (Loc,
-                 Attribute_Name => Name_Address,
-                 Prefix         => R),
+                 Prefix         => R,
+                 Attribute_Name => Name_Address),
 
                RLexpr)));
       end if;
@@ -2244,22 +2246,23 @@ package body Exp_Pakd is
                   Parameter_Associations => New_List (
 
                     Make_Byte_Aligned_Attribute_Reference (Loc,
-                      Attribute_Name => Name_Address,
-                      Prefix         => Opnd),
+                      Prefix         => Opnd,
+                      Attribute_Name => Name_Address),
 
                     Make_Op_Multiply (Loc,
                       Left_Opnd =>
                         Make_Attribute_Reference (Loc,
-                          Prefix =>
+                          Prefix         =>
                             New_Occurrence_Of
                               (Etype (First_Index (Rtyp)), Loc),
                           Attribute_Name => Name_Range_Length),
+
                       Right_Opnd =>
                         Make_Integer_Literal (Loc, Component_Size (Rtyp))),
 
                     Make_Byte_Aligned_Attribute_Reference (Loc,
-                      Attribute_Name => Name_Address,
-                      Prefix => New_Occurrence_Of (Result_Ent, Loc))))));
+                      Prefix => New_Occurrence_Of (Result_Ent, Loc),
+                      Attribute_Name => Name_Address)))));
 
             Rewrite (N,
               New_Occurrence_Of (Result_Ent, Loc));

gcc/ada/g-alleve.adb

@@ -7,7 +7,7 @@
 --                                 B o d y                                  --
 --                         (Soft Binding Version)                           --
 --                                                                          --
---          Copyright (C) 2004-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-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- --
@@ -49,17 +49,6 @@ with GNAT.Altivec.Low_Level_Interface; use  GNAT.Altivec.Low_Level_Interface;
 
 package body GNAT.Altivec.Low_Level_Vectors is
 
-   --  This package assumes C_float is an IEEE single-precision float type
-
-   pragma Assert (C_float'Machine_Radix = 2);
-   pragma Assert (C_float'Machine_Mantissa = 24);
-   pragma Assert (C_float'Machine_Emin = -125);
-   pragma Assert (C_float'Machine_Emax = 128);
-   pragma Assert (C_float'Machine_Rounds);
-   pragma Assert (not C_float'Machine_Overflows);
-   pragma Assert (C_float'Signed_Zeros);
-   pragma Assert (C_float'Denorm);
-
    --  Pixel types. As defined in [PIM-2.1 Data types]:
    --  A 16-bit pixel is 1/5/5/5;
    --  A 32-bit pixel is 8/8/8/8.

gcc/ada/g-altive.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-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- --
@@ -341,6 +341,14 @@ package GNAT.Altivec is
 
    type C_float is digits FLOAT_DIGIT range FLOAT_MIN .. FLOAT_MAX;
    for C_float'Size use FLOAT_BIT;
+   --  Altivec operations always use the standard native floating-point
+   --  support of the target. Note that this means that there may be
+   --  minor differences in results between targets when the floating-
+   --  point implementations are slightly different, as would happen
+   --  with normal non-altivec floating-point operations. In particular
+   --  the Altivec simulations may yield slightly different results
+   --  from those obtained on a true hardware Altivec target if the
+   --  floating-point implementation is not 100% compatible.
 
    ----------------------
    -- pixel components --

gcc/ada/g-bytswa.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 2006-2007, AdaCore                     --     --
+--                     Copyright (C) 2006-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- --

gcc/ada/g-rannum.ads

@@ -33,22 +33,21 @@
 
 --  Extended pseudo-random number generation
 
---  This package provides a type representing pseudo-random number
---  generators, and subprograms to extract various distributions of numbers
---  from them. It also provides types for representing initialization values
---  and snapshots of internal generator state, which permit reproducible
---  pseudo-random streams.
+--  This package provides a type representing pseudo-random number generators,
+--  and subprograms to extract various distributions of numbers from them. It
+--  also provides types for representing initialization values and snapshots of
+--  internal generator state, which permit reproducible pseudo-random streams.
 
 --  The generator currently provided by this package has an extremely long
---  period (at least 2**19937-1), and passes the Big Crush test suite, with
---  the exception of the two linear complexity tests. Therefore, it is
---  suitable for simulations, but should not be used as a cryptographic
---  pseudo-random source without additional processing.
-
---  The design of this package effects some simplification from that of
---  the standard Ada.Numerics packages. There is no separate State type;
---  the Generator type itself suffices for this purpose. The parameter
---  modes on Reset procedures better reflect the effect of these routines.
+--  period (at least 2**19937-1), and passes the Big Crush test suite, with the
+--  exception of the two linear complexity tests. Therefore, it is suitable for
+--  simulations, but should not be used as a cryptographic pseudo-random source
+--  without additional processing.
+
+--  The design of this package effects is simplified compared to the design
+--  of standard Ada.Numerics packages. There is no separate State type; the
+--  Generator type itself suffices for this purpose. The parameter modes on
+--  Reset procedures better reflect the effect of these routines.
 
 with System.Random_Numbers;
 with Interfaces; use Interfaces;

gcc/ada/g-soliop-mingw.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                     Copyright (C) 2001-2006, AdaCore                     --
+--                     Copyright (C) 2001-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- --
@@ -36,6 +36,8 @@
 
 --  This is the Windows/NT version of this package
 
+--  This package should not be directly with'ed by an application program
+
 package GNAT.Sockets.Linker_Options is
 private
    pragma Linker_Options ("-lws2_32");

gcc/ada/g-soliop-solaris.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                     Copyright (C) 2001-2005, AdaCore                     --
+--                     Copyright (C) 2001-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- --
@@ -36,6 +36,8 @@
 
 --  This is the Solaris version of this package
 
+--  This package should not be directly with'ed by an application program
+
 package GNAT.Sockets.Linker_Options is
 private
    pragma Linker_Options ("-lnsl");

gcc/ada/g-soliop.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                     Copyright (C) 2001-2005, AdaCore                     --
+--                     Copyright (C) 2001-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- --
@@ -38,5 +38,7 @@
 --  are required. On some targets a target specific version of this unit
 --  ensures linking with required libraries for proper sockets operation.
 
+--  This package should not be directly with'ed by an application program
+
 package GNAT.Sockets.Linker_Options is
 end GNAT.Sockets.Linker_Options;

gcc/ada/g-sttsne-locking.ads

@@ -34,6 +34,8 @@
 --  This version is used on VMS, LynxOS, and VxWorks. There are two versions of
 --  the body: one for VMS and LynxOS, the other for VxWorks.
 
+--  This package should not be directly with'ed by an application
+
 package GNAT.Sockets.Thin.Task_Safe_NetDB is
 
    ----------------------------------------

gcc/ada/g-sttsne.ads

@@ -36,6 +36,8 @@
 --  from C; see gsocket.h for details. Different versions are provided on
 --  platforms where this functionality is implemented in Ada.
 
+--  This package should not be directly with'ed by an application
+
 package GNAT.Sockets.Thin.Task_Safe_NetDB is
 
    ----------------------------------------

gcc/ada/g-thread.adb

@@ -68,7 +68,6 @@ package body GNAT.Threads is
       Parm : Void_Ptr;
       Code : Code_Proc)
    is
-      pragma Unreferenced (Parm);
       pragma Priority (Prio);
       pragma Storage_Size (Stsz);
    end Thread;

gcc/ada/lib.ads

@@ -208,10 +208,10 @@ package Lib is
    -- Special Handling of Subprogram Bodies --
    -------------------------------------------
 
-   --  A subprogram body (in an adb file) may stand for both a spec and a
-   --  body. A simple model (and one that was adopted through version 2.07),
-   --  is simply to assume that such an adb file acts as its own spec if no
-   --  ads file is present.
+   --  A subprogram body (in an adb file) may stand for both a spec and a body.
+   --  A simple model (and one that was adopted through version 2.07) is simply
+   --  to assume that such an adb file acts as its own spec if no ads file is
+   --  is present.
 
    --  However, this is not correct. RM 10.1.4(4) requires that such a body
    --  act as a spec unless a subprogram declaration of the same name is

gcc/ada/par-ch9.adb

@@ -610,7 +610,7 @@ package body Ch9 is
 
          if (Is_Overriding or else Not_Overriding) then
             if Ada_Version < Ada_05 then
-               Error_Msg_SP (" overriding indicator is an Ada 2005 extension");
+               Error_Msg_SP ("overriding indicator is an Ada 2005 extension");
                Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
 
             elsif Token = Tok_Entry then
@@ -786,7 +786,7 @@ package body Ch9 is
 
       if (Is_Overriding or else Not_Overriding) then
          if Ada_Version < Ada_05 then
-            Error_Msg_SP (" overriding indicator is an Ada 2005 extension");
+            Error_Msg_SP ("overriding indicator is an Ada 2005 extension");
             Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
 
          elsif Token /= Tok_Entry then

gcc/ada/s-fileio.adb

@@ -1080,7 +1080,7 @@ package body System.File_IO is
       if File.Shared_Status = Yes
         or else File.Name'Length <= 1
         or else File.Is_System_File
-        or else (not File.Is_Regular_File)
+        or else not File.Is_Regular_File
       then
          raise Use_Error;
 

gcc/ada/s-interr.adb

@@ -140,9 +140,8 @@ package body System.Interrupts is
    -- Local Tasks --
    -----------------
 
-   --  WARNING: System.Tasking.Stages performs calls to this task
-   --  with low-level constructs. Do not change this spec without synchro-
-   --  nizing it.
+   --  WARNING: System.Tasking.Stages performs calls to this task with
+   --  low-level constructs. Do not change this spec without synchronizing it.
 
    task Interrupt_Manager is
       entry Detach_Interrupt_Entries (T : Task_Id);
@@ -183,10 +182,10 @@ package body System.Interrupts is
 
    task type Server_Task (Interrupt : Interrupt_ID) is
       pragma Priority (System.Interrupt_Priority'Last);
-      --  Note: the above pragma Priority is strictly speaking improper
-      --  since it is outside the range of allowed priorities, but the
-      --  compiler treats system units specially and does not apply
-      --  this range checking rule to system units.
+      --  Note: the above pragma Priority is strictly speaking improper since
+      --  it is outside the range of allowed priorities, but the compiler
+      --  treats system units specially and does not apply this range checking
+      --  rule to system units.
 
    end Server_Task;
 
@@ -210,9 +209,9 @@ package body System.Interrupts is
                     (others => (null, Static => False));
    pragma Volatile_Components (User_Handler);
    --  Holds the protected procedure handler (if any) and its Static
-   --  information  for each interrupt. A handler is a Static one if
-   --  it is specified through the pragma Attach_Handler.
-   --  Attach_Handler. Otherwise, not static)
+   --  information for each interrupt. A handler is a Static one if it is
+   --  specified through the pragma Attach_Handler. Attach_Handler. Otherwise,
+   --  not static)
 
    User_Entry : array (Interrupt_ID'Range) of Entry_Assoc :=
                   (others => (T => Null_Task, E => Null_Task_Entry));
@@ -230,16 +229,16 @@ package body System.Interrupts is
    Last_Unblocker :
      array (Interrupt_ID'Range) of Task_Id := (others => Null_Task);
    pragma Atomic_Components (Last_Unblocker);
-   --  Holds the ID of the last Task which Unblocked this Interrupt.
-   --  It contains Null_Task if no tasks have ever requested the
-   --  Unblocking operation or the Interrupt is currently Blocked.
+   --  Holds the ID of the last Task which Unblocked this Interrupt. It
+   --  contains Null_Task if no tasks have ever requested the Unblocking
+   --  operation or the Interrupt is currently Blocked.
 
    Server_ID : array (Interrupt_ID'Range) of Task_Id :=
                  (others => Null_Task);
    pragma Atomic_Components (Server_ID);
-   --  Holds the Task_Id of the Server_Task for each interrupt.
-   --  Task_Id is needed to accomplish locking per Interrupt base. Also
-   --  is needed to decide whether to create a new Server_Task.
+   --  Holds the Task_Id of the Server_Task for each interrupt. Task_Id is
+   --  needed to accomplish locking per Interrupt base. Also is needed to
+   --  decide whether to create a new Server_Task.
 
    --  Type and Head, Tail of the list containing Registered Interrupt
    --  Handlers. These definitions are used to register the handlers
@@ -264,20 +263,20 @@ package body System.Interrupts is
    -----------------------
 
    function Is_Registered (Handler : Parameterless_Handler) return Boolean;
-   --  See if the Handler has been "pragma"ed using Interrupt_Handler.
-   --  Always consider a null handler as registered.
+   --  See if the Handler has been "pragma"ed using Interrupt_Handler. Always
+   --  consider a null handler as registered.
 
    --------------------
    -- Attach_Handler --
    --------------------
 
-   --  Calling this procedure with New_Handler = null and Static = True
-   --  means we want to detach the current handler regardless of the
-   --  previous handler's binding status (ie. do not care if it is a
-   --  dynamic or static handler).
+   --  Calling this procedure with New_Handler = null and Static = True means
+   --  we want to detach the current handler regardless of the previous
+   --  handler's binding status (ie. do not care if it is a dynamic or static
+   --  handler).
 
-   --  This option is needed so that during the finalization of a PO, we
-   --  can detach handlers attached through pragma Attach_Handler.
+   --  This option is needed so that during the finalization of a PO, we can
+   --  detach handlers attached through pragma Attach_Handler.
 
    procedure Attach_Handler
      (New_Handler : Parameterless_Handler;
@@ -298,8 +297,8 @@ package body System.Interrupts is
    -- Bind_Interrupt_To_Entry --
    -----------------------------
 
-   --  This procedure raises a Program_Error if it tries to bind an
-   --  interrupt to which an Entry or a Procedure is already bound.
+   --  This procedure raises a Program_Error if it tries to bind an interrupt
+   --  to which an Entry or a Procedure is already bound.
 
    procedure Bind_Interrupt_To_Entry
      (T       : Task_Id;
@@ -389,13 +388,13 @@ package body System.Interrupts is
    -- Exchange_Handler --
    ----------------------
 
-   --  Calling this procedure with New_Handler = null and Static = True
-   --  means we want to detach the current handler regardless of the
-   --  previous handler's binding status (ie. do not care if it is a
-   --  dynamic or static handler).
+   --  Calling this procedure with New_Handler = null and Static = True means
+   --  we want to detach the current handler regardless of the previous
+   --  handler's binding status (ie. do not care if it is a dynamic or static
+   --  handler).
 
-   --  This option is needed so that during the finalization of a PO,
-   --  we can detach handlers attached through pragma Attach_Handler.
+   --  This option is needed so that during the finalization of a PO, we can
+   --  detach handlers attached through pragma Attach_Handler.
 
    procedure Exchange_Handler
      (Old_Handler : out Parameterless_Handler;

gcc/ada/s-tasinf-mingw.adb

@@ -4,7 +4,7 @@
 --                                                                          --
 --                     S Y S T E M . T A S K _ I N F O                      --
 --                                                                          --
---                                 S p e c                                  --
+--                                 B o d y                                  --
 --                                                                          --
 --            Copyright (C) 2007, Free Software Foundation, Inc.            --
 --                                                                          --

gcc/ada/s-vmexta.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---           Copyright (C) 1997-2004 Free Software Foundation, Inc.         --
+--          Copyright (C) 1997-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- --
@@ -46,7 +46,7 @@ package System.VMS_Exception_Table is
    --  Register an exception in the hash table mapping with a VMS
    --  condition code.
 
-   --  LOTS more comments needed here regarding the enire scheme ???
+   --  LOTS more comments needed here regarding the entire scheme ???
 
 private
 

gcc/ada/sem_case.adb

@@ -756,7 +756,6 @@ package body Sem_Case is
 
             else
                Choice := First (Get_Choices (Alt));
-
                while Present (Choice) loop
                   Analyze (Choice);
                   Kind := Nkind (Choice);

gcc/ada/vxaddr2line.adb

@@ -458,6 +458,10 @@ begin
    Spawn (Addr2line_Cmd.all,
           Addr2line_Args (1 .. Addr2line_Args_Count), Success);
 
+   if not Success then
+      Error ("Couldn't spawn " & Addr2line_Cmd.all);
+   end if;
+
 exception
    when others =>
 

gcc/ada/xeinfo.adb

@@ -63,6 +63,9 @@ procedure XEinfo is
 
    Err : exception;
 
+   pragma Warnings (Off);
+   --  These seem not to be referenced, but they are (by * operator)
+
    A         : VString := Nul;
    B         : VString := Nul;
    C         : VString := Nul;
@@ -85,6 +88,8 @@ procedure XEinfo is
    Rtn       : VString := Nul;
    Term      : VString := Nul;
 
+   pragma Warnings (On);
+
    InB : File_Type;
    --  Used to read initial header from body
 
@@ -94,41 +99,45 @@ procedure XEinfo is
    Ofile : File_Type;
    --  Used to write output file
 
-   wsp      : Pattern := NSpan (' ' & ASCII.HT);
-   Comment  : Pattern := wsp & "--";
-   For_Rep  : Pattern := wsp & "for";
-   Get_Func : Pattern := wsp * A & "function" & wsp & Break (' ') * Name;
-   Inline   : Pattern := wsp & "pragma Inline (" & Break (')') * Name;
-   Get_Pack : Pattern := wsp & "package ";
-   Get_Enam : Pattern := wsp & Break (',') * N & ',';
-   Find_Fun : Pattern := wsp & "function";
-   F_Subtyp : Pattern := wsp * A & "subtype " & Break (' ') * N;
-   G_Subtyp : Pattern := wsp & "subtype" & wsp & Break (' ') * NewS
-                           & wsp & "is" & wsp & Break (" ;") * OldS
-                           & wsp & ';' & wsp & Rtab (0);
-   F_Typ    : Pattern := wsp * A & "type " & Break (' ') * N & " is (";
-   Get_Nam  : Pattern := wsp * A & Break (",)") * Nam & Len (1) * Term;
-   Get_Styp : Pattern := wsp * A & "subtype " & Break (' ') * N;
-   Get_N1   : Pattern := wsp & Break (' ') * N1;
-   Get_N2   : Pattern := wsp & "-- " & Rest * N2;
-   Get_N3   : Pattern := wsp & Break (';') * N3;
-   Get_FN   : Pattern := wsp * C & "function" & wsp & Break (" (") * FN;
-   Is_Rturn : Pattern := BreakX ('r') & "return";
-   Is_Begin : Pattern := wsp & "begin";
-   Get_Asrt : Pattern := wsp & "pragma Assert";
-   Semicoln : Pattern := BreakX (';');
-   Get_Cmnt : Pattern := BreakX ('-') * A & "--";
-   Get_Expr : Pattern := wsp & "return " & Break (';') * Expr;
-   Chek_End : Pattern := wsp & "end" & BreakX (';') & ';';
-   Get_B1   : Pattern := BreakX (' ') * A & " in " & Rest * B;
-   Get_B2   : Pattern := BreakX (' ') * A & " = " & Rest * B;
-   Get_B3   : Pattern := BreakX (' ') * A & " /= " & Rest * B;
-   To_Paren : Pattern := wsp * Filler & '(';
-   Get_Fml  : Pattern := Break (" :") * Formal & wsp & ':' & wsp
-                           & BreakX (" );") * Formaltyp;
-   Nxt_Fml  : Pattern := wsp & "; ";
-   Get_Rtn  : Pattern := wsp & "return" & wsp & BreakX (" ;") * Rtn;
-   Rem_Prn  : Pattern := wsp & ')';
+   wsp      : constant Pattern := NSpan (' ' & ASCII.HT);
+   Comment  : constant Pattern := wsp & "--";
+   For_Rep  : constant Pattern := wsp & "for";
+   Get_Func : constant Pattern := wsp * A & "function" & wsp
+                                  & Break (' ') * Name;
+   Inline   : constant Pattern := wsp & "pragma Inline (" & Break (')') * Name;
+   Get_Pack : constant Pattern := wsp & "package ";
+   Get_Enam : constant Pattern := wsp & Break (',') * N & ',';
+   Find_Fun : constant Pattern := wsp & "function";
+   F_Subtyp : constant Pattern := wsp * A & "subtype " & Break (' ') * N;
+   G_Subtyp : constant Pattern := wsp & "subtype" & wsp & Break (' ') * NewS
+                                  & wsp & "is" & wsp & Break (" ;") * OldS
+                                  & wsp & ';' & wsp & Rtab (0);
+   F_Typ    : constant Pattern := wsp * A & "type " & Break (' ') * N &
+                                  " is (";
+   Get_Nam  : constant Pattern := wsp * A & Break (",)") * Nam
+                                  & Len (1) * Term;
+   Get_Styp : constant Pattern := wsp * A & "subtype " & Break (' ') * N;
+   Get_N1   : constant Pattern := wsp & Break (' ') * N1;
+   Get_N2   : constant Pattern := wsp & "-- " & Rest * N2;
+   Get_N3   : constant Pattern := wsp & Break (';') * N3;
+   Get_FN   : constant Pattern := wsp * C & "function" & wsp
+                                  & Break (" (") * FN;
+   Is_Rturn : constant Pattern := BreakX ('r') & "return";
+   Is_Begin : constant Pattern := wsp & "begin";
+   Get_Asrt : constant Pattern := wsp & "pragma Assert";
+   Semicoln : constant Pattern := BreakX (';');
+   Get_Cmnt : constant Pattern := BreakX ('-') * A & "--";
+   Get_Expr : constant Pattern := wsp & "return " & Break (';') * Expr;
+   Chek_End : constant Pattern := wsp & "end" & BreakX (';') & ';';
+   Get_B1   : constant Pattern := BreakX (' ') * A & " in " & Rest * B;
+   Get_B2   : constant Pattern := BreakX (' ') * A & " = " & Rest * B;
+   Get_B3   : constant Pattern := BreakX (' ') * A & " /= " & Rest * B;
+   To_Paren : constant Pattern := wsp * Filler & '(';
+   Get_Fml  : constant Pattern := Break (" :") * Formal & wsp & ':' & wsp
+                                  & BreakX (" );") * Formaltyp;
+   Nxt_Fml  : constant Pattern := wsp & "; ";
+   Get_Rtn  : constant Pattern := wsp & "return" & wsp & BreakX (" ;") * Rtn;
+   Rem_Prn  : constant Pattern := wsp & ')';
 
    M : Match_Result;
 

gcc/ada/xnmake.adb

@@ -63,18 +63,21 @@ procedure XNmake is
    Err : exception;
    --  Raised to terminate execution
 
-   A          : VString := Nul;
-   Arg        : VString := Nul;
-   Arg_List   : VString := Nul;
-   Comment    : VString := Nul;
-   Default    : VString := Nul;
-   Field      : VString := Nul;
-   Line       : VString := Nul;
-   Node       : VString := Nul;
-   Op_Name    : VString := Nul;
-   Prevl      : VString := Nul;
-   Synonym    : VString := Nul;
-   X          : VString := Nul;
+   pragma Warnings (Off);
+   --  The following are modified by * operator
+
+   A        : VString := Nul;
+   Arg      : VString := Nul;
+   Arg_List : VString := Nul;
+   Comment  : VString := Nul;
+   Default  : VString := Nul;
+   Field    : VString := Nul;
+   Line     : VString := Nul;
+   Node     : VString := Nul;
+   Op_Name  : VString := Nul;
+   Prevl    : VString := Nul;
+   Synonym  : VString := Nul;
+   X        : VString := Nul;
 
    NWidth : Natural;
 
@@ -90,37 +93,43 @@ procedure XNmake is
    InS,  InT  : Ada.Text_IO.File_Type;
    OutS, OutB : Sfile;
 
-   wsp : Pattern := Span (' ' & ASCII.HT);
+   wsp : constant Pattern := Span (' ' & ASCII.HT);
 
-   Body_Only : Pattern := BreakX (' ') * X & Span (' ') & "--  body only";
-   Spec_Only : Pattern := BreakX (' ') * X & Span (' ') & "--  spec only";
+   Body_Only : constant Pattern := BreakX (' ') * X
+                                   & Span (' ') & "--  body only";
+   Spec_Only : constant Pattern := BreakX (' ') * X
+                                   & Span (' ') & "--  spec only";
 
-   Node_Hdr  : Pattern := wsp & "--  N_" & Rest * Node;
-   Punc      : Pattern := BreakX (" .,");
+   Node_Hdr  : constant Pattern := wsp & "--  N_" & Rest * Node;
+   Punc      : constant Pattern := BreakX (" .,");
 
-   Binop     : Pattern := wsp & "--  plus fields for binary operator";
-   Unop      : Pattern := wsp & "--  plus fields for unary operator";
-   Syn       : Pattern := wsp & "--  " & Break (' ') * Synonym
-                            & " (" & Break (')') * Field & Rest * Comment;
+   Binop     : constant Pattern := wsp
+                                   & "--  plus fields for binary operator";
+   Unop      : constant Pattern := wsp
+                                   & "--  plus fields for unary operator";
+   Syn       : constant Pattern := wsp & "--  " & Break (' ') * Synonym
+                                   & " (" & Break (')') * Field
+                                   & Rest * Comment;
 
-   Templ     : Pattern := BreakX ('T') * A & "T e m p l a t e";
-   Spec      : Pattern := BreakX ('S') * A & "S p e c";
+   Templ     : constant Pattern := BreakX ('T') * A & "T e m p l a t e";
+   Spec      : constant Pattern := BreakX ('S') * A & "S p e c";
 
-   Sem_Field : Pattern := BreakX ('-') & "-Sem";
-   Lib_Field : Pattern := BreakX ('-') & "-Lib";
+   Sem_Field : constant Pattern := BreakX ('-') & "-Sem";
+   Lib_Field : constant Pattern := BreakX ('-') & "-Lib";
 
-   Get_Field : Pattern := BreakX (Decimal_Digit_Set) * Field;
+   Get_Field : constant Pattern := BreakX (Decimal_Digit_Set) * Field;
 
-   Get_Dflt  : Pattern := BreakX ('(') & "(set to "
-                            & Break (" ") * Default & " if";
+   Get_Dflt  : constant Pattern := BreakX ('(') & "(set to "
+                                   & Break (" ") * Default & " if";
 
-   Next_Arg  : Pattern := Break (',') * Arg & ',';
+   Next_Arg  : constant Pattern := Break (',') * Arg & ',';
 
-   Op_Node   : Pattern := "Op_" & Rest * Op_Name;
+   Op_Node   : constant Pattern := "Op_" & Rest * Op_Name;
 
-   Shft_Rot  : Pattern := "Shift_" or "Rotate_";
+   Shft_Rot  : constant Pattern := "Shift_" or "Rotate_";
 
-   No_Ent    : Pattern := "Or_Else" or "And_Then" or "In" or "Not_In";
+   No_Ent    : constant Pattern := "Or_Else" or "And_Then"
+                                     or "In" or "Not_In";
 
    M : Match_Result;
 

gcc/ada/xsinfo.adb

@@ -55,6 +55,9 @@ procedure XSinfo is
    Done : exception;
    Err  : exception;
 
+   pragma Warnings (Off);
+   --  Below variables are referenced using * operator
+
    A         : VString := Nul;
    Arg       : VString := Nul;
    Comment   : VString := Nul;
@@ -65,23 +68,26 @@ procedure XSinfo is
    Rtn       : VString := Nul;
    Term      : VString := Nul;
 
+   pragma Warnings (On);
+
    InS       : File_Type;
    Ofile     : File_Type;
 
-   wsp     : Pattern := Span (' ' & ASCII.HT);
-   Wsp_For : Pattern := wsp & "for";
-   Is_Cmnt : Pattern := wsp & "--";
-   Typ_Nod : Pattern := wsp * A & "type Node_Kind is";
-   Get_Nam : Pattern := wsp * A & "N_" &  Break (",)") * Nam
-                          & Len (1) * Term;
-   Sub_Typ : Pattern := wsp * A & "subtype " &  Break (' ') * N;
-   No_Cont : Pattern := wsp & Break (' ') * N1 & " .. " & Break (';') * N2;
-   Cont_N1 : Pattern := wsp & Break (' ') * N1 & " .." & Rpos (0);
-   Cont_N2 : Pattern := Span (' ') & Break (';') * N2;
-   Is_Func : Pattern := wsp * A & "function " & Rest * Nam;
-   Get_Arg : Pattern := wsp & "(N : " & Break (')') * Arg
-                          & ") return " & Break (';') * Rtn
-                          & ';' & wsp & "--" & wsp & Rest * Comment;
+   wsp     : constant Pattern := Span (' ' & ASCII.HT);
+   Wsp_For : constant Pattern := wsp & "for";
+   Is_Cmnt : constant Pattern := wsp & "--";
+   Typ_Nod : constant Pattern := wsp * A & "type Node_Kind is";
+   Get_Nam : constant Pattern := wsp * A & "N_" &  Break (",)") * Nam
+                                 & Len (1) * Term;
+   Sub_Typ : constant Pattern := wsp * A & "subtype " &  Break (' ') * N;
+   No_Cont : constant Pattern := wsp & Break (' ') * N1
+                                 & " .. " & Break (';') * N2;
+   Cont_N1 : constant Pattern := wsp & Break (' ') * N1 & " .." & Rpos (0);
+   Cont_N2 : constant Pattern := Span (' ') & Break (';') * N2;
+   Is_Func : constant Pattern := wsp * A & "function " & Rest * Nam;
+   Get_Arg : constant Pattern := wsp & "(N : " & Break (')') * Arg
+                                 & ") return " & Break (';') * Rtn
+                                 & ';' & wsp & "--" & wsp & Rest * Comment;
 
    NKV : Natural;
 

gcc/ada/xsnames.adb

@@ -47,43 +47,48 @@ procedure XSnames is
    InH  : File_Type;
    OutH : File_Type;
 
-   A, B    : VString := Nul;
-   Line    : VString := Nul;
-   Name    : VString := Nul;
-   Name1   : VString := Nul;
-   Oname   : VString := Nul;
-   Oval    : VString := Nul;
-   Restl   : VString := Nul;
+   pragma Warnings (Off);
+   --  Variables below are modifed by * operator
 
-   Tdigs : Pattern := Any (Decimal_Digit_Set) &
-                      Any (Decimal_Digit_Set) &
-                      Any (Decimal_Digit_Set);
+   A, B  : VString := Nul;
+   Line  : VString := Nul;
+   Name  : VString := Nul;
+   Name1 : VString := Nul;
+   Oname : VString := Nul;
+   Oval  : VString := Nul;
+   Restl : VString := Nul;
 
-   Name_Ref : Pattern := Span (' ') * A & Break (' ') * Name
-                           & Span (' ') * B
-                           & ": constant Name_Id := N + " & Tdigs
-                           & ';' & Rest * Restl;
+   pragma Warnings (On);
 
-   Get_Name : Pattern := "Name_" & Rest * Name1;
+   Tdigs : constant Pattern := Any (Decimal_Digit_Set) &
+                               Any (Decimal_Digit_Set) &
+                               Any (Decimal_Digit_Set);
 
-   Chk_Low  : Pattern := Pos (0) & Any (Lower_Set) & Rest & Pos (1);
+   Name_Ref : constant Pattern := Span (' ') * A & Break (' ') * Name
+                                  & Span (' ') * B
+                                  & ": constant Name_Id := N + " & Tdigs
+                                  & ';' & Rest * Restl;
 
-   Findu    : Pattern := Span ('u') * A;
+   Get_Name : constant Pattern := "Name_" & Rest * Name1;
+   Chk_Low  : constant Pattern := Pos (0) & Any (Lower_Set) & Rest & Pos (1);
+   Findu    : constant Pattern := Span ('u') * A;
 
    Val : Natural;
 
-   Xlate_U_Und : Character_Mapping := To_Mapping ("u", "_");
+   Xlate_U_Und : constant Character_Mapping := To_Mapping ("u", "_");
 
    M : Match_Result;
 
    type Header_Symbol is (None, Attr, Conv, Prag);
    --  A symbol in the header file
 
-   --  Prefixes used in the header file
+   procedure Output_Header_Line (S : Header_Symbol);
+   --  Output header line
 
    Header_Attr : aliased String := "Attr";
    Header_Conv : aliased String := "Convention";
    Header_Prag : aliased String := "Pragma";
+   --  Prefixes used in the header file
 
    type String_Ptr is access all String;
    Header_Prefix : constant array (Header_Symbol) of String_Ptr :=
@@ -94,9 +99,12 @@ procedure XSnames is
 
    --  Patterns used in the spec file
 
-   Get_Attr : Pattern := Span (' ') & "Attribute_" & Break (",)") * Name1;
-   Get_Conv : Pattern := Span (' ') & "Convention_" & Break (",)") * Name1;
-   Get_Prag : Pattern := Span (' ') & "Pragma_" & Break (",)") * Name1;
+   Get_Attr : constant Pattern := Span (' ') & "Attribute_"
+                                  & Break (",)") * Name1;
+   Get_Conv : constant Pattern := Span (' ') & "Convention_"
+                                  & Break (",)") * Name1;
+   Get_Prag : constant Pattern := Span (' ') & "Pragma_"
+                                  & Break (",)") * Name1;
 
    type Header_Symbol_Counter is array (Header_Symbol) of Natural;
    Header_Counter : Header_Symbol_Counter := (0, 0, 0, 0);
@@ -117,7 +125,7 @@ procedure XSnames is
 
       if Header_Current_Symbol /= S then
          declare
-            Pat : String := "#define  " & Header_Prefix (S).all;
+            Pat : constant String := "#define  " & Header_Prefix (S).all;
             In_Pat : Boolean := False;
 
          begin
@@ -129,7 +137,7 @@ procedure XSnames is
                Line := Get_Line (InH);
 
                if Match (Line, Pat) then
-                  In_Pat := true;
+                  In_Pat := True;
                elsif In_Pat then
                   Header_Pending_Line := Line;
                   exit;

gcc/ada/xtreeprs.adb

@@ -59,21 +59,26 @@ procedure XTreeprs is
    Err : exception;
    --  Raised on fatal error
 
-   A          : VString := Nul;
-   Ffield     : VString := Nul;
-   Field      : VString := Nul;
-   Fieldno    : VString := Nul;
-   Flagno     : VString := Nul;
-   Line       : VString := Nul;
-   Name       : VString := Nul;
-   Node       : VString := Nul;
-   Outstring  : VString := Nul;
-   Prefix     : VString := Nul;
-   S          : VString := Nul;
-   S1         : VString := Nul;
-   Syn        : VString := Nul;
-   Synonym    : VString := Nul;
-   Term       : VString := Nul;
+   pragma Warnings (Off);
+   --  Following variables are assigned by * operator
+
+   A         : VString := Nul;
+   Ffield    : VString := Nul;
+   Field     : VString := Nul;
+   Fieldno   : VString := Nul;
+   Flagno    : VString := Nul;
+   Line      : VString := Nul;
+   Name      : VString := Nul;
+   Node      : VString := Nul;
+   Outstring : VString := Nul;
+   Prefix    : VString := Nul;
+   S         : VString := Nul;
+   S1        : VString := Nul;
+   Syn       : VString := Nul;
+   Synonym   : VString := Nul;
+   Term      : VString := Nul;
+
+   pragma Warnings (On);
 
    subtype Sfile is Ada.Streams.Stream_IO.File_Type;
 
@@ -123,19 +128,19 @@ procedure XTreeprs is
    Sp : aliased Natural;
    --  Space left on line for Pchars output
 
-   wsp : Pattern := Span (' ' & ASCII.HT);
-
-   Is_Temp  : Pattern := BreakX ('T') * A & "T e m p l a t e";
-   Get_Node : Pattern := wsp & "--  N_" & Rest * Node;
-   Tst_Punc : Pattern := Break (" ,.");
-   Get_Syn  : Pattern := Span (' ') & "--  " & Break (' ') * Synonym
-                & " (" & Break (')') * Field;
-   Brk_Min  : Pattern := Break ('-') * Ffield;
-   Is_Flag  : Pattern := "Flag" & Rest * Flagno;
-   Is_Field : Pattern := Rtab (1) & Len (1) * Fieldno;
-   Is_Syn   : Pattern := wsp & "N_" & Break (",)") * Syn & Len (1) * Term;
-   Brk_Node : Pattern := Break (' ') * Node & ' ';
-   Chop_SP  : Pattern := Len (Sp'Unrestricted_Access) * S1;
+   wsp      : constant Pattern := Span (' ' & ASCII.HT);
+   Is_Temp  : constant Pattern := BreakX ('T') * A & "T e m p l a t e";
+   Get_Node : constant Pattern := wsp & "--  N_" & Rest * Node;
+   Tst_Punc : constant Pattern := Break (" ,.");
+   Get_Syn  : constant Pattern := Span (' ') & "--  " & Break (' ') * Synonym
+                                  & " (" & Break (')') * Field;
+   Brk_Min  : constant Pattern := Break ('-') * Ffield;
+   Is_Flag  : constant Pattern := "Flag" & Rest * Flagno;
+   Is_Field : constant Pattern := Rtab (1) & Len (1) * Fieldno;
+   Is_Syn   : constant Pattern := wsp & "N_" & Break (",)") * Syn
+                                  & Len (1) * Term;
+   Brk_Node : constant Pattern := Break (' ') * Node & ' ';
+   Chop_SP  : constant Pattern := Len (Sp'Unrestricted_Access) * S1;
 
    M : Match_Result;