File Coverage

inc/TestML/Library/Standard.pm
Criterion Covered Total %
statement 10 58 17.2
branch 0 8 0.0
condition n/a
subroutine 3 19 15.7
pod 0 17 0.0
total 13 102 12.7


line stmt bran cond sub pod time code
1             package TestML::Library::Standard;
2              
3 1     1   4 use TestML::Base;
  1         2  
  1         4  
4             extends 'TestML::Library';
5              
6 1     1   7 use TestML::Util;
  1         3  
  1         907  
7              
8             sub Get {
9 0     0 0 0 my ($self, $key) = @_;
10 0         0 return $self->runtime->function->getvar($key->str->value);
11             }
12              
13             # sub Set {
14             # my ($self, $key, $value) = @_;
15             # return $self->runtime->function->setvar($key, $value);
16             # }
17              
18             sub GetLabel {
19 0     0 0 0 my ($self) = @_;
20 0         0 return str($self->runtime->get_label);
21             }
22              
23             sub Type {
24 0     0 0 0 my ($self, $var) = @_;
25 0         0 return str($var->type);
26             }
27              
28             sub Catch {
29 0     0 0 0 my ($self) = @_;
30 0 0       0 my $error = $self->runtime->error
31             or die "Catch called but no TestML error found";
32 0         0 $error =~ s/ at .* line \d+\.\n\z//;
33 0         0 $self->runtime->{error} = undef;
34 0         0 return str($error);
35             }
36              
37             sub Throw {
38 0     0 0 0 my ($self, $msg) = @_;
39 0         0 die $msg->value;
40             }
41              
42             sub Str {
43 0     0 0 0 my ($self, $object) = @_;
44 0         0 return str($object->str->value);
45             }
46             # sub Num {
47             # my ($self, $object) = @_;
48             # return num($object->num->value);
49             # }
50             # sub Bool {
51             # my ($self, $object) = @_;
52             # return bool($object->bool->value);
53             # }
54             sub List {
55 0     0 0 0 my $self = shift;
56 0         0 return list([@_]);
57             }
58              
59             sub Join {
60 0     0 0 0 my ($self, $list, $separator) = @_;
61 0 0       0 $separator = $separator ? $separator->value : '';
62 0         0 my @strings = map $_->value, @{$list->list->value};
  0         0  
63 0         0 return str join $separator, @strings;
64             }
65              
66             sub Not {
67 0     0 0 0 my ($self, $bool) = @_;
68 0 0       0 return bool($bool->bool->value ? 0: 1);
69             }
70              
71             sub Text {
72 0     0 0 0 my ($self, $lines) = @_;
73 0         0 my $value = $lines->list->value;
74 0         0 return str(join $/, map($_->value, @$value), '');
75             }
76              
77             sub Count {
78 0     0 0 0 my ($self, $list) = @_;
79 0         0 return num scalar @{$list->list->value};
  0         0  
80             }
81              
82             sub Lines {
83 0     0 0 0 my ($self, $text) = @_;
84 0         0 return list([ map str($_), split /\n/, $text->value ]);
85             }
86              
87             sub Reverse {
88 0     0 0 0 my ($self, $list) = @_;
89 0         0 my $value = $list->list->value;
90 0         0 return list([ reverse @$value ]);
91             }
92              
93             sub Sort {
94 0     0 0 0 my ($self, $list) = @_;
95 0         0 my $value = $list->list->value;
96 0         0 return list([ sort { $a->value cmp $b->value } @$value ]);
  0         0  
97             }
98              
99             sub Strip {
100 0     0 0 0 my ($self, $string, $part) = @_;
101 0         0 $string = $string->str->value;
102 0         0 $part = $part->str->value;
103 0 0       0 if ((my $i = index($string, $part)) >= 0) {
104 0         0 $string = substr($string, 0, $i) . substr($string, $i + length($part));
105             }
106 0         0 return str $string;
107             }
108              
109             sub Print {
110 0     0 0 0 my ($self, $string) = @_;
111 0         0 print STDOUT $string->value;
112 0         0 return bool(1);
113             }
114              
115             sub Chomp {
116 7     7 0 11 my ($self, $string) = @_;
117 7         15 my $value = $string->str->value;
118 7         17 chomp($value);
119 7         15 return str $value;
120             }
121              
122             1;
123              
124             # sub Has {
125             # my ($self, $string, $part) = @_;
126             # $string = $string->str->value;
127             # $part = $part->str->value;
128             # return bool(index($string, $part) >= 0);
129             # }
130              
131             # sub RunCommand {
132             # require Capture::Tiny;
133             # my ($self, $command) = @_;
134             # $command = $command->value;
135             # chomp($command);
136             # my $sub = sub {
137             # system($command);
138             # };
139             # my ($stdout, $stderr) = Capture::Tiny::capture($sub);
140             # $self->runtime->function->setvar('_Stdout', $stdout);
141             # $self->runtime->function->setvar('_Stderr', $stderr);
142             # return str('');
143             # }
144              
145             # sub RmPath {
146             # require File::Path;
147             # my ($self, $path) = @_;
148             # $path = $path->value;
149             # File::Path::rmtree($path);
150             # return str('');
151             # }
152              
153             # sub Stdout {
154             # my ($self) = @_;
155             # return $self->runtime->function->getvar('_Stdout');
156             # }
157              
158             # sub Stderr {
159             # my ($self) = @_;
160             # return $self->runtime->function->getvar('_Stderr');
161             # }
162              
163             # sub Chdir {
164             # my ($self, $dir) = @_;
165             # $dir = $dir->value;
166             # chdir $dir;
167             # return str('');
168             # }
169              
170             # sub Read {
171             # my ($self, $file) = @_;
172             # $file = $file->value;
173             # use Cwd;
174             # open FILE, $file or die "Can't open $file for input in " . Cwd::cwd;
175             # my $text = do { local $/; };
176             # close FILE;
177             # return str($text);
178             # }
179              
180             # sub Pass {
181             # my ($self, @args) = @_;
182             # return @args;
183             # }
184              
185             # sub Raw {
186             # my $self = shift;
187             # my $point = $self->point
188             # or die "Raw called but there is no point";
189             # return $self->runtime->block->points->{$point};
190             # }
191              
192             # sub Point {
193             # my ($self, $name) = @_;
194             # $name = $name->value;
195             # $self->runtime->get_point($name);
196             # }