Index: openacs-4/packages/acs-api-browser/tcl/test/acs-api-browser-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-api-browser/tcl/test/acs-api-browser-procs.tcl,v
diff -u -r1.4.2.23 -r1.4.2.24
--- openacs-4/packages/acs-api-browser/tcl/test/acs-api-browser-procs.tcl 16 Feb 2021 20:59:02 -0000 1.4.2.23
+++ openacs-4/packages/acs-api-browser/tcl/test/acs-api-browser-procs.tcl 19 Feb 2021 10:08:49 -0000 1.4.2.24
@@ -402,6 +402,67 @@
}
+aa_register_case \
+ -cats {smoke production_safe} \
+ -procs {
+ aa_error
+ api_called_proc_names
+ apidoc::get_doc_property
+ } \
+ callgraph__bad_calls {
+
+ Checks for calls of deprecated procs and for private calls in
+ other packages. Remember: "private" means "package private", a
+ "private" proc must be only directly called by a proc of the
+ same package
+
+ This test covers only library functions.
+
+ @author Gustaf Neumann
+
+ @creation-date 2020-02-18
+ } {
+
+ foreach caller [lsort -dictionary [nsv_array names api_proc_doc]] {
+ #set caller db_transaction
+ set called_procs [api_called_proc_names -proc_name $caller]
+ set caller_deprecated_p [apidoc::get_doc_property $caller deprecated_p 0]
+ set caller_package_key [apidoc::get_doc_property $caller package_key ""]
+ foreach called $called_procs {
+ #ns_log notice "$caller calls $called"
+ set msg "proc $caller calls deprecated proc: $called"
+ if {[apidoc::get_doc_property $called deprecated_p 0]} {
+ if {$caller_deprecated_p} {
+ aa_log_result warning "deprecated $msg"
+ } else {
+ aa_error "$msg
\
+ [apidoc::get_doc_property $caller script]
\
+ [apidoc::get_doc_property $called script]
"
+ }
+ }
+ set package_key [apidoc::get_doc_property $called package_key ""]
+ if {$caller_package_key ne ""
+ && $package_key ne ""
+ && $caller_package_key ne $package_key
+ } {
+ if {[apidoc::get_doc_property $called protection public] eq "private"
+ && ![string match AcsSc.* $caller]
+ } {
+ set msg "proc $caller_package_key.$caller calls private $package_key.$called"
+ if {$caller_deprecated_p} {
+ aa_log_result warning "deprecated $msg"
+ } else {
+ aa_error "$msg
\
+ [apidoc::get_doc_property $caller script]
\
+ [apidoc::get_doc_property $called script]
"
+ }
+ }
+ }
+ }
+ }
+ }
+}
+
# Local variables:
# mode: tcl
# tcl-indent-level: 4