SmalltalkImage >> postFailedLoad:. Fixes #1237.

lang/src/Kernel-Infrastructure.js

@@ -3628,6 +3628,56 @@ return $recv($recv($globals.Compiler)._new())._parse_(aString);
 }; }),
 $globals.SmalltalkImage);
 
+$core.addMethod(
+$core.method({
+selector: "postFailedLoad:",
+protocol: "image",
+//>>excludeStart("ide", pragmas.excludeIdeData);
+args: ["aPackage"],
+source: "postFailedLoad: aPackage\x0a\x09| keys descriptors |\x0a\x09Smalltalk removePackage: aPackage name.\x0a\x09keys := Set new.\x0a\x09descriptors := self core packageDescriptors.\x0a\x09descriptors keysAndValuesDo: [ :key :value | keys add: key ].\x0a\x09keys do: [ :each |\x0a\x09\x09Smalltalk removePackage: each.\x0a\x09\x09descriptors removeKey: each ]",
+referencedClasses: ["Smalltalk", "Set"],
+//>>excludeEnd("ide");
+pragmas: [],
+messageSends: ["removePackage:", "name", "new", "packageDescriptors", "core", "keysAndValuesDo:", "add:", "do:", "removeKey:"]
+}, function ($methodClass){ return function (aPackage){
+var self=this,$self=this;
+var keys,descriptors;
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+return $core.withContext(function($ctx1) {
+//>>excludeEnd("ctx");
+[$recv($globals.Smalltalk)._removePackage_($recv(aPackage)._name())
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+,$ctx1.sendIdx["removePackage:"]=1
+//>>excludeEnd("ctx");
+][0];
+keys=$recv($globals.Set)._new();
+descriptors=$recv($self._core())._packageDescriptors();
+$recv(descriptors)._keysAndValuesDo_((function(key,value){
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+return $core.withContext(function($ctx2) {
+//>>excludeEnd("ctx");
+return $recv(keys)._add_(key);
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+}, function($ctx2) {$ctx2.fillBlock({key:key,value:value},$ctx1,1)});
+//>>excludeEnd("ctx");
+}));
+$recv(keys)._do_((function(each){
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+return $core.withContext(function($ctx2) {
+//>>excludeEnd("ctx");
+$recv($globals.Smalltalk)._removePackage_(each);
+return $recv(descriptors)._removeKey_(each);
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+}, function($ctx2) {$ctx2.fillBlock({each:each},$ctx1,2)});
+//>>excludeEnd("ctx");
+}));
+return self;
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+}, function($ctx1) {$ctx1.fill(self,"postFailedLoad:",{aPackage:aPackage,keys:keys,descriptors:descriptors})});
+//>>excludeEnd("ctx");
+}; }),
+$globals.SmalltalkImage);
+
 $core.addMethod(
 $core.method({
 selector: "postLoad",
@@ -3825,17 +3875,18 @@ selector: "removePackage:",
 protocol: "packages",
 //>>excludeStart("ide", pragmas.excludeIdeData);
 args: ["packageName"],
-source: "removePackage: packageName\x0a\x09\x22Removes a package and all its classes.\x22\x0a\x0a\x09| pkg |\x0a\x09pkg := self packageAt: packageName ifAbsent: [ self error: 'Missing package: ', packageName ].\x0a\x09pkg classes do: [ :each |\x0a\x09\x09\x09self removeClass: each ].\x0a\x09self packageDictionary removeKey: packageName",
-referencedClasses: [],
+source: "removePackage: packageName\x0a\x09\x22Removes a package and all its classes.\x22\x0a\x0a\x09| pkg |\x0a\x09pkg := self packageAt: packageName ifAbsent: [ self error: 'Missing package: ', packageName ].\x0a\x09pkg classes do: [ :each |\x0a\x09\x09\x09self removeClass: each ].\x0a\x09self packageDictionary removeKey: packageName.\x0a\x09\x0a\x09SystemAnnouncer current\x0a\x09announce: (PackageRemoved new\x0a\x09\x09package: pkg;\x0a\x09\x09yourself)",
+referencedClasses: ["SystemAnnouncer", "PackageRemoved"],
 //>>excludeEnd("ide");
 pragmas: [],
-messageSends: ["packageAt:ifAbsent:", "error:", ",", "do:", "classes", "removeClass:", "removeKey:", "packageDictionary"]
+messageSends: ["packageAt:ifAbsent:", "error:", ",", "do:", "classes", "removeClass:", "removeKey:", "packageDictionary", "announce:", "current", "package:", "new", "yourself"]
 }, function ($methodClass){ return function (packageName){
 var self=this,$self=this;
 var pkg;
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 return $core.withContext(function($ctx1) {
 //>>excludeEnd("ctx");
+var $1,$2;
 pkg=$self._packageAt_ifAbsent_(packageName,(function(){
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 return $core.withContext(function($ctx2) {
@@ -3855,6 +3906,10 @@ return $self._removeClass_(each);
 //>>excludeEnd("ctx");
 }));
 $recv($self._packageDictionary())._removeKey_(packageName);
+$1=$recv($globals.SystemAnnouncer)._current();
+$2=$recv($globals.PackageRemoved)._new();
+$recv($2)._package_(pkg);
+$recv($1)._announce_($recv($2)._yourself());
 return self;
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 }, function($ctx1) {$ctx1.fill(self,"removePackage:",{packageName:packageName,pkg:pkg})});

lang/src/Kernel-Infrastructure.st

@@ -968,6 +968,17 @@ globalJsVariables
 
 !SmalltalkImage methodsFor: 'image'!
 
+postFailedLoad: aPackage
+	| keys descriptors |
+	Smalltalk removePackage: aPackage name.
+	keys := Set new.
+	descriptors := self core packageDescriptors.
+	descriptors keysAndValuesDo: [ :key :value | keys add: key ].
+	keys do: [ :each |
+		Smalltalk removePackage: each.
+		descriptors removeKey: each ]
+!
+
 postLoad
 	^ self adoptPackageDescriptors then: [ :pkgs |
 		| classes |
@@ -1026,7 +1037,12 @@ removePackage: packageName
 	pkg := self packageAt: packageName ifAbsent: [ self error: 'Missing package: ', packageName ].
 	pkg classes do: [ :each |
 			self removeClass: each ].
-	self packageDictionary removeKey: packageName
+	self packageDictionary removeKey: packageName.
+	
+	SystemAnnouncer current
+	announce: (PackageRemoved new
+		package: pkg;
+		yourself)
 !
 
 renamePackage: packageName to: newName

lang/src/Platform-ImportExport.js

@@ -3889,17 +3889,21 @@ selector: "load",
 protocol: "loading",
 //>>excludeStart("ide", pragmas.excludeIdeData);
 args: [],
-source: "load\x0a\x09^ (self commitHandler load: self package)\x0a\x09\x09then: [ Smalltalk postLoad ]",
+source: "load\x0a\x09^ ((self commitHandler load: self package)\x0a\x09\x09then: [ Smalltalk postLoad ])\x0a\x09\x09catch: [ :e | Smalltalk postFailedLoad: self package. e pass ]",
 referencedClasses: ["Smalltalk"],
 //>>excludeEnd("ide");
 pragmas: [],
-messageSends: ["then:", "load:", "commitHandler", "package", "postLoad"]
+messageSends: ["catch:", "then:", "load:", "commitHandler", "package", "postLoad", "postFailedLoad:", "pass"]
 }, function ($methodClass){ return function (){
 var self=this,$self=this;
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 return $core.withContext(function($ctx1) {
 //>>excludeEnd("ctx");
-return $recv($recv($self._commitHandler())._load_($self._package()))._then_((function(){
+return $recv($recv($recv($self._commitHandler())._load_([$self._package()
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+,$ctx1.sendIdx["package"]=1
+//>>excludeEnd("ctx");
+][0]))._then_((function(){
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 return $core.withContext(function($ctx2) {
 //>>excludeEnd("ctx");
@@ -3907,6 +3911,15 @@ return $recv($globals.Smalltalk)._postLoad();
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 }, function($ctx2) {$ctx2.fillBlock({},$ctx1,1)});
 //>>excludeEnd("ctx");
+})))._catch_((function(e){
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+return $core.withContext(function($ctx2) {
+//>>excludeEnd("ctx");
+$recv($globals.Smalltalk)._postFailedLoad_($self._package());
+return $recv(e)._pass();
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+}, function($ctx2) {$ctx2.fillBlock({e:e},$ctx1,2)});
+//>>excludeEnd("ctx");
 }));
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 }, function($ctx1) {$ctx1.fill(self,"load",{})});

lang/src/Platform-ImportExport.st

@@ -1016,8 +1016,9 @@ setupFromJson: anObject
 !PackageTransport methodsFor: 'loading'!
 
 load
-	^ (self commitHandler load: self package)
-		then: [ Smalltalk postLoad ]
+	^ ((self commitHandler load: self package)
+		then: [ Smalltalk postLoad ])
+		catch: [ :e | Smalltalk postFailedLoad: self package. e pass ]
 ! !
 
 PackageTransport class slots: {#registry}!