mirror of
https://github.com/janet-lang/janet
synced 2026-05-13 00:42:15 +00:00
Calvin Rose
7fc12ff167
Still fallback to blocking connect with WSAConnect when ConnectEx is not available or applicable, but ConnectEx is preferred and recommended by Microsoft. Also make some changes to our use of OVERLAPPED in various places in the ev code, replacing all uses with JanetOverlapped. This also let's us avoid reusing internal fields for OVERLAPPED which may or may not be used in various places.
203 lines
7.3 KiB
Janet
203 lines
7.3 KiB
Janet
# Copyright (c) 2026 Calvin Rose
|
|
#
|
|
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
|
# of this software and associated documentation files (the "Software"), to
|
|
# deal in the Software without restriction, including without limitation the
|
|
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
|
# sell copies of the Software, and to permit persons to whom the Software is
|
|
# furnished to do so, subject to the following conditions:
|
|
#
|
|
# The above copyright notice and this permission notice shall be included in
|
|
# all copies or substantial portions of the Software.
|
|
#
|
|
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
|
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
|
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
|
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
|
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
|
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
|
# IN THE SOFTWARE.
|
|
|
|
(import ./helper :prefix "" :exit true)
|
|
(start-suite)
|
|
|
|
(def janet (dyn :executable))
|
|
(def run (filter next (string/split " " (os/getenv "SUBRUN" ""))))
|
|
|
|
# OS Date test
|
|
# 719f7ba0c
|
|
(assert (deep= {:year-day 0
|
|
:minutes 30
|
|
:month 0
|
|
:dst false
|
|
:seconds 0
|
|
:year 2014
|
|
:month-day 0
|
|
:hours 20
|
|
:week-day 3}
|
|
(os/date 1388608200)) "os/date")
|
|
|
|
# OS mktime test
|
|
# 3ee43c3ab
|
|
(assert (= 1388608200 (os/mktime {:year-day 0
|
|
:minutes 30
|
|
:month 0
|
|
:dst false
|
|
:seconds 0
|
|
:year 2014
|
|
:month-day 0
|
|
:hours 20
|
|
:week-day 3})) "os/mktime")
|
|
|
|
(def now (os/time))
|
|
(assert (= (os/mktime (os/date now)) now) "UTC os/mktime")
|
|
(assert (= (os/mktime (os/date now true) true) now) "local os/mktime")
|
|
(assert (= (os/mktime {:year 1970}) 0) "os/mktime default values")
|
|
|
|
# OS strftime test
|
|
# 5cd729c4c
|
|
(assert (= (os/strftime "%Y-%m-%d %H:%M:%S" 0) "1970-01-01 00:00:00")
|
|
"strftime UTC epoch")
|
|
(assert (= (os/strftime "%Y-%m-%d %H:%M:%S" 1388608200)
|
|
"2014-01-01 20:30:00")
|
|
"strftime january 2014")
|
|
(assert (= (try (os/strftime "%%%d%t") ([err] err))
|
|
"invalid conversion specifier '%t'")
|
|
"invalid conversion specifier 1")
|
|
(assert (= (try (os/strftime "%H:%M:%") ([err] err))
|
|
"invalid conversion specifier")
|
|
"invalid conversion specifier 2")
|
|
|
|
# 07db4c530
|
|
(os/setenv "TESTENV1" "v1")
|
|
(os/setenv "TESTENV2" "v2")
|
|
(assert (= (os/getenv "TESTENV1") "v1") "getenv works")
|
|
(def environ (os/environ))
|
|
(assert (= [(environ "TESTENV1") (environ "TESTENV2")] ["v1" "v2"])
|
|
"environ works")
|
|
|
|
# Ensure randomness puts n of pred into our buffer eventually
|
|
# 0ac5b243c
|
|
(defn cryptorand-check
|
|
[n pred]
|
|
(def max-attempts 10000)
|
|
(var attempts 0)
|
|
(while (not= attempts max-attempts)
|
|
(def cryptobuf (os/cryptorand 10))
|
|
(when (= n (count pred cryptobuf))
|
|
(break))
|
|
(++ attempts))
|
|
(not= attempts max-attempts))
|
|
|
|
(def v (math/rng-int (math/rng (os/time)) 100))
|
|
(assert (cryptorand-check 0 |(= $ v)) "cryptorand skips value sometimes")
|
|
(assert (cryptorand-check 1 |(= $ v)) "cryptorand has value sometimes")
|
|
|
|
(do
|
|
(def buf (buffer/new-filled 1))
|
|
(os/cryptorand 1 buf)
|
|
(assert (= (in buf 0) 0) "cryptorand doesn't overwrite buffer")
|
|
(assert (= (length buf) 2) "cryptorand appends to buffer"))
|
|
|
|
(assert-no-error "realtime clock" (os/clock))
|
|
(assert-no-error "realtime clock" (os/clock nil))
|
|
(assert-no-error "realtime clock" (os/clock nil nil))
|
|
|
|
# 80db68210
|
|
(assert-no-error "realtime clock" (os/clock :realtime))
|
|
(assert-no-error "cputime clock" (os/clock :cputime))
|
|
(assert-no-error "monotonic clock" (os/clock :monotonic))
|
|
|
|
(assert-no-error "realtime clock double output" (os/clock nil :double))
|
|
(assert-no-error "realtime clock int output" (os/clock nil :int))
|
|
(assert-no-error "realtime clock tuple output" (os/clock nil :tuple))
|
|
|
|
(assert-error "invalid clock" (os/clock :a))
|
|
(assert-error "invalid output" (os/clock :realtime :b))
|
|
(assert-error "invalid clock and output" (os/clock :a :b))
|
|
|
|
(def before (os/clock :monotonic))
|
|
(def after (os/clock :monotonic))
|
|
(assert (>= after before) "monotonic clock is monotonic")
|
|
|
|
# Perm strings
|
|
# a0d61e45d
|
|
(assert (= (os/perm-int "rwxrwxrwx") 8r777) "perm 1")
|
|
(assert (= (os/perm-int "rwxr-xr-x") 8r755) "perm 2")
|
|
(assert (= (os/perm-int "rw-r--r--") 8r644) "perm 3")
|
|
|
|
(assert (= (band (os/perm-int "rwxrwxrwx") 8r077) 8r077) "perm 4")
|
|
(assert (= (band (os/perm-int "rwxr-xr-x") 8r077) 8r055) "perm 5")
|
|
(assert (= (band (os/perm-int "rw-r--r--") 8r077) 8r044) "perm 6")
|
|
|
|
(assert (= (os/perm-string 8r777) "rwxrwxrwx") "perm 7")
|
|
(assert (= (os/perm-string 8r755) "rwxr-xr-x") "perm 8")
|
|
(assert (= (os/perm-string 8r644) "rw-r--r--") "perm 9")
|
|
|
|
# Pipes
|
|
(assert-no-error (os/pipe))
|
|
(assert-no-error (os/pipe :RW))
|
|
(assert-no-error (os/pipe :R))
|
|
(assert-no-error (os/pipe :W))
|
|
|
|
# os/execute with environment variables
|
|
# issue #636 - 7e2c433ab
|
|
(assert (= 0 (os/execute [;run janet "-e" "(+ 1 2 3)"] :pe
|
|
(merge (os/environ) {"HELLO" "WORLD"})))
|
|
"os/execute with env")
|
|
|
|
# os/execute with empty environment
|
|
# pr #1686
|
|
# native MinGW can't find system DLLs without PATH, SystemRoot, etc. and so fails
|
|
# Also fails for address sanitizer builds on windows.
|
|
(def result (os/execute [;run janet "-e" "(+ 1 2 3)"] :pe {}))
|
|
(assert (or (= result -1073741515) (= result 0))
|
|
"os/execute with minimal env")
|
|
|
|
# os/execute regressions
|
|
# 427f7c362
|
|
(for i 0 10
|
|
(assert (= i (os/execute [;run janet "-e"
|
|
(string/format "(os/exit %d)" i)] :p))
|
|
(string "os/execute " i)))
|
|
|
|
# os/execute IO redirection
|
|
(assert-no-error "IO redirection"
|
|
(defn devnull []
|
|
(def os (os/which))
|
|
(def path (if (or (= os :mingw) (= os :windows))
|
|
"NUL"
|
|
"/dev/null"))
|
|
(os/open path :w))
|
|
(with [dn (devnull)]
|
|
(os/execute [;run janet
|
|
"-e"
|
|
"(print :foo) (eprint :bar)"]
|
|
:px
|
|
{:out dn :err dn})))
|
|
|
|
# os/execute IO redirection with more windows flags
|
|
(assert-no-error "IO redirection more windows flags"
|
|
(defn devnull []
|
|
(def os (os/which))
|
|
(def path (if (or (= os :mingw) (= os :windows))
|
|
"NUL"
|
|
"/dev/null"))
|
|
(os/open path (if (= os :windows) :wWI :wW)))
|
|
(with [dn (devnull)]
|
|
(os/execute [;run janet
|
|
"-e"
|
|
"(print :foo) (eprint :bar)"]
|
|
:px
|
|
{:out dn :err dn})))
|
|
|
|
# Issue 16922
|
|
(assert-error "os/realpath errors when path does not exist"
|
|
(os/realpath "abc123def456"))
|
|
|
|
# os/which changes
|
|
(assert (os/which (os/which)) "os/which 1 arg")
|
|
(assert (not (os/which :gobbledegook)) "os/which 2")
|
|
|
|
(end-suite)
|