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