a-direct.adb (Duration_To_Time, [...]): New Unchecked_Conversion functions.

2006-02-13  Vincent Celier  <celier@adacore.com>

	* a-direct.adb (Duration_To_Time, OS_Time_To_Long_Integer): New
	Unchecked_Conversion functions.
	(Modification_Time): Use direct conversion of OS_Time to Calendar time
	when OpenVMS returns False.

	* a-dirval-mingw.adb, a-dirval-vms.adb, a-dirval.ads,
	a-dirval.adb (OpenVMS): New Boolean function

From-SVN: r111051

diff --git a/gcc/ada/a-direct.adb b/gcc/ada/a-direct.adb
index 318d10445029c2d26006834d3455e974a5230515..2cd29ed380b8e192bc70781c410c1f0c7153076b 100644 (file)
--- a/gcc/ada/a-direct.adb
+++ b/gcc/ada/a-direct.adb
@@ -34,6 +34,7 @@
 with Ada.Directories.Validity;   use Ada.Directories.Validity;
 with Ada.Strings.Unbounded;      use Ada.Strings.Unbounded;
 with Ada.Unchecked_Deallocation;
+with Ada.Unchecked_Conversion;
 with Ada.Characters.Handling;    use Ada.Characters.Handling;
 
 with GNAT.Directory_Operations;  use GNAT.Directory_Operations;
@@ -45,6 +46,13 @@ with System;
 
 package body Ada.Directories is
 
+   function Duration_To_Time is new
+     Ada.Unchecked_Conversion (Duration, Ada.Calendar.Time);
+   function OS_Time_To_Long_Integer is new
+     Ada.Unchecked_Conversion (OS_Time, Long_Integer);
+   --  These two unchecked conversions are used in function Modification_Time
+   --  to convert an OS_Time to a Calendar.Time.
+
    type Search_Data is record
       Is_Valid      : Boolean := False;
       Name          : Ada.Strings.Unbounded.Unbounded_String;
@@ -54,10 +62,10 @@ package body Ada.Directories is
       Entry_Fetched : Boolean := False;
       Dir_Entry     : Directory_Entry_Type;
    end record;
-   --  Comment required ???
+   --  The current state of a search
 
    Empty_String : constant String := (1 .. 0 => ASCII.NUL);
-   --  Comment required ???
+   --  Empty string, returned by function Extension when there is no extension
 
    procedure Free is new Ada.Unchecked_Deallocation (Search_Data, Search_Ptr);
 
@@ -725,6 +733,8 @@ package body Ada.Directories is
       Minute : Minute_Type;
       Second : Second_Type;
 
+      Result : Ada.Calendar.Time;
+
    begin
       --  First, the invalid cases
 
@@ -733,14 +743,27 @@ package body Ada.Directories is
 
       else
          Date := File_Time_Stamp (Name);
-         --  ???? We need to be able to convert OS_Time to Ada.Calendar.Time
-         --  For now, use the component of the OS_Time to create the
-         --  Calendar.Time value.
 
-         GM_Split (Date, Year, Month, Day, Hour, Minute, Second);
+         --  ??? This implementation should be revisited when AI 00351 has
+         --  implemented.
+
+         if OpenVMS then
+
+            --  On OpenVMS, OS_Time is in local time
 
-         return Ada.Calendar.Time_Of
-           (Year, Month, Day, Duration (Second + 60 * (Minute + 60 * Hour)));
+            GM_Split (Date, Year, Month, Day, Hour, Minute, Second);
+
+            return Ada.Calendar.Time_Of
+              (Year, Month, Day,
+               Duration (Second + 60 * (Minute + 60 * Hour)));
+
+         else
+            --  On Unix and Windows, OS_Time is in GMT
+
+            Result :=
+              Duration_To_Time (Duration (OS_Time_To_Long_Integer (Date)));
+            return Result;
+         end if;
       end if;
    end Modification_Time;
 

diff --git a/gcc/ada/a-dirval-mingw.adb b/gcc/ada/a-dirval-mingw.adb
index 760102c9e1027fc6ae98f67d95706f492545ba75..d08355d0e1f2a5082278c14cb7ccab1ba14ec7a0 100644 (file)
--- a/gcc/ada/a-dirval-mingw.adb
+++ b/gcc/ada/a-dirval-mingw.adb
@@ -153,4 +153,13 @@ package body Ada.Directories.Validity is
       end if;
    end Is_Valid_Simple_Name;
 
+   -------------
+   -- OpenVMS --
+   -------------
+
+   function OpenVMS return Boolean is
+   begin
+      return False;
+   end OpenVMS;
+
 end Ada.Directories.Validity;

diff --git a/gcc/ada/a-dirval-vms.adb b/gcc/ada/a-dirval-vms.adb
index 089f7cdd9e61efbfb58c55d5528b0198232a69c0..9948ea2348c069ec4a215cfec271afd881beab38 100644 (file)
--- a/gcc/ada/a-dirval-vms.adb
+++ b/gcc/ada/a-dirval-vms.adb
@@ -7,7 +7,7 @@
 --                                 B o d y                                  --
 --                              (VMS Version)                               --
 --                                                                          --
---          Copyright (C) 2004 Free Software Foundation, Inc.               --
+--          Copyright (C) 2004-2005 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- --
@@ -180,4 +180,13 @@ package body Ada.Directories.Validity is
       return True;
    end Is_Valid_Simple_Name;
 
+   -------------
+   -- OpenVMS --
+   -------------
+
+   function OpenVMS return Boolean is
+   begin
+      return True;
+   end OpenVMS;
+
 end Ada.Directories.Validity;

diff --git a/gcc/ada/a-dirval.adb b/gcc/ada/a-dirval.adb
index 206af7fc665a8d5d646d1d9598dd77c5a80a702a..d4395e1d15c446e481e20f5e6e3a0d749b9b3ba8 100644 (file)
--- a/gcc/ada/a-dirval.adb
+++ b/gcc/ada/a-dirval.adb
@@ -94,4 +94,13 @@ package body Ada.Directories.Validity is
       return True;
    end Is_Valid_Simple_Name;
 
+   -------------
+   -- OpenVMS --
+   -------------
+
+   function OpenVMS return Boolean is
+   begin
+      return False;
+   end OpenVMS;
+
 end Ada.Directories.Validity;

diff --git a/gcc/ada/a-dirval.ads b/gcc/ada/a-dirval.ads
index 9785f30f7c4bb41a294da6e3e7010cba5faf1afb..b8d5eafc94cfc59c141c5bbd207c5c4f3ab24733 100644 (file)
--- a/gcc/ada/a-dirval.ads
+++ b/gcc/ada/a-dirval.ads
@@ -45,4 +45,7 @@ private package Ada.Directories.Validity is
    function Is_Path_Name_Case_Sensitive return Boolean;
    --  Returns True if file and path names are case-sensitive
 
+   function OpenVMS return Boolean;
+   --  Return True when OS is OpenVMS
+
 end Ada.Directories.Validity;