Permalink
Browse files

import version 2.40 from backpan

  • Loading branch information...
1 parent 62e9af2 commit 78f72c84ae50bd3944eeaf701935bcba1f50a2e4 @fperrad committed with May 18, 2004
Showing with 20,815 additions and 20,534 deletions.
  1. +3 −0 Changes
  2. +18 −16 ascii.pm
  3. +14 −4 lexer.pm
  4. +35 −8 node.pm
  5. +1,979 −1,965 parser20.pm
  6. +15 −2 parser20.yp
  7. +2,321 −2,307 parser21.pm
  8. +15 −1 parser21.yp
  9. +2,336 −2,323 parser22.pm
  10. +16 −3 parser22.yp
  11. +3,265 −3,244 parser23.pm
  12. +22 −3 parser23.yp
  13. +3,044 −3,027 parser24.pm
  14. +20 −3 parser24.yp
  15. +4,261 −4,237 parser30.pm
  16. +27 −3 parser30.yp
  17. +3,394 −3,378 parserxp.pm
  18. +22 −6 parserxp.yp
  19. +7 −3 repos_id.pm
  20. +1 −1 symbtab.pm
View
@@ -1,5 +1,8 @@
Revision history for Perl extension CORBA::IDL.
+2.40 Tue May 18 18:30:00 2004
+ - modification of the AST (not compatible with 2.2x version) : add NativeType node
+
2.22 Wed Mar 31 12:30:00 2004
- prerequest Math::BigInt 1.66 (incompatible with 0.01)
- symbtab.pm : add a flag 'collision_allowed'
View
@@ -425,27 +425,29 @@ sub visitTypeDeclarators {
sub visitTypeDeclarator {
my $self = shift;
my ($node) = @_;
- if (exists $node->{modifier}) { # native IDL2.2
- print $self->get_tab(), "type declarator $node->{idf}\n";
- $self->inc_tab();
- $self->_xp($node);
- print $self->get_tab(), "modifier $node->{modifier}\n";
- } else {
- print $self->get_tab(), "type declarator $node->{idf} '$node->{repos_id}'\n";
- $self->inc_tab();
- $self->_xp($node);
- print $self->get_tab(), "doc: $node->{doc}\n"
- if ($self->{doc} and exists $node->{doc});
- $self->visitType($node->{type});
- if (exists $node->{array_size}) {
- foreach (@{$node->{array_size}}) {
- $_->visit($self); # expression
- }
+ print $self->get_tab(), "type declarator $node->{idf} '$node->{repos_id}'\n";
+ $self->inc_tab();
+ $self->_xp($node);
+ print $self->get_tab(), "doc: $node->{doc}\n"
+ if ($self->{doc} and exists $node->{doc});
+ $self->visitType($node->{type});
+ if (exists $node->{array_size}) {
+ foreach (@{$node->{array_size}}) {
+ $_->visit($self); # expression
}
}
$self->dec_tab();
}
+sub visitNativeType {
+ my $self = shift;
+ my ($node) = @_;
+ print $self->get_tab(), "native $node->{idf}\n";
+ $self->inc_tab();
+ $self->_xp($node);
+ $self->dec_tab();
+}
+
#
# 3.11.1 Basic Types
#
View
@@ -200,6 +200,7 @@ sub _Identifier {
if (exists $parser->YYData->{keyword}{$key}) {
my $keywd = $parser->YYData->{keyword}{$key}[0];
my $version = $parser->YYData->{keyword}{$key}[1];
+ my $lang = $parser->YYData->{keyword}{$key}[2];
if ($Parser::IDL_version ge $version) {
if ($ident eq $keywd) {
return ($key, $ident);
@@ -208,10 +209,18 @@ sub _Identifier {
return ('IDENTIFIER', $ident);
}
} else {
- if ($ident eq $keywd) {
- $parser->Info("'$ident' is a future keyword.\n");
+ if (defined $lang) {
+ if ($ident eq $keywd) {
+ $parser->Info("'$ident' is a keyword of $lang.\n");
+ } else {
+ $parser->Info("'$ident' collides with keyword '$keywd' of $lang.\n");
+ }
} else {
- $parser->Info("'$ident' collides with future keyword '$keywd'.\n");
+ if ($ident eq $keywd) {
+ $parser->Info("'$ident' is a future keyword.\n");
+ } else {
+ $parser->Info("'$ident' collides with future keyword '$keywd'.\n");
+ }
}
return ('IDENTIFIER', $ident);
}
@@ -326,7 +335,7 @@ sub _CodeLexer {
and $parser->YYData->{lineno} ++,
$frag .= $1,
last;
- s/^%\}//
+ s/^%\}.*//
and return ('CODE_FRAGMENT', $frag);
s/^(.)//
and $frag .= $1,
@@ -562,6 +571,7 @@ sub _InitLexico {
'ANY' => [ 'any', '2.0' ],
'ATTRIBUTE' => [ 'attribute', '2.0' ],
'BOOLEAN' => [ 'boolean', '2.0' ],
+ 'BYTE' => [ 'byte', '9.9', "MIDL/MODL" ],
'CASE' => [ 'case', '2.0' ],
'CHAR' => [ 'char', '2.0' ],
'COMPONENT' => [ 'component', '3.0' ],
View
43 node.pm
@@ -8,7 +8,7 @@ use UNIVERSAL;
package CORBA::IDL::node;
use vars qw($VERSION);
-$VERSION = '2.22';
+$VERSION = '2.40';
sub _Build {
my $proto = shift;
@@ -91,6 +91,14 @@ sub getProperty {
return $self->{props}->{$key};
}
+sub hasProperty {
+ my $self = shift;
+ my ($key) = @_;
+ return 0 unless (exists $self->{props});
+ return 0 unless (exists $self->{props}->{$key});
+ return 1;
+}
+
sub visit {
my $self = shift;
my $class = ref $self;
@@ -298,11 +306,12 @@ sub Configure {
sub Lookup {
my $proto = shift;
my $class = ref($proto) || $proto;
- my ($parser, $name) = @_;
+ my ($parser, $name, $bypass) = @_;
my $defn = $parser->YYData->{symbtab}->Lookup($name);
if (defined $defn) {
if ($defn->isa('Forward' . $class)) {
- $parser->Error("'$name' is declared, but not defined.\n");
+ $parser->Error("'$name' is declared, but not defined.\n")
+ unless ($bypass);
} elsif (! $defn->isa($class)) {
$parser->Error("'$name' is not a $class.\n");
}
@@ -1373,6 +1382,7 @@ use base qw(CORBA::IDL::node);
sub _Init {
my $self = shift;
my ($parser) = @_;
+ $self->line_stamp($parser);
my @list;
foreach (@{$self->{list_expr}}) {
my @array_size = @{$_};
@@ -1416,10 +1426,8 @@ sub _Init {
}
$parser->YYData->{symbtab}->Insert($self);
$parser->YYData->{curr_node} = $self;
- if (exists $self->{type}) {
- $self->{local_type} = 1 if (TypeDeclarator->IsaLocal($parser, $self->{type}));
- $self->{deprecated} = 1 if (TypeDeclarator->IsDeprecated($parser, $self->{type}));
- }
+ $self->{local_type} = 1 if (TypeDeclarator->IsaLocal($parser, $self->{type}));
+ $self->{deprecated} = 1 if (TypeDeclarator->IsDeprecated($parser, $self->{type}));
}
sub Lookup {
@@ -1429,6 +1437,7 @@ sub Lookup {
my $defn = $parser->YYData->{symbtab}->Lookup($name);
if (defined $defn) {
if ( ! $defn->isa($class)
+ and ! $defn->isa('NativeType')
and ! $defn->isa('_ConstructedType')
and ! $defn->isa('_ForwardConstructedType')
and ! $defn->isa('BaseInterface')
@@ -1516,7 +1525,6 @@ sub CheckForward {
while ( $defn->isa('SequenceType')
or $defn->isa('TypeDeclarator') ) {
last if (exists $defn->{array_size});
- last if (exists $defn->{modifier}); # native
$defn = TypeDeclarator->GetDefn($parser, $defn->{type});
return unless (defined $defn);
}
@@ -1537,6 +1545,24 @@ sub IsaLocal {
return undef;
}
+package NativeType;
+
+use base qw(CORBA::IDL::node);
+
+sub _Init {
+ my $self = shift;
+ my ($parser) = @_;
+ $self->{prefix} = $parser->YYData->{symbtab}->GetPrefix();
+ $self->{_typeprefix} = $parser->YYData->{symbtab}->GetTypePrefix();
+ $self->line_stamp($parser);
+ if ($parser->YYData->{doc} ne '') {
+ $self->{doc} = $parser->YYData->{doc};
+ $parser->YYData->{doc} = '';
+ }
+ $parser->YYData->{symbtab}->Insert($self);
+ $parser->YYData->{curr_node} = $self;
+}
+
#
# 3.11.1 Basic Types
#
@@ -2508,6 +2534,7 @@ sub _Init {
BooleanLiteral -
TypeDeclarator
TypeDeclarators
+ NativeType
(BasicType)
FloatingPtType -
IntegerType -
Oops, something went wrong.

0 comments on commit 78f72c8

Please sign in to comment.