Convert to native NQP-rx regex; move last bits of Glue functionality to Util; kill...
[parrot-plumage:parrot-plumage.git] / probes / cap-test.nqp
1 ###
2 ### cap-test.nqp: Test the current capabilities of NQP
3 ###
4
5 # TO USE:
6 #   $ parrot-nqp cap-test.nqp
7
8
9 # First, declare the builtin "globals" we'd like to access
10 my $*OSNAME;
11 my $*OSVER;
12 my %*ENV;
13 my %*VM;
14
15 # Next, load the utility functions and fill in the "globals"
16 pir::load_bytecode('src/lib/Util.pir');
17 say("Util loaded.\n");
18
19 # Inline PIR
20 print("Inline PIR says:  ");
21 test_inline_pir('Plumage');
22
23 sub test_inline_pir ($name) {
24     my $string := Q:PIR{
25         $S0  = 'Hello, '
26         $P0  = find_lex '$name'
27         $S1  = $P0
28         $S0 .= $S1
29         $S0 .= '!'
30         %r   = box $S0
31     };
32
33     say($string);
34 }
35
36 # Binding only, no assignment.  At least we have simple interpolation now.
37 our $libdir := get_versioned_libdir();
38 say("\nVersioned libdir: $libdir");
39
40 sub get_versioned_libdir () {
41     my $config := %*VM<config>;
42     my $libdir := $config<libdir>;
43     my $verdir := $config<versiondir>;
44
45     return $libdir ~ $verdir;
46 }
47
48 # The NQP parser complains about PIR-created globals
49 # unless they are (redundantly) declared in NQP.
50 say("Operating system: $*OSNAME $*OSVER");
51 say('%*ENV<PATH>:       ' ~ %*ENV<PATH>);
52
53 # Class declaration is ... suboptimal ... at the moment
54 my $bar := BarFly.new(:flea('bag'));
55 say('$bar.foo():       ' ~ $bar.foo());
56
57 class BarFly {
58     # has $!flea;
59
60     # method new () {...}
61
62     method foo () {
63         # say($!flea);
64         return "BARFLE";
65     }
66 }
67
68 # These work OK, but qx() is insecurely implemented (in Parrot),
69 # and the error handling is not yet strong.
70 say("\nLocal directory:");
71 my $status := run('ls', '-l');
72
73 say("\nEnvironment variables:");
74 my $output := qx('env');
75 print($output);
76
77 # Test that %*ENV is writable
78 say("\nSetting environment variables:");
79 say('%*ENV<PATH> before: ' ~ %*ENV<PATH>);
80 say('echo $PATH before: ' ~ qx('echo $PATH'));
81
82 # XXXX: Need system-dependent path separator
83 %*ENV<PATH> := '/foo/bar:' ~ %*ENV<PATH>;
84
85 say('%*ENV<PATH> after:  ' ~ %*ENV<PATH>);
86 say('echo $PATH after:  ' ~ qx('echo $PATH'));
87
88 # Load JSON
89 say("\nLoad JSON:");
90 my $json := eval('{"a":[null,false,true,3.5,"Hello from JSON"]}', 'data_json');
91 say($json<a>[4]);