Make some fatal errors non-fatal. This means we generate invalid code in
[tprouty/samba.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 sub is_intree()
22 {
23         my $srcdir = $ENV{srcdir};
24         $srcdir = $srcdir ? "$srcdir/" : "";
25         return 4 if (-f "${srcdir}kdc/kdc.c");
26         return 3 if (-f "${srcdir}include/smb.h");
27         return 0;
28 }
29
30 # Return an #include line depending on whether this build is an in-tree
31 # build or not.
32 sub choose_header($$)
33 {
34         my ($in,$out) = @_;
35         return "#include \"$in\"" if (is_intree());
36         return "#include <$out>";
37 }
38
39 sub ArrayDynamicallyAllocated($$)
40 {
41         my ($e, $l) = @_;
42         die("Not an array") unless ($l->{TYPE} eq "ARRAY");
43         return 0 if ($l->{IS_FIXED} and not has_property($e, "charset"));
44         return 1;
45 }
46
47 sub NumStars($;$)
48 {
49         my ($e, $d) = @_;
50         $d = 0 unless defined($d);
51         my $n = 0;
52
53         foreach my $l (@{$e->{LEVELS}}) {
54                 next unless ($l->{TYPE} eq "POINTER");
55
56                 my $nl = GetNextLevel($e, $l);
57                 next if (defined($nl) and $nl->{TYPE} eq "ARRAY");
58
59                 $n++;
60         }
61
62         if ($n >= 1) {
63                 $n-- if (scalar_is_reference($e->{TYPE}));
64         }
65
66         foreach my $l (@{$e->{LEVELS}}) {
67                 next unless ($l->{TYPE} eq "ARRAY");
68                 next unless (ArrayDynamicallyAllocated($e, $l));
69                 $n++;
70         }
71
72         error($e->{ORIGINAL}, "Too few pointers $n < $d") if ($n < $d);
73
74         $n -= $d;
75
76         return $n;
77 }
78
79 sub ElementStars($;$)
80 {
81         my ($e, $d) = @_;
82         my $res = "";
83         my $n = 0;
84
85         $n = NumStars($e, $d);
86         $res .= "*" foreach (1..$n);
87
88         return $res;
89 }
90
91 sub ArrayBrackets($)
92 {
93         my ($e) = @_;
94         my $res = "";
95
96         foreach my $l (@{$e->{LEVELS}}) {
97                 next unless ($l->{TYPE} eq "ARRAY");
98                 next if ArrayDynamicallyAllocated($e, $l);
99                 $res .= "[$l->{SIZE_IS}]";
100         }
101
102         return $res;
103 }
104
105 sub DeclLong($)
106 {
107         my ($e) = shift;
108         my $res = "";
109
110         if (has_property($e, "represent_as")) {
111                 $res .= mapTypeName($e->{PROPERTIES}->{represent_as})." ";
112         } else {
113                 if (has_property($e, "charset")) {
114                         $res .= "const char ";
115                 } else {
116                         $res .= mapTypeName($e->{TYPE})." ";
117                 }
118
119                 $res .= ElementStars($e);
120         }
121         $res .= $e->{NAME};
122         $res .= ArrayBrackets($e);
123
124         return $res;
125 }
126
127 1;