* 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
This commit is contained in:
Douglas B Rupp
Geert Bosch
parent
b0ca54affc
commit
9678de4977
|
|
@ -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
|
||||
|
|
|
|||
237
gcc/ada/adaint.c
237
gcc/ada/adaint.c
|
|
@ -67,6 +67,62 @@
|
|||
#endif
|
||||
#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;
|
||||
|
|
|
|||
|
|
@ -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 *));
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
Loading…
Reference in New Issue