Permalink
Browse files

Perlito5 - parser - add "glob variable"

  • Loading branch information...
fglock committed Nov 15, 2012
1 parent b33a702 commit e107c18970dd60c42d28b6a1aea6bf6dc70a55dc
Showing with 50 additions and 19 deletions.
  1. +15 −0 TODO-perlito5
  2. +8 −7 html/perlito5.js
  3. +7 −6 perlito5.pl
  4. +17 −3 src5/lib/Perlito5/Grammar/Bareword.pm
  5. +3 −3 t5/01-perlito/04-string.t
View
@@ -73,6 +73,21 @@ TODO list for Perlito5
my $t = Class::->new # this works
my $u = new Class::; # this also works (even with sub main in the current package)
+ $ perl -e ' { package X; sub print { CORE::print(">$_[1]<\n") } } my $x = bless {}, "X"; print $x "xxx" '
+ Not a GLOB reference at -e line 1.
+
+ $ perl -e ' { package X; sub printx { CORE::print(">$_[1]<\n") } } my $x = bless {}, "X"; printx $x "xxx" '
+ >xxx<
+
+ $ perl -MO=Deparse -e ' print X:: "xxx" '
+ print X 'xxx';
+
+ $ perl -e ' use strict; my $x = X::; print $x '
+ X
+
+ $ perl -e ' use strict; my $x = X; print $x '
+ Bareword "X" not allowed while "strict subs" in use
+
-- clean up:
the several "end_tables" in Expression.pm are duplicating the function of
$Precedence in Precedence.pm - Expression.pm should use $Precedence directly.
View
@@ -4969,20 +4969,21 @@ var p5100 = p5pkg['main'];
(v_p = (v_pos));
var v_m_namespace;
(v_m_namespace = (p5call(p5pkg["Perlito5::Grammar"], "optional_namespace_before_ident", [v_str, v_p], 0)));
+ var v_namespace;
+ (v_namespace = (p5pkg["Perlito5::Match"].flat([v_m_namespace], 0)));
(v_p = ((v_m_namespace || (v_m_namespace = new p5HashRef({})))._hash_.p5hget('to')));
var v_m_name;
(v_m_name = (p5call(p5pkg["Perlito5::Grammar"], "ident", [v_str, v_p], 0)));
- if ( p5bool(v_m_name) ) {
- null;
- }
- else {
- throw(p5context([v_m_name], p5want));
+ if ( !( p5bool(v_m_name)) ) {
+ if ( p5bool(v_namespace) ) {
+ (v_m_namespace || (v_m_namespace = new p5HashRef({})))._hash_.p5hset('capture', ((new p5ArrayRef(p5list_to_a('term', p5call(p5pkg["Perlito5::AST::Var"], "new", ['sigil', '::', 'name', '', 'namespace', v_namespace], 1))))));
+ throw(p5context([v_m_namespace], p5want));
+ };
+ throw(p5context([], p5want));
};
(v_p = ((v_m_name || (v_m_name = new p5HashRef({})))._hash_.p5hget('to')));
var v_name;
(v_name = (p5pkg["Perlito5::Match"].flat([v_m_name], 0)));
- var v_namespace;
- (v_namespace = (p5pkg["Perlito5::Match"].flat([v_m_namespace], 0)));
var v_full_name;
(v_full_name = (v_name));
if ( p5bool(v_namespace) ) {
View
@@ -656,17 +656,18 @@ sub Perlito5::Grammar::Bareword::term_bareword {
((my $pos) = $_[2]);
((my $p) = $pos);
((my $m_namespace) = Perlito5::Grammar->optional_namespace_before_ident($str, $p));
+ ((my $namespace) = Perlito5::Match::flat($m_namespace));
($p = $m_namespace->{'to'});
((my $m_name) = Perlito5::Grammar->ident($str, $p));
- if ($m_name) {
-
- }
- else {
- return ($m_name)
+ if (!($m_name)) {
+ if ($namespace) {
+ ($m_namespace->{'capture'} = ['term', Perlito5::AST::Var->new('sigil', '::', 'name', '', 'namespace', $namespace)]);
+ return ($m_namespace)
+ };
+ return ()
};
($p = $m_name->{'to'});
((my $name) = Perlito5::Match::flat($m_name));
- ((my $namespace) = Perlito5::Match::flat($m_namespace));
((my $full_name) = $name);
if ($namespace) {
($full_name = ($namespace . '::' . $name))
@@ -8,14 +8,28 @@ package Perlito5::Grammar::Bareword;
my $p = $pos;
my $m_namespace = Perlito5::Grammar->optional_namespace_before_ident( $str, $p );
+ my $namespace = Perlito5::Match::flat($m_namespace);
$p = $m_namespace->{to};
my $m_name = Perlito5::Grammar->ident( $str, $p );
- return $m_name
- unless $m_name;
+
+ if (!$m_name) {
+ if ($namespace) {
+ # namespace without name - X::
+ $m_namespace->{capture} = [ 'term',
+ Perlito5::AST::Var->new(
+ sigil => '::',
+ name => '',
+ namespace => $namespace,
+ )
+ ];
+ return $m_namespace;
+ }
+ return;
+ }
+
$p = $m_name->{to};
my $name = Perlito5::Match::flat($m_name);
- my $namespace = Perlito5::Match::flat($m_namespace);
my $full_name = $name;
$full_name = $namespace . '::' . $name if $namespace;
@@ -2,7 +2,7 @@ use v5;
use strict;
use feature 'say';
-say '1..19';
+say '1..20';
my $x = "abcd";
if (substr($x,1,1) ne "b") {
@@ -100,12 +100,12 @@ print 'not ' if $r ne '-890-'; say "ok 18 - array deref interpolation - $r";
# }
$r = "-$$v[2]-";
-print 'not ' if $r ne '-890-'; say "ok 18 - array deref interpolation - $r";
+print 'not ' if $r ne '-890-'; say "ok 19 - array deref interpolation - $r";
{
my $x = "123";
my $y = \$x;
$r = "[$$y]";
- print 'not ' if $r ne '[123]'; say "ok 19 - scalar deref interpolation - $r";
+ print 'not ' if $r ne '[123]'; say "ok 20 - scalar deref interpolation - $r";
}

0 comments on commit e107c18

Please sign in to comment.