signbit detection (was [perl #39875] -0.0 loses signedness upon numeric comparison)
[perl.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';
25 die "overload.h: $!" unless open(H, ">overload.h");
26 binmode H;
27 select H;
28 print <<'EOF';
29 /* -*- buffer-read-only: t -*-
30  *
31  *    overload.h
32  *
33  *    Copyright (C) 1997, 1998, 2000, 2001, 2005, 2006, 2007 by Larry Wall
34  *    and others
35  *
36  *    You may distribute under the terms of either the GNU General Public
37  *    License or the Artistic License, as specified in the README file.
38  *
39  *  !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
40  *  This file is built by overload.pl
41  */
42
43 enum {
44 EOF
45
46 print "    ${_}_amg,\n", foreach @enums;
47
48 print <<'EOF';
49     max_amg_code
50     /* Do not leave a trailing comma here.  C9X allows it, C89 doesn't. */
51 };
52
53
54 #define NofAMmeth max_amg_code
55 #define AMG_id2name(id) (PL_AMG_names[id]+1)
56
57 #ifdef DOINIT
58 EXTCONST char * const PL_AMG_names[NofAMmeth] = {
59   /* Names kept in the symbol table.  fallback => "()", the rest has
60      "(" prepended.  The only other place in perl which knows about
61      this convention is AMG_id2name (used for debugging output and
62      'nomethod' only), the only other place which has it hardwired is
63      overload.pm.  */
64 EOF
65
66 my $last = pop @names;
67 print "    \"$_\",\n" foreach map { s/(["\\"])/\\$1/g; $_ } @names;
68
69 print <<"EOT";
70     "$last"
71 };
72 #else
73 EXTCONST char * PL_AMG_names[NofAMmeth];
74 #endif /* def INITAMAGIC */
75 EOT
76
77 close H or die $!;
78
79 __DATA__
80 # Fallback should be the first
81 fallback        ()
82
83 # These 5 are the most common in the fallback switch statement in amagic_call
84 to_sv           (${}
85 to_av           (@{}
86 to_hv           (%{}
87 to_gv           (*{}
88 to_cv           (&{}
89
90 # These have non-default cases in that switch statement
91 inc             (++
92 dec             (--
93 bool_           (bool
94 numer           (0+
95 string          (""
96 not             (!
97 copy            (=
98 abs             (abs
99 neg             (neg
100 iter            (<>
101 int             (int
102
103 # These 12 feature in the next switch statement
104 lt              (<
105 le              (<=
106 gt              (>
107 ge              (>=
108 eq              (==
109 ne              (!=
110 slt             (lt
111 sle             (le
112 sgt             (gt
113 sge             (ge
114 seq             (eq
115 sne             (ne
116
117 nomethod        (nomethod
118 add             (+
119 add_ass         (+=
120 subtr           (-
121 subtr_ass       (-=
122 mult            (*
123 mult_ass        (*=
124 div             (/
125 div_ass         (/=
126 modulo          (%
127 modulo_ass      (%=
128 pow             (**
129 pow_ass         (**=
130 lshift          (<<
131 lshift_ass      (<<=
132 rshift          (>>
133 rshift_ass      (>>=
134 band            (&
135 band_ass        (&=
136 bor             (|
137 bor_ass         (|=
138 bxor            (^
139 bxor_ass        (^=
140 ncmp            (<=>
141 scmp            (cmp
142 compl           (~
143 atan2           (atan2
144 cos             (cos
145 sin             (sin
146 exp             (exp
147 log             (log
148 sqrt            (sqrt
149 repeat          (x
150 repeat_ass      (x=
151 concat          (.
152 concat_ass      (.=
153 smart           (~~
154 # Note: Perl_Gv_AMupdate() assumes that DESTROY is the last entry
155 DESTROY         DESTROY