pyldb: avoid segfault when adding an element with no name
[kai/samba-autobuild/.git] / pidl / lib / Parse / Pidl / Samba4.pm
1 ###################################################
2 # Common Samba4 functions
3 # Copyright jelmer@samba.org 2006
4 # released under the GNU GPL
5
6 package Parse::Pidl::Samba4;
7
8 require Exporter;
9 @ISA = qw(Exporter);
10 @EXPORT = qw(is_intree choose_header NumStars ElementStars ArrayBrackets DeclLong ArrayDynamicallyAllocated);
11
12 use Parse::Pidl::Util qw(has_property is_constant);
13 use Parse::Pidl::NDR qw(GetNextLevel);
14 use Parse::Pidl::Typelist qw(mapTypeName scalar_is_reference);
15 use Parse::Pidl qw(fatal error);
16 use strict;
17
18 use vars qw($VERSION);
19 $VERSION = '0.01';
20
21
22 # return true if we are using pidl within the samba source tree. This changes
23 # the names of include files, as some include files (such as ntstatus.h) have
24 # different paths when installed to the patch in the source tree
25 sub is_intree()
26 {
27         my $srcdir = $ENV{srcdir};
28         $srcdir = $srcdir ? "$srcdir/" : "";
29         return 1 if (-f "${srcdir}kdc/kdc.c");
30         return 1 if (-d "${srcdir}source4");
31         return 1 if (-f "${srcdir}include/smb.h");
32         return 0;
33 }
34
35 # Return an #include line depending on whether this build is an in-tree
36 # build or not.
37 sub choose_header($$)
38 {
39         my ($in,$out) = @_;
40         return "#include \"$in\"" if (is_intree());
41         return "#include <$out>";
42 }
43
44 sub ArrayDynamicallyAllocated($$)
45 {
46         my ($e, $l) = @_;
47         die("Not an array") unless ($l->{TYPE} eq "ARRAY");
48         return 0 if ($l->{IS_FIXED} and not has_property($e, "charset"));
49         return 1;
50 }
51
52 sub NumStars($;$)
53 {
54         my ($e, $d) = @_;
55         $d = 0 unless defined($d);
56         my $n = 0;
57
58         foreach my $l (@{$e->{LEVELS}}) {
59                 next unless ($l->{TYPE} eq "POINTER");
60
61                 my $nl = GetNextLevel($e, $l);
62                 next if (defined($nl) and $nl->{TYPE} eq "ARRAY");
63
64                 $n++;
65         }
66
67         if ($n >= 1) {
68                 $n-- if (scalar_is_reference($e->{TYPE}));
69         }
70
71         foreach my $l (@{$e->{LEVELS}}) {
72                 next unless ($l->{TYPE} eq "ARRAY");
73                 next unless (ArrayDynamicallyAllocated($e, $l));
74                 $n++;
75         }
76
77         error($e->{ORIGINAL}, "Too few pointers $n < $d") if ($n < $d);
78
79         $n -= $d;
80
81         return $n;
82 }
83
84 sub ElementStars($;$)
85 {
86         my ($e, $d) = @_;
87         my $res = "";
88         my $n = 0;
89
90         $n = NumStars($e, $d);
91         $res .= "*" foreach (1..$n);
92
93         return $res;
94 }
95
96 sub ArrayBrackets($)
97 {
98         my ($e) = @_;
99         my $res = "";
100
101         foreach my $l (@{$e->{LEVELS}}) {
102                 next unless ($l->{TYPE} eq "ARRAY");
103                 next if ArrayDynamicallyAllocated($e, $l);
104                 $res .= "[$l->{SIZE_IS}]";
105         }
106
107         return $res;
108 }
109
110 sub DeclLong($;$)
111 {
112         my ($e, $p) = @_;
113         my $res = "";
114         $p = "" unless defined($p);
115
116         if (has_property($e, "represent_as")) {
117                 $res .= mapTypeName($e->{PROPERTIES}->{represent_as})." ";
118         } else {
119                 if (has_property($e, "charset")) {
120                         $res .= "const char ";
121                 } else {
122                         $res .= mapTypeName($e->{TYPE})." ";
123                 }
124
125                 $res .= ElementStars($e);
126         }
127         $res .= $p.$e->{NAME};
128         $res .= ArrayBrackets($e);
129
130         return $res;
131 }
132
133 1;