diff --git a/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java b/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java index 5d70fa069..29d003e9c 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java +++ b/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java @@ -3299,6 +3299,8 @@ void compileVariableDeclaration(OperatorNode node, String op) { // Regular lexical variable (not captured, not state) int reg = addVariable(varName, "my"); + sigilOp.setAnnotation("bytecodeLexicalRegister", reg); + node.setAnnotation("bytecodeLexicalRegister", reg); // Normal initialization: load undef/empty array/empty hash switch (sigil) { @@ -7837,6 +7839,16 @@ public void visit(FormatNode node) { } } } + if (node.getAnnotation("formatLexicalDeclarations") + instanceof Map declarations) { + for (Map.Entry entry : declarations.entrySet()) { + if (entry.getKey() instanceof String name + && entry.getValue() instanceof OperatorNode declaration + && declaration.getAnnotation("bytecodeLexicalRegister") instanceof Integer reg) { + captures.putIfAbsent(name, reg); + } + } + } emit(captures.size()); for (Map.Entry capture : captures.entrySet()) { emit(addToStringPool(capture.getKey())); diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitFormat.java b/src/main/java/org/perlonjava/backend/jvm/EmitFormat.java index 08cf9c071..f7976a7c1 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitFormat.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitFormat.java @@ -130,6 +130,16 @@ public static void emitFormat(EmitterVisitor emitterVisitor, FormatNode node) { } } } + if (node.getAnnotation("formatLexicalDeclarations") + instanceof Map declarations) { + for (Map.Entry entry : declarations.entrySet()) { + if (entry.getKey() instanceof String name + && entry.getValue() instanceof OperatorNode declaration + && declaration.getAnnotation("jvmLexicalSlot") instanceof Integer slot) { + captures.putIfAbsent(name, slot); + } + } + } for (Map.Entry capture : captures.entrySet()) { mv.visitInsn(Opcodes.DUP); mv.visitLdcInsn(capture.getKey()); diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitVariable.java b/src/main/java/org/perlonjava/backend/jvm/EmitVariable.java index 766589588..c67d79609 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitVariable.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitVariable.java @@ -1437,6 +1437,10 @@ static void handleMyOperator(EmitterVisitor emitterVisitor, OperatorNode node) { myNode.annotations.put("attributePackage", node.annotations.get("attributePackage")); } myNode.accept(emitterVisitor.with(RuntimeContextType.VOID)); + Object lexicalSlot = myNode.getAnnotation("jvmLexicalSlot"); + if (lexicalSlot != null) { + varNode.setAnnotation("jvmLexicalSlot", lexicalSlot); + } } else if (operatorNode.operand instanceof ListNode nestedList) { // Handle my(\($d, $e)) - nested list with backslash // Process each element in the nested list as a declared reference @@ -1619,6 +1623,8 @@ static void handleMyOperator(EmitterVisitor emitterVisitor, OperatorNode node) { } int varIndex = emitterVisitor.ctx.symbolTable.addVariable(var, operator, sigilNode); + sigilNode.setAnnotation("jvmLexicalSlot", varIndex); + node.setAnnotation("jvmLexicalSlot", varIndex); // TODO optimization - SETVAR+MY can be combined // Check if this is a declared reference (my \$x) diff --git a/src/main/java/org/perlonjava/frontend/parser/FormatParser.java b/src/main/java/org/perlonjava/frontend/parser/FormatParser.java index 9eab5c40f..17a41bc4e 100644 --- a/src/main/java/org/perlonjava/frontend/parser/FormatParser.java +++ b/src/main/java/org/perlonjava/frontend/parser/FormatParser.java @@ -12,7 +12,9 @@ import org.perlonjava.runtime.runtimetypes.RuntimeFormat; import java.util.ArrayList; +import java.util.LinkedHashMap; import java.util.List; +import java.util.Map; import java.util.regex.Matcher; import java.util.regex.Pattern; @@ -60,6 +62,17 @@ public static FormatNode parseFormatDeclaration(Parser parser, String formatName // Create a format node with the parsed template content FormatNode formatNode = new FormatNode(formatName, templateLines, tokenIndex); + // A FORMAT captures lexical cells from its declaration site. Keep the + // declaration ASTs, not parser-time numeric ids: each backend assigns + // its own executable local slot while lowering the declaration. + Map lexicalDeclarations = new LinkedHashMap<>(); + for (var entry : parser.ctx.symbolTable.getAllVisibleVariables().values()) { + if (("my".equals(entry.decl()) || "state".equals(entry.decl())) + && entry.ast() != null) { + lexicalDeclarations.put(entry.name(), entry.ast()); + } + } + formatNode.setAnnotation("formatLexicalDeclarations", lexicalDeclarations); // Formats are declarations, not statements delayed until an enclosing // subroutine is called. A later write() must find this slot even when diff --git a/src/main/java/org/perlonjava/runtime/operators/IOOperator.java b/src/main/java/org/perlonjava/runtime/operators/IOOperator.java index 82048080d..a2c19d102 100644 --- a/src/main/java/org/perlonjava/runtime/operators/IOOperator.java +++ b/src/main/java/org/perlonjava/runtime/operators/IOOperator.java @@ -4,13 +4,16 @@ import org.perlonjava.frontend.astnode.PictureLine; import org.perlonjava.frontend.parser.StringParser; import org.perlonjava.runtime.ForkOpenState; +import org.perlonjava.runtime.WarningBitsRegistry; import org.perlonjava.runtime.io.*; import org.perlonjava.runtime.nativ.NativeUtils; import org.perlonjava.runtime.nativ.ffm.FFMPosix; import org.perlonjava.runtime.perlmodule.Socket; +import org.perlonjava.runtime.perlmodule.Strict; import org.perlonjava.runtime.perlmodule.Warnings; import org.perlonjava.runtime.runtimetypes.*; +import java.io.ByteArrayOutputStream; import java.io.File; import java.io.IOException; import java.net.*; @@ -1985,13 +1988,26 @@ private static String paginateFormatOutput(RuntimeIO fh, RuntimeFormat topFormat if (formattedOutput == null || formattedOutput.isEmpty()) { return ""; } + // write() starts a body format on a fresh page when the complete + // record block cannot fit in the lines remaining on this page. This + // is observable with a repeated ENTRY picture following a short EOR + // record: Perl emits the footer and form feed before the next ENTRY, + // rather than splitting its first record across the old page. + if (fh.formatLinesLeft > 0 + && countFormatLines(formattedOutput) > fh.formatLinesLeft) { + fh.formatLinesLeft = 0; + } StringBuilder paged = new StringBuilder(); int offset = 0; boolean firstPage = true; while (offset < formattedOutput.length()) { if (fh.formatLinesLeft <= 0) { - if (!firstPage) { - paged.append('\f'); + // firstPage is local to this write() call; a later write can + // still begin after a partially used physical page. $% + // records that persistent page state and requires a form + // feed when this write's preflight moved to the next page. + boolean pageBreak = !firstPage || fh.formatPageNumber > 0; + if (pageBreak) { fh.formatPageNumber++; } else if (topFormat != null) { // $% is page one while a top format is being evaluated, @@ -2002,9 +2018,20 @@ private static String paginateFormatOutput(RuntimeIO fh, RuntimeFormat topFormat firstPage = false; fh.formatLinesLeft = fh.formatPageLength; if (topFormat != null) { - String topText = topFormat.execute(new RuntimeList()); + TopFormatOutput topOutput = executeTopFormat(topFormat, fh); + paged.append(topOutput.printedText()); + if (pageBreak) { + paged.append('\f'); + } + String topText = topOutput.formatText(); paged.append(topText); - fh.formatLinesLeft -= countFormatLines(topText); + // Top-format argument evaluation can itself inspect the + // magic $- variable. Its transient state must not alter + // the body format's page budget; establish that budget + // from the page length and the top text actually emitted. + fh.formatLinesLeft = fh.formatPageLength - countFormatLines(topText); + } else if (pageBreak) { + paged.append('\f'); } } @@ -2017,6 +2044,34 @@ private static String paginateFormatOutput(RuntimeIO fh, RuntimeFormat topFormat return paged.toString(); } + /** + * A TOP argument line can call print (the traditional footer idiom). + * write() buffers its body format before committing it, so let those + * callback writes share that buffer instead of sending them ahead of the + * already formatted page text. + */ + private static TopFormatOutput executeTopFormat(RuntimeFormat topFormat, RuntimeIO fh) { + ByteArrayOutputStream printed = new ByteArrayOutputStream(); + RuntimeIO capture = new RuntimeIO(new CustomOutputStreamHandle(printed)); + capture.formatPageLength = fh.formatPageLength; + capture.formatLinesLeft = fh.formatLinesLeft; + capture.formatPageNumber = fh.formatPageNumber; + RuntimeIO savedSelectedHandle = RuntimeIO.getSelectedHandle(); + String formatText; + try { + RuntimeIO.setSelectedHandle(capture); + formatText = topFormat.execute(new RuntimeList()); + } finally { + fh.formatPageLength = capture.formatPageLength; + fh.formatLinesLeft = capture.formatLinesLeft; + fh.formatPageNumber = capture.formatPageNumber; + RuntimeIO.setSelectedHandle(savedSelectedHandle); + } + return new TopFormatOutput(printed.toString(StandardCharsets.ISO_8859_1), formatText); + } + + private record TopFormatOutput(String printedText, String formatText) { } + private static int countFormatLines(String text) { if (text == null || text.isEmpty()) return 0; int lines = text.endsWith("\n") ? 0 : 1; @@ -2057,7 +2112,12 @@ public static RuntimeScalar formline(int ctx, RuntimeBase... args) { boolean resultTainted = accumulator.isTainted() || picture.isTainted() || picture.formatPictureTainted; String currentValue = accumulator.toString(); - accumulator.set(currentValue + formatTemplate); + String result = currentValue + formatTemplate; + if ((WarningBitsRegistry.getCallSiteHints() & Strict.HINT_BYTES) != 0) { + accumulator.set(new RuntimeScalar(result.getBytes(StandardCharsets.UTF_8))); + } else { + accumulator.set(result); + } accumulator.tainted = resultTainted; return scalarTrue; } @@ -2092,6 +2152,16 @@ public static RuntimeScalar formline(int ctx, RuntimeBase... args) { // Return success (1) return scalarTrue; + } catch (RuntimeFormat.FormatFieldMutationException e) { + // Perl updates $^A with the formatted prefix before the ^ field + // fails while attempting to consume a bare typeglob operand. + RuntimeScalar accumulator = getGlobalVariable(GlobalContext.encodeSpecialVar("A")); + accumulator.set(accumulator.toString() + e.renderedText()); + throw new PerlCompilerException("Modification of a read-only value attempted"); + } catch (PerlCompilerException e) { + // Preserve Perl runtime errors (notably readonly ^-field + // operands) so eval sees the normal canonical diagnostic. + throw e; } catch (Exception e) { throw new PerlCompilerException("formline failed: " + e.getMessage()); } diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/OutputFormatVariable.java b/src/main/java/org/perlonjava/runtime/runtimetypes/OutputFormatVariable.java index 499c7fec9..b7ac18c44 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/OutputFormatVariable.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/OutputFormatVariable.java @@ -59,6 +59,14 @@ public RuntimeScalar set(RuntimeScalar value) { @Override public boolean getDefinedBoolean() { return true; } @Override public String toString() { return Integer.toString(getInt()); } + // The base scalar keeps its default UNDEF type, which would otherwise + // make RuntimeScalar.getNumber() return numeric zero without consulting + // this handle-backed value. Page variables participate in ordinary + // numeric expressions such as `$% == 1` in TOP formats. + @Override public RuntimeScalar getNumber() { return new RuntimeScalar(getInt()); } + @Override public RuntimeScalar getNumber(String operation) { return getNumber(); } + @Override public RuntimeScalar getNumberNoOverload() { return getNumber(); } + @Override public void dynamicSaveState() { RuntimeIO handle = currentHandle(); diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/PerlRuntime.java b/src/main/java/org/perlonjava/runtime/runtimetypes/PerlRuntime.java index e95c897cb..ecdeda152 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/PerlRuntime.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/PerlRuntime.java @@ -162,6 +162,12 @@ private PerlRuntime(PerlThreadRegistry threadRegistry, long perlThreadId) { public void activateForkOpenChildStdout() { RuntimeIO muted = ioStdout; RuntimeIO stdout = new RuntimeIO(new StandardIO(System.out, true)); + // A replay child has already run the pre-fork setup against its muted + // STDOUT. Activating the real stream must retain the filehandle- + // scoped format state ($=, $-, and $%) established there. + stdout.formatPageLength = muted.formatPageLength; + stdout.formatLinesLeft = muted.formatLinesLeft; + stdout.formatPageNumber = muted.formatPageNumber; RuntimeIO stdin = new RuntimeIO(new StandardIO(System.in)); replaceStandardHandle("main::STDOUT", stdout); replaceStandardHandle("main::stdout", stdout); @@ -740,20 +746,26 @@ void replaceStandardHandle(String name, RuntimeIO io) { case "main::STDOUT" -> { ioStdout = io; updateStandardGlobHandle(name, io); + io.globName = name; } case "main::STDERR" -> { ioStderr = io; updateStandardGlobHandle(name, io); + io.globName = name; } case "main::STDIN" -> { ioStdin = io; updateStandardGlobHandle(name, io); + io.globName = name; } + // Lowercase standard names are aliases. They must not overwrite the + // canonical name carried by the shared RuntimeIO: format defaults + // derive $~ from that name, so a replay child would otherwise look up + // a nonexistent `stdout` format instead of `STDOUT`. case "main::stdout", "main::stderr", "main::stdin" -> updateStandardGlobHandle(name, io); default -> throw new IllegalArgumentException("Not a standard I/O glob: " + name); } - io.globName = name; } private void installInitialStandardGlob(String name, RuntimeIO io) { diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java index af2eaba50..c95b9f5f3 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java @@ -571,6 +571,18 @@ public static Map snapshotActiveLexicals(RuntimeCode code) return Collections.emptyMap(); } + /** Return the nearest active cell for each lexical name across call frames. */ + public static Map snapshotAllActiveLexicals() { + PerlRuntime runtime = PerlRuntime.current(); + Map result = new LinkedHashMap<>(); + for (ActiveLexicalFrame frame : activeLexicalFrames(runtime.executionState())) { + for (Map.Entry entry : frame.cells().entrySet()) { + result.putIfAbsent(entry.getKey(), entry.getValue()); + } + } + return result; + } + /** * Select eval STRING captures for Perl's package-DB rule. An eval run by * a DB subroutine is evaluated in the lexical pad of the code being diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeFormat.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeFormat.java index a76e9d99e..f4496cea0 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeFormat.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeFormat.java @@ -373,7 +373,14 @@ public String execute(RuntimeList args) { .anyMatch(field -> field.isSpecialField && field instanceof TextFormatField); boolean repeatByEach = argLine != null && argLine.content.trim().matches("^each\\s+.*"); - if (repeat && !hasConsumingField && !repeatByEach) { + // A ~~ picture may also terminate because a stateful argument + // expression (for example shift @rows) eventually supplies + // only empty fields. Do not reject that valid form before its + // first evaluation; the loop below stops it on the empty row. + boolean repeatByStatefulExpression = argLine != null + && argLine.content.matches("(?s).*\\b(?:shift|pop)\\b.*"); + if (repeat && !hasConsumingField && !repeatByEach + && !repeatByStatefulExpression) { throw new RuntimeException("Repeated format line will never terminate"); } @@ -390,11 +397,19 @@ public String execute(RuntimeList args) { } int syntacticOperandCount = argLine == null ? 0 : 1 + (int) argLine.content.chars().filter(ch -> ch == ',').count(); - PictureExecution execution = executePictureLine(pictureLine, lineArgs, - syntacticOperandCount, argLine); + PictureExecution execution; + try { + execution = executePictureLine(pictureLine, lineArgs, + syntacticOperandCount, argLine); + } catch (FormatFieldMutationException e) { + // formline retains text rendered before a caret field + // discovers that its operand cannot be modified. + throw new FormatFieldMutationException(output + e.renderedText); + } output.append(execution.text()); - boolean suppressedPicture = pictureLine.content.replace("~~", "").contains("~") - && execution.text().isEmpty(); + boolean suppressedPicture = (pictureLine.content.replace("~~", "").contains("~") + || repeatByStatefulExpression) + && !execution.hasNonemptyFieldValue(); // `write` terminates each picture line with a record // separator, including the last one. `formline` uses the // same runtime formatter but appends directly to $^A, where @@ -404,7 +419,9 @@ public String execute(RuntimeList args) { || formlineWithTerminalNewline)) { output.append("\n"); } - if (!repeat || (!repeatByEach && !execution.hasRemainingText())) { + if (!repeat + || (!repeatByEach && !execution.hasRemainingText() + && (!repeatByStatefulExpression || !execution.hasNonemptyFieldValue()))) { break; } } while (true); @@ -496,7 +513,7 @@ private PictureExecution executePictureLine(PictureLine pictureLine, List materializeLineArguments(ArgumentLine argLine, List args, int startIndex) { List lineArgs = new ArrayList<>(); if (argLine != null && !argLine.content.trim().isEmpty()) { + // A FORMAT slot can survive a fork while its declaring lexical pad + // is recreated in the child. Refresh only names captured by the + // emitter; never discover new names from arbitrary caller frames. + Map activeLexicals = RuntimeCode.snapshotAllActiveLexicals(); + for (String name : lexicalVariables.keySet()) { + RuntimeBase active = activeLexicals.get(name); + if (active != null) { + lexicalVariables.put(name, active); + } + } List simpleScalarSlots = resolveSimpleGlobalScalarSlots(argLine.content); if (simpleScalarSlots != null) { lineArgs.addAll(simpleScalarSlots); @@ -802,7 +840,8 @@ private static ConsumedText consumeEllipsisText(String text, int width) { private record ConsumedText(String text, String remaining) { } - private record PictureExecution(String text, boolean hasRemainingText) { } + private record PictureExecution(String text, boolean hasRemainingText, + boolean hasNonemptyFieldValue) { } /** * Evaluate an expression node to get its runtime value. @@ -1021,4 +1060,22 @@ private FormatField createFormatField(String fieldSpec, int startPos, boolean is private String extractLiteralText(String line) { return line.replaceAll("[@^]([<>|*]+|[0#]+(?:\\.[0#]*)?|\\.+)", "{}"); } + + /** + * A caret field can render text before it fails to store its unconsumed + * input. formline needs that prefix to update $^A before it reports the + * normal read-only exception to its caller. + */ + public static final class FormatFieldMutationException extends PerlCompilerException { + private final String renderedText; + + FormatFieldMutationException(String renderedText) { + super("Modification of a read-only value attempted"); + this.renderedText = renderedText; + } + + public String renderedText() { + return renderedText; + } + } } diff --git a/src/test/resources/unit/fork_open_bareword_write.t b/src/test/resources/unit/fork_open_bareword_write.t new file mode 100644 index 000000000..e486423ba --- /dev/null +++ b/src/test/resources/unit/fork_open_bareword_write.t @@ -0,0 +1,29 @@ +use strict; +use warnings; +use Test::More tests => 3; + +my $pid = open FROM_CHILD, '-|'; +unless (defined $pid) { + fail('bareword fork-open starts a child'); + fail('parent reads bareword child output'); + fail('bareword child exits successfully'); + exit 0; +} + +if ($pid) { + ok($pid > 0, 'bareword fork-open starts a child'); + is(, "bareword fork-open output\n", + 'parent reads a bareword child format write'); + ok(close FROM_CHILD, 'bareword child exits successfully'); + exit 0; +} + +{ + format STDOUT = +@* +'bareword fork-open output' +. + write; + close STDOUT; + exit 0; +} diff --git a/src/test/resources/unit/format_argument_line_execution.t b/src/test/resources/unit/format_argument_line_execution.t index c6de84d98..df4c5717a 100644 --- a/src/test/resources/unit/format_argument_line_execution.t +++ b/src/test/resources/unit/format_argument_line_execution.t @@ -99,6 +99,26 @@ is($continuation_rendered, "one\ntwo\nthre\ne\n", is($format_continuation_value, '', 'write consumes a continuation operand across repeated picture lines'); +{ + my @format_rows = ([1, 'One'], [2, 'Two']); + format FORMAT_LEXICAL_ARRAY_REPEAT = +@ @<<<~~ +@{(shift @format_rows) || ["", ""]} +. + + my $rows_path = 'format_lexical_array_repeat.tmp'; + open my $rows_fh, '>', $rows_path or die "open $rows_path: $!"; + select((select($rows_fh), $~ = 'FORMAT_LEXICAL_ARRAY_REPEAT')[0]); + write $rows_fh; + close $rows_fh or die "close $rows_path: $!"; + open my $rows_read_fh, '<', $rows_path or die "read $rows_path: $!"; + my $rows_rendered = do { local $/; <$rows_read_fh> }; + close $rows_read_fh or die "close $rows_path after read: $!"; + unlink $rows_path or die "unlink $rows_path: $!"; + is($rows_rendered, "1 One\n2 Two\n", + 'a repeated format line consumes a captured lexical array'); +} + format FORMAT_TRAILING_LITERAL_LINE = @<< 'value' diff --git a/src/test/resources/unit/formline_bytes_and_glob.t b/src/test/resources/unit/formline_bytes_and_glob.t new file mode 100644 index 000000000..1298bff93 --- /dev/null +++ b/src/test/resources/unit/formline_bytes_and_glob.t @@ -0,0 +1,34 @@ +use strict; +use warnings; +use Test::More; + +{ + local $^A = ''; + my $picture = "X\n\x{100}" . ("\x80" x 200); + my $expected = $picture; + utf8::encode($expected); + use bytes; + formline($picture); + is $^A, $expected, 'formline byte-mode output retains UTF-8 bytes'; +} + +{ + $^A = ''; + my $copy = *formline_glob_copy; + my $result = eval { formline '^<<', $copy }; + is $@, '', 'glob value copied into a scalar is writable'; + ok $result, 'formline succeeds for copied glob value'; + is $^A, '*ma', 'copied glob contributes its formatted prefix'; + is $copy, 'in::formline_glob_copy', 'caret field consumes copied glob value'; +} + +{ + $^A = ''; + my $result = eval { formline '^<<', *formline_real_glob }; + like $@, qr/\AModification of a read-only value attempted /, + 'bare real glob is read-only to a caret field'; + is $result, undef, 'formline fails for bare real glob'; + is $^A, '*ma', 'formline retains text rendered before bare-glob failure'; +} + +done_testing;