------------------------------------------------------------------------------
--                                  G P S                                   --
--                                                                          --
--                     Copyright (C) 2010-2014, 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.                            --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
-- 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/>.                                          --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Strings.Unbounded;     use Ada.Strings.Unbounded;
with Asserts;                   use Asserts;
with GNATCOLL.Projects;         use GNATCOLL.Projects;
with GNATCOLL.VFS;              use GNATCOLL.VFS;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.IO;                   use GNAT.IO;
with GNAT.Strings;              use GNAT.Strings;
with Test_Projects_Support;     use Test_Projects_Support;

procedure Test_Projects is
   procedure Display_Error (Msg : String);
   procedure Capture_Error (Msg : String);

   procedure Display_Error (Msg : String) is
   begin
      Put_Line ("Error while loading project: " & Msg);
   end Display_Error;

   Errors : Unbounded_String;

   procedure Capture_Error (Msg : String) is
   begin
      Append (Errors, Msg);
   end Capture_Error;

   Env      : Project_Environment_Access;
   Tree     : My_Project_Tree;
   Prj2     : Project_Type;
   Src2     : Virtual_File;
   Projects : Virtual_File;
   F        : Virtual_File;
   Reloaded : Boolean;
   Info     : File_Info;
   Switches : String_List_Access;
   Is_Default : Boolean;

begin
   Asserts.Set_Module ("Projects");

   Initialize (Env);

   --  Loading invalid project

   begin
      Tree.Load (Create ("invalid.gpr"), Env => Env,
                 Errors => Capture_Error'Unrestricted_Access);
      Assert (False, "Should have raised exception while loading invalid");
   exception
      when Invalid_Project =>
         Assert (Errors,
                 "invalid.gpr:5:08: undefined attribute ""object_dirwrong"""
                 & ASCII.LF,
                 "Expected errors when loading project");
   end;

   --  Loading valid project

   Tree.Load (Create ("prj.gpr"), Env => Env,
              Errors => Display_Error'Unrestricted_Access);

   Assert (Tree.Root_Project.Name, "Prj", "Name of root project");
   Assert (Tree.Project_From_Name ("Prj2").Name, "Prj2", "Retrieving project");
   Assert (Tree.Project_From_Name ("PRJ2").Name, "Prj2",
           "Retrieving project must be case insensitive");

   Tree.Reload_If_Needed (Reloaded => Reloaded);
   Assert (not Reloaded, "No reload necessary");

   --  Test having our own project data

   Assert (Tree.Root_Project.Data.all in My_Project_Data'Class,
           "Custom project data");

   My_Project_Data (Tree.Root_Project.Data.all).Dummy := 2;
   Assert (My_Project_Data (Tree.Project_From_Name ("prj").Data.all).Dummy,
           2,
           "Retrieving the same custom data");

   --  Iterators

   declare
      Iter : Project_Iterator := Tree.Root_Project.Start (Recursive => True);
      Imported : GNAT.Strings.String_List (1 .. 40);
      Index    : Natural := Imported'First;
   begin
      while Current (Iter) /= No_Project loop
         Imported (Index) := new String'(Current (Iter).Name);
         Index := Index + 1;
         Next (Iter);
      end loop;

      Assert (Index - 1, 3, "Iterator did not return all projects");
      Assert (Imported (1 .. 3),
              (new String'("Prj3"),
               new String'("Prj2"),
               new String'("Prj")),
              "Iterator did not return correct projects");

      Iter := Tree.Root_Project.Start (Recursive => False);
      Index := Imported'First;
      while Current (Iter) /= No_Project loop
         Imported (Index) := new String'(Current (Iter).Name);
         Index := Index + 1;
         Next (Iter);
      end loop;

      Assert (Index - 1, 1, "Non-recursive iterator returned wrong count");
      Assert (Imported (1 .. 1),
              (1 => new String'("Prj")),
              "Non-recursive Iterator did not return correct projects");
   end;

   --  Scenario variables

   declare
      Vars : constant Scenario_Variable_Array := Tree.Scenario_Variables;
   begin
      Assert (Vars'Length, 1, "A single scenario variable");
      Assert (External_Name (Vars (Vars'First)),
              "BUILD", "First scenario var");
      Assert (External_Default (Vars (Vars'First)),
              "Debug", "Default for var");
      Assert (Tree.Possible_Values_Of (Vars (Vars'First)),
              String_List'(1 => new String'("Debug"),
                           2 => new String'("Production")),
              "Possible values for scenario variable");
   end;

   --  Source dirs

   Src2     := Create_From_Dir (Get_Current_Dir, "src2/");
   Projects := Get_Current_Dir;

   Prj2 := Tree.Project_From_Name ("prj2");
   Assert (Prj2.Source_Dirs (Recursive => False), (1 .. 1 => Src2),
           "Direct source dirs for prj2");
   Assert (Prj2.Source_Dirs (Recursive => True),  (1 .. 1 => Src2),
           "Recursive source dirs for prj2");

   Assert (Tree.Root_Project.Source_Dirs (Recursive => False),
           (1 .. 1 => Projects),
           "Direct source dirs for prj2");
   Assert (Tree.Root_Project.Source_Dirs (Recursive => True),
           (1 => Projects, 2 => Src2, 3 => Projects),
           "Recursive source dirs for prj2");

   --  Source files

   Info := Tree.Info (Tree.Create (+"src2/a~b.ads"));

   Assert (Project (Info).Name, "Prj2", "Find project from source file");
   Assert (Unit_Name (Info), "a.b", "Find unit name from Ada file");
   Assert (Language (Info), "ada", "Find language from source file");

   --  Executable names (J501-001)

   Assert (+Tree.Root_Project.Executable_Name
              (Tree.Create ("test_projects_support.ads").Full_Name),
           "test_projects_support",
           "Computing executable name (default case)");
   Assert (+Tree.Root_Project.Executable_Name
              (Tree.Create ("test_projects.adb").Full_Name),
           "testprj",
           "Computing executable name (from Executable attribute)");
   Assert (+Prj2.Executable_Name
              (Tree.Create ("a.ads").Full_Name),
           "a.foo",
           "Computing executable name (using Executable_Suffix)");

   --  Attributes

   Assert (Tree.Root_Project.Languages,
           (1 .. 1 => new String'("ada")),
           "Find languages with default value");

   F := Create ("test_projects.adb");
   Tree.Root_Project.Switches ("compiler", F, "ada", Switches, Is_Default);
   Assert (not Is_Default, "Special switches for test_projects.adb");
   Assert (Switches.all,
           (1 .. 1 => new String'("-g")),
           "switches for test_projects.adb");

   F := Create ("test_projects_support.ads");
   Tree.Root_Project.Switches ("compiler", F, "ada", Switches, Is_Default);
   Assert (Is_Default, "Default switches for test_projects_support.ads");
   Assert (Switches.all,
           (1 .. 1 => new String'("-O1")),
           "switches for test_projects_support.ads");

   Assert (Tree.Root_Project.Attribute_Value (Obj_Dir_Attribute),
           "obj",
           "Object dir for prj.gpr");

   --  Unloading

   Tree.Unload;
   Free (Env);
end Test_Projects;
