Index: openacs-4/packages/acs-tcl/tcl/apm-install-procs-oracle.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/apm-install-procs-oracle.xql,v
diff -u -r1.9 -r1.10
--- openacs-4/packages/acs-tcl/tcl/apm-install-procs-oracle.xql 30 Sep 2003 12:10:03 -0000 1.9
+++ openacs-4/packages/acs-tcl/tcl/apm-install-procs-oracle.xql 12 Jul 2004 11:12:38 -0000 1.10
@@ -286,4 +286,11 @@
+
+
+
+ select apm_package_version.sortable_version_name(:version) from dual
+
+
+
Index: openacs-4/packages/acs-tcl/tcl/apm-install-procs-postgresql.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/apm-install-procs-postgresql.xql,v
diff -u -r1.13 -r1.14
--- openacs-4/packages/acs-tcl/tcl/apm-install-procs-postgresql.xql 25 Feb 2003 16:42:12 -0000 1.13
+++ openacs-4/packages/acs-tcl/tcl/apm-install-procs-postgresql.xql 12 Jul 2004 11:12:38 -0000 1.14
@@ -147,21 +147,21 @@
-
-
+
+
- select apm_package_version__sortable_version_name('$f1_version_from');
-
+ select apm_package_version__sortable_version_name(:f1_version_from);
+
-
-
+
+
- select apm_package_version__sortable_version_name('$f2_version_from');
-
+ select apm_package_version__sortable_version_name(:f2_version_from);
+
@@ -237,4 +237,10 @@
+
+
+ select apm_package_version__sortable_version_name(:version)
+
+
+
Index: openacs-4/packages/acs-tcl/tcl/apm-install-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/apm-install-procs.tcl,v
diff -u -r1.79 -r1.80
--- openacs-4/packages/acs-tcl/tcl/apm-install-procs.tcl 8 Jul 2004 14:19:58 -0000 1.79
+++ openacs-4/packages/acs-tcl/tcl/apm-install-procs.tcl 12 Jul 2004 11:12:38 -0000 1.80
@@ -1686,6 +1686,16 @@
ns_log Notice "apm_mount_core_packages: Finished mounting of core packages"
}
+ad_proc -public apm_version_sortable {
+ version
+} {
+ Return a sortable version of the version name.
+
+ @author Jeff Davis
+} {
+ return [db_string sortable_version {}]
+}
+
ad_proc -public apm_version_names_compare {
version_name_1
version_name_2
Index: openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl,v
diff -u -r1.40 -r1.41
--- openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl 29 Jun 2004 10:17:44 -0000 1.40
+++ openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl 12 Jul 2004 11:12:38 -0000 1.41
@@ -790,9 +790,12 @@
set count 0
while 1 {
- if { [incr count] > 1000 } {
- error "There appears to be a programming bug in ad_html_to_text: We've entered an infinite loop."
- }
+ if {[incr count] > 1000 } {
+ # JCD: the programming bug is that an unmatched < in the input runs off forever looking for
+ # it's closing > and in some long text like program listings you can have lots of quotes
+ # before you find that >
+ error "There appears to be a programming bug in ad_html_to_text: We've entered an infinite loop."
+ }
# Find the positions of the first quote, apostrophe and greater-than sign.
set quote_idx [string first \" $html $i]
set apostrophe_idx [string first ' $html $i]
Index: openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl,v
diff -u -r1.26 -r1.27
--- openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl 5 Jul 2004 16:28:23 -0000 1.26
+++ openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl 12 Jul 2004 11:12:39 -0000 1.27
@@ -747,7 +747,7 @@
aa_register_case -cats {db smoke production_safe} acs-tcl__named_constraints {
Check that there are no tables with unnamed constraints
-
+ @author Jeff Davis davis@xarg.net
} {
switch -exact -- [db_name] {
PostgreSQL {
@@ -812,6 +812,63 @@
}
}
+aa_register_case -cats {smoke production_safe} acs-tcl__check_upgrade_ordering {
+ Check that all the upgrade files are well ordered (non-overlapping and v1 > v2)
+
+ @author Jeff Davis davis@xarg.net
+} {
+ foreach dir [lsort [glob -nocomplain -types f "[acs_root_dir]/packages/*/*.info"]] {
+
+ set error_p 0
+
+ regexp {/([^/]*).info} $dir match package
+ set files [apm_get_package_files -package_key $package -file_types data_model_upgrade]
+
+ # build list of files for each db type, sort, check strict ordering.
+ foreach db_type {postgresql oracle} {
+ set upgrades [list]
+ foreach file $files {
+ set db [apm_guess_db_type $package $file]
+ if {[string is space $db]
+ || [string equal $db $db_type]} {
+ set tail [file tail $file]
+ if {[regexp {\-(.*)-(.*).sql} $tail match v1 v2]} {
+ set v1s [apm_version_sortable $v1]
+ set v2s [apm_version_sortable $v2]
+ if {[string compare $v1s $v2s] > -1} {
+ set error_p 1
+ aa_log_result fail "$file: from after to version"
+ } else {
+ lappend upgrades [list $v1s $v2s $v1 $v2 $file]
+ }
+ } else {
+ set error_p 1
+ aa_log_result fail "$file: could not find version numbers"
+ }
+ }
+ }
+
+ # if we have more than 1 upgrade check they are well ordered.
+ if {[llength $upgrades] > 1} {
+ set u1 [lsort -dictionary -index 0 $upgrades]
+ set u2 [lsort -dictionary -index 1 $upgrades]
+
+ foreach f1 $u1 f2 $u2 {
+ if {![string equal $f1 $f2]} {
+ set error_p 1
+ aa_log_result fail "$package upgrade not well ordered [lindex $f1 end] [lindex $f2 end]\n"
+ }
+ }
+ }
+ }
+
+ if {!$error_p} {
+ aa_log_result pass "$package upgrades well ordered"
+ }
+ }
+}
+
+
aa_register_case -cats {api smoke} util__randomize_list {
Test util::randomize_list
} {
@@ -836,7 +893,7 @@
aa_register_case -cats {api} acs_tcl__util_url_valid_p {
A very rudimentary test of util_url_valid_p
-
+
@creation-date 2004-01-10
@author Branimir Dolicki (bdolicki@branimir.com)
} {