Index: openacs-4/packages/acs-tcl/tcl/test/datamodel-test-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/datamodel-test-procs.tcl,v diff -u -r1.20 -r1.21 --- openacs-4/packages/acs-tcl/tcl/test/datamodel-test-procs.tcl 3 Nov 2018 11:15:16 -0000 1.20 +++ openacs-4/packages/acs-tcl/tcl/test/datamodel-test-procs.tcl 3 Sep 2024 15:37:34 -0000 1.21 @@ -1,5 +1,5 @@ ad_library { - Sweep the all the files in the system looking for systematic errors. + Sweep all the files in the system looking for systematic errors. @author Jeff Davis @creation-date 2005-02-28 @@ -8,9 +8,13 @@ aa_register_case \ - -cats {db smoke production_safe} \ + -cats {api db smoke production_safe} \ -error_level warning \ - -procs {} \ + -procs { + db_name + aa_log_result + ad_decode + } \ datamodel__named_constraints { Check that all the constraints meet the constraint naming @@ -22,7 +26,8 @@ set db_is_pg_p [string equal [db_name] "PostgreSQL"] if { $db_is_pg_p } { - set get_constraints "select + set get_constraints { + select cla.relname as table_name, con.conrelid, con.conname as constraint_name, @@ -35,28 +40,43 @@ END as constraint_type, con.conkey, '' as search_condition - from + from pg_constraint con, pg_class cla - where con.conrelid != 0 and cla.oid=con.conrelid - order by table_name,constraint_name" - set get_constraint_col "select attname from pg_attribute where attnum = :columns_list and attrelid = :conrelid" + where con.conrelid != 0 and cla.oid=con.conrelid + order by table_name,constraint_name + } + set get_constraint_col { + select attname from pg_attribute where attnum = :columns_list and attrelid = :conrelid + } } else { # Oracle - set get_constraints "select + set get_constraints { + select acc.*, ac.search_condition, decode(ac.constraint_type,'C','CK','R','FK','P','PK','U','UN','') as constraint_type - from - (select count(column_name) as columns, table_name, constraint_name from user_cons_columns group by table_name, constraint_name) acc, - user_constraints ac - where ac.constraint_name = acc.constraint_name - order by acc.table_name, acc.constraint_name" - set get_constraint_col "select column_name from user_cons_columns where constraint_name = :constraint_name" + from + (select count(column_name) as columns, table_name, constraint_name + from user_cons_columns group by table_name, constraint_name) acc, user_constraints ac + where ac.constraint_name = acc.constraint_name + order by acc.table_name, acc.constraint_name + } + set get_constraint_col { + select column_name from user_cons_columns where constraint_name = :constraint_name + } } db_foreach check_constraints $get_constraints { if { $db_is_pg_p || [string last "$" $table_name] eq -1 } { + if {[string range $constraint_name 0 2] eq "pg_"} { + # + # Don't complain about PostgreSQL not naming its + # constraints according to the OpenACS rules. + # + continue + } + regsub {_[[:alpha:]]+$} $constraint_name "" name_without_type set standard_name "${name_without_type}_${constraint_type}" set standard_name_alt "${name_without_type}_[ad_decode $constraint_type pk pkey fk fkey un key ck ck missing]" @@ -71,28 +91,47 @@ set column_name [db_string get_col $get_constraint_col] # NOT NULL constraints (oracle only) - if { [string equal $search_condition "\"$column_name\" IS NOT NULL"] } { + if { $search_condition eq "\"$column_name\" IS NOT NULL" } { set constraint_type "NN" } - set standard_name ${table_name}_${column_name}_${constraint_type} + set full_name ${table_name}_${column_name}_${constraint_type} - if { [string length $standard_name] > 30 } { + if { [string length $full_name] < 30 } { # Only check the abbreviation - set standard_name "${name_without_type}_${constraint_type}" + set checked_name $full_name + } else { + set checked_name $standard_name } + } else { + set checked_name $standard_name } # Giving a hint for constraint naming - if {[string range $standard_name 0 2] eq "SYS"} { + if {[string range $checked_name 0 2] eq "SYS"} { set hint "unnamed" } else { - set hint "hint: $standard_name" + set hint "hint: $checked_name" } - if { $standard_name ne $constraint_name - && $standard_name_alt ne $constraint_name } { - aa_log_result fail "Table $table_name constraint $constraint_name ($constraint_type) violates naming standard ($hint)" + if { $checked_name ne $constraint_name } { + set oversized [expr {[string length $constraint_name] >= 30}] + set oversized_checked [expr {[string length $checked_name] >= 30}] + if {!$oversized && $oversized_checked} { + # + # Don't complain, if the standard name is + # oversized, but the chosen variant is not. + # + } else { + # + # Too many entries for the log, we the information as well in the protocol + # + aa_silence_log_entries -severities warning { + aa_log_result fail "Constraint '$constraint_name' ($constraint_type)" \ + " violates naming standard ($hint)" \ + " oversized $oversized oversized by standard naming $oversized_checked" + } + } } } } @@ -102,7 +141,10 @@ aa_register_case \ -cats {db smoke production_safe} \ - -procs {db_table_exists} \ + -procs { + db_table_exists + aa_log_result + } \ datamodel__acs_object_type_check { Check that the object type tables exist and that the id column is @@ -164,7 +206,10 @@ aa_register_case \ -cats {db smoke production_safe} \ - -procs {db_column_type db_columns} \ + -procs { + db_column_type db_columns + aa_log_result + } \ datamodel__acs_attribute_check { Check that the acs_attribute column is present and the