mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-21 15:40:55 +08:00
Code Issues Packages Projects Releases Wiki Activity

* gnatchop.adb:

Browse Source 
(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 2001-12-04 17:37:55 +01:00 committed by Geert Bosch
parent b0ca54affc
commit 9678de4977
5 changed files with 297 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
gcc/ada/ChangeLog
View File

@ -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
View File

@ -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;

1
gcc/ada/adaint.h
View File

@ -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 *));

41
gcc/ada/gnatchop.adb
View File

@ -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

4
gcc/ada/gnatcmd.adb
View File

@ -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);