RFC: a slightly larger uic.t test for perl@16307

Folks,

The uic.t test that I had introduced last week is
now up to 5 tests.  In comparing the operation of
t/op/pwent.t it occurs to me that without read
access to SYSUAF.DAT doing the equivalent
of ypcat passwd on VMS  (namely
`mcr authorize show */brief`).  Would not be helpful.
Hence I limit uic.t to just calling Perl's getpwuid()
and do not bother with trying to test the *pwent()
calls.

Does this run OK for you all?  Does anyone out
there have a SYLOGIN.COM or LOGIN.COM that
actually attempts to re -DEFINE SYS$LOGIN (and
possibly make test #5 fail)?

diff -ruN perl_16307/MANIFEST perl/MANIFEST
--- perl_16307/MANIFEST Tue Apr 30 16:30:08 2002
+++ perl/MANIFEST Fri May  3 14:56:09 2002
@@ -2599,6 +2599,7 @@
 t/uni/sprintf.t              See if Unicode sprintf works
 t/uni/title.t                See if Unicode casing works
 t/uni/upper.t                See if Unicode casing works
+t/vms/uic.t                  See if getpwuid() works on VMS
 t/win32/longpath.t           Test if Win32::GetLongPathName() works
 t/win32/system.t       See if system works in Win*
 t/win32/system_tests         Test runner for system.t
diff -ruN perl_16307/t/vms/uic.t perl/t/vms/uic.t
--- perl_16307/t/vms/uic.t    Wed Dec 31 19:00:00 1969
+++ perl/t/vms/uic.t    Fri May  3 14:54:57 2002
@@ -0,0 +1,65 @@
+# uic.t - test return values from the getpwuid() function against
+#         equivalent DCL calls.  This can be expected to run on VMS only.
+#
+# $Id: //depot/temp/pprymmer/perl/t/vms/uic.t#1 $
+# $Change: 2142 $
+# $DateTime: 2002/04/30 10:21:00 $
+# $Revision: #1 $
+# $Author: pprymmer $
+
+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";
+
End of Patch.

Peter Prymmer

• RFC: a slightly larger uic.t test for perl@16307 by PPrymmer