===================================================================
@@ -14637,6 +14637,8 @@
@menu
* Intrinsic Operators::
+* Compilation_Date::
+* Compilation_Time::
* Enclosing_Entity::
* Exception_Information::
* Exception_Message::
@@ -14694,12 +14696,34 @@
It is also possible to specify such operators for private types, if the
full views are appropriate arithmetic types.
+@node Compilation_Date
+@section Compilation_Date
+@cindex Compilation_Date
+@noindent
+This intrinsic subprogram is used in the implementation of the
+library package @code{GNAT.Source_Info}. The only useful use of the
+intrinsic import in this case is the one in this unit, so an
+application program should simply call the function
+@code{GNAT.Source_Info.Compilation_Date} to obtain the date of
+the current compilation (in local time format MMM DD YYYY).
+
+@node Compilation_Time
+@section Compilation_Time
+@cindex Compilation_Time
+@noindent
+This intrinsic subprogram is used in the implementation of the
+library package @code{GNAT.Source_Info}. The only useful use of the
+intrinsic import in this case is the one in this unit, so an
+application program should simply call the function
+@code{GNAT.Source_Info.Compilation_Time} to obtain the time of
+the current compilation (in local time format HH:MM:SS).
+
@node Enclosing_Entity
@section Enclosing_Entity
@cindex Enclosing_Entity
@noindent
This intrinsic subprogram is used in the implementation of the
-library routine @code{GNAT.Source_Info}. The only useful use of the
+library package @code{GNAT.Source_Info}. The only useful use of the
intrinsic import in this case is the one in this unit, so an
application program should simply call the function
@code{GNAT.Source_Info.Enclosing_Entity} to obtain the name of
@@ -14710,7 +14734,7 @@
@cindex Exception_Information'
@noindent
This intrinsic subprogram is used in the implementation of the
-library routine @code{GNAT.Current_Exception}. The only useful
+library package @code{GNAT.Current_Exception}. The only useful
use of the intrinsic import in this case is the one in this unit,
so an application program should simply call the function
@code{GNAT.Current_Exception.Exception_Information} to obtain
@@ -14721,7 +14745,7 @@
@cindex Exception_Message
@noindent
This intrinsic subprogram is used in the implementation of the
-library routine @code{GNAT.Current_Exception}. The only useful
+library package @code{GNAT.Current_Exception}. The only useful
use of the intrinsic import in this case is the one in this unit,
so an application program should simply call the function
@code{GNAT.Current_Exception.Exception_Message} to obtain
@@ -14732,7 +14756,7 @@
@cindex Exception_Name
@noindent
This intrinsic subprogram is used in the implementation of the
-library routine @code{GNAT.Current_Exception}. The only useful
+library package @code{GNAT.Current_Exception}. The only useful
use of the intrinsic import in this case is the one in this unit,
so an application program should simply call the function
@code{GNAT.Current_Exception.Exception_Name} to obtain
@@ -14743,7 +14767,7 @@
@cindex File
@noindent
This intrinsic subprogram is used in the implementation of the
-library routine @code{GNAT.Source_Info}. The only useful use of the
+library package @code{GNAT.Source_Info}. The only useful use of the
intrinsic import in this case is the one in this unit, so an
application program should simply call the function
@code{GNAT.Source_Info.File} to obtain the name of the current
@@ -14754,7 +14778,7 @@
@cindex Line
@noindent
This intrinsic subprogram is used in the implementation of the
-library routine @code{GNAT.Source_Info}. The only useful use of the
+library package @code{GNAT.Source_Info}. The only useful use of the
intrinsic import in this case is the one in this unit, so an
application program should simply call the function
@code{GNAT.Source_Info.Line} to obtain the number of the current
@@ -20172,7 +20196,9 @@
@noindent
Provides subprograms that give access to source code information known at
-compile time, such as the current file name and line number.
+compile time, such as the current file name and line number. Also provides
+subprograms yielding the date and time of the current compilation (like the
+C macros @code{__DATE__} and @code{__TIME__})
@node GNAT.Spelling_Checker (g-speche.ads)
@section @code{GNAT.Spelling_Checker} (@file{g-speche.ads})
===================================================================
@@ -362,8 +362,12 @@
-- Source_Location and navigation functions
- elsif Nam_In (Nam, Name_File, Name_Line, Name_Source_Location,
- Name_Enclosing_Entity)
+ elsif Nam_In (Nam, Name_File,
+ Name_Line,
+ Name_Source_Location,
+ Name_Enclosing_Entity,
+ Name_Compilation_Date,
+ Name_Compilation_Time)
then
null;
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 2000-2014, Free Software Foundation, 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- --
@@ -46,15 +46,18 @@
-- Historical note: this used to be Pure, but that was when we marked all
-- intrinsics as not Pure, even in Pure units, so no problems arose.
- function File return String;
+ function File return String with
+ Import, Convention => Intrinsic;
-- Return the name of the current file, not including the path information.
-- The result is considered to be a static string constant.
- function Line return Positive;
+ function Line return Positive with
+ Import, Convention => Intrinsic;
-- Return the current input line number. The result is considered to be a
-- static expression.
- function Source_Location return String;
+ function Source_Location return String with
+ Import, Convention => Intrinsic;
-- Return a string literal of the form "name:line", where name is the
-- current source file name without path information, and line is the
-- current line number. In the event that instantiations are involved,
@@ -62,7 +65,8 @@
-- string " instantiated at ". The result is considered to be a static
-- string constant.
- function Enclosing_Entity return String;
+ function Enclosing_Entity return String with
+ Import, Convention => Intrinsic;
-- Return the name of the current subprogram, package, task, entry or
-- protected subprogram. The string is in exactly the form used for the
-- declaration of the entity (casing and encoding conventions), and is
@@ -75,9 +79,14 @@
-- package itself. This is useful in identifying and logging information
-- from within generic templates.
-private
- pragma Import (Intrinsic, File);
- pragma Import (Intrinsic, Line);
- pragma Import (Intrinsic, Source_Location);
- pragma Import (Intrinsic, Enclosing_Entity);
+ function Compilation_Date return String with
+ Import, Convention => Intrinsic;
+ -- Returns date of compilation as a static string "mmm dd yyyy". This is
+ -- in local time form, and is exactly compatible with C macro __DATE__.
+
+ function Compilation_Time return String with
+ Import, Convention => Intrinsic;
+ -- Returns GMT time of compilation as a static string "hh:mm:ss". This is
+ -- in local time form, and is exactly compatible with C macro __TIME__.
+
end GNAT.Source_Info;
===================================================================
@@ -151,7 +151,7 @@
-- d4 Inhibit automatic krunch of predefined library unit files
-- d5 Debug output for tree read/write
-- d6 Default access unconstrained to thin pointers
- -- d7 Do not output version & file time stamp in -gnatv or -gnatl mode
+ -- d7 Suppress version/source stamp/compilation time for -gnatv/-gnatl
-- d8 Force opposite endianness in packed stuff
-- d9 Allow lock free implementation
@@ -721,10 +721,11 @@
-- implications of using thin pointers, and also to test that the
-- compiler functions correctly with this choice.
- -- d7 Normally a -gnatl or -gnatv listing includes the time stamp
- -- of the source file. This debug flag suppresses this output,
- -- and also suppresses the message with the version number.
- -- This is useful in certain regression tests.
+ -- d7 Normally a -gnatl or -gnatv listing includes the time stamp of the
+ -- source file and the time of the compilation. This debug flag can
+ -- be used to suppress this output, and also suppresses the message
+ -- with the version of the compiler. This is useful for regression
+ -- tests which need to have consistent output.
-- d8 This forces the packed stuff to generate code assuming the
-- opposite endianness from the actual correct value. Useful in
===================================================================
@@ -82,6 +82,7 @@
with Validsw; use Validsw;
with System.Assertions;
+with System.OS_Lib;
--------------
-- Gnat1drv --
@@ -838,6 +839,10 @@
Sem_Eval.Initialize;
Sem_Type.Init_Interp_Tables;
+ -- Capture compilation date and time
+
+ Opt.Compilation_Time := System.OS_Lib.Current_Time_String;
+
-- Acquire target parameters from system.ads (source of package System)
Targparm_Acquire : declare
===================================================================
@@ -1761,9 +1761,11 @@
Write_Name (Full_File_Name (Sfile));
if not Debug_Flag_7 then
- Write_Str (" (source file time stamp: ");
+ Write_Eol;
+ Write_Str ("Source file time stamp: ");
Write_Time_Stamp (Sfile);
- Write_Char (')');
+ Write_Eol;
+ Write_Str ("Compiled at: " & Compilation_Time);
end if;
Write_Eol;
===================================================================
@@ -366,14 +366,17 @@
-- True if source lines removed by the preprocessor should be commented
-- in the output file.
+ Compilation_Time : String (1 .. 19);
+ -- GNAT
+ -- Compilation date and time in form YYYY-MM-DD HH:MM:SS
+
Compile_Only : Boolean := False;
-- GNATMAKE, GNATCLEAN, GPRMAKE, GPBUILD, GPRCLEAN
-- GNATMAKE, GPRMAKE, GPRMAKE:
- -- set to True to skip bind and link steps (except when Bind_Only is
- -- True).
+ -- set True to skip bind and link steps (except when Bind_Only is True)
-- GNATCLEAN, GPRCLEAN:
- -- set to True to delete only the files produced by the compiler but not
- -- the library files or the executable files.
+ -- set True to delete only the files produced by the compiler but not the
+ -- library files or the executable files.
Compiler_Unit : Boolean := False;
-- GNAT1
@@ -772,11 +775,12 @@
-- use of pragma Implicit_Packing.
Ineffective_Inline_Warnings : Boolean := False;
- -- GNAT Set True to activate warnings if front-end inlining (-gnatN) is
- -- not able to actually inline a particular call (or all calls). Can be
- -- controlled by use of -gnatwp/-gnatwP. Also set True to activate warnings
- -- if frontend inlining is not able to inline a subprogram expected to be
- -- inlined in GNATprove mode.
+ -- GNAT
+ -- Set True to activate warnings if front-end inlining (-gnatN) is not able
+ -- to actually inline a particular call (or all calls). Can be controlled
+ -- by use of -gnatwp/-gnatwP. Also set True to activate warnings if
+ -- frontend inlining is not able to inline a subprogram expected to
+ -- be inlined in GNATprove mode.
Init_Or_Norm_Scalars : Boolean := False;
-- GNAT, GANTBIND
===================================================================
@@ -109,10 +109,12 @@
procedure Expand_Source_Info (N : Node_Id; Nam : Name_Id);
-- Rewrite the node by the appropriate string or positive constant.
-- Nam can be one of the following:
- -- Name_File - expand string that is the name of source file
- -- Name_Line - expand integer line number
- -- Name_Source_Location - expand string of form file:line
- -- Name_Enclosing_Entity - expand string with name of enclosing entity
+ -- Name_File - expand string name of source file
+ -- Name_Line - expand integer line number
+ -- Name_Source_Location - expand string of form file:line
+ -- Name_Enclosing_Entity - expand string name of enclosing entity
+ -- Name_Compilation_Date - expand string with compilation date
+ -- Name_Compilation_Time - expand string with compilation time
---------------------------------
-- Expand_Binary_Operator_Call --
@@ -557,7 +559,9 @@
elsif Nam_In (Nam, Name_File,
Name_Line,
Name_Source_Location,
- Name_Enclosing_Entity)
+ Name_Enclosing_Entity,
+ Name_Compilation_Date,
+ Name_Compilation_Time)
then
Expand_Source_Info (N, Nam);
@@ -806,6 +810,35 @@
Write_Entity_Name (Ent);
+ when Name_Compilation_Date =>
+ declare
+ subtype S13 is String (1 .. 3);
+ Months : constant array (1 .. 12) of S13 :=
+ ("Jan", "Feb", "Mar", "Apr", "May", "Jun",
+ "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
+
+ M1 : constant Character := Opt.Compilation_Time (6);
+ M2 : constant Character := Opt.Compilation_Time (7);
+
+ MM : constant Natural range 1 .. 12 :=
+ (Character'Pos (M1) - Character'Pos ('0')) * 10 +
+ (Character'Pos (M2) - Character'Pos ('0'));
+
+ begin
+ -- Reformat ISO date into MMM DD YYYY (__DATE__) format
+
+ Name_Buffer (1 .. 3) := Months (MM);
+ Name_Buffer (4) := ' ';
+ Name_Buffer (5 .. 6) := Opt.Compilation_Time (9 .. 10);
+ Name_Buffer (7) := ' ';
+ Name_Buffer (8 .. 11) := Opt.Compilation_Time (1 .. 4);
+ Name_Len := 11;
+ end;
+
+ when Name_Compilation_Time =>
+ Name_Buffer (1 .. 8) := Opt.Compilation_Time (12 .. 19);
+ Name_Len := 8;
+
when others =>
raise Program_Error;
end case;
===================================================================
@@ -1187,6 +1187,8 @@
-- convention name. So is To_Address, which is a GNAT attribute.
First_Intrinsic_Name : constant Name_Id := N + $;
+ Name_Compilation_Date : constant Name_Id := N + $;
+ Name_Compilation_Time : constant Name_Id := N + $;
Name_Divide : constant Name_Id := N + $;
Name_Enclosing_Entity : constant Name_Id := N + $;
Name_Exception_Information : constant Name_Id := N + $;
===================================================================
@@ -888,6 +888,26 @@
end loop File_Loop;
end Create_Temp_File_Internal;
+ -------------------------
+ -- Current_Time_String --
+ -------------------------
+
+ function Current_Time_String return String is
+ subtype S23 is String (1 .. 23);
+ -- Holds current time in ISO 8601 format YYYY-MM-DD HH:MM:SS.SS + NUL
+
+ procedure Current_Time_String (Time : System.Address);
+ pragma Import (C, Current_Time_String, "__gnat_current_time_string");
+ -- Puts current time into Time in above ISO 8601 format
+
+ Result23 : aliased S23;
+ -- Current time in ISO 8601 format
+
+ begin
+ Current_Time_String (Result23'Address);
+ return Result23 (1 .. 19);
+ end Current_Time_String;
+
-----------------
-- Delete_File --
-----------------
===================================================================
@@ -101,14 +101,14 @@
---------------------
type OS_Time is private;
- -- The OS's notion of time is represented by the private type OS_Time.
- -- This is the type returned by the File_Time_Stamp functions to obtain
- -- the time stamp of a specified file. Functions and a procedure (modeled
- -- after the similar subprograms in package Calendar) are provided for
- -- extracting information from a value of this type. Although these are
- -- called GM, the intention is not that they provide GMT times in all
- -- cases but rather the actual (time-zone independent) time stamp of the
- -- file (of course in Unix systems, this *is* in GMT form).
+ -- The OS's notion of time is represented by the private type OS_Time. This
+ -- is the type returned by the File_Time_Stamp functions to obtain the time
+ -- stamp of a specified file. Functions and a procedure (modeled after the
+ -- similar subprograms in package Calendar) are provided for extracting
+ -- information from a value of this type. Although these are called GM, the
+ -- intention in the case of time stamps is not that they provide GMT times
+ -- in all cases but rather the actual (time-zone independent) time stamp of
+ -- the file (of course in Unix systems, this *is* in GMT form).
Invalid_Time : constant OS_Time;
-- A special unique value used to flag an invalid time stamp value
@@ -130,7 +130,7 @@
function GM_Hour (Date : OS_Time) return Hour_Type;
function GM_Minute (Date : OS_Time) return Minute_Type;
function GM_Second (Date : OS_Time) return Second_Type;
- -- Functions to extract information from OS_Time value
+ -- Functions to extract information from OS_Time value in GMT form
function "<" (X, Y : OS_Time) return Boolean;
function ">" (X, Y : OS_Time) return Boolean;
@@ -163,6 +163,10 @@
-- component parts and returns an OS_Time. Returns Invalid_Time if the
-- creation fails.
+ function Current_Time_String return String;
+ -- Returns current local time in the form YYYY-MM-DD HH:MM:SS. The result
+ -- has bounds 1 .. 19.
+
----------------
-- File Stuff --
----------------
This patch causes the compiler to print the compilation time in -gnatv or -gnatl mode (suppressible with debug flag -gnatd7). It also provides new functions in GNAT.Source_Info to obtain the compilation date and time (in a form compatible with the use of the C macros __DATE__ and __TIME__. Finally a new function System.OS_Lib.Current_Time_String is introduced (and used by the compiler to implement the above). The following test is compiled with -gnatl: Compiling: ctime.adb Source file time stamp: 2014-04-04 14:00:32 Compiled at: 2014-04-04 10:03:24 1. with Text_IO; use Text_IO; 2. with GNAT.Source_Info; use GNAT.Source_Info; 3. procedure Ctime is 4. begin 5. Put_Line (Compilation_Date); 6. Put_Line (Compilation_Time); 7. end; When run, the output is: Jul 30 2014 10:03:24 Note: by its very nature, the above test is not suitable as a standard regression test since of course its output changes each time it is run. Tested on x86_64-pc-linux-gnu, committed on trunk 2014-07-30 Robert Dewar <dewar@adacore.com> * debug.adb: Document that d7 suppresses compilation time output. * errout.adb (Write_Header): Include compilation time in header output. * exp_intr.adb (Expand_Intrinsic_Call): Add Compilation_Date/Compilation_Time (Expand_Source_Info): Expand Compilation_Date/Compilation_Time. * g-souinf.ads (Compilation_Date): New function (Compilation_Time): New function. * gnat1drv.adb (Gnat1drv): Set Opt.Compilation_Time. * gnat_rm.texi (Compilation_Date): New function (Compilation_Time): New function. * opt.ads (Compilation_Time): New variable. * s-os_lib.ads, s-os_lib.adb (Current_Time_String): New function. * sem_intr.adb (Compilation_Date): New function. (Compilation_Time): New function. * snames.ads-tmpl (Name_Compilation_Date): New entry. (Name_Compilation_Time): New entry.