From d6ca724ce2bf5d47d973d6231a80e6e83c244a92 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 26 May 2008 11:43:27 +0000 Subject: [PATCH] * ceinfo.adb, csinfo.adb: Remove warnings. Update headers. From-SVN: r135912 --- gcc/ada/ChangeLog | 4 ++ gcc/ada/ceinfo.adb | 36 ++++++++-------- gcc/ada/csinfo.adb | 103 ++++++++++++++++++++++++--------------------- 3 files changed, 76 insertions(+), 67 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7929d702bb4..1d114c2d2c3 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,7 @@ +2008-05-26 Arnaud Charlet + + * ceinfo.adb, csinfo.adb: Remove warnings. Update headers. + 2008-05-26 Eric Botcazou * gigi.h (gigi): Remove bogus ATTRIBUTE_UNUSED marker. diff --git a/gcc/ada/ceinfo.adb b/gcc/ada/ceinfo.adb index 494b9077c47..c88b642e444 100644 --- a/gcc/ada/ceinfo.adb +++ b/gcc/ada/ceinfo.adb @@ -6,18 +6,17 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998 Free Software Foundation, Inc. -- +-- Copyright (C) 1998-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- -- --- ware Foundation; either version 2, or (at your option) any later ver- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING. If not, write -- --- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- --- Boston, MA 02110-1301, USA. -- +-- Public License distributed with GNAT; see file COPYING3. If not, go to -- +-- http://www.gnu.org/licenses for a complete copy of the license. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- @@ -43,9 +42,6 @@ procedure CEinfo is Infil : File_Type; Lineno : Natural := 0; - Err : exception; - -- Raised on fatal error - Fieldnm : VString; Accessfunc : VString; Line : VString; @@ -53,25 +49,27 @@ procedure CEinfo is Fields : GNAT.Spitbol.Table_VString.Table (500); -- Maps field names to underlying field access name - UC : Pattern := Any ("ABCDEFGHIJKLMNOPQRSTUVWXYZ"); + UC : constant Pattern := Any ("ABCDEFGHIJKLMNOPQRSTUVWXYZ"); - Fnam : Pattern := (UC & Break (' ')) * Fieldnm; + Fnam : constant Pattern := (UC & Break (' ')) * Fieldnm; - Field_Def : Pattern := "-- " & Fnam & " (" & Break (')') * Accessfunc; + Field_Def : constant Pattern := + "-- " & Fnam & " (" & Break (')') * Accessfunc; - Field_Ref : Pattern := " -- " & Fnam & Break ('(') & Len (1) & - Break (')') * Accessfunc; + Field_Ref : constant Pattern := + " -- " & Fnam & Break ('(') & Len (1) & + Break (')') * Accessfunc; - Field_Com : Pattern := " -- " & Fnam & Span (' ') & - (Break (' ') or Rest) * Accessfunc; + Field_Com : constant Pattern := " -- " & Fnam & Span (' ') & + (Break (' ') or Rest) * Accessfunc; - Func_Hedr : Pattern := " function " & Fnam; + Func_Hedr : constant Pattern := " function " & Fnam; - Func_Retn : Pattern := " return " & Break (' ') * Accessfunc; + Func_Retn : constant Pattern := " return " & Break (' ') * Accessfunc; - Proc_Hedr : Pattern := " procedure " & Fnam; + Proc_Hedr : constant Pattern := " procedure " & Fnam; - Proc_Setf : Pattern := " Set_" & Break (' ') * Accessfunc; + Proc_Setf : constant Pattern := " Set_" & Break (' ') * Accessfunc; procedure Next_Line; -- Read next line trimmed from Infil into Line and bump Lineno diff --git a/gcc/ada/csinfo.adb b/gcc/ada/csinfo.adb index 47953e89ce2..9d8b16b572c 100644 --- a/gcc/ada/csinfo.adb +++ b/gcc/ada/csinfo.adb @@ -6,18 +6,17 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2005 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 2, or (at your option) any later ver- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING. If not, write -- --- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- --- Boston, MA 02110-1301, USA. -- +-- Public License distributed with GNAT; see file COPYING3. If not, go to -- +-- http://www.gnu.org/licenses for a complete copy of the license. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- @@ -55,7 +54,7 @@ procedure CSinfo is Done : exception; -- Raised after error is found to terminate run - WSP : Pattern := Span (' ' & ASCII.HT); + WSP : constant Pattern := Span (' ' & ASCII.HT); Fields : TV.Table (300); Fields1 : TV.Table (300); @@ -87,50 +86,56 @@ procedure CSinfo is Flags : TV.Table (20); -- Maps flag numbers to letters - N_Fields : Pattern := BreakX ("JL"); - E_Fields : Pattern := BreakX ("5EFGHIJLOP"); - U_Fields : Pattern := BreakX ("1345EFGHIJKLOPQ"); - B_Fields : Pattern := BreakX ("12345EFGHIJKLOPQ"); + N_Fields : constant Pattern := BreakX ("JL"); + E_Fields : constant Pattern := BreakX ("5EFGHIJLOP"); + U_Fields : constant Pattern := BreakX ("1345EFGHIJKLOPQ"); + B_Fields : constant Pattern := BreakX ("12345EFGHIJKLOPQ"); Line : VString; Bad : Boolean; - Field : VString := Nul; + Field : constant VString := Nul; Fields_Used : VString := Nul; - Name : VString := Nul; - Next : VString := Nul; + Name : constant VString := Nul; + Next : constant VString := Nul; Node : VString := Nul; Ref : VString := Nul; - Synonym : VString := Nul; - Nxtref : VString := Nul; + Synonym : constant VString := Nul; + Nxtref : constant VString := Nul; Which_Field : aliased VString := Nul; - Node_Search : Pattern := WSP & "-- N_" & Rest * Node; - Break_Punc : Pattern := Break (" .,"); - Plus_Binary : Pattern := WSP & "-- plus fields for binary operator"; - Plus_Unary : Pattern := WSP & "-- plus fields for unary operator"; - Plus_Expr : Pattern := WSP & "-- plus fields for expression"; - Break_Syn : Pattern := WSP & "-- " & Break (' ') * Synonym & - " (" & Break (')') * Field; - Break_Field : Pattern := BreakX ('-') * Field; - Get_Field : Pattern := BreakX (Decimal_Digit_Set) & - Span (Decimal_Digit_Set) * Which_Field; - Break_WFld : Pattern := Break (Which_Field'Access); - Get_Funcsyn : Pattern := WSP & "function " & Rest * Synonym; - Extr_Field : Pattern := BreakX ('-') & "-- " & Rest * Field; - Get_Procsyn : Pattern := WSP & "procedure Set_" & Rest * Synonym; - Get_Inline : Pattern := WSP & "pragma Inline (" & Break (')') * Name; - Set_Name : Pattern := "Set_" & Rest * Name; - Func_Rest : Pattern := " function " & Rest * Synonym; - Get_Nxtref : Pattern := Break (',') * Nxtref & ','; - Test_Syn : Pattern := Break ('=') & "= N_" & - (Break (" ,)") or Rest) * Next; - Chop_Comma : Pattern := BreakX (',') * Next; - Return_Fld : Pattern := WSP & "return " & Break (' ') * Field; - Set_Syn : Pattern := " procedure Set_" & Rest * Synonym; - Set_Fld : Pattern := WSP & "Set_" & Break (' ') * Field & " (N, Val)"; - Break_With : Pattern := Break ('_') ** Field & "_With_Parent"; + Node_Search : constant Pattern := WSP & "-- N_" & Rest * Node; + Break_Punc : constant Pattern := Break (" .,"); + Plus_Binary : constant Pattern := WSP + & "-- plus fields for binary operator"; + Plus_Unary : constant Pattern := WSP + & "-- plus fields for unary operator"; + Plus_Expr : constant Pattern := WSP + & "-- plus fields for expression"; + Break_Syn : constant Pattern := WSP & "-- " + & Break (' ') * Synonym + & " (" & Break (')') * Field; + Break_Field : constant Pattern := BreakX ('-') * Field; + Get_Field : constant Pattern := BreakX (Decimal_Digit_Set) + & Span (Decimal_Digit_Set) * Which_Field; + Break_WFld : constant Pattern := Break (Which_Field'Access); + Get_Funcsyn : constant Pattern := WSP & "function " & Rest * Synonym; + Extr_Field : constant Pattern := BreakX ('-') & "-- " & Rest * Field; + Get_Procsyn : constant Pattern := WSP & "procedure Set_" & Rest * Synonym; + Get_Inline : constant Pattern := WSP & "pragma Inline (" + & Break (')') * Name; + Set_Name : constant Pattern := "Set_" & Rest * Name; + Func_Rest : constant Pattern := " function " & Rest * Synonym; + Get_Nxtref : constant Pattern := Break (',') * Nxtref & ','; + Test_Syn : constant Pattern := Break ('=') & "= N_" + & (Break (" ,)") or Rest) * Next; + Chop_Comma : constant Pattern := BreakX (',') * Next; + Return_Fld : constant Pattern := WSP & "return " & Break (' ') * Field; + Set_Syn : constant Pattern := " procedure Set_" & Rest * Synonym; + Set_Fld : constant Pattern := WSP & "Set_" & Break (' ') * Field + & " (N, Val)"; + Break_With : constant Pattern := Break ('_') ** Field & "_With_Parent"; type VStringA is array (Natural range <>) of VString; @@ -187,9 +192,9 @@ begin Set (Flags, "17", V ("Q")); Set (Flags, "18", V ("R")); - -- Special fields table. The following fields are not recorded or checked - -- by Csinfo, since they are specially handled. This means that both the - -- field definitions, and the corresponding subprograms are ignored. + -- Special fields table. The following names are not recorded or checked + -- by Csinfo, since they are specially handled. This means that any field + -- definition or subprogram with a matching name is ignored. Set (Special, "Analyzed", True); Set (Special, "Assignment_OK", True); @@ -214,7 +219,9 @@ begin Set (Special, "Is_Static_Expression", True); Set (Special, "Left_Opnd", True); Set (Special, "Must_Not_Freeze", True); + Set (Special, "Nkind_In", True); Set (Special, "Parens", True); + Set (Special, "Pragma_Name", True); Set (Special, "Raises_Constraint_Error", True); Set (Special, "Right_Opnd", True); @@ -334,7 +341,7 @@ begin Put_Line ("Check for missing functions"); declare - List : TV.Table_Array := Convert_To_Array (Fields1); + List : constant TV.Table_Array := Convert_To_Array (Fields1); begin if List'Length > 0 then @@ -385,7 +392,7 @@ begin Put_Line ("Check for missing set procedures"); declare - List : TV.Table_Array := Convert_To_Array (Fields1); + List : constant TV.Table_Array := Convert_To_Array (Fields1); begin if List'Length > 0 then @@ -424,7 +431,7 @@ begin Put_Line ("Check no pragma Inlines were omitted"); declare - List : TV.Table_Array := Convert_To_Array (Fields); + List : constant TV.Table_Array := Convert_To_Array (Fields); Nxt : VString := Nul; begin @@ -523,7 +530,7 @@ begin Put_Line ("Check for missing functions in body"); declare - List : TV.Table_Array := Convert_To_Array (Refs); + List : constant TV.Table_Array := Convert_To_Array (Refs); begin if List'Length /= 0 then @@ -613,7 +620,7 @@ begin Put_Line ("Check for missing set procedures in body"); declare - List : TV.Table_Array := Convert_To_Array (Fields1); + List : constant TV.Table_Array := Convert_To_Array (Fields1); begin if List'Length /= 0 then -- 2.30.2