source4/build/pidl/validator.pm

   1 ###################################################
   2 # check that a parsed IDL file is valid
   3 # Copyright tridge@samba.org 2003
   4 # released under the GNU GPL
   5
   6 package IdlValidator;
   7 use Data::Dumper;
   8
   9 use strict;
  10
  11 #####################################################################
  12 # signal a fatal validation error
  13 sub fatal($)
  14 {
  15         my $s = shift;
  16         print "$s\n";
  17         die "IDL is not valid\n";
  18 }
  19
  20 sub el_name($)
  21 {
  22         my $e = shift;
  23
  24         if ($e->{PARENT} && $e->{PARENT}->{NAME}) {
  25                 return "$e->{PARENT}->{NAME}.$e->{NAME}";
  26         }
  27
  28         if ($e->{PARENT} && $e->{PARENT}->{PARENT}->{NAME}) {
  29                 return "$e->{PARENT}->{PARENT}->{NAME}.$e->{NAME}";
  30         }
  31
  32         if ($e->{PARENT}) {
  33                 return "$e->{PARENT}->{NAME}.$e->{NAME}";
  34         }
  35         return $e->{NAME};
  36 }
  37
  38 #####################################################################
  39 # parse a struct
  40 sub ValidElement($)
  41 {
  42         my $e = shift;
  43         if ($e->{POINTERS} && $e->{POINTERS} > 1) {
  44                 fatal(el_name($e) . " : pidl cannot handle multiple pointer levels. Use a sub-structure containing a pointer instead\n");
  45         }
  46
  47         if ($e->{POINTERS} && $e->{ARRAY_LEN}) {
  48                 fatal(el_name($e) . " : pidl cannot handle pointers to arrays. Use a substructure instead\n");
  49         }
  50
  51         if (util::has_property($e, "ptr")) {
  52                 fatal(el_name($e) . " : pidl does not support full NDR pointers yet\n");
  53         }
  54
  55         if (!$e->{POINTERS} && (
  56                 util::has_property($e, "ptr") or
  57                 util::has_property($e, "unique") or
  58                 util::has_property($e, "relative") or
  59                 util::has_property($e, "ref"))) {
  60                 fatal(el_name($e) . " : pointer properties on non-pointer element\n");
  61         }
  62 }
  63
  64 #####################################################################
  65 # parse a struct
  66 sub ValidStruct($)
  67 {
  68         my($struct) = shift;
  69
  70         foreach my $e (@{$struct->{ELEMENTS}}) {
  71                 if (util::has_property($e, "ref")) {
  72                         fatal(el_name($e) . " : embedded ref pointers are not supported yet\n");
  73                 }
  74
  75                 $e->{PARENT} = $struct;
  76                 ValidElement($e);
  77         }
  78 }
  79
  80 #####################################################################
  81 # parse a union
  82 sub ValidUnion($)
  83 {
  84         my($union) = shift;
  85         foreach my $e (@{$union->{ELEMENTS}}) {
  86                 $e->{PARENT} = $union;
  87
  88                 if (defined($e->{PROPERTIES}->{default}) and
  89                         defined($e->{PROPERTIES}->{case})) {
  90                         fatal "Union member $e->{NAME} can not have both default and case properties!\n";
  91                 }
  92
  93                 unless (defined ($e->{PROPERTIES}->{default}) or
  94                                 defined ($e->{PROPERTIES}->{case})) {
  95                         fatal "Union member $e->{NAME} must have default or case property\n";
  96                 }
  97
  98                 if (util::has_property($e, "ref")) {
  99                         fatal(el_name($e) . " : embedded ref pointers are not supported yet\n");
 100                 }
 101
 102
 103                 ValidElement($e);
 104         }
 105 }
 106
 107 #####################################################################
 108 # parse a typedef
 109 sub ValidTypedef($)
 110 {
 111         my($typedef) = shift;
 112         my $data = $typedef->{DATA};
 113
 114         $data->{PARENT} = $typedef;
 115
 116         if (ref($data) eq "HASH") {
 117                 if ($data->{TYPE} eq "STRUCT") {
 118                         ValidStruct($data);
 119                 }
 120
 121                 if ($data->{TYPE} eq "UNION") {
 122                         ValidUnion($data);
 123                 }
 124         }
 125 }
 126
 127 #####################################################################
 128 # parse a function
 129 sub ValidFunction($)
 130 {
 131         my($fn) = shift;
 132
 133         foreach my $e (@{$fn->{ELEMENTS}}) {
 134                 $e->{PARENT} = $fn;
 135                 if (util::has_property($e, "ref") && !$e->{POINTERS}) {
 136                         fatal "[ref] variables must be pointers ($fn->{NAME}/$e->{NAME})\n";
 137                 }
 138                 ValidElement($e);
 139         }
 140 }
 141
 142 #####################################################################
 143 # parse the interface definitions
 144 sub ValidInterface($)
 145 {
 146         my($interface) = shift;
 147         my($data) = $interface->{DATA};
 148
 149         if (util::has_property($interface, "pointer_default") &&
 150                 $interface->{PROPERTIES}->{pointer_default} eq "ptr") {
 151                 fatal "Full pointers are not supported yet\n";
 152         }
 153
 154         if (util::has_property($interface, "object")) {
 155         if(util::has_property($interface, "version") &&
 156                         $interface->{PROPERTIES}->{version} != 0) {
 157                         fatal "Object interfaces must have version 0.0 ($interface->{NAME})\n";
 158                 }
 159
 160                 if(!defined($interface->{BASE}) &&
 161                         not ($interface->{NAME} eq "IUnknown")) {
 162                         fatal "Object interfaces must all derive from IUnknown ($interface->{NAME})\n";
 163                 }
 164         }
 165
 166         foreach my $d (@{$data}) {
 167                 ($d->{TYPE} eq "TYPEDEF") &&
 168                     ValidTypedef($d);
 169                 ($d->{TYPE} eq "FUNCTION") &&
 170                     ValidFunction($d);
 171         }
 172
 173 }
 174
 175 #####################################################################
 176 # parse a parsed IDL into a C header
 177 sub Validate($)
 178 {
 179         my($idl) = shift;
 180
 181         foreach my $x (@{$idl}) {
 182                 ($x->{TYPE} eq "INTERFACE") &&
 183                     ValidInterface($x);
 184         }
 185 }
 186
 187 1;