Test case:
use 5.026;
use Perl6::Controls qw(for);
for (1..10) -> $n {
say $n;
}
loop {};
Expect:
Can't call method "loop" without a package or object reference
Got:
infinite loop
use Perl6::Controls qw(for);
BEGIN {
delete $^H{'Keyword::Simple/keywords'}{"loop"};
}
...
which I stumbled into running your script through B::Deparse.
To pick and choose the keywords you want to keep, you could say
use Perl6::Controls;
BEGIN {
my #keep = ...; # e.g. #keep = qw(for);
my %keywords;
#keywords{#keep} = #{$^H{'Keyword::Simple/keywords'}}{#keep};
$^H{'Keyword::Simple/keywords'} = \%keywords;
}
You can't. Looking at the source-code for Perl6::Controls it uses it's own import method to define all the new keywords using Keyword::Declare. It ignores any parameters passed on the use line.
Related
I´m working in a code which follows some steps, and each of this steps is done in one class. Right now my code looks like this:
use step_1_class;
use step_2_class;
use step_3_class;
use step_4_class;
use step_5_class;
use step_6_class;
use step_7_class;
...
use step_n_class;
my $o_step_1 = step_1_class->new(#args1);
my $o_step_2 = step_2_class->new(#args2);
my $o_step_3 = step_3_class->new(#args3);
my $o_step_4 = step_4_class->new(#args4,$args_4_1);
my $o_step_5 = step_5_class->new(#args5);
my $o_step_6 = step_6_class->new(#args6,$args_6_1);
my $o_step_7 = step_7_class->new(#args7);
...
my $o_step_n = step_n_class->new(#argsn);
Is there a cleaner way of declaring this somewhat similar classes wihtout using hundreds of lines?
Your use classes as written are equivalent to
BEGIN {
require step_1_class;
step_1_class->import() if step_1_class->can('import');
require step_2_class;
step_2_class->import() if step_2_class->can('import');
...
}
This can be rewritten as
BEGIN {
foreach my $i ( 1 .. $max_class ) {
eval "require step_${i}_class";
"step_${i}_class"->import() if "step_${i}_class"->can('import');
}
}
The new statements are a little more complex as you have separate variables and differing parameters, however this can be worked around by storing all the objects in an array and also preprocessing the parameters like so
my #steps;
my #parameters = ( undef, \#args1, \#args2, \#args3, [ #args4, $args_4_1], ...);
for ($i = 1; $i <= $max_class; $i++) {
push #steps, "step_${i}_class"->new(#{$parameters[$i]});
}
You can generate the use clauses in a Makefile. Generating the construction of the object will be more tricky as the arguments aren't uniform - but you can e.g. save the exceptions to a hash. This will make deployment more complex and searching the code tricky.
It might be wiser to rename each step by its purpose, and group the steps together logically to form a hierarchy instead of a plain sequence of steps.
Problem : I want to have a list of objects stored so that i can call the corresponding methods at latter point in time
my #tc = ("TC_1","TC_2");
my %obj_list = ();
foreach my $test (#tc) {
$obj_list{$test} = Test->new($test);
}
In the same module file at latter stage where i need to call the corresponding methods of those objects
foreach my $test (keys %obj_list) {
if (some specific condition is satisfied for a test) {
1 --> $obj_list->$test->action();
2 --> $obj_list{$test}->action();
}
}
I tried 1 and 2 and they are not working. Could some one tell me what i could be doing wrong here.Any inputs would be of great help.
Your code is basically correct - other than a few syntax errors.
# Use ( ... ) to initialise an array.
my #tc = ("TC_1","TC_2");
my %obj_list = ();
foreach my $test (#tc) {
$obj_list{$test} = Test->new($test);
}
foreach (keys %obj_list) {
if (some specific condition is satisfied for a test) {
# This version is incorrect
# $obj_list->$key->action();
# This version will work, except you have the
# key in $_, not $key.
$obj_list{$_}->action();
}
}
Adding use strict and use warnings to your code would have helped you find some of these problems.
I am trying to write some classes with Perl 6 just for testing out Perl 6 classes and methods.
Here is the code:
class human1 {
method fn1() {
print "#from human1.fn1\n";
}
}
class human2 {
method fn1() {
print "#from human2.fn1\n";
}
}
my $a = human1.new();
my $b = human2.new();
$a.fn1();
$b.fn1();
print "now trying more complex stuff\n";
my $hum1_const = &human1.new;
my $hum2_const = &human2.new;
my $c = $hum2_const();
$c.fn1();
Essentially I want to be able to use either the human1 constructor or human2 constructor to be able to build $c object dynamically. But I'm getting the following error:
Error while compiling /usr/bhaskars/code/perl/./a.pl6
Illegally post-declared types:
human1 used at line 23
human2 used at line 24
How do I create $c using the function pointers to choose which constructor I use?
I think this is a case of an LTA error. What I understand you want to achieve, is a lambda that will create a new human1 or human2 object for you. The way you do that is not correct, and the error it causes is confusing.
my $hum1_const = -> { human1.new };
my $hum2_const = -> { human2.new };
would be a correct way of doing this. Although, I would consider this a bit of an obfuscation. Since human1 and human2 are already constants, you can assign them to a variable, and then just call new on that:
my $the_human = $condition ?? human1 !! human2;
my $c = $the_human.new;
$c.fn1;
Does that make sense?
To get a “reference” to .new you have to use the meta object protocol.
Either .^lookup, or .^find_method.
my $hum1-create = human1.^find_method('new');
That is still not quite what you are looking for, as methods require either a class object or an instance, as their first argument.
my $c = $hum1-create( human1 );
So you would probably want to curry the class as the first argument to the method.
my $hum1-create = human1.^find_method('new').assuming(human1);
my $c = $hum1-create();
Note that .assuming in this case basically does the same thing as
-> |capture { human1.^find_method('new').( human1, |capture ) }
So you could just write:
my $hum1-create = -> |capture { human1.new( |capture ) }
Or if you are never going to give it an argument
my $hum1-create = -> { human1.new }
Also you can store it in a & sigiled variable, so you can use it as if it were a normal subroutine.
my &hum1-create = human1.^find_method('new').assuming(human1);
my $c = hum1-create;
I want to make a console and change the automatic completion function when I press tab but I want to differentiate between two cases:
If I press tab and the beginning of the command matches a list I supplied in an array, the auto complete will be according to this array.
If I press tab and the command isn't recognized from the list I supplied, I want the generic completion function to work, so t hat it will auto complete directories and file names in the current directory.
Is it possible?
Thanks a lot.
Edit: I'm trying to do it inside a perl script. I saw this example:
rl_attempted_completion_function
A reference to an alternative function to create matches.
The function is called with TEXT, LINE_BUFFER, START, and END. LINE_BUFFER is a current input buffer string. START and END are indices in LINE_BUFFER saying what the boundaries of TEXT are.
If this function exists and returns null list or undef, or if this variable is set to undef, then an internal function rl_complete() will call the value of $rl_completion_entry_function to generate matches, otherwise the array of strings returned will be used.
The default value of this variable is undef. You can use it as follows;
use Term::ReadLine;
...
my $term = new Term::ReadLine 'sample';
my $attribs = $term->Attribs;
...
sub sample_completion {
my ($text, $line, $start, $end) = #_;
# If first word then username completion, else filename completion
if (substr($line, 0, $start) =~ /^\s*$/) {
return $term->completion_matches($text,
$attribs->{'username_completion_function'});
} else {
return ();
}
}
...
$attribs->{attempted_completion_function} = \&sample_completion;
completion_matches(TEXT, ENTRY_FUNC)
What I want to do is that in case when tab is pressed it recognizes a substring from an array I provide, the auto completion will be from that array (if there are multiple matches it will give all of them like a regular unix console).
Otherwise, I want the auto completion to be file recognition.
The subroutine used internally by Term::ReadLine::Gnu to provide the default completion is filename_completion_function, which you can call directly from your custom subroutine:
use Term::ReadLine;
my $term = new Term::ReadLine 'MyTerm';
$term->Attribs->{'completion_entry_function'} = \&my_completion;
my $ans = $term->readline('How can I help you? ');
sub my_completion {
my ($text, $state) = #_;
if (my_test) {
return my_custom_stuff;
}
else {
return Term::ReadLine::Gnu->filename_completion_function($text, $state);
}
}
I have a Perl project were I just had a problem by making a circular package call. The code below demonstrates the problem.
When this is executed, each package will call the other until all of the memory of the computer is consumed and it locks up. I agree that this is a bad design and that circular calls like this should not be made in the design, but my project is sufficiently big that I would like to detect this at run time.
I have read about the weaken function and Data::Structure::Util, but I have not figured out a way to detect if there is a circular package load (I am assume, because a new copy is being made at each iteration and stored in each copy of the $this hash). Any ideas?
use system::one;
my $one = new system::one();
package system::one;
use strict;
use system::two;
sub new {
my ($class) = #_;
my $this = {};
bless($this,$class);
# attributes
$this->{two} = new system::two();
return $this;
}
package system::two;
use strict;
use system::one;
sub new {
my ($class) = #_;
my $this = {};
bless($this,$class);
# attributes
$this->{one} = new system::one();
return $this;
}
Here, have some code too. :)
sub break_recursion(;$) {
my $allowed = #_ ? shift : 1;
my #caller = caller(1);
my $call = $caller[3];
my $count = 1;
for(my $ix = 2; #caller = caller($ix); $ix++) {
croak "found $count levels of recursion into $call"
if $caller[3] eq $call && ++$count > $allowed;
}
}
sub check_recursion(;$) {
my $allowed = #_ ? shift : 1;
my #caller = caller(1);
my $call = $caller[3];
my $count = 1;
for(my $ix = 2; #caller = caller($ix); $ix++) {
return 1
if $caller[3] eq $call && ++$count > $allowed;
}
return 0;
}
These are called like:
break_recursion(); # to die on any recursion
break_recursion(5); # to allow up to 5 levels of recursion
my $recursing = check_recursion(); # to check for any recursion
my $recursing = check_recursion(10); # to check to see if we have more than 10 levels of recursion.
Might CPAN these, I think. If anyone has any thoughts about that, please share.
The fact that these are in separate packages has nothing at all to do with the fact that this runs infinitely, consuming all available resources. You're calling two methods from within one another. This isn't circular reference, it's recursion, which is not the same thing. In particular, weaken won't help you at all. You'd get exactly the same effect from:
sub a {
b();
}
sub b {
a();
}
a();
The best way to avoid this is don't do that. More usefully, if you have to write recursive functions try not to use multiple functions in the recursion chain, but simply the one, so you have an easier time mentally keeping track of where your calls should terminate.
As to how to detect whether something like this is happening, you would have to do something simple like increment a variable with your recursion depth and terminate (or return) if your depth exceeds a certain value. But you really shouldn't have to rely on that, it's similar to writing a while loop and using an increment there to make sure your function doesn't run out of control. Just don't recurse over a set unless you know how and when it terminates.
Another relevant question would be what are you trying to accomplish in the first place?
I suggest making a routine called something like break_constructor_recursion() that uses caller() to examine the call stack like so:
Find out what method in what package just called me.
Look up the rest of the call stack seeing if that same method in that same package is anywhere further up.
If so, die() with something appropriate.
Then you add a call to break_constructor_recursion() in your constructors. If the constructor is being called from inside itself, it'll bomb out.
Now, this can throw false positives; it's not impossible for a constructor to be legitimately called inside itself. If you have issues with that, I'd say just have it look for some N additional occurrences of the constructor before it identifies an error. If there are 20 calls to system::two::new() on the stack, the chances that you aren't recursing are pretty low.
The classic break on double recursion is to use a state variable to determine if you are already inside a function:
{
my $in_a;
sub a {
return if $in_a; #do nothing if b(), or someone b() calls, calls a()
$in_a = 1;
b();
$in_a = 0;
}
}
You can do whatever you want if $in_a is true, but dieing or returning is common. If you are using Perl 5.10 or later you can use the state function instead of nesting the function in its own scope:
sub a {
state $in_a;
return if $in_a; #do nothing if b(), or someone b() calls, calls a()
$in_a = 1;
b();
$in_a = 0;
}
use warnings;
without warnings:
#!/usr/bin/perl
use strict;
sub foo {
foo();
}
foo();
-
$ perl script.pl
^C # after death
with warnings:
#!/usr/bin/perl
use strict;
use warnings;
sub foo {
foo();
}
foo();
-
$ perl script.pl
Deep recursion on subroutine "main::foo" at script.pl line 7.
^C # after death
Always always use warnings.
use warnings FATAL => qw( recursion );
#!/usr/bin/perl
use strict;
use warnings FATAL => qw( recursion );
sub foo {
foo();
}
foo();
-
$ perl script.pl
Deep recursion on subroutine "main::foo" at script.pl line 7.
$