Ticket #19176: patch-uninstall.diff

src/port1.0/portinstall.tcl

@@ -128 +128 @@
 }
 
 proc install_main {args} {
-        global portname portversion portpath categories description long_description homepage depends_run installPlist package-install uninstall workdir worksrcdir pregrefix UI_PREFIX destroot portrevision maintainers ports_force portvariants targets depends_lib PortInfo epoch
+        global portname portversion portpath categories description long_description homepage depends_run installPlist package-install workdir worksrcdir pregrefix UI_PREFIX destroot portrevision maintainers ports_force portvariants targets depends_lib PortInfo epoch
 
         # Begin the registry entry
         set regref [registry_new $portname $portversion $portrevision $portvariants $epoch]
@@ -168 +168 @@
                 registry_prop_store $regref package-install ${package-install}
     }
     if {[info proc pkg_uninstall] == "pkg_uninstall"} {
-                registry_prop_store $regref uninstall [proc_disasm pkg_uninstall]
+                registry_prop_store $regref pkg_uninstall [proc_disasm pkg_uninstall]
     }
         
         registry_write $regref 
@@ -176 +176 @@
     return 0
 }
 
+#
+# apparent usage of pkg_uninstall variable in the registry
+# the Portfile needs to define a procedure
+# proc pkg_uninstall {portname portver} {
+#     body of proc
+# }
+# which gets stored above into the registry pkg_uninstall variable
+# this is then called by the portuninstall procedure
+# note that in general the portuninstall procedure is not called within
+# the context of its port so many usual port variables do not exist
+# e.g. destroot/workpath/filespath
+ 
+# this procedure encodes the pkg_uninstall body so that it can be stored in the
+# the receipt file
 proc proc_disasm {pname} {
     set p "proc "
-    append p $pname " \{"
+    append p $pname " {"
     set space ""
     foreach arg [info args $pname] {
         if {[info default $pname $arg value]} {
@@ -188 +202 @@
         }
         set space " "
     }
-    append p "\} \{" [info body $pname] "\}"
+    append p "} {" [string map { \n \\n } [info body $pname] ] " }"
     return $p
 }

src/registry1.0/portuninstall.tcl

@@ -140 +140 @@
         # Look to see if the port has registered an uninstall procedure
         set uninstall [registry::property_retrieve $ref pkg_uninstall] 
         if { $uninstall != 0 } {
-                if {![catch {eval $uninstall} err]} {
+                if {![catch {eval [string map { \\n \n } $uninstall]} err]} {
+                        ui_info "Executing pkg_uninstall procedure"
                         pkg_uninstall $portname ${version}_${revision}${variants}
                 } else {
                         global errorInfo