Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

import version 2.05 from backpan

  • Loading branch information...
commit 5f9a44301f1ca08e8ea06e3b7d431cd43006e246 1 parent b8b7c31
@fperrad authored
View
6 Changes
@@ -1,5 +1,11 @@
Revision history for Perl extension CORBA::IDL.
+2.05 Wed Dec 17 12:30:00 2003
+ - improvement for EnumType
+ - improvement for value and boxed value
+ - add extra rules in grammar (export for value)
+ - bug in _StringLexer
+
2.04 Mon Sep 22 12:30:00 2003
- support cpp GCC 3.2.3
- bug : value inheritance
View
2  README
@@ -19,12 +19,12 @@ Description:
Prerequisites:
--------------
- This module needs Math::BigInt and Math::BigFloat modules.
This module needs a C preprocessor executable, like cpp.
See also:
---------
CORBA::C - Implements CORBA C language mapping
+ CORBA::JAVA - Implements CORBA Java language mapping
CORBA::HTML - Implements HTML documentation
References:
View
4 lexer.pm
@@ -117,7 +117,7 @@ sub _StringLexer {
s/^\\v//
and $str .= "\013", # vertical tab
last;
- s/^\\([\\?'"])\'//
+ s/^\\([\?'"])//
and $str .= $1, # backslash, question mark, single quote, double quote
last;
@@ -168,7 +168,7 @@ sub _CharLexer {
and return ($token,"\f"); # form feed
s/^\\a\'//
and return ($token,"\a"); # alert
- s/^\\([\\?'"])\'//
+ s/^\\([\?'"])\'//
and return ($token,$1); # backslash, question mark, single quote, double quote
s/^\\([0-7]{1,3})\'//
and return ($token,chr oct $1);
View
2  makefile.yapp
@@ -1,7 +1,7 @@
YAPP=yapp -s -v -m
CP=copy
-RM=del
+RM=-del
all: parser30.pm parser24.pm parser23.pm parser22.pm parser21.pm parser20.pm
$(RM) Parser.pm
View
63 node.pm
@@ -7,7 +7,7 @@ use UNIVERSAL;
package node;
use vars qw($VERSION);
-$VERSION = '2.04';
+$VERSION = '2.05';
sub _Build {
my $proto = shift;
@@ -318,6 +318,7 @@ use base qw(node);
sub _Init {
my $self = shift;
my ($parser) = @_;
+ $self->{hash_interface} = {};
my %hash;
# 3.8.5 Interface Inheritance
if (exists $self->{list_interface}) {
@@ -325,7 +326,12 @@ sub _Init {
if (exists $hash{$name}) {
$parser->Warning("'$name' redeclares inheritance.\n");
} else {
- $hash{$name} = $_;
+ $hash{$name} = 1;
+ $self->{hash_interface}->{$name} = 1;
+ my $base = $parser->YYData->{symbtab}->Lookup($name);
+ foreach (keys %{$base->{inheritance}->{hash_interface}}) {
+ $self->{hash_interface}->{$_} = 1;
+ }
}
}
}
@@ -335,7 +341,12 @@ sub _Init {
if (exists $hash{$name}) {
$parser->Warning("'$name' redeclares inheritance.\n");
} else {
- $hash{$name} = $_;
+ $hash{$name} = 1;
+ $self->{hash_interface}->{$name} = 1;
+ my $base = $parser->YYData->{symbtab}->Lookup($name);
+ foreach (keys %{$base->{inheritance}->{hash_interface}}) {
+ $self->{hash_interface}->{$_} = 1;
+ }
}
}
}
@@ -516,20 +527,20 @@ sub _CheckInheritance {
}
}
-#sub Configure {
-# my $self = shift;
-# my $parser = shift;
-# $self->SUPER::Configure($parser,@_);
-# my @list;
-# foreach my $value_element (@{$self->{list_decl}}) {
-# next unless (ref $value_element eq 'StateMembers');
-# foreach (@{$value_element->{list_decl}}) {
-# push @list, $_;
-# }
-# }
-# $self->configure(list_value => \@list); # list of 'StateMember'
-# return $self;
-#}
+sub Configure {
+ my $self = shift;
+ my $parser = shift;
+ $self->SUPER::Configure($parser,@_);
+ my @list;
+ foreach my $value_element (@{$self->{list_decl}}) {
+ next unless (ref $value_element eq 'StateMembers');
+ foreach (@{$value_element->{list_decl}}) {
+ push @list, $_;
+ }
+ }
+ $self->configure(list_value => \@list); # list of 'StateMember'
+ return $self;
+}
sub _CheckLocal {
# A local type may be used as a parameter, attribute, return type, or exception
@@ -657,13 +668,20 @@ sub _Init {
my ($parser) = @_;
$self->{prefix} = $parser->YYData->{symbtab}->GetPrefix();
$self->{_typeprefix} = $parser->YYData->{symbtab}->GetTypePrefix();
- $parser->YYData->{symbtab}->Insert($self);
$self->line_stamp($parser);
if ($parser->YYData->{doc} ne '') {
$self->{doc} = $parser->YYData->{doc};
$parser->YYData->{doc} = '';
}
+ $parser->YYData->{symbtab}->PushCurrentScope($self);
+ $parser->YYData->{curr_itf} = $self;
$parser->YYData->{curr_node} = $self;
+}
+
+sub Configure {
+ my $self = shift;
+ my $parser = shift;
+ $self->configure(@_);
my $type = TypeDeclarator->GetDefn($parser, $self->{type});
if ($type->isa('Value')) {
if ($Parser::IDL_version ge '3.0') {
@@ -672,6 +690,7 @@ sub _Init {
$parser->Info("$self->{type}->{idf} is a value type.\n");
}
}
+ return $self;
}
#
@@ -975,7 +994,7 @@ sub _Eval {
return undef;
}
} elsif ($elt->isa('Enum')) {
- if ($type eq $elt->{type}) {
+ if ($type eq $parser->YYData->{symbtab}->Lookup($elt->{type})) {
return $elt;
} else {
$parser->Error("'$elt->{idf}' is not a '$type->{idf}'.\n");
@@ -1796,7 +1815,7 @@ sub Configure {
push @list, $_->{full};
}
$_->configure(
- type => $self,
+ type => $self->{full},
value => "$idx"
);
$idx++;
@@ -2360,7 +2379,7 @@ sub Configure {
return $self;
}
-=pod
+=for tree
node
Specification -
@@ -2458,7 +2477,7 @@ sub Configure {
Factory
Finder
-=cut
+=end tree
1;
View
6,205 parser23.pm
3,142 additions, 3,063 deletions not shown
View
33 parser23.yp
@@ -299,11 +299,11 @@ interface_body
;
exports
-: export
+: _export
{
[$_[1]->getRef()];
}
-| export exports
+| _export exports
{
unshift(@{$_[2]},$_[1]->getRef());
$_[2];
@@ -311,6 +311,21 @@ exports
;
/* 9 */
+_export
+: export
+ #default action
+| state_member
+ {
+ $_[0]->Error("state member unexpected.\n");
+ $_[1]; #default action
+ }
+| init_dcl
+ {
+ $_[0]->Error("initializer unexpected.\n");
+ $_[1]; #default action
+ }
+;
+
export
: type_dcl ';'
#default action
@@ -443,11 +458,21 @@ value_forward_dcl
/* 15 */ /* 3.8.2 Boxed Value Type */
value_box_dcl
-: VALUETYPE IDENTIFIER type_spec
+: value_box_header type_spec
+ {
+ $_[0]->YYData->{symbtab}->PopCurrentScope($_[1]);
+ $_[0]->YYData->{curr_itf} = undef;
+ $_[1]->Configure($_[0],
+ 'type' => $_[2]
+ ) if (defined $_[1]);
+ }
+;
+
+value_box_header
+: VALUETYPE IDENTIFIER
{
new BoxedValue($_[0],
'idf' => $_[2],
- 'type' => $_[3]
);
}
;
View
6,243 parser24.pm
3,141 additions, 3,102 deletions not shown
View
33 parser24.yp
@@ -315,11 +315,11 @@ interface_body
;
exports
-: export
+: _export
{
[$_[1]->getRef()];
}
-| export exports
+| export _exports
{
unshift(@{$_[2]},$_[1]->getRef());
$_[2];
@@ -327,6 +327,21 @@ exports
;
/* 9 */
+_export
+: export
+ #default action
+| state_member
+ {
+ $_[0]->Error("state member unexpected.\n");
+ $_[1]; #default action
+ }
+| init_dcl
+ {
+ $_[0]->Error("initializer unexpected.\n");
+ $_[1]; #default action
+ }
+;
+
export
: type_dcl ';'
#default action
@@ -459,11 +474,21 @@ value_forward_dcl
/* 15 */ /* 3.8.2 Boxed Value Type */
value_box_dcl
-: VALUETYPE IDENTIFIER type_spec
+: value_box_header type_spec
+ {
+ $_[0]->YYData->{symbtab}->PopCurrentScope($_[1]);
+ $_[0]->YYData->{curr_itf} = undef;
+ $_[1]->Configure($_[0],
+ 'type' => $_[2]
+ ) if (defined $_[1]);
+ }
+;
+
+value_box_header
+: VALUETYPE IDENTIFIER
{
new BoxedValue($_[0],
'idf' => $_[2],
- 'type' => $_[3]
);
}
;
View
8,646 parser30.pm
4,368 additions, 4,278 deletions not shown
View
33 parser30.yp
@@ -402,11 +402,11 @@ interface_body
;
exports
-: export
+: _export
{
[$_[1]->getRef()];
}
-| export exports
+| _export exports
{
unshift(@{$_[2]},$_[1]->getRef());
$_[2];
@@ -414,6 +414,21 @@ exports
;
/* 9 */
+_export
+: export
+ #default action
+| state_member
+ {
+ $_[0]->Error("state member unexpected.\n");
+ $_[1]; #default action
+ }
+| init_dcl
+ {
+ $_[0]->Error("initializer unexpected.\n");
+ $_[1]; #default action
+ }
+;
+
export
: type_dcl ';'
#default action
@@ -562,11 +577,21 @@ value_forward_dcl
/* 15 */ /* 3.9.2 Boxed Value Type */
value_box_dcl
-: VALUETYPE IDENTIFIER type_spec
+: value_box_header type_spec
+ {
+ $_[0]->YYData->{symbtab}->PopCurrentScope($_[1]);
+ $_[0]->YYData->{curr_itf} = undef;
+ $_[1]->Configure($_[0],
+ 'type' => $_[2]
+ ) if (defined $_[1]);
+ }
+;
+
+value_box_header
+: VALUETYPE IDENTIFIER
{
new BoxedValue($_[0],
'idf' => $_[2],
- 'type' => $_[3]
);
}
;
View
27 repos_id.pm
@@ -14,14 +14,14 @@ sub new {
my $class = ref($proto) || $proto;
my $self = {};
bless($self, $class);
- my($parser) = @_;
+ my ($parser) = @_;
$self->{symbtab} = $parser->YYData->{symbtab};
return $self;
}
sub _set_repos_id {
my $self = shift;
- my($node) = @_;
+ my ($node) = @_;
if (exists $node->{typeid}) {
$node->{repos_id} = $node->{typeid};
} elsif (exists $node->{id}) {
@@ -64,7 +64,7 @@ sub visitNameType {
sub visitNameSpecification {
my $self = shift;
- my($node) = @_;
+ my ($node) = @_;
foreach (@{$node->{list_export}}) {
$self->{symbtab}->Lookup($_)->visitName($self);
}
@@ -80,7 +80,7 @@ sub visitNameSpecification {
sub visitNameModules {
my $self = shift;
- my($node) = @_;
+ my ($node) = @_;
$self->_set_repos_id($node);
foreach (@{$node->{list_export}}) {
$self->{symbtab}->Lookup($_)->visitName($self);
@@ -93,7 +93,7 @@ sub visitNameModules {
sub visitNameBaseInterface {
my $self = shift;
- my($node) = @_;
+ my ($node) = @_;
$self->_set_repos_id($node);
foreach (@{$node->{list_export}}) {
$self->{symbtab}->Lookup($_)->visitName($self);
@@ -112,6 +112,13 @@ sub visitNameInitializer {
# empty
}
+sub visitNameBoxedValue {
+ my $self = shift;
+ my ($node) = @_;
+ $self->_set_repos_id($node);
+ $self->visitNameType($node->{type});
+}
+
#
# 3.10 Constant Declaration
#
@@ -126,7 +133,7 @@ sub visitNameConstant {
sub visitNameTypeDeclarator {
my $self = shift;
- my($node) = @_;
+ my ($node) = @_;
unless (exists $node->{modifier}) { # native IDL2.2
$self->_set_repos_id($node);
$self->visitNameType($node->{type});
@@ -147,7 +154,7 @@ sub visitNameBasicType {
sub visitNameStructType {
my $self = shift;
- my($node) = @_;
+ my ($node) = @_;
$self->_set_repos_id($node);
foreach (@{$node->{list_expr}}) {
if (ref $_->{type}) {
@@ -163,7 +170,7 @@ sub visitNameStructType {
sub visitNameUnionType {
my $self = shift;
- my($node) = @_;
+ my ($node) = @_;
$self->_set_repos_id($node);
foreach (@{$node->{list_expr}}) {
if (ref $_->{element}->{type}) {
@@ -180,7 +187,7 @@ sub visitNameUnionType {
sub visitNameEnumType {
my $self = shift;
- my($node) = @_;
+ my ($node) = @_;
$self->_set_repos_id($node);
}
@@ -210,7 +217,7 @@ sub visitNameFixedPtType {
sub visitNameException {
my $self = shift;
- my($node) = @_;
+ my ($node) = @_;
$self->_set_repos_id($node);
if (exists $node->{list_expr}) {
warn __PACKAGE__,"::visitNameException $node->{idf} : empty list_expr.\n"
Please sign in to comment.
Something went wrong with that request. Please try again.