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