gnatcoll_xref_24.0.0_4b44508a/gnatcoll_db2ada/gnatcoll-db2ada-main-generate.adb

------------------------------------------------------------------------------
--                             G N A T C O L L                              --
--                                                                          --
--                     Copyright (C) 2008-2020, AdaCore                     --
--                                                                          --
-- This library is free software;  you can redistribute it and/or modify it --
-- under terms of the  GNU General Public License  as published by the Free --
-- Software  Foundation;  either version 3,  or (at your  option) any later --
-- version. This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
------------------------------------------------------------------------------

pragma Ada_2012;

with Ada.Containers;          use Ada.Containers;
with Ada.Containers.Indefinite_Ordered_Sets;
with Ada.Strings.Maps;        use Ada.Strings.Maps;
with Ada.Text_IO;             use Ada.Text_IO;
with GNATCOLL.Utils;          use GNATCOLL.Utils;

--  Register advanced types
pragma Warnings (Off, "no entities of * are referenced");
with GNATCOLL.SQL_Fields;     use GNATCOLL.SQL_Fields;
pragma Warnings (On, "no entities of * are referenced");

separate (GNATCOLL.Db2Ada.Main)
procedure Generate
  (Generated : String; Include_Database_Create : Boolean)
is
   package String_Sets is new Ada.Containers.Indefinite_Ordered_Sets
     (String, "<", "=");
   use String_Sets;

   Spec_File, Body_File : File_Type;

   function Capitalize (Name : XString) return String;
   --  Make a name suitable for display

   function Get_Namespace (T_Descr : Table_Description) return String;
   --  Return the name of the namespace for the table

   procedure Print_Comment
     (File : File_Type; Indent : String; Comment : String);
   --  Print a multi-line comment to the File

   procedure Print_Withs (T_Descr : in out Table_Description);
   --  Print all withs needed for the given table

   Names     : String_Sets.Set;
   procedure Print_String_Constants (Table : in out Table_Description);
   --  Process a table, and generate string constants for it and its fields.
   --  Names is used to avoid duplicates

   procedure Print_Database_Create;
   --  Print the Ada subprogram that recreates the database and its initial
   --  contents.

   procedure Process_Tables;
   --  Generate the Ada mapping for all the SQL tables

   -------------------
   -- Print_Comment --
   -------------------

   procedure Print_Comment
     (File : File_Type; Indent : String; Comment : String)
   is
      Reflow : constant Boolean := True;
      --  If True, ASCII.LF are ignored in the initial comment, and the text is
      --  reflowed.

      Str   : String := Comment;
      Start : Integer := Str'First;
      Last_Space : Natural := Str'First;
   begin
      for C in Str'Range loop
         if not Reflow and then Str (C) = ASCII.LF then
            Put_Line (File, Indent & "--  " & Str (Start .. C - 1));
            Start := C + 1;
            Last_Space := Start;

         else
            if Str (C) = ASCII.LF or else Str (C) = ' ' then
               Str (C) := ' ';
               Last_Space := C;
               if C = Start then
                  Start := C + 1;
               end if;
            end if;

            if C - Start >= 78 - 4 - Indent'Length then
               Put_Line
                 (File, Indent & "--  " & Str (Start .. Last_Space - 1));
               Start := Last_Space + 1;
            end if;
         end if;
      end loop;

      if Start < Str'Last then
         Put_Line (File, Indent & "--  " & Str (Start .. Str'Last));
      end if;
   end Print_Comment;

   -----------------
   -- Print_Withs --
   -----------------

   procedure Print_Withs (T_Descr : in out Table_Description) is
      procedure For_Field (F : in out GNATCOLL.SQL.Inspect.Field);
      procedure For_Field (F : in out GNATCOLL.SQL.Inspect.Field) is
         Typ : constant String :=
            F.Get_Type.Type_To_SQL (null, For_Database => False);
      begin
         for T in reverse Typ'Range loop
            if Typ (T) = '.' then
               Put_Line
                  (Spec_File,
                   "with " & Typ (Typ'First .. T - 1) & "; use "
                   & Typ (Typ'First .. T - 1) & ";");
               exit;
            end if;
         end loop;
      end For_Field;
   begin
      For_Each_Field (T_Descr, For_Field'Access, False);
   end Print_Withs;

   -------------------
   -- Get_Namespace --
   -------------------

   function Get_Namespace (T_Descr : Table_Description) return String is
      N : constant String := T_Descr.Name;
   begin
      for J in N'Range loop
         if N (J) = '.' then
            return Capitalize (N (N'First .. J - 1));
         end if;
      end loop;
      return "";
   end Get_Namespace;

   --------------------
   -- Process_Tables --
   --------------------

   procedure Process_Tables is
      Namespaces              : String_Sets.Set;
      Indent_Level            : Natural;
      Process_Abstract_Tables : Boolean;
      Current_Namespace       : XString;

      procedure Add_Namespace (T_Descr : in out Table_Description);
      --  Add the namespace for T_Descr

      procedure Print_Table_Spec (T_Descr : in out Table_Description);
      --  Print the specs for a table.
      --  If Process_Abstract_Tables is True, only abstract tables are
      --  processed. Otherwise they are ignored.

      procedure Print_Table_Global (Table : in out Table_Description);
      --  Print the global constant for the table.

      procedure Print_FK (Table : in out Table_Description);
      --  Print the FK subprograms

      function Table_Matches (T_Descr : Table_Description) return Boolean
         is (Get_Namespace (T_Descr) = Current_Namespace
             and then
                ((Process_Abstract_Tables and then T_Descr.Is_Abstract)
                 or else (not Process_Abstract_Tables
                          and then not T_Descr.Is_Abstract)));
      --  Whether the table matches the current filtering

      -------------------
      -- Add_Namespace --
      -------------------

      procedure Add_Namespace (T_Descr : in out Table_Description) is
      begin
         Namespaces.Include (Get_Namespace (T_Descr));
      end Add_Namespace;

      ----------------------
      -- Print_Table_Spec --
      ----------------------

      procedure Print_Table_Spec (T_Descr : in out Table_Description) is
         Indent : constant String := (1 .. Indent_Level => ' ');

         procedure For_Field (F : in out GNATCOLL.SQL.Inspect.Field);
         procedure For_Field (F : in out GNATCOLL.SQL.Inspect.Field) is
            Typ : constant String :=
               F.Get_Type.Type_To_SQL (null, For_Database => False);
         begin
            Put
               (Spec_File,
                Indent & "   " & Capitalize (F.Name) & " : " & Typ);

            if T_Descr.Is_Abstract then
               Put (Spec_File, " (Table_Name");
            else
               Put (Spec_File, " (Ta_" & Capitalize (T_Descr.Name));
            end if;

            Put_Line (Spec_File,
                      ", Instance, N_" & Capitalize (F.Name) & ", Index);");

            if F.Description /= "" then
               Print_Comment (Spec_File, Indent & "   ", F.Description);
               New_Line (Spec_File);
            end if;
         end For_Field;

      begin
         if not Table_Matches (T_Descr) then
            return;
         end if;

         New_Line (Spec_File);

         if T_Descr.Is_Abstract then
            Put_Line
               (Spec_File,
                Indent & "type T_" & Capitalize (T_Descr.Name));
            Put_Line
               (Spec_File,
                Indent & "   (Table_Name : Cst_String_Access;");
            Put_Line
               (Spec_File,
                Indent & "    Instance   : Cst_String_Access;");
            Put_Line
               (Spec_File,
                Indent & "    Index      : Integer)");
            Put
               (Spec_File,
                Indent & "is abstract new ");

            if T_Descr.Super_Table /= No_Table then
               Put (Spec_File, "T_" & Capitalize (T_Descr.Super_Table.Name));
            else
               Put (Spec_File, "SQL_Table");
            end if;

            Put_Line (Spec_File, " (Table_Name, Instance, Index) with");

         else
            Put_Line
               (Spec_File,
                Indent & "type T_Abstract_" & Capitalize (T_Descr.Name));
            Put_Line
               (Spec_File,
                Indent & "   (Instance : Cst_String_Access;");
            Put_Line
               (Spec_File,
                Indent & "    Index    : Integer)");
            Put
               (Spec_File,
                Indent & "is abstract new ");

            if T_Descr.Super_Table /= No_Table then
               Put (Spec_File, "T_" & Capitalize (T_Descr.Super_Table.Name));
            else
               Put (Spec_File, "SQL_Table");
            end if;

            Put_Line (Spec_File,
                      " (Ta_" & Capitalize (T_Descr.Name)
                      & ", Instance, Index) with");
         end if;

         Put_Line (Spec_File, Indent & "record");
         For_Each_Field (T_Descr, For_Field'Access, False);
         Put_Line (Spec_File, Indent & "end record;");

         Print_Comment (Spec_File, Indent, T_Descr.Description);

         if not T_Descr.Is_Abstract then
            New_Line (Spec_File);
            Put_Line (Spec_File, Indent & "type T_" & Capitalize (T_Descr.Name)
                      & " (Instance : Cst_String_Access)");
            Put (Spec_File,
                 Indent & "   is new T_Abstract_" & Capitalize (T_Descr.Name));
            Put_Line (Spec_File, " (Instance, -1) with null record;");
            Put_Line
               (Spec_File,
                Indent & "--  To use named aliases of the table in a query");
            Put_Line
               (Spec_File,
                Indent & "--  Use Instance=>null to use the default name.");

            New_Line (Spec_File);
            Put_Line
               (Spec_File,
                Indent & "type T_Numbered_" & Capitalize (T_Descr.Name)
                & " (Index : Integer)");
            Put (Spec_File,
                Indent &  "   is new T_Abstract_" & Capitalize (T_Descr.Name));
            Put_Line (Spec_File, " (null, Index) with null record;");
            Put_Line
               (Spec_File,
                Indent & "--  To use aliases in the form name1, name2,...");
         end if;
      end Print_Table_Spec;

      --------------
      -- Print_FK --
      --------------

      procedure Print_FK (Table : in out Table_Description) is
         Indent : constant String := (1 .. Indent_Level => ' ');
         Prev_Id : Integer := -1;

         procedure For_FK
           (From, To : GNATCOLL.SQL.Inspect.Field;
            Id : Natural; Ambiguous : Boolean);

         procedure Finish_Subprogram (Id : Integer);

         procedure Finish_Subprogram (Id : Integer) is
         begin
            if Id /= Prev_Id then
               Put_Line (Body_File, ";");
               Put_Line (Body_File, Indent & "end FK;");
            end if;
         end Finish_Subprogram;

         procedure For_FK
           (From, To : GNATCOLL.SQL.Inspect.Field;
            Id : Natural; Ambiguous : Boolean) is
         begin
            if not Ambiguous then
               if Id /= Prev_Id then
                  if Prev_Id /= -1 then
                     Finish_Subprogram (Id);
                  end if;

                  Put_Line
                    (Spec_File, Indent & "function FK (Self : T_" &
                       Capitalize (Table.Name) &
                       "'Class; Foreign : T_" & Capitalize (To.Get_Table.Name)
                       & "'Class) return SQL_Criteria;");

                  New_Line (Body_File);
                  Put_Line
                    (Body_File, Indent & "function FK (Self : T_" &
                       Capitalize (Table.Name) &
                       "'Class; Foreign : T_" & Capitalize (To.Get_Table.Name)
                       & "'Class) return SQL_Criteria is");
                  Put_Line (Body_File, Indent & "begin");
                  Put (Body_File, Indent & "   return Self.");
               else
                  New_Line (Body_File);
                  Put (Body_File, Indent & "      and Self.");
               end if;

               Put (Body_File,
                    Capitalize (From.Name)
                    & " = Foreign." & Capitalize (To.Name));
               Prev_Id := Id;
            end if;
         end For_FK;

      begin
         if Get_Namespace (Table) = Current_Namespace then
            For_Each_FK (Table, For_FK'Access);
            Finish_Subprogram (-1);
         end if;
      end Print_FK;

      ------------------------
      -- Print_Table_Global --
      ------------------------

      procedure Print_Table_Global (Table : in out Table_Description) is
         Indent : constant String := (1 .. Indent_Level => ' ');
         NS     : constant String := Get_Namespace (Table);
      begin
         if not Table.Is_Abstract
            and then NS = Current_Namespace
         then
            declare
               --  The namespace's name is already part of the enclosing
               --  package, so don't duplicate it in the table's name.
               N : constant String := Capitalize (Table.Name);
               N2 : constant String :=
                  N (N'First
                     + (if NS'Length = 0 then 0 else NS'Length + 1)
                     .. N'Last);
            begin
               Put_Line
                  (Spec_File, Indent & N2 & " : T_" & N & " (null);");
            end;
         end if;
      end Print_Table_Global;

   begin
      --  Compute the namespaces
      For_Each_Table (Schema, Add_Namespace'Access);

      for Namespace of Namespaces loop
         Current_Namespace := To_XString (Namespace);

         if Namespace /= "" then
            New_Line (Spec_File);
            Put_Line (Spec_File,
                      "   ---" & (1 .. Namespace'Length => '-') & "---");
            Put_Line (Spec_File,
                      "   -- " & Namespace & " --");
            Put_Line (Spec_File,
                      "   ---" & (1 .. Namespace'Length => '-') & "---");
            New_Line (Spec_File);

            Put_Line (Spec_File, "   package " & Namespace & " is");
            Put_Line (Body_File, "   package body " & Namespace & " is");
            Indent_Level := 6;
         else
            Indent_Level := 3;
         end if;

         Process_Abstract_Tables := True;
         For_Each_Table (Schema, Print_Table_Spec'Access);

         Process_Abstract_Tables := False;
         For_Each_Table (Schema, Print_Table_Spec'Access);

         New_Line (Spec_File);
         For_Each_Table (Schema, Print_FK'Access);

         For_Each_Table (Schema, Print_Table_Global'Access);

         if Namespace /= "" then
            Put_Line (Spec_File, "   end " & Namespace & ";");
            Put_Line (Body_File, "   end " & Namespace & ";");
         end if;
      end loop;
   end Process_Tables;

   ----------------
   -- Capitalize --
   ----------------

   function Capitalize (Name : XString) return String is
   begin
      return Capitalize (To_String (Name));
   end Capitalize;

   ----------------------------
   -- Print_String_Constants --
   ----------------------------

   procedure Print_String_Constants (Table : in out Table_Description) is
      procedure For_Field (F : in out GNATCOLL.SQL.Inspect.Field);
      procedure For_Field (F : in out GNATCOLL.SQL.Inspect.Field) is
      begin
         Names.Include (F.Name);
      end For_Field;

   begin
      Put_Line (Spec_File, "   TC_" & Capitalize (Table.Name)
                & " : aliased constant String := """
                & Ada_Quote (Quote_Keyword (Table.Name)) & """;");
      Put_Line (Spec_File, "   Ta_" & Capitalize (Table.Name)
                & " : constant Cst_String_Access := TC_"
                & Capitalize (Table.Name) & "'Access;");

      For_Each_Field (Table, For_Field'Access, True);
   end Print_String_Constants;

   ---------------------------
   -- Print_Database_Create --
   ---------------------------

   procedure Print_Database_Create is
      Spec : constant String :=
        "   procedure Create_Database" & ASCII.LF
        & "      (DB : not null access"
        &  " GNATCOLL.SQL.Exec.Database_Connection_Record'Class)";

      procedure Puts (Data : String);
      --  Format Data as an Ada String

      procedure Puts (Data : String) is
      begin
         for D in Data'Range loop
            if Data (D) = '"' then
               Put (Body_File, """""");
            elsif Data (D) = ASCII.LF then
               Put_Line (Body_File, """ & ASCII.LF");
               Put (Body_File, "         & """);
            else
               Put (Body_File, Data (D));
            end if;
         end loop;
      end Puts;

      F : File_Schema_IO;
   begin
      Put_Line (Spec_File, ASCII.LF & Spec & ";");
      Put_Line
        (Spec_File, "   --  Create the database and its initial contents");
      Put_Line
        (Spec_File, "   --  The SQL is not automatically committed");

      Put_Line (Body_File, ASCII.LF & Spec & ASCII.LF & "   is");

      Put (Body_File, "      DbSchema : constant String := """);
      F.File := GNATCOLL.VFS.No_File;
      Write_Schema
        (F, Schema, Puts => Puts'Access, Align_Columns => False,
         Show_Comments => False);
      Put_Line (Body_File, """;");

      if Load_File /= GNATCOLL.VFS.No_File then
         Put (Body_File, "      Data : constant String := """);
         Load_Data (Load_File, Puts'Access);
         Put_Line (Body_File, """;");
      end if;

      Put_Line (Body_File, "      F : File_Schema_IO;");
      Put_Line (Body_File, "      D : DB_Schema_IO;");
      Put_Line (Body_File, "      Schema : DB_Schema;");
      Put_Line (Body_File, "   begin");
      Put_Line (Body_File, "      Schema := Read_Schema (F, DbSchema);");
      Put_Line (Body_File, "      D.DB := Database_Connection (DB);");
      Put_Line (Body_File, "      Write_Schema (D, Schema);");

      if Load_File /= GNATCOLL.VFS.No_File then
         Put_Line (Body_File, "      if DB.Success then");
         Put_Line (Body_File, "         Load_Data (DB, Data, Schema);");
         Put_Line (Body_File, "      end if;");
      end if;

      Put_Line (Body_File, "   end Create_Database;");
   end Print_Database_Create;

   N : String_Sets.Cursor;
   F : Virtual_File;

   Base_File : constant Filesystem_String :=
     +To_Lower (Translate (Generated, To_Mapping (".", "-")));

begin
   --  This version creates the output via a simple list of calls to Put_Line.
   --  A more advanced version using the templates_parser is also available,
   --  but requires the installation of the latter on the machine

   --  Create the database_names package

   if Output (Output_Ada_Specs) then
      F := Create_From_Dir
        (Dir => Output_Dir, Base_Name => Base_File & "_names.ads");

      Create (Spec_File, Name => F.Display_Full_Name);
      Put_Line (Spec_File, "with GNATCOLL.SQL; use GNATCOLL.SQL;");

      Put_Line (Spec_File, "package " & Generated & "_Names is");
      Put_Line (Spec_File, "   pragma Style_Checks (Off);");

      For_Each_Table (Schema, Print_String_Constants'Access);

      New_Line (Spec_File);

      N := First (Names);
      while Has_Element (N) loop
         Put_Line (Spec_File, "   NC_" & Capitalize (Element (N))
                   & " : aliased constant String := """
                   & Ada_Quote (Quote_Keyword (Element (N))) & """;");
         Put_Line (Spec_File, "   N_" & Capitalize (Element (N))
                   & " : constant Cst_String_Access := NC_"
                   & Element (N) & "'Access;");
         Next (N);
      end loop;

      Put_Line (Spec_File, "end " & Generated & "_Names;");
      Close (Spec_File);
   end if;

   --  Create the database package

   F := Create_From_Dir (Dir => Output_Dir, Base_Name => Base_File & ".ads");
   Create (Spec_File, Name => F.Display_Full_Name);

   Put_Line (Spec_File, "with GNATCOLL.SQL; use GNATCOLL.SQL;");

   Put_Line
     (Spec_File,
      "pragma Warnings (Off, ""no entities of * are referenced"");");
   Put_Line
     (Spec_File,
      "pragma Warnings (Off, ""use clause for package * has no effect"");");
   Put_Line
     (Spec_File, "with GNATCOLL.SQL_Fields; use GNATCOLL.SQL_Fields;");
   For_Each_Table (Schema, Print_Withs'Access);
   Put_Line
     (Spec_File,
      "pragma Warnings (On, ""no entities of * are referenced"");");
   Put_Line
     (Spec_File,
      "pragma Warnings (On, ""use clause for package * has no effect"");");

   if Include_Database_Create then
      Put_Line (Spec_File, "with GNATCOLL.SQL.Exec;");
   end if;

   if Output (Output_Ada_Specs) then
      Put_Line (Spec_File, "with " & Generated & "_Names;"
                & " use " & Generated & "_Names;");
   end if;

   Put_Line (Spec_File, "package " & Generated & " is");
   Put_Line (Spec_File, "   pragma Style_Checks (Off);");

   if Output (Output_Ada_Specs) then
      Put_Line (Spec_File, "   pragma Elaborate_Body;");

      F := Create_From_Dir
        (Dir => Output_Dir, Base_Name => Base_File & ".adb");
      Create (Body_File, Name => F.Display_Full_Name);

      if Include_Database_Create then
         Put_Line
           (Body_File, "with GNATCOLL.SQL.Inspect; use GNATCOLL.SQL.Inspect;");
         Put_Line
           (Body_File, "with GNATCOLL.SQL.Exec; use GNATCOLL.SQL.Exec;");
      end if;

      Put_Line (Body_File, "package body " & Generated & " is");
      Put_Line (Body_File, "   pragma Style_Checks (Off);");
   end if;

   --  Process enumerations

   if Output (Output_Ada_Enums) then
      declare
         C          : Enumeration_Lists.Cursor := First (Enumerations);
         Enum       : Dumped_Enums;
         C2, C3, C4 : String_Lists.Cursor;

         Max_Name_Len, Max_Value_Len : Integer;

         function Quote (Str : String) return String;
         --  Replace characters that are not acceptable in an Ada
         --  identifier

         -----------
         -- Quote --
         -----------

         function Quote (Str : String) return String is
            S : XString;
         begin
            for C in Str'Range loop
               if not Is_Alphanumeric (Str (C)) then
                  --  Some special cases to try and keep meaningful
                  --  identifiers.

                  if Str (C) = '+' then
                     Append (S, "plus");
                  elsif Str (C) = '?' then
                     Append (S, "question");
                  else
                     Append (S, '_');
                  end if;
               else
                  Append (S, Str (C));
               end if;
            end loop;

            declare
               S2 : constant String := To_String (S);
            begin
               for C in reverse S2'Range loop
                  if S2 (C) /= '_' then
                     return S2 (S2'First .. C);
                  end if;
               end loop;
               return "";
            end;
         end Quote;

      begin
         while Has_Element (C) loop
            Enum := Element (C);

            declare
               Type_Name : constant String :=
                 Capitalize (Enum.Type_Name);
               Base_Type : constant String :=
                 Capitalize (Enum.Base_Type);
               Is_String : constant Boolean :=
                 Base_Type = "String";

               Quoted_Names : String_Lists.List;

            begin
               New_Line (Spec_File);
               Put_Line (Spec_File, "   subtype " & Type_Name
                         & " is " & Base_Type & ";");

               Max_Name_Len  := 0;
               for N of Enum.Names loop
                  declare
                     QN : constant String := Quote (N);
                  begin
                     Quoted_Names.Append (QN);
                     if QN'Length > Max_Name_Len then
                        Max_Name_Len := QN'Length;
                     end if;
                  end;
               end loop;

               Max_Value_Len := 6; --  "others"
               for V of Enum.Values loop
                  if V'Length > Max_Value_Len then
                     Max_Value_Len := V'Length;
                  end if;
               end loop;

               C2 := First (Quoted_Names);
               C3 := First (Enum.Values);
               while Has_Element (C2) loop
                  Put_Line (Spec_File,
                    "   "
                    & Capitalize (To_String (Enum.Prefix)) & '_'
                    & Head (Capitalize (Element (C2)), Max_Name_Len)
                    & " : constant " & Type_Name & " := "
                    & (if Is_String
                       then """" & Element (C3) & """"
                       else Element (C3))
                    & ";");

                  Next (C2);
                  Next (C3);
               end loop;

               if Output (Output_Ada_Enums_Image)
                 and then not Is_String
               then
                  New_Line (Spec_File);
                  Put_Line (Spec_File,
                     "   function Image_" & Type_Name);
                  Put_Line (Spec_File, "     (X : "
                     & Capitalize (Enum.Type_Name) & ") return String");
                  Put_Line (Spec_File, "   is (case X is");

                  C2 := First (Quoted_Names);
                  C3 := First (Enum.Values);
                  C4 := First (Enum.Names);
                  while Has_Element (C2) loop
                     Put_Line (Spec_File,
                       "          when " & Head (Element (C3), Max_Value_Len)
                       & " => """ & Element (C4) & """,");
                     Next (C2);
                     Next (C3);
                     Next (C4);
                  end loop;
                  Put_Line (Spec_File,
                    "          when others =>");
                  Put_Line (Spec_File,
                    "             raise Constraint_Error");
                  Put_Line (Spec_File,
                    "               with ""invalid "
                    & Type_Name & " "" & X'Img);");
               end if;
            end;
            Next (C);
         end loop;
      end;

      --  Process variables

      declare
         C4 : Variables_List.Cursor := First (Variables);
      begin
         if Has_Element (C4) then
            New_Line (Spec_File);
         end if;

         while Has_Element (C4) loop
            Put_Line
              (Spec_File, "   " & Capitalize (Element (C4).Name)
               & " : constant := " & To_String (Element (C4).Value) & ";");
            Print_Comment (Spec_File, "   ", To_String (Element (C4).Comment));
            Next (C4);
         end loop;
      end;
   end if;

   if Output (Output_Ada_Specs) then
      Process_Tables;
   end if;

   if Include_Database_Create then
      Print_Database_Create;
   end if;

   Put_Line (Spec_File, "end " & Generated & ";");
   Close (Spec_File);

   if Output (Output_Ada_Specs) then
      Put_Line (Body_File, "end " & Generated & ";");
      Close (Body_File);
   end if;
end Generate;