aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
authorEduardo Julian2022-11-05 21:23:20 -0400
committerEduardo Julian2022-11-05 21:23:20 -0400
commitfd8ea1e1b9cae781abe42aeadda2e0ef149994d6 (patch)
tree7fdc152ac481d4f2a8b7be12c98d11a8c644f541 /stdlib
parent736521eb56a45122eb0a545b677d3ffca1451080 (diff)
Property-based testing can now log/print successful seeds from run.
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/library/lux/control/exception.lux22
-rw-r--r--stdlib/source/library/lux/control/function/named.lux8
-rw-r--r--stdlib/source/library/lux/control/function/polymorphism/context.lux4
-rw-r--r--stdlib/source/library/lux/control/function/polymorphism/predicate.lux16
-rw-r--r--stdlib/source/library/lux/control/function/polymorphism/type.lux12
-rw-r--r--stdlib/source/library/lux/control/function/variadic.lux8
-rw-r--r--stdlib/source/library/lux/control/security/capability.lux10
-rw-r--r--stdlib/source/library/lux/meta/macro/context.lux6
-rw-r--r--stdlib/source/library/lux/meta/macro/syntax/export.lux4
-rw-r--r--stdlib/source/library/lux/meta/macro/vocabulary.lux2
-rw-r--r--stdlib/source/library/lux/meta/type/primitive.lux14
-rw-r--r--stdlib/source/library/lux/meta/type/row.lux2
-rw-r--r--stdlib/source/library/lux/test/property.lux31
-rw-r--r--stdlib/source/library/lux/world/net.lux8
-rw-r--r--stdlib/source/library/lux/world/net/uri/port.lux103
-rw-r--r--stdlib/source/library/lux/world/net/uri/scheme.lux14
-rw-r--r--stdlib/source/specification/lux/abstract/apply.lux101
-rw-r--r--stdlib/source/specification/lux/abstract/comonad.lux77
-rw-r--r--stdlib/source/test/lux.lux2
-rw-r--r--stdlib/source/test/lux/test/property.lux7
-rw-r--r--stdlib/source/test/lux/world/net.lux4
-rw-r--r--stdlib/source/test/lux/world/net/uri/port.lux177
-rw-r--r--stdlib/source/test/lux/world/net/uri/scheme.lux14
23 files changed, 462 insertions, 184 deletions
diff --git a/stdlib/source/library/lux/control/exception.lux b/stdlib/source/library/lux/control/exception.lux
index fabba5ad5..55ac0667d 100644
--- a/stdlib/source/library/lux/control/exception.lux
+++ b/stdlib/source/library/lux/control/exception.lux
@@ -75,17 +75,17 @@
(.def exceptionP
(Parser [export.Policy [[Text Code] Code Code]])
- (export.parser
- (all <>.either
- (all <>.and
- (<code>.form (<>.and <code>.local <code>.any))
- <code>.any
- <code>.any)
- (do <>.monad
- [name <code>.local]
- (in [[name (code.local name)]
- (` (Exception Any))
- (` "")])))))
+ (export.with
+ (all <>.either
+ (all <>.and
+ (<code>.form (<>.and <code>.local <code>.any))
+ <code>.any
+ <code>.any)
+ (do <>.monad
+ [name <code>.local]
+ (in [[name (code.local name)]
+ (` (Exception Any))
+ (` "")])))))
(.def .public def
(syntax (_ [[export_policy [[name input] type body]] ..exceptionP])
diff --git a/stdlib/source/library/lux/control/function/named.lux b/stdlib/source/library/lux/control/function/named.lux
index eeade0ed5..39e0fba22 100644
--- a/stdlib/source/library/lux/control/function/named.lux
+++ b/stdlib/source/library/lux/control/function/named.lux
@@ -40,10 +40,10 @@
(.def .public def
(syntax (_ [[exported? [name parameters] type body]
- (export.parser (all ?.and
- (?code.form (?.and ?code.local (?.some ?code.local)))
- ?code.any
- ?code.any))])
+ (export.with (all ?.and
+ (?code.form (?.and ?code.local (?.some ?code.local)))
+ ?code.any
+ ?code.any))])
(do meta.monad
[here meta.current_module_name]
(if (n.= (list.size parameters)
diff --git a/stdlib/source/library/lux/control/function/polymorphism/context.lux b/stdlib/source/library/lux/control/function/polymorphism/context.lux
index 904cc100c..be28c494e 100644
--- a/stdlib/source/library/lux/control/function/polymorphism/context.lux
+++ b/stdlib/source/library/lux/control/function/polymorphism/context.lux
@@ -41,7 +41,7 @@
<representation>
(.def .public layer
- (syntax (_ [[export_policy name] (export.parser ?code.local)])
+ (syntax (_ [[export_policy name] (export.with ?code.local)])
(do meta.monad
[@ meta.current_module_name]
(in (list (` (.def (, export_policy) (, (code.local name))
@@ -118,7 +118,7 @@
(` ((,' .,') (, it))))
(.def .public def
- (syntax (_ [[export_policy signature] (export.parser ..signature)
+ (syntax (_ [[export_policy signature] (export.with ..signature)
quantifications (?code.tuple (?.some ?code.any))
context ?code.any
inputs (?code.tuple (?.many ?code.any))
diff --git a/stdlib/source/library/lux/control/function/polymorphism/predicate.lux b/stdlib/source/library/lux/control/function/polymorphism/predicate.lux
index 78a238fa4..3a145e7eb 100644
--- a/stdlib/source/library/lux/control/function/polymorphism/predicate.lux
+++ b/stdlib/source/library/lux/control/function/polymorphism/predicate.lux
@@ -58,14 +58,14 @@
(.def .public def
(syntax (_ [[export_policy signature quantifications inputs output default methods]
- (export.parser
- (all ?.and
- ..signature
- (?code.tuple (?.some ?code.any))
- (?code.tuple (?.many ?code.any))
- ?code.any
- ?code.any
- (?.some ?code.any)))])
+ (export.with
+ (all ?.and
+ ..signature
+ (?code.tuple (?.some ?code.any))
+ (?code.tuple (?.many ?code.any))
+ ?code.any
+ ?code.any
+ (?.some ?code.any)))])
(<| (with_symbols [g!self g!_ g!scenarios g!scenario g!mixin])
(..declaration [#function (the #name signature)
#quantifications quantifications
diff --git a/stdlib/source/library/lux/control/function/polymorphism/type.lux b/stdlib/source/library/lux/control/function/polymorphism/type.lux
index 6dbd0ef42..5aec52b70 100644
--- a/stdlib/source/library/lux/control/function/polymorphism/type.lux
+++ b/stdlib/source/library/lux/control/function/polymorphism/type.lux
@@ -34,12 +34,12 @@
(.def .public def
(syntax (_ [[export_policy name parameters type methods]
- (export.parser
- (all ?.and
- ?code.local
- (?code.tuple (?.many ?code.local))
- ?code.any
- (?.many ?code.any)))])
+ (export.with
+ (all ?.and
+ ?code.local
+ (?code.tuple (?.many ?code.local))
+ ?code.any
+ (?.many ?code.any)))])
(<| (do meta.monad
[@ meta.current_module_name
g!interface (macro.symbol name)
diff --git a/stdlib/source/library/lux/control/function/variadic.lux b/stdlib/source/library/lux/control/function/variadic.lux
index 5b53bbe83..e914dde9e 100644
--- a/stdlib/source/library/lux/control/function/variadic.lux
+++ b/stdlib/source/library/lux/control/function/variadic.lux
@@ -36,10 +36,10 @@
(.def .public def
(syntax (_ [[exported? [name parameters] type body]
- (export.parser (all ?.and
- (?code.form (?.and ?code.local (?.some ?code.local)))
- ?code.any
- ?code.any))])
+ (export.with (all ?.and
+ (?code.form (?.and ?code.local (?.some ?code.local)))
+ ?code.any
+ ?code.any))])
(do meta.monad
[here meta.current_module_name]
(if (n.= (list.size parameters)
diff --git a/stdlib/source/library/lux/control/security/capability.lux b/stdlib/source/library/lux/control/security/capability.lux
index e422ba4ed..bdcc86586 100644
--- a/stdlib/source/library/lux/control/security/capability.lux
+++ b/stdlib/source/library/lux/control/security/capability.lux
@@ -18,7 +18,7 @@
["<[1]>" \\parser]]
["[0]" macro (.only)
[syntax (.only syntax)
- ["|[0]|" export]
+ ["[0]" export]
["|[0]|" declaration]]]
[type
["[0]" primitive (.except def)]]]]])
@@ -35,10 +35,10 @@
(def .public capability
(syntax (_ [[export_policy declaration [forger input output]]
- (|export|.parser
- (all <>.and
- |declaration|.parser
- (<code>.form (all <>.and <code>.local <code>.any <code>.any))))])
+ (export.with
+ (all <>.and
+ |declaration|.parser
+ (<code>.form (all <>.and <code>.local <code>.any <code>.any))))])
(macro.with_symbols [g!_]
(do [! meta.monad]
[this_module meta.current_module_name
diff --git a/stdlib/source/library/lux/meta/macro/context.lux b/stdlib/source/library/lux/meta/macro/context.lux
index c39bbd539..4ec34b5df 100644
--- a/stdlib/source/library/lux/meta/macro/context.lux
+++ b/stdlib/source/library/lux/meta/macro/context.lux
@@ -230,9 +230,9 @@
(syntax (_ [.let [! ?.monad
?local (at ! each code.local ?code.local)]
- [export_$? $] (?code.tuple (export.parser ?code.local))
- [export_expression? g!expression] (?code.tuple (export.parser ?local))
- [export_declaration? g!declaration] (?code.tuple (export.parser ?local))
+ [export_$? $] (?code.tuple (export.with ?code.local))
+ [export_expression? g!expression] (?code.tuple (export.with ?local))
+ [export_declaration? g!declaration] (?code.tuple (export.with ?local))
context_type ?code.any])
(do [! meta.monad]
diff --git a/stdlib/source/library/lux/meta/macro/syntax/export.lux b/stdlib/source/library/lux/meta/macro/syntax/export.lux
index 98db6124e..522fefb6b 100644
--- a/stdlib/source/library/lux/meta/macro/syntax/export.lux
+++ b/stdlib/source/library/lux/meta/macro/syntax/export.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except)
+ [lux (.except with)
[abstract
[monad (.only do)]]
[control
@@ -37,6 +37,6 @@
_
(in default)))))
-(def .public parser
+(def .public with
(All (_ a) (-> (Parser a) (Parser [Policy a])))
(<>.and ..policy))
diff --git a/stdlib/source/library/lux/meta/macro/vocabulary.lux b/stdlib/source/library/lux/meta/macro/vocabulary.lux
index 31e0dc1d9..71327712d 100644
--- a/stdlib/source/library/lux/meta/macro/vocabulary.lux
+++ b/stdlib/source/library/lux/meta/macro/vocabulary.lux
@@ -25,7 +25,7 @@
(.def local
(Parser [Code Code])
- (?code.tuple (export.parser (?#each code.local ?code.local))))
+ (?code.tuple (export.with (?#each code.local ?code.local))))
(.def .public def
(syntax (_ [[public|private@type type] ..local
diff --git a/stdlib/source/library/lux/meta/type/primitive.lux b/stdlib/source/library/lux/meta/type/primitive.lux
index db066d253..033be6d6e 100644
--- a/stdlib/source/library/lux/meta/type/primitive.lux
+++ b/stdlib/source/library/lux/meta/type/primitive.lux
@@ -17,7 +17,7 @@
["[0]" macro (.only)
["[0]" context]
[syntax (.only syntax)
- ["|[0]|" export]]]]]]
+ ["[0]" export]]]]]]
["[0]" //])
(type .public Frame
@@ -70,12 +70,12 @@
(.def abstract
(Parser [Code [Text (List Text)] Code (List Code)])
- (|export|.parser
- (all <>.and
- ..declarationP
- <code>.any
- (<>.some <code>.any)
- )))
+ (export.with
+ (all <>.and
+ ..declarationP
+ <code>.any
+ (<>.some <code>.any)
+ )))
... TODO: Make sure the generated code always gets optimized away.
... (This applies to uses of "abstraction" and "representation")
diff --git a/stdlib/source/library/lux/meta/type/row.lux b/stdlib/source/library/lux/meta/type/row.lux
index c4c8b9b1f..3d3ac324d 100644
--- a/stdlib/source/library/lux/meta/type/row.lux
+++ b/stdlib/source/library/lux/meta/type/row.lux
@@ -103,7 +103,7 @@
(n.= (list.size it))))
(def .public type
- (syntax (_ [[export_policy [name parameters]] (export.parser ..declaration)
+ (syntax (_ [[export_policy [name parameters]] (export.with ..declaration)
[super slots] ..definition])
(let [slot_names (list#each product.left slots)]
(if (unique_slots? slot_names)
diff --git a/stdlib/source/library/lux/test/property.lux b/stdlib/source/library/lux/test/property.lux
index 732be561f..db3adfb11 100644
--- a/stdlib/source/library/lux/test/property.lux
+++ b/stdlib/source/library/lux/test/property.lux
@@ -108,8 +108,19 @@
(exception.def .public must_try_test_at_least_once)
-(def .public (times amount test)
- (-> Nat Test Test)
+(type .public Success_Policy
+ Bit)
+
+(def .public ignore_success
+ Success_Policy
+ #0)
+
+(def .public announce_success
+ Success_Policy
+ #1)
+
+(def .public (times amount announce_success? test)
+ (-> Nat Success_Policy Test Test)
(when amount
0 (..failure (exception.error ..must_try_test_at_least_once []))
_ (do random.monad
@@ -120,12 +131,16 @@
[[tally documentation] instance]
(if (..failed? tally)
(in [tally (times_failure seed documentation)])
- (when amount
- 1 instance
- _ (|> test
- (times (-- amount))
- (random.result prng')
- product.right))))])))))
+ (exec
+ (if announce_success?
+ (debug.log! (format "Succeeded with this seed: " (%.nat seed)))
+ [])
+ (when amount
+ 1 instance
+ _ (|> test
+ (times (-- amount) announce_success?)
+ (random.result prng')
+ product.right)))))])))))
(def (description duration tally)
(-> Duration Tally Text)
diff --git a/stdlib/source/library/lux/world/net.lux b/stdlib/source/library/lux/world/net.lux
index fccb47177..4bbf75cd3 100644
--- a/stdlib/source/library/lux/world/net.lux
+++ b/stdlib/source/library/lux/world/net.lux
@@ -1,13 +1,13 @@
(.require
[library
- [lux (.except #host)]])
+ [lux (.except #host)]]
+ [/
+ [uri
+ [port (.only Port)]]])
(type .public Host
Text)
-(type .public Port
- Nat)
-
(type .public URL
Text)
diff --git a/stdlib/source/library/lux/world/net/uri/port.lux b/stdlib/source/library/lux/world/net/uri/port.lux
new file mode 100644
index 000000000..3b6d8a8e5
--- /dev/null
+++ b/stdlib/source/library/lux/world/net/uri/port.lux
@@ -0,0 +1,103 @@
+... https://en.wikipedia.org/wiki/List_of_TCP_and_UDP_port_numbers
+(.require
+ [library
+ [lux (.except)
+ [meta
+ [macro
+ ["[0]" template]]]]])
+
+(type .public Port
+ Nat)
+
+(with_template [<port> <name> <aliases>']
+ [(def .public <name>
+ Port
+ <port>)
+
+ (with_expansions [<aliases> (template.spliced <aliases>')]
+ (with_template [<alias>]
+ [(def .public <alias> <name>)]
+
+ <aliases>
+ ))]
+
+ [007 echo_protocol []] ... https://en.wikipedia.org/wiki/Echo_Protocol
+ [009 discard_protocol []] ... https://en.wikipedia.org/wiki/Discard_Protocol
+ [013 daytime_protocol []] ... https://en.wikipedia.org/wiki/Daytime_Protocol
+ [017 quote_of_the_day []] ... https://en.wikipedia.org/wiki/QOTD
+ [018 message_send_protocol []] ... https://en.wikipedia.org/wiki/Message_Send_Protocol
+ [019 character_generator_protocol []] ... https://en.wikipedia.org/wiki/Character_Generator_Protocol
+ [020 file_transfer_protocol_data_transfer [[ftp_data_transfer]]]
+ [021 file_transfer_protocol_control [[ftp_control]]]
+ [023 telnet []] ... https://en.wikipedia.org/wiki/Telnet
+ [025 simple_mail_transfer_protocol [[smtp]]] ... https://en.wikipedia.org/wiki/Simple_Mail_Transfer_Protocol
+ [037 time_protocol []] ... https://en.wikipedia.org/wiki/Time_Protocol
+ [042 host_name_server_protocol []] ... https://en.wikipedia.org/wiki/ARPA_Host_Name_Server_Protocol
+ [043 whois []] ... https://en.wikipedia.org/wiki/WHOIS
+ [053 domain_name_system [[dns]]] ... https://en.wikipedia.org/wiki/Domain_Name_System
+ [070 gopher []] ... https://en.wikipedia.org/wiki/Gopher_(protocol)
+ [079 finger []] ... https://en.wikipedia.org/wiki/Finger_(protocol)
+ [080 hypertext_transfer_protocol [[http]]] ... https://en.wikipedia.org/wiki/Hypertext_Transfer_Protocol
+ [088 kerberos []] ... https://en.wikipedia.org/wiki/Kerberos_(protocol)
+
+ [104 digital_imaging_and_communications_in_medicine [[dicom]]] ... https://en.wikipedia.org/wiki/DICOM
+ [107 remote_user_telnet_service [[rtelnet]]] ... https://en.wikipedia.org/wiki/Rtelnet
+ [109 post_office_protocol_2 [[pop2]]] ... https://en.wikipedia.org/wiki/Post_Office_Protocol
+ [110 post_office_protocol_3 [[pop3]]] ... https://en.wikipedia.org/wiki/Post_Office_Protocol
+ [111 open_network_computing_remote_procedure_call [[onc_rpc]]] ... https://en.wikipedia.org/wiki/Sun_RPC
+ [115 simple_file_transfer_protocol [[simple_ftp]]] ... https://en.wikipedia.org/wiki/File_Transfer_Protocol#Simple_File_Transfer_Protocol
+ [119 network_news_transfer_protocol [[nntp]]] ... https://en.wikipedia.org/wiki/Network_News_Transfer_Protocol
+ [123 network_time_protocol [[ntp]]] ... https://en.wikipedia.org/wiki/Network_Time_Protocol
+ [143 internet_message_access_protocol [[imap]]] ... https://en.wikipedia.org/wiki/Internet_Message_Access_Protocol
+ [153 simple_gateway_monitoring_protocol [[sgmp]]] ... https://en.wikipedia.org/wiki/Simple_Gateway_Monitoring_Protocol
+ [156 structured_query_language [[sql]]] ... https://en.wikipedia.org/wiki/SQL
+ [161 simple_network_management_protocol [[snmp]]] ... https://en.wikipedia.org/wiki/Simple_Network_Management_Protocol
+ [162 simple_network_management_protocol_trap [[snmp_trap]]] ... https://en.wikipedia.org/wiki/Simple_Network_Management_Protocol
+ [169 secure_neighbor_discovery [[send]]] ... https://en.wikipedia.org/wiki/Secure_Neighbor_Discovery
+ [177 x_display_manager_control_protocol [[xdmcp]]] ... https://en.wikipedia.org/wiki/X_display_manager#XDMCP
+ [179 border_gateway_protocol [[bgp]]] ... https://en.wikipedia.org/wiki/Border_Gateway_Protocol
+ [194 internet_relay_chat [[irc]]] ... https://en.wikipedia.org/wiki/Internet_Relay_Chat
+ [199 snmp_unix_multiplexer [[smux]]] ... https://datatracker.ietf.org/doc/html/rfc1227#page-8
+
+ [264 border_gateway_multicast_protocol [[bgmp]]] ... https://en.wikipedia.org/wiki/Border_Gateway_Multicast_Protocol
+
+ [319 precision_time_protocol_event_messages [[ptp_event_messages]]] ... https://en.wikipedia.org/wiki/Precision_Time_Protocol
+ [320 precision_time_protocol_general_messages [[ptp_general_messages]]] ... https://en.wikipedia.org/wiki/Precision_Time_Protocol
+ [389 lightweight_directory_access_protocol [[ldap]]] ... https://en.wikipedia.org/wiki/Lightweight_Directory_Access_Protocol
+
+ [401 uninterruptible_power_supply [[ups]]] ... https://en.wikipedia.org/wiki/Uninterruptible_power_supply
+ [427 service_location_protocol [[slp]]] ... https://en.wikipedia.org/wiki/Service_Location_Protocol
+ [443 hypertext_transfer_protocol_secure [[https]]] ... https://en.wikipedia.org/wiki/HTTPS
+ [444 simple_network_paging_protocol [[snpp]]] ... https://en.wikipedia.org/wiki/Simple_Network_Paging_Protocol
+ [464 kerberos_change/set_password []] ... https://en.wikipedia.org/wiki/Kerberos_(protocol)
+
+ [530 remote_procedure_call [[rpc]]] ... https://en.wikipedia.org/wiki/Remote_procedure_call
+ [554 real_time_streaming_protocol [[rtsp]]] ... https://en.wikipedia.org/wiki/Real_Time_Streaming_Protocol
+ [546 dynamic_host_configuration_protocol/6_client [[dhcp/6_client]]] ... https://en.wikipedia.org/wiki/Dynamic_Host_Configuration_Protocol
+ [547 dynamic_host_configuration_protocol/6_server [[dhcp/6_server]]] ... https://en.wikipedia.org/wiki/Dynamic_Host_Configuration_Protocol
+ [563 network_news_transfer_protocol_secure [[nntps]]] ... https://en.wikipedia.org/wiki/Network_News_Transfer_Protocol
+
+ [631 internet_printing_protocol [[ipp]]] ... https://en.wikipedia.org/wiki/Internet_Printing_Protocol
+ [636 lightweight_directory_access_protocol_secure [[ldaps]]] ... https://en.wikipedia.org/wiki/Lightweight_Directory_Access_Protocol
+ [639 multicast_source_discovery_protocol [[msdp]]] ... https://en.wikipedia.org/wiki/Multicast_Source_Discovery_Protocol
+ [646 label_distribution_protocol [[ldp]]] ... https://en.wikipedia.org/wiki/Label_Distribution_Protocol
+ [674 application_configuration_access_protocol [[acap]]] ... https://en.wikipedia.org/wiki/Application_Configuration_Access_Protocol
+ [698 optimized_link_state_routing_protocol [[olsr]]] ... https://en.wikipedia.org/wiki/Optimized_Link_State_Routing_Protocol
+
+ [700 extensible_provisioning_protocol [[epp]]] ... https://en.wikipedia.org/wiki/Extensible_Provisioning_Protocol
+ [701 link_management_protocol [[lmp]]] ... https://www.ietf.org/rfc/rfc4204.txt
+ [706 secure_internet_live_conferencing_protocol [[silc]]] ... https://en.wikipedia.org/wiki/SILC_(protocol)
+ [749 kerberos_administration []] ... https://en.wikipedia.org/wiki/Kerberos_(protocol)
+
+ [829 certificate_management_protocol [[cmp]]] ... https://en.wikipedia.org/wiki/Certificate_Management_Protocol
+ [830 network_configuration_protocol/ssh [[netconf/ssh]]] ... https://en.wikipedia.org/wiki/NETCONF
+ [831 network_configuration_protocol/beep [[netconf/beep]]] ... https://en.wikipedia.org/wiki/NETCONF
+ [832 network_configuration_protocol/soap/https [[netconf/soap/https]]] ... https://en.wikipedia.org/wiki/NETCONF
+ [833 network_configuration_protocol/soap/beep [[netconf/soap/beep]]] ... https://en.wikipedia.org/wiki/NETCONF
+
+ [989 file_transfer_protocol_secure_data_transfer [[ftps_data_transfer]]] ... https://en.wikipedia.org/wiki/FTPS
+ [990 file_transfer_protocol_secure_control [[ftps_control]]] ... https://en.wikipedia.org/wiki/FTPS
+ [992 telnet/tls []] ... https://en.wikipedia.org/wiki/Telnet
+ [993 internet_message_access_protocol_secure [[imaps]]] ... https://en.wikipedia.org/wiki/Internet_Message_Access_Protocol
+ [995 post_office_protocol_3_secure [[pop3s]]] ... https://en.wikipedia.org/wiki/Post_Office_Protocol
+ )
diff --git a/stdlib/source/library/lux/world/net/uri/scheme.lux b/stdlib/source/library/lux/world/net/uri/scheme.lux
index 2c5d7b36f..aabe810b1 100644
--- a/stdlib/source/library/lux/world/net/uri/scheme.lux
+++ b/stdlib/source/library/lux/world/net/uri/scheme.lux
@@ -95,30 +95,30 @@
[ftp file_transfer_protocol]
[http hypertext_transfer_protocol]
- [https secure_hypertext_transfer_protocol]
+ [https hypertext_transfer_protocol_secure]
[imap internet_message_access_protocol]
[ipp internet_printing_protocol]
- [ipps secure_internet_printing_protocol]
+ [ipps internet_printing_protocol_secure]
[irc internet_relay_chat]
- [ircs secure_internet_relay_chat]
+ [ircs internet_relay_chat_secure]
[ldap lightweight_directory_access_protocol]
- [ldaps secure_lightweight_directory_access_protocol]
+ [ldaps lightweight_directory_access_protocol_secure]
[pop post_office_protocol]
[sip session_initiation_protocol]
- [sips secure_session_initiation_protocol]
+ [sips session_initiation_protocol_secure]
[sms short_message_service]
[snmp simple_network_management_protocol]
[ssh secure_shell_protocol]
[stun session_traversal_utilities_for_nat]
- [stuns secure_session_traversal_utilities_for_nat]
+ [stuns session_traversal_utilities_for_nat_secure]
[turn traversal_using_relays_around_nat]
- [turns secure_traversal_using_relays_around_nat]
+ [turns traversal_using_relays_around_nat_secure]
[xmpp extensible_messaging_and_presence_protocol]
)
diff --git a/stdlib/source/specification/lux/abstract/apply.lux b/stdlib/source/specification/lux/abstract/apply.lux
index 607024f11..eaf4d741c 100644
--- a/stdlib/source/specification/lux/abstract/apply.lux
+++ b/stdlib/source/specification/lux/abstract/apply.lux
@@ -16,64 +16,53 @@
[\\library
["[0]" / (.only Apply)]]
[//
- [functor (.only Injection Comparison)]])
+ ["[0]S" functor (.only Injection Comparison)]])
-(def (identity injection comparison (open "/#[0]"))
+(def .public (spec injection comparison it)
(All (_ f) (-> (Injection f) (Comparison f) (Apply f) Test))
- (do [! random.monad]
- [sample (at ! each injection random.nat)]
- (_.test "Identity."
- ((comparison n.=)
- (/#on sample (injection function.identity))
- sample))))
+ (<| (_.for [/.Apply])
+ (type.let [:$/1: (-> Nat Nat)])
+ (do [! random.monad]
+ [sample random.nat
+ increase (is (Random :$/1:)
+ (at ! each n.+ random.nat))
+ decrease (is (Random :$/1:)
+ (at ! each n.- random.nat))])
+ (all _.and
+ (_.for [/.functor]
+ (functorS.spec injection comparison (the /.functor it)))
-(def (homomorphism injection comparison (open "/#[0]"))
- (All (_ f) (-> (Injection f) (Comparison f) (Apply f) Test))
- (do [! random.monad]
- [sample random.nat
- increase (at ! each n.+ random.nat)]
- (_.test "Homomorphism."
- ((comparison n.=)
- (/#on (injection sample) (injection increase))
- (injection (increase sample))))))
+ (_.coverage [/.on]
+ (let [(open "/#[0]") it
-(def (interchange injection comparison (open "/#[0]"))
- (All (_ f) (-> (Injection f) (Comparison f) (Apply f) Test))
- (do [! random.monad]
- [sample random.nat
- increase (at ! each n.+ random.nat)]
- (_.test "Interchange."
- ((comparison n.=)
- (/#on (injection sample) (injection increase))
- (/#on (injection increase) (injection (is (-> (-> Nat Nat) Nat)
- (function (_ f) (f sample)))))))))
+ identity!
+ ((comparison n.=)
+ (/#on (injection sample)
+ (injection function.identity))
+ (injection sample))
-(def (composition injection comparison (open "/#[0]"))
- (All (_ f) (-> (Injection f) (Comparison f) (Apply f) Test))
- (type.let [:$/1: (-> Nat Nat)]
- (do [! random.monad]
- [sample random.nat
- increase (is (Random :$/1:)
- (at ! each n.+ random.nat))
- decrease (is (Random :$/1:)
- (at ! each n.- random.nat))]
- (_.test "Composition."
- ((comparison n.=)
- (|> (injection (is (-> :$/1: :$/1: :$/1:)
- function.composite))
- (/#on (injection increase))
- (/#on (injection decrease))
- (/#on (injection sample)))
- (/#on (/#on (injection sample)
- (injection increase))
- (injection decrease)))))))
-
-(def .public (spec injection comparison apply)
- (All (_ f) (-> (Injection f) (Comparison f) (Apply f) Test))
- (_.for [/.Apply]
- (all _.and
- (..identity injection comparison apply)
- (..homomorphism injection comparison apply)
- (..interchange injection comparison apply)
- (..composition injection comparison apply)
- )))
+ homomorphism!
+ ((comparison n.=)
+ (/#on (injection sample) (injection increase))
+ (injection (increase sample)))
+
+ interchange!
+ ((comparison n.=) (/#on (injection sample) (injection increase))
+ (/#on (injection increase) (injection (is (-> (-> Nat Nat) Nat)
+ (function (_ f) (f sample))))))
+
+ composition!
+ ((comparison n.=)
+ (|> (injection (is (-> :$/1: :$/1: :$/1:)
+ function.composite))
+ (/#on (injection increase))
+ (/#on (injection decrease))
+ (/#on (injection sample)))
+ (/#on (/#on (injection sample)
+ (injection increase))
+ (injection decrease)))]
+ (and identity!
+ homomorphism!
+ interchange!
+ composition!)))
+ )))
diff --git a/stdlib/source/specification/lux/abstract/comonad.lux b/stdlib/source/specification/lux/abstract/comonad.lux
index 2583715f2..9763f136b 100644
--- a/stdlib/source/specification/lux/abstract/comonad.lux
+++ b/stdlib/source/specification/lux/abstract/comonad.lux
@@ -12,51 +12,42 @@
[\\library
["[0]" / (.only CoMonad)]]
[//
- [functor (.only Injection Comparison)]])
+ ["[0]S" functor (.only Injection Comparison)]])
-(def (left_identity injection (open "_//[0]"))
- (All (_ f) (-> (Injection f) (CoMonad f) Test))
- (do [! random.monad]
- [sample random.nat
- morphism (at ! each (function (_ diff)
- (|>> _//out (n.+ diff)))
- random.nat)
- .let [start (injection sample)]]
- (_.test "Left identity."
- (n.= (morphism start)
- (|> start _//disjoint (_//each morphism) _//out)))))
-
-(def (right_identity injection comparison (open "_//[0]"))
- (All (_ f) (-> (Injection f) (Comparison f) (CoMonad f) Test))
- (do random.monad
- [sample random.nat
- .let [start (injection sample)
- == (comparison n.=)]]
- (_.test "Right identity."
- (== start
- (|> start _//disjoint (_//each _//out))))))
-
-(def (associativity injection comparison (open "_//[0]"))
- (All (_ f) (-> (Injection f) (Comparison f) (CoMonad f) Test))
- (do [! random.monad]
- [sample random.nat
- increase (at ! each (function (_ diff)
- (|>> _//out (n.+ diff)))
- random.nat)
- decrease (at ! each (function (_ diff)
- (|>> _//out(n.- diff)))
- random.nat)
- .let [start (injection sample)
- == (comparison n.=)]]
- (_.test "Associativity."
- (== (|> start _//disjoint (_//each (|>> _//disjoint (_//each increase) decrease)))
- (|> start _//disjoint (_//each increase) _//disjoint (_//each decrease))))))
-
-(def .public (spec injection comparison subject)
+(def .public (spec injection comparison it)
(All (_ f) (-> (Injection f) (Comparison f) (CoMonad f) Test))
(<| (_.for [/.CoMonad])
+ (do [! random.monad]
+ [.let [(open "/#[0]") it]
+ sample random.nat
+ increase (at ! each (function (_ diff)
+ (|>> /#out (n.+ diff)))
+ random.nat)
+ decrease (at ! each (function (_ diff)
+ (|>> /#out (n.- diff)))
+ random.nat)
+ morphism (at ! each (function (_ diff)
+ (|>> /#out (n.+ diff)))
+ random.nat)
+ .let [start (injection sample)
+ == (comparison n.=)]])
(all _.and
- (..left_identity injection subject)
- (..right_identity injection comparison subject)
- (..associativity injection comparison subject)
+ (_.for [/.functor]
+ (functorS.spec injection comparison (the /.functor it)))
+
+ (_.coverage [/.disjoint /.out]
+ (let [left_identity!
+ (n.= (morphism start)
+ (|> start /#disjoint (/#each morphism) /#out))
+
+ right_identity!
+ (== start
+ (|> start /#disjoint (/#each /#out)))
+
+ associativity!
+ (== (|> start /#disjoint (/#each (|>> /#disjoint (/#each increase) decrease)))
+ (|> start /#disjoint (/#each increase) /#disjoint (/#each decrease)))]
+ (and left_identity!
+ right_identity!
+ associativity!)))
)))
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index f00cf0abc..d2af0e624 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -1274,6 +1274,6 @@
100)]
(<| io.io
_.run!
- (_.times times)
+ (_.times times _.announce_success)
..test
))))
diff --git a/stdlib/source/test/lux/test/property.lux b/stdlib/source/test/lux/test/property.lux
index dfaaddac5..f5754958a 100644
--- a/stdlib/source/test/lux/test/property.lux
+++ b/stdlib/source/test/lux/test/property.lux
@@ -62,7 +62,7 @@
/.Test
(all /.and
(do [! random.monad]
- [times_unit_test (/.times 0 (/.test "" true))]
+ [times_unit_test (/.times 0 /.ignore_success (/.test "" true))]
(in (do async.monad
[[tally error] times_unit_test]
(unit.coverage [/.must_try_test_at_least_once]
@@ -73,7 +73,7 @@
[expected (at ! each (|>> (n.% 10) ++) random.nat)
.let [counter (is (Atom Nat)
(atom.atom 0))]
- times_unit_test (<| (/.times expected)
+ times_unit_test (<| (/.times expected /.ignore_success)
(do !
[_ (in [])
.let [_ (io.run! (atom.update! ++ counter))]]
@@ -85,6 +85,9 @@
(and (n.= expected actual)
(n.= 1 (the tally.#successes tally))
(n.= 0 (the tally.#failures tally)))))))
+ (/.coverage [/.Success_Policy /.ignore_success /.announce_success]
+ (and (not /.ignore_success)
+ /.announce_success))
))
(def in_parallel
diff --git a/stdlib/source/test/lux/world/net.lux b/stdlib/source/test/lux/world/net.lux
index 08c56fa4b..885a918e7 100644
--- a/stdlib/source/test/lux/world/net.lux
+++ b/stdlib/source/test/lux/world/net.lux
@@ -21,6 +21,7 @@
["[1][0]" uri
["[1]/[0]" encoding]
["[1]/[0]" scheme]
+ ["[1]/[0]" port]
["[1]/[0]" path]
["[1]/[0]" query]]])
@@ -32,8 +33,6 @@
(all _.and
(_.coverage [/.Host]
true)
- (_.coverage [/.Port]
- true)
(_.coverage [/.URL]
true)
(_.coverage [/.Address]
@@ -50,6 +49,7 @@
/uri/encoding.test
/uri/scheme.test
+ /uri/port.test
/uri/path.test
/uri/query.test
)))
diff --git a/stdlib/source/test/lux/world/net/uri/port.lux b/stdlib/source/test/lux/world/net/uri/port.lux
new file mode 100644
index 000000000..14ffa5059
--- /dev/null
+++ b/stdlib/source/test/lux/world/net/uri/port.lux
@@ -0,0 +1,177 @@
+(.require
+ [library
+ [lux (.except)
+ [abstract
+ [monad (.only do)]]
+ [data
+ [collection
+ ["[0]" list]
+ ["[0]" set]]]
+ [math
+ ["[0]" random (.only Random)]
+ [number
+ ["[0]" nat]]]
+ [test
+ ["_" property (.only Test)]]]]
+ [\\library
+ ["[0]" /]])
+
+(def .public test
+ Test
+ (<| (_.covering /._)
+ (do [! random.monad]
+ [])
+ (`` (all _.and
+ (with_expansions [<options> (these /.echo_protocol
+ /.discard_protocol
+ /.daytime_protocol
+ /.quote_of_the_day
+ /.message_send_protocol
+ /.character_generator_protocol
+ /.file_transfer_protocol_data_transfer
+ /.file_transfer_protocol_control
+ /.telnet
+ /.simple_mail_transfer_protocol
+ /.time_protocol
+ /.host_name_server_protocol
+ /.whois
+ /.domain_name_system
+ /.gopher
+ /.finger
+ /.hypertext_transfer_protocol
+ /.kerberos
+
+ /.digital_imaging_and_communications_in_medicine
+ /.remote_user_telnet_service
+ /.post_office_protocol_2
+ /.post_office_protocol_3
+ /.open_network_computing_remote_procedure_call
+ /.simple_file_transfer_protocol
+ /.network_news_transfer_protocol
+ /.network_time_protocol
+ /.internet_message_access_protocol
+ /.simple_gateway_monitoring_protocol
+ /.structured_query_language
+ /.simple_network_management_protocol
+ /.simple_network_management_protocol_trap
+ /.secure_neighbor_discovery
+ /.x_display_manager_control_protocol
+ /.border_gateway_protocol
+ /.internet_relay_chat
+ /.snmp_unix_multiplexer
+
+ /.border_gateway_multicast_protocol
+
+ /.precision_time_protocol_event_messages
+ /.precision_time_protocol_general_messages
+ /.lightweight_directory_access_protocol
+
+ /.uninterruptible_power_supply
+ /.service_location_protocol
+ /.hypertext_transfer_protocol_secure
+ /.simple_network_paging_protocol
+ /.kerberos_change/set_password
+
+ /.remote_procedure_call
+ /.real_time_streaming_protocol
+ /.dynamic_host_configuration_protocol/6_client
+ /.dynamic_host_configuration_protocol/6_server
+ /.network_news_transfer_protocol_secure
+
+ /.internet_printing_protocol
+ /.lightweight_directory_access_protocol_secure
+ /.multicast_source_discovery_protocol
+ /.label_distribution_protocol
+ /.application_configuration_access_protocol
+ /.optimized_link_state_routing_protocol
+
+ /.extensible_provisioning_protocol
+ /.link_management_protocol
+ /.secure_internet_live_conferencing_protocol
+ /.kerberos_administration
+
+ /.certificate_management_protocol
+ /.network_configuration_protocol/ssh
+ /.network_configuration_protocol/beep
+ /.network_configuration_protocol/soap/https
+ /.network_configuration_protocol/soap/beep
+
+ /.file_transfer_protocol_secure_data_transfer
+ /.file_transfer_protocol_secure_control
+ /.telnet/tls
+ /.internet_message_access_protocol_secure
+ /.post_office_protocol_3_secure)]
+ (_.coverage [<options>]
+ (let [options (list <options>)
+ uniques (set.of_list nat.hash options)]
+ (nat.= (list.size options)
+ (set.size uniques)))))
+ (,, (with_template [<long> <short>]
+ [(_.coverage [<short>]
+ (same? <long> <short>))]
+
+ [/.file_transfer_protocol_data_transfer /.ftp_data_transfer]
+ [/.file_transfer_protocol_control /.ftp_control]
+ [/.simple_mail_transfer_protocol /.smtp]
+ [/.domain_name_system /.dns]
+ [/.hypertext_transfer_protocol /.http]
+
+ [/.digital_imaging_and_communications_in_medicine /.dicom]
+ [/.remote_user_telnet_service /.rtelnet]
+ [/.post_office_protocol_2 /.pop2]
+ [/.post_office_protocol_3 /.pop3]
+ [/.open_network_computing_remote_procedure_call /.onc_rpc]
+ [/.simple_file_transfer_protocol /.simple_ftp]
+ [/.network_news_transfer_protocol /.nntp]
+ [/.network_time_protocol /.ntp]
+ [/.internet_message_access_protocol /.imap]
+ [/.simple_gateway_monitoring_protocol /.sgmp]
+ [/.structured_query_language /.sql]
+ [/.simple_network_management_protocol /.snmp]
+ [/.simple_network_management_protocol_trap /.snmp_trap]
+ [/.secure_neighbor_discovery /.send]
+ [/.x_display_manager_control_protocol /.xdmcp]
+ [/.border_gateway_protocol /.bgp]
+ [/.internet_relay_chat /.irc]
+ [/.snmp_unix_multiplexer /.smux]
+
+ [/.border_gateway_multicast_protocol /.bgmp]
+
+ [/.precision_time_protocol_event_messages /.ptp_event_messages]
+ [/.precision_time_protocol_general_messages /.ptp_general_messages]
+ [/.lightweight_directory_access_protocol /.ldap]
+
+ [/.uninterruptible_power_supply /.ups]
+ [/.service_location_protocol /.slp]
+ [/.hypertext_transfer_protocol_secure /.https]
+ [/.simple_network_paging_protocol /.snpp]
+
+ [/.remote_procedure_call /.rpc]
+ [/.real_time_streaming_protocol /.rtsp]
+ [/.dynamic_host_configuration_protocol/6_client /.dhcp/6_client]
+ [/.dynamic_host_configuration_protocol/6_server /.dhcp/6_server]
+ [/.network_news_transfer_protocol_secure /.nntps]
+
+ [/.internet_printing_protocol /.ipp]
+ [/.lightweight_directory_access_protocol_secure /.ldaps]
+ [/.multicast_source_discovery_protocol /.msdp]
+ [/.label_distribution_protocol /.ldp]
+ [/.application_configuration_access_protocol /.acap]
+ [/.optimized_link_state_routing_protocol /.olsr]
+
+ [/.extensible_provisioning_protocol /.epp]
+ [/.link_management_protocol /.lmp]
+ [/.secure_internet_live_conferencing_protocol /.silc]
+
+ [/.certificate_management_protocol /.cmp]
+ [/.network_configuration_protocol/ssh /.netconf/ssh]
+ [/.network_configuration_protocol/beep /.netconf/beep]
+ [/.network_configuration_protocol/soap/https /.netconf/soap/https]
+ [/.network_configuration_protocol/soap/beep /.netconf/soap/beep]
+
+ [/.file_transfer_protocol_secure_data_transfer /.ftps_data_transfer]
+ [/.file_transfer_protocol_secure_control /.ftps_control]
+ [/.internet_message_access_protocol_secure /.imaps]
+ [/.post_office_protocol_3_secure /.pop3s]
+ ))
+ ))))
diff --git a/stdlib/source/test/lux/world/net/uri/scheme.lux b/stdlib/source/test/lux/world/net/uri/scheme.lux
index c91c49fbf..868f2cddf 100644
--- a/stdlib/source/test/lux/world/net/uri/scheme.lux
+++ b/stdlib/source/test/lux/world/net/uri/scheme.lux
@@ -134,30 +134,30 @@
[/.ftp /.file_transfer_protocol]
[/.http /.hypertext_transfer_protocol]
- [/.https /.secure_hypertext_transfer_protocol]
+ [/.https /.hypertext_transfer_protocol_secure]
[/.imap /.internet_message_access_protocol]
[/.ipp /.internet_printing_protocol]
- [/.ipps /.secure_internet_printing_protocol]
+ [/.ipps /.internet_printing_protocol_secure]
[/.irc /.internet_relay_chat]
- [/.ircs /.secure_internet_relay_chat]
+ [/.ircs /.internet_relay_chat_secure]
[/.ldap /.lightweight_directory_access_protocol]
- [/.ldaps /.secure_lightweight_directory_access_protocol]
+ [/.ldaps /.lightweight_directory_access_protocol_secure]
[/.pop /.post_office_protocol]
[/.sip /.session_initiation_protocol]
- [/.sips /.secure_session_initiation_protocol]
+ [/.sips /.session_initiation_protocol_secure]
[/.sms /.short_message_service]
[/.snmp /.simple_network_management_protocol]
[/.ssh /.secure_shell_protocol]
[/.stun /.session_traversal_utilities_for_nat]
- [/.stuns /.secure_session_traversal_utilities_for_nat]
+ [/.stuns /.session_traversal_utilities_for_nat_secure]
[/.turn /.traversal_using_relays_around_nat]
- [/.turns /.secure_traversal_using_relays_around_nat]
+ [/.turns /.traversal_using_relays_around_nat_secure]
[/.xmpp /.extensible_messaging_and_presence_protocol]))
))))