perl-language-server
perl-language-server copied to clipboard
FractalBoy
use require to load modules
ref #105
Synopsis
An approach to using module friendly syntax for loading modules.
Open Questions
-
Is my .pm check too naive? What happens when it's syntax checking an unsaved file, what filename shows up? Does that even happen?
-
Will there be any downside to adding a layer of require? It seems like the parsing code strips that out.
This appears to be good, I'll need to test it though. I thought you need to require files using a path relative to @INC.
This appears to be good, I'll need to test it though. I thought you need to require files using a path relative to
@INC.
I believe that's only with a relative path. So far, I see that PLS returns absolute paths.
I have been testing it and it seems to work fine. Not sure what edge cases await us, though
When there is a syntax error preventing 1; from being reached at the end of the file, the compilation error is not displayed. A simple way to reproduce is with a module called Test.pm, with just one line
package Test;
The compilation error looks like:
[mreisner@vm-mreisner bin]$ perl -e 'BEGIN { require "/home/mreisner/perl-language-server/server/lib/Test.pm" }'
/home/mreisner/perl-language-server/server/lib/Test.pm did not return a true value at -e line 1.
This is filtered out because -e doesn't match the file name. Looks like we need to add special handling for errors coming from -e line 1. This should probably just be linked to either line 1 of the file or the last line of the file.
Recommended patch:
diff --git a/server/lib/PLS/Server/Request/TextDocument/PublishDiagnostics.pm b/server/lib/PLS/Server/Request/TextDocument/PublishDiagnostics.pm
index 4e49f7e..a1e4854 100644
--- a/server/lib/PLS/Server/Request/TextDocument/PublishDiagnostics.pm
+++ b/server/lib/PLS/Server/Request/TextDocument/PublishDiagnostics.pm
@@ -58,7 +58,7 @@ sub new
},
$class;
- my (undef, $dir, $suffix) = File::Basename::fileparse($uri->file, qw/pm pl al/);
+ my (undef, $dir, $suffix) = File::Basename::fileparse($uri->file, qr/\.[^\.]*$/);
my $source = $uri->file;
my $text = PLS::Parser::Document->text_from_uri($uri->as_string);
@@ -72,7 +72,7 @@ sub new
my @futures;
- push @futures, get_compilation_errors($source, $dir, $suffix) if (defined $PLS::Server::State::CONFIG->{syntax}{enabled} and $PLS::Server::State::CONFIG->{syntax}{enabled});
+ push @futures, get_compilation_errors($source, $dir, $uri->file, $suffix) if (defined $PLS::Server::State::CONFIG->{syntax}{enabled} and $PLS::Server::State::CONFIG->{syntax}{enabled});
push @futures, get_perlcritic_errors($source, $uri->file)
if (defined $PLS::Server::State::CONFIG->{perlcritic}{enabled} and $PLS::Server::State::CONFIG->{perlcritic}{enabled});
@@ -99,7 +99,7 @@ sub new
sub get_compilation_errors
{
- my ($source, $dir, $suffix) = @_;
+ my ($source, $dir, $orig_path, $suffix) = @_;
my $temp;
my $future = $loop->new_future();
@@ -152,12 +152,13 @@ sub get_compilation_errors
my @diagnostics;
my @loadfile;
- if (not length $suffix or $suffix eq 'pl')
+ if (not length $suffix or $suffix eq '.pl')
{
@loadfile = (-c => $path);
}
else
{
+ $path =~ s/'/\\'/g;
@loadfile = (-e => "BEGIN { require '$path' }");
}
@@ -183,7 +184,10 @@ sub get_compilation_errors
{
$error .= $area if (length $area);
$line = int $line;
- next if $file ne $path;
+ $file = $path if ($file eq '-e');
+ next if ($file ne $path);
+
+ $error =~ s/\Q$path\E/$orig_path/g;
push @diagnostics,
{
Seems that we also forgot .t files - these should be treated like .pl files.
Can you also please make this change:
diff --git a/server/lib/PLS/Server/Request/TextDocument/PublishDiagnostics.pm b/server/lib/PLS/Server/Request/TextDocument/PublishDiagnostics.pm
index 01846da..ba75127 100644
--- a/server/lib/PLS/Server/Request/TextDocument/PublishDiagnostics.pm
+++ b/server/lib/PLS/Server/Request/TextDocument/PublishDiagnostics.pm
@@ -163,7 +163,7 @@ sub get_compilation_errors
}
my $proc = IO::Async::Process->new(
- command => [$perl, @inc, @loadfile, @{$args}],
+ command => [$perl, @inc, @loadfile, '--', @{$args}],
setup => \@setup,
stderr => {
on_read => sub {
I did a slightly different impl of the suffix check which I like better than the way we had it.
I believe I implemented everything else we discussed
I'm letting this burn in before I merge it. I've found an issue.
One of the files from my company's code base is failing to compile under this change, when -c would succeed (there would just be some "Subroutine redefined" warnings, which are filtered out by PLS).
This seems to only occur when not using a path relative to a directory in @INC.
Can you update this to try to determine the appropriate relative path? It would be something like this (using Path::Tiny):
foreach my $inc_path (@inc)
{
if (path($inc_path)->subsumes($path))
{
$path = path($path)->relative($inc_path);
last;
}
}
You could also try this:
foreach my $inc_path (@inc)
{
my $rel = path($path)->relative($inc_path);
if ($rel !~ /\.\./)
{
$path = $rel;
last;
}
}
Nevermind my last two comments - those don't seem to work either as-is. What does work is fooling Perl into thinking that it is loading the actual module. It falls back to old behavior if it can't be resolved.
my $module;
my $relative;
foreach my $inc_path (@{$inc})
{
my $rel = path($orig_path)->relative($inc_path);
if ($rel !~ /\.\./)
{
$module = $rel;
$relative = $rel;
$module =~ s/\.pm$//;
$module =~ s/\//::/g;
last;
}
}
my $code;
$path =~ s/'/\\'/g;
if (length $module and length $relative)
{
$relative =~ s/'/\\'/g;
$code = q[BEGIN { unshift @INC, sub { my (undef, $filename) = @_; if ($filename eq '] . $relative . q[') { open (my $fh, '<', '] . $path . q['); return $fh; } return undef; }; require ] . $module . q[ }];
}
else
{
$code = "BEGIN { require '$path' }";
}
@loadfile = (-e => $code);
This requires a slight change to the compilation parsing:
if (my ($error, $file, $line, $area) = $line =~ /^(.+) at (.+?) line (\d+)(, .+)?/)
{
$error .= $area if (length $area);
$line = int $line;
$file = $path if ($file eq '-e');
+ $file = $path if ($file =~ /^\/loader/); # coming from the subroutine in @INC
next if ($file ne $path);
I'm letting this burn in before I merge it. I've found an issue.
One of the files from my company's code base is failing to compile under this change, when -c would succeed (there would just be some "Subroutine redefined" warnings, which are filtered out by PLS).
This seems to only occur when not using a path relative to a directory in
@INC.
Could I get a minimal example of this problem that happens? I'd like to be able to work against real files
I'll try, it's kind of a weird scenario related to messing with the symbol table.
Alright, this is a bit of a contrived example, but it looks like the issue is that when you have circular dependencies, if you have functions running at BEGIN time, they end up running twice (seems like the library is maybe loaded twice)
3 files:
Test1.pm
package Test1;
sub test
{
print "this should only print once\n";
}
BEGIN
{
require Test2;
require Test3;
}
1;
Test2.pm:
package Test2;
BEGIN {
require Test1;
require Test3;
}
1;
Test3.pm:
package Test3;
BEGIN {
require Test1;
require Test2;
}
Test1::test();
1;
Here are the different results:
[mreisner@vm-mreisner mre]$ perl -I. -e 'BEGIN { require "/home/mreisner/mre/Test3.pm" }'
this should only print once
this should only print once
[mreisner@vm-mreisner mre]$ perl -I. -e 'BEGIN { require Test3 }'
this should only print once
If you change the code to add a subroutine reference to @INC to handle the file being checked (to point it to the unsaved copy), it works:
[mreisner@vm-mreisner mre]$ cp Test3.pm .pls-tmp-xyz; sed -i '$ d' .pls-tmp-xyz; echo 0 >> .pls-tmp-xyz; perl -I. -e 'BEGIN { unshift @INC, sub { my (undef, $filename) = @_; if ($filename eq "Test3.pm") { if (open my $fh, "<", "/home/mreisner/mre/.pls-tmp-xyz") { $INC{$filename} = "/home/mreisner/mre/.pls-tmp-xyz"; return $fh } } }; require Test3; }'
this should only print once
Test3.pm did not return a true value at -e line 1.
BEGIN failed--compilation aborted at -e line 1.
vs this:
[mreisner@vm-mreisner mre]$ cp Test3.pm .pls-tmp-xyz; sed -i '$ d' .pls-tmp-xyz; echo 0 >> .pls-tmp-xyz; perl -I. -e 'BEGIN { require "/home/mreisner/mre/.pls-tmp-xyz" }'
this should only print once
this should only print once
/home/mreisner/mre/.pls-tmp-xyz did not return a true value at -e line 1.
BEGIN failed--compilation aborted at -e line 1.
FWIW, string require works as well, so long as you provide a path relative to @INC.
[mreisner@vm-mreisner mre]$ cp Test3.pm .pls-tmp-xyz; sed -i '$ d' .pls-tmp-xyz; echo 0 >> .pls-tmp-xyz; perl -I. -e 'BEGIN { unshift @INC, sub { my (undef, $filename) = @_; if ($filename eq "Test3.pm") { if (open my $fh, "<", "/home/mreisner/mre/.pls-tmp-xyz") { $INC{$filename} = "/home/mreisner/mre/.pls-tmp-xyz"; return $fh } } }; require "Test3.pm"; }'
this should only print once
Test3.pm did not return a true value at -e line 1.
BEGIN failed--compilation aborted at -e line 1.
Looks like this has something to do with how %INC gets set.
[mreisner@vm-mreisner mre]$ perl -MData::Dumper -I. -e 'BEGIN { require "/home/mreisner/mre/Test3.pm"; print Dumper \%INC }'
this should only print once
this should only print once
$VAR1 = {
'bytes.pm' => '/home/mreisner/perl5/perlbrew/perls/perl-5.34.0/lib/5.34.0/bytes.pm',
'XSLoader.pm' => '/home/mreisner/perl5/perlbrew/perls/perl-5.34.0/lib/5.34.0/XSLoader.pm',
'Data/Dumper.pm' => '/home/mreisner/perl5/perlbrew/perls/perl-5.34.0/lib/5.34.0/x86_64-linux/Data/Dumper.pm',
'Test2.pm' => 'Test2.pm',
'/home/mreisner/mre/Test3.pm' => '/home/mreisner/mre/Test3.pm',
'warnings/register.pm' => '/home/mreisner/perl5/perlbrew/perls/perl-5.34.0/lib/5.34.0/warnings/register.pm',
'Test1.pm' => 'Test1.pm',
'constant.pm' => '/home/mreisner/perl5/perlbrew/perls/perl-5.34.0/lib/5.34.0/constant.pm',
'warnings.pm' => '/home/mreisner/perl5/perlbrew/perls/perl-5.34.0/lib/5.34.0/warnings.pm',
'strict.pm' => '/home/mreisner/perl5/perlbrew/perls/perl-5.34.0/lib/5.34.0/strict.pm',
'Test3.pm' => 'Test3.pm',
'overloading.pm' => '/home/mreisner/perl5/perlbrew/perls/perl-5.34.0/lib/5.34.0/overloading.pm',
'Carp.pm' => '/home/mreisner/perl5/perlbrew/perls/perl-5.34.0/lib/5.34.0/Carp.pm',
'Exporter.pm' => '/home/mreisner/perl5/perlbrew/perls/perl-5.34.0/lib/5.34.0/Exporter.pm'
};
[mreisner@vm-mreisner mre]$ perl -MData::Dumper -I. -e 'BEGIN { require Test3; print Dumper \%INC }'
this should only print once
$VAR1 = {
'Carp.pm' => '/home/mreisner/perl5/perlbrew/perls/perl-5.34.0/lib/5.34.0/Carp.pm',
'strict.pm' => '/home/mreisner/perl5/perlbrew/perls/perl-5.34.0/lib/5.34.0/strict.pm',
'warnings.pm' => '/home/mreisner/perl5/perlbrew/perls/perl-5.34.0/lib/5.34.0/warnings.pm',
'Exporter.pm' => '/home/mreisner/perl5/perlbrew/perls/perl-5.34.0/lib/5.34.0/Exporter.pm',
'constant.pm' => '/home/mreisner/perl5/perlbrew/perls/perl-5.34.0/lib/5.34.0/constant.pm',
'warnings/register.pm' => '/home/mreisner/perl5/perlbrew/perls/perl-5.34.0/lib/5.34.0/warnings/register.pm',
'XSLoader.pm' => '/home/mreisner/perl5/perlbrew/perls/perl-5.34.0/lib/5.34.0/XSLoader.pm',
'overloading.pm' => '/home/mreisner/perl5/perlbrew/perls/perl-5.34.0/lib/5.34.0/overloading.pm',
'bytes.pm' => '/home/mreisner/perl5/perlbrew/perls/perl-5.34.0/lib/5.34.0/bytes.pm',
'Test2.pm' => 'Test2.pm',
'Data/Dumper.pm' => '/home/mreisner/perl5/perlbrew/perls/perl-5.34.0/lib/5.34.0/x86_64-linux/Data/Dumper.pm',
'Test3.pm' => 'Test3.pm',
'Test1.pm' => 'Test1.pm'
};
Looks like this has something to do with how %INC gets set.
yes, that makes sense to me. What's funny is that this is the same thing that happens when you load it via -c, that it doesn't create an INC entry so it will get loaded twice; what code was handling that, and why is that not getting tripped here?
I plan on merging this when I'm confident that there are no more issues, probably next week.
I'll update to the latest version and let you know if I have any issues.
On Tue, Nov 22, 2022, 19:30 Marc Reisner @.***> wrote:
I plan on merging this when I'm confident that there are no more issues, probably next week.
— Reply to this email directly, view it on GitHub https://github.com/FractalBoy/perl-language-server/pull/119#issuecomment-1324020865, or unsubscribe https://github.com/notifications/unsubscribe-auth/AFURPKRFFMHWWXAINYMDXYTWJT7LJANCNFSM6AAAAAARNJKXVM . You are receiving this because you authored the thread.Message ID: @.***>
🥳
On Thu, Dec 8, 2022, 22:55 Marc Reisner @.***> wrote:
Merged #119 https://github.com/FractalBoy/perl-language-server/pull/119 into master.
— Reply to this email directly, view it on GitHub https://github.com/FractalBoy/perl-language-server/pull/119#event-7992910105, or unsubscribe https://github.com/notifications/unsubscribe-auth/AFURPKV7OXS3BULGGB6DQXTWMJDNBANCNFSM6AAAAAARNJKXVM . You are receiving this because you authored the thread.Message ID: @.*** com>