------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                                 M L I B                                  --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--           Copyright (C) 1999-2003, Ada Core Technologies, Inc.           --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Characters.Handling; use Ada.Characters.Handling;

with Hostparm;
with Opt;
with Output; use Output;
with Namet;  use Namet;

with MLib.Utl; use MLib.Utl;

with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.OS_Lib;               use GNAT.OS_Lib;

package body MLib is

   Preserve : Attribute := Time_Stamps;
   --  Used by Copy_ALI_Files.
   --  Changed to None for OpenVMS, because Copy_Attributes always fails
   --  on VMS.

   -------------------
   -- Build_Library --
   -------------------

   procedure Build_Library
     (Ofiles      : Argument_List;
      Afiles      : Argument_List;
      Output_File : String;
      Output_Dir  : String)
   is
      pragma Warnings (Off, Afiles);

      use GNAT.OS_Lib;

   begin
      if not Opt.Quiet_Output then
         Write_Line ("building a library...");
         Write_Str  ("   make ");
         Write_Line (Output_File);
      end if;

      Ar (Output_Dir & "/lib" & Output_File & ".a", Objects => Ofiles);
   end Build_Library;

   ------------------------
   -- Check_Library_Name --
   ------------------------

   procedure Check_Library_Name (Name : String) is
   begin
      if Name'Length = 0 then
         Fail ("library name cannot be empty");
      end if;

      if Name'Length > Max_Characters_In_Library_Name then
         Fail ("illegal library name """, Name, """: too long");
      end if;

      if not Is_Letter (Name (Name'First)) then
         Fail ("illegal library name """,
               Name,
               """: should start with a letter");
      end if;

      for Index in Name'Range loop
         if not Is_Alphanumeric (Name (Index)) then
            Fail ("illegal library name """,
                  Name,
                  """: should include only letters and digits");
         end if;
      end loop;
   end Check_Library_Name;

   --------------------
   -- Copy_ALI_Files --
   --------------------

   procedure Copy_ALI_Files
     (From       : Name_Id;
      To         : Name_Id;
      Interfaces : String_List)
   is
      Dir       : Dir_Type;
      Name      : String (1 .. 1_024);
      Last      : Natural;
      Success   : Boolean := False;
      From_Dir  : constant String := Get_Name_String (From);
      To_Dir    : constant String := Get_Name_String (To);
      Interface : Boolean := False;

   begin
      Open (Dir, From_Dir);

      loop
         Read (Dir, Name, Last);
         exit when Last = 0;

         Canonical_Case_File_Name (Name (1 .. Last));

         Success := False;

         if Last > 4 and then Name (Last - 3 .. Last) = ".ali" then
            if Opt.Verbose_Mode then
               Write_Str ("copy ");
               Write_Str (From_Dir & Directory_Separator & Name (1 .. Last));
               Write_Char (' ');
               Write_Line (To_Dir);
            end if;

            if Interfaces'Length = 0 then

               --  If there are no Interfaces, copy all the ALI files as is

               Copy_File
                 (From_Dir & Directory_Separator & Name (1 .. Last),
                  To_Dir,
                  Success,
                  Mode => Overwrite,
                  Preserve => Preserve);

            else
               --  Check if this is one of the interface ALIs

               Interface := False;

               for Index in Interfaces'Range loop
                  if Name (1 .. Last) = Interfaces (Index).all then
                     Interface := True;
                     exit;
                  end if;
               end loop;

               --  If it is an interface ALI, copy line by line. Insert
               --  the interface indication at the end of the P line.
               --  Do not copy ALI files that are not Interfaces.

               if Interface then
                  Success := False;

                  declare
                     FD         : File_Descriptor;
                     Len        : Integer;
                     Actual_Len : Integer;
                     S          : String_Access;
                     Curr       : Natural;
                     P_Line_Found : Boolean;

                  begin
                     --  Open the file

                     Name_Len := From_Dir'Length;
                     Name_Buffer (1 .. Name_Len) := From_Dir;
                     Name_Len := Name_Len + 1;
                     Name_Buffer (Name_Len) := Directory_Separator;
                     Name_Buffer (Name_Len + 1 .. Name_Len + Last) :=
                       Name (1 .. Last);
                     Name_Len := Name_Len + Last + 1;
                     Name_Buffer (Name_Len) := ASCII.NUL;

                     FD := Open_Read (Name_Buffer'Address, Binary);

                     if FD /= Invalid_FD then
                        Len := Integer (File_Length (FD));

                        S := new String (1 .. Len + 3);

                        --  Read the file. Note that the loop is not necessary
                        --  since the whole file is read at once except on VMS.

                        Curr := 1;
                        Actual_Len := Len;

                        while Actual_Len /= 0 loop
                           Actual_Len := Read (FD, S (Curr)'Address, Len);
                           Curr := Curr + Actual_Len;
                        end loop;

                        --  We are done with the input file, so we close it

                        Close (FD);

                        P_Line_Found := False;

                        --  Look for the P line. When found, add marker SL
                        --  at the beginning of the P line.

                        for Index in 1 .. Len - 3 loop
                           if (S (Index) = ASCII.LF or else
                                 S (Index) = ASCII.CR)
                             and then
                               S (Index + 1) = 'P'
                           then
                              S (Index + 5 .. Len + 3) := S (Index + 2 .. Len);
                              S (Index + 2 .. Index + 4) := " SL";
                              P_Line_Found := True;
                              exit;
                           end if;
                        end loop;

                        if P_Line_Found then

                           --  Create new modified ALI file

                           Name_Len := To_Dir'Length;
                           Name_Buffer (1 .. Name_Len) := To_Dir;
                           Name_Len := Name_Len + 1;
                           Name_Buffer (Name_Len) := Directory_Separator;
                           Name_Buffer (Name_Len + 1 .. Name_Len + Last) :=
                             Name (1 .. Last);
                           Name_Len := Name_Len + Last + 1;
                           Name_Buffer (Name_Len) := ASCII.NUL;

                           FD := Create_File (Name_Buffer'Address, Binary);

                           --  Write the modified text and close the newly
                           --  created file.

                           if FD /= Invalid_FD then
                              Actual_Len := Write (FD, S (1)'Address, Len + 3);

                              Close (FD);

                              --  Set Success to True only if the newly
                              --  created file has been correctly written.

                              Success := Actual_Len = Len + 3;
                           end if;
                        end if;
                     end if;
                  end;

               else
                  --  This is not an interface ALI

                  Success := True;

               end if;
            end if;

            if not Success then
               Fail ("could not copy ALI files to library dir");
            end if;
         end if;
      end loop;
   end Copy_ALI_Files;

--  Package elaboration

begin
   if Hostparm.OpenVMS then

      --  Copy_Attributes always fails on VMS

      Preserve := None;
   end if;
end MLib;
