Index: openacs-4/packages/acs-tcl/tcl/object-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/object-procs.tcl,v
diff -u -N -r1.14.2.10 -r1.14.2.11
--- openacs-4/packages/acs-tcl/tcl/object-procs.tcl	29 Jul 2022 18:54:26 -0000	1.14.2.10
+++ openacs-4/packages/acs-tcl/tcl/object-procs.tcl	8 Aug 2022 11:01:07 -0000	1.14.2.11
@@ -185,36 +185,42 @@
     -no_hierarchy:boolean
 } {
     Returns whether an object is of a given object type.
+
+    @return boolean
 } {
     if { ![string is integer -strict $object_id] } {
         return 0
     }
-    return [acs::per_request_cache eval \
-                -key acs-tcl.acs_object.is_type_p($object_id,$object_types,$no_hierarchy_p) {
-                    set object_types [ns_dbquotelist $object_types]
-                    set no_hierarchy_p [expr {$no_hierarchy_p ? "t" : "f"}]
-                    db_0or1row check_types [subst -nocommands {
-                        with recursive hierarchy as
-                        (
-                         select o.object_type::varchar(1000), t.supertype
-                         from acs_objects o, acs_object_types t
-                         where o.object_id = :object_id
-                           and o.object_type = t.object_type
 
-                         union
+    set object [acs::per_request_cache eval \
+                    -key acs-tcl.acs_object.is_type_p($object_id,$object_types,$no_hierarchy_p) {
 
-                         select t.object_type::varchar(1000), t.supertype
-                         from acs_object_types t,
-                              hierarchy h
-                         where :no_hierarchy_p = 'f'
-                           and t.object_type = h.supertype
-                           and h.object_type not in ($object_types)
-                         )
-                        select 1 from hierarchy
-                        where object_type in ($object_types)
-                        fetch first 1 rows only
+                        set object_type [acs_object_type $object_id]
+
+                        if {$object_type eq ""} {
+                            # Object was not found
+                            return 0
+                        } elseif {$object_type in $object_types} {
+                            # Object is one of the types we look for
+                            return 1
+                        } elseif {$no_hierarchy_p} {
+                            # Object is not one of the types we look
+                            # for and we were told to not look into
+                            # the hierarchy
+                            return 0
+                        } else {
+                            # We expand the object type hierarchy and
+                            # see if one of our supertypes is a type
+                            # we look for
+                            foreach supertype [acs_object_type::supertypes -subtype $object_type] {
+                                if {$supertype in $object_types} {
+                                    return 1
+                                }
+                            }
+
+                            return 0
+                        }
                     }]
-                }]
 }
 
 ad_proc -public acs_object::set_context_id {
Index: openacs-4/packages/acs-tcl/tcl/object-type-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/object-type-procs.tcl,v
diff -u -N -r1.15 -r1.15.2.1
--- openacs-4/packages/acs-tcl/tcl/object-type-procs.tcl	15 Jun 2018 08:39:48 -0000	1.15
+++ openacs-4/packages/acs-tcl/tcl/object-type-procs.tcl	8 Aug 2022 11:01:07 -0000	1.15.2.1
@@ -120,9 +120,12 @@
     if {$no_cache_p} {
         return [db_list supertypes {}]
     } else {
-        return [util_memoize [list acs_object_type::supertypes \
-            -subtype $subtype \
-            -no_cache]]
+        return [acs::per_thread_cache eval \
+                    -key acs-tcl.acs_object_type.supertypes($subtype) {
+                        util_memoize [list acs_object_type::supertypes \
+                                          -subtype $subtype \
+                                          -no_cache]
+                    }]
     }
 }
 
Index: openacs-4/packages/acs-tcl/tcl/test/object-test-case-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/object-test-case-procs.tcl,v
diff -u -N -r1.9.2.7 -r1.9.2.8
--- openacs-4/packages/acs-tcl/tcl/test/object-test-case-procs.tcl	15 Jul 2022 13:58:40 -0000	1.9.2.7
+++ openacs-4/packages/acs-tcl/tcl/test/object-test-case-procs.tcl	8 Aug 2022 11:01:07 -0000	1.9.2.8
@@ -167,6 +167,7 @@
     smoke
 } -procs {
     acs_object::is_type_p
+    acs_object_type::supertypes
 } is_object_type_p {
     Test the acs_object::is_type_p proc.
 } {
@@ -201,6 +202,23 @@
         aa_false "Is $object_id a party (no hierachy)?" \
             [acs_object::is_type_p -object_id $object_id -object_type party -no_hierarchy]
 
+        aa_true "Is $object_id a user os a package?" \
+            [acs_object::is_type_p -object_id $object_id -object_type {apm_package user}]
+        aa_true "Is $object_id a person or a package?" \
+            [acs_object::is_type_p -object_id $object_id -object_type {apm_package person}]
+        aa_true "Is $object_id a party or a package?" \
+            [acs_object::is_type_p -object_id $object_id -object_type {apm_package party}]
+        aa_true "Is $object_id a user or a package (no hierachy)?" \
+            [acs_object::is_type_p -object_id $object_id -object_type {apm_package user} -no_hierarchy]
+        aa_false "Is $object_id a person or a package (no hierachy)?" \
+            [acs_object::is_type_p -object_id $object_id \
+                 -object_type {apm_package person} \
+                 -no_hierarchy]
+        aa_false "Is $object_id a party or a package (no hierachy)?" \
+            [acs_object::is_type_p -object_id $object_id \
+                 -object_type {apm_package party} -no_hierarchy]
+
+
         aa_section "Create an object and check"
         set object_id [package_instantiate_object acs_object]
         aa_true "Is $object_id an acs_object?" \