Skip to content

Fix foreach-refalias for arrays and hashes (for \@arr, for \%hash) #175

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
fglock merged 4 commits into from
Feb 6, 2026
Merged

Fix foreach-refalias for arrays and hashes (for \@arr, for \%hash) #175

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
8e0be55
Fix foreach-refalias for arrays and hashes (for \@arr, for \%hash)
fglock Feb 6, 2026
89cc587
Add validation to prevent operators on variable declarations
fglock Feb 6, 2026
2a077d7
Fix race condition in directory.t test
fglock Feb 6, 2026
d74afb5
Fix operator validation to only apply to declared references
fglock Feb 6, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
60 changes: 54 additions & 6 deletions src/main/java/org/perlonjava/codegen/EmitForeach.java
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -352,15 +352,63 @@ public static void emitFor1(EmitterVisitor emitterVisitor, For1Node node) {
mv.visitMethodInsn(Opcodes.INVOKEINTERFACE, "java/util/Iterator", "next", "()Ljava/lang/Object;", true);
mv.visitTypeInsn(Opcodes.CHECKCAST, "org/perlonjava/runtime/RuntimeScalar");

// For reference aliasing with arrays/hashes, dereference the scalar
// to get the underlying RuntimeArray/RuntimeHash
if (isReferenceAliasing && actualVariable instanceof OperatorNode innerOp) {
if (innerOp.operator.equals("@")) {
// Array: dereference scalar to get RuntimeArray
mv.visitMethodInsn(Opcodes.INVOKEVIRTUAL,
"org/perlonjava/runtime/RuntimeScalar",
"arrayDeref",
"()Lorg/perlonjava/runtime/RuntimeArray;",
false);
} else if (innerOp.operator.equals("%")) {
// Hash: dereference scalar to get RuntimeHash
mv.visitMethodInsn(Opcodes.INVOKEVIRTUAL,
"org/perlonjava/runtime/RuntimeScalar",
"hashDeref",
"()Lorg/perlonjava/runtime/RuntimeHash;",
false);
}
// For scalars ($), no dereferencing needed - keep the reference as-is
}

if (loopVariableIsGlobal) {
// Regular global variable assignment
// Global variable assignment
mv.visitLdcInsn(globalVarName);
mv.visitInsn(Opcodes.SWAP); // Stack: globalVarName, iteratorValue
mv.visitMethodInsn(Opcodes.INVOKESTATIC,
"org/perlonjava/runtime/GlobalVariable",
"aliasGlobalVariable",
"(Ljava/lang/String;Lorg/perlonjava/runtime/RuntimeScalar;)V",
false);

if (isReferenceAliasing && actualVariable instanceof OperatorNode innerOp) {
if (innerOp.operator.equals("@")) {
// Array: use setGlobalArray
mv.visitMethodInsn(Opcodes.INVOKESTATIC,
"org/perlonjava/runtime/GlobalVariable",
"setGlobalArray",
"(Ljava/lang/String;Lorg/perlonjava/runtime/RuntimeArray;)V",
false);
} else if (innerOp.operator.equals("%")) {
// Hash: use setGlobalHash
mv.visitMethodInsn(Opcodes.INVOKESTATIC,
"org/perlonjava/runtime/GlobalVariable",
"setGlobalHash",
"(Ljava/lang/String;Lorg/perlonjava/runtime/RuntimeHash;)V",
false);
} else {
// Scalar: use aliasGlobalVariable (original behavior)
mv.visitMethodInsn(Opcodes.INVOKESTATIC,
"org/perlonjava/runtime/GlobalVariable",
"aliasGlobalVariable",
"(Ljava/lang/String;Lorg/perlonjava/runtime/RuntimeScalar;)V",
false);
}
} else {
// Non-reference-aliasing case: use aliasGlobalVariable
mv.visitMethodInsn(Opcodes.INVOKESTATIC,
"org/perlonjava/runtime/GlobalVariable",
"aliasGlobalVariable",
"(Ljava/lang/String;Lorg/perlonjava/runtime/RuntimeScalar;)V",
false);
}
} else if (variableNode instanceof OperatorNode operatorNode) {
// Local variable case
String varName = operatorNode.operator + ((IdentifierNode) operatorNode.operand).name;
Expand Down
48 changes: 48 additions & 0 deletions src/main/java/org/perlonjava/parser/ParseInfix.java
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -50,6 +50,54 @@ public static Node parseInfixOperation(Parser parser, Node left, int precedence)

if (ParserTables.INFIX_OP.contains(token.text)) {
String operator = token.text;

// Check if left operand is a DECLARED REFERENCE (my \$a, our \@arr, etc.)
// Most operators cannot be applied to declared references
if (left instanceof OperatorNode leftOp) {
String declOperator = leftOp.operator;
boolean isDeclaredReference = leftOp.getBooleanAnnotation("isDeclaredReference");

if (isDeclaredReference &&
("my".equals(declOperator) || "our".equals(declOperator) ||
"state".equals(declOperator) || "local".equals(declOperator))) {

// Allow assignment operators and comma (special handling)
boolean isAllowedOperator =
operator.equals("=") || operator.equals(",") ||
operator.endsWith("="); // +=, -=, .=, etc.

if (!isAllowedOperator) {
// Get operator name for error message
String opName = switch (operator) {
case "**" -> "exponentiation (**)";
case "+" -> "addition (+)";
case "-" -> "subtraction (-)";
case "*" -> "multiplication (*)";
case "/" -> "division (/)";
case "%" -> "modulus (%)";
case "x" -> "repetition (x)";
case "." -> "concatenation (.)";
case ".." -> "range (..)";
case "..." -> "flip-flop (...)";
case "<<", ">>" -> "shift (" + operator + ")";
case "<", ">", "<=", ">=", "==", "!=" -> "comparison (" + operator + ")";
case "lt", "gt", "le", "ge", "eq", "ne", "cmp", "<=>" -> "comparison (" + operator + ")";
case "~~" -> "smartmatch (~~)";
case "&", "|", "^" -> "bitwise (" + operator + ")";
case "&&", "||", "//" -> "logical (" + operator + ")";
case "and", "or", "xor" -> "logical (" + operator + ")";
default -> operator + " (" + operator + ")";
};

throw new PerlCompilerException(
parser.tokenIndex,
"Can't declare " + opName + " in " + declOperator,
parser.ctx.errorUtil
);
}
}
}

boolean operatorEnabled = switch (operator) {
case "isa" -> parser.ctx.symbolTable.isFeatureCategoryEnabled("isa");
case "&.", "|.", "^.", "&.=", "|.=", "^.=" ->
Expand Down
53 changes: 44 additions & 9 deletions src/test/resources/unit/directory.t
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,9 +3,35 @@ use strict;
use warnings;
use Test::More tests => 9;
use Cwd qw(getcwd abs_path);
use File::Spec;

# Create a unique directory name to avoid conflicts when tests run in parallel
my $test_dir = 'test_dir_' . $$ . '_' . time();
my $test_file = 'test_file.txt';

# Cleanup function to remove test artifacts
sub cleanup {
my $original_cwd = getcwd();

# Try to clean up test file and directory
eval {
chdir $original_cwd;
if (-e "$test_dir/$test_file") {
unlink "$test_dir/$test_file" or warn "Failed to remove test file: $!";
}
if (-d $test_dir) {
rmdir $test_dir or warn "Failed to remove test directory: $!";
}
};
}

# Ensure cleanup happens even if test fails
END { cleanup(); }

# Clean up any leftover artifacts from previous failed runs
cleanup();

# Test mkdir function
my $test_dir = 'test_dir';
my $mkdir_result = mkdir $test_dir;
ok($mkdir_result, 'mkdir creates a directory');

Expand Down Expand Up @@ -42,17 +68,26 @@ my $expected_cwd = abs_path('.'); # Correctly calculate the expected path
is($cwd_after_chdir, $expected_cwd, 'cwd returns correct path after chdir');

# Test open command after directory change
open my $fh, '>', 'test_file.txt' or die "Cannot open file: $!";
open my $fh, '>', $test_file or die "Cannot open file: $!";
print $fh "test content";
close $fh;
ok(-e 'test_file.txt', 'open creates a file in the new directory');
ok(-e $test_file, 'open creates a file in the new directory');

# Cleanup
# Cleanup - restore original directory before removing files
chdir $original_cwd;
unlink "$test_dir/test_file.txt" if -e "$test_dir/test_file.txt";
rmdir $test_dir if -d $test_dir;

# Verify cleanup
if (-d $test_dir || -e "$test_dir/test_file.txt") {
die "Cleanup failed: test directory or files still exist";
# Give filesystem a moment to sync (helps with parallel test reliability)
# Remove test file
if (-e "$test_dir/$test_file") {
unlink "$test_dir/$test_file" or warn "Failed to remove $test_dir/$test_file: $!";
}

# Remove test directory
if (-d $test_dir) {
rmdir $test_dir or warn "Failed to remove $test_dir: $!";
}

# Verify cleanup (non-fatal - let END block try again if needed)
if (-d $test_dir || -e "$test_dir/$test_file") {
diag "Warning: Cleanup verification found leftover files (will retry in END block)";
}