3 # Regenerate (overwriting only if changed):
7 # lib/overload/numbers.pm
9 # from information stored in the DATA section of this file.
11 # This allows the order of overloading constants to be changed.
13 # Accepts the standard regen_lib -q and -v args.
15 # This script is normally invoked from regen.pl.
18 # Get function prototypes
19 require 'regen/regen_lib.pl';
28 my ($enum, $name) = /^(\S+)\s+(\S+)/ or die "Can't parse $_";
33 my $c = safer_open("overload.c-new");
34 my $h = safer_open("overload.h-new");
35 mkdir("lib/overload", 0777) unless -d 'lib/overload';
36 my $p = safer_open('lib/overload/numbers.pm-new');
41 print read_only_top(lang => 'Perl', by => 'regen/overload.pl',
42 file => 'lib/overload/numbers.pm', copyright => [2008]);
47 package overload::numbers;
57 { my \$i = 0; our %names = map { \$_ => \$i++ } \@names }
59 { my \$i = 0; our %enums = map { \$_ => \$i++ } \@enums }
64 for ([$c, 'overload.c'], [$h, 'overload.h']) {
65 my ($handle, $file) = @$_;
66 print $handle read_only_top(lang => 'C', by => 'regen/overload.pl',
67 file => $file, style => '*',
68 copyright => [1997, 1998, 2000, 2001,
77 $op = 'fallback' if $op eq '()';
80 my $l = 3 - int((length($enums[$_]) + 9) / 8);
82 printf " %s_amg,%s/* 0x%02x %-8s */\n", $enums[$_],
88 /* Do not leave a trailing comma here. C9X allows it, C89 doesn't. */
91 #define NofAMmeth max_amg_code
96 #define AMG_id2name(id) (PL_AMG_names[id]+1)
97 #define AMG_id2namelen(id) (PL_AMG_namelens[id]-1)
99 static const U8 PL_AMG_namelens[NofAMmeth] = {
102 my $last = pop @names;
104 print $c map { " " . (length $_) . ",\n" } @names;
106 my $lastlen = length $last;
111 static const char * const PL_AMG_names[NofAMmeth] = {
112 /* Names kept in the symbol table. fallback => "()", the rest has
113 "(" prepended. The only other place in perl which knows about
114 this convention is AMG_id2name (used for debugging output and
115 'nomethod' only), the only other place which has it hardwired is
121 $n =~ s/(["\\])/\\$1/g;
122 my $l = 3 - int((length($n) + 7) / 8);
124 printf $c " \"%s\",%s/* %-10s */\n", $n, ("\t" x $l), $enums[$_];
135 rename_if_different("overload.c-new", "overload.c");
136 rename_if_different("overload.h-new","overload.h");
137 rename_if_different('lib/overload/numbers.pm-new', 'lib/overload/numbers.pm');
140 # Fallback should be the first
143 # These 5 are the most common in the fallback switch statement in amagic_call
150 # These have non-default cases in that switch statement
163 # These 12 feature in the next switch statement
216 # Note: Perl_Gv_AMupdate() assumes that DESTROY is the last entry