------------------------------------------------------------------------------
-- --
-- COMMON ASIS TOOLS COMPONENTS LIBRARY --
-- --
-- A S I S _ U L . O U T P U T --
-- --
-- B o d y --
-- --
-- Copyright (C) 2004-2017, AdaCore --
-- --
-- Asis Utility Library (ASIS UL) 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. ASIS UL is distributed in the hope that it --
-- will be useful, but WITHOUT ANY WARRANTY; without even the implied --
-- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --
-- GNU General Public License for more details. You should have received a --
-- copy of the GNU General Public License distributed with GNAT; see file --
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
-- of the license. --
-- --
-- ASIS UL is maintained by AdaCore (http://www.adacore.com). --
-- --
------------------------------------------------------------------------------
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Utils.Formatted_Output; use Utils.Formatted_Output;
with Utils.Tool_Names;
with Libadalang;
package body Utils.Versions is
-- Much of the following is copied from gnatvsn.ads in the GNAT sources.
Copyright_Holder : constant String := "AdaCore.";
function Gnat_Free_Software return String;
-- Text to be displayed by the different GNAT tools when switch --version
-- is used. This text depends on the GNAT build type.
------------------------
-- Gnat_Free_Software --
------------------------
function Gnat_Free_Software return String is
begin
case Build_Type is
when GPL =>
return "This is free software; see the source for copying conditions." &
ASCII.LF &
"There is NO warranty; not even for MERCHANTABILITY or FITNESS" &
" FOR A PARTICULAR PURPOSE.";
when Gnatpro =>
return "This is free software; see the source for copying conditions." &
ASCII.LF &
"See your AdaCore support agreement for details of warranty" &
" and support." & ASCII.LF &
"If you do not have a current support agreement, then there" &
" is absolutely" & ASCII.LF &
"no warranty; not even for MERCHANTABILITY or FITNESS FOR" &
" A PARTICULAR" & ASCII.LF & "PURPOSE.";
end case;
end Gnat_Free_Software;
------------------------
-- Print_Tool_Version --
------------------------
Initial_Year : constant String := "2004";
-- This is the first year in which any of the sources used by these tools
-- was written.
function Edition return String is
(case Build_Type is when Gnatpro => "Pro", when GPL => "Community");
procedure Print_Tool_Version is
begin
Put
("\1 \2 \3\n", To_Upper (Tool_Names.Tool_Name), Edition,
Libadalang.Version);
Put
("Copyright (C) \1-\2, \3\n", Initial_Year, Libadalang.Current_Year,
Copyright_Holder);
Put ("\1", Gnat_Free_Software);
Put ("\n");
end Print_Tool_Version;
------------------------
-- Print_Version_Info --
------------------------
procedure Print_Version_Info is
begin
Put ("\1 \2 \3\n", Tool_Names.Tool_Name, Edition, Libadalang.Version);
Put
("Copyright (C) \1-\2, \3\n", Initial_Year, Libadalang.Current_Year,
Copyright_Holder);
end Print_Version_Info;
end Utils.Versions;