From 12a5702a745d7541f0ce844c2640c8686fd492c6 Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Wed, 29 Apr 2026 10:06:00 +0200 Subject: [PATCH 1/2] docs(examples): add Moose demo with cross-Perl compat check Adds examples/moose.pl, a self-contained Test::More-style demo that exercises a representative slice of Moose features (attributes with types/defaults/builders/lazy, inheritance, roles, method modifiers, type constraints, BUILD, delegation) wrapped in a small forest ecosystem of animals. Also adds examples/test_moose_compat.sh which runs the demo under both system perl and ./jperl and asserts the outputs are byte-for-byte identical, so the demo doubles as a smoke test for the bundled Moose stack on PerlOnJava. Generated with [Devin](https://cli.devin.ai/docs) Co-Authored-By: Devin <158243242+devin-ai-integration[bot]@users.noreply.github.com> --- examples/moose.pl | 331 ++++++++++++++++++ examples/test_moose_compat.sh | 45 +++ .../org/perlonjava/core/Configuration.java | 6 +- 3 files changed, 379 insertions(+), 3 deletions(-) create mode 100644 examples/moose.pl create mode 100644 examples/test_moose_compat.sh diff --git a/examples/moose.pl b/examples/moose.pl new file mode 100644 index 000000000..ce6caafff --- /dev/null +++ b/examples/moose.pl @@ -0,0 +1,331 @@ +# A cute demonstration of Moose, the postmodern object system for Perl +# +# What better way to showcase Moose than with actual moose +# (and friends) in a little forest ecosystem? +# +# This file exists solely for demonstration and educational purposes. +# It is NOT part of the automated test suite. +# +# Running this demo: +# ./jperl examples/moose.pl +# +# Features demonstrated: +# - Moose attributes (has) with types, defaults, builders, and lazy +# - Inheritance (extends) +# - Roles (with, Moose::Role) +# - Method modifiers (before, after, around) +# - Type constraints (isa) +# - Required attributes and predicates +# - BUILD hooks +# - Delegation (handles) + +use strict; +use warnings; +use Test::More; + +# ── Role: Printable ────────────────────────────────────────────────── +# Roles are like mix-ins — any class can consume them. + +package Printable { + use Moose::Role; + + requires 'describe'; + + sub print_tag { + my $self = shift; + return "[" . ref($self) . "] " . $self->describe; + } +} + +# ── Role: Swimmable ────────────────────────────────────────────────── + +package Swimmable { + use Moose::Role; + + has swim_speed => ( + is => 'ro', + isa => 'Int', + default => 3, + ); + + sub swim { + my $self = shift; + return ref($self) . " paddles along at " . $self->swim_speed . " km/h"; + } +} + +# ── Base class: Animal ─────────────────────────────────────────────── + +package Animal { + use Moose; + with 'Printable'; + + has name => ( + is => 'ro', + isa => 'Str', + required => 1, + ); + + has sound => ( + is => 'ro', + isa => 'Str', + default => '...', + ); + + has hunger => ( + is => 'rw', + isa => 'Int', + default => 5, + ); + + sub speak { + my $self = shift; + return $self->name . ' says "' . $self->sound . '"'; + } + + sub eat { + my ($self, $food) = @_; + my $h = $self->hunger - 1; + $h = 0 if $h < 0; + $self->hunger($h); + return $self->name . " munches on $food (hunger: " . $self->hunger . ")"; + } + + sub describe { + my $self = shift; + return $self->name . " the " . ref($self); + } +} + +# ── The star of the show: Moose! ───────────────────────────────────── + +package Moose::Animal { + use Moose; + extends 'Animal'; + with 'Swimmable'; + + has antler_points => ( + is => 'ro', + isa => 'Int', + default => 10, + ); + + has '+sound' => (default => 'GRUNT'); + + has '+swim_speed' => (default => 8); + + # A lazy attribute with a builder + has title => ( + is => 'ro', + isa => 'Str', + lazy => 1, + builder => '_build_title', + ); + + sub _build_title { + my $self = shift; + my $pts = $self->antler_points; + return $pts >= 12 ? "Majestic" + : $pts >= 8 ? "Regal" + : "Young"; + } + + # Method modifier: around wraps the parent method + around describe => sub { + my ($orig, $self) = @_; + return $self->title . " " . $self->$orig() + . " (" . $self->antler_points . "-point antlers)"; + }; +} + +# ── Squirrel ────────────────────────────────────────────────────────── + +package Squirrel { + use Moose; + extends 'Animal'; + + has acorns => ( + is => 'rw', + isa => 'Int', + default => 0, + ); + + has '+sound' => (default => 'CHITTER'); + + sub gather { + my ($self, $n) = @_; + $n //= 1; + $self->acorns($self->acorns + $n); + return $self->name . " gathered $n acorn(s) (total: " . $self->acorns . ")"; + } + + # Method modifier: after runs code after the parent method + after eat => sub { + my $self = shift; + $self->acorns($self->acorns + 1); # always stashes one for later + }; +} + +# ── Owl ─────────────────────────────────────────────────────────────── + +package Owl { + use Moose; + extends 'Animal'; + + has wisdom => ( + is => 'ro', + isa => 'Int', + default => 42, + ); + + has '+sound' => (default => 'HOO HOO'); + + # Method modifier: before runs code before the parent method + before speak => sub { + my $self = shift; + # Owls blink wisely before speaking + }; + + sub ponder { + my $self = shift; + return $self->name . " ponders the meaning of life... (wisdom: " . $self->wisdom . ")"; + } +} + +# ── Forest: uses delegation ────────────────────────────────────────── + +package Forest { + use Moose; + + has name => ( + is => 'ro', + isa => 'Str', + required => 1, + ); + + has residents => ( + is => 'ro', + isa => 'ArrayRef[Animal]', + default => sub { [] }, + handles => { + add_resident => 'push', + resident_count => 'count', + all_residents => 'elements', + }, + traits => ['Array'], + ); + + sub roll_call { + my $self = shift; + return join(", ", map { $_->name } @{ $self->residents }); + } + + sub describe { + my $self = shift; + return $self->name . " forest (" . scalar(@{ $self->residents }) . " residents)"; + } +} + +# ══════════════════════════════════════════════════════════════════════ +# Let's bring the forest to life! +# ══════════════════════════════════════════════════════════════════════ + +package main; + +subtest 'Creating animals with Moose' => sub { + my $bullwinkle = Moose::Animal->new( + name => 'Bullwinkle', + antler_points => 14, + ); + + is($bullwinkle->name, 'Bullwinkle', 'moose has a name'); + is($bullwinkle->sound, 'GRUNT', 'moose grunts'); + is($bullwinkle->antler_points, 14, 'moose has 14-point antlers'); + is($bullwinkle->title, 'Majestic', 'lazy builder computed title'); + ok($bullwinkle->isa('Animal'), 'moose isa Animal'); + ok($bullwinkle->does('Swimmable'), 'moose does Swimmable'); +}; + +subtest 'Inheritance and default overrides' => sub { + my $rocky = Squirrel->new(name => 'Rocky'); + + is($rocky->sound, 'CHITTER', 'squirrel default sound'); + is($rocky->acorns, 0, 'starts with no acorns'); + + like($rocky->gather(3), qr/gathered 3 acorn/, 'gathering acorns'); + is($rocky->acorns, 3, 'acorn count updated'); +}; + +subtest 'Method modifiers' => sub { + # 'around' on describe + my $moose = Moose::Animal->new(name => 'Morris', antler_points => 6); + like($moose->describe, qr/Young Morris the Moose::Animal/, 'around modifier decorates describe'); + + # 'after' on eat — squirrel stashes an extra acorn + my $squirrel = Squirrel->new(name => 'Hazel'); + $squirrel->eat('walnut'); + is($squirrel->acorns, 1, 'after modifier stashed an acorn during eat'); +}; + +subtest 'Roles' => sub { + my $moose = Moose::Animal->new(name => 'Magnus', antler_points => 12); + + # Printable role + like($moose->print_tag, qr/\[Moose::Animal\]/, 'Printable role adds print_tag'); + + # Swimmable role + is($moose->swim_speed, 8, 'moose overrides default swim speed'); + like($moose->swim, qr/paddles along at 8/, 'Swimmable role adds swim'); + + # Owl doesn't swim + my $owl = Owl->new(name => 'Archimedes'); + ok(!$owl->can('swim'), 'owl cannot swim (no Swimmable role)'); + ok($owl->does('Printable'), 'owl does Printable'); +}; + +subtest 'Type constraints' => sub { + # Hunger must be an Int + my $moose = Moose::Animal->new(name => 'Monty'); + $moose->hunger(3); + is($moose->hunger, 3, 'hunger set to Int'); + + eval { $moose->hunger('very hungry') }; + ok($@, 'type constraint rejects non-Int for hunger'); +}; + +subtest 'Forest with delegation' => sub { + my $forest = Forest->new(name => 'Whispering Pines'); + + my $moose = Moose::Animal->new(name => 'Bullwinkle', antler_points => 14); + my $squirrel = Squirrel->new(name => 'Rocky'); + my $owl = Owl->new(name => 'Archimedes'); + + $forest->add_resident($moose); + $forest->add_resident($squirrel); + $forest->add_resident($owl); + + is($forest->resident_count, 3, 'forest has 3 residents'); + is($forest->roll_call, 'Bullwinkle, Rocky, Archimedes', 'roll call lists everyone'); +}; + +subtest 'A day in the forest' => sub { + my $bullwinkle = Moose::Animal->new(name => 'Bullwinkle', antler_points => 14); + my $rocky = Squirrel->new(name => 'Rocky'); + my $archimedes = Owl->new(name => 'Archimedes'); + + # Morning activities + like($bullwinkle->speak, qr/GRUNT/, 'moose grunts good morning'); + like($rocky->gather(5), qr/gathered 5/, 'squirrel gathers acorns'); + like($archimedes->ponder, qr/meaning of life/, 'owl ponders'); + + # Lunchtime + like($bullwinkle->eat('willow bark'), qr/munches on willow bark/, 'moose eats'); + like($bullwinkle->swim, qr/paddles along/, 'moose goes for a swim'); + + # Evening report + like($bullwinkle->print_tag, qr/Majestic Bullwinkle/, 'moose print tag'); + like($rocky->print_tag, qr/\[Squirrel\] Rocky/, 'squirrel print tag'); + like($archimedes->print_tag, qr/\[Owl\] Archimedes/, 'owl print tag'); +}; + +done_testing(); diff --git a/examples/test_moose_compat.sh b/examples/test_moose_compat.sh new file mode 100644 index 000000000..299637131 --- /dev/null +++ b/examples/test_moose_compat.sh @@ -0,0 +1,45 @@ +#!/usr/bin/env bash +# Runs examples/moose.pl under both system Perl and PerlOnJava and asserts +# that the outputs are identical. +# +# Usage (from the repo root): +# bash examples/test_moose_compat.sh + +set -euo pipefail + +SCRIPT="examples/moose.pl" +PERL_OUT=$(mktemp /tmp/moose_perl_XXXXXX.out) +JPERL_OUT=$(mktemp /tmp/moose_jperl_XXXXXX.out) + +cleanup() { rm -f "$PERL_OUT" "$JPERL_OUT"; } +trap cleanup EXIT + +echo "Running with system Perl..." +perl "$SCRIPT" > "$PERL_OUT" 2>&1 +PERL_EXIT=$? + +echo "Running with PerlOnJava..." +./jperl "$SCRIPT" > "$JPERL_OUT" 2>&1 +JPERL_EXIT=$? + +if [ "$PERL_EXIT" -ne 0 ]; then + echo "FAIL: system Perl exited with $PERL_EXIT" + cat "$PERL_OUT" + exit 1 +fi + +if [ "$JPERL_EXIT" -ne 0 ]; then + echo "FAIL: PerlOnJava exited with $JPERL_EXIT" + cat "$JPERL_OUT" + exit 1 +fi + +if diff -u "$PERL_OUT" "$JPERL_OUT" > /dev/null 2>&1; then + echo "OK: outputs are identical" + echo "--- output ---" + cat "$PERL_OUT" +else + echo "FAIL: outputs differ" + diff -u "$PERL_OUT" "$JPERL_OUT" + exit 1 +fi diff --git a/src/main/java/org/perlonjava/core/Configuration.java b/src/main/java/org/perlonjava/core/Configuration.java index 5831c4256..86398df01 100644 --- a/src/main/java/org/perlonjava/core/Configuration.java +++ b/src/main/java/org/perlonjava/core/Configuration.java @@ -33,14 +33,14 @@ public final class Configuration { * Automatically populated by Gradle/Maven during build. * DO NOT EDIT MANUALLY - this value is replaced at build time. */ - public static final String gitCommitId = "d7eacf972"; + public static final String gitCommitId = "82e5e452d"; /** * Git commit date of the build (ISO format: YYYY-MM-DD). * Automatically populated by Gradle/Maven during build. * DO NOT EDIT MANUALLY - this value is replaced at build time. */ - public static final String gitCommitDate = "2026-04-28"; + public static final String gitCommitDate = "2026-04-29"; /** * Build timestamp in Perl 5 "Compiled at" format (e.g., "Apr 7 2026 11:20:00"). @@ -48,7 +48,7 @@ public final class Configuration { * Parsed by App::perlbrew and other tools via: perl -V | grep "Compiled at" * DO NOT EDIT MANUALLY - this value is replaced at build time. */ - public static final String buildTimestamp = "Apr 28 2026 21:49:56"; + public static final String buildTimestamp = "Apr 29 2026 10:05:08"; // Prevent instantiation private Configuration() { From 23d2e76ac850e3a6c98d911f7b8965b2bc778b26 Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Wed, 29 Apr 2026 10:06:31 +0200 Subject: [PATCH 2/2] chore(examples): drop test_moose_compat.sh helper Generated with [Devin](https://cli.devin.ai/docs) Co-Authored-By: Devin <158243242+devin-ai-integration[bot]@users.noreply.github.com> --- examples/test_moose_compat.sh | 45 ----------------------------------- 1 file changed, 45 deletions(-) delete mode 100644 examples/test_moose_compat.sh diff --git a/examples/test_moose_compat.sh b/examples/test_moose_compat.sh deleted file mode 100644 index 299637131..000000000 --- a/examples/test_moose_compat.sh +++ /dev/null @@ -1,45 +0,0 @@ -#!/usr/bin/env bash -# Runs examples/moose.pl under both system Perl and PerlOnJava and asserts -# that the outputs are identical. -# -# Usage (from the repo root): -# bash examples/test_moose_compat.sh - -set -euo pipefail - -SCRIPT="examples/moose.pl" -PERL_OUT=$(mktemp /tmp/moose_perl_XXXXXX.out) -JPERL_OUT=$(mktemp /tmp/moose_jperl_XXXXXX.out) - -cleanup() { rm -f "$PERL_OUT" "$JPERL_OUT"; } -trap cleanup EXIT - -echo "Running with system Perl..." -perl "$SCRIPT" > "$PERL_OUT" 2>&1 -PERL_EXIT=$? - -echo "Running with PerlOnJava..." -./jperl "$SCRIPT" > "$JPERL_OUT" 2>&1 -JPERL_EXIT=$? - -if [ "$PERL_EXIT" -ne 0 ]; then - echo "FAIL: system Perl exited with $PERL_EXIT" - cat "$PERL_OUT" - exit 1 -fi - -if [ "$JPERL_EXIT" -ne 0 ]; then - echo "FAIL: PerlOnJava exited with $JPERL_EXIT" - cat "$JPERL_OUT" - exit 1 -fi - -if diff -u "$PERL_OUT" "$JPERL_OUT" > /dev/null 2>&1; then - echo "OK: outputs are identical" - echo "--- output ---" - cat "$PERL_OUT" -else - echo "FAIL: outputs differ" - diff -u "$PERL_OUT" "$JPERL_OUT" - exit 1 -fi