Add some tests of invalid attribute access

diff --git a/src/tests/modules/perl/list.unlang b/src/tests/modules/perl/list.unlang
index 6150e391162223a8da114597da563197055b0805..66ddb5e866a281233a4d4a288bc16c230e403e65 100644 (file)
--- a/src/tests/modules/perl/list.unlang
+++ b/src/tests/modules/perl/list.unlang
@@ -21,6 +21,33 @@ if (Filter-Id != 'Secondary' || Filter-Id[#] != 1 ) {
        test_fail
 }
 
+# Check we can't set a value on a tied hash
+perl.set_on_hash {
+       fail = 1
+}
+if (!fail) {
+       test_fail
+}
+
+# Check that setting an attribute instance more than one beyond the existing fails
+perl.set_beyond_limit {
+       fail = 1
+}
+if (!fail) {
+       test_fail
+}
+if (reply.Reply-Message[3] != 'Will set') {
+       test_fail
+}
+
+# Check that setting an invalid attribute fails
+perl.invalid_attr {
+       fail = 1
+}
+if (!fail) {
+       test_fail
+}
+
 reply := {}
 
 test_pass

diff --git a/src/tests/modules/perl/test.pl b/src/tests/modules/perl/test.pl
index cf3fe8391e7018ed0ce4e0c4f85110edcf44bf33..7bbef91a76af280e27564e78e72872a11eedf293 100644 (file)
--- a/src/tests/modules/perl/test.pl
+++ b/src/tests/modules/perl/test.pl
@@ -128,6 +128,22 @@ sub array_ops {
        return RLM_MODULE_OK;
 }
 
+sub set_on_hash {
+       my $p = shift();
+       $p->{'reply'}{'User-Name'} = 'bob';
+}
+
+sub set_beyond_limit {
+       my $p = shift();
+       $p->{'reply'}{'Reply-Message'}[3] = 'Will set';
+       $p->{'reply'}{'Reply-Message'}[10] = 'Will not set';
+}
+
+sub invalid_attr {
+       my $p = shift();
+       $p->{'reply'}{'Invalid-Attr'}[0] = 'Hello';
+}
+
 sub log_attributes {
        my %hash = %{$_[0]};
        my $indent = $_[1];