From 9678de4977f3ea4a80bd40e05d62ce6b7d7ead23 Mon Sep 17 00:00:00 2001 From: Douglas B Rupp Date: Tue, 4 Dec 2001 17:37:55 +0100 Subject: [PATCH] * 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 From-SVN: r47613 --- gcc/ada/ChangeLog | 18 ++++ gcc/ada/adaint.c | 237 +++++++++++++++++++++++++++++++++++++++++++ gcc/ada/adaint.h | 1 + gcc/ada/gnatchop.adb | 41 +++++++- gcc/ada/gnatcmd.adb | 4 + 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. + + * 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 * 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 @@ -67,6 +67,62 @@ #endif #include +#if defined (__EMX__) || defined (MSDOS) || defined (_WIN32) +#elif defined (VMS) +#include +#include +#include +#include +#include +#include +#include +#include +#include + +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 +#endif + #if defined (__EMX__) || defined (MSDOS) || defined (_WIN32) #include #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 @@ -1300,6 +1321,10 @@ procedure Gnatchop is (" -k krunch file names of generated files to " & "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); -- 2.30.2