diff options
Diffstat (limited to 'source4/pidl/lib/Parse/Pidl')
| -rw-r--r-- | source4/pidl/lib/Parse/Pidl/Compat.pm | 8 | ||||
| -rw-r--r-- | source4/pidl/lib/Parse/Pidl/NDR.pm | 49 | ||||
| -rw-r--r-- | source4/pidl/lib/Parse/Pidl/Samba3/ClientNDR.pm | 3 | ||||
| -rw-r--r-- | source4/pidl/lib/Parse/Pidl/Samba3/ServerNDR.pm | 3 | ||||
| -rw-r--r-- | source4/pidl/lib/Parse/Pidl/Samba4/TDR.pm | 2 | ||||
| -rw-r--r-- | source4/pidl/lib/Parse/Pidl/Wireshark/Conformance.pm | 29 | ||||
| -rw-r--r-- | source4/pidl/lib/Parse/Pidl/Wireshark/NDR.pm | 27 |
7 files changed, 49 insertions, 72 deletions
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"); } } } |