Fix assertion triggered by 13be902ce ([perl #77362] glob-to-lv assign)

[perl5.git] / writemain.SH

diff --git a/writemain.SH b/writemain.SH
old mode 100644 (file)
new mode 100755 (executable)
index ea8aeab..ac1c5aa
--- a/writemain.SH
+++ b/writemain.SH
@@ -1,4 +1,4 @@
-case $CONFIG in
+case $PERL_CONFIG_SH in
 '')
        if test -f config.sh; then TOP=.;
        elif test -f ../config.sh; then TOP=..;
@@ -21,35 +21,88 @@ echo "Extracting writemain (with variable substitutions)"
 : Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!.
 : Protect any dollar signs and backticks that you do not want interpreted
 : by putting a backslash in front.  You may delete these comments.
+rm -f writemain
 $spitshell >writemain <<!GROK!THIS!
 $startsh
 !GROK!THIS!
 
 : In the following dollars and backticks do not need the extra backslash.
 $spitshell >>writemain <<'!NO!SUBS!'
-: This script takes the plain miniperlmain.c and writes out perlmain.c
-: which includes all the extensions.
-: The command line arguments name extensions to be used.
-:  E.g.:  sh writemain SDBM_File POSIX > perlmain.c
-:
-args="$*"
-if test X"$args" = "X" ; then
-    cat miniperlmain.c
-else
-    sed '/Do not delete this line--writemain depends on it/q' miniperlmain.c
-    cat << 'EOP'
-
-#ifdef USE_DYNAMIC_LOADING
-    boot_DynamicLoader();
-#endif
+# This script takes the plain miniperlmain.c and writes out perlmain.c
+# which includes all the extensions.
+# The command line arguments name extensions to be used.
+#  E.g.:  sh writemain SDBM_File POSIX > perlmain.c
+#
 
+orig="$*"
+args=''
+: Remove any .a suffixes and any leading path components
+for file in $orig ; do
+        case "$file" in
+           *.a)  file=`echo $file | sed 's/\.a//g'`;;
+           *.o)  file=`echo $file | sed 's/\.o//g'`;;
+        esac
+       case "$file" in
+       ext/*)  file=`echo $file | sed 's:ext/\(.*\)/[^/]*:\1:'`
+               ;;
+       lib/auto/*)     file=`echo $file | sed 's:lib/auto/\(.*\)/[^/]*:\1:'`
+               ;;
+       */*)
+               file=`expr X$file : 'X.*/\(.*\)'`
+               ;;
+       esac
+       args="$args $file"
+done
+
+
+sed '/Do not delete this line--writemain depends on it/q' miniperlmain.c
+
+
+if test X"$args" != "X" ; then
+    for ext in $args ; do
+: $ext will either be 'Name' or 'Name1/Name2' etc
+: convert ext into cname and mname
+mname=`echo $ext   | sed 's!/!::!g'`
+cname=`echo $mname | sed 's!:!_!g'`
+
+echo "EXTERN_C void boot_${cname} (pTHX_ CV* cv);"
+    done
+fi
+
+cat << 'EOP'
+
+static void
+xs_init(pTHX)
+{
 EOP
-    for ext in $args; do
-       echo "    newXSUB(\"${ext}::bootstrap\", 0, boot_${ext}, file);"
+
+if test X"$args" != "X" ; then
+    echo "    static const char file[] = __FILE__;"
+    echo "    dXSUB_SYS;"
+
+    ai=''
+
+    for ext in $args ; do
+
+       : $ext will either be 'Name' or 'Name1/Name2' etc
+       : convert ext into cname and mname
+       mname=`echo $ext   | sed 's!/!::!g'`
+       cname=`echo $mname | sed 's!:!_!g'`
+
+       if test "$ext" = "DynaLoader"; then
+           : Must NOT install 'DynaLoader::boot_DynaLoader' as 'bootstrap'!
+           : boot_DynaLoader is called directly in DynaLoader.pm
+           echo "        newXS(\"${mname}::boot_${ext}\", boot_${cname}, file);"
+       else
+           echo "        newXS(\"${mname}::bootstrap\", boot_${cname}, file);"
+       fi
     done
-    echo '}'
 fi
 
+cat << 'EOP'
+}
+EOP
+
 !NO!SUBS!
 chmod 755 writemain
 $eunicefix writemain