usr/src/cmd/perl/contrib/Sun/Solaris/Lgrp/t/Lgrp.t

   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
  40 use strict;
  41 use warnings;
  42 use Test;
  43
  44 # Tests to run
  45 BEGIN { plan tests => 63 }
  46
  47 use Sun::Solaris::Lgrp ':ALL';
  48
  49 #
  50 ######################################################################
  51
  52 my ($home, $fail);
  53
  54 ######################################################################
  55 # Check that all exported constants can be accessed.
  56 $fail = 0;
  57 foreach 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
  67 ok($fail,  0, 'All Constants defined' );
  68
  69 #########################
  70
  71 ######################################################################
  72 # Verify lgrp_version
  73 ##
  74 my $version = lgrp_version(-1);
  75 ok($version, LGRP_VER_NONE, 'incorrect lgrp version unsupported');
  76
  77 $version = lgrp_version(LGRP_VER_NONE);
  78 ok($version, LGRP_VER_CURRENT, 'lgrp version is current');
  79
  80 $version = lgrp_version(LGRP_VER_CURRENT);
  81 ok($version, LGRP_VER_CURRENT, 'support LGRP_VER_CURRENT version');
  82 #
  83 #######################################################################
  84
  85 ######################################################################
  86 # Verify that lgrp_init()/lgrp_fini work.
  87 ##
  88 my $c = lgrp_init(LGRP_VIEW_CALLER);
  89 ok($c) or
  90     die("lgrp_init: $!");
  91
  92 my $view = lgrp_view($c);
  93
  94 ok($view, LGRP_VIEW_CALLER, 'View is LGRP_VIEW_CALLER');
  95
  96 my $fin = lgrp_fini($c);
  97 ok($fin);
  98
  99 # Try to free it again, it should fail.
 100 $fin = lgrp_fini($c);
 101 ok($fin, undef, 'lgrp_fini second time should fail');
 102
 103 $c = lgrp_init(LGRP_VIEW_OS);
 104 ok($c) or
 105     die("lgrp_init: $!");
 106
 107 $view = lgrp_view($c);
 108
 109 ok($view, LGRP_VIEW_OS, 'View is LGRP_VIEW_OS');
 110 #
 111 ######################################################################
 112
 113 ######################################################################
 114 # root should have ID 0.
 115 ##
 116 my $root = lgrp_root($c);
 117 ok($root, 0, 'root should have id zero');
 118 #
 119 ######################################################################
 120 # Verify lgrp_nlgrps()
 121 ##
 122 my $nlgrps = lgrp_nlgrps($c);
 123 ok($nlgrps);
 124
 125 my @lgrps = lgrp_lgrps($c);
 126 ok(@lgrps);
 127 ok(scalar @lgrps, $nlgrps, 'lgrp_nlgrps() should match number of lgrps');
 128 ok($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;
 134 my @children = lgrp_children($c, $root);
 135 ok(scalar @children, lgrp_children($c, $root), 'lgrp_children as scalar');
 136 my @leaves = lgrp_leaves $c;
 137 ok(scalar @leaves);
 138 ok(scalar @leaves, lgrp_leaves $c);
 139 ok(scalar @children <= scalar @leaves);
 140
 141 my @parents;
 142
 143 my $fail_lgrp_parents = 0;
 144
 145 foreach 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 }
 154 ok($fail, 0, 'correct parents for children');
 155 ok($fail_lgrp_parents, 0, 'correct lgrp_parents() as scalar');
 156
 157 ######################################################################
 158 # Illegal parents have no children
 159 ##
 160 @children = lgrp_children($c, -1);
 161 my $nchildren = lgrp_children($c, -1);
 162 ok(scalar @children, 0, 'Illegal parents have no children');
 163 # Same in scalar context
 164 ok($nchildren, undef, 'No children means undef as scalar');
 165
 166 ######################################################################
 167 # root should have no parents.
 168 ##
 169 @parents = lgrp_parents($c, $root);
 170 ok(scalar @parents, 0, 'root should have no parents');
 171 # Same in scalar context
 172 ok(lgrp_parents($c, $root), 0);
 173 #
 174 ######################################################################
 175 # Illegal children have no paremts
 176 ##
 177 @parents = lgrp_parents($c, -1);
 178 my $nparents = lgrp_parents($c, -1);
 179 ok(scalar @parents, 0, 'Illegal children have no paremts');
 180 # Same in scalar context
 181 ok($nparents, undef, 'No parents means undef as scalar');
 182 #
 183 ######################################################################
 184 # Root should have non-zero CPUs and memory size
 185 ##
 186 my @cpus = lgrp_cpus($c, $root, LGRP_CONTENT_HIERARCHY);
 187 my $ncpus = lgrp_cpus($c, $root, LGRP_CONTENT_HIERARCHY);
 188 ok(scalar @cpus, $ncpus);
 189 ok($ncpus);
 190 ok(lgrp_mem_size($c, $root, LGRP_MEM_SZ_INSTALLED, LGRP_CONTENT_HIERARCHY));
 191 my @ncpus_bad = lgrp_cpus($c, $root, -1);
 192 ok(scalar @ncpus_bad, 0, 'Bad argument to lgrp_cpus should return empty');
 193 my $ncpus_bad = lgrp_cpus($c, $root, -1);
 194 ok($ncpus_bad, undef, 'Bad argument to lgrp_cpus should return undef');
 195 #
 196 ######################################################################
 197
 198 ######################################################################
 199 # The cookie should not be stale
 200 #
 201 ok(! 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 ##
 209 my $latency = lgrp_latency($root, $root);
 210 ok(defined $latency);
 211
 212 my $latency1 = lgrp_latency_cookie($c, $root, $root);
 213 ok(defined $latency1);
 214 ok($latency, $latency1, 'Latencies should match');
 215 #
 216 ######################################################################
 217 # Can we call lgrp_resources?
 218 ##
 219 my @lgrps_c = lgrp_resources($c, $root, LGRP_RSRC_CPU);
 220 my $nresources = lgrp_resources($c, $root, LGRP_RSRC_CPU);
 221 ok(!defined $nresources) if $version < 2;
 222 ok(scalar @lgrps_c, 0) if $version < 2;
 223 ok($nresources) if $version >= 2;
 224 ok(@lgrps_c) if $version >= 2;
 225
 226 ##
 227 # lgrp_fini should always succeed.
 228 ok(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
 237 ok($c->view, LGRP_VIEW_OS);
 238 ok($c->stale, 0, 'cookie is not stale');
 239 ok($nlgrps, $c->nlgrps, 'nlgrps');
 240 my @lg1 = $c->lgrps;
 241 ok(@lgrps, @lg1);
 242 my@leaves1 = $c->leaves;
 243 ok(@leaves, @leaves1) or
 244     print STDERR "# \@leaves: @leaves, \@leaves1: @leaves\n";
 245 ok($root, $c->root);
 246 @cpus = lgrp_cpus($c->cookie, $root, LGRP_CONTENT_HIERARCHY);
 247 my @cpus1 = $c->cpus($root, LGRP_CONTENT_HIERARCHY);
 248 ok(@cpus, @cpus1) or
 249     print STDERR "# \@cpus: @cpus, \@cpus1: @cpus1\n";
 250 ok(lgrp_latency($root, $root), $c->latency($root, $root));
 251 my @lgrps_c1 = $c->resources($root, LGRP_RSRC_CPU);
 252 ok(@lgrps_c, @lgrps_c1);
 253 ok(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);
 260 ok(defined($home));
 261 my $home1 = $c->home(P_PID, P_MYID);
 262 ok($home1 == $home);
 263 $home1 = lgrp_home(P_LWPID, 1);
 264 ok($home1 == $home);
 265 $home1 = $c->home(P_LWPID, 1);
 266 ok($home1 == $home);
 267
 268 #
 269 ######################################################################
 270 # Can we call lgrp_affinity_set?
 271 ##
 272 my $affinity;
 273
 274 ok(LGRP_AFF_WEAK);
 275 ok(P_LWPID);
 276
 277 $affinity = $c->affinity_set(P_PID, P_MYID, $home, LGRP_AFF_WEAK);
 278 ok($affinity);
 279
 280 $affinity = $c->affinity_set(P_LWPID, 1, $home, LGRP_AFF_WEAK);
 281 ok($affinity);
 282
 283 $affinity = lgrp_affinity_set(P_PID, P_MYID, $home, LGRP_AFF_WEAK);
 284 ok($affinity);
 285
 286 $affinity = lgrp_affinity_set(P_LWPID, 1, $home, LGRP_AFF_WEAK);
 287 ok($affinity);
 288
 289 #
 290 ######################################################################
 291 # Can we call lgrp_affinity_get?
 292 ##
 293 $affinity = lgrp_affinity_get(P_PID, P_MYID, $home);
 294 ok($affinity = LGRP_AFF_WEAK);
 295
 296 $affinity = lgrp_affinity_get(P_LWPID, 1, $home);
 297 ok($affinity == LGRP_AFF_WEAK);
 298
 299 $affinity = $c->affinity_get(P_PID, P_MYID, $home);
 300 ok($affinity == LGRP_AFF_WEAK);
 301
 302 $affinity = $c->affinity_get(P_LWPID, 1, $home);
 303 ok($affinity == LGRP_AFF_WEAK);
 304
 305 #
 306 ######################################################################
 307 # THE END!
 308 #########