* xsnames.adb: New utility for updating snames.ads and snames.adb

From-SVN: r46109

gcc/ada/ChangeLog

+2001-10-08  Geert Bosch  <bosch@gnat.com>
+
+	* xsnames.adb: New utility for updating snames.ads and snames.adb
+
 2001-10-08  Zack Weinberg  <zack@codesourcery.com>
 
 	* Make-lang.in (ADAFLAGS): Add -W -Wall.

gcc/ada/xsnames.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                          GNAT SYSTEM UTILITIES                           --
+--                                                                          --
+--                              X S N A M E S                               --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                            $Revision$
+--                                                                          --
+--          Copyright (C) 1992-2001 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- --
+-- 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,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This utility is used to make a new version of the Snames package when
+--  new names are added to the spec, the existing versions of snames.ads and
+--  snames.adb are read, and updated to match the set of names in snames.ads.
+--  The updated versions are written to snames.ns and snames.nb (new spec/body)
+
+with Ada.Strings.Unbounded;         use Ada.Strings.Unbounded;
+with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO;
+with Ada.Strings.Maps;              use Ada.Strings.Maps;
+with Ada.Strings.Maps.Constants;    use Ada.Strings.Maps.Constants;
+with Ada.Text_IO;                   use Ada.Text_IO;
+
+with GNAT.Spitbol;                  use GNAT.Spitbol;
+with GNAT.Spitbol.Patterns;         use GNAT.Spitbol.Patterns;
+
+procedure XSnames is
+
+   InB  : File_Type;
+   InS  : File_Type;
+   OutS : File_Type;
+   OutB : File_Type;
+
+   A, B    : VString := Nul;
+   Line    : VString := Nul;
+   Name    : VString := Nul;
+   Name1   : VString := Nul;
+   Oldrev  : VString := Nul;
+   Oname   : VString := Nul;
+   Oval    : VString := Nul;
+   Restl   : VString := Nul;
+   Specrev : VString := Nul;
+
+   Tdigs : Pattern := Any (Decimal_Digit_Set) &
+                      Any (Decimal_Digit_Set) &
+                      Any (Decimal_Digit_Set);
+
+   Get_Srev : Pattern := BreakX ('$') & "$Rev" & "ision: "
+                           & Break (' ') * Specrev;
+
+   Get_Orev : Pattern := (BreakX ('$') & "$Rev" &  "ision: "
+                           & Break ('.') & '.') * A
+                           & Break (' ') * Oldrev & ' ';
+
+   Name_Ref : Pattern := Span (' ') * A & Break (' ') * Name
+                           & Span (' ') * B
+                           & ": constant Name_Id := N + " & Tdigs
+                           & ';' & Rest * Restl;
+
+   Get_Name : Pattern := "Name_" & Rest * Name1;
+
+   Chk_Low  : Pattern := Pos (0) & Any (Lower_Set) & Rest & Pos (1);
+
+   Findu    : Pattern := Span ('u') * A;
+
+   Val : Natural;
+
+   Xlate_U_Und : Character_Mapping := To_Mapping ("u", "_");
+
+   M : Match_Result;
+
+begin
+   Open (InB, In_File, "snames.adb");
+   Open (InS, In_File, "snames.ads");
+
+   Create (OutS, Out_File, "snames.ns");
+   Create (OutB, Out_File, "snames.nb");
+
+   Anchored_Mode := True;
+   Oname := Nul;
+   Val := 0;
+
+   loop
+      Line := Get_Line (InS);
+      Put_Line (OutS, Line);
+      exit when not Match (Line, Get_Srev);
+   end loop;
+
+   loop
+      Line := Get_Line (InB);
+      exit when Match (Line, Get_Orev);
+      Put_Line (OutB, Line);
+   end loop;
+
+   Line := A & (Natural'Value (S (Oldrev)) + 1) & " $";
+   Line := Rpad (Line, 76) & "--";
+   Put_Line (OutB, Line);
+
+   loop
+      Line := Get_Line (InB);
+      exit when Match (Line, "   Preset_Names");
+      Put_Line (OutB, Line);
+   end loop;
+
+   Put_Line (OutB, Line);
+
+   LoopN : while not End_Of_File (InS) loop
+      Line := Get_Line (InS);
+
+      if not Match (Line, Name_Ref) then
+         Put_Line (OutS, Line);
+
+      else
+         Oval := Lpad (V (Val), 3, '0');
+
+         if Match (Name, "Last_") then
+            Oval := Lpad (V (Val - 1), 3, '0');
+         end if;
+
+         Put_Line
+           (OutS, A & Name & B & ": constant Name_Id := N + "
+            & Oval & ';' & Restl);
+
+         if Match (Name, Get_Name) then
+            Name := Name1;
+            Val := Val + 1;
+
+            if Match (Name, Findu, M) then
+               Replace (M, Translate (A, Xlate_U_Und));
+               Translate (Name, Lower_Case_Map);
+
+            elsif not Match (Name, "Op_", "") then
+               Translate (Name, Lower_Case_Map);
+
+            else
+               Name := 'O' & Translate (Name, Lower_Case_Map);
+            end if;
+
+            if Name = "error" then
+               Name := V ("<error>");
+            end if;
+
+            if not Match (Name, Chk_Low) then
+               Put_Line (OutB, "     """ & Name & "#"" &");
+            end if;
+         end if;
+      end if;
+   end loop LoopN;
+
+   loop
+      Line := Get_Line (InB);
+      exit when Match (Line, "      ""#"";");
+   end loop;
+
+   Put_Line (OutB, Line);
+
+   while not End_Of_File (InB) loop
+      Put_Line (OutB, Get_Line (InB));
+   end loop;
+
+   Put_Line (OutB, "--  Updated to match snames.ads revision " & Specrev);
+
+end XSnames;