X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/8c798f879fd93d8d52542fe5d6d63725e8005251..6797b0fef2e51d44193184687a5343e7bd3b5874:/overload.pl?ds=sidebyside

diff --git a/overload.pl b/overload.pl
index 1bddd3f..1c9a0b3 100644
--- a/overload.pl
+++ b/overload.pl
@@ -1,9 +1,18 @@
 #!/usr/bin/perl -w
-
 #
-# Generate overload.h
+# Regenerate (overwriting only if changed):
+#
+#    overload.h
+#    overload.c
+#    lib/overload/numbers.pm
+#
+# from information stored in the DATA section of this file.
+#
 # This allows the order of overloading constants to be changed.
-# 
+#
+# Accepts the standard regen_lib -q and -v args.
+#
+# This script is normally invoked from regen.pl.
 
 BEGIN {
     # Get function prototypes
@@ -21,17 +30,58 @@ while (<DATA>) {
   push @names, $name;
 }
 
-safer_unlink 'overload.h';
-die "overload.h: $!" unless open(H, ">overload.h");
-binmode H;
-select H;
-print <<'EOF';
+safer_unlink ('lib/overload/numbers.pm');
+my $c = safer_open("overload.c-new");
+my $h = safer_open("overload.h-new");
+mkdir("lib/overload", 0777) unless -d 'lib/overload';
+my $p = safer_open('lib/overload/numbers.pm');
+
+
+select $p;
+
+{
+local $" = "\n    ";
+print <<"EOF";
+# -*- buffer-read-only: t -*-
+#
+#   lib/overload/numbers.pm
+#
+#   Copyright (C) 2008 by Larry Wall and others
+#
+#   You may distribute under the terms of either the GNU General Public
+#   License or the Artistic License, as specified in the README file.
+#
+# !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
+# This file is built by overload.pl
+#
+
+package overload::numbers;
+
+our \@names = qw#
+    @names
+#;
+
+our \@enums = qw#
+    @enums
+#;
+
+{ my \$i = 0; our %names = map { \$_ => \$i++ } \@names }
+
+{ my \$i = 0; our %enums = map { \$_ => \$i++ } \@enums }
+
+EOF
+}
+
+
+sub print_header {
+  my $file = shift;
+  print <<"EOF";
 /* -*- buffer-read-only: t -*-
  *
- *    overload.h
+ *    $file
  *
- *    Copyright (C) 1997, 1998, 2000, 2001, 2005 and 2006 by Larry Wall and
- *    others
+ *    Copyright (C) 1997, 1998, 2000, 2001, 2005, 2006, 2007 by Larry Wall
+ *    and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -39,42 +89,67 @@ print <<'EOF';
  *  !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
  *  This file is built by overload.pl
  */
+EOF
+}
+
+select $c;
+print_header('overload.c');
+
+select $h;
+print_header('overload.h');
+print <<'EOF';
 
 enum {
 EOF
 
-print "    ${_}_amg,\n", foreach @enums;
+print map "    ${_}_amg,\n", @enums;
 
 print <<'EOF';
     max_amg_code
     /* Do not leave a trailing comma here.  C9X allows it, C89 doesn't. */
 };
 
-
 #define NofAMmeth max_amg_code
+
+EOF
+
+print $c <<'EOF';
+
 #define AMG_id2name(id) (PL_AMG_names[id]+1)
+#define AMG_id2namelen(id) (PL_AMG_namelens[id]-1)
+
+static const U8 PL_AMG_namelens[NofAMmeth] = {
+EOF
+
+my $last = pop @names;
+
+print $c map { "    " . (length $_) . ",\n" } @names;
 
-#ifdef DOINIT
-EXTCONST char * const PL_AMG_names[NofAMmeth] = {
+my $lastlen = length $last;
+print $c <<"EOT";
+    $lastlen
+};
+
+static const char * const PL_AMG_names[NofAMmeth] = {
   /* Names kept in the symbol table.  fallback => "()", the rest has
      "(" prepended.  The only other place in perl which knows about
      this convention is AMG_id2name (used for debugging output and
      'nomethod' only), the only other place which has it hardwired is
      overload.pm.  */
-EOF
+EOT
 
-my $last = pop @names;
-print "    \"$_\",\n" foreach map { s/(["\\"])/\\$1/g; $_ } @names;
+print $c map { s/(["\\"])/\\$1/g; "    \"$_\",\n" } @names;
 
-print <<"EOT";
+print $c <<"EOT";
     "$last"
 };
-#else
-EXTCONST char * PL_AMG_names[NofAMmeth];
-#endif /* def INITAMAGIC */
 EOT
 
-close H or die $!;
+safer_close($h);
+safer_close($c);
+safer_close($p);
+rename_if_different("overload.c-new", "overload.c");
+rename_if_different("overload.h-new","overload.h");
 
 __DATA__
 # Fallback should be the first
@@ -151,5 +226,7 @@ repeat_ass	(x=
 concat		(.
 concat_ass	(.=
 smart		(~~
+ftest           (-X
+regexp          (qr
 # Note: Perl_Gv_AMupdate() assumes that DESTROY is the last entry
 DESTROY		DESTROY