fix(variables): fix variable handling

src/extension.ts

@@ -184,7 +184,15 @@ class PerlDebugConfigurationProvider implements vscode.DebugConfigurationProvide
 
 		const editor = vscode.window.activeTextEditor;
 
-		if (!config.request && editor.document.languageId === 'perl') {
+		const perlEditor = (
+			editor
+			&&
+			editor.document
+			&&
+			editor.document.languageId === 'perl'
+		);
+
+		if (!config.request && perlEditor) {
 
 			const defaultConfig = vscode.extensions.getExtension(
 				"mortenhenriksen.perl-debug"

src/remoteSession.ts

@@ -100,16 +100,7 @@ export class RemoteSession extends EventEmitter implements DebugSession {
 			}
 
 			socket.on('data', data => {
-				// const str = data.toString('utf8');
-				// const signature = str.split('\n').pop();
-				// xxx: We should figure out a more stable way of differentiating between
-				// command result and application output
-				this.stderr.push(data); // xxx: For now we don't forward application output
-				/*  if (debuggerSignature.test(signature)) {
-					this.stderr.push(data);
-				} else {
-					this.stdout.push(data);
-				}*/
+				this.stderr.push(data);
 			});
 
 			socket.on('end', data => {

src/tests/adapter.test.ts

@@ -1,8 +1,3 @@
-/*---------------------------------------------------------------------------------------------
- *  Copyright (c) Microsoft Corporation. All rights reserved.
- *  Licensed under the MIT License. See License.txt in the project root for license information.
- *--------------------------------------------------------------------------------------------*/
-
 import assert = require('assert');
 import * as Path from 'path';
 import * as fs from 'fs';
@@ -27,6 +22,7 @@ describe('Perl debug Adapter', () => {
 	const FILE_PRINT_ARGUMENTS = 'print_arguments.pl';
 	const FILE_FAST_TEST_PL = 'fast_test.pl';
 	const FILE_LONG_RUNNING_PL = 'long_running.pl';
+	const FILE_VARS_TEST_PL = "vars_test.pl";
 
 	const PERL_DEBUG_LOG = 'perl_debugger.log';
 
@@ -40,6 +36,11 @@ describe('Perl debug Adapter', () => {
 		program: Path.join(DATA_ROOT, FILE_FAST_TEST_PL),
 		inc: [],
 		args: [],
+		env: {
+			// User perlbrew installations should take priority over system
+			// Perl installations.
+			PATH: process.env.PATH,
+		},
 		stopOnEntry: false,
 		console: 'none',
 		trace: false,
@@ -61,6 +62,29 @@ describe('Perl debug Adapter', () => {
 		}
 	};
 
+	const getScopedVars = async (
+		dc: DebugClient,
+		frameId: number,
+		name: string,
+	): Promise<DebugProtocol.VariablesResponse> => {
+
+		const st = await dc.stackTraceRequest({
+			threadId: undefined
+		});
+
+		const scopes = await dc.scopesRequest({
+			frameId: st.body.stackFrames[frameId].id
+		});
+
+		const vars = await dc.variablesRequest({
+			variablesReference: scopes.body.scopes.filter(
+				x => x.name === name
+			)[0].variablesReference
+		});
+
+		return vars;
+
+	};
 
 	let dc: DebugClient;
 
@@ -152,6 +176,97 @@ describe('Perl debug Adapter', () => {
 		});
 	});
 
+	describe('variables', () => {
+
+		it('variable retrieval should work', async () => {
+
+			await dc.launch(Configuration({
+				program: FILE_VARS_TEST_PL,
+				stopOnEntry: true
+			}));
+
+			const globalVars = await getScopedVars(dc, 0, 'Global');
+
+			const perlVer = globalVars.body.variables.filter(
+				x => x.name === '$]'
+			)[0];
+
+			assert.ok(/^5\./.test(perlVer.value));
+
+			const bpRespone = await dc.setBreakpointsRequest({
+				source: {
+					path: FILE_VARS_TEST_PL,
+				},
+				lines: [17],
+			});
+
+			assert(bpRespone.success, 'set breakpoint');
+
+			await Promise.all([
+				dc.continueRequest({ threadId: undefined }),
+				dc.assertStoppedLocation('breakpoint', {
+					line: 17
+				})
+			]);
+
+			const lexicals1 = async () => {
+
+				const lexicalVars = await getScopedVars(dc, 0, 'Lexical');
+
+				assert.ok(
+					lexicalVars.body.variables.filter(
+						x => x.name === '$PKG_MY' && x.value.indexOf('PKG_MY') > 0
+					).length > 0,
+					'can see a PKG_MY variable'
+				);
+
+				assert.ok(
+					lexicalVars.body.variables.filter(
+						x => x.name === '$arg' && x.value.indexOf('inner') > 0
+					).length > 0,
+					'can see a arg variable'
+				);
+
+				assert.ok(
+					lexicalVars.body.variables.filter(
+						x => x.name === '$outer_my' && x.value.indexOf('outer_my') > 0
+					).length === 0,
+					'cannot see a $outer_my variable from other stack frame'
+				);
+
+				const globalVars = await getScopedVars(dc, 0, 'Global');
+
+				assert.ok(
+					globalVars.body.variables.filter(
+						x => x.name === '$/'
+						&&
+						x.value.toLowerCase().indexOf('20ac') > 0
+					).length > 0,
+					'can see a localised $/ variable set to EURO sign'
+				);
+
+			};
+
+			const lexicals2 = async () => {
+
+				const lexicalVars = await getScopedVars(dc, 1, 'Lexical');
+
+				assert.ok(
+					lexicalVars.body.variables.filter(
+						x => x.name === '$outer_my' && x.value.indexOf('outer_my') > 0
+					).length > 0,
+					'can see a $outer_my variable in middle stack frame'
+				);
+
+			};
+
+			await lexicals1();
+			await lexicals2();
+
+		});
+
+	});
+
 	describe('pause', () => {
 
 		(platform() === "win32" ? it.skip : it)('should be able to pause programs', async () => {
@@ -172,7 +287,7 @@ describe('Perl debug Adapter', () => {
 			// NOTE(bh): Perl's built-in `sleep` function only supports
 			// integer resolution sleeps, so this test is a bit slow.
 
-			await new Promise(resolve => setTimeout(resolve, 2200));
+			await new Promise(resolve => setTimeout(resolve, 1200));
 
 			await dc.pauseRequest({
 				threadId: undefined,
@@ -192,8 +307,8 @@ describe('Perl debug Adapter', () => {
 			});
 
 			assert.ok(
-				parseInt(result.body.result) > 3,
-				'must have gone at least twice through the loop'
+				parseInt(result.body.result, 10) > 2,
+				'must have gone at least once through the loop'
 			);
 
 		});

src/tests/connection.test.ts

@@ -319,28 +319,6 @@ describe('Perl debugger connection', () => {
 			});
 		});
 
-		describe('getVariableList', () => {
-			it('Should get more scope variables types', async function() {
-				await testLaunch(conn, FILE_TEST_PL, DATA_ROOT, []);
-				await conn.setBreakPoint(23, FILE_MODULE);
-
-				await conn.continue();
-
-				const vars0 = await conn.getVariableList(0);
-				const actual = Object.keys(vars0).length;
-				const expected = [0, 44, 45, 46]; // xxx: Investigate 44+46 might be a perser issue
-				assert(expected.indexOf(actual) > -1, 'variable count level 0, actual: ' +
-						actual + ' expected: ' + expected.join(' or '));
-
-				const vars1 = await conn.getVariableList(1);
-				assert.equal(Object.keys(vars1).length, 7, 'variable count level 1');
-				const vars2 = await conn.getVariableList(2);
-				assert.equal(Object.keys(vars2).length, 1, 'variable count level 2');
-				const vars3 = await conn.getVariableList(3);
-				assert.equal(Object.keys(vars3).length, 0, 'variable count level 3');
-			});
-		});
-
 		describe('restart', () => {
 			it('Should start from the beginning', async () => {
 				let res = await testLaunch(conn, FILE_TEST_PL, DATA_ROOT, []);

src/tests/data/vars_test.pl

@@ -0,0 +1,38 @@
+#!/usr/bin/env perl
+package Local::Package;
+use strict;
+use warnings;
+
+our $PKG_OUR = "our Local::Package PKG_OUR";
+my $PKG_MY = "my Local::Package PKG_MY";
+
+sub outer_sub {
+	my $outer_my = "outer_my";
+	inner_sub("argument to inner_sub");
+}
+
+sub inner_sub {
+	my ($arg) = @_;
+	local $/ = "\x{20ac}";
+	return $arg;
+}
+
+package main;
+use strict;
+use warnings;
+
+my $main_my = "main_my";
+my %hash = ("\%hash_key" => "\%hash_value");
+my $hash_ref = {
+	"hash_ref_key" => "hash_ref_value"
+};
+
+my $array_ref = [1..9];
+
+my $string = "string";
+
+my $ref_to_ref_to_string = \(\("ref_to_ref_to_string"));
+
+Local::Package::outer_sub();
+
+exit 0;