1#! /usr/perl5/bin/perl
2#
3# CDDL HEADER START
4#
5# The contents of this file are subject to the terms of the
6# Common Development and Distribution License (the "License").
7# You may not use this file except in compliance with the License.
8#
9# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
10# or http://www.opensolaris.org/os/licensing.
11# See the License for the specific language governing permissions
12# and limitations under the License.
13#
14# When distributing Covered Code, include this CDDL HEADER in each
15# file and include the License file at usr/src/OPENSOLARIS.LICENSE.
16# If applicable, add the following below this CDDL HEADER, with the
17# fields enclosed by brackets "[]" replaced with your own identifying
18# information: Portions Copyright [yyyy] [name of copyright owner]
19#
20# CDDL HEADER END
21#
22
23#
24# Copyright 2006 Sun Microsystems, Inc.  All rights reserved.
25# Use is subject to license terms.
26#
27# ident	"%Z%%M%	%I%	%E% SMI"
28#
29
30#
31# Tests for Sun::Solaris::Lgrp API.
32#
33# Before `make install' is performed this script should be runnable with
34# `make test'. After `make install' it should work as `perl Lgrp.t'
35#
36# The test uses Test module which is available on Perl 5.6 and later.
37#
38
39
40use strict;
41use warnings;
42use Test;
43
44# Tests to run
45BEGIN { plan tests => 63 }
46
47use Sun::Solaris::Lgrp ':ALL';
48
49#
50######################################################################
51
52my ($home, $fail);
53
54######################################################################
55# Check that all exported constants can be accessed.
56$fail = 0;
57foreach my $constname (qw(
58	LGRP_AFF_NONE LGRP_AFF_STRONG LGRP_AFF_WEAK LGRP_CONTENT_DIRECT
59	LGRP_CONTENT_HIERARCHY LGRP_MEM_SZ_FREE
60	LGRP_MEM_SZ_INSTALLED LGRP_VER_CURRENT LGRP_VER_NONE
61	LGRP_VIEW_CALLER LGRP_VIEW_OS LGRP_RSRC_CPU LGRP_RSRC_MEM
62	LGRP_CONTENT_ALL LGRP_LAT_CPU_TO_MEM)) {
63  next if (eval "my \$a = $constname; 1");
64  $fail++;
65}
66
67ok($fail,  0, 'All Constants defined' );
68
69#########################
70
71######################################################################
72# Verify lgrp_version
73##
74my $version = lgrp_version(-1);
75ok($version, LGRP_VER_NONE, 'incorrect lgrp version unsupported');
76
77$version = lgrp_version(LGRP_VER_NONE);
78ok($version, LGRP_VER_CURRENT, 'lgrp version is current');
79
80$version = lgrp_version(LGRP_VER_CURRENT);
81ok($version, LGRP_VER_CURRENT, 'support LGRP_VER_CURRENT version');
82#
83#######################################################################
84
85######################################################################
86# Verify that lgrp_init()/lgrp_fini work.
87##
88my $c = lgrp_init(LGRP_VIEW_CALLER);
89ok($c) or
90    die("lgrp_init: $!");
91
92my $view = lgrp_view($c);
93
94ok($view, LGRP_VIEW_CALLER, 'View is LGRP_VIEW_CALLER');
95
96my $fin = lgrp_fini($c);
97ok($fin);
98
99# Try to free it again, it should fail.
100$fin = lgrp_fini($c);
101ok($fin, undef, 'lgrp_fini second time should fail');
102
103$c = lgrp_init(LGRP_VIEW_OS);
104ok($c) or
105    die("lgrp_init: $!");
106
107$view = lgrp_view($c);
108
109ok($view, LGRP_VIEW_OS, 'View is LGRP_VIEW_OS');
110#
111######################################################################
112
113######################################################################
114# root should have ID 0.
115##
116my $root = lgrp_root($c);
117ok($root, 0, 'root should have id zero');
118#
119######################################################################
120# Verify lgrp_nlgrps()
121##
122my $nlgrps = lgrp_nlgrps($c);
123ok($nlgrps);
124
125my @lgrps = lgrp_lgrps($c);
126ok(@lgrps);
127ok(scalar @lgrps, $nlgrps, 'lgrp_nlgrps() should match number of lgrps');
128ok($nlgrps, lgrp_lgrps($c), 'lgrp_lgrps() in scalar context is sane');
129
130######################################################################
131# All root children should have root as their one and only one parent
132##
133$fail = 0;
134my @children = lgrp_children($c, $root);
135ok(scalar @children, lgrp_children($c, $root), 'lgrp_children as scalar');
136my @leaves = lgrp_leaves $c;
137ok(scalar @leaves);
138ok(scalar @leaves, lgrp_leaves $c);
139ok(scalar @children <= scalar @leaves);
140
141my @parents;
142
143my $fail_lgrp_parents = 0;
144
145foreach my $l (@children) {
146    @parents = lgrp_parents($c, $l) or
147	(print STDERR "# lgrp_parents: $!\n"), $fail++, last;
148    my $nparents = @parents;
149    my ($parent, @rest) = @parents;
150    $fail++ if $parent != $root;
151    $fail++ unless $nparents == 1;
152    $fail_lgrp_parents++ if $nparents != lgrp_parents($c, $l);
153}
154ok($fail, 0, 'correct parents for children');
155ok($fail_lgrp_parents, 0, 'correct lgrp_parents() as scalar');
156
157######################################################################
158# Illegal parents have no children
159##
160@children = lgrp_children($c, -1);
161my $nchildren = lgrp_children($c, -1);
162ok(scalar @children, 0, 'Illegal parents have no children');
163# Same in scalar context
164ok($nchildren, undef, 'No children means undef as scalar');
165
166######################################################################
167# root should have no parents.
168##
169@parents = lgrp_parents($c, $root);
170ok(scalar @parents, 0, 'root should have no parents');
171# Same in scalar context
172ok(lgrp_parents($c, $root), 0);
173#
174######################################################################
175# Illegal children have no paremts
176##
177@parents = lgrp_parents($c, -1);
178my $nparents = lgrp_parents($c, -1);
179ok(scalar @parents, 0, 'Illegal children have no paremts');
180# Same in scalar context
181ok($nparents, undef, 'No parents means undef as scalar');
182#
183######################################################################
184# Root should have non-zero CPUs and memory size
185##
186my @cpus = lgrp_cpus($c, $root, LGRP_CONTENT_HIERARCHY);
187my $ncpus = lgrp_cpus($c, $root, LGRP_CONTENT_HIERARCHY);
188ok(scalar @cpus, $ncpus);
189ok($ncpus);
190ok(lgrp_mem_size($c, $root, LGRP_MEM_SZ_INSTALLED, LGRP_CONTENT_HIERARCHY));
191my @ncpus_bad = lgrp_cpus($c, $root, -1);
192ok(scalar @ncpus_bad, 0, 'Bad argument to lgrp_cpus should return empty');
193my $ncpus_bad = lgrp_cpus($c, $root, -1);
194ok($ncpus_bad, undef, 'Bad argument to lgrp_cpus should return undef');
195#
196######################################################################
197
198######################################################################
199# The cookie should not be stale
200#
201ok(! lgrp_cookie_stale($c));
202#
203######################################################################
204
205######################################################################
206# Can we call lgrp_latency?
207# The latencies from lgrp_latency and lgrp_latency_cookie should match.
208##
209my $latency = lgrp_latency($root, $root);
210ok(defined $latency);
211
212my $latency1 = lgrp_latency_cookie($c, $root, $root);
213ok(defined $latency1);
214ok($latency, $latency1, 'Latencies should match');
215#
216######################################################################
217# Can we call lgrp_resources?
218##
219my @lgrps_c = lgrp_resources($c, $root, LGRP_RSRC_CPU);
220my $nresources = lgrp_resources($c, $root, LGRP_RSRC_CPU);
221ok(!defined $nresources) if $version < 2;
222ok(scalar @lgrps_c, 0) if $version < 2;
223ok($nresources) if $version >= 2;
224ok(@lgrps_c) if $version >= 2;
225
226##
227# lgrp_fini should always succeed.
228ok(lgrp_fini($c));
229
230
231######################################################################
232# Now test Object-Oriented interface.
233##
234$c = Sun::Solaris::Lgrp->new or
235    die "Lgrp->new(LGRP_VIEW_OS): $!";
236
237ok($c->view, LGRP_VIEW_OS);
238ok($c->stale, 0, 'cookie is not stale');
239ok($nlgrps, $c->nlgrps, 'nlgrps');
240my @lg1 = $c->lgrps;
241ok(@lgrps, @lg1);
242my@leaves1 = $c->leaves;
243ok(@leaves, @leaves1) or
244    print STDERR "# \@leaves: @leaves, \@leaves1: @leaves\n";
245ok($root, $c->root);
246@cpus = lgrp_cpus($c->cookie, $root, LGRP_CONTENT_HIERARCHY);
247my @cpus1 = $c->cpus($root, LGRP_CONTENT_HIERARCHY);
248ok(@cpus, @cpus1) or
249    print STDERR "# \@cpus: @cpus, \@cpus1: @cpus1\n";
250ok(lgrp_latency($root, $root), $c->latency($root, $root));
251my @lgrps_c1 = $c->resources($root, LGRP_RSRC_CPU);
252ok(@lgrps_c, @lgrps_c1);
253ok(lgrp_version(LGRP_VER_NONE), $c->version);
254
255#
256######################################################################
257# Can we call lgrp_home?
258##
259$home = lgrp_home(P_PID, P_MYID);
260ok(defined($home));
261my $home1 = $c->home(P_PID, P_MYID);
262ok($home1 == $home);
263$home1 = lgrp_home(P_LWPID, 1);
264ok($home1 == $home);
265$home1 = $c->home(P_LWPID, 1);
266ok($home1 == $home);
267
268#
269######################################################################
270# Can we call lgrp_affinity_set?
271##
272my $affinity;
273
274ok(LGRP_AFF_WEAK);
275ok(P_LWPID);
276
277$affinity = $c->affinity_set(P_PID, P_MYID, $home, LGRP_AFF_WEAK);
278ok($affinity);
279
280$affinity = $c->affinity_set(P_LWPID, 1, $home, LGRP_AFF_WEAK);
281ok($affinity);
282
283$affinity = lgrp_affinity_set(P_PID, P_MYID, $home, LGRP_AFF_WEAK);
284ok($affinity);
285
286$affinity = lgrp_affinity_set(P_LWPID, 1, $home, LGRP_AFF_WEAK);
287ok($affinity);
288
289#
290######################################################################
291# Can we call lgrp_affinity_get?
292##
293$affinity = lgrp_affinity_get(P_PID, P_MYID, $home);
294ok($affinity = LGRP_AFF_WEAK);
295
296$affinity = lgrp_affinity_get(P_LWPID, 1, $home);
297ok($affinity == LGRP_AFF_WEAK);
298
299$affinity = $c->affinity_get(P_PID, P_MYID, $home);
300ok($affinity == LGRP_AFF_WEAK);
301
302$affinity = $c->affinity_get(P_LWPID, 1, $home);
303ok($affinity == LGRP_AFF_WEAK);
304
305#
306######################################################################
307# THE END!
308#########
309