* gnatchop.adb:

	(File_Time_Stamp): New procedure.
	(Preserve_Mode): New boolean.
	(Write_Unit): Pass time stamp.
	Implement -p switch (preserve time stamps).

	* gnatcmd.adb (CHOP): Add translation for -p (/PRESERVE).

	* gnatchop.adb: Do usage info for -p switch

	* adaint.h (__gnat_set_file_time_name): New function

	* adaint.c (__gnat_set_file_time_name): Implement

	* adaint.h: Fix typo


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@47613 138bc75d-0d04-0410-961f-82ee72b054a4

5 files changed, 297 insertions, 4 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index cf3b44bb4a9..3fdfd09afc0 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,21 @@
+2001-12-04  Douglas B. <rupp@gnat.com>
+
+	* gnatchop.adb:
+	(File_Time_Stamp): New procedure.
+	(Preserve_Mode): New boolean.
+	(Write_Unit): Pass time stamp.
+	Implement -p switch (preserve time stamps).
+	
+	* gnatcmd.adb (CHOP): Add translation for -p (/PRESERVE).
+	
+	* gnatchop.adb: Do usage info for -p switch
+	
+	* adaint.h (__gnat_set_file_time_name): New function
+	
+	* adaint.c (__gnat_set_file_time_name): Implement
+	
+	* adaint.h: Fix typo
+
 2001-12-03  Robert Dewar <dewar@gnat.com>
 
 	* sinfo.ads: Minor reformatting. N_Freeze_Entity node does not
diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c
index 48d66c79f3d..d54d8873d37 100644
--- a/gcc/ada/adaint.c
+++ b/gcc/ada/adaint.c
@@ -68,6 +68,62 @@
 #include <sys/wait.h>
 
 #if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
+#elif defined (VMS)
+#include <rms.h>
+#include <atrdef.h>
+#include <fibdef.h>
+#include <stsdef.h>
+#include <iodef.h>
+#include <errno.h>
+#include <descrip.h>
+#include <string.h>
+#include <unixlib.h>
+
+struct utimbuf
+{
+  time_t actime;
+  time_t modtime;
+};
+
+#define NOREAD     0x01
+#define NOWRITE    0x02
+#define NOEXECUTE  0x04
+#define NODELETE   0x08
+
+/* use native 64-bit arithmetic */
+#define unix_time_to_vms(X,Y) \
+  { unsigned long long reftime, tmptime = (X); \
+    $DESCRIPTOR (unixtime,"1-JAN-1970 0:00:00.00"); \
+    SYS$BINTIM (&unixtime, &reftime); \
+    Y = tmptime * 10000000 + reftime; }
+
+/* descrip.h doesn't have everything ... */
+struct dsc$descriptor_fib
+{
+  unsigned long fib$l_len;
+  struct fibdef *fib$l_addr;
+};
+
+struct IOSB
+{ 
+  unsigned short status, count;
+  unsigned long devdep;
+};
+
+static char *tryfile;
+
+struct vstring
+{
+  short length;
+  char string [NAM$C_MAXRSS+1];
+};
+
+
+#else
+#include <utime.h>
+#endif
+
+#if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
 #include <process.h>
 #endif
 
@@ -872,6 +928,187 @@ __gnat_file_time_fd (fd)
 #endif
 }
 
+/* Set the file time stamp */
+
+void
+__gnat_set_file_time_name (name, time_stamp)
+     char *name;
+     time_t time_stamp;
+{
+#if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
+#elif defined (VMS)
+  struct FAB fab;
+  struct NAM nam;
+
+  struct
+    {
+      unsigned long long backup, create, expire, revise;
+      unsigned long uic;
+      union
+	{
+	  unsigned short value;
+	  struct
+	    {
+	      unsigned system : 4;
+	      unsigned owner  : 4;
+	      unsigned group  : 4;
+	      unsigned world  : 4;
+	    } bits;
+	} prot;
+    } Fat = { 0 };
+
+  ATRDEF atrlst []
+    = {
+      { ATR$S_CREDATE,  ATR$C_CREDATE,  &Fat.create },
+      { ATR$S_REVDATE,  ATR$C_REVDATE,  &Fat.revise },
+      { ATR$S_EXPDATE,  ATR$C_EXPDATE,  &Fat.expire },
+      { ATR$S_BAKDATE,  ATR$C_BAKDATE,  &Fat.backup },
+      n{ ATR$S_FPRO,     ATR$C_FPRO,     &Fat.prot },
+      { ATR$S_UIC,      ATR$C_UIC,      &Fat.uic },
+      { 0, 0, 0}
+    };
+
+  FIBDEF fib;
+  struct dsc$descriptor_fib fibdsc = {sizeof (fib), (void *) &fib};
+
+  struct IOSB iosb;
+
+  unsigned long long newtime;
+  unsigned long long revtime;
+  long status;
+  short chan;
+
+  struct vstring file;
+  struct dsc$descriptor_s filedsc
+    = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) file.string};
+  struct vstring device;
+  struct dsc$descriptor_s devicedsc
+    = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) device.string};
+  struct vstring timev;
+  struct dsc$descriptor_s timedsc
+    = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) timev.string};
+  struct vstring result;
+  struct dsc$descriptor_s resultdsc
+    = {NAM$C_MAXRSS, DSC$K_DTYPE_VT, DSC$K_CLASS_VS, (void *) result.string};
+
+  tryfile = (char *) __gnat_to_host_dir_spec (name, 0);
+
+  /* Allocate and initialize a fab and nam structures. */
+  fab = cc$rms_fab;
+  nam = cc$rms_nam;
+
+  nam.nam$l_esa = file.string;
+  nam.nam$b_ess = NAM$C_MAXRSS;
+  nam.nam$l_rsa = result.string;
+  nam.nam$b_rss = NAM$C_MAXRSS;
+  fab.fab$l_fna = tryfile;
+  fab.fab$b_fns = strlen (tryfile);
+  fab.fab$l_nam = &nam;
+
+  /*Validate filespec syntax and device existence.  */
+  status = SYS$PARSE (&fab, 0, 0);
+  if ((status & 1) != 1)
+    LIB$SIGNAL (status);
+
+  file.string [nam.nam$b_esl] = 0;
+
+  /* Find matching filespec. */
+  status = SYS$SEARCH (&fab, 0, 0);
+  if ((status & 1) != 1)
+    LIB$SIGNAL (status);
+
+  file.string [nam.nam$b_esl] = 0;
+  result.string [result.length=nam.nam$b_rsl] = 0;
+
+  /* Get the device name and assign an IO channel. */
+  strncpy (device.string, nam.nam$l_dev, nam.nam$b_dev);
+  devicedsc.dsc$w_length  = nam.nam$b_dev;
+  chan = 0;
+  status = SYS$ASSIGN (&devicedsc, &chan, 0, 0, 0);
+  if ((status & 1) != 1)
+    LIB$SIGNAL (status);
+
+  /*  Initialize the FIB and fill in the directory id field. */
+  bzero (&fib, sizeof (fib));
+  fib.fib$w_did [0]  = nam.nam$w_did [0];
+  fib.fib$w_did [1]  = nam.nam$w_did [1];
+  fib.fib$w_did [2]  = nam.nam$w_did [2];
+  fib.fib$l_acctl = 0;
+  fib.fib$l_wcc = 0;
+  strcpy (file.string, (strrchr (result.string, ']') + 1));
+  filedsc.dsc$w_length = strlen (file.string);
+  result.string [result.length = 0] = 0;
+
+  /* Open and close the file to fill in the attributes.  */
+  status
+    = SYS$QIOW (0, chan, IO$_ACCESS|IO$M_ACCESS, &iosb, 0, 0,
+		&fibdsc, &filedsc, &result.length, &resultdsc, &atrlst, 0);
+  if ((status & 1) != 1)
+    LIB$SIGNAL (status);
+  if ((iosb.status & 1) != 1)
+    LIB$SIGNAL (iosb.status);
+
+  result.string [result.length] = 0;
+  status = SYS$QIOW (0, chan, IO$_DEACCESS, &iosb, 0, 0,
+                     &fibdsc, 0, 0, 0, &atrlst, 0);
+  if ((status & 1) != 1)
+    LIB$SIGNAL (status);
+  if ((iosb.status & 1) != 1)
+    LIB$SIGNAL (iosb.status);
+
+  /* Set creation time to requested time */
+  unix_time_to_vms (time_stamp, newtime);
+
+  {
+    time_t t;
+    struct tm *ts;
+
+    t = time ((time_t) 0);
+    ts = localtime (&t);
+
+    /* Set revision time to now in local time. */
+    unix_time_to_vms (t + ts->tm_gmtoff, revtime);
+  }
+
+  /*  Reopen the file, modify the times and then close. */
+  fib.fib$l_acctl = FIB$M_WRITE;
+  status
+    = SYS$QIOW (0, chan, IO$_ACCESS|IO$M_ACCESS, &iosb, 0, 0,
+		&fibdsc, &filedsc, &result.length, &resultdsc, &atrlst, 0);
+  if ((status & 1) != 1)
+    LIB$SIGNAL (status);
+  if ((iosb.status & 1) != 1)
+    LIB$SIGNAL (iosb.status);
+
+  Fat.create = newtime;
+  Fat.revise = revtime;
+
+  status = SYS$QIOW (0, chan, IO$_DEACCESS, &iosb, 0, 0,
+                     &fibdsc, 0, 0, 0, &atrlst, 0);
+  if ((status & 1) != 1)
+    LIB$SIGNAL (status);
+  if ((iosb.status & 1) != 1)
+    LIB$SIGNAL (iosb.status);
+
+  /* Deassign the channel and exit. */
+  status = SYS$DASSGN (chan);
+  if ((status & 1) != 1)
+    LIB$SIGNAL (status);
+#else
+  struct utimbuf utimbuf;
+  time_t t;
+
+  /* Set modification time to requested time */
+  utimbuf.modtime = time_stamp;
+
+  /* Set access time to now in local time */
+  t = time ((time_t) 0);
+  utimbuf.actime = mktime (localtime (&t));
+
+  utime (name, &utimbuf);
+#endif
+}
+
 void
 __gnat_get_env_value_ptr (name, len, value)
      char *name;
diff --git a/gcc/ada/adaint.h b/gcc/ada/adaint.h
index 474c68a9c8a..8bcdbcf46f6 100644
--- a/gcc/ada/adaint.h
+++ b/gcc/ada/adaint.h
@@ -69,6 +69,7 @@ extern char  *__gnat_readdir                       PARAMS ((DIR *, char *));
 extern int    __gnat_readdir_is_thread_safe        PARAMS ((void));
 extern time_t __gnat_file_time_name                PARAMS ((char *));
 extern time_t __gnat_file_time_fd                  PARAMS ((int));
+extern void   __gnat_set_file_time_name		   PARAMS ((char *, time_t));
 extern void   __gnat_get_env_value_ptr             PARAMS ((char *, int *,
 							    char **));
 extern int    __gnat_file_exists		   PARAMS ((char *));
diff --git a/gcc/ada/gnatchop.adb b/gcc/ada/gnatchop.adb
index 6d444c1fb82..72fec21d7e7 100644
--- a/gcc/ada/gnatchop.adb
+++ b/gcc/ada/gnatchop.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                            $Revision: 1.1 $
+--                            $Revision$
 --                                                                          --
 --            Copyright (C) 1998-2001 Ada Core Technologies, Inc.           --
 --                                                                          --
@@ -90,6 +90,7 @@ procedure Gnatchop is
 
    Compilation_Mode  : Boolean := False;
    Overwrite_Files   : Boolean := False;
+   Preserve_Mode     : Boolean := False;
    Quiet_Mode        : Boolean := False;
    Source_References : Boolean := False;
    Verbose_Mode      : Boolean := False;
@@ -204,6 +205,10 @@ procedure Gnatchop is
    procedure Error_Msg (Message : String);
    --  Produce an error message on standard error output
 
+   procedure File_Time_Stamp (Name : C_File_Name; Time : OS_Time);
+   --  Given the name of a file or directory, Name, set the
+   --  time stamp. This function must be used for an unopened file.
+
    function Files_Exist return Boolean;
    --  Check Unit.Table for possible file names that already exist
    --  in the file system. Returns true if files exist, False otherwise
@@ -316,6 +321,7 @@ procedure Gnatchop is
    procedure Write_Unit
      (Source  : access String;
       Num     : Unit_Num;
+      TS_Time : OS_Time;
       Success : out Boolean);
    --  Write one compilation unit of the source to file
 
@@ -333,6 +339,18 @@ procedure Gnatchop is
       end if;
    end Error_Msg;
 
+   ---------------------
+   -- File_Time_Stamp --
+   ---------------------
+
+   procedure File_Time_Stamp (Name : C_File_Name; Time : OS_Time) is
+      procedure Set_File_Time (Name : C_File_Name; Time : OS_Time);
+      pragma Import (C, Set_File_Time, "__gnat_set_file_time_name");
+
+   begin
+      Set_File_Time (Name, Time);
+   end File_Time_Stamp;
+
    -----------------
    -- Files_Exist --
    -----------------
@@ -1040,7 +1058,7 @@ procedure Gnatchop is
       --  Scan options first
 
       loop
-         case Getopt ("c gnat? h k? q r v w x") is
+         case Getopt ("c gnat? h k? p q r v w x") is
             when ASCII.NUL =>
                exit;
 
@@ -1088,6 +1106,9 @@ procedure Gnatchop is
                   Kset := True;
                end;
 
+            when 'p' =>
+               Preserve_Mode     := True;
+
             when 'q' =>
                Quiet_Mode        := True;
 
@@ -1279,7 +1300,7 @@ procedure Gnatchop is
    begin
       Put_Line
         ("Usage: gnatchop [-c] [-h] [-k#] " &
-         "[-r] [-q] [-v] [-w] [-x] file [file ...] [dir]");
+         "[-r] [-p] [-q] [-v] [-w] [-x] file [file ...] [dir]");
 
       New_Line;
       Put_Line
@@ -1301,6 +1322,10 @@ procedure Gnatchop is
          "no more than 8 characters");
 
       Put_Line
+        ("  -p       preserve time stamp, output files will " &
+         "have same stamp as input");
+
+      Put_Line
         ("  -q       quiet mode, no output of generated file " &
          "names");
 
@@ -1347,9 +1372,11 @@ procedure Gnatchop is
       FD      : File_Descriptor;
       Buffer  : String_Access;
       Success : Boolean;
+      TS_Time : OS_Time;
 
    begin
       FD := Open_Read (Name'Address, Binary);
+      TS_Time := File_Time_Stamp (FD);
 
       if FD = Invalid_FD then
          Error_Msg ("cannot open " & File.Table (Input).Name.all);
@@ -1372,7 +1399,7 @@ procedure Gnatchop is
 
       for Num in 1 .. Unit.Last loop
          if Unit.Table (Num).Chop_File = Input then
-            Write_Unit (Buffer, Num, Success);
+            Write_Unit (Buffer, Num, TS_Time, Success);
             exit when not Success;
          end if;
       end loop;
@@ -1533,6 +1560,7 @@ procedure Gnatchop is
    procedure Write_Unit
      (Source  : access String;
       Num     : Unit_Num;
+      TS_Time : OS_Time;
       Success : out Boolean)
    is
       Info   : Unit_Info renames Unit.Table (Num);
@@ -1600,6 +1628,11 @@ procedure Gnatchop is
       end if;
 
       Close (FD);
+
+      if Preserve_Mode then
+         File_Time_Stamp (Name'Address, TS_Time);
+      end if;
+
    end Write_Unit;
 
 --  Start of processing for gnatchop
diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb
index 75811ee74c8..1e67d667777 100644
--- a/gcc/ada/gnatcmd.adb
+++ b/gcc/ada/gnatcmd.adb
@@ -351,6 +351,9 @@ procedure GNATCmd is
    S_Chop_Over   : aliased constant S := "/OVERWRITE "                     &
                                             "-w";
 
+   S_Chop_Pres   : aliased constant S := "/PRESERVE "                      &
+                                            "-p";
+
    S_Chop_Quiet  : aliased constant S := "/QUIET "                         &
                                             "-q";
 
@@ -365,6 +368,7 @@ procedure GNATCmd is
      S_Chop_File   'Access,
      S_Chop_Help   'Access,
      S_Chop_Over   'Access,
+     S_Chop_Pres   'Access,
      S_Chop_Quiet  'Access,
      S_Chop_Ref    'Access,
      S_Chop_Verb   'Access);