antoniop
committed
on 05 Sep 19
Automated test for merge::MergeUserInfo
openacs-4/.../test/acs-admin-procs.tcl (+70 -1)
71 71             set right_sections_number 0
72 72         } else {
73 73             set right_sections_number 0
74 74             foreach section $sections {
75 75                 if {$section ne ""} {
76 76                     incr right_sections_number
77 77                 }
78 78             }
79 79             incr right_sections_number 2
80 80         }
81 81         set proc_sections [lindex [apm_parameter_section_slider $package_key] 0 3]
82 82         aa_true "Sections for '$package_key' are in the right number ([llength $proc_sections] == $right_sections_number)" {[llength $proc_sections] == $right_sections_number}
83 83         foreach section $proc_sections {
84 84             set section_name [lindex $section 0]
85 85             set section_length [llength $section]
86 86             aa_true "Section '$section_name' for '$package_key' is composed by 3 elements ($section_length)" {$section_length == 3}
87 87         }
88 88     }
89 89 }
90 90
  91 aa_register_case -cats {
  92     api smoke
  93 } -procs {
  94     merge::MergeUserInfo
  95 } acs_admin_merge_MergeUserInfo {
  96     Check merge::MergeUserInfo
  97 } {
  98     aa_run_with_teardown \
  99         -rollback \
  100         -test_code {
  101             # Create 2 dummy users
  102             set user_id_1 [dict get [acs::test::user::create] user_id]
  103             set user_id_2 [dict get [acs::test::user::create] user_id]
91 104
  105             # Fake non-image just to have a file to save
  106             set tmpnam [ad_tmpnam].png
  107             set wfd [open $tmpnam w]
  108             puts $wfd [string repeat a 1000]
  109             close $wfd
  110             # Give a fake portrait to user_1
  111             set portrait_id [acs_user::create_portrait \
  112                                  -user_id $user_id_1 \
  113                                  -file $tmpnam]
  114             file delete $tmpnam
  115
  116             # Get a random object none of the two users has write
  117             # privilege for
  118             set random_object [db_string get_object {
  119                 select min(object_id) from acs_objects
  120                 where not acs_permission.permission_p(object_id, :user_id_1, 'write')
  121                   and not acs_permission.permission_p(object_id, :user_id_2, 'write')
  122             }]
  123             # Set user_1 as fake creation user
  124             db_dml update_object {
  125                 update acs_objects set
  126                 creation_user = :user_id_1
  127                 where object_id = :random_object
  128             }
  129             # Give user_1 the privilege
  130             permission::grant -party_id $user_id_1 -object_id $random_object \
  131                 -privilege write
  132
  133             # Merge them
  134             merge::MergeUserInfo \
  135                 -from_user_id $user_id_1 \
  136                 -to_user_id $user_id_2
  137
  138             set portrait_id_2 [acs_user::get_portrait_id -user_id $user_id_2]
  139             aa_true "Users have now the same portrait ($portrait_id == $portrait_id_2)" \
  140                 {$portrait_id == $portrait_id_2}
  141
  142             set creation_user_2 [db_string get_creator {
  143                 select creation_user from acs_objects where object_id = :random_object
  144             }]
  145             aa_true "Creator of object '$random_object' is now user '$user_id_2'" \
  146                 {$creation_user_2 == $user_id_2}
  147
  148             aa_true "User '$user_id_2' has now write permission on object '$random_object'" \
  149                 [permission::permission_p \
  150                      -party_id $user_id_2 \
  151                      -object_id $random_object \
  152                      -privilege "write"]
  153             aa_false "User '$user_id_1' was revoked write permission on object '$random_object'" \
  154                 [permission::permission_p \
  155                      -party_id $user_id_1 \
  156                      -object_id $random_object \
  157                      -privilege "write"]
  158         }
  159 }
  160
92 161 # Local variables:
93 162 #    mode: tcl
94 163 #    tcl-indent-level: 4
95 164 #    indent-tabs-mode: nil
96 165 # End: