Squeak-dev December 2018

squeak-dev@lists.squeakfoundation.org

30 participants
115 discussions

The Inbox: Chronology-Core-dtl.16.mcz
by commits＠source.squeak.org 29 Dec '18

29 Dec '18

David T. Lewis uploaded a new version of Chronology-Core to project The Inbox: http://source.squeak.org/inbox/Chronology-Core-dtl.16.mcz ==================== Summary ==================== Name: Chronology-Core-dtl.16 Author: dtl Time: 15 December 2018, 6:40:11.92086 pm UUID: a0841e45-839c-4658-abe1-09dd1cbbe96c Ancestors: Chronology-Core-cmm.15 Bootstrap UTCDateAndTime, step 1 of 5 Add LXDateAndTime and LXTimeStamp as alternative implementations of DateAndTime an TimeStamp. DateAndTime uses instance variables 'seconds offset jdn nanos' and calculates its magnitude based on those varables in conjunction with the local TimeZone, The LXDateAndTime variation uses instance variables 'utcMicroseconds localOffsetSeconds'. It represents time magnitude as elapsed microseconds since the Posix epoch, with localOffsetSeconds representing local offset from UTC. The magnitude is used for comparison and duration calculations, and the local offset is used for displaying this magnitude in the context of a local time zone. The implementation ignores leap seconds, which are adjustments made to maintain earth rotational clock time in synchronization with elapsed seconds. LXDateAndTime class>>now uses #primitiveUtcWithOffset to obtain current time in UTC microseconds with current local offset in seconds. The primitive provides an atomic query for UTC time and local offset as measured by the OS platform. If primitiveUtcWithOffset is not available, the traditional implementation is used, which relies on a primitive for microseconds in the local time zone and derives UTC based on the TimeZone setting. Tests are provided to verify equivalence of the LXDateAndTime and DateAndTime hierarchies. LXDateAndTimeConversionTest tests conversion to and from LXDateAndTime. LXDateAndTimeTest, LXDateAndTimeEpochTest, and LXDateAndTimeLeapTest are variations on their corresponding DateAndTime tests. These tests are placed in the Kernel package because they are temporary tests that will be removed when LXDateAndTime replaces DateAndTime in a later update. =============== Diff against Chronology-Core-cmm.15 =============== Item was changed: Timespan subclass: #Date instanceVariableNames: '' classVariableNames: '' poolDictionaries: 'ChronologyConstants' category: 'Chronology-Core'! + !Date commentStamp: 'cmm 2/3/2012 17:30' prior: 0! + Instances of Date are Timespans with duration of 1 day. - !Date commentStamp: 'cmm 6/28/2016 21:36' prior: 0! - Instances of Date are Timespans with duration of 1 day. As with all Chronology Timespan sub-instances, Dates can be instantiated as position values which compare equally to any other instance of the same Date, irregardless of the timezone in which either is created. + Their default creation assumes a start of midnight of UTC to provide the fast, globalized Dates out of the box. The legacy behavior that creates Timezone-sensitive Dates can be used by sending #localizedDates. + ! - However, like the other Timespan subInstances, there are rare cases where it may be desirable to use instances of Date to represent a particular 1-day span of time at a particular locality on the globe. All Timespans, including Dates, may specify a particular timezone offset for this purpose.! Item was removed: - ----- Method: Date>>@ (in category 'squeak protocol') ----- - @ aTime - ^ DateAndTime - date: self - time: aTime! Item was changed: ----- Method: DateAndTime class>>automaticTimezone: (in category 'preferences') ----- automaticTimezone: aBoolean + "Accessor for the system-wide preference" - "Accessor for the system-wide preference. - Note this gets disabled in localTimeZone: to make that override stick" + AutomaticTimezone := aBoolean! - AutomaticTimezone := aBoolean. - aBoolean ifTrue: [self now]. "fetch timezone immediately"! Item was removed: - ----- Method: DateAndTime class>>fromUnixTime: (in category 'squeak protocol') ----- - fromUnixTime: aNumber - - - ^ self fromSeconds: aNumber + self unixEpoch asSeconds! Item was changed: ----- Method: DateAndTime class>>localOffset: (in category 'squeak protocol') ----- localOffset: aDuration + "Set the duration we are offset from UTC (done automatically in #now)" + self localTimeZone: (TimeZone offset: aDuration name: 'Local Time' abbreviation: 'LT'). - "Override the local time zone (for testing). This disables the #automaticTimezone: preference" - self localTimeZone: (TimeZone offset: aDuration name: 'Local Time (override)' abbreviation: 'LTO'). ! Item was changed: ----- Method: DateAndTime class>>localTimeZone: (in category 'accessing') ----- localTimeZone: aTimeZone "Set the local time zone" + " DateAndTime localTimeZone: (TimeZone offset: 0 hours name: 'Universal Time' abbreviation: 'UTC'). DateAndTime localTimeZone: (TimeZone offset: -8 hours name: 'Pacific Standard Time' abbreviation: 'PST'). " + + LocalTimeZone := aTimeZone + + + ! - LocalTimeZone := aTimeZone. - self automaticTimezone: (aTimeZone abbreviation = 'LT')! Item was changed: ----- Method: DateAndTime class>>now (in category 'ansi protocol') ----- now + | clockAndOffset | + clockAndOffset := self clock localMicrosecondClockWithOffset. + (self automaticTimezone and: + [self localOffset asSeconds ~= clockAndOffset second]) + ifTrue: [self localOffset: (Duration seconds: clockAndOffset second)]. + ^self now: clockAndOffset first offset: self localOffset! - | clockAndOffset localSeconds | - clockAndOffset := self clock utcMicrosecondClockWithOffset. - localSeconds := self localOffset asSeconds. - (self automaticTimezone and: [localSeconds ~= clockAndOffset second]) - ifTrue: [self setLocalOffsetAutomatically: (Duration seconds: (localSeconds := clockAndOffset second))]. - ^self now: clockAndOffset first + (localSeconds * 1000000) offset: self localOffset! Item was removed: - ----- Method: DateAndTime class>>nowAtOffset: (in category 'squeak protocol') ----- - nowAtOffset: offsetDuration - "Answers the local time at places with the specified offsetDuration timezone." - "local time Chicago (CST)" - "DateAndTime nowAtOffset: -6 hours" - ^ self now + (offsetDuration - self localOffset) offset: offsetDuration! Item was removed: - ----- Method: DateAndTime class>>setLocalOffsetAutomatically: (in category 'squeak protocol') ----- - setLocalOffsetAutomatically: aDuration - "Set the duration we are offset from UTC (done automatically in #now)" - LocalTimeZone := (TimeZone offset: aDuration name: 'Local Time' abbreviation: 'LT'). - ! Item was changed: ----- Method: DateAndTime class>>startUp: (in category 'system startup') ----- startUp: startingAfresh "Set local timezone" + startingAfresh ifTrue: [self now]. - startingAfresh & self automaticTimezone ifTrue: [self now]. ! Item was changed: ----- Method: DateAndTime>>< (in category 'ansi protocol') ----- < comparand "comparand conforms to protocol DateAndTime, or can be converted into something that conforms." | lvalue rvalue comparandAsDateAndTime | + comparandAsDateAndTime _ comparand asDateAndTime. - comparandAsDateAndTime := comparand asDateAndTime. self offset = comparandAsDateAndTime offset ifTrue: [ lvalue := self. rvalue := comparandAsDateAndTime ] ifFalse: [ lvalue := self asUTC. rvalue := comparandAsDateAndTime asUTC ]. ^ lvalue julianDayNumber < rvalue julianDayNumber or: [ lvalue julianDayNumber > rvalue julianDayNumber ifTrue: [ false ] ifFalse: [ lvalue secondsSinceMidnight < rvalue secondsSinceMidnight or: [ lvalue secondsSinceMidnight > rvalue secondsSinceMidnight ifTrue: [ false ] ifFalse: [ lvalue nanoSecond < rvalue nanoSecond ] ] ] ]! Item was added: + ----- Method: DateAndTime>>asLXDateAndTime (in category 'LX-Kernel-Chronology') ----- + asLXDateAndTime + + ^LXDateAndTime + year: self year + month: self month + day: self dayOfMonth + hour: self hour + minute: self minute + second: self second + nanoSecond: self nanoSecond + offset: self offset! Item was changed: ----- Method: DateAndTime>>setJdn:seconds:nano:offset: (in category 'squeak protocol') ----- setJdn: j seconds: s nano: n offset: o + jdn := j. + seconds := s. + nanos := n. + offset := o - jdn := j. - seconds := s. - nanos := n. - offset := o ! Item was removed: - ----- Method: Duration>>wait (in category 'squeak protocol') ----- - wait - "Convert this duration in a delay and wait once. Return the created delay so that the client can wait on it again if needed. - - Do-it: 3 minutes wait" - - | delay | - delay := self asDelay. - delay wait. - ^ delay! Item was added: + Magnitude subclass: #LXDateAndTime + instanceVariableNames: 'utcMicroseconds localOffsetSeconds' + classVariableNames: 'ClockProvider DaysSinceEpoch LastMilliSeconds LastTick LastTickSemaphore LocalTimeZone MilliSecondOffset OffsetsAreValid' + poolDictionaries: 'ChronologyConstants' + category: 'Chronology-Core'! + + !LXDateAndTime commentStamp: 'dtl 3/31/2014 19:49' prior: 0! + I represent a point in UTC time as defined by ISO 8601. I have zero duration. + + My magnitude represents the elapsed time since (or before) the Posix epoch. + + I have a local offset for presenting my date and time in the context of a local time zone. This offset is independent of my magnitude. + + My implementation ignores leap seconds, which are adjustments made to maintain earth rotational clock time in synchronization with elapsed seconds.! Item was added: + ----- Method: LXDateAndTime class>>clock (in category 'clock provider') ----- + clock + "the provider of real time seconds/milliseconds." + + ^ ClockProvider ! Item was added: + ----- Method: LXDateAndTime class>>clockPrecision (in category 'ansi protocol') ----- + clockPrecision + "One nanosecond precision" + + ^ Duration seconds: 0 nanoSeconds: 1 + ! Item was added: + ----- Method: LXDateAndTime class>>current (in category 'squeak protocol') ----- + current + + + ^ self now! Item was added: + ----- Method: LXDateAndTime class>>date:time: (in category 'squeak protocol') ----- + date: aDate time: aTime + + ^ self + year: aDate year + day: aDate dayOfYear + hour: aTime hour + minute: aTime minute + second: aTime second + offset: aDate start offset! Item was added: + ----- Method: LXDateAndTime class>>daysFromSmalltalkEpochToPosixEpoch (in category 'DTL') ----- + daysFromSmalltalkEpochToPosixEpoch + + ^52 * 365 + (17 * 366)! Item was added: + ----- Method: LXDateAndTime class>>epoch (in category 'squeak protocol') ----- + epoch + "Answer a DateAndTime representing the Squeak epoch: 1 January 1901" + + | uSec | + self flag: #FIXME. "see comment in fromSeconds: " + uSec := self epochOffsetMicros negated. + ^ self utcMicroseconds: uSec offset: self localOffsetSeconds + + + " + ^ self julianDayNumber: SqueakEpoch + "! Item was added: + ----- Method: LXDateAndTime class>>epochOffset (in category 'DTL') ----- + epochOffset + "Elaspsed seconds from the Smalltalk epoch to the Posix epoch" + ^self daysFromSmalltalkEpochToPosixEpoch * SecondsInDay! Item was added: + ----- Method: LXDateAndTime class>>epochOffsetMicros (in category 'DTL') ----- + epochOffsetMicros + "Elaspsed microseconds from the Smalltalk epoch to the Posix epoch" + ^self epochOffset * 1000000! Item was added: + ----- Method: LXDateAndTime class>>fromSeconds: (in category 'smalltalk-80') ----- + fromSeconds: seconds + "Answer a DateAndTime since the Squeak epoch: 1 January 1901" + + "dtl - Implemented for compatibiity with Squeak, but this is probably wrong" + + | s uSec offset | + self flag: #FIXME. "local versus UTC? what should we set the offset to?" + offset := self localOffsetSeconds. + s := seconds - self epochOffset - offset.. + uSec := s * 1000000. + ^ self utcMicroseconds: uSec offset: offset + ! Item was added: + ----- Method: LXDateAndTime class>>fromString: (in category 'squeak protocol') ----- + fromString: aString + + + ^ self readFrom: (ReadStream on: aString)! Item was added: + ----- Method: LXDateAndTime class>>initialize (in category 'initialize-release') ----- + initialize + + super initialize. + + ClockProvider := Time. + LastTickSemaphore := Semaphore forMutualExclusion. + LastMilliSeconds := 0. + LastTick := 0. + Smalltalk addToStartUpList: self. + self startUp: true + ! Item was added: + ----- Method: LXDateAndTime class>>initializeOffsets (in category 'initialize-release') ----- + initializeOffsets + | durationSinceEpoch secondsSinceMidnight nowSecs | + LastTick := 0. + nowSecs := self clock secondsWhenClockTicks. + LastMilliSeconds := self millisecondClockValue. + durationSinceEpoch := Duration + days: SqueakEpoch + hours: 0 + minutes: 0 + seconds: nowSecs. + DaysSinceEpoch := durationSinceEpoch days. + secondsSinceMidnight := (durationSinceEpoch - + (Duration + days: DaysSinceEpoch + hours: 0 + minutes: 0 + seconds: 0)) asSeconds. + MilliSecondOffset := secondsSinceMidnight * 1000 - LastMilliSeconds! Item was added: + ----- Method: LXDateAndTime class>>julianDayNumber: (in category 'squeak protocol') ----- + julianDayNumber: anInteger + ^ self + julianDayNumber: anInteger + offset: self localOffset! Item was added: + ----- Method: LXDateAndTime class>>julianDayNumber:offset: (in category 'squeak protocol') ----- + julianDayNumber: anInteger offset: aDuration + ^ self basicNew + ticks: anInteger days ticks + offset: aDuration ; + yourself! Item was added: + ----- Method: LXDateAndTime class>>localOffset (in category 'squeak protocol') ----- + localOffset + "Answer the duration we are offset from UTC" + + ^ self localTimeZone offset + ! Item was added: + ----- Method: LXDateAndTime class>>localOffsetSeconds (in category 'DTL') ----- + localOffsetSeconds + ^self localOffset asSeconds! Item was added: + ----- Method: LXDateAndTime class>>localTimeZone (in category 'accessing') ----- + localTimeZone + "Answer the local time zone" + + ^ LocalTimeZone ifNil: [ LocalTimeZone := TimeZone default ] + + ! Item was added: + ----- Method: LXDateAndTime class>>localTimeZone: (in category 'accessing') ----- + localTimeZone: aTimeZone + "Set the local time zone" + + " + DateAndTime localTimeZone: (TimeZone offset: 0 hours name: 'Universal Time' abbreviation: 'UTC'). + DateAndTime localTimeZone: (TimeZone offset: -8 hours name: 'Pacific Standard Time' abbreviation: 'PST'). + " + + LocalTimeZone := aTimeZone + + + ! Item was added: + ----- Method: LXDateAndTime class>>midnight (in category 'squeak protocol') ----- + midnight + + ^ self now midnight! Item was added: + ----- Method: LXDateAndTime class>>milliSecondsSinceMidnight (in category 'squeak protocol') ----- + milliSecondsSinceMidnight + | msm msClock | + + "This is usually only during system startup..." + self waitForOffsets. + + msClock := self millisecondClockValue. + msClock < LastMilliSeconds ifTrue: [ "rolled over" + MilliSecondOffset := MilliSecondOffset + (SmallInteger maxVal // 2) + 1 ]. + LastMilliSeconds := msClock. + [ + msm := msClock + MilliSecondOffset. + msm >= 86400000 ] whileTrue: [ + "next day" + LastTick := -1. + DaysSinceEpoch := DaysSinceEpoch + 1. + MilliSecondOffset := MilliSecondOffset - 86400000 ]. + "day rolled over sanity check" + (LastTick = -1 and: [ + (Duration + days: SqueakEpoch + hours: 0 + minutes: 0 + seconds: self clock totalSeconds) days ~= DaysSinceEpoch ]) ifTrue: [ + self initializeOffsets. + ^ self milliSecondsSinceMidnight ]. + ^ msm.! Item was added: + ----- Method: LXDateAndTime class>>millisecondClockValue (in category 'smalltalk-80') ----- + millisecondClockValue + + ^ self clock millisecondClockValue! Item was added: + ----- Method: LXDateAndTime class>>new (in category 'squeak protocol') ----- + new + "Answer a DateAndTime representing the Squeak epoch: 1 January 1901" + + ^ self epoch! Item was added: + ----- Method: LXDateAndTime class>>noon (in category 'squeak protocol') ----- + noon + + ^ self now noon + ! Item was added: + ----- Method: LXDateAndTime class>>now (in category 'ansi protocol') ----- + now + + [ | timeArray | + timeArray := self primPosixMicrosecondClockWithOffset. + ^ self utcMicroseconds: timeArray first offset: timeArray second] + on: Error + do: [ "Use old style primitive support" + ^self nowWithOffset: self localOffset]! Item was added: + ----- Method: LXDateAndTime class>>nowWithOffset: (in category 'squeak protocol') ----- + nowWithOffset: aDuration + | nanoTicks msm | + nanoTicks := (msm := self milliSecondsSinceMidnight) * 1000000. + "The following usually only executes at system startup." + ^ LastTick < nanoTicks + ifTrue: + [ LastTick := nanoTicks. + self waitForOffsets. + self basicNew + setJdn: DaysSinceEpoch + seconds: msm // 1000 + nano: msm \\ 1000 * 1000000 + offset: aDuration ] + ifFalse: + [ LastTickSemaphore critical: + [ LastTick := LastTick + 1. + self waitForOffsets. + self basicNew + setJdn: DaysSinceEpoch + seconds: LastTick // 1000000000 + nano: LastTick \\ 1000000000 + offset: aDuration ] ] + " + [ 10000 timesRepeat: [ self now. ] ] timeToRun / 10000.0 . + + If calls to DateAndTime-c-#now are within a single millisecond the semaphore code + to ensure that (self now <= self now) slows things down considerably by a factor of about 20. + + The actual speed of a single call to DateAndTime-now in milliseconds is + demonstrated by the unguarded method below. + + [ 100000 timesRepeat: [ self todayAtMilliSeconds: (self milliSecondsSinceMidnight) ] ] timeToRun / 100000.0 . 0.00494 0.00481 0.00492 0.00495 + + "! Item was added: + ----- Method: LXDateAndTime class>>posixEpoch (in category 'DTL') ----- + posixEpoch + "Answer a DateAndTime representing the Posix epoch" + + ^ self julianDayNumber: self posixEpochJulianDays ! Item was added: + ----- Method: LXDateAndTime class>>primPosixMicrosecondClockWithOffset (in category 'DTL') ----- + primPosixMicrosecondClockWithOffset + "Answer an array with UTC microseconds since the Posix epoch and the + current seconds offset from GMT in the local time zone." + + <primitive: 'primitiveUtcWithOffset'> + + ^self primitiveFailed! Item was added: + ----- Method: LXDateAndTime class>>readFrom: (in category 'squeak protocol') ----- + readFrom: aStream + + | offset date time ch | + + date := Date readFrom: aStream. + [aStream peek isDigit] + whileFalse: [aStream next]. + time := Time readFrom: aStream. + (aStream atEnd or: [('+-Z' includes: aStream peek) not]) + ifTrue: [offset := self localOffset] + ifFalse: [(aStream peekFor: $Z) + ifTrue: [offset := Duration zero] + ifFalse: [ + ch := aStream next. + ch = $+ ifTrue: [ch := Character space]. + offset := Duration fromString: ch asString, '0:', aStream upToEnd, ':0']]. + ^ self + year: date year + month: date monthIndex + day: date dayOfMonth + hour: time hour + minute: time minute + second: time second + nanoSecond: time nanoSecond + offset: offset + + + " '-1199-01-05T20:33:14.321-05:00' asDateAndTime + ' 2002-05-16T17:20:45.1+01:01' asDateAndTime + + ' 2002-05-16T17:20:45.02+01:01' asDateAndTime + + ' 2002-05-16T17:20:45.003+01:01' asDateAndTime + + ' 2002-05-16T17:20:45.0004+01:01' asDateAndTime + ' 2002-05-16T17:20:45.00005' asDateAndTime + ' 2002-05-16T17:20:45.000006+01:01' asDateAndTime + + ' 2002-05-16T17:20:45.0000007+01:01' asDateAndTime + ' 2002-05-16T17:20:45.00000008-01:01' asDateAndTime + ' 2002-05-16T17:20:45.000000009+01:01' asDateAndTime + ' 2002-05-16T17:20:45.0000000001+01:01' asDateAndTime + + ' 2002-05-16T17:20' asDateAndTime + ' 2002-05-16T17:20:45' asDateAndTime + ' 2002-05-16T17:20:45+01:57' asDateAndTime + ' 2002-05-16T17:20:45-02:34' asDateAndTime + ' 2002-05-16T17:20:45+00:00' asDateAndTime + ' 1997-04-26T01:02:03+01:02:3' asDateAndTime + "! Item was added: + ----- Method: LXDateAndTime class>>startUp: (in category 'initialize-release') ----- + startUp: resuming + resuming ifFalse: [ ^ self ]. + "Time initializeMillisecondClockMask." + OffsetsAreValid := false. + [ + self initializeOffsets. + OffsetsAreValid := true + ] forkAt: Processor userInterruptPriority.! Item was added: + ----- Method: LXDateAndTime class>>today (in category 'squeak protocol') ----- + today + + ^ self midnight! Item was added: + ----- Method: LXDateAndTime class>>tomorrow (in category 'squeak protocol') ----- + tomorrow + + ^ self today asDate next asLXDateAndTime + ! Item was added: + ----- Method: LXDateAndTime class>>totalSeconds (in category 'smalltalk-80') ----- + totalSeconds + + ^ self clock totalSeconds! Item was added: + ----- Method: LXDateAndTime class>>unixEpoch (in category 'squeak protocol') ----- + unixEpoch + "Answer a DateAndTime representing the Unix epoch (1 January 1970, midnight UTC)" + + ^ self basicNew + ticks: #(2440588 0 0) offset: Duration zero; + yourself. + ! Item was added: + ----- Method: LXDateAndTime class>>utcMicroseconds:offset: (in category 'DTL') ----- + utcMicroseconds: microsecondsSincePosixEpoch offset: offsetSeconds + + ^super new + utcMicroseconds: microsecondsSincePosixEpoch + offset: offsetSeconds! Item was added: + ----- Method: LXDateAndTime class>>waitForOffsets (in category 'initialize-release') ----- + waitForOffsets + OffsetsAreValid ifFalse: [ + [ + (Delay forSeconds: 1) wait. + OffsetsAreValid + ] whileFalse + ]! Item was added: + ----- Method: LXDateAndTime class>>year:day: (in category 'squeak protocol') ----- + year: year day: dayOfYear + "Return a DateAndTime" + + ^ self + year: year + day: dayOfYear + hour: 0 + minute: 0 + second: 0 + ! Item was added: + ----- Method: LXDateAndTime class>>year:day:hour:minute:second: (in category 'ansi protocol') ----- + year: year day: dayOfYear hour: hour minute: minute second: second + + ^ self + year: year + day: dayOfYear + hour: hour + minute: minute + second: second + offset: self localOffset + ! Item was added: + ----- Method: LXDateAndTime class>>year:day:hour:minute:second:offset: (in category 'ansi protocol') ----- + year: year day: dayOfYear hour: hour minute: minute second: second offset: offset + "Return a DataAndTime" + + | y d | + y := self + year: year + month: 1 + day: 1 + hour: hour + minute: minute + second: second + nanoSecond: 0 + offset: offset. + + d := Duration days: (dayOfYear - 1). + + ^ y + d + ! Item was added: + ----- Method: LXDateAndTime class>>year:month:day: (in category 'squeak protocol') ----- + year: year month: month day: day + "Return a DateAndTime, midnight local time" + + ^self + year: year + month: month + day: day + hour: 0 + minute: 0 + ! Item was added: + ----- Method: LXDateAndTime class>>year:month:day:hour:minute: (in category 'squeak protocol') ----- + year: year month: month day: day hour: hour minute: minute + "Return a DateAndTime" + + ^self + year: year + month: month + day: day + hour: hour + minute: minute + second: 0 + ! Item was added: + ----- Method: LXDateAndTime class>>year:month:day:hour:minute:second: (in category 'ansi protocol') ----- + year: year month: month day: day hour: hour minute: minute second: second + "Return a DateAndTime" + + ^ self + year: year + month: month + day: day + hour: hour + minute: minute + second: second + offset: self localOffset! Item was added: + ----- Method: LXDateAndTime class>>year:month:day:hour:minute:second:nanoSecond:offset: (in category 'squeak protocol') ----- + year: year month: month day: day hour: hour minute: minute second: second nanoSecond: nanoCount offset: offset + "Return a DateAndTime" + + | monthIndex daysInMonth p q r s julianDayNumber | + + monthIndex := month isInteger ifTrue: [month] ifFalse: [Month indexOfMonth: month]. + daysInMonth := Month + daysInMonth: monthIndex + forYear: year. + day < 1 ifTrue: [self error: 'day may not be zero or negative']. + day > daysInMonth ifTrue: [self error: 'day is after month ends']. + + p := (monthIndex - 14) quo: 12. + q := year + 4800 + p. + r := monthIndex - 2 - (12 * p). + s := (year + 4900 + p) quo: 100. + + julianDayNumber := + ( (1461 * q) quo: 4 ) + + ( (367 * r) quo: 12 ) - + ( (3 * s) quo: 4 ) + + ( day - 32075 ). + + ^self basicNew + setJdn: julianDayNumber + seconds: hour * 60 + minute * 60 + second - offset asSeconds + nano: nanoCount + offset: offset; + yourself! Item was added: + ----- Method: LXDateAndTime class>>year:month:day:hour:minute:second:offset: (in category 'ansi protocol') ----- + year: year month: month day: day hour: hour minute: minute second: second offset: offset + + ^ self + year: year + month: month + day: day + hour: hour + minute: minute + second: second + nanoSecond: 0 + offset: offset! Item was added: + ----- Method: LXDateAndTime class>>yesterday (in category 'squeak protocol') ----- + yesterday + + ^ self today asDate previous asLXDateAndTime! Item was added: + ----- Method: LXDateAndTime>>+ (in category 'ansi protocol') ----- + + operand + "operand conforms to protocol Duration" + + ^ self class + utcMicroseconds: operand asDuration asNanoSeconds / 1000 + utcMicroseconds + offset: localOffsetSeconds + ! Item was added: + ----- Method: LXDateAndTime>>- (in category 'ansi protocol') ----- + - operand + "operand conforms to protocol DateAndTime or protocol Duration" + + ^ (operand respondsTo: #asLXDateAndTime) + ifTrue: + [ | lticks rticks | + lticks := self asLocal ticks. + + rticks := operand asLXDateAndTime asLocal ticks. + Duration + seconds: (SecondsInDay *(lticks first - rticks first)) + + (lticks second - rticks second) + nanoSeconds: (lticks third - rticks third) ] + + ifFalse: + + [ self + (operand negated) ] + ! Item was added: + ----- Method: LXDateAndTime>>< (in category 'ansi protocol') ----- + < comparand + "comparand conforms to protocol DateAndTime, + or can be converted into something that conforms." + + ^utcMicroseconds < comparand asLXDateAndTime utcMicroseconds + ! Item was added: + ----- Method: LXDateAndTime>>= (in category 'ansi protocol') ----- + = aDateAndTimeOrTimeStamp + "Equal if the absolute time values match, regardless of local time transform" + self == aDateAndTimeOrTimeStamp ifTrue: [ ^ true ]. + ((aDateAndTimeOrTimeStamp isKindOf: self class) + or: [aDateAndTimeOrTimeStamp isKindOf: LXDateAndTime orOf: TimeStamp]) + ifFalse: [ ^ false ]. + ^utcMicroseconds = aDateAndTimeOrTimeStamp utcMicroseconds! Item was added: + ----- Method: LXDateAndTime>>asDate (in category 'squeak protocol') ----- + asDate + + + ^ Date starting: self asDateAndTime! Item was added: + ----- Method: LXDateAndTime>>asDateAndTime (in category 'squeak protocol') ----- + asDateAndTime + + ^DateAndTime + year: self year + month: self month + day: self dayOfMonth + hour: self hour + minute: self minute + second: self second + nanoSecond: self nanoSecond + offset: self offset! Item was added: + ----- Method: LXDateAndTime>>asDuration (in category 'squeak protocol') ----- + asDuration + "Answer the duration since midnight." + + ^ Duration seconds: self getSeconds nanoSeconds: self nanoSecond + ! Item was added: + ----- Method: LXDateAndTime>>asLXDateAndTime (in category 'squeak protocol') ----- + asLXDateAndTime + + ^ self! Item was added: + ----- Method: LXDateAndTime>>asLXTimeStamp (in category 'transitional - temporary') ----- + asLXTimeStamp + + ^ self as: LXTimeStamp! Item was added: + ----- Method: LXDateAndTime>>asLocal (in category 'ansi protocol') ----- + asLocal + + + ^ (self offset = self class localOffset) + + ifTrue: [self] + ifFalse: [self utcOffset: self class localOffset]! Item was added: + ----- Method: LXDateAndTime>>asMonth (in category 'squeak protocol') ----- + asMonth + + ^ Month starting: self! Item was added: + ----- Method: LXDateAndTime>>asNanoSeconds (in category 'squeak protocol') ----- + asNanoSeconds + "Answer the number of nanoseconds since midnight" + + ^ self asDuration asNanoSeconds! Item was added: + ----- Method: LXDateAndTime>>asPosixSeconds (in category 'transitional - temporary') ----- + asPosixSeconds + + ^ (self - (self class posixEpoch offset: self offset)) asSeconds! Item was added: + ----- Method: LXDateAndTime>>asSeconds (in category 'smalltalk-80') ----- + asSeconds + "Return the number of seconds since the Squeak epoch" + + self flag: #FIXME. "is this whole seconds or partial? UTC or local?" + + ^ utcMicroseconds / 1000000 + self class epochOffset + ! Item was added: + ----- Method: LXDateAndTime>>asTime (in category 'squeak protocol') ----- + asTime + + + ^ Time seconds: self getSeconds nanoSeconds: self nanoSecond + ! Item was added: + ----- Method: LXDateAndTime>>asTimeStamp (in category 'squeak protocol') ----- + asTimeStamp + + ^ self + asDateAndTime "FIXME LX hack for test support" + as: TimeStamp! Item was added: + ----- Method: LXDateAndTime>>asUTC (in category 'ansi protocol') ----- + asUTC + + ^ self offset isZero + ifTrue: [self] + ifFalse: [self utcOffset: 0] + ! Item was added: + ----- Method: LXDateAndTime>>asUnixTime (in category 'squeak protocol') ----- + asUnixTime + "answer number of seconds since unix epoch (midnight Jan 1, 1970, UTC)" + + ^(self - self class unixEpoch) asSeconds! Item was added: + ----- Method: LXDateAndTime>>asWeek (in category 'squeak protocol') ----- + asWeek + + ^ Week starting: self! Item was added: + ----- Method: LXDateAndTime>>asYear (in category 'squeak protocol') ----- + asYear + + ^ Year starting: self! Item was added: + ----- Method: LXDateAndTime>>day (in category 'smalltalk-80') ----- + day + + ^ self dayOfYear + ! Item was added: + ----- Method: LXDateAndTime>>dayMonthYearDo: (in category 'squeak protocol') ----- + dayMonthYearDo: aBlock + "Evaluation the block with three arguments: day month, year." + + | l n i j dd mm yyyy | + l := self julianDayNumber + 68569. + n := 4 * l // 146097. + l := l - (146097 * n + 3 // 4). + i := 4000 * (l + 1) // 1461001. + l := l - (1461 * i // 4) + 31. + j := 80 * l // 2447. + dd := l - (2447 * j // 80). + l := j // 11. + mm := j + 2 - (12 * l). + yyyy := 100 * (n - 49) + i + l. + + ^ aBlock + value: dd + value: mm + value: yyyy! Item was added: + ----- Method: LXDateAndTime>>dayOfMonth (in category 'ansi protocol') ----- + dayOfMonth + "Answer which day of the month is represented by the receiver." + + ^ self + dayMonthYearDo: [ :d :m :y | d ] + ! Item was added: + ----- Method: LXDateAndTime>>dayOfWeek (in category 'ansi protocol') ----- + dayOfWeek + + "Sunday=1, ... , Saturday=7" + + ^ (self julianDayNumber + 1 rem: 7) + 1 + ! Item was added: + ----- Method: LXDateAndTime>>dayOfWeekAbbreviation (in category 'ansi protocol') ----- + dayOfWeekAbbreviation + + ^ self dayOfWeekName copyFrom: 1 to: 3 + ! Item was added: + ----- Method: LXDateAndTime>>dayOfWeekName (in category 'ansi protocol') ----- + dayOfWeekName + + ^ Week nameOfDay: self dayOfWeek! Item was added: + ----- Method: LXDateAndTime>>dayOfYear (in category 'ansi protocol') ----- + dayOfYear + "This code was contributed by Dan Ingalls. It is equivalent to the terser + ^ jdn - (Year year: self year) start julianDayNumber + 1 but much quicker." + + ^ self dayMonthYearDo: + [ :d :m :y | + | monthStart | + monthStart := #(1 32 60 91 121 152 182 213 244 274 305 335) at: m. + (m > 2 and: [ Year isLeapYear: y ]) + ifTrue: [ monthStart + d ] + ifFalse: [ monthStart + d - 1 ]]! Item was added: + ----- Method: LXDateAndTime>>daysInMonth (in category 'smalltalk-80') ----- + daysInMonth + "Answer the number of days in the month represented by the receiver." + + + ^ self asMonth daysInMonth! Item was added: + ----- Method: LXDateAndTime>>daysInYear (in category 'smalltalk-80') ----- + daysInYear + + "Answer the number of days in the year represented by the receiver." + + ^ self asYear daysInYear! Item was added: + ----- Method: LXDateAndTime>>daysLeftInYear (in category 'smalltalk-80') ----- + daysLeftInYear + "Answer the number of days in the year after the date of the receiver." + + ^ self daysInYear - self dayOfYear! Item was added: + ----- Method: LXDateAndTime>>duration (in category 'squeak protocol') ----- + duration + + ^ Duration zero! Item was added: + ----- Method: LXDateAndTime>>firstDayOfMonth (in category 'smalltalk-80') ----- + firstDayOfMonth + + ^ self asMonth start day + ! Item was added: + ----- Method: LXDateAndTime>>getSeconds (in category 'transitional - temporary') ----- + getSeconds + + | posixDays posixSeconds localSeconds | + posixSeconds := utcMicroseconds / 1000000. + localSeconds := posixSeconds + localOffsetSeconds. + localSeconds < 0 ifTrue: [localSeconds := localSeconds \\ SecondsInDay]. "normalize" + posixDays := (localSeconds / SecondsInDay) asInteger. + ^localSeconds - (posixDays * SecondsInDay). + ! Item was added: + ----- Method: LXDateAndTime>>hasEqualTicks: (in category 'private') ----- + hasEqualTicks: aDateAndTime + + ^ (self julianDayNumber = aDateAndTime julianDayNumber) + and: [ (self getSeconds = aDateAndTime secondsSinceMidnight) + and: [ self nanoSecond = aDateAndTime nanoSecond ] ] + + ! Item was added: + ----- Method: LXDateAndTime>>hash (in category 'ansi protocol') ----- + hash + | totalSeconds | + totalSeconds := self getSeconds - self offsetSeconds. + ^ ((totalSeconds // 86400 + self julianDayNumber) hashMultiply bitXor: totalSeconds \\ + 86400) bitXor: self nanoSecond! Item was added: + ----- Method: LXDateAndTime>>hour (in category 'ansi protocol') ----- + hour + + ^ self hour24! Item was added: + ----- Method: LXDateAndTime>>hour12 (in category 'ansi protocol') ----- + hour12 + "Answer an <integer> between 1 and 12, inclusive, representing the hour + of the day in the 12-hour clock of the local time of the receiver." + ^ self hour24 - 1 \\ 12 + 1 + ! Item was added: + ----- Method: LXDateAndTime>>hour24 (in category 'ansi protocol') ----- + hour24 + + + ^ (Duration seconds: self getSeconds) hours! Item was added: + ----- Method: LXDateAndTime>>hours (in category 'smalltalk-80') ----- + hours + + ^ self hour + ! Item was added: + ----- Method: LXDateAndTime>>isLeapYear (in category 'ansi protocol') ----- + isLeapYear + + + ^ Year isLeapYear: self year + ! Item was added: + ----- Method: LXDateAndTime>>julianDayNumber (in category 'squeak protocol') ----- + julianDayNumber + + | posixDays posixSeconds localSeconds negativeDays | + posixSeconds := utcMicroseconds / 1000000. + localSeconds := posixSeconds + localOffsetSeconds. + negativeDays := 0. + localSeconds < 0 ifTrue: [ "normalize" + negativeDays := localSeconds // SecondsInDay. + localSeconds := negativeDays - 1 * SecondsInDay + localSeconds]. + posixDays := (localSeconds / SecondsInDay) asInteger. + ^posixDays + self posixEpochJulianDays - negativeDays. + ! Item was added: + ----- Method: LXDateAndTime>>makeUTC (in category 'squeak protocol') ----- + makeUTC + "Make the receiver's timezone UTC." + localOffsetSeconds := 0! Item was added: + ----- Method: LXDateAndTime>>meridianAbbreviation (in category 'ansi protocol') ----- + meridianAbbreviation + + ^ self asTime meridianAbbreviation + ! Item was added: + ----- Method: LXDateAndTime>>middleOf: (in category 'squeak protocol') ----- + middleOf: aDuration + "Return a Timespan where the receiver is the middle of the Duration" + + | duration | + duration := aDuration asDuration. + + ^ Timespan starting: (self - (duration / 2)) duration: duration + ! Item was added: + ----- Method: LXDateAndTime>>midnight (in category 'squeak protocol') ----- + midnight + "Answer a DateAndTime starting at midnight of the same timezone offset as the receiver." + ^ self class basicNew + setJdn: self julianDayNumber + seconds: 0 + nano: 0 + offset: self offset! Item was added: + ----- Method: LXDateAndTime>>minute (in category 'ansi protocol') ----- + minute + + + ^ (Duration seconds: self getSeconds) minutes! Item was added: + ----- Method: LXDateAndTime>>minutes (in category 'smalltalk-80') ----- + minutes + + ^ self minute + ! Item was added: + ----- Method: LXDateAndTime>>month (in category 'ansi protocol') ----- + month + + ^ self + dayMonthYearDo: [ :d :m :y | m ] + ! Item was added: + ----- Method: LXDateAndTime>>monthAbbreviation (in category 'ansi protocol') ----- + monthAbbreviation + + + ^ self monthName copyFrom: 1 to: 3! Item was added: + ----- Method: LXDateAndTime>>monthIndex (in category 'smalltalk-80') ----- + monthIndex + + + ^ self month! Item was added: + ----- Method: LXDateAndTime>>monthName (in category 'ansi protocol') ----- + monthName + + + ^ Month nameOfMonth: self month! Item was added: + ----- Method: LXDateAndTime>>nanoSecond (in category 'squeak protocol') ----- + nanoSecond + + ^utcMicroseconds \\ 1000000 * 1000 + ! Item was added: + ----- Method: LXDateAndTime>>noon (in category 'squeak protocol') ----- + noon + "Answer a DateAndTime starting at noon" + + ^ self dayMonthYearDo: + [ :d :m :y | self class year: y month: m day: d hour: 12 minute: 0 second: 0 ] + ! Item was added: + ----- Method: LXDateAndTime>>normalize:ticks:base: (in category 'private') ----- + normalize: i ticks: ticks base: base + + | tick div quo rem | + tick := ticks at: i. + div := tick asInteger digitDiv: base neg: tick negative. + quo := (div at: 1) normalize. + rem := (div at: 2) normalize. + rem < 0 ifTrue: [ quo := quo - 1. rem := base + rem ]. + ticks at: (i-1) put: ((ticks at: i-1) + quo). + ticks at: i put: rem + ! Item was added: + ----- Method: LXDateAndTime>>offset (in category 'ansi protocol') ----- + offset + + ^ Duration seconds: localOffsetSeconds! Item was added: + ----- Method: LXDateAndTime>>offset: (in category 'ansi protocol') ----- + offset: anOffset + + "Answer a <DateAndTime> equivalent to the receiver but with its local time + being offset from UTC by offset." + + ^ self class utcMicroseconds: utcMicroseconds offset: anOffset asDuration asSeconds + ! Item was added: + ----- Method: LXDateAndTime>>offsetSeconds (in category 'transitional - temporary') ----- + offsetSeconds + + ^localOffsetSeconds ifNil: [localOffsetSeconds := self offset asSeconds]! Item was added: + ----- Method: LXDateAndTime>>posixEpochJulianDays (in category 'DTL-initializing') ----- + posixEpochJulianDays + + ^self class daysFromSmalltalkEpochToPosixEpoch + SqueakEpoch! Item was added: + ----- Method: LXDateAndTime>>posixMicrosecondsJdn:seconds:nanos:offset: (in category 'transitional - temporary') ----- + posixMicrosecondsJdn: j seconds: s nanos: n offset: o + + | days totalSeconds micros | + days := j - self posixEpochJulianDays. + totalSeconds := days * 24 * 60 * 60 + s. + micros := totalSeconds * 1000000. + ^micros + (n / 1000) + ! Item was added: + ----- Method: LXDateAndTime>>printHMSOn: (in category 'squeak protocol') ----- + printHMSOn: aStream + "Print just hh:mm:ss" + aStream + nextPutAll: (self hour asString padded: #left to: 2 with: $0); + nextPut: $:; + nextPutAll: (self minute asString padded: #left to: 2 with: $0); + nextPut: $:; + nextPutAll: (self second asString padded: #left to: 2 with: $0). + ! Item was added: + ----- Method: LXDateAndTime>>printOn: (in category 'squeak protocol') ----- + printOn: aStream + "Print as per ISO 8601 sections 5.3.3 and 5.4.1. + Prints either: + 'YYYY-MM-DDThh:mm:ss.s+ZZ:zz:z' (for positive years) or '-YYYY-MM-DDThh:mm:ss.s+ZZ:zz:z' (for negative years)" + + ^self printOn: aStream withLeadingSpace: false + ! Item was added: + ----- Method: LXDateAndTime>>printOn:withLeadingSpace: (in category 'squeak protocol') ----- + printOn: aStream withLeadingSpace: printLeadingSpaceToo + "Print as per ISO 8601 sections 5.3.3 and 5.4.1. + If printLeadingSpaceToo is false, prints either: + 'YYYY-MM-DDThh:mm:ss.s+ZZ:zz:z' (for positive years) or '-YYYY-MM-DDThh:mm:ss.s+ZZ:zz:z' (for negative years) + If printLeadingSpaceToo is true, prints either: + ' YYYY-MM-DDThh:mm:ss.s+ZZ:zz:z' (for positive years) or '-YYYY-MM-DDThh:mm:ss.s+ZZ:zz:z' (for negative years) + " + + self printYMDOn: aStream withLeadingSpace: printLeadingSpaceToo. + aStream nextPut: $T. + self printHMSOn: aStream. + self nanoSecond ~= 0 ifTrue: + [ | z ps | + ps := self nanoSecond printString padded: #left to: 9 with: $0. + z := ps findLast: [ :c | c asciiValue > $0 asciiValue ]. + (z > 0) ifTrue: [aStream nextPut: $.]. + ps from: 1 to: z do: [ :c | aStream nextPut: c ] ]. + aStream + nextPut: (self offset positive ifTrue: [$+] ifFalse: [$-]); + nextPutAll: (self offset hours abs asString padded: #left to: 2 with: $0); + nextPut: $:; + nextPutAll: (self offset minutes abs asString padded: #left to: 2 with: $0). + self offset seconds = 0 ifFalse: + [ aStream + nextPut: $:; + nextPutAll: (self offset seconds abs truncated asString) ]. + ! Item was added: + ----- Method: LXDateAndTime>>printYMDOn: (in category 'squeak protocol') ----- + printYMDOn: aStream + "Print just YYYY-MM-DD part. + If the year is negative, prints out '-YYYY-MM-DD'." + + ^self printYMDOn: aStream withLeadingSpace: false. + ! Item was added: + ----- Method: LXDateAndTime>>printYMDOn:withLeadingSpace: (in category 'squeak protocol') ----- + printYMDOn: aStream withLeadingSpace: printLeadingSpaceToo + "Print just the year, month, and day on aStream. + + If printLeadingSpaceToo is true, then print as: + ' YYYY-MM-DD' (if the year is positive) or '-YYYY-MM-DD' (if the year is negative) + otherwise print as: + 'YYYY-MM-DD' or '-YYYY-MM-DD' " + + | year month day | + self dayMonthYearDo: [ :d :m :y | year := y. month := m. day := d ]. + year negative + ifTrue: [ aStream nextPut: $- ] + ifFalse: [ printLeadingSpaceToo ifTrue: [ aStream space ]]. + aStream + nextPutAll: (year abs asString padded: #left to: 4 with: $0); + nextPut: $-; + nextPutAll: (month asString padded: #left to: 2 with: $0); + nextPut: $-; + nextPutAll: (day asString padded: #left to: 2 with: $0) + ! Item was added: + ----- Method: LXDateAndTime>>second (in category 'ansi protocol') ----- + second + + + ^ (Duration seconds: self getSeconds) seconds! Item was added: + ----- Method: LXDateAndTime>>seconds (in category 'smalltalk-80') ----- + seconds + + ^ self second + ! Item was added: + ----- Method: LXDateAndTime>>secondsSinceMidnight (in category 'private') ----- + secondsSinceMidnight + + ^ self getSeconds! Item was added: + ----- Method: LXDateAndTime>>setJdn:seconds:nano:offset: (in category 'squeak protocol') ----- + setJdn: jdn seconds: s nano: n offset: o + + localOffsetSeconds := o asSeconds. + utcMicroseconds := self posixMicrosecondsJdn: jdn seconds: s nanos: n offset: localOffsetSeconds. + + ! Item was added: + ----- Method: LXDateAndTime>>ticks (in category 'private') ----- + ticks + "Private - answer an array with our instance variables. Assumed to be UTC " + + ^ Array with: self julianDayNumber with: self getSeconds with: self nanoSecond + ! Item was added: + ----- Method: LXDateAndTime>>ticks:offset: (in category 'private') ----- + ticks: ticks offset: utcOffset + "ticks is {julianDayNumber. secondCount. nanoSeconds}" + + | jdn s nanos | + self normalize: 3 ticks: ticks base: NanosInSecond. + self normalize: 2 ticks: ticks base: SecondsInDay. + + jdn := ticks at: 1. + s := ticks at: 2. + nanos := ticks at: 3. + localOffsetSeconds := utcOffset asSeconds. + utcMicroseconds := self posixMicrosecondsJdn: jdn seconds: s nanos: nanos offset: localOffsetSeconds. + ! Item was added: + ----- Method: LXDateAndTime>>timeZoneAbbreviation (in category 'ansi protocol') ----- + timeZoneAbbreviation + + ^ self class localTimeZone abbreviation! Item was added: + ----- Method: LXDateAndTime>>timeZoneName (in category 'ansi protocol') ----- + timeZoneName + + ^ self class localTimeZone name! Item was added: + ----- Method: LXDateAndTime>>to: (in category 'squeak protocol') ----- + to: anEnd + "Answer a Timespan. anEnd conforms to protocol DateAndTime or protocol Timespan" + + ^ Timespan starting: self ending: (anEnd asLXDateAndTime) + ! Item was added: + ----- Method: LXDateAndTime>>to:by: (in category 'squeak protocol') ----- + to: anEnd by: aDuration + "Answer a Timespan. anEnd conforms to protocol DateAndTime or protocol Timespan" + + ^ (Schedule starting: self ending: (anEnd asLXDateAndTime)) + schedule: (Array with: aDuration asDuration); + yourself + ! Item was added: + ----- Method: LXDateAndTime>>to:by:do: (in category 'squeak protocol') ----- + to: anEnd by: aDuration do: aBlock + "Answer a Timespan. anEnd conforms to protocol DateAndTime or protocol Timespan" + + ^ (self to: anEnd by: aDuration) scheduleDo: aBlock! Item was added: + ----- Method: LXDateAndTime>>utcMicroseconds (in category 'transitional - temporary') ----- + utcMicroseconds + ^utcMicroseconds! Item was added: + ----- Method: LXDateAndTime>>utcMicroseconds:offset: (in category 'DTL-initializing') ----- + utcMicroseconds: microsecondsSincePosixEpoch offset: tzOffset + + utcMicroseconds := microsecondsSincePosixEpoch. + localOffsetSeconds := tzOffset. + ! Item was added: + ----- Method: LXDateAndTime>>utcOffset: (in category 'squeak protocol') ----- + utcOffset: anOffset + + "Answer a <DateAndTime> equivalent to the receiver but offset from UTC by anOffset" + + | equiv | + equiv := self + (anOffset asDuration - self offset). + ^ equiv ticks: (equiv ticks) offset: anOffset asDuration; yourself! Item was added: + ----- Method: LXDateAndTime>>year (in category 'ansi protocol') ----- + year + ^ self + dayMonthYearDo: [ :d :m :y | y ] + ! Item was added: + TestCase subclass: #LXDateAndTimeConversionTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Chronology-Core'! Item was added: + ----- Method: LXDateAndTimeConversionTest>>testAsSeconds (in category 'testing') ----- + testAsSeconds + + | day dt hour lxdt min mo nano offset sec yr expectedSeconds | + yr := 1970. + mo := 12. + day := 2. + hour := 2. + min := 3. + sec := 4. + nano := 5. + offset := 6 hours. + lxdt := LXDateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + dt := DateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + self assert: 2206404184 equals: dt asSeconds. + self assert: 2206404184 equals: lxdt asSeconds. + + yr := 1969. + lxdt := LXDateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + dt := DateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + expectedSeconds := 2206404184 - (365 * 24 * 60 * 60). + self assert: expectedSeconds equals: dt asSeconds. + self assert: expectedSeconds equals: lxdt asSeconds. + ! Item was added: + ----- Method: LXDateAndTimeConversionTest>>testAsSeconds2 (in category 'testing') ----- + testAsSeconds2 + "(self selector: #testAsSeconds2) debug" + + | day dt hour lxdt min mo nano offset sec | + mo := 12. + day := 2. + hour := 2. + min := 3. + sec := 4. + nano := 5. + offset := 6 hours. + " -2000 to: 5000 do: [:yr |" + 1970 to: 5000 do: [:yr | + lxdt := LXDateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + dt := DateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + self assert: dt asSeconds equals: lxdt asSeconds]. + ! Item was added: + ----- Method: LXDateAndTimeConversionTest>>testDayOfMonth (in category 'testing') ----- + testDayOfMonth + "(self selector: #testDayOfMonth) debug" + + | day dt hour lxdt min mo nano offset sec | + mo := 12. + day := 2. + hour := 2. + min := 3. + sec := 4. + nano := 5. + offset := 6 hours. + -1200 to: 3000 do: [:yr | + lxdt := LXDateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + dt := DateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + self assert: dt dayOfMonth equals: lxdt dayOfMonth]. + ! Item was added: + ----- Method: LXDateAndTimeConversionTest>>testDayOfWeek (in category 'testing') ----- + testDayOfWeek + "(self selector: #testDayOfWeek) debug" + + | day dt hour lxdt min mo nano offset sec | + mo := 12. + day := 2. + hour := 2. + min := 3. + sec := 4. + nano := 5. + offset := 6 hours. + -1200 to: 3000 do: [:yr | + lxdt := LXDateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + dt := DateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + self assert: dt dayOfWeek equals: lxdt dayOfWeek]. + ! Item was added: + ----- Method: LXDateAndTimeConversionTest>>testDayOfYear (in category 'testing') ----- + testDayOfYear + "(self selector: #testDayOfYear) debug" + + | day dt hour lxdt min mo nano offset sec | + mo := 12. + day := 2. + hour := 2. + min := 3. + sec := 4. + nano := 5. + offset := 6 hours. + -1200 to: 3000 do: [:yr | + lxdt := LXDateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + dt := DateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + self assert: dt dayOfYear equals: lxdt dayOfYear]. + ! Item was added: + ----- Method: LXDateAndTimeConversionTest>>testFromString (in category 'testing') ----- + testFromString + "Convert to string then back, verify same date and time. Skip years in the + range 0 to 99 because they are interpreted relative to 2000." + + "(LXDateAndTimeConversionTest selector: #testFromString) debug" + + | day hour lxdt min mo nano offset sec newLxdt s | + mo := 12. + day := 2. + hour := 2. + min := 3. + sec := 4. + nano := 5. + offset := 6 hours. + (-2000 to: -1) , (100 to: 5000) do: [:yr | + lxdt := LXDateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + s := lxdt asString. + newLxdt := LXDateAndTime fromString: s. + self assert: lxdt equals: newLxdt]. + ! Item was added: + ----- Method: LXDateAndTimeConversionTest>>testJulianDayNumber (in category 'testing') ----- + testJulianDayNumber + "(self selector: #testJulianDayNumber) debug" + + | day dt hour lxdt min mo nano offset sec | + mo := 12. + day := 2. + hour := 2. + min := 3. + sec := 4. + nano := 5. + offset := 6 hours. + -2000 to: 5000 do: [:yr | + lxdt := LXDateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + dt := DateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + self assert: dt julianDayNumber equals: lxdt julianDayNumber]. + ! Item was added: + ----- Method: LXDateAndTimeConversionTest>>testMinute (in category 'testing') ----- + testMinute + "(self selector: #testMinute) debug" + + | day dt hour lxdt min mo nano offset sec | + mo := 12. + day := 2. + hour := 2. + min := 3. + sec := 4. + nano := 5. + offset := 6 hours. + -2000 to: 5000 do: [:yr | + lxdt := LXDateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + dt := DateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + self assert: dt minute equals: lxdt minute]. + ! Item was added: + ----- Method: LXDateAndTimeConversionTest>>testMonth (in category 'testing') ----- + testMonth + + | day dt hour lxdt min mo nano offset sec yr | + yr := 1969. + mo := 12. + day := 2. + hour := 2. + min := 3. + sec := 4. + nano := 5. + offset := 6 hours. + lxdt := LXDateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + dt := DateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + self assert: 12 equals: dt month. + self assert: 12 equals: lxdt month. + + (2105 to: -1105 by: 20) + do: [:year | + 1 to: 12 do: [:m | + lxdt := LXDateAndTime + year: year month: m day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + dt := DateAndTime + year: year month: m day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + self assert: m equals: dt month. + self assert: m equals: lxdt month]] + ! Item was added: + ----- Method: LXDateAndTimeConversionTest>>testNanoSecond (in category 'testing') ----- + testNanoSecond + + | day dt hour lxdt min mo nano offset sec yr | + yr := 1969. + mo := 12. + day := 2. + hour := 2. + min := 3. + sec := 4. + nano := 5. + offset := 6 hours. + lxdt := LXDateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + dt := DateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + self assert: 5 equals: dt nanoSecond. + self assert: 5 equals: lxdt nanoSecond. + + (2105 to: -1105 by: 20) + do: [:year | + lxdt := LXDateAndTime + year: year month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + dt := DateAndTime + year: year month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + self assert: 5 equals: dt nanoSecond. + self assert: 5 equals: lxdt nanoSecond] + + ! Item was added: + ----- Method: LXDateAndTimeConversionTest>>testSecond (in category 'testing') ----- + testSecond + "(self selector: #testSecond) debug" + + | day dt hour lxdt min mo nano offset sec | + mo := 12. + day := 2. + hour := 2. + min := 3. + sec := 4. + nano := 5. + offset := 6 hours. + -2000 to: 5000 do: [:yr | + lxdt := LXDateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + dt := DateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + self assert: dt second equals: lxdt second]. + ! Item was added: + ----- Method: LXDateAndTimeConversionTest>>testYear (in category 'testing') ----- + testYear + + | day dt hour lxdt min mo nano offset sec yr | + yr := 1969. + mo := 12. + day := 2. + hour := 2. + min := 3. + sec := 4. + nano := 5. + offset := 6 hours. + lxdt := LXDateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + dt := DateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + self assert: 1969 equals: dt year. + self assert: 1969 equals: lxdt year. + + (2105 to: -1105 by: 20) + do: [:year | + lxdt := LXDateAndTime + year: year month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + dt := DateAndTime + year: year month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + self assert: year equals: dt year. + self assert: year equals: lxdt year] + + ! Item was added: + TestCase subclass: #LXDateAndTimeEpochTest + instanceVariableNames: 'aDateAndTime aDuration aTimeZone localTimeZoneToRestore' + classVariableNames: '' + poolDictionaries: '' + category: 'Chronology-Core'! + + !LXDateAndTimeEpochTest commentStamp: 'tlk 1/6/2004 18:27' prior: 0! + I represent one of several Sunit test Cases intentended to provide complete coverage for the Chronology set of classes as part of the external testing. The other Chronology sunit test cases are: + DateTestCase + DateAndTimeLeapTestCase, + DurationTestCase, + ScheduleTestCase + TimeStampTestCase + TimespanDoTestCase, + TimespanDoSpanAYearTestCase, + TimespanTestCase, + YearMonthWeekTestCase. + These tests attempt to exercise all public and private methods. Except, they do not explicitly depreciated methods. tlk + My fixtures are: + aDateAndTime = January 01, 1901 midnight (the start of the Squeak epoch) with localTimeZone = Grenwhich Meridian (local offset = 0 hours) + aDuration = 1 day, 2 hours, 3, minutes, 4 seconds and 5 nano seconds. + aTimeZone = 'Epoch Test Time Zone', 'ETZ' , offset: 12 hours, 15 minutes. ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>setUp (in category 'running') ----- + setUp + localTimeZoneToRestore := LXDateAndTime localTimeZone. + aDateAndTime := LXDateAndTime localTimeZone: TimeZone default; epoch. + aTimeZone := TimeZone offset: (Duration minutes: 135) name: 'Epoch Test Time Zone' abbreviation: 'ETZ'. + aDuration := Duration days: 1 hours: 2 minutes: 3 seconds: 4 nanoSeconds: 5 ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>tearDown (in category 'running') ----- + tearDown + LXDateAndTime localTimeZone: localTimeZoneToRestore. + "wish I could remove the time zones I added earlier, tut there is no method for that" + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testAsDate (in category 'testing') ----- + testAsDate + self assert: aDateAndTime asDate = 'January 1, 1901' asDate. + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testAsDateAndTime (in category 'testing') ----- + testAsDateAndTime + self assert: aDateAndTime asLXDateAndTime = aDateAndTime + + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testAsDuration (in category 'testing') ----- + testAsDuration + self assert: aDateAndTime asDuration = 0 asDuration + + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testAsLocal (in category 'testing') ----- + testAsLocal + self assert: aDateAndTime asLocal = aDateAndTime. + self assert: aDateAndTime asLocal = (aDateAndTime utcOffset: aDateAndTime class localOffset) + + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testAsMonth (in category 'testing') ----- + testAsMonth + self assert: aDateAndTime asMonth = (Month month: 'January' year: 1901). + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testAsNanoSeconds (in category 'testing') ----- + testAsNanoSeconds + self assert: aDateAndTime asNanoSeconds = 0 asDuration asNanoSeconds + + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testAsSeconds (in category 'testing') ----- + testAsSeconds + self assert: aDateAndTime asSeconds = 0 asDuration asSeconds + + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testAsTime (in category 'testing') ----- + testAsTime + self assert: aDateAndTime asTime = Time midnight. + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testAsTimeStamp (in category 'testing') ----- + testAsTimeStamp + self assert: aDateAndTime asTimeStamp = TimeStamp new. + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testAsUTC (in category 'testing') ----- + testAsUTC + self assert: aDateAndTime asUTC = aDateAndTime + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testAsWeek (in category 'testing') ----- + testAsWeek + self assert: aDateAndTime asWeek = (Week starting: '12-31-1900' asDate). + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testAsYear (in category 'testing') ----- + testAsYear + self assert: aDateAndTime asYear = (Year starting: '01-01-1901' asDate). + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testCurrent (in category 'testing') ----- + testCurrent + self deny: aDateAndTime = (LXDateAndTime current). + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testDateTime (in category 'testing') ----- + testDateTime + self assert: aDateAndTime = (LXDateAndTime date: '01-01-1901' asDate time: '00:00:00' asTime) + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testDay (in category 'testing') ----- + testDay + self assert: aDateAndTime day = LXDateAndTime new day + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testDayMonthYearDo (in category 'testing') ----- + testDayMonthYearDo + |iterations| + iterations := 0. + self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear | iterations := iterations + 1]) = 1. + self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear | eachYear]) = 1901. + self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear | eachMonth]) = 1. + self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear | eachDay]) = 1. + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testDayOfMonth (in category 'testing') ----- + testDayOfMonth + self assert: aDateAndTime dayOfMonth = 1. + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testDayOfWeek (in category 'testing') ----- + testDayOfWeek + self assert: aDateAndTime dayOfWeek = 3. + self assert: aDateAndTime dayOfWeekAbbreviation = 'Tue'. + self assert: aDateAndTime dayOfWeekName = 'Tuesday'. + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testDayOfYear (in category 'testing') ----- + testDayOfYear + self assert: aDateAndTime dayOfYear = 1. + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testDaysInMonth (in category 'testing') ----- + testDaysInMonth + self assert: aDateAndTime daysInMonth = 31. + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testDaysInYear (in category 'testing') ----- + testDaysInYear + self assert: aDateAndTime daysInYear = 365. + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testDaysLeftInYear (in category 'testing') ----- + testDaysLeftInYear + self assert: aDateAndTime daysLeftInYear = 364. + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testDuration (in category 'testing') ----- + testDuration + self assert: aDateAndTime duration = 0 asDuration. + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testEpoch (in category 'testing') ----- + testEpoch + self assert: aDateAndTime = '1901-01-01T00:00:00+00:00' asLXDateAndTime + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testFirstDayOfMonth (in category 'testing') ----- + testFirstDayOfMonth + self assert: aDateAndTime firstDayOfMonth = 1 + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testFromSeconds (in category 'testing') ----- + testFromSeconds + self assert: aDateAndTime = (LXDateAndTime fromSeconds: 0). + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testFromString (in category 'testing') ----- + testFromString + self assert: aDateAndTime = (LXDateAndTime fromString: ' 1901-01-01T00:00:00+00:00'). + self assert: aDateAndTime = (LXDateAndTime fromString: ' 1901-01-01T00:00:00'). + self assert: aDateAndTime = (LXDateAndTime fromString: ' 1901-01-01T00:00'). + self assert: aDateAndTime = (LXDateAndTime fromString: ' 1901-01-01T00:00:00+00:00'). + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testHash (in category 'testing') ----- + testHash + self assert: aDateAndTime hash = LXDateAndTime new hash. + self assert: aDateAndTime hash = 112557138 + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testHour (in category 'testing') ----- + testHour + self assert: aDateAndTime hour = aDateAndTime hour24. + self assert: aDateAndTime hour = 0. + self assert: aDateAndTime hour = aDateAndTime hours + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testHour12 (in category 'testing') ----- + testHour12 + self assert: aDateAndTime hour12 = LXDateAndTime new hour12. + self assert: aDateAndTime hour12 = 12 + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testIsLeapYear (in category 'testing') ----- + testIsLeapYear + self deny: aDateAndTime isLeapYear + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testJulianDayNumber (in category 'testing') ----- + testJulianDayNumber + self assert: aDateAndTime = (LXDateAndTime julianDayNumber: 2415386). + self assert: aDateAndTime julianDayNumber = 2415386.! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testLessThan (in category 'testing') ----- + testLessThan + self assert: aDateAndTime < (aDateAndTime + '1:00:00:00'). + self assert: aDateAndTime + -1 < aDateAndTime. + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testMeridianAbbreviation (in category 'testing') ----- + testMeridianAbbreviation + self assert: aDateAndTime meridianAbbreviation = 'AM'. + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testMiddleOf (in category 'testing') ----- + testMiddleOf + self assert: (aDateAndTime middleOf: '2:00:00:00' asDuration) = + (Timespan starting: '12-31-1900' asDate duration: 2 days). + + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testMidnight (in category 'testing') ----- + testMidnight + self assert: aDateAndTime midnight = aDateAndTime + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testMinus (in category 'testing') ----- + testMinus + self assert: aDateAndTime - aDateAndTime = '0:00:00:00' asDuration. + self assert: aDateAndTime - '0:00:00:00' asDuration = aDateAndTime. + self assert: aDateAndTime - aDuration = (LXDateAndTime year: 1900 month: 12 day: 30 hour: 21 minute: 56 second: 55 nanoSecond: 999999995 offset: 0 hours ). + " I believe this Failure is a bug in the nanosecond part of (LXDateAndTime >> year:month:day:hour:minute:second:nanoSecond:offset:)" ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testMinute (in category 'testing') ----- + testMinute + self assert: aDateAndTime minute = 0 + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testMinutes (in category 'testing') ----- + testMinutes + self assert: aDateAndTime minutes = 0 + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testMonth (in category 'testing') ----- + testMonth + self assert: aDateAndTime month = 1. + self assert: aDateAndTime monthAbbreviation = 'Jan'. + self assert: aDateAndTime monthName = 'January'. + self assert: aDateAndTime monthIndex = 1.! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testNanoSecond (in category 'testing') ----- + testNanoSecond + self assert: aDateAndTime nanoSecond = 0 + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testNew (in category 'testing') ----- + testNew + self assert: aDateAndTime = (LXDateAndTime new). + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testNoon (in category 'testing') ----- + testNoon + self assert: aDateAndTime noon = '1901-01-01T12:00:00+00:00' asLXDateAndTime! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testNow (in category 'testing') ----- + testNow + self deny: aDateAndTime = (LXDateAndTime now). + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testOffset (in category 'testing') ----- + testOffset + self assert: aDateAndTime offset = '0:00:00:00' asDuration. + self assert: (aDateAndTime offset: '0:12:00:00') = '1901-01-01T00:00:00+12:00' asLXDateAndTime! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testPlus (in category 'testing') ----- + testPlus + self assert: aDateAndTime + '0:00:00:00' = aDateAndTime. + self assert: aDateAndTime + 0 = aDateAndTime. + self assert: aDateAndTime + aDuration = (LXDateAndTime year: 1901 month: 1 day: 2 hour: 2 minute: 3 second: 4 nanoSecond: 5 offset: 0 hours ) + " I believe this is a bug in the nanosecond part of (DateAndTime >> year:month:day:hour:minute:second:nanoSecond:offset:)" + + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testPrintOn (in category 'testing') ----- + testPrintOn + | ref ws | + ref := '1901-01-01T00:00:00+00:00'. + ws := '' writeStream. + aDateAndTime printOn: ws. + self assert: ws contents = ref. + ref := 'a TimeZone(ETZ)'. + ws := '' writeStream. + aTimeZone printOn: ws. + self assert: ws contents = ref! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testSecond (in category 'testing') ----- + testSecond + self assert: aDateAndTime second = 0 + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testSeconds (in category 'testing') ----- + testSeconds + self assert: aDateAndTime seconds = 0 + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testTicks (in category 'testing') ----- + testTicks + self assert: aDateAndTime ticks = (LXDateAndTime julianDayNumber: 2415386) ticks. + self assert: aDateAndTime ticks = #(2415386 0 0)! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testTicksOffset (in category 'testing') ----- + testTicksOffset + self assert: aDateAndTime = (aDateAndTime ticks: #(2415386 0 0) offset: LXDateAndTime localOffset). + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testTo (in category 'testing') ----- + testTo + self assert: (aDateAndTime to: aDateAndTime) = (LXDateAndTime new to: LXDateAndTime new) + "MessageNotUnderstood: UndefinedObject>>starting:ending: where UndefinedObject is Timespan "! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testToBy (in category 'testing') ----- + testToBy + self assert: (aDateAndTime to: aDateAndTime + 10 days by: 5 days) = + (LXDateAndTime new to: LXDateAndTime new + 10 days by: 5 days ) + "MessageNotUnderstood: UndefinedObject>>starting:ending: where UndefinedObject is Timespan "! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testToByDo (in category 'testing') ----- + testToByDo + "self assert: (aDateAndTime to: aDateAndTime + 10 days by: 5 days do: []) = " + "MessageNotUnderstood: UndefinedObject>>starting:ending: where UndefinedObject is Timespan "! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testToday (in category 'testing') ----- + testToday + self deny: aDateAndTime = (LXDateAndTime today). + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testTommorrow (in category 'testing') ----- + testTommorrow + self assert: (LXDateAndTime today + 24 hours) = (LXDateAndTime tomorrow). + self deny: aDateAndTime = (LXDateAndTime tomorrow). + "MessageNotUnderstood: Date class>>starting:"! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testUtcOffset (in category 'testing') ----- + testUtcOffset + self assert: (aDateAndTime utcOffset: '0:12:00:00') = '1901-01-01T12:00:00+12:00' asLXDateAndTime! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testYear (in category 'testing') ----- + testYear + self assert: aDateAndTime year = 1901. + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testYearDay (in category 'testing') ----- + testYearDay + self assert: aDateAndTime = (LXDateAndTime year: 1901 day: 1). + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testYearDayHourMinuteSecond (in category 'testing') ----- + testYearDayHourMinuteSecond + self assert: aDateAndTime = (LXDateAndTime year: 1901 day: 1 hour: 0 minute: 0 second: 0). + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testYearMonthDay (in category 'testing') ----- + testYearMonthDay + self assert: aDateAndTime = (LXDateAndTime year: 1901 month: 1 day: 1). + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testYearMonthDayHourMinuteSecond (in category 'testing') ----- + testYearMonthDayHourMinuteSecond + self assert: aDateAndTime = (LXDateAndTime year: 1901 month: 1 day: 1 hour: 0 minute: 0 second: 0). + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testYearMonthDayHourMinuteSecondNanosSecondOffset (in category 'testing') ----- + testYearMonthDayHourMinuteSecondNanosSecondOffset + self assert: aDateAndTime = (LXDateAndTime year: 1901 month: 1 day: 1 hour: 0 minute: 0 second: 0 nanoSecond: 0 offset:0 hours ). + self assert: ((LXDateAndTime year: 1 month: 1 day: 1 hour: 0 minute: 0 second: 0 nanoSecond: 0 offset: 0 hours ) + + (Duration days: 1 hours: 2 minutes: 3 seconds: 4 nanoSeconds: 5) ) = + (LXDateAndTime year: 1 month: 1 day: 2 hour: 2 minute: 3 second: 4 nanoSecond: 5 offset: 0 hours ) + " I believe this is a bug in the nanosecond part of (DateAndTime >> year:month:day:hour:minute:second:nanoSecond:offset:)"" I believe this is a bug in the nanosecond part of (DateAndTime >> year:month:day:hour:minute:second:nanoSecond:offset:)" + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testYesterday (in category 'testing') ----- + testYesterday + self deny: aDateAndTime = (LXDateAndTime yesterday). + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testtimeZone (in category 'testing') ----- + testtimeZone + self assert: aDateAndTime timeZoneName = 'Universal Time'. + self assert: aDateAndTime timeZoneAbbreviation = 'UTC' + ! Item was added: + TestCase subclass: #LXDateAndTimeLeapTest + instanceVariableNames: 'aDateAndTime aDuration aTimeZone localTimeZoneToRestore' + classVariableNames: '' + poolDictionaries: '' + category: 'Chronology-Core'! + + !LXDateAndTimeLeapTest commentStamp: 'tlk 1/6/2004 17:54' prior: 0! + I represent one of several Sunit test Cases intentended to provide complete coverage for the Chronology set of classes as part of the external testing. tlk. + My fixtures are: + aDateAndTime = February 29, 2004 1:33 PM with offset: 2 hours + aDuration = 15 days, 14 hours, 13 minutes, 12 seconds and 11 nano seconds. + aTimeZone = Grenwhich Meridian (local offset = 0 hours) ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>setUp (in category 'running') ----- + setUp + localTimeZoneToRestore := LXDateAndTime localTimeZone. + LXDateAndTime localTimeZone: TimeZone default. + aDateAndTime := (LXDateAndTime year: 2004 month: 2 day: 29 hour: 13 minute: 33 second: 0 offset: 2 hours). + aTimeZone := TimeZone default. + aDuration := Duration days: 0 hours: 13 minutes: 33 seconds: 0 nanoSeconds: 0 + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>tearDown (in category 'running') ----- + tearDown + LXDateAndTime localTimeZone: localTimeZoneToRestore. + "wish I could remove the time zones I added earlier, tut there is no method for that" + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testAsDate (in category 'testing') ----- + testAsDate + self assert: (aDateAndTime offset: LXDateAndTime localTimeZone offset) asDate = 'February 29, 2004' asDate! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testAsDuration (in category 'testing') ----- + testAsDuration + self assert: aDateAndTime asDuration = aDuration + + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testAsLocal (in category 'testing') ----- + testAsLocal + self assert: aDateAndTime asLocal = aDateAndTime. + self assert: aDateAndTime asLocal = (aDateAndTime utcOffset: aDateAndTime class localOffset) + + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testAsMonth (in category 'testing') ----- + testAsMonth + self assert: + (aDateAndTime offset: Month defaultOffset) asMonth = + (Month + month: 'February' + year: 2004)! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testAsNanoSeconds (in category 'testing') ----- + testAsNanoSeconds + self assert: aDateAndTime asNanoSeconds = aDuration asNanoSeconds. + self assert: aDateAndTime asNanoSeconds = 48780000000000 + + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testAsSeconds (in category 'testing') ----- + testAsSeconds + self assert: aDuration asSeconds = 48780. + self assert: aDateAndTime asSeconds = 3255514380! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testAsTime (in category 'testing') ----- + testAsTime + self assert: aDateAndTime asTime = (Time hour: 13 minute: 33 second: 0) + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testAsTimeStamp (in category 'testing') ----- + testAsTimeStamp + self assert: aDateAndTime asTimeStamp = ((TimeStamp readFrom: '2-29-2004 1:33 pm' readStream) offset: 2 hours). + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testAsUTC (in category 'testing') ----- + testAsUTC + self assert: aDateAndTime asUTC = aDateAndTime + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testAsWeek (in category 'testing') ----- + testAsWeek + self assert: (aDateAndTime offset: LXDateAndTime localTimeZone offset) asWeek = (Week starting: '02-29-2004' asDate)! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testAsYear (in category 'testing') ----- + testAsYear + | year | + year := (aDateAndTime offset: LXDateAndTime localTimeZone offset) asYear. + self assert: year = (Year starting: '02-29-2004' asDate). + self deny: year = (Year starting: '01-01-2004' asDate)! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testDay (in category 'testing') ----- + testDay + self assert: aDateAndTime day = 60. + self deny: aDateAndTime day = 29 ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testDayMonthYearDo (in category 'testing') ----- + testDayMonthYearDo + self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear | eachYear]) = 2004. + self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear | eachMonth]) = 2. + self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear | eachDay]) = 29. + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testDayOfMonth (in category 'testing') ----- + testDayOfMonth + self assert: aDateAndTime dayOfMonth = 29. + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testDayOfWeek (in category 'testing') ----- + testDayOfWeek + self assert: aDateAndTime dayOfWeek = 1. + self assert: aDateAndTime dayOfWeekAbbreviation = 'Sun'. + self assert: aDateAndTime dayOfWeekName = 'Sunday'. + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testDayOfYear (in category 'testing') ----- + testDayOfYear + self assert: aDateAndTime dayOfYear = 60. + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testDaysInMonth (in category 'testing') ----- + testDaysInMonth + self assert: aDateAndTime daysInMonth = 29. + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testDaysInYear (in category 'testing') ----- + testDaysInYear + self assert: aDateAndTime daysInYear = 366. + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testDaysLeftInYear (in category 'testing') ----- + testDaysLeftInYear + self assert: aDateAndTime daysLeftInYear = 306. + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testFirstDayOfMonth (in category 'testing') ----- + testFirstDayOfMonth + self deny: aDateAndTime firstDayOfMonth = 1. + self assert: aDateAndTime firstDayOfMonth = 32 + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testFromString (in category 'testing') ----- + testFromString + self assert: aDateAndTime = (LXDateAndTime fromString: ' 2004-02-29T13:33:00+02:00'). + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testHash (in category 'testing') ----- + testHash + self assert: aDateAndTime hash = 16256473 + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testHour (in category 'testing') ----- + testHour + self assert: aDateAndTime hour = aDateAndTime hour24. + self assert: aDateAndTime hour = 13. + self assert: aDateAndTime hour = aDateAndTime hours + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testHour12 (in category 'testing') ----- + testHour12 + self assert: aDateAndTime hour12 = 1. + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testIsLeapYear (in category 'testing') ----- + testIsLeapYear + self assert: aDateAndTime isLeapYear + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testLessThan (in category 'testing') ----- + testLessThan + self assert: aDateAndTime < (aDateAndTime + '1:00:00:00'). + self assert: aDateAndTime + -1 < aDateAndTime. + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testMeridianAbbreviation (in category 'testing') ----- + testMeridianAbbreviation + self assert: aDateAndTime meridianAbbreviation = 'PM'. + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testMiddleOf (in category 'testing') ----- + testMiddleOf + self assert: (aDateAndTime middleOf: aDuration) = + (Timespan starting: (LXDateAndTime year: 2004 month: 2 day: 29 hour: 6 minute: 46 second: 30 offset: 2 hours) + duration: (Duration days: 0 hours: 13 minutes: 33 seconds: 0 nanoSeconds: 0 )) + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testMidnight (in category 'testing') ----- + testMidnight + | midnight | + midnight := (aDateAndTime offset: LXDateAndTime localTimeZone offset) midnight. + self assert: midnight = '2004-02-29T00:00:00+00:00' asLXDateAndTime. + self deny: midnight = '2004-02-29T00:00:00+02:00' asLXDateAndTime! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testMinute (in category 'testing') ----- + testMinute + self assert: aDateAndTime minute = 33 + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testMinutes (in category 'testing') ----- + testMinutes + self assert: aDateAndTime minutes = 33 + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testMonth (in category 'testing') ----- + testMonth + self assert: aDateAndTime month = 2. + self assert: aDateAndTime monthAbbreviation = 'Feb'. + self assert: aDateAndTime monthName = 'February'. + self assert: aDateAndTime monthIndex = 2.! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testMonthParsing (in category 'testing') ----- + testMonthParsing + self assert: + (Month readFrom: 'Feb 2011' readStream) = + (Month + month: 2 + year: 2011)! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testNanoSecond (in category 'testing') ----- + testNanoSecond + self assert: aDateAndTime nanoSecond = 0 + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testNoon (in category 'testing') ----- + testNoon + self assert: aDateAndTime noon = '2004-02-29T12:00:00+00:00' asLXDateAndTime! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testOffset (in category 'testing') ----- + testOffset + self assert: aDateAndTime offset = '0:02:00:00' asDuration. + self assert: (aDateAndTime offset: '0:12:00:00') = '2004-02-29T13:33:00+12:00' asLXDateAndTime! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testPrintOn (in category 'testing') ----- + testPrintOn + | ref ws | + ref := '2004-02-29T13:33:00+02:00'. + ws := '' writeStream. + aDateAndTime printOn: ws. + self assert: ws contents = ref. + ref := 'a TimeZone(UTC)'. + ws := '' writeStream. + aTimeZone printOn: ws. + self assert: ws contents = ref ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testSecond (in category 'testing') ----- + testSecond + self assert: aDateAndTime second = 0 + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testSeconds (in category 'testing') ----- + testSeconds + self assert: aDateAndTime seconds = 0 + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testTicks (in category 'testing') ----- + testTicks + self assert: aDateAndTime ticks = ((LXDateAndTime julianDayNumber: 2453065) + 48780 seconds) ticks. + self assert: aDateAndTime ticks = #(2453065 48780 0)! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testTicksOffset (in category 'testing') ----- + testTicksOffset + self assert: aDateAndTime = (aDateAndTime ticks: #(2453065 48780 0) offset: LXDateAndTime localOffset). + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testUtcOffset (in category 'testing') ----- + testUtcOffset + self assert: (aDateAndTime utcOffset: '0:02:00:00') = '2004-02-29T13:33:00+02:00' asLXDateAndTime! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testYear (in category 'testing') ----- + testYear + self assert: aDateAndTime year = 2004. + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testYearDayHourMinuteSecond (in category 'testing') ----- + testYearDayHourMinuteSecond + self assert: aDateAndTime = ((LXDateAndTime year: 2004 day: 60 hour: 13 minute: 33 second: 0) offset: 2 hours). + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testYearMonthDayHourMinuteSecond (in category 'testing') ----- + testYearMonthDayHourMinuteSecond + self assert: aDateAndTime = ((LXDateAndTime year: 2004 month: 2 day: 29 hour: 13 minute: 33 second: 0) offset: 2 hours). + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testtimeZone (in category 'testing') ----- + testtimeZone + self assert: aDateAndTime timeZoneName = 'Universal Time'. + self assert: aDateAndTime timeZoneAbbreviation = 'UTC' + ! Item was added: + ClassTestCase subclass: #LXDateAndTimeTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Chronology-Core'! Item was added: + ----- Method: LXDateAndTimeTest>>classToBeTested (in category 'Coverage') ----- + classToBeTested + ^ LXDateAndTime + ! Item was added: + ----- Method: LXDateAndTimeTest>>selectorsToBeIgnored (in category 'Coverage') ----- + selectorsToBeIgnored + | private | + private := #( #printOn: ). + ^ super selectorsToBeIgnored, private + ! Item was added: + ----- Method: LXDateAndTimeTest>>testArithmeticAcrossDateBoundary (in category 'Tests') ----- + testArithmeticAcrossDateBoundary + | t1 t2 | + t1 := '2004-01-07T11:55:00+00:00' asLXDateAndTime. + t2 := t1 - ( (42900+1) seconds). + self + assert: t2 = ('2004-01-06T23:59:59+00:00' asLXDateAndTime) + + ! Item was added: + ----- Method: LXDateAndTimeTest>>testDateTimeDenotation1 (in category 'Tests') ----- + testDateTimeDenotation1 + "LXDateAndTimeTest new testDateTimeDenotation1" + + " Detroit is 5 hours behind UTC, this offset to UTC is therefore written with a minus sign. This example tests the correct interpretation of the DateAndTime denotation. " + | twoPmInLondon twoPmUTCInLocalTimeOfDetroit nineAmInDetroit | + twoPmInLondon := LXDateAndTime + year: 2004 + month: 11 + day: 2 + hour: 14 + minute: 0 + second: 0 + offset: 0 hours. + twoPmUTCInLocalTimeOfDetroit := twoPmInLondon utcOffset: -5 hours. + nineAmInDetroit := '2004-11-02T09:00:00-05:00' asLXDateAndTime. + self assert: twoPmUTCInLocalTimeOfDetroit = nineAmInDetroit. + + ! Item was added: + ----- Method: LXDateAndTimeTest>>testDateTimeDenotation2 (in category 'Tests') ----- + testDateTimeDenotation2 + "LXDateAndTimeTest new testDateTimeDenotation2" + + " Moscow is 3 hours ahead UTC, this offset to UTC is therefore positive. This example tests the correct interpretation of the DateAndTime denotation. " + | lateEveningInLondon lateEveningInLocalTimeOfMoscow + localMoscowTimeFromDenotation | + lateEveningInLondon := LXDateAndTime + year: 2004 + month: 11 + day: 30 + hour: 23 + minute: 30 + second: 0 + offset: 0 hours. + lateEveningInLocalTimeOfMoscow := lateEveningInLondon utcOffset: 3 hours. + localMoscowTimeFromDenotation := '2004-12-01T02:30:00+03:00' asLXDateAndTime. + self assert: lateEveningInLocalTimeOfMoscow = localMoscowTimeFromDenotation. + + ! Item was added: + ----- Method: LXDateAndTimeTest>>testErrorWhenDayIsAfterMonthEnd (in category 'Tests') ----- + testErrorWhenDayIsAfterMonthEnd + self + should: + [LXDateAndTime + year: 2004 + month: 2 + day: 30] + raise: Error.! Item was added: + ----- Method: LXDateAndTimeTest>>testErrorWhenDayIsBeforeMonthStart (in category 'Tests') ----- + testErrorWhenDayIsBeforeMonthStart + self + should: + [LXDateAndTime + year: 2004 + month: 2 + day: -1] + raise: Error. + self + should: + [LXDateAndTime + year: 2004 + month: 2 + day: 0] + raise: Error.! Item was added: + ----- Method: LXDateAndTimeTest>>testFromString (in category 'Tests') ----- + testFromString + | fromString fromStringNoOffset fromStringUTC | + fromString := LXDateAndTime fromString: '-1199-01-05T20:33:14.321-05:00'. + self assert: (fromString printString = '-1199-01-05T20:33:14.321-05:00'). + + "if no offset is provided, the local offset should be used" + fromStringNoOffset := LXDateAndTime fromString: '-1199-01-05T20:33:14.321'. + self assert: (fromStringNoOffset offset = LXDateAndTime localOffset). + + "if a string contains the UTC designator Z, the local offset should not be used" + fromStringUTC := LXDateAndTime fromString: '2011-08-26T18:00:03Z'. + self assert: (fromStringUTC printString = '2011-08-26T18:00:03+00:00').! Item was added: + ----- Method: LXDateAndTimeTest>>testHash (in category 'Tests') ----- + testHash + | date0 date1 date2 | + date0 := LXDateAndTime unixEpoch. + date1 := LXDateAndTime new ticks: (date0 + 1 hours) ticks offset: 0 hours. + date2 := LXDateAndTime new ticks: (date0 - 2 hours) ticks offset: -3 hours. + self assert: (date1 = date2) ==> [date1 hash = date2 hash]! Item was added: + ----- Method: LXDateAndTimeTest>>testInstanceCreation (in category 'Tests') ----- + testInstanceCreation + | t | + t := LXDateAndTime + year: 1 month: 1 day: 2 + hour: 2 minute: 3 second: 4 nanoSecond: 5 + offset: 6 hours. + self + assert: (t julianDayNumber = 1721427); + assert: (t offset = 6 hours); + assert: (t hour = 2); + assert: (t minute = 3); + assert: (t second = 4); + assert: (t nanoSecond = 5). + + ! Item was added: + ----- Method: LXDateAndTimeTest>>testMonotonicity (in category 'Tests') ----- + testMonotonicity + | t1 t2 t3 t4 | + t1 := LXDateAndTime now. + t2 := LXDateAndTime now. + (Delay forMilliseconds: 1000) wait. + t3 := LXDateAndTime now. + t4 := LXDateAndTime now. + self + assert: ( t1 <= t2); + assert: ( t2 < t3); + assert: ( t3 <= t4). + ! Item was added: + ----- Method: LXDateAndTimeTest>>testPrecision (in category 'Tests') ----- + testPrecision + "Verify that the clock is returning a value with accuracy of better than 1 second. For now it seems sufficient to get two values and verify they are not the same." + self + assert: (LXDateAndTime now ~= LXDateAndTime now) + ! Item was added: + ----- Method: LXDateAndTimeTest>>testPrintString (in category 'Tests') ----- + testPrintString + "(self new setTestSelector: #testPrintString) debug" + | dt dtNoOffset | + dt :=LXDateAndTime + year: 2004 + month: 11 + day: 2 + hour: 14 + minute: 3 + second: 5 + nanoSecond: 12345 + offset: (Duration seconds: (5 * 3600)). + self assert: dt printString = '2004-11-02T14:03:05.000012345+05:00'. + + self assert: ('2002-05-16T17:20:45.1+01:01' asLXDateAndTime printString = '2002-05-16T17:20:45.1+01:01'). + self assert: (' 2002-05-16T17:20:45.02+01:01' asLXDateAndTime printString = '2002-05-16T17:20:45.02+01:01'). + self assert: ('2002-05-16T17:20:45.000000009+01:01' asLXDateAndTime printString = '2002-05-16T17:20:45.000000009+01:01'). + self assert: ('2002-05-16T17:20:45+00:00' asLXDateAndTime printString = '2002-05-16T17:20:45+00:00' ). + self assert: (' 2002-05-16T17:20:45+01:57' asLXDateAndTime printString = '2002-05-16T17:20:45+01:57'). + self assert: (' 2002-05-16T17:20:45-02:34' asLXDateAndTime printString = '2002-05-16T17:20:45-02:34'). + self assert: ('2002-05-16T17:20:45+00:00' asLXDateAndTime printString = '2002-05-16T17:20:45+00:00'). + self assert: ('1997-04-26T01:02:03+01:02:3' asLXDateAndTime printString = '1997-04-26T01:02:03+01:02:3'). + "When no offset is provided, the local one is used" + dtNoOffset := '2002-05-16T17:20' asLXDateAndTime. + self assert: (('2002-05-16T17:20:00*' match: dtNoOffset printString) and: [dtNoOffset offset = LXDateAndTime localOffset]). + ! Item was added: + ----- Method: LXDateAndTimeTest>>testReadFrom (in category 'Tests') ----- + testReadFrom + self assert: ((LXDateAndTime readFrom: '-1199-01-05T20:33:14.321-05:00' readStream) printString = '-1199-01-05T20:33:14.321-05:00'). + ! Item was added: + ----- Method: LXDateAndTimeTest>>testSmalltalk80Accessors (in category 'Tests') ----- + testSmalltalk80Accessors + | t | + t := LXDateAndTime + year: 1 month: 1 day: 2 + hour: 2 minute: 3 second: 4 nanoSecond: 5 + offset: 6 hours. + self + assert: (t hours = t hours); + assert: (t minutes = t minute); + assert: (t seconds = t second). + ! Item was added: + ----- Method: LXDateAndTimeTest>>testTimeZoneEquivalence (in category 'Tests') ----- + testTimeZoneEquivalence + "LXDateAndTimeTest new testTimeZoneEquivalence" + "When the clock on the wall in Detroit says 9:00am, the clock on the wall + in London says 2:00pm. The Duration difference between the corresponding + DateAndTime values should be zero." + + " Detroit is 5 hours behind UTC, this offset to UTC is therefore written with a minus sign. This example tests both the correct interpretation of the DateAndTime denotation and correct DateAndTime arithmetics. " + | twoPmInLondon nineAmInDetroit durationDifference | + twoPmInLondon := '2004-11-02T14:00:00+00:00' asLXDateAndTime. + nineAmInDetroit := '2004-11-02T09:00:00-05:00' asLXDateAndTime. + durationDifference := twoPmInLondon - nineAmInDetroit. + self assert: durationDifference asSeconds = 0. + self assert: twoPmInLondon = nineAmInDetroit + ! Item was added: + ----- Method: LXDateAndTimeTest>>testTimeZoneEquivalence2 (in category 'Tests') ----- + testTimeZoneEquivalence2 + "LXDateAndTimeTest new testTimeZoneEquivalence2" + "This example demonstates the fact that + 2004-05-24T22:40:00 UTC is + 2004-05-25T01:40:00 in Moscow + (Moscow is 3 hours ahead of UTC) " + | thisMoment thisMomentInMoscow | + thisMoment := LXDateAndTime year: 2004 month: 5 day: 24 hour: 22 minute: 40. + thisMomentInMoscow := thisMoment utcOffset: 3 hours. + self assert: (thisMoment - thisMomentInMoscow) asSeconds = 0. + self assert: thisMoment = thisMomentInMoscow + ! Item was added: + LXDateAndTime subclass: #LXTimeStamp + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Chronology-Core'! + + !LXTimeStamp commentStamp: '<historical>' prior: 0! + This represents a duration of 0 length that marks a particular point in time.! Item was added: + ----- Method: LXTimeStamp class>>current (in category 'squeak protocol') ----- + current + + | ts ticks | + ts := super now asTimeStamp. + ticks := ts ticks. + ticks at: 3 put: 0. + ts ticks: ticks offset: ts offset. + ^ ts + ! Item was added: + ----- Method: LXTimeStamp class>>now (in category 'ansi protocol') ----- + now + "Answer the current date and time as a TimeStamp." + + ^self current! Item was added: + ----- Method: LXTimeStamp>>asDateAndTime (in category 'squeak protocol') ----- + asDateAndTime + "Answer the receiver as an instance of DateAndTime." + + ^ self asLXDateAndTime asDateAndTime! Item was added: + ----- Method: LXTimeStamp>>asLXDateAndTime (in category 'transitional') ----- + asLXDateAndTime + "Answer the receiver as an instance of DateAndTime." + + ^ LXDateAndTime utcMicroseconds: utcMicroseconds offset: self offsetSeconds + ! Item was added: + ----- Method: LXTimeStamp>>asLXTimeStamp (in category 'transitional') ----- + asLXTimeStamp + "Answer the receiver as an instance of TimeStamp." + + ^ self! Item was added: + ----- Method: LXTimeStamp>>asTimeStamp (in category 'squeak protocol') ----- + asTimeStamp + "Answer the receiver as an instance of TimeStamp." + + ^ self asDateAndTime asTimeStamp! Item was added: + ----- Method: LXTimeStamp>>date (in category 'squeak protocol') ----- + date + "Answer the date of the receiver." + + ^ self asDate! Item was added: + ----- Method: LXTimeStamp>>dateAndTime (in category 'squeak protocol') ----- + dateAndTime + "Answer a two element Array containing the receiver's date and time." + + ^ Array with: self date with: self time! Item was added: + ----- Method: LXTimeStamp>>minusDays: (in category 'squeak protocol') ----- + minusDays: anInteger + "Answer a TimeStamp which is anInteger days before the receiver." + + ^ self - (anInteger days)! Item was added: + ----- Method: LXTimeStamp>>minusSeconds: (in category 'squeak protocol') ----- + minusSeconds: anInteger + "Answer a TimeStamp which is anInteger number of seconds before the receiver." + + ^ self - (anInteger seconds)! Item was added: + ----- Method: LXTimeStamp>>plusDays: (in category 'squeak protocol') ----- + plusDays: anInteger + "Answer a TimeStamp which is anInteger days after the receiver." + + ^ self + (anInteger days)! Item was added: + ----- Method: LXTimeStamp>>plusSeconds: (in category 'squeak protocol') ----- + plusSeconds: anInteger + "Answer a TimeStamp which is anInteger number of seconds after the receiver." + + ^ self + (anInteger seconds)! Item was added: + ----- Method: LXTimeStamp>>printOn: (in category 'squeak protocol') ----- + printOn: aStream + "Print receiver's date and time on aStream." + + aStream + nextPutAll: self date printString; + space; + nextPutAll: self time printString.! Item was added: + ----- Method: LXTimeStamp>>storeOn: (in category 'squeak protocol') ----- + storeOn: aStream + + aStream + print: self printString; + nextPutAll: ' asTimeStamp'! Item was added: + ----- Method: LXTimeStamp>>time (in category 'squeak protocol') ----- + time + "Answer the time of the receiver." + + ^ self asTime! Item was added: + Object subclass: #NameOfSubclass + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Chronology-Core'! Item was changed: ----- Method: Time class>>condenseBunches: (in category 'general inquiries') ----- condenseBunches: aCollectionOfSeconds | secArray now out pause prev bunchEnd | "Identify the major intervals in a bunch of numbers. Each number is a seconds since 1901 that represents a date and time. We want the last event in a bunch. Return array of seconds for: Every event in the last half hour. Every bunch separated by 30 min in the last 24 hours. Every bunch separated by two hours before that." "Time condenseBunches: (#(20 400 401 20000 20200 20300 40000 45000 200000 201000 202000) collect: [ :tt | self totalSeconds - tt]) " + secArray := aCollectionOfSeconds asSortedCollection. - secArray := aCollectionOfSeconds sorted. pause := 1. now := self totalSeconds. out := OrderedCollection new. prev := 0. bunchEnd := nil. secArray reverseDo: [:secs | | ago | "descending" ago := now - secs. ago > (60*30) ifTrue: [pause := "60*30" 1800]. ago > (60*60*24) ifTrue: [pause := "60*120" 7200]. ago - prev >= pause ifTrue: [out add: bunchEnd. bunchEnd := secs]. prev := ago]. out add: bunchEnd. out removeFirst. ^ out ! Item was changed: ----- Method: Time class>>localMicrosecondClock (in category 'clock') ----- localMicrosecondClock "Answer the local microseconds since the Smalltalk epoch (January 1st 1901, the start of the 20th century). + The value is derived from the Posix epoch with a constant offset corresponding to elapsed microseconds + between the two epochs according to RFC 868, and with an offset duration corresponding to the current + offset of local time from UTC." + <primitive: 241> + ^0! - The value is derived from the current UTC wallclock time and the image's current notion of time zone." - ^self utcMicrosecondClock + (DateAndTime localOffset asSeconds * 1000000)! Item was removed: - ----- Method: Time class>>localMicrosecondClockPrimitive (in category 'clock') ----- - localMicrosecondClockPrimitive - "Answer the local microseconds since the Smalltalk epoch (January 1st 1901, the start of the 20th century). - The value is derived from the Posix epoch with a constant offset corresponding to elapsed microseconds - between the two epochs according to RFC 868, and with an offset duration corresponding to the current - offset of local time from UTC." - <primitive: 241> - ^0! Item was added: + ----- Method: Time class>>localMicrosecondClockWithOffset (in category 'clock') ----- + localMicrosecondClockWithOffset + "Answer an array with local microseconds since the Smalltalk epoch and the + current seconds offset from GMT in the local time zone." + + | result | + result := self primPosixMicrosecondClockWithOffset. + "DateAndTime unixEpoch asSeconds" + result at: 1 put: result first + ((2177452800 + result second) * 1000000). + ^result! Item was changed: ----- Method: Time class>>millisecondClockValue (in category 'general inquiries') ----- millisecondClockValue "Answer the value of the millisecond clock." + ^self localMicrosecondClock // 1000! - ^self utcMicrosecondClock // 1000! Item was removed: - ----- Method: Time class>>utcMicrosecondClockWithOffset (in category 'clock') ----- - utcMicrosecondClockWithOffset - "Answer an array with UTC microseconds since the Smalltalk epoch and the - current seconds offset from UTC in the local time zone." - | offset utc | - utc := self utcMicrosecondClock. - offset := (self localMicrosecondClockPrimitive - utc) // 1000000. - ^{utc. offset}! Item was changed: ----- Method: Time>>print24:showSeconds:on: (in category 'printing') ----- print24: hr24 showSeconds: showSeconds on: aStream "Format is 'hh:mm:ss' or 'h:mm:ss am' or, if showSeconds is false, 'hh:mm' or 'h:mm am'" + | h m s | + h := self hour. m := self minute. s := self second. + hr24 + ifTrue: + [ h < 10 ifTrue: [ aStream nextPutAll: '0' ]. + h printOn: aStream ] + ifFalse: + [ h > 12 + ifTrue: [h - 12 printOn: aStream] + ifFalse: + [h < 1 + ifTrue: [ 12 printOn: aStream ] + ifFalse: [ h printOn: aStream ]]]. + + aStream nextPutAll: (m < 10 ifTrue: [':0'] ifFalse: [':']). + m printOn: aStream. + + showSeconds ifTrue: + [ aStream nextPutAll: (s < 10 ifTrue: [':0'] ifFalse: [':']). + self nanoSecond = 0 + ifTrue: [s asInteger printOn: aStream] + ifFalse: [s asInteger * NanosInSecond + self nanoSecond asInteger + printOn: aStream asFixedPoint: NanosInSecond]]. + + hr24 ifFalse: + [ aStream nextPutAll: (h < 12 ifTrue: [' am'] ifFalse: [' pm']) ]. + ! - ^self print24: hr24 showSeconds: showSeconds showSubseconds: false on: aStream ! Item was removed: - ----- Method: Time>>print24:showSeconds:showSubseconds:on: (in category 'printing') ----- - print24: hr24 showSeconds: showSeconds showSubseconds: showSubseconds on: aStream - "Format is 'hh:mm:ss' or 'h:mm:ss am' or, if showSeconds is false, 'hh:mm' or 'h:mm am'. - If showSubseconds is true and our nanoSeconds are not zero, a decimal point and subseconds are added" - - | h m s | - h := self hour. m := self minute. s := self second. - hr24 - ifTrue: - [ h < 10 ifTrue: [ aStream nextPutAll: '0' ]. - h printOn: aStream ] - ifFalse: - [ h > 12 - ifTrue: [h - 12 printOn: aStream] - ifFalse: - [h < 1 - ifTrue: [ 12 printOn: aStream ] - ifFalse: [ h printOn: aStream ]]]. - - aStream nextPutAll: (m < 10 ifTrue: [':0'] ifFalse: [':']). - m printOn: aStream. - - showSeconds ifTrue: - [ aStream nextPutAll: (s < 10 ifTrue: [':0'] ifFalse: [':']). - (showSubseconds not or: [self nanoSecond = 0]) - ifTrue: [s asInteger printOn: aStream] - ifFalse: [s asInteger * NanosInSecond + self nanoSecond asInteger - printOn: aStream asFixedPoint: NanosInSecond]]. - - hr24 ifFalse: - [ aStream nextPutAll: (h < 12 ifTrue: [' am'] ifFalse: [' pm']) ]. - ! Item was changed: ----- Method: Time>>printOn: (in category 'printing') ----- printOn: aStream self print24: false showSeconds: (self seconds ~= 0 or: [self nanoSecond ~= 0]) - showSubseconds: self nanoSecond ~= 0 on: aStream! Item was added: + ----- Method: TimeStamp>>asLXTimeStamp (in category 'LX-Kernel-Chronology') ----- + asLXTimeStamp + + ^self asLXDateAndTime asLXTimeStamp! Item was changed: Magnitude subclass: #Timespan instanceVariableNames: 'start duration' classVariableNames: '' poolDictionaries: '' category: 'Chronology-Core'! + !Timespan commentStamp: 'bf 2/18/2016 14:43' prior: 0! + I represent a duration starting on a specific DateAndTime. + + If my start has an offset identical to my #defaultOffset then comparisons ignore timezone offset.! - !Timespan commentStamp: 'cmm 10/17/2018 22:00' prior: 0! - I represent a duration starting on a specific DateAndTime.! Item was changed: ----- Method: Timespan>>= (in category 'ansi protocol') ----- = comparand + ^ self class = comparand class + and: [((self noTimezone or: [ comparand noTimezone ]) + ifTrue: [ self start hasEqualTicks: comparand start ] + ifFalse: [ self start = comparand start ]) + and: [ self duration = comparand duration ] ] - ^ self class = comparand class - and: [(((self noTimezone and: [comparand noTimezone]) or: [self start offset = comparand start offset]) - ifTrue: [ self start hasEqualTicks: comparand start ] - ifFalse: [ self start = comparand start ]) - and: [ self duration = comparand duration ] ] .! Item was added: + ----- Method: Timespan>>asLXDateAndTime (in category 'LX-Kernel-Chronology') ----- + asLXDateAndTime + + ^ start asLXDateAndTime! Item was removed: - ----- Method: Timespan>>beCanonical (in category 'squeak protocol') ----- - beCanonical - "Make the receiver a canonical Date (or Month or Year) instead of a timespan of my duration starting at a specific local time. Canonical are the most common use of Dates in applications." - self stripTimezone! Item was removed: - ----- Method: Timespan>>stripTimezone (in category 'squeak protocol') ----- - stripTimezone - "Chronology preserves Timespans that are extracted from DateAndTime's, making Dates, Months and Years in Squeak able to represent a true Timespan of those durations starting at a specific local DateAndTime. In case a canonical version is needed, make the receiver independent of any Timezone by removing it." - start primOffset: self class defaultOffset! Item was added: + (PackageInfo named: 'Chronology-Core') postscript: '"Ensure that the object history mark process uses DateAndTime>>floor rather than an earlier implementation that relied on a named instance variable." + + Smalltalk at: #ObjectHistory ifPresent: [ :cls | cls current restartMarkProcess ]. + '!

1 0

The Inbox: Chronology-Core-dtl.17.mcz
by commits＠source.squeak.org 29 Dec '18

29 Dec '18

David T. Lewis uploaded a new version of Chronology-Core to project The Inbox: http://source.squeak.org/inbox/Chronology-Core-dtl.17.mcz ==================== Summary ==================== Name: Chronology-Core-dtl.17 Author: dtl Time: 15 December 2018, 6:44:08.809994 pm UUID: 9d9b49d4-46f4-496f-bfd1-70fdb1641e43 Ancestors: Chronology-Core-dtl.16 Bootstrap UTCDateAndTime, step 2 of 5 Start using LXDateAndTime instead of DateAndTime. Change instance creation in DateAndTime to create LXDateAndTime instances instead. In the postscript, have all DateAndTime instances become LXDateAndTime. =============== Diff against Chronology-Core-dtl.16 =============== Item was changed: ----- Method: DateAndTime class>>fromSeconds: (in category 'smalltalk-80') ----- fromSeconds: seconds "Answer a DateAndTime since the Squeak epoch: 1 January 1901" + ^ LXDateAndTime fromSeconds: seconds + " | integerSeconds nanos | - | integerSeconds nanos | integerSeconds := seconds truncated. integerSeconds = seconds ifTrue: [nanos := 0] ifFalse: [nanos := (seconds - integerSeconds * NanosInSecond) asInteger]. ^ self basicNew ticks: (Array with: SqueakEpoch with: integerSeconds with: nanos) + offset: self localOffset"! - offset: self localOffset! Item was changed: ----- Method: DateAndTime class>>julianDayNumber:offset: (in category 'squeak protocol') ----- + julianDayNumber: anInteger offset: aDuration + ^ LXDateAndTime julianDayNumber: anInteger offset: aDuration + " ^ self basicNew + ticks: anInteger days ticks + offset: aDuration ; + yourself"! - julianDayNumber: anInteger offset: aDuration - - ^self basicNew - setJdn: anInteger - seconds: 0 - nano: 0 - offset: aDuration! Item was changed: ----- Method: DateAndTime class>>now (in category 'ansi protocol') ----- now + + ^LXDateAndTime now. + " [ | timeArray | + timeArray := self primPosixMicrosecondClockWithOffset. + ^ self utcMicroseconds: timeArray first offset: timeArray second] + on: Error + do: [ ""Use old style primitive support"" + ^self nowWithOffset: self localOffset]"! - | clockAndOffset | - clockAndOffset := self clock localMicrosecondClockWithOffset. - (self automaticTimezone and: - [self localOffset asSeconds ~= clockAndOffset second]) - ifTrue: [self localOffset: (Duration seconds: clockAndOffset second)]. - ^self now: clockAndOffset first offset: self localOffset! Item was changed: ----- Method: DateAndTime class>>year:month:day:hour:minute:second:nanoSecond:offset: (in category 'squeak protocol') ----- year: year month: month day: day hour: hour minute: minute second: second nanoSecond: nanoCount offset: offset "Return a DateAndTime" + ^ LXDateAndTime year: year month: month day: day hour: hour minute: minute second: second nanoSecond: nanoCount offset: offset + " | monthIndex daysInMonth p q r s julianDayNumber | - | monthIndex daysInMonth p q r s julianDayNumber | monthIndex := month isInteger ifTrue: [month] ifFalse: [Month indexOfMonth: month]. daysInMonth := Month daysInMonth: monthIndex forYear: year. day < 1 ifTrue: [self error: 'day may not be zero or negative']. day > daysInMonth ifTrue: [self error: 'day is after month ends']. p := (monthIndex - 14) quo: 12. q := year + 4800 + p. r := monthIndex - 2 - (12 * p). s := (year + 4900 + p) quo: 100. julianDayNumber := ( (1461 * q) quo: 4 ) + ( (367 * r) quo: 12 ) - ( (3 * s) quo: 4 ) + ( day - 32075 ). ^self basicNew setJdn: julianDayNumber seconds: hour * 60 + minute * 60 + second nano: nanoCount offset: offset; + yourself"! - yourself! Item was added: + ----- Method: LXDateAndTime>>floor (in category 'squeak protocol') ----- + floor + "Answer a copy with magnitude rounded down to the nearest whole second" + ^self class + utcMicroseconds: utcMicroseconds - (utcMicroseconds \\ 1000000) + offset: localOffsetSeconds! Item was changed: ----- Method: TimeStamp class>>current (in category 'squeak protocol') ----- current + ^self now! - | ts ticks | - ts := super now asTimeStamp. - ticks := ts ticks. - ticks at: 3 put: 0. - ts ticks: ticks offset: ts offset. - ^ ts - ! Item was removed: - ----- Method: TimeStamp class>>now (in category 'ansi protocol') ----- - now - "Answer the current date and time as a TimeStamp." - - ^self current! Item was changed: ----- Method: Timespan class>>defaultOffset (in category 'configuring') ----- defaultOffset + "Timespans created in the context of an offset will start in that offset. When no context is available, the defaultOffset for Timespans must be zero. For example, two ways to make a Date for today: + Date today. 'start is midnight at offset zero. Will compare successfully to other Date today results.' + DateAndTime now asDate. 'In this case, the start is midnight of the local time-zone. It can only compare equally to Dates of its time-zone.'" + ^ Duration zero! - "Timespans created in the context of an offset will start in that offset. When no context is available, the defaultOffset for Timespans must be nil. For example, two ways to make a Date for today: - Date today. 'start is midnight without offset. Will compare successfully to other Date today results.' - DateAndTime now asDate. 'In this case, the start is midnight of the local time-zone. It can only compare equally to Dates of its time-zone or Dates without timezone.'" - ^ nil! Item was changed: + (PackageInfo named: 'Chronology-Core') postscript: '"Convert all instances of DateAndTime and TimeStamp to the equivalent LXDateAndTime and LXTimeStamp." - (PackageInfo named: 'Chronology-Core') postscript: '"Ensure that the object history mark process uses DateAndTime>>floor rather than an earlier implementation that relied on a named instance variable." + | oldInstances newInstances | + Smalltalk garbageCollect. + oldInstances := DateAndTime allInstances, TimeStamp allInstances. + newInstances := oldInstances collect: [ :each | + each class == DateAndTime + ifTrue: [ each asLXDateAndTime ] + ifFalse: [ each asLXTimeStamp ] ]. + oldInstances elementsForwardIdentityTo: newInstances. + Smalltalk garbageCollect. + + "Ensure that the object history mark process uses DateAndTime>>floor rather than an earlier implementation that relied on a named instance variable." + Smalltalk at: #ObjectHistory ifPresent: [ :cls | cls current restartMarkProcess ]. '!

1 0

The Trunk: Chronology-Core-dtl.16.mcz
by commits＠source.squeak.org 29 Dec '18

29 Dec '18

David T. Lewis uploaded a new version of Chronology-Core to project The Trunk: http://source.squeak.org/trunk/Chronology-Core-dtl.16.mcz ==================== Summary ==================== Name: Chronology-Core-dtl.16 Author: dtl Time: 15 December 2018, 6:40:11.92086 pm UUID: a0841e45-839c-4658-abe1-09dd1cbbe96c Ancestors: Chronology-Core-cmm.15 Bootstrap UTCDateAndTime, step 1 of 5 Add LXDateAndTime and LXTimeStamp as alternative implementations of DateAndTime an TimeStamp. DateAndTime uses instance variables 'seconds offset jdn nanos' and calculates its magnitude based on those varables in conjunction with the local TimeZone, The LXDateAndTime variation uses instance variables 'utcMicroseconds localOffsetSeconds'. It represents time magnitude as elapsed microseconds since the Posix epoch, with localOffsetSeconds representing local offset from UTC. The magnitude is used for comparison and duration calculations, and the local offset is used for displaying this magnitude in the context of a local time zone. The implementation ignores leap seconds, which are adjustments made to maintain earth rotational clock time in synchronization with elapsed seconds. LXDateAndTime class>>now uses #primitiveUtcWithOffset to obtain current time in UTC microseconds with current local offset in seconds. The primitive provides an atomic query for UTC time and local offset as measured by the OS platform. If primitiveUtcWithOffset is not available, the traditional implementation is used, which relies on a primitive for microseconds in the local time zone and derives UTC based on the TimeZone setting. Tests are provided to verify equivalence of the LXDateAndTime and DateAndTime hierarchies. LXDateAndTimeConversionTest tests conversion to and from LXDateAndTime. LXDateAndTimeTest, LXDateAndTimeEpochTest, and LXDateAndTimeLeapTest are variations on their corresponding DateAndTime tests. These tests are placed in the Kernel package because they are temporary tests that will be removed when LXDateAndTime replaces DateAndTime in a later update. =============== Diff against Chronology-Core-cmm.15 =============== Item was changed: Timespan subclass: #Date instanceVariableNames: '' classVariableNames: '' poolDictionaries: 'ChronologyConstants' category: 'Chronology-Core'! + !Date commentStamp: 'cmm 2/3/2012 17:30' prior: 0! + Instances of Date are Timespans with duration of 1 day. - !Date commentStamp: 'cmm 6/28/2016 21:36' prior: 0! - Instances of Date are Timespans with duration of 1 day. As with all Chronology Timespan sub-instances, Dates can be instantiated as position values which compare equally to any other instance of the same Date, irregardless of the timezone in which either is created. + Their default creation assumes a start of midnight of UTC to provide the fast, globalized Dates out of the box. The legacy behavior that creates Timezone-sensitive Dates can be used by sending #localizedDates. + ! - However, like the other Timespan subInstances, there are rare cases where it may be desirable to use instances of Date to represent a particular 1-day span of time at a particular locality on the globe. All Timespans, including Dates, may specify a particular timezone offset for this purpose.! Item was removed: - ----- Method: Date>>@ (in category 'squeak protocol') ----- - @ aTime - ^ DateAndTime - date: self - time: aTime! Item was changed: ----- Method: DateAndTime class>>automaticTimezone: (in category 'preferences') ----- automaticTimezone: aBoolean + "Accessor for the system-wide preference" - "Accessor for the system-wide preference. - Note this gets disabled in localTimeZone: to make that override stick" + AutomaticTimezone := aBoolean! - AutomaticTimezone := aBoolean. - aBoolean ifTrue: [self now]. "fetch timezone immediately"! Item was removed: - ----- Method: DateAndTime class>>fromUnixTime: (in category 'squeak protocol') ----- - fromUnixTime: aNumber - - - ^ self fromSeconds: aNumber + self unixEpoch asSeconds! Item was changed: ----- Method: DateAndTime class>>localOffset: (in category 'squeak protocol') ----- localOffset: aDuration + "Set the duration we are offset from UTC (done automatically in #now)" + self localTimeZone: (TimeZone offset: aDuration name: 'Local Time' abbreviation: 'LT'). - "Override the local time zone (for testing). This disables the #automaticTimezone: preference" - self localTimeZone: (TimeZone offset: aDuration name: 'Local Time (override)' abbreviation: 'LTO'). ! Item was changed: ----- Method: DateAndTime class>>localTimeZone: (in category 'accessing') ----- localTimeZone: aTimeZone "Set the local time zone" + " DateAndTime localTimeZone: (TimeZone offset: 0 hours name: 'Universal Time' abbreviation: 'UTC'). DateAndTime localTimeZone: (TimeZone offset: -8 hours name: 'Pacific Standard Time' abbreviation: 'PST'). " + + LocalTimeZone := aTimeZone + + + ! - LocalTimeZone := aTimeZone. - self automaticTimezone: (aTimeZone abbreviation = 'LT')! Item was changed: ----- Method: DateAndTime class>>now (in category 'ansi protocol') ----- now + | clockAndOffset | + clockAndOffset := self clock localMicrosecondClockWithOffset. + (self automaticTimezone and: + [self localOffset asSeconds ~= clockAndOffset second]) + ifTrue: [self localOffset: (Duration seconds: clockAndOffset second)]. + ^self now: clockAndOffset first offset: self localOffset! - | clockAndOffset localSeconds | - clockAndOffset := self clock utcMicrosecondClockWithOffset. - localSeconds := self localOffset asSeconds. - (self automaticTimezone and: [localSeconds ~= clockAndOffset second]) - ifTrue: [self setLocalOffsetAutomatically: (Duration seconds: (localSeconds := clockAndOffset second))]. - ^self now: clockAndOffset first + (localSeconds * 1000000) offset: self localOffset! Item was removed: - ----- Method: DateAndTime class>>nowAtOffset: (in category 'squeak protocol') ----- - nowAtOffset: offsetDuration - "Answers the local time at places with the specified offsetDuration timezone." - "local time Chicago (CST)" - "DateAndTime nowAtOffset: -6 hours" - ^ self now + (offsetDuration - self localOffset) offset: offsetDuration! Item was removed: - ----- Method: DateAndTime class>>setLocalOffsetAutomatically: (in category 'squeak protocol') ----- - setLocalOffsetAutomatically: aDuration - "Set the duration we are offset from UTC (done automatically in #now)" - LocalTimeZone := (TimeZone offset: aDuration name: 'Local Time' abbreviation: 'LT'). - ! Item was changed: ----- Method: DateAndTime class>>startUp: (in category 'system startup') ----- startUp: startingAfresh "Set local timezone" + startingAfresh ifTrue: [self now]. - startingAfresh & self automaticTimezone ifTrue: [self now]. ! Item was changed: ----- Method: DateAndTime>>< (in category 'ansi protocol') ----- < comparand "comparand conforms to protocol DateAndTime, or can be converted into something that conforms." | lvalue rvalue comparandAsDateAndTime | + comparandAsDateAndTime _ comparand asDateAndTime. - comparandAsDateAndTime := comparand asDateAndTime. self offset = comparandAsDateAndTime offset ifTrue: [ lvalue := self. rvalue := comparandAsDateAndTime ] ifFalse: [ lvalue := self asUTC. rvalue := comparandAsDateAndTime asUTC ]. ^ lvalue julianDayNumber < rvalue julianDayNumber or: [ lvalue julianDayNumber > rvalue julianDayNumber ifTrue: [ false ] ifFalse: [ lvalue secondsSinceMidnight < rvalue secondsSinceMidnight or: [ lvalue secondsSinceMidnight > rvalue secondsSinceMidnight ifTrue: [ false ] ifFalse: [ lvalue nanoSecond < rvalue nanoSecond ] ] ] ]! Item was added: + ----- Method: DateAndTime>>asLXDateAndTime (in category 'LX-Kernel-Chronology') ----- + asLXDateAndTime + + ^LXDateAndTime + year: self year + month: self month + day: self dayOfMonth + hour: self hour + minute: self minute + second: self second + nanoSecond: self nanoSecond + offset: self offset! Item was changed: ----- Method: DateAndTime>>setJdn:seconds:nano:offset: (in category 'squeak protocol') ----- setJdn: j seconds: s nano: n offset: o + jdn := j. + seconds := s. + nanos := n. + offset := o - jdn := j. - seconds := s. - nanos := n. - offset := o ! Item was removed: - ----- Method: Duration>>wait (in category 'squeak protocol') ----- - wait - "Convert this duration in a delay and wait once. Return the created delay so that the client can wait on it again if needed. - - Do-it: 3 minutes wait" - - | delay | - delay := self asDelay. - delay wait. - ^ delay! Item was added: + Magnitude subclass: #LXDateAndTime + instanceVariableNames: 'utcMicroseconds localOffsetSeconds' + classVariableNames: 'ClockProvider DaysSinceEpoch LastMilliSeconds LastTick LastTickSemaphore LocalTimeZone MilliSecondOffset OffsetsAreValid' + poolDictionaries: 'ChronologyConstants' + category: 'Chronology-Core'! + + !LXDateAndTime commentStamp: 'dtl 3/31/2014 19:49' prior: 0! + I represent a point in UTC time as defined by ISO 8601. I have zero duration. + + My magnitude represents the elapsed time since (or before) the Posix epoch. + + I have a local offset for presenting my date and time in the context of a local time zone. This offset is independent of my magnitude. + + My implementation ignores leap seconds, which are adjustments made to maintain earth rotational clock time in synchronization with elapsed seconds.! Item was added: + ----- Method: LXDateAndTime class>>clock (in category 'clock provider') ----- + clock + "the provider of real time seconds/milliseconds." + + ^ ClockProvider ! Item was added: + ----- Method: LXDateAndTime class>>clockPrecision (in category 'ansi protocol') ----- + clockPrecision + "One nanosecond precision" + + ^ Duration seconds: 0 nanoSeconds: 1 + ! Item was added: + ----- Method: LXDateAndTime class>>current (in category 'squeak protocol') ----- + current + + + ^ self now! Item was added: + ----- Method: LXDateAndTime class>>date:time: (in category 'squeak protocol') ----- + date: aDate time: aTime + + ^ self + year: aDate year + day: aDate dayOfYear + hour: aTime hour + minute: aTime minute + second: aTime second + offset: aDate start offset! Item was added: + ----- Method: LXDateAndTime class>>daysFromSmalltalkEpochToPosixEpoch (in category 'DTL') ----- + daysFromSmalltalkEpochToPosixEpoch + + ^52 * 365 + (17 * 366)! Item was added: + ----- Method: LXDateAndTime class>>epoch (in category 'squeak protocol') ----- + epoch + "Answer a DateAndTime representing the Squeak epoch: 1 January 1901" + + | uSec | + self flag: #FIXME. "see comment in fromSeconds: " + uSec := self epochOffsetMicros negated. + ^ self utcMicroseconds: uSec offset: self localOffsetSeconds + + + " + ^ self julianDayNumber: SqueakEpoch + "! Item was added: + ----- Method: LXDateAndTime class>>epochOffset (in category 'DTL') ----- + epochOffset + "Elaspsed seconds from the Smalltalk epoch to the Posix epoch" + ^self daysFromSmalltalkEpochToPosixEpoch * SecondsInDay! Item was added: + ----- Method: LXDateAndTime class>>epochOffsetMicros (in category 'DTL') ----- + epochOffsetMicros + "Elaspsed microseconds from the Smalltalk epoch to the Posix epoch" + ^self epochOffset * 1000000! Item was added: + ----- Method: LXDateAndTime class>>fromSeconds: (in category 'smalltalk-80') ----- + fromSeconds: seconds + "Answer a DateAndTime since the Squeak epoch: 1 January 1901" + + "dtl - Implemented for compatibiity with Squeak, but this is probably wrong" + + | s uSec offset | + self flag: #FIXME. "local versus UTC? what should we set the offset to?" + offset := self localOffsetSeconds. + s := seconds - self epochOffset - offset.. + uSec := s * 1000000. + ^ self utcMicroseconds: uSec offset: offset + ! Item was added: + ----- Method: LXDateAndTime class>>fromString: (in category 'squeak protocol') ----- + fromString: aString + + + ^ self readFrom: (ReadStream on: aString)! Item was added: + ----- Method: LXDateAndTime class>>initialize (in category 'initialize-release') ----- + initialize + + super initialize. + + ClockProvider := Time. + LastTickSemaphore := Semaphore forMutualExclusion. + LastMilliSeconds := 0. + LastTick := 0. + Smalltalk addToStartUpList: self. + self startUp: true + ! Item was added: + ----- Method: LXDateAndTime class>>initializeOffsets (in category 'initialize-release') ----- + initializeOffsets + | durationSinceEpoch secondsSinceMidnight nowSecs | + LastTick := 0. + nowSecs := self clock secondsWhenClockTicks. + LastMilliSeconds := self millisecondClockValue. + durationSinceEpoch := Duration + days: SqueakEpoch + hours: 0 + minutes: 0 + seconds: nowSecs. + DaysSinceEpoch := durationSinceEpoch days. + secondsSinceMidnight := (durationSinceEpoch - + (Duration + days: DaysSinceEpoch + hours: 0 + minutes: 0 + seconds: 0)) asSeconds. + MilliSecondOffset := secondsSinceMidnight * 1000 - LastMilliSeconds! Item was added: + ----- Method: LXDateAndTime class>>julianDayNumber: (in category 'squeak protocol') ----- + julianDayNumber: anInteger + ^ self + julianDayNumber: anInteger + offset: self localOffset! Item was added: + ----- Method: LXDateAndTime class>>julianDayNumber:offset: (in category 'squeak protocol') ----- + julianDayNumber: anInteger offset: aDuration + ^ self basicNew + ticks: anInteger days ticks + offset: aDuration ; + yourself! Item was added: + ----- Method: LXDateAndTime class>>localOffset (in category 'squeak protocol') ----- + localOffset + "Answer the duration we are offset from UTC" + + ^ self localTimeZone offset + ! Item was added: + ----- Method: LXDateAndTime class>>localOffsetSeconds (in category 'DTL') ----- + localOffsetSeconds + ^self localOffset asSeconds! Item was added: + ----- Method: LXDateAndTime class>>localTimeZone (in category 'accessing') ----- + localTimeZone + "Answer the local time zone" + + ^ LocalTimeZone ifNil: [ LocalTimeZone := TimeZone default ] + + ! Item was added: + ----- Method: LXDateAndTime class>>localTimeZone: (in category 'accessing') ----- + localTimeZone: aTimeZone + "Set the local time zone" + + " + DateAndTime localTimeZone: (TimeZone offset: 0 hours name: 'Universal Time' abbreviation: 'UTC'). + DateAndTime localTimeZone: (TimeZone offset: -8 hours name: 'Pacific Standard Time' abbreviation: 'PST'). + " + + LocalTimeZone := aTimeZone + + + ! Item was added: + ----- Method: LXDateAndTime class>>midnight (in category 'squeak protocol') ----- + midnight + + ^ self now midnight! Item was added: + ----- Method: LXDateAndTime class>>milliSecondsSinceMidnight (in category 'squeak protocol') ----- + milliSecondsSinceMidnight + | msm msClock | + + "This is usually only during system startup..." + self waitForOffsets. + + msClock := self millisecondClockValue. + msClock < LastMilliSeconds ifTrue: [ "rolled over" + MilliSecondOffset := MilliSecondOffset + (SmallInteger maxVal // 2) + 1 ]. + LastMilliSeconds := msClock. + [ + msm := msClock + MilliSecondOffset. + msm >= 86400000 ] whileTrue: [ + "next day" + LastTick := -1. + DaysSinceEpoch := DaysSinceEpoch + 1. + MilliSecondOffset := MilliSecondOffset - 86400000 ]. + "day rolled over sanity check" + (LastTick = -1 and: [ + (Duration + days: SqueakEpoch + hours: 0 + minutes: 0 + seconds: self clock totalSeconds) days ~= DaysSinceEpoch ]) ifTrue: [ + self initializeOffsets. + ^ self milliSecondsSinceMidnight ]. + ^ msm.! Item was added: + ----- Method: LXDateAndTime class>>millisecondClockValue (in category 'smalltalk-80') ----- + millisecondClockValue + + ^ self clock millisecondClockValue! Item was added: + ----- Method: LXDateAndTime class>>new (in category 'squeak protocol') ----- + new + "Answer a DateAndTime representing the Squeak epoch: 1 January 1901" + + ^ self epoch! Item was added: + ----- Method: LXDateAndTime class>>noon (in category 'squeak protocol') ----- + noon + + ^ self now noon + ! Item was added: + ----- Method: LXDateAndTime class>>now (in category 'ansi protocol') ----- + now + + [ | timeArray | + timeArray := self primPosixMicrosecondClockWithOffset. + ^ self utcMicroseconds: timeArray first offset: timeArray second] + on: Error + do: [ "Use old style primitive support" + ^self nowWithOffset: self localOffset]! Item was added: + ----- Method: LXDateAndTime class>>nowWithOffset: (in category 'squeak protocol') ----- + nowWithOffset: aDuration + | nanoTicks msm | + nanoTicks := (msm := self milliSecondsSinceMidnight) * 1000000. + "The following usually only executes at system startup." + ^ LastTick < nanoTicks + ifTrue: + [ LastTick := nanoTicks. + self waitForOffsets. + self basicNew + setJdn: DaysSinceEpoch + seconds: msm // 1000 + nano: msm \\ 1000 * 1000000 + offset: aDuration ] + ifFalse: + [ LastTickSemaphore critical: + [ LastTick := LastTick + 1. + self waitForOffsets. + self basicNew + setJdn: DaysSinceEpoch + seconds: LastTick // 1000000000 + nano: LastTick \\ 1000000000 + offset: aDuration ] ] + " + [ 10000 timesRepeat: [ self now. ] ] timeToRun / 10000.0 . + + If calls to DateAndTime-c-#now are within a single millisecond the semaphore code + to ensure that (self now <= self now) slows things down considerably by a factor of about 20. + + The actual speed of a single call to DateAndTime-now in milliseconds is + demonstrated by the unguarded method below. + + [ 100000 timesRepeat: [ self todayAtMilliSeconds: (self milliSecondsSinceMidnight) ] ] timeToRun / 100000.0 . 0.00494 0.00481 0.00492 0.00495 + + "! Item was added: + ----- Method: LXDateAndTime class>>posixEpoch (in category 'DTL') ----- + posixEpoch + "Answer a DateAndTime representing the Posix epoch" + + ^ self julianDayNumber: self posixEpochJulianDays ! Item was added: + ----- Method: LXDateAndTime class>>primPosixMicrosecondClockWithOffset (in category 'DTL') ----- + primPosixMicrosecondClockWithOffset + "Answer an array with UTC microseconds since the Posix epoch and the + current seconds offset from GMT in the local time zone." + + <primitive: 'primitiveUtcWithOffset'> + + ^self primitiveFailed! Item was added: + ----- Method: LXDateAndTime class>>readFrom: (in category 'squeak protocol') ----- + readFrom: aStream + + | offset date time ch | + + date := Date readFrom: aStream. + [aStream peek isDigit] + whileFalse: [aStream next]. + time := Time readFrom: aStream. + (aStream atEnd or: [('+-Z' includes: aStream peek) not]) + ifTrue: [offset := self localOffset] + ifFalse: [(aStream peekFor: $Z) + ifTrue: [offset := Duration zero] + ifFalse: [ + ch := aStream next. + ch = $+ ifTrue: [ch := Character space]. + offset := Duration fromString: ch asString, '0:', aStream upToEnd, ':0']]. + ^ self + year: date year + month: date monthIndex + day: date dayOfMonth + hour: time hour + minute: time minute + second: time second + nanoSecond: time nanoSecond + offset: offset + + + " '-1199-01-05T20:33:14.321-05:00' asDateAndTime + ' 2002-05-16T17:20:45.1+01:01' asDateAndTime + + ' 2002-05-16T17:20:45.02+01:01' asDateAndTime + + ' 2002-05-16T17:20:45.003+01:01' asDateAndTime + + ' 2002-05-16T17:20:45.0004+01:01' asDateAndTime + ' 2002-05-16T17:20:45.00005' asDateAndTime + ' 2002-05-16T17:20:45.000006+01:01' asDateAndTime + + ' 2002-05-16T17:20:45.0000007+01:01' asDateAndTime + ' 2002-05-16T17:20:45.00000008-01:01' asDateAndTime + ' 2002-05-16T17:20:45.000000009+01:01' asDateAndTime + ' 2002-05-16T17:20:45.0000000001+01:01' asDateAndTime + + ' 2002-05-16T17:20' asDateAndTime + ' 2002-05-16T17:20:45' asDateAndTime + ' 2002-05-16T17:20:45+01:57' asDateAndTime + ' 2002-05-16T17:20:45-02:34' asDateAndTime + ' 2002-05-16T17:20:45+00:00' asDateAndTime + ' 1997-04-26T01:02:03+01:02:3' asDateAndTime + "! Item was added: + ----- Method: LXDateAndTime class>>startUp: (in category 'initialize-release') ----- + startUp: resuming + resuming ifFalse: [ ^ self ]. + "Time initializeMillisecondClockMask." + OffsetsAreValid := false. + [ + self initializeOffsets. + OffsetsAreValid := true + ] forkAt: Processor userInterruptPriority.! Item was added: + ----- Method: LXDateAndTime class>>today (in category 'squeak protocol') ----- + today + + ^ self midnight! Item was added: + ----- Method: LXDateAndTime class>>tomorrow (in category 'squeak protocol') ----- + tomorrow + + ^ self today asDate next asLXDateAndTime + ! Item was added: + ----- Method: LXDateAndTime class>>totalSeconds (in category 'smalltalk-80') ----- + totalSeconds + + ^ self clock totalSeconds! Item was added: + ----- Method: LXDateAndTime class>>unixEpoch (in category 'squeak protocol') ----- + unixEpoch + "Answer a DateAndTime representing the Unix epoch (1 January 1970, midnight UTC)" + + ^ self basicNew + ticks: #(2440588 0 0) offset: Duration zero; + yourself. + ! Item was added: + ----- Method: LXDateAndTime class>>utcMicroseconds:offset: (in category 'DTL') ----- + utcMicroseconds: microsecondsSincePosixEpoch offset: offsetSeconds + + ^super new + utcMicroseconds: microsecondsSincePosixEpoch + offset: offsetSeconds! Item was added: + ----- Method: LXDateAndTime class>>waitForOffsets (in category 'initialize-release') ----- + waitForOffsets + OffsetsAreValid ifFalse: [ + [ + (Delay forSeconds: 1) wait. + OffsetsAreValid + ] whileFalse + ]! Item was added: + ----- Method: LXDateAndTime class>>year:day: (in category 'squeak protocol') ----- + year: year day: dayOfYear + "Return a DateAndTime" + + ^ self + year: year + day: dayOfYear + hour: 0 + minute: 0 + second: 0 + ! Item was added: + ----- Method: LXDateAndTime class>>year:day:hour:minute:second: (in category 'ansi protocol') ----- + year: year day: dayOfYear hour: hour minute: minute second: second + + ^ self + year: year + day: dayOfYear + hour: hour + minute: minute + second: second + offset: self localOffset + ! Item was added: + ----- Method: LXDateAndTime class>>year:day:hour:minute:second:offset: (in category 'ansi protocol') ----- + year: year day: dayOfYear hour: hour minute: minute second: second offset: offset + "Return a DataAndTime" + + | y d | + y := self + year: year + month: 1 + day: 1 + hour: hour + minute: minute + second: second + nanoSecond: 0 + offset: offset. + + d := Duration days: (dayOfYear - 1). + + ^ y + d + ! Item was added: + ----- Method: LXDateAndTime class>>year:month:day: (in category 'squeak protocol') ----- + year: year month: month day: day + "Return a DateAndTime, midnight local time" + + ^self + year: year + month: month + day: day + hour: 0 + minute: 0 + ! Item was added: + ----- Method: LXDateAndTime class>>year:month:day:hour:minute: (in category 'squeak protocol') ----- + year: year month: month day: day hour: hour minute: minute + "Return a DateAndTime" + + ^self + year: year + month: month + day: day + hour: hour + minute: minute + second: 0 + ! Item was added: + ----- Method: LXDateAndTime class>>year:month:day:hour:minute:second: (in category 'ansi protocol') ----- + year: year month: month day: day hour: hour minute: minute second: second + "Return a DateAndTime" + + ^ self + year: year + month: month + day: day + hour: hour + minute: minute + second: second + offset: self localOffset! Item was added: + ----- Method: LXDateAndTime class>>year:month:day:hour:minute:second:nanoSecond:offset: (in category 'squeak protocol') ----- + year: year month: month day: day hour: hour minute: minute second: second nanoSecond: nanoCount offset: offset + "Return a DateAndTime" + + | monthIndex daysInMonth p q r s julianDayNumber | + + monthIndex := month isInteger ifTrue: [month] ifFalse: [Month indexOfMonth: month]. + daysInMonth := Month + daysInMonth: monthIndex + forYear: year. + day < 1 ifTrue: [self error: 'day may not be zero or negative']. + day > daysInMonth ifTrue: [self error: 'day is after month ends']. + + p := (monthIndex - 14) quo: 12. + q := year + 4800 + p. + r := monthIndex - 2 - (12 * p). + s := (year + 4900 + p) quo: 100. + + julianDayNumber := + ( (1461 * q) quo: 4 ) + + ( (367 * r) quo: 12 ) - + ( (3 * s) quo: 4 ) + + ( day - 32075 ). + + ^self basicNew + setJdn: julianDayNumber + seconds: hour * 60 + minute * 60 + second - offset asSeconds + nano: nanoCount + offset: offset; + yourself! Item was added: + ----- Method: LXDateAndTime class>>year:month:day:hour:minute:second:offset: (in category 'ansi protocol') ----- + year: year month: month day: day hour: hour minute: minute second: second offset: offset + + ^ self + year: year + month: month + day: day + hour: hour + minute: minute + second: second + nanoSecond: 0 + offset: offset! Item was added: + ----- Method: LXDateAndTime class>>yesterday (in category 'squeak protocol') ----- + yesterday + + ^ self today asDate previous asLXDateAndTime! Item was added: + ----- Method: LXDateAndTime>>+ (in category 'ansi protocol') ----- + + operand + "operand conforms to protocol Duration" + + ^ self class + utcMicroseconds: operand asDuration asNanoSeconds / 1000 + utcMicroseconds + offset: localOffsetSeconds + ! Item was added: + ----- Method: LXDateAndTime>>- (in category 'ansi protocol') ----- + - operand + "operand conforms to protocol DateAndTime or protocol Duration" + + ^ (operand respondsTo: #asLXDateAndTime) + ifTrue: + [ | lticks rticks | + lticks := self asLocal ticks. + + rticks := operand asLXDateAndTime asLocal ticks. + Duration + seconds: (SecondsInDay *(lticks first - rticks first)) + + (lticks second - rticks second) + nanoSeconds: (lticks third - rticks third) ] + + ifFalse: + + [ self + (operand negated) ] + ! Item was added: + ----- Method: LXDateAndTime>>< (in category 'ansi protocol') ----- + < comparand + "comparand conforms to protocol DateAndTime, + or can be converted into something that conforms." + + ^utcMicroseconds < comparand asLXDateAndTime utcMicroseconds + ! Item was added: + ----- Method: LXDateAndTime>>= (in category 'ansi protocol') ----- + = aDateAndTimeOrTimeStamp + "Equal if the absolute time values match, regardless of local time transform" + self == aDateAndTimeOrTimeStamp ifTrue: [ ^ true ]. + ((aDateAndTimeOrTimeStamp isKindOf: self class) + or: [aDateAndTimeOrTimeStamp isKindOf: LXDateAndTime orOf: TimeStamp]) + ifFalse: [ ^ false ]. + ^utcMicroseconds = aDateAndTimeOrTimeStamp utcMicroseconds! Item was added: + ----- Method: LXDateAndTime>>asDate (in category 'squeak protocol') ----- + asDate + + + ^ Date starting: self asDateAndTime! Item was added: + ----- Method: LXDateAndTime>>asDateAndTime (in category 'squeak protocol') ----- + asDateAndTime + + ^DateAndTime + year: self year + month: self month + day: self dayOfMonth + hour: self hour + minute: self minute + second: self second + nanoSecond: self nanoSecond + offset: self offset! Item was added: + ----- Method: LXDateAndTime>>asDuration (in category 'squeak protocol') ----- + asDuration + "Answer the duration since midnight." + + ^ Duration seconds: self getSeconds nanoSeconds: self nanoSecond + ! Item was added: + ----- Method: LXDateAndTime>>asLXDateAndTime (in category 'squeak protocol') ----- + asLXDateAndTime + + ^ self! Item was added: + ----- Method: LXDateAndTime>>asLXTimeStamp (in category 'transitional - temporary') ----- + asLXTimeStamp + + ^ self as: LXTimeStamp! Item was added: + ----- Method: LXDateAndTime>>asLocal (in category 'ansi protocol') ----- + asLocal + + + ^ (self offset = self class localOffset) + + ifTrue: [self] + ifFalse: [self utcOffset: self class localOffset]! Item was added: + ----- Method: LXDateAndTime>>asMonth (in category 'squeak protocol') ----- + asMonth + + ^ Month starting: self! Item was added: + ----- Method: LXDateAndTime>>asNanoSeconds (in category 'squeak protocol') ----- + asNanoSeconds + "Answer the number of nanoseconds since midnight" + + ^ self asDuration asNanoSeconds! Item was added: + ----- Method: LXDateAndTime>>asPosixSeconds (in category 'transitional - temporary') ----- + asPosixSeconds + + ^ (self - (self class posixEpoch offset: self offset)) asSeconds! Item was added: + ----- Method: LXDateAndTime>>asSeconds (in category 'smalltalk-80') ----- + asSeconds + "Return the number of seconds since the Squeak epoch" + + self flag: #FIXME. "is this whole seconds or partial? UTC or local?" + + ^ utcMicroseconds / 1000000 + self class epochOffset + ! Item was added: + ----- Method: LXDateAndTime>>asTime (in category 'squeak protocol') ----- + asTime + + + ^ Time seconds: self getSeconds nanoSeconds: self nanoSecond + ! Item was added: + ----- Method: LXDateAndTime>>asTimeStamp (in category 'squeak protocol') ----- + asTimeStamp + + ^ self + asDateAndTime "FIXME LX hack for test support" + as: TimeStamp! Item was added: + ----- Method: LXDateAndTime>>asUTC (in category 'ansi protocol') ----- + asUTC + + ^ self offset isZero + ifTrue: [self] + ifFalse: [self utcOffset: 0] + ! Item was added: + ----- Method: LXDateAndTime>>asUnixTime (in category 'squeak protocol') ----- + asUnixTime + "answer number of seconds since unix epoch (midnight Jan 1, 1970, UTC)" + + ^(self - self class unixEpoch) asSeconds! Item was added: + ----- Method: LXDateAndTime>>asWeek (in category 'squeak protocol') ----- + asWeek + + ^ Week starting: self! Item was added: + ----- Method: LXDateAndTime>>asYear (in category 'squeak protocol') ----- + asYear + + ^ Year starting: self! Item was added: + ----- Method: LXDateAndTime>>day (in category 'smalltalk-80') ----- + day + + ^ self dayOfYear + ! Item was added: + ----- Method: LXDateAndTime>>dayMonthYearDo: (in category 'squeak protocol') ----- + dayMonthYearDo: aBlock + "Evaluation the block with three arguments: day month, year." + + | l n i j dd mm yyyy | + l := self julianDayNumber + 68569. + n := 4 * l // 146097. + l := l - (146097 * n + 3 // 4). + i := 4000 * (l + 1) // 1461001. + l := l - (1461 * i // 4) + 31. + j := 80 * l // 2447. + dd := l - (2447 * j // 80). + l := j // 11. + mm := j + 2 - (12 * l). + yyyy := 100 * (n - 49) + i + l. + + ^ aBlock + value: dd + value: mm + value: yyyy! Item was added: + ----- Method: LXDateAndTime>>dayOfMonth (in category 'ansi protocol') ----- + dayOfMonth + "Answer which day of the month is represented by the receiver." + + ^ self + dayMonthYearDo: [ :d :m :y | d ] + ! Item was added: + ----- Method: LXDateAndTime>>dayOfWeek (in category 'ansi protocol') ----- + dayOfWeek + + "Sunday=1, ... , Saturday=7" + + ^ (self julianDayNumber + 1 rem: 7) + 1 + ! Item was added: + ----- Method: LXDateAndTime>>dayOfWeekAbbreviation (in category 'ansi protocol') ----- + dayOfWeekAbbreviation + + ^ self dayOfWeekName copyFrom: 1 to: 3 + ! Item was added: + ----- Method: LXDateAndTime>>dayOfWeekName (in category 'ansi protocol') ----- + dayOfWeekName + + ^ Week nameOfDay: self dayOfWeek! Item was added: + ----- Method: LXDateAndTime>>dayOfYear (in category 'ansi protocol') ----- + dayOfYear + "This code was contributed by Dan Ingalls. It is equivalent to the terser + ^ jdn - (Year year: self year) start julianDayNumber + 1 but much quicker." + + ^ self dayMonthYearDo: + [ :d :m :y | + | monthStart | + monthStart := #(1 32 60 91 121 152 182 213 244 274 305 335) at: m. + (m > 2 and: [ Year isLeapYear: y ]) + ifTrue: [ monthStart + d ] + ifFalse: [ monthStart + d - 1 ]]! Item was added: + ----- Method: LXDateAndTime>>daysInMonth (in category 'smalltalk-80') ----- + daysInMonth + "Answer the number of days in the month represented by the receiver." + + + ^ self asMonth daysInMonth! Item was added: + ----- Method: LXDateAndTime>>daysInYear (in category 'smalltalk-80') ----- + daysInYear + + "Answer the number of days in the year represented by the receiver." + + ^ self asYear daysInYear! Item was added: + ----- Method: LXDateAndTime>>daysLeftInYear (in category 'smalltalk-80') ----- + daysLeftInYear + "Answer the number of days in the year after the date of the receiver." + + ^ self daysInYear - self dayOfYear! Item was added: + ----- Method: LXDateAndTime>>duration (in category 'squeak protocol') ----- + duration + + ^ Duration zero! Item was added: + ----- Method: LXDateAndTime>>firstDayOfMonth (in category 'smalltalk-80') ----- + firstDayOfMonth + + ^ self asMonth start day + ! Item was added: + ----- Method: LXDateAndTime>>getSeconds (in category 'transitional - temporary') ----- + getSeconds + + | posixDays posixSeconds localSeconds | + posixSeconds := utcMicroseconds / 1000000. + localSeconds := posixSeconds + localOffsetSeconds. + localSeconds < 0 ifTrue: [localSeconds := localSeconds \\ SecondsInDay]. "normalize" + posixDays := (localSeconds / SecondsInDay) asInteger. + ^localSeconds - (posixDays * SecondsInDay). + ! Item was added: + ----- Method: LXDateAndTime>>hasEqualTicks: (in category 'private') ----- + hasEqualTicks: aDateAndTime + + ^ (self julianDayNumber = aDateAndTime julianDayNumber) + and: [ (self getSeconds = aDateAndTime secondsSinceMidnight) + and: [ self nanoSecond = aDateAndTime nanoSecond ] ] + + ! Item was added: + ----- Method: LXDateAndTime>>hash (in category 'ansi protocol') ----- + hash + | totalSeconds | + totalSeconds := self getSeconds - self offsetSeconds. + ^ ((totalSeconds // 86400 + self julianDayNumber) hashMultiply bitXor: totalSeconds \\ + 86400) bitXor: self nanoSecond! Item was added: + ----- Method: LXDateAndTime>>hour (in category 'ansi protocol') ----- + hour + + ^ self hour24! Item was added: + ----- Method: LXDateAndTime>>hour12 (in category 'ansi protocol') ----- + hour12 + "Answer an <integer> between 1 and 12, inclusive, representing the hour + of the day in the 12-hour clock of the local time of the receiver." + ^ self hour24 - 1 \\ 12 + 1 + ! Item was added: + ----- Method: LXDateAndTime>>hour24 (in category 'ansi protocol') ----- + hour24 + + + ^ (Duration seconds: self getSeconds) hours! Item was added: + ----- Method: LXDateAndTime>>hours (in category 'smalltalk-80') ----- + hours + + ^ self hour + ! Item was added: + ----- Method: LXDateAndTime>>isLeapYear (in category 'ansi protocol') ----- + isLeapYear + + + ^ Year isLeapYear: self year + ! Item was added: + ----- Method: LXDateAndTime>>julianDayNumber (in category 'squeak protocol') ----- + julianDayNumber + + | posixDays posixSeconds localSeconds negativeDays | + posixSeconds := utcMicroseconds / 1000000. + localSeconds := posixSeconds + localOffsetSeconds. + negativeDays := 0. + localSeconds < 0 ifTrue: [ "normalize" + negativeDays := localSeconds // SecondsInDay. + localSeconds := negativeDays - 1 * SecondsInDay + localSeconds]. + posixDays := (localSeconds / SecondsInDay) asInteger. + ^posixDays + self posixEpochJulianDays - negativeDays. + ! Item was added: + ----- Method: LXDateAndTime>>makeUTC (in category 'squeak protocol') ----- + makeUTC + "Make the receiver's timezone UTC." + localOffsetSeconds := 0! Item was added: + ----- Method: LXDateAndTime>>meridianAbbreviation (in category 'ansi protocol') ----- + meridianAbbreviation + + ^ self asTime meridianAbbreviation + ! Item was added: + ----- Method: LXDateAndTime>>middleOf: (in category 'squeak protocol') ----- + middleOf: aDuration + "Return a Timespan where the receiver is the middle of the Duration" + + | duration | + duration := aDuration asDuration. + + ^ Timespan starting: (self - (duration / 2)) duration: duration + ! Item was added: + ----- Method: LXDateAndTime>>midnight (in category 'squeak protocol') ----- + midnight + "Answer a DateAndTime starting at midnight of the same timezone offset as the receiver." + ^ self class basicNew + setJdn: self julianDayNumber + seconds: 0 + nano: 0 + offset: self offset! Item was added: + ----- Method: LXDateAndTime>>minute (in category 'ansi protocol') ----- + minute + + + ^ (Duration seconds: self getSeconds) minutes! Item was added: + ----- Method: LXDateAndTime>>minutes (in category 'smalltalk-80') ----- + minutes + + ^ self minute + ! Item was added: + ----- Method: LXDateAndTime>>month (in category 'ansi protocol') ----- + month + + ^ self + dayMonthYearDo: [ :d :m :y | m ] + ! Item was added: + ----- Method: LXDateAndTime>>monthAbbreviation (in category 'ansi protocol') ----- + monthAbbreviation + + + ^ self monthName copyFrom: 1 to: 3! Item was added: + ----- Method: LXDateAndTime>>monthIndex (in category 'smalltalk-80') ----- + monthIndex + + + ^ self month! Item was added: + ----- Method: LXDateAndTime>>monthName (in category 'ansi protocol') ----- + monthName + + + ^ Month nameOfMonth: self month! Item was added: + ----- Method: LXDateAndTime>>nanoSecond (in category 'squeak protocol') ----- + nanoSecond + + ^utcMicroseconds \\ 1000000 * 1000 + ! Item was added: + ----- Method: LXDateAndTime>>noon (in category 'squeak protocol') ----- + noon + "Answer a DateAndTime starting at noon" + + ^ self dayMonthYearDo: + [ :d :m :y | self class year: y month: m day: d hour: 12 minute: 0 second: 0 ] + ! Item was added: + ----- Method: LXDateAndTime>>normalize:ticks:base: (in category 'private') ----- + normalize: i ticks: ticks base: base + + | tick div quo rem | + tick := ticks at: i. + div := tick asInteger digitDiv: base neg: tick negative. + quo := (div at: 1) normalize. + rem := (div at: 2) normalize. + rem < 0 ifTrue: [ quo := quo - 1. rem := base + rem ]. + ticks at: (i-1) put: ((ticks at: i-1) + quo). + ticks at: i put: rem + ! Item was added: + ----- Method: LXDateAndTime>>offset (in category 'ansi protocol') ----- + offset + + ^ Duration seconds: localOffsetSeconds! Item was added: + ----- Method: LXDateAndTime>>offset: (in category 'ansi protocol') ----- + offset: anOffset + + "Answer a <DateAndTime> equivalent to the receiver but with its local time + being offset from UTC by offset." + + ^ self class utcMicroseconds: utcMicroseconds offset: anOffset asDuration asSeconds + ! Item was added: + ----- Method: LXDateAndTime>>offsetSeconds (in category 'transitional - temporary') ----- + offsetSeconds + + ^localOffsetSeconds ifNil: [localOffsetSeconds := self offset asSeconds]! Item was added: + ----- Method: LXDateAndTime>>posixEpochJulianDays (in category 'DTL-initializing') ----- + posixEpochJulianDays + + ^self class daysFromSmalltalkEpochToPosixEpoch + SqueakEpoch! Item was added: + ----- Method: LXDateAndTime>>posixMicrosecondsJdn:seconds:nanos:offset: (in category 'transitional - temporary') ----- + posixMicrosecondsJdn: j seconds: s nanos: n offset: o + + | days totalSeconds micros | + days := j - self posixEpochJulianDays. + totalSeconds := days * 24 * 60 * 60 + s. + micros := totalSeconds * 1000000. + ^micros + (n / 1000) + ! Item was added: + ----- Method: LXDateAndTime>>printHMSOn: (in category 'squeak protocol') ----- + printHMSOn: aStream + "Print just hh:mm:ss" + aStream + nextPutAll: (self hour asString padded: #left to: 2 with: $0); + nextPut: $:; + nextPutAll: (self minute asString padded: #left to: 2 with: $0); + nextPut: $:; + nextPutAll: (self second asString padded: #left to: 2 with: $0). + ! Item was added: + ----- Method: LXDateAndTime>>printOn: (in category 'squeak protocol') ----- + printOn: aStream + "Print as per ISO 8601 sections 5.3.3 and 5.4.1. + Prints either: + 'YYYY-MM-DDThh:mm:ss.s+ZZ:zz:z' (for positive years) or '-YYYY-MM-DDThh:mm:ss.s+ZZ:zz:z' (for negative years)" + + ^self printOn: aStream withLeadingSpace: false + ! Item was added: + ----- Method: LXDateAndTime>>printOn:withLeadingSpace: (in category 'squeak protocol') ----- + printOn: aStream withLeadingSpace: printLeadingSpaceToo + "Print as per ISO 8601 sections 5.3.3 and 5.4.1. + If printLeadingSpaceToo is false, prints either: + 'YYYY-MM-DDThh:mm:ss.s+ZZ:zz:z' (for positive years) or '-YYYY-MM-DDThh:mm:ss.s+ZZ:zz:z' (for negative years) + If printLeadingSpaceToo is true, prints either: + ' YYYY-MM-DDThh:mm:ss.s+ZZ:zz:z' (for positive years) or '-YYYY-MM-DDThh:mm:ss.s+ZZ:zz:z' (for negative years) + " + + self printYMDOn: aStream withLeadingSpace: printLeadingSpaceToo. + aStream nextPut: $T. + self printHMSOn: aStream. + self nanoSecond ~= 0 ifTrue: + [ | z ps | + ps := self nanoSecond printString padded: #left to: 9 with: $0. + z := ps findLast: [ :c | c asciiValue > $0 asciiValue ]. + (z > 0) ifTrue: [aStream nextPut: $.]. + ps from: 1 to: z do: [ :c | aStream nextPut: c ] ]. + aStream + nextPut: (self offset positive ifTrue: [$+] ifFalse: [$-]); + nextPutAll: (self offset hours abs asString padded: #left to: 2 with: $0); + nextPut: $:; + nextPutAll: (self offset minutes abs asString padded: #left to: 2 with: $0). + self offset seconds = 0 ifFalse: + [ aStream + nextPut: $:; + nextPutAll: (self offset seconds abs truncated asString) ]. + ! Item was added: + ----- Method: LXDateAndTime>>printYMDOn: (in category 'squeak protocol') ----- + printYMDOn: aStream + "Print just YYYY-MM-DD part. + If the year is negative, prints out '-YYYY-MM-DD'." + + ^self printYMDOn: aStream withLeadingSpace: false. + ! Item was added: + ----- Method: LXDateAndTime>>printYMDOn:withLeadingSpace: (in category 'squeak protocol') ----- + printYMDOn: aStream withLeadingSpace: printLeadingSpaceToo + "Print just the year, month, and day on aStream. + + If printLeadingSpaceToo is true, then print as: + ' YYYY-MM-DD' (if the year is positive) or '-YYYY-MM-DD' (if the year is negative) + otherwise print as: + 'YYYY-MM-DD' or '-YYYY-MM-DD' " + + | year month day | + self dayMonthYearDo: [ :d :m :y | year := y. month := m. day := d ]. + year negative + ifTrue: [ aStream nextPut: $- ] + ifFalse: [ printLeadingSpaceToo ifTrue: [ aStream space ]]. + aStream + nextPutAll: (year abs asString padded: #left to: 4 with: $0); + nextPut: $-; + nextPutAll: (month asString padded: #left to: 2 with: $0); + nextPut: $-; + nextPutAll: (day asString padded: #left to: 2 with: $0) + ! Item was added: + ----- Method: LXDateAndTime>>second (in category 'ansi protocol') ----- + second + + + ^ (Duration seconds: self getSeconds) seconds! Item was added: + ----- Method: LXDateAndTime>>seconds (in category 'smalltalk-80') ----- + seconds + + ^ self second + ! Item was added: + ----- Method: LXDateAndTime>>secondsSinceMidnight (in category 'private') ----- + secondsSinceMidnight + + ^ self getSeconds! Item was added: + ----- Method: LXDateAndTime>>setJdn:seconds:nano:offset: (in category 'squeak protocol') ----- + setJdn: jdn seconds: s nano: n offset: o + + localOffsetSeconds := o asSeconds. + utcMicroseconds := self posixMicrosecondsJdn: jdn seconds: s nanos: n offset: localOffsetSeconds. + + ! Item was added: + ----- Method: LXDateAndTime>>ticks (in category 'private') ----- + ticks + "Private - answer an array with our instance variables. Assumed to be UTC " + + ^ Array with: self julianDayNumber with: self getSeconds with: self nanoSecond + ! Item was added: + ----- Method: LXDateAndTime>>ticks:offset: (in category 'private') ----- + ticks: ticks offset: utcOffset + "ticks is {julianDayNumber. secondCount. nanoSeconds}" + + | jdn s nanos | + self normalize: 3 ticks: ticks base: NanosInSecond. + self normalize: 2 ticks: ticks base: SecondsInDay. + + jdn := ticks at: 1. + s := ticks at: 2. + nanos := ticks at: 3. + localOffsetSeconds := utcOffset asSeconds. + utcMicroseconds := self posixMicrosecondsJdn: jdn seconds: s nanos: nanos offset: localOffsetSeconds. + ! Item was added: + ----- Method: LXDateAndTime>>timeZoneAbbreviation (in category 'ansi protocol') ----- + timeZoneAbbreviation + + ^ self class localTimeZone abbreviation! Item was added: + ----- Method: LXDateAndTime>>timeZoneName (in category 'ansi protocol') ----- + timeZoneName + + ^ self class localTimeZone name! Item was added: + ----- Method: LXDateAndTime>>to: (in category 'squeak protocol') ----- + to: anEnd + "Answer a Timespan. anEnd conforms to protocol DateAndTime or protocol Timespan" + + ^ Timespan starting: self ending: (anEnd asLXDateAndTime) + ! Item was added: + ----- Method: LXDateAndTime>>to:by: (in category 'squeak protocol') ----- + to: anEnd by: aDuration + "Answer a Timespan. anEnd conforms to protocol DateAndTime or protocol Timespan" + + ^ (Schedule starting: self ending: (anEnd asLXDateAndTime)) + schedule: (Array with: aDuration asDuration); + yourself + ! Item was added: + ----- Method: LXDateAndTime>>to:by:do: (in category 'squeak protocol') ----- + to: anEnd by: aDuration do: aBlock + "Answer a Timespan. anEnd conforms to protocol DateAndTime or protocol Timespan" + + ^ (self to: anEnd by: aDuration) scheduleDo: aBlock! Item was added: + ----- Method: LXDateAndTime>>utcMicroseconds (in category 'transitional - temporary') ----- + utcMicroseconds + ^utcMicroseconds! Item was added: + ----- Method: LXDateAndTime>>utcMicroseconds:offset: (in category 'DTL-initializing') ----- + utcMicroseconds: microsecondsSincePosixEpoch offset: tzOffset + + utcMicroseconds := microsecondsSincePosixEpoch. + localOffsetSeconds := tzOffset. + ! Item was added: + ----- Method: LXDateAndTime>>utcOffset: (in category 'squeak protocol') ----- + utcOffset: anOffset + + "Answer a <DateAndTime> equivalent to the receiver but offset from UTC by anOffset" + + | equiv | + equiv := self + (anOffset asDuration - self offset). + ^ equiv ticks: (equiv ticks) offset: anOffset asDuration; yourself! Item was added: + ----- Method: LXDateAndTime>>year (in category 'ansi protocol') ----- + year + ^ self + dayMonthYearDo: [ :d :m :y | y ] + ! Item was added: + TestCase subclass: #LXDateAndTimeConversionTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Chronology-Core'! Item was added: + ----- Method: LXDateAndTimeConversionTest>>testAsSeconds (in category 'testing') ----- + testAsSeconds + + | day dt hour lxdt min mo nano offset sec yr expectedSeconds | + yr := 1970. + mo := 12. + day := 2. + hour := 2. + min := 3. + sec := 4. + nano := 5. + offset := 6 hours. + lxdt := LXDateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + dt := DateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + self assert: 2206404184 equals: dt asSeconds. + self assert: 2206404184 equals: lxdt asSeconds. + + yr := 1969. + lxdt := LXDateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + dt := DateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + expectedSeconds := 2206404184 - (365 * 24 * 60 * 60). + self assert: expectedSeconds equals: dt asSeconds. + self assert: expectedSeconds equals: lxdt asSeconds. + ! Item was added: + ----- Method: LXDateAndTimeConversionTest>>testAsSeconds2 (in category 'testing') ----- + testAsSeconds2 + "(self selector: #testAsSeconds2) debug" + + | day dt hour lxdt min mo nano offset sec | + mo := 12. + day := 2. + hour := 2. + min := 3. + sec := 4. + nano := 5. + offset := 6 hours. + " -2000 to: 5000 do: [:yr |" + 1970 to: 5000 do: [:yr | + lxdt := LXDateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + dt := DateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + self assert: dt asSeconds equals: lxdt asSeconds]. + ! Item was added: + ----- Method: LXDateAndTimeConversionTest>>testDayOfMonth (in category 'testing') ----- + testDayOfMonth + "(self selector: #testDayOfMonth) debug" + + | day dt hour lxdt min mo nano offset sec | + mo := 12. + day := 2. + hour := 2. + min := 3. + sec := 4. + nano := 5. + offset := 6 hours. + -1200 to: 3000 do: [:yr | + lxdt := LXDateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + dt := DateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + self assert: dt dayOfMonth equals: lxdt dayOfMonth]. + ! Item was added: + ----- Method: LXDateAndTimeConversionTest>>testDayOfWeek (in category 'testing') ----- + testDayOfWeek + "(self selector: #testDayOfWeek) debug" + + | day dt hour lxdt min mo nano offset sec | + mo := 12. + day := 2. + hour := 2. + min := 3. + sec := 4. + nano := 5. + offset := 6 hours. + -1200 to: 3000 do: [:yr | + lxdt := LXDateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + dt := DateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + self assert: dt dayOfWeek equals: lxdt dayOfWeek]. + ! Item was added: + ----- Method: LXDateAndTimeConversionTest>>testDayOfYear (in category 'testing') ----- + testDayOfYear + "(self selector: #testDayOfYear) debug" + + | day dt hour lxdt min mo nano offset sec | + mo := 12. + day := 2. + hour := 2. + min := 3. + sec := 4. + nano := 5. + offset := 6 hours. + -1200 to: 3000 do: [:yr | + lxdt := LXDateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + dt := DateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + self assert: dt dayOfYear equals: lxdt dayOfYear]. + ! Item was added: + ----- Method: LXDateAndTimeConversionTest>>testFromString (in category 'testing') ----- + testFromString + "Convert to string then back, verify same date and time. Skip years in the + range 0 to 99 because they are interpreted relative to 2000." + + "(LXDateAndTimeConversionTest selector: #testFromString) debug" + + | day hour lxdt min mo nano offset sec newLxdt s | + mo := 12. + day := 2. + hour := 2. + min := 3. + sec := 4. + nano := 5. + offset := 6 hours. + (-2000 to: -1) , (100 to: 5000) do: [:yr | + lxdt := LXDateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + s := lxdt asString. + newLxdt := LXDateAndTime fromString: s. + self assert: lxdt equals: newLxdt]. + ! Item was added: + ----- Method: LXDateAndTimeConversionTest>>testJulianDayNumber (in category 'testing') ----- + testJulianDayNumber + "(self selector: #testJulianDayNumber) debug" + + | day dt hour lxdt min mo nano offset sec | + mo := 12. + day := 2. + hour := 2. + min := 3. + sec := 4. + nano := 5. + offset := 6 hours. + -2000 to: 5000 do: [:yr | + lxdt := LXDateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + dt := DateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + self assert: dt julianDayNumber equals: lxdt julianDayNumber]. + ! Item was added: + ----- Method: LXDateAndTimeConversionTest>>testMinute (in category 'testing') ----- + testMinute + "(self selector: #testMinute) debug" + + | day dt hour lxdt min mo nano offset sec | + mo := 12. + day := 2. + hour := 2. + min := 3. + sec := 4. + nano := 5. + offset := 6 hours. + -2000 to: 5000 do: [:yr | + lxdt := LXDateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + dt := DateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + self assert: dt minute equals: lxdt minute]. + ! Item was added: + ----- Method: LXDateAndTimeConversionTest>>testMonth (in category 'testing') ----- + testMonth + + | day dt hour lxdt min mo nano offset sec yr | + yr := 1969. + mo := 12. + day := 2. + hour := 2. + min := 3. + sec := 4. + nano := 5. + offset := 6 hours. + lxdt := LXDateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + dt := DateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + self assert: 12 equals: dt month. + self assert: 12 equals: lxdt month. + + (2105 to: -1105 by: 20) + do: [:year | + 1 to: 12 do: [:m | + lxdt := LXDateAndTime + year: year month: m day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + dt := DateAndTime + year: year month: m day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + self assert: m equals: dt month. + self assert: m equals: lxdt month]] + ! Item was added: + ----- Method: LXDateAndTimeConversionTest>>testNanoSecond (in category 'testing') ----- + testNanoSecond + + | day dt hour lxdt min mo nano offset sec yr | + yr := 1969. + mo := 12. + day := 2. + hour := 2. + min := 3. + sec := 4. + nano := 5. + offset := 6 hours. + lxdt := LXDateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + dt := DateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + self assert: 5 equals: dt nanoSecond. + self assert: 5 equals: lxdt nanoSecond. + + (2105 to: -1105 by: 20) + do: [:year | + lxdt := LXDateAndTime + year: year month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + dt := DateAndTime + year: year month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + self assert: 5 equals: dt nanoSecond. + self assert: 5 equals: lxdt nanoSecond] + + ! Item was added: + ----- Method: LXDateAndTimeConversionTest>>testSecond (in category 'testing') ----- + testSecond + "(self selector: #testSecond) debug" + + | day dt hour lxdt min mo nano offset sec | + mo := 12. + day := 2. + hour := 2. + min := 3. + sec := 4. + nano := 5. + offset := 6 hours. + -2000 to: 5000 do: [:yr | + lxdt := LXDateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + dt := DateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + self assert: dt second equals: lxdt second]. + ! Item was added: + ----- Method: LXDateAndTimeConversionTest>>testYear (in category 'testing') ----- + testYear + + | day dt hour lxdt min mo nano offset sec yr | + yr := 1969. + mo := 12. + day := 2. + hour := 2. + min := 3. + sec := 4. + nano := 5. + offset := 6 hours. + lxdt := LXDateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + dt := DateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + self assert: 1969 equals: dt year. + self assert: 1969 equals: lxdt year. + + (2105 to: -1105 by: 20) + do: [:year | + lxdt := LXDateAndTime + year: year month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + dt := DateAndTime + year: year month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + self assert: year equals: dt year. + self assert: year equals: lxdt year] + + ! Item was added: + TestCase subclass: #LXDateAndTimeEpochTest + instanceVariableNames: 'aDateAndTime aDuration aTimeZone localTimeZoneToRestore' + classVariableNames: '' + poolDictionaries: '' + category: 'Chronology-Core'! + + !LXDateAndTimeEpochTest commentStamp: 'tlk 1/6/2004 18:27' prior: 0! + I represent one of several Sunit test Cases intentended to provide complete coverage for the Chronology set of classes as part of the external testing. The other Chronology sunit test cases are: + DateTestCase + DateAndTimeLeapTestCase, + DurationTestCase, + ScheduleTestCase + TimeStampTestCase + TimespanDoTestCase, + TimespanDoSpanAYearTestCase, + TimespanTestCase, + YearMonthWeekTestCase. + These tests attempt to exercise all public and private methods. Except, they do not explicitly depreciated methods. tlk + My fixtures are: + aDateAndTime = January 01, 1901 midnight (the start of the Squeak epoch) with localTimeZone = Grenwhich Meridian (local offset = 0 hours) + aDuration = 1 day, 2 hours, 3, minutes, 4 seconds and 5 nano seconds. + aTimeZone = 'Epoch Test Time Zone', 'ETZ' , offset: 12 hours, 15 minutes. ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>setUp (in category 'running') ----- + setUp + localTimeZoneToRestore := LXDateAndTime localTimeZone. + aDateAndTime := LXDateAndTime localTimeZone: TimeZone default; epoch. + aTimeZone := TimeZone offset: (Duration minutes: 135) name: 'Epoch Test Time Zone' abbreviation: 'ETZ'. + aDuration := Duration days: 1 hours: 2 minutes: 3 seconds: 4 nanoSeconds: 5 ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>tearDown (in category 'running') ----- + tearDown + LXDateAndTime localTimeZone: localTimeZoneToRestore. + "wish I could remove the time zones I added earlier, tut there is no method for that" + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testAsDate (in category 'testing') ----- + testAsDate + self assert: aDateAndTime asDate = 'January 1, 1901' asDate. + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testAsDateAndTime (in category 'testing') ----- + testAsDateAndTime + self assert: aDateAndTime asLXDateAndTime = aDateAndTime + + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testAsDuration (in category 'testing') ----- + testAsDuration + self assert: aDateAndTime asDuration = 0 asDuration + + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testAsLocal (in category 'testing') ----- + testAsLocal + self assert: aDateAndTime asLocal = aDateAndTime. + self assert: aDateAndTime asLocal = (aDateAndTime utcOffset: aDateAndTime class localOffset) + + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testAsMonth (in category 'testing') ----- + testAsMonth + self assert: aDateAndTime asMonth = (Month month: 'January' year: 1901). + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testAsNanoSeconds (in category 'testing') ----- + testAsNanoSeconds + self assert: aDateAndTime asNanoSeconds = 0 asDuration asNanoSeconds + + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testAsSeconds (in category 'testing') ----- + testAsSeconds + self assert: aDateAndTime asSeconds = 0 asDuration asSeconds + + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testAsTime (in category 'testing') ----- + testAsTime + self assert: aDateAndTime asTime = Time midnight. + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testAsTimeStamp (in category 'testing') ----- + testAsTimeStamp + self assert: aDateAndTime asTimeStamp = TimeStamp new. + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testAsUTC (in category 'testing') ----- + testAsUTC + self assert: aDateAndTime asUTC = aDateAndTime + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testAsWeek (in category 'testing') ----- + testAsWeek + self assert: aDateAndTime asWeek = (Week starting: '12-31-1900' asDate). + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testAsYear (in category 'testing') ----- + testAsYear + self assert: aDateAndTime asYear = (Year starting: '01-01-1901' asDate). + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testCurrent (in category 'testing') ----- + testCurrent + self deny: aDateAndTime = (LXDateAndTime current). + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testDateTime (in category 'testing') ----- + testDateTime + self assert: aDateAndTime = (LXDateAndTime date: '01-01-1901' asDate time: '00:00:00' asTime) + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testDay (in category 'testing') ----- + testDay + self assert: aDateAndTime day = LXDateAndTime new day + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testDayMonthYearDo (in category 'testing') ----- + testDayMonthYearDo + |iterations| + iterations := 0. + self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear | iterations := iterations + 1]) = 1. + self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear | eachYear]) = 1901. + self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear | eachMonth]) = 1. + self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear | eachDay]) = 1. + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testDayOfMonth (in category 'testing') ----- + testDayOfMonth + self assert: aDateAndTime dayOfMonth = 1. + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testDayOfWeek (in category 'testing') ----- + testDayOfWeek + self assert: aDateAndTime dayOfWeek = 3. + self assert: aDateAndTime dayOfWeekAbbreviation = 'Tue'. + self assert: aDateAndTime dayOfWeekName = 'Tuesday'. + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testDayOfYear (in category 'testing') ----- + testDayOfYear + self assert: aDateAndTime dayOfYear = 1. + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testDaysInMonth (in category 'testing') ----- + testDaysInMonth + self assert: aDateAndTime daysInMonth = 31. + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testDaysInYear (in category 'testing') ----- + testDaysInYear + self assert: aDateAndTime daysInYear = 365. + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testDaysLeftInYear (in category 'testing') ----- + testDaysLeftInYear + self assert: aDateAndTime daysLeftInYear = 364. + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testDuration (in category 'testing') ----- + testDuration + self assert: aDateAndTime duration = 0 asDuration. + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testEpoch (in category 'testing') ----- + testEpoch + self assert: aDateAndTime = '1901-01-01T00:00:00+00:00' asLXDateAndTime + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testFirstDayOfMonth (in category 'testing') ----- + testFirstDayOfMonth + self assert: aDateAndTime firstDayOfMonth = 1 + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testFromSeconds (in category 'testing') ----- + testFromSeconds + self assert: aDateAndTime = (LXDateAndTime fromSeconds: 0). + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testFromString (in category 'testing') ----- + testFromString + self assert: aDateAndTime = (LXDateAndTime fromString: ' 1901-01-01T00:00:00+00:00'). + self assert: aDateAndTime = (LXDateAndTime fromString: ' 1901-01-01T00:00:00'). + self assert: aDateAndTime = (LXDateAndTime fromString: ' 1901-01-01T00:00'). + self assert: aDateAndTime = (LXDateAndTime fromString: ' 1901-01-01T00:00:00+00:00'). + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testHash (in category 'testing') ----- + testHash + self assert: aDateAndTime hash = LXDateAndTime new hash. + self assert: aDateAndTime hash = 112557138 + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testHour (in category 'testing') ----- + testHour + self assert: aDateAndTime hour = aDateAndTime hour24. + self assert: aDateAndTime hour = 0. + self assert: aDateAndTime hour = aDateAndTime hours + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testHour12 (in category 'testing') ----- + testHour12 + self assert: aDateAndTime hour12 = LXDateAndTime new hour12. + self assert: aDateAndTime hour12 = 12 + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testIsLeapYear (in category 'testing') ----- + testIsLeapYear + self deny: aDateAndTime isLeapYear + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testJulianDayNumber (in category 'testing') ----- + testJulianDayNumber + self assert: aDateAndTime = (LXDateAndTime julianDayNumber: 2415386). + self assert: aDateAndTime julianDayNumber = 2415386.! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testLessThan (in category 'testing') ----- + testLessThan + self assert: aDateAndTime < (aDateAndTime + '1:00:00:00'). + self assert: aDateAndTime + -1 < aDateAndTime. + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testMeridianAbbreviation (in category 'testing') ----- + testMeridianAbbreviation + self assert: aDateAndTime meridianAbbreviation = 'AM'. + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testMiddleOf (in category 'testing') ----- + testMiddleOf + self assert: (aDateAndTime middleOf: '2:00:00:00' asDuration) = + (Timespan starting: '12-31-1900' asDate duration: 2 days). + + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testMidnight (in category 'testing') ----- + testMidnight + self assert: aDateAndTime midnight = aDateAndTime + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testMinus (in category 'testing') ----- + testMinus + self assert: aDateAndTime - aDateAndTime = '0:00:00:00' asDuration. + self assert: aDateAndTime - '0:00:00:00' asDuration = aDateAndTime. + self assert: aDateAndTime - aDuration = (LXDateAndTime year: 1900 month: 12 day: 30 hour: 21 minute: 56 second: 55 nanoSecond: 999999995 offset: 0 hours ). + " I believe this Failure is a bug in the nanosecond part of (LXDateAndTime >> year:month:day:hour:minute:second:nanoSecond:offset:)" ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testMinute (in category 'testing') ----- + testMinute + self assert: aDateAndTime minute = 0 + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testMinutes (in category 'testing') ----- + testMinutes + self assert: aDateAndTime minutes = 0 + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testMonth (in category 'testing') ----- + testMonth + self assert: aDateAndTime month = 1. + self assert: aDateAndTime monthAbbreviation = 'Jan'. + self assert: aDateAndTime monthName = 'January'. + self assert: aDateAndTime monthIndex = 1.! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testNanoSecond (in category 'testing') ----- + testNanoSecond + self assert: aDateAndTime nanoSecond = 0 + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testNew (in category 'testing') ----- + testNew + self assert: aDateAndTime = (LXDateAndTime new). + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testNoon (in category 'testing') ----- + testNoon + self assert: aDateAndTime noon = '1901-01-01T12:00:00+00:00' asLXDateAndTime! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testNow (in category 'testing') ----- + testNow + self deny: aDateAndTime = (LXDateAndTime now). + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testOffset (in category 'testing') ----- + testOffset + self assert: aDateAndTime offset = '0:00:00:00' asDuration. + self assert: (aDateAndTime offset: '0:12:00:00') = '1901-01-01T00:00:00+12:00' asLXDateAndTime! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testPlus (in category 'testing') ----- + testPlus + self assert: aDateAndTime + '0:00:00:00' = aDateAndTime. + self assert: aDateAndTime + 0 = aDateAndTime. + self assert: aDateAndTime + aDuration = (LXDateAndTime year: 1901 month: 1 day: 2 hour: 2 minute: 3 second: 4 nanoSecond: 5 offset: 0 hours ) + " I believe this is a bug in the nanosecond part of (DateAndTime >> year:month:day:hour:minute:second:nanoSecond:offset:)" + + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testPrintOn (in category 'testing') ----- + testPrintOn + | ref ws | + ref := '1901-01-01T00:00:00+00:00'. + ws := '' writeStream. + aDateAndTime printOn: ws. + self assert: ws contents = ref. + ref := 'a TimeZone(ETZ)'. + ws := '' writeStream. + aTimeZone printOn: ws. + self assert: ws contents = ref! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testSecond (in category 'testing') ----- + testSecond + self assert: aDateAndTime second = 0 + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testSeconds (in category 'testing') ----- + testSeconds + self assert: aDateAndTime seconds = 0 + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testTicks (in category 'testing') ----- + testTicks + self assert: aDateAndTime ticks = (LXDateAndTime julianDayNumber: 2415386) ticks. + self assert: aDateAndTime ticks = #(2415386 0 0)! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testTicksOffset (in category 'testing') ----- + testTicksOffset + self assert: aDateAndTime = (aDateAndTime ticks: #(2415386 0 0) offset: LXDateAndTime localOffset). + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testTo (in category 'testing') ----- + testTo + self assert: (aDateAndTime to: aDateAndTime) = (LXDateAndTime new to: LXDateAndTime new) + "MessageNotUnderstood: UndefinedObject>>starting:ending: where UndefinedObject is Timespan "! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testToBy (in category 'testing') ----- + testToBy + self assert: (aDateAndTime to: aDateAndTime + 10 days by: 5 days) = + (LXDateAndTime new to: LXDateAndTime new + 10 days by: 5 days ) + "MessageNotUnderstood: UndefinedObject>>starting:ending: where UndefinedObject is Timespan "! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testToByDo (in category 'testing') ----- + testToByDo + "self assert: (aDateAndTime to: aDateAndTime + 10 days by: 5 days do: []) = " + "MessageNotUnderstood: UndefinedObject>>starting:ending: where UndefinedObject is Timespan "! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testToday (in category 'testing') ----- + testToday + self deny: aDateAndTime = (LXDateAndTime today). + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testTommorrow (in category 'testing') ----- + testTommorrow + self assert: (LXDateAndTime today + 24 hours) = (LXDateAndTime tomorrow). + self deny: aDateAndTime = (LXDateAndTime tomorrow). + "MessageNotUnderstood: Date class>>starting:"! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testUtcOffset (in category 'testing') ----- + testUtcOffset + self assert: (aDateAndTime utcOffset: '0:12:00:00') = '1901-01-01T12:00:00+12:00' asLXDateAndTime! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testYear (in category 'testing') ----- + testYear + self assert: aDateAndTime year = 1901. + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testYearDay (in category 'testing') ----- + testYearDay + self assert: aDateAndTime = (LXDateAndTime year: 1901 day: 1). + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testYearDayHourMinuteSecond (in category 'testing') ----- + testYearDayHourMinuteSecond + self assert: aDateAndTime = (LXDateAndTime year: 1901 day: 1 hour: 0 minute: 0 second: 0). + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testYearMonthDay (in category 'testing') ----- + testYearMonthDay + self assert: aDateAndTime = (LXDateAndTime year: 1901 month: 1 day: 1). + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testYearMonthDayHourMinuteSecond (in category 'testing') ----- + testYearMonthDayHourMinuteSecond + self assert: aDateAndTime = (LXDateAndTime year: 1901 month: 1 day: 1 hour: 0 minute: 0 second: 0). + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testYearMonthDayHourMinuteSecondNanosSecondOffset (in category 'testing') ----- + testYearMonthDayHourMinuteSecondNanosSecondOffset + self assert: aDateAndTime = (LXDateAndTime year: 1901 month: 1 day: 1 hour: 0 minute: 0 second: 0 nanoSecond: 0 offset:0 hours ). + self assert: ((LXDateAndTime year: 1 month: 1 day: 1 hour: 0 minute: 0 second: 0 nanoSecond: 0 offset: 0 hours ) + + (Duration days: 1 hours: 2 minutes: 3 seconds: 4 nanoSeconds: 5) ) = + (LXDateAndTime year: 1 month: 1 day: 2 hour: 2 minute: 3 second: 4 nanoSecond: 5 offset: 0 hours ) + " I believe this is a bug in the nanosecond part of (DateAndTime >> year:month:day:hour:minute:second:nanoSecond:offset:)"" I believe this is a bug in the nanosecond part of (DateAndTime >> year:month:day:hour:minute:second:nanoSecond:offset:)" + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testYesterday (in category 'testing') ----- + testYesterday + self deny: aDateAndTime = (LXDateAndTime yesterday). + ! Item was added: + ----- Method: LXDateAndTimeEpochTest>>testtimeZone (in category 'testing') ----- + testtimeZone + self assert: aDateAndTime timeZoneName = 'Universal Time'. + self assert: aDateAndTime timeZoneAbbreviation = 'UTC' + ! Item was added: + TestCase subclass: #LXDateAndTimeLeapTest + instanceVariableNames: 'aDateAndTime aDuration aTimeZone localTimeZoneToRestore' + classVariableNames: '' + poolDictionaries: '' + category: 'Chronology-Core'! + + !LXDateAndTimeLeapTest commentStamp: 'tlk 1/6/2004 17:54' prior: 0! + I represent one of several Sunit test Cases intentended to provide complete coverage for the Chronology set of classes as part of the external testing. tlk. + My fixtures are: + aDateAndTime = February 29, 2004 1:33 PM with offset: 2 hours + aDuration = 15 days, 14 hours, 13 minutes, 12 seconds and 11 nano seconds. + aTimeZone = Grenwhich Meridian (local offset = 0 hours) ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>setUp (in category 'running') ----- + setUp + localTimeZoneToRestore := LXDateAndTime localTimeZone. + LXDateAndTime localTimeZone: TimeZone default. + aDateAndTime := (LXDateAndTime year: 2004 month: 2 day: 29 hour: 13 minute: 33 second: 0 offset: 2 hours). + aTimeZone := TimeZone default. + aDuration := Duration days: 0 hours: 13 minutes: 33 seconds: 0 nanoSeconds: 0 + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>tearDown (in category 'running') ----- + tearDown + LXDateAndTime localTimeZone: localTimeZoneToRestore. + "wish I could remove the time zones I added earlier, tut there is no method for that" + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testAsDate (in category 'testing') ----- + testAsDate + self assert: (aDateAndTime offset: LXDateAndTime localTimeZone offset) asDate = 'February 29, 2004' asDate! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testAsDuration (in category 'testing') ----- + testAsDuration + self assert: aDateAndTime asDuration = aDuration + + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testAsLocal (in category 'testing') ----- + testAsLocal + self assert: aDateAndTime asLocal = aDateAndTime. + self assert: aDateAndTime asLocal = (aDateAndTime utcOffset: aDateAndTime class localOffset) + + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testAsMonth (in category 'testing') ----- + testAsMonth + self assert: + (aDateAndTime offset: Month defaultOffset) asMonth = + (Month + month: 'February' + year: 2004)! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testAsNanoSeconds (in category 'testing') ----- + testAsNanoSeconds + self assert: aDateAndTime asNanoSeconds = aDuration asNanoSeconds. + self assert: aDateAndTime asNanoSeconds = 48780000000000 + + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testAsSeconds (in category 'testing') ----- + testAsSeconds + self assert: aDuration asSeconds = 48780. + self assert: aDateAndTime asSeconds = 3255514380! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testAsTime (in category 'testing') ----- + testAsTime + self assert: aDateAndTime asTime = (Time hour: 13 minute: 33 second: 0) + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testAsTimeStamp (in category 'testing') ----- + testAsTimeStamp + self assert: aDateAndTime asTimeStamp = ((TimeStamp readFrom: '2-29-2004 1:33 pm' readStream) offset: 2 hours). + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testAsUTC (in category 'testing') ----- + testAsUTC + self assert: aDateAndTime asUTC = aDateAndTime + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testAsWeek (in category 'testing') ----- + testAsWeek + self assert: (aDateAndTime offset: LXDateAndTime localTimeZone offset) asWeek = (Week starting: '02-29-2004' asDate)! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testAsYear (in category 'testing') ----- + testAsYear + | year | + year := (aDateAndTime offset: LXDateAndTime localTimeZone offset) asYear. + self assert: year = (Year starting: '02-29-2004' asDate). + self deny: year = (Year starting: '01-01-2004' asDate)! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testDay (in category 'testing') ----- + testDay + self assert: aDateAndTime day = 60. + self deny: aDateAndTime day = 29 ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testDayMonthYearDo (in category 'testing') ----- + testDayMonthYearDo + self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear | eachYear]) = 2004. + self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear | eachMonth]) = 2. + self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear | eachDay]) = 29. + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testDayOfMonth (in category 'testing') ----- + testDayOfMonth + self assert: aDateAndTime dayOfMonth = 29. + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testDayOfWeek (in category 'testing') ----- + testDayOfWeek + self assert: aDateAndTime dayOfWeek = 1. + self assert: aDateAndTime dayOfWeekAbbreviation = 'Sun'. + self assert: aDateAndTime dayOfWeekName = 'Sunday'. + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testDayOfYear (in category 'testing') ----- + testDayOfYear + self assert: aDateAndTime dayOfYear = 60. + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testDaysInMonth (in category 'testing') ----- + testDaysInMonth + self assert: aDateAndTime daysInMonth = 29. + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testDaysInYear (in category 'testing') ----- + testDaysInYear + self assert: aDateAndTime daysInYear = 366. + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testDaysLeftInYear (in category 'testing') ----- + testDaysLeftInYear + self assert: aDateAndTime daysLeftInYear = 306. + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testFirstDayOfMonth (in category 'testing') ----- + testFirstDayOfMonth + self deny: aDateAndTime firstDayOfMonth = 1. + self assert: aDateAndTime firstDayOfMonth = 32 + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testFromString (in category 'testing') ----- + testFromString + self assert: aDateAndTime = (LXDateAndTime fromString: ' 2004-02-29T13:33:00+02:00'). + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testHash (in category 'testing') ----- + testHash + self assert: aDateAndTime hash = 16256473 + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testHour (in category 'testing') ----- + testHour + self assert: aDateAndTime hour = aDateAndTime hour24. + self assert: aDateAndTime hour = 13. + self assert: aDateAndTime hour = aDateAndTime hours + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testHour12 (in category 'testing') ----- + testHour12 + self assert: aDateAndTime hour12 = 1. + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testIsLeapYear (in category 'testing') ----- + testIsLeapYear + self assert: aDateAndTime isLeapYear + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testLessThan (in category 'testing') ----- + testLessThan + self assert: aDateAndTime < (aDateAndTime + '1:00:00:00'). + self assert: aDateAndTime + -1 < aDateAndTime. + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testMeridianAbbreviation (in category 'testing') ----- + testMeridianAbbreviation + self assert: aDateAndTime meridianAbbreviation = 'PM'. + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testMiddleOf (in category 'testing') ----- + testMiddleOf + self assert: (aDateAndTime middleOf: aDuration) = + (Timespan starting: (LXDateAndTime year: 2004 month: 2 day: 29 hour: 6 minute: 46 second: 30 offset: 2 hours) + duration: (Duration days: 0 hours: 13 minutes: 33 seconds: 0 nanoSeconds: 0 )) + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testMidnight (in category 'testing') ----- + testMidnight + | midnight | + midnight := (aDateAndTime offset: LXDateAndTime localTimeZone offset) midnight. + self assert: midnight = '2004-02-29T00:00:00+00:00' asLXDateAndTime. + self deny: midnight = '2004-02-29T00:00:00+02:00' asLXDateAndTime! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testMinute (in category 'testing') ----- + testMinute + self assert: aDateAndTime minute = 33 + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testMinutes (in category 'testing') ----- + testMinutes + self assert: aDateAndTime minutes = 33 + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testMonth (in category 'testing') ----- + testMonth + self assert: aDateAndTime month = 2. + self assert: aDateAndTime monthAbbreviation = 'Feb'. + self assert: aDateAndTime monthName = 'February'. + self assert: aDateAndTime monthIndex = 2.! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testMonthParsing (in category 'testing') ----- + testMonthParsing + self assert: + (Month readFrom: 'Feb 2011' readStream) = + (Month + month: 2 + year: 2011)! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testNanoSecond (in category 'testing') ----- + testNanoSecond + self assert: aDateAndTime nanoSecond = 0 + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testNoon (in category 'testing') ----- + testNoon + self assert: aDateAndTime noon = '2004-02-29T12:00:00+00:00' asLXDateAndTime! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testOffset (in category 'testing') ----- + testOffset + self assert: aDateAndTime offset = '0:02:00:00' asDuration. + self assert: (aDateAndTime offset: '0:12:00:00') = '2004-02-29T13:33:00+12:00' asLXDateAndTime! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testPrintOn (in category 'testing') ----- + testPrintOn + | ref ws | + ref := '2004-02-29T13:33:00+02:00'. + ws := '' writeStream. + aDateAndTime printOn: ws. + self assert: ws contents = ref. + ref := 'a TimeZone(UTC)'. + ws := '' writeStream. + aTimeZone printOn: ws. + self assert: ws contents = ref ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testSecond (in category 'testing') ----- + testSecond + self assert: aDateAndTime second = 0 + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testSeconds (in category 'testing') ----- + testSeconds + self assert: aDateAndTime seconds = 0 + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testTicks (in category 'testing') ----- + testTicks + self assert: aDateAndTime ticks = ((LXDateAndTime julianDayNumber: 2453065) + 48780 seconds) ticks. + self assert: aDateAndTime ticks = #(2453065 48780 0)! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testTicksOffset (in category 'testing') ----- + testTicksOffset + self assert: aDateAndTime = (aDateAndTime ticks: #(2453065 48780 0) offset: LXDateAndTime localOffset). + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testUtcOffset (in category 'testing') ----- + testUtcOffset + self assert: (aDateAndTime utcOffset: '0:02:00:00') = '2004-02-29T13:33:00+02:00' asLXDateAndTime! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testYear (in category 'testing') ----- + testYear + self assert: aDateAndTime year = 2004. + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testYearDayHourMinuteSecond (in category 'testing') ----- + testYearDayHourMinuteSecond + self assert: aDateAndTime = ((LXDateAndTime year: 2004 day: 60 hour: 13 minute: 33 second: 0) offset: 2 hours). + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testYearMonthDayHourMinuteSecond (in category 'testing') ----- + testYearMonthDayHourMinuteSecond + self assert: aDateAndTime = ((LXDateAndTime year: 2004 month: 2 day: 29 hour: 13 minute: 33 second: 0) offset: 2 hours). + ! Item was added: + ----- Method: LXDateAndTimeLeapTest>>testtimeZone (in category 'testing') ----- + testtimeZone + self assert: aDateAndTime timeZoneName = 'Universal Time'. + self assert: aDateAndTime timeZoneAbbreviation = 'UTC' + ! Item was added: + ClassTestCase subclass: #LXDateAndTimeTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Chronology-Core'! Item was added: + ----- Method: LXDateAndTimeTest>>classToBeTested (in category 'Coverage') ----- + classToBeTested + ^ LXDateAndTime + ! Item was added: + ----- Method: LXDateAndTimeTest>>selectorsToBeIgnored (in category 'Coverage') ----- + selectorsToBeIgnored + | private | + private := #( #printOn: ). + ^ super selectorsToBeIgnored, private + ! Item was added: + ----- Method: LXDateAndTimeTest>>testArithmeticAcrossDateBoundary (in category 'Tests') ----- + testArithmeticAcrossDateBoundary + | t1 t2 | + t1 := '2004-01-07T11:55:00+00:00' asLXDateAndTime. + t2 := t1 - ( (42900+1) seconds). + self + assert: t2 = ('2004-01-06T23:59:59+00:00' asLXDateAndTime) + + ! Item was added: + ----- Method: LXDateAndTimeTest>>testDateTimeDenotation1 (in category 'Tests') ----- + testDateTimeDenotation1 + "LXDateAndTimeTest new testDateTimeDenotation1" + + " Detroit is 5 hours behind UTC, this offset to UTC is therefore written with a minus sign. This example tests the correct interpretation of the DateAndTime denotation. " + | twoPmInLondon twoPmUTCInLocalTimeOfDetroit nineAmInDetroit | + twoPmInLondon := LXDateAndTime + year: 2004 + month: 11 + day: 2 + hour: 14 + minute: 0 + second: 0 + offset: 0 hours. + twoPmUTCInLocalTimeOfDetroit := twoPmInLondon utcOffset: -5 hours. + nineAmInDetroit := '2004-11-02T09:00:00-05:00' asLXDateAndTime. + self assert: twoPmUTCInLocalTimeOfDetroit = nineAmInDetroit. + + ! Item was added: + ----- Method: LXDateAndTimeTest>>testDateTimeDenotation2 (in category 'Tests') ----- + testDateTimeDenotation2 + "LXDateAndTimeTest new testDateTimeDenotation2" + + " Moscow is 3 hours ahead UTC, this offset to UTC is therefore positive. This example tests the correct interpretation of the DateAndTime denotation. " + | lateEveningInLondon lateEveningInLocalTimeOfMoscow + localMoscowTimeFromDenotation | + lateEveningInLondon := LXDateAndTime + year: 2004 + month: 11 + day: 30 + hour: 23 + minute: 30 + second: 0 + offset: 0 hours. + lateEveningInLocalTimeOfMoscow := lateEveningInLondon utcOffset: 3 hours. + localMoscowTimeFromDenotation := '2004-12-01T02:30:00+03:00' asLXDateAndTime. + self assert: lateEveningInLocalTimeOfMoscow = localMoscowTimeFromDenotation. + + ! Item was added: + ----- Method: LXDateAndTimeTest>>testErrorWhenDayIsAfterMonthEnd (in category 'Tests') ----- + testErrorWhenDayIsAfterMonthEnd + self + should: + [LXDateAndTime + year: 2004 + month: 2 + day: 30] + raise: Error.! Item was added: + ----- Method: LXDateAndTimeTest>>testErrorWhenDayIsBeforeMonthStart (in category 'Tests') ----- + testErrorWhenDayIsBeforeMonthStart + self + should: + [LXDateAndTime + year: 2004 + month: 2 + day: -1] + raise: Error. + self + should: + [LXDateAndTime + year: 2004 + month: 2 + day: 0] + raise: Error.! Item was added: + ----- Method: LXDateAndTimeTest>>testFromString (in category 'Tests') ----- + testFromString + | fromString fromStringNoOffset fromStringUTC | + fromString := LXDateAndTime fromString: '-1199-01-05T20:33:14.321-05:00'. + self assert: (fromString printString = '-1199-01-05T20:33:14.321-05:00'). + + "if no offset is provided, the local offset should be used" + fromStringNoOffset := LXDateAndTime fromString: '-1199-01-05T20:33:14.321'. + self assert: (fromStringNoOffset offset = LXDateAndTime localOffset). + + "if a string contains the UTC designator Z, the local offset should not be used" + fromStringUTC := LXDateAndTime fromString: '2011-08-26T18:00:03Z'. + self assert: (fromStringUTC printString = '2011-08-26T18:00:03+00:00').! Item was added: + ----- Method: LXDateAndTimeTest>>testHash (in category 'Tests') ----- + testHash + | date0 date1 date2 | + date0 := LXDateAndTime unixEpoch. + date1 := LXDateAndTime new ticks: (date0 + 1 hours) ticks offset: 0 hours. + date2 := LXDateAndTime new ticks: (date0 - 2 hours) ticks offset: -3 hours. + self assert: (date1 = date2) ==> [date1 hash = date2 hash]! Item was added: + ----- Method: LXDateAndTimeTest>>testInstanceCreation (in category 'Tests') ----- + testInstanceCreation + | t | + t := LXDateAndTime + year: 1 month: 1 day: 2 + hour: 2 minute: 3 second: 4 nanoSecond: 5 + offset: 6 hours. + self + assert: (t julianDayNumber = 1721427); + assert: (t offset = 6 hours); + assert: (t hour = 2); + assert: (t minute = 3); + assert: (t second = 4); + assert: (t nanoSecond = 5). + + ! Item was added: + ----- Method: LXDateAndTimeTest>>testMonotonicity (in category 'Tests') ----- + testMonotonicity + | t1 t2 t3 t4 | + t1 := LXDateAndTime now. + t2 := LXDateAndTime now. + (Delay forMilliseconds: 1000) wait. + t3 := LXDateAndTime now. + t4 := LXDateAndTime now. + self + assert: ( t1 <= t2); + assert: ( t2 < t3); + assert: ( t3 <= t4). + ! Item was added: + ----- Method: LXDateAndTimeTest>>testPrecision (in category 'Tests') ----- + testPrecision + "Verify that the clock is returning a value with accuracy of better than 1 second. For now it seems sufficient to get two values and verify they are not the same." + self + assert: (LXDateAndTime now ~= LXDateAndTime now) + ! Item was added: + ----- Method: LXDateAndTimeTest>>testPrintString (in category 'Tests') ----- + testPrintString + "(self new setTestSelector: #testPrintString) debug" + | dt dtNoOffset | + dt :=LXDateAndTime + year: 2004 + month: 11 + day: 2 + hour: 14 + minute: 3 + second: 5 + nanoSecond: 12345 + offset: (Duration seconds: (5 * 3600)). + self assert: dt printString = '2004-11-02T14:03:05.000012345+05:00'. + + self assert: ('2002-05-16T17:20:45.1+01:01' asLXDateAndTime printString = '2002-05-16T17:20:45.1+01:01'). + self assert: (' 2002-05-16T17:20:45.02+01:01' asLXDateAndTime printString = '2002-05-16T17:20:45.02+01:01'). + self assert: ('2002-05-16T17:20:45.000000009+01:01' asLXDateAndTime printString = '2002-05-16T17:20:45.000000009+01:01'). + self assert: ('2002-05-16T17:20:45+00:00' asLXDateAndTime printString = '2002-05-16T17:20:45+00:00' ). + self assert: (' 2002-05-16T17:20:45+01:57' asLXDateAndTime printString = '2002-05-16T17:20:45+01:57'). + self assert: (' 2002-05-16T17:20:45-02:34' asLXDateAndTime printString = '2002-05-16T17:20:45-02:34'). + self assert: ('2002-05-16T17:20:45+00:00' asLXDateAndTime printString = '2002-05-16T17:20:45+00:00'). + self assert: ('1997-04-26T01:02:03+01:02:3' asLXDateAndTime printString = '1997-04-26T01:02:03+01:02:3'). + "When no offset is provided, the local one is used" + dtNoOffset := '2002-05-16T17:20' asLXDateAndTime. + self assert: (('2002-05-16T17:20:00*' match: dtNoOffset printString) and: [dtNoOffset offset = LXDateAndTime localOffset]). + ! Item was added: + ----- Method: LXDateAndTimeTest>>testReadFrom (in category 'Tests') ----- + testReadFrom + self assert: ((LXDateAndTime readFrom: '-1199-01-05T20:33:14.321-05:00' readStream) printString = '-1199-01-05T20:33:14.321-05:00'). + ! Item was added: + ----- Method: LXDateAndTimeTest>>testSmalltalk80Accessors (in category 'Tests') ----- + testSmalltalk80Accessors + | t | + t := LXDateAndTime + year: 1 month: 1 day: 2 + hour: 2 minute: 3 second: 4 nanoSecond: 5 + offset: 6 hours. + self + assert: (t hours = t hours); + assert: (t minutes = t minute); + assert: (t seconds = t second). + ! Item was added: + ----- Method: LXDateAndTimeTest>>testTimeZoneEquivalence (in category 'Tests') ----- + testTimeZoneEquivalence + "LXDateAndTimeTest new testTimeZoneEquivalence" + "When the clock on the wall in Detroit says 9:00am, the clock on the wall + in London says 2:00pm. The Duration difference between the corresponding + DateAndTime values should be zero." + + " Detroit is 5 hours behind UTC, this offset to UTC is therefore written with a minus sign. This example tests both the correct interpretation of the DateAndTime denotation and correct DateAndTime arithmetics. " + | twoPmInLondon nineAmInDetroit durationDifference | + twoPmInLondon := '2004-11-02T14:00:00+00:00' asLXDateAndTime. + nineAmInDetroit := '2004-11-02T09:00:00-05:00' asLXDateAndTime. + durationDifference := twoPmInLondon - nineAmInDetroit. + self assert: durationDifference asSeconds = 0. + self assert: twoPmInLondon = nineAmInDetroit + ! Item was added: + ----- Method: LXDateAndTimeTest>>testTimeZoneEquivalence2 (in category 'Tests') ----- + testTimeZoneEquivalence2 + "LXDateAndTimeTest new testTimeZoneEquivalence2" + "This example demonstates the fact that + 2004-05-24T22:40:00 UTC is + 2004-05-25T01:40:00 in Moscow + (Moscow is 3 hours ahead of UTC) " + | thisMoment thisMomentInMoscow | + thisMoment := LXDateAndTime year: 2004 month: 5 day: 24 hour: 22 minute: 40. + thisMomentInMoscow := thisMoment utcOffset: 3 hours. + self assert: (thisMoment - thisMomentInMoscow) asSeconds = 0. + self assert: thisMoment = thisMomentInMoscow + ! Item was added: + LXDateAndTime subclass: #LXTimeStamp + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Chronology-Core'! + + !LXTimeStamp commentStamp: '<historical>' prior: 0! + This represents a duration of 0 length that marks a particular point in time.! Item was added: + ----- Method: LXTimeStamp class>>current (in category 'squeak protocol') ----- + current + + | ts ticks | + ts := super now asTimeStamp. + ticks := ts ticks. + ticks at: 3 put: 0. + ts ticks: ticks offset: ts offset. + ^ ts + ! Item was added: + ----- Method: LXTimeStamp class>>now (in category 'ansi protocol') ----- + now + "Answer the current date and time as a TimeStamp." + + ^self current! Item was added: + ----- Method: LXTimeStamp>>asDateAndTime (in category 'squeak protocol') ----- + asDateAndTime + "Answer the receiver as an instance of DateAndTime." + + ^ self asLXDateAndTime asDateAndTime! Item was added: + ----- Method: LXTimeStamp>>asLXDateAndTime (in category 'transitional') ----- + asLXDateAndTime + "Answer the receiver as an instance of DateAndTime." + + ^ LXDateAndTime utcMicroseconds: utcMicroseconds offset: self offsetSeconds + ! Item was added: + ----- Method: LXTimeStamp>>asLXTimeStamp (in category 'transitional') ----- + asLXTimeStamp + "Answer the receiver as an instance of TimeStamp." + + ^ self! Item was added: + ----- Method: LXTimeStamp>>asTimeStamp (in category 'squeak protocol') ----- + asTimeStamp + "Answer the receiver as an instance of TimeStamp." + + ^ self asDateAndTime asTimeStamp! Item was added: + ----- Method: LXTimeStamp>>date (in category 'squeak protocol') ----- + date + "Answer the date of the receiver." + + ^ self asDate! Item was added: + ----- Method: LXTimeStamp>>dateAndTime (in category 'squeak protocol') ----- + dateAndTime + "Answer a two element Array containing the receiver's date and time." + + ^ Array with: self date with: self time! Item was added: + ----- Method: LXTimeStamp>>minusDays: (in category 'squeak protocol') ----- + minusDays: anInteger + "Answer a TimeStamp which is anInteger days before the receiver." + + ^ self - (anInteger days)! Item was added: + ----- Method: LXTimeStamp>>minusSeconds: (in category 'squeak protocol') ----- + minusSeconds: anInteger + "Answer a TimeStamp which is anInteger number of seconds before the receiver." + + ^ self - (anInteger seconds)! Item was added: + ----- Method: LXTimeStamp>>plusDays: (in category 'squeak protocol') ----- + plusDays: anInteger + "Answer a TimeStamp which is anInteger days after the receiver." + + ^ self + (anInteger days)! Item was added: + ----- Method: LXTimeStamp>>plusSeconds: (in category 'squeak protocol') ----- + plusSeconds: anInteger + "Answer a TimeStamp which is anInteger number of seconds after the receiver." + + ^ self + (anInteger seconds)! Item was added: + ----- Method: LXTimeStamp>>printOn: (in category 'squeak protocol') ----- + printOn: aStream + "Print receiver's date and time on aStream." + + aStream + nextPutAll: self date printString; + space; + nextPutAll: self time printString.! Item was added: + ----- Method: LXTimeStamp>>storeOn: (in category 'squeak protocol') ----- + storeOn: aStream + + aStream + print: self printString; + nextPutAll: ' asTimeStamp'! Item was added: + ----- Method: LXTimeStamp>>time (in category 'squeak protocol') ----- + time + "Answer the time of the receiver." + + ^ self asTime! Item was added: + Object subclass: #NameOfSubclass + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Chronology-Core'! Item was changed: ----- Method: Time class>>condenseBunches: (in category 'general inquiries') ----- condenseBunches: aCollectionOfSeconds | secArray now out pause prev bunchEnd | "Identify the major intervals in a bunch of numbers. Each number is a seconds since 1901 that represents a date and time. We want the last event in a bunch. Return array of seconds for: Every event in the last half hour. Every bunch separated by 30 min in the last 24 hours. Every bunch separated by two hours before that." "Time condenseBunches: (#(20 400 401 20000 20200 20300 40000 45000 200000 201000 202000) collect: [ :tt | self totalSeconds - tt]) " + secArray := aCollectionOfSeconds asSortedCollection. - secArray := aCollectionOfSeconds sorted. pause := 1. now := self totalSeconds. out := OrderedCollection new. prev := 0. bunchEnd := nil. secArray reverseDo: [:secs | | ago | "descending" ago := now - secs. ago > (60*30) ifTrue: [pause := "60*30" 1800]. ago > (60*60*24) ifTrue: [pause := "60*120" 7200]. ago - prev >= pause ifTrue: [out add: bunchEnd. bunchEnd := secs]. prev := ago]. out add: bunchEnd. out removeFirst. ^ out ! Item was changed: ----- Method: Time class>>localMicrosecondClock (in category 'clock') ----- localMicrosecondClock "Answer the local microseconds since the Smalltalk epoch (January 1st 1901, the start of the 20th century). + The value is derived from the Posix epoch with a constant offset corresponding to elapsed microseconds + between the two epochs according to RFC 868, and with an offset duration corresponding to the current + offset of local time from UTC." + <primitive: 241> + ^0! - The value is derived from the current UTC wallclock time and the image's current notion of time zone." - ^self utcMicrosecondClock + (DateAndTime localOffset asSeconds * 1000000)! Item was removed: - ----- Method: Time class>>localMicrosecondClockPrimitive (in category 'clock') ----- - localMicrosecondClockPrimitive - "Answer the local microseconds since the Smalltalk epoch (January 1st 1901, the start of the 20th century). - The value is derived from the Posix epoch with a constant offset corresponding to elapsed microseconds - between the two epochs according to RFC 868, and with an offset duration corresponding to the current - offset of local time from UTC." - <primitive: 241> - ^0! Item was added: + ----- Method: Time class>>localMicrosecondClockWithOffset (in category 'clock') ----- + localMicrosecondClockWithOffset + "Answer an array with local microseconds since the Smalltalk epoch and the + current seconds offset from GMT in the local time zone." + + | result | + result := self primPosixMicrosecondClockWithOffset. + "DateAndTime unixEpoch asSeconds" + result at: 1 put: result first + ((2177452800 + result second) * 1000000). + ^result! Item was changed: ----- Method: Time class>>millisecondClockValue (in category 'general inquiries') ----- millisecondClockValue "Answer the value of the millisecond clock." + ^self localMicrosecondClock // 1000! - ^self utcMicrosecondClock // 1000! Item was removed: - ----- Method: Time class>>utcMicrosecondClockWithOffset (in category 'clock') ----- - utcMicrosecondClockWithOffset - "Answer an array with UTC microseconds since the Smalltalk epoch and the - current seconds offset from UTC in the local time zone." - | offset utc | - utc := self utcMicrosecondClock. - offset := (self localMicrosecondClockPrimitive - utc) // 1000000. - ^{utc. offset}! Item was changed: ----- Method: Time>>print24:showSeconds:on: (in category 'printing') ----- print24: hr24 showSeconds: showSeconds on: aStream "Format is 'hh:mm:ss' or 'h:mm:ss am' or, if showSeconds is false, 'hh:mm' or 'h:mm am'" + | h m s | + h := self hour. m := self minute. s := self second. + hr24 + ifTrue: + [ h < 10 ifTrue: [ aStream nextPutAll: '0' ]. + h printOn: aStream ] + ifFalse: + [ h > 12 + ifTrue: [h - 12 printOn: aStream] + ifFalse: + [h < 1 + ifTrue: [ 12 printOn: aStream ] + ifFalse: [ h printOn: aStream ]]]. + + aStream nextPutAll: (m < 10 ifTrue: [':0'] ifFalse: [':']). + m printOn: aStream. + + showSeconds ifTrue: + [ aStream nextPutAll: (s < 10 ifTrue: [':0'] ifFalse: [':']). + self nanoSecond = 0 + ifTrue: [s asInteger printOn: aStream] + ifFalse: [s asInteger * NanosInSecond + self nanoSecond asInteger + printOn: aStream asFixedPoint: NanosInSecond]]. + + hr24 ifFalse: + [ aStream nextPutAll: (h < 12 ifTrue: [' am'] ifFalse: [' pm']) ]. + ! - ^self print24: hr24 showSeconds: showSeconds showSubseconds: false on: aStream ! Item was removed: - ----- Method: Time>>print24:showSeconds:showSubseconds:on: (in category 'printing') ----- - print24: hr24 showSeconds: showSeconds showSubseconds: showSubseconds on: aStream - "Format is 'hh:mm:ss' or 'h:mm:ss am' or, if showSeconds is false, 'hh:mm' or 'h:mm am'. - If showSubseconds is true and our nanoSeconds are not zero, a decimal point and subseconds are added" - - | h m s | - h := self hour. m := self minute. s := self second. - hr24 - ifTrue: - [ h < 10 ifTrue: [ aStream nextPutAll: '0' ]. - h printOn: aStream ] - ifFalse: - [ h > 12 - ifTrue: [h - 12 printOn: aStream] - ifFalse: - [h < 1 - ifTrue: [ 12 printOn: aStream ] - ifFalse: [ h printOn: aStream ]]]. - - aStream nextPutAll: (m < 10 ifTrue: [':0'] ifFalse: [':']). - m printOn: aStream. - - showSeconds ifTrue: - [ aStream nextPutAll: (s < 10 ifTrue: [':0'] ifFalse: [':']). - (showSubseconds not or: [self nanoSecond = 0]) - ifTrue: [s asInteger printOn: aStream] - ifFalse: [s asInteger * NanosInSecond + self nanoSecond asInteger - printOn: aStream asFixedPoint: NanosInSecond]]. - - hr24 ifFalse: - [ aStream nextPutAll: (h < 12 ifTrue: [' am'] ifFalse: [' pm']) ]. - ! Item was changed: ----- Method: Time>>printOn: (in category 'printing') ----- printOn: aStream self print24: false showSeconds: (self seconds ~= 0 or: [self nanoSecond ~= 0]) - showSubseconds: self nanoSecond ~= 0 on: aStream! Item was added: + ----- Method: TimeStamp>>asLXTimeStamp (in category 'LX-Kernel-Chronology') ----- + asLXTimeStamp + + ^self asLXDateAndTime asLXTimeStamp! Item was changed: Magnitude subclass: #Timespan instanceVariableNames: 'start duration' classVariableNames: '' poolDictionaries: '' category: 'Chronology-Core'! + !Timespan commentStamp: 'bf 2/18/2016 14:43' prior: 0! + I represent a duration starting on a specific DateAndTime. + + If my start has an offset identical to my #defaultOffset then comparisons ignore timezone offset.! - !Timespan commentStamp: 'cmm 10/17/2018 22:00' prior: 0! - I represent a duration starting on a specific DateAndTime.! Item was changed: ----- Method: Timespan>>= (in category 'ansi protocol') ----- = comparand + ^ self class = comparand class + and: [((self noTimezone or: [ comparand noTimezone ]) + ifTrue: [ self start hasEqualTicks: comparand start ] + ifFalse: [ self start = comparand start ]) + and: [ self duration = comparand duration ] ] - ^ self class = comparand class - and: [(((self noTimezone and: [comparand noTimezone]) or: [self start offset = comparand start offset]) - ifTrue: [ self start hasEqualTicks: comparand start ] - ifFalse: [ self start = comparand start ]) - and: [ self duration = comparand duration ] ] .! Item was added: + ----- Method: Timespan>>asLXDateAndTime (in category 'LX-Kernel-Chronology') ----- + asLXDateAndTime + + ^ start asLXDateAndTime! Item was removed: - ----- Method: Timespan>>beCanonical (in category 'squeak protocol') ----- - beCanonical - "Make the receiver a canonical Date (or Month or Year) instead of a timespan of my duration starting at a specific local time. Canonical are the most common use of Dates in applications." - self stripTimezone! Item was removed: - ----- Method: Timespan>>stripTimezone (in category 'squeak protocol') ----- - stripTimezone - "Chronology preserves Timespans that are extracted from DateAndTime's, making Dates, Months and Years in Squeak able to represent a true Timespan of those durations starting at a specific local DateAndTime. In case a canonical version is needed, make the receiver independent of any Timezone by removing it." - start primOffset: self class defaultOffset! Item was added: + (PackageInfo named: 'Chronology-Core') postscript: '"Ensure that the object history mark process uses DateAndTime>>floor rather than an earlier implementation that relied on a named instance variable." + + Smalltalk at: #ObjectHistory ifPresent: [ :cls | cls current restartMarkProcess ]. + '!

1 0

The Trunk: Tests-pre.404.mcz
by commits＠source.squeak.org 29 Dec '18

29 Dec '18

Patrick Rein uploaded a new version of Tests to project The Trunk: http://source.squeak.org/trunk/Tests-pre.404.mcz ==================== Summary ==================== Name: Tests-pre.404 Author: pre Time: 7 December 2018, 1:27:40.307037 pm UUID: d2787b99-db2d-4f7a-b4ed-4735c24b6eca Ancestors: Tests-dtl.403 Categorizes unclassified methods in the Tests package, also recategorizes some test methods from testing to tests but not all (another door of the message categories advent calendar) =============== Diff against Tests-dtl.403 =============== Item was changed: + ----- Method: AbstractObjectsAsMethod>>flushCache (in category 'cleaning') ----- - ----- Method: AbstractObjectsAsMethod>>flushCache (in category 'as yet unclassified') ----- flushCache! Item was changed: + ----- Method: AbstractObjectsAsMethod>>methodClass: (in category 'accessing') ----- - ----- Method: AbstractObjectsAsMethod>>methodClass: (in category 'as yet unclassified') ----- methodClass: aMethodClass! Item was changed: + ----- Method: AbstractObjectsAsMethod>>selector: (in category 'accessing') ----- - ----- Method: AbstractObjectsAsMethod>>selector: (in category 'as yet unclassified') ----- selector: aSymbol! Item was changed: + ----- Method: BitBltClipBugs>>testDrawingWayOutside (in category 'tests') ----- - ----- Method: BitBltClipBugs>>testDrawingWayOutside (in category 'as yet unclassified') ----- testDrawingWayOutside | f1 bb f2 | f1 := Form extent: 100@100 depth: 1. f2 := Form extent: 100@100 depth: 1. bb := BitBlt toForm: f1. bb combinationRule: 3. bb sourceForm: f2. bb destOrigin: SmallInteger maxVal squared asPoint. bb width: 100; height: 100. "This should not throw an exception:" bb copyBits. ! Item was changed: + ----- Method: BitBltClipBugs>>testDrawingWayOutside2 (in category 'tests') ----- - ----- Method: BitBltClipBugs>>testDrawingWayOutside2 (in category 'as yet unclassified') ----- testDrawingWayOutside2 | f1 bb f2 | f1 := Form extent: 100@100 depth: 1. f2 := Form extent: 100@100 depth: 1. bb := BitBlt toForm: f1. bb combinationRule: 3. bb sourceForm: f2. bb destOrigin: 0@0. bb width: SmallInteger maxVal squared; height: SmallInteger maxVal squared. "This should not throw an exception:" bb copyBits.! Item was changed: + ----- Method: BitBltClipBugs>>testDrawingWayOutside3 (in category 'tests') ----- - ----- Method: BitBltClipBugs>>testDrawingWayOutside3 (in category 'as yet unclassified') ----- testDrawingWayOutside3 | f1 bb f2 | f1 := Form extent: 100@100 depth: 1. f2 := Form extent: 100@100 depth: 1. bb := BitBlt toForm: f1. bb combinationRule: 3. bb sourceForm: f2. bb destOrigin: SmallInteger maxVal squared asPoint. bb width: SmallInteger maxVal squared; height: SmallInteger maxVal squared. "This should not throw an exception:" bb copyBits. ! Item was changed: + ----- Method: BitBltClipBugs>>testDrawingWayOutside4 (in category 'tests') ----- - ----- Method: BitBltClipBugs>>testDrawingWayOutside4 (in category 'as yet unclassified') ----- testDrawingWayOutside4 | f1 bb f2 | f1 := Form extent: 100@100 depth: 1. f2 := Form extent: 100@100 depth: 1. bb := BitBlt toForm: f1. bb combinationRule: 3. bb sourceForm: f2. bb destOrigin: SmallInteger maxVal squared asPoint. bb width: 100; height: 100. bb sourceOrigin: SmallInteger maxVal squared asPoint. "This should not throw an exception:" bb copyBits. ! Item was changed: + ----- Method: BitBltClipBugs>>testDrawingWayOutside5 (in category 'tests') ----- - ----- Method: BitBltClipBugs>>testDrawingWayOutside5 (in category 'as yet unclassified') ----- testDrawingWayOutside5 | f1 bb f2 | f1 := Form extent: 100@100 depth: 1. f2 := Form extent: 100@100 depth: 1. bb := BitBlt toForm: f1. bb combinationRule: 3. bb sourceForm: f2. bb destOrigin: 0@0. bb width: SmallInteger maxVal squared; height: SmallInteger maxVal squared. bb sourceOrigin: SmallInteger maxVal squared asPoint. "This should not throw an exception:" bb copyBits.! Item was changed: + ----- Method: BitBltClipBugs>>testDrawingWayOutside6 (in category 'tests') ----- - ----- Method: BitBltClipBugs>>testDrawingWayOutside6 (in category 'as yet unclassified') ----- testDrawingWayOutside6 | f1 bb f2 | f1 := Form extent: 100@100 depth: 1. f2 := Form extent: 100@100 depth: 1. bb := BitBlt toForm: f1. bb combinationRule: 3. bb sourceForm: f2. bb destOrigin: SmallInteger maxVal squared asPoint. bb width: SmallInteger maxVal squared; height: SmallInteger maxVal squared. bb sourceOrigin: SmallInteger maxVal squared asPoint. "This should not throw an exception:" bb copyBits. ! Item was changed: + ----- Method: BitBltClipBugs>>testFillingWayOutside (in category 'tests') ----- - ----- Method: BitBltClipBugs>>testFillingWayOutside (in category 'as yet unclassified') ----- testFillingWayOutside | f1 bb | f1 := Form extent: 100@100 depth: 1. bb := BitBlt toForm: f1. bb combinationRule: 3. bb fillColor: Color black. bb destOrigin: SmallInteger maxVal squared asPoint. bb width: 100; height: 100. "This should not throw an exception:" bb copyBits. ! Item was changed: + ----- Method: BitBltClipBugs>>testFillingWayOutside2 (in category 'tests') ----- - ----- Method: BitBltClipBugs>>testFillingWayOutside2 (in category 'as yet unclassified') ----- testFillingWayOutside2 | f1 bb | f1 := Form extent: 100@100 depth: 1. bb := BitBlt toForm: f1. bb combinationRule: 3. bb fillColor: Color black. bb destOrigin: 0@0. bb width: SmallInteger maxVal squared; height: SmallInteger maxVal squared. "This should not throw an exception:" bb copyBits.! Item was changed: + ----- Method: BitBltClipBugs>>testFillingWayOutside3 (in category 'tests') ----- - ----- Method: BitBltClipBugs>>testFillingWayOutside3 (in category 'as yet unclassified') ----- testFillingWayOutside3 | f1 bb | f1 := Form extent: 100@100 depth: 1. bb := BitBlt toForm: f1. bb combinationRule: 3. bb fillColor: Color black. bb destOrigin: SmallInteger maxVal squared asPoint. bb width: SmallInteger maxVal squared; height: SmallInteger maxVal squared. "This should not throw an exception:" bb copyBits. ! Item was changed: + ----- Method: BitmapStreamTests class>>testSelectors (in category 'accessing') ----- - ----- Method: BitmapStreamTests class>>testSelectors (in category 'Accessing') ----- testSelectors "The ImageSegment-based Bitmap Test is known to not work on SPUR VMs with the prospect of crashing. #expectedFailure does not cut it here, don't even try to run them" ^ super testSelectors copyWithout: #testMatrixTransform2x3WithImageSegment! Item was changed: + ----- Method: BitmapStreamTests>>setUp (in category 'running') ----- - ----- Method: BitmapStreamTests>>setUp (in category 'Running') ----- setUp random := Random new.! Item was changed: + ----- Method: ChangeSetClassChangesTest>>testAddInstanceVariable (in category 'tests') ----- - ----- Method: ChangeSetClassChangesTest>>testAddInstanceVariable (in category 'testing') ----- testAddInstanceVariable "Adding an instance variable to the class should result in a change record being added to the current change set." | saveClassDefinition | "Define a class and save its definition" Object subclass: #JunkClass instanceVariableNames: 'zzz' classVariableNames: '' poolDictionaries: '' category: 'DeleteMe-1'. saveClassDefinition := (Smalltalk classNamed: #JunkClass) definition. self assert: (self isDefinition: saveClassDefinition equivalentTo: (ChangeSet current fatDefForClass: (Smalltalk classNamed: #JunkClass))). "Redefine the class, adding one instance variable" Object subclass: #JunkClass instanceVariableNames: 'zzz aaa' classVariableNames: '' poolDictionaries: '' category: 'DeleteMe-1'. "Assert that the class definition has changed" self deny: (self isDefinition: (Smalltalk classNamed: #JunkClass) definition equivalentTo: saveClassDefinition). self deny: (self isDefinition: saveClassDefinition equivalentTo: (ChangeSet current fatDefForClass: (Smalltalk classNamed: #JunkClass))). self assert: (self isDefinition: (Smalltalk classNamed: #JunkClass) definition equivalentTo: (ChangeSet current fatDefForClass: (Smalltalk classNamed: #JunkClass))). "Assert that the change has been recorded in the current change set" self assert: (self isDefinition: (ChangeSet current changeRecorderFor: (Smalltalk classNamed: #JunkClass)) priorDefinition equivalentTo: saveClassDefinition). ! Item was changed: + ----- Method: ChangeSetClassChangesTest>>testAddInstanceVariableAddsNewChangeRecord (in category 'tests') ----- - ----- Method: ChangeSetClassChangesTest>>testAddInstanceVariableAddsNewChangeRecord (in category 'testing') ----- testAddInstanceVariableAddsNewChangeRecord "Changing the class category for a class should result in a change record being updated in the current change set." "At the start of this test, JunkClass should not exist, and there should be no change records pertaining to it in the change set." self deny: (Smalltalk hasClassNamed: 'JunkClass'). self assert: (ChangeSet current changeRecorderFor: (Smalltalk classNamed: #JunkClass)) thisName = 'nil'. "Remove bogus change records created as side effect of preceding assert" ChangeSet current removeClassChanges: 'nil'. "Define a class and save its definition" Object subclass: #JunkClass instanceVariableNames: 'zzz' classVariableNames: '' poolDictionaries: '' category: 'DeleteMe-1'. "Forget about JunkClass in the change set" ChangeSet current removeClassChanges: 'JunkClass'. "Redefine the class, adding one instance variable" Object subclass: #JunkClass instanceVariableNames: 'zzz aaa' classVariableNames: '' poolDictionaries: '' category: 'DeleteMe-1'. "A change record should now exist in the change set" self assert: (self isDefinition: (ChangeSet current changeRecorderFor: (Smalltalk classNamed: #JunkClass)) priorDefinition equivalentTo: 'Object subclass: #JunkClass instanceVariableNames: ''zzz '' classVariableNames: '''' poolDictionaries: '''' category: ''DeleteMe-1''') ! Item was changed: + ----- Method: ChangeSetClassChangesTest>>testChangeClassCategory (in category 'tests') ----- - ----- Method: ChangeSetClassChangesTest>>testChangeClassCategory (in category 'testing') ----- testChangeClassCategory "Changing the class category for a class should result in a change record being added to the current change set." | saveClassDefinition | "Define a class and save its definition" Object subclass: #JunkClass instanceVariableNames: 'zzz' classVariableNames: '' poolDictionaries: '' category: 'DeleteMe-1'. saveClassDefinition := (Smalltalk classNamed: #JunkClass) definition. self assert: saveClassDefinition = (ChangeSet current fatDefForClass: (Smalltalk classNamed: #JunkClass)). "Redefine the class, changing only the class category" Object subclass: #JunkClass instanceVariableNames: 'zzz' classVariableNames: '' poolDictionaries: '' category: 'DeleteMe-2'. "Assert that the class definition has changed" self deny: (self isDefinition: (Smalltalk classNamed: #JunkClass) definition equivalentTo: saveClassDefinition). self deny: (self isDefinition: saveClassDefinition equivalentTo: (ChangeSet current fatDefForClass: (Smalltalk classNamed: #JunkClass))). self assert: (self isDefinition: (Smalltalk classNamed: #JunkClass) definition equivalentTo: (ChangeSet current fatDefForClass: (Smalltalk classNamed: #JunkClass))). "Assert that the change has been recorded in the current change set" self assert: (self isDefinition: (ChangeSet current changeRecorderFor: (Smalltalk classNamed: #JunkClass)) priorDefinition equivalentTo: 'Object subclass: #JunkClass instanceVariableNames: ''zzz '' classVariableNames: '''' poolDictionaries: '''' category: ''DeleteMe-2''')! Item was changed: + ----- Method: ChangeSetClassChangesTest>>testChangeClassCategoryAddsNewChangeRecord (in category 'tests') ----- - ----- Method: ChangeSetClassChangesTest>>testChangeClassCategoryAddsNewChangeRecord (in category 'testing') ----- testChangeClassCategoryAddsNewChangeRecord "Changing the class category for a class should result in a change record being updated in the current change set." "At the start of this test, JunkClass should not exist, and there should be no change records pertaining to it in the change set." self deny: (Smalltalk hasClassNamed: 'JunkClass'). self assert: (ChangeSet current changeRecorderFor: (Smalltalk classNamed: #JunkClass)) thisName = 'nil'. "Remove bogus change records created as side effect of preceding assert" ChangeSet current removeClassChanges: 'nil'. "Define a class and save its definition" Object subclass: #JunkClass instanceVariableNames: 'zzz' classVariableNames: '' poolDictionaries: '' category: 'DeleteMe-1'. "Forget about JunkClass in the change set" ChangeSet current removeClassChanges: 'JunkClass'. "Redefine the class, changing only the class category" Object subclass: #JunkClass instanceVariableNames: 'zzz' classVariableNames: '' poolDictionaries: '' category: 'DeleteMe-2'. "A change record should now exist in the change set" self assert: (self isDefinition: (ChangeSet current changeRecorderFor: (Smalltalk classNamed: #JunkClass)) priorDefinition equivalentTo: 'Object subclass: #JunkClass instanceVariableNames: ''zzz '' classVariableNames: '''' poolDictionaries: '''' category: ''DeleteMe-2''')! Item was changed: + ----- Method: ChangeSetClassChangesTest>>testInitialChangeSet (in category 'tests') ----- - ----- Method: ChangeSetClassChangesTest>>testInitialChangeSet (in category 'testing') ----- testInitialChangeSet "Run this to assure the initial changeset is named. Checks bug found in 3.9 7052." "self new testInitialChangeSet" "self run: #testInitialChangeSet" self deny: (ChangeSet current printString = 'a ChangeSet named <no name -- garbage?>') . ^true! Item was changed: + ----- Method: ClassBindingTest>>setUp (in category 'running') ----- - ----- Method: ClassBindingTest>>setUp (in category 'as yet unclassified') ----- setUp key := Object new. value := Object new.! Item was changed: + ----- Method: ClassBindingTest>>testArrowBinding (in category 'tests') ----- - ----- Method: ClassBindingTest>>testArrowBinding (in category 'as yet unclassified') ----- testArrowBinding | binding | binding := #Griffle => self class. self assert: binding class = ClassBinding. self assert: binding key = #Griffle. self assert: binding value = self class. ! Item was changed: + ----- Method: ClassBindingTest>>testAsBindingAlias (in category 'tests') ----- - ----- Method: ClassBindingTest>>testAsBindingAlias (in category 'as yet unclassified') ----- testAsBindingAlias | binding imported | binding := ClassBinding key: #Griffle value: value. imported := binding asBinding: #Plonk. self assert: imported class == Alias! Item was changed: + ----- Method: ClassBindingTest>>testAsBindingOriginal (in category 'tests') ----- - ----- Method: ClassBindingTest>>testAsBindingOriginal (in category 'as yet unclassified') ----- testAsBindingOriginal | binding imported | binding := ClassBinding key: #Griffle value: value. imported := binding asBinding: #Griffle. self assert: binding == imported! Item was changed: + ----- Method: ClassBindingTest>>testAsBindingRead (in category 'tests') ----- - ----- Method: ClassBindingTest>>testAsBindingRead (in category 'as yet unclassified') ----- testAsBindingRead | binding imported | binding := ClassBinding key: #Griffle value: value. imported := binding asBinding: #Plonk. self assert: imported key = #Plonk. self assert: imported value == value.! Item was changed: + ----- Method: ClassBindingTest>>testAsBindingWrite (in category 'tests') ----- - ----- Method: ClassBindingTest>>testAsBindingWrite (in category 'as yet unclassified') ----- testAsBindingWrite | binding imported | binding := ClassBinding key: #Griffle value: value. imported := binding asBinding: #Plonk. self should: [imported value: Object new] raise: AttemptToWriteReadOnlyGlobal ! Item was changed: + ----- Method: ClassBindingTest>>testCanAssign (in category 'tests') ----- - ----- Method: ClassBindingTest>>testCanAssign (in category 'as yet unclassified') ----- testCanAssign | binding | binding := ClassBinding key: key value: value. self deny: binding canAssign! Item was changed: + ----- Method: ClassBindingTest>>testIsSpecialRead (in category 'tests') ----- - ----- Method: ClassBindingTest>>testIsSpecialRead (in category 'as yet unclassified') ----- testIsSpecialRead | binding | binding := ClassBinding key: key value: value. self deny: binding isSpecialReadBinding! Item was changed: + ----- Method: ClassBindingTest>>testIsSpecialWrite (in category 'tests') ----- - ----- Method: ClassBindingTest>>testIsSpecialWrite (in category 'as yet unclassified') ----- testIsSpecialWrite | binding | binding := ClassBinding key: key value: value. self assert: binding isSpecialWriteBinding! Item was changed: + ----- Method: ClassBindingTest>>testLiteralEqual (in category 'tests') ----- - ----- Method: ClassBindingTest>>testLiteralEqual (in category 'as yet unclassified') ----- testLiteralEqual | b1 b2 | b1 := #Griffle => self class. b2 := #Plonk => self class. self assert: (b1 literalEqual: b2)! Item was changed: + ----- Method: ClassBindingTest>>testLiteralUnequal (in category 'tests') ----- - ----- Method: ClassBindingTest>>testLiteralUnequal (in category 'as yet unclassified') ----- testLiteralUnequal | b1 b2 | b1 := #Griffle => self class. b2 := #Griffle => self class superclass. self deny: (b1 literalEqual: b2)! Item was changed: + ----- Method: ClassBindingTest>>testRead (in category 'tests') ----- - ----- Method: ClassBindingTest>>testRead (in category 'as yet unclassified') ----- testRead | binding | binding := ClassBinding key: key value: value. self assert: binding key == key. self assert: binding value == value! Item was changed: + ----- Method: ClassBindingTest>>testResumeExceptionToWrite (in category 'tests') ----- - ----- Method: ClassBindingTest>>testResumeExceptionToWrite (in category 'as yet unclassified') ----- testResumeExceptionToWrite | binding | binding := ClassBinding key: key value: Object new. [binding value: value] on: AttemptToWriteReadOnlyGlobal do: [:ex | ex resume: true]. self assert: binding value == value! Item was changed: + ----- Method: ClassBindingTest>>testSource (in category 'tests') ----- - ----- Method: ClassBindingTest>>testSource (in category 'as yet unclassified') ----- testSource | binding | binding := ClassBinding key: #Griffle value: value. self assert: binding source == binding! Item was changed: + ----- Method: ClassBindingTest>>testWriteRaisesException (in category 'tests') ----- - ----- Method: ClassBindingTest>>testWriteRaisesException (in category 'as yet unclassified') ----- testWriteRaisesException | binding | binding := ClassBinding key: key value: value. self should: [binding value: Object new] raise: AttemptToWriteReadOnlyGlobal.! Item was changed: + ----- Method: ClassRenameFixTest>>newUniqueClassName (in category 'private') ----- - ----- Method: ClassRenameFixTest>>newUniqueClassName (in category 'Private') ----- newUniqueClassName "Return a class name that is not used in the system." "self new newClassName" | baseName newName | baseName := 'AutoGeneratedClassForTestingSystemChanges'. 1 to: 9999 do: [:number | newName := baseName , number printString. (Smalltalk hasClassNamed: newName) ifFalse: [^newName asSymbol]]. ^self error: 'Can no longer find a new and unique class name for the SystemChangeTest !!'! Item was changed: + ----- Method: ClassRenameFixTest>>removeEverythingInSetFromSystem: (in category 'private') ----- - ----- Method: ClassRenameFixTest>>removeEverythingInSetFromSystem: (in category 'Private') ----- removeEverythingInSetFromSystem: aChangeSet aChangeSet changedMessageList do: [:methodRef | methodRef actualClass removeSelector: methodRef methodSymbol]. aChangeSet changedClasses do: [:each | each isMeta ifFalse: [each removeFromSystemUnlogged]]! Item was changed: + ----- Method: ClassRenameFixTest>>renameClassUsing: (in category 'tests') ----- - ----- Method: ClassRenameFixTest>>renameClassUsing: (in category 'Tests') ----- renameClassUsing: aBlock | createdClass foundClasses | originalName := self newUniqueClassName. createdClass := Object subclass: originalName instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ClassRenameFix-GeneradClass'. newClassName := self newUniqueClassName. aBlock value: createdClass value: newClassName. self assert: (Smalltalk classNamed: originalName) isNil. self assert: (Smalltalk classNamed: newClassName) notNil. foundClasses := Smalltalk organization listAtCategoryNamed: 'ClassRenameFix-GeneradClass'. self assert: (foundClasses notEmpty). self assert: (foundClasses includes: newClassName). self assert: (createdClass name = newClassName).! Item was changed: + ----- Method: ClassRenameFixTest>>setUp (in category 'running') ----- - ----- Method: ClassRenameFixTest>>setUp (in category 'Running') ----- setUp previousChangeSet := ChangeSet current. testsChangeSet := ChangeSet new. ChangeSet newChanges: testsChangeSet. SystemChangeNotifier uniqueInstance notify: self ofSystemChangesOfItem: #class change: #Renamed using: #verifyRenameEvent:. super setUp! Item was changed: + ----- Method: ClassRenameFixTest>>tearDown (in category 'running') ----- - ----- Method: ClassRenameFixTest>>tearDown (in category 'Running') ----- tearDown self removeEverythingInSetFromSystem: testsChangeSet. ChangeSet newChanges: previousChangeSet. ChangesOrganizer removeChangeSet: testsChangeSet. previousChangeSet := nil. testsChangeSet := nil. SystemChangeNotifier uniqueInstance noMoreNotificationsFor: self. super tearDown.! Item was changed: + ----- Method: ClassRenameFixTest>>testRenameClassUsingClass (in category 'tests') ----- - ----- Method: ClassRenameFixTest>>testRenameClassUsingClass (in category 'Tests') ----- testRenameClassUsingClass "self run: #testRenameClassUsingClass" self renameClassUsing: [:class :newName | class rename: newName].! Item was changed: + ----- Method: ClassRenameFixTest>>verifyRenameEvent: (in category 'private') ----- - ----- Method: ClassRenameFixTest>>verifyRenameEvent: (in category 'Running') ----- verifyRenameEvent: aRenamedEvent | renamedClass | self assert: aRenamedEvent isRenamed. renamedClass := aRenamedEvent item. self assert: (Smalltalk classNamed: newClassName) name = newClassName. self assert: renamedClass name = newClassName! Item was changed: + ----- Method: ClipboardTest>>setUp (in category 'running') ----- - ----- Method: ClipboardTest>>setUp (in category 'as yet unclassified') ----- setUp "Store the contents of the default clipboard. This is necessary, because all Clipboard instances modify the contents of the system clipboard." originalClipboardText := Clipboard default clipboardText! Item was changed: + ----- Method: ClipboardTest>>tearDown (in category 'running') ----- - ----- Method: ClipboardTest>>tearDown (in category 'as yet unclassified') ----- tearDown "Restore the contents of the default clipboard. This is necessary, because all Clipboard instances modify the contents of the system clipboard." Clipboard default clipboardText: originalClipboardText! Item was changed: + ----- Method: ClipboardTest>>testClipboardText (in category 'tests') ----- - ----- Method: ClipboardTest>>testClipboardText (in category 'as yet unclassified') ----- testClipboardText | uuidString clipboard | uuidString := UUID new asString36. clipboard := Clipboard new. clipboard clipboardText: uuidString. self assert: uuidString equals: clipboard clipboardText asString! Item was changed: + ----- Method: ClipboardTest>>testClipboardTextNotifyWith (in category 'tests') ----- - ----- Method: ClipboardTest>>testClipboardTextNotifyWith (in category 'as yet unclassified') ----- testClipboardTextNotifyWith | uuidString clipboard subscriber notifiedText notifiedSource | uuidString := UUID new asString36. clipboard := Clipboard new. subscriber := [ :text :source | notifiedText := text. notifiedSource := source ]. clipboard when: #contentChanged send: #value:value: to: subscriber. clipboard clipboardText: uuidString. self assert: uuidString equals: notifiedText; assert: nil equals: notifiedSource. clipboard clipboardText: uuidString reversed notifyWith: self. self assert: uuidString reversed equals: notifiedText; assert: self == notifiedSource. clipboard removeActionsWithReceiver: subscriber. clipboard clipboardText: uuidString. self assert: uuidString reversed equals: notifiedText; assert: self == notifiedSource! Item was changed: + ----- Method: EqualityTester>>resultFor: (in category 'running') ----- - ----- Method: EqualityTester>>resultFor: (in category 'as yet unclassified') ----- resultFor: runs "Test that equality is the same over runs and answer the result" 1 to: runs do: [:i | self prototype = self prototype ifFalse: [^ false]]. ^ true! Item was changed: + ----- Method: EventManagerTest>>testBlockReceiverNoArgs (in category 'tests-dependent action') ----- - ----- Method: EventManagerTest>>testBlockReceiverNoArgs (in category 'running-dependent action') ----- testBlockReceiverNoArgs eventSource when: #anEvent evaluate:[self heardEvent]. eventSource triggerEvent: #anEvent. self should: [succeeded]! Item was changed: + ----- Method: EventManagerTest>>testBlockReceiverOneArg (in category 'tests-dependent action') ----- - ----- Method: EventManagerTest>>testBlockReceiverOneArg (in category 'running-dependent action') ----- testBlockReceiverOneArg eventSource when: #anEvent: evaluate:[:arg1| eventListener add: arg1]. eventSource triggerEvent: #anEvent: with: 9. self should: [eventListener includes: 9]! Item was changed: + ----- Method: EventManagerTest>>testBlockReceiverTwoArgs (in category 'tests-dependent action') ----- - ----- Method: EventManagerTest>>testBlockReceiverTwoArgs (in category 'running-dependent action') ----- testBlockReceiverTwoArgs eventSource when: #anEvent:info: evaluate:[:arg1 :arg2| self addArg1: arg1 addArg2: arg2]. eventSource triggerEvent: #anEvent:info: withArguments: #( 9 42 ). self should: [(eventListener includes: 9) and: [eventListener includes: 42]]! Item was changed: + ----- Method: EventManagerTest>>testCopy (in category 'tests-copying') ----- - ----- Method: EventManagerTest>>testCopy (in category 'running-copying') ----- testCopy "Ensure that the actionMap is zapped when you make a copy of anEventManager" eventSource when: #blah send: #yourself to: eventListener. self assert: eventSource actionMap keys isEmpty not. self assert: eventSource copy actionMap keys isEmpty! Item was changed: + ----- Method: EventManagerTest>>testMultipleValueSuppliers (in category 'tests-broadcast query') ----- - ----- Method: EventManagerTest>>testMultipleValueSuppliers (in category 'running-broadcast query') ----- testMultipleValueSuppliers eventSource when: #needsValue send: #getFalse to: self. eventSource when: #needsValue send: #getTrue to: self. succeeded := eventSource triggerEvent: #needsValue. self should: [succeeded]! Item was changed: + ----- Method: EventManagerTest>>testMultipleValueSuppliersEventHasArguments (in category 'tests-broadcast query') ----- - ----- Method: EventManagerTest>>testMultipleValueSuppliersEventHasArguments (in category 'running-broadcast query') ----- testMultipleValueSuppliersEventHasArguments eventSource when: #needsValue: send: #getFalse: to: self. eventSource when: #needsValue: send: #getTrue: to: self. succeeded := eventSource triggerEvent: #needsValue: with: 'kolme'. self should: [succeeded]! Item was changed: + ----- Method: EventManagerTest>>testNoArgumentEvent (in category 'tests-dependent action') ----- - ----- Method: EventManagerTest>>testNoArgumentEvent (in category 'running-dependent action') ----- testNoArgumentEvent eventSource when: #anEvent send: #heardEvent to: self. eventSource triggerEvent: #anEvent. self should: [succeeded]! Item was changed: + ----- Method: EventManagerTest>>testNoArgumentEventDependentSuppliedArgument (in category 'tests-dependent action supplied arguments') ----- - ----- Method: EventManagerTest>>testNoArgumentEventDependentSuppliedArgument (in category 'running-dependent action supplied arguments') ----- testNoArgumentEventDependentSuppliedArgument eventSource when: #anEvent send: #add: to: eventListener with: 'boundValue'. eventSource triggerEvent: #anEvent. self should: [eventListener includes: 'boundValue']! Item was changed: + ----- Method: EventManagerTest>>testNoArgumentEventDependentSuppliedArguments (in category 'tests-dependent action supplied arguments') ----- - ----- Method: EventManagerTest>>testNoArgumentEventDependentSuppliedArguments (in category 'running-dependent action supplied arguments') ----- testNoArgumentEventDependentSuppliedArguments eventSource when: #anEvent send: #addArg1:addArg2: to: self withArguments: #('hello' 'world'). eventSource triggerEvent: #anEvent. self should: [(eventListener includes: 'hello') and: [eventListener includes: 'world']]! Item was changed: + ----- Method: EventManagerTest>>testNoValueSupplier (in category 'tests-broadcast query') ----- - ----- Method: EventManagerTest>>testNoValueSupplier (in category 'running-broadcast query') ----- testNoValueSupplier succeeded := eventSource triggerEvent: #needsValue ifNotHandled: [true]. self should: [succeeded]! Item was changed: + ----- Method: EventManagerTest>>testNoValueSupplierHasArguments (in category 'tests-broadcast query') ----- - ----- Method: EventManagerTest>>testNoValueSupplierHasArguments (in category 'running-broadcast query') ----- testNoValueSupplierHasArguments succeeded := eventSource triggerEvent: #needsValue: with: 'nelja' ifNotHandled: [true]. self should: [succeeded]! Item was changed: + ----- Method: EventManagerTest>>testOneArgumentEvent (in category 'tests-dependent action') ----- - ----- Method: EventManagerTest>>testOneArgumentEvent (in category 'running-dependent action') ----- testOneArgumentEvent eventSource when: #anEvent: send: #add: to: eventListener. eventSource triggerEvent: #anEvent: with: 9. self should: [eventListener includes: 9]! Item was changed: + ----- Method: EventManagerTest>>testRemoveActionsForEvent (in category 'tests-remove actions') ----- - ----- Method: EventManagerTest>>testRemoveActionsForEvent (in category 'running-remove actions') ----- testRemoveActionsForEvent eventSource when: #anEvent send: #size to: eventListener; when: #anEvent send: #getTrue to: self; when: #anEvent: send: #fizzbin to: self. eventSource removeActionsForEvent: #anEvent. self shouldnt: [eventSource hasActionForEvent: #anEvent]! Item was changed: + ----- Method: EventManagerTest>>testRemoveActionsTwiceForEvent (in category 'tests-remove actions') ----- - ----- Method: EventManagerTest>>testRemoveActionsTwiceForEvent (in category 'running-remove actions') ----- testRemoveActionsTwiceForEvent eventSource when: #anEvent send: #size to: eventListener; when: #anEvent send: #getTrue to: self; when: #anEvent: send: #fizzbin to: self. eventSource removeActionsForEvent: #anEvent. self assert: (eventSource hasActionForEvent: #anEvent) not. eventSource removeActionsForEvent: #anEvent. self assert: (eventSource hasActionForEvent: #anEvent) not.! Item was changed: + ----- Method: EventManagerTest>>testRemoveActionsWithReceiver (in category 'tests-remove actions') ----- - ----- Method: EventManagerTest>>testRemoveActionsWithReceiver (in category 'running-remove actions') ----- testRemoveActionsWithReceiver | action | eventSource when: #anEvent send: #size to: eventListener; when: #anEvent send: #getTrue to: self; when: #anEvent: send: #fizzbin to: self. eventSource removeActionsWithReceiver: self. action := eventSource actionForEvent: #anEvent. self assert: (action respondsTo: #receiver). self assert: ((action receiver == self) not)! Item was changed: + ----- Method: EventManagerTest>>testReturnValueWithManyListeners (in category 'tests-dependent value') ----- - ----- Method: EventManagerTest>>testReturnValueWithManyListeners (in category 'running-dependent value') ----- testReturnValueWithManyListeners | value newListener | newListener := 'busybody'. eventSource when: #needsValue send: #yourself to: eventListener. eventSource when: #needsValue send: #yourself to: newListener. value := eventSource triggerEvent: #needsValue. self should: [value == newListener]! Item was changed: + ----- Method: EventManagerTest>>testReturnValueWithNoListeners (in category 'tests-dependent value') ----- - ----- Method: EventManagerTest>>testReturnValueWithNoListeners (in category 'running-dependent value') ----- testReturnValueWithNoListeners | value | value := eventSource triggerEvent: #needsValue. self should: [value == nil]! Item was changed: + ----- Method: EventManagerTest>>testReturnValueWithOneListener (in category 'tests-dependent value') ----- - ----- Method: EventManagerTest>>testReturnValueWithOneListener (in category 'running-dependent value') ----- testReturnValueWithOneListener | value | eventSource when: #needsValue send: #yourself to: eventListener. value := eventSource triggerEvent: #needsValue. self should: [value == eventListener]! Item was changed: + ----- Method: EventManagerTest>>testSingleValueSupplier (in category 'tests-broadcast query') ----- - ----- Method: EventManagerTest>>testSingleValueSupplier (in category 'running-broadcast query') ----- testSingleValueSupplier eventSource when: #needsValue send: #getTrue to: self. succeeded := eventSource triggerEvent: #needsValue. self should: [succeeded]! Item was changed: + ----- Method: EventManagerTest>>testTwoArgumentEvent (in category 'tests-dependent action') ----- - ----- Method: EventManagerTest>>testTwoArgumentEvent (in category 'running-dependent action') ----- testTwoArgumentEvent eventSource when: #anEvent:info: send: #addArg1:addArg2: to: self. eventSource triggerEvent: #anEvent:info: withArguments: #( 9 42 ). self should: [(eventListener includes: 9) and: [eventListener includes: 42]]! Item was changed: + ----- Method: FakeObjectOut>>doesNotUnderstand: (in category 'error handling') ----- - ----- Method: FakeObjectOut>>doesNotUnderstand: (in category 'as yet unclassified') ----- doesNotUnderstand: aMessage ^ aMessage sendTo: self class ! Item was changed: + ----- Method: FakeObjectOut>>isInMemory (in category 'testing') ----- - ----- Method: FakeObjectOut>>isInMemory (in category 'as yet unclassified') ----- isInMemory ^ false.! Item was changed: + ----- Method: HandBugs>>testTargetPoint (in category 'tests') ----- - ----- Method: HandBugs>>testTargetPoint (in category 'as yet unclassified') ----- testTargetPoint "self new testTargetPoint" "self run: #testTargetPoint" "This should not throw an exception." ActiveHand targetPoint ! Item was changed: + ----- Method: HashAndEqualsTestCase>>setUp (in category 'running') ----- - ----- Method: HashAndEqualsTestCase>>setUp (in category 'as yet unclassified') ----- setUp "subclasses will add their prototypes into this collection" prototypes := OrderedCollection new ! Item was changed: + ----- Method: HashAndEqualsTestCase>>testEquality (in category 'tests') ----- - ----- Method: HashAndEqualsTestCase>>testEquality (in category 'as yet unclassified') ----- testEquality "Check that TextFontChanges report equality correctly" prototypes do: [:p | self should: [(EqualityTester with: p) result]] ! Item was changed: + ----- Method: HashAndEqualsTestCase>>testHash (in category 'tests') ----- - ----- Method: HashAndEqualsTestCase>>testHash (in category 'as yet unclassified') ----- testHash "test that TextFontChanges hash correctly" prototypes do: [:p | self should: [(HashTester with: p) result]] ! Item was changed: + ----- Method: HashTester>>resultFor: (in category 'running') ----- - ----- Method: HashTester>>resultFor: (in category 'as yet unclassified') ----- resultFor: runs "Test that the hash is the same over runs and answer the result" | hash | hash := self prototype hash. 1 to: runs do: [:i | hash = self prototype hash ifFalse: [^ false]]. ^ true ! Item was changed: + ----- Method: HashTesterTest>>testBasicBehaviour (in category 'tests') ----- - ----- Method: HashTesterTest>>testBasicBehaviour (in category 'as yet unclassified') ----- testBasicBehaviour self should: [(HashTester with: 1) resultFor: 100]. self should: [(HashTester with: 'fred') resultFor: 100]. self shouldnt: [(HashTester with: BadHasher new) resultFor: 100] ! Item was changed: + ----- Method: HexTest>>testCharacterHex (in category 'tests') ----- - ----- Method: HexTest>>testCharacterHex (in category 'as yet unclassified') ----- testCharacterHex | result | result := $a hex. self assert: result = '61'. result := $A hex. self assert: result = '41'. ! Item was changed: + ----- Method: HexTest>>testColorPrintHtmlString (in category 'tests') ----- - ----- Method: HexTest>>testColorPrintHtmlString (in category 'as yet unclassified') ----- testColorPrintHtmlString self assert: (Color red printHtmlString ) = ( Color red asHTMLColor allButFirst asUppercase). ! Item was changed: + ----- Method: HexTest>>testIntegerHex (in category 'tests') ----- - ----- Method: HexTest>>testIntegerHex (in category 'as yet unclassified') ----- testIntegerHex | result | result := 15 asInteger hex. self assert: result = '16rF'. result := 0 asInteger hex. self assert: result = '16r0'. result := 255 asInteger hex. self assert: result = '16rFF'. result := 90 asInteger hex. self assert: result = '16r5A'! Item was changed: + ----- Method: HexTest>>testStringAsHex (in category 'tests') ----- - ----- Method: HexTest>>testStringAsHex (in category 'as yet unclassified') ----- testStringAsHex | result | result := 'abc' asHex. self assert: result = '616263'. ! Item was changed: + ----- Method: ImageSegmentTest>>testContextsShouldBeWritableToaFile (in category 'tests') ----- - ----- Method: ImageSegmentTest>>testContextsShouldBeWritableToaFile (in category 'testing') ----- testContextsShouldBeWritableToaFile "This should not throw an exception" NativeImageSegment new copyFromRoots: {thisContext. thisContext copyStack} sizeHint: 100; extract; writeToFile: 'ContextChain'; yourself "TODO: write assertions showing that something meaningful actually happened." "TODO: bring them back in again"! Item was changed: + ----- Method: ImageSegmentTest>>testImageSegmentsShouldBeWritableToaFile (in category 'tests') ----- - ----- Method: ImageSegmentTest>>testImageSegmentsShouldBeWritableToaFile (in category 'testing') ----- testImageSegmentsShouldBeWritableToaFile "This should not throw an exception" | classes | classes := UIManager subclasses reject: [:sc| sc isActiveManager]. NativeImageSegment new copyFromRoots: classes asArray sizeHint: 100; extract; writeToFile: 'InactiveUIManagers'; yourself. "TODO: write assertions showing that something meaningful actually happened." "now bring them back in again" classes do: [:ea| ea new]! Item was changed: + ----- Method: InstallerUrlTest>>testAddPackageShouldResultInCorrectUrl (in category 'tests') ----- - ----- Method: InstallerUrlTest>>testAddPackageShouldResultInCorrectUrl (in category 'as yet unclassified') ----- testAddPackageShouldResultInCorrectUrl | url | url := (Installer url: 'http://seaside.gemstone.com/ss/metacello') addPackage: 'ConfigurationOfMetacello-dkh.754.mcz'; urlToDownload. "Note the insertion of a / in the URL." self assert: 'http://seaside.gemstone.com/ss/metacello/ConfigurationOfMetacello-dkh.754.m…' equals: url.! Item was changed: + ----- Method: LangEnvBugs>>defaultTimeout (in category 'accessing') ----- - ----- Method: LangEnvBugs>>defaultTimeout (in category 'as yet unclassified') ----- defaultTimeout ^ super defaultTimeout * 10 "seconds"! Item was changed: + ----- Method: LangEnvBugs>>tearDown (in category 'running') ----- - ----- Method: LangEnvBugs>>tearDown (in category 'as yet unclassified') ----- tearDown [Preferences restoreDefaultFonts] valueSupplyingAnswers: #(('Sorry, could not revert font choices' #default))! Item was changed: + ----- Method: LangEnvBugs>>testIsFontAvailable (in category 'tests') ----- - ----- Method: LangEnvBugs>>testIsFontAvailable (in category 'as yet unclassified') ----- testIsFontAvailable "self new testIsFontAvailable" "self run: #testIsFontAvailable" | oldPref | oldPref := Preferences valueOfPreference: #tinyDisplay. Preferences restoreFontsAfter: [ [Preferences enable: #tinyDisplay. "This should not throw an exception." (LanguageEnvironment localeID: (LocaleID isoLanguage: 'en')) isFontAvailable] ensure: [Preferences setPreference: #tinyDisplay toValue: oldPref]].! Item was changed: + ----- Method: LocaleTest>>setUp (in category 'running') ----- - ----- Method: LocaleTest>>setUp (in category 'testing') ----- setUp previousID := Locale current localeID. previousKeyboardInterpreter := ActiveHand instVarNamed: 'keyboardInterpreter'. previousClipboardInterpreter := Clipboard default instVarNamed: 'interpreter'. ActiveHand clearKeyboardInterpreter. Clipboard default clearInterpreter. ! Item was changed: + ----- Method: LocaleTest>>tearDown (in category 'running') ----- - ----- Method: LocaleTest>>tearDown (in category 'testing') ----- tearDown ActiveHand instVarNamed: 'keyboardInterpreter' put: previousKeyboardInterpreter. Clipboard default instVarNamed: 'interpreter' put: previousClipboardInterpreter. Locale switchToID: (LocaleID isoLanguage: previousID).! Item was changed: + ----- Method: LocaleTest>>testEncodingName (in category 'tests') ----- - ----- Method: LocaleTest>>testEncodingName (in category 'testing') ----- testEncodingName "self debug: #testEncodingName" | locale | locale := Locale isoLanguage: 'ja'. self assert: locale languageEnvironment fontEncodingName = #FontJapaneseEnvironment! Item was changed: + ----- Method: LocaleTest>>testIsFontAvailable (in category 'tests') ----- - ----- Method: LocaleTest>>testIsFontAvailable (in category 'testing') ----- testIsFontAvailable "self debug: #testIsFontAvailable" <timeout: 60> "takes quite a while" self ensureInternetConnectionTo: 'http://metatoys.org/pub/'. Preferences restoreFontsAfter: [ | currentDefaultTextStyle | currentDefaultTextStyle := TextStyle default. [ TextStyle setDefault: (TextStyle actualTextStyles at: #Accuny). (Locale isoLanguage: 'ja') languageEnvironment removeFonts. self assert: (Locale isoLanguage: 'en') languageEnvironment isFontAvailable. "Next test should fail after installing Japanese font" self assert: (Locale isoLanguage: 'ja') languageEnvironment isFontAvailable not. (Locale isoLanguage: 'ja') languageEnvironment installFont. self assert: (Locale isoLanguage: 'ja') languageEnvironment isFontAvailable ] ensure: [ TextStyle setDefault: currentDefaultTextStyle. FileDirectory default deleteFileNamed: (Locale isoLanguage: 'ja') languageEnvironment fontFullName. ] ].! Item was changed: + ----- Method: LocaleTest>>testLocaleChanged (in category 'tests') ----- - ----- Method: LocaleTest>>testLocaleChanged (in category 'testing') ----- testLocaleChanged "self debug: #testLocaleChanged" "LanguageEnvironment >> startUp is called from Prject >> localeChanged" <timeout: 60> "takes quite a while" Project current updateLocaleDependents. self assert: (ActiveHand instVarNamed: 'keyboardInterpreter') isNil description: 'non-nil keyboardInterpreter'. self assert: (Clipboard default instVarNamed: 'interpreter') isNil description: 'non-nil interpreter'. Locale switchToID: (LocaleID isoLanguage: 'ja'). self assert: 'ja' equals: Locale current localeID isoLanguage. Locale switchToID: (LocaleID isoLanguage: 'en'). self assert: 'en' equals: Locale current localeID isoLanguage.! Item was changed: + ----- Method: MCDirtyPackageInfo>>classes (in category 'listing') ----- - ----- Method: MCDirtyPackageInfo>>classes (in category 'as yet unclassified') ----- classes ^ Array new: 0.! Item was changed: + ----- Method: MCDirtyPackageInfo>>methods (in category 'listing') ----- - ----- Method: MCDirtyPackageInfo>>methods (in category 'as yet unclassified') ----- methods ^ MCMockClassA selectors select: [:ea | ea beginsWith: 'ordinal'] thenCollect: [:ea | MethodReference class: MCMockClassA selector: ea].! Item was changed: + ----- Method: MCDirtyPackageInfo>>packageName (in category 'naming') ----- - ----- Method: MCDirtyPackageInfo>>packageName (in category 'as yet unclassified') ----- packageName ^ 'MCDirtyPackage'! Item was changed: + ----- Method: MCEmptyPackageInfo>>classes (in category 'listing') ----- - ----- Method: MCEmptyPackageInfo>>classes (in category 'as yet unclassified') ----- classes ^ #()! Item was changed: + ----- Method: MCEmptyPackageInfo>>methods (in category 'listing') ----- - ----- Method: MCEmptyPackageInfo>>methods (in category 'as yet unclassified') ----- methods ^ #()! Item was changed: + ----- Method: MCEmptyPackageInfo>>packageName (in category 'naming') ----- - ----- Method: MCEmptyPackageInfo>>packageName (in category 'as yet unclassified') ----- packageName ^ 'MCEmptyPackage'! Item was changed: + ----- Method: MCMockClassA>>d (in category 'numeric') ----- - ----- Method: MCMockClassA>>d (in category 'as yet classified') ----- d ^ 'd'! Item was changed: + ----- Method: MCMockDefinition>>= (in category 'comparing') ----- - ----- Method: MCMockDefinition>>= (in category 'as yet unclassified') ----- = definition ^definition token = token! Item was changed: + ----- Method: MCMockDefinition>>asString (in category 'converting') ----- - ----- Method: MCMockDefinition>>asString (in category 'as yet unclassified') ----- asString ^ token! Item was changed: + ----- Method: MCMockDefinition>>description (in category 'comparing') ----- - ----- Method: MCMockDefinition>>description (in category 'as yet unclassified') ----- description ^ token first! Item was changed: + ----- Method: MCMockDefinition>>hash (in category 'comparing') ----- - ----- Method: MCMockDefinition>>hash (in category 'as yet unclassified') ----- hash ^ token hash! Item was changed: + ----- Method: MCMockDefinition>>printString (in category 'printing') ----- - ----- Method: MCMockDefinition>>printString (in category 'as yet unclassified') ----- printString ^ token! Item was changed: + ----- Method: MCMockDefinition>>summary (in category 'printing') ----- - ----- Method: MCMockDefinition>>summary (in category 'as yet unclassified') ----- summary ^ token! Item was changed: + ----- Method: MCMockDefinition>>token (in category 'accessing') ----- - ----- Method: MCMockDefinition>>token (in category 'as yet unclassified') ----- token ^ token! Item was changed: + ----- Method: MCMockDefinition>>token: (in category 'accessing') ----- - ----- Method: MCMockDefinition>>token: (in category 'as yet unclassified') ----- token: aString token := aString! Item was changed: + ----- Method: MCMockPackageInfo>>classNames (in category 'constants') ----- - ----- Method: MCMockPackageInfo>>classNames (in category 'as yet unclassified') ----- classNames ^ #( MCMockClassA MCMockASubclass MCMockClassB MCMockClassD MCMockClassE MCMockClassF MCMockClassG MCMockClassH MCMockClassI )! Item was changed: + ----- Method: MCMockPackageInfo>>classes (in category 'listing') ----- - ----- Method: MCMockPackageInfo>>classes (in category 'as yet unclassified') ----- classes ^ self classNames select: [:name | Smalltalk hasClassNamed: name] thenCollect: [:name | Smalltalk at: name]! Item was changed: + ----- Method: MCMockPackageInfo>>extensionMethods (in category 'listing') ----- - ----- Method: MCMockPackageInfo>>extensionMethods (in category 'as yet unclassified') ----- extensionMethods ^ Array with: (MethodReference class: MCSnapshotTest selector: #mockClassExtension)! Item was changed: + ----- Method: MCMockPackageInfo>>includesClass: (in category 'testing') ----- - ----- Method: MCMockPackageInfo>>includesClass: (in category 'as yet unclassified') ----- includesClass: aClass ^self classes includes: aClass! Item was changed: + ----- Method: MCMockPackageInfo>>includesSystemCategory: (in category 'testing') ----- - ----- Method: MCMockPackageInfo>>includesSystemCategory: (in category 'as yet unclassified') ----- includesSystemCategory: categoryName ^self systemCategories anySatisfy: [:cat | cat sameAs: categoryName]! Item was changed: + ----- Method: MCMockPackageInfo>>packageName (in category 'naming') ----- - ----- Method: MCMockPackageInfo>>packageName (in category 'as yet unclassified') ----- packageName ^ 'MonticelloMocks'! Item was changed: + ----- Method: MCMockPackageInfo>>systemCategories (in category 'listing') ----- - ----- Method: MCMockPackageInfo>>systemCategories (in category 'as yet unclassified') ----- systemCategories ^ Array with: 'Tests-MonticelloMocks'! Item was changed: + ----- Method: MCTestCase>>performTest (in category 'private') ----- - ----- Method: MCTestCase>>performTest (in category 'as yet unclassified') ----- performTest Utilities useAuthorInitials: self className during: [ super performTest ]! Item was changed: + ----- Method: MethodReferenceTest>>testEquals (in category 'tests') ----- - ----- Method: MethodReferenceTest>>testEquals (in category 'Running') ----- testEquals | aMethodReference anotherMethodReference | aMethodReference := MethodReference new. anotherMethodReference := MethodReference new. "Two fresh instances should be equals between them" self assert: MethodReference new equals: MethodReference new. self assert: MethodReference new hash equals: MethodReference new hash. "Two instances representing the same method (same class and same selector) should be equals" self assert: (MethodReference class: String selector: #foo) equals: (MethodReference class: String selector: #foo). self assert: (MethodReference class: String selector: #foo) hash equals: (MethodReference class: String selector: #foo) hash.! Item was changed: + ----- Method: MethodReferenceTest>>testNotEquals (in category 'tests') ----- - ----- Method: MethodReferenceTest>>testNotEquals (in category 'Running') ----- testNotEquals self deny: (MethodReference class: String selector: #foo) = (MethodReference class: String class selector: #foo) description: 'Different classes, same selector -> no more equals'. self deny: (MethodReference class: String selector: #foo) = (MethodReference class: String selector: #bar) description: 'Same class, different selectors -> no more equals'.! Item was changed: + ----- Method: NamePolicyTest class>>isAbstract (in category 'testing') ----- - ----- Method: NamePolicyTest class>>isAbstract (in category 'as yet unclassified') ----- isAbstract ^ self name = #NamePolicyTest! Item was changed: + ----- Method: ObjectsAsMethodsExample>>add:with: (in category 'example methods') ----- - ----- Method: ObjectsAsMethodsExample>>add:with: (in category 'as yet unclassified') ----- add: a with: b ^a + b! Item was changed: + ----- Method: ObjectsAsMethodsExample>>answer42 (in category 'example methods') ----- - ----- Method: ObjectsAsMethodsExample>>answer42 (in category 'as yet unclassified') ----- answer42 ^42! Item was changed: + ----- Method: ObjectsAsMethodsExample>>run:with:in: (in category 'example methods') ----- - ----- Method: ObjectsAsMethodsExample>>run:with:in: (in category 'as yet unclassified') ----- run: oldSelector with: arguments in: aReceiver ^self perform: oldSelector withArguments: arguments! Item was changed: + ----- Method: PCCByCompilationTest class>>isAbstract (in category 'testing') ----- - ----- Method: PCCByCompilationTest class>>isAbstract (in category 'Testing') ----- isAbstract ^ false! Item was changed: + ----- Method: PCCByLiteralsTest class>>isAbstract (in category 'testing') ----- - ----- Method: PCCByLiteralsTest class>>isAbstract (in category 'Testing') ----- isAbstract ^ false! Item was changed: + ----- Method: PrimCallControllerAbstractTest class>>isAbstract (in category 'testing') ----- - ----- Method: PrimCallControllerAbstractTest class>>isAbstract (in category 'Testing') ----- isAbstract ^ true! Item was changed: + ----- Method: PrimCallControllerAbstractTest>>setUp (in category 'running') ----- - ----- Method: PrimCallControllerAbstractTest>>setUp (in category 'tests') ----- setUp super setUp. pcc := self classToBeTested new. "set failed call" (self class >> self failedCallSelector) literals first at: 4 put: -1. "set it to false for some very slow tests..." doNotMakeSlowTestsFlag := true! Item was changed: + ----- Method: PrototypeTester>>prototype (in category 'accessing') ----- - ----- Method: PrototypeTester>>prototype (in category 'as yet unclassified') ----- prototype "Get a prototype" ^ prototype copy ! Item was changed: + ----- Method: PrototypeTester>>prototype: (in category 'accessing') ----- - ----- Method: PrototypeTester>>prototype: (in category 'as yet unclassified') ----- prototype: aPrototype "Set my prototype" prototype := aPrototype copy ! Item was changed: + ----- Method: PrototypeTester>>result (in category 'running') ----- - ----- Method: PrototypeTester>>result (in category 'as yet unclassified') ----- result "Perform the test the default number of times" ^ self resultFor: self class defaultRuns ! Item was changed: + ----- Method: RecentMessagesTest>>testIsEmpty (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testIsEmpty (in category 'testing') ----- testIsEmpty self assert: rm isEmpty description: 'Initially, must be empty'. rm recordSelector: #foo forClass: Utilities inEnvironment: Smalltalk globals. self deny: rm isEmpty description: 'After submission, must not be empty'.! Item was changed: + ----- Method: RecentMessagesTest>>testMaximumSubmissionCountCanReduceNumberOfReferences (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testMaximumSubmissionCountCanReduceNumberOfReferences (in category 'testing') ----- testMaximumSubmissionCountCanReduceNumberOfReferences rm maximumSubmissionCount: 2. rm recordSelector: #foo forClass: Utilities inEnvironment: Smalltalk globals. rm recordSelector: #bar forClass: Utilities inEnvironment: Smalltalk globals. rm maximumSubmissionCount: 1. self assert: 1 equals: rm size.! Item was changed: + ----- Method: RecentMessagesTest>>testMaximumSubmissionCountCapsReferenceCount (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testMaximumSubmissionCountCapsReferenceCount (in category 'testing') ----- testMaximumSubmissionCountCapsReferenceCount rm maximumSubmissionCount: 2. rm recordSelector: #foo forClass: Utilities inEnvironment: Smalltalk globals. rm recordSelector: #bar forClass: Utilities inEnvironment: Smalltalk globals. rm recordSelector: #baz forClass: Utilities inEnvironment: Smalltalk globals. self assert: #bar equals: rm leastRecent selector.! Item was changed: + ----- Method: RecentMessagesTest>>testMaximumSubmissionCountDefaultsToTen (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testMaximumSubmissionCountDefaultsToTen (in category 'testing') ----- testMaximumSubmissionCountDefaultsToTen self assert: 30 equals: rm maximumSubmissionCount.! Item was changed: + ----- Method: RecentMessagesTest>>testMaximumSubmissionCountReturnsMaximumNumberOfRecordedMethodSubmissions (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testMaximumSubmissionCountReturnsMaximumNumberOfRecordedMethodSubmissions (in category 'testing') ----- testMaximumSubmissionCountReturnsMaximumNumberOfRecordedMethodSubmissions rm maximumSubmissionCount: 0. self assert: 0 equals: rm maximumSubmissionCount. rm maximumSubmissionCount: 1. self assert: 1 equals: rm maximumSubmissionCount.! Item was changed: + ----- Method: RecentMessagesTest>>testMethodReferencesReturnsAllSubmissions (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testMethodReferencesReturnsAllSubmissions (in category 'testing') ----- testMethodReferencesReturnsAllSubmissions | expected | expected := { MethodReference class: Utilities selector: #bar environment: env. MethodReference class: Utilities selector: #foo environment: env }. rm recordSelector: #foo forClass: Utilities inEnvironment: env. rm recordSelector: #bar forClass: Utilities inEnvironment: env. self assert: expected equals: rm methodReferences! Item was changed: + ----- Method: RecentMessagesTest>>testMethodReferencesReturnsaCopy (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testMethodReferencesReturnsaCopy (in category 'testing') ----- testMethodReferencesReturnsaCopy | expected original | rm recordSelector: #foo forClass: Utilities inEnvironment: env. original := rm methodReferences. expected := original copy. rm recordSelector: #bar forClass: Utilities inEnvironment: env. self assert: expected equals: original.! Item was changed: + ----- Method: RecentMessagesTest>>testMostRecentReturnsLastAddedReference (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testMostRecentReturnsLastAddedReference (in category 'testing') ----- testMostRecentReturnsLastAddedReference | victim | victim := self createClass: #Victim. victim compile: 'foo ^ 1'. victim compile: 'bar ^ 1'. rm recordSelector: #foo forClass: victim inEnvironment: env. self assert: #foo equals: rm mostRecent selector. rm recordSelector: #bar forClass: victim inEnvironment: env. self assert: #bar equals: rm mostRecent selector.! Item was changed: + ----- Method: RecentMessagesTest>>testMostRecentReturnsRemovedReference (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testMostRecentReturnsRemovedReference (in category 'testing') ----- testMostRecentReturnsRemovedReference | victim | victim := self createClass: #Victim. victim compile: 'foo ^ 1'. victim compile: 'bar ^ 1'. rm recordSelector: #foo forClass: victim inEnvironment: env. rm recordSelector: #bar forClass: victim inEnvironment: env. victim removeSelector: #bar. self assert: #bar equals: rm mostRecent selector.! Item was changed: + ----- Method: RecentMessagesTest>>testOldestReturnsOldestSubmission (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testOldestReturnsOldestSubmission (in category 'testing') ----- testOldestReturnsOldestSubmission self assert: nil equals: rm leastRecent description: 'Return nil if no submissions yet'. rm recordSelector: #foo forClass: Utilities inEnvironment: Smalltalk globals. self assert: #foo equals: rm leastRecent selector. rm recordSelector: #baz forClass: Utilities inEnvironment: Smalltalk globals. self assert: #foo equals: rm leastRecent selector.! Item was changed: + ----- Method: RecentMessagesTest>>testPurgeMissingMethodsKeepsComments (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testPurgeMissingMethodsKeepsComments (in category 'testing') ----- testPurgeMissingMethodsKeepsComments rm recordSelector: #Comment forClass: Utilities inEnvironment: Smalltalk globals. self deny: rm isEmpty.! Item was changed: + ----- Method: RecentMessagesTest>>testReferencesAreUnique (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testReferencesAreUnique (in category 'testing') ----- testReferencesAreUnique rm recordSelector: #foo forClass: Utilities inEnvironment: Smalltalk globals. rm recordSelector: #foo forClass: Utilities inEnvironment: Smalltalk globals. self assert: 1 equals: rm size description: 'After duplicate'.! Item was changed: + ----- Method: RecentMessagesTest>>testRevertMostRecentRemovesLatestVersion (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testRevertMostRecentRemovesLatestVersion (in category 'testing') ----- testRevertMostRecentRemovesLatestVersion | victim | victim := self createClass: #Victim. victim compile: 'foo ^ 1'. victim compile: 'foo ^ 2'. rm recordSelector: #foo forClass: victim inEnvironment: env. rm revertMostRecent. self assert: 1 equals: victim new foo description: 'Version not removed'.! Item was changed: + ----- Method: RecentMessagesTest>>testRevertMostRecentRemovesNewMethod (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testRevertMostRecentRemovesNewMethod (in category 'testing') ----- testRevertMostRecentRemovesNewMethod | victim | victim := self createClass: #Victim. victim compile: 'foo ^ 1'. rm recordSelector: #foo forClass: victim inEnvironment: env. rm revertMostRecent. self deny: (victim includesSelector: #foo) description: 'Method not removed'.! Item was changed: + ----- Method: RecentMessagesTest>>testSizeReturnsNumberOfRecordedMethodSubmissions (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testSizeReturnsNumberOfRecordedMethodSubmissions (in category 'testing') ----- testSizeReturnsNumberOfRecordedMethodSubmissions self assert: 0 equals: rm size description: 'Initial state'. rm recordSelector: #foo forClass: Utilities inEnvironment: Smalltalk globals. self assert: 1 equals: rm size description: 'After 1 submission'. rm recordSelector: #bar forClass: Utilities inEnvironment: Smalltalk globals. self assert: 2 equals: rm size description: 'After 2 submissions'.! Item was changed: + ----- Method: RecentMessagesTest>>testSubmissionClassControlsLogging (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testSubmissionClassControlsLogging (in category 'testing') ----- testSubmissionClassControlsLogging WantsChangeSetLogging yes. rm recordSelector: #foo forClass: WantsChangeSetLogging inEnvironment: Smalltalk globals. WantsChangeSetLogging no. rm recordSelector: #bar forClass: WantsChangeSetLogging inEnvironment: Smalltalk globals. self assert: 1 equals: rm size description: 'Class asked for logging not to happen'.! Item was changed: + ----- Method: ReleaseTest>>testClassesSystemCategory (in category 'tests') ----- - ----- Method: ReleaseTest>>testClassesSystemCategory (in category 'testing') ----- testClassesSystemCategory "Find cases where classes have nil system categories. This test will tell you the classes. This is inspired by the proposed fix of a bug in release of 3.10.1 see Mantis #7070" | rejectClasses | rejectClasses := nil systemNavigation allClasses reject: [ :each | each category notNil ] . self assert: rejectClasses isEmpty description: ('Classes with nil system categories: {1}' format: {rejectClasses asCommaString}).! Item was changed: + ----- Method: ReleaseTest>>testMethodsWithUnboundGlobals (in category 'tests') ----- - ----- Method: ReleaseTest>>testMethodsWithUnboundGlobals (in category 'testing') ----- testMethodsWithUnboundGlobals | unbound | unbound := SystemNavigation default methodsWithUnboundGlobals. Smalltalk cleanOutUndeclared. self assert: unbound isEmpty description: 'Unbound: ', unbound asCommaString! Item was changed: + ----- Method: ReleaseTest>>testNoObsoleteClasses (in category 'tests') ----- - ----- Method: ReleaseTest>>testNoObsoleteClasses (in category 'testing') ----- testNoObsoleteClasses | obsoleteClasses | obsoleteClasses := self systemNavigation obsoleteClasses. self assert: obsoleteClasses isEmpty description: ('{1} {2} obsolete' format: { obsoleteClasses asCommaStringAnd. obsoleteClasses size = 1 ifTrue: [ 'is' ] ifFalse: [ 'are' ] }) ! Item was changed: + ----- Method: ReleaseTest>>testSqueakThemeFonts (in category 'tests') ----- - ----- Method: ReleaseTest>>testSqueakThemeFonts (in category 'testing') ----- testSqueakThemeFonts "Check whether the fonts installed in the active theme in the release are correct" "preference selector - font family name - font size" { #(standardDefaultTextFont 'Bitmap DejaVu Sans' 9). #(standardListFont 'Bitmap DejaVu Sans' 9). #(standardFlapFont 'Bitmap DejaVu Sans' 7). #(standardMenuFont 'Bitmap DejaVu Sans' 9). #(windowTitleFont 'Bitmap DejaVu Sans' 9). #(standardBalloonHelpFont 'Bitmap DejaVu Sans' 7). #(standardCodeFont 'Bitmap DejaVu Sans' 9). #(standardButtonFont 'Bitmap DejaVu Sans' 7) } do: [:triple | | font | font := Preferences perform: triple first. self assert: triple second equals: font familyName. self assert: triple third equals: font pointSize ] ! Item was changed: + ----- Method: ReleaseTest>>testSuperSubclassReferences (in category 'tests') ----- - ----- Method: ReleaseTest>>testSuperSubclassReferences (in category 'testing') ----- testSuperSubclassReferences "see mantis bug 7090 for more info on this" "If the reason for this test to fail is above bug, the following might fix the system" "(ProtoObject subclasses reject: [:each | each isMeta or: [each environment includes: each]]) do: [:each | ProtoObject removeSubclass: each]" | strangeClasses | strangeClasses := ProtoObject allSubclasses reject: [:each | each isMeta or: [each environment includes: each]]. self assert: strangeClasses isEmpty description: ('Not expecting to find any of {1}' format: {strangeClasses asCommaString}).! Item was changed: + ----- Method: ReleaseTest>>testSwapMouseButtonsPreference (in category 'tests') ----- - ----- Method: ReleaseTest>>testSwapMouseButtonsPreference (in category 'testing') ----- testSwapMouseButtonsPreference "Swap mouse buttons should be enabled" self assert: Preferences swapMouseButtons! Item was changed: + ----- Method: ReleaseTest>>testSystemCategoryClasses (in category 'tests') ----- - ----- Method: ReleaseTest>>testSystemCategoryClasses (in category 'testing') ----- testSystemCategoryClasses "Find cases where system categories name absent classes. This test will tell you the classes. This is inspired by a bug in release of 3.10.1 see Mantis #7070" | rejectCats rejectClasses | rejectCats := SystemOrganization categories reject: [ :catName | (SystemOrganization listAtCategoryNamed: catName) allSatisfy: [ :className | ( Smalltalk includesKey: className ) ] ] . "self assert: rejectCats isEmpty ." rejectCats isEmpty ifTrue: [ ^ true ] . rejectClasses := rejectCats collect: [ :each | each -> ( (SystemOrganization listAtCategoryNamed: each) reject: [ :eachOne | ( Smalltalk includesKey: eachOne ) ] ) ] . self assert: rejectCats isEmpty description: ('Not expecting any of {1}' format: { rejectClasses asCommaString}). ! Item was changed: + ----- Method: ReleaseTest>>testUndeclared (in category 'tests') ----- - ----- Method: ReleaseTest>>testUndeclared (in category 'testing') ----- testUndeclared Smalltalk cleanOutUndeclared. self assert: Undeclared isEmpty description: ('{1} {2} in Undeclared' format: { Undeclared keys asCommaStringAnd. Undeclared keys size = 1 ifTrue: [ 'is' ] ifFalse: [ 'are' ] })! Item was changed: + ----- Method: ScannerTest>>testLiteralSymbols (in category 'tests') ----- - ----- Method: ScannerTest>>testLiteralSymbols (in category 'testing') ----- testLiteralSymbols self assert: ('*+-/\~=<>&@%,|' allSatisfy: [:char | Scanner isLiteralSymbol: (String with: char) asSymbol]) description: 'single letter binary symbols can be printed without string quotes'. self assert: (#('x' 'x:' 'x:y:' 'from:to:by:' 'yourself') allSatisfy: [:str | Scanner isLiteralSymbol: str asSymbol]) description: 'valid ascii selector symbols can be printed without string quotes'. ((32 to: 126) collect: [:ascii | Character value: ascii]) , #(':x:yourself' '::' 'x:yourself' '123' 'x0:1:2:' 'x.y.z' '1abc' 'a1b0c2' ' x' 'x ' '+x-y' '||' '--' '++' '+-' '+/-' '-/+' '<|>' '#x' '()' '[]' '{}' '') do: [:str | self assert: (Compiler evaluate: str asSymbol printString) = str asSymbol description: 'in all case, a Symbol must be printed in an interpretable fashion']! Item was changed: + ----- Method: SecureHashAlgorithmTest>>testEmptyInput (in category 'tests - examples') ----- - ----- Method: SecureHashAlgorithmTest>>testEmptyInput (in category 'testing - examples') ----- testEmptyInput self assert: ((SecureHashAlgorithm new hashMessage: '') radix: 16) = 'DA39A3EE5E6B4B0D3255BFEF95601890AFD80709'! Item was changed: + ----- Method: SecureHashAlgorithmTest>>testExample1 (in category 'tests - examples') ----- - ----- Method: SecureHashAlgorithmTest>>testExample1 (in category 'testing - examples') ----- testExample1 "This is the first example from the specification document (FIPS PUB 180-1)" hash := SecureHashAlgorithm new hashMessage: 'abc'. self assert: (hash = 16rA9993E364706816ABA3E25717850C26C9CD0D89D). ! Item was changed: + ----- Method: SecureHashAlgorithmTest>>testExample2 (in category 'tests - examples') ----- - ----- Method: SecureHashAlgorithmTest>>testExample2 (in category 'testing - examples') ----- testExample2 "This is the second example from the specification document (FIPS PUB 180-1)" hash := SecureHashAlgorithm new hashMessage: 'abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq'. self assert: (hash = 16r84983E441C3BD26EBAAE4AA1F95129E5E54670F1).! Item was changed: + ----- Method: SecureHashAlgorithmTest>>testExample3 (in category 'tests - examples') ----- - ----- Method: SecureHashAlgorithmTest>>testExample3 (in category 'testing - examples') ----- testExample3 "This is the third example from the specification document (FIPS PUB 180-1). This example may take several minutes." hash := SecureHashAlgorithm new hashMessage: (String new: 1000000 withAll: $a). self assert: (hash = 16r34AA973CD4C4DAA4F61EEB2BDBAD27316534016F).! Item was changed: + ----- Method: SumBugs>>testSummingColors (in category 'tests') ----- - ----- Method: SumBugs>>testSummingColors (in category 'as yet unclassified') ----- testSummingColors "self run: #testSummingColors" | cases | cases := { Color black. Color red. Color green. Color blue. Color cyan. Color magenta. Color yellow. Color white. }. cases do: [ :each | self assert: ((Array with: each) sum = each) ]. ! Item was changed: + ----- Method: SumBugs>>testSummingToTen (in category 'tests') ----- - ----- Method: SumBugs>>testSummingToTen (in category 'as yet unclassified') ----- testSummingToTen "self run: #testSummingToTen" | cases | cases :={ { 1 . 2 . 3 . 4 }. { 2.0 . 2.0 . 2.0 . 2.0 . 2.0 }. { 2/5 . 5/2 . 5/2 . 3/5 . 4 } } . cases do: [ :each | self assert: (each sum = 10 ) ] .! Item was changed: + ----- Method: SumBugs>>testSummingToWhite (in category 'tests') ----- - ----- Method: SumBugs>>testSummingToWhite (in category 'as yet unclassified') ----- testSummingToWhite "self run: #testSummingToWhite" | cases | cases := { { Color black . Color white }. { Color red . Color green. Color blue }. { Color gray . Color gray }. { Color cyan. Color magenta. Color yellow }. { Color cyan. Color magenta. }. { Color magenta. Color yellow }. { Color cyan. Color yellow }. { Color cyan. Color red }. { Color green .Color magenta. }. { Color blue. Color yellow }. } . cases do: [ :each | self assert: (each sum = Color white) ] . ! Item was changed: + ----- Method: SumBugs>>testSummingWithBlack (in category 'tests') ----- - ----- Method: SumBugs>>testSummingWithBlack (in category 'as yet unclassified') ----- testSummingWithBlack "self run: #testSummingWithBlack" | cases | cases := { Color black. Color red. Color green. Color blue. Color cyan. Color magenta. Color yellow. Color white. }. cases do: [ :each | self assert: ((Array with: each with: Color black) sum = each) ] . ! Item was changed: + ----- Method: SumBugs>>testSummingWithWhite (in category 'tests') ----- - ----- Method: SumBugs>>testSummingWithWhite (in category 'as yet unclassified') ----- testSummingWithWhite "self run: #testSummingWithWhite" | cases | cases := { Color black. Color red. Color green. Color blue. Color cyan. Color magenta. Color yellow. Color white. } . cases do: [ :each | self assert: ((Array with: Color white with: each ) sum = Color white) ] . ! Item was changed: + ----- Method: SystemVersionTest>>testMajorMinorVersion (in category 'tests') ----- - ----- Method: SystemVersionTest>>testMajorMinorVersion (in category 'as yet unclassified') ----- testMajorMinorVersion " SystemVersionTest run: #testMajorMinorVersion " self assert: (SystemVersion new version: 'Squeak3.7alpha') majorMinorVersion = 'Squeak3.7'. self assert: (SystemVersion new version: 'Squeak3.7') majorMinorVersion = 'Squeak3.7'. self assert: (SystemVersion new version: 'Squeak3') majorMinorVersion = 'Squeak3'. self assert: (SystemVersion new version: '') majorMinorVersion = ''. ! Item was changed: + ----- Method: TestObjectsAsMethods>>testAddNumbers (in category 'tests') ----- - ----- Method: TestObjectsAsMethods>>testAddNumbers (in category 'testing') ----- testAddNumbers self assert: (self add: 3 with: 4) = 7. self assert: (self perform: #add:with: withArguments: #(3 4)) = 7.! Item was changed: + ----- Method: TestObjectsAsMethods>>testAnswer42 (in category 'tests') ----- - ----- Method: TestObjectsAsMethods>>testAnswer42 (in category 'testing') ----- testAnswer42 self assert: self answer42 = 42! Item was changed: + ----- Method: TestObjectsAsMethods>>testDNU (in category 'tests') ----- - ----- Method: TestObjectsAsMethods>>testDNU (in category 'testing') ----- testDNU self should: [self foo] raise: MessageNotUnderstood! Item was changed: + ----- Method: TestVMStatistics>>testVmStatisticsReportString (in category 'tests') ----- - ----- Method: TestVMStatistics>>testVmStatisticsReportString (in category 'testing') ----- testVmStatisticsReportString "Results of this test vary by VM implementation. Failure usually indicates an unchecked assumption about the array size." self shouldnt: [Smalltalk vmStatisticsReportString] raise: Error description: 'probable unchecked VM statistics array size' ! Item was changed: + ----- Method: TestValueWithinFix>>valueWithinNonLocalReturn (in category 'private') ----- - ----- Method: TestValueWithinFix>>valueWithinNonLocalReturn (in category 'tests') ----- valueWithinNonLocalReturn "Do a non-local return from a valueWithin: block" [^self] valueWithin: 20 milliSeconds onTimeout:[]. !

2 1

The Trunk: Tools-pre.840.mcz
by commits＠source.squeak.org 27 Dec '18

27 Dec '18

Patrick Rein uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-pre.840.mcz ==================== Summary ==================== Name: Tools-pre.840 Author: pre Time: 27 December 2018, 10:03:04.287503 pm UUID: 192f0561-821d-a347-a550-e12bbd53b360 Ancestors: Tools-pre.839 Fixes two defects in the FileContentsBrowser. One prevented the browsing of methods in changessets whose classes are not present. The other is a dnu error due to an, seemingly, overlooked old message send. (http://bugs.squeak.org/view.php?id=7615) =============== Diff against Tools-pre.839 =============== Item was changed: ----- Method: FileContentsBrowser>>changeMessageCategories: (in category 'other') ----- changeMessageCategories: aString "The characters in aString represent an edited version of the the message categories for the selected class. Update this information in the system and inform any dependents that the categories have been changed. This message is invoked because the user had issued the categories command and edited the message categories. Then the user issued the accept command." self classOrMetaClassOrganizer changeFromString: aString. - self unlock. self editClass. self selectClassNamed: selectedClassName. ^ true! Item was added: + ----- Method: FileContentsBrowser>>hasClassSelected (in category 'class list') ----- + hasClassSelected + ^ selectedClassName notNil !

1 0

The Trunk: ToolsTests-pre.90.mcz
by commits＠source.squeak.org 27 Dec '18

27 Dec '18

Patrick Rein uploaded a new version of ToolsTests to project The Trunk: http://source.squeak.org/trunk/ToolsTests-pre.90.mcz ==================== Summary ==================== Name: ToolsTests-pre.90 Author: pre Time: 27 December 2018, 10:01:15.558503 pm UUID: 580984a1-c023-c149-962f-0e6ca7836596 Ancestors: ToolsTests-pre.89 Changes the FileContentsBrowserTest to trigger a failure we observed recently when browsing a changeset whose classes are not present in the system. Also improves another test case and removes the expected failures after fixing the corresponding bug. =============== Diff against ToolsTests-pre.89 =============== Item was removed: - ----- Method: FileContentsBrowserTest>>expectedFailures (in category 'failures') ----- - expectedFailures - ^ #(testChangeMessageCategoriesLeavesClassSelected) "See Mantis #7615"! Item was changed: ----- Method: FileContentsBrowserTest>>testBrowsingAChangesetShowsMethods (in category 'tests') ----- testBrowsingAChangesetShowsMethods + | newChangeSet fileContents internalStream class | - | newChangeSet fileContents internalStream | newChangeSet := ChangeSet basicNewNamed: 'fooTestSet' , (Random new nextLargeInt: 10000) asString. + SystemChangeNotifier uniqueInstance doSilently: [ + class := Object subclass: #FileContentsBrowserTestTestObject + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: self class category name asString. + class compileSilently: 'theTestMethod ^ false']. - self class compileSilently: 'theTestMethod ^ false'. - newChangeSet adoptSelector: #theTestMethod forClass: self class. + newChangeSet adoptSelector: #theTestMethod forClass: class. + internalStream := WriteStream on: (String new: 10000). newChangeSet fileOutOn: internalStream. fileContents := internalStream contents. + class removeFromSystem. - self class removeSelector: #theTestMethod. browser := FileContentsBrowser createBrowserForStream: (MultiByteBinaryOrTextStream with: fileContents) named: 'testFoo'. browser selectSystemCategory: browser systemCategoryList first. browser selectClassNamed: browser classList first. self assert: browser messageList size = 1.! Item was changed: ----- Method: FileContentsBrowserTest>>testChangeMessageCategoriesLeavesClassSelected (in category 'tests') ----- testChangeMessageCategoriesLeavesClassSelected browser selectSystemCategory: browser systemCategoryList first. + browser selectClassNamed: self class name. - browser selectClassNamed: browser classList first. "This is a no-op." browser changeMessageCategories: browser classOrMetaClassOrganizer printString. + self assert: browser selectedClassName = self class name.! - self assert: browser selectedClassName = browser class name.!

1 0

Happy Holidays to Squeakers around the world
by David T. Lewis 26 Dec '18

26 Dec '18

It just turned midnight in my small part of the world, and I think I see Santa's sleigh overhead. Cheers and best wishes to all! Dave

6 5

UTCDateAndTime updates for Chronology-Core
by David T. Lewis 26 Dec '18

26 Dec '18

I am putting five Chronology-Core updates in the inbox, to be moved to trunk some time soon. These are the updates to Chronology that change the internal representation of DateAndTime as described on http://wiki.squeak.org/squeak/6197, and with original development at http://www.squeaksource.com/UTCDateAndTime. When moved to trunk, the five MCZ versions will be loaded in sequence based on new update map entries, such that instances of DateAndTime will be converted in-place during the update process. Chris Muller has done a good deal of testing of these updates, with coverage including various Magma database scenarios that depend heavliy on DateAndTime (thank you Chris). Together we have resolved a number of important issues based on that testing, and are fairly confident now that it is safe to move the UTC updates for Chronology-Core to trunk. These changes are inherently risky because they modify the DateAndTime instances that are used trhoughout our source code and version control, and also because they are not easily reversed. I will be traveling for the holidays, so I do not want to move the updates to trunk until I can be around to respond to any problems. Most likely that will be December 28, but in the mean time the updates should stay in inbox. Once moved to trunk, there will be eight failing tests in Chronology-Tests. Each of these represents an issue that I think should be addressed in discussion on the squeak-dev list. Dave

2 2

The Inbox: Chronology-Core-ul.21.mcz
by commits＠source.squeak.org 26 Dec '18

26 Dec '18

Levente Uzonyi uploaded a new version of Chronology-Core to project The Inbox: http://source.squeak.org/inbox/Chronology-Core-ul.21.mcz ==================== Summary ==================== Name: Chronology-Core-ul.21 Author: ul Time: 26 December 2018, 1:48:40.220196 am UUID: 2e6f6ce2-d0ec-41a0-b27c-88c642e5afc9 Ancestors: Chronology-Core-dtl.20 - fix: do not subtract the offset twice while evaluating DateAndTime >> #setJdn:seconds:nano:localOffsetSeconds: - use 0 for seconds in DateAndTime >> #midnight, because the offset will not be subtracted from the passed value =============== Diff against Chronology-Core-dtl.20 =============== Item was changed: ----- Method: DateAndTime>>midnight (in category 'squeak protocol') ----- midnight "Answer a DateAndTime starting at midnight of the same timezone offset as the receiver." ^ self class basicNew setJdn: self julianDayNumber + seconds: 0 - seconds: localOffsetSeconds nano: 0 localOffsetSeconds: localOffsetSeconds.! Item was changed: ----- Method: DateAndTime>>setJdn:seconds:nano:localOffsetSeconds: (in category 'private') ----- setJdn: jdn seconds: s nano: n localOffsetSeconds: offset localOffsetSeconds := offset. utcMicroseconds := self microsecondsFromDay: jdn + seconds: s - seconds: s - offset nanos: n offset: offset!

1 0

PostgresV3 with parameter binding
by Pierce Ng 25 Dec '18

25 Dec '18

Hi Levente, Balázs, and all, I've modified PostgresV3 to support parameter binding so that parsing SQL with placeholders and binding/executing with data are done separately. So far tested inserts and selects successfully. I've created an account on Squeaksource called PierceNg. Happy to contribute my changes to the Squeaksource repo if you grant me commit access. I'm more of a Pharo user, and intend to make PostgresV3's TLS work with Pharo, and also to develop a more friendly API for it. Of course I will keep protocol state machine changes in sync between the Squeak and Pharo versions. Screenshots: 1 - Wireshark capture of a select protocol exchange. 2 - Pharo inspector of a PG3ResultSet. More work needs to be done - the left-most column should not be large negative numbers. Cheers, Pierce https://www.samadhiweb.com/blog

2 2