Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
T
time
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Requirements
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Locked files
Build
Pipelines
Jobs
Pipeline schedules
Test cases
Artifacts
Deploy
Releases
Package Registry
Container Registry
Model registry
Operate
Environments
Terraform modules
Monitor
Incidents
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Code review analytics
Issue analytics
Insights
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Rinat Striungis
time
Commits
c763435e
Commit
c763435e
authored
8 years ago
by
Ashley Yakeley
Browse files
Options
Downloads
Plain Diff
Merge branch 'master' into format-widths
parents
bd85cb05
dd86365d
No related branches found
No related tags found
No related merge requests found
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
test/unix/Test/Format/Format.hs
+45
-52
45 additions, 52 deletions
test/unix/Test/Format/Format.hs
test/unix/Test/TestUtil.hs
+9
-1
9 additions, 1 deletion
test/unix/Test/TestUtil.hs
with
54 additions
and
53 deletions
test/unix/Test/Format/Format.hs
+
45
−
52
View file @
c763435e
...
...
@@ -7,9 +7,11 @@ import Data.Time.Clock.POSIX
import
Data.Char
import
Foreign
import
Foreign.C
import
Test.QuickCheck
hiding
(
Result
)
import
Test.QuickCheck.Property
import
Test.Tasty
import
Test.Tasty.HUnit
import
Test.TestUtil
import
System.IO.Unsafe
{-
size_t format_time (
...
...
@@ -26,8 +28,8 @@ withBuffer n f = withArray (replicate n 0) (\buffer -> do
peekCStringLen
(
buffer
,
fromIntegral
len
)
)
unixFormatTime
::
String
->
TimeZone
->
UTCTime
->
IO
String
unixFormatTime
fmt
zone
time
=
withCString
fmt
(
\
pfmt
->
withCString
(
timeZoneName
zone
)
(
\
pzonename
->
unixFormatTime
::
String
->
TimeZone
->
UTCTime
->
String
unixFormatTime
fmt
zone
time
=
unsafePerformIO
$
withCString
fmt
(
\
pfmt
->
withCString
(
timeZoneName
zone
)
(
\
pzonename
->
withBuffer
100
(
\
buffer
->
format_time
buffer
100
pfmt
(
if
timeZoneSummerOnly
zone
then
1
else
0
)
(
fromIntegral
(
timeZoneMinutes
zone
*
60
))
...
...
@@ -39,36 +41,18 @@ unixFormatTime fmt zone time = withCString fmt (\pfmt -> withCString (timeZoneNa
locale
::
TimeLocale
locale
=
defaultTimeLocale
{
dateTimeFmt
=
"%a %b %e %H:%M:%S %Y"
}
zones
::
[
TimeZone
]
zones
=
[
utc
,
TimeZone
87
True
"Fenwickian Daylight Time"
]
zones
::
Gen
TimeZone
zones
=
do
mins
<-
choose
(
-
2000
,
2000
)
dst
<-
arbitrary
name
<-
return
"ZONE"
return
$
TimeZone
mins
dst
name
baseTime0
::
UTCTime
baseTime0
=
localTimeToUTC
utc
(
LocalTime
(
fromGregorian
1970
01
01
)
midnight
)
baseTime1
::
UTCTime
baseTime1
=
localTimeToUTC
utc
(
LocalTime
(
fromGregorian
2000
01
01
)
midnight
)
getDay
::
Integer
->
UTCTime
getDay
day
=
addUTCTime
((
fromInteger
day
)
*
nominalDay
)
baseTime1
getYearP1
::
Integer
->
UTCTime
getYearP1
year
=
localTimeToUTC
utc
(
LocalTime
(
fromGregorian
year
01
01
)
midnight
)
getYearP2
::
Integer
->
UTCTime
getYearP2
year
=
localTimeToUTC
utc
(
LocalTime
(
fromGregorian
year
02
04
)
midnight
)
getYearP3
::
Integer
->
UTCTime
getYearP3
year
=
localTimeToUTC
utc
(
LocalTime
(
fromGregorian
year
03
04
)
midnight
)
getYearP4
::
Integer
->
UTCTime
getYearP4
year
=
localTimeToUTC
utc
(
LocalTime
(
fromGregorian
year
12
31
)
midnight
)
years
::
[
Integer
]
years
=
[
999
,
1000
,
1899
,
1900
,
1901
]
++
[
1980
..
2000
]
++
[
9999
,
10000
]
times
::
[
UTCTime
]
times
=
[
baseTime0
]
++
(
fmap
getDay
[
0
..
23
])
++
(
fmap
getDay
[
0
..
100
])
++
(
fmap
getYearP1
years
)
++
(
fmap
getYearP2
years
)
++
(
fmap
getYearP3
years
)
++
(
fmap
getYearP4
years
)
times
::
Gen
UTCTime
times
=
do
day
<-
choose
(
-
25000
,
75000
)
time
<-
return
midnight
return
$
localTimeToUTC
utc
$
LocalTime
(
ModifiedJulianDay
day
)
time
padN
::
Int
->
Char
->
String
->
String
padN
n
_
s
|
n
<=
(
length
s
)
=
s
...
...
@@ -85,14 +69,13 @@ unixWorkarounds "%_f" s = padN 2 ' ' s
unixWorkarounds
"%0f"
s
=
padN
2
'0'
s
unixWorkarounds
_
s
=
s
compareFormat
::
(
String
->
String
)
->
String
->
TimeZone
->
UTCTime
->
Assertion
compareFormat
::
(
String
->
String
)
->
String
->
TimeZone
->
UTCTime
->
Result
compareFormat
modUnix
fmt
zone
time
=
let
ctime
=
utcToZonedTime
zone
time
haskellText
=
formatTime
locale
fmt
ctime
in
do
unixText
<-
unixFormatTime
fmt
zone
time
let
expectedText
=
unixWorkarounds
fmt
(
modUnix
unixText
)
assertEqual
""
expectedText
haskellText
unixText
=
unixFormatTime
fmt
zone
time
expectedText
=
unixWorkarounds
fmt
(
modUnix
unixText
)
in
assertEqualQC
""
expectedText
haskellText
-- as found in http://www.opengroup.org/onlinepubs/007908799/xsh/strftime.html
-- plus FgGklz
...
...
@@ -103,27 +86,37 @@ chars :: [Char]
chars
=
"aAbBcCdDeFgGhHIjklmMnprRStTuUVwWxXyYzZ%"
-- as found in "man strftime" on a glibc system. '#' is different, though
modifiers
::
[
Char
]
modifiers
=
"_-0
^"
modifiers
::
[
String
]
modifiers
=
[
""
,
"_"
,
"-"
,
"0"
,
"
^"
]
widths
::
[
String
]
widths
=
[
""
,
"1"
,
"2"
,
"9"
,
"12"
]
formats
::
[
String
]
formats
=
[
"%G-W%V-%u"
,
"%U-%w"
,
"%W-%u"
]
++
(
fmap
(
\
char
->
'%'
:
[
char
])
chars
)
++
(
concat
$
fmap
(
\
char
->
concat
$
fmap
(
\
width
->
fmap
(
\
modifier
->
"%"
++
[
modifier
]
++
width
++
[
char
])
modifiers
)
widths
)
chars
)
formats
=
[
"%G-W%V-%u"
,
"%U-%w"
,
"%W-%u"
]
++
(
do
char
<-
chars
width
<-
widths
modifier
<-
modifiers
return
$
"%"
++
modifier
++
width
++
[
char
]
)
hashformats
::
[
String
]
hashformats
=
(
fmap
(
\
char
->
'%'
:
'#'
:
char
:
[]
)
chars
)
testCompareFormat
::
TestTree
testCompareFormat
=
testGroup
"compare format"
$
tgroup
formats
$
\
fmt
->
tgroup
times
$
\
time
->
tgroup
zones
$
\
zone
->
compareFormat
id
fmt
zone
time
testCompareHashFormat
::
TestTree
testCompareHashFormat
=
testGroup
"compare hashformat"
$
tgroup
hashformats
$
\
fmt
->
tgroup
times
$
\
time
->
tgroup
zones
$
\
zone
->
compareFormat
(
fmap
toLower
)
fmt
zone
time
hashformats
=
do
char
<-
chars
return
$
"%#"
++
[
char
]
testCompareFormat
::
[
TestTree
]
testCompareFormat
=
tgroup
formats
$
\
fmt
->
do
time
<-
times
zone
<-
zones
return
$
compareFormat
id
fmt
zone
time
testCompareHashFormat
::
[
TestTree
]
testCompareHashFormat
=
tgroup
hashformats
$
\
fmt
->
do
time
<-
times
zone
<-
zones
return
$
compareFormat
(
fmap
toLower
)
fmt
zone
time
testFormat
::
TestTree
testFormat
=
testGroup
"testFormat"
$
[
testCompareFormat
,
testCompareHashFormat
]
testFormat
=
testGroup
"testFormat"
$
testCompareFormat
++
testCompareHashFormat
This diff is collapsed.
Click to expand it.
test/unix/Test/TestUtil.hs
+
9
−
1
View file @
c763435e
...
...
@@ -4,7 +4,7 @@ module Test.TestUtil where
import
Test.QuickCheck.Property
import
Test.Tasty
import
Test.Tasty.HUnit
import
Test.Tasty.QuickCheck
import
Test.Tasty.QuickCheck
hiding
(
reason
)
assertFailure'
::
String
->
IO
a
assertFailure'
s
=
do
...
...
@@ -33,5 +33,13 @@ instance NameTest Result where
instance
(
Arbitrary
a
,
Show
a
,
Testable
b
)
=>
NameTest
(
a
->
b
)
where
nameTest
name
=
nameTest
name
.
property
instance
(
Testable
a
)
=>
NameTest
(
Gen
a
)
where
nameTest
name
=
nameTest
name
.
property
tgroup
::
(
Show
a
,
NameTest
t
)
=>
[
a
]
->
(
a
->
t
)
->
[
TestTree
]
tgroup
aa
f
=
fmap
(
\
a
->
nameTest
(
show
a
)
$
f
a
)
aa
assertEqualQC
::
(
Show
a
,
Eq
a
)
=>
String
->
a
->
a
->
Result
assertEqualQC
_name
expected
found
|
expected
==
found
=
succeeded
assertEqualQC
""
expected
found
=
failed
{
reason
=
"expected "
++
show
expected
++
", found "
++
show
found
}
assertEqualQC
name
expected
found
=
failed
{
reason
=
name
++
": expected "
++
show
expected
++
", found "
++
show
found
}
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment