Subversion Repositories openrisc

------------------------------------------------------------------------------

--                                                                          --

--                          GNAT SYSTEM UTILITIES                           --

--                                                                          --

--                               C E I N F O                                --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--          Copyright (C) 1998-2010, 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 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 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.      --

--                                                                          --

------------------------------------------------------------------------------

--  Check consistency of einfo.ads and einfo.adb. Checks that field name usage

--  is consistent, including comments mentioning fields.

--  Note that this is used both as a standalone program, and as a procedure

--  called by XEinfo. This raises an unhandled exception if it finds any

--  errors; we don't attempt any sophisticated error recovery.

with Ada.Strings.Unbounded;         use Ada.Strings.Unbounded;

with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO;

with Ada.Text_IO;                   use Ada.Text_IO;

with GNAT.Spitbol;                  use GNAT.Spitbol;

with GNAT.Spitbol.Patterns;         use GNAT.Spitbol.Patterns;

with GNAT.Spitbol.Table_VString;

procedure CEinfo is

   package TV renames GNAT.Spitbol.Table_VString;

   use TV;

   Infil  : File_Type;

   Lineno : Natural := 0;

   Err : exception;

   --  Raised on error

   Fieldnm    : VString;

   Accessfunc : VString;

   Line       : VString;

   Fields : GNAT.Spitbol.Table_VString.Table (500);

   --  Maps field names to underlying field access name

   UC : constant Pattern := Any ("ABCDEFGHIJKLMNOPQRSTUVWXYZ");

   Fnam : constant Pattern := (UC & Break (' ')) * Fieldnm;

   Field_Def : constant Pattern :=

                 "--    " & Fnam & " (" & Break (')') * Accessfunc;

   Field_Ref : constant Pattern :=

                 "   --    " & Fnam & Break ('(') & Len (1) &

                   Break (')') * Accessfunc;

   Field_Com : constant Pattern := "   --    " & Fnam & Span (' ') &

                                     (Break (' ') or Rest) * Accessfunc;

   Func_Hedr : constant Pattern := "   function " & Fnam;

   Func_Retn : constant Pattern := "      return " & Break (' ') * Accessfunc;

   Proc_Hedr : constant Pattern := "   procedure " & Fnam;

   Proc_Setf : constant Pattern := "      Set_" & Break (' ') * Accessfunc;

   procedure Next_Line;

   --  Read next line trimmed from Infil into Line and bump Lineno

   procedure Next_Line is

   begin

      Line := Get_Line (Infil);

      Trim (Line);

      Lineno := Lineno + 1;

   end Next_Line;

--  Start of processing for CEinfo

begin

   Anchored_Mode := True;

   New_Line;

   Open (Infil, In_File, "einfo.ads");

   Put_Line ("Acquiring field names from spec");

   loop

      Next_Line;

      exit when Match (Line, "   -- Access Kinds --");

      if Match (Line, Field_Def) then

         Set (Fields, Fieldnm, Accessfunc);

      end if;

   end loop;

   Put_Line ("Checking consistent references in spec");

   loop

      Next_Line;

      exit when Match (Line, "   -- Description of Defined");

   end loop;

   loop

      Next_Line;

      exit when Match (Line, "   -- Component_Alignment Control");

      if Match (Line, Field_Ref) then

         if Accessfunc /= "synth"

              and then

            Accessfunc /= "special"

              and then

            Accessfunc /= Get (Fields, Fieldnm)

         then

            if Present (Fields, Fieldnm) then

               Put_Line ("*** field name incorrect at line " & Lineno);

               Put_Line ("      found field " & Accessfunc);

               Put_Line ("      expecting field " & Get (Fields, Fieldnm));

            else

               Put_Line

                 ("*** unknown field name " & Fieldnm & " at line " & Lineno);

            end if;

            raise Err;

         end if;

      end if;

   end loop;

   Close (Infil);

   Open (Infil, In_File, "einfo.adb");

   Lineno := 0;

   Put_Line ("Check listing of fields in body");

   loop

      Next_Line;

      exit when Match (Line, "   -- Attribute Access Functions --");

      if Match (Line, Field_Com)

        and then Fieldnm /= "(unused)"

        and then Accessfunc /= Get (Fields, Fieldnm)

      then

         if Present (Fields, Fieldnm) then

            Put_Line ("*** field name incorrect at line " & Lineno);

            Put_Line ("      found field " & Accessfunc);

            Put_Line ("      expecting field " & Get (Fields, Fieldnm));

         else

            Put_Line

              ("*** unknown field name " & Fieldnm & " at line " & Lineno);

         end if;

         raise Err;

      end if;

   end loop;

   Put_Line ("Check references in access routines in body");

   loop

      Next_Line;

      exit when Match (Line, "   -- Classification Functions --");

      if Match (Line, Func_Hedr) then

         null;

      elsif Match (Line, Func_Retn)

        and then Accessfunc /= Get (Fields, Fieldnm)

        and then Fieldnm /= "Mechanism"

      then

         Put_Line ("*** incorrect field at line " & Lineno);

         Put_Line ("      found field " & Accessfunc);

         Put_Line ("      expecting field " & Get (Fields, Fieldnm));

         raise Err;

      end if;

   end loop;

   Put_Line ("Check references in set routines in body");

   loop

      Next_Line;

      exit when Match (Line, "   -- Attribute Set Procedures");

   end loop;

   loop

      Next_Line;

      exit when Match (Line, "   ------------");

      if Match (Line, Proc_Hedr) then

         null;

      elsif Match (Line, Proc_Setf)

        and then Accessfunc /= Get (Fields, Fieldnm)

        and then Fieldnm /= "Mechanism"

      then

         Put_Line ("*** incorrect field at line " & Lineno);

         Put_Line ("      found field " & Accessfunc);

         Put_Line ("      expecting field " & Get (Fields, Fieldnm));

         raise Err;

      end if;

   end loop;

   Close (Infil);

   Put_Line ("All tests completed successfully, no errors detected");

end CEinfo;