t/op/sysinfo.t

   1 #!perl
   2 # Copyright (C) 2008, The Perl Foundation.
   3 # $Id$
   4
   5 # initial work by Brad Gilbert b2gills <at> gmail <dot> com
   6
   7 use strict;
   8 use warnings;
   9 use lib qw( . lib ../lib ../../lib );
  10
  11 use Test::More import => [ '$TODO' ];
  12 use Parrot::Test tests => 8;
  13 use Parrot::Config;
  14
  15 use Config;
  16
  17 =head1 NAME
  18
  19 t/op/sysinfo.t - System Info
  20
  21 =head1 SYNOPSIS
  22
  23         % prove t/op/sysinfo.t
  24
  25 =head1 DESCRIPTION
  26
  27 Tests for basic system information.
  28
  29 =over 4
  30
  31 =item 1 The size of a platform integer
  32
  33 =item 2 The size of a platform float
  34
  35 =item 3 The size of a platform pointer. (Largest possible data pointer)
  36
  37 =item 4 The OS name
  38
  39 =item 5 The OS version string
  40
  41 =item 6 The OS version number string
  42
  43 =item 7 The CPU architecture
  44
  45 =item 8 The CPU model
  46
  47 =back
  48
  49 =cut
  50
  51
  52
  53 pasm_output_is( <<'CODE', $PConfig{intvalsize}, "sysinfo integer size" );
  54                 sysinfo_i_ic I1, 1
  55                 print I1
  56                 end
  57 CODE
  58
  59 # XXX is 'doublesize' the right thing to use?
  60 pasm_output_is( <<'CODE', $PConfig{doublesize}, "sysinfo float size" );
  61                 sysinfo_i_ic I1, 2
  62                 print I1
  63                 end
  64 CODE
  65
  66 pasm_output_is( <<'CODE', $PConfig{ptrsize}, "sysinfo pointer size" );
  67                 sysinfo_i_ic I1, 3
  68                 print I1
  69                 end
  70 CODE
  71
  72 pasm_output_is( <<'CODE', $PConfig{osname}, "sysinfo osname" );
  73                 sysinfo_s_ic S1, 4
  74         print S1
  75         end
  76 CODE
  77
  78 # 5 & 6
  79 if( $PConfig{osname} eq 'MSWin32' ){
  80         # Windows 5 & 6
  81         SKIP: {
  82                 eval{ require Win32; } or
  83                     skip "requires package Win32 for these tests", 2;
  84
  85                 # specifically don't use $Config{osvers}
  86                 # because it probably was the system perl was compiled on
  87                 # and we can do much better than that
  88
  89                 my $osname = Win32::GetOSName();
  90                 $osname = 'WinXP' if $osname =~ m/^WinXP/;
  91                 TODO: {
  92                         local $TODO = "Not Currently Implemented";
  93 pasm_output_is( <<'CODE', $osname, "sysinfo OS version string" );
  94                 sysinfo_s_ic S1, 5
  95                 print S1
  96                 end
  97 CODE
  98
  99                 my($osvername,$major,$minor,$id) = Win32::GetOSVersion();
 100
 101 pasm_output_is( <<'CODE', "$major.$minor", "sysinfo OS version number string" );
 102                 sysinfo_s_ic S1, 6
 103                 print S1
 104                 end
 105 CODE
 106                 }
 107         }
 108
 109 }else{
 110         # Other 5 & 6
 111
 112 # XXX I know this is wrong on Win32 but is it correct on any others?
 113 # XXX also should it be %Config or %PConfig
 114 TODO: {
 115         local $TODO = "Not Currently Implemented";
 116
 117 pasm_output_is( <<'CODE', $Config{osvers}, "sysinfo OS version string" );
 118                 sysinfo_s_ic S1, 5
 119                 print S1
 120                 end
 121 CODE
 122
 123 pasm_output_is( <<'CODE', $Config{osvers}, "sysinfo OS version number string" );
 124                 sysinfo_s_ic S1, 6
 125                 print S1
 126                 end
 127 CODE
 128         }
 129
 130 }
 131
 132 # 7
 133
 134 TODO: {
 135         local $TODO = "Not Currently Implemented";
 136
 137 pasm_output_is( <<'CODE', $PConfig{cpuarch}, "sysinfo CPU Arch Family" );
 138                 sysinfo_s_ic S1, 7
 139                 print S1
 140                 end
 141 CODE
 142 }
 143
 144 # 8
 145
 146 SKIP: {
 147         skip "Requires a lot of work to find out the correct answer", 1;
 148
 149 pasm_output_is( <<'CODE', $PConfig{archname}, "sysinfo CPU Model" );
 150                 sysinfo_s_ic S1, 8
 151                 print S1
 152                 end
 153 CODE
 154 }
 155