Improve and restructure t/op/pat.t and split out some unicode related tests into...
[p5sagit/p5-mst-13.2.git] / overload.pl
1 #!/usr/bin/perl -w
2
3 #
4 # Generate overload.h
5 # This allows the order of overloading constants to be changed.
6
7
8 BEGIN {
9     # Get function prototypes
10     require 'regen_lib.pl';
11 }
12
13 use strict;
14
15 my (@enums, @names);
16 while (<DATA>) {
17   next if /^#/;
18   next if /^$/;
19   my ($enum, $name) = /^(\S+)\s+(\S+)/ or die "Can't parse $_";
20   push @enums, $enum;
21   push @names, $name;
22 }
23
24 safer_unlink ('overload.h', 'overload.c');
25 my $c = safer_open("overload.c");
26 my $h = safer_open("overload.h");
27
28 sub print_header {
29   my $file = shift;
30   print <<"EOF";
31 /* -*- buffer-read-only: t -*-
32  *
33  *    $file
34  *
35  *    Copyright (C) 1997, 1998, 2000, 2001, 2005, 2006, 2007 by Larry Wall
36  *    and others
37  *
38  *    You may distribute under the terms of either the GNU General Public
39  *    License or the Artistic License, as specified in the README file.
40  *
41  *  !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
42  *  This file is built by overload.pl
43  */
44 EOF
45 }
46
47 select $c;
48 print_header('overload.c');
49
50 select $h;
51 print_header('overload.h');
52 print <<'EOF';
53
54 enum {
55 EOF
56
57 print "    ${_}_amg,\n", foreach @enums;
58
59 print <<'EOF';
60     max_amg_code
61     /* Do not leave a trailing comma here.  C9X allows it, C89 doesn't. */
62 };
63
64 #define NofAMmeth max_amg_code
65
66 EOF
67
68 print $c <<'EOF';
69
70 #define AMG_id2name(id) (PL_AMG_names[id]+1)
71 #define AMG_id2namelen(id) (PL_AMG_namelens[id]-1)
72
73 static const U8 PL_AMG_namelens[NofAMmeth] = {
74 EOF
75
76 my $last = pop @names;
77
78 print $c "    $_,\n" foreach map { length $_ } @names;
79
80 my $lastlen = length $last;
81 print $c <<"EOT";
82     $lastlen
83 };
84
85 static const char * const PL_AMG_names[NofAMmeth] = {
86   /* Names kept in the symbol table.  fallback => "()", the rest has
87      "(" prepended.  The only other place in perl which knows about
88      this convention is AMG_id2name (used for debugging output and
89      'nomethod' only), the only other place which has it hardwired is
90      overload.pm.  */
91 EOT
92
93 print $c "    \"$_\",\n" foreach map { s/(["\\"])/\\$1/g; $_ } @names;
94
95 print $c <<"EOT";
96     "$last"
97 };
98 EOT
99
100 safer_close($h);
101 safer_close($c);
102
103 __DATA__
104 # Fallback should be the first
105 fallback        ()
106
107 # These 5 are the most common in the fallback switch statement in amagic_call
108 to_sv           (${}
109 to_av           (@{}
110 to_hv           (%{}
111 to_gv           (*{}
112 to_cv           (&{}
113
114 # These have non-default cases in that switch statement
115 inc             (++
116 dec             (--
117 bool_           (bool
118 numer           (0+
119 string          (""
120 not             (!
121 copy            (=
122 abs             (abs
123 neg             (neg
124 iter            (<>
125 int             (int
126
127 # These 12 feature in the next switch statement
128 lt              (<
129 le              (<=
130 gt              (>
131 ge              (>=
132 eq              (==
133 ne              (!=
134 slt             (lt
135 sle             (le
136 sgt             (gt
137 sge             (ge
138 seq             (eq
139 sne             (ne
140
141 nomethod        (nomethod
142 add             (+
143 add_ass         (+=
144 subtr           (-
145 subtr_ass       (-=
146 mult            (*
147 mult_ass        (*=
148 div             (/
149 div_ass         (/=
150 modulo          (%
151 modulo_ass      (%=
152 pow             (**
153 pow_ass         (**=
154 lshift          (<<
155 lshift_ass      (<<=
156 rshift          (>>
157 rshift_ass      (>>=
158 band            (&
159 band_ass        (&=
160 bor             (|
161 bor_ass         (|=
162 bxor            (^
163 bxor_ass        (^=
164 ncmp            (<=>
165 scmp            (cmp
166 compl           (~
167 atan2           (atan2
168 cos             (cos
169 sin             (sin
170 exp             (exp
171 log             (log
172 sqrt            (sqrt
173 repeat          (x
174 repeat_ass      (x=
175 concat          (.
176 concat_ass      (.=
177 smart           (~~
178 # Note: Perl_Gv_AMupdate() assumes that DESTROY is the last entry
179 DESTROY         DESTROY