'From Squeak3.5 of ''11 April 2003'' [latest update: #5180] on 27 April 2003 at 6:13:04 pm'! "Change Set: date fixes Date: 31 January 2003 Author: Stephan B. Wessels By default weeks begin on Monday in Squeak and code exists to toggle between Sunday start and Monday start. This change set adds a explicit setting methods for the start of week day. There were a few places in the code where proper adjustment to Sunday beginning weeks were not correct. The Date method #weekday math was corrected to account for Monday/Sunday week start. Month has a new #weeksInMonth method. Week #indexInMonth: method was also fixed. Note that the MonthMorph still works correctly since it coded around this. Also added some SUnit tests for Date and Week. Date Update ------------- ----------------------------------------------------------------------- 15-apr-2003 update for Squeak 3.5 31-jan-2003 initial release. " ! TestCase subclass: #DateTestCase instanceVariableNames: '' classVariableNames: 'PreviousWeekStartValue ' poolDictionaries: '' category: 'SUnit-Core'! !Date methodsFor: 'accessing' stamp: 'sbw 1/30/2003 10:22'! weekday "Answer the name of the day of the week on which the receiver falls." | temp | Week startMonday ifTrue: [^ WeekDayNames at: self weekdayIndex] ifFalse: [temp := self weekdayIndex - 1. temp = 0 ifTrue: [temp := 7]. ^ WeekDayNames at: temp]! ! !Date methodsFor: 'accessing' stamp: 'sbw 2/1/2003 20:29'! weekdayIndex "Monday=1, ... , Sunday=7 only when week begins on Monday, else Sunday=1, .., Saturday=7." | temp | Week startMonday ifTrue: [^ (self julianDayNumber rem: 7) + 1] ifFalse: [temp _ (self julianDayNumber rem: 7) + 2. temp = 8 ifTrue: [temp _ 1]. ^ temp]! ! !Date class methodsFor: 'general inquiries' stamp: 'sbw 1/30/2003 21:54'! dayOfWeek: dayName "Answer the index in a week, 1-7, of the day named dayName. Create an error notification if no such day exists." | result | result _ 0. 1 to: 7 do: [:index | (WeekDayNames at: index) = dayName ifTrue: [result _ index]]. result = 0 ifTrue: [self error: dayName asString , ' is not a day of the week'] ifFalse: [Week startMonday ifTrue: [^result] ifFalse: [result := result + 1. result = 8 ifTrue: [result := 1]. ^result]]! ]style[(11 7 3 114 3 7 4 6 3 1 3 1 7 1 8 7 3 12 5 5 9 7 14 6 3 5 5 6 3 1 12 4 8 7 12 27 14 5 119)f1b,f1cblue;b,f1,f1c148046000,f1,f1cblue;i,f1,f1cblue;i,f1,f1c000130027,f1,f1c000130027,f1,f1c000130027,f1,f1cred;,f1,f1cmagenta;,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1c000130027,f1,f1cmagenta;,f1,f1cblue;i,f1,f1c000130027,f1,f1cmagenta;,f1! ! !Date class methodsFor: 'general inquiries' stamp: 'sbw 2/2/2003 05:27'! firstWeekdayOfMonth: mn year: yr "Answer the weekday index (Sunday=1, etc) of the first day in the month named mn in the year yr. Account for weeks that begin on Monday." ^ (self newDay: 1 month: mn year: yr) weekdayIndex + 7 \\ 7 + 1! ! !Date class methodsFor: 'general inquiries' stamp: 'sbw 2/2/2003 05:22'! weeksInMonth: monthName forYear: yearInteger "Answer the number of weeks in the month named monthName in the year yearInteger." ^ (self newDay: 1 month: monthName year: yearInteger) month weeksInMonth! ! !DateTestCase methodsFor: 'Testing' stamp: 'sbw 1/31/2003 18:39'! testDayOfWeekBeginningOnMonday | coll date | self class ensureWeekBeginsOnMonday. coll _ self sevenDaysBeginningWithJul012002. "M T W R F S N" "1 2 3 4 5 6 7" 1 to: 7 do: [:index | date _ coll at: index. self assert: date weekdayIndex = index]! ! !DateTestCase methodsFor: 'Testing' stamp: 'sbw 2/1/2003 21:06'! testDayOfWeekBeginningOnSunday | coll date | self class ensureWeekBeginsOnSunday. coll _ self sevenDaysBeginningWithDec012002. "N M T W R F S" "1 2 3 4 5 6 7" 1 to: 7 do: [:index | date _ coll at: index. self assert: date weekdayIndex = index]! ! !DateTestCase methodsFor: 'Testing' stamp: 'sbw 1/31/2003 18:44'! testDayOfWeekLookupWeekBeginsOnMonday | dayNames dayName dayOfWeek | self class ensureWeekBeginsOnMonday. dayNames _ #(#Monday #Tuesday #Wednesday #Thursday #Friday #Saturday #Sunday ). 1 to: 7 do: [:index | dayName _ dayNames at: index. dayOfWeek _ Date dayOfWeek: dayName. self assert: dayOfWeek = index]! ! !DateTestCase methodsFor: 'Testing' stamp: 'sbw 1/31/2003 18:45'! testDayOfWeekLookupWeekBeginsOnSunday | dayNames dayName dayOfWeek | self class ensureWeekBeginsOnSunday. dayNames _ #(#Sunday #Monday #Tuesday #Wednesday #Thursday #Friday #Saturday ). 1 to: 7 do: [:index | dayName _ dayNames at: index. dayOfWeek _ Date dayOfWeek: dayName. self assert: dayOfWeek = index]! ! !DateTestCase methodsFor: 'Testing' stamp: 'sbw 1/31/2003 18:39'! testDayOfWeekNameBeginningOnMonday | coll date dayNames | self class ensureWeekBeginsOnMonday. coll _ self sevenDaysBeginningWithJul012002. dayNames _ #(#Monday #Tuesday #Wednesday #Thursday #Friday #Saturday #Sunday ). "M T W R F S N" "1 2 3 4 5 6 7" 1 to: 7 do: [:index | date _ coll at: index. self assert: date weekday = (dayNames at: index)]! ! !DateTestCase methodsFor: 'Testing' stamp: 'sbw 1/31/2003 18:40'! testDayOfWeekNameBeginningOnSunday | coll date dayNames | self class ensureWeekBeginsOnSunday. coll _ self sevenDaysBeginningWithDec012002. dayNames _ #(#Sunday #Monday #Tuesday #Wednesday #Thursday #Friday #Saturday ). "N M T W R F S" "1 2 3 4 5 6 7" 1 to: 7 do: [:index | date _ coll at: index. self assert: date weekday = (dayNames at: index)]! ! !DateTestCase methodsFor: 'Testing' stamp: 'sbw 2/2/2003 05:55'! testFirstWeekIndexesWithWeekBeginningOnMonday | date month index week | self class ensureWeekBeginsOnMonday. date _ self jun012002. month _ date month. week _ date week. index _ week indexInMonth: month. self assert: index = 1. date _ self jul012002. month _ date month. week _ date week. index _ week indexInMonth: month. self assert: index = 1. date _ self dec012002. month _ date month. week _ date week. index _ week indexInMonth: month. self assert: index = 1! ! !DateTestCase methodsFor: 'Testing' stamp: 'sbw 2/2/2003 05:56'! testFirstWeekIndexesWithWeekBeginningOnSunday | date month index week | self class ensureWeekBeginsOnSunday. date _ self jun012002. month _ date month. week _ date week. index _ week indexInMonth: month. self assert: index = 1. date _ self jul012002. month _ date month. week _ date week. index _ week indexInMonth: month. self assert: index = 1. date _ self dec012002. month _ date month. week _ date week. index _ week indexInMonth: month. self assert: index = 1! ! !DateTestCase methodsFor: 'Testing' stamp: 'sbw 1/31/2003 18:51'! testWeeksInMonthBeginningOnMondayWeekBeginsOnMonday | count | self class ensureWeekBeginsOnMonday. count _ self numberOfWeeksInMonthBeginningOn: self jul012002. self assert: count = 5! ! !DateTestCase methodsFor: 'Testing' stamp: 'sbw 1/31/2003 18:50'! testWeeksInMonthBeginningOnMondayWeekBeginsOnSunday | count | self class ensureWeekBeginsOnSunday. count _ self numberOfWeeksInMonthBeginningOn: self jul012002. self assert: count = 5. ! ! !DateTestCase methodsFor: 'Testing' stamp: 'sbw 1/31/2003 18:52'! testWeeksInMonthBeginningOnSaturdayWeekBeginsOnMonday | count | self class ensureWeekBeginsOnMonday. count _ self numberOfWeeksInMonthBeginningOn: self jun012002. self assert: count = 5! ! !DateTestCase methodsFor: 'Testing' stamp: 'sbw 1/31/2003 18:52'! testWeeksInMonthBeginningOnSaturdayWeekBeginsOnSunday | count | self class ensureWeekBeginsOnSunday. count _ self numberOfWeeksInMonthBeginningOn: self jun012002. self assert: count = 6. ! ! !DateTestCase methodsFor: 'Testing' stamp: 'sbw 1/31/2003 18:52'! testWeeksInMonthBeginningOnSundayWeekBeginsOnMonday | count | self class ensureWeekBeginsOnMonday. count _ self numberOfWeeksInMonthBeginningOn: self dec012002. self assert: count = 6! ! !DateTestCase methodsFor: 'Testing' stamp: 'sbw 1/31/2003 18:53'! testWeeksInMonthBeginningOnSundayWeekBeginsOnSunday | count | self class ensureWeekBeginsOnSunday. count _ self numberOfWeeksInMonthBeginningOn: self dec012002. self assert: count = 5. ! ! !DateTestCase methodsFor: 'private' stamp: 'sbw 2/1/2003 21:04'! dec012002 "December 1st, 2002 was a Sunday. When weeks begin on Sunday, December 2002 has 5 weeks. When weeks begin on Monday, December 2002 has 6 weeks." ^ Date fromString: '12.01.2002'! ! !DateTestCase methodsFor: 'private' stamp: 'sbw 2/1/2003 21:03'! jul012002 "July 1st, 2002 was a Monday. When weeks begin on Sunday, July 2002 has 5 weeks. When weeks begin on Monday, July 2002 has 5 weeks." ^ Date fromString: '07.01.2002'! ! !DateTestCase methodsFor: 'private' stamp: 'sbw 2/1/2003 21:02'! jun012002 "June 1st, 2002 was a Saturday. When weeks begin on Sunday, June 2002 has 6 weeks. When weeks begin on Monday, June 2002 has 5 weeks." ^ Date fromString: '06.01.2002'! ! !DateTestCase methodsFor: 'private' stamp: 'sbw 2/2/2003 05:13'! numberOfWeeksInMonthBeginningOn: aDate | month | month _ aDate month. ^month weeksInMonth! ! !DateTestCase methodsFor: 'private' stamp: 'sbw 1/31/2003 17:36'! setUp super setUp. self class savePreviousWeekStartValue! ! !DateTestCase methodsFor: 'private' stamp: 'sbw 1/31/2003 18:06'! sevenDaysBeginningWith: aDate | date result | date _ aDate. result _ OrderedCollection new. result add: date. 6 timesRepeat: [date _ date addDays: 1. result add: date]. ^ result! ! !DateTestCase methodsFor: 'private' stamp: 'sbw 1/31/2003 18:06'! sevenDaysBeginningWithDec012002 ^self sevenDaysBeginningWith: self dec012002! ! !DateTestCase methodsFor: 'private' stamp: 'sbw 1/31/2003 18:06'! sevenDaysBeginningWithJul012002 ^ self sevenDaysBeginningWith: self jul012002! ! !DateTestCase methodsFor: 'private' stamp: 'sbw 1/31/2003 17:37'! tearDown self class restorePreviousWeekStartValue. super tearDown! ! !DateTestCase class methodsFor: 'Accessing' stamp: 'sbw 1/31/2003 17:30'! previousWeekStartValue ^PreviousWeekStartValue! ! !DateTestCase class methodsFor: 'Accessing' stamp: 'sbw 1/31/2003 17:30'! previousWeekStartValue: aBoolean PreviousWeekStartValue _ aBoolean! ! !DateTestCase class methodsFor: 'utility' stamp: 'sbw 1/31/2003 18:37'! ensureWeekBeginsOnMonday Week setWeekToStartOnMonday! ! !DateTestCase class methodsFor: 'utility' stamp: 'sbw 1/31/2003 18:38'! ensureWeekBeginsOnSunday Week setWeekToStartOnSunday! ! !DateTestCase class methodsFor: 'utility' stamp: 'sbw 1/31/2003 17:34'! restorePreviousWeekStartValue | boolean | boolean := self previousWeekStartValue. boolean isNil ifFalse: [Week setWeekToStartOnMonday: boolean]! ! !DateTestCase class methodsFor: 'utility' stamp: 'sbw 1/31/2003 17:32'! savePreviousWeekStartValue self previousWeekStartValue: Week startMonday copy! ! !Month methodsFor: 'inquiries' stamp: 'sbw 2/2/2003 06:02'! weeksInMonth "Answers the number of weeks in a month. The first week of a month is usually also the last week of the previous month except when the month begins on the first day of the week." | count | count _ 0. self eachWeekDo: [:x | count _ count + 1]. ^count! ! !Week methodsFor: 'inquiries' stamp: 'sbw 2/2/2003 17:30'! indexInMonth: aMonth "1=first week, 2=second week, etc." "Some weeks live in 2 months." ^ aMonth firstDate week = self ifTrue: [1] ifFalse: [(Date dayOfWeek: aMonth weekday) + self dayOfMonth - 2 // 7 + 1]! ! !Week class methodsFor: 'class variables' stamp: 'sbw 1/30/2003 09:33'! setWeekToStartOnMonday self setWeekToStartOnMonday: true! ! !Week class methodsFor: 'class variables' stamp: 'sbw 1/30/2003 09:33'! setWeekToStartOnMonday: aBoolean StartMonday _ aBoolean! ! !Week class methodsFor: 'class variables' stamp: 'sbw 1/30/2003 09:33'! setWeekToStartOnSunday self setWeekToStartOnMonday: false! ! !DateTestCase reorganize! ('Testing' testDayOfWeekBeginningOnMonday testDayOfWeekBeginningOnSunday testDayOfWeekLookupWeekBeginsOnMonday testDayOfWeekLookupWeekBeginsOnSunday testDayOfWeekNameBeginningOnMonday testDayOfWeekNameBeginningOnSunday testFirstWeekIndexesWithWeekBeginningOnMonday testFirstWeekIndexesWithWeekBeginningOnSunday testWeeksInMonthBeginningOnMondayWeekBeginsOnMonday testWeeksInMonthBeginningOnMondayWeekBeginsOnSunday testWeeksInMonthBeginningOnSaturdayWeekBeginsOnMonday testWeeksInMonthBeginningOnSaturdayWeekBeginsOnSunday testWeeksInMonthBeginningOnSundayWeekBeginsOnMonday testWeeksInMonthBeginningOnSundayWeekBeginsOnSunday) ('private' dec012002 jul012002 jun012002 numberOfWeeksInMonthBeginningOn: setUp sevenDaysBeginningWith: sevenDaysBeginningWithDec012002 sevenDaysBeginningWithJul012002 tearDown) !