summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--client/src/test/completion.test.ts10
-rw-r--r--client/src/test/diagnostics.test.ts9
-rw-r--r--server/src/perl/Inquisitor.pm62
-rw-r--r--server/src/perl/defaultCriticProfile4
-rw-r--r--t/01_MyClass.t21
-rw-r--r--testWorkspace/MyLib/MyClass.pm4
-rw-r--r--testWorkspace/mainTest.pl2
7 files changed, 96 insertions, 16 deletions
diff --git a/client/src/test/completion.test.ts b/client/src/test/completion.test.ts
index 29786f1..af0a613 100644
--- a/client/src/test/completion.test.ts
+++ b/client/src/test/completion.test.ts
@@ -10,11 +10,11 @@ import { getDocUri, activate } from './helper';
suite('Should do completion', () => {
const docUri = getDocUri('mainTest.pl');
- test('Completes JS/TS in txt file', async () => {
- await testCompletion(docUri, new vscode.Position(0, 0), {
+ // Unfortunately, this test does not work yet
+ test('Test autocompletion', async () => {
+ await testCompletion(docUri, new vscode.Position(29, 23), {
items: [
- { label: 'JavaScript', kind: vscode.CompletionItemKind.Text },
- { label: 'TypeScript', kind: vscode.CompletionItemKind.Text }
+ { label: '$my_scalar', kind: vscode.CompletionItemKind.Variable },
]
});
});
@@ -34,7 +34,7 @@ async function testCompletion(
position
)) as vscode.CompletionList;
- assert.ok(actualCompletionList.items.length >= 2);
+ assert.ok(actualCompletionList.items.length == 1);
expectedCompletionList.items.forEach((expectedItem, i) => {
const actualItem = actualCompletionList.items[i];
assert.equal(actualItem.label, expectedItem.label);
diff --git a/client/src/test/diagnostics.test.ts b/client/src/test/diagnostics.test.ts
index 9683eef..fb47905 100644
--- a/client/src/test/diagnostics.test.ts
+++ b/client/src/test/diagnostics.test.ts
@@ -8,13 +8,12 @@ import * as assert from 'assert';
import { getDocUri, activate } from './helper';
suite('Should get diagnostics', () => {
- const docUri = getDocUri('mainTest.pl');
+ const docUri = getDocUri('MyLib/MyClass.pm');
- test('Diagnoses uppercase texts', async () => {
+ test('Checks perl compilation warnings', async () => {
await testDiagnostics(docUri, [
- { message: 'ANY is all uppercase.', range: toRange(0, 0, 0, 3), severity: vscode.DiagnosticSeverity.Warning, source: 'ex' },
- { message: 'ANY is all uppercase.', range: toRange(0, 14, 0, 17), severity: vscode.DiagnosticSeverity.Warning, source: 'ex' },
- { message: 'OS is all uppercase.', range: toRange(0, 18, 0, 20), severity: vscode.DiagnosticSeverity.Warning, source: 'ex' }
+ { message: 'Syntax: "my" variable $genWarning masks earlier declaration in same scope at /home/brian/github/PerlNavigator/testWorkspace/MyLib/MyClass.pm line 27.',
+ range: toRange(26, 0, 26, 500), severity: vscode.DiagnosticSeverity.Warning, source: 'perlnavigator' },
]);
});
});
diff --git a/server/src/perl/Inquisitor.pm b/server/src/perl/Inquisitor.pm
index 1174ebc..c0723df 100644
--- a/server/src/perl/Inquisitor.pm
+++ b/server/src/perl/Inquisitor.pm
@@ -11,8 +11,16 @@ my @checkPreloaded = qw(List::Util File::Spec Sub::Util Cwd Scalar::Util );
CHECK {
+ if(!$ENV{'PERLNAVIGATORTEST'}){
+ run();
+ }
+}
+
+sub run {
print "Running inquisitor\n";
+ my $sourceFilePath = shift;
eval {
+ load_test_file($sourceFilePath);
populate_preloaded();
load_dependencies();
@@ -25,7 +33,7 @@ CHECK {
$allPackages = filter_modpacks($allPackages);
dump_subs_from_packages($allPackages);
- my $packages = run_pltags();
+ my $packages = run_pltags($sourceFilePath);
print "Done with pltags. Now dumping same-file packages\n";
foreach my $package (@$packages){
@@ -57,6 +65,22 @@ sub load_dependencies {
require Devel::Symdump;
}
+sub load_test_file {
+ # If we're in test mode for a .t file, we haven't loaded the file yet, so let's eval it to populate the symbol table
+ my $filePath = shift;
+ return if !$filePath;
+ my ($source, $offset, $file) = load_source($filePath);
+
+ $source = "local \$0; BEGIN { \$0 = '${filePath}'; if (\$INC{'FindBin.pm'}) { FindBin->again(); }; }\n# line 0 \"${filePath}\"\nCORE::die('END_EARLY');\n$source";
+ eval $source; ## no critic
+
+ if ($@ eq "END_EARLY.\n"){
+ return;
+ } else {
+ die("Rethrowing error from $filePath: ---$@---");
+ }
+}
+
sub maybe_print_sub_info {
my ($sFullPath, $sDisplayName, $codeRef, $sSkipPackage, $subType) = @_;
$subType = 't' if !$subType;
@@ -141,7 +165,8 @@ sub print_tag {
sub run_pltags {
require pltags;
- my ($source, $offset, $file) = load_source();
+ my $sourceFilePath = shift;
+ my ($source, $offset, $file) = load_source($sourceFilePath);
print "\n--------------Now Building the new pltags ---------------------\n";
my ($tags, $packages) = pltags::build_pltags($source, $offset, $file); # $0 should be the script getting compiled, not this module
@@ -293,23 +318,50 @@ sub get_all_packages {
}
sub load_source {
+ my $sourceFilePath = shift; # Only set during testing.
my ($source, $offset, $file);
- if ($INC{"lib_bs22/SourceStash.pm"}){
+
+ if($sourceFilePath){
+ # Currently loading the source twice, which is a waste. TODO: Move some stuff around
+ open my $fh, '<:utf8', $sourceFilePath or die "Can't open file $!"; ## no critic (UTF8)
+ $file = $sourceFilePath;
+ $source = do { local $/; <$fh> };
+ $offset = 1;
+ close($fh);
+ } elsif ($INC{"lib_bs22/SourceStash.pm"}){
+ # Path run during the extension
$source = $lib_bs22::SourceStash::source;
$file = $lib_bs22::SourceStash::filename;
$source = Encode::decode('utf-8', $source);
$offset = 3;
} else{
+ # Used for debugging the extension and shown to users in the log
require File::Spec;
# TODO: Adjust PLTags offset in this case.
- my $orig_file = File::Spec->rel2abs($0);
- open my $fh, '<:utf8', $orig_file or die "Can't open file $!"; ## no critic (UTF8)
+ $file = File::Spec->rel2abs($0);
+ open my $fh, '<:utf8', $file or die "Can't open file $!"; ## no critic (UTF8)
$source = do { local $/; <$fh> };
$offset = 1;
+ close($fh);
}
$source = "" if !defined($source);
return ($source, $offset, $file);
}
+sub tags_to_symbols {
+ # Currently only used for testing. Turns an output of tags into a hash of symbol array, similiar to ParseDocument.ts
+ my $tags = shift;
+ my $symbols = {};
+ foreach my $tag_str (split("\n", $tags)){
+ my @pieces = split("\t", $tag_str, -1);
+ if( scalar( @pieces ) == 7 ){
+ my ($tag, $type, $typeDetails, $file, $package_name, $line) = @pieces;
+ $symbols->{$tag} = [] if !exists($symbols->{$tag});
+ push @{ $symbols->{$tag} }, {'type'=> $type, 'typeDetails' => $typeDetails, 'file'=>$file, 'package_name'=>$package_name, 'line'=>$line};
+ }
+ }
+ return $symbols;
+}
+
1;
diff --git a/server/src/perl/defaultCriticProfile b/server/src/perl/defaultCriticProfile
index be2d055..0644b8c 100644
--- a/server/src/perl/defaultCriticProfile
+++ b/server/src/perl/defaultCriticProfile
@@ -27,4 +27,6 @@ allow = vars subs refs
[-ValuesAndExpressions::ProhibitConstantPragma]
# Multiple packages in one file is bad form, but it's not a bug or unintentional
-[-Modules::ProhibitMultiplePackages] \ No newline at end of file
+[-Modules::ProhibitMultiplePackages]
+
+[-Subroutines::RequireFinalReturn] \ No newline at end of file
diff --git a/t/01_MyClass.t b/t/01_MyClass.t
new file mode 100644
index 0000000..fccc375
--- /dev/null
+++ b/t/01_MyClass.t
@@ -0,0 +1,21 @@
+use strict;
+use warnings;
+use Capture::Tiny qw(capture);
+use Test::More import => [qw(done_testing is like)];
+
+# Need to pass some signal to inquistor to not run during its CHECK block. Alternatively, maybe we can check for the test harness environment variable?
+BEGIN { $ENV{'PERLNAVIGATORTEST'} = 1; }
+
+use FindBin qw($Bin);
+use lib "$Bin/../server/src/perl";
+use Inquisitor;
+
+
+my $testFile = File::Spec->rel2abs("$Bin/../testWorkspace/MyLib/MyClass.pm");
+my $output = capture(sub { Inquisitor::run($testFile) });
+my $symbols = Inquisitor::tags_to_symbols($output);
+
+is($symbols->{'overridden_method'}->[0]->{'type'}, 's', 'Basic sub');
+is($symbols->{'overridden_method'}->[0]->{'line'}, '11;14', 'Sub boundaries');
+
+done_testing; \ No newline at end of file
diff --git a/testWorkspace/MyLib/MyClass.pm b/testWorkspace/MyLib/MyClass.pm
index 810751d..a229420 100644
--- a/testWorkspace/MyLib/MyClass.pm
+++ b/testWorkspace/MyLib/MyClass.pm
@@ -22,4 +22,8 @@ sub duplicate_method_name {
print "In MyObject duplicate_name\n";
}
+
+my $genWarning;
+my $genWarning;
+
1; \ No newline at end of file
diff --git a/testWorkspace/mainTest.pl b/testWorkspace/mainTest.pl
index 9a29e12..ce8d6b5 100644
--- a/testWorkspace/mainTest.pl
+++ b/testWorkspace/mainTest.pl
@@ -27,6 +27,8 @@ use MySubClass;
use constant MYCONSTANT => 6;
+my $autoComplete = ' $my ';
+
my $my_scalar = 1;
my @my_array = (2,2);
my $array_ref = [3,3];