From 34a343e634c7b155a8553e45ffabd3f24f0765ec Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Thu, 13 Dec 2007 11:40:58 +0100 Subject: [PATCH] xeinfo.adb: Remove warnings 2007-12-06 Robert Dewar * 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 | 29 ++++++++----- gcc/ada/a-ngcoar.adb | 4 +- gcc/ada/debug.adb | 23 +++++++---- gcc/ada/env.c | 11 ++--- gcc/ada/exp_aggr.ads | 6 +-- gcc/ada/exp_ch2.adb | 17 ++++---- gcc/ada/exp_pakd.adb | 69 ++++++++++++++++--------------- gcc/ada/g-alleve.adb | 13 +----- gcc/ada/g-altive.ads | 10 ++++- gcc/ada/g-bytswa.adb | 2 +- gcc/ada/g-rannum.ads | 27 ++++++------ gcc/ada/g-soliop-mingw.ads | 4 +- gcc/ada/g-soliop-solaris.ads | 4 +- gcc/ada/g-soliop.ads | 4 +- gcc/ada/g-sttsne-locking.ads | 2 + gcc/ada/g-sttsne.ads | 2 + gcc/ada/g-thread.adb | 1 - gcc/ada/lib.ads | 8 ++-- gcc/ada/par-ch9.adb | 4 +- gcc/ada/s-fileio.adb | 2 +- gcc/ada/s-interr.adb | 63 ++++++++++++++-------------- gcc/ada/s-tasinf-mingw.adb | 2 +- gcc/ada/s-vmexta.ads | 4 +- gcc/ada/sem_case.adb | 1 - gcc/ada/vxaddr2line.adb | 4 ++ gcc/ada/xeinfo.adb | 79 ++++++++++++++++++++---------------- gcc/ada/xnmake.adb | 73 ++++++++++++++++++--------------- gcc/ada/xsinfo.adb | 34 +++++++++------- gcc/ada/xsnames.adb | 56 ++++++++++++++----------- gcc/ada/xtreeprs.adb | 61 +++++++++++++++------------- 30 files changed, 341 insertions(+), 278 deletions(-) diff --git a/gcc/ada/a-clrefi.adb b/gcc/ada/a-clrefi.adb index 0b125e2b2ee..07c0d99c40d 100644 --- a/gcc/ada/a-clrefi.adb +++ b/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); diff --git a/gcc/ada/a-ngcoar.adb b/gcc/ada/a-ngcoar.adb index 9e0f03818cb..47f4db3674b 100644 --- a/gcc/ada/a-ngcoar.adb +++ b/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, diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 9ea1c3f8a69..b4ab4c6e7da 100644 --- a/gcc/ada/debug.adb +++ b/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 -- -------------------- diff --git a/gcc/ada/env.c b/gcc/ada/env.c index 4d361096872..6cbb7057a64 100644 --- a/gcc/ada/env.c +++ b/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 diff --git a/gcc/ada/exp_aggr.ads b/gcc/ada/exp_aggr.ads index 7deb03e2659..8f9f9630a25 100644 --- a/gcc/ada/exp_aggr.ads +++ b/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 diff --git a/gcc/ada/exp_ch2.adb b/gcc/ada/exp_ch2.adb index ff56e049a7f..95291d49245 100644 --- a/gcc/ada/exp_ch2.adb +++ b/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); diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb index fd280163f5e..9a753def146 100644 --- a/gcc/ada/exp_pakd.adb +++ b/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)); diff --git a/gcc/ada/g-alleve.adb b/gcc/ada/g-alleve.adb index 3f760e4793c..329106f8ece 100644 --- a/gcc/ada/g-alleve.adb +++ b/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. diff --git a/gcc/ada/g-altive.ads b/gcc/ada/g-altive.ads index c9ee0577c18..5951358fada 100644 --- a/gcc/ada/g-altive.ads +++ b/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 -- diff --git a/gcc/ada/g-bytswa.adb b/gcc/ada/g-bytswa.adb index 9ce718a22f4..36eb12dcfef 100644 --- a/gcc/ada/g-bytswa.adb +++ b/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- -- diff --git a/gcc/ada/g-rannum.ads b/gcc/ada/g-rannum.ads index 441c3ce7258..cf34cee55bb 100644 --- a/gcc/ada/g-rannum.ads +++ b/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; diff --git a/gcc/ada/g-soliop-mingw.ads b/gcc/ada/g-soliop-mingw.ads index 039d3754c04..01007ccd291 100644 --- a/gcc/ada/g-soliop-mingw.ads +++ b/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"); diff --git a/gcc/ada/g-soliop-solaris.ads b/gcc/ada/g-soliop-solaris.ads index 9e012d61f73..e4774c0b8f5 100644 --- a/gcc/ada/g-soliop-solaris.ads +++ b/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"); diff --git a/gcc/ada/g-soliop.ads b/gcc/ada/g-soliop.ads index daaa4743b4f..604542f54bf 100644 --- a/gcc/ada/g-soliop.ads +++ b/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; diff --git a/gcc/ada/g-sttsne-locking.ads b/gcc/ada/g-sttsne-locking.ads index 3f2fb43da7b..0032d8066a1 100644 --- a/gcc/ada/g-sttsne-locking.ads +++ b/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 ---------------------------------------- diff --git a/gcc/ada/g-sttsne.ads b/gcc/ada/g-sttsne.ads index c10534e2dbd..f438a0aea47 100644 --- a/gcc/ada/g-sttsne.ads +++ b/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 ---------------------------------------- diff --git a/gcc/ada/g-thread.adb b/gcc/ada/g-thread.adb index 9f584fdc1ce..94719ce9bd7 100644 --- a/gcc/ada/g-thread.adb +++ b/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; diff --git a/gcc/ada/lib.ads b/gcc/ada/lib.ads index bff54f09ec1..746b2c87c7e 100644 --- a/gcc/ada/lib.ads +++ b/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 diff --git a/gcc/ada/par-ch9.adb b/gcc/ada/par-ch9.adb index a4813bdd03b..453b9ab69f8 100644 --- a/gcc/ada/par-ch9.adb +++ b/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 diff --git a/gcc/ada/s-fileio.adb b/gcc/ada/s-fileio.adb index e2c0e3df29c..a56877e2ad6 100644 --- a/gcc/ada/s-fileio.adb +++ b/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; diff --git a/gcc/ada/s-interr.adb b/gcc/ada/s-interr.adb index 6b0037fe771..6f112826c4a 100644 --- a/gcc/ada/s-interr.adb +++ b/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; diff --git a/gcc/ada/s-tasinf-mingw.adb b/gcc/ada/s-tasinf-mingw.adb index 530924efaca..c992da54991 100644 --- a/gcc/ada/s-tasinf-mingw.adb +++ b/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. -- -- -- diff --git a/gcc/ada/s-vmexta.ads b/gcc/ada/s-vmexta.ads index c995a0b7f0d..82b12b3440a 100644 --- a/gcc/ada/s-vmexta.ads +++ b/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 diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb index 3a3e09f0199..3f27a4f1e7b 100644 --- a/gcc/ada/sem_case.adb +++ b/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); diff --git a/gcc/ada/vxaddr2line.adb b/gcc/ada/vxaddr2line.adb index fe12d8ba4b3..b64e364ff01 100644 --- a/gcc/ada/vxaddr2line.adb +++ b/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 => diff --git a/gcc/ada/xeinfo.adb b/gcc/ada/xeinfo.adb index 2742e9173e0..120bf397b22 100644 --- a/gcc/ada/xeinfo.adb +++ b/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; diff --git a/gcc/ada/xnmake.adb b/gcc/ada/xnmake.adb index c3eafd69473..3b3ed830b3a 100644 --- a/gcc/ada/xnmake.adb +++ b/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; diff --git a/gcc/ada/xsinfo.adb b/gcc/ada/xsinfo.adb index e688272b0bc..3a1ba2e7e4a 100644 --- a/gcc/ada/xsinfo.adb +++ b/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; diff --git a/gcc/ada/xsnames.adb b/gcc/ada/xsnames.adb index 204aff98690..4e5ea56b93c 100644 --- a/gcc/ada/xsnames.adb +++ b/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; diff --git a/gcc/ada/xtreeprs.adb b/gcc/ada/xtreeprs.adb index 13b382adb2b..4d735298230 100644 --- a/gcc/ada/xtreeprs.adb +++ b/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; -- 2.30.2