diff --git a/src/main/java/org/perlonjava/codegen/EmitForeach.java b/src/main/java/org/perlonjava/codegen/EmitForeach.java index e309624f4..02fe091b9 100644 --- a/src/main/java/org/perlonjava/codegen/EmitForeach.java +++ b/src/main/java/org/perlonjava/codegen/EmitForeach.java @@ -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; diff --git a/src/main/java/org/perlonjava/parser/ParseInfix.java b/src/main/java/org/perlonjava/parser/ParseInfix.java index facc0969a..ca8b8a466 100644 --- a/src/main/java/org/perlonjava/parser/ParseInfix.java +++ b/src/main/java/org/perlonjava/parser/ParseInfix.java @@ -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 "&.", "|.", "^.", "&.=", "|.=", "^.=" -> diff --git a/src/test/resources/unit/directory.t b/src/test/resources/unit/directory.t index d954cff30..9966b90c5 100644 --- a/src/test/resources/unit/directory.t +++ b/src/test/resources/unit/directory.t @@ -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'); @@ -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)"; }