From 32c65fc062e4ad4f981e4db110436a23f3c8e4f0 Mon Sep 17 00:00:00 2001 From: Vincent Celier Date: Wed, 15 Feb 2006 10:36:23 +0100 Subject: [PATCH] a-direct.adb (Duration_To_Time, [...]): New Unchecked_Conversion functions. 2006-02-13 Vincent Celier * 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 --- gcc/ada/a-direct.adb | 39 ++++++++++++++++++++++++++++++-------- gcc/ada/a-dirval-mingw.adb | 9 +++++++++ gcc/ada/a-dirval-vms.adb | 11 ++++++++++- gcc/ada/a-dirval.adb | 9 +++++++++ gcc/ada/a-dirval.ads | 3 +++ 5 files changed, 62 insertions(+), 9 deletions(-) diff --git a/gcc/ada/a-direct.adb b/gcc/ada/a-direct.adb index 318d10445029..2cd29ed380b8 100644 --- 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 760102c9e102..d08355d0e1f2 100644 --- 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 089f7cdd9e61..9948ea2348c0 100644 --- 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 206af7fc665a..d4395e1d15c4 100644 --- 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 9785f30f7c4b..b8d5eafc94cf 100644 --- 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; -- 2.43.5