Skip to content

Commit

Permalink
60433
Browse files Browse the repository at this point in the history
19809 Failing test: WeakAnnouncerTest>>#testNoDeadWeakSubscriptions
	https://pharo.fogbugz.com/f/cases/19809

19799 Nautilus rebuilds the package view twice when adding a new protocol
	https://pharo.fogbugz.com/f/cases/19799

19810 Non weak announcements in the SystemAnnouncer
	https://pharo.fogbugz.com/f/cases/19810

http://files.pharo.org/image/60/60433.zip
  • Loading branch information
Jenkins Build Server authored and ci committed Mar 7, 2017
1 parent 2277855 commit e72b6dd
Show file tree
Hide file tree
Showing 9 changed files with 50 additions and 38 deletions.
Expand Up @@ -20,6 +20,4 @@ registerToSystemAnnouncements
when: MethodModified send: #methodModified: to: self;
when: MethodRecategorized send: #methodRecategorized: to: self;
when: MethodRemoved send: #methodRemoved: to: self;
when: ProtocolAdded send: #classReorganized: to: self;
when: ProtocolRemoved send: #classReorganized: to: self;
when: MetalinkChanged send: #metaLinkModified: to: self.
@@ -1,5 +1,10 @@
compiledMethod: aCompiledMethod

compiledMethod := aCompiledMethod.
class := aCompiledMethod methodClass.
ast := compiledMethod ast.
SystemAnnouncer uniqueInstance when: ASTCacheReset send: #reinstallASTInCache to: self

SystemAnnouncer uniqueInstance weak
when: ASTCacheReset
send: #reinstallASTInCache
to: self
@@ -1,4 +1,4 @@
script60432
script60433

^ 'AST-Core-TheIntegrator.492.mcz
AST-Tests-Core-TheIntegrator.134.mcz
Expand Down Expand Up @@ -222,7 +222,7 @@ Multilingual-TextConversion-TheIntegrator.83.mcz
Multilingual-TextConverterOtherLanguages-TheIntegrator.4.mcz
NECompletion-TheIntegrator.257.mcz
NECompletion-Tests-TheIntegrator.10.mcz
Nautilus-TheIntegrator.1354.mcz
Nautilus-TheIntegrator.1357.mcz
Nautilus-GroupManager-TheIntegrator.24.mcz
Nautilus-GroupManagerUI-TheIntegrator.44.mcz
Nautilus-Tests-TheIntegrator.52.mcz
Expand Down Expand Up @@ -278,7 +278,7 @@ Refactoring-Tests-Critics-TheIntegrator.54.mcz
Refactoring-Tests-Environment-TheIntegrator.30.mcz
ReflectionMirrors-Primitives-TheIntegrator.9.mcz
ReflectionMirrors-Primitives-Tests-TheIntegrator.6.mcz
Reflectivity-TheIntegrator.320.mcz
Reflectivity-TheIntegrator.323.mcz
Reflectivity-Examples-TheIntegrator.46.mcz
Reflectivity-Tests-TheIntegrator.219.mcz
Reflectivity-Tools-TheIntegrator.73.mcz
Expand Down Expand Up @@ -373,7 +373,7 @@ System-Support-TheIntegrator.1269.mcz
System-Support-Rules-TheIntegrator.2.mcz
System-SupportTests-TheIntegrator.5.mcz
System-VMEvents-TheIntegrator.19.mcz
Tests-TheIntegrator.790.mcz
Tests-TheIntegrator.794.mcz
Text-Core-TheIntegrator.66.mcz
Text-Diff-TheIntegrator.6.mcz
Text-Edition-TheIntegrator.126.mcz
Expand Down Expand Up @@ -409,9 +409,9 @@ TxText-Styler-HenrikNergaard.18.mcz
TxTextTests-Model-SeanDeNigris.29.mcz
UIManager-TheIntegrator.195.mcz
Unicode-Initialization-TheIntegrator.17.mcz
UnifiedFFI-EstebanLorenzano.96.mcz
UnifiedFFI-Legacy-TheIntegrator.4.mcz
UnifiedFFI-Tests-TheIntegrator.42.mcz
UnifiedFFI-EstebanLorenzano.97.mcz
UnifiedFFI-Legacy-EstebanLorenzano.3.mcz
UnifiedFFI-Tests-EstebanLorenzano.41.mcz
UpdateStreamer-Core-TheIntegrator.34.mcz
UpdateStreamer-Tests-TheIntegrator.9.mcz
Versionner-Commit-TheIntegrator.38.mcz
Expand Down

This file was deleted.

@@ -0,0 +1,14 @@
update60433
"self new update60433"
self withUpdateLog: '19809 Failing test: WeakAnnouncerTest>>#testNoDeadWeakSubscriptions
https://pharo.fogbugz.com/f/cases/19809
19799 Nautilus rebuilds the package view twice when adding a new protocol
https://pharo.fogbugz.com/f/cases/19799
19810 Non weak announcements in the SystemAnnouncer
https://pharo.fogbugz.com/f/cases/19810'.
self loadTogether: self script60433 merge: false.

(SystemAnnouncer uniqueInstance subscriptions glmSubscriptions select: [:sub | sub subscriber isNil]) do: #finalize. 3 timesRepeat: [Smalltalk garbageCollect ].
self flushCaches.
@@ -1,9 +1,9 @@
commentForCurrentUpdate
^ '19808 add timeout and cache per session to catalog
https://pharo.fogbugz.com/f/cases/19808
^ '19809 Failing test: WeakAnnouncerTest>>#testNoDeadWeakSubscriptions
https://pharo.fogbugz.com/f/cases/19809
19803 MCSTWriterTest>>#testMethodDefinitionWithBangs failing on bootstrapped image
https://pharo.fogbugz.com/f/cases/19803
19799 Nautilus rebuilds the package view twice when adding a new protocol
https://pharo.fogbugz.com/f/cases/19799
19811 some methods are wrong in DynamicLoader
https://pharo.fogbugz.com/f/cases/19811'
19810 Non weak announcements in the SystemAnnouncer
https://pharo.fogbugz.com/f/cases/19810'
@@ -1,8 +1,12 @@
testNoDeadSubscriptions

| dead |

3 timesRepeat: [ Smalltalk garbageCollect ].

self deny: (
(SystemAnnouncer uniqueInstance subscriptions instVarNamed: #subscriptions) anySatisfy: [ :sub |
sub subscriber isNil ]
)
dead := SystemAnnouncer uniqueInstance
subscriptions subscriptions select: [ :sub |
sub subscriber isNil
].

self assert: dead asArray equals: #()
@@ -1,9 +1,12 @@
testOnlyWeakSubscriptions

"only weak subscriptions should be allowed to be added to the SystemAnnouncer..."
| strong |

"only weak subscriptions should be allowed to be added to the SystemAnnouncer..."

strong := SystemAnnouncer uniqueInstance
subscriptions subscriptions reject: [ :each |
each isKindOf: WeakAnnouncementSubscription
].

"self assert: (
(SystemAnnouncer uniqueInstance subscriptions instVarNamed: #subscriptions)
allSatisfy: [ :sub | sub isKindOf: WeakAnnouncementSubscription ]
)"
self assert: strong asArray equals: #()
@@ -1,4 +1,4 @@
testSaneSubscriptionSize

self flag: 'this should be a release test, not a regular one'
"self flag: 'this should be a release test, not a regular one'"
"self assert: SystemAnnouncer uniqueInstance subscriptions numberOfSubscriptions < 75."

0 comments on commit e72b6dd

Please sign in to comment.