summaryrefslogtreecommitdiff
path: root/source4/pidl
diff options
context:
space:
mode:
Diffstat (limited to 'source4/pidl')
-rw-r--r--source4/pidl/lib/Parse/Pidl.pm22
-rw-r--r--source4/pidl/lib/Parse/Pidl/Compat.pm8
-rw-r--r--source4/pidl/lib/Parse/Pidl/NDR.pm49
-rw-r--r--source4/pidl/lib/Parse/Pidl/Samba3/ClientNDR.pm3
-rw-r--r--source4/pidl/lib/Parse/Pidl/Samba3/ServerNDR.pm3
-rw-r--r--source4/pidl/lib/Parse/Pidl/Samba4/TDR.pm2
-rw-r--r--source4/pidl/lib/Parse/Pidl/Wireshark/Conformance.pm29
-rw-r--r--source4/pidl/lib/Parse/Pidl/Wireshark/NDR.pm27
8 files changed, 71 insertions, 72 deletions
diff --git a/source4/pidl/lib/Parse/Pidl.pm b/source4/pidl/lib/Parse/Pidl.pm
index c60fc59aba..249bcd9f20 100644
--- a/source4/pidl/lib/Parse/Pidl.pm
+++ b/source4/pidl/lib/Parse/Pidl.pm
@@ -7,10 +7,32 @@
package Parse::Pidl;
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(warning error fatal);
+
use strict;
use vars qw ( $VERSION );
$VERSION = '0.02';
+sub warning($$)
+{
+ my ($l,$m) = @_;
+ print STDERR "$l->{FILE}:$l->{LINE}: warning: $m\n";
+}
+
+sub error($$)
+{
+ my ($l,$m) = @_;
+ print STDERR "$l->{FILE}:$l->{LINE}: error: $m\n";
+}
+
+sub fatal($$)
+{
+ my ($e,$s) = @_;
+ die("$e->{FILE}:$e->{LINE}: $s\n");
+}
+
1;
diff --git a/source4/pidl/lib/Parse/Pidl/Compat.pm b/source4/pidl/lib/Parse/Pidl/Compat.pm
index 944193ac1b..f1241ef341 100644
--- a/source4/pidl/lib/Parse/Pidl/Compat.pm
+++ b/source4/pidl/lib/Parse/Pidl/Compat.pm
@@ -5,6 +5,7 @@
package Parse::Pidl::Compat;
+use Parse::Pidl qw(warning);
use Parse::Pidl::Util qw(has_property);
use strict;
@@ -74,13 +75,6 @@ my %supported_properties = (
"length_is" => ["ELEMENT"],
);
-sub warning($$)
-{
- my ($l,$m) = @_;
-
- print STDERR "$l->{FILE}:$l->{LINE}:warning:$m\n";
-}
-
sub CheckTypedef($)
{
my ($td) = @_;
diff --git a/source4/pidl/lib/Parse/Pidl/NDR.pm b/source4/pidl/lib/Parse/Pidl/NDR.pm
index 9670e05744..f8cae5665f 100644
--- a/source4/pidl/lib/Parse/Pidl/NDR.pm
+++ b/source4/pidl/lib/Parse/Pidl/NDR.pm
@@ -37,6 +37,7 @@ $VERSION = '0.01';
@EXPORT = qw(GetPrevLevel GetNextLevel ContainsDeferred ContainsString);
use strict;
+use Parse::Pidl qw(warning fatal);
use Parse::Pidl::Typelist qw(hasType getType expandAlias);
use Parse::Pidl::Util qw(has_property property_matches);
@@ -70,20 +71,6 @@ my $scalar_alignment = {
'ipv4address' => 4
};
-sub nonfatal($$)
-{
- my ($e,$s) = @_;
- warn ("$e->{FILE}:$e->{LINE}: warning: $s\n");
-}
-
-#####################################################################
-# signal a fatal validation error
-sub fatal($$)
-{
- my ($pos,$s) = @_;
- die("$pos->{FILE}:$pos->{LINE}:$s\n");
-}
-
sub GetElementLevelTable($)
{
my $e = shift;
@@ -113,7 +100,7 @@ sub GetElementLevelTable($)
if (has_property($e, "string")) { $needptrs++; }
if ($#bracket_array >= 0) { $needptrs = 0; }
- nonfatal($e, "[out] argument `$e->{NAME}' not a pointer") if ($needptrs > $e->{POINTERS});
+ warning($e, "[out] argument `$e->{NAME}' not a pointer") if ($needptrs > $e->{POINTERS});
}
# Parse the [][][][] style array stuff
@@ -181,7 +168,7 @@ sub GetElementLevelTable($)
LEVEL => $level
});
- nonfatal($e, "top-level \[out\] pointer `$e->{NAME}' is not a \[ref\] pointer")
+ warning($e, "top-level \[out\] pointer `$e->{NAME}' is not a \[ref\] pointer")
if ($i == 1 and pointer_type($e) ne "ref" and
$e->{PARENT}->{TYPE} eq "FUNCTION" and
not has_property($e, "in"));
@@ -256,15 +243,15 @@ sub GetElementLevelTable($)
}
if (scalar(@size_is) > 0) {
- nonfatal($e, "size_is() on non-array element");
+ warning($e, "size_is() on non-array element");
}
if (scalar(@length_is) > 0) {
- nonfatal($e, "length_is() on non-array element");
+ warning($e, "length_is() on non-array element");
}
if (has_property($e, "string")) {
- nonfatal($e, "string() attribute on non-array element");
+ warning($e, "string() attribute on non-array element");
}
push (@$order, {
@@ -608,7 +595,7 @@ sub ParseInterface($)
if (not has_property($idl, "pointer_default_top")) {
$idl->{PROPERTIES}->{pointer_default_top} = "ref";
} else {
- nonfatal($idl, "pointer_default_top() is a pidl extension and should not be used");
+ warning($idl, "pointer_default_top() is a pidl extension and should not be used");
}
foreach my $d (@{$idl->{DATA}}) {
@@ -850,10 +837,10 @@ sub ValidProperties($$)
return unless defined $e->{PROPERTIES};
foreach my $key (keys %{$e->{PROPERTIES}}) {
- fatal($e, el_name($e) . ": unknown property '$key'\n")
+ fatal($e, el_name($e) . ": unknown property '$key'")
unless defined($property_list{$key});
- fatal($e, el_name($e) . ": property '$key' not allowed on '$t'\n")
+ fatal($e, el_name($e) . ": property '$key' not allowed on '$t'")
unless grep($t, @{$property_list{$key}});
}
}
@@ -909,7 +896,7 @@ sub ValidElement($)
}
if ($t1 ne $t2) {
- nonfatal($e, el_name($e) . ": switch_is() is of type $e2->{TYPE} ($t2), while discriminator type for union $type->{NAME} is $discriminator_type ($t1)");
+ warning($e, el_name($e) . ": switch_is() is of type $e2->{TYPE} ($t2), while discriminator type for union $type->{NAME} is $discriminator_type ($t1)");
}
}
}
@@ -979,12 +966,12 @@ sub ValidUnion($)
if (defined($e->{PROPERTIES}->{default}) and
defined($e->{PROPERTIES}->{case})) {
- fatal $e, "Union member $e->{NAME} can not have both default and case properties!\n";
+ fatal($e, "Union member $e->{NAME} can not have both default and case properties!");
}
unless (defined ($e->{PROPERTIES}->{default}) or
defined ($e->{PROPERTIES}->{case})) {
- fatal $e, "Union member $e->{NAME} must have default or case property\n";
+ fatal($e, "Union member $e->{NAME} must have default or case property");
}
if (has_property($e, "ref")) {
@@ -1029,7 +1016,7 @@ sub ValidFunction($)
foreach my $e (@{$fn->{ELEMENTS}}) {
$e->{PARENT} = $fn;
if (has_property($e, "ref") && !$e->{POINTERS}) {
- fatal $e, "[ref] variables must be pointers ($fn->{NAME}/$e->{NAME})\n";
+ fatal($e, "[ref] variables must be pointers ($fn->{NAME}/$e->{NAME})");
}
ValidElement($e);
}
@@ -1043,7 +1030,7 @@ sub ValidInterface($)
my($data) = $interface->{DATA};
if (has_property($interface, "helper")) {
- nonfatal $interface, "helper() is pidl-specific and deprecated. Use `include' instead";
+ warning($interface, "helper() is pidl-specific and deprecated. Use `include' instead");
}
ValidProperties($interface,"INTERFACE");
@@ -1051,19 +1038,19 @@ sub ValidInterface($)
if (has_property($interface, "pointer_default")) {
if (not grep (/$interface->{PROPERTIES}->{pointer_default}/,
("ref", "unique", "ptr"))) {
- fatal $interface, "Unknown default pointer type `$interface->{PROPERTIES}->{pointer_default}'";
+ fatal($interface, "Unknown default pointer type `$interface->{PROPERTIES}->{pointer_default}'");
}
}
if (has_property($interface, "object")) {
if (has_property($interface, "version") &&
$interface->{PROPERTIES}->{version} != 0) {
- fatal $interface, "Object interfaces must have version 0.0 ($interface->{NAME})\n";
+ fatal($interface, "Object interfaces must have version 0.0 ($interface->{NAME})");
}
if (!defined($interface->{BASE}) &&
not ($interface->{NAME} eq "IUnknown")) {
- fatal $interface, "Object interfaces must all derive from IUnknown ($interface->{NAME})\n";
+ fatal($interface, "Object interfaces must all derive from IUnknown ($interface->{NAME})");
}
}
@@ -1086,7 +1073,7 @@ sub Validate($)
($x->{TYPE} eq "INTERFACE") &&
ValidInterface($x);
($x->{TYPE} eq "IMPORTLIB") &&
- nonfatal($x, "importlib() not supported");
+ warning($x, "importlib() not supported");
}
}
diff --git a/source4/pidl/lib/Parse/Pidl/Samba3/ClientNDR.pm b/source4/pidl/lib/Parse/Pidl/Samba3/ClientNDR.pm
index 6cfab753e9..5c88e3d22f 100644
--- a/source4/pidl/lib/Parse/Pidl/Samba3/ClientNDR.pm
+++ b/source4/pidl/lib/Parse/Pidl/Samba3/ClientNDR.pm
@@ -7,6 +7,7 @@
package Parse::Pidl::Samba3::ClientNDR;
use strict;
+use Parse::Pidl qw(fatal warning);
use Parse::Pidl::Typelist qw(hasType getType mapType scalar_is_reference);
use Parse::Pidl::Util qw(has_property ParseExpr is_constant);
use Parse::Pidl::NDR qw(GetPrevLevel GetNextLevel ContainsDeferred);
@@ -22,8 +23,6 @@ sub indent() { $tabs.="\t"; }
sub deindent() { $tabs = substr($tabs, 1); }
sub pidl($) { $res .= $tabs.(shift)."\n"; }
sub pidl_hdr($) { $res_hdr .= (shift)."\n"; }
-sub fatal($$) { my ($e,$s) = @_; die("$e->{ORIGINAL}->{FILE}:$e->{ORIGINAL}->{LINE}: $s\n"); }
-sub warning($$) { my ($e,$s) = @_; warn("$e->{ORIGINAL}->{FILE}:$e->{ORIGINAL}->{LINE}: $s\n"); }
sub fn_declare($) { my ($n) = @_; pidl $n; pidl_hdr "$n;"; }
sub ParseFunction($$)
diff --git a/source4/pidl/lib/Parse/Pidl/Samba3/ServerNDR.pm b/source4/pidl/lib/Parse/Pidl/Samba3/ServerNDR.pm
index a7c81e4e2b..8d42b483ec 100644
--- a/source4/pidl/lib/Parse/Pidl/Samba3/ServerNDR.pm
+++ b/source4/pidl/lib/Parse/Pidl/Samba3/ServerNDR.pm
@@ -7,6 +7,7 @@
package Parse::Pidl::Samba3::ServerNDR;
use strict;
+use Parse::Pidl qw(warning fatal);
use Parse::Pidl::Typelist qw(hasType getType mapType scalar_is_reference);
use Parse::Pidl::Util qw(has_property ParseExpr is_constant);
use Parse::Pidl::NDR qw(GetPrevLevel GetNextLevel ContainsDeferred);
@@ -22,8 +23,6 @@ sub indent() { $tabs.="\t"; }
sub deindent() { $tabs = substr($tabs, 1); }
sub pidl($) { $res .= $tabs.(shift)."\n"; }
sub pidl_hdr($) { $res_hdr .= (shift)."\n"; }
-sub fatal($$) { my ($e,$s) = @_; die("$e->{ORIGINAL}->{FILE}:$e->{ORIGINAL}->{LINE}: $s\n"); }
-sub warning($$) { my ($e,$s) = @_; warn("$e->{ORIGINAL}->{FILE}:$e->{ORIGINAL}->{LINE}: $s\n"); }
sub fn_declare($) { my ($n) = @_; pidl $n; pidl_hdr "$n;"; }
sub AllocOutVar($$$$)
diff --git a/source4/pidl/lib/Parse/Pidl/Samba4/TDR.pm b/source4/pidl/lib/Parse/Pidl/Samba4/TDR.pm
index 592961dee2..bc8d27a283 100644
--- a/source4/pidl/lib/Parse/Pidl/Samba4/TDR.pm
+++ b/source4/pidl/lib/Parse/Pidl/Samba4/TDR.pm
@@ -4,6 +4,7 @@
# released under the GNU GPL
package Parse::Pidl::Samba4::TDR;
+use Parse::Pidl qw(fatal);
use Parse::Pidl::Util qw(has_property ParseExpr is_constant);
use Parse::Pidl::Samba4 qw(is_intree choose_header);
@@ -20,7 +21,6 @@ sub indent() { $tabs.="\t"; }
sub deindent() { $tabs = substr($tabs, 1); }
sub pidl($) { $ret .= $tabs.(shift)."\n"; }
sub pidl_hdr($) { $ret_hdr .= (shift)."\n"; }
-sub fatal($$) { my ($e,$s) = @_; die("$e->{FILE}:$e->{LINE}: $s\n"); }
sub typearg($) {
my $t = shift;
return(", const char *name") if ($t eq "print");
diff --git a/source4/pidl/lib/Parse/Pidl/Wireshark/Conformance.pm b/source4/pidl/lib/Parse/Pidl/Wireshark/Conformance.pm
index 163b3053f4..4ad60319a6 100644
--- a/source4/pidl/lib/Parse/Pidl/Wireshark/Conformance.pm
+++ b/source4/pidl/lib/Parse/Pidl/Wireshark/Conformance.pm
@@ -100,6 +100,7 @@ $VERSION = '0.01';
use strict;
+use Parse::Pidl qw(fatal warning error);
use Parse::Pidl::Util qw(has_property);
sub handle_type($$$$$$$$$$)
@@ -107,20 +108,20 @@ sub handle_type($$$$$$$$$$)
my ($pos,$data,$name,$dissectorname,$ft_type,$base_type,$mask,$valsstring,$alignment) = @_;
unless(defined($alignment)) {
- print "$pos: error incomplete TYPE command\n";
+ error($pos, "incomplete TYPE command");
return;
}
unless ($dissectorname =~ /.*dissect_.*/) {
- print "$pos: warning: dissector name does not contain `dissect'\n";
+ warning($pos, "dissector name does not contain `dissect'");
}
unless(valid_ft_type($ft_type)) {
- print "$pos: warning: invalid FT_TYPE `$ft_type'\n";
+ warning($pos, "invalid FT_TYPE `$ft_type'");
}
unless (valid_base_type($base_type)) {
- print "$pos: warning: invalid BASE_TYPE `$base_type'\n";
+ warning($pos, "invalid BASE_TYPE `$base_type'");
}
$data->{types}->{$name} = {
@@ -141,7 +142,7 @@ sub handle_tfs($$$$$)
my ($pos,$data,$hf,$trues,$falses) = @_;
unless(defined($falses)) {
- print "$pos: error: incomplete TFS command\n";
+ error($pos, "incomplete TFS command");
return;
}
@@ -156,7 +157,7 @@ sub handle_hf_rename($$$$)
my ($pos,$data,$old,$new) = @_;
unless(defined($new)) {
- print "$pos: error: incomplete HF_RENAME command\n";
+ error($pos, "incomplete HF_RENAME command");
return;
}
@@ -173,7 +174,7 @@ sub handle_param_value($$$$)
my ($pos,$data,$dissector_name,$value) = @_;
unless(defined($value)) {
- print "$pos: error: incomplete PARAM_VALUE command\n";
+ error($pos, "incomplete PARAM_VALUE command");
return;
}
@@ -204,16 +205,16 @@ sub handle_hf_field($$$$$$$$$$)
my ($pos,$data,$index,$name,$filter,$ft_type,$base_type,$valsstring,$mask,$blurb) = @_;
unless(defined($blurb)) {
- print "$pos: error: incomplete HF_FIELD command\n";
+ error($pos, "incomplete HF_FIELD command");
return;
}
unless(valid_ft_type($ft_type)) {
- print "$pos: warning: invalid FT_TYPE `$ft_type'\n";
+ warning($pos, "invalid FT_TYPE `$ft_type'");
}
unless(valid_base_type($base_type)) {
- print "$pos: warning: invalid BASE_TYPE `$base_type'\n";
+ warning($pos, "invalid BASE_TYPE `$base_type'");
}
$data->{header_fields}->{$index} = {
@@ -284,7 +285,7 @@ sub handle_import
my $dissectorname = shift @_;
unless(defined($dissectorname)) {
- print "$pos: error: no dissectorname specified\n";
+ error($pos, "no dissectorname specified");
return;
}
@@ -346,12 +347,14 @@ sub ReadConformance($$)
shift @fields;
+ my $pos = { FILE => $f, LINE => $ln };
+
if (not defined($field_handlers{$cmd})) {
- print "$f:$ln: warning: Unknown command `$cmd'\n";
+ warning($pos, "Unknown command `$cmd'");
next;
}
- $field_handlers{$cmd}("$f:$ln", $data, @fields);
+ $field_handlers{$cmd}($pos, $data, @fields);
}
close(IN);
diff --git a/source4/pidl/lib/Parse/Pidl/Wireshark/NDR.pm b/source4/pidl/lib/Parse/Pidl/Wireshark/NDR.pm
index 14b922353a..9526d76a37 100644
--- a/source4/pidl/lib/Parse/Pidl/Wireshark/NDR.pm
+++ b/source4/pidl/lib/Parse/Pidl/Wireshark/NDR.pm
@@ -17,6 +17,7 @@ Parse::Pidl::Wireshark::NDR - Parser generator for Wireshark
package Parse::Pidl::Wireshark::NDR;
use strict;
+use Parse::Pidl qw(error);
use Parse::Pidl::Typelist qw(getType);
use Parse::Pidl::Util qw(has_property ParseExpr property_matches make_str);
use Parse::Pidl::NDR qw(ContainsString GetNextLevel);
@@ -27,12 +28,6 @@ use File::Basename;
use vars qw($VERSION);
$VERSION = '0.01';
-sub error($$)
-{
- my ($e,$t) = @_;
- print "$e->{FILE}:$e->{LINE}: $t\n";
-}
-
my @ett;
my %hf_used = ();
@@ -441,10 +436,10 @@ sub Function($$$)
} elsif ($type->{DATA}->{TYPE} eq "SCALAR") {
pidl_code "g$fn->{RETURN_TYPE} status;\n";
} else {
- print "$fn->{FILE}:$fn->{LINE}: error: return type `$fn->{RETURN_TYPE}' not yet supported\n";
+ error($fn, "return type `$fn->{RETURN_TYPE}' not yet supported");
}
} else {
- print "$fn->{FILE}:$fn->{LINE}: error: unknown return type `$fn->{RETURN_TYPE}'\n";
+ error($fn, "unknown return type `$fn->{RETURN_TYPE}'");
}
foreach (@{$fn->{ELEMENTS}}) {
@@ -828,7 +823,7 @@ sub Initialize($)
header_fields=> {}
};
- ReadConformance($cnf_file, $conformance) or print "Warning: No conformance file `$cnf_file'\n";
+ ReadConformance($cnf_file, $conformance) or print STDERR "warning: No conformance file `$cnf_file'\n";
foreach my $bytes (qw(1 2 4 8)) {
my $bits = $bytes * 8;
@@ -1054,43 +1049,43 @@ sub CheckUsed($)
my $conformance = shift;
foreach (values %{$conformance->{header_fields}}) {
if (not defined($hf_used{$_->{INDEX}})) {
- print "$_->{POS}: warning: hf field `$_->{INDEX}' not used\n";
+ warning($_->{POS}, "hf field `$_->{INDEX}' not used");
}
}
foreach (values %{$conformance->{hf_renames}}) {
if (not $_->{USED}) {
- print "$_->{POS}: warning: hf field `$_->{OLDNAME}' not used\n";
+ warning($_->{POS}, "hf field `$_->{OLDNAME}' not used");
}
}
foreach (values %{$conformance->{dissectorparams}}) {
if (not $_->{USED}) {
- print "$_->{POS}: warning: dissector param never used\n";
+ warning($_->{POS}, "dissector param never used");
}
}
foreach (values %{$conformance->{imports}}) {
if (not $_->{USED}) {
- print "$_->{POS}: warning: import never used\n";
+ warning($_->{POS}, "import never used");
}
}
foreach (values %{$conformance->{types}}) {
if (not $_->{USED} and defined($_->{POS})) {
- print "$_->{POS}: warning: type never used\n";
+ warning($_->{POS}, "type never used");
}
}
foreach (values %{$conformance->{fielddescription}}) {
if (not $_->{USED}) {
- print "$_->{POS}: warning: description never used\n";
+ warning($_->{POS}, "description never used");
}
}
foreach (values %{$conformance->{tfs}}) {
if (not $_->{USED}) {
- print "$_->{POS}: warning: True/False description never used\n";
+ warning($_->{POS}, "True/False description never used");
}
}
}
generated by cgit (git 2.34.1) at 2024-11-09 17:57:02 +0000