uic.t test to compare perl calls to dcl lexicals

Hi,

For a while now I have been sitting on this test that I thought might be 
of interest to
the vmsperl community.  I have not worked it into a patch, but I wanted 
this
to appear in the mailing list archive for future reference.  The tests run 
only on VMS
and more than testing things I think help to illustrate the equivalence of
the lexical calls and the perl (hence C rtl) calls employed.

Peter Prymmer

# uic.t - test return values from the getpwuid() function against
#         equivalent DCL calls.  This can be expected to run on VMS only.
#
# $Id: //perl/pvhp/perl/t/vms/uic.t#1 $
# $Change: 2142 $
# $DateTime: 2002/04/30 10:21:00 $
# $Revision: #1 $
# $Author: pvhp $

BEGIN {
    if ( $^O ne 'VMS' ) { print "1..0\n"; exit; }
}

print "1..5\n";

# variables for perl
my $login;
my $pass;
my $uid;
my $gid;
my ( $f, $g, $h );
my $sys_login;
my $cliname;
# for manipulation
my $ugid_as_uic;

# variables for DCL
my $USERNAME;
my $UIC;
my $CLINAME;
# for $fao reformatting
my $UIC_NUMERIC;

( $login, $pass, $uid, $gid, $f, $g, $h, $sys_login, $cliname ) = 
getpwuid( $< );

$login = uc( $login );

$USERNAME = `write sys\$output f\$edit( f\$getjpi( "", "USERNAME" ), 
"TRIM" )`;

chomp( $USERNAME );

print + ( $USERNAME eq $login ) ? '' : 'not ', "ok 1\n";

$UIC = `write sys\$output f\$identifier("$USERNAME","NAME_TO_NUMBER")`;

chomp( $UIC );

print + ( $UIC == $uid ) ? '' : 'not ', "ok 2\n";

$UIC_NUMERIC = `write sys\$output f\$fao( "!\%U", $UIC )`;

chomp( $UIC_NUMERIC );

$ugid_as_uic = sprintf( "[%o,%o]", $gid, ( $uid - ( $gid * 0x10000 ) ) );

print + ( $UIC_NUMERIC eq $ugid_as_uic ) ? '' : 'not ', "ok 3\n";

$CLINAME = `write sys\$output f\$getjpi("","CLINAME")`;

chomp( $CLINAME );

print + ( $cliname eq $CLINAME ) ? '' : 'not ', "ok 4\n";

print + ( $sys_login eq $ENV{'SYS$LOGIN'} ) ? '' : 'not ', "ok 5\n";