gnatcoll_sql_24.0.0_4b44508a/sql/gnatcoll-sql-inspect.adb

------------------------------------------------------------------------------
--                             G N A T C O L L                              --
--                                                                          --
--                     Copyright (C) 2011-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.Characters.Handling;     use Ada.Characters.Handling;
with Ada.Command_Line;
with Ada.Containers.Hashed_Sets;  use Ada.Containers;
with Ada.Exceptions;              use Ada.Exceptions;
with Ada.Strings.Fixed;           use Ada.Strings, Ada.Strings.Fixed;
with Ada.Strings.Maps;            use Ada.Strings.Maps;
with Ada.Text_IO;                 use Ada.Text_IO;
with Ada.Unchecked_Deallocation;
with GNAT.Strings;                use GNAT.Strings;
with GNATCOLL.Mmap;               use GNATCOLL.Mmap;
with GNATCOLL.Strings;            use GNATCOLL.Strings;
with GNATCOLL.Traces;             use GNATCOLL.Traces;
with GNATCOLL.VFS;                use GNATCOLL.VFS;
with GNATCOLL.Utils;              use GNATCOLL.Utils;

package body GNATCOLL.SQL.Inspect is
   Me : constant Trace_Handle := Create ("SQL.INSPECT");

   use Tables_Maps, Field_Lists, Foreign_Refs;
   use Foreign_Keys, Pair_Lists, Tables_Lists;
   use String_Lists, String_Sets;

   package Field_Mapping_Vectors is new Ada.Containers.Indefinite_Vectors
     (Positive, Field_Mapping'Class);
   All_Field_Mappings : Field_Mapping_Vectors.Vector;
   --  When you create new field types, they should be registered in this list.
   --  Put an uninitialized instance of the field type in the list. A copy of
   --  it will be used to call Type_From_SQL when parsing the database schema.

   Invalid_Schema : exception;

   Keywords : String_Sets.Set;

   Max_Fields_Per_Line : constant := 30;
   --  Maximum number of fields per line (separated by '|')

   procedure Parse_Line
     (Line         : in out String_List;
      Line_Number  : in out Natural;
      Fields_Count : out Natural;
      Data         : String;
      First        : in out Integer;
      Replace_Newline : Boolean := True);
   --  Parse the current line and set Line and Fields_Count as appropriate.
   --  Fields_Count is set to 0 if the current line is not part of a table
   --  and should be ignored.

   procedure Parse_Table
     (Self        : DB_Schema_IO'Class;
      Table       : Table_Description;
      Attributes  : in out Field_List);
   --  Get the attributes of the specified table

   procedure Mark_FK_As_Ambiguous
     (Table     : in out Table_Description;
      Foreign   : Table_Description;
      Ambiguous : out Boolean);
   --  Mark all foreign keys from Table to Foreign as ambiguous (ie there are
   --  multiple references to the same foreign table, so we need special care
   --  in code generation). Ambiguous is set to False if there was no such
   --  FK yet.

   function Get_To (FK : Foreign_Key; Pair : Field_Pair) return Field;
   --  Return the field this points to (possibly the primary key of another
   --  table if FK.To is unset)

   function EOW (Str : String; First : Integer) return Natural;
   --  Return the position of the next '|'

   procedure Append
     (List : in out String_List; Last : in out Natural; Str : String);
   --  Add a new element to the list

   procedure Format_Field
     (DB       : access Database_Connection_Record'Class;
      Value    : String;
      Typ      : Field_Mapping'Class;
      Val      : out GNAT.Strings.String_Access;
      Param    : out SQL_Parameter;
      Has_Xref : Boolean);
   --  Format a value for proper use in SQL.
   --  This translates boolean values "true" and "false" as appropriate for
   --  the backend.

   ----------------------------
   -- Register_Field_Mapping --
   ----------------------------

   procedure Register_Field_Mapping (Self : Field_Mapping'Class) is
   begin
      All_Field_Mappings.Append (Self);
   end Register_Field_Mapping;

   ---------------------------
   -- Simple_Field_Mappings --
   ---------------------------

   package body Simple_Field_Mappings is

      --------------------
      -- Parameter_Type --
      --------------------

      overriding function Parameter_Type
        (Self : Simple_Field_Mapping) return SQL_Parameter_Type'Class
      is
         pragma Unreferenced (Self);
         Dummy : Param_Type;
         --  intentionally uninitialized, only the specific type is relevant
         --  as return value
      begin
         return Dummy;
      end Parameter_Type;

      -----------------
      -- Type_To_SQL --
      -----------------

      overriding function Type_To_SQL
        (Self         : Simple_Field_Mapping;
         Format       : access Formatter'Class := null;
         For_Database : Boolean := True) return String
      is
         pragma Unreferenced (Self, Format);
      begin
         return (if For_Database then SQL_Type else Ada_Field_Mapping);
      end Type_To_SQL;

   begin
      Register_Field_Mapping
         (Simple_Field_Mapping'(Field_Mapping with null record));
   end Simple_Field_Mappings;

   package Bigint_Mappings is new Simple_Field_Mappings
     ("bigint", "SQL_Field_Bigint", SQL_Parameter_Bigint);
   package Boolean_Mappings is new GNATCOLL.SQL.Inspect.Simple_Field_Mappings
     ("boolean", "SQL_Field_Boolean", SQL_Parameter_Boolean);
   package Time_Mappings is new Simple_Field_Mappings
     ("time", "SQL_Field_Time", SQL_Parameter_Time);
   package Date_Mappings is new Simple_Field_Mappings
     ("date", "SQL_Field_Date", SQL_Parameter_Date);
   pragma Unreferenced (Bigint_Mappings, Time_Mappings, Date_Mappings);
   --  The side effect is to register the mappings

   ---------
   -- EOW --
   ---------

   function EOW (Str : String; First : Integer) return Natural is
   begin
      return Find_Char (Str (First .. Str'Last), '|');
   end EOW;

   ------------
   -- Get_To --
   ------------

   function Get_To (FK : Foreign_Key; Pair : Field_Pair) return Field is
   begin
      if Pair.To = No_Field then
         return Get_PK (FK.To_Table);
      else
         return Pair.To;
      end if;
   end Get_To;

   --------
   -- Id --
   --------

   function Id (Self : Field) return Positive is
   begin
      return Self.Get.Id;
   end Id;

   ----------
   -- Name --
   ----------

   function Name (Self : Field) return String is
   begin
      return Self.Get.Name.all;
   end Name;

   -----------------
   -- Description --
   -----------------

   function Description (Self : Field) return String is
      Descr : constant GNAT.Strings.String_Access := Self.Get.Description;
   begin
      if Descr = null then
         return "";
      else
         return Descr.all;
      end if;
   end Description;

   ---------------
   -- Get_Table --
   ---------------

   function Get_Table (Self : Field) return Table_Description'Class is
      R : Table_Description;
   begin
      R.Set (Self.Get.Table);
      return R;
   end Get_Table;

   --------------
   -- Get_Type --
   --------------

   function Get_Type (Self : Field) return Field_Mapping_Access is
      FK : constant Field := Self.Is_FK;
      T  : Field_Mapping_Access;
   begin
      if FK = No_Field then
         return Self.Get.Typ;
      else
         T := Get_Type (FK);
         if T.all in Field_Mapping_Autoincrement'Class then
            --  Do not return T itself, or the table would end up with two
            --  primary keys (since autoincrement fields are only used for
            --  primary keys).
            return new Field_Mapping_Integer;   --   ??? memory leak
         else
            return T;
         end if;
      end if;
   end Get_Type;

   ----------------
   -- Set_Active --
   ----------------

   procedure Set_Active (Self : in out Field; Active : Boolean) is
   begin
      Self.Get.Active := Active;
   end Set_Active;

   ---------------
   -- Is_Active --
   ---------------

   function Is_Active (Self : Field) return Boolean is
   begin
      return Self.Get.Active;
   end Is_Active;

   -----------------
   -- Can_Be_Null --
   -----------------

   function Can_Be_Null (Self : Field) return Boolean is
   begin
      return not Self.Get.Props.Not_Null;
   end Can_Be_Null;

   -------------
   -- Default --
   -------------

   function Default (Self : Field) return String is
      Def : constant GNAT.Strings.String_Access := Self.Get.Default;
   begin
      if Def = null then
         return "";
      else
         return Def.all;
      end if;
   end Default;

   -----------
   -- Is_PK --
   -----------

   function Is_PK (Self : Field) return Boolean is
   begin
      return Self.Get.Props.PK;
   end Is_PK;

   ------------
   -- Get_PK --
   ------------

   function Get_PK (Self : Table_Description'Class) return Field is
      F  : Field_Lists.Cursor := TDR (Self.Unchecked_Get).Fields.First;
      PK : Field := No_Field;
   begin
      while Has_Element (F) loop
         if Element (F).Get.Props.PK then
            if PK = No_Field then
               PK := Element (F);
            else
               return No_Field;  --  Primary key is a tuple
            end if;
         end if;

         Next (F);
      end loop;

      return PK;
   end Get_PK;

   -----------
   -- Is_FK --
   -----------

   function Is_FK (Self : Field) return Field is
      T : Table_Description;
      C : Foreign_Keys.Cursor;
   begin
      if Self.Get.FK then
         T := Table_Description (Get_Table (Self));
         C := TDR (T.Unchecked_Get).FK.First;
         while Has_Element (C) loop
            declare
               A : Pair_Lists.Cursor := Element (C).Get.Fields.First;
               P : Field_Pair;
            begin
               while Has_Element (A) loop
                  P := Element (A);
                  if P.From = Self then
                     return Get_To (Element (C), P);
                  end if;

                  Next (A);
               end loop;
            end;

            Next (C);
         end loop;
      end if;

      return No_Field;
   end Is_FK;

   ----------
   -- Free --
   ----------

   procedure Free (Self : in out Field_Description) is
      procedure Unchecked_Free is new Ada.Unchecked_Deallocation
         (Field_Mapping'Class, Field_Mapping_Access);
   begin
      Free (Self.Name);
      Free (Self.Description);
      Free (Self.Default);
      Unchecked_Free (Self.Typ);
   end Free;

   --------
   -- Id --
   --------

   function Id (Self : Table_Description) return Positive is
   begin
      return TDR (Self.Unchecked_Get).Id;
   end Id;

   --------------
   -- Get_Kind --
   --------------

   function Get_Kind (Self : Table_Description) return Relation_Kind is
   begin
      return TDR (Self.Unchecked_Get).Kind;
   end Get_Kind;

   ----------
   -- Name --
   ----------

   function Name (Self : Table_Description) return String is
   begin
      return TDR (Self.Unchecked_Get).Name.all;
   end Name;

   --------------
   -- Row_Name --
   --------------

   function Row_Name (Self : Table_Description) return String is
      Row : constant GNAT.Strings.String_Access :=
         TDR (Self.Unchecked_Get).Row;
   begin
      if Row = null then
         return Name (Self);
      else
         return Row.all;
      end if;
   end Row_Name;

   -----------------
   -- Description --
   -----------------

   function Description (Self : Table_Description) return String is
      Descr : constant GNAT.Strings.String_Access :=
        TDR (Self.Unchecked_Get).Description;
   begin
      if Descr = null then
         return "";
      else
         return Descr.all;
      end if;
   end Description;

   -----------------
   -- Is_Abstract --
   -----------------

   function Is_Abstract (Self : Table_Description) return Boolean is
   begin
      return TDR (Self.Unchecked_Get).Is_Abstract;
   end Is_Abstract;

   ----------------
   -- Set_Active --
   ----------------

   procedure Set_Active (Self : in out Table_Description; Active : Boolean) is
   begin
      TDR (Self.Unchecked_Get).Active := Active;
   end Set_Active;

   ---------------
   -- Is_Active --
   ---------------

   function Is_Active (Self : Table_Description) return Boolean is
   begin
      return TDR (Self.Unchecked_Get).Active;
   end Is_Active;

   -----------------
   -- Super_Table --
   -----------------

   function Super_Table (Self : Table_Description) return Table_Description is
   begin
      return TDR (Self.Unchecked_Get).Super_Table;
   end Super_Table;

   --------------------
   -- For_Each_Field --
   --------------------

   procedure For_Each_Field
     (Self              : Table_Description;
      Callback          : access procedure (F : in out Field);
      Include_Inherited : Boolean := False)
   is
      C      : Field_Lists.Cursor := TDR (Self.Unchecked_Get).Fields.First;
      F      : Field;
   begin
      while Has_Element (C) loop
         F := Element (C);
         Callback (F);
         Next (C);
      end loop;

      if Include_Inherited
        and then TDR (Self.Unchecked_Get).Super_Table /= No_Table
      then
         For_Each_Field (Self.Super_Table, Callback, Include_Inherited);
      end if;
   end For_Each_Field;

   ---------------------
   -- Field_From_Name --
   ---------------------

   function Field_From_Name
     (Self  : Table_Description'Class; Name  : String) return Field
   is
      Result : Field := No_Field;

      procedure For_Field (F : in out Field);
      procedure For_Field (F : in out Field) is
      begin
         if F.Name = Name then
            Result := F;
         end if;
      end For_Field;

   begin
      For_Each_Field (Self, For_Field'Access, Include_Inherited => True);
      return Result;
   end Field_From_Name;

   ----------
   -- Free --
   ----------

   procedure Free (Self : in out Foreign_Key_Description) is
   begin
      Free (Self.Revert_Name);
   end Free;

   ----------
   -- Free --
   ----------

   overriding procedure Free (Self : in out Table_Description_Record) is
   begin
      Free (Self.Name);
      Free (Self.Row);
      Free (Self.Description);
   end Free;

   ---------------
   -- Get_Table --
   ---------------

   function Get_Table
     (Self : DB_Schema; Name : String) return Table_Description
   is
      C : constant Tables_Maps.Cursor := Self.Tables.Find (Name);
   begin
      if C = Tables_Maps.No_Element then
         raise Invalid_Table with "No such table: " & Name;
      end if;

      return Element (C);
   end Get_Table;

   --------------------
   -- For_Each_Table --
   --------------------

   procedure For_Each_Table
     (Self     : DB_Schema;
      Callback : access procedure (T : in out Table_Description);
      Alphabetical : Boolean := True)
   is
      T : Table_Description;
   begin
      if Alphabetical
        or else Self.Ordered_Tables.Is_Empty
      then
         declare
            C : Tables_Maps.Cursor := Self.Tables.First;
         begin
            while Has_Element (C) loop
               T := Element (C);
               Callback (T);
               Next (C);
            end loop;
         end;

      else
         declare
            C : Tables_Lists.Cursor := Self.Ordered_Tables.First;
         begin
            while Has_Element (C) loop
               T := Self.Tables.Element (Element (C));
               Callback (T);
               Next (C);
            end loop;
         end;
      end if;
   end For_Each_Table;

   -----------------
   -- For_Each_FK --
   -----------------

   procedure For_Each_FK
     (Self     : Table_Description;
      Callback : access procedure
        (From, To : Field; Id : Natural; Ambiguous : Boolean))
   is
      F  : Foreign_Keys.Cursor;
      P  : Pair_Lists.Cursor;
      Id : Integer := 1;
   begin
      F := TDR (Self.Unchecked_Get).FK.First;
      while Has_Element (F) loop
         P := Element (F).Get.Fields.First;
         while Has_Element (P) loop
            Callback (From      => Element (P).From,
                      To        => Get_To (Element (F), Element (P)),
                      Ambiguous => Element (F).Get.Ambiguous,
                      Id        => Id);
            Next (P);
         end loop;

         Id := Id + 1;
         Next (F);
      end loop;
   end For_Each_FK;

   -------------------
   -- Type_From_SQL --
   -------------------

   overriding function Type_From_SQL
      (Self : in out Field_Mapping_Text; Str : String) return Boolean
   is
      function Process_Max_Length (Kind : String) return Boolean;
      --  Try to take max length from sql type like varchar(123), returns True
      --  on success, raises Invalid_Schema is value in brackets is not an
      --  number.

      ------------------------
      -- Process_Max_Length --
      ------------------------

      function Process_Max_Length (Kind : String) return Boolean is
      begin
         if Str'Length > Kind'Length
           and then Str (Str'First .. Str'First + Kind'Length) = Kind & '('
           and then Str (Str'Last) = ')'
         then
            begin
               Self.Max_Length := Integer'Value
                 (Str (Str'First + Kind'Length + 1 .. Str'Last - 1));

               return True;

            exception
               when Constraint_Error =>
                  Put_Line
                    ("Missing max length after '" & Kind & "' in " & Str);
                  raise Invalid_Schema;
            end;
         end if;

         return False;
      end Process_Max_Length;

   begin
      if Str in "text" | "varchar" | "nvarchar"
         or else (Str'Length >= 10    --  "character varying(...)"
                  and then Str (Str'First .. Str'First + 9) = "character ")
      then
         Self.Max_Length := Integer'Last;
         return True;
      else
         return Process_Max_Length ("varchar")
           or else Process_Max_Length ("character")
           or else Process_Max_Length ("nvarchar");
      end if;
   end Type_From_SQL;

   -------------------
   -- Type_From_SQL --
   -------------------

   overriding function Type_From_SQL
      (Self : in out Field_Mapping_Integer; Str : String) return Boolean
   is
      pragma Unreferenced (Self);
   begin
      if Str in "integer" | "smallint" | "oid" then
         return True;

      elsif Str'Length > 7
         and then Str (Str'First .. Str'First + 6) in "numeric" | "decimal"
      then
         --  Check the scale

         for Comma in reverse Str'Range loop
            if Str (Comma) = ',' then
               return Str (Comma + 1 .. Str'Last - 1) = "0";
            end if;
         end loop;

         return True;

      else
         return False;
      end if;
   end Type_From_SQL;

   -------------------
   -- Type_From_SQL --
   -------------------

   overriding function Type_From_SQL
      (Self : in out Field_Mapping_Float; Str : String) return Boolean
   is
      pragma Unreferenced (Self);
   begin
      if Str in "float" | "numeric" | "decimal" then
         return True;

      elsif Str'Length > 7
        and then Str (Str'First .. Str'First + 6) in "numeric" | "decimal"
      then
         --  Check the scale

         for Comma in reverse Str'Range loop
            if Str (Comma) = ',' then
               return Str (Comma + 1 .. Str'Last - 1) /= "0";
            end if;
         end loop;
      end if;

      return False;
   end Type_From_SQL;

   -----------------
   -- Type_To_SQL --
   -----------------

   overriding function Type_To_SQL
     (Self         : Field_Mapping_Text;
      Format       : access Formatter'Class := null;
      For_Database : Boolean := True) return String
   is
      pragma Unreferenced (Format);
   begin
      return (if not For_Database then "SQL_Field_Text"
              elsif Self.Max_Length = Integer'Last then "Text"
              else "Character(" & Image (Self.Max_Length, 1) & ')');
   end Type_To_SQL;

   -----------------
   -- Type_To_SQL --
   -----------------

   overriding function Type_To_SQL
     (Self         : Field_Mapping_Float;
      Format       : access Formatter'Class := null;
      For_Database : Boolean := True) return String
   is
      pragma Unreferenced (Self, Format);
   begin
      return (if For_Database then "Float" else "SQL_Field_Float");
   end Type_To_SQL;

   -----------------
   -- Type_To_SQL --
   -----------------

   overriding function Type_To_SQL
     (Self         : Field_Mapping_Integer;
      Format       : access Formatter'Class := null;
      For_Database : Boolean := True) return String
   is
      pragma Unreferenced (Self, Format);
   begin
      return (if For_Database then "Integer" else "SQL_Field_Integer");
   end Type_To_SQL;

   -----------------
   -- Type_To_SQL --
   -----------------

   overriding function Type_To_SQL
     (Self         : Field_Mapping_Timestamp;
      Format       : access Formatter'Class := null;
      For_Database : Boolean := True) return String
   is
      pragma Unreferenced (Self, Format);
   begin
      return (if For_Database then "timestamp with time zone"
              else "SQL_Field_Time");
   end Type_To_SQL;

   --------------
   -- From_SQL --
   --------------

   function From_SQL (SQL_Type : String) return Field_Mapping_Access is
      T     : constant String := To_Lower (SQL_Type);
   begin
      --  Go into reverse order, so that custom fields take precedence
      --  over the predefined fields
      for F of reverse All_Field_Mappings loop
         if F.Type_From_SQL (T) then
            return new Field_Mapping'Class'(F);
         end if;
      end loop;
      return null;
   end From_SQL;

   -----------------
   -- Parse_Table --
   -----------------

   procedure Parse_Table
     (Self        : DB_Schema_IO'Class;
      Table       : Table_Description;
      Attributes  : in out Field_List)
   is
      procedure On_Field
        (Name           : String;
         Typ            : String;
         Index          : Natural;
         Description    : String;
         Default_Value  : String;
         Is_Primary_Key : Boolean;
         Not_Null       : Boolean);
      --  Called when a new field is discovered

      procedure On_Field
        (Name           : String;
         Typ            : String;
         Index          : Natural;
         Description    : String;
         Default_Value  : String;
         Is_Primary_Key : Boolean;
         Not_Null       : Boolean)
      is
         Descr : Field_Description;
         Ref   : Field;
         T     : constant Field_Mapping_Access := From_SQL (Typ);
      begin
         if T = null then
            Put_Line
              ("Error: unknown field type " & Typ & " in " & Table.Name);
            raise Invalid_Type;
         end if;

         Descr := Field_Description'
           (Name        => new String'(Name),
            Typ         => T,
            Id          => Index,
            Description => new String'(Description),
            Default     => null,
            Props       => (PK       => Is_Primary_Key,
                            Not_Null => Not_Null or else Is_Primary_Key,
                            others => <>),
            FK          => False,
            Table       => Table.Weak,
            Active      => True);

         if Default_Value'Length < 8
           or else Default_Value
             (Default_Value'First .. Default_Value'First + 7)
           /= "nextval("
         then
            Descr.Default  := new String'(Default_Value);
         end if;

         Ref.Set (Descr);
         Append (Attributes, Ref);
      end On_Field;

   begin
      Foreach_Field
        (Self.DB,
         Table_Name => Table.Name,
         Callback   => On_Field'Access);
   end Parse_Table;

   -----------------
   -- Read_Schema --
   -----------------

   overriding function Read_Schema
     (Self : DB_Schema_IO) return DB_Schema
   is
      Schema : DB_Schema;
      T : Natural := 0;

      procedure On_Table (Name, Description : String; Kind : Relation_Kind);
      --  Called when a new table is discovered

      procedure Compute_Foreign_Keys
        (Name  : String; Table : in out Table_Description);
      --  Compute the foreign keys for a specific table

      function Field_From_Index
        (Descr     : Table_Description;
         Index     : Natural) return Field;
      --  Return the field given its index in the table. Information
      --  is extracted from All_Attrs

      --------------
      -- On_Table --
      --------------

      procedure On_Table (Name, Description : String; Kind : Relation_Kind) is
         Descr : Table_Description_Record;
         Ref   : Table_Description;
      begin
         if not Match (Name, Self.Filter) then
            return;
         end if;

         T := T + 1;
         Descr.Id          := T;
         Descr.Kind        := Kind;
         Descr.Name        := new String'(Name);
         Descr.Row         := null;  --  Will default to Descr.Name
         Descr.Description := new String'(Description);
         Ref.Set (Descr);

         Parse_Table (Self, Ref, TDR (Ref.Unchecked_Get).Fields);

         Insert (Schema.Tables, Name, Ref);
         Schema.Ordered_Tables.Append (Name);
      end On_Table;

      ----------------------
      -- Field_From_Index --
      ----------------------

      function Field_From_Index
        (Descr     : Table_Description;
         Index     : Natural) return Field
      is
         A : Field_Lists.Cursor := First (TDR (Descr.Unchecked_Get).Fields);
      begin
         while Has_Element (A) loop
            if Element (A).Id = Index then
               return Element (A);
            end if;
            Next (A);
         end loop;
         return No_Field;
      end Field_From_Index;

      --------------------------
      -- Compute_Foreign_Keys --
      --------------------------

      procedure Compute_Foreign_Keys
        (Name  : String; Table : in out Table_Description)
      is
         Prev_Index : Integer := -1;
         To_Table   : Table_Description;
         Descr      : Foreign_Key_Description;
         R          : Foreign_Key;

         procedure On_Key
           (Index             : Positive;
            Local_Attribute   : Integer;
            Foreign_Table     : String;
            Foreign_Attribute : Integer);
         --  Called for each foreign key in the table

         procedure On_Key
           (Index             : Positive;
            Local_Attribute   : Integer;
            Foreign_Table     : String;
            Foreign_Attribute : Integer)
         is
            From : Field;
         begin
            if Prev_Index /= Index then
               --  A new foreign key, as opposed to a new attribute in the same
               --  key

               if Prev_Index /= -1 then
                  R.Set (Descr);
                  Append (TDR (Table.Unchecked_Get).FK, R);
               end if;

               Prev_Index := Index;

               To_Table := Get_Table (Schema, Foreign_Table);
               Descr :=
                 (To_Table        => To_Table.Weak,
                  Revert_Name     => null,
                  Fields          => Pair_Lists.Empty_Vector,
                  Ambiguous       => False);

               Mark_FK_As_Ambiguous (Table, To_Table, Descr.Ambiguous);
            end if;

            From := Field_From_Index (Table, Local_Attribute);
            From.Get.FK := True;
            Append
              (Descr.Fields,
               Field_Pair'
                 (From => From,
                  To   => Field_From_Index (To_Table, Foreign_Attribute)));
         end On_Key;

      begin
         Foreach_Foreign_Key
           (Self.DB,
            Table_Name => Name,
            Callback   => On_Key'Access);

         if Prev_Index /= -1 then
            R.Set (Descr);
            Append (TDR (Table.Unchecked_Get).FK, R);
         end if;
      end Compute_Foreign_Keys;

      C : Tables_Maps.Cursor;

   begin
      Foreach_Table (Self.DB, On_Table'Access);

      C := First (Schema.Tables);
      while Has_Element (C) loop
         Update_Element (Schema.Tables, C, Compute_Foreign_Keys'Access);
         Next (C);
      end loop;

      return Schema;
   end Read_Schema;

   --------------
   -- To_Table --
   --------------

   function To_Table (FK : Foreign_Key) return Table_Description'Class is
      R : Tables_Ref.Ref;
   begin
      R.Set (FK.Get.To_Table);
      return Table_Description'(R with null record);
   end To_Table;

   --------------------------
   -- Mark_FK_As_Ambiguous --
   --------------------------

   procedure Mark_FK_As_Ambiguous
     (Table     : in out Table_Description;
      Foreign   : Table_Description;
      Ambiguous : out Boolean)
   is
      use Tables_Ref;
      R     : Tables_Ref.Ref;
   begin
      Ambiguous := False;
      for FK of TDR (Table.Unchecked_Get).FK loop
         R.Set (FK.Get.To_Table);
         if R = Tables_Ref.Ref (Foreign) then
            if not FK.Get.Ambiguous then
               FK.Get.Ambiguous := True;
            end if;

            Ambiguous := True;
            return;
         end if;
      end loop;
   end Mark_FK_As_Ambiguous;

   ------------
   -- Append --
   ------------

   procedure Append
     (List : in out String_List; Last : in out Natural; Str : String) is
   begin
      Last := Last + 1;
      List (Last) := new String'(Str);
   end Append;

   ------------------
   -- Format_Field --
   ------------------

   procedure Format_Field
     (DB       : access Database_Connection_Record'Class;
      Value    : String;
      Typ      : Field_Mapping'Class;
      Val      : out GNAT.Strings.String_Access;
      Param    : out SQL_Parameter;
      Has_Xref : Boolean)
   is
      V : constant String := To_Lower (Value);
      B : Boolean;
   begin
      if Typ in Boolean_Mappings.Simple_Field_Mapping'Class then
         if V = "true" or else V = "false" then
            B := Boolean'Value (Value);
            Val := new String'(Boolean_Image (DB.all, B));
            Param := +B;
         else
            Val := new String'(Value);
            Param := +Val;
         end if;

      elsif Value'Length = 0 then
         if Has_Xref then
            Val := new String'("''");
         else
            Val := new String'("");
         end if;
         Param := +Val;

      elsif V = "null" then
         Val := new String'("NULL");
         if Has_Xref then
            Param := +Val;
         else
            Param := Null_Parameter;
         end if;

      elsif Typ in Field_Mapping_Integer'Class then
         Val := new String'(Value);
         Param := +Val;

      elsif Typ in Field_Mapping_Money'Class then
         Param := +T_Money'Value (Value);
         Val := new String'(Param.Image (DB.all));

      else
         if Has_Xref then
            Val := new String'
              (String_To_SQL (DB.all, Value, Quote => True));
         else
            Val := new String'(Value);
         end if;

         Param := +Val;
      end if;
   end Format_Field;

   -----------------
   -- Read_Schema --
   -----------------

   function Read_Schema
     (Self : File_Schema_IO; Data : String) return DB_Schema
   is
      Schema : DB_Schema;
      T     : Natural := 0;  --  Index of the table we are creating
      First : Natural; --  Current index in Data
      Line_Number : Natural := 0;

      Fields_Per_Line : constant := 5;
      --  Maximum number of fields per line (fields are separated with |)

      type Line_Fields is new String_List (1 .. Fields_Per_Line);

      procedure Parse_Line (Result : in out Line_Fields);
      --  Split the line that starts at First into its fields.
      --  On exit, First points to the beginning of the next line

      procedure Parse_Table (Table_Def, Name : String; Is_View : Boolean);
      --  Parse a table description

      procedure Parse_Table_Inheritance
        (Table_Def : String; Table : in out Table_Description);
      --  Parse the description of table inheritance

      procedure Parse_Table_Properties (Name : String);
      --  Parse all foreign keys and indices for table Name, when they are
      --  described on their own line

      function Parse_Properties (Str : String) return Field_Properties;
      --  Parse the third column of a field description

      ----------------------
      -- Parse_Properties --
      ----------------------

      function Parse_Properties (Str : String) return Field_Properties is
         S : String_List_Access := Split (Str, On => ',');
         Props : Field_Properties;
      begin
         for P in S'Range loop
            declare
               T : constant String := Trim (S (P).all, Both);
            begin
               if T = "NOT NULL" then
                  Props.Not_Null := True;
               elsif T = "INDEX" then
                  Props.Indexed := True;
               elsif T = "UNIQUE" then
                  Props.Unique := True;
               elsif T = "NOINDEX" then
                  Props.Noindex := True;
               elsif T = "PK" then
                  Props.PK := True;
                  Props.Not_Null := True;
               elsif T = "NOCASE" then
                  Props.Case_Insensitive := True;
               end if;
            end;
         end loop;

         Free (S);
         return Props;
      end Parse_Properties;

      ----------------
      -- Parse_Line --
      ----------------

      procedure Parse_Line (Result : in out Line_Fields) is
         Index  : Natural := Result'First - 1;
         Last, Tmp : Natural;
         Current_Line_End : constant Natural :=
           EOL (Data (First .. Data'Last));
      begin
         pragma Assert (Data (First) = '|');
         Line_Number := Line_Number + 1;

         Free (String_List (Result));

         First := First + 1;

         while First <= Current_Line_End loop
            Skip_Blanks (Data, First);
            --  First now points to first non-blank char

            Last := EOW (Data, First);
            Tmp := Last - 1;

            Skip_Blanks_Backward (Data (First .. Tmp), Tmp);

            Append (String_List (Result), Index, Data (First .. Tmp));
            exit when Index = Fields_Per_Line;

            First := Last + 1;
         end loop;

         First := Current_Line_End + 1;
      end Parse_Line;

      -----------------------------
      -- Parse_Table_Inheritance --
      -----------------------------

      procedure Parse_Table_Inheritance
        (Table_Def : String; Table : in out Table_Description)
      is
         First : Natural := Table_Def'First;
         Last  : Natural;
      begin
         while First <= Table_Def'Last loop
            if Table_Def (First) = '(' then
               Last := First + 1;
               while Last <= Table_Def'Last loop
                  if Table_Def (Last) = ')' then
                     TDR (Table.Unchecked_Get).Super_Table :=
                       Get_Table (Schema, Table_Def (First + 1 .. Last - 1));
                     return;
                  end if;
                  Last := Last + 1;
               end loop;
            end if;

            First := First + 1;
         end loop;
      end Parse_Table_Inheritance;

      -----------------
      -- Parse_Table --
      -----------------

      procedure Parse_Table (Table_Def, Name : String; Is_View : Boolean) is
         Table : Table_Description;
         Line  : Line_Fields;
         Attr_Id : Natural := 0;
         Props : Field_Properties;
         Kind : Relation_Kind;
      begin
         T := T + 1;

         --  The code below might be creating table before we actually see
         --  their schema (in the case of FK to them). Reuse the prior
         --  definition if one is found.
         declare
            C : Tables_Maps.Cursor;
         begin
            C := Find (Schema.Tables, Name);
            if C = Tables_Maps.No_Element then
               if Is_View then
                  Kind := Kind_View;
               else
                  Kind := Kind_Table;
               end if;

               Table.Set (Table_Description_Record'
                   (Name        => new String'(Name),
                    Row         => null,
                    Kind        => Kind,
                    Id          => T,
                    Description => null,
                    Fields      => Empty_Field_List,
                    Indexes     => String_Lists.Empty_Vector,
                    Uniques     => String_Lists.Empty_Vector,
                    Is_Abstract => False,
                    Has_PK      => False,
                    FK          => Foreign_Keys.Empty_Vector,
                    Active      => True,
                    Super_Table => No_Table));
               Include (Schema.Tables, Name, Table);
            else
               Table := Element (C);
            end if;

            TDR (Table.Unchecked_Get).Is_Abstract :=
               Starts_With (Table_Def, "ABSTRACT");
         end;

         Parse_Table_Inheritance (Table_Def, Table);

         while First <= Data'Last and then Data (First) = '|' loop
            Parse_Line (Result => Line);

            if Starts_With (Line (1).all, "--") then
               --  A comment line, skip this line
               null;

            elsif Line (1).all = "FK:"
              or else Line (1).all = "INDEX:"
              or else Line (1).all = "UNIQUE:"
            then
               null;   --  Skip for now, will do in second pass

            else
               if Line (2) = null
                  or else Line (3) = null
                  or else Line (4) = null
                  or else Line (5) = null
               then
                  Put_Line ("Error: missing fields on line "
                     & Join (" | ", String_List (Line)));
                  return;
               end if;

               Attr_Id := Attr_Id + 1;

               Props := Parse_Properties (Line (3).all);

               declare
                  Typ       : String renames Line (2).all;
                  Tmp, Tmp2 : Natural;

                  Att : Field;
                  FKD : Foreign_Key_Description;
                  FK  : Foreign_Key;
                  To_Table : Table_Description;

               begin
                  TDR (Table.Unchecked_Get).Has_PK :=
                    Props.PK or else TDR (Table.Unchecked_Get).Has_PK;

                  Att.Set (Field_Description'
                         (Name        => new String'(Line (1).all),
                          Typ         => null,
                          Id          => Attr_Id,
                          Description => new String'(Line (5).all),
                          Default     => new String'(Line (4).all),
                          Props       => Props,
                          FK          => Typ'Length > 3
                            and then Typ (Typ'First .. Typ'First + 2) = "FK ",
                          Table       => Table.Weak,
                          Active      => True));
                  Append (TDR (Table.Unchecked_Get).Fields, Att);

                  if Att.Get.FK then
                     Tmp := Find_Char (Typ (Typ'First + 3 .. Typ'Last), '(');

                     if Tmp < Typ'Last then
                        Tmp2 := Find_Char (Typ (Tmp + 1 .. Typ'Last), ')');
                     else
                        Tmp2 := Typ'Last;
                     end if;

                     declare
                        To : constant String :=
                          Trim (Typ (Typ'First + 3 .. Tmp - 1), Both);
                     begin
                        if To = Name then
                           To_Table := Table;
                        else
                           To_Table := Get_Table (Schema, To);
                        end if;

                     exception
                        when Invalid_Table =>
                           --  The table might be declared later on
                           To_Table.Set (Table_Description_Record'
                                  (Name   => new String'(To),
                                   others => <>));
                           Include (Schema.Tables, To, To_Table);
                     end;

                     FKD := Foreign_Key_Description'
                       (To_Table    => To_Table.Weak,
                        Revert_Name => new String'(Typ (Tmp + 1 .. Tmp2 - 1)),
                        Fields      => Pair_Lists.Empty_Vector,
                        Ambiguous   => False);
                     Mark_FK_As_Ambiguous (Table, To_Table, FKD.Ambiguous);

                     Append (FKD.Fields,
                             Field_Pair'
                               (From => Att,
                                To   => No_Field));   --  To primary key

                     FK.Set (FKD);
                     Append (TDR (Table.Unchecked_Get).FK, FK);

                     Att.Get.FK := True;

                  else
                     Att.Get.Typ := From_SQL (Typ);
                     if Att.Get.Typ = null then
                        Put_Line ("Error: unknown field type """ & Typ & '"');
                        raise Invalid_Type;
                     end if;
                  end if;
               end;
            end if;
         end loop;

         --  Check that the table has a valid Primary Key
         --  ??? Code is commented out for reference in case we decide to
         --  output such a warning after all. For now, since there is no way
         --  to hide the warning for the user, this is too verbose.

--           if not TDR (Table.Get).Has_PK
--             and then not Table.Is_Abstract
--             and then (Table.Super_Table = No_Table
--                       or else not TDR (Table.Super_Table.Get).Has_PK)
--           then
--              Put_Line ("Warning: table '"
--                        & Table.Name & "' has no primary key");
--              Put_Line ("    No Delete operation generated for this table");
--           end if;

         Free (String_List (Line));
         Schema.Ordered_Tables.Append (Name);
      end Parse_Table;

      ----------------------------
      -- Parse_Table_Properties --
      ----------------------------

      procedure Parse_Table_Properties (Name : String) is
         Curs  : constant Tables_Maps.Cursor := Schema.Tables.Find (Name);
         From_Table : Table_Description := Element (Curs);
         To_Table : Table_Description;
         FK    : Foreign_Key;
         Line  : Line_Fields;
         Index_Count : Natural := 1;
      begin
         while First <= Data'Last and then Data (First) = '|' loop
            Parse_Line (Result => Line);

            if Line (1).all = "FK:" then
               To_Table := Get_Table (Schema, Line (2).all);
               FK.Set (Foreign_Key_Description'
                    (To_Table        => To_Table.Weak,
                     Revert_Name     => null,
                     Ambiguous       => False,
                     Fields          => Pair_Lists.Empty_Vector));
               Mark_FK_As_Ambiguous (From_Table, To_Table, FK.Get.Ambiguous);

               declare
                  From : String renames Line (3).all;
                  To   : String renames Line (4).all;
                  First, First2, Tmp, Tmp2 : Natural;
               begin
                  First  := From'First;
                  First2 := To'First;

                  while First <= From'Last loop
                     Skip_Blanks (From, First);
                     Skip_Blanks (To, First2);

                     Tmp := Find_Char (From (First + 1 .. From'Last), ' ');
                     Tmp2 := Find_Char (To (First2 + 1 .. To'Last), ' ');

                     Append (FK.Get.Fields,
                             (From => From_Table.Field_From_Name
                                        (From (First .. Tmp - 1)),
                              To   => To_Table.Field_From_Name
                                        (To (First2 .. Tmp2 - 1))));
                     First  := Tmp + 1;
                     First2 := Tmp2 + 1;
                  end loop;
               end;

               TDR (From_Table.Unchecked_Get).FK.Append (FK);

            elsif Line (1).all = "INDEX:" then
               if Line (3).all = "" then
                  TDR (From_Table.Unchecked_Get).Indexes.Append
                    (String'(Line (2).all
                     & "|"
                     & Name & "_idx"
                     & Image (Index_Count, Min_Width => 1)));
               else
                  TDR (From_Table.Unchecked_Get).Indexes.Append
                    (String'(Line (2).all & "|" & Line (3).all));
               end if;

               Index_Count := Index_Count + 1;

            elsif Line (1).all = "UNIQUE:" then
               TDR (From_Table.Unchecked_Get).Uniques.Append
                 (String'(Line (2).all & "|" & Line (3).all));
            end if;
         end loop;

         Free (String_List (Line));
         Replace_Element (Schema.Tables, Curs, From_Table);
      end Parse_Table_Properties;

      Line : Line_Fields;
      type Parse_Mode is (Parsing_Table, Parsing_Properties);

   begin
      for Mode in Parse_Mode loop
         First := Data'First;
         Line_Number := 0;

         while First <= Data'Last loop
            if Data (First) = '|' then
               Parse_Line (Result => Line);

               if Starts_With (Line (1).all, "ABSTRACT TABLE")
                 or else Starts_With (Line (1).all, "TABLE")
                 or else Starts_With (Line (1).all, "VIEW")
               then
                  case Mode is
                     when Parsing_Table =>
                        Parse_Table
                          (Line (1).all,
                           Line (2).all,
                           Is_View => Starts_With (Line (1).all, "VIEW"));
                     when Parsing_Properties    =>
                        Parse_Table_Properties (Line (2).all);
                  end case;
               end if;
            else
               First := EOL (Data (First .. Data'Last)) + 1;
               Line_Number := Line_Number + 1;
            end if;
         end loop;
      end loop;

      --  Check that all foreign keys reference valid tables

      declare
         Has_Errors : Boolean := False;

         procedure Cb (From, To : Field; Id : Natural; Ambiguous : Boolean);
         procedure Cb (From, To : Field; Id : Natural; Ambiguous : Boolean) is
            pragma Unreferenced (Id, Ambiguous);
         begin
            if To = No_Field then
               Put_Line ("Invalid foreign key: "
                  & From.Get_Table.Name & "." & From.Name
                  & " references an invalid table or field");
               Has_Errors := True;
            end if;
         end Cb;

         procedure On_Table (Descr : in out Table_Description);
         procedure On_Table (Descr : in out Table_Description) is
         begin
            For_Each_FK (Descr, Cb'Access);
         end On_Table;

      begin
         For_Each_Table (Schema, On_Table'Access);

         Free (String_List (Line));

         if Has_Errors then
            return No_Schema;
         else
            return Schema;
         end if;
      end;

   exception
      when E : Invalid_Type =>
         Free (String_List (Line));
         Put_Line (Standard_Error,
                   Self.File.Display_Full_Name
                   & ":" & Image (Line_Number, Min_Width => 1) & " "
                   & Exception_Message (E));
         raise;

      when Name_Error =>
         Put_Line ("Could not open " & Self.File.Display_Full_Name);
         return No_Schema;
   end Read_Schema;

   -----------------
   -- Read_Schema --
   -----------------

   overriding function Read_Schema
     (Self : File_Schema_IO) return DB_Schema
   is
      Str    : GNAT.Strings.String_Access := Self.File.Read_File;
      Schema : DB_Schema;
   begin
      if Str = null then
         Put_Line ("File not found: " & Self.File.Display_Full_Name);
         return No_Schema;
      end if;
      Schema := Read_Schema (Self, Str.all);
      Free (Str);
      return Schema;

   exception
      when others =>
         Free (Str);
         raise;
   end Read_Schema;

   ------------------
   -- Write_Schema --
   ------------------

   overriding procedure Write_Schema
     (Self : DB_Schema_IO; Schema : DB_Schema)
   is
      Created : String_Lists.Vector;
      --  List of tables that have been created. When a table has already been
      --  created, we set the foreign key constraints to it immediately,
      --  otherwise we defer them till all tables have been created.

      package XString_Sets is new Ada.Containers.Hashed_Sets
        (XString, Hash, "=");
      Dummy : XString_Sets.Cursor;

      Namespaces : XString_Sets.Set;

      Deferred         : String_Lists.Vector;
      Deferred_Indexes : String_Lists.Vector;
      --  Statements to execute to create the indexes

      type Namespaced_Name is record
         Namespace : XString;
         Full_Name : XString;
      end record;

      procedure For_Table (Table : in out Table_Description);
      --  Process a table

      function Quoted (Item : String) return Namespaced_Name;
      --  Returns quoted namespace and quoted full table name

      procedure Do_Statement (SQL : String);
      --  Execute or output the statement, depending on user's choice

      ------------------
      -- Do_Statement --
      ------------------

      procedure Do_Statement (SQL : String) is
      begin
         if SQL /= "" then
            if Self.DB = null then
               Put_Line (SQL & ";");
            else
               Execute (Self.DB, SQL);
            end if;
         end if;
      end Do_Statement;

      ------------
      -- Quoted --
      ------------

      function Quoted (Item : String) return Namespaced_Name is
         Dot_Idx : Natural;
         Result : Namespaced_Name;
      begin
         if Item (Item'First) = '"' then
            if Item (Item'Last) = '"' then
               Dot_Idx := Fixed.Index (Item, """.""");

               Result.Full_Name := To_XString (Item);
               Result.Namespace :=
                 (if Dot_Idx = 0 then Null_XString
                  else To_XString (Item (Item'First .. Dot_Idx)));

            else
               Dot_Idx := Fixed.Index (Item, """.");

               if Dot_Idx = 0 then
                  raise Constraint_Error with
                     "Unsupported table name format " & Item;
               else
                  Result.Namespace :=
                    To_XString (Item (Item'First .. Dot_Idx));
                  Result.Full_Name := Result.Namespace;
                  Result.Full_Name.Append
                    (".""" & Item (Dot_Idx + 2 .. Item'Last) & '"');
               end if;
            end if;

         elsif Item (Item'Last) = '"' then
            Dot_Idx := Fixed.Index (Item, ".""");

            if Dot_Idx = 0 then
               raise Constraint_Error with
                 "Unsupported table name format " & Item;
            else
               Result.Namespace :=
                 To_XString ('"' & Item (Item'First .. Dot_Idx - 1) & '"');
               Result.Full_Name := Result.Namespace;
               Result.Full_Name.Append ('.' & Item (Dot_Idx + 1 .. Item'Last));
            end if;

         else
            Dot_Idx := Fixed.Index (Item, ".");
            if Dot_Idx = 0 then
               Result.Namespace := Null_XString;
               Result.Full_Name := To_XString ('"' & Item & '"');
            else
               Result.Namespace :=
                 To_XString ('"' & Item (Item'First .. Dot_Idx - 1) & '"');
               Result.Full_Name := Result.Namespace;
               Result.Full_Name.Append
                 (".""" & Item (Dot_Idx + 1 .. Item'Last) & '"');
            end if;
         end if;

         return Result;
      end Quoted;

      ---------------
      -- For_Table --
      ---------------

      procedure For_Table (Table : in out Table_Description) is
         SQL : Unbounded_String;
         --  The statement to execute

         TNS : constant Namespaced_Name := Quoted (Table.Name);
         Table_Name : constant String := To_String (TNS.Full_Name);
         New_NS : Boolean;

         SQL_PK : Unbounded_String;
         --  The SQL to create the primary key

         Is_First_Attribute : Boolean := True;

         procedure Print_PK (F : in out Field);
         procedure Add_Field_To_SQL (F : in out Field);

         procedure Print_Uniques;

         procedure Get_Field_Def
           (F    : Field;
            Stmt : out Unbounded_String;
            Can_Be_Not_Null : Boolean := True;
            FK_Table : String := "");
         --  Set Stmt to the definition for the field F.
         --  If Can_Be_Not_Null is False, the field will never have NOT NULL.
         --  This is needed in sqlite3 when adding FK columns later on. When
         --  Can_Be_Not_Null is set to False, you must set FK_Table to the
         --  table pointed to by the field.

         procedure Print_Indexes (Table : Table_Description);
         --  Create the multi-column indexes for the table

         procedure Print_FK (Table : Table_Description);
         --  Process the foreign key and indexes constraints. They are either
         --  added to the table creation statement, or deferred until all
         --  tables have been created.

         -------------------
         -- Print_Indexes --
         -------------------

         procedure Print_Indexes (Table : Table_Description) is
            Name_Start : Positive;
         begin
            for Descr of TDR (Table.Unchecked_Get).Indexes loop
               Name_Start := Index (Descr, "|", Descr'First + 1);

               Deferred_Indexes.Append
                  (String'
                   ("CREATE INDEX """
                    & Descr (Name_Start + 1 .. Descr'Last)
                    & """ ON "
                    & Table_Name & " ("
                    & Descr (Descr'First .. Name_Start - 1)
                    & ")"));
            end loop;
         end Print_Indexes;

         -------------------
         -- Print_Uniques --
         -------------------

         procedure Print_Uniques is
            Name_Start : Positive;
         begin
            for Descr of TDR (Table.Unchecked_Get).Uniques loop
               Append (SQL, ',' & ASCII.LF);

               Name_Start := Index (Descr, "|", Descr'First + 1);

               if Name_Start < Descr'Last then
                  Append
                    (SQL,
                     "CONSTRAINT """ & Descr (Name_Start + 1 .. Descr'Last)
                     & """ ");
               end if;

               Append
                 (SQL,
                  "UNIQUE (" & Descr (Descr'First .. Name_Start - 1) & ')');
            end loop;
         end Print_Uniques;

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

         procedure Print_FK (Table : Table_Description) is
            Stmt2 : Unbounded_String;
            --  The deferred statement to execute

            Stmt_FK, Stmt_References : Unbounded_String;
            P : Pair_Lists.Cursor;
            Is_First : Boolean;
            Table_To : XString;
         begin
            for R of TDR (Table.Unchecked_Get).FK loop
               --  Prepare the constraint

               Table_To := Quoted (R.To_Table.Name).Full_Name;

               Stmt_FK := To_Unbounded_String (" FOREIGN KEY (");
               Is_First := True;
               P := R.Get.Fields.First;
               while Has_Element (P) loop
                  if not Is_First then
                     Append (Stmt_FK, ",");
                  end if;
                  Is_First := False;
                  Append (Stmt_FK, '"' & Element (P).From.Name & '"');
                  Next (P);
               end loop;
               Append (Stmt_FK, ")");

               Stmt_References := To_Unbounded_String
                 (" REFERENCES " & To_String (Table_To) & " (");
               Is_First := True;
               P := R.Get.Fields.First;
               while Has_Element (P) loop
                  if not Is_First then
                     Append (Stmt_References, ",");
                  end if;
                  Is_First := False;

                  if Element (P).To = No_Field then
                     Append
                       (Stmt_References, '"' & R.To_Table.Get_PK.Name & '"');
                  else
                     Append
                       (Stmt_References, '"' & Element (P).To.Name & '"');
                  end if;
                  Next (P);
               end loop;
               Append (Stmt_References, ")");

               Append (Stmt_FK, Stmt_References);

               --  If the other table has already been created, we can add the
               --  new constraint directly in the table creation which is more
               --  efficient (a single SQL statement).

               if Created.Contains (To_String (Table_To)) then
                  Append (SQL, "," & ASCII.LF & Stmt_FK);

               elsif Self.DB.Can_Alter_Table_Constraints then
                  Append
                    (Deferred,
                     To_String
                       ("ALTER TABLE " & Table_Name & " ADD CONSTRAINT "
                        & Element (R.Get.Fields.First).From.Name
                        & "_fk" & Stmt_FK));

               else
                  P := R.Get.Fields.First;
                  while Has_Element (P) loop
                     --  Sqlite only allows adding a NON NULL REFERENCES column
                     --  if it has a non-null default. So we need to provide a
                     --  random default in such a case.

                     Get_Field_Def (Element (P).From, Stmt2,
                                    Can_Be_Not_Null => False,
                                    FK_Table => To_String (Table_To));
                     Stmt2 := "ALTER TABLE " & Table_Name & " ADD COLUMN "
                       & Stmt2 & Stmt_References;
                     Append (Deferred, To_String (Stmt2));
                     Next (P);
                  end loop;
               end if;

               --  Create indexes for the reverse relationships, since it is
               --  likely the user will want to use them a lot anyway

               if Length (R.Get.Fields) = 1

                 --  Unless already created explicitly
                 and not Element (R.Get.Fields.First).From.Get.Props.Indexed

                 --  Unless disabled by the user
                 and not Element (R.Get.Fields.First).From.Get.Props.Noindex
               then
                  Deferred_Indexes.Append
                     (String'
                        ("CREATE INDEX """
                         & Table.Name & "_"
                         & Element (R.Get.Fields.First).From.Name
                         & "_idx"" ON "
                         & Table_Name & " ("""
                         & Element (R.Get.Fields.First).From.Name
                         & """)"));
               end if;
            end loop;
         end Print_FK;

         -------------------
         -- Get_Field_Def --
         -------------------

         procedure Get_Field_Def
           (F    : Field;
            Stmt : out Unbounded_String;
            Can_Be_Not_Null : Boolean := True;
            FK_Table : String := "")
         is
            Val : GNAT.Strings.String_Access;
            Val_Param : SQL_Parameter;
         begin
            Stmt := Null_Unbounded_String;

            Append (Stmt, " """ & F.Name & """ "
                    & Get_Type (F).Type_To_SQL
                       (Self.DB, For_Database => True));

            if not F.Can_Be_Null then
               if not Can_Be_Not_Null then
                  Put_Line (Standard_Error,
                            "Warning: '" & F.Get_Table.Name
                            & "." & F.Name
                            & "' cannot be NOT NULL in sqlite, because it"
                            & " references '" & FK_Table
                            & "' which hasn't been defined yet." & ASCII.LF
                            & "  Try reordering the table definitions");
               else
                  Append (Stmt, " NOT NULL");
               end if;
            end if;

            if F.Get.Props.Unique then
               Append (Stmt, " UNIQUE");
            end if;

            if F.Get.Props.Case_Insensitive then
               Append (Stmt, " COLLATE NOCASE");
            end if;

            if F.Default /= "" then
               Format_Field
                 (Self.DB, F.Default, Get_Type (F).all, Val, Val_Param, False);
               Append (Stmt, " DEFAULT " & Val.all);
               Free (Val);

               if not Can_Be_Not_Null then
                  --  When adding FK fields to an existing table, sqlite only
                  --  allows a NULL default value.

                  Put_Line
                    (Standard_Error,
                     "Error: '" & F.Get_Table.Name & "." & F.Name
                     & "' is a reference to table '"
                     & F.Is_FK.Get_Table.Name
                     & "' which isn't defined yet. Sqlite imposes a NULL"
                     & " default in this case.");
                  raise Invalid_Schema;
               end if;
            end if;

            if F.Get.Props.Indexed then
               Deferred_Indexes.Append
                  (String'
                    ("CREATE INDEX """
                     & Table.Name & "_"
                     & F.Get.Name.all
                     & "_idx"" ON "
                     & Table_Name & " ("""
                     & F.Get.Name.all
                     & """)"));
            end if;
         end Get_Field_Def;

         ----------------------
         -- Add_Field_To_SQL --
         ----------------------

         procedure Add_Field_To_SQL (F : in out Field) is
            Tmp : Unbounded_String;
         begin
            --  When a field is a FK to a table that hasn't been created yet,
            --  we need to alter the table later to set the constraint. But in
            --  some cases (sqlite3), this isn't possible, so we will create
            --  the field later altogether.

            if not Self.DB.Can_Alter_Table_Constraints
              and then F.Is_FK /= No_Field
              and then not Created.Contains
                (To_String (Quoted (F.Is_FK.Get_Table.Name).Full_Name))
            then
               if F.Is_PK then
                  Put_Line (Standard_Error,
                            "Error: '" & F.Get_Table.Name & "." & F.Name
                            & "' is a primary key and references the table '"
                            & F.Is_FK.Get_Table.Name & "' which hasn't been"
                            & " defined yet.");
                  raise Invalid_Schema;
               end if;
               return;
            end if;

            if not Is_First_Attribute then
               Append (SQL, "," & ASCII.LF);
            end if;

            Is_First_Attribute := False;

            Get_Field_Def (F, Tmp);
            Append (SQL, Tmp);
         end Add_Field_To_SQL;

         --------------
         -- Print_PK --
         --------------

         procedure Print_PK (F : in out Field) is
         begin
            --  Auto increment fields were already setup as primary keys
            --  via Field_Mapping_Autoincrement primitive operation.
            if F.Is_PK
              and then F.Get_Type.all not in Field_Mapping_Autoincrement'Class
            then
               if SQL_PK = Null_Unbounded_String then
                  Append (SQL_PK, '"' & F.Name & '"');
               else
                  Append (SQL_PK, ",""" & F.Name & '"');
               end if;
            end if;
         end Print_PK;

      begin -- For_Table
         if Self.DB.Success and then not Table.Is_Abstract then
            if TNS.Namespace /= Null_XString then
               Namespaces.Insert (TNS.Namespace, Dummy, New_NS);

               if New_NS then
                  Append
                    (SQL,
                     "CREATE SCHEMA IF NOT EXISTS "
                     & To_String (TNS.Namespace) & ';' & ASCII.LF);
               end if;
            end if;

            case Table.Get_Kind is
               when Kind_Table =>
                  Created.Append (Table_Name); -- mark the table as created

                  Append (SQL, "CREATE TABLE " & Table_Name & " (" & ASCII.LF);
                  For_Each_Field
                    (Table, Add_Field_To_SQL'Access,
                     Include_Inherited => True);

                  SQL_PK := Null_Unbounded_String;
                  For_Each_Field (Table, Print_PK'Access, True);
                  if SQL_PK /= "" then
                     Append (SQL, ", PRIMARY KEY (" & SQL_PK & ")");
                  end if;

                  Print_Uniques;

                  Print_FK (Table);
                  Print_Indexes (Table);
                  Append (SQL, ")");
                  Do_Statement (To_String (SQL));

               when Kind_View  =>
                  null;
            end case;
         end if;
      end For_Table;

      S  : String_Lists.Cursor;

   begin
      For_Each_Table (Schema, For_Table'Access, Alphabetical => False);

      if Self.DB.Success then
         S := First (Deferred);
         while Has_Element (S) loop
            Do_Statement (Element (S));
            Next (S);
         end loop;

         S := First (Deferred_Indexes);
         while Has_Element (S) loop
            Do_Statement (Element (S));
            Next (S);
         end loop;
      end if;

      if Self.DB /= null then
         if Self.DB.Automatic_Transactions then
            Commit_Or_Rollback (Self.DB);
         end if;

         if not Self.DB.Success then
            Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
         end if;
      end if;

   exception
      when Invalid_Schema =>
         Self.DB.Set_Failure;
         if Self.DB.Automatic_Transactions then
            Rollback (Self.DB);
         end if;
         Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
   end Write_Schema;

   ------------------
   -- Write_Schema --
   ------------------

   overriding procedure Write_Schema
     (Self : File_Schema_IO; Schema : DB_Schema)
   is
   begin
      Write_Schema (Self, Schema, Ada.Text_IO.Put'Access);
   end Write_Schema;

   ------------------
   -- Write_Schema --
   ------------------

   procedure Write_Schema
     (Self   : File_Schema_IO;
      Schema : DB_Schema;
      Puts   : access procedure (S : String);
      Align_Columns : Boolean := True;
      Show_Comments : Boolean := True)
   is
      To_File : File_Type;
      Put : access procedure (S : String) := Puts;

      Not_Null : constant String := "NOT NULL";
      Column_Widths : array (1 .. 4) of Natural;
      --  The maximum width of all columns

      function SQL_Type (Attr : Field) return String;
      --  Return the type to use for Attr. This includes foreign keys when
      --  appropriate

      procedure For_Table (Table : in out Table_Description);
      --  Process a table

      procedure For_Field (F : in out Field);
      --  Process a field

      function Omit_Schema (Name : String) return String;
      --  Remove schema prefix if it is defined in -omit-schema parameter

      -----------------
      -- Omit_Schema --
      -----------------

      function Omit_Schema (Name : String) return String is
         Dot : constant Natural := Index (Name, ".");
      begin
         if Dot = 0
           or else not Self.Omit_Schema.Contains (Name (Name'First .. Dot - 1))
         then
            return Name;
         end if;

         return Name (Dot + 1 .. Name'Last);
      end Omit_Schema;

      --------------
      -- SQL_Type --
      --------------

      function SQL_Type (Attr : Field) return String is
         FK : constant Field := Attr.Is_FK;
      begin
         if FK = No_Field then
            if Attr.Get_Type.all in Field_Mapping_Autoincrement'Class then
               return "AUTOINCREMENT";
            else
               return Attr.Get_Type.Type_To_SQL
                 (Self.DB, For_Database => True);
            end if;
         else
            return "FK " & Omit_Schema (FK.Get_Table.Name);
         end if;
      end SQL_Type;

      ---------------
      -- For_Field --
      ---------------

      procedure For_Field (F : in out Field) is
         Name    : constant String := F.Name;
         Default : constant String := F.Default;
      begin
         Put
           ("|" & Name & (1 .. Column_Widths (1) - Name'Length => ' ') & "|");

         declare
            Typ : constant String := SQL_Type (F);
         begin
            Put (Typ & (1 .. Column_Widths (2) - Typ'Length => ' ') & "|");
         end;

         if F.Is_PK then
            Put ("PK");
         elsif not F.Can_Be_Null then
            Put (Not_Null);
         elsif Align_Columns then
            Put ("NULL");
         end if;

         if F.Get.Props.Indexed then
            Put (",INDEX");
         elsif F.Get.Props.Noindex then
            Put (",NOINDEX");
         end if;

         if F.Get.Props.Unique then
            Put (",UNIQUE");
         end if;

         if F.Get.Props.Case_Insensitive then
            Put (",NOCASE");
         end if;

         Put
           ("|" & Default & (1 .. Column_Widths (4) - Default'Length => ' ')
            & "|");

         if Show_Comments then
            Put
              (Translate (F.Description,
               Mapping => To_Mapping ("" & ASCII.LF, " ")) & "|" & ASCII.LF);
         else
            Put ("" & ASCII.LF);
         end if;
      end For_Field;

      ---------------
      -- For_Table --
      ---------------

      procedure For_Table (Table : in out Table_Description) is
         P  : Pair_Lists.Cursor;

         procedure Write_Index (Prefix : String; List : String_Lists.Vector);

         -----------------
         -- Write_Index --
         -----------------

         procedure Write_Index (Prefix : String; List : String_Lists.Vector) is
            Name_Start : Positive;
         begin
            for Descr of List loop
               Name_Start := Index (Descr, "|", Descr'First + 1);

               Put ('|' & Prefix & ":|"
                    & Descr (Descr'First .. Name_Start - 1)
                    & "|" & Descr (Name_Start + 1 .. Descr'Last)
                    & ASCII.LF);
            end loop;
         end Write_Index;

         Table_Name : constant String := Omit_Schema (Table.Name);

      begin
         --  Compute widths
         --  Minimum size of column 1 is 5 (for "TABLE")
         if Align_Columns then
            Column_Widths := (1 => 5, 2 => 0, 3 => Not_Null'Length, 4 => 0);
            for A of TDR (Table.Unchecked_Get).Fields loop
               Column_Widths (1) := Integer'Max
                 (Column_Widths (1), A.Name'Length);
               Column_Widths (2) := Integer'Max
                 (Column_Widths (2), SQL_Type (A)'Length);
               Column_Widths (4) := Integer'Max
                 (Column_Widths (4), A.Default'Length);
            end loop;

         else
            Column_Widths := (others => 0);
         end if;

         case Table.Get_Kind is
            when Kind_Table =>
               Put
                 ("|TABLE" & (1 .. Column_Widths (1) - 5 => ' ')
                  & "| " & Table_Name & ASCII.LF);
            when Kind_View  =>
               Put
                 ("|VIEW" & (1 .. Column_Widths (1) - 4 => ' ')
                  & "| " & Table_Name & ASCII.LF);
         end case;

         For_Each_Field (Table, For_Field'Access, True);

         for FK of TDR (Table.Unchecked_Get).FK loop
            if Length (FK.Get.Fields) > 1 then
               Put ("| FK: | " & Omit_Schema (FK.To_Table.Name) & " | ");

               P := FK.Get.Fields.First;
               while Has_Element (P) loop
                  Put (Element (P).From.Name & " ");
                  Next (P);
               end loop;

               Put (" | ");

               P := FK.Get.Fields.First;
               while Has_Element (P) loop
                  Put (Element (P).To.Name & " ");
                  Next (P);
               end loop;

               Put (" |" & ASCII.LF);
            end if;
         end loop;

         Write_Index ("INDEX", TDR (Table.Unchecked_Get).Indexes);
         Write_Index ("UNIQUE", TDR (Table.Unchecked_Get).Uniques);

         Put ("" & ASCII.LF);
      end For_Table;

   begin
      if Self.File /= No_File then
         Create (To_File, Out_File, Self.File.Display_Full_Name);
         Set_Output (To_File);
         Put := Ada.Text_IO.Put'Access;
      end if;

      For_Each_Table (Schema, For_Table'Access, Alphabetical => False);

      if Self.File /= No_File then
         Set_Output (Standard_Output);
         Close (To_File);
      end if;
   end Write_Schema;

   ---------------
   -- Load_Data --
   ---------------

   procedure Load_Data
     (File   : GNATCOLL.VFS.Virtual_File;
      Puts   : access procedure (S : String))
   is
      Str          : GNAT.Strings.String_Access;
      Line_Number  : Natural := 0;
      Line         : String_List (1 .. Max_Fields_Per_Line);
      First        : Integer;
      Fields_Count : Natural;  --  Number of fields on current line

   begin
      Str := Read_Whole_File (+File.Full_Name.all);
      if Str /= null then
         First := Str'First;

         while First <= Str'Last loop
            Parse_Line
              (Line, Line_Number, Fields_Count, Str.all, First,
               Replace_Newline => False);

            if Fields_Count > 0 then
               for F in 1 .. Fields_Count loop
                  Puts ("|" & Line (F).all);
               end loop;
               Puts ("|" & ASCII.LF);
            end if;
         end loop;
      end if;

      Free (Str);
   end Load_Data;

   ----------------
   -- Parse_Line --
   ----------------

   procedure Parse_Line
     (Line         : in out String_List;
      Line_Number  : in out Natural;
      Fields_Count : out Natural;
      Data         : String;
      First        : in out Integer;
      Replace_Newline : Boolean := True)
   is
      Line_End : Natural := EOL (Data (First .. Data'Last));
      Last, Tmp : Natural;
   begin
      Free (String_List (Line));
      Fields_Count := Line'First - 1;

      Line_Number := Line_Number + 1;

      while Data (First) = '|'
        and then Data (First + 1) = '-'  --  Skip line like  |---|----|

        --  But we want to parse  |-1|...
        and then (Data'Length < 3 or else Data (First + 2) = '-')
      loop
         First := Line_End + 1;
         Line_End := EOL (Data (First .. Data'Last));
         Line_Number := Line_Number + 1;
      end loop;

      if Data (First) = '|' then
         First := First + 1;

         while First <= Line_End loop
            Skip_Blanks (Data, First);
            exit when First >= Line_End;
            exit when Data (First) = '#';  --  A comment

            --  First now points to first non-blank char

            Last := EOW (Data, First);
            exit when Last > Line_End;

            Tmp := Last - 1;
            Skip_Blanks_Backward (Data (First .. Tmp), Tmp);

            if Replace_Newline then
               declare
                  S : Unbounded_String :=
                    To_Unbounded_String (Data (First .. Tmp));
               begin
                  Replace
                    (S, Pattern => "\n", Replacement => "" & ASCII.LF);
                  Append (Line, Fields_Count, To_String (S));
               end;

            else
               Append (Line, Fields_Count, Data (First .. Tmp));
            end if;

            First := Last + 1;
         end loop;
      end if;

      First := Line_End + 1;
   end Parse_Line;

   ---------------
   -- Load_Data --
   ---------------

   procedure Load_Data
     (DB     : access Database_Connection_Record'Class;
      Data   : String;
      Schema : DB_Schema := No_Schema;
      Location : String := "data";
      Replace_Newline : Boolean := True)
   is
      Line_Number : Natural := 0;

      Line         : String_List (1 .. Max_Fields_Per_Line);
      First        : Integer;
      Fields_Count : Natural;  --  Number of fields on current line

      Table     : Table_Description;

      DB_Fields       : String_List (1 .. Max_Fields_Per_Line);
      DB_Fields_Count : Natural := DB_Fields'First - 1;
      Xref       : String_List (1 .. Max_Fields_Per_Line);
      Xref_Count : Natural := Xref'First - 1;
      Xref_Type  : array (1 .. Max_Fields_Per_Line) of Field_Mapping_Access;

      function Is_Xref (Index : Positive) return Boolean is
        (Xref_Type (Index) /= null);
      --  Whether a given column must be an xref

      Paren      : Natural;
      DB_Field_Mappings : array (Line'First .. Max_Fields_Per_Line)
        of Field_Mapping_Access;

      --  TODO : convert for parameter_decimal
      Tmp_DB_Fields_Count : Natural := DB_Fields'First - 1;

      FK : Field;
      Tables : String_List (1 .. Max_Fields_Per_Line);
      Where  : String_List (1 .. Max_Fields_Per_Line);

      Select_Values : String_List (1 .. Max_Fields_Per_Line);
      --  Parameters when values are queries through a SELECT

      DB_Values : String_List (1 .. Max_Fields_Per_Line);
      --  Parameters when all values are provided in the file

      Has_Xref_Column : Boolean;
      --  Whether at least one column can handle xref (values starting with &)

      Q_Values : Prepared_Statement;
      Q_Values_With_Select : Prepared_Statement;

      procedure Parse_Line;

      procedure Free_Vars;
      --  Free all local variables

      procedure Parse_Line is
      begin
         Parse_Line
           (Line, Line_Number, Fields_Count, Data, First, Replace_Newline);
      end Parse_Line;

      ---------------
      -- Free_Vars --
      ---------------

      procedure Free_Vars is
      begin
         Has_Xref_Column := False;

         Free (DB_Fields);
         DB_Fields_Count := DB_Fields'First - 1;
         Tmp_DB_Fields_Count := DB_Fields'First - 1;

         Free (Xref);
         Xref_Count := Xref'First - 1;

         Free (Tables);
         Free (Where);
         Free (Select_Values);
         Free (DB_Values);
      end Free_Vars;

   begin
      Trace (Me, "Loading data from " & Location & " into database");

      First := Data'First;

      if DB.Has_Pragmas then
         Execute (DB, "PRAGMA foreign_keys=OFF");
      end if;

      while First <= Data'Last loop
         Parse_Line;

         if Fields_Count /= 0
           and then (Line (1).all = "TABLE"
                     or else Line (1).all = "VIEW")
         then
            Free_Vars;

            Table := Get_Table (Schema, Line (2).all);

            Parse_Line;  --  Parse fields
            for L in Line'First .. Fields_Count loop
               exit when Line (L).all = "";

               Paren := Ada.Strings.Fixed.Index (Line (L).all, "(&");

               if Paren >= Line (L)'First then
                  --  Reference to another table.column

                  declare
                     Name : constant String :=
                              Line (L) (Line (L)'First .. Paren - 1);
                     Refn : constant String :=
                              Line (L)
                                (Paren + 2 .. Index (Line (L).all, ")") - 1);
                  begin
                     Append (DB_Fields, DB_Fields_Count, Quote_Keyword (Name));
                     Append (Xref, Xref_Count,
                             Line (L) (Paren + 2 .. Line (L)'Last - 1));
                     FK := Table.Field_From_Name (Name).Is_FK;
                     Xref_Type (L) := Get_Table (Schema, FK.Get_Table.Name)
                                      .Field_From_Name (Refn).Get_Type;
                     Has_Xref_Column := True;
                     Tables (L) := new String'
                       (FK.Get_Table.Name & " t" & Image (L, 0));
                  end;
               else
                  Append (DB_Fields, DB_Fields_Count,
                          Quote_Keyword (Line (L).all));
                  Append (Xref, Xref_Count, "");
               end if;

               pragma Assert (L = DB_Fields_Count);
               pragma Assert (L = Xref_Count); -- Xref_Count can be removed
            end loop;

            declare
               procedure On_Field (F : in out Field);
               procedure On_Field (F : in out Field) is
                  N : constant String := Quote_Keyword (F.Name);
               begin
                  for L in DB_Fields'First .. DB_Fields_Count loop
                     if DB_Fields (L).all = N then
                        DB_Field_Mappings (L) := F.Get_Type;
                        return;
                     end if;
                  end loop;

                  --  We might not find the field, in case the data only sets
                  --  a subset of the fields. That doesn't matter.
               end On_Field;
            begin
               Table.For_Each_Field
                 (On_Field'Access, Include_Inherited => True);
            end;

            --  Set Select_Values and DB_Values according to DB_Field_Mappings
            for L in Line'First .. Fields_Count loop
               exit when Line (L).all = "";

               declare
                  Param : constant SQL_Parameter_Type'Class :=
                    DB_Field_Mappings (L).Parameter_Type;
                  P     : constant String :=
                    Param.Type_String (Index => L, Format => DB.all);
               begin
                  if Is_Xref (Tmp_DB_Fields_Count + 1) then
                     Select_Values (L) :=
                       new String'("t" & Image (L, 0) & "." & FK.Name);
                     Where (L) := new String'
                       ("t" & Image (L, 0) & "." & Xref (L).all
                        & "=" & Xref_Type (L).Parameter_Type.Type_String
                                  (Index => L, Format => DB.all));
                  else
                     Select_Values (L) := new String'(P);
                  end if;

                  DB_Values (L) := new String'(P);

                  Tmp_DB_Fields_Count := Tmp_DB_Fields_Count + 1;
               end;
            end loop;

            Q_Values := Prepare
              ("INSERT INTO """ & Table.Name & """("
               & Join (",", DB_Fields (DB_Fields'First .. DB_Fields_Count))
               & ") VALUES ("
               & Join (",", DB_Values (1 .. DB_Fields_Count)) & ")",
               On_Server => True,
               Name => "insertval");

            if Has_Xref_Column then
               Q_Values_With_Select := Prepare
                 ("INSERT INTO """ & Table.Name & """("
                  & Join (",", DB_Fields (DB_Fields'First .. DB_Fields_Count))
                  & ") SELECT "
                  & Join (",", Select_Values (1 .. DB_Fields_Count))
                  & " FROM " & Join (",", Tables (1 .. DB_Fields_Count))
                  & " WHERE " & Join (" and ", Where (1 .. DB_Fields_Count)),
                  On_Server => True,
                  Name => "insertv");
            end if;

         elsif Fields_Count /= 0
           and then Line (1).all = "QUERIES"
         then
            while First <= Data'Last and then Data (First) = '|' loop
               Parse_Line;
               Execute (DB, Line (1).all);
            end loop;

         elsif Fields_Count /= 0 then
            declare
               Values : SQL_Parameters (1 .. DB_Fields_Count);
               Vals   : String_List (1 .. DB_Fields_Count);
               Has_Xref : Boolean := False;
               Use_Custom : Boolean := False;
               Custom_Tables : String_List (1 .. DB_Fields_Count);
               Custom_Where : String_List (1 .. DB_Fields_Count);
            begin
               --  Check the xref in the columns

               for L in Line'First
                 .. Integer'Min (Fields_Count, DB_Fields_Count)
               loop
                  if Starts_With (Line (L).all, "&") then
                     Has_Xref := True;

                     if not Is_Xref (L) then
                        --  The column was not prepared as an xref
                        raise Invalid_File
                           with Location & ":" & Image (Line_Number, 0)
                          & ": column title must indicate referenced field";
                     end if;

                     Vals (L) := new String'
                       (Line (L) (Line (L)'First + 1 .. Line (L)'Last));
                     Values (L) := +Vals (L);

                  else
                     if Is_Xref (L) then
                        --  The prepared query expects an xref, but we do not
                        --  have. So we'll use a custom query
                        Use_Custom := True;
                     end if;
                  end if;
               end loop;

               if Use_Custom then
                  for L in Line'First
                    .. Integer'Min (Fields_Count, DB_Fields_Count)
                  loop
                     if Starts_With (Line (L).all, "&") then
                        Custom_Tables (L) := Tables (L);
                        Custom_Where (L) := new String'
                          ("t" & Image (L, 0) & "." & Xref (L).all
                           & "='"   --  ??? Beware of SQL injection here
                           & Line (L) (Line (L)'First + 1 .. Line (L)'Last)
                           & "'");
                        Free (Vals (L));
                        Vals (L) := new String'(Select_Values (L).all);
                     end if;
                  end loop;
               end if;

               for L in Line'First
                 .. Integer'Min (Fields_Count, DB_Fields_Count)
               loop
                  if Vals (L) = null then
                     Format_Field
                       (DB,
                        Line (L).all,
                        DB_Field_Mappings (L).all,
                        Vals (L),
                        Values (L),
                        Has_Xref => Use_Custom);
                  end if;
               end loop;

               if not Has_Xref then
                  Execute (DB, Q_Values, Params => Values);
               elsif Use_Custom then
                  Execute
                    (DB, "INSERT INTO """ & Table.Name & """("
                     & Join
                       (",", DB_Fields (DB_Fields'First .. DB_Fields_Count))
                     & ") SELECT " & Join (",", Vals)
                     & " FROM " & Join (",", Custom_Tables)
                     & " WHERE " & Join (" and ", Custom_Where));
               else
                  Execute (DB, Q_Values_With_Select, Params => Values);
               end if;

               Free (Custom_Where);
               Free (Vals);
            end;
         end if;

         exit when not Success (DB);
      end loop;

      Free (String_List (Line));
      Free_Vars;
   end Load_Data;

   ---------------
   -- Load_Data --
   ---------------

   procedure Load_Data
     (DB     : access Database_Connection_Record'Class;
      File   : GNATCOLL.VFS.Virtual_File;
      Schema : DB_Schema := No_Schema;
      Replace_Newline : Boolean := True)
   is
      Str : GNAT.Strings.String_Access;
   begin
      Str := Read_Whole_File (+File.Full_Name.all);
      if Str /= null then
         Load_Data (DB, Str.all, Schema, File.Display_Full_Name,
                    Replace_Newline => Replace_Newline);
         Free (Str);
      else
         raise Invalid_File with "File not found: " & File.Display_Full_Name;
      end if;
   end Load_Data;

   -------------------
   -- New_Schema_IO --
   -------------------

   function New_Schema_IO
     (File : GNATCOLL.VFS.Virtual_File) return File_Schema_IO'Class is
   begin
      return Result : File_Schema_IO do
         Result.File := File;
      end return;
   end New_Schema_IO;

   -------------------
   -- New_Schema_IO --
   -------------------

   function New_Schema_IO
     (DB : Database_Connection) return DB_Schema_IO'Class is
   begin
      return Result : DB_Schema_IO do
         Result.DB := DB;
      end return;
   end New_Schema_IO;

   -------------------
   -- Quote_Keyword --
   -------------------

   function Quote_Keyword (Str : String) return String is
   begin
      if Keywords.Is_Empty then
         --  For each keyword (from the postgreSQL documentation):
         --     * reserved (in sql99 or postgreSQL) means the word cannot be
         --       used for identifiers
         --     * non means the word can only be used in some cases.

         --  Keywords.Include ("ABORT");    --  psql:non
         Keywords.Include ("ABS");          --  sql99:non
         Keywords.Include ("ABSOLUTE");     --  sql99:reserved, psql:non
         Keywords.Include ("ACCESS");       --  non postgres
         Keywords.Include ("ACTION");       --  reserved sql99, not postgres
         Keywords.Include ("ADA");          --  non

         Keywords.Include ("ADD");   --  psql:non, sql99:reserved
         Keywords.Include ("ADMIN");   --  psql:reserved, sql99:
         Keywords.Include ("AFTER");   --  psql:non, sql99:reserved
         Keywords.Include ("AGGREGATE");   --  psql:non, sql99:reserved
         Keywords.Include ("ALIAS");   --  psql:reserved, sql99:
         Keywords.Include ("ALL");   --  psql:reserved, sql99:reserved
         Keywords.Include ("ALLOCATE");   --  psql:reserved, sql99:reserved
         Keywords.Include ("ALTER");   --  psql:non, sql99:reserved
         Keywords.Include ("ANALYSE");   --  psql:reserved, sql99:
         Keywords.Include ("ANALYZE");   --  psql:reserved, sql99:
         Keywords.Include ("AND");   --  psql:reserved, sql99:reserved
         Keywords.Include ("ANY");   --  psql:reserved, sql99:reserved
         Keywords.Include ("ARE");   --  psql:reserved, sql99:reserved
         Keywords.Include ("ARRAY");   --  psql:reserved, sql99:
         Keywords.Include ("AS");   --  psql:reserved, sql99:reserved
         Keywords.Include ("ASC");   --  psql:reserved, sql99:reserved
         Keywords.Include ("ASENSITIVE");   --  psql:non, sql99:
         Keywords.Include ("ASSERTION");   --  psql:non, sql99:reserved
         Keywords.Include ("ASSIGNMENT");   --  psql:non, sql99:non
         Keywords.Include ("ASYMMETRIC");   --  psql:non, sql99:
         Keywords.Include ("AT");   --  psql:non, sql99:reserved
         Keywords.Include ("ATOMIC");   --  psql:non, sql99:
         Keywords.Include ("AUTHORIZATION");  --  psql:reserved, sql99:reserved
         Keywords.Include ("AVG");   --  psql:non, sql99:reserved
         Keywords.Include ("BACKWARD");   --  psql:non, sql99:
         Keywords.Include ("BEFORE");   --  psql:non, sql99:reserved
         Keywords.Include ("BEGIN");   --  psql:non, sql99:reserved
         Keywords.Include ("BETWEEN");   --  psql:reserved, sql99:(can
         Keywords.Include ("BIGINT");   --  psql:non, sql99:(cannot
         Keywords.Include ("BINARY");   --  psql:reserved, sql99:(can
         Keywords.Include ("BIT");   --  psql:non, sql99:(cannot
         Keywords.Include ("BITVAR");   --  psql:non, sql99:
         Keywords.Include ("BIT_LENGTH");   --  psql:non, sql99:reserved
         Keywords.Include ("BLOB");   --  psql:reserved, sql99:
         Keywords.Include ("BOOLEAN");   --  psql:non, sql99:(cannot
         Keywords.Include ("BOTH");   --  psql:reserved, sql99:reserved
         Keywords.Include ("BREADTH");   --  psql:reserved, sql99:
         Keywords.Include ("BY");   --  psql:non, sql99:reserved
         Keywords.Include ("C");   --  psql:non, sql99:non
         Keywords.Include ("CACHE");   --  psql:non, sql99:
         Keywords.Include ("CALL");   --  psql:reserved, sql99:
         Keywords.Include ("CALLED");   --  psql:non, sql99:non
         Keywords.Include ("CARDINALITY");   --  psql:non, sql99:
         Keywords.Include ("CASCADE");   --  psql:non, sql99:reserved
         Keywords.Include ("CASCADED");   --  psql:reserved, sql99:reserved
         Keywords.Include ("CASE");   --  psql:reserved, sql99:reserved
         Keywords.Include ("CAST");   --  psql:reserved, sql99:reserved
         Keywords.Include ("CATALOG");   --  psql:reserved, sql99:reserved
         Keywords.Include ("CATALOG_NAME");   --  psql:non, sql99:non
         Keywords.Include ("CHAIN");   --  psql:non, sql99:non
         Keywords.Include ("CHAR");   --  psql:non, sql99:(cannot
         Keywords.Include ("CHARACTER");   --  psql:non, sql99:(cannot
         Keywords.Include ("CHARACTERISTICS");   --  psql:non, sql99:
         Keywords.Include ("CHARACTER_LENGTH");   --  psql:non, sql99:reserved
         Keywords.Include ("CHARACTER_SET_CATALOG");   --  psql:non, sql99:non
         Keywords.Include ("CHARACTER_SET_NAME");   --  psql:non, sql99:non
         Keywords.Include ("CHARACTER_SET_SCHEMA");   --  psql:non, sql99:non
         Keywords.Include ("CHAR_LENGTH");   --  psql:non, sql99:reserved
         Keywords.Include ("CHECK");   --  psql:reserved, sql99:reserved
         Keywords.Include ("CHECKED");   --  psql:non, sql99:
         Keywords.Include ("CHECKPOINT");   --  psql:non, sql99:
         Keywords.Include ("CLASS");   --  psql:non, sql99:reserved
         Keywords.Include ("CLASS_ORIGIN");   --  psql:non, sql99:non
         Keywords.Include ("CLOB");   --  psql:reserved, sql99:
         Keywords.Include ("CLOSE");   --  psql:non, sql99:reserved
         Keywords.Include ("CLUSTER");   --  psql:non, sql99:
         Keywords.Include ("COALESCE");   --  psql:non, sql99:non
         Keywords.Include ("COBOL");   --  psql:non, sql99:non
         Keywords.Include ("COLLATE");   --  psql:reserved, sql99:reserved
         Keywords.Include ("COLLATION");   --  psql:reserved, sql99:reserved
         Keywords.Include ("COLLATION_CATALOG");   --  psql:non, sql99:non
         Keywords.Include ("COLLATION_NAME");   --  psql:non, sql99:non
         Keywords.Include ("COLLATION_SCHEMA");   --  psql:non, sql99:non
         Keywords.Include ("COLUMN");   --  psql:reserved, sql99:reserved
         Keywords.Include ("COLUMN_NAME");   --  psql:non, sql99:non
         Keywords.Include ("COMMAND_FUNCTION");   --  psql:non, sql99:non
         Keywords.Include ("COMMAND_FUNCTION_CODE");   --  psql:non, sql99:
         Keywords.Include ("COMMENT");   --  psql:non, sql99:
         Keywords.Include ("COMMIT");   --  psql:non, sql99:reserved
         Keywords.Include ("COMMITTED");   --  psql:non, sql99:non
         Keywords.Include ("COMPLETION");   --  psql:reserved, sql99:
         Keywords.Include ("CONDITION_NUMBER");   --  psql:non, sql99:non
         Keywords.Include ("CONNECT");   --  psql:reserved, sql99:reserved
         Keywords.Include ("CONNECTION");   --  psql:reserved, sql99:reserved
         Keywords.Include ("CONNECTION_NAME");   --  psql:non, sql99:non
         Keywords.Include ("CONSTRAINT");   --  psql:reserved, sql99:reserved
         Keywords.Include ("CONSTRAINTS");   --  psql:non, sql99:reserved
         Keywords.Include ("CONSTRAINT_CATALOG");   --  psql:non, sql99:non
         Keywords.Include ("CONSTRAINT_NAME");   --  psql:non, sql99:non
         Keywords.Include ("CONSTRAINT_SCHEMA");   --  psql:non, sql99:non
         Keywords.Include ("CONSTRUCTOR");   --  psql:reserved, sql99:
         Keywords.Include ("CONTAINS");   --  psql:non, sql99:
         Keywords.Include ("CONTINUE");   --  psql:reserved, sql99:reserved
         Keywords.Include ("CONVERSION");   --  psql:non, sql99:
         Keywords.Include ("CONVERT");   --  psql:non, sql99:(cannot
         Keywords.Include ("COPY");   --  psql:non, sql99:
         Keywords.Include ("CORRESPONDING");   --  psql:res., sql99:res.
         Keywords.Include ("COUNT");   --  psql:non, sql99:reserved
         Keywords.Include ("CREATE");   --  psql:reserved, sql99:reserved
         Keywords.Include ("CREATEDB");   --  psql:non, sql99:
         Keywords.Include ("CREATEUSER");   --  psql:non, sql99:
         Keywords.Include ("CROSS");   --  psql:reserved, sql99:(can
         Keywords.Include ("CUBE");   --  psql:reserved, sql99:
         Keywords.Include ("CURRENT");   --  psql:reserved, sql99:reserved
         Keywords.Include ("CURRENT_DATE");   --  psql:reserved, sql99:reserved
         Keywords.Include ("CURRENT_PATH");   --  psql:reserved, sql99:
         Keywords.Include ("CURRENT_ROLE");   --  psql:reserved, sql99:
         Keywords.Include ("CURRENT_TIME");   --  psql:reserved, sql99:reserved
         Keywords.Include ("CURRENT_TIMESTAMP");   --  psql:res., sql99:res.
         Keywords.Include ("CURRENT_USER");   --  psql:reserved, sql99:reserved
         Keywords.Include ("CURSOR");   --  psql:non, sql99:reserved
         Keywords.Include ("CURSOR_NAME");   --  psql:non, sql99:non
         Keywords.Include ("CYCLE");   --  psql:non, sql99:reserved
         Keywords.Include ("DATA");   --  psql:reserved, sql99:non
         Keywords.Include ("DATABASE");   --  psql:non, sql99:
         Keywords.Include ("DATE");   --  psql:reserved, sql99:reserved
         Keywords.Include ("DATETIME_INTERVAL_CODE");   --  psql:non, sql99:non
         Keywords.Include ("DATETIME_INTERVAL_PRECISION");  --  psql:n, sql99:n
         Keywords.Include ("DAY");   --  psql:non, sql99:reserved
         Keywords.Include ("DEALLOCATE");   --  psql:non, sql99:reserved
         Keywords.Include ("DEC");   --  psql:non, sql99:(cannot
         Keywords.Include ("DECIMAL");   --  psql:non, sql99:(cannot
         Keywords.Include ("DECLARE");   --  psql:non, sql99:reserved
         Keywords.Include ("DEFAULT");   --  psql:reserved, sql99:reserved
         Keywords.Include ("DEFERRABLE");   --  psql:reserved, sql99:reserved
         Keywords.Include ("DEFERRED");   --  psql:non, sql99:reserved
         Keywords.Include ("DEFINED");   --  psql:non, sql99:
         Keywords.Include ("DEFINER");   --  psql:non, sql99:non
         Keywords.Include ("DELETE");   --  psql:non, sql99:reserved
         Keywords.Include ("DELIMITER");   --  psql:non, sql99:
         Keywords.Include ("DELIMITERS");   --  psql:non, sql99:
         Keywords.Include ("DEPTH");   --  psql:reserved, sql99:
         Keywords.Include ("DEREF");   --  psql:reserved, sql99:
         Keywords.Include ("DESC");   --  psql:reserved, sql99:reserved
         Keywords.Include ("DESCRIBE");   --  psql:reserved, sql99:reserved
         Keywords.Include ("DESCRIPTOR");   --  psql:reserved, sql99:reserved
         Keywords.Include ("DESTROY");   --  psql:reserved, sql99:
         Keywords.Include ("DESTRUCTOR");   --  psql:reserved, sql99:
         Keywords.Include ("DETERMINISTIC");   --  psql:reserved, sql99:
         Keywords.Include ("DIAGNOSTICS");   --  psql:reserved, sql99:reserved
         Keywords.Include ("DICTIONARY");   --  psql:reserved, sql99:
         Keywords.Include ("DISCONNECT");   --  psql:reserved, sql99:reserved
         Keywords.Include ("DISPATCH");   --  psql:non, sql99:
         Keywords.Include ("DISTINCT");   --  psql:reserved, sql99:reserved
         Keywords.Include ("DO");   --  psql:reserved, sql99:
         Keywords.Include ("DOMAIN");   --  psql:non, sql99:reserved
         Keywords.Include ("DOUBLE");   --  psql:non, sql99:reserved
         Keywords.Include ("DROP");   --  psql:non, sql99:reserved
         Keywords.Include ("DYNAMIC");   --  psql:reserved, sql99:
         Keywords.Include ("DYNAMIC_FUNCTION");   --  psql:non, sql99:non
         Keywords.Include ("DYNAMIC_FUNCTION_CODE");   --  psql:non, sql99:
         Keywords.Include ("EACH");   --  psql:non, sql99:reserved
         Keywords.Include ("ELSE");   --  psql:reserved, sql99:reserved
         Keywords.Include ("ENCODING");   --  psql:non, sql99:
         Keywords.Include ("ENCRYPTED");   --  psql:non, sql99:
         Keywords.Include ("END");   --  psql:reserved, sql99:reserved
         Keywords.Include ("END-EXEC");   --  psql:reserved, sql99:reserved
         Keywords.Include ("EQUALS");   --  psql:reserved, sql99:
         Keywords.Include ("ESCAPE");   --  psql:non, sql99:reserved
         Keywords.Include ("EVERY");   --  psql:reserved, sql99:
         Keywords.Include ("EXCEPT");   --  psql:reserved, sql99:reserved
         Keywords.Include ("EXCEPTION");   --  psql:reserved, sql99:reserved
         Keywords.Include ("EXCLUSIVE");   --  psql:non, sql99:
         Keywords.Include ("EXEC");   --  psql:reserved, sql99:reserved
         Keywords.Include ("EXECUTE");   --  psql:non, sql99:reserved
         Keywords.Include ("EXISTING");   --  psql:non, sql99:
         Keywords.Include ("EXISTS");   --  psql:non, sql99:(cannot
         Keywords.Include ("EXPLAIN");   --  psql:non, sql99:
         Keywords.Include ("EXTERNAL");   --  psql:non, sql99:reserved
         Keywords.Include ("EXTRACT");   --  psql:non, sql99:(cannot
         Keywords.Include ("FALSE");   --  psql:reserved, sql99:reserved
         Keywords.Include ("FETCH");   --  psql:non, sql99:reserved
         Keywords.Include ("FINAL");   --  psql:non, sql99:
         Keywords.Include ("FIRST");   --  psql:reserved, sql99:reserved
         Keywords.Include ("FLOAT");   --  psql:non, sql99:(cannot
         Keywords.Include ("FOR");   --  psql:reserved, sql99:reserved
         Keywords.Include ("FORCE");   --  psql:non, sql99:
         Keywords.Include ("FOREIGN");   --  psql:reserved, sql99:reserved
         Keywords.Include ("FORTRAN");   --  psql:non, sql99:non
         Keywords.Include ("FORWARD");   --  psql:non, sql99:
         Keywords.Include ("FOUND");   --  psql:reserved, sql99:reserved
         Keywords.Include ("FREE");   --  psql:reserved, sql99:
         Keywords.Include ("FREEZE");   --  psql:reserved, sql99:(can
         Keywords.Include ("FROM");   --  psql:reserved, sql99:reserved
         Keywords.Include ("FULL");   --  psql:reserved, sql99:(can
         Keywords.Include ("FUNCTION");   --  psql:non, sql99:reserved
         Keywords.Include ("G");   --  psql:non, sql99:
         Keywords.Include ("GENERAL");   --  psql:reserved, sql99:
         Keywords.Include ("GENERATED");   --  psql:non, sql99:
         Keywords.Include ("GET");   --  psql:non, sql99:reserved
         Keywords.Include ("GLOBAL");   --  psql:non, sql99:reserved
         Keywords.Include ("GO");   --  psql:reserved, sql99:reserved
         Keywords.Include ("GOTO");   --  psql:reserved, sql99:reserved
         Keywords.Include ("GRANT");   --  psql:reserved, sql99:reserved
         Keywords.Include ("GRANTED");   --  psql:non, sql99:
         Keywords.Include ("GROUP");   --  psql:reserved, sql99:reserved
         Keywords.Include ("GROUPING");   --  psql:reserved, sql99:
         Keywords.Include ("HANDLER");   --  psql:non, sql99:
         Keywords.Include ("HAVING");   --  psql:reserved, sql99:reserved
         Keywords.Include ("HIERARCHY");   --  psql:non, sql99:
         Keywords.Include ("HOLD");   --  psql:non, sql99:
         Keywords.Include ("HOST");   --  psql:reserved, sql99:
         Keywords.Include ("HOUR");   --  psql:non, sql99:reserved
         Keywords.Include ("IDENTITY");   --  psql:reserved, sql99:reserved
         Keywords.Include ("IGNORE");   --  psql:reserved, sql99:
         Keywords.Include ("ILIKE");   --  psql:reserved, sql99:(can
         Keywords.Include ("IMMEDIATE");   --  psql:non, sql99:reserved
         Keywords.Include ("IMMUTABLE");   --  psql:non, sql99:
         Keywords.Include ("IMPLEMENTATION");   --  psql:non, sql99:
         Keywords.Include ("IMPLICIT");   --  psql:non, sql99:
         Keywords.Include ("IN");   --  psql:reserved, sql99:(can
         Keywords.Include ("INCREMENT");   --  psql:non, sql99:
         Keywords.Include ("INDEX");   --  psql:non, sql99:
         Keywords.Include ("INDICATOR");   --  psql:reserved, sql99:reserved
         Keywords.Include ("INFIX");   --  psql:non, sql99:
         Keywords.Include ("INHERITS");   --  psql:non, sql99:
         Keywords.Include ("INITIALIZE");   --  psql:reserved, sql99:
         Keywords.Include ("INITIALLY");   --  psql:reserved, sql99:reserved
         Keywords.Include ("INNER");   --  psql:reserved, sql99:(can
         Keywords.Include ("INOUT");   --  psql:non, sql99:reserved
         Keywords.Include ("INPUT");   --  psql:non, sql99:reserved
         Keywords.Include ("INSENSITIVE");   --  psql:non, sql99:non
         Keywords.Include ("INSERT");   --  psql:non, sql99:reserved
         Keywords.Include ("INSTANCE");   --  psql:non, sql99:
         Keywords.Include ("INSTANTIABLE");   --  psql:non, sql99:
         Keywords.Include ("INSTEAD");   --  psql:non, sql99:
         Keywords.Include ("INT");   --  psql:non, sql99:(cannot
         Keywords.Include ("INTEGER");   --  psql:non, sql99:(cannot
         Keywords.Include ("INTERSECT");   --  psql:reserved, sql99:reserved
         Keywords.Include ("INTERVAL");   --  psql:non, sql99:(cannot
         Keywords.Include ("INTO");   --  psql:reserved, sql99:reserved
         Keywords.Include ("INVOKER");   --  psql:non, sql99:non
         Keywords.Include ("IS");   --  psql:reserved, sql99:(can
         Keywords.Include ("ISNULL");   --  psql:reserved, sql99:(can
         Keywords.Include ("ISOLATION");   --  psql:non, sql99:reserved
         Keywords.Include ("ITERATE");   --  psql:reserved, sql99:
         Keywords.Include ("JOIN");   --  psql:reserved, sql99:(can
         Keywords.Include ("K");   --  psql:non, sql99:
         Keywords.Include ("KEY");   --  psql:non, sql99:reserved
         Keywords.Include ("KEY_MEMBER");   --  psql:non, sql99:
         Keywords.Include ("KEY_TYPE");   --  psql:non, sql99:
         Keywords.Include ("LANCOMPILER");   --  psql:non, sql99:
         Keywords.Include ("LANGUAGE");   --  psql:non, sql99:reserved
         Keywords.Include ("LARGE");   --  psql:reserved, sql99:
         Keywords.Include ("LAST");   --  psql:reserved, sql99:reserved
         Keywords.Include ("LATERAL");   --  psql:reserved, sql99:
         Keywords.Include ("LEADING");   --  psql:reserved, sql99:reserved
         Keywords.Include ("LEFT");   --  psql:reserved, sql99:(can
         Keywords.Include ("LENGTH");   --  psql:non, sql99:non
         Keywords.Include ("LESS");   --  psql:reserved, sql99:
         Keywords.Include ("LEVEL");   --  psql:non, sql99:reserved
         Keywords.Include ("LIKE");   --  psql:reserved, sql99:(can
         Keywords.Include ("LIMIT");   --  psql:reserved, sql99:reserved
         Keywords.Include ("LISTEN");   --  psql:non, sql99:
         Keywords.Include ("LOAD");   --  psql:non, sql99:
         Keywords.Include ("LOCAL");   --  psql:non, sql99:reserved
         Keywords.Include ("LOCALTIME");   --  psql:reserved, sql99:reserved
         Keywords.Include ("LOCALTIMESTAMP");   --  psql:reserved, sql99:res.
         Keywords.Include ("LOCATION");   --  psql:non, sql99:
         Keywords.Include ("LOCATOR");   --  psql:reserved, sql99:
         Keywords.Include ("LOCK");   --  psql:non, sql99:
         Keywords.Include ("LOWER");   --  psql:non, sql99:reserved
         Keywords.Include ("M");   --  psql:non, sql99:
         Keywords.Include ("MAP");   --  psql:reserved, sql99:
         Keywords.Include ("MATCH");   --  psql:non, sql99:reserved
         Keywords.Include ("MAX");   --  psql:non, sql99:reserved
         Keywords.Include ("MAXVALUE");   --  psql:non, sql99:
         Keywords.Include ("MESSAGE_LENGTH");   --  psql:non, sql99:non
         Keywords.Include ("MESSAGE_OCTET_LENGTH");   --  psql:non, sql99:non
         Keywords.Include ("MESSAGE_TEXT");   --  psql:non, sql99:non
         Keywords.Include ("METHOD");   --  psql:non, sql99:
         Keywords.Include ("MIN");   --  psql:non, sql99:reserved
         Keywords.Include ("MINUTE");   --  psql:non, sql99:reserved
         Keywords.Include ("MINVALUE");   --  psql:non, sql99:
         Keywords.Include ("MOD");   --  psql:non, sql99:
         Keywords.Include ("MODE");   --  psql:non, sql99:
         Keywords.Include ("MODIFIES");   --  psql:reserved, sql99:
         Keywords.Include ("MODIFY");   --  psql:reserved, sql99:
         Keywords.Include ("MODULE");   --  psql:reserved, sql99:reserved
         Keywords.Include ("MONTH");   --  psql:non, sql99:reserved
         Keywords.Include ("MORE");   --  psql:non, sql99:non
         Keywords.Include ("MOVE");   --  psql:non, sql99:
         Keywords.Include ("MUMPS");   --  psql:non, sql99:non
         Keywords.Include ("NAME");   --  psql:non, sql99:non
         Keywords.Include ("NAMES");   --  psql:non, sql99:reserved
         Keywords.Include ("NATIONAL");   --  psql:non, sql99:reserved
         Keywords.Include ("NATURAL");   --  psql:reserved, sql99:(can
         Keywords.Include ("NCHAR");   --  psql:non, sql99:(cannot
         Keywords.Include ("NCLOB");   --  psql:reserved, sql99:
         Keywords.Include ("NEW");   --  psql:reserved, sql99:reserved
         Keywords.Include ("NEXT");   --  psql:non, sql99:reserved
         Keywords.Include ("NO");   --  psql:non, sql99:reserved
         Keywords.Include ("NOCREATEDB");   --  psql:non, sql99:
         Keywords.Include ("NOCREATEUSER");   --  psql:non, sql99:
         Keywords.Include ("NONE");   --  psql:non, sql99:(cannot
         Keywords.Include ("NOT");   --  psql:reserved, sql99:reserved
         Keywords.Include ("NOTHING");   --  psql:non, sql99:
         Keywords.Include ("NOTIFY");   --  psql:non, sql99:
         Keywords.Include ("NOTNULL");   --  psql:reserved, sql99:(can
         Keywords.Include ("NULL");   --  psql:reserved, sql99:reserved
         Keywords.Include ("NULLABLE");   --  psql:non, sql99:non
         Keywords.Include ("NULLIF");   --  psql:non, sql99:(cannot
         Keywords.Include ("NUMBER");   --  psql:non, sql99:non
         Keywords.Include ("NUMERIC");   --  psql:non, sql99:(cannot
         Keywords.Include ("OBJECT");   --  psql:reserved, sql99:
         Keywords.Include ("OCTET_LENGTH");   --  psql:non, sql99:reserved
         Keywords.Include ("OF");   --  psql:non, sql99:reserved
         Keywords.Include ("OFF");   --  psql:reserved, sql99:reserved
         Keywords.Include ("OFFSET");   --  psql:reserved, sql99:
         Keywords.Include ("OIDS");   --  psql:non, sql99:
         Keywords.Include ("OLD");   --  psql:reserved, sql99:reserved
         Keywords.Include ("ON");   --  psql:reserved, sql99:reserved
         Keywords.Include ("ONLY");   --  psql:reserved, sql99:reserved
         Keywords.Include ("OPEN");   --  psql:reserved, sql99:reserved
         Keywords.Include ("OPERATION");   --  psql:reserved, sql99:
         Keywords.Include ("OPERATOR");   --  psql:non, sql99:
         Keywords.Include ("OPTION");   --  psql:non, sql99:reserved
         Keywords.Include ("OPTIONS");   --  psql:non, sql99:
         Keywords.Include ("OR");   --  psql:reserved, sql99:reserved
         Keywords.Include ("ORDER");   --  psql:reserved, sql99:reserved
         Keywords.Include ("ORDINALITY");   --  psql:reserved, sql99:
         Keywords.Include ("OUT");   --  psql:non, sql99:reserved
         Keywords.Include ("OUTER");   --  psql:reserved, sql99:(can
         Keywords.Include ("OUTPUT");   --  psql:reserved, sql99:reserved
         Keywords.Include ("OVERLAPS");   --  psql:reserved, sql99:(can
         Keywords.Include ("OVERLAY");   --  psql:non, sql99:(cannot
         Keywords.Include ("OVERRIDING");   --  psql:non, sql99:
         Keywords.Include ("OWNER");   --  psql:non, sql99:
         Keywords.Include ("PAD");   --  psql:reserved, sql99:reserved
         Keywords.Include ("PARAMETER");   --  psql:reserved, sql99:
         Keywords.Include ("PARAMETERS");   --  psql:reserved, sql99:
         Keywords.Include ("PARAMETER_MODE");   --  psql:non, sql99:
         Keywords.Include ("PARAMETER_NAME");   --  psql:non, sql99:
         Keywords.Include ("PARAMETER_ORDINAL_POSITION");   --  sql99:non
         Keywords.Include ("PARAMETER_SPECIFIC_CATALOG");   --  sql99:non
         Keywords.Include ("PARAMETER_SPECIFIC_NAME");   --  psql:non, sql99:
         Keywords.Include ("PARAMETER_SPECIFIC_SCHEMA");   --  psql:non, sql99:
         Keywords.Include ("PARTIAL");   --  psql:non, sql99:reserved
         Keywords.Include ("PASCAL");   --  psql:non, sql99:non
         Keywords.Include ("PASSWORD");   --  psql:non, sql99:
         Keywords.Include ("PATH");   --  psql:non, sql99:reserved
         Keywords.Include ("PENDANT");   --  psql:non, sql99:
         Keywords.Include ("PLACING");   --  psql:reserved, sql99:
         Keywords.Include ("PLI");   --  psql:non, sql99:non
         Keywords.Include ("POSITION");   --  psql:non, sql99:(cannot
         Keywords.Include ("POSTFIX");   --  psql:reserved, sql99:
         Keywords.Include ("PRECISION");   --  psql:non, sql99:reserved
         Keywords.Include ("PREFIX");   --  psql:reserved, sql99:
         Keywords.Include ("PREORDER");   --  psql:reserved, sql99:
         Keywords.Include ("PREPARE");   --  psql:non, sql99:reserved
         Keywords.Include ("PRESERVE");   --  psql:reserved, sql99:reserved
         Keywords.Include ("PRIMARY");   --  psql:reserved, sql99:reserved
         Keywords.Include ("PRIOR");   --  psql:non, sql99:reserved
         Keywords.Include ("PRIVILEGES");   --  psql:non, sql99:reserved
         Keywords.Include ("PROCEDURAL");   --  psql:non, sql99:
         Keywords.Include ("PROCEDURE");   --  psql:non, sql99:reserved
         Keywords.Include ("PUBLIC");   --  psql:reserved, sql99:reserved
         Keywords.Include ("READ");   --  psql:non, sql99:reserved
         Keywords.Include ("READS");   --  psql:reserved, sql99:
         Keywords.Include ("REAL");   --  psql:non, sql99:(cannot
         Keywords.Include ("RECHECK");   --  psql:non, sql99:
         Keywords.Include ("RECURSIVE");   --  psql:reserved, sql99:
         Keywords.Include ("REF");   --  psql:reserved, sql99:
         Keywords.Include ("REFERENCES");   --  psql:reserved, sql99:reserved
         Keywords.Include ("REFERENCING");   --  psql:reserved, sql99:
         Keywords.Include ("REINDEX");   --  psql:non, sql99:
         Keywords.Include ("RELATIVE");   --  psql:non, sql99:reserved
         Keywords.Include ("RENAME");   --  psql:non, sql99:
         Keywords.Include ("REPEATABLE");   --  psql:non, sql99:non
         Keywords.Include ("REPLACE");   --  psql:non, sql99:
         Keywords.Include ("RESET");   --  psql:non, sql99:
         Keywords.Include ("RESTRICT");   --  psql:non, sql99:reserved
         Keywords.Include ("RESULT");   --  psql:reserved, sql99:
         Keywords.Include ("RETURN");   --  psql:reserved, sql99:
         Keywords.Include ("RETURNED_LENGTH");   --  psql:non, sql99:non
         Keywords.Include ("RETURNED_OCTET_LENGTH");   --  psql:non, sql99:non
         Keywords.Include ("RETURNED_SQLSTATE");   --  psql:non, sql99:non
         Keywords.Include ("RETURNS");   --  psql:non, sql99:reserved
         Keywords.Include ("REVOKE");   --  psql:non, sql99:reserved
         Keywords.Include ("RIGHT");   --  psql:reserved, sql99:(can
         Keywords.Include ("ROLE");   --  psql:reserved, sql99:
         Keywords.Include ("ROLLBACK");   --  psql:non, sql99:reserved
         Keywords.Include ("ROLLUP");   --  psql:reserved, sql99:
         Keywords.Include ("ROUTINE");   --  psql:reserved, sql99:
         Keywords.Include ("ROUTINE_CATALOG");   --  psql:non, sql99:
         Keywords.Include ("ROUTINE_NAME");   --  psql:non, sql99:
         Keywords.Include ("ROUTINE_SCHEMA");   --  psql:non, sql99:
         Keywords.Include ("ROW");   --  psql:non, sql99:(cannot
         Keywords.Include ("ROWS");   --  psql:reserved, sql99:reserved
         Keywords.Include ("ROW_COUNT");   --  psql:non, sql99:non
         Keywords.Include ("RULE");   --  psql:non, sql99:
         Keywords.Include ("SAVEPOINT");   --  psql:reserved, sql99:
         Keywords.Include ("SCALE");   --  psql:non, sql99:non
         Keywords.Include ("SCHEMA");   --  psql:non, sql99:reserved
         Keywords.Include ("SCHEMA_NAME");   --  psql:non, sql99:non
         Keywords.Include ("SCOPE");   --  psql:reserved, sql99:
         Keywords.Include ("SCROLL");   --  psql:non, sql99:reserved
         Keywords.Include ("SEARCH");   --  psql:reserved, sql99:
         Keywords.Include ("SECOND");   --  psql:non, sql99:reserved
         Keywords.Include ("SECTION");   --  psql:reserved, sql99:reserved
         Keywords.Include ("SECURITY");   --  psql:non, sql99:non
         Keywords.Include ("SELECT");   --  psql:reserved, sql99:reserved
         Keywords.Include ("SELF");   --  psql:non, sql99:
         Keywords.Include ("SENSITIVE");   --  psql:non, sql99:
         Keywords.Include ("SEQUENCE");   --  psql:non, sql99:reserved
         Keywords.Include ("SERIALIZABLE");   --  psql:non, sql99:non
         Keywords.Include ("SERVER_NAME");   --  psql:non, sql99:non
         Keywords.Include ("SESSION");   --  psql:non, sql99:reserved
         Keywords.Include ("SESSION_USER");   --  psql:reserved, sql99:reserved
         Keywords.Include ("SET");   --  psql:non, sql99:reserved
         Keywords.Include ("SETOF");   --  psql:non, sql99:(cannot
         Keywords.Include ("SETS");   --  psql:reserved, sql99:
         Keywords.Include ("SHARE");   --  psql:non, sql99:
         Keywords.Include ("SHOW");   --  psql:non, sql99:
         Keywords.Include ("SIMILAR");   --  psql:reserved, sql99:(can
         Keywords.Include ("SIMPLE");   --  psql:non, sql99:non
         Keywords.Include ("SIZE");   --  psql:reserved, sql99:reserved
         Keywords.Include ("SMALLINT");   --  psql:non, sql99:(cannot
         Keywords.Include ("SOME");   --  psql:reserved, sql99:reserved
         Keywords.Include ("SOURCE");   --  psql:non, sql99:
         Keywords.Include ("SPACE");   --  psql:reserved, sql99:reserved
         Keywords.Include ("SPECIFIC");   --  psql:reserved, sql99:
         Keywords.Include ("SPECIFICTYPE");   --  psql:reserved, sql99:
         Keywords.Include ("SPECIFIC_NAME");   --  psql:non, sql99:
         Keywords.Include ("SQL");   --  psql:reserved, sql99:reserved
         Keywords.Include ("SQLCODE");   --  psql:reserved, sql99:
         Keywords.Include ("SQLERROR");   --  psql:reserved, sql99:
         Keywords.Include ("SQLEXCEPTION");   --  psql:reserved, sql99:
         Keywords.Include ("SQLSTATE");   --  psql:reserved, sql99:reserved
         Keywords.Include ("SQLWARNING");   --  psql:reserved, sql99:
         Keywords.Include ("STABLE");   --  psql:non, sql99:
         Keywords.Include ("START");   --  psql:non, sql99:reserved
         Keywords.Include ("STATE");   --  psql:reserved, sql99:
         Keywords.Include ("STATEMENT");   --  psql:non, sql99:reserved
         Keywords.Include ("STATIC");   --  psql:reserved, sql99:
         Keywords.Include ("STATISTICS");   --  psql:non, sql99:
         Keywords.Include ("STDIN");   --  psql:non, sql99:
         Keywords.Include ("STDOUT");   --  psql:non, sql99:
         Keywords.Include ("STORAGE");   --  psql:non, sql99:
         Keywords.Include ("STRICT");   --  psql:non, sql99:
         Keywords.Include ("STRUCTURE");   --  psql:reserved, sql99:
         Keywords.Include ("STYLE");   --  psql:non, sql99:
         Keywords.Include ("SUBCLASS_ORIGIN");   --  psql:non, sql99:non
         Keywords.Include ("SUBLIST");   --  psql:non, sql99:
         Keywords.Include ("SUBSTRING");   --  psql:non, sql99:(cannot
         Keywords.Include ("SUM");   --  psql:non, sql99:reserved
         Keywords.Include ("SYMMETRIC");   --  psql:non, sql99:
         Keywords.Include ("SYSID");   --  psql:non, sql99:
         Keywords.Include ("SYSTEM");   --  psql:non, sql99:
         Keywords.Include ("SYSTEM_USER");   --  psql:reserved, sql99:reserved
         Keywords.Include ("TABLE");   --  psql:reserved, sql99:reserved
         Keywords.Include ("TABLE_NAME");   --  psql:non, sql99:non
         Keywords.Include ("TEMP");   --  psql:non, sql99:
         Keywords.Include ("TEMPLATE");   --  psql:non, sql99:
         Keywords.Include ("TEMPORARY");   --  psql:non, sql99:reserved
         Keywords.Include ("TERMINATE");   --  psql:reserved, sql99:
         Keywords.Include ("THAN");   --  psql:reserved, sql99:
         Keywords.Include ("THEN");   --  psql:reserved, sql99:reserved
         Keywords.Include ("TIME");   --  psql:non, sql99:(cannot
         Keywords.Include ("TIMESTAMP");   --  psql:non, sql99:(cannot
         Keywords.Include ("TIMEZONE_HOUR");   --  psql:reserved, sql99:res.
         Keywords.Include ("TIMEZONE_MINUTE");   --  psql:reserved, sql99:res.
         Keywords.Include ("TO");   --  psql:reserved, sql99:reserved
         Keywords.Include ("TOAST");   --  psql:non, sql99:
         Keywords.Include ("TRAILING");   --  psql:reserved, sql99:reserved
         Keywords.Include ("TRANSACTION");   --  psql:non, sql99:reserved
         Keywords.Include ("TRANSACTIONS_COMMITTED");   --  psql:non, sql99:
         Keywords.Include ("TRANSACTIONS_ROLLED_BACK");   --  psql:non, sql99:
         Keywords.Include ("TRANSACTION_ACTIVE");   --  psql:non, sql99:
         Keywords.Include ("TRANSFORM");   --  psql:non, sql99:
         Keywords.Include ("TRANSFORMS");   --  psql:non, sql99:
         Keywords.Include ("TRANSLATE");   --  psql:non, sql99:reserved
         Keywords.Include ("TRANSLATION");   --  psql:reserved, sql99:reserved
         Keywords.Include ("TREAT");   --  psql:non, sql99:(cannot
         Keywords.Include ("TRIGGER");   --  psql:non, sql99:reserved
         Keywords.Include ("TRIGGER_CATALOG");   --  psql:non, sql99:
         Keywords.Include ("TRIGGER_NAME");   --  psql:non, sql99:
         Keywords.Include ("TRIGGER_SCHEMA");   --  psql:non, sql99:
         Keywords.Include ("TRIM");   --  psql:non, sql99:(cannot
         Keywords.Include ("TRUE");   --  psql:reserved, sql99:reserved
         Keywords.Include ("TRUNCATE");   --  psql:non, sql99:
         Keywords.Include ("TRUSTED");   --  psql:non, sql99:
         Keywords.Include ("TYPE");   --  psql:non, sql99:non
         Keywords.Include ("UNCOMMITTED");   --  psql:non, sql99:non
         Keywords.Include ("UNDER");   --  psql:reserved, sql99:
         Keywords.Include ("UNENCRYPTED");   --  psql:non, sql99:
         Keywords.Include ("UNION");   --  psql:reserved, sql99:reserved
         Keywords.Include ("UNIQUE");   --  psql:reserved, sql99:reserved
         Keywords.Include ("UNKNOWN");   --  psql:non, sql99:reserved
         Keywords.Include ("UNLISTEN");   --  psql:non, sql99:
         Keywords.Include ("UNNAMED");   --  psql:non, sql99:non
         Keywords.Include ("UNNEST");   --  psql:reserved, sql99:
         Keywords.Include ("UNTIL");   --  psql:non, sql99:
         Keywords.Include ("UPDATE");   --  psql:non, sql99:reserved
         Keywords.Include ("UPPER");   --  psql:non, sql99:reserved
         Keywords.Include ("USAGE");   --  psql:non, sql99:reserved
         Keywords.Include ("USER");   --  psql:reserved, sql99:reserved
         Keywords.Include ("USER_DEFINED_TYPE_CATALOG");   --  psql:non, sql99:
         Keywords.Include ("USER_DEFINED_TYPE_NAME");   --  psql:non, sql99:
         Keywords.Include ("USER_DEFINED_TYPE_SCHEMA");   --  psql:non, sql99:
         Keywords.Include ("USING");   --  psql:reserved, sql99:reserved
         Keywords.Include ("VACUUM");   --  psql:non, sql99:
         Keywords.Include ("VALID");   --  psql:non, sql99:
         Keywords.Include ("VALIDATOR");   --  psql:non, sql99:
         Keywords.Include ("VALUE");   --  psql:reserved, sql99:reserved
         Keywords.Include ("VALUES");   --  psql:non, sql99:reserved
         Keywords.Include ("VARCHAR");   --  psql:non, sql99:(cannot
         Keywords.Include ("VARIABLE");   --  psql:reserved, sql99:
         Keywords.Include ("VARYING");   --  psql:non, sql99:reserved
         Keywords.Include ("VERBOSE");   --  psql:reserved, sql99:(can
         Keywords.Include ("VERSION");   --  psql:non, sql99:
         Keywords.Include ("VIEW");   --  psql:non, sql99:reserved
         Keywords.Include ("VOLATILE");   --  psql:non, sql99:
         Keywords.Include ("WHEN");   --  psql:reserved, sql99:reserved
         Keywords.Include ("WHENEVER");   --  psql:reserved, sql99:reserved
         Keywords.Include ("WHERE");   --  psql:reserved, sql99:reserved
         Keywords.Include ("WITH");   --  psql:non, sql99:reserved
         Keywords.Include ("WITHOUT");   --  psql:non, sql99:reserved
         Keywords.Include ("WORK");   --  psql:non, sql99:reserved
         Keywords.Include ("WRITE");   --  psql:non, sql99:reserved
         Keywords.Include ("YEAR");   --  psql:non, sql99:reserved
         Keywords.Include ("ZONE");   --  psql:non, sql99:reserved
      end if;

      --  With postgreSQL, there is also an issue with identifiers using
      --  CamelCase (this is accepted when creating the database, but then
      --  we get an error when creating an index saying that the field does
      --  not exist). So we always convert to lower case.

      if Keywords.Contains (Str)
        or else To_Lower (Str) /= Str
      then
         --  Insert two '"' at start and end, since these names will be quoted
         --  in the generated files.

         return '"' & Str & '"';
      else
         return Str;
      end if;
   end Quote_Keyword;

   -------------------
   -- Free_Dispatch --
   -------------------

   procedure Free_Dispatch (Self : in out Abstract_Table_Description'Class) is
   begin
      Free (Self);
   end Free_Dispatch;

begin
   Register_Field_Mapping (Field_Mapping_Text'(others => <>));
   Register_Field_Mapping (Field_Mapping_Integer'(null record));
   Register_Field_Mapping (Field_Mapping_Autoincrement'(null record));
   Register_Field_Mapping (Field_Mapping_Timestamp'(null record));
   Register_Field_Mapping (Field_Mapping_Float'(null record));
   Register_Field_Mapping (Field_Mapping_Money'(null record));
end GNATCOLL.SQL.Inspect;