[MLton] cvs commit: raising SysErr on time functions
Stephen Weeks
sweeks@mlton.org
Wed, 7 Jul 2004 11:36:21 -0700
sweeks 04/07/07 11:36:04
Modified: basis-library/net socket.sml
basis-library/posix file-sys.sml process.sml
basis-library/system file-sys.sml io.sml
Log:
MAIL raising SysErr on time functions
Fixed the following functions so that they raise SysErr inval, not
Overflow, on time values that are too large.
OS.FileSys.setTime
OS.IO.poll
OS.Process.sleep
Posix.FileSys.utime
Posix.Process.{alarm,sleep}
Socket.select
Revision Changes Path
1.14 +32 -30 mlton/basis-library/net/socket.sml
Index: socket.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/net/socket.sml,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- socket.sml 18 May 2004 00:35:39 -0000 1.13
+++ socket.sml 7 Jul 2004 18:36:02 -0000 1.14
@@ -5,15 +5,15 @@
struct
structure Prim = Primitive.Socket
-structure PE = Posix.Error
-structure PESC = PE.SysCall
-structure PFS = Posix.FileSys
+structure Error = Posix.Error
+structure Syscall = Error.SysCall
+structure FileSys = Posix.FileSys
datatype sock = S of Prim.sock
fun sockToWord (S s) = SysWord.fromInt s
fun wordToSock s = S (SysWord.toInt s)
-fun sockToFD sock = PFS.wordToFD (sockToWord sock)
-fun fdToSock fd = wordToSock (PFS.fdToWord fd)
+fun sockToFD sock = FileSys.wordToFD (sockToWord sock)
+fun fdToSock fd = wordToSock (FileSys.fdToWord fd)
type pre_sock_addr = Prim.pre_sock_addr
datatype sock_addr = SA of Prim.sock_addr
@@ -111,9 +111,11 @@
case t of
NONE => (marshalBool (false, wa, s)
; marshalInt (0, wa, s + boolLen))
- | SOME t => (marshalBool (true, wa, s)
- ; marshalWord (Word.fromLargeInt (Time.toSeconds t),
- wa, s + boolLen))
+ | SOME t =>
+ (marshalBool (true, wa, s)
+ ; marshalWord (Word.fromLargeInt (Time.toSeconds t)
+ handle Overflow => Error.raiseSys Error.inval,
+ wa, s + boolLen))
local
fun make (optlen: int,
@@ -132,7 +134,7 @@
val optval = Word8Array.array (optlen, 0wx0)
val optlen = ref optlen
in
- PESC.simple
+ Syscall.simple
(fn () =>
Prim.Ctl.getSockOpt (s, level, optname,
Word8Array.toPoly optval,
@@ -144,7 +146,7 @@
val optval = marshal optval
val optlen = Word8Vector.length optval
in
- PESC.simple
+ Syscall.simple
(fn () =>
Prim.Ctl.setSockOpt (s, level, optname,
Word8Vector.toPoly optval,
@@ -154,7 +156,7 @@
let
val optval = Word8Array.array (optlen, 0wx0)
in
- PESC.simple
+ Syscall.simple
(fn () =>
Prim.Ctl.getIOCtl
(s, request, Word8Array.toPoly optval))
@@ -164,7 +166,7 @@
let
val optval = marshal optval
in
- PESC.simple
+ Syscall.simple
(fn () =>
Prim.Ctl.setIOCtl
(s, request, Word8Vector.toPoly optval))
@@ -213,7 +215,7 @@
(S s) =
let
val (sa, salen, finish) = new_sock_addr ()
- val () = PESC.simple (fn () => f (s, sa, salen))
+ val () = Syscall.simple (fn () => f (s, sa, salen))
in
finish ()
end
@@ -230,14 +232,14 @@
fun familyOfAddr (SA sa) = NetHostDB.intToAddrFamily (Prim.familyOfAddr sa)
fun bind (S s, SA sa) =
- PESC.simple (fn () => Prim.bind (s, sa, Vector.length sa))
+ Syscall.simple (fn () => Prim.bind (s, sa, Vector.length sa))
fun listen (S s, n) =
- PESC.simple (fn () => Prim.listen (s, n))
+ Syscall.simple (fn () => Prim.listen (s, n))
fun nonBlock' ({restart: bool},
f : unit -> int, post : int -> 'a, again, no : 'a) =
- PESC.syscallErr
+ Syscall.syscallErr
({clear = false, restart = restart},
fn () => let val res = f ()
in
@@ -247,7 +249,7 @@
end)
fun nonBlock (f, post, no) =
- nonBlock' ({restart = true}, f, post, PE.again, no)
+ nonBlock' ({restart = true}, f, post, Error.again, no)
local
structure PIO = PosixPrimitive.IO
@@ -255,10 +257,10 @@
fun withNonBlock (fd, f: unit -> 'a) =
let
val flags =
- PESC.simpleResultRestart
+ Syscall.simpleResultRestart
(fn () => PIO.fcntl2 (fd, PIO.F_GETFL))
val _ =
- PESC.simpleResultRestart
+ Syscall.simpleResultRestart
(fn () =>
PIO.fcntl3 (fd, PIO.F_SETFL,
Word.toIntX
@@ -266,24 +268,24 @@
PosixPrimitive.FileSys.O.nonblock))))
in
DynamicWind.wind
- (f, fn () => PESC.simple (fn () => PIO.fcntl3 (fd, PIO.F_SETFL, flags)))
+ (f, fn () => Syscall.simple (fn () => PIO.fcntl3 (fd, PIO.F_SETFL, flags)))
end
end
fun connect (S s, SA sa) =
- PESC.simple (fn () => Prim.connect (s, sa, Vector.length sa))
+ Syscall.simple (fn () => Prim.connect (s, sa, Vector.length sa))
fun connectNB (S s, SA sa) =
nonBlock'
({restart = false}, fn () =>
withNonBlock (s, fn () => Prim.connect (s, sa, Vector.length sa)),
fn _ => true,
- PE.inprogress, false)
+ Error.inprogress, false)
fun accept (S s) =
let
val (sa, salen, finish) = new_sock_addr ()
- val s = PESC.simpleResultRestart (fn () => Prim.accept (s, sa, salen))
+ val s = Syscall.simpleResultRestart (fn () => Prim.accept (s, sa, salen))
in
(S s, finish ())
end
@@ -298,7 +300,7 @@
NONE)
end
-fun close (S s) = PESC.simple (fn () => Prim.close (s))
+fun close (S s) = Syscall.simple (fn () => Prim.close (s))
datatype shutdown_mode = NO_RECVS | NO_SENDS | NO_RECVS_OR_SENDS
@@ -310,12 +312,12 @@
fun shutdown (S s, m) =
let val m = shutdownModeToHow m
- in PESC.simple (fn () => Prim.shutdown (s, m))
+ in Syscall.simple (fn () => Prim.shutdown (s, m))
end
type sock_desc = OS.IO.iodesc
-fun sockDesc sock = PFS.fdToIOD (sockToFD sock)
+fun sockDesc sock = FileSys.fdToIOD (sockToFD sock)
fun sameDesc (desc1, desc2) =
OS.IO.compare (desc1, desc2) = EQUAL
@@ -377,7 +379,7 @@
let
val (buf, i, sz) = base sl
in
- PESC.simpleResultRestart
+ Syscall.simpleResultRestart
(fn () => primSend (s, buf, i, sz, mk_out_flags out_flags))
end
fun send (sock, buf) = send' (sock, buf, no_out_flags)
@@ -395,7 +397,7 @@
let
val (buf, i, sz) = base sl
in
- PESC.simpleRestart
+ Syscall.simpleRestart
(fn () => primSendTo (s, buf, i, sz, mk_out_flags out_flags, sa, Vector.length sa))
end
fun sendTo (sock, sock_addr, sl) =
@@ -439,7 +441,7 @@
let
val (buf, i, sz) = Word8ArraySlice.base sl
in
- PESC.simpleResultRestart
+ Syscall.simpleResultRestart
(fn () => Prim.recv (s, Word8Array.toPoly buf, i, sz, mk_in_flags in_flags))
end
@@ -466,7 +468,7 @@
val (buf, i, sz) = Word8ArraySlice.base sl
val (sa, salen, finish) = new_sock_addr ()
val n =
- PESC.simpleResultRestart
+ Syscall.simpleResultRestart
(fn () => Prim.recvFrom (s, Word8Array.toPoly buf, i, sz, mk_in_flags in_flags, sa, salen))
in
(n, finish ())
1.18 +7 -2 mlton/basis-library/posix/file-sys.sml
Index: file-sys.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/file-sys.sml,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- file-sys.sml 2 May 2004 15:31:25 -0000 1.17
+++ file-sys.sml 7 Jul 2004 18:36:02 -0000 1.18
@@ -7,17 +7,22 @@
*)
structure PosixFileSys: POSIX_FILE_SYS_EXTRA =
struct
+ structure Error = PosixError
+
(* Patch to make Time look like it deals with Int.int
* instead of LargeInt.int.
*)
structure Time =
struct
open Time
- val toSeconds = LargeInt.toInt o toSeconds
+
val fromSeconds = fromSeconds o LargeInt.fromInt
+
+ fun toSeconds t =
+ LargeInt.toInt (Time.toSeconds t)
+ handle Overflow => Error.raiseSys Error.inval
end
- structure Error = PosixError
structure SysCall = Error.SysCall
structure Prim = PosixPrimitive.FileSys
open Prim
1.22 +5 -3 mlton/basis-library/posix/process.sml
Index: process.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/process.sml,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -r1.21 -r1.22
--- process.sml 1 May 2004 20:11:39 -0000 1.21
+++ process.sml 7 Jul 2004 18:36:03 -0000 1.22
@@ -201,9 +201,11 @@
local
fun wrap prim (t: Time.time): Time.time =
- (Time.fromSeconds (LargeInt.fromInt
- (prim
- (LargeInt.toInt (Time.toSeconds t)))))
+ Time.fromSeconds
+ (LargeInt.fromInt
+ (prim
+ (LargeInt.toInt (Time.toSeconds t)
+ handle Overflow => Error.raiseSys Error.inval)))
in
val alarm = wrap Prim.alarm
val sleep = wrap Prim.sleep
1.6 +12 -7 mlton/basis-library/system/file-sys.sml
Index: file-sys.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/system/file-sys.sml,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- file-sys.sml 16 Feb 2004 22:43:23 -0000 1.5
+++ file-sys.sml 7 Jul 2004 18:36:03 -0000 1.6
@@ -96,16 +96,21 @@
end
fun realPath p =
- if (P.isAbsolute p)
+ if P.isAbsolute p
then fullPath p
- else P.mkRelative {path = fullPath p, relativeTo = fullPath(getDir())}
+ else P.mkRelative {path = fullPath p,
+ relativeTo = fullPath (getDir ())}
val fileSize = P_FSys.ST.size o P_FSys.stat
- val modTime = P_FSys.ST.mtime o P_FSys.stat
- fun setTime (path, NONE) = P_FSys.utime(path, NONE)
- | setTime (path, SOME t) = P_FSys.utime(path, SOME{actime=t, modtime=t})
- val remove = P_FSys.unlink
- val rename = P_FSys.rename
+
+ val modTime = P_FSys.ST.mtime o P_FSys.stat
+
+ fun setTime (path, t) =
+ P_FSys.utime (path, Option.map (fn t => {actime = t, modtime = t}) t)
+
+ val remove = P_FSys.unlink
+
+ val rename = P_FSys.rename
datatype access_mode = datatype Posix.FileSys.access_mode
1.9 +3 -1 mlton/basis-library/system/io.sml
Index: io.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/system/io.sml,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- io.sml 1 May 2004 20:11:39 -0000 1.8
+++ io.sml 7 Jul 2004 18:36:03 -0000 1.9
@@ -13,6 +13,7 @@
structure OS_IO: OS_IO =
struct
+ structure Error = PosixError
(* an iodesc is an abstract descriptor for an OS object that
* supports I/O (e.g., file, tty device, socket, ...).
@@ -120,7 +121,8 @@
| SOME t =>
if Time.< (t, Time.zeroTime)
then let open PosixError in raiseSys inval end
- else Int.fromLarge (Time.toMilliseconds t)
+ else (Int.fromLarge (Time.toMilliseconds t)
+ handle Overflow => Error.raiseSys Error.inval)
val reventss = Array.array (n, 0w0)
val _ = Posix.Error.SysCall.simpleRestart
(fn () => Prim.poll (fds, eventss, n, timeOut, reventss))