summaryrefslogtreecommitdiffstats
path: root/dcopperl/test.pl
diff options
context:
space:
mode:
authortoma <toma@283d02a7-25f6-0310-bc7c-ecb5cbfe19da>2009-11-25 17:56:58 +0000
committertoma <toma@283d02a7-25f6-0310-bc7c-ecb5cbfe19da>2009-11-25 17:56:58 +0000
commit90825e2392b2d70e43c7a25b8a3752299a933894 (patch)
treee33aa27f02b74604afbfd0ea4f1cfca8833d882a /dcopperl/test.pl
downloadtdebindings-90825e2392b2d70e43c7a25b8a3752299a933894.tar.gz
tdebindings-90825e2392b2d70e43c7a25b8a3752299a933894.zip
Copy the KDE 3.5 branch to branches/trinity for new KDE 3.5 features.
BUG:215923 git-svn-id: svn://anonsvn.kde.org/home/kde/branches/trinity/kdebindings@1054174 283d02a7-25f6-0310-bc7c-ecb5cbfe19da
Diffstat (limited to 'dcopperl/test.pl')
-rw-r--r--dcopperl/test.pl123
1 files changed, 123 insertions, 0 deletions
diff --git a/dcopperl/test.pl b/dcopperl/test.pl
new file mode 100644
index 00000000..0402395e
--- /dev/null
+++ b/dcopperl/test.pl
@@ -0,0 +1,123 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+BEGIN {
+ print <<EOT;
+Now that you've built the DCOP extension, it's time to run some tests on it.
+The first of them will just run by themselves, after that, there will be
+some interactive ones.
+
+EOT
+print "Loading...";
+}
+
+END {print "failed\n" unless $loaded;}
+use DCOP;
+$loaded = 1;
+print "done\n";
+
+######################### End of black magic.
+
+my $ok;
+
+sub check {
+ my $res = shift;
+ print $res ? "." : "!";
+ $ok = undef unless $res;
+}
+
+my ($client, $desk);
+
+sub attach {
+ $client = new DCOP;
+ check (ref $client) eq "DCOP";
+ check !$client->isAttached();
+ check $client->attach();
+ check $client->isAttached();
+ check $client->detach();
+ check !$client->isAttached();
+# For now, as register is disabled
+ $client->attach();
+}
+
+sub register {
+ check (my $appid = $client->registerAs("perltests"));
+ print "[$appid]";
+ check $client->isRegistered();
+ check $client->appId() eq $appid;
+ check ($appid = $client->registerAs("perltests", undef));
+ print "[$appid]";
+ check $client->isRegistered();
+ check $client->appId() eq $appid;
+}
+
+sub query {
+ check (my $list = $client->registeredApplications());
+ print "[$#$list]";
+ check ($list = $client->remoteObjects("kdesktop"));
+ print "[$#$list]";
+ check ($list = $client->remoteInterfaces("kdesktop", "qt"));
+ print "[$#$list]";
+ check ($list = $client->remoteFunctions("kdesktop", "qt"));
+ print "[$#$list]";
+ check grep /^QCStringList functions\(\)$/, @$list;
+}
+
+sub calls {
+ check (my $list = $client->call("kdesktop", "qt", "objects()"));
+ print "[$#$list]";
+ check grep m#^qt/kdesktop$#, @$list;
+}
+
+sub magic {
+ check ($desk = $client->createObject("kdesktop"));
+ check (ref $desk) eq "DCOP::Object";
+ check (my ($list) = $desk->interfaces());
+ print "[$#$list]";
+ check grep /^KDesktopIface$/, @$list;
+}
+
+sub icons {
+ check scalar $desk->selectAll();
+ sleep 1;
+ check scalar $desk->unselectAll();
+}
+
+sub saver {
+ check ($desk = $client->createObject("kdesktop")) unless defined $desk;
+ check (my ($saver) = $desk->screenSaver());
+ check (ref $saver) eq "DCOP::Object";
+ check scalar $saver->save();
+}
+
+@tests = (
+ ["simple attachments", \&attach],
+# ["full registration", \&register],
+ ["tree queries", \&query],
+ ["calls", \&calls],
+ ["autoload magic", \&magic],
+ ["more autoload magic", \&icons,
+ "The next test should cause all icons on your desktop to be selected\nand deselected again."],
+ ["DCOPRefs", \&saver,
+ "The next test should activate your screen saver."],
+ );
+
+foreach (@tests) {
+ my ($msg, $test, $confirm) = @{$_};
+ if ($confirm) {
+ print "$confirm\nDo you want this test to be performed? [Y/n]";
+ my $answer = <>;
+ next unless ($answer =~ /^\s*$/ || $answer =~ /^[yY]/);
+ }
+ printf "%-25s", $msg;
+ $ok = 1;
+ &$test();
+ unless ($ok) {
+ print "failed\n";
+ exit 1;
+ }
+ print "passed\n";
+}
+