From: Arran Cudbard-Bell <a.cudbardb@freeradius.org>
Date: Wed, 25 Aug 2021 18:57:14 +0000 (-0500)
Subject: Move perl xlat tests into the module module
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=6e3dafdcd90450d572ec77a678539f3d8d67255c;p=thirdparty%2Ffreeradius-server.git

Move perl xlat tests into the module module
---

diff --git a/src/tests/keywords/radius.conf b/src/tests/keywords/radius.conf
index c07b8660ff1..14fa4de67da 100644
--- a/src/tests/keywords/radius.conf
+++ b/src/tests/keywords/radius.conf
@@ -52,11 +52,6 @@ modules {
 	mschap {
 
 	}
-
-	perl {
-		filename = ${keyword}/perl.conf
-		func_xlat = xlat
-	}
 }
 
 policy {
diff --git a/src/tests/modules/perl/module.conf b/src/tests/modules/perl/module.conf
index c4ea5b5f693..0a8094235ff 100644
--- a/src/tests/modules/perl/module.conf
+++ b/src/tests/modules/perl/module.conf
@@ -25,4 +25,9 @@ perl {
 
 client {
 
-}
\ No newline at end of file
+}
+
+perl perl_xlat {
+	filename = $ENV{MODULE_TEST_DIR}/xlat.pl
+	func_xlat = xlat
+}
diff --git a/src/tests/modules/perl/xlat.attrs b/src/tests/modules/perl/xlat.attrs
new file mode 100644
index 00000000000..e92a8b3383d
--- /dev/null
+++ b/src/tests/modules/perl/xlat.attrs
@@ -0,0 +1,12 @@
+#
+#  Input packet
+#
+Packet-Type = Access-Request
+User-Name = "bob"
+User-Password = "hello"
+raw.17 = 0xabcdef
+
+#
+#  Expected answer
+#
+Packet-Type == Access-Accept
diff --git a/src/tests/keywords/perl.conf b/src/tests/modules/perl/xlat.pl
similarity index 100%
rename from src/tests/keywords/perl.conf
rename to src/tests/modules/perl/xlat.pl
diff --git a/src/tests/modules/perl/xlat.unlang b/src/tests/modules/perl/xlat.unlang
new file mode 100644
index 00000000000..d5045ea9bf3
--- /dev/null
+++ b/src/tests/modules/perl/xlat.unlang
@@ -0,0 +1,97 @@
+#
+#  PRE: update
+#
+#  TODO
+#  A number of these tests return multiple values - either arrays, or hashes.
+#  Currently xlats have all returned values concatenated into a single value box -
+#  once multiple retuned boxes are handled to produce multiple attributes the tests
+#  will need amending.
+
+update request {
+	&Tmp-String-0 := "hello,goodbye,welcome,farewell"
+	&Tmp-String-1 := "foo,bar"
+}
+update request{
+	&Tmp-String-2 := "%(perl_xlat:xlat %{Tmp-String-0})"
+}
+
+if (&Tmp-String-2 != "hello|goodbye|welcome|farewell") {
+	test_fail
+}
+
+# Check for multiple arguments to perl function
+update request {
+	&Tmp-String-3 := "%(perl_xlat:xlat %{Tmp-String-0} %{Tmp-String-1})"
+}
+
+if (&Tmp-String-3 != "hello|goodbye|welcome|farewell#foo|bar") {
+	test_fail
+}
+
+update request {
+	&Tmp-Integer-0 := "%(perl_xlat:add 1 2 3)"
+}
+
+if (&Tmp-Integer-0 != 6) {
+	test_fail
+}
+
+
+update request {
+	&Tmp-String-0 := "hello"
+	&Tmp-String-0 += "goodbye"
+	&Tmp-String-0 += "welcome"
+}
+
+# Pass a list as an array
+update request {
+	&Tmp-String-2 := "%(perl_xlat:xlatarray %{Tmp-String-0[*]})"
+}
+
+if (&Tmp-String-2 != "hello|goodbye|welcome") {
+	test_fail
+}
+
+update request {
+	&Tmp-String-0 := "aa bb cc dd ee"
+}
+
+# Expect an array of returned values
+update request {
+	&Tmp-String-2 := "%(perl_xlat:xlatscalar2array %{Tmp-String-0})"
+}
+
+if (&Tmp-String-2 != "aabbccddee") {
+	test_fail
+}
+
+update request {
+	&Tmp-String-1 := "ff gg hh ii"
+}
+
+# Expect an array of array ref returned values
+update request {
+	&Tmp-String-2 := "%(perl_xlat:xlatscalar2arrayref %{Tmp-String-0} %{Tmp-String-1})"
+}
+
+if (&Tmp-String-2 != "aabbccddeeffgghhii") {
+	test_fail
+}
+
+update request {
+	&Tmp-String-0 := "a"
+	&Tmp-String-0 += "b"
+	&Tmp-String-0 += "c"
+}
+
+# Returns a hash with each element in the provided array converted to Vn->value
+update request {
+	&Tmp-String-2 := "%(perl_xlat:xlatarray2hash %{Tmp-String-0[*]})"
+}
+
+# Note: hashes don't have a defined sequence so these are all the possible return values
+if (&Tmp-String-2 != "V1aV2bV3c") && (&Tmp-String-2 != "V1aV3cV2b") && (&Tmp-String-2 != "V2bV1aV3c") && (&Tmp-String-2 != "V2bV3cV1a") && (&Tmp-String-2 != "V3cV1aV2b") && (&Tmp-String-2 != "V3cV2bV1a") {
+	test_fail
+}
+
+test_pass