From ca52e2759425b377b5dc12982e77d433d3a63150 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Sun, 28 Jan 2024 00:20:22 +0100 Subject: [PATCH] Put test values in a dedicated module. --- src/GenericParser/RFC5234.purs | 12 +++--- test/Main.purs | 74 ++++++++-------------------------- test/TestValues.purs | 66 ++++++++++++++++++++++++++++++ 3 files changed, 89 insertions(+), 63 deletions(-) create mode 100644 test/TestValues.purs diff --git a/src/GenericParser/RFC5234.purs b/src/GenericParser/RFC5234.purs index 2769570..f3d456d 100644 --- a/src/GenericParser/RFC5234.purs +++ b/src/GenericParser/RFC5234.purs @@ -34,8 +34,8 @@ asciichar = sat (between 1 127 <<< C.toCharCode) -- | CR: carriage return. -- | -- | CR = %x0D -cr :: forall e. Parser e Unit -cr = void $ char '\r' +cr :: forall e. Parser e Char +cr = char '\r' -- | CRLF: Internet standard newline. -- | @@ -61,8 +61,8 @@ digit = sat isDigit -- | DQUOTE: double quote ("). -- | -- | DQUOTE = %x22 -dquote :: forall e. Parser e Unit -dquote = void $ sat (\x -> C.toCharCode x == 34) +dquote :: forall e. Parser e Char +dquote = sat (\x -> C.toCharCode x == 34) -- | HEXDIG: hexadecimal. -- | @@ -78,8 +78,8 @@ htab = char '\t' -- | LF: linefeed. -- | -- | LF = %x0A -lf :: forall e. Parser e Unit -lf = void $ char '\n' +lf :: forall e. Parser e Char +lf = char '\n' -- | LWSP: Use of this linear-white-space rule permits lines containing only white -- | space that are no longer legal in mail headers and have caused interoperability diff --git a/test/Main.purs b/test/Main.purs index 1a61243..081b453 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -1,5 +1,12 @@ module Test.Main where +import Prelude (Unit, discard, show, ($), (<>)) +import Data.Either (Either(..)) +import Data.Maybe (Maybe(..), maybe) +import Data.String.CodeUnits (fromCharArray) +import Effect.Console (log) +import Effect (Effect, foreachE) + import GenericParser.Parser (Parser(..)) import GenericParser.DomainParser.Common (ldh_str, DomainError(..)) import GenericParser.DomainParserRFC1035 as RFC1035 @@ -7,13 +14,7 @@ import GenericParser.DomainParser as ModernDomains import GenericParser.IPAddress (IPv4Error(..)) import GenericParser.IPAddress as IP import GenericParser.EmailAddress as E - -import Prelude (Unit, discard, show, ($), (<>)) -import Data.Either (Either(..)) -import Data.Maybe (Maybe(..), maybe) -import Data.String.CodeUnits (fromCharArray) -import Effect.Console (log) -import Effect (Effect, foreachE) +import Test.TestValues as T logtest :: forall e v. String -> Parser e v -> String -> (v -> String) -> (e -> String) -> Effect Unit logtest fname (Parser p) str r e = do @@ -59,64 +60,23 @@ showerror_email (E.InvalidDomain e) = "invalid domain: " <> maybe "no domain err main :: Effect Unit main = do - let domains = [ - "", - "-", - ".", - "a", - "a.", - "a-", - "a.x", - "a2.org", - "a33.org", - "xblah.a.x", - "xblah.a2.org", - "xblah.a33.org", - "_dmarc.example.com" - ] - test_series "ldh_str" ldh_str fromCharArray showerror domains + test_series "ldh_str" ldh_str fromCharArray showerror T.domains log "" - test_series "RFC1035.label" RFC1035.label id showerror domains + test_series "RFC1035.label" RFC1035.label id showerror T.domains log "" - test_series "RFC1035.subdomain" RFC1035.subdomain id showerror domains + test_series "RFC1035.subdomain" RFC1035.subdomain id showerror T.domains log "" - test_series "RFC1035.sub_eof" RFC1035.sub_eof id showerror domains + test_series "RFC1035.sub_eof" RFC1035.sub_eof id showerror T.domains log "" - test_series "RFC1035.domain" RFC1035.domain id showerror domains + test_series "RFC1035.domain" RFC1035.domain id showerror T.domains log "" - test_series "ModernDomains.domain" ModernDomains.domain id showerror domains + test_series "ModernDomains.domain" ModernDomains.domain id showerror T.domains log "" - let ipv4_addresses = [ "10..1." - , "10..1" - , "1..2" - , "1.2.3.4" - , "192.168..1" - , "1..2.3.4" - , "1.5.10.255" - , "100.200.300.400" - ] - test_series "IP.ipv4" IP.ipv4 id showerror_ipv4 ipv4_addresses + test_series "IP.ipv4" IP.ipv4 id showerror_ipv4 T.ipv4_addresses log "" - let ipv6_addresses = [ "2001:0" - , "2001::x:0" - , "2001:x::0" - , "2001::0" - , "2001::1:" - , "::" - , "2001::" - , "::1" - , "2001:0db8:0000:0000:0000:8a2e:0370:7334:30:1035:3" - , "2001:0db8:0000:0000:0000:8a2e:0370:7334" - , "2001:0db8::8a2e:0370:7334" - ] - test_series "IP.ipv6" IP.ipv6 id showerror_ipv6 ipv6_addresses + test_series "IP.ipv6" IP.ipv6 id showerror_ipv6 T.ipv6_addresses log "" - let email_addresses = [ "guy@example.com" - , "guy.name@example.com" - , "well-look-at-this-domain@.com" - , "guy-@example.com" - ] - test_series "E.email" E.email id showerror_email email_addresses + test_series "E.email" E.email id showerror_email T.valid_email_addresses diff --git a/test/TestValues.purs b/test/TestValues.purs new file mode 100644 index 0000000..cb75c16 --- /dev/null +++ b/test/TestValues.purs @@ -0,0 +1,66 @@ +module Test.TestValues where + +domains :: Array String +domains + = [ "" + , "-" + , "." + , "a" + , "a." + , "a-" + , "a.x" + , "a2.org" + , "a33.org" + , "xblah.a.x" + , "xblah.a2.org" + , "xblah.a33.org" + , "_dmarc.example.com" + ] + +ipv4_addresses :: Array String +ipv4_addresses + = [ "10..1." + , "10..1" + , "1..2" + , "1.2.3.4" + , "192.168..1" + , "1..2.3.4" + , "1.5.10.255" + , "100.200.300.400" + ] + +ipv6_addresses :: Array String +ipv6_addresses + = [ "2001:0" + , "2001::x:0" + , "2001:x::0" + , "2001::0" + , "2001::1:" + , "::" + , "2001::" + , "::1" + , "2001:0db8:0000:0000:0000:8a2e:0370:7334:30:1035:3" + , "2001:0db8:0000:0000:0000:8a2e:0370:7334" + , "2001:0db8::8a2e:0370:7334" + ] + +valid_email_addresses :: Array String +valid_email_addresses + = [ """simple@example.com""" + , """very.common@example.com""" + , """x@example.com (one-letter local-part)""" + , """long.email-address-with-hyphens@and.subdomains.example.com""" + , """user.name+tag+sorting@example.com (may be routed to user.name@example.com inbox depending on mail server)""" + , """name/surname@example.com (slashes are a printable character, and allowed)""" + , """admin@example (local domain name with no TLD, although ICANN highly discourages dotless email addresses[29])""" + , """example@s.example (see the List of Internet top-level domains)""" + , """" "@example.org (space between the quotes)""" + , """"john..doe"@example.org (quoted double dot)""" + , """mailhost!username@example.org (bangified host route used for uucp mailers)""" + , """"very.(),:;<>[]\".VERY.\"very@\\ \"very\".unusual"@strange.example.com (include non-letters character AND multiple at sign, the first one being double quoted)""" + , """user%example.com@example.org (% escaped mail route to user@example.com via example.org)""" + , """user-@example.org (local-part ending with non-alphanumeric character from the list of allowed printable characters)""" + , """postmaster@[123.123.123.123] (IP addresses are allowed instead of domains when in square brackets, but strongly discouraged)""" + , """postmaster@[IPv6:2001:0db8:85a3:0000:0000:8a2e:0370:7334] (IPv6 uses a different syntax)""" + , """_test@[IPv6:2001:0db8:85a3:0000:0000:8a2e:0370:7334] (begin with underscore different syntax)""" + ]