Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

import version 2.61 from backpan

  • Loading branch information...
commit 09f04c3f86c240cc7f4e47c63b5e84ef46336a82 1 parent 5879bb9
@fperrad authored
View
3  Changes
@@ -1,5 +1,8 @@
Revision history for Perl extension CORBA::IDL.
+2.61 Fri Oct 19 08:30:00 2007
+ - package refactoring (avoid PAUSE indexer errors)
+
2.60 Fri Oct 12 08:30:00 2007
- package refactoring (not compatible with 2.4x version)
- some Perl Best Practices
View
3  META.yml
@@ -1,12 +1,13 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: CORBA-IDL
-version: 2.60
+version: 2.61
version_from: lib/CORBA/IDL.pm
installdirs: site
requires:
Digest::SHA1: 0
Math::BigInt: 1.66
+ Parse::Yapp: 0
distribution_type: module
generated_by: ExtUtils::MakeMaker version 6.30
View
1  Makefile.PL
@@ -8,6 +8,7 @@ WriteMakefile(
'PREREQ_PM' => {
'Digest::SHA1' => 0,
'Math::BigInt' => 1.66,
+ 'Parse::Yapp' => 0,
},
'INSTALLDIRS' => 'site',
'EXE_FILES' => [ 'bin/idl' ],
View
2  lib/CORBA/IDL.pm
@@ -3,7 +3,7 @@ use warnings;
package CORBA::IDL;
-our $VERSION = '2.60';
+our $VERSION = '2.61';
use CORBA::IDL::ParserFactory;
View
4 lib/CORBA/IDL/Makefile.yapp
@@ -1,6 +1,6 @@
PERL=perl
-YAPP=yapp -s -v
+YAPP=yapp -v
CP=$(PERL) -MExtUtils::Command -e cp
RM_F=$(PERL) -MExtUtils::Command -e rm_f
@@ -38,6 +38,6 @@ ParserXp.pm: ParserXp.yp
$(CP) Parser.pm ParserXp.pm
clean:
- $(RM_F) Parser*.pm
+ $(RM_F) Parser??.pm
$(RM_F) Parser*.output
View
452 lib/CORBA/IDL/Node.pm
@@ -7,7 +7,9 @@ use warnings;
package CORBA::IDL::Node;
-our $VERSION = '2.60';
+our $VERSION = '2.61';
+
+use UNIVERSAL;
sub _Build {
my $proto = shift;
@@ -31,6 +33,12 @@ sub new {
return $self
}
+sub isa {
+ my $self = shift;
+ my ($type) = @_;
+ return UNIVERSAL::isa($self, 'CORBA::IDL::' . $type);
+}
+
sub _Init {
# default
}
@@ -55,9 +63,11 @@ sub line_stamp {
sub getRef {
my $self = shift;
+ my $class = ref $self;
+ $class = substr $class, rindex($class, ':') + 1;
if (exists $self->{full}) {
- if ( ref($self) eq 'Module'
- or ref($self) =~ /^Forward/ ) {
+ if ( $class eq 'Module'
+ or $class =~ /^Forward/ ) {
return $self;
}
else {
@@ -105,7 +115,7 @@ sub visit {
my $visitor = shift;
no strict "refs";
while ($class ne 'CORBA::IDL::Node') {
- my $func = 'visit' . $class;
+ my $func = 'visit' . substr($class, rindex($class, ':') + 1);
if ($visitor->can($func)) {
return $visitor->$func($self, @_);
}
@@ -122,7 +132,7 @@ sub visitName {
my $visitor = shift;
no strict "refs";
while ($class ne 'CORBA::IDL::Node') {
- my $func = 'visitName' . $class;
+ my $func = 'visitName' . substr($class, rindex($class, ':') + 1);
if ($visitor->can($func)) {
return $visitor->$func($self, @_);
}
@@ -138,7 +148,7 @@ sub visitName {
# 3.5 OMG IDL Specification
#
-package Specification;
+package CORBA::IDL::Specification;
use base qw(CORBA::IDL::Node);
@@ -148,7 +158,7 @@ sub _Init {
my %hash;
foreach my $export (@{$self->{list_decl}}) {
if (ref $export) {
- unless (ref($export) =~ /^Forward/) {
+ unless (ref($export) =~ /^CORBA::IDL::Forward/) {
if ($export->isa('Module')) {
$hash{$export->{full}} = 1;
}
@@ -171,7 +181,7 @@ sub _Init {
# 3.6 Import Declaration
#
-package Import;
+package CORBA::IDL::Import;
use base qw(CORBA::IDL::Node);
@@ -185,11 +195,11 @@ sub _Init {
# 3.7 Module Declaration
#
-package Modules;
+package CORBA::IDL::Modules;
use base qw(CORBA::IDL::Node);
-package Module;
+package CORBA::IDL::Module;
use base qw(CORBA::IDL::Node);
@@ -217,7 +227,7 @@ sub Configure {
foreach my $module (@{$defn->{list_decl}}) {
foreach my $export (@{$module->{list_decl}}) {
if (ref $export) {
- unless (ref($export) =~ /^Forward/) {
+ unless (ref($export) =~ /^CORBA::IDL::Forward/) {
if ($export->isa('Module')) {
$hash{$export->{full}} = 1;
}
@@ -241,7 +251,7 @@ sub Configure {
# 3.8 Interface Declaration
#
-package BaseInterface;
+package CORBA::IDL::BaseInterface;
use base qw(CORBA::IDL::Node);
@@ -296,7 +306,7 @@ sub Configure {
my @list;
foreach my $export (@{$self->{list_decl}}) {
if (ref $export) {
- unless (ref($export) =~ /^Forward/) {
+ unless (ref($export) =~ /^CORBA::IDL::Forward/) {
foreach (@{$export->{list_decl}}) {
push @list, $_ if (defined $_);
}
@@ -320,6 +330,7 @@ sub _CheckNative {
sub Lookup {
my $proto = shift;
my $class = ref($proto) || $proto;
+ $class = substr $class, rindex($class, ':') + 1;
my ($parser, $name, $bypass) = @_;
my $defn = $parser->YYData->{symbtab}->Lookup($name);
if (defined $defn) {
@@ -341,7 +352,7 @@ sub Lookup {
# 3.8.2 Interface Inheritance Specification
#
-package InheritanceSpec;
+package CORBA::IDL::InheritanceSpec;
use base qw(CORBA::IDL::Node);
@@ -388,13 +399,13 @@ sub _Init {
}
}
-package Interface;
+package CORBA::IDL::Interface;
-use base qw(BaseInterface);
+use base qw(CORBA::IDL::BaseInterface);
-package RegularInterface;
+package CORBA::IDL::RegularInterface;
-use base qw(Interface);
+use base qw(CORBA::IDL::Interface);
sub _CheckInheritance {
my $self = shift;
@@ -419,16 +430,16 @@ sub _CheckLocal {
foreach (@{$self->{list_export}}) {
my $defn = $parser->YYData->{symbtab}->Lookup($_);
if ($defn->isa('Attribute')) {
- if (TypeDeclarator->IsaLocal($parser, $defn->{type})) {
+ if (CORBA::IDL::TypeDeclarator->IsaLocal($parser, $defn->{type})) {
$parser->Error("'$self->{idf}' is not local.\n");
}
}
elsif ($defn->isa('Operation')) {
- if (TypeDeclarator->IsaLocal($parser, $defn->{type})) {
+ if (CORBA::IDL::TypeDeclarator->IsaLocal($parser, $defn->{type})) {
$parser->Error("'$self->{idf}' is not local.\n");
}
foreach (@{$defn->{list_param}}) {
- if (TypeDeclarator->IsaLocal($parser, $_->{type})) {
+ if (CORBA::IDL::TypeDeclarator->IsaLocal($parser, $_->{type})) {
$parser->Error("'$self->{idf}' is not local.\n");
}
}
@@ -459,7 +470,7 @@ sub _CheckNative {
# 3.8.4 Forward Declaration
#
-package ForwardBaseInterface;
+package CORBA::IDL::ForwardBaseInterface;
use base qw(CORBA::IDL::Node);
@@ -473,29 +484,29 @@ sub _Init {
$parser->YYData->{symbtab}->InsertForward($self);
}
-package ForwardInterface;
+package CORBA::IDL::ForwardInterface;
-use base qw(ForwardBaseInterface);
+use base qw(CORBA::IDL::ForwardBaseInterface);
-package ForwardRegularInterface;
+package CORBA::IDL::ForwardRegularInterface;
-use base qw(ForwardInterface);
+use base qw(CORBA::IDL::ForwardInterface);
-package ForwardAbstractInterface;
+package CORBA::IDL::ForwardAbstractInterface;
-use base qw(ForwardInterface);
+use base qw(CORBA::IDL::ForwardInterface);
-package ForwardLocalInterface;
+package CORBA::IDL::ForwardLocalInterface;
-use base qw(ForwardInterface);
+use base qw(CORBA::IDL::ForwardInterface);
#
# 3.8.6 Abstract Interface
#
-package AbstractInterface;
+package CORBA::IDL::AbstractInterface;
-use base qw(Interface);
+use base qw(CORBA::IDL::Interface);
sub _CheckInheritance {
my $self = shift;
@@ -521,16 +532,16 @@ sub _CheckLocal {
foreach (@{$self->{list_export}}) {
my $defn = $parser->YYData->{symbtab}->Lookup($_);
if ($defn->isa('Attribute')) {
- if (TypeDeclarator->IsaLocal($parser, $defn->{type})) {
+ if (CORBA::IDL::TypeDeclarator->IsaLocal($parser, $defn->{type})) {
$parser->Error("'$self->{idf}' is not local.\n");
}
}
elsif ($defn->isa('Operation')) {
- if (TypeDeclarator->IsaLocal($parser, $defn->{type})) {
+ if (CORBA::IDL::TypeDeclarator->IsaLocal($parser, $defn->{type})) {
$parser->Error("'$self->{idf}' is not local.\n");
}
foreach (@{$defn->{list_param}}) {
- if (TypeDeclarator->IsaLocal($parser, $_->{type})) {
+ if (CORBA::IDL::TypeDeclarator->IsaLocal($parser, $_->{type})) {
$parser->Error("'$self->{idf}' is not local.\n");
}
}
@@ -561,9 +572,9 @@ sub _CheckNative {
# 3.8.7 Local Interface
#
-package LocalInterface;
+package CORBA::IDL::LocalInterface;
-use base qw(Interface);
+use base qw(CORBA::IDL::Interface);
sub _CheckInheritance {
# A local interface may inherit from other local or unconstrained interfaces
@@ -581,16 +592,16 @@ sub _CheckLocal {
# 3.9 Value Declaration
#
-package Value;
+package CORBA::IDL::Value;
-use base qw(BaseInterface);
+use base qw(CORBA::IDL::BaseInterface);
# 3.9.1 Regular Value Type
#
-package RegularValue;
+package CORBA::IDL::RegularValue;
-use base qw(Value);
+use base qw(CORBA::IDL::Value);
sub _CheckInheritance {
my $self = shift;
@@ -634,10 +645,10 @@ sub Configure {
$self->SUPER::Configure($parser, @_);
my @list;
foreach my $value_element (@{$self->{list_decl}}) {
- next unless (ref $value_element eq 'StateMembers');
+ next unless (ref $value_element eq 'CORBA::IDL::StateMembers');
foreach (@{$value_element->{list_decl}}) {
push @list, $_;
- $self->{deprecated} = 1 if (TypeDeclarator->IsDeprecated($parser, $_));
+ $self->{deprecated} = 1 if (CORBA::IDL::TypeDeclarator->IsDeprecated($parser, $_));
}
}
$self->configure(list_member => \@list); # list of 'StateMember'
@@ -653,22 +664,22 @@ sub _CheckLocal {
# 3.9.1.4 State Members
#
-package StateMembers;
+package CORBA::IDL::StateMembers;
use base qw(CORBA::IDL::Node);
sub _Init {
my $self = shift;
my ($parser) = @_;
- TypeDeclarator->CheckDeprecated($parser, $self->{type});
- TypeDeclarator->CheckForward($parser, $self->{type});
+ CORBA::IDL::TypeDeclarator->CheckDeprecated($parser, $self->{type});
+ CORBA::IDL::TypeDeclarator->CheckForward($parser, $self->{type});
my @list;
foreach (@{$self->{list_expr}}) {
my $member;
my @array_size = @{$_};
my $idf = shift @array_size;
if (@array_size) {
- $member = new StateMember($parser,
+ $member = new CORBA::IDL::StateMember($parser,
declspec => $self->{declspec},
props => $self->{props},
modifier => $self->{modifier},
@@ -681,13 +692,13 @@ sub _Init {
if ($CORBA::IDL::Parser::IDL_VERSION ge '2.4');
}
else {
- $member = new StateMember($parser,
+ $member = new CORBA::IDL::StateMember($parser,
declspec => $self->{declspec},
props => $self->{props},
modifier => $self->{modifier},
type => $self->{type},
idf => $idf,
- deprecated => TypeDeclarator->IsDeprecated($parser, $self->{type}),
+ deprecated => CORBA::IDL::TypeDeclarator->IsDeprecated($parser, $self->{type}),
);
}
push @list, $member->{full};
@@ -695,14 +706,14 @@ sub _Init {
$self->configure(list_decl => \@list);
# A local type may not appear as a parameter, attribute, return type, or exception
# declaration of an unconstrained interface or as a state member of a valuetype.
- if (TypeDeclarator->IsaLocal($parser, $self->{type})) {
+ if (CORBA::IDL::TypeDeclarator->IsaLocal($parser, $self->{type})) {
my $idf = $self->{type}->{idf} if (exists $self->{type}->{idf});
$idf ||= $self->{type};
$parser->Error("'$idf' is local.\n");
}
}
-package StateMember; # modifier, idf, type[, array_size]
+package CORBA::IDL::StateMember; # modifier, idf, type[, array_size]
use base qw(CORBA::IDL::Node);
@@ -727,7 +738,7 @@ sub _Init {
# 3.9.1.5 Initializers
#
-package Initializer;
+package CORBA::IDL::Initializer;
use base qw(CORBA::IDL::Node);
@@ -769,9 +780,9 @@ sub Configure {
#
# 3.9.2 Boxed Value Type
#
-package BoxedValue;
+package CORBA::IDL::BoxedValue;
-use base qw(Value);
+use base qw(CORBA::IDL::Value);
sub _Init {
my $self = shift;
@@ -792,7 +803,7 @@ sub Configure {
my $self = shift;
my $parser = shift;
$self->configure(@_);
- my $type = TypeDeclarator->GetDefn($parser, $self->{type});
+ my $type = CORBA::IDL::TypeDeclarator->GetDefn($parser, $self->{type});
if ($type->isa('Value')) {
if ($CORBA::IDL::Parser::IDL_VERSION ge '3.0') {
$parser->Error("$self->{type}->{idf} is a value type.\n");
@@ -801,7 +812,7 @@ sub Configure {
$parser->Info("$self->{type}->{idf} is a value type.\n");
}
}
- $self->{deprecated} = 1 if (TypeDeclarator->IsDeprecated($parser, $type));
+ $self->{deprecated} = 1 if (CORBA::IDL::TypeDeclarator->IsDeprecated($parser, $type));
return $self;
}
@@ -809,9 +820,9 @@ sub Configure {
# 3.9.3 Abstract Value Type
#
-package AbstractValue;
+package CORBA::IDL::AbstractValue;
-use base qw(Value);
+use base qw(CORBA::IDL::Value);
sub _CheckInheritance {
my $self = shift;
@@ -848,23 +859,23 @@ sub _CheckLocal {
# 3.9.4 Value Forward Declaration
#
-package ForwardValue;
+package CORBA::IDL::ForwardValue;
-use base qw(ForwardBaseInterface);
+use base qw(CORBA::IDL::ForwardBaseInterface);
-package ForwardRegularValue;
+package CORBA::IDL::ForwardRegularValue;
-use base qw(ForwardValue);
+use base qw(CORBA::IDL::ForwardValue);
-package ForwardAbstractValue;
+package CORBA::IDL::ForwardAbstractValue;
-use base qw(ForwardValue);
+use base qw(CORBA::IDL::ForwardValue);
#
# 3.10 Constant Declaration
#
-package Expression;
+package CORBA::IDL::Expression;
use base qw(CORBA::IDL::Node);
@@ -873,7 +884,7 @@ sub _Init {
my ($parser) = @_;
if ( ! exists $self->{type} ) {
$self->configure(
- type => new IntegerType($parser,
+ type => new CORBA::IDL::IntegerType($parser,
value => 'unsigned long',
auto => 1
)
@@ -886,7 +897,7 @@ sub _Init {
if ( $self->{type}->isa('WideCharType')
and $expr->isa('CharacterLiteral') ) {
$self->{list_expr} = [
- new WideCharacterLiteral($parser,
+ new CORBA::IDL::WideCharacterLiteral($parser,
value => $expr->{value}
)
];
@@ -894,7 +905,7 @@ sub _Init {
elsif ( $self->{type}->isa('WideStringType')
and $expr->isa('StringLiteral') ) {
$self->{list_expr} = [
- new WideStringLiteral($parser,
+ new CORBA::IDL::WideStringLiteral($parser,
value => $expr->{value}
)
];
@@ -930,7 +941,7 @@ sub Eval {
my $self = shift;
my ($parser) = @_;
my @list_expr = @{$self->{list_expr}}; # create a copy
- my $type = TypeDeclarator->GetEffectiveType($parser, $self->{type});
+ my $type = CORBA::IDL::TypeDeclarator->GetEffectiveType($parser, $self->{type});
if (defined $type) {
return _Eval($parser, $type, \@list_expr);
}
@@ -1417,7 +1428,7 @@ sub _CheckRange {
}
}
-package Constant;
+package CORBA::IDL::Constant;
use base qw(CORBA::IDL::Node);
@@ -1433,8 +1444,8 @@ sub _Init {
$self->{_typeprefix} = $parser->YYData->{symbtab}->GetTypePrefix();
$parser->YYData->{symbtab}->Insert($self);
my $type = $self->{type};
- TypeDeclarator->CheckDeprecated($parser, $type);
- my $defn = TypeDeclarator->GetEffectiveType($parser, $type);
+ CORBA::IDL::TypeDeclarator->CheckDeprecated($parser, $type);
+ my $defn = CORBA::IDL::TypeDeclarator->GetEffectiveType($parser, $type);
if (defined $defn) {
if ( ! $defn->isa('IntegerType')
and ! $defn->isa('CharType')
@@ -1457,7 +1468,7 @@ sub _Init {
$parser->Error(__PACKAGE__ . "::_Init ERROR_INTERNAL ($type).\n");
}
$self->configure(
- value => new Expression($parser,
+ value => new CORBA::IDL::Expression($parser,
type => $defn,
list_expr => $self->{list_expr}
)
@@ -1468,6 +1479,7 @@ sub _Init {
sub Lookup {
my $proto = shift;
my $class = ref($proto) || $proto;
+ $class = substr $class, rindex($class, ':') + 1;
my ($parser, $name) = @_;
my $defn = $parser->YYData->{symbtab}->Lookup($name);
if (defined $defn) {
@@ -1482,11 +1494,11 @@ sub Lookup {
}
}
-package UnaryOp;
+package CORBA::IDL::UnaryOp;
use base qw(CORBA::IDL::Node);
-package BinaryOp;
+package CORBA::IDL::BinaryOp;
use base qw(CORBA::IDL::Node);
@@ -1494,47 +1506,47 @@ use base qw(CORBA::IDL::Node);
# 3.2.5 Literals
#
-package Literal;
+package CORBA::IDL::Literal;
use base qw(CORBA::IDL::Node);
-package IntegerLiteral;
+package CORBA::IDL::IntegerLiteral;
-use base qw(Literal);
+use base qw(CORBA::IDL::Literal);
-package StringLiteral;
+package CORBA::IDL::StringLiteral;
-use base qw(Literal);
+use base qw(CORBA::IDL::Literal);
-package WideStringLiteral;
+package CORBA::IDL::WideStringLiteral;
-use base qw(Literal);
+use base qw(CORBA::IDL::Literal);
-package CharacterLiteral;
+package CORBA::IDL::CharacterLiteral;
-use base qw(Literal);
+use base qw(CORBA::IDL::Literal);
-package WideCharacterLiteral;
+package CORBA::IDL::WideCharacterLiteral;
-use base qw(Literal);
+use base qw(CORBA::IDL::Literal);
-package FixedPtLiteral;
+package CORBA::IDL::FixedPtLiteral;
-use base qw(Literal);
+use base qw(CORBA::IDL::Literal);
-package FloatingPtLiteral;
+package CORBA::IDL::FloatingPtLiteral;
-use base qw(Literal);
+use base qw(CORBA::IDL::Literal);
-package BooleanLiteral;
+package CORBA::IDL::BooleanLiteral;
-use base qw(Literal);
+use base qw(CORBA::IDL::Literal);
#
# 3.11 Type Declaration
#
-package TypeDeclarators;
+package CORBA::IDL::TypeDeclarators;
use base qw(CORBA::IDL::Node);
@@ -1548,15 +1560,15 @@ sub _Init {
my $idf = shift @array_size;
my $decl;
if (@array_size) {
- $decl = new TypeDeclarator($parser,
+ $decl = new CORBA::IDL::TypeDeclarator($parser,
type => $self->{type},
idf => $idf,
array_size => \@array_size
);
- TypeDeclarator->CheckDeprecated($parser, $self->{type});
+ CORBA::IDL::TypeDeclarator->CheckDeprecated($parser, $self->{type});
}
else {
- $decl = new TypeDeclarator($parser,
+ $decl = new CORBA::IDL::TypeDeclarator($parser,
type => $self->{type},
idf => $idf
);
@@ -1577,7 +1589,7 @@ sub Configure {
return $self;
}
-package TypeDeclarator;
+package CORBA::IDL::TypeDeclarator;
use base qw(CORBA::IDL::Node);
@@ -1593,13 +1605,14 @@ sub _Init {
}
$parser->YYData->{symbtab}->Insert($self);
$parser->YYData->{curr_node} = $self;
- $self->{local_type} = 1 if (TypeDeclarator->IsaLocal($parser, $self->{type}));
- $self->{deprecated} = 1 if (TypeDeclarator->IsDeprecated($parser, $self->{type}));
+ $self->{local_type} = 1 if (CORBA::IDL::TypeDeclarator->IsaLocal($parser, $self->{type}));
+ $self->{deprecated} = 1 if (CORBA::IDL::TypeDeclarator->IsDeprecated($parser, $self->{type}));
}
sub Lookup {
my $proto = shift;
my $class = ref($proto) || $proto;
+ $class = substr $class, rindex($class, ':') + 1;
my ($parser, $name) = @_;
my $defn = $parser->YYData->{symbtab}->Lookup($name);
if (defined $defn) {
@@ -1636,14 +1649,14 @@ sub GetEffectiveType {
my $proto = shift;
my $class = ref($proto) || $proto;
my ($parser, $type) = @_;
- my $defn = TypeDeclarator->GetDefn($parser, $type);
+ my $defn = CORBA::IDL::TypeDeclarator->GetDefn($parser, $type);
unless (defined $defn) {
$parser->Error(__PACKAGE__ . "::GetEffectiveType ERROR_INTERNAL ($type).\n");
return undef;
}
while ( $defn->isa('TypeDeclarator')
and ! exists $defn->{array_size} ) {
- $defn = TypeDeclarator->GetDefn($parser, $defn->{type});
+ $defn = CORBA::IDL::TypeDeclarator->GetDefn($parser, $defn->{type});
unless (defined $defn) {
$parser->Error(__PACKAGE__ . "::GetEffectiveType ERROR_INTERNAL ($defn->{type}).\n");
return undef;
@@ -1656,7 +1669,7 @@ sub CheckDeprecated {
my $proto = shift;
my $class = ref($proto) || $proto;
my ($parser, $type) = @_;
- my $defn = TypeDeclarator->GetDefn($parser, $type);
+ my $defn = CORBA::IDL::TypeDeclarator->GetDefn($parser, $type);
return unless (defined $defn);
if ( $defn->isa('StringType')
or $defn->isa('WideStringType') ) {
@@ -1682,7 +1695,7 @@ sub IsDeprecated {
my $proto = shift;
my $class = ref($proto) || $proto;
my ($parser, $type) = @_;
- my $defn = TypeDeclarator->GetDefn($parser, $type);
+ my $defn = CORBA::IDL::TypeDeclarator->GetDefn($parser, $type);
return (exists $defn->{deprecated} ? 1 : undef);
}
@@ -1691,12 +1704,12 @@ sub CheckForward {
my $class = ref($proto) || $proto;
my ($parser, $type) = @_;
- my $defn = TypeDeclarator->GetDefn($parser, $type);
+ my $defn = CORBA::IDL::TypeDeclarator->GetDefn($parser, $type);
return unless (defined $defn);
while ( $defn->isa('SequenceType')
or $defn->isa('TypeDeclarator') ) {
last if (exists $defn->{array_size});
- $defn = TypeDeclarator->GetDefn($parser, $defn->{type});
+ $defn = CORBA::IDL::TypeDeclarator->GetDefn($parser, $defn->{type});
return unless (defined $defn);
}
if ($defn->isa('_ForwardConstructedType')) {
@@ -1710,13 +1723,13 @@ sub IsaLocal {
my ($parser, $type) = @_;
return undef unless ($type);
- my $defn = TypeDeclarator->GetDefn($parser, $type);
+ my $defn = CORBA::IDL::TypeDeclarator->GetDefn($parser, $type);
return exists $defn->{local_type} if ($defn);
$parser->Error(__PACKAGE__ . "::IsaLocal ERROR_INTERNAL ($type).\n");
return undef;
}
-package NativeType;
+package CORBA::IDL::NativeType;
use base qw(CORBA::IDL::Node);
@@ -1744,60 +1757,60 @@ sub Configure {
# 3.11.1 Basic Types
#
-package BasicType;
+package CORBA::IDL::BasicType;
use base qw(CORBA::IDL::Node);
-package FloatingPtType;
+package CORBA::IDL::FloatingPtType;
-use base qw(BasicType);
+use base qw(CORBA::IDL::BasicType);
-package IntegerType;
+package CORBA::IDL::IntegerType;
-use base qw(BasicType);
+use base qw(CORBA::IDL::BasicType);
-package CharType;
+package CORBA::IDL::CharType;
-use base qw(BasicType);
+use base qw(CORBA::IDL::BasicType);
-package WideCharType;
+package CORBA::IDL::WideCharType;
-use base qw(BasicType);
+use base qw(CORBA::IDL::BasicType);
-package BooleanType;
+package CORBA::IDL::BooleanType;
-use base qw(BasicType);
+use base qw(CORBA::IDL::BasicType);
-package OctetType;
+package CORBA::IDL::OctetType;
-use base qw(BasicType);
+use base qw(CORBA::IDL::BasicType);
-package AnyType;
+package CORBA::IDL::AnyType;
-use base qw(BasicType);
+use base qw(CORBA::IDL::BasicType);
-package ObjectType;
+package CORBA::IDL::ObjectType;
-use base qw(BasicType);
+use base qw(CORBA::IDL::BasicType);
-package ValueBaseType;
+package CORBA::IDL::ValueBaseType;
-use base qw(BasicType);
+use base qw(CORBA::IDL::BasicType);
#
# 3.11.2 Constructed Types
#
-package _ConstructedType;
+package CORBA::IDL::_ConstructedType;
use base qw(CORBA::IDL::Node);
# 3.11.2.1 Structures
#
-package StructType;
+package CORBA::IDL::StructType;
-use base qw(_ConstructedType);
+use base qw(CORBA::IDL::_ConstructedType);
sub _Init {
my $self = shift;
@@ -1821,30 +1834,30 @@ sub Configure {
foreach (@{$self->{list_expr}}) {
foreach (@{$_->{list_member}}) {
push @list, $_;
- $self->{deprecated} = 1 if (TypeDeclarator->IsDeprecated($parser, $_));
+ $self->{deprecated} = 1 if (CORBA::IDL::TypeDeclarator->IsDeprecated($parser, $_));
}
- $self->{local_type} = 1 if (TypeDeclarator->IsaLocal($parser, $_->{type}));
+ $self->{local_type} = 1 if (CORBA::IDL::TypeDeclarator->IsaLocal($parser, $_->{type}));
}
$self->configure(list_member => \@list); # list of 'Member'
return $self;
}
-package Members;
+package CORBA::IDL::Members;
use base qw(CORBA::IDL::Node);
sub _Init {
my $self = shift;
my ($parser) = @_;
- TypeDeclarator->CheckDeprecated($parser, $self->{type});
- TypeDeclarator->CheckForward($parser, $self->{type});
+ CORBA::IDL::TypeDeclarator->CheckDeprecated($parser, $self->{type});
+ CORBA::IDL::TypeDeclarator->CheckForward($parser, $self->{type});
my @list;
foreach (@{$self->{list_expr}}) {
my $member;
my @array_size = @{$_};
my $idf = shift @array_size;
if (@array_size) {
- $member = new Member($parser,
+ $member = new CORBA::IDL::Member($parser,
props => $self->{props},
type => $self->{type},
idf => $idf,
@@ -1855,11 +1868,11 @@ sub _Init {
if ($CORBA::IDL::Parser::IDL_VERSION ge '2.4');
}
else {
- $member = new Member($parser,
+ $member = new CORBA::IDL::Member($parser,
props => $self->{props},
type => $self->{type},
idf => $idf,
- deprecated => TypeDeclarator->IsDeprecated($parser, $self->{type}),
+ deprecated => CORBA::IDL::TypeDeclarator->IsDeprecated($parser, $self->{type}),
);
}
push @list, $member->{full};
@@ -1867,7 +1880,7 @@ sub _Init {
$self->configure(list_member => \@list);
}
-package Member; # idf, type[, array_size]
+package CORBA::IDL::Member; # idf, type[, array_size]
use base qw(CORBA::IDL::Node);
@@ -1885,9 +1898,9 @@ sub _Init {
# 3.11.2.2 Discriminated Unions
#
-package UnionType;
+package CORBA::IDL::UnionType;
-use base qw(_ConstructedType);
+use base qw(CORBA::IDL::_ConstructedType);
sub _Init {
my $self = shift;
@@ -1908,7 +1921,7 @@ sub Configure {
my $parser = shift;
$self->configure(@_);
my $dis = $self->{type};
- my $defn = TypeDeclarator->GetEffectiveType($parser, $dis);
+ my $defn = CORBA::IDL::TypeDeclarator->GetEffectiveType($parser, $dis);
if (defined $defn) {
if ( ! $defn->isa('IntegerType')
and ! $defn->isa('CharType')
@@ -1925,19 +1938,19 @@ sub Configure {
my @list_all;
foreach my $case (@{$self->{list_expr}}) {
my $elt = $case->{element};
- $self->{local_type} = 1 if (TypeDeclarator->IsaLocal($parser, $elt->{type}));
- $self->{deprecated} = 1 if (TypeDeclarator->IsDeprecated($parser, $elt->{value}));
+ $self->{local_type} = 1 if (CORBA::IDL::TypeDeclarator->IsaLocal($parser, $elt->{type}));
+ $self->{deprecated} = 1 if (CORBA::IDL::TypeDeclarator->IsDeprecated($parser, $elt->{value}));
my @list;
foreach (@{$case->{list_label}}) {
my $key;
- if (ref $_ eq 'Default') {
+ if (ref $_ eq 'CORBA::IDL::Default') {
$key = 'Default';
push @list, $_;
$self->configure(default => $case);
}
else {
# now, type is known
- my $cst = new Expression($parser,
+ my $cst = new CORBA::IDL::Expression($parser,
type => $dis,
list_expr => $_
);
@@ -1984,28 +1997,28 @@ sub Configure {
return $self;
}
-package Case;
+package CORBA::IDL::Case;
use base qw(CORBA::IDL::Node);
-package Default;
+package CORBA::IDL::Default;
use base qw(CORBA::IDL::Node);
-package Element;
+package CORBA::IDL::Element;
use base qw(CORBA::IDL::Node);
sub _Init {
my $self = shift;
my ($parser) = @_;
- TypeDeclarator->CheckDeprecated($parser, $self->{type});
- TypeDeclarator->CheckForward($parser, $self->{type});
+ CORBA::IDL::TypeDeclarator->CheckDeprecated($parser, $self->{type});
+ CORBA::IDL::TypeDeclarator->CheckForward($parser, $self->{type});
my @array_size = @{$self->{list_expr}};
my $idf = shift @array_size;
my $value;
if (@array_size) {
- $value = new Member($parser,
+ $value = new CORBA::IDL::Member($parser,
type => $self->{type},
idf => $idf,
array_size => \@array_size,
@@ -2015,10 +2028,10 @@ sub _Init {
if ($CORBA::IDL::Parser::IDL_VERSION ge '2.4');
}
else {
- $value = new Member($parser,
+ $value = new CORBA::IDL::Member($parser,
type => $self->{type},
idf => $idf,
- deprecated => TypeDeclarator->IsDeprecated($parser, $self->{type}),
+ deprecated => CORBA::IDL::TypeDeclarator->IsDeprecated($parser, $self->{type}),
);
}
$self->configure(value => $value->{full}); # 'Member'
@@ -2027,7 +2040,7 @@ sub _Init {
# 3.11.2.3 Constructed Recursive Types and Forward Declarations
#
-package _ForwardConstructedType;
+package CORBA::IDL::_ForwardConstructedType;
use base qw(CORBA::IDL::Node);
@@ -2043,20 +2056,20 @@ sub _Init {
}
-package ForwardStructType;
+package CORBA::IDL::ForwardStructType;
-use base qw(_ForwardConstructedType);
+use base qw(CORBA::IDL::_ForwardConstructedType);
-package ForwardUnionType;
+package CORBA::IDL::ForwardUnionType;
-use base qw(_ForwardConstructedType);
+use base qw(CORBA::IDL::_ForwardConstructedType);
# 3.11.2.4 Enumerations
#
-package EnumType;
+package CORBA::IDL::EnumType;
-use base qw(_ConstructedType);
+use base qw(CORBA::IDL::_ConstructedType);
use constant ULONG_MAX => 4294967295;
@@ -2103,7 +2116,7 @@ sub Configure {
return $self;
}
-package Enum;
+package CORBA::IDL::Enum;
use base qw(CORBA::IDL::Node);
@@ -2122,34 +2135,34 @@ sub _Init {
# 3.11.3 Template Types
#
-package _TemplateType;
+package CORBA::IDL::_TemplateType;
use base qw(CORBA::IDL::Node);
-package SequenceType;
+package CORBA::IDL::SequenceType;
-use base qw(_TemplateType);
+use base qw(CORBA::IDL::_TemplateType);
sub _Init {
my $self = shift;
my ($parser) = @_;
$self->line_stamp($parser);
$parser->YYData->{symbtab}->InsertBogus($self);
- TypeDeclarator->CheckDeprecated($parser, $self->{type});
- $self->{local_type} = 1 if (TypeDeclarator->IsaLocal($parser, $self->{type}));
+ CORBA::IDL::TypeDeclarator->CheckDeprecated($parser, $self->{type});
+ $self->{local_type} = 1 if (CORBA::IDL::TypeDeclarator->IsaLocal($parser, $self->{type}));
}
-package StringType;
+package CORBA::IDL::StringType;
-use base qw(_TemplateType);
+use base qw(CORBA::IDL::_TemplateType);
-package WideStringType;
+package CORBA::IDL::WideStringType;
-use base qw(_TemplateType);
+use base qw(CORBA::IDL::_TemplateType);
-package FixedPtType;
+package CORBA::IDL::FixedPtType;
-use base qw(_TemplateType);
+use base qw(CORBA::IDL::_TemplateType);
sub _Init {
my $self = shift;
@@ -2157,15 +2170,15 @@ sub _Init {
$self->line_stamp($parser);
}
-package FixedPtConstType;
+package CORBA::IDL::FixedPtConstType;
-use base qw(_TemplateType);
+use base qw(CORBA::IDL::_TemplateType);
#
# 3.12 Exception Declaration
#
-package Exception;
+package CORBA::IDL::Exception;
use base qw(CORBA::IDL::Node);
@@ -2192,7 +2205,7 @@ sub Configure {
foreach (@{$_->{list_member}}) {
push @list, $_;
}
- $self->{local_type} = 1 if (TypeDeclarator->IsaLocal($parser, $_->{type}));
+ $self->{local_type} = 1 if (CORBA::IDL::TypeDeclarator->IsaLocal($parser, $_->{type}));
}
$self->configure(list_member => \@list); # list of 'Member'
return $self;
@@ -2201,6 +2214,7 @@ sub Configure {
sub Lookup {
my $proto = shift;
my $class = ref($proto) || $proto;
+ $class = substr $class, rindex($class, ':') + 1;
my ($parser, $name) = @_;
my $defn = $parser->YYData->{symbtab}->Lookup($name);
if (defined $defn) {
@@ -2218,7 +2232,7 @@ sub Lookup {
# 3.13 Operation Declaration
#
-package Operation;
+package CORBA::IDL::Operation;
use base qw(CORBA::IDL::Node);
@@ -2233,8 +2247,8 @@ sub _Init {
}
$parser->YYData->{symbtab}->Insert($self);
$parser->YYData->{unnamed_symbtab} = new CORBA::IDL::UnnamedSymbtab($parser);
- TypeDeclarator->CheckDeprecated($parser, $type);
- TypeDeclarator->CheckForward($parser, $type);
+ CORBA::IDL::TypeDeclarator->CheckDeprecated($parser, $type);
+ CORBA::IDL::TypeDeclarator->CheckForward($parser, $type);
if (defined $parser->YYData->{curr_itf}) {
$self->{itf} = $parser->YYData->{curr_itf}->{full};
$parser->YYData->{curr_itf}->{hash_attribute_operation}{$self->{idf}} = $self->{full}
@@ -2298,7 +2312,7 @@ sub Configure {
return $self;
}
-package Parameter;
+package CORBA::IDL::Parameter;
use base qw(CORBA::IDL::Node);
@@ -2312,8 +2326,8 @@ sub _Init {
$parser->YYData->{unnamed_symbtab}->InsertUsed($1);
}
}
- TypeDeclarator->CheckDeprecated($parser, $type);
- TypeDeclarator->CheckForward($parser, $type);
+ CORBA::IDL::TypeDeclarator->CheckDeprecated($parser, $type);
+ CORBA::IDL::TypeDeclarator->CheckForward($parser, $type);
$parser->YYData->{unnamed_symbtab}->Insert($self->{idf});
if ($parser->YYData->{doc} ne q{}) {
$self->{doc} = $parser->YYData->{doc};
@@ -2322,11 +2336,11 @@ sub _Init {
$parser->YYData->{curr_node} = $self;
}
-package VoidType;
+package CORBA::IDL::VoidType;
use base qw(CORBA::IDL::Node);
-package Ellipsis;
+package CORBA::IDL::Ellipsis;
use base qw(CORBA::IDL::Node);
@@ -2334,7 +2348,7 @@ use base qw(CORBA::IDL::Node);
# 3.14 Attribute Declaration
#
-package Attributes;
+package CORBA::IDL::Attributes;
use base qw(CORBA::IDL::Node);
@@ -2343,7 +2357,7 @@ sub _Init {
my ($parser) = @_;
my @list;
foreach (@{$self->{list_expr}}) {
- my $attr = new Attribute($parser,
+ my $attr = new CORBA::IDL::Attribute($parser,
declspec => $self->{declspec},
props => $self->{props},
modifier => $self->{modifier},
@@ -2357,7 +2371,7 @@ sub _Init {
$self->configure(list_decl => \@list);
}
-package Attribute;
+package CORBA::IDL::Attribute;
use base qw(CORBA::IDL::Node);
@@ -2379,7 +2393,7 @@ sub _Init {
$parser->Error(__PACKAGE__ . "::new ERROR_INTERNAL.\n");
}
$parser->YYData->{curr_node} = $self;
- my $op = new Operation($parser,
+ my $op = new CORBA::IDL::Operation($parser,
type => $self->{type},
idf => '_get_' . $self->{idf}
);
@@ -2391,8 +2405,8 @@ sub _Init {
_get => $op
);
unless (exists $self->{modifier}) { # readonly
- $op = new Operation($parser,
- type => new VoidType($parser,
+ $op = new CORBA::IDL::Operation($parser,
+ type => new CORBA::IDL::VoidType($parser,
value => 'void'
),
idf => '_set_' . $self->{idf}
@@ -2400,7 +2414,7 @@ sub _Init {
# unnamed_symbtab created
$op->Configure($parser,
list_param => [
- new Parameter($parser,
+ new CORBA::IDL::Parameter($parser,
attr => 'in',
type => $self->{type},
idf => 'new' . ucfirst $self->{idf}
@@ -2418,7 +2432,7 @@ sub _Init {
# 3.15 Repository Identity Related Declarations
#
-package TypeId;
+package CORBA::IDL::TypeId;
use base qw(CORBA::IDL::Node);
@@ -2461,7 +2475,7 @@ sub _Init {
}
}
-package TypePrefix;
+package CORBA::IDL::TypePrefix;
use base qw(CORBA::IDL::Node);
@@ -2501,13 +2515,13 @@ sub _Init {
# 3.16 Event Declaration
#
-package Event;
+package CORBA::IDL::Event;
-use base qw(Value);
+use base qw(CORBA::IDL::Value);
-package RegularEvent;
+package CORBA::IDL::RegularEvent;
-use base qw(Event);
+use base qw(CORBA::IDL::Event);
sub _CheckInheritance {
my $self = shift;
@@ -2525,9 +2539,9 @@ sub _CheckLocal {
# declaration of a local interface or of a valuetype.
}
-package AbstractEvent;
+package CORBA::IDL::AbstractEvent;
-use base qw(Event);
+use base qw(CORBA::IDL::Event);
sub _CheckInheritance {
# empty
@@ -2538,50 +2552,50 @@ sub _CheckLocal {
# declaration of a local interface or of a valuetype.
}
-package ForwardEvent;
+package CORBA::IDL::ForwardEvent;
-use base qw(ForwardValue);
+use base qw(CORBA::IDL::ForwardValue);
-package ForwardRegularEvent;
+package CORBA::IDL::ForwardRegularEvent;
-use base qw(ForwardEvent);
+use base qw(CORBA::IDL::ForwardEvent);
-package ForwardAbstractEvent;
+package CORBA::IDL::ForwardAbstractEvent;
-use base qw(ForwardEvent);
+use base qw(CORBA::IDL::ForwardEvent);
#
# 3.17 Component Declaration
#
-package Component;
+package CORBA::IDL::Component;
-use base qw(BaseInterface);
+use base qw(CORBA::IDL::BaseInterface);
sub _CheckInheritance {
}
-package ForwardComponent;
+package CORBA::IDL::ForwardComponent;
-use base qw(ForwardBaseInterface);
+use base qw(CORBA::IDL::ForwardBaseInterface);
-package Provides;
+package CORBA::IDL::Provides;
use base qw(CORBA::IDL::Node);
-package Uses;
+package CORBA::IDL::Uses;
use base qw(CORBA::IDL::Node);
-package Emits;
+package CORBA::IDL::Emits;
use base qw(CORBA::IDL::Node);
-package Publishes;
+package CORBA::IDL::Publishes;
use base qw(CORBA::IDL::Node);
-package Consumes;
+package CORBA::IDL::Consumes;
use base qw(CORBA::IDL::Node);
@@ -2589,14 +2603,14 @@ use base qw(CORBA::IDL::Node);
# 3.18 Home Declaration
#
-package Home;
+package CORBA::IDL::Home;
-use base qw(BaseInterface);
+use base qw(CORBA::IDL::BaseInterface);
sub _CheckInheritance {
}
-package Factory;
+package CORBA::IDL::Factory;
use base qw(CORBA::IDL::Node);
@@ -2635,7 +2649,7 @@ sub Configure {
return $self;
}
-package Finder;
+package CORBA::IDL::Finder;
use base qw(CORBA::IDL::Node);
@@ -2674,7 +2688,7 @@ sub Configure {
return $self;
}
-package CodeFragment;
+package CORBA::IDL::CodeFragment;
use base qw(CORBA::IDL::Node);
View
583 lib/CORBA/IDL/Parser20.pm
@@ -12,482 +12,7 @@ use vars qw ( @ISA );
use strict;
@ISA= qw ( Parse::Yapp::Driver );
-#Included Parse/Yapp/Driver.pm file----------------------------------------
-{
-#
-# Module Parse::Yapp::Driver
-#
-# This module is part of the Parse::Yapp package available on your
-# nearest CPAN
-#
-# Any use of this module in a standalone parser make the included
-# text under the same copyright as the Parse::Yapp module itself.
-#
-# This notice should remain unchanged.
-#
-# (c) Copyright 1998-2001 Francois Desarmenien, all rights reserved.
-# (see the pod text in Parse::Yapp module for use and distribution rights)
-#
-
-package Parse::Yapp::Driver;
-
-require 5.004;
-
-use strict;
-
-use vars qw ( $VERSION $COMPATIBLE $FILENAME );
-
-$VERSION = '1.05';
-$COMPATIBLE = '0.07';
-$FILENAME=__FILE__;
-
-use Carp;
-
-#Known parameters, all starting with YY (leading YY will be discarded)
-my(%params)=(YYLEX => 'CODE', 'YYERROR' => 'CODE', YYVERSION => '',
- YYRULES => 'ARRAY', YYSTATES => 'ARRAY', YYDEBUG => '');
-#Mandatory parameters
-my(@params)=('LEX','RULES','STATES');
-
-sub new {
- my($class)=shift;
- my($errst,$nberr,$token,$value,$check,$dotpos);
- my($self)={ ERROR => \&_Error,
- ERRST => \$errst,
- NBERR => \$nberr,
- TOKEN => \$token,
- VALUE => \$value,
- DOTPOS => \$dotpos,
- STACK => [],
- DEBUG => 0,
- CHECK => \$check };
-
- _CheckParams( [], \%params, \@_, $self );
-
- exists($$self{VERSION})
- and $$self{VERSION} < $COMPATIBLE
- and croak "Yapp driver version $VERSION ".
- "incompatible with version $$self{VERSION}:\n".
- "Please recompile parser module.";
-
- ref($class)
- and $class=ref($class);
-
- bless($self,$class);
-}
-
-sub YYParse {
- my($self)=shift;
- my($retval);
-
- _CheckParams( \@params, \%params, \@_, $self );
-
- if($$self{DEBUG}) {
- _DBLoad();
- $retval = eval '$self->_DBParse()';#Do not create stab entry on compile
- $@ and die $@;
- }
- else {
- $retval = $self->_Parse();
- }
- $retval
-}
-
-sub YYData {
- my($self)=shift;
-
- exists($$self{USER})
- or $$self{USER}={};
-
- $$self{USER};
-
-}
-
-sub YYErrok {
- my($self)=shift;
-
- ${$$self{ERRST}}=0;
- undef;
-}
-
-sub YYNberr {
- my($self)=shift;
-
- ${$$self{NBERR}};
-}
-
-sub YYRecovering {
- my($self)=shift;
-
- ${$$self{ERRST}} != 0;
-}
-
-sub YYAbort {
- my($self)=shift;
-
- ${$$self{CHECK}}='ABORT';
- undef;
-}
-
-sub YYAccept {
- my($self)=shift;
-
- ${$$self{CHECK}}='ACCEPT';
- undef;
-}
-
-sub YYError {
- my($self)=shift;
-
- ${$$self{CHECK}}='ERROR';
- undef;
-}
-
-sub YYSemval {
- my($self)=shift;
- my($index)= $_[0] - ${$$self{DOTPOS}} - 1;
-
- $index < 0
- and -$index <= @{$$self{STACK}}
- and return $$self{STACK}[$index][1];
-
- undef; #Invalid index
-}
-
-sub YYCurtok {
- my($self)=shift;
-
- @_
- and ${$$self{TOKEN}}=$_[0];
- ${$$self{TOKEN}};
-}
-
-sub YYCurval {
- my($self)=shift;
-
- @_
- and ${$$self{VALUE}}=$_[0];
- ${$$self{VALUE}};
-}
-
-sub YYExpect {
- my($self)=shift;
-
- keys %{$self->{STATES}[$self->{STACK}[-1][0]]{ACTIONS}}
-}
-
-sub YYLexer {
- my($self)=shift;
-
- $$self{LEX};
-}
-
-
-#################
-# Private stuff #
-#################
-
-
-sub _CheckParams {
- my($mandatory,$checklist,$inarray,$outhash)=@_;
- my($prm,$value);
- my($prmlst)={};
-
- while(($prm,$value)=splice(@$inarray,0,2)) {
- $prm=uc($prm);
- exists($$checklist{$prm})
- or croak("Unknow parameter '$prm'");
- ref($value) eq $$checklist{$prm}
- or croak("Invalid value for parameter '$prm'");
- $prm=unpack('@2A*',$prm);
- $$outhash{$prm}=$value;
- }
- for (@$mandatory) {
- exists($$outhash{$_})
- or croak("Missing mandatory parameter '".lc($_)."'");
- }
-}
-
-sub _Error {
- print "Parse error.\n";
-}
-
-sub _DBLoad {
- {
- no strict 'refs';
-
- exists(${__PACKAGE__.'::'}{_DBParse})#Already loaded ?
- and return;
- }
- my($fname)=__FILE__;
- my(@drv);
- open(DRV,"<$fname") or die "Report this as a BUG: Cannot open $fname";
- while(<DRV>) {
- /^\s*sub\s+_Parse\s*{\s*$/ .. /^\s*}\s*#\s*_Parse\s*$/
- and do {
- s/^#DBG>//;
- push(@drv,$_);
- }
- }
- close(DRV);
-
- $drv[0]=~s/_P/_DBP/;
- eval join('',@drv);
-}
-
-#Note that for loading debugging version of the driver,
-#this file will be parsed from 'sub _Parse' up to '}#_Parse' inclusive.
-#So, DO NOT remove comment at end of sub !!!
-sub _Parse {
- my($self)=shift;
-
- my($rules,$states,$lex,$error)
- = @$self{ 'RULES', 'STATES', 'LEX', 'ERROR' };
- my($errstatus,$nberror,$token,$value,$stack,$check,$dotpos)
- = @$self{ 'ERRST', 'NBERR', 'TOKEN', 'VALUE', 'STACK', 'CHECK', 'DOTPOS' };
-
-#DBG> my($debug)=$$self{DEBUG};
-#DBG> my($dbgerror)=0;
-
-#DBG> my($ShowCurToken) = sub {
-#DBG> my($tok)='>';
-#DBG> for (split('',$$token)) {
-#DBG> $tok.= (ord($_) < 32 or ord($_) > 126)
-#DBG> ? sprintf('<%02X>',ord($_))
-#DBG> : $_;
-#DBG> }
-#DBG> $tok.='<';
-#DBG> };
-
- $$errstatus=0;
- $$nberror=0;
- ($$token,$$value)=(undef,undef);
- @$stack=( [ 0, undef ] );
- $$check='';
-
- while(1) {
- my($actions,$act,$stateno);
-
- $stateno=$$stack[-1][0];
- $actions=$$states[$stateno];
-
-#DBG> print STDERR ('-' x 40),"\n";
-#DBG> $debug & 0x2
-#DBG> and print STDERR "In state $stateno:\n";
-#DBG> $debug & 0x08
-#DBG> and print STDERR "Stack:[".
-#DBG> join(',',map { $$_[0] } @$stack).
-#DBG> "]\n";
-
-
- if (exists($$actions{ACTIONS})) {
-
- defined($$token)
- or do {
- ($$token,$$value)=&$lex($self);
-#DBG> $debug & 0x01
-#DBG> and print STDERR "Need token. Got ".&$ShowCurToken."\n";
- };
-
- $act= exists($$actions{ACTIONS}{$$token})
- ? $$actions{ACTIONS}{$$token}
- : exists($$actions{DEFAULT})
- ? $$actions{DEFAULT}
- : undef;
- }
- else {
- $act=$$actions{DEFAULT};
-#DBG> $debug & 0x01
-#DBG> and print STDERR "Don't need token.\n";
- }
-
- defined($act)
- and do {
-
- $act > 0
- and do { #shift
-
-#DBG> $debug & 0x04
-#DBG> and print STDERR "Shift and go to state $act.\n";
-
- $$errstatus
- and do {
- --$$errstatus;
-
-#DBG> $debug & 0x10
-#DBG> and $dbgerror
-#DBG> and $$errstatus == 0
-#DBG> and do {
-#DBG> print STDERR "**End of Error recovery.\n";
-#DBG> $dbgerror=0;
-#DBG> };
- };
-
-
- push(@$stack,[ $act, $$value ]);
-
- $$token ne '' #Don't eat the eof
- and $$token=$$value=undef;
- next;
- };
-
- #reduce
- my($lhs,$len,$code,@sempar,$semval);
- ($lhs,$len,$code)=@{$$rules[-$act]};
-
-#DBG> $debug & 0x04
-#DBG> and $act
-#DBG> and print STDERR "Reduce using rule ".-$act." ($lhs,$len): ";
-
- $act
- or $self->YYAccept();
-
- $$dotpos=$len;
-
- unpack('A1',$lhs) eq '@' #In line rule
- and do {
- $lhs =~ /^\@[0-9]+\-([0-9]+)$/
- or die "In line rule name '$lhs' ill formed: ".
- "report it as a BUG.\n";
- $$dotpos = $1;
- };
-
- @sempar = $$dotpos
- ? map { $$_[1] } @$stack[ -$$dotpos .. -1 ]
- : ();
-
- $semval = $code ? &$code( $self, @sempar )
- : @sempar ? $sempar[0] : undef;
-
- splice(@$stack,-$len,$len);
-
- $$check eq 'ACCEPT'
- and do {
-
-#DBG> $debug & 0x04
-#DBG> and print STDERR "Accept.\n";
-
- return($semval);
- };
-
- $$check eq 'ABORT'
- and do {
-
-#DBG> $debug & 0x04
-#DBG> and print STDERR "Abort.\n";
-
- return(undef);
-
- };
-
-#DBG> $debug & 0x04
-#DBG> and print STDERR "Back to state $$stack[-1][0], then ";
-
- $$check eq 'ERROR'
- or do {
-#DBG> $debug & 0x04
-#DBG> and print STDERR
-#DBG> "go to state $$states[$$stack[-1][0]]{GOTOS}{$lhs}.\n";
-
-#DBG> $debug & 0x10
-#DBG> and $dbgerror
-#DBG> and $$errstatus == 0
-#DBG> and do {
-#DBG> print STDERR "**End of Error recovery.\n";
-#DBG> $dbgerror=0;
-#DBG> };
-
- push(@$stack,
- [ $$states[$$stack[-1][0]]{GOTOS}{$lhs}, $semval ]);
- $$check='';
- next;
- };
-
-#DBG> $debug & 0x04
-#DBG> and print STDERR "Forced Error recovery.\n";
-
- $$check='';
-
- };
-
- #Error
- $$errstatus
- or do {
-
- $$errstatus = 1;
- &$error($self);
- $$errstatus # if 0, then YYErrok has been called
- or next; # so continue parsing
-
-#DBG> $debug & 0x10
-#DBG> and do {
-#DBG> print STDERR "**Entering Error recovery.\n";
-#DBG> ++$dbgerror;
-#DBG> };
-
- ++$$nberror;
-
- };
-
- $$errstatus == 3 #The next token is not valid: discard it
- and do {
- $$token eq '' # End of input: no hope
- and do {
-#DBG> $debug & 0x10
-#DBG> and print STDERR "**At eof: aborting.\n";
- return(undef);
- };
-
-#DBG> $debug & 0x10
-#DBG> and print STDERR "**Dicard invalid token ".&$ShowCurToken.".\n";
-
- $$token=$$value=undef;
- };
-
- $$errstatus=3;
-
- while( @$stack
- and ( not exists($$states[$$stack[-1][0]]{ACTIONS})
- or not exists($$states[$$stack[-1][0]]{ACTIONS}{error})
- or $$states[$$stack[-1][0]]{ACTIONS}{error} <= 0)) {
-
-#DBG> $debug & 0x10
-#DBG> and print STDERR "**Pop state $$stack[-1][0].\n";
-
- pop(@$stack);
- }
-
- @$stack
- or do {
-
-#DBG> $debug & 0x10
-#DBG> and print STDERR "**No state left on stack: aborting.\n";
-
- return(undef);
- };
-
- #shift the error token
-
-#DBG> $debug & 0x10
-#DBG> and print STDERR "**Shift \$error token and go to state ".
-#DBG> $$states[$$stack[-1][0]]{ACTIONS}{error}.
-#DBG> ".\n";
-
- push(@$stack, [ $$states[$$stack[-1][0]]{ACTIONS}{error}, undef ]);
-
- }
-
- #never reached
- croak("Error in driver logic. Please, report it as a BUG");
-
-}#_Parse
-#DO NOT remove comment
-
-1;
-
-}
-#End of include--------------------------------------------------
-
+use Parse::Yapp::Driver;
@@ -3241,7 +2766,7 @@ sub new {
sub
#line 52 "Parser20.yp"
{
- $_[0]->YYData->{root} = new Specification($_[0],
+ $_[0]->YYData->{root} = new CORBA::IDL::Specification($_[0],
'list_decl' => $_[1],
);
}
@@ -3368,7 +2893,7 @@ sub
sub
#line 146 "Parser20.yp"
{
- new Module($_[0],
+ new CORBA::IDL::Module($_[0],
'idf' => $_[2],
);
}
@@ -3429,7 +2954,7 @@ sub
sub
#line 197 "Parser20.yp"
{
- new ForwardRegularInterface($_[0],
+ new CORBA::IDL::ForwardRegularInterface($_[0],
'idf' => $_[2]
);
}
@@ -3448,7 +2973,7 @@ sub
sub
#line 212 "Parser20.yp"
{
- new RegularInterface($_[0],
+ new CORBA::IDL::RegularInterface($_[0],
'idf' => $_[2],
'inheritance' => $_[3]
);
@@ -3503,7 +3028,7 @@ sub
sub
#line 260 "Parser20.yp"
{
- new InheritanceSpec($_[0],
+ new CORBA::IDL::InheritanceSpec($_[0],
'list_interface' => $_[2]
);
}
@@ -3542,7 +3067,7 @@ sub
sub
#line 288 "Parser20.yp"
{
- Interface->Lookup($_[0], $_[1]);
+ CORBA::IDL::Interface->Lookup($_[0], $_[1]);
}
],
[#Rule 43
@@ -3589,7 +3114,7 @@ sub
sub
#line 322 "Parser20.yp"
{
- new Constant($_[0],
+ new CORBA::IDL::Constant($_[0],
'type' => $_[2],
'idf' => $_[3],
'list_expr' => $_[5]
@@ -3652,7 +3177,7 @@ sub
sub
#line 364 "Parser20.yp"
{
- TypeDeclarator->Lookup($_[0], $_[1]);
+ CORBA::IDL::TypeDeclarator->Lookup($_[0], $_[1]);
}
],
[#Rule 59
@@ -3782,7 +3307,7 @@ sub
#line 474 "Parser20.yp"
{
[
- Constant->Lookup($_[0], $_[1])
+ CORBA::IDL::Constant->Lookup($_[0], $_[1])
];
}
],
@@ -3816,7 +3341,7 @@ sub
sub
#line 497 "Parser20.yp"
{
- new IntegerLiteral($_[0],
+ new CORBA::IDL::IntegerLiteral($_[0],
'value' => $_[1],
'lexeme' => $_[0]->YYData->{lexeme}
);
@@ -3827,7 +3352,7 @@ sub
sub
#line 504 "Parser20.yp"
{
- new StringLiteral($_[0],
+ new CORBA::IDL::StringLiteral($_[0],
'value' => $_[1]
);
}
@@ -3837,7 +3362,7 @@ sub
sub
#line 510 "Parser20.yp"
{
- new CharacterLiteral($_[0],
+ new CORBA::IDL::CharacterLiteral($_[0],
'value' => $_[1]
);
}
@@ -3847,7 +3372,7 @@ sub
sub
#line 516 "Parser20.yp"
{
- new FloatingPtLiteral($_[0],
+ new CORBA::IDL::FloatingPtLiteral($_[0],
'value' => $_[1],
'lexeme' => $_[0]->YYData->{lexeme}
);
@@ -3872,7 +3397,7 @@ sub
sub
#line 538 "Parser20.yp"
{
- new BooleanLiteral($_[0],
+ new CORBA::IDL::BooleanLiteral($_[0],
'value' => $_[1]
);
}
@@ -3882,7 +3407,7 @@ sub
sub
#line 544 "Parser20.yp"
{
- new BooleanLiteral($_[0],
+ new CORBA::IDL::BooleanLiteral($_[0],
'value' => $_[1]
);
}
@@ -3892,7 +3417,7 @@ sub
sub
#line 554 "Parser20.yp"
{
- new Expression($_[0],
+ new CORBA::IDL::Expression($_[0],
'list_expr' => $_[1]
);
}
@@ -3928,7 +3453,7 @@ sub
sub
#line 583 "Parser20.yp"
{
- new TypeDeclarators($_[0],
+ new CORBA::IDL::TypeDeclarators($_[0],
'type' => $_[1],
'list_expr' => $_[2]
);
@@ -3951,7 +3476,7 @@ sub
sub
#line 606 "Parser20.yp"
{
- TypeDeclarator->Lookup($_[0], $_[1]);
+ CORBA::IDL::TypeDeclarator->Lookup($_[0], $_[1]);
}
],
[#Rule 106
@@ -3960,7 +3485,7 @@ sub
#line 610 "Parser20.yp"
{
$_[0]->Error("simple_type_spec expected.\n");
- new VoidType($_[0],
+ new CORBA::IDL::VoidType($_[0],
'value' => $_[1]
);
}
@@ -4055,7 +3580,7 @@ sub
sub
#line 700 "Parser20.yp"
{
- new FloatingPtType($_[0],
+ new CORBA::IDL::FloatingPtType($_[0],
'value' => $_[1]
);
}
@@ -4065,7 +3590,7 @@ sub
sub
#line 706 "Parser20.yp"
{
- new FloatingPtType($_[0],
+ new CORBA::IDL::FloatingPtType($_[0],
'value' => $_[1]
);
}
@@ -4087,7 +3612,7 @@ sub
sub
#line 732 "Parser20.yp"
{
- new IntegerType($_[0],
+ new CORBA::IDL::IntegerType($_[0],
'value' => $_[1]
);
}
@@ -4097,7 +3622,7 @@ sub
sub
#line 742 "Parser20.yp"
{
- new IntegerType($_[0],
+ new CORBA::IDL::IntegerType($_[0],
'value' => $_[1]
);
}
@@ -4113,7 +3638,7 @@ sub
sub
#line 760 "Parser20.yp"
{
- new IntegerType($_[0],
+ new CORBA::IDL::IntegerType($_[0],
'value' => $_[1] . q{ } . $_[2]
);
}
@@ -4123,7 +3648,7 @@ sub
sub
#line 770 "Parser20.yp"
{
- new IntegerType($_[0],
+ new CORBA::IDL::IntegerType($_[0],
'value' => $_[1] . q{ } . $_[2]
);
}
@@ -4133,7 +3658,7 @@ sub
sub
#line 780 "Parser20.yp"
{
- new CharType($_[0],
+ new CORBA::IDL::CharType($_[0],
'value' => $_[1]
);
}
@@ -4143,7 +3668,7 @@ sub
sub
#line 790 "Parser20.yp"
{
- new BooleanType($_[0],
+ new CORBA::IDL::BooleanType($_[0],
'value' => $_[1]
);
}
@@ -4153,7 +3678,7 @@ sub
sub
#line 800 "Parser20.yp"
{
- new OctetType($_[0],
+ new CORBA::IDL::OctetType($_[0],
'value' => $_[1]
);
}
@@ -4163,7 +3688,7 @@ sub
sub
#line 810 "Parser20.yp"
{
- new AnyType($_[0],
+ new CORBA::IDL::AnyType($_[0],
'value' => $_[1]
);
}
@@ -4195,7 +3720,7 @@ sub
sub
#line 837 "Parser20.yp"
{
- new StructType($_[0],
+ new CORBA::IDL::StructType($_[0],
'idf' => $_[2]
);
}
@@ -4232,7 +3757,7 @@ sub
sub
#line 866 "Parser20.yp"
{
- new Members($_[0],
+ new CORBA::IDL::Members($_[0],
'type' => $_[1],
'list_expr' => $_[2]
);
@@ -4299,7 +3824,7 @@ sub
sub
#line 916 "Parser20.yp"
{
- new UnionType($_[0],
+ new CORBA::IDL::UnionType($_[0],
'idf' => $_[2],
);
}
@@ -4330,7 +3855,7 @@ sub
sub
#line 939 "Parser20.yp"
{
- TypeDeclarator->Lookup($_[0], $_[1]);
+ CORBA::IDL::TypeDeclarator->Lookup($_[0], $_[1]);
}
],
[#Rule 161
@@ -4355,7 +3880,7 @@ sub
sub
#line 960 "Parser20.yp"
{
- new Case($_[0],
+ new CORBA::IDL::Case($_[0],
'list_label' => $_[1],
'element' => $_[2]
);
@@ -4410,7 +3935,7 @@ sub
sub
#line 998 "Parser20.yp"
{
- new Default($_[0]);
+ new CORBA::IDL::Default($_[0]);
}
],
[#Rule 170
@@ -4420,7 +3945,7 @@ sub
{
$_[0]->Error("':' expected.\n");
$_[0]->YYErrok();