From comp.lang.perl Tue Aug 17 09:37:46 1993
Newsgroups: comp.lang.perl
Path: ruuinf!sun4nl!mcsun!uunet!elroy.jpl.nasa.gov!swrinde!network.ucsd.edu!news.cerf.net!netlabs!lwall
From: lwall@netlabs.com (Larry Wall)
Subject: Alpha 2 available
Message-ID: <1993Aug16.181531.4345@netlabs.com>
Sender: news@netlabs.com
Nntp-Posting-Host: scalpel.netlabs.com
Organization: NetLabs, Inc.
Date: Mon, 16 Aug 1993 18:15:31 GMT
Lines: 246

Okay, I'm going away on a trip again, so here's the next installment... :-)

New in Alpha 2:
	Many bug fixes from Alpha 1.
	Several compiler optimizations installed.
	New ref function to return a reference's type.
	Anonymous associative array reference constructor {} to go with [].
	First cut at object-oriented features.

Like the Alpha 1 prerelease, this is an unsupported code.  It is
expected to work only on a Sparc architecture machine.  No Configure
support is provided.  In fact, if you succeed in configuring and making
a new makefile, you'll probably overwrite the only makefile that
works.  (Note that a Sparc executable comes with the kit, so you may
not need to compile at all.)

There is no list of new features yet, but if you look at t/op/ref.t
you'll see some of them in use.  perl -Dxst is also fun.

The kit is located on ftp.netlabs.com, in pub/outgoing/perl5.0/perl5a2.tar.Z.

Here's t/op/ref.t for your perusal.  Newer stuff is at the bottom.

#!./perl

print "1..37\n";

# Test glob operations.

$bar = "ok 1\n";
$foo = "ok 2\n";
{
    local(*foo) = *bar;
    print $foo;
}
print $foo;

$baz = "ok 3\n";
$foo = "ok 4\n";
{
    local(*foo) = 'baz';
    print $foo;
}
print $foo;

$foo = "ok 6\n";
{
    local(*foo);
    print $foo;
    $foo = "ok 5\n";
    print $foo;
}
print $foo;

# Test fake references.

$baz = "ok 7\n";
$bar = 'baz';
$foo = 'bar';
print $$$foo;

# Test real references.

$FOO = \$BAR;
$BAR = \$BAZ;
$BAZ = "ok 8\n";
print $$$FOO;

# Test references to real arrays.

@ary = (9,10,11,12);
$ref[0] = \@a;
$ref[1] = \@b;
$ref[2] = \@c;
$ref[3] = \@d;
for $i (3,1,2,0) {
    push(@{$ref[$i]}, "ok $ary[$i]\n");
}
print @a;
print ${$ref[1]}[0];
print @{$ref[2]}[0];
print @{'d'};

# Test references to references.

$refref = \\$x;
$x = "ok 13\n";
print $$$refref;

# Test nested anonymous lists.

$ref = [[],2,[3,4,5,]];
print scalar @$ref == 3 ? "ok 14\n" : "not ok 14\n";
print $$ref[1] == 2 ? "ok 15\n" : "not ok 15\n";
print ${$$ref[2]}[2] == 5 ? "ok 16\n" : "not ok 16\n";
print scalar @{$$ref[0]} == 0 ? "ok 17\n" : "not ok 17\n";

print $ref->[1] == 2 ? "ok 18\n" : "not ok 18\n";
print $ref->[2]->[0] == 3 ? "ok 19\n" : "not ok 18\n";

# Test references to hashes of references.

$refref = \%whatever;
$refref->{"key"} = $ref;
print $refref->{"key"}->[2]->[0] == 3 ? "ok 20\n" : "not ok 20\n";

# Test to see if anonymous subarrays spring into existence.

$spring[5]->[0] = 123;
$spring[5]->[1] = 456;
push(@{$spring[5]}, 789);
print join(':',@{$spring[5]}) eq "123:456:789" ? "ok 21\n" : "not ok 21\n";

# Test to see if anonymous subhashes spring into existence.

@{$spring2{"foo"}} = (1,2,3);
$spring2{"foo"}->[3] = 4;
print join(':',@{$spring2{"foo"}}) eq "1:2:3:4" ? "ok 22\n" : "not ok 22\n";

# Test references to subroutines.

sub mysub { print "ok 23\n" }
$subref = \&mysub;
&$subref;

$subrefref = \\&mysub2;
&$$subrefref("ok 24\n");
sub mysub2 { print shift }

# Test the ref operator.

print ref $subref	eq CODE  ? "ok 25\n" : "not ok 25\n";
print ref $ref		eq ARRAY ? "ok 26\n" : "not ok 26\n";
print ref $refref	eq HASH  ? "ok 27\n" : "not ok 27\n";

# Test anonymous hash syntax.

$anonhash = {};
print ref $anonhash	eq HASH  ? "ok 28\n" : "not ok 28\n";
$anonhash2 = {FOO => BAR, ABC => XYZ,};
print join('', sort values %$anonhash2) eq BARXYZ ? "ok 29\n" : "not ok 29\n";

# Test bless operator.

package MYHASH;

$object = bless $main'anonhash2;
print ref $object	eq MYHASH  ? "ok 30\n" : "not ok 30\n";
print $object->{ABC}	eq XYZ     ? "ok 31\n" : "not ok 31\n";

$object2 = bless {};
print ref $object2	eq MYHASH  ? "ok 32\n" : "not ok 32\n";

# Test ordinary call on object method.

&mymethod($object,33);

sub mymethod {
    local($THIS, @ARGS) = @_;
    die "Not a MYHASH" unless ref $THIS eq MYHASH;
    print $THIS->{FOO} eq BAR  ? "ok $ARGS[0]\n" : "not ok $ARGS[0]\n";
}

# Test automatic destructor call.

$string = "not ok 34\n";
$object = "foo";
$string = "ok 34\n";
$main'anonhash2 = "foo";
$string = "not ok 34\n";

sub DESTROY {
    print $string;

    # Test that the object has already been "cursed".
    print ref shift eq HASH ? "ok 35\n" : "not ok 35\n";
}

# Now test inheritance of methods.

package OBJ;

@ISA = (BASEOBJ);

$main'object = bless {FOO => foo, BAR => bar};

package main;

# Test arrow-style method invocation.

print $object->doit("BAR") eq bar ? "ok 36\n" : "not ok 36\n";

# Test indirect-object-style method invocation.

$foo = doit $object "FOO";
print $foo eq foo ? "ok 37\n" : "not ok 37\n";

sub BASEOBJ'doit {
    local $ref = shift;
    die "Not an OBJ" unless ref $ref eq OBJ;
    $ref->{shift};
}


Some notes about the OO stuff.  Unlike certain languages we could name,
I've tried to minimize the amount of new syntax needed.  An object is
simply a reference to a value that knows what package it belongs to.
Object methods are simply subroutines in that package.  The only
difference between ordinary subroutine calls and method invocation is
that with method invocation the package name is supplied by the
object.  The object comes into a method as an explicit first argument,
which you'd typically pull out as in the BASEOBJ'doit routine above.

You make an ordinary reference into an object reference by "blessing"
it with the bless operator.  Ordinarily you'd call this as the last
thing in a constructor subroutine, but you don't have to.  I didn't
in the tests above.  When you bless an object, all references to it
change their type to the name of the package it was blessed in.  The
type of a reference is available with the new ref function.  (You may
bless an object that was already blessed, though I may limit that
to objects that were blessed by a base class.)

Since all objects are references, and since Perl 5 knows when the
reference count goes to zero, it'll call a destructor for your object
at the appropriate moment, presuming you've defined one.  The destructor
for a package is named DESTROY.  (I haven't implemented inheritance of
destructors yet, so please don't complain about that.)  Currently
an object comes into the destructor already "cursed", so there's
no explicit curse operator to go with the bless operator.  As the
apostle Paul says: "Bless, and curse not."  :-)

Inheritance is implemented without any new syntax.  Any package that
wants to inherit from another package does so by putting a list of
package names into its @ISA array.  Only method names are inherited.
All methods are automatically "virtual" in the C++ sense--they'll call
the most derived version available.  Efficiency is maintained by
caching the looked-up subroutine, though I haven't implemented that
optimization yet.  Multiple inheritance is done by putting multiple
package names into the @ISA array.  They are prioritized by that
ordering.

OO specialists are free to comment.  And I'm free to ignore them...  :-)

Well, that's all I can think of for now.  Have some amount of fun.

Larry

