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 2008 Sun Microsystems, Inc. All rights reserved. 25# Use is subject to license terms. 26# 27# ident "%Z%%M% %I% %E% SMI" 28# 29 30require 5.8.0; 31use strict; 32use warnings; 33 34# Make sure that Lgrp test is not executed on anything less than 5.8.0, 35# as Lgrp is not implemented there 36BEGIN { 37 if ($] < 5.008) { 38 # Fake one successfull test and exit 39 printf "1..1\nok\n"; 40 exit 0; 41 } 42} 43 44###################################################################### 45# Tests for Sun::Solaris::Lgrp API. 46# 47# This is an example script that demonstrates use of Sun::Solaris::Lgrp module. 48# It can be used to test the module itself, the liblgrp library or the in-kernel 49# implementation. 50###################################################################### 51 52# Tests to run 53use Test::More tests => 33; 54 55# Verify that we can load the module 56BEGIN { use_ok('Sun::Solaris::Lgrp') }; 57 58use Sun::Solaris::Lgrp ':ALL'; 59 60my ($home, $fail); 61 62###################################################################### 63# Verify that lgrp_init() works. 64## 65my $c = Sun::Solaris::Lgrp->new(LGRP_VIEW_OS); 66ok($c, 'lgrp_init') or die("lgrp_init: $!"); 67# 68###################################################################### 69 70###################################################################### 71# root should have ID 0. 72## 73my $root = $c->root; 74is($root, 0, 'root should have id zero'); 75 76# 77###################################################################### 78# Verify lgrp_nlgrps() 79## 80my $nlgrps = $c->nlgrps; 81ok($nlgrps, 'lgrp_nlgrps') or 82 diag("lgrp_nlgrps: $!"); 83 84my $is_numa = ($nlgrps > 1); 85 86my @lgrps = $c->lgrps; 87ok(scalar @lgrps, 'Can get lgrps list') or 88 diag("lgrp_lgrps: $!"); 89 90is(scalar @lgrps, $nlgrps, 'lgrp_nlgrps() should match number of lgrps'); 91 92###################################################################### 93# All root children should have root as their one and only one parent 94## 95$fail = 0; 96my (@children) = $c->children($root); 97my @leaves = $c->leaves; 98ok(@leaves, 'There are some leaves'); 99 100cmp_ok(@children, '<=', @leaves, 'Root should have nchildren <= nleaves'); 101my @parents; 102 103foreach my $l (@children) { 104 (@parents) = $c->parents($l) or 105 diag("lgrp_parents: $!"); 106 my $nparents = @parents; 107 my ($parent, @rest) = @parents; 108 $fail++ if $parent != $root; 109 $fail++ unless $nparents == 1; 110} 111is($fail, 0, 'correct parents for children'); 112 113###################################################################### 114# Each lgrp other than root should have a single parent and 115# root should have no parents. 116## 117 118$fail = 0; 119foreach my $l (lgrp_lgrps($c)) { 120 next if $l == $root; 121 my (@parents) = $c->parents($l) or 122 diag("lgrp_parents: $!"); 123 my $nparents = @parents; 124 $fail++ unless $nparents == 1; 125} 126is($fail, 0, 'All non-leaf lgrps should have single parent'); 127 128@parents = $c->parents($root); 129ok(!@parents, 'root should have no parents'); 130# 131####################################################################### 132 133###################################################################### 134# Lgrp affinity tests. 135####################### 136 137###################################################################### 138# lgrp_affinity-set should change home lgrp. 139## 140SKIP: { 141 skip 'Test only valid on NUMA platform', 1 unless $is_numa; 142 my $leaf = $leaves[0]; # Pickup any non-root lgrp. 143 $home = $c->home(P_PID, P_MYID); 144 145 # Pickup any lgrp not equal to the current one. 146 my $lgrp = ($home == $root ? $leaf : $root); 147 # Set affinity to the new lgrp. 148 $c->affinity_set(P_PID, P_MYID, $lgrp, LGRP_AFF_STRONG) or 149 diag("lgrp_affinity_set(): $!"); 150 # Our home should change to a new lgrp. 151 $home = $c->home(P_PID, P_MYID); 152 is($home, $lgrp, 'Home lgrp should change after strong affinity is set'); 153 # Drop affinity to the lgrp. 154 $c->affinity_set(P_PID, P_MYID, $lgrp, LGRP_AFF_NONE) or 155 diag("lgrp_affinity_set(): $!"); 156} 157 158###################################################################### 159# Should be able to set affinity to any legal value 160## 161 162my @affs = (LGRP_AFF_WEAK, LGRP_AFF_STRONG, LGRP_AFF_NONE); 163 164foreach my $aff (@affs) { 165 $c->affinity_set(P_PID, P_MYID, $root, $aff) or 166 diag("lgrp_affinity_set(): $!"); 167 my $affinity = $c->affinity_get(P_PID, $$, $root); 168 is($affinity, $aff, "affinity should be $aff"); 169} 170 171# 172###################################################################### 173 174###################################################################### 175# Root should have non-zero CPUs and memory size 176# Also, its memory size should be consistent with the one reported by 177# sysconfig. 178## 179my @rcpus = $c->cpus($root, LGRP_CONTENT_HIERARCHY) or 180 die("lgrp_cpus: $!"); 181my $ncpus = @rcpus; 182ok($ncpus, 'there are CPUs in the system'); 183 184my $memsize = $c->mem_size($root, 185 LGRP_MEM_SZ_INSTALLED, 186 LGRP_CONTENT_HIERARCHY) or 187 diag("lgrp_mem_size(): $!"); 188 189ok($memsize, 'memory size is non-zero'); 190# 191###################################################################### 192 193###################################################################### 194# The cookie should not be stale 195is($c->stale, 0, 'Cookie should not be stale'); 196# 197###################################################################### 198 199###################################################################### 200# Latency should be non-zero. 201my $latency = lgrp_latency($root, $root); 202ok(defined $latency, 'lgrp_latency() is working') or 203 diag("lgrp_latency: $!"); 204 205my $latency1 = $c->latency($root, $root); 206ok(defined $latency1, 'lgrp_latency_cookie() is working') or 207 diag("lgrp_latency_cookie: $!"); 208 209is($latency, $latency1, 'Latencies should match'); 210# 211###################################################################### 212 213###################################################################### 214# Verify latency matrix. 215## 216SKIP: { 217 skip 'Test only valid on NUMA platform', 9 unless $is_numa; 218 219 cmp_ok($latency, '>', 0, "Latency from root to self should be positive"); 220 my $latencies; 221 my $min_latency = 10000; 222 my $max_latency = 0; 223 my $badlatency = 0; 224 my $assymetrical = 0; 225 my $diagonalmin = 0; 226 my $badself = 0; 227 my $nlatencies; 228 229 foreach my $l1 (@lgrps) { 230 foreach my $l2 (@lgrps) { 231 $latencies->{$l1}{$l2} = $c->latency($l1, $l2); 232 $nlatencies++ if $latencies->{$l1}{$l2}; 233 } 234 } 235 236 # There should be at least some lgroups which have latencies. 237 my @d_lgrps = grep { defined $latencies->{$_}{$_} } @leaves; 238 ok(@d_lgrps, 'There should be at least some lgroups which have latencies'); 239 240 # All diagonal latencies should be the same. 241 my $lat_diag_lgrp = $d_lgrps[0]; 242 my $lat_diag = $latencies->{$lat_diag_lgrp}{$lat_diag_lgrp}; 243 my @badlatencies = grep { $latencies->{$_}{$_} != $lat_diag } @d_lgrps; 244 is(scalar @badlatencies, 0, 'All diagonal latencies should be the same') or 245 diag("diagonal latency: $lat_diag; bad latencies: @badlatencies"); 246 247 my %l_cpus; 248 my %l_mem; 249 my $lgrps_nomem; 250 my $lgrps_nocpus; 251 252 foreach my $l1 (@lgrps) { 253 $l_cpus{$l1} = scalar $c->cpus($l1, LGRP_CONTENT_HIERARCHY); 254 $l_mem{$l1} = $c->mem_size($l1, LGRP_MEM_SZ_INSTALLED, 255 LGRP_CONTENT_HIERARCHY); 256 $lgrps_nomem++ unless $l_mem{$l1}; 257 $lgrps_nocpus++ unless $c->cpus($l1, LGRP_CONTENT_HIERARCHY); 258 } 259 260 # Verify latencies consistency 261 foreach my $l1 (@lgrps) { 262 # Can't get latency if source doesn't have CPUs 263 next unless $l_cpus{$l1}; 264 my $self_latency = $latencies->{$l1}{$l1}; 265 $lat_diag = $self_latency if $self_latency; 266 267 foreach my $l2 (@lgrps) { 268 # Can't get latenciy if destination doesn't have memory 269 next unless $l_mem{$l2}; 270 271 if (! $latencies->{$l1}{$l2}) { 272 $badlatency++; 273 diag("Invalid latency between $l1 and $l2"); 274 next; 275 } 276 277 $max_latency = $latencies->{$l1}{$l2} if 278 $latencies->{$l1}{$l2} > $max_latency; 279 $min_latency = $latencies->{$l1}{$l2} if 280 $latencies->{$l1}{$l2} < $min_latency; 281 282 # Latencies should be symmetrical but only if they are valid. 283 if ($latencies->{$l2}{$l1} && 284 $latencies->{$l1}{$l2} != $latencies->{$l2}{$l1}) { 285 $assymetrical++; 286 diag("latency($l1, $l2) != latency($l2, $l1)"); 287 } 288 289 $diagonalmin++ if $c->isleaf($l1) && $c->isleaf($l2) && 290 $self_latency && $self_latency > $latencies->{$l1}{$l2}; 291 } 292 } 293 294 SKIP: { 295 skip 'Symmetry test only valid if all lgroups have memory and CPUs', 296 1 if $lgrps_nomem || $lgrps_nocpus; 297 is($assymetrical, 0, 'Latencies should be symmetrical'); 298 } 299 300 is($diagonalmin, 0, 'Latency should be minimal on diagonals'); 301 is($badlatency, 0, 'Latency should be defined'); 302 is($max_latency, $latencies->{$root}{$root}, 303 'Root should have maximum latencies'); 304 cmp_ok($min_latency, '>', 0, 'Minimum latency should be positive') if 305 $nlatencies; 306 cmp_ok($min_latency, '<=', $max_latency, 307 'Minimum latency should be less then maximum') if $nlatencies; 308} 309 310###################################################################### 311# Verify lgrp_resources API 312## 313SKIP: { 314 skip 'lgrp_resources() is not supported', 3 if 315 ((LGRP_VER_CURRENT == 1) || !$is_numa); 316 317 my @lgrps_c = $c->resources($root, LGRP_RSRC_CPU); 318 ok(scalar @lgrps_c, 'there are CPU resources in the system'); 319 $fail = 0; 320 my $nc = 0; 321 foreach my $l (@lgrps_c) { 322 $fail++ unless $c->isleaf($l); 323 my @cpu_l = $c->cpus($l, LGRP_CONTENT_DIRECT); 324 $nc += @cpu_l; 325 } 326 is($fail, 0, 'Each lgrp containing CPU resources should be leaf'); 327 is($nc, $ncpus, 'Number of CPUs should match'); 328} 329 330# 331###################################################################### 332# THE END! 333######### 334