Index: openacs-4/packages/acs-automated-testing/tcl/tclwebtest-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-automated-testing/tcl/tclwebtest-procs.tcl,v
diff -u -r1.1 -r1.1.2.1
--- openacs-4/packages/acs-automated-testing/tcl/tclwebtest-procs.tcl	31 Mar 2004 12:11:09 -0000	1.1
+++ openacs-4/packages/acs-automated-testing/tcl/tclwebtest-procs.tcl	20 Apr 2004 14:06:53 -0000	1.1.2.1
@@ -20,6 +20,8 @@
     the request a number of times if it fails because of a socket
     connect problem.
 } {
+    aa_log "twt::do_request $page_url"
+
     # Qualify page_url if necessary
     if { [regexp {^/} $page_url] } {
         set page_url "[twt::server_url]${page_url}"
@@ -53,11 +55,11 @@
     if { $error_p } {
         # Either some non-socket error, or a socket problem occuring with more than
         # $retry_max times. Propagate the error while retaining the stack trace
+        aa_log "twt::do_request failed with error=\"$errmsg\" response_url=\"[tclwebtest::response url]\". See error log for the HTML response body"
+        ns_log Error "twt::do_request failed with error=\"$errmsg\" response_url=\"[tclwebtest::response url]\" response_body=\"[tclwebtest::response body]\""
         global errorInfo
         error $errmsg $errorInfo
     }
-
-    #::twt::acs_lang::check_no_keys
 }
 
 ad_proc twt::log { message } {
@@ -89,8 +91,11 @@
 
 ad_proc twt::user::create { 
     {-user_id {}}
+    {-admin:boolean}
  } {
     Create a test user with random email and password for testing
+
+     @param admin Provide this switch to make the user site-wide admin
     
     @return The user_info array list returned by auth::create_user. Contains
             the additional keys email and password.
@@ -119,6 +124,13 @@
     set user_info(password) $password
     set user_info(email) $email
 
+    aa_log "Created user with email=\"$email\" and password=\"$password\""
+
+    if { $admin_p } {
+        aa_log "Making user site-wide admin"
+        permission::grant -object_id [acs_magic_object "security_context_root"] -party_id $user_info(user_id) -privilege "admin"
+    }
+
     return [array get user_info]
 }
 
@@ -134,7 +146,7 @@
 
 ad_proc twt::user::login { email password } {
 
-    ::twt::user::logout
+    tclwebtest::cookies clear
 
     # Request the start page
     ::twt::do_request "[twt::server_url]/register"
@@ -146,6 +158,20 @@
     tclwebtest::field find ~n password
     tclwebtest::field fill $password
     tclwebtest::form submit
+
+    # Verify that user is actually logged in and throw error otherwise
+    set home_uri "/pvt/home"
+    twt::do_request $home_uri
+    set response_url [tclwebtest::response url]
+    if { ![string match "*${home_uri}*" $response_url] } {
+        if { [empty_string_p [cc_lookup_email_user $email]] } {
+            error "Failed to login user with email=\"$email\" and password=\"$password\". No user with such email in database."
+        } else {
+            ns_log Error "Failed to log in user with email=\"$email\" and password=\"$password\" eventhough email exists (password may be incorrect). response_body=[tclwebtest::response body]"
+            error "Failed to log in user with email=\"$email\" and password=\"$password\" eventhough email exists (password may be incorrect). User should be able to request $home_uri without redirection, however response url=$response_url"
+
+        }
+    }
 }
 
 ad_proc twt::user::logout {} {
Index: openacs-4/packages/acs-automated-testing/tcl/test/acs-automated-testing-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-automated-testing/tcl/test/acs-automated-testing-procs.tcl,v
diff -u -r1.1 -r1.1.2.1
--- openacs-4/packages/acs-automated-testing/tcl/test/acs-automated-testing-procs.tcl	31 Mar 2004 12:11:10 -0000	1.1
+++ openacs-4/packages/acs-automated-testing/tcl/test/acs-automated-testing-procs.tcl	20 Apr 2004 14:06:57 -0000	1.1.2.1
@@ -1,153 +1,11 @@
-##############################################################################
-#
-#   Copyright 2001, OpenMSG Ltd, Peter Harper.
-#
-#   This file is part of acs-automated-testing.
-#
-##############################################################################
+ad_library {
+    Automated tests.
 
-aa_register_init_class "my_init" {
-  An example chunk of initialisation code.
-} {
-  # Constructor
-  aa_export_vars {my_var1 my_var2}
-  
-  set my_var1 "Variable 1"
-  set my_var2 "Variable 2"
-  aa_equals "Do a dummy test on my_var1" $my_var1 "Variable 1"
-  aa_log "Do a test log message"
-} {
-  # Descructor
-  # aa_log, aa_equals, aa_true and aa_false all ignored here.
-  set _my_var1 $my_var1
-  set _my_var2 $my_var2
-  aa_log "Do a log message that should be ignored"
+    @author Peter Marklund
+    @creation-date 20 April 2004
+    @cvs-id $Id$
 }
 
-
-aa_register_init_class "my_init2" {
-  An second example chunk of initialisation code.
-} {
-  # Constructor
-  aa_log "The second constructor"
-} {
-  # Descructor
-  aa_log "The second destructor"
-}
-
-
-aa_register_component "my_component" {
-  An example chunk of component code.
-} {
-  aa_export_vars {an_example_value}
-  set an_example_value 1000
-  aa_log "Log message from the example component my_component"
-}
-
-aa_register_case -cats {
-  tcl
-} -init_classes {
-  my_init
-} "aa_example-000" {
-  Tests successful audit writing.
-} {
-  aa_call_component "my_component"
-} {
-  set test_value 1056
-
-  aa_stub aa_example_write_audit_entry {
-    switch $sequence_id {
-      1 {
-        aa_equals "aa_example_write_audit_entry" $name "name1"
-        aa_equals "aa_example_write_audit_entry" $value "value1"
-        return 1
-      }
-      2 {
-        aa_equals "aa_example_write_audit_entry" $name "name2"
-        aa_equals "aa_example_write_audit_entry" $value "value2"
-        return 1
-      }
-    }
-  }
-
-  set entries {{"name1" "value1"} {"name2" "value2"}}
-  set entries_ex $entries
-
-  set result [aa_example_write_audit_entries $entries]
-
-  aa_log "This is a test log message"
-  aa_true "return value true" $result
-  aa_equals "entries parameter not currupted" $entries $entries_ex
-} {
-  aa_equals "Check that test_value is visible here" $test_value "1056"
-  aa_equals "Check that my_component set value is visible here" $an_example_value "1000"
-}
-
-aa_register_case -cats {
-  tcl
-} -init_classes {
-  my_init my_init2
-} "aa-example-001" {
-  Tests un-successful audit writing.
-  First call succeeds, second fails
-} {
-  aa_stub aa_example_write_audit_entry {
-    switch $sequence_id {
-      1 {
-        aa_equals "aa_example_write_audit_entry, name" $name "name1"
-        aa_equals "aa_example_write_audit_entry, value" $value "value1"
-        return 1
-      }
-      2 {
-        aa_equals "aa_example_write_audit_entry, name" $name "name2"
-        aa_equals "aa_example_write_audit_entry, value" $value "value2"
-        return 0
-      }
-    }
-  }
-
-  set entries {{"name1" "value1"} {"name2" "value2"}}
-  set entries_ex $entries
-
-  set result [aa_example_write_audit_entries $entries]
-
-  aa_false "return value false" $result
-  aa_equals "entries parameter not currupted" $entries $entries_ex
-}
-
-aa_register_case -cats {
-  tcl
-} "aa_example-002" {
-  Tests un-successful audit writing.
-  First call fails.
-} {
-  aa_stub aa_example_write_audit_entry {
-    switch $sequence_id {
-      1 {
-        aa_equals "aa_example_write_audit_entry, name" $name "name1"
-        aa_equals "aa_example_write_audit_entry, value" $value "value1"
-        return 0
-      }
-    }
-  }
-
-  set entries {{"name1" "value1"} {"name2" "value2"}}
-  set entries_ex $entries
-
-  set result [aa_example_write_audit_entries $entries]
-
-  aa_false "return value false" $result
-  aa_equals "entries parameter not corrupted" $entries $entries_ex
-}
-
-aa_register_case -cats {
-    security_risk
-} "aa_example-exclusion-security-risk" {
-    If security-risk is not checked, this test shouldn't run
-} {
-    aa_log "Unless security-risk is was checked, you shouldn't see this test."
-}
-
 aa_register_case -cats {web smoke} -libraries tclwebtest tclwebtest_example {
     A simple test case demonstrating the use of tclwebtest (HTTP level testing).
 
@@ -160,9 +18,11 @@
             # Create test user
             array set user_info [twt::user::create -user_id $user_id]
 
+            # Login user
             twt::user::login $user_info(email) $user_info(password)
 
-            twt::do_request "/acs-lang"
+            # Visit homepage
+            twt::do_request "/"
 
         } -teardown_code {
             # TODO: delete test user