diff options
262 files changed, 14895 insertions, 8761 deletions
diff --git a/bootstrap/lib/compiler/ebin/erl_bifs.beam b/bootstrap/lib/compiler/ebin/erl_bifs.beam Binary files differindex 815258e0ac..e2dc90c887 100644 --- a/bootstrap/lib/compiler/ebin/erl_bifs.beam +++ b/bootstrap/lib/compiler/ebin/erl_bifs.beam diff --git a/bootstrap/lib/stdlib/ebin/epp.beam b/bootstrap/lib/stdlib/ebin/epp.beam Binary files differindex 5bd32be090..59e07c65c2 100644 --- a/bootstrap/lib/stdlib/ebin/epp.beam +++ b/bootstrap/lib/stdlib/ebin/epp.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_internal.beam b/bootstrap/lib/stdlib/ebin/erl_internal.beam Binary files differindex 641888643b..d8c77627f1 100644 --- a/bootstrap/lib/stdlib/ebin/erl_internal.beam +++ b/bootstrap/lib/stdlib/ebin/erl_internal.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam Binary files differindex 7503114c68..ac593149b8 100644 --- a/bootstrap/lib/stdlib/ebin/erl_lint.beam +++ b/bootstrap/lib/stdlib/ebin/erl_lint.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_pp.beam b/bootstrap/lib/stdlib/ebin/erl_pp.beam Binary files differindex 362e530d6c..8e531126d2 100644 --- a/bootstrap/lib/stdlib/ebin/erl_pp.beam +++ b/bootstrap/lib/stdlib/ebin/erl_pp.beam diff --git a/bootstrap/lib/stdlib/ebin/io.beam b/bootstrap/lib/stdlib/ebin/io.beam Binary files differindex ddfcca41e8..73cf837dfb 100644 --- a/bootstrap/lib/stdlib/ebin/io.beam +++ b/bootstrap/lib/stdlib/ebin/io.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib.beam b/bootstrap/lib/stdlib/ebin/io_lib.beam Binary files differindex 9bb33a2248..08e497e35a 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib_format.beam b/bootstrap/lib/stdlib/ebin/io_lib_format.beam Binary files differindex ceac63435b..a476dcc6be 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib_format.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib_format.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam Binary files differindex c007d4b306..b9bcaf8cf2 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam diff --git a/bootstrap/lib/stdlib/ebin/shell.beam b/bootstrap/lib/stdlib/ebin/shell.beam Binary files differindex 097f9e0ab7..f4e416e5ad 100644 --- a/bootstrap/lib/stdlib/ebin/shell.beam +++ b/bootstrap/lib/stdlib/ebin/shell.beam diff --git a/erts/autoconf/config.guess b/erts/autoconf/config.guess index 38a833903b..f475ceb413 100755 --- a/erts/autoconf/config.guess +++ b/erts/autoconf/config.guess @@ -1,14 +1,12 @@ #! /bin/sh # Attempt to guess a canonical system name. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, -# Inc. +# Copyright 1992-2013 Free Software Foundation, Inc. -timestamp='2007-05-17' +timestamp='2013-02-12' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or +# the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, but @@ -17,26 +15,22 @@ timestamp='2007-05-17' # General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. +# along with this program; if not, see <http://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - - -# Originally written by Per Bothner <[email protected]>. -# Please send patches to <[email protected]>. Submit a context -# diff and a properly formatted ChangeLog entry. +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). +# +# Originally written by Per Bothner. # -# This script attempts to guess a canonical system name similar to -# config.sub. If it succeeds, it prints the system name on stdout, and -# exits with 0. Otherwise, it exits with 1. +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD # -# The plan is that this can be called by configure scripts if you -# don't specify an explicit build system type. +# Please send patches with a ChangeLog entry to [email protected]. + me=`echo "$0" | sed -e 's,.*/,,'` @@ -56,8 +50,7 @@ version="\ GNU config.guess ($timestamp) Originally written by Per Bothner. -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 -Free Software Foundation, Inc. +Copyright 1992-2013 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -144,7 +137,7 @@ UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in *:NetBSD:*:*) # NetBSD (nbsd) targets should (where applicable) match one or - # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*, + # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*, # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently # switched to ELF, *-*-netbsd* would select the old # object file format. This provides both forward @@ -170,7 +163,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in arm*|i386|m68k|ns32k|sh3*|sparc|vax) eval $set_cc_for_build if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep __ELF__ >/dev/null + | grep -q __ELF__ then # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). # Return netbsd for either. FIX? @@ -180,7 +173,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in fi ;; *) - os=netbsd + os=netbsd ;; esac # The OS release @@ -201,6 +194,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. echo "${machine}-${os}${release}" exit ;; + *:Bitrig:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'` + echo ${UNAME_MACHINE_ARCH}-unknown-bitrig${UNAME_RELEASE} + exit ;; *:OpenBSD:*:*) UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} @@ -223,7 +220,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` ;; *5.*) - UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` ;; esac # According to Compaq, /usr/sbin/psrinfo has been available on @@ -269,7 +266,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # A Xn.n version is an unreleased experimental baselevel. # 1.2 uses "1.2" for uname -r. echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - exit ;; + # Reset EXIT trap before exiting to avoid spurious non-zero exit code. + exitcode=$? + trap '' 0 + exit $exitcode ;; Alpha\ *:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # Should we change UNAME_MACHINE based on the output of uname instead @@ -295,12 +295,12 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in echo s390-ibm-zvmoe exit ;; *:OS400:*:*) - echo powerpc-ibm-os400 + echo powerpc-ibm-os400 exit ;; arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) echo arm-acorn-riscix${UNAME_RELEASE} exit ;; - arm:riscos:*:*|arm:RISCOS:*:*) + arm*:riscos:*:*|arm*:RISCOS:*:*) echo arm-unknown-riscos exit ;; SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) @@ -324,14 +324,33 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in case `/usr/bin/uname -p` in sparc) echo sparc-icl-nx7; exit ;; esac ;; + s390x:SunOS:*:*) + echo ${UNAME_MACHINE}-ibm-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; sun4H:SunOS:5.*:*) echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; - i86pc:SunOS:5.*:* | ix86xen:SunOS:5.*:*) - echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) + echo i386-pc-auroraux${UNAME_RELEASE} + exit ;; + i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) + eval $set_cc_for_build + SUN_ARCH="i386" + # If there is a compiler, see if it is configured for 64-bit objects. + # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. + # This test works for both compilers. + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + SUN_ARCH="x86_64" + fi + fi + echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:6*:*) # According to config.sub, this is the proper way to canonicalize @@ -375,23 +394,23 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # MiNT. But MiNT is downward compatible to TOS, so this should # be no problem. atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} + echo m68k-atari-mint${UNAME_RELEASE} exit ;; atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) echo m68k-atari-mint${UNAME_RELEASE} - exit ;; + exit ;; *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} + echo m68k-atari-mint${UNAME_RELEASE} exit ;; milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) - echo m68k-milan-mint${UNAME_RELEASE} - exit ;; + echo m68k-milan-mint${UNAME_RELEASE} + exit ;; hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) - echo m68k-hades-mint${UNAME_RELEASE} - exit ;; + echo m68k-hades-mint${UNAME_RELEASE} + exit ;; *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) - echo m68k-unknown-mint${UNAME_RELEASE} - exit ;; + echo m68k-unknown-mint${UNAME_RELEASE} + exit ;; m68k:machten:*:*) echo m68k-apple-machten${UNAME_RELEASE} exit ;; @@ -461,8 +480,8 @@ EOF echo m88k-motorola-sysv3 exit ;; AViiON:dgux:*:*) - # DG/UX returns AViiON for all architectures - UNAME_PROCESSOR=`/usr/bin/uname -p` + # DG/UX returns AViiON for all architectures + UNAME_PROCESSOR=`/usr/bin/uname -p` if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] then if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ @@ -475,7 +494,7 @@ EOF else echo i586-dg-dgux${UNAME_RELEASE} fi - exit ;; + exit ;; M88*:DolphinOS:*:*) # DolphinOS (SVR3) echo m88k-dolphin-sysv3 exit ;; @@ -532,7 +551,7 @@ EOF echo rs6000-ibm-aix3.2 fi exit ;; - *:AIX:*:[45]) + *:AIX:*:[4567]) IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then IBM_ARCH=rs6000 @@ -575,52 +594,52 @@ EOF 9000/[678][0-9][0-9]) if [ -x /usr/bin/getconf ]; then sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` - sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` - case "${sc_cpu_version}" in - 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 - 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 - 532) # CPU_PA_RISC2_0 - case "${sc_kernel_bits}" in - 32) HP_ARCH="hppa2.0n" ;; - 64) HP_ARCH="hppa2.0w" ;; + sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` + case "${sc_cpu_version}" in + 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 + 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 + 532) # CPU_PA_RISC2_0 + case "${sc_kernel_bits}" in + 32) HP_ARCH="hppa2.0n" ;; + 64) HP_ARCH="hppa2.0w" ;; '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 - esac ;; - esac + esac ;; + esac fi if [ "${HP_ARCH}" = "" ]; then eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c + sed 's/^ //' << EOF >$dummy.c - #define _HPUX_SOURCE - #include <stdlib.h> - #include <unistd.h> + #define _HPUX_SOURCE + #include <stdlib.h> + #include <unistd.h> - int main () - { - #if defined(_SC_KERNEL_BITS) - long bits = sysconf(_SC_KERNEL_BITS); - #endif - long cpu = sysconf (_SC_CPU_VERSION); + int main () + { + #if defined(_SC_KERNEL_BITS) + long bits = sysconf(_SC_KERNEL_BITS); + #endif + long cpu = sysconf (_SC_CPU_VERSION); - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1"); break; - case CPU_PA_RISC2_0: - #if defined(_SC_KERNEL_BITS) - switch (bits) - { - case 64: puts ("hppa2.0w"); break; - case 32: puts ("hppa2.0n"); break; - default: puts ("hppa2.0"); break; - } break; - #else /* !defined(_SC_KERNEL_BITS) */ - puts ("hppa2.0"); break; - #endif - default: puts ("hppa1.0"); break; - } - exit (0); - } + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1"); break; + case CPU_PA_RISC2_0: + #if defined(_SC_KERNEL_BITS) + switch (bits) + { + case 64: puts ("hppa2.0w"); break; + case 32: puts ("hppa2.0n"); break; + default: puts ("hppa2.0"); break; + } break; + #else /* !defined(_SC_KERNEL_BITS) */ + puts ("hppa2.0"); break; + #endif + default: puts ("hppa1.0"); break; + } + exit (0); + } EOF (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` test -z "$HP_ARCH" && HP_ARCH=hppa @@ -640,7 +659,7 @@ EOF # => hppa64-hp-hpux11.23 if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | - grep __LP64__ >/dev/null + grep -q __LP64__ then HP_ARCH="hppa2.0w" else @@ -711,22 +730,22 @@ EOF exit ;; C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) echo c1-convex-bsd - exit ;; + exit ;; C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) if getsysinfo -f scalar_acc then echo c32-convex-bsd else echo c2-convex-bsd fi - exit ;; + exit ;; C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) echo c34-convex-bsd - exit ;; + exit ;; C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) echo c38-convex-bsd - exit ;; + exit ;; C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) echo c4-convex-bsd - exit ;; + exit ;; CRAY*Y-MP:*:*:*) echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; @@ -750,14 +769,14 @@ EOF exit ;; F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` - echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit ;; + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` + echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; 5000:UNIX_System_V:4.*:*) - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` - echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` + echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" exit ;; i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} @@ -769,40 +788,51 @@ EOF echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} exit ;; *:FreeBSD:*:*) - case ${UNAME_MACHINE} in - pc98) - echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + UNAME_PROCESSOR=`/usr/bin/uname -p` + case ${UNAME_PROCESSOR} in amd64) echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; *) - echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + echo ${UNAME_PROCESSOR}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; esac exit ;; i*:CYGWIN*:*) echo ${UNAME_MACHINE}-pc-cygwin exit ;; + *:MINGW64*:*) + echo ${UNAME_MACHINE}-pc-mingw64 + exit ;; *:MINGW*:*) echo ${UNAME_MACHINE}-pc-mingw32 exit ;; + i*:MSYS*:*) + echo ${UNAME_MACHINE}-pc-msys + exit ;; i*:windows32*:*) - # uname -m includes "-pc" on this system. - echo ${UNAME_MACHINE}-mingw32 + # uname -m includes "-pc" on this system. + echo ${UNAME_MACHINE}-mingw32 exit ;; i*:PW*:*) echo ${UNAME_MACHINE}-pc-pw32 exit ;; - *:Interix*:[3456]*) - case ${UNAME_MACHINE} in - x86) + *:Interix*:*) + case ${UNAME_MACHINE} in + x86) echo i586-pc-interix${UNAME_RELEASE} exit ;; - EM64T | authenticamd) + authenticamd | genuineintel | EM64T) echo x86_64-unknown-interix${UNAME_RELEASE} exit ;; + IA64) + echo ia64-unknown-interix${UNAME_RELEASE} + exit ;; esac ;; [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) echo i${UNAME_MACHINE}-pc-mks exit ;; + 8664:Windows_NT:*) + echo x86_64-pc-mks + exit ;; i*:Windows_NT*:* | Pentium*:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we @@ -832,20 +862,68 @@ EOF i*86:Minix:*:*) echo ${UNAME_MACHINE}-pc-minix exit ;; - arm*:Linux:*:*) + aarch64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + aarch64_be:Linux:*:*) + UNAME_MACHINE=aarch64_be echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; + alpha:Linux:*:*) + case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in + EV5) UNAME_MACHINE=alphaev5 ;; + EV56) UNAME_MACHINE=alphaev56 ;; + PCA56) UNAME_MACHINE=alphapca56 ;; + PCA57) UNAME_MACHINE=alphapca56 ;; + EV6) UNAME_MACHINE=alphaev6 ;; + EV67) UNAME_MACHINE=alphaev67 ;; + EV68*) UNAME_MACHINE=alphaev68 ;; + esac + objdump --private-headers /bin/sh | grep -q ld.so.1 + if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi + echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + exit ;; + arm*:Linux:*:*) + eval $set_cc_for_build + if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_EABI__ + then + echo ${UNAME_MACHINE}-unknown-linux-gnu + else + if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_PCS_VFP + then + echo ${UNAME_MACHINE}-unknown-linux-gnueabi + else + echo ${UNAME_MACHINE}-unknown-linux-gnueabihf + fi + fi + exit ;; avr32*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; cris:Linux:*:*) - echo cris-axis-linux-gnu + echo ${UNAME_MACHINE}-axis-linux-gnu exit ;; crisv32:Linux:*:*) - echo crisv32-axis-linux-gnu + echo ${UNAME_MACHINE}-axis-linux-gnu exit ;; frv:Linux:*:*) - echo frv-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + hexagon:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + i*86:Linux:*:*) + LIBC=gnu + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #ifdef __dietlibc__ + LIBC=dietlibc + #endif +EOF + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'` + echo "${UNAME_MACHINE}-pc-linux-${LIBC}" exit ;; ia64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu @@ -856,74 +934,36 @@ EOF m68*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - mips:Linux:*:*) - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #undef CPU - #undef mips - #undef mipsel - #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mipsel - #else - #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips - #else - CPU= - #endif - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" - test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } - ;; - mips64:Linux:*:*) + mips:Linux:*:* | mips64:Linux:*:*) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #undef CPU - #undef mips64 - #undef mips64el + #undef ${UNAME_MACHINE} + #undef ${UNAME_MACHINE}el #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mips64el + CPU=${UNAME_MACHINE}el #else #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips64 + CPU=${UNAME_MACHINE} #else CPU= #endif #endif EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'` test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } ;; - or32:Linux:*:*) - echo or32-unknown-linux-gnu + or1k:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - ppc:Linux:*:*) - echo powerpc-unknown-linux-gnu + or32:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - ppc64:Linux:*:*) - echo powerpc64-unknown-linux-gnu + padre:Linux:*:*) + echo sparc-unknown-linux-gnu exit ;; - alpha:Linux:*:*) - case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in - EV5) UNAME_MACHINE=alphaev5 ;; - EV56) UNAME_MACHINE=alphaev56 ;; - PCA56) UNAME_MACHINE=alphapca56 ;; - PCA57) UNAME_MACHINE=alphapca56 ;; - EV6) UNAME_MACHINE=alphaev6 ;; - EV67) UNAME_MACHINE=alphaev67 ;; - EV68*) UNAME_MACHINE=alphaev68 ;; - esac - objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null - if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi - echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + parisc64:Linux:*:* | hppa64:Linux:*:*) + echo hppa64-unknown-linux-gnu exit ;; parisc:Linux:*:* | hppa:Linux:*:*) # Look for CPU level @@ -933,14 +973,17 @@ EOF *) echo hppa-unknown-linux-gnu ;; esac exit ;; - parisc64:Linux:*:* | hppa64:Linux:*:*) - echo hppa64-unknown-linux-gnu + ppc64:Linux:*:*) + echo powerpc64-unknown-linux-gnu + exit ;; + ppc:Linux:*:*) + echo powerpc-unknown-linux-gnu exit ;; s390:Linux:*:* | s390x:Linux:*:*) echo ${UNAME_MACHINE}-ibm-linux exit ;; sh64*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; sh*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu @@ -948,81 +991,18 @@ EOF sparc:Linux:*:* | sparc64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - tile:Linux:*:*) - echo tile-unknown-linux-gnu + tile*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; vax:Linux:*:*) echo ${UNAME_MACHINE}-dec-linux-gnu exit ;; x86_64:Linux:*:*) - echo x86_64-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - xtensa:Linux:*:*) - echo xtensa-unknown-linux-gnu + xtensa*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - i*86:Linux:*:*) - # The BFD linker knows what the default object file format is, so - # first see if it will tell us. cd to the root directory to prevent - # problems with other programs or directories called `ld' in the path. - # Set LC_ALL=C to ensure ld outputs messages in English. - ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \ - | sed -ne '/supported targets:/!d - s/[ ][ ]*/ /g - s/.*supported targets: *// - s/ .*// - p'` - case "$ld_supported_targets" in - elf32-i386) - TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu" - ;; - a.out-i386-linux) - echo "${UNAME_MACHINE}-pc-linux-gnuaout" - exit ;; - coff-i386) - echo "${UNAME_MACHINE}-pc-linux-gnucoff" - exit ;; - "") - # Either a pre-BFD a.out linker (linux-gnuoldld) or - # one that does not give us useful --help. - echo "${UNAME_MACHINE}-pc-linux-gnuoldld" - exit ;; - esac - # Determine whether the default compiler is a.out or elf - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #include <features.h> - #ifdef __ELF__ - # ifdef __GLIBC__ - # if __GLIBC__ >= 2 - LIBC=gnu - # else - LIBC=gnulibc1 - # endif - # else - LIBC=gnulibc1 - # endif - #else - #if defined(__INTEL_COMPILER) || defined(__PGI) || defined(__SUNPRO_C) || defined(__SUNPRO_CC) - LIBC=gnu - #else - LIBC=gnuaout - #endif - #endif - #ifdef __dietlibc__ - LIBC=dietlibc - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^LIBC/{ - s: ::g - p - }'`" - test x"${LIBC}" != x && { - echo "${UNAME_MACHINE}-pc-linux-${LIBC}" - exit - } - test x"${TENTATIVE}" != x && { echo "${TENTATIVE}"; exit; } - ;; i*86:DYNIX/ptx:4*:*) # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. # earlier versions are messed up and put the nodename in both @@ -1030,11 +1010,11 @@ EOF echo i386-sequent-sysv4 exit ;; i*86:UNIX_SV:4.2MP:2.*) - # Unixware is an offshoot of SVR4, but it has its own version - # number series starting with 2... - # I am not positive that other SVR4 systems won't match this, + # Unixware is an offshoot of SVR4, but it has its own version + # number series starting with 2... + # I am not positive that other SVR4 systems won't match this, # I just have to hope. -- rms. - # Use sysv4.2uw... so that sysv4* matches it. + # Use sysv4.2uw... so that sysv4* matches it. echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} exit ;; i*86:OS/2:*:*) @@ -1051,7 +1031,7 @@ EOF i*86:syllable:*:*) echo ${UNAME_MACHINE}-pc-syllable exit ;; - i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*) + i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) echo i386-unknown-lynxos${UNAME_RELEASE} exit ;; i*86:*DOS:*:*) @@ -1066,7 +1046,7 @@ EOF fi exit ;; i*86:*:5:[678]*) - # UnixWare 7.x, OpenUNIX and OpenServer 6. + # UnixWare 7.x, OpenUNIX and OpenServer 6. case `/bin/uname -X | grep "^Machine"` in *486*) UNAME_MACHINE=i486 ;; *Pentium) UNAME_MACHINE=i586 ;; @@ -1094,10 +1074,13 @@ EOF exit ;; pc:*:*:*) # Left here for compatibility: - # uname -m prints for DJGPP always 'pc', but it prints nothing about - # the processor, so we play safe by assuming i386. - echo i386-pc-msdosdjgpp - exit ;; + # uname -m prints for DJGPP always 'pc', but it prints nothing about + # the processor, so we play safe by assuming i586. + # Note: whatever this is, it MUST be the same as what config.sub + # prints for the "djgpp" host, or else GDB configury will decide that + # this is a cross-build. + echo i586-pc-msdosdjgpp + exit ;; Intel:Mach:3*:*) echo i386-pc-mach3 exit ;; @@ -1132,8 +1115,18 @@ EOF /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4; exit; } ;; + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4; exit; } ;; + NCR*:*:4.2:* | MPRAS*:*:4.2:*) + OS_REL='.3' + test -r /etc/.relid \ + && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) echo m68k-unknown-lynxos${UNAME_RELEASE} exit ;; @@ -1146,7 +1139,7 @@ EOF rs6000:LynxOS:2.*:*) echo rs6000-unknown-lynxos${UNAME_RELEASE} exit ;; - PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*) + PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) echo powerpc-unknown-lynxos${UNAME_RELEASE} exit ;; SM[BE]S:UNIX_SV:*:*) @@ -1166,10 +1159,10 @@ EOF echo ns32k-sni-sysv fi exit ;; - PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort - # says <[email protected]> - echo i586-unisys-sysv4 - exit ;; + PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort + # says <[email protected]> + echo i586-unisys-sysv4 + exit ;; *:UNIX_System_V:4*:FTX*) # From Gerald Hewes <[email protected]>. # How about differentiating between stratus architectures? -djm @@ -1195,11 +1188,11 @@ EOF exit ;; R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) if [ -d /usr/nec ]; then - echo mips-nec-sysv${UNAME_RELEASE} + echo mips-nec-sysv${UNAME_RELEASE} else - echo mips-unknown-sysv${UNAME_RELEASE} + echo mips-unknown-sysv${UNAME_RELEASE} fi - exit ;; + exit ;; BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. echo powerpc-be-beos exit ;; @@ -1209,6 +1202,12 @@ EOF BePC:BeOS:*:*) # BeOS running on Intel PC compatible. echo i586-pc-beos exit ;; + BePC:Haiku:*:*) # Haiku running on Intel PC compatible. + echo i586-pc-haiku + exit ;; + x86_64:Haiku:*:*) + echo x86_64-unknown-haiku + exit ;; SX-4:SUPER-UX:*:*) echo sx4-nec-superux${UNAME_RELEASE} exit ;; @@ -1236,6 +1235,16 @@ EOF *:Darwin:*:*) UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown case $UNAME_PROCESSOR in + i386) + eval $set_cc_for_build + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + UNAME_PROCESSOR="x86_64" + fi + fi ;; unknown) UNAME_PROCESSOR=powerpc ;; esac echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} @@ -1251,7 +1260,10 @@ EOF *:QNX:*:4*) echo i386-pc-qnx exit ;; - NSE-?:NONSTOP_KERNEL:*:*) + NEO-?:NONSTOP_KERNEL:*:*) + echo neo-tandem-nsk${UNAME_RELEASE} + exit ;; + NSE-*:NONSTOP_KERNEL:*:*) echo nse-tandem-nsk${UNAME_RELEASE} exit ;; NSR-?:NONSTOP_KERNEL:*:*) @@ -1296,13 +1308,13 @@ EOF echo pdp10-unknown-its exit ;; SEI:*:*:SEIUX) - echo mips-sei-seiux${UNAME_RELEASE} + echo mips-sei-seiux${UNAME_RELEASE} exit ;; *:DragonFly:*:*) echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` exit ;; *:*VMS:*:*) - UNAME_MACHINE=`(uname -p) 2>/dev/null` + UNAME_MACHINE=`(uname -p) 2>/dev/null` case "${UNAME_MACHINE}" in A*) echo alpha-dec-vms ; exit ;; I*) echo ia64-dec-vms ; exit ;; @@ -1317,11 +1329,14 @@ EOF i*86:rdos:*:*) echo ${UNAME_MACHINE}-pc-rdos exit ;; + i*86:AROS:*:*) + echo ${UNAME_MACHINE}-pc-aros + exit ;; + x86_64:VMkernel:*:*) + echo ${UNAME_MACHINE}-unknown-esx + exit ;; esac -#echo '(No uname command or uname output not recognized.)' 1>&2 -#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 - eval $set_cc_for_build cat >$dummy.c <<EOF #ifdef _SEQUENT_ @@ -1339,11 +1354,11 @@ main () #include <sys/param.h> printf ("m68k-sony-newsos%s\n", #ifdef NEWSOS4 - "4" + "4" #else - "" + "" #endif - ); exit (0); + ); exit (0); #endif #endif @@ -1477,9 +1492,9 @@ This script, last modified $timestamp, has failed to recognize the operating system you are using. It is advised that you download the most up to date version of the config scripts from - http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.guess + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD and - http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.sub + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD If the version you run ($0) is already up to date, please send the following data and any information you think might be diff --git a/erts/autoconf/config.sub b/erts/autoconf/config.sub index f43233b104..bb6edbdb47 100755 --- a/erts/autoconf/config.sub +++ b/erts/autoconf/config.sub @@ -1,44 +1,40 @@ #! /bin/sh # Configuration validation subroutine script. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, -# Inc. +# Copyright 1992-2013 Free Software Foundation, Inc. -timestamp='2007-04-29' +timestamp='2013-02-12' -# This file is (in principle) common to ALL GNU software. -# The presence of a machine in this file suggests that SOME GNU software -# can handle that machine. It does not imply ALL GNU software can. -# -# This file is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or +# This file is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. +# along with this program; if not, see <http://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). -# Please send patches to <[email protected]>. Submit a context -# diff and a properly formatted ChangeLog entry. +# Please send patches with a ChangeLog entry to [email protected]. # # Configuration subroutine to validate and canonicalize a configuration type. # Supply the specified configuration type as an argument. # If it is invalid, we print an error message on stderr and exit with code 1. # Otherwise, we print the canonical config type on stdout and succeed. +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD + # This file is supposed to be the same for all GNU packages # and recognize all the CPU types, system types and aliases # that are meaningful with *any* GNU software. @@ -72,8 +68,7 @@ Report bugs and patches to <[email protected]>." version="\ GNU config.sub ($timestamp) -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 -Free Software Foundation, Inc. +Copyright 1992-2013 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -120,12 +115,18 @@ esac # Here we must recognize all the valid KERNEL-OS combinations. maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` case $maybe_os in - nto-qnx* | linux-gnu* | linux-dietlibc | linux-newlib* | linux-uclibc* | \ - uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* | \ + nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \ + linux-musl* | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \ + knetbsd*-gnu* | netbsd*-gnu* | \ + kopensolaris*-gnu* | \ storm-chaos* | os2-emx* | rtmk-nova*) os=-$maybe_os basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` ;; + android-linux) + os=-linux-android + basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-unknown + ;; *) basic_machine=`echo $1 | sed 's/-[^-]*$//'` if [ $basic_machine != $1 ] @@ -148,10 +149,13 @@ case $os in -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ - -apple | -axis | -knuth | -cray) + -apple | -axis | -knuth | -cray | -microblaze*) os= basic_machine=$1 ;; + -bluegene*) + os=-cnk + ;; -sim | -cisco | -oki | -wec | -winbond) os= basic_machine=$1 @@ -166,10 +170,10 @@ case $os in os=-chorusos basic_machine=$1 ;; - -chorusrdb) - os=-chorusrdb + -chorusrdb) + os=-chorusrdb basic_machine=$1 - ;; + ;; -hiux*) os=-hiuxwe2 ;; @@ -214,6 +218,12 @@ case $os in -isc*) basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; + -lynx*178) + os=-lynxos178 + ;; + -lynx*5) + os=-lynxos5 + ;; -lynx*) os=-lynxos ;; @@ -238,24 +248,34 @@ case $basic_machine in # Some are omitted here because they have special meanings below. 1750a | 580 \ | a29k \ + | aarch64 | aarch64_be \ | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ | am33_2.0 \ - | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr | avr32 \ + | arc \ + | arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv7[arm] \ + | avr | avr32 \ + | be32 | be64 \ | bfin \ | c4x | clipper \ | d10v | d30v | dlx | dsp16xx \ + | epiphany \ | fido | fr30 | frv \ | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ + | hexagon \ | i370 | i860 | i960 | ia64 \ | ip2k | iq2000 \ + | le32 | le64 \ + | lm32 \ | m32c | m32r | m32rle | m68000 | m68k | m88k \ - | maxq | mb | microblaze | mcore | mep \ + | maxq | mb | microblaze | microblazeel | mcore | mep | metag \ | mips | mipsbe | mipseb | mipsel | mipsle \ | mips16 \ | mips64 | mips64el \ - | mips64vr | mips64vrel \ + | mips64octeon | mips64octeonel \ | mips64orion | mips64orionel \ + | mips64r5900 | mips64r5900el \ + | mips64vr | mips64vrel \ | mips64vr4100 | mips64vr4100el \ | mips64vr4300 | mips64vr4300el \ | mips64vr5000 | mips64vr5000el \ @@ -266,31 +286,45 @@ case $basic_machine in | mipsisa64r2 | mipsisa64r2el \ | mipsisa64sb1 | mipsisa64sb1el \ | mipsisa64sr71k | mipsisa64sr71kel \ + | mipsr5900 | mipsr5900el \ | mipstx39 | mipstx39el \ | mn10200 | mn10300 \ + | moxie \ | mt \ | msp430 \ - | nios | nios2 \ + | nds32 | nds32le | nds32be \ + | nios | nios2 | nios2eb | nios2el \ | ns16k | ns32k \ - | or32 \ + | open8 \ + | or1k | or32 \ | pdp10 | pdp11 | pj | pjl \ - | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \ + | powerpc | powerpc64 | powerpc64le | powerpcle \ | pyramid \ + | rl78 | rx \ | score \ - | sh | sh[1234] | sh[24]a | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ + | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ | sh64 | sh64le \ | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ - | spu | strongarm \ - | tahoe | thumb | tic4x | tic80 | tron \ - | v850 | v850e \ + | spu \ + | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \ + | ubicom32 \ + | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \ | we32k \ - | x86 | xc16x | xscale | xscalee[bl] | xstormy16 | xtensa \ - | z8k) + | x86 | xc16x | xstormy16 | xtensa \ + | z8k | z80) basic_machine=$basic_machine-unknown ;; - m6811 | m68hc11 | m6812 | m68hc12) - # Motorola 68HC11/12. + c54x) + basic_machine=tic54x-unknown + ;; + c55x) + basic_machine=tic55x-unknown + ;; + c6x) + basic_machine=tic6x-unknown + ;; + m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | picochip) basic_machine=$basic_machine-unknown os=-none ;; @@ -300,6 +334,21 @@ case $basic_machine in basic_machine=mt-unknown ;; + strongarm | thumb | xscale) + basic_machine=arm-unknown + ;; + xgate) + basic_machine=$basic_machine-unknown + os=-none + ;; + xscaleeb) + basic_machine=armeb-unknown + ;; + + xscaleel) + basic_machine=armel-unknown + ;; + # We use `pc' rather than `unknown' # because (1) that's what they normally are, and # (2) the word "unknown" tends to confuse beginning users. @@ -314,29 +363,37 @@ case $basic_machine in # Recognize the basic CPU types with company name. 580-* \ | a29k-* \ + | aarch64-* | aarch64_be-* \ | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \ | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ | avr-* | avr32-* \ + | be32-* | be64-* \ | bfin-* | bs2000-* \ - | c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \ + | c[123]* | c30-* | [cjt]90-* | c4x-* \ | clipper-* | craynv-* | cydra-* \ | d10v-* | d30v-* | dlx-* \ | elxsi-* \ | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \ | h8300-* | h8500-* \ | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ + | hexagon-* \ | i*86-* | i860-* | i960-* | ia64-* \ | ip2k-* | iq2000-* \ + | le32-* | le64-* \ + | lm32-* \ | m32c-* | m32r-* | m32rle-* \ | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ - | m88110-* | m88k-* | maxq-* | mcore-* \ + | m88110-* | m88k-* | maxq-* | mcore-* | metag-* \ + | microblaze-* | microblazeel-* \ | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ | mips16-* \ | mips64-* | mips64el-* \ - | mips64vr-* | mips64vrel-* \ + | mips64octeon-* | mips64octeonel-* \ | mips64orion-* | mips64orionel-* \ + | mips64r5900-* | mips64r5900el-* \ + | mips64vr-* | mips64vrel-* \ | mips64vr4100-* | mips64vr4100el-* \ | mips64vr4300-* | mips64vr4300el-* \ | mips64vr5000-* | mips64vr5000el-* \ @@ -347,31 +404,41 @@ case $basic_machine in | mipsisa64r2-* | mipsisa64r2el-* \ | mipsisa64sb1-* | mipsisa64sb1el-* \ | mipsisa64sr71k-* | mipsisa64sr71kel-* \ + | mipsr5900-* | mipsr5900el-* \ | mipstx39-* | mipstx39el-* \ | mmix-* \ | mt-* \ | msp430-* \ - | nios-* | nios2-* \ + | nds32-* | nds32le-* | nds32be-* \ + | nios-* | nios2-* | nios2eb-* | nios2el-* \ | none-* | np1-* | ns16k-* | ns32k-* \ + | open8-* \ | orion-* \ | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ - | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \ + | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \ | pyramid-* \ - | romp-* | rs6000-* \ - | sh-* | sh[1234]-* | sh[24]a-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ + | rl78-* | romp-* | rs6000-* | rx-* \ + | sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ | sparclite-* \ - | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | strongarm-* | sv1-* | sx?-* \ - | tahoe-* | thumb-* \ + | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx?-* \ + | tahoe-* \ | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ + | tile*-* \ | tron-* \ - | v850-* | v850e-* | vax-* \ + | ubicom32-* \ + | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \ + | vax-* \ | we32k-* \ - | x86-* | x86_64-* | xc16x-* | xps100-* | xscale-* | xscalee[bl]-* \ - | xstormy16-* | xtensa-* \ + | x86-* | x86_64-* | xc16x-* | xps100-* \ + | xstormy16-* | xtensa*-* \ | ymp-* \ - | z8k-*) + | z8k-* | z80-*) + ;; + # Recognize the basic CPU types without company name, with glob match. + xtensa*) + basic_machine=$basic_machine-unknown ;; # Recognize the various machine names and aliases which stand # for a CPU type and a company and sometimes even an OS. @@ -389,7 +456,7 @@ case $basic_machine in basic_machine=a29k-amd os=-udi ;; - abacus) + abacus) basic_machine=abacus-unknown ;; adobe68k) @@ -435,6 +502,10 @@ case $basic_machine in basic_machine=m68k-apollo os=-bsd ;; + aros) + basic_machine=i386-pc + os=-aros + ;; aux) basic_machine=m68k-apple os=-aux @@ -443,10 +514,35 @@ case $basic_machine in basic_machine=ns32k-sequent os=-dynix ;; + blackfin) + basic_machine=bfin-unknown + os=-linux + ;; + blackfin-*) + basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; + bluegene*) + basic_machine=powerpc-ibm + os=-cnk + ;; + c54x-*) + basic_machine=tic54x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c55x-*) + basic_machine=tic55x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c6x-*) + basic_machine=tic6x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; c90) basic_machine=c90-cray os=-unicos ;; + cegcc) + basic_machine=arm-unknown + os=-cegcc + ;; convex-c1) basic_machine=c1-convex os=-bsd @@ -475,8 +571,8 @@ case $basic_machine in basic_machine=craynv-cray os=-unicosmp ;; - cr16c) - basic_machine=cr16c-unknown + cr16 | cr16-*) + basic_machine=cr16-unknown os=-elf ;; crds | unos) @@ -514,6 +610,10 @@ case $basic_machine in basic_machine=m88k-motorola os=-sysv3 ;; + dicos) + basic_machine=i686-pc + os=-dicos + ;; djgpp) basic_machine=i586-pc os=-msdosdjgpp @@ -629,7 +729,6 @@ case $basic_machine in i370-ibm* | ibm*) basic_machine=i370-ibm ;; -# I'm not sure what "Sysv32" means. Should this be sysv3.2? i*86v32) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv32 @@ -668,6 +767,14 @@ case $basic_machine in basic_machine=m68k-isi os=-sysv ;; + m68knommu) + basic_machine=m68k-unknown + os=-linux + ;; + m68knommu-*) + basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; m88k-omron*) basic_machine=m88k-omron ;; @@ -679,6 +786,13 @@ case $basic_machine in basic_machine=ns32k-utek os=-sysv ;; + microblaze*) + basic_machine=microblaze-xilinx + ;; + mingw64) + basic_machine=x86_64-pc + os=-mingw64 + ;; mingw32) basic_machine=i386-pc os=-mingw32 @@ -715,10 +829,18 @@ case $basic_machine in ms1-*) basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` ;; + msys) + basic_machine=i386-pc + os=-msys + ;; mvs) basic_machine=i370-ibm os=-mvs ;; + nacl) + basic_machine=le32-unknown + os=-nacl + ;; ncr3000) basic_machine=i486-ncr os=-sysv4 @@ -783,6 +905,12 @@ case $basic_machine in np1) basic_machine=np1-gould ;; + neo-tandem) + basic_machine=neo-tandem + ;; + nse-tandem) + basic_machine=nse-tandem + ;; nsr-tandem) basic_machine=nsr-tandem ;; @@ -813,6 +941,14 @@ case $basic_machine in basic_machine=i860-intel os=-osf ;; + parisc) + basic_machine=hppa-unknown + os=-linux + ;; + parisc-*) + basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; pbd) basic_machine=sparc-tti ;; @@ -857,9 +993,10 @@ case $basic_machine in ;; power) basic_machine=power-ibm ;; - ppc) basic_machine=powerpc-unknown + ppc | ppcbe) basic_machine=powerpc-unknown ;; - ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` + ppc-* | ppcbe-*) + basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppcle | powerpclittle | ppc-le | powerpc-little) basic_machine=powerpcle-unknown @@ -884,7 +1021,11 @@ case $basic_machine in basic_machine=i586-unknown os=-pw32 ;; - rdos) + rdos | rdos64) + basic_machine=x86_64-pc + os=-rdos + ;; + rdos32) basic_machine=i386-pc os=-rdos ;; @@ -953,6 +1094,9 @@ case $basic_machine in basic_machine=i860-stratus os=-sysv4 ;; + strongarm-* | thumb-*) + basic_machine=arm-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; sun2) basic_machine=m68000-sun ;; @@ -1009,17 +1153,9 @@ case $basic_machine in basic_machine=t90-cray os=-unicos ;; - tic54x | c54x*) - basic_machine=tic54x-unknown - os=-coff - ;; - tic55x | c55x*) - basic_machine=tic55x-unknown - os=-coff - ;; - tic6x | c6x*) - basic_machine=tic6x-unknown - os=-coff + tile*) + basic_machine=$basic_machine-unknown + os=-linux-gnu ;; tx39) basic_machine=mipstx39-unknown @@ -1027,10 +1163,6 @@ case $basic_machine in tx39el) basic_machine=mipstx39el-unknown ;; - tile*) - basic_machine=tile-tilera - os=-linux-gnu - ;; toad1) basic_machine=pdp10-xkl os=-tops20 @@ -1092,6 +1224,9 @@ case $basic_machine in xps | xps100) basic_machine=xps100-honeywell ;; + xscale-* | xscalee[bl]-*) + basic_machine=`echo $basic_machine | sed 's/^xscale/arm/'` + ;; ymp) basic_machine=ymp-cray os=-unicos @@ -1100,6 +1235,10 @@ case $basic_machine in basic_machine=z8k-unknown os=-sim ;; + z80-*-coff) + basic_machine=z80-unknown + os=-sim + ;; none) basic_machine=none-none os=-none @@ -1138,7 +1277,7 @@ case $basic_machine in we32k) basic_machine=we32k-att ;; - sh[1234] | sh[24]a | sh[34]eb | sh[1234]le | sh[23]ele) + sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele) basic_machine=sh-unknown ;; sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v) @@ -1185,9 +1324,12 @@ esac if [ x"$os" != x"" ] then case $os in - # First match some system type aliases - # that might get confused with valid system types. + # First match some system type aliases + # that might get confused with valid system types. # -solaris* is a basic system type, with this one exception. + -auroraux) + os=-auroraux + ;; -solaris1 | -solaris1.*) os=`echo $os | sed -e 's|solaris1|sunos4|'` ;; @@ -1208,21 +1350,23 @@ case $os in # Each alternative MUST END IN A *, to match a version number. # -sysv* is not here because it comes later, after sysvr4. -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ - | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\ - | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ + | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\ + | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \ + | -sym* | -kopensolaris* | -plan9* \ | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ - | -aos* \ + | -aos* | -aros* \ | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ - | -openbsd* | -solidbsd* \ + | -bitrig* | -openbsd* | -solidbsd* \ | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ - | -chorusos* | -chorusrdb* \ - | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ - | -mingw32* | -linux-gnu* | -linux-newlib* | -linux-uclibc* \ + | -chorusos* | -chorusrdb* | -cegcc* \ + | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ + | -mingw32* | -mingw64* | -linux-gnu* | -linux-android* \ + | -linux-newlib* | -linux-musl* | -linux-uclibc* \ | -uxpv* | -beos* | -mpeix* | -udk* \ | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ @@ -1230,7 +1374,7 @@ case $os in | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ - | -skyos* | -haiku* | -rdos* | -toppers* | -drops*) + | -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es*) # Remember, each alternative MUST END IN *, to match a version number. ;; -qnx*) @@ -1269,7 +1413,7 @@ case $os in -opened*) os=-openedition ;; - -os400*) + -os400*) os=-os400 ;; -wince*) @@ -1318,7 +1462,7 @@ case $os in -sinix*) os=-sysv4 ;; - -tpf*) + -tpf*) os=-tpf ;; -triton*) @@ -1354,12 +1498,14 @@ case $os in -aros*) os=-aros ;; - -kaos*) - os=-kaos - ;; -zvmoe) os=-zvmoe ;; + -dicos*) + os=-dicos + ;; + -nacl*) + ;; -none) ;; *) @@ -1382,10 +1528,10 @@ else # system, and we'll never get to this point. case $basic_machine in - score-*) + score-*) os=-elf ;; - spu-*) + spu-*) os=-elf ;; *-acorn) @@ -1397,8 +1543,20 @@ case $basic_machine in arm*-semi) os=-aout ;; - c4x-* | tic4x-*) - os=-coff + c4x-* | tic4x-*) + os=-coff + ;; + hexagon-*) + os=-elf + ;; + tic54x-*) + os=-coff + ;; + tic55x-*) + os=-coff + ;; + tic6x-*) + os=-coff ;; # This must come before the *-dec entry. pdp10-*) @@ -1418,14 +1576,11 @@ case $basic_machine in ;; m68000-sun) os=-sunos3 - # This also exists in the configure program, but was not the - # default. - # os=-sunos4 ;; m68*-cisco) os=-aout ;; - mep-*) + mep-*) os=-elf ;; mips*-cisco) @@ -1434,6 +1589,9 @@ case $basic_machine in mips*-*) os=-elf ;; + or1k-*) + os=-elf + ;; or32-*) os=-coff ;; @@ -1452,7 +1610,7 @@ case $basic_machine in *-ibm) os=-aix ;; - *-knuth) + *-knuth) os=-mmixware ;; *-wec) @@ -1557,7 +1715,7 @@ case $basic_machine in -sunos*) vendor=sun ;; - -aix*) + -cnk*|-aix*) vendor=ibm ;; -beos*) @@ -1628,3 +1786,4 @@ exit # time-stamp-format: "%:y-%02m-%02d" # time-stamp-end: "'" # End: + diff --git a/erts/configure.in b/erts/configure.in index 1e3a607a6f..7257751068 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -1923,12 +1923,21 @@ fi AC_CHECK_FUNCS([getipnodebyname getipnodebyaddr gethostbyname2]) AC_CHECK_FUNCS([ieee_handler fpsetmask finite isnan isinf res_gethostbyname dlopen \ - pread pwrite writev memmove strerror strerror_r strncasecmp \ + pread pwrite memmove strerror strerror_r strncasecmp \ gethrtime localtime_r gmtime_r inet_pton mmap mremap memcpy mallopt \ sbrk _sbrk __sbrk brk _brk __brk \ flockfile fstat strlcpy strlcat setsid posix2time time2posix \ setlocale nl_langinfo poll]) +dnl writev on OS X snow leopard is broken for files > 4GB +case $host_os in + darwin10.8.0) + AC_MSG_CHECKING([for writev]) + AC_MSG_RESULT(no, not stable on OS X Snow Leopard) ;; + *) + AC_CHECK_FUNCS([writev]) ;; +esac + AC_CHECK_DECLS([posix2time, time2posix],,,[#include <time.h>]) disable_vfork=false diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index f354d68d45..bd03fb4970 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -615,6 +615,28 @@ debugging.</item> </taglist> </item> + <tag><marker id="+pc"/><marker id="max_processes"><c><![CDATA[+pc Range]]></c></marker></tag> + <item> + <p>Sets the range of characters that the system will consider printable in heuristic detection of strings. This typically affects the shell, debugger and io:format functions (when ~tp is used in the format string).</p> + <p>Currently two values for the <c>Range</c> are supported: + <taglist> + <tag><c>latin1</c></tag> <item>The default. Only characters + in the ISO-latin-1 range can be considered printable, which means + that a character with a code point > 255 will never be + considered printable and that lists containing such + characters will be displayed as lists of integers rather + than text strings by tools.</item> + <tag><c>unicode</c></tag> + <item>All printable Unicode characters are considered when + determining if a list of integers is to be displayed in + string syntax. This may give unexpected results if for + example your font does not cover all Unicode + characters.</item> + </taglist> + </p> + <p>Se also <seealso marker="stdlib:io#printable_range/0"> + io:printable_range/0</seealso>.</p> + </item> <tag><marker id="+P"/><marker id="max_processes"><c><![CDATA[+P Number]]></c></marker></tag> <item> <p>Sets the maximum number of simultaneously existing processes for this @@ -985,15 +1007,12 @@ documentation of the <seealso marker="#+sbt">+sbt</seealso> flag. </p> </item> - <tag><marker id="+sws"><c>+sws default|legacy|proposal</c></marker></tag> + <tag><marker id="+sws"><c>+sws default|legacy</c></marker></tag> <item> - <p>Set scheduler wakeup strategy. Default is <c>legacy</c> (has been - used since OTP-R13B). The <c>proposal</c> strategy is the currently - proposed strategy for OTP-R16. Note that the <c>proposal</c> strategy - might change during OTP-R15. + <p> + Set scheduler wakeup strategy. Default strategy changed in erts-5.10/OTP-R16A. This strategy was previously known as <c>proposal</c> in OTP-R15. The <c>legacy</c> strategy was used as default from R13 up to and including R15. </p> - <p><em>NOTE:</em> This flag may be removed or changed at any time - without prior notice. + <p><em>NOTE:</em> This flag may be removed or changed at any time without prior notice. </p> </item> <tag><marker id="+swt"><c>+swt very_low|low|medium|high|very_high</c></marker></tag> diff --git a/erts/doc/src/erl_driver.xml b/erts/doc/src/erl_driver.xml index 0e27f8a5bd..636326e4e1 100644 --- a/erts/doc/src/erl_driver.xml +++ b/erts/doc/src/erl_driver.xml @@ -170,10 +170,13 @@ callback, the best approach is to divide the work into multiple chunks of work and trigger multiple calls to the <seealso marker="driver_entry#timeout">timeout callback</seealso> using - zero timeouts. This might, however, not always be possible, e.g. when - calling third party libraries. In this case you typically want to dispatch - the work to another thread. Information about thread primitives can be - found below.</p> + zero timeouts. The + <seealso marker="#erl_drv_consume_timeslice"><c>erl_drv_consume_timeslice()</c></seealso> + function can be useful in order to determine when to trigger such + timeout callback calls. It might, however, not always be possible to + implement it this way, e.g. when calling third party libraries. In this + case you typically want to dispatch the work to another thread. + Information about thread primitives can be found below.</p> </description> <section> @@ -2805,7 +2808,6 @@ ERL_DRV_EXT2TERM char *buf, ErlDrvUInt len <p>This function is thread-safe.</p> </desc> </func> - <func> <name><ret>int</ret><nametext>erl_drv_getenv(char *key, char *value, size_t *value_size)</nametext></name> <fsummary>Get the value of an environment variable</fsummary> @@ -2841,6 +2843,52 @@ ERL_DRV_EXT2TERM char *buf, ErlDrvUInt len <p>This function is thread-safe.</p> </desc> </func> + <func> + <name><ret>int</ret><nametext>erl_drv_consume_timeslice(ErlDrvPort port, int percent)</nametext></name> + <fsummary>Give the runtime system a hint about how much CPU time the + current driver callback call has consumed</fsummary> + <desc> + <marker id="erl_drv_consume_timeslice"></marker> + <p>Arguments:</p> + <taglist> + <tag><c>port</c></tag> + <item>Port handle of the executing port.</item> + <tag><c>percent</c></tag> + <item>Approximate consumed fraction of a full + time-slice in percent.</item> + </taglist> + <p>Give the runtime system a hint about how much CPU time the + current driver callback call has consumed since last hint, or + since the start of the callback if no previous hint has been given. + The time is given as a fraction, in percent, of a full time-slice + that a port is allowed to execute before it should surrender the + CPU to other runnable ports or processes. Valid range is + <c>[1, 100]</c>. The scheduling time-slice is not an exact entity, + but can usually be approximated to about 1 millisecond.</p> + + <p>Note that it is up to the runtime system to determine if and + how to use this information. Implementations on some platforms + may use other means in order to determine the consumed fraction + of the time-slice. Lengthy driver callbacks should regardless of + this frequently call the <c>erl_drv_consume_timeslice()</c> + function in order to determine if it is allowed to continue + execution or not.</p> + + <p><c>erl_drv_consume_timeslice()</c> returns a non-zero value + if the time-slice has been exhausted, and zero if the callback is + allowed to continue execution. If a non-zero value is + returned the driver callback should return as soon as possible in + order for the port to be able to yield.</p> + + <p>This function is provided to better support co-operative scheduling, + improve system responsiveness, and to make it easier to prevent + misbehaviors of the VM due to a port monopolizing a scheduler thread. + It can be used when dividing length work into a number of repeated + driver callback calls without the need to use threads. Also see the + important <seealso marker="#WARNING">warning</seealso> text at the + beginning of this document.</p> + </desc> + </func> </funcs> <section> diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 5a63aaadc6..06fefa8efb 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -300,6 +300,44 @@ </desc> </func> <func> + <name name="binary_to_float" arity="1"/> + <fsummary>Convert from text representation to a float</fsummary> + <desc> + <p>Returns the float whose text representation is <c><anno>Binary</anno></c>.</p> + <pre> +> <input>binary_to_float(<<"2.2017764e+0">>).</input> +2.2017764</pre> + <p>Failure: <c>badarg</c> if <c><anno>Binary</anno></c> contains a bad + representation of a float.</p> + </desc> + </func> + <func> + <name name="binary_to_integer" arity="1"/> + <fsummary>Convert from text representation to an integer</fsummary> + <desc> + <p>Returns an integer whose text representation is + <c><anno>Binary</anno></c>.</p> + <pre> +> <input>binary_to_integer(<<"123">>).</input> +123</pre> + <p>Failure: <c>badarg</c> if <c><anno>Binary</anno></c> contains a bad + representation of an integer.</p> + </desc> + </func> + <func> + <name name="binary_to_integer" arity="2"/> + <fsummary>Convert from text representation to an integer</fsummary> + <desc> + <p>Returns an integer whose text representation in base + <c><anno>Base</anno></c> is <c><anno>Binary</anno></c>.</p> + <pre> +> <input>binary_to_integer(<<"3FF">>, 16).</input> +1023</pre> + <p>Failure: <c>badarg</c> if <c><anno>Binary</anno></c> contains a bad + representation of an integer.</p> + </desc> + </func> + <func> <name name="binary_to_list" arity="1"/> <fsummary>Convert a binary to a list</fsummary> <desc> @@ -961,26 +999,38 @@ true </desc> </func> <func> - <name name="float_to_list" arity="1"/> + <name name="float_to_binary" arity="1"/> <fsummary>Text representation of a float</fsummary> <desc> - <p>Returns a string which corresponds to the text - representation of <c><anno>Float</anno></c>.</p> + <p>The same as <c>float_to_binary(<anno>Float</anno>,[{scientific,20}])</c>.</p> + </desc> + </func> + <func> + <name name="float_to_binary" arity="2"/> + <fsummary>Text representation of a float formatted using given options</fsummary> + <desc> + <p>Returns a binary which corresponds to the text + representation of <c><anno>Float</anno></c> using fixed decimal + point formatting. The <c><anno>Options</anno></c> behave in the same + way as <seealso marker="#float_to_list/2">float_to_list/2</seealso>. + </p> <pre> -> <input>float_to_list(7.0).</input> -"7.00000000000000000000e+00"</pre> +> <input>float_to_binary(7.12, [{decimals, 4}]).</input> +<<"7.1200">> +> <input>float_to_binary(7.12, [{decimals, 4}, compact]).</input> +<<"7.12">></pre> </desc> </func> <func> - <name>float_to_list(Float, Options) -> string()</name> + <name name="float_to_list" arity="1"/> + <fsummary>Text representation of a float</fsummary> + <desc> + <p>The same as <c>float_to_list(<anno>Float</anno>,[{scientific,20}])</c>.</p> + </desc> + </func> + <func> + <name name="float_to_list" arity="2"/> <fsummary>Text representation of a float formatted using given options</fsummary> - <type> - <v>Float = float()</v> - <v>Options = [Option]</v> - <v>Option = {decimals, Decimals::0..253} | - {scientific, Decimals::0..249} | - compact</v> - </type> <desc> <p>Returns a string which corresponds to the text representation of <c>Float</c> using fixed decimal point formatting. @@ -993,7 +1043,8 @@ true only meaningful together with the <c>decimals</c> option). When <c>scientific</c> option is provided, the float will be formatted using scientific notation with <c>Decimals</c> digits of precision. If - <c>Options</c> is <c>[]</c> the function behaves like <c>float_to_list/1</c>. + <c>Options</c> is <c>[]</c> the function behaves like + <c><seealso marker="#float_to_list/1">float_to_list/1</seealso></c>. </p> <pre> > <input>float_to_list(7.12, [{decimals, 4}]).</input> @@ -1429,7 +1480,28 @@ os_prompt% </pre> {one,new,two,three}</pre> </desc> </func> - + <func> + <name name="integer_to_binary" arity="1"/> + <fsummary>Text representation of an integer</fsummary> + <desc> + <p>Returns a binary which corresponds to the text + representation of <c><anno>Integer</anno></c>.</p> + <pre> +> <input>integer_to_binary(77).</input> +<<"77">></pre> + </desc> + </func> + <func> + <name name="integer_to_binary" arity="2"/> + <fsummary>Text representation of an integer</fsummary> + <desc> + <p>Returns a binary which corresponds to the text + representation of <c><anno>Integer</anno></c> in base <c><anno>Base</anno></c>.</p> + <pre> +> <input>integer_to_binary(1023, 16).</input> +<<"3FF">></pre> + </desc> + </func> <func> <name name="integer_to_list" arity="1"/> <fsummary>Text representation of an integer</fsummary> diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml index 42298e4824..0363f0237e 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -144,7 +144,7 @@ spawning processes, terminating processes, sending messages, etc.</item> <item>Optimizations of run queue management reducing contention.</item> - <item>Optimizations of process state changes reducing + <item>Optimizations of process internal state changes reducing contention.</item> </list> <p>These changes imply changes of the characteristics the system. Most notable: changed timing in the system.</p> @@ -403,7 +403,7 @@ </item> <item> <p> - The <seealso marker="#+stbt">+stbt</seealso> command line + The <seealso marker="erl#+stbt">+stbt</seealso> command line argument of <c>erl</c> was added. This argument can be used for trying to set scheduler bind type. Upon failure unbound schedulers will be used.</p> diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 7033ea0a3d..2877e58cdf 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -20,7 +20,7 @@ include $(ERL_TOP)/make/target.mk include ../vsn.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk -include $(TARGET)/gen_git_version.mk +-include $(TARGET)/gen_git_version.mk ENABLE_ALLOC_TYPE_VARS = @ENABLE_ALLOC_TYPE_VARS@ diff --git a/erts/emulator/beam/atom.c b/erts/emulator/beam/atom.c index b69f979397..84d2d5e3ed 100644 --- a/erts/emulator/beam/atom.c +++ b/erts/emulator/beam/atom.c @@ -132,9 +132,17 @@ atom_hash(Atom* obj) byte* p = obj->name; int len = obj->len; HashValue h = 0, g; + byte v; while(len--) { - h = (h << 4) + *p++; + v = *p++; + /* latin1 clutch for r16 */ + if ((v & 0xFE) == 0xC2 && (*p & 0xC0) == 0x80) { + v = (v << 6) | (*p & 0x3F); + p++; len--; + } + /* normal hashpjw follows for v */ + h = (h << 4) + v; if ((g = h & 0xf0000000)) { h ^= (g >> 24); h ^= g; diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 73264214ce..8a8239493a 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -1081,7 +1081,21 @@ beam_make_current_old(Process *c_p, ErtsProcLocks c_p_locks, Eterm module) static int is_native(BeamInstr* code) { - return ((Eterm *)code[MI_FUNCTIONS])[1] != 0; + Uint i, num_functions = code[MI_NUM_FUNCTIONS]; + + /* Check NativeAdress of first real function in module + */ + for (i=0; i<num_functions; i++) { + BeamInstr* func_info = (BeamInstr *) code[MI_FUNCTIONS+i]; + Eterm name = (Eterm) func_info[3]; + + if (is_atom(name)) { + return func_info[1] != 0; + } + else ASSERT(is_nil(name)); /* ignore BIF stubs */ + } + /* Not a single non-BIF function? */ + return 0; } diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 0e9d140908..e2c3bf292f 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -1070,17 +1070,6 @@ init_emulator(void) #endif /* USE_VM_PROBES */ -#ifdef USE_VM_PROBES -void -dtrace_drvport_str(ErlDrvPort drvport, char *port_buf) -{ - Port *port = erts_drvport2port(drvport, NULL); - - erts_snprintf(port_buf, DTRACE_TERM_BUF_SIZE, "#Port<%lu.%lu>", - port_channel_no(port->common.id), - port_number(port->common.id)); -} -#endif /* * process_main() is called twice: * The first call performs some initialisation, including exporting diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index df084e1185..9c438679ea 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -39,6 +39,7 @@ #include "erl_thr_progress.h" #define ERTS_PTAB_WANT_BIF_IMPL__ #include "erl_ptab.h" +#include "erl_bits.h" static Export* flush_monitor_message_trap = NULL; static Export* set_cpu_topology_trap = NULL; @@ -2069,11 +2070,16 @@ BIF_RETTYPE send_3(BIF_ALIST_3) result = do_send(p, to, msg, suspend, &ref); if (result > 0) { ERTS_VBUMP_REDS(p, result); + if (ERTS_IS_PROC_OUT_OF_REDS(p)) + goto yield_return; BIF_RET(am_ok); } switch (result) { case 0: + /* May need to yield even though we do not bump reds here... */ + if (ERTS_IS_PROC_OUT_OF_REDS(p)) + goto yield_return; BIF_RET(am_ok); break; case SEND_TRAP: @@ -2091,10 +2097,10 @@ BIF_RETTYPE send_3(BIF_ALIST_3) } break; case SEND_YIELD_RETURN: - if (suspend) - ERTS_BIF_YIELD_RETURN(p, am_ok); - else + if (!suspend) BIF_RET(am_nosuspend); + yield_return: + ERTS_BIF_YIELD_RETURN(p, am_ok); case SEND_AWAIT_RESULT: ASSERT(is_internal_ref(ref)); BIF_TRAP3(await_port_send_result_trap, p, ref, am_nosuspend, am_ok); @@ -2133,11 +2139,16 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg) if (result > 0) { ERTS_VBUMP_REDS(p, result); + if (ERTS_IS_PROC_OUT_OF_REDS(p)) + goto yield_return; BIF_RET(msg); } switch (result) { case 0: + /* May need to yield even though we do not bump reds here... */ + if (ERTS_IS_PROC_OUT_OF_REDS(p)) + goto yield_return; BIF_RET(msg); break; case SEND_TRAP: @@ -2147,6 +2158,7 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg) ERTS_BIF_YIELD2(bif_export[BIF_send_2], p, to, msg); break; case SEND_YIELD_RETURN: + yield_return: ERTS_BIF_YIELD_RETURN(p, msg); case SEND_AWAIT_RESULT: ASSERT(is_internal_ref(ref)); @@ -2895,45 +2907,69 @@ BIF_RETTYPE string_to_integer_1(BIF_ALIST_1) BIF_RET(TUPLE2(hp, res, tail)); } } - BIF_RETTYPE list_to_integer_1(BIF_ALIST_1) -{ + { + /* Using do_list_to_integer is about twice as fast as using + erts_chars_to_integer because we do not have to copy the + entire list */ Eterm res; Eterm dummy; /* must be a list */ - if (do_list_to_integer(BIF_P,BIF_ARG_1,&res,&dummy) != LTI_ALL_INTEGER) { BIF_ERROR(BIF_P,BADARG); } BIF_RET(res); } -/**********************************************************************/ +BIF_RETTYPE list_to_integer_2(BIF_ALIST_2) +{ -/* convert a float to a list of ascii characters */ + /* Bif implementation is about 50% faster than pure erlang, + and since we have erts_chars_to_integer now it is simpler + as well. This could be optmized further if we did not have to + copy the list to buf. */ + int i; + Eterm res; + char *buf = NULL; + int base; -BIF_RETTYPE float_to_list_1(BIF_ALIST_1) -{ - int i; - Uint need; - Eterm* hp; - FloatDef f; - char fbuf[30]; + i = list_length(BIF_ARG_1); + if (i < 0) + BIF_ERROR(BIF_P, BADARG); + + base = signed_val(BIF_ARG_2); + + if (base < 2 || base > 36) + BIF_ERROR(BIF_P, BADARG); + + /* Take fast path if base it 10 */ + if (base == 10) + return list_to_integer_1(BIF_P,&BIF_ARG_1); + + buf = (char *) erts_alloc(ERTS_ALC_T_TMP, i + 1); + + if (intlist_to_buf(BIF_ARG_1, buf, i) < 0) + goto list_to_integer_1_error; + buf[i] = '\0'; /* null terminal */ + + if ((res = erts_chars_to_integer(BIF_P,buf,i,base)) == THE_NON_VALUE) + goto list_to_integer_1_error; + + erts_free(ERTS_ALC_T_TMP, (void *) buf); + BIF_RET(res); + + list_to_integer_1_error: + erts_free(ERTS_ALC_T_TMP, (void *) buf); + BIF_ERROR(BIF_P, BADARG); - /* check the arguments */ - if (is_not_float(BIF_ARG_1)) - BIF_ERROR(BIF_P, BADARG); - GET_DOUBLE(BIF_ARG_1, f); - if ((i = sys_double_to_chars(f.fd, fbuf, sizeof(fbuf))) <= 0) - BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR); - need = i*2; - hp = HAlloc(BIF_P, need); - BIF_RET(buf_to_intlist(&hp, fbuf, i, NIL)); -} + } + +/**********************************************************************/ + +static int do_float_to_charbuf(Process *p, Eterm efloat, Eterm list, + char *fbuf, int sizeof_fbuf) { -BIF_RETTYPE float_to_list_2(BIF_ALIST_2) -{ const static int arity_two = make_arityval(2); int decimals = SYS_DEFAULT_FLOAT_DECIMALS; int compact = 0; @@ -2942,16 +2978,11 @@ BIF_RETTYPE float_to_list_2(BIF_ALIST_2) FMT_FIXED, FMT_SCIENTIFIC } fmt_type = FMT_LEGACY; - Eterm list = BIF_ARG_2; Eterm arg; - int i; - Uint need; - Eterm* hp; FloatDef f; - char fbuf[256]; /* check the arguments */ - if (is_not_float(BIF_ARG_1)) + if (is_not_float(efloat)) goto badarg; for(; is_list(list); list = CDR(list_val(list))) { @@ -2979,22 +3010,64 @@ BIF_RETTYPE float_to_list_2(BIF_ALIST_2) goto badarg; } - GET_DOUBLE(BIF_ARG_1, f); + GET_DOUBLE(efloat, f); if (fmt_type == FMT_FIXED) { - if ((i = sys_double_to_chars_fast(f.fd, fbuf, sizeof(fbuf), - decimals, compact)) <= 0) - goto badarg; + return sys_double_to_chars_fast(f.fd, fbuf, sizeof_fbuf, + decimals, compact); } else { - if ((i = sys_double_to_chars_ext(f.fd, fbuf, sizeof(fbuf), decimals)) <= 0) - goto badarg; + return sys_double_to_chars_ext(f.fd, fbuf, sizeof_fbuf, decimals); } - need = i*2; - hp = HAlloc(BIF_P, need); - BIF_RET(buf_to_intlist(&hp, fbuf, i, NIL)); badarg: + return -1; +} + +/* convert a float to a list of ascii characters */ + +static BIF_RETTYPE do_float_to_list(Process *BIF_P, Eterm arg, Eterm opts) { + int used; + Eterm* hp; + char fbuf[256]; + + if ((used = do_float_to_charbuf(BIF_P,arg,opts,fbuf,sizeof(fbuf))) <= 0) { BIF_ERROR(BIF_P, BADARG); + } + hp = HAlloc(BIF_P, (Uint)used*2); + BIF_RET(buf_to_intlist(&hp, fbuf, (Uint)used, NIL)); +} + + +BIF_RETTYPE float_to_list_1(BIF_ALIST_1) +{ + return do_float_to_list(BIF_P,BIF_ARG_1,NIL); +} + +BIF_RETTYPE float_to_list_2(BIF_ALIST_2) +{ + return do_float_to_list(BIF_P,BIF_ARG_1,BIF_ARG_2); +} + +/* convert a float to a binary of ascii characters */ + +static BIF_RETTYPE do_float_to_binary(Process *BIF_P, Eterm arg, Eterm opts) { + int used; + char fbuf[256]; + + if ((used = do_float_to_charbuf(BIF_P,arg,opts,fbuf,sizeof(fbuf))) <= 0) { + BIF_ERROR(BIF_P, BADARG); + } + BIF_RET(new_binary(BIF_P, (byte*)fbuf, (Uint)used)); +} + +BIF_RETTYPE float_to_binary_1(BIF_ALIST_1) +{ + return do_float_to_binary(BIF_P,BIF_ARG_1,NIL); +} + +BIF_RETTYPE float_to_binary_2(BIF_ALIST_2) +{ + return do_float_to_binary(BIF_P,BIF_ARG_1,BIF_ARG_2); } /**********************************************************************/ @@ -3179,36 +3252,101 @@ BIF_RETTYPE string_to_float_1(BIF_ALIST_1) BIF_RET(tup); } +static BIF_RETTYPE do_charbuf_to_float(Process *BIF_P,char *buf) { + FloatDef f; + Eterm res; + Eterm* hp; + + if (sys_chars_to_double(buf, &f.fd) != 0) + BIF_ERROR(BIF_P, BADARG); + + hp = HAlloc(BIF_P, FLOAT_SIZE_OBJECT); + res = make_float(hp); + PUT_DOUBLE(f, hp); + BIF_RET(res); + +} BIF_RETTYPE list_to_float_1(BIF_ALIST_1) { int i; - FloatDef f; Eterm res; - Eterm* hp; char *buf = NULL; i = list_length(BIF_ARG_1); - if (i < 0) { - badarg: - if (buf) - erts_free(ERTS_ALC_T_TMP, (void *) buf); - BIF_ERROR(BIF_P, BADARG); - } - + if (i < 0) + BIF_ERROR(BIF_P, BADARG); + buf = (char *) erts_alloc(ERTS_ALC_T_TMP, i + 1); if (intlist_to_buf(BIF_ARG_1, buf, i) < 0) - goto badarg; + goto list_to_float_1_error; buf[i] = '\0'; /* null terminal */ + + if ((res = do_charbuf_to_float(BIF_P,buf)) == THE_NON_VALUE) + goto list_to_float_1_error; + + erts_free(ERTS_ALC_T_TMP, (void *) buf); + BIF_RET(res); + + list_to_float_1_error: + erts_free(ERTS_ALC_T_TMP, (void *) buf); + BIF_ERROR(BIF_P, BADARG); + +} + +BIF_RETTYPE binary_to_float_1(BIF_ALIST_1) +{ + Eterm res; + Eterm binary = BIF_ARG_1; + Sint size; + byte* bytes, *buf; + Eterm* real_bin; + Uint offs = 0; + Uint bit_offs = 0; + + if (is_not_binary(binary) || (size = binary_size(binary)) == 0) + BIF_ERROR(BIF_P, BADARG); + + /* + * Unfortunately we have to copy the binary because we have to insert + * the '\0' at the end of the binary for strtod to work + * (there is no nstrtod :( ) + */ + + buf = erts_alloc(ERTS_ALC_T_TMP, size + 1); + + real_bin = binary_val(binary); + if (*real_bin == HEADER_SUB_BIN) { + ErlSubBin* sb = (ErlSubBin *) real_bin; + if (sb->bitsize) { + goto binary_to_float_1_error; + } + offs = sb->offs; + bit_offs = sb->bitoffs; + real_bin = binary_val(sb->orig); + } + if (*real_bin == HEADER_PROC_BIN) { + bytes = ((ProcBin *) real_bin)->bytes + offs; + } else { + bytes = (byte *)(&(((ErlHeapBin *) real_bin)->data)) + offs; + } + if (bit_offs) + erts_copy_bits(bytes, bit_offs, 1, buf, 0, 1, size*8); + else + memcpy(buf, bytes, size); + + buf[size] = '\0'; + + if ((res = do_charbuf_to_float(BIF_P,(char*)buf)) == THE_NON_VALUE) + goto binary_to_float_1_error; - if (sys_chars_to_double(buf, &f.fd) != 0) - goto badarg; - hp = HAlloc(BIF_P, FLOAT_SIZE_OBJECT); - res = make_float(hp); - PUT_DOUBLE(f, hp); erts_free(ERTS_ALC_T_TMP, (void *) buf); BIF_RET(res); + + binary_to_float_1_error: + erts_free(ERTS_ALC_T_TMP, (void *) buf); + BIF_ERROR(BIF_P, BADARG); } /**********************************************************************/ diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h index ceaf747875..51b77a95ed 100644 --- a/erts/emulator/beam/bif.h +++ b/erts/emulator/beam/bif.h @@ -35,6 +35,13 @@ extern Export* erts_format_cpu_topology_trap; #define BIF_ARG_2 (BIF__ARGS[1]) #define BIF_ARG_3 (BIF__ARGS[2]) +#define ERTS_IS_PROC_OUT_OF_REDS(p) \ + ((p)->fcalls > 0 \ + ? 0 \ + : (!ERTS_PROC_GET_SAVED_CALLS_BUF((p)) \ + ? (p)->fcalls == 0 \ + : ((p)->fcalls == -CONTEXT_REDS))) + #define BUMP_ALL_REDS(p) do { \ if (!ERTS_PROC_GET_SAVED_CALLS_BUF((p))) \ (p)->fcalls = 0; \ diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index e313188901..8bc994c8c3 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -561,6 +561,15 @@ bif erlang:prepare_loading/2 bif erlang:finish_loading/1 bif erlang:insert_element/3 bif erlang:delete_element/2 +bif erlang:binary_to_integer/1 +bif erlang:binary_to_integer/2 +bif erlang:integer_to_binary/1 +bif erlang:list_to_integer/2 +bif erlang:float_to_binary/1 +bif erlang:float_to_binary/2 +bif erlang:binary_to_float/1 + +bif io:printable_range/0 # # Obsolete diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c index 5a5b162b9c..acfcc845e4 100644 --- a/erts/emulator/beam/big.c +++ b/erts/emulator/beam/big.c @@ -1674,26 +1674,26 @@ int big_decimal_estimate(Wterm x) ** Convert a bignum into a string of decimal numbers */ -static void write_big(Wterm x, void (*write_func)(void *, char), void *arg) +static Uint write_big(Wterm x, void (*write_func)(void *, char), void *arg) { Eterm* xp = big_val(x); ErtsDigit* dx = BIG_V(xp); dsize_t xl = BIG_SIZE(xp); short sign = BIG_SIGN(xp); ErtsDigit rem; + Uint n = 0; if (xl == 1 && *dx < D_DECIMAL_BASE) { rem = *dx; - if (rem == 0) - (*write_func)(arg, '0'); - else { + if (rem == 0) { + (*write_func)(arg, '0'); n++; + } else { while(rem) { - (*write_func)(arg, (rem % 10) + '0'); + (*write_func)(arg, (rem % 10) + '0'); n++; rem /= 10; } } - } - else { + } else { ErtsDigit* tmp = (ErtsDigit*) erts_alloc(ERTS_ALC_T_TMP, sizeof(ErtsDigit)*xl); dsize_t tmpl = xl; @@ -1704,15 +1704,14 @@ static void write_big(Wterm x, void (*write_func)(void *, char), void *arg) tmpl = D_div(tmp, tmpl, D_DECIMAL_BASE, tmp, &rem); if (tmpl == 1 && *tmp == 0) { while(rem) { - (*write_func)(arg, (rem % 10)+'0'); + (*write_func)(arg, (rem % 10)+'0'); n++; rem /= 10; } break; - } - else { + } else { int i = D_DECIMAL_EXP; while(i--) { - (*write_func)(arg, (rem % 10)+'0'); + (*write_func)(arg, (rem % 10)+'0'); n++; rem /= 10; } } @@ -1720,8 +1719,10 @@ static void write_big(Wterm x, void (*write_func)(void *, char), void *arg) erts_free(ERTS_ALC_T_TMP, (void *) tmp); } - if (sign) - (*write_func)(arg, '-'); + if (sign) { + (*write_func)(arg, '-'); n++; + } + return n; } struct big_list__ { @@ -1762,6 +1763,20 @@ char *erts_big_to_string(Wterm x, char *buf, Uint buf_sz) return big_str; } +/* Bignum to binary bytes + * e.g. 1 bsl 64 -> "18446744073709551616" + */ + +Uint erts_big_to_binary_bytes(Eterm x, char *buf, Uint buf_sz) +{ + char *big_str = buf + buf_sz; + Uint n; + n = write_big(x, write_string, (void *) &big_str); + ASSERT(buf <= big_str && big_str <= buf + buf_sz); + return n; +} + + /* ** Normalize a bignum given thing pointer length in digits and a sign ** patch zero if odd length @@ -2467,3 +2482,209 @@ int term_equals_2pow32(Eterm x) return 0; } } + + +#define IS_VALID_CHARACTER(CHAR,BASE) \ + (CHAR < '0' \ + || (CHAR > ('0' + BASE - 1) \ + && !(BASE > 10 \ + && ((CHAR >= 'a' && CHAR < ('a' + BASE - 10)) \ + || (CHAR >= 'A' && CHAR < ('A' + BASE - 10)))))) +#define CHARACTER_FROM_BASE(CHAR) \ + ((CHAR <= '9') ? CHAR - '0' : 10 + ((CHAR <= 'Z') ? CHAR - 'A' : CHAR - 'a')) +#define D_BASE_EXP(BASE) (d_base_exp_lookup[BASE-2]) +#define D_BASE_BASE(BASE) (d_base_base_lookup[BASE-2]) +#define LG2_LOOKUP(BASE) (lg2_lookup[base-2]) + +/* + * for i in 2..64 do + * lg2_lookup[i-2] = log2(i) + * end + * How many bits are needed to store string of size n + */ +const double lg2_lookup[] = { 1.0, 1.58496, 2, 2.32193, 2.58496, 2.80735, 3.0, + 3.16993, 3.32193, 3.45943, 3.58496, 3.70044, 3.80735, 3.90689, 4.0, + 4.08746, 4.16993, 4.24793, 4.32193, 4.39232, 4.45943, 4.52356, 4.58496, + 4.64386, 4.70044, 4.75489, 4.80735, 4.85798, 4.90689, 4.9542, 5.0, + 5.04439, 5.08746, 5.12928, 5.16993, 5.20945, 5.24793, 5.2854, 5.32193, + 5.35755, 5.39232, 5.42626, 5.45943, 5.49185, 5.52356, 5.55459, 5.58496, + 5.61471, 5.64386, 5.67243, 5.70044, 5.72792, 5.75489, 5.78136, 5.80735, + 5.83289, 5.85798, 5.88264, 5.90689, 5.93074, 5.9542, 5.97728, 6.0 }; + +/* + * for i in 2..64 do + * d_base_exp_lookup[i-2] = 31 / lg2_lookup[i-2]; + * end + * How many characters can fit in 31 bits + */ +const byte d_base_exp_lookup[] = { 31, 19, 15, 13, 11, 11, 10, 9, 9, 8, 8, 8, 8, + 7, 7, 7, 7, 7, 7, 7, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5 }; + +/* + * for i in 2..64 do + * d_base_base_lookup[i-2] = pow(i,d_base_exp_lookup[i-2]); + * end + * How much can the characters which fit in 31 bit represent + */ +const Uint d_base_base_lookup[] = { 2147483648, 1162261467, 1073741824, + 1220703125, 362797056, 1977326743, 1073741824, 387420489, 1000000000, + 214358881, 429981696, 815730721, 1475789056, 170859375, 268435456, + 410338673, 612220032, 893871739, 1280000000, 1801088541, 113379904, + 148035889, 191102976, 244140625, 308915776, 387420489, 481890304, + 594823321, 729000000, 887503681, 1073741824, 1291467969, 1544804416, + 1838265625, 60466176, 69343957, 79235168, 90224199, 102400000, + 115856201, 130691232, 147008443, 164916224, 184528125, 205962976, + 229345007, 254803968, 282475249, 312500000, 345025251, 380204032, + 418195493, 459165024, 503284375, 550731776, 601692057, 656356768, + 714924299, 777600000, 844596301, 916132832, 992436543, 1073741824 }; + +Eterm erts_chars_to_integer(Process *BIF_P, char *bytes, + Uint size, const int base) { + Eterm res; + Sint i = 0; + int n = 0; + int neg = 0; + byte b; + Eterm *hp, *hp_end; + int m; + int lg2; + + if (size == 0) + goto bytebuf_to_integer_1_error; + + if (bytes[0] == '-') { + neg = 1; + bytes++; + size--; + + } else if (bytes[0] == '+') { + bytes++; + size--; + } + + if (size < SMALL_DIGITS && base <= 10) { + /* * + * Take shortcut if we know that all chars are '0' < b < '9' and + * fit in a small. This improves speed by about 10% over the generic + * small case. + * */ + while (size--) { + b = *bytes++; + + if (b < '0' || b > ('0'+base-1)) + goto bytebuf_to_integer_1_error; + + i = i * base + b - '0'; + } + + if (neg) + i = -i; + res = make_small(i); + goto bytebuf_to_integer_1_done; + } + + /* + * Calculate the maximum number of bits which will + * be needed to represent the binary + */ + lg2 = ((size+2)*LG2_LOOKUP(base)+1); + + if (lg2 < SMALL_BITS) { + /* Take shortcut if we know it will fit in a small. + * This improves speed by about 30%. + */ + while (size) { + b = *bytes++; + size--; + + if (IS_VALID_CHARACTER(b,base)) + goto bytebuf_to_integer_1_error; + + i = i * base + CHARACTER_FROM_BASE(b); + + } + + if (neg) + i = -i; + res = make_small(i); + goto bytebuf_to_integer_1_done; + + } + + /* Start calculating bignum */ + m = (lg2 + D_EXP-1)/D_EXP; + m = BIG_NEED_SIZE(m); + + hp = HAlloc(BIF_P, m); + hp_end = hp + m; + + if ((i = (size % D_BASE_EXP(base))) == 0) + i = D_BASE_EXP(base); + + n = size - i; + m = 0; + + while (i--) { + b = *bytes++; + + if (IS_VALID_CHARACTER(b,base)) { + HRelease(BIF_P, hp_end, hp); + goto bytebuf_to_integer_1_error; + } + + m = base * m + CHARACTER_FROM_BASE(b); + } + + res = small_to_big(m, hp); + + while (n) { + i = D_BASE_EXP(base); + n -= D_BASE_EXP(base); + m = 0; + while (i--) { + b = *bytes++; + + if (IS_VALID_CHARACTER(b,base)) { + HRelease(BIF_P, hp_end, hp); + goto bytebuf_to_integer_1_error; + } + + m = base * m + CHARACTER_FROM_BASE(b); + } + if (is_small(res)) { + res = small_to_big(signed_val(res), hp); + } + res = big_times_small(res, D_BASE_BASE(base), hp); + if (is_small(res)) { + res = small_to_big(signed_val(res), hp); + } + res = big_plus_small(res, m, hp); + } + + if (is_big(res)) /* check if small */ + res = big_plus_small(res, 0, hp); /* includes conversion to small */ + + if (neg) { + if (is_small(res)) + res = make_small(-signed_val(res)); + else { + Uint *big = big_val(res); /* point to thing */ + *big = bignum_header_neg(*big); + } + } + + if (is_big(res)) { + hp += (big_arity(res) + 1); + } + HRelease(BIF_P, hp_end, hp); + goto bytebuf_to_integer_1_done; + +bytebuf_to_integer_1_error: + return THE_NON_VALUE; + +bytebuf_to_integer_1_done: + return res; + +} diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h index 7eb1e5afe2..c74283b9e5 100644 --- a/erts/emulator/beam/big.h +++ b/erts/emulator/beam/big.h @@ -117,6 +117,7 @@ typedef Uint dsize_t; /* Vector size type */ int big_decimal_estimate(Wterm); Eterm erts_big_to_list(Eterm, Eterm**); char *erts_big_to_string(Wterm x, char *buf, Uint buf_sz); +Uint erts_big_to_binary_bytes(Eterm x, char *buf, Uint buf_sz); Eterm small_times(Sint, Sint, Eterm*); @@ -165,5 +166,7 @@ int term_equals_2pow32(Eterm); Eterm erts_uint64_to_big(Uint64, Eterm **); Eterm erts_sint64_to_big(Sint64, Eterm **); +Eterm erts_chars_to_integer(Process *, char*, Uint, const int); + #endif diff --git a/erts/emulator/beam/binary.c b/erts/emulator/beam/binary.c index dad13f1067..33abac2f3d 100644 --- a/erts/emulator/beam/binary.c +++ b/erts/emulator/beam/binary.c @@ -240,6 +240,98 @@ erts_bin_bytes_to_list(Eterm previous, Eterm* hp, byte* bytes, Uint size, Uint b return previous; } +BIF_RETTYPE binary_to_integer_1(BIF_ALIST_1) +{ + byte *temp_alloc = NULL; + char *bytes; + Uint size; + Eterm res; + + if ((bytes = (char*)erts_get_aligned_binary_bytes(BIF_ARG_1, &temp_alloc)) + == NULL ) + goto binary_to_integer_1_error; + + size = binary_size(BIF_ARG_1); + + if ((res = erts_chars_to_integer(BIF_P,bytes,size,10)) != THE_NON_VALUE) { + erts_free_aligned_binary_bytes(temp_alloc); + return res; + } + + binary_to_integer_1_error: + erts_free_aligned_binary_bytes(temp_alloc); + BIF_ERROR(BIF_P, BADARG); +} + +BIF_RETTYPE binary_to_integer_2(BIF_ALIST_2) +{ + byte *temp_alloc = NULL; + char *bytes; + Uint size; + int base; + Eterm res; + + if (!is_small(BIF_ARG_2)) + BIF_ERROR(BIF_P, BADARG); + + base = signed_val(BIF_ARG_2); + + if (base < 2 || base > 36) + BIF_ERROR(BIF_P, BADARG); + + if ((bytes = (char*)erts_get_aligned_binary_bytes(BIF_ARG_1, &temp_alloc)) + == NULL ) + goto binary_to_integer_2_error; + + size = binary_size(BIF_ARG_1); + + if ((res = erts_chars_to_integer(BIF_P,bytes,size,base)) != THE_NON_VALUE) { + erts_free_aligned_binary_bytes(temp_alloc); + return res; + } + + binary_to_integer_2_error: + + erts_free_aligned_binary_bytes(temp_alloc); + BIF_ERROR(BIF_P, BADARG); + +} + +BIF_RETTYPE integer_to_binary_1(BIF_ALIST_1) +{ + Uint size; + Eterm res; + + if (is_not_integer(BIF_ARG_1)) { + BIF_ERROR(BIF_P, BADARG); + } + + if (is_small(BIF_ARG_1)) { + char *c; + struct Sint_buf ibuf; + + /* Enhancement: If we can calculate the buffer size exactly + * we could avoid an unnecessary copy of buffers. + * Useful if size determination is faster than a copy. + */ + c = Sint_to_buf(signed_val(BIF_ARG_1), &ibuf); + size = sys_strlen(c); + res = new_binary(BIF_P, (byte *)c, size); + } else { + byte* bytes; + Uint n = 0; + + /* Here we also have multiple copies of buffers + * due to new_binary interface + */ + size = big_decimal_estimate(BIF_ARG_1) - 1; /* remove null */ + bytes = (byte*) erts_alloc(ERTS_ALC_T_TMP, sizeof(byte)*size); + n = erts_big_to_binary_bytes(BIF_ARG_1, (char *)bytes, size); + res = new_binary(BIF_P, bytes + size - n, n); + erts_free(ERTS_ALC_T_TMP, (void *) bytes); + } + BIF_RET(res); +} BIF_RETTYPE binary_to_list_1(BIF_ALIST_1) { diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index 59fe7ea418..0781665f05 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -2698,7 +2698,7 @@ BIF_RETTYPE setnode_3(BIF_ALIST_3) */ { ErlDrvSizeT disable = ERL_DRV_BUSY_MSGQ_DISABLED; - erl_drv_busy_msgq_limits((ErlDrvPort) pp, &disable, NULL); + erl_drv_busy_msgq_limits(ERTS_Port2ErlDrvPort(pp), &disable, NULL); } pp->dist_entry = dep; diff --git a/erts/emulator/beam/erl_async.c b/erts/emulator/beam/erl_async.c index f2ca193ace..831e29d8a2 100644 --- a/erts/emulator/beam/erl_async.c +++ b/erts/emulator/beam/erl_async.c @@ -612,8 +612,8 @@ long driver_async(ErlDrvPort ix, unsigned int* key, sched_id = 1; #endif - prt = erts_drvport2port(ix, NULL); - if (!prt) + prt = erts_drvport2port(ix); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); diff --git a/erts/emulator/beam/erl_bif_ddll.c b/erts/emulator/beam/erl_bif_ddll.c index 7cea0bc2eb..1c3e955f47 100644 --- a/erts/emulator/beam/erl_bif_ddll.c +++ b/erts/emulator/beam/erl_bif_ddll.c @@ -141,7 +141,7 @@ kill_ports_driver_unloaded(DE_Handle *dh) state = erts_atomic32_read_nob(&prt->state); if (!(state & ERTS_PORT_SFLGS_DEAD) && prt->drv_ptr->handle == dh) - driver_failure_atom((ErlDrvPort) prt, "driver_unloaded"); + driver_failure_atom(ERTS_Port2ErlDrvPort(prt), "driver_unloaded"); erts_port_release(prt); } diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h index a9a50a10bf..e280563de1 100644 --- a/erts/emulator/beam/erl_driver.h +++ b/erts/emulator/beam/erl_driver.h @@ -408,6 +408,11 @@ EXTERN int driver_cancel_timer(ErlDrvPort port); EXTERN int driver_read_timer(ErlDrvPort port, unsigned long *time_left); /* + * Inform runtime system about lengthy work. + */ +EXTERN int erl_drv_consume_timeslice(ErlDrvPort port, int percent); + +/* * Get plain-text error message from within a driver */ EXTERN char* erl_errno_id(int error); diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index ec3e0d54cb..83853dcd43 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -496,7 +496,7 @@ void erts_usage(void) erts_fprintf(stderr, "-d don't write a crash dump for internally detected errors\n"); erts_fprintf(stderr, " (halt(String) will still produce a crash dump)\n"); - + erts_fprintf(stderr, "-fn[u|a|l] Control how filenames are interpreted\n"); erts_fprintf(stderr, "-hms size set minimum heap size in words (default %d)\n", H_DEFAULT_SIZE); erts_fprintf(stderr, "-hmbs size set minimum binary virtual heap size in words (default %d)\n", @@ -509,7 +509,7 @@ void erts_usage(void) erts_fprintf(stderr, " Note that this flag is deprecated!\n"); erts_fprintf(stderr, "-M<X> <Y> memory allocator switches,\n"); erts_fprintf(stderr, " see the erts_alloc(3) documentation for more info.\n"); - + erts_fprintf(stderr, "-pc <set> Control what characters are considered printable (default latin1)\n"); erts_fprintf(stderr, "-P number set maximum number of processes on this node,\n"); erts_fprintf(stderr, " valid range is [%d-%d]\n", ERTS_MIN_PROCESSES, ERTS_MAX_PROCESSES); @@ -979,13 +979,30 @@ erl_start(int argc, char **argv) VERBOSE(DEBUG_SYSTEM, ("using display items %d\n",display_items)); break; + case 'p': + if (!strncmp(argv[i],"-pc",3)) { + int printable_chars = ERL_PRINTABLE_CHARACTERS_LATIN1; + arg = get_arg(argv[i]+3, argv[i+1], &i); + if (!strcmp(arg,"unicode")) { + printable_chars = ERL_PRINTABLE_CHARACTERS_UNICODE; + } else if (strcmp(arg,"latin1")) { + erts_fprintf(stderr, "bad range of printable " + "characters: %s\n", arg); + erts_usage(); + } + erts_set_printable_characters(printable_chars); + break; + } else { + erts_fprintf(stderr, "%s unknown flag %s\n", argv[0], argv[i]); + erts_usage(); + } case 'f': if (!strncmp(argv[i],"-fn",3)) { int warning_type = ERL_FILENAME_WARNING_WARNING; arg = get_arg(argv[i]+3, argv[i+1], &i); switch (*arg) { case 'u': - switch (*(argv[i]+4)) { + switch (*(arg+1)) { case 'w': case 0: break; @@ -997,7 +1014,7 @@ erl_start(int argc, char **argv) break; default: erts_fprintf(stderr, "bad type of warnings for " - "wrongly coded filename: %s\n", argv[i]+4); + "wrongly coded filename: %s\n", arg+1); erts_usage(); } erts_set_user_requested_filename_encoding @@ -1014,7 +1031,7 @@ erl_start(int argc, char **argv) ); break; case 'a': - switch (*(argv[i]+4)) { + switch (*(arg+1)) { case 'w': case 0: break; @@ -1026,7 +1043,7 @@ erl_start(int argc, char **argv) break; default: erts_fprintf(stderr, "bad type of warnings for " - "wrongly coded filename: %s\n", argv[i]+4); + "wrongly coded filename: %s\n", arg+1); erts_usage(); } erts_set_user_requested_filename_encoding diff --git a/erts/emulator/beam/erl_port.h b/erts/emulator/beam/erl_port.h index 65b4cd0bfe..ac4f7af5a7 100644 --- a/erts/emulator/beam/erl_port.h +++ b/erts/emulator/beam/erl_port.h @@ -40,7 +40,29 @@ extern int erts_port_parallelism; typedef struct erts_driver_t_ erts_driver_t; -#define ERTS_INVALID_ERL_DRV_PORT ((ErlDrvPort) (SWord) -1) +/* + * It would have been preferred to use NULL as value of + * ERTS_INVALID_ERL_DRV_PORT. That would, however, not be + * backward compatible. In pre-R16 systems, 0 was a valid + * port handle and -1 was used as invalid handle, so we + * are stuck with it. + */ +#define ERTS_INVALID_ERL_DRV_PORT ((struct _erl_drv_port *) ((SWord) -1)) +#ifdef DEBUG +/* Make sure we use this api, and do not cast directly */ +#define ERTS_ErlDrvPort2Port(PH) \ + ((PH) == ERTS_INVALID_ERL_DRV_PORT \ + ? ERTS_INVALID_ERL_DRV_PORT \ + : ((Port *) ((PH) - 4711))) +#define ERTS_Port2ErlDrvPort(PH) \ + ((PH) == ERTS_INVALID_ERL_DRV_PORT \ + ? ERTS_INVALID_ERL_DRV_PORT \ + : ((ErlDrvPort) ((PH) + 4711))) +#else +#define ERTS_ErlDrvPort2Port(PH) ((Port *) (PH)) +#define ERTS_Port2ErlDrvPort(PH) ((ErlDrvPort) (PH)) +#endif + #define SMALL_IO_QUEUE 5 /* Number of fixed elements */ typedef struct { @@ -153,6 +175,7 @@ struct _erl_drv_port { ErlDrvPDL port_data_lock; ErtsPrtSD *psd; /* Port specific data */ + int reds; /* Only used while executing driver callbacks */ }; #define ERTS_PORT_GET_CONNECTED(PRT) \ @@ -429,16 +452,16 @@ ERTS_GLB_INLINE void erts_port_release(Port *); ERTS_GLB_INLINE Port *erts_thr_id2port_sflgs(Eterm id, Uint32 invalid_sflgs); ERTS_GLB_INLINE void erts_thr_port_release(Port *prt); #endif -ERTS_GLB_INLINE Port *erts_thr_drvport2port_raw(ErlDrvPort, int); -ERTS_GLB_INLINE Port *erts_drvport2port_raw(ErlDrvPort drvport); -ERTS_GLB_INLINE Port *erts_drvport2port(ErlDrvPort, erts_aint32_t *); -ERTS_GLB_INLINE Port *erts_drvportid2port(Eterm); +ERTS_GLB_INLINE Port *erts_thr_drvport2port(ErlDrvPort, int); +ERTS_GLB_INLINE Port *erts_drvport2port_state(ErlDrvPort, erts_aint32_t *); ERTS_GLB_INLINE Eterm erts_drvport2id(ErlDrvPort); ERTS_GLB_INLINE Uint32 erts_portid2status(Eterm); ERTS_GLB_INLINE int erts_is_port_alive(Eterm); ERTS_GLB_INLINE int erts_is_valid_tracer_port(Eterm); ERTS_GLB_INLINE int erts_port_driver_callback_epilogue(Port *, erts_aint32_t *); +#define erts_drvport2port(Prt) erts_drvport2port_state((Prt), NULL) + #if ERTS_GLB_INLINE_INCL_FUNC_DEF ERTS_GLB_INLINE Port *erts_pix2port(int ix) @@ -620,90 +643,72 @@ erts_thr_port_release(Port *prt) #endif -ERTS_GLB_INLINE Port* -erts_thr_drvport2port_raw(ErlDrvPort drvport, int lock_pdl) +ERTS_GLB_INLINE Port * +erts_thr_drvport2port(ErlDrvPort drvport, int lock_pdl) { + Port *prt = ERTS_ErlDrvPort2Port(drvport); + ASSERT(prt != NULL); + if (prt == ERTS_INVALID_ERL_DRV_PORT) + return ERTS_INVALID_ERL_DRV_PORT; + + if (lock_pdl && prt->port_data_lock) + driver_pdl_lock(prt->port_data_lock); + #if ERTS_ENABLE_LOCK_CHECK - int emu_thread = erts_lc_is_emu_thr(); -#endif - if (drvport == ERTS_INVALID_ERL_DRV_PORT) - return NULL; - else { - Port *prt = (Port *) drvport; - if (lock_pdl && prt->port_data_lock) - driver_pdl_lock(prt->port_data_lock); -#if ERTS_ENABLE_LOCK_CHECK - if (!ERTS_IS_CRASH_DUMPING) { - if (emu_thread) { - ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); - ERTS_LC_ASSERT(!prt->port_data_lock - || erts_lc_mtx_is_locked(&prt->port_data_lock->mtx)); - } - else { - ERTS_LC_ASSERT(prt->port_data_lock); - ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&prt->port_data_lock->mtx)); - } + if (!ERTS_IS_CRASH_DUMPING) { + if (erts_lc_is_emu_thr()) { + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + ERTS_LC_ASSERT(!prt->port_data_lock + || erts_lc_mtx_is_locked(&prt->port_data_lock->mtx)); + } + else { + ERTS_LC_ASSERT(prt->port_data_lock); + ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&prt->port_data_lock->mtx)); } -#endif - return prt; } -} +#endif -ERTS_GLB_INLINE Port* -erts_drvport2port_raw(ErlDrvPort drvport) -{ - ERTS_LC_ASSERT(erts_lc_is_emu_thr()); - if (drvport == ERTS_INVALID_ERL_DRV_PORT) - return NULL; - else { - Port *prt = (Port *) drvport; - ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt) - || ERTS_IS_CRASH_DUMPING); - return prt; + if (erts_atomic32_read_nob(&prt->state) + & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) { + if (lock_pdl && prt->port_data_lock) + driver_pdl_unlock(prt->port_data_lock); + return ERTS_INVALID_ERL_DRV_PORT; } -} - -ERTS_GLB_INLINE Port* -erts_drvport2port(ErlDrvPort drvport, erts_aint32_t *statep) -{ - Port *prt = erts_drvport2port_raw(drvport); - erts_aint32_t state; - if (!prt) - return NULL; - state = erts_atomic32_read_nob(&prt->state); - if (state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) - return NULL; - if (statep) - *statep = state; return prt; } -ERTS_GLB_INLINE Port* -erts_drvportid2port(Eterm id) +ERTS_GLB_INLINE Port * +erts_drvport2port_state(ErlDrvPort drvport, erts_aint32_t *statep) { - Port *prt; + Port *prt = ERTS_ErlDrvPort2Port(drvport); erts_aint32_t state; - if (is_not_internal_port(id)) - return NULL; - prt = (Port *) erts_ptab_pix2intptr_nob(&erts_port, - internal_port_index(id)); - if (!prt) - return NULL; + ASSERT(prt); + ERTS_LC_ASSERT(erts_lc_is_emu_thr()); + if (prt == ERTS_INVALID_ERL_DRV_PORT) + return ERTS_INVALID_ERL_DRV_PORT; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt) || ERTS_IS_CRASH_DUMPING); - if (prt->common.id != id) - return NULL; + /* + * This state check is only needed since a driver callback + * might terminate the port, and then call back into the + * emulator. Drivers should preferably have been forbidden + * to call into the emulator after terminating the port, + * but it has been like this for ages. Perhaps forbid this + * in some future major release? + */ state = erts_atomic32_read_nob(&prt->state); if (state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) - return NULL; + return ERTS_INVALID_ERL_DRV_PORT; + if (statep) + *statep = state; return prt; } ERTS_GLB_INLINE Eterm erts_drvport2id(ErlDrvPort drvport) { - Port *prt = erts_drvport2port_raw(drvport); - if (!prt) + Port *prt = erts_drvport2port(drvport); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return am_undefined; else return prt->common.id; diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c index dbc4a06c2d..ce045ec94e 100644 --- a/erts/emulator/beam/erl_port_task.c +++ b/erts/emulator/beam/erl_port_task.c @@ -685,12 +685,12 @@ enqueue_proc2port_data(Port *pp, void erl_drv_busy_msgq_limits(ErlDrvPort dport, ErlDrvSizeT *lowp, ErlDrvSizeT *highp) { - Port *pp = erts_drvport2port(dport, NULL); - ErtsPortTaskBusyPortQ *bpq = pp->sched.taskq.bpq; + Port *pp = erts_drvport2port(dport); + ErtsPortTaskBusyPortQ *bpq; int written = 0, resume_procs = 0; ErlDrvSizeT low, high; - if (!pp || !bpq) { + if (pp == ERTS_INVALID_ERL_DRV_PORT || !(bpq = pp->sched.taskq.bpq)) { if (lowp) *lowp = ERL_DRV_BUSY_MSGQ_DISABLED; if (highp) @@ -1160,6 +1160,27 @@ select_task_for_exec(Port *pp, } /* + * Cut time slice + */ + +int +erl_drv_consume_timeslice(ErlDrvPort dprt, int percent) +{ + Port *pp = erts_drvport2port(dprt); + if (pp == ERTS_INVALID_ERL_DRV_PORT) + return -1; + if (percent < 1) + percent = 1; + else if (100 < percent) + percent = 100; + pp->reds += percent*((CONTEXT_REDS+99)/100); + if (pp->reds < CONTEXT_REDS) + return 0; + pp->reds = CONTEXT_REDS; + return 1; +} + +/* * Abort a scheduled task. */ @@ -1509,7 +1530,6 @@ fail: void erts_port_task_free_port(Port *pp) { - ErtsProcList *suspended; erts_aint32_t flags; ErtsRunQueue *runq; @@ -1522,19 +1542,16 @@ erts_port_task_free_port(Port *pp) erts_port_task_sched_lock(&pp->sched); flags = erts_smp_atomic32_read_bor_relb(&pp->sched.flags, ERTS_PTS_FLG_EXIT); - suspended = pp->suspended; - pp->suspended = NULL; erts_port_task_sched_unlock(&pp->sched); erts_atomic32_read_bset_relb(&pp->state, - (ERTS_PORT_SFLG_CLOSING + (ERTS_PORT_SFLG_CONNECTED + | ERTS_PORT_SFLG_EXITING + | ERTS_PORT_SFLG_CLOSING | ERTS_PORT_SFLG_FREE), ERTS_PORT_SFLG_FREE); erts_smp_runq_unlock(runq); - if (erts_proclist_fetch(&suspended, NULL)) - erts_resume_processes(suspended); - if (!(flags & (ERTS_PTS_FLG_IN_RUNQ|ERTS_PTS_FLG_EXEC))) begin_port_cleanup(pp, NULL, NULL); } @@ -1554,7 +1571,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) int processing_busy_q; int res = 0; int vreds = 0; - int reds = ERTS_PORT_REDS_EXECUTE; + int reds = 0; erts_aint_t io_tasks_executed = 0; int fpe_was_unmasked; erts_aint32_t state; @@ -1599,6 +1616,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) fpe_was_unmasked = erts_block_fpe(); state = erts_atomic32_read_nob(&pp->state); + pp->reds = ERTS_PORT_REDS_EXECUTE; goto begin_handle_tasks; while (1) { @@ -1625,14 +1643,14 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) switch (ptp->type) { case ERTS_PORT_TASK_TIMEOUT: - reds += ERTS_PORT_REDS_TIMEOUT; + reds = ERTS_PORT_REDS_TIMEOUT; if (!(state & ERTS_PORT_SFLGS_DEAD)) { DTRACE_DRIVER(driver_timeout, pp); (*pp->drv_ptr->timeout)((ErlDrvData) pp->drv_data); } break; case ERTS_PORT_TASK_INPUT: - reds += ERTS_PORT_REDS_INPUT; + reds = ERTS_PORT_REDS_INPUT; ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0); DTRACE_DRIVER(driver_ready_input, pp); /* NOTE some windows drivers use ->ready_input for input and output */ @@ -1641,7 +1659,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) io_tasks_executed++; break; case ERTS_PORT_TASK_OUTPUT: - reds += ERTS_PORT_REDS_OUTPUT; + reds = ERTS_PORT_REDS_OUTPUT; ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0); DTRACE_DRIVER(driver_ready_output, pp); (*pp->drv_ptr->ready_output)((ErlDrvData) pp->drv_data, @@ -1649,7 +1667,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) io_tasks_executed++; break; case ERTS_PORT_TASK_EVENT: - reds += ERTS_PORT_REDS_EVENT; + reds = ERTS_PORT_REDS_EVENT; ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0); DTRACE_DRIVER(driver_event, pp); (*pp->drv_ptr->event)((ErlDrvData) pp->drv_data, @@ -1661,22 +1679,22 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) ErtsProc2PortSigData *sigdp = &ptp->u.alive.td.psig.data; ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0); if (!pp->sched.taskq.bpq) - reds += ptp->u.alive.td.psig.callback(pp, - state, - ERTS_PROC2PORT_SIG_EXEC, - sigdp); + reds = ptp->u.alive.td.psig.callback(pp, + state, + ERTS_PROC2PORT_SIG_EXEC, + sigdp); else { ErlDrvSizeT size = erts_proc2port_sig_command_data_size(sigdp); - reds += ptp->u.alive.td.psig.callback(pp, - state, - ERTS_PROC2PORT_SIG_EXEC, - sigdp); + reds = ptp->u.alive.td.psig.callback(pp, + state, + ERTS_PROC2PORT_SIG_EXEC, + sigdp); dequeued_proc2port_data(pp, size); } break; } case ERTS_PORT_TASK_DIST_CMD: - reds += erts_dist_command(pp, CONTEXT_REDS-reds); + reds = erts_dist_command(pp, CONTEXT_REDS - pp->reds); break; default: erl_exit(ERTS_ABORT_EXIT, @@ -1701,7 +1719,10 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) vreds += ERTS_PORT_CALLBACK_VREDS; reds += ERTS_PORT_CALLBACK_VREDS; - if (reds >= CONTEXT_REDS) + pp->reds += reds; + reds = 0; + + if (pp->reds >= CONTEXT_REDS) break; } @@ -1725,6 +1746,8 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) active = finalize_exec(pp, &execq, processing_busy_q); + reds = pp->reds - vreds; + erts_port_release(pp); *curr_port_pp = NULL; @@ -1770,7 +1793,6 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) res = (erts_smp_atomic_read_nob(&erts_port_task_outstanding_io_tasks) != (erts_aint_t) 0); - reds -= vreds; runq->scheduler->reductions += reds; ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq)); @@ -1793,10 +1815,11 @@ begin_port_cleanup(Port *pp, ErtsPortTask **execqp, int *processing_busy_q_p) int i, max; ErtsPortTaskBusyCallerTable *tabp; ErtsPortTask *qs[3]; + ErtsPortTaskHandleList *free_nshp = NULL; + ErtsProcList *plp; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(pp)); - /* * Abort remaining tasks... * @@ -1935,7 +1958,42 @@ begin_port_cleanup(Port *pp, ErtsPortTask **execqp, int *processing_busy_q_p) erts_smp_atomic32_read_band_nob(&pp->sched.flags, ~(ERTS_PTS_FLG_HAVE_BUSY_TASKS - |ERTS_PTS_FLG_HAVE_TASKS)); + |ERTS_PTS_FLG_HAVE_TASKS + |ERTS_PTS_FLGS_BUSY)); + + erts_port_task_sched_lock(&pp->sched); + + /* Cleanup nosuspend handles... */ + free_nshp = (pp->sched.taskq.local.busy.nosuspend + ? get_free_nosuspend_handles(pp) + : NULL); + ASSERT(!pp->sched.taskq.local.busy.nosuspend); + + /* Make sure not to leave any processes suspended on the port... */ + plp = pp->suspended; + pp->suspended = NULL; + + erts_port_task_sched_unlock(&pp->sched); + + if (free_nshp) + free_nosuspend_handles(free_nshp); + + if (erts_proclist_fetch(&plp, NULL)) { +#ifdef USE_VM_PROBES + if (DTRACE_ENABLED(process_port_unblocked)) { + DTRACE_CHARBUF(port_str, 16); + DTRACE_CHARBUF(pid_str, 16); + ErtsProcList* plp2 = plp; + + erts_snprintf(port_str, sizeof(port_str), "%T", pp->common.id); + while (plp2 != NULL) { + erts_snprintf(pid_str, sizeof(pid_str), "%T", plp2->pid); + DTRACE2(process_port_unblocked, pid_str, port_str); + } + } +#endif + erts_resume_processes(plp); + } /* * Schedule cleanup of port structure... diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 96af19fb83..00247b387a 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -4311,8 +4311,7 @@ erts_sched_set_wakeup_other_type(char *str) wakeup_other.type = type; return 0; #else - if (sys_strcmp(str, "proposal") == 0 || sys_strcmp(str, "default") == 0 || - sys_strcmp(str, "legacy") == 0) { + if (sys_strcmp(str, "default") == 0 || sys_strcmp(str, "legacy") == 0) { return 0; } return EINVAL; diff --git a/erts/emulator/beam/erl_smp.h b/erts/emulator/beam/erl_smp.h index 34c90c0bda..0dd9e29e8e 100644 --- a/erts/emulator/beam/erl_smp.h +++ b/erts/emulator/beam/erl_smp.h @@ -259,6 +259,9 @@ ERTS_GLB_INLINE void erts_smp_thr_sigwait(const sigset_t *set, int *sig); #define erts_smp_dw_atomic_read_wb erts_dw_atomic_read_wb #define erts_smp_dw_atomic_cmpxchg_wb erts_dw_atomic_cmpxchg_wb +#define erts_smp_dw_atomic_set_dirty erts_dw_atomic_set_dirty +#define erts_smp_dw_atomic_read_dirty erts_dw_atomic_read_dirty + /* Word size atomics */ #define erts_smp_atomic_init_nob erts_atomic_init_nob @@ -366,6 +369,9 @@ ERTS_GLB_INLINE void erts_smp_thr_sigwait(const sigset_t *set, int *sig); #define erts_smp_atomic_cmpxchg_wb erts_atomic_cmpxchg_wb #define erts_smp_atomic_read_bset_wb erts_atomic_read_bset_wb +#define erts_smp_atomic_set_dirty erts_atomic_set_dirty +#define erts_smp_atomic_read_dirty erts_atomic_read_dirty + /* 32-bit atomics */ #define erts_smp_atomic32_init_nob erts_atomic32_init_nob @@ -473,6 +479,9 @@ ERTS_GLB_INLINE void erts_smp_thr_sigwait(const sigset_t *set, int *sig); #define erts_smp_atomic32_cmpxchg_wb erts_atomic32_cmpxchg_wb #define erts_smp_atomic32_read_bset_wb erts_atomic32_read_bset_wb +#define erts_smp_atomic32_set_dirty erts_atomic32_set_dirty +#define erts_smp_atomic32_read_dirty erts_atomic32_read_dirty + #else /* !ERTS_SMP */ /* Double word size atomics */ @@ -512,6 +521,9 @@ ERTS_GLB_INLINE void erts_smp_thr_sigwait(const sigset_t *set, int *sig); #define erts_smp_dw_atomic_read_wb erts_no_dw_atomic_read #define erts_smp_dw_atomic_cmpxchg_wb erts_no_dw_atomic_cmpxchg +#define erts_smp_dw_atomic_set_dirty erts_no_dw_atomic_set +#define erts_smp_dw_atomic_read_dirty erts_no_dw_atomic_read + /* Word size atomics */ #define erts_smp_atomic_init_nob erts_no_atomic_set @@ -619,6 +631,9 @@ ERTS_GLB_INLINE void erts_smp_thr_sigwait(const sigset_t *set, int *sig); #define erts_smp_atomic_cmpxchg_wb erts_no_atomic_cmpxchg #define erts_smp_atomic_read_bset_wb erts_no_atomic_read_bset +#define erts_smp_atomic_set_dirty erts_no_atomic_set +#define erts_smp_atomic_read_dirty erts_no_atomic_read + /* 32-bit atomics */ #define erts_smp_atomic32_init_nob erts_no_atomic32_set @@ -726,6 +741,9 @@ ERTS_GLB_INLINE void erts_smp_thr_sigwait(const sigset_t *set, int *sig); #define erts_smp_atomic32_cmpxchg_wb erts_no_atomic32_cmpxchg #define erts_smp_atomic32_read_bset_wb erts_no_atomic32_read_bset +#define erts_smp_atomic32_set_dirty erts_no_atomic32_set +#define erts_smp_atomic32_read_dirty erts_no_atomic32_read + #endif /* !ERTS_SMP */ #if ERTS_GLB_INLINE_INCL_FUNC_DEF diff --git a/erts/emulator/beam/erl_thr_queue.c b/erts/emulator/beam/erl_thr_queue.c index f07964a265..ee2ff765e0 100644 --- a/erts/emulator/beam/erl_thr_queue.c +++ b/erts/emulator/beam/erl_thr_queue.c @@ -113,6 +113,11 @@ sl_element_free(ErtsThrQElement_t *p) #endif +#define ErtsThrQDirtyReadEl(A) \ + ((ErtsThrQElement_t *) erts_atomic_read_dirty((A))) +#define ErtsThrQDirtySetEl(A, V) \ + erts_atomic_set_dirty((A), (erts_aint_t) (V)) + typedef union { ErtsThrQ_t q; char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsThrQ_t))]; @@ -137,7 +142,7 @@ erts_thr_q_initialize(ErtsThrQ_t *q, ErtsThrQInit_t *qi) q->last = NULL; q->q.blk = NULL; #else - erts_atomic_init_nob(&q->tail.data.marker.next.atmc, ERTS_AINT_NULL); + erts_atomic_init_nob(&q->tail.data.marker.next, ERTS_AINT_NULL); q->tail.data.marker.data.ptr = NULL; erts_atomic_init_nob(&q->tail.data.last, (erts_aint_t) &q->tail.data.marker); @@ -150,7 +155,7 @@ erts_thr_q_initialize(ErtsThrQ_t *q, ErtsThrQInit_t *qi) if (!q->tail.data.notify) q->tail.data.notify = noop_callback; - q->head.head.ptr = &q->tail.data.marker; + erts_atomic_init_nob(&q->head.head, (erts_aint_t) &q->tail.data.marker); q->head.live = qi->live.objects; q->head.first = &q->tail.data.marker; q->head.unref_end = &q->tail.data.marker; @@ -296,17 +301,17 @@ element_free(ErtsThrQ_t *q, ErtsThrQElement_t *el) #ifdef USE_THREADS static ERTS_INLINE ErtsThrQElement_t * -enqueue_managed(ErtsThrQ_t *q, ErtsThrQElement_t *this, int want_last) +enqueue_managed(ErtsThrQ_t *q, ErtsThrQElement_t *this) { erts_aint_t ilast, itmp; - erts_atomic_init_nob(&this->next.atmc, ERTS_AINT_NULL); + erts_atomic_init_nob(&this->next, ERTS_AINT_NULL); /* Enqueue at end of list... */ ilast = erts_atomic_read_nob(&q->tail.data.last); while (1) { ErtsThrQElement_t *last = (ErtsThrQElement_t *) ilast; - itmp = erts_atomic_cmpxchg_mb(&last->next.atmc, + itmp = erts_atomic_cmpxchg_mb(&last->next, (erts_aint_t) this, ERTS_AINT_NULL); if (itmp == ERTS_AINT_NULL) @@ -316,31 +321,57 @@ enqueue_managed(ErtsThrQ_t *q, ErtsThrQElement_t *this, int want_last) /* Move last pointer forward... */ while (1) { - if (want_last) { - if (erts_atomic_read_rb(&this->next.atmc) != ERTS_AINT_NULL) { - /* Someone else will move it forward */ - ilast = erts_atomic_read_rb(&q->tail.data.last); - return (ErtsThrQElement_t *) ilast; - } - } - else { - if (erts_atomic_read_nob(&this->next.atmc) != ERTS_AINT_NULL) { - /* Someone else will move it forward */ - return NULL; - } + if (erts_atomic_read_rb(&this->next) != ERTS_AINT_NULL) { + /* Someone else will move it forward */ + ilast = erts_atomic_read_rb(&q->tail.data.last); + return (ErtsThrQElement_t *) ilast; } itmp = erts_atomic_cmpxchg_mb(&q->tail.data.last, (erts_aint_t) this, ilast); if (ilast == itmp) - return want_last ? this : NULL; + return this; ilast = itmp; } } +static ERTS_INLINE ErtsThrQElement_t * +enqueue_marker(ErtsThrQ_t *q, ErtsThrQElement_t **headp) +{ + int maybe_notify; + erts_aint_t inext; + ErtsThrQElement_t *last, *head; + + if (headp) + head = *headp; + else + head = ErtsThrQDirtyReadEl(&q->head.head); + + ASSERT(!q->head.used_marker); + q->head.used_marker = 1; + last = enqueue_managed(q, &q->tail.data.marker); + maybe_notify = &q->tail.data.marker == last; + inext = erts_atomic_read_acqb(&head->next); + if (inext == (erts_aint_t) &q->tail.data.marker) { + ErtsThrQDirtySetEl(&q->head.head, &q->tail.data.marker); + if (headp) + *headp = &q->tail.data.marker; + } + else if (maybe_notify) { + /* + * We need to notify; otherwise, we might loose a notification + * for a concurrently inserted element. + */ + q->head.notify(q->head.arg); + } + return last; +} + + static ErtsThrQCleanState_t clean(ErtsThrQ_t *q, int max_ops, int do_notify) { + ErtsThrQElement_t *head; erts_aint_t ilast; int um_refc_ix; int ops; @@ -349,7 +380,8 @@ clean(ErtsThrQ_t *q, int max_ops, int do_notify) ErtsThrQElement_t *tmp; restart: ASSERT(q->head.first); - if (q->head.first == q->head.head.ptr) { + head = ErtsThrQDirtyReadEl(&q->head.head); + if (q->head.first == head) { q->head.clean_reached_head_count++; if (q->head.clean_reached_head_count >= ERTS_THR_Q_MAX_CLEAN_REACHED_HEAD_COUNT) { @@ -362,19 +394,20 @@ clean(ErtsThrQ_t *q, int max_ops, int do_notify) break; if (q->head.first == &q->tail.data.marker) { q->head.used_marker = 0; - q->head.first = q->head.first->next.ptr; + q->head.first = ErtsThrQDirtyReadEl(&q->head.first->next); goto restart; } tmp = q->head.first; - q->head.first = q->head.first->next.ptr; + q->head.first = ErtsThrQDirtyReadEl(&q->head.first->next); if (q->head.deq_fini.automatic) element_free(q, tmp); else { tmp->data.ptr = (void *) (UWord) q->head.live; if (!q->head.deq_fini.start) q->head.deq_fini.start = tmp; - else if (q->head.deq_fini.end->next.ptr == &q->tail.data.marker) - q->head.deq_fini.end->next.ptr = tmp; + else if (ErtsThrQDirtyReadEl(&q->head.deq_fini.end->next) + == &q->tail.data.marker) + ErtsThrQDirtySetEl(&q->head.deq_fini.end->next, tmp); q->head.deq_fini.end = tmp; } } @@ -401,21 +434,8 @@ clean(ErtsThrQ_t *q, int max_ops, int do_notify) q->head.unref_end = q->head.next.unref_end; if (!q->head.used_marker - && q->head.unref_end == (ErtsThrQElement_t *) ilast) { - q->head.used_marker = 1; - ilast = (erts_aint_t) enqueue_managed(q, - &q->tail.data.marker, - 1); - if (q->head.head.ptr == q->head.unref_end) { - ErtsThrQElement_t *next; - next = ((ErtsThrQElement_t *) - erts_atomic_read_acqb(&q->head.head.ptr->next.atmc)); - if (next == &q->tail.data.marker) { - q->head.head.ptr->next.ptr = &q->tail.data.marker; - q->head.head.ptr = &q->tail.data.marker; - } - } - } + && q->head.unref_end == (ErtsThrQElement_t *) ilast) + ilast = (erts_aint_t) enqueue_marker(q, NULL); if (q->head.unref_end == (ErtsThrQElement_t *) ilast) ERTS_SMP_MEMORY_BARRIER; @@ -436,20 +456,16 @@ clean(ErtsThrQ_t *q, int max_ops, int do_notify) } #endif - if (q->head.first == q->head.head.ptr) { + head = ErtsThrQDirtyReadEl(&q->head.head); + if (q->head.first == head) { inspect_head: if (!q->head.used_marker) { erts_aint_t inext; - inext = erts_atomic_read_acqb(&q->head.head.ptr->next.atmc); + inext = erts_atomic_read_acqb(&head->next); if (inext == ERTS_AINT_NULL) { - q->head.used_marker = 1; - (void) enqueue_managed(q, &q->tail.data.marker, 0); - inext = erts_atomic_read_acqb(&q->head.head.ptr->next.atmc); - if (inext == (erts_aint_t) &q->tail.data.marker) { - q->head.head.ptr->next.ptr = &q->tail.data.marker; - q->head.head.ptr = &q->tail.data.marker; + enqueue_marker(q, &head); + if (head == &q->tail.data.marker) goto check_thr_progress; - } } } @@ -506,26 +522,27 @@ erts_thr_q_inspect(ErtsThrQ_t *q, int ensure_empty) #ifndef USE_THREADS return ERTS_THR_Q_CLEAN; #else + ErtsThrQElement_t *head = ErtsThrQDirtyReadEl(&q->head.head); if (ensure_empty) { erts_aint_t inext; - inext = erts_atomic_read_acqb(&q->head.head.ptr->next.atmc); + inext = erts_atomic_read_acqb(&head->next); if (inext != ERTS_AINT_NULL) { if (&q->tail.data.marker != (ErtsThrQElement_t *) inext) return ERTS_THR_Q_DIRTY; else { - q->head.head.ptr->next.ptr = (ErtsThrQElement_t *) inext; - q->head.head.ptr = (ErtsThrQElement_t *) inext; - inext = erts_atomic_read_acqb(&q->head.head.ptr->next.atmc); + head = (ErtsThrQElement_t *) inext; + ErtsThrQDirtySetEl(&q->head.head, head); + inext = erts_atomic_read_acqb(&head->next); if (inext != ERTS_AINT_NULL) return ERTS_THR_Q_DIRTY; } } } - if (q->head.first == q->head.head.ptr) { + if (q->head.first == head) { if (!q->head.used_marker) { erts_aint_t inext; - inext = erts_atomic_read_acqb(&q->head.head.ptr->next.atmc); + inext = erts_atomic_read_acqb(&head->next); if (inext == ERTS_AINT_NULL) return ERTS_THR_Q_DIRTY; } @@ -553,11 +570,11 @@ enqueue(ErtsThrQ_t *q, void *data, ErtsThrQElement_t *this) #ifndef USE_THREADS ASSERT(data); - this->next.ptr = NULL; + this->next = NULL; this->data.ptr = data; if (q->last) - q->last->next.ptr = this; + q->last->next = this; else { q->first = q->last = this; q->init.notify(q->init.arg); @@ -595,7 +612,7 @@ enqueue(ErtsThrQ_t *q, void *data, ErtsThrQElement_t *this) } } - notify = this == enqueue_managed(q, this, 1); + notify = this == enqueue_managed(q, this); #ifdef ERTS_SMP @@ -638,17 +655,17 @@ erts_thr_q_get_finalize_dequeue_data(ErtsThrQ_t *q, ErtsThrQFinDeQ_t *fdp) ErtsThrQElement_t *e = q->head.deq_fini.start; ErtsThrQElement_t *end = q->head.deq_fini.end; while (e != end) { - ASSERT(q->head.head.ptr != e); + ASSERT(ErtsThrQDirtyReadEl(&q->head.head) != e); ASSERT(q->head.first != e); ASSERT(q->head.unref_end != e); - e = e->next.ptr; + e = ErtsThrQDirtyReadEl(&e->next); } } #endif fdp->start = q->head.deq_fini.start; fdp->end = q->head.deq_fini.end; if (fdp->end) - fdp->end->next.ptr = NULL; + ErtsThrQDirtySetEl(&fdp->end->next, NULL); q->head.deq_fini.start = NULL; q->head.deq_fini.end = NULL; return fdp->start != NULL; @@ -662,7 +679,7 @@ erts_thr_q_append_finalize_dequeue_data(ErtsThrQFinDeQ_t *fdp0, #ifdef USE_THREADS if (fdp1->start) { if (fdp0->end) - fdp0->end->next.ptr = fdp1->start; + ErtsThrQDirtySetEl(&fdp0->end->next, fdp1->start); else fdp0->start = fdp1->start; fdp0->end = fdp1->end; @@ -683,7 +700,7 @@ int erts_thr_q_finalize_dequeue(ErtsThrQFinDeQ_t *state) if (!start) break; tmp = start; - start = start->next.ptr; + start = ErtsThrQDirtyReadEl(&start->next); live = (ErtsThrQLive_t) (UWord) tmp->data.ptr; element_live_free(live, tmp); } @@ -724,7 +741,7 @@ erts_thr_q_dequeue(ErtsThrQ_t *q) return NULL; tmp = q->first; res = tmp->data.ptr; - q->first = tmp->next.ptr; + q->first = tmp->next; if (!q->first) q->last = NULL; @@ -732,24 +749,26 @@ erts_thr_q_dequeue(ErtsThrQ_t *q) return res; #else + ErtsThrQElement_t *head; erts_aint_t inext; void *res; - inext = erts_atomic_read_acqb(&q->head.head.ptr->next.atmc); + head = ErtsThrQDirtyReadEl(&q->head.head); + inext = erts_atomic_read_acqb(&head->next); if (inext == ERTS_AINT_NULL) return NULL; - q->head.head.ptr->next.ptr = (ErtsThrQElement_t *) inext; - q->head.head.ptr = (ErtsThrQElement_t *) inext; - if (q->head.head.ptr == &q->tail.data.marker) { - inext = erts_atomic_read_acqb(&q->head.head.ptr->next.atmc); + head = (ErtsThrQElement_t *) inext; + ErtsThrQDirtySetEl(&q->head.head, head); + if (head == &q->tail.data.marker) { + inext = erts_atomic_read_acqb(&head->next); if (inext == ERTS_AINT_NULL) return NULL; - q->head.head.ptr->next.ptr = (ErtsThrQElement_t *) inext; - q->head.head.ptr = (ErtsThrQElement_t *) inext; + head = (ErtsThrQElement_t *) inext; + ErtsThrQDirtySetEl(&q->head.head, head); } - res = q->head.head.ptr->data.ptr; + res = head->data.ptr; #if ERTS_THR_Q_DBG_CHK_DATA - q->head.head.ptr->data.ptr = NULL; + head->data.ptr = NULL; if (!res) erl_exit(ERTS_ABORT_EXIT, "Missing data in dequeue\n"); #endif diff --git a/erts/emulator/beam/erl_thr_queue.h b/erts/emulator/beam/erl_thr_queue.h index edcf2c3823..ae8c7fb19a 100644 --- a/erts/emulator/beam/erl_thr_queue.h +++ b/erts/emulator/beam/erl_thr_queue.h @@ -76,13 +76,12 @@ typedef struct { typedef struct ErtsThrQElement_t_ ErtsThrQElement_t; typedef struct ErtsThrQElement_t ErtsThrQPrepEnQ_t; -typedef union { - erts_atomic_t atmc; - ErtsThrQElement_t *ptr; -} ErtsThrQPtr_t; - struct ErtsThrQElement_t_ { - ErtsThrQPtr_t next; +#ifdef USE_THREADS + erts_atomic_t next; +#else + ErtsThrQElement_t *next; +#endif union { erts_atomic_t atmc; void *ptr; @@ -130,7 +129,7 @@ struct ErtsThrQ_t_ { * thread dequeuing. */ struct { - ErtsThrQPtr_t head; + erts_atomic_t head; ErtsThrQLive_t live; ErtsThrQElement_t *first; ErtsThrQElement_t *unref_end; diff --git a/erts/emulator/beam/erl_threads.h b/erts/emulator/beam/erl_threads.h index 1dc3ffeb3c..594d38b2a1 100644 --- a/erts/emulator/beam/erl_threads.h +++ b/erts/emulator/beam/erl_threads.h @@ -690,6 +690,19 @@ do { \ } while (0) #endif +ERTS_GLB_INLINE void +erts_dw_atomic_set_dirty(erts_dw_atomic_t *var, erts_dw_aint_t *val); +ERTS_GLB_INLINE void +erts_dw_atomic_read_dirty(erts_dw_atomic_t *var, erts_dw_aint_t *val); +ERTS_GLB_INLINE void +erts_atomic_set_dirty(erts_atomic_t *var, erts_aint_t val); +ERTS_GLB_INLINE erts_aint_t +erts_atomic_read_dirty(erts_atomic_t *var); +ERTS_GLB_INLINE void +erts_atomic32_set_dirty(erts_atomic32_t *var, erts_aint32_t val); +ERTS_GLB_INLINE erts_aint32_t +erts_atomic32_read_dirty(erts_atomic32_t *var); + /* * See "Documentation of atomics and memory barriers" at the top * of this file for info on atomics. @@ -732,6 +745,26 @@ do { \ #define erts_dw_atomic_read_wb ethr_dw_atomic_read_wb #define erts_dw_atomic_cmpxchg_wb ethr_dw_atomic_cmpxchg_wb +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE void +erts_dw_atomic_set_dirty(erts_dw_atomic_t *var, erts_dw_aint_t *val) +{ + ethr_sint_t *sint = ethr_dw_atomic_addr(var); + sint[0] = val->sint[0]; + sint[1] = val->sint[1]; +} + +ERTS_GLB_INLINE void +erts_dw_atomic_read_dirty(erts_dw_atomic_t *var, erts_dw_aint_t *val) +{ + ethr_sint_t *sint = ethr_dw_atomic_addr(var); + val->sint[0] = sint[0]; + val->sint[1] = sint[1]; +} + +#endif + /* Word size atomics */ #define erts_atomic_init_nob ethr_atomic_init @@ -911,6 +944,7 @@ erts_atomic_read_bset_rb(erts_atomic_t *var, #define erts_atomic_cmpxchg_wb ethr_atomic_cmpxchg_wb #if ERTS_GLB_INLINE_INCL_FUNC_DEF + ERTS_GLB_INLINE erts_aint_t erts_atomic_read_bset_wb(erts_atomic_t *var, erts_aint_t mask, @@ -921,6 +955,25 @@ erts_atomic_read_bset_wb(erts_atomic_t *var, ethr_atomic_cmpxchg_wb, var, mask, set); } + +#endif + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE void +erts_atomic_set_dirty(erts_atomic_t *var, erts_aint_t val) +{ + ethr_sint_t *sint = ethr_atomic_addr(var); + *sint = val; +} + +ERTS_GLB_INLINE erts_aint_t +erts_atomic_read_dirty(erts_atomic_t *var) +{ + ethr_sint_t *sint = ethr_atomic_addr(var); + return *sint; +} + #endif /* 32-bit atomics */ @@ -1102,6 +1155,7 @@ erts_atomic32_read_bset_rb(erts_atomic32_t *var, #define erts_atomic32_cmpxchg_wb ethr_atomic32_cmpxchg_wb #if ERTS_GLB_INLINE_INCL_FUNC_DEF + ERTS_GLB_INLINE erts_aint32_t erts_atomic32_read_bset_wb(erts_atomic32_t *var, erts_aint32_t mask, @@ -1112,10 +1166,29 @@ erts_atomic32_read_bset_wb(erts_atomic32_t *var, ethr_atomic32_cmpxchg_wb, var, mask, set); } + #endif #undef ERTS_ATOMIC_BSET_IMPL__ +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE void +erts_atomic32_set_dirty(erts_atomic32_t *var, erts_aint32_t val) +{ + ethr_sint32_t *sint = ethr_atomic32_addr(var); + *sint = val; +} + +ERTS_GLB_INLINE erts_aint32_t +erts_atomic32_read_dirty(erts_atomic32_t *var) +{ + ethr_sint32_t *sint = ethr_atomic32_addr(var); + return *sint; +} + +#endif + #else /* !USE_THREADS */ /* Double word size atomics */ @@ -1155,6 +1228,9 @@ erts_atomic32_read_bset_wb(erts_atomic32_t *var, #define erts_dw_atomic_read_wb erts_no_dw_atomic_read #define erts_dw_atomic_cmpxchg_wb erts_no_dw_atomic_cmpxchg +#define erts_dw_atomic_set_dirty erts_no_dw_atomic_set +#define erts_dw_atomic_read_dirty erts_no_dw_atomic_read + /* Word size atomics */ #define erts_atomic_init_nob erts_no_atomic_set @@ -1262,6 +1338,9 @@ erts_atomic32_read_bset_wb(erts_atomic32_t *var, #define erts_atomic_cmpxchg_wb erts_no_atomic_cmpxchg #define erts_atomic_read_bset_wb erts_no_atomic_read_bset +#define erts_atomic_set_dirty erts_no_atomic_set +#define erts_atomic_read_dirty erts_no_atomic_read + /* 32-bit atomics */ #define erts_atomic32_init_nob erts_no_atomic32_set @@ -1369,6 +1448,9 @@ erts_atomic32_read_bset_wb(erts_atomic32_t *var, #define erts_atomic32_cmpxchg_wb erts_no_atomic32_cmpxchg #define erts_atomic32_read_bset_wb erts_no_atomic32_read_bset +#define erts_atomic32_set_dirty erts_no_atomic32_set +#define erts_atomic32_read_dirty erts_no_atomic32_read + #endif /* !USE_THREADS */ #if ERTS_GLB_INLINE_INCL_FUNC_DEF diff --git a/erts/emulator/beam/erl_unicode.c b/erts/emulator/beam/erl_unicode.c index 80982f3760..fa53fd0937 100644 --- a/erts/emulator/beam/erl_unicode.c +++ b/erts/emulator/beam/erl_unicode.c @@ -2747,3 +2747,11 @@ int erts_utf8_to_latin1(byte* dest, const byte* source, int slen) return dp - dest; } +BIF_RETTYPE io_printable_range_0(BIF_ALIST_0) +{ + if (erts_get_printable_characters() == ERL_PRINTABLE_CHARACTERS_UNICODE) { + BIF_RET(am_unicode); + } else { + BIF_RET(am_latin1); + } +} diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 3ea4b24848..b73c883658 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -82,11 +82,11 @@ static void pdl_init(void); #ifdef ERTS_SMP static void driver_monitor_lock_pdl(Port *p); static void driver_monitor_unlock_pdl(Port *p); -#define DRV_MONITOR_LOOKUP_PORT_LOCK_PDL(Port) erts_thr_drvport2port_raw((Port), 1) +#define DRV_MONITOR_LOOKUP_PORT_LOCK_PDL(Port) erts_thr_drvport2port((Port), 1) #define DRV_MONITOR_LOCK_PDL(Port) driver_monitor_lock_pdl(Port) #define DRV_MONITOR_UNLOCK_PDL(Port) driver_monitor_unlock_pdl(Port) #else -#define DRV_MONITOR_LOOKUP_PORT_LOCK_PDL(Port) erts_thr_drvport2port_raw((Port), 0) +#define DRV_MONITOR_LOOKUP_PORT_LOCK_PDL(Port) erts_thr_drvport2port((Port), 0) #define DRV_MONITOR_LOCK_PDL(Port) /* nothing */ #define DRV_MONITOR_UNLOCK_PDL(Port) /* nothing */ #endif @@ -97,12 +97,10 @@ static void driver_monitor_unlock_pdl(Port *p); static ERTS_INLINE ErlIOQueue* drvport2ioq(ErlDrvPort drvport) { - Port *prt = erts_thr_drvport2port_raw(drvport, 0); - erts_aint32_t state = erts_atomic32_read_nob(&prt->state); - if (state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) + Port *prt = erts_thr_drvport2port(drvport, 0); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return NULL; - else - return &prt->ioq; + return &prt->ioq; } static ERTS_INLINE int @@ -178,6 +176,22 @@ typedef struct line_buf_context { \ dtrace_proc_str((PID), process_str); \ dtrace_port_str((PORT), port_str); + +void +dtrace_drvport_str(ErlDrvPort drvport, char *port_buf) +{ + Port *port = erts_drvport2port(drvport); + + if (port != ERTS_INVALID_ERL_DRV_PORT) + erts_snprintf(port_buf, DTRACE_TERM_BUF_SIZE, "#Port<%lu.%lu>", + port_channel_no(port->common.id), + port_number(port->common.id)); + else + erts_snprintf(port_buf, DTRACE_TERM_BUF_SIZE, "#Port<INVALID>", + port_channel_no(port->common.id), + port_number(port->common.id)); +} + #endif static ERTS_INLINE void @@ -683,7 +697,7 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */ } #endif fpe_was_unmasked = erts_block_fpe(); - drv_data = (*driver->start)((ErlDrvPort) port, name, opts); + drv_data = (*driver->start)(ERTS_Port2ErlDrvPort(port), name, opts); if (((SWord) drv_data) == -1) error_type = -1; else if (((SWord) drv_data) == -2) { @@ -777,8 +791,8 @@ driver_create_port(ErlDrvPort creator_port_ix, /* Creating port */ if (!erts_get_scheduler_id()) return ERTS_INVALID_ERL_DRV_PORT; - creator_port = erts_drvport2port(creator_port_ix, NULL); - if (!creator_port) + creator_port = erts_drvport2port(creator_port_ix); + if (creator_port == ERTS_INVALID_ERL_DRV_PORT) return ERTS_INVALID_ERL_DRV_PORT; rp = erts_proc_lookup(pid); @@ -849,7 +863,7 @@ driver_create_port(ErlDrvPort creator_port_ix, /* Creating port */ port->drv_data = (UWord) drv_data; - return (ErlDrvPort) port; + return ERTS_Port2ErlDrvPort(port); } #ifdef ERTS_SMP @@ -1185,6 +1199,7 @@ typedef struct { int async; /* Asynchronous operation */ int pre_chk_sched_flags; /* Check sched flags before lock? */ int fpe_was_unmasked; + int reds_left_in; } ErtsTryImmDrvCallState; #define ERTS_INIT_TRY_IMM_DRV_CALL_STATE(C_P, PRT, SFLGS, PTS_FLGS, A, PRT_OP) \ @@ -1199,6 +1214,7 @@ static ERTS_INLINE ErtsTryImmDrvCallResult try_imm_drv_call(ErtsTryImmDrvCallState *sp) { ErtsTryImmDrvCallResult res; + int reds_left_in; erts_aint32_t invalid_state, invalid_sched_flags; Port *prt = sp->port; Process *c_p = sp->c_p; @@ -1232,16 +1248,24 @@ try_imm_drv_call(ErtsTryImmDrvCallState *sp) goto locked_fail; } - if (c_p) { + + if (!c_p) + reds_left_in = CONTEXT_REDS/10; + else { if (IS_TRACED_FL(c_p, F_TRACE_SCHED_PROCS)) trace_virtual_sched(c_p, am_out); if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) profile_runnable_proc(c_p, am_inactive); + reds_left_in = ERTS_BIF_REDS_LEFT(c_p); erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN); } + ASSERT(0 <= reds_left_in && reds_left_in <= CONTEXT_REDS); + sp->reds_left_in = reds_left_in; + prt->reds = CONTEXT_REDS - reds_left_in; + ERTS_SMP_CHK_NO_PROC_LOCKS; if (IS_TRACED_FL(prt, F_TRACE_SCHED_PORTS)) @@ -1262,10 +1286,12 @@ locked_fail: static ERTS_INLINE void finalize_imm_drv_call(ErtsTryImmDrvCallState *sp) { + int reds; Port *prt = sp->port; Process *c_p = sp->c_p; - erts_port_driver_callback_epilogue(prt, NULL); + reds = prt->reds; + reds += erts_port_driver_callback_epilogue(prt, NULL); erts_unblock_fpe(sp->fpe_was_unmasked); @@ -1280,6 +1306,12 @@ finalize_imm_drv_call(ErtsTryImmDrvCallState *sp) if (c_p) { erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); + if (reds != (CONTEXT_REDS - sp->reds_left_in)) { + int bump_reds = reds - (CONTEXT_REDS - sp->reds_left_in); + ASSERT(bump_reds > 0); + BUMP_REDS(c_p, bump_reds); + } + if (IS_TRACED_FL(c_p, F_TRACE_SCHED_PROCS)) trace_virtual_sched(c_p, am_in); if (erts_system_profile_flags.runnable_procs @@ -3470,7 +3502,7 @@ erts_deliver_port_exit(Port *p, Eterm from, Eterm reason, int send_closed) { ErtsLink *lnk; Eterm rreason; - erts_aint32_t state; + erts_aint32_t state, set_state_flags; ERTS_SMP_CHK_NO_PROC_LOCKS; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p)); @@ -3499,9 +3531,12 @@ erts_deliver_port_exit(Port *p, Eterm from, Eterm reason, int send_closed) if (reason == am_normal && from != ERTS_PORT_GET_CONNECTED(p) && from != p->common.id) return 0; + set_state_flags = ERTS_PORT_SFLG_EXITING; if (send_closed) - erts_atomic32_read_bor_relb(&p->state, - ERTS_PORT_SFLG_SEND_CLOSED); + set_state_flags |= ERTS_PORT_SFLG_SEND_CLOSED; + + state = erts_atomic32_read_bor_mb(&p->state, set_state_flags); + state |= set_state_flags; if (IS_TRACED_FL(p, F_TRACE_PORTS)) { trace_port(p, am_closed, reason); @@ -3509,17 +3544,11 @@ erts_deliver_port_exit(Port *p, Eterm from, Eterm reason, int send_closed) erts_trace_check_exiting(p->common.id); - /* - * Setting the port to not busy here, frees the list of pending - * processes and makes them runnable. - */ - set_busy_port((ErlDrvPort) p, 0); + set_busy_port(ERTS_Port2ErlDrvPort(p), 0); if (p->common.u.alive.reg != NULL) (void) erts_unregister_name(NULL, 0, p, p->common.u.alive.reg->name); - state = erts_atomic32_read_bor_relb(&p->state, ERTS_PORT_SFLG_EXITING); - { SweepContext sc = {p->common.id, rreason}; lnk = ERTS_P_LINKS(p); @@ -4759,8 +4788,8 @@ set_busy_port(ErlDrvPort dprt, int on) ERTS_SMP_CHK_NO_PROC_LOCKS; - prt = erts_drvport2port_raw(dprt); - if (!prt) + prt = erts_drvport2port(dprt); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return; if (on) { @@ -4859,8 +4888,8 @@ erts_port_resume_procs(Port *prt) void set_port_control_flags(ErlDrvPort port_num, int flags) { - Port *prt = erts_drvport2port_raw(port_num); - if (prt) + Port *prt = erts_drvport2port(port_num); + if (prt != ERTS_INVALID_ERL_DRV_PORT) prt->control_flags = flags; } @@ -4870,8 +4899,8 @@ int get_port_flags(ErlDrvPort ix) Port *prt; erts_aint32_t state; - prt = erts_drvport2port(ix, &state); - if (!prt) + prt = erts_drvport2port_state(ix, &state); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return 0; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); @@ -4960,7 +4989,7 @@ erts_stale_drv_select(Eterm port, int deselect) { char *type; - ErlDrvPort drv_port = (ErlDrvPort) erts_port_lookup_raw(port); + ErlDrvPort drv_port = ERTS_Port2ErlDrvPort(erts_port_lookup_raw(port)); ErtsPortNames *pnp = erts_get_port_names(port); erts_dsprintf_buf_t *dsbufp; @@ -5082,7 +5111,6 @@ ErlDrvTermData driver_mk_term_nil(void) void driver_report_exit(ErlDrvPort ix, int status) { - Port* prt = erts_drvport2port(ix, NULL); Eterm* hp; Eterm tuple; Process *rp; @@ -5091,6 +5119,10 @@ void driver_report_exit(ErlDrvPort ix, int status) ErlOffHeap *ohp; ErtsProcLocks rp_locks = 0; int scheduler = erts_get_scheduler_id() != 0; + Port* prt = erts_drvport2port(ix); + + if (prt == ERTS_INVALID_ERL_DRV_PORT) + return; ERTS_SMP_CHK_NO_PROC_LOCKS; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); @@ -5687,8 +5719,18 @@ deliver_term_check_port(ErlDrvTermData port_id, Eterm *connected_p) #ifdef ERTS_SMP ErtsThrPrgrDelayHandle dhndl = erts_thr_progress_unmanaged_delay(); #endif + erts_aint32_t state; Port *prt = erts_port_lookup_raw((Eterm) port_id); - erts_aint32_t state = erts_atomic32_read_nob(&prt->state); + if (!prt) + return -1; + state = erts_atomic32_read_nob(&prt->state); + if (state & (ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP + | ERTS_PORT_SFLG_CLOSING)) { + if (state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) + return -1; + else + return 0; + } if (connected_p) { #ifdef ERTS_SMP if (dhndl != ERTS_THR_PRGR_DHANDLE_MANAGED) @@ -5705,9 +5747,7 @@ deliver_term_check_port(ErlDrvTermData port_id, Eterm *connected_p) ERTS_SMP_LC_ASSERT(dhndl == ERTS_THR_PRGR_DHANDLE_MANAGED ? erts_lc_is_port_locked(prt) : !erts_lc_is_port_locked(prt)); - return ((state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) - ? -1 - : ((state & ERTS_PORT_SFLG_CLOSING) ? 0 : 1)); + return 1; } int erl_drv_output_term(ErlDrvTermData port_id, ErlDrvTermData* data, int len) @@ -5733,14 +5773,12 @@ driver_output_term(ErlDrvPort drvport, ErlDrvTermData* data, int len) ERTS_SMP_CHK_NO_PROC_LOCKS; /* NOTE! It *not* safe to access 'drvport' from unmanaged threads. */ - prt = erts_drvport2port(drvport, &state); - if (!prt) + prt = erts_drvport2port_state(drvport, &state); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; /* invalid (dead) */ ERTS_SMP_CHK_NO_PROC_LOCKS; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); - if (state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) - return -1; - else if (state & ERTS_PORT_SFLG_CLOSING) + if (state & ERTS_PORT_SFLG_CLOSING) return 0; return driver_deliver_term(ERTS_PORT_GET_CONNECTED(prt), data, len); @@ -5780,13 +5818,11 @@ driver_send_term(ErlDrvPort drvport, #endif { erts_aint32_t state; - Port* prt = erts_drvport2port(drvport, &state); - if (!prt) + Port* prt = erts_drvport2port_state(drvport, &state); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; /* invalid (dead) */ ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); - if (state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) - return -1; - else if (state & ERTS_PORT_SFLG_CLOSING) + if (state & ERTS_PORT_SFLG_CLOSING) return 0; } return driver_deliver_term(to, data, len); @@ -5802,11 +5838,11 @@ int driver_output_binary(ErlDrvPort ix, char* hbuf, ErlDrvSizeT hlen, ErlDrvBinary* bin, ErlDrvSizeT offs, ErlDrvSizeT len) { erts_aint32_t state; - Port* prt = erts_drvport2port(ix, &state); + Port* prt = erts_drvport2port_state(ix, &state); ERTS_SMP_CHK_NO_PROC_LOCKS; - if (prt == NULL) + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); if (state & ERTS_PORT_SFLG_CLOSING) @@ -5837,15 +5873,14 @@ int driver_output2(ErlDrvPort ix, char* hbuf, ErlDrvSizeT hlen, char* buf, ErlDrvSizeT len) { erts_aint32_t state; - Port* prt = erts_drvport2port(ix, &state); + Port* prt = erts_drvport2port_state(ix, &state); ERTS_SMP_CHK_NO_PROC_LOCKS; - if (prt == NULL) + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); - if (state & ERTS_PORT_SFLG_CLOSING) return 0; @@ -5902,8 +5937,8 @@ int driver_outputv(ErlDrvPort ix, char* hbuf, ErlDrvSizeT hlen, if (hlen < 0) hlen = 0; - prt = erts_drvport2port(ix, &state); - if (prt == NULL) + prt = erts_drvport2port_state(ix, &state); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); @@ -6179,8 +6214,8 @@ ErlDrvPDL driver_pdl_create(ErlDrvPort dp) { ErlDrvPDL pdl; - Port *pp = erts_drvport2port(dp, NULL); - if (!pp || pp->port_data_lock) + Port *pp = erts_drvport2port(dp); + if (pp == ERTS_INVALID_ERL_DRV_PORT || pp->port_data_lock) return NULL; pdl = erts_alloc(ERTS_ALC_T_PORT_DATA_LOCK, sizeof(struct erl_drv_port_data_lock)); @@ -6638,11 +6673,11 @@ drv_cancel_timer(Port *prt) int driver_set_timer(ErlDrvPort ix, unsigned long t) { - Port* prt = erts_drvport2port(ix, NULL); + Port* prt = erts_drvport2port(ix); ERTS_SMP_CHK_NO_PROC_LOCKS; - if (prt == NULL) + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; if (prt->drv_ptr->timeout == NULL) @@ -6665,8 +6700,8 @@ int driver_set_timer(ErlDrvPort ix, unsigned long t) int driver_cancel_timer(ErlDrvPort ix) { - Port* prt = erts_drvport2port(ix, NULL); - if (prt == NULL) + Port* prt = erts_drvport2port(ix); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); drv_cancel_timer(prt); @@ -6677,11 +6712,11 @@ int driver_cancel_timer(ErlDrvPort ix) int driver_read_timer(ErlDrvPort ix, unsigned long* t) { - Port* prt = erts_drvport2port(ix, NULL); + Port* prt = erts_drvport2port(ix); ERTS_SMP_CHK_NO_PROC_LOCKS; - if (prt == NULL) + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); #ifdef ERTS_SMP @@ -6757,19 +6792,13 @@ int driver_monitor_process(ErlDrvPort drvport, { Port *prt; int ret; - erts_aint32_t state; #if !HEAP_ON_C_STACK || (defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)) ErtsSchedulerData *sched = erts_get_scheduler_data(); #endif prt = DRV_MONITOR_LOOKUP_PORT_LOCK_PDL(drvport); - - state = erts_atomic32_read_nob(&prt->state); - - if (state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) { - DRV_MONITOR_UNLOCK_PDL(prt); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; - } /* Now (in SMP) we should have either the port lock (if we have a scheduler) or the port data lock (if we're a driver thread) */ @@ -6836,19 +6865,13 @@ int driver_demonitor_process(ErlDrvPort drvport, { Port *prt; int ret; - erts_aint32_t state; #if !HEAP_ON_C_STACK || (defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)) ErtsSchedulerData *sched = erts_get_scheduler_data(); #endif prt = DRV_MONITOR_LOOKUP_PORT_LOCK_PDL(drvport); - - state = erts_atomic32_read_nob(&prt->state); - - if (state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) { - DRV_MONITOR_UNLOCK_PDL(prt); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; - } /* Now we should have either the port lock (if we have a scheduler) or the port data lock (if we're a driver thread) */ @@ -6897,18 +6920,13 @@ ErlDrvTermData driver_get_monitored_process(ErlDrvPort drvport, { Port *prt; ErlDrvTermData ret; - erts_aint32_t state; #if !HEAP_ON_C_STACK || (defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)) ErtsSchedulerData *sched = erts_get_scheduler_data(); #endif prt = DRV_MONITOR_LOOKUP_PORT_LOCK_PDL(drvport); - - state = erts_atomic32_read_nob(&prt->state); - if (state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) { - DRV_MONITOR_UNLOCK_PDL(prt); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return driver_term_nil; - } /* Now we should have either the port lock (if we have a scheduler) or the port data lock (if we're a driver thread) */ @@ -6981,11 +6999,11 @@ static int driver_failure_term(ErlDrvPort ix, Eterm term, int eof) { erts_aint32_t state; - Port* prt = erts_drvport2port(ix, &state); + Port* prt = erts_drvport2port_state(ix, &state); ERTS_SMP_CHK_NO_PROC_LOCKS; - if (prt == NULL) + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); if (eof) @@ -7014,14 +7032,14 @@ driver_failure_term(ErlDrvPort ix, Eterm term, int eof) */ int driver_exit(ErlDrvPort ix, int err) { - Port* prt = erts_drvport2port(ix, NULL); + Port* prt = erts_drvport2port(ix); Process* rp; ErtsLink *lnk, *rlnk = NULL; Eterm connected; ERTS_SMP_CHK_NO_PROC_LOCKS; - if (prt == NULL) + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; connected = ERTS_PORT_GET_CONNECTED(prt); @@ -7095,16 +7113,18 @@ ErlDrvTermData driver_mk_atom(char* string) ErlDrvTermData driver_mk_port(ErlDrvPort ix) { - Port* prt = erts_drvport2port(ix, NULL); + Port* prt = erts_drvport2port(ix); + if (prt == ERTS_INVALID_ERL_DRV_PORT) + return (ErlDrvTermData) NIL; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); return (ErlDrvTermData) prt->common.id; } ErlDrvTermData driver_connected(ErlDrvPort ix) { - Port* prt = erts_drvport2port(ix, NULL); + Port* prt = erts_drvport2port(ix); ERTS_SMP_CHK_NO_PROC_LOCKS; - if (prt == NULL) + if (prt == ERTS_INVALID_ERL_DRV_PORT) return NIL; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); return ERTS_PORT_GET_CONNECTED(prt); @@ -7112,9 +7132,9 @@ ErlDrvTermData driver_connected(ErlDrvPort ix) ErlDrvTermData driver_caller(ErlDrvPort ix) { - Port* prt = erts_drvport2port(ix, NULL); + Port* prt = erts_drvport2port(ix); ERTS_SMP_CHK_NO_PROC_LOCKS; - if (prt == NULL) + if (prt == ERTS_INVALID_ERL_DRV_PORT) return NIL; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); return prt->caller; @@ -7122,17 +7142,15 @@ ErlDrvTermData driver_caller(ErlDrvPort ix) int driver_lock_driver(ErlDrvPort ix) { - Port* prt = erts_drvport2port(ix, NULL); + Port* prt = erts_drvport2port(ix); DE_Handle* dh; ERTS_SMP_CHK_NO_PROC_LOCKS; - erts_smp_rwmtx_rwlock(&erts_driver_list_lock); - - if (prt == NULL) { - erts_smp_rwmtx_rwunlock(&erts_driver_list_lock); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; - } + + erts_smp_rwmtx_rwlock(&erts_driver_list_lock); ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); if ((dh = (DE_Handle*)prt->drv_ptr->handle ) == NULL) { @@ -7327,7 +7345,7 @@ no_event_callback(ErlDrvData drv_data, ErlDrvEvent event, ErlDrvEventData event_ { Port *prt = get_current_port(); report_missing_drv_callback(prt, "Event", "event()"); - driver_event((ErlDrvPort) prt, event, NULL); + driver_event(ERTS_Port2ErlDrvPort(prt), event, NULL); } static void @@ -7335,7 +7353,7 @@ no_ready_input_callback(ErlDrvData drv_data, ErlDrvEvent event) { Port *prt = get_current_port(); report_missing_drv_callback(prt, "Input", "ready_input()"); - driver_select((ErlDrvPort) prt, event, + driver_select(ERTS_Port2ErlDrvPort(prt), event, (ERL_DRV_READ | ERL_DRV_USE_NO_CALLBACK), 0); } @@ -7344,7 +7362,7 @@ no_ready_output_callback(ErlDrvData drv_data, ErlDrvEvent event) { Port *prt = get_current_port(); report_missing_drv_callback(prt, "Output", "ready_output()"); - driver_select((ErlDrvPort) prt, event, + driver_select(ERTS_Port2ErlDrvPort(prt), event, (ERL_DRV_WRITE | ERL_DRV_USE_NO_CALLBACK), 0); } diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index 9416a91480..05bff430e3 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -1040,11 +1040,24 @@ char* win32_errorstr(int); #define ERL_FILENAME_WARNING_IGNORE (1) #define ERL_FILENAME_WARNING_ERROR (2) +/*********************************************************************** + * The user can request a range of character that he/she consider + * printable. Currently this can be either latin1 or unicode, but + * in the future a set of ranges, or languages, could be specified. + ***********************************************************************/ +#define ERL_PRINTABLE_CHARACTERS_LATIN1 (0) +#define ERL_PRINTABLE_CHARACTERS_UNICODE (1) + int erts_get_native_filename_encoding(void); /* The set function is only to be used by erl_init! */ void erts_set_user_requested_filename_encoding(int encoding, int warning); int erts_get_user_requested_filename_encoding(void); int erts_get_filename_warning_type(void); +/* This function is called from erl_init. The setting is read by BIF's + in io/io_lib. Setting is not atomic. */ +void erts_set_printable_characters(int range); +/* Get the setting (ERL_PRINTABLE_CHARACTERS_{LATIN1|UNICODE} */ +int erts_get_printable_characters(void); void erts_init_sys_common_misc(void); diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c index 2279fec72a..22328fcd11 100644 --- a/erts/emulator/drivers/common/efile_drv.c +++ b/erts/emulator/drivers/common/efile_drv.c @@ -1160,7 +1160,14 @@ static void invoke_read_line(void *data) /* Need more place */ ErlDrvSizeT need = (d->c.read_line.read_size >= DEFAULT_LINEBUF_SIZE) ? d->c.read_line.read_size + DEFAULT_LINEBUF_SIZE : DEFAULT_LINEBUF_SIZE; - ErlDrvBinary *newbin = driver_alloc_binary(need); + ErlDrvBinary *newbin; +#if !ALWAYS_READ_LINE_AHEAD + /* Use read_ahead size if need does not exceed it */ + if (need < (d->c.read_line.binp)->orig_size && + d->c.read_line.read_ahead) + need = (d->c.read_line.binp)->orig_size; +#endif + newbin = driver_alloc_binary(need); if (newbin == NULL) { d->result_ok = 0; d->errInfo.posix_errno = ENOMEM; diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index f0c22e9ebe..3832cf1227 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -7834,7 +7834,7 @@ static ErlDrvSSizeT inet_ctl(inet_descriptor* desc, int cmd, char* buf, if (!IS_CONNECTED(desc)) return ctl_error(ENOTCONN, rbuf, rsize); - if (!desc->stype == SOCK_STREAM) + if (desc->stype != SOCK_STREAM) return ctl_error(EINVAL, rbuf, rsize); if (*buf == 1 && !desc->is_ignored) { @@ -8816,7 +8816,7 @@ static int tcp_recv_error(tcp_descriptor* desc, int err) if (desc->inet.exitf) driver_exit(desc->inet.port, err); else - desc_close(INETP(desc)); + desc_close_read(INETP(desc)); } return -1; } diff --git a/erts/emulator/hipe/hipe_bif0.c b/erts/emulator/hipe/hipe_bif0.c index 1562748f2d..059c013322 100644 --- a/erts/emulator/hipe/hipe_bif0.c +++ b/erts/emulator/hipe/hipe_bif0.c @@ -1791,7 +1791,7 @@ BIF_RETTYPE hipe_bifs_remove_refs_from_1(BIF_ALIST_1) if (BIF_ARG_1 == am_all) { hipe_purge_all_refs(); - BIF_RET(NIL); + BIF_RET(am_ok); } if (!term_to_mfa(BIF_ARG_1, &mfa)) @@ -1828,7 +1828,7 @@ BIF_RETTYPE hipe_bifs_remove_refs_from_1(BIF_ALIST_1) caller_mfa->refers_to = NULL; } hipe_mfa_info_table_unlock(); - BIF_RET(NIL); + BIF_RET(am_ok); } diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c index 3be821f8f7..af1c36777f 100644 --- a/erts/emulator/hipe/hipe_native_bif.c +++ b/erts/emulator/hipe/hipe_native_bif.c @@ -503,9 +503,7 @@ static int validate_unicode(Eterm arg) { if (is_not_small(arg) || arg > make_small(0x10FFFFUL) || - (make_small(0xD800UL) <= arg && arg <= make_small(0xDFFFUL)) || - arg == make_small(0xFFFEUL) || - arg == make_small(0xFFFFUL)) + (make_small(0xD800UL) <= arg && arg <= make_small(0xDFFFUL))) return 0; return 1; } diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c index 474408ae7c..c16831a07d 100644 --- a/erts/emulator/sys/common/erl_check_io.c +++ b/erts/emulator/sys/common/erl_check_io.c @@ -481,6 +481,7 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix, int on) { void (*stop_select_fn)(ErlDrvEvent, void*) = NULL; + Port *prt = erts_drvport2port(ix); Eterm id = erts_drvport2id(ix); ErtsSysFdType fd = (ErtsSysFdType) e; ErtsPollEvents ctl_events = (ErtsPollEvents) 0; @@ -491,9 +492,11 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix, #ifdef USE_VM_PROBES DTRACE_CHARBUF(name, 64); #endif - - ERTS_SMP_LC_ASSERT(erts_drvport2port(ix, NULL) - && erts_lc_is_port_locked(erts_drvport2port(ix, NULL))); + + if (prt == ERTS_INVALID_ERL_DRV_PORT) + return -1; + + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); #ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS if ((unsigned)fd >= (unsigned)erts_smp_atomic_read_nob(&drv_ev_state_len)) { @@ -519,9 +522,9 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix, if (!on && (mode&ERL_DRV_USE_NO_CALLBACK) == ERL_DRV_USE) { if (IS_FD_UNKNOWN(state)) { /* fast track to stop_select callback */ - stop_select_fn = erts_drvport2port(ix, NULL)->drv_ptr->stop_select; + stop_select_fn = prt->drv_ptr->stop_select; #ifdef USE_VM_PROBES - strncpy(name, erts_drvport2port(ix, NULL)->drv_ptr->name, sizeof(name)-1); + strncpy(name, prt->drv_ptr->name, sizeof(name)-1); name[sizeof(name)-1] = '\0'; #endif ret = 0; @@ -654,14 +657,14 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix, } } if ((mode & ERL_DRV_USE_NO_CALLBACK) == ERL_DRV_USE) { - erts_driver_t* drv_ptr = erts_drvport2port(ix, NULL)->drv_ptr; + erts_driver_t* drv_ptr = prt->drv_ptr; ASSERT(new_events==0); if (state->remove_cnt == 0 || !wake_poller) { /* Safe to close fd now as it is not in pollset or there was no need to eject fd (kernel poll) */ stop_select_fn = drv_ptr->stop_select; #ifdef USE_VM_PROBES - strncpy(name, erts_drvport2port(ix, NULL)->drv_ptr->name, sizeof(name)-1); + strncpy(name, prt->drv_ptr->name, sizeof(name)-1); name[sizeof(name)-1] = '\0'; #endif } @@ -712,9 +715,12 @@ ERTS_CIO_EXPORT(driver_event)(ErlDrvPort ix, ErtsDrvEventState *state; int do_wake = 0; int ret; + Port *prt = erts_drvport2port(ix); + + if (prt == ERTS_INVALID_ERL_DRV_PORT) + return -1; - ERTS_SMP_LC_ASSERT(erts_drvport2port(ix, NULL) - && erts_lc_is_port_locked(erts_drvport2port(ix, NULL))); + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); #ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS if ((unsigned)fd >= (unsigned)erts_smp_atomic_read_nob(&drv_ev_state_len)) { @@ -949,7 +955,7 @@ static void print_select_op(erts_dsprintf_buf_t *dsbufp, ErlDrvPort ix, ErtsSysFdType fd, int mode, int on) { - Port *pp = erts_drvport2port(ix, NULL); + Port *pp = erts_drvport2port(ix); erts_dsprintf(dsbufp, "driver_select(%p, %d,%s%s%s%s, %d) " "by ", @@ -960,8 +966,8 @@ print_select_op(erts_dsprintf_buf_t *dsbufp, mode & ERL_DRV_USE ? " ERL_DRV_USE" : "", mode & (ERL_DRV_USE_NO_CALLBACK & ~ERL_DRV_USE) ? "_NO_CALLBACK" : "", on); - print_driver_name(dsbufp, pp->common.id); - erts_dsprintf(dsbufp, "driver %T ", pp ? pp->common.id : NIL); + print_driver_name(dsbufp, pp != ERTS_INVALID_ERL_DRV_PORT ? pp->common.id : NIL); + erts_dsprintf(dsbufp, "driver %T ", pp != ERTS_INVALID_ERL_DRV_PORT ? pp->common.id : NIL); } static void @@ -1020,8 +1026,9 @@ steal_pending_stop_select(erts_dsprintf_buf_t *dsbufp, ErlDrvPort ix, state->driver.drv_ptr = NULL; } else if ((mode & ERL_DRV_USE_NO_CALLBACK) == ERL_DRV_USE) { - erts_driver_t* drv_ptr = erts_drvport2port(ix, NULL)->drv_ptr; - if (drv_ptr != state->driver.drv_ptr) { + Port *prt = erts_drvport2port(ix); + erts_driver_t* drv_ptr = prt != ERTS_INVALID_ERL_DRV_PORT ? prt->drv_ptr : NULL; + if (drv_ptr && drv_ptr != state->driver.drv_ptr) { /* Some other driver wants the stop_select callback */ if (state->driver.drv_ptr->handle) { erts_ddll_dereference_driver(state->driver.drv_ptr->handle); @@ -1042,7 +1049,7 @@ static void print_event_op(erts_dsprintf_buf_t *dsbufp, ErlDrvPort ix, ErtsSysFdType fd, ErlDrvEventData event_data) { - Port *pp = erts_drvport2port(ix, NULL); + Port *pp = erts_drvport2port(ix); erts_dsprintf(dsbufp, "driver_event(%p, %d, ", ix, (int) fd); if (!event_data) erts_dsprintf(dsbufp, "NULL"); @@ -1051,8 +1058,9 @@ print_event_op(erts_dsprintf_buf_t *dsbufp, (unsigned int) event_data->events, (unsigned int) event_data->revents); erts_dsprintf(dsbufp, ") by "); - print_driver_name(dsbufp, pp->common.id); - erts_dsprintf(dsbufp, "driver %T ", pp ? pp->common.id : NIL); + if (pp != ERTS_INVALID_ERL_DRV_PORT) + print_driver_name(dsbufp, pp->common.id); + erts_dsprintf(dsbufp, "driver %T ", pp != ERTS_INVALID_ERL_DRV_PORT ? pp->common.id : NIL); } static void diff --git a/erts/emulator/sys/common/erl_sys_common_misc.c b/erts/emulator/sys/common/erl_sys_common_misc.c index 0b31c125e5..31ad3b82d5 100644 --- a/erts/emulator/sys/common/erl_sys_common_misc.c +++ b/erts/emulator/sys/common/erl_sys_common_misc.c @@ -49,10 +49,15 @@ static int filename_encoding = ERL_FILENAME_UNKNOWN; static int filename_warning = ERL_FILENAME_WARNING_WARNING; #if defined(__WIN32__) || defined(__DARWIN__) -static int user_filename_encoding = ERL_FILENAME_UTF8; /* Default unicode on windows */ +/* Default unicode on windows and MacOS X */ +static int user_filename_encoding = ERL_FILENAME_UTF8; #else static int user_filename_encoding = ERL_FILENAME_LATIN1; #endif +/* This controls the heuristic in printing characters in shell and w/ + io:format("~tp", ...) etc. */ +static int printable_character_set = ERL_PRINTABLE_CHARACTERS_LATIN1; + void erts_set_user_requested_filename_encoding(int encoding, int warning) { user_filename_encoding = encoding; @@ -69,6 +74,15 @@ int erts_get_filename_warning_type(void) return filename_warning; } +void erts_set_printable_characters(int range) { + /* Not an atomic */ + printable_character_set = range; +} + +int erts_get_printable_characters(void) { + return printable_character_set; +} + void erts_init_sys_common_misc(void) { #if defined(__WIN32__) diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index 0b96eded76..dbc163bac1 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -1211,8 +1211,8 @@ static int set_driver_data(ErlDrvPort port_num, report_exit_list = report_exit; } - prt = erts_drvport2port(port_num, NULL); - if (prt) + prt = erts_drvport2port(port_num); + if (prt != ERTS_INVALID_ERL_DRV_PORT) prt->os_pid = pid; if (read_write & DO_READ) { @@ -2650,7 +2650,7 @@ report_exit_status(ErtsSysReportExit *rep, int status) if (rep->ifd >= 0) { driver_data[rep->ifd].alive = 0; driver_data[rep->ifd].status = status; - (void) driver_select((ErlDrvPort) pp, + (void) driver_select(ERTS_Port2ErlDrvPort(pp), rep->ifd, (ERL_DRV_READ|ERL_DRV_USE), 1); @@ -2658,7 +2658,7 @@ report_exit_status(ErtsSysReportExit *rep, int status) if (rep->ofd >= 0) { driver_data[rep->ofd].alive = 0; driver_data[rep->ofd].status = status; - (void) driver_select((ErlDrvPort) pp, + (void) driver_select(ERTS_Port2ErlDrvPort(pp), rep->ofd, (ERL_DRV_WRITE|ERL_DRV_USE), 1); diff --git a/erts/emulator/sys/win32/erl_win_dyn_driver.h b/erts/emulator/sys/win32/erl_win_dyn_driver.h index ae3228ff28..a7c53c904d 100644 --- a/erts/emulator/sys/win32/erl_win_dyn_driver.h +++ b/erts/emulator/sys/win32/erl_win_dyn_driver.h @@ -37,6 +37,7 @@ WDD_TYPEDEF(int, driver_failure_posix,(ErlDrvPort, int)); WDD_TYPEDEF(int, driver_failure,(ErlDrvPort, int)); WDD_TYPEDEF(int, driver_exit, (ErlDrvPort, int)); WDD_TYPEDEF(int, driver_failure_eof, (ErlDrvPort)); +WDD_TYPEDEF(void, erl_drv_busy_msgq_limits, (ErlDrvPort, ErlDrvSizeT *, ErlDrvSizeT *)); WDD_TYPEDEF(int, driver_select, (ErlDrvPort, ErlDrvEvent, int, int)); WDD_TYPEDEF(int, driver_event, (ErlDrvPort, ErlDrvEvent,ErlDrvEventData)); WDD_TYPEDEF(int, driver_output, (ErlDrvPort, char *, ErlDrvSizeT)); @@ -47,6 +48,7 @@ WDD_TYPEDEF(ErlDrvSizeT, driver_vec_to_buf, (ErlIOVec *, char *, ErlDrvSizeT)); WDD_TYPEDEF(int, driver_set_timer, (ErlDrvPort, unsigned long)); WDD_TYPEDEF(int, driver_cancel_timer, (ErlDrvPort)); WDD_TYPEDEF(int, driver_read_timer, (ErlDrvPort, unsigned long *)); +WDD_TYPEDEF(int, erl_drv_consume_timeslice, (ErlDrvPort, int)); WDD_TYPEDEF(char *, erl_errno_id, (int)); WDD_TYPEDEF(void, set_busy_port, (ErlDrvPort, int)); WDD_TYPEDEF(void, set_port_control_flags, (ErlDrvPort, int)); @@ -152,6 +154,7 @@ typedef struct { WDD_FTYPE(driver_failure) *driver_failure; WDD_FTYPE(driver_exit) *driver_exit; WDD_FTYPE(driver_failure_eof) *driver_failure_eof; + WDD_FTYPE(erl_drv_busy_msgq_limits) *erl_drv_busy_msgq_limits; WDD_FTYPE(driver_select) *driver_select; WDD_FTYPE(driver_event) *driver_event; WDD_FTYPE(driver_output) *driver_output; @@ -162,6 +165,7 @@ typedef struct { WDD_FTYPE(driver_set_timer) *driver_set_timer; WDD_FTYPE(driver_cancel_timer) *driver_cancel_timer; WDD_FTYPE(driver_read_timer) *driver_read_timer; + WDD_FTYPE(erl_drv_consume_timeslice) *erl_drv_consume_timeslice; WDD_FTYPE(erl_errno_id) *erl_errno_id; WDD_FTYPE(set_busy_port)* set_busy_port; WDD_FTYPE(set_port_control_flags) *set_port_control_flags; @@ -261,6 +265,7 @@ extern TWinDynDriverCallbacks WinDynDriverCallbacks; #define driver_failure (WinDynDriverCallbacks.driver_failure) #define driver_exit (WinDynDriverCallbacks.driver_exit) #define driver_failure_eof (WinDynDriverCallbacks.driver_failure_eof) +#define erl_drv_busy_msgq_limits (WinDynDriverCallbacks.erl_drv_busy_msgq_limits) #define driver_select (WinDynDriverCallbacks.driver_select) #define driver_event (WinDynDriverCallbacks.driver_event) #define driver_output (WinDynDriverCallbacks.driver_output) @@ -271,6 +276,7 @@ extern TWinDynDriverCallbacks WinDynDriverCallbacks; #define driver_set_timer (WinDynDriverCallbacks.driver_set_timer) #define driver_cancel_timer (WinDynDriverCallbacks.driver_cancel_timer) #define driver_read_timer (WinDynDriverCallbacks.driver_read_timer) +#define erl_drv_consume_timeslice (WinDynDriverCallbacks.erl_drv_consume_timeslice) #define erl_errno_id (WinDynDriverCallbacks.erl_errno_id) #define set_busy_port (WinDynDriverCallbacks.set_busy_port) #define set_port_control_flags (WinDynDriverCallbacks.set_port_control_flags) @@ -394,6 +400,7 @@ do { \ ((W).driver_failure) = driver_failure; \ ((W).driver_exit) = driver_exit; \ ((W).driver_failure_eof) = driver_failure_eof; \ +((W).erl_drv_busy_msgq_limits) = erl_drv_busy_msgq_limits;\ ((W).driver_select) = driver_select; \ ((W).driver_event) = driver_event; \ ((W).driver_output) = driver_output; \ @@ -404,6 +411,7 @@ do { \ ((W).driver_set_timer) = driver_set_timer; \ ((W).driver_cancel_timer) = driver_cancel_timer; \ ((W).driver_read_timer) = driver_read_timer; \ +((W).erl_drv_consume_timeslice) = erl_drv_consume_timeslice;\ ((W).erl_errno_id) = erl_errno_id; \ ((W).set_busy_port) = set_busy_port; \ ((W).set_port_control_flags) = set_port_control_flags; \ diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c index 1cd9072cea..19dffd0ea4 100755 --- a/erts/emulator/sys/win32/sys.c +++ b/erts/emulator/sys/win32/sys.c @@ -57,11 +57,13 @@ extern void _dosmaperr(DWORD); #define __argv e_argv #endif +typedef struct driver_data DriverData; + static void init_console(); static int get_and_remove_option(int* argc, char** argv, const char* option); static char *get_and_remove_option2(int *argc, char **argv, const char *option); -static int init_async_io(struct async_io* aio, int use_threads); +static int init_async_io(DriverData *dp, struct async_io* aio, int use_threads); static void release_async_io(struct async_io* aio, ErlDrvPort); static void async_read_file(struct async_io* aio, LPVOID buf, DWORD numToRead); static int async_write_file(struct async_io* aio, LPVOID buf, DWORD numToWrite); @@ -96,7 +98,7 @@ static erts_smp_atomic_t pipe_creation_counter; static int driver_write(long, HANDLE, byte*, int); static int create_file_thread(struct async_io* aio, int mode); #ifdef ERTS_SMP -static void close_active_handle(ErlDrvPort, HANDLE handle); +static void close_active_handle(DriverData *, HANDLE handle); static DWORD WINAPI threaded_handle_closer(LPVOID param); #endif static DWORD WINAPI threaded_reader(LPVOID param); @@ -440,6 +442,8 @@ typedef struct async_io { DWORD bytesTransferred; /* Bytes read or write in the last operation. * Valid only when DF_OVR_READY is set. */ + DriverData *dp; /* Pointer to driver data struct which + this struct is part of */ } AsyncIo; @@ -458,7 +462,7 @@ static BOOL (WINAPI *fpSetHandleInformation)(HANDLE,DWORD,DWORD); * none of the file handles. */ -typedef struct driver_data { +struct driver_data { int totalNeeded; /* Total number of bytes needed to fill * up the packet header or packet. */ int bytesInBuffer; /* Number of bytes read so far in @@ -476,7 +480,8 @@ typedef struct driver_data { AsyncIo in; /* Control block for overlapped reading. */ AsyncIo out; /* Control block for overlapped writing. */ int report_exit; /* Do report exit status for the port */ -} DriverData; + erts_atomic32_t refc; /* References to this struct */ +}; /* Driver interfaces */ static ErlDrvData spawn_start(ErlDrvPort, char*, SysDriverOpts*); @@ -581,6 +586,26 @@ struct erl_drv_entry vanilla_driver_entry = { stop_select }; +static ERTS_INLINE void +refer_driver_data(DriverData *dp) +{ +#ifdef DEBUG + erts_aint32_t refc = erts_atomic32_inc_read_nob(&dp->refc); + ASSERT(refc > 1); +#else + erts_atomic32_inc_nob(&dp->refc); +#endif +} + +static ERTS_INLINE void +unrefer_driver_data(DriverData *dp) +{ + erts_aint32_t refc = erts_atomic32_dec_read_mb(&dp->refc); + ASSERT(refc >= 0); + if (refc == 0) + driver_free(dp); +} + /* * Initialises a DriverData structure. * @@ -604,6 +629,7 @@ new_driver_data(ErlDrvPort port_num, int packet_bytes, int wait_objs_required, i * any more, since driver_select() can't fail. */ + erts_atomic32_init_nob(&dp->refc, 1); dp->bytesInBuffer = 0; dp->totalNeeded = packet_bytes; dp->inBufSize = PORT_BUFSIZ; @@ -616,9 +642,9 @@ new_driver_data(ErlDrvPort port_num, int packet_bytes, int wait_objs_required, i dp->port_num = port_num; dp->packet_bytes = packet_bytes; dp->port_pid = INVALID_HANDLE_VALUE; - if (init_async_io(&dp->in, use_threads) == -1) + if (init_async_io(dp, &dp->in, use_threads) == -1) goto async_io_error1; - if (init_async_io(&dp->out, use_threads) == -1) + if (init_async_io(dp, &dp->out, use_threads) == -1) goto async_io_error2; return dp; @@ -662,7 +688,7 @@ release_driver_data(DriverData* dp) dp->in.fd = INVALID_HANDLE_VALUE; DEBUGF(("Waiting for the in event thingie")); if (WaitForSingleObject(dp->in.ov.hEvent,timeout) == WAIT_TIMEOUT) { - close_active_handle(dp->port_num, dp->in.ov.hEvent); + close_active_handle(dp, dp->in.ov.hEvent); dp->in.ov.hEvent = NULL; timeout = 0; } @@ -673,7 +699,7 @@ release_driver_data(DriverData* dp) dp->out.fd = INVALID_HANDLE_VALUE; DEBUGF(("Waiting for the out event thingie")); if (WaitForSingleObject(dp->out.ov.hEvent,timeout) == WAIT_TIMEOUT) { - close_active_handle(dp->port_num, dp->out.ov.hEvent); + close_active_handle(dp, dp->out.ov.hEvent); dp->out.ov.hEvent = NULL; } DEBUGF(("...done\n")); @@ -719,7 +745,7 @@ release_driver_data(DriverData* dp) * the exit thread. */ - driver_free(dp); + unrefer_driver_data(dp); } #ifdef ERTS_SMP @@ -727,11 +753,12 @@ release_driver_data(DriverData* dp) struct handles_to_be_closed { HANDLE handles[MAXIMUM_WAIT_OBJECTS]; unsigned cnt; + DriverData *dp; }; static struct handles_to_be_closed* htbc_curr = NULL; CRITICAL_SECTION htbc_lock; -static void close_active_handle(ErlDrvPort port_num, HANDLE handle) +static void close_active_handle(DriverData *dp, HANDLE handle) { struct handles_to_be_closed* htbc; int i; @@ -745,11 +772,14 @@ static void close_active_handle(ErlDrvPort port_num, HANDLE handle) sizeof(*htbc)); htbc->handles[0] = CreateAutoEvent(FALSE); htbc->cnt = 1; + htbc->dp = dp; + refer_driver_data(dp); /* Need to keep driver data until we have + closed the event; outstanding operation + might write into it.. */ thread = (HANDLE *) _beginthreadex(NULL, 0, threaded_handle_closer, htbc, 0, &tid); CloseHandle(thread); } htbc->handles[htbc->cnt++] = handle; - driver_select(port_num, (ErlDrvEvent)handle, ERL_DRV_USE_NO_CALLBACK, 0); SetEvent(htbc->handles[0]); htbc_curr = htbc; LeaveCriticalSection(&htbc_lock); @@ -798,6 +828,7 @@ threaded_handle_closer(LPVOID param) } LeaveCriticalSection(&htbc_lock); CloseHandle(htbc->handles[0]); + unrefer_driver_data(htbc->dp); erts_free(ERTS_ALC_T_DRV_TAB, htbc); DEBUGF(("threaded_handle_closer %p terminating\r\n", htbc)); return 0; @@ -864,8 +895,9 @@ reuse_driver_data(DriverData *dp, HANDLE ifd, HANDLE ofd, int read_write, ErlDrv */ static int -init_async_io(AsyncIo* aio, int use_threads) +init_async_io(DriverData *dp, AsyncIo* aio, int use_threads) { + aio->dp = dp; aio->flags = 0; aio->thread = (HANDLE) -1; aio->fd = INVALID_HANDLE_VALUE; @@ -884,6 +916,8 @@ init_async_io(AsyncIo* aio, int use_threads) if (aio->ov.hEvent == NULL) return -1; if (use_threads) { + OV_BUFFER_PTR(aio) = NULL; + OV_NUM_TO_READ(aio) = 0; aio->ioAllowed = CreateAutoEvent(FALSE); if (aio->ioAllowed == NULL) return -1; @@ -914,12 +948,8 @@ release_async_io(AsyncIo* aio, ErlDrvPort port_num) CloseHandle(aio->fd); aio->fd = INVALID_HANDLE_VALUE; - if (aio->ov.hEvent != NULL) { - (void) driver_select(port_num, - (ErlDrvEvent)aio->ov.hEvent, - ERL_DRV_USE, 0); - /* was CloseHandle(aio->ov.hEvent); */ - } + if (aio->ov.hEvent != NULL) + CloseHandle(aio->ov.hEvent); aio->ov.hEvent = NULL; @@ -1260,9 +1290,9 @@ spawn_start(ErlDrvPort port_num, char* name, SysDriverOpts* opts) retval = set_driver_data(dp, hFromChild, hToChild, opts->read_write, opts->exit_status); if (retval != ERL_DRV_ERROR_GENERAL && retval != ERL_DRV_ERROR_ERRNO) { - Port *prt = erts_drvport2port_raw(port_num); + Port *prt = erts_drvport2port(port_num); /* We assume that this cannot generate a negative number */ - ASSERT(prt); + ASSERT(prt != ERTS_INVALID_ERL_DRV_PORT); prt->os_pid = (SWord) pid; } } @@ -1287,12 +1317,15 @@ create_file_thread(AsyncIo* aio, int mode) { DWORD tid; /* Id for thread. */ + refer_driver_data(aio->dp); aio->thread = (HANDLE) _beginthreadex(NULL, 0, (mode & DO_WRITE) ? threaded_writer : threaded_reader, aio, 0, &tid); - - return aio->thread != (HANDLE) -1; + if (aio->thread != (HANDLE) -1) + return 1; + unrefer_driver_data(aio->dp); + return 0; } /* @@ -2078,6 +2111,7 @@ threaded_reader(LPVOID param) if (aio->flags & DF_EXIT_THREAD) break; } + unrefer_driver_data(aio->dp); return 0; } @@ -2157,6 +2191,7 @@ threaded_writer(LPVOID param) } CloseHandle(aio->fd); aio->fd = INVALID_HANDLE_VALUE; + unrefer_driver_data(aio->dp); return 0; } @@ -2297,6 +2332,7 @@ static void fd_stop(ErlDrvData data) (void) driver_select(dp->port_num, (ErlDrvEvent)dp->out.ov.hEvent, ERL_DRV_WRITE, 0); + ASSERT(dp->out.flushEvent); SetEvent(dp->out.flushEvent); WaitForSingleObject(dp->out.flushReplyEvent, INFINITE); } @@ -2349,12 +2385,12 @@ stop(ErlDrvData data) if (dp->in.ov.hEvent != NULL) { (void) driver_select(dp->port_num, (ErlDrvEvent)dp->in.ov.hEvent, - ERL_DRV_READ, 0); + ERL_DRV_READ|ERL_DRV_USE_NO_CALLBACK, 0); } if (dp->out.ov.hEvent != NULL) { (void) driver_select(dp->port_num, (ErlDrvEvent)dp->out.ov.hEvent, - ERL_DRV_WRITE, 0); + ERL_DRV_WRITE|ERL_DRV_USE_NO_CALLBACK, 0); } if (dp->out.thread == (HANDLE) -1 && dp->in.thread == (HANDLE) -1) { @@ -2366,6 +2402,8 @@ stop(ErlDrvData data) */ HANDLE thread; DWORD tid; + + /* threaded_exiter implicitly takes over refc from us... */ thread = (HANDLE *) _beginthreadex(NULL, 0, threaded_exiter, dp, 0, &tid); CloseHandle(thread); } diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl index dae36fed8f..dfba7d098f 100644 --- a/erts/emulator/test/driver_SUITE.erl +++ b/erts/emulator/test/driver_SUITE.erl @@ -78,7 +78,8 @@ otp_9302/1, thr_free_drv/1, async_blast/1, - thr_msg_blast/1]). + thr_msg_blast/1, + consume_timeslice/1]). -export([bin_prefix/2]). @@ -149,7 +150,8 @@ all() -> otp_9302, thr_free_drv, async_blast, - thr_msg_blast]. + thr_msg_blast, + consume_timeslice]. groups() -> [{timer, [], @@ -2073,10 +2075,329 @@ thr_msg_blast(Config) when is_list(Config) -> Res end. +consume_timeslice(Config) when is_list(Config) -> + %% + %% Verify that erl_drv_consume_timeslice() works. + %% + %% The first four cases expect that the command signal is + %% delivered immediately, i.e., isn't scheduled. Since there + %% are no conflicts these signals should normally be delivered + %% immediately. However some builds and configurations may + %% schedule these ops anyway, in these cases we do not verify + %% scheduling counts. + %% + %% When signal is delivered immediately we must take into account + %% that process and port are "virtualy" scheduled out and in + %% in the trace generated. + %% + %% Port ! {_, {command, _}, and port_command() differs. The send + %% instruction needs to check if the caller is out of reductions + %% at the end of the instruction, since no erlang function call + %% is involved. Otherwise, a sequence of send instructions would + %% not be scheduled out even when out of reductions. port_commond() + %% doesn't do that since it will always (since R16A) be called via + %% the erlang wrappers in the erlang module. + %% + %% The last two cases tests scheduled operations. We create + %% a conflict by executing at the same time on different + %% schedulers. When only one scheduler we enable parallelism on + %% the port instead. + %% + + Path = ?config(data_dir, Config), + erl_ddll:start(), + ok = load_driver(Path, consume_timeslice_drv), + Port = open_port({spawn, consume_timeslice_drv}, [{parallelism, false}]), + + Parent = self(), + Go = make_ref(), + + "enabled" = port_control(Port, $E, ""), + Proc1 = spawn_link(fun () -> + receive Go -> ok end, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}} + end), + receive after 100 -> ok end, + count_pp_sched_start(), + Proc1 ! Go, + wait_command_msgs(Port, 10), + [{Port, Sprt1}, {Proc1, Sproc1}] = count_pp_sched_stop([Port, Proc1]), + case Sprt1 of + 10 -> + true = in_range(5, Sproc1-10, 7); + _ -> + case erlang:system_info(lock_checking) of + true -> ?t:format("Ignore bad sched count due to lock checking", []); + false -> ?t:fail({unexpected_sched_counts, Sprt1, Sproc1}) + end + end, + + "disabled" = port_control(Port, $D, ""), + Proc2 = spawn_link(fun () -> + receive Go -> ok end, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}} + end), + receive after 100 -> ok end, + count_pp_sched_start(), + Proc2 ! Go, + wait_command_msgs(Port, 10), + [{Port, Sprt2}, {Proc2, Sproc2}] = count_pp_sched_stop([Port, Proc2]), + case Sprt2 of + 10 -> + true = in_range(1, Sproc2-10, 2); + _ -> + case erlang:system_info(lock_checking) of + true -> ?t:format("Ignore bad sched count due to lock checking", []); + false -> ?t:fail({unexpected_sched_counts, Sprt2, Sproc2}) + end + end, + + "enabled" = port_control(Port, $E, ""), + Proc3 = spawn_link(fun () -> + receive Go -> ok end, + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, "") + end), + count_pp_sched_start(), + Proc3 ! Go, + wait_command_msgs(Port, 10), + [{Port, Sprt3}, {Proc3, Sproc3}] = count_pp_sched_stop([Port, Proc3]), + case Sprt3 of + 10 -> + true = in_range(5, Sproc3-10, 7); + _ -> + case erlang:system_info(lock_checking) of + true -> ?t:format("Ignore bad sched count due to lock checking", []); + false -> ?t:fail({unexpected_sched_counts, Sprt3, Sproc3}) + end + end, + + "disabled" = port_control(Port, $D, ""), + Proc4 = spawn_link(fun () -> + receive Go -> ok end, + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, "") + end), + count_pp_sched_start(), + Proc4 ! Go, + wait_command_msgs(Port, 10), + [{Port, Sprt4}, {Proc4, Sproc4}] = count_pp_sched_stop([Port, Proc4]), + case Sprt4 of + 10 -> + true = in_range(1, Sproc4-10, 2); + _ -> + case erlang:system_info(lock_checking) of + true -> ?t:format("Ignore bad sched count due to lock checking", []); + false -> ?t:fail({unexpected_sched_counts, Sprt4, Sproc4}) + end + end, + + SOnl = erlang:system_info(schedulers_online), + %% If only one scheduler use port with parallelism set to true, + %% in order to trigger scheduling of command signals + Port2 = case SOnl of + 1 -> + Port ! {self(), close}, + receive {Port, closed} -> ok end, + open_port({spawn, consume_timeslice_drv}, + [{parallelism, true}]); + _ -> + process_flag(scheduler, 1), + 1 = erlang:system_info(scheduler_id), + Port + end, + count_pp_sched_start(), + "enabled" = port_control(Port2, $E, ""), + W5 = case SOnl of + 1 -> + false; + _ -> + W1= spawn_opt(fun () -> + 2 = erlang:system_info(scheduler_id), + "sleeped" = port_control(Port2, $S, "") + end, [link,{scheduler,2}]), + receive after 100 -> ok end, + W1 + end, + Proc5 = spawn_opt(fun () -> + receive Go -> ok end, + 1 = erlang:system_info(scheduler_id), + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}} + end, [link,{scheduler,1}]), + receive after 100 -> ok end, + Proc5 ! Go, + wait_procs_exit([W5, Proc5]), + wait_command_msgs(Port2, 10), + [{Port2, Sprt5}, {Proc5, Sproc5}] = count_pp_sched_stop([Port2, Proc5]), + true = in_range(2, Sproc5, 3), + true = in_range(7, Sprt5, 20), + + count_pp_sched_start(), + "disabled" = port_control(Port2, $D, ""), + W6 = case SOnl of + 1 -> + false; + _ -> + W2= spawn_opt(fun () -> + 2 = erlang:system_info(scheduler_id), + "sleeped" = port_control(Port2, $S, "") + end, [link,{scheduler,2}]), + receive after 100 -> ok end, + W2 + end, + Proc6 = spawn_opt(fun () -> + receive Go -> ok end, + 1 = erlang:system_info(scheduler_id), + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}} + end, [link,{scheduler,1}]), + receive after 100 -> ok end, + Proc6 ! Go, + wait_procs_exit([W6, Proc6]), + wait_command_msgs(Port2, 10), + [{Port2, Sprt6}, {Proc6, Sproc6}] = count_pp_sched_stop([Port2, Proc6]), + true = in_range(2, Sproc6, 3), + true = in_range(3, Sprt6, 6), + + process_flag(scheduler, 0), + + Port2 ! {self(), close}, + receive {Port2, closed} -> ok end, + ok. + +wait_command_msgs(_, 0) -> + ok; +wait_command_msgs(Port, N) -> + receive + {Port, command} -> + wait_command_msgs(Port, N-1) + end. + +in_range(Low, Val, High) when is_integer(Low), + is_integer(Val), + is_integer(High), + Low =< Val, + Val =< High -> + true; +in_range(Low, Val, High) when is_integer(Low), + is_integer(Val), + is_integer(High) -> + false. + +count_pp_sched_start() -> + erlang:trace(all, true, [running_procs, running_ports, {tracer, self()}]), + ok. + +count_pp_sched_stop(Ps) -> + Td = erlang:trace_delivered(all), + erlang:trace(all, false, [running_procs, running_ports, {tracer, self()}]), + PNs = lists:map(fun (P) -> {P, 0} end, Ps), + receive {trace_delivered, all, Td} -> ok end, + Res = count_proc_sched(Ps, PNs), + ?t:format("Scheduling counts: ~p~n", [Res]), + erlang:display({scheduling_counts, Res}), + Res. + +do_inc_pn(_P, []) -> + throw(undefined); +do_inc_pn(P, [{P,N}|PNs]) -> + [{P,N+1}|PNs]; +do_inc_pn(P, [PN|PNs]) -> + [PN|do_inc_pn(P, PNs)]. + +inc_pn(P, PNs) -> + try + do_inc_pn(P, PNs) + catch + throw:undefined -> PNs + end. + +count_proc_sched(Ps, PNs) -> + receive + TT when element(1, TT) == trace, element(3, TT) == in -> +% erlang:display(TT), + count_proc_sched(Ps, inc_pn(element(2, TT), PNs)); + TT when element(1, TT) == trace, element(3, TT) == out -> + count_proc_sched(Ps, PNs) + after 0 -> + PNs + end. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Utilities %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%flush_msgs() -> +% receive +% M -> +% erlang:display(M), +% flush_msgs() +% after 0 -> +% ok +% end. + +wait_procs_exit([]) -> + ok; +wait_procs_exit([P|Ps]) when is_pid(P) -> + Mon = erlang:monitor(process, P), + receive + {'DOWN', Mon, process, P, _} -> + wait_procs_exit(Ps) + end; +wait_procs_exit([_|Ps]) -> + wait_procs_exit(Ps). + get_port_msg(Port, Timeout) -> receive {Port, What} -> diff --git a/erts/emulator/test/driver_SUITE_data/Makefile.src b/erts/emulator/test/driver_SUITE_data/Makefile.src index b667dff6b6..1fedd72200 100644 --- a/erts/emulator/test/driver_SUITE_data/Makefile.src +++ b/erts/emulator/test/driver_SUITE_data/Makefile.src @@ -15,7 +15,8 @@ MISC_DRVS = outputv_drv@dll@ \ otp_9302_drv@dll@ \ thr_free_drv@dll@ \ async_blast_drv@dll@ \ - thr_msg_blast_drv@dll@ + thr_msg_blast_drv@dll@ \ + consume_timeslice_drv@dll@ SYS_INFO_DRVS = sys_info_base_drv@dll@ \ sys_info_prev_drv@dll@ \ diff --git a/erts/emulator/test/driver_SUITE_data/consume_timeslice_drv.c b/erts/emulator/test/driver_SUITE_data/consume_timeslice_drv.c new file mode 100644 index 0000000000..6b0c4cf37d --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/consume_timeslice_drv.c @@ -0,0 +1,172 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2012. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#include "erl_driver.h" +#ifdef __WIN32__ +#include <windows.h> +#else +#include <unistd.h> +#endif +#include <stdio.h> +#include <string.h> + +static void stop(ErlDrvData drv_data); +static ErlDrvData start(ErlDrvPort port, + char *command); +static void output(ErlDrvData drv_data, + char *buf, ErlDrvSizeT len); +static ErlDrvSSizeT control(ErlDrvData drv_data, + unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen); + +static ErlDrvEntry consume_timeslice_drv_entry = { + NULL /* init */, + start, + stop, + output, + NULL /* ready_input */, + NULL /* ready_output */, + "consume_timeslice_drv", + NULL /* finish */, + NULL /* handle */, + control, + NULL /* timeout */, + NULL /* outputv */, + NULL /* ready_async */, + NULL /* flush */, + NULL /* call */, + NULL /* event */, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERL_DRV_FLAG_USE_PORT_LOCKING, + NULL /* handle2 */, + NULL /* handle_monitor */ +}; + +typedef struct { + ErlDrvPort port; + ErlDrvTermData tport; + ErlDrvTermData cmd_msg[6]; + int consume_timeslice; +} consume_timeslice_data_t; + + +DRIVER_INIT(consume_timeslice_drv) +{ + return &consume_timeslice_drv_entry; +} + +static void stop(ErlDrvData drv_data) +{ + driver_free((void *) drv_data); +} + +static ErlDrvData start(ErlDrvPort port, + char *command) +{ + consume_timeslice_data_t *ctsd; + + ctsd = driver_alloc(sizeof(consume_timeslice_data_t)); + if (!ctsd) + return ERL_DRV_ERROR_GENERAL; + + ctsd->port = port; + ctsd->tport = driver_mk_port(port); + ctsd->consume_timeslice = 0; + + ctsd->cmd_msg[0] = ERL_DRV_PORT; + ctsd->cmd_msg[1] = ctsd->tport; + ctsd->cmd_msg[2] = ERL_DRV_ATOM; + ctsd->cmd_msg[3] = driver_mk_atom("command"); + ctsd->cmd_msg[4] = ERL_DRV_TUPLE; + ctsd->cmd_msg[5] = (ErlDrvTermData) 2; + + return (ErlDrvData) ctsd; +} + +static void output(ErlDrvData drv_data, + char *buf, ErlDrvSizeT len) +{ + consume_timeslice_data_t *ctsd = (consume_timeslice_data_t *) drv_data; + int res; + + if (ctsd->consume_timeslice) { + int res = erl_drv_consume_timeslice(ctsd->port, 50); + if (res < 0) { + driver_failure_atom(ctsd->port, "erl_drv_consume_timeslice() failed"); + return; + } + } + + res = erl_drv_output_term(ctsd->tport, + ctsd->cmd_msg, + sizeof(ctsd->cmd_msg)/sizeof(ErlDrvTermData)); + if (res <= 0) { + driver_failure_atom(ctsd->port, "erl_drv_output_term() failed"); + return; + } +} +static ErlDrvSSizeT control(ErlDrvData drv_data, + unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen) +{ + consume_timeslice_data_t *ctsd = (consume_timeslice_data_t *) drv_data; + int res; + char *res_str; + ErlDrvSSizeT res_len; + + switch (command) { + case 'E': + ctsd->consume_timeslice = 1; + res_str = "enabled"; + break; + case 'D': + ctsd->consume_timeslice = 0; + res_str = "disabled"; + break; + case 'S': +#ifdef __WIN32__ + Sleep((DWORD) 1000); +#else + sleep(1); +#endif + res_str = "sleeped"; + break; + default: + res_str = "what?"; + break; + } + + res_len = strlen(res_str); + if (res_len > rlen) { + char *abuf = driver_alloc(sizeof(char)*res_len); + if (!abuf) { + driver_failure_atom(ctsd->port, "driver_alloc() failed"); + return 0; + } + *rbuf = abuf; + } + + memcpy((void *) *rbuf, (void *) res_str, res_len); + + return res_len; +} diff --git a/erts/emulator/test/efile_SUITE.erl b/erts/emulator/test/efile_SUITE.erl index 9ac004200e..ddf23f90fd 100644 --- a/erts/emulator/test/efile_SUITE.erl +++ b/erts/emulator/test/efile_SUITE.erl @@ -21,6 +21,8 @@ init_per_group/2,end_per_group/2]). -export([iter_max_files/1]). +-export([do_iter_max_files/2]). + -include_lib("test_server/include/test_server.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -51,11 +53,17 @@ end_per_group(_GroupName, Config) -> iter_max_files(suite) -> []; iter_max_files(Config) when is_list(Config) -> - ?line DataDir = ?config(data_dir,Config), - ?line TestFile = filename:join(DataDir, "existing_file"), - ?line L = do_iter_max_files(10, TestFile), - ?line io:format("Number of files opened in each test:~n~w\n", [L]), - ?line all_equal(L), + DataDir = ?config(data_dir,Config), + TestFile = filename:join(DataDir, "existing_file"), + N = 10, + %% Run on a different node in order to set the max ports + Dir = filename:dirname(code:which(?MODULE)), + {ok,Node} = test_server:start_node(test_iter_max_files,slave, + [{args,"+Q 1524 -pa " ++ Dir}]), + L = rpc:call(Node,?MODULE,do_iter_max_files,[N, TestFile]), + test_server:stop_node(Node), + io:format("Number of files opened in each test:~n~w\n", [L]), + all_equal(L), Head = hd(L), if Head >= 2 -> ok; true -> ?line test_server:fail(too_few_files) @@ -91,6 +99,6 @@ open_files(Name) -> {ok, Fd} -> [Fd| open_files(Name)]; {error, Reason} -> - io:format("Error reason: ~p", [Reason]), +% io:format("Error reason: ~p", [Reason]), [] end. diff --git a/erts/emulator/test/hash_SUITE.erl b/erts/emulator/test/hash_SUITE.erl index 830ed91da9..e34050cd07 100644 --- a/erts/emulator/test/hash_SUITE.erl +++ b/erts/emulator/test/hash_SUITE.erl @@ -1,3 +1,4 @@ +%% -*- coding: utf-8 -*- %% %% %CopyrightBegin% %% @@ -75,7 +76,7 @@ config(priv_dir,_) -> test_phash2/1,otp_5292/1,bit_level_binaries/1,otp_7127/1, end_per_testcase/2,init_per_testcase/2]). init_per_testcase(_Case, Config) -> - ?line Dog=test_server:timetrap(test_server:minutes(10)), + Dog=test_server:timetrap(test_server:minutes(10)), [{watchdog, Dog}|Config]. end_per_testcase(_Case, Config) -> @@ -169,24 +170,24 @@ otp_7127(Config) when is_list(Config) -> %% define -DSTANDALONE when compiling. %% basic_test() -> - ?line 685556714 = erlang:phash({a,b,c},16#FFFFFFFF), - ?line 14468079 = erlang:hash({a,b,c},16#7FFFFFF), - ?line 37442646 = erlang:phash([a,b,c,{1,2,3},c:pid(0,2,3), + 685556714 = erlang:phash({a,b,c},16#FFFFFFFF), + 14468079 = erlang:hash({a,b,c},16#7FFFFFF), + 37442646 = erlang:phash([a,b,c,{1,2,3},c:pid(0,2,3), 16#77777777777777],16#FFFFFFFF), - ?line Comment = case erlang:hash([a,b,c,{1,2,3},c:pid(0,2,3), + Comment = case erlang:hash([a,b,c,{1,2,3},c:pid(0,2,3), 16#77777777777777],16#7FFFFFF) of 102727602 -> - ?line big = erlang:system_info(endian), + big = erlang:system_info(endian), "Big endian machine"; 105818829 -> - ?line little = erlang:system_info(endian), + little = erlang:system_info(endian), "Little endian machine" end, ExternalReference = <<131,114,0,3,100,0,13,110,111,110,111,100,101,64, 110,111,104,111,115,116,0,0,0,0,122,0,0,0,0,0,0,0,0>>, - ?line 1113403635 = erlang:phash(binary_to_term(ExternalReference), + 1113403635 = erlang:phash(binary_to_term(ExternalReference), 16#FFFFFFFF), - ?line 123 = erlang:hash(binary_to_term(ExternalReference), + 123 = erlang:hash(binary_to_term(ExternalReference), 16#7FFFFFF), ExternalFun = <<131,117,0,0,0,3,103,100,0,13,110,111,110,111,100,101,64, 110,111,104,111,115,116,0,0,0,38,0,0,0,0,0,100,0,8,101, @@ -204,9 +205,9 @@ basic_test() -> 104,101,108,108,100,0,10,108,111,99,97,108,95,102,117, 110,99,108,0,0,0,1,103,100,0,13,110,111,110,111,100,101, 64,110,111,104,111,115,116,0,0,0,22,0,0,0,0,0,106>>, - ?line 170987488 = erlang:phash(binary_to_term(ExternalFun), + 170987488 = erlang:phash(binary_to_term(ExternalFun), 16#FFFFFFFF), - ?line 124460689 = erlang:hash(binary_to_term(ExternalFun), + 124460689 = erlang:hash(binary_to_term(ExternalFun), 16#7FFFFFF), case (catch erlang:phash(1,0)) of {'EXIT',{badarg, _}} -> @@ -237,23 +238,23 @@ range_test() -> spread_test(N) -> - ?line test_fun(N,{erlang,phash},16#50000000000,fun(X) -> + test_fun(N,{erlang,phash},16#50000000000,fun(X) -> X end), - ?line test_fun(N,{erlang,phash},0,fun(X) -> + test_fun(N,{erlang,phash},0,fun(X) -> X end), - ?line test_fun(N,{erlang,phash},16#123456789ABCDEF123456789ABCDEF,fun(X) -> + test_fun(N,{erlang,phash},16#123456789ABCDEF123456789ABCDEF,fun(X) -> X end), - ?line test_fun(N,{erlang,phash},16#50000000000,fun(X) -> + test_fun(N,{erlang,phash},16#50000000000,fun(X) -> integer_to_list(X) end), - ?line test_fun(N,{erlang,phash},16#50000000000,fun(X) -> + test_fun(N,{erlang,phash},16#50000000000,fun(X) -> integer_to_bytelist(X,[]) end), - ?line test_fun(N,{erlang,phash},16#50000000000,fun(X) -> - integer_to_binary(X) + test_fun(N,{erlang,phash},16#50000000000,fun(X) -> + integer_to_binary_value(X) end). @@ -265,14 +266,14 @@ cmp_test(N) -> do_cmp_hashes(0,_) -> ok; do_cmp_hashes(N,Steps) -> - ?line R0 = random:uniform(1 bsl Steps - 1) + random:uniform(16#FFFFFFFF), - ?line R = case random:uniform(2) of + R0 = random:uniform(1 bsl Steps - 1) + random:uniform(16#FFFFFFFF), + R = case random:uniform(2) of 1 -> R0; _ -> -R0 end, - ?line NSteps = case N rem 10 of + NSteps = case N rem 10 of 0 -> case (Steps + 8) rem 1024 of 0 -> @@ -283,9 +284,9 @@ do_cmp_hashes(N,Steps) -> _ -> Steps end, - ?line X = erlang:phash(R,16#FFFFFFFF), - ?line Y = make_hash(R,16#FFFFFFFF), - ?line case X =:= Y of + X = erlang:phash(R,16#FFFFFFFF), + Y = make_hash(R,16#FFFFFFFF), + case X =:= Y of true -> do_cmp_hashes(N - 1, NSteps); _ -> @@ -363,6 +364,15 @@ phash2_test() -> %% (cannot use block_hash due to compatibility issues...) {abc,26499}, {abd,26500}, + {'åäö', 62518}, + %% 81 runes as an atom, 'ᚠᚡᚢᚣᚤᚥᚦᚧᚨᚩᚪᚫᚬᚭᚮᚯᚰᚱᚲᚳᚴᚵᚶᚷᚸᚹᚺᚻᚼᚽᚾᚿᛀᛁᛂᛃᛄᛅᛆᛇᛈᛉᛊᛋᛌᛍᛎᛏᛐᛑᛒᛓᛔᛕᛖᛗᛘᛙᛚᛛᛜᛝᛞᛟᛠᛡᛢᛣᛤᛥᛦᛧᛨᛩᛪ᛫᛬᛭ᛮᛯᛰ' + {erlang:binary_to_term(<<131, 118, 0, 243, (unicode:characters_to_binary(lists:seq(5792, 5872)))/binary >>), 241561024}, + %% åäö dynamic + {erlang:binary_to_term(<<131, 118, 0, 6, 195, 165, 195, 164, 195, 182>>),62518}, + %% the atom '゙゚゛゜ゝゞゟ゠ァアィイゥウェエォオカガキギクグケゲコゴサザシジスズ' + {erlang:binary_to_term(<<131, 118, 0, 102, (unicode:characters_to_binary(lists:seq(12441, 12542)))/binary>>), 246053818}, + %% the atom, '😃' + {erlang:binary_to_term(<<131, 118, 0, 4, 240, 159, 152, 131>>), 1026307}, %% small {0,3175731469}, @@ -469,8 +479,8 @@ phash2_test() -> SpecFun = fun(S) -> sofs:no_elements(S) > 1 end, F = sofs:relation_to_family(sofs:converse(sofs:relation(L))), D = sofs:to_external(sofs:family_specification(SpecFun, F)), - ?line [] = D, - ?line [] = [{E,H,H2} || {E,H} <- L, (H2 = erlang:phash2(E, Max)) =/= H], + [] = D, + [] = [{E,H,H2} || {E,H} <- L, (H2 = erlang:phash2(E, Max)) =/= H], ok. -ifdef(FALSE). @@ -497,17 +507,17 @@ otp_5292_test() -> end, S2 = md5([md5(hash_int(S, E, PH)) || {Start, N, Sz} <- d(), {S, E} <- int(Start, N, Sz)]), - ?line Comment = case S1 of + Comment = case S1 of <<4,248,208,156,200,131,7,1,173,13,239,173,112,81,16,174>> -> - ?line big = erlang:system_info(endian), + big = erlang:system_info(endian), "Big endian machine"; <<180,28,33,231,239,184,71,125,76,47,227,241,78,184,176,233>> -> - ?line little = erlang:system_info(endian), + little = erlang:system_info(endian), "Little endian machine" end, - ?line <<124,81,198,121,174,233,19,137,10,83,33,80,226,111,238,99>> = S2, - ?line 2 = erlang:hash(1, (1 bsl 27) -1), - ?line {'EXIT', _} = (catch erlang:hash(1, (1 bsl 27))), + <<124,81,198,121,174,233,19,137,10,83,33,80,226,111,238,99>> = S2, + 2 = erlang:hash(1, (1 bsl 27) -1), + {'EXIT', _} = (catch erlang:hash(1, (1 bsl 27))), {comment, Comment}. d() -> @@ -528,21 +538,21 @@ md5(T) -> erlang:md5(term_to_binary(T)). bit_level_binaries() -> - ?line [3511317,7022633,14044578,28087749,56173436,112344123,90467083|_] = + [3511317,7022633,14044578,28087749,56173436,112344123,90467083|_] = bit_level_all_different(fun erlang:hash/2), - ?line [3511317,7022633,14044578,28087749,56173436,112344123,90467083|_] = + [3511317,7022633,14044578,28087749,56173436,112344123,90467083|_] = bit_level_all_different(fun erlang:phash/2), - ?line [102233154,19716,102133857,4532024,123369135,24565730,109558721|_] = + [102233154,19716,102133857,4532024,123369135,24565730,109558721|_] = bit_level_all_different(fun erlang:phash2/2), - ?line 13233341 = test_hash_phash(<<42:7>>, 16#7FFFFFF), - ?line 79121243 = test_hash_phash(<<99:7>>, 16#7FFFFFF), - ?line 95517726 = test_hash_phash(<<16#378ABF73:31>>, 16#7FFFFFF), + 13233341 = test_hash_phash(<<42:7>>, 16#7FFFFFF), + 79121243 = test_hash_phash(<<99:7>>, 16#7FFFFFF), + 95517726 = test_hash_phash(<<16#378ABF73:31>>, 16#7FFFFFF), - ?line 64409098 = test_phash2(<<99:7>>, 16#7FFFFFF), - ?line 55555814 = test_phash2(<<123,19:2>>, 16#7FFFFFF), - ?line 83868582 = test_phash2(<<123,45,6:3>>, 16#7FFFFFF), - ?line 2123204 = test_phash2(<<123,45,7:3>>, 16#7FFFFFF), + 64409098 = test_phash2(<<99:7>>, 16#7FFFFFF), + 55555814 = test_phash2(<<123,19:2>>, 16#7FFFFFF), + 83868582 = test_phash2(<<123,45,6:3>>, 16#7FFFFFF), + 2123204 = test_phash2(<<123,45,7:3>>, 16#7FFFFFF), ok. @@ -579,7 +589,7 @@ test_phash2(Bitstr, Rem) -> otp_7127_test() -> %% Used to return 2589127136. - ?line 38990304 = erlang:phash2(<<"Scott9">>), + 38990304 = erlang:phash2(<<"Scott9">>), ok. %% @@ -711,7 +721,7 @@ collect_hits() -> init_table(), N. -integer_to_binary(N) -> +integer_to_binary_value(N) -> list_to_binary(lists:reverse(integer_to_bytelist(N,[]))). integer_to_bytelist(0,Acc) -> diff --git a/erts/emulator/test/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl index c625e655ce..b92a0e2059 100644 --- a/erts/emulator/test/num_bif_SUITE.erl +++ b/erts/emulator/test/num_bif_SUITE.erl @@ -31,24 +31,28 @@ %% list_to_integer/1 %% round/1 %% trunc/1 - --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, t_abs/1, t_float/1, - t_float_to_list/1, t_integer_to_list/1, - t_list_to_integer/1, - t_list_to_float_safe/1, t_list_to_float_risky/1, - t_round/1, t_trunc/1]). +%% integer_to_binary/1 +%% integer_to_binary/2 +%% binary_to_integer/1 + +-export([all/0, suite/0, groups/0, init_per_suite/1, end_per_suite/1, + init_per_group/2, end_per_group/2, t_abs/1, t_float/1, + t_float_to_string/1, t_integer_to_string/1, + t_string_to_integer/1, + t_string_to_float_safe/1, t_string_to_float_risky/1, + t_round/1, t_trunc/1 + ]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [t_abs, t_float, t_float_to_list, t_integer_to_list, - {group, t_list_to_float}, t_list_to_integer, t_round, + [t_abs, t_float, t_float_to_string, t_integer_to_string, + {group, t_string_to_float}, t_string_to_integer, t_round, t_trunc]. groups() -> - [{t_list_to_float, [], - [t_list_to_float_safe, t_list_to_float_risky]}]. + [{t_string_to_float, [], + [t_string_to_float_safe, t_string_to_float_risky]}]. init_per_suite(Config) -> Config. @@ -65,273 +69,382 @@ end_per_group(_GroupName, Config) -> t_abs(Config) when is_list(Config) -> %% Floats. - ?line 5.5 = abs(id(5.5)), - ?line 0.0 = abs(id(0.0)), - ?line 100.0 = abs(id(-100.0)), + 5.5 = abs(id(5.5)), + 0.0 = abs(id(0.0)), + 100.0 = abs(id(-100.0)), %% Integers. - ?line 5 = abs(id(5)), - ?line 0 = abs(id(0)), - ?line 100 = abs(id(-100)), + 5 = abs(id(5)), + 0 = abs(id(0)), + 100 = abs(id(-100)), %% The largest smallnum. OTP-3190. - ?line X = id((1 bsl 27) - 1), - ?line X = abs(X), - ?line X = abs(X-1)+1, - ?line X = abs(X+1)-1, - ?line X = abs(-X), - ?line X = abs(-X-1)-1, - ?line X = abs(-X+1)+1, + X = id((1 bsl 27) - 1), + X = abs(X), + X = abs(X-1)+1, + X = abs(X+1)-1, + X = abs(-X), + X = abs(-X-1)-1, + X = abs(-X+1)+1, %% Bignums. BigNum = id(13984792374983749), - ?line BigNum = abs(BigNum), - ?line BigNum = abs(-BigNum), + BigNum = abs(BigNum), + BigNum = abs(-BigNum), ok. t_float(Config) when is_list(Config) -> - ?line 0.0 = float(id(0)), - ?line 2.5 = float(id(2.5)), - ?line 0.0 = float(id(0.0)), - ?line -100.55 = float(id(-100.55)), - ?line 42.0 = float(id(42)), - ?line -100.0 = float(id(-100)), + 0.0 = float(id(0)), + 2.5 = float(id(2.5)), + 0.0 = float(id(0.0)), + -100.55 = float(id(-100.55)), + 42.0 = float(id(42)), + -100.0 = float(id(-100)), %% Bignums. - ?line 4294967305.0 = float(id(4294967305)), - ?line -4294967305.0 = float(id(-4294967305)), + 4294967305.0 = float(id(4294967305)), + -4294967305.0 = float(id(-4294967305)), %% Extremly big bignums. - ?line Big = id(list_to_integer(id(lists:duplicate(2000, $1)))), - ?line {'EXIT', {badarg, _}} = (catch float(Big)), - - %% Invalid types and lists. - ?line {'EXIT', {badarg, _}} = (catch list_to_integer(id(atom))), - ?line {'EXIT', {badarg, _}} = (catch list_to_integer(id(123))), - ?line {'EXIT', {badarg, _}} = (catch list_to_integer(id([$1,[$2]]))), - ?line {'EXIT', {badarg, _}} = (catch list_to_integer(id("1.2"))), - ?line {'EXIT', {badarg, _}} = (catch list_to_integer(id("a"))), - ?line {'EXIT', {badarg, _}} = (catch list_to_integer(id(""))), + Big = id(list_to_integer(id(lists:duplicate(2000, $1)))), + {'EXIT', {badarg, _}} = (catch float(Big)), + ok. -%% Tests float_to_list/1, float_to_list/2. - -t_float_to_list(Config) when is_list(Config) -> - test_ftl("0.0e+0", 0.0), - test_ftl("2.5e+1", 25.0), - test_ftl("2.5e+0", 2.5), - test_ftl("2.5e-1", 0.25), - test_ftl("-3.5e+17", -350.0e15), - "1.00000000000000000000e+00" = float_to_list(1.0), - "1.00000000000000000000e+00" = float_to_list(1.0, []), - "-1.00000000000000000000e+00" = float_to_list(-1.0, []), - "-1.00000000000000000000" = float_to_list(-1.0, [{decimals, 20}]), - {'EXIT', {badarg, _}} = (catch float_to_list(1.0, [{decimals, -1}])), - {'EXIT', {badarg, _}} = (catch float_to_list(1.0, [{decimals, 254}])), - {'EXIT', {badarg, _}} = (catch float_to_list(1.0, [{scientific, 250}])), - {'EXIT', {badarg, _}} = (catch float_to_list(1.0e+300, [{decimals, 1}])), - "1.0e+300" = float_to_list(1.0e+300, [{scientific, 1}]), - "1.0" = float_to_list(1.0, [{decimals, 249}, compact]), - "1" = float_to_list(1.0, [{decimals, 0}]), - "2" = float_to_list(1.9, [{decimals, 0}]), - "123456789012345680.0" = erlang:float_to_list( - 123456789012345678.0, [{decimals, 236}, compact]), - {'EXIT', {badarg, _}} = (catch float_to_list( - 123456789012345678.0, [{decimals, 237}])), - Expected = "1." ++ string:copies("0", 249) ++ "e+00", - Expected = float_to_list(1.0, [{scientific, 249}, compact]), +%% Tests float_to_list/1, float_to_list/2, float_to_binary/1, float_to_binary/2 + +t_float_to_string(Config) when is_list(Config) -> + test_fts("0.00000000000000000000e+00", 0.0), + test_fts("2.50000000000000000000e+01", 25.0), + test_fts("2.50000000000000000000e+00", 2.5), + test_fts("2.50000000000000000000e-01", 0.25), + test_fts("-3.50000000000000000000e+17", -350.0e15), + test_fts("1.00000000000000000000e+00",1.0), + test_fts("1.00000000000000000000e+00",1.0, []), + test_fts("-1.00000000000000000000e+00",-1.0, []), + test_fts("-1.00000000000000000000",-1.0, [{decimals, 20}]), + {'EXIT', {badarg, _}} = (catch float_to_list(1.0, [{decimals, -1}])), + {'EXIT', {badarg, _}} = (catch float_to_list(1.0, [{decimals, 254}])), + {'EXIT', {badarg, _}} = (catch float_to_list(1.0, [{scientific, 250}])), + {'EXIT', {badarg, _}} = (catch float_to_list(1.0e+300, [{decimals, 1}])), + {'EXIT', {badarg, _}} = (catch float_to_binary(1.0, [{decimals, -1}])), + {'EXIT', {badarg, _}} = (catch float_to_binary(1.0, [{decimals, 254}])), + {'EXIT', {badarg, _}} = (catch float_to_binary(1.0, [{scientific, 250}])), + {'EXIT', {badarg, _}} = (catch float_to_binary(1.0e+300, [{decimals, 1}])), + test_fts("1.0e+300",1.0e+300, [{scientific, 1}]), + test_fts("1.0",1.0, [{decimals, 249}, compact]), + test_fts("1",1.0,[{decimals,0}]), + test_fts("2",1.9,[{decimals,0}]), + test_fts("123456789012345680.0",123456789012345678.0, + [{decimals, 236}, compact]), + {'EXIT', {badarg, _}} = (catch float_to_list( + 123456789012345678.0, [{decimals, 237}])), + {'EXIT', {badarg, _}} = (catch float_to_binary( + 123456789012345678.0, [{decimals, 237}])), + test_fts("1." ++ string:copies("0", 249) ++ "e+00", + 1.0, [{scientific, 249}, compact]), X1 = float_to_list(1.0), X2 = float_to_list(1.0, [{scientific, 20}]), X1 = X2, - "1.000e+00" = float_to_list(1.0, [{scientific, 3}]), - "1.000" = float_to_list(1.0, [{decimals, 3}]), - "1.0" = float_to_list(1.0, [{decimals, 1}]), - "1.0" = float_to_list(1.0, [{decimals, 3}, compact]), - "1.12" = float_to_list(1.123, [{decimals, 2}]), - "1.123" = float_to_list(1.123, [{decimals, 3}]), - "1.123" = float_to_list(1.123, [{decimals, 3}, compact]), - "1.1230" = float_to_list(1.123, [{decimals, 4}]), - "1.12300" = float_to_list(1.123, [{decimals, 5}]), - "1.123" = float_to_list(1.123, [{decimals, 5}, compact]), - "1.1234" = float_to_list(1.1234,[{decimals, 6}, compact]), - "1.01" = float_to_list(1.005, [{decimals, 2}]), - "-1.01" = float_to_list(-1.005,[{decimals, 2}]), - "0.999" = float_to_list(0.999, [{decimals, 3}]), - "-0.999" = float_to_list(-0.999,[{decimals, 3}]), - "1.0" = float_to_list(0.999, [{decimals, 2}, compact]), - "-1.0" = float_to_list(-0.999,[{decimals, 2}, compact]), - "0.5" = float_to_list(0.5, [{decimals, 1}]), - "-0.5" = float_to_list(-0.5, [{decimals, 1}]), + + Y1 = float_to_binary(1.0), + Y2 = float_to_binary(1.0, [{scientific, 20}]), + Y1 = Y2, + + test_fts("1.000e+00",1.0, [{scientific, 3}]), + test_fts("1.000",1.0, [{decimals, 3}]), + test_fts("1.0",1.0, [{decimals, 1}]), + test_fts("1.0",1.0, [{decimals, 3}, compact]), + test_fts("1.12",1.123, [{decimals, 2}]), + test_fts("1.123",1.123, [{decimals, 3}]), + test_fts("1.123",1.123, [{decimals, 3}, compact]), + test_fts("1.1230",1.123, [{decimals, 4}]), + test_fts("1.12300",1.123, [{decimals, 5}]), + test_fts("1.123",1.123, [{decimals, 5}, compact]), + test_fts("1.1234",1.1234,[{decimals, 6}, compact]), + test_fts("1.01",1.005, [{decimals, 2}]), + test_fts("-1.01",-1.005,[{decimals, 2}]), + test_fts("0.999",0.999, [{decimals, 3}]), + test_fts("-0.999",-0.999,[{decimals, 3}]), + test_fts("1.0",0.999, [{decimals, 2}, compact]), + test_fts("-1.0",-0.999,[{decimals, 2}, compact]), + test_fts("0.5",0.5, [{decimals, 1}]), + test_fts("-0.5",-0.5, [{decimals, 1}]), "2.333333" = erlang:float_to_list(7/3, [{decimals, 6}, compact]), "2.333333" = erlang:float_to_list(7/3, [{decimals, 6}]), - "0.00000000000000000000e+00" = float_to_list(0.0, [compact]), - "0.0" = float_to_list(0.0, [{decimals, 10}, compact]), - "123000000000000000000.0" = float_to_list(1.23e20, [{decimals, 10}, compact]), - "1.2300000000e+20" = float_to_list(1.23e20, [{scientific, 10}, compact]), - "1.23000000000000000000e+20" = float_to_list(1.23e20, []), + <<"2.333333">> = erlang:float_to_binary(7/3, [{decimals, 6}, compact]), + <<"2.333333">> = erlang:float_to_binary(7/3, [{decimals, 6}]), + test_fts("0.00000000000000000000e+00",0.0, [compact]), + test_fts("0.0",0.0, [{decimals, 10}, compact]), + test_fts("123000000000000000000.0",1.23e20, [{decimals, 10}, compact]), + test_fts("1.2300000000e+20",1.23e20, [{scientific, 10}, compact]), + test_fts("1.23000000000000000000e+20",1.23e20, []), ok. -test_ftl(Expect, Float) -> - %% No ?line on the next line -- we want the line number from t_float_to_list. - Expect = remove_zeros(lists:reverse(float_to_list(Float)), []). - -%% Removes any non-significant zeros in a floating point number. -%% Example: 2.500000e+01 -> 2.5e+1 - -remove_zeros([$+, $e|Rest], [$0, X|Result]) -> - remove_zeros([$+, $e|Rest], [X|Result]); -remove_zeros([$-, $e|Rest], [$0, X|Result]) -> - remove_zeros([$-, $e|Rest], [X|Result]); -remove_zeros([$0, $.|Rest], [$e|Result]) -> - remove_zeros(Rest, [$., $0, $e|Result]); -remove_zeros([$0|Rest], [$e|Result]) -> - remove_zeros(Rest, [$e|Result]); -remove_zeros([Char|Rest], Result) -> - remove_zeros(Rest, [Char|Result]); -remove_zeros([], Result) -> - Result. - -%% Tests integer_to_list/1. - -t_integer_to_list(Config) when is_list(Config) -> - ?line "0" = integer_to_list(id(0)), - ?line "42" = integer_to_list(id(42)), - ?line "-42" = integer_to_list(id(-42)), - ?line "32768" = integer_to_list(id(32768)), - ?line "268435455" = integer_to_list(id(268435455)), - ?line "-268435455" = integer_to_list(id(-268435455)), - ?line "123456932798748738738" = integer_to_list(id(123456932798748738738)), - ?line Big_List = id(lists:duplicate(2000, id($1))), - ?line Big = list_to_integer(Big_List), - ?line Big_List = integer_to_list(Big), - ok. +test_fts(Expect, Float) -> + Expect = float_to_list(Float), + BinExpect = list_to_binary(Expect), + BinExpect = float_to_binary(Float). -%% Tests list_to_float/1. +test_fts(Expect, Float, Args) -> + Expect = float_to_list(Float,Args), + BinExpect = list_to_binary(Expect), + BinExpect = float_to_binary(Float,Args). -t_list_to_float_safe(Config) when is_list(Config) -> - ?line 0.0 = list_to_float(id("0.0")), - ?line 0.0 = list_to_float(id("-0.0")), - ?line 0.5 = list_to_float(id("0.5")), - ?line -0.5 = list_to_float(id("-0.5")), - ?line 100.0 = list_to_float(id("1.0e2")), - ?line 127.5 = list_to_float(id("127.5")), - ?line -199.5 = list_to_float(id("-199.5")), +%% Tests list_to_float/1. - ?line {'EXIT',{badarg,_}} = (catch list_to_float(id("0"))), - ?line {'EXIT',{badarg,_}} = (catch list_to_float(id("0..0"))), - ?line {'EXIT',{badarg,_}} = (catch list_to_float(id("0e12"))), - ?line {'EXIT',{badarg,_}} = (catch list_to_float(id("--0.0"))), +t_string_to_float_safe(Config) when is_list(Config) -> + test_stf(0.0,"0.0"), + test_stf(0.0,"-0.0"), + test_stf(0.5,"0.5"), + test_stf(-0.5,"-0.5"), + test_stf(100.0,"1.0e2"), + test_stf(127.5,"127.5"), + test_stf(-199.5,"-199.5"), + + {'EXIT',{badarg,_}} = (catch list_to_float(id("0"))), + {'EXIT',{badarg,_}} = (catch list_to_float(id("0..0"))), + {'EXIT',{badarg,_}} = (catch list_to_float(id("0e12"))), + {'EXIT',{badarg,_}} = (catch list_to_float(id("--0.0"))), + {'EXIT',{badarg,_}} = (catch binary_to_float(id(<<"0">>))), + {'EXIT',{badarg,_}} = (catch binary_to_float(id(<<"0..0">>))), + {'EXIT',{badarg,_}} = (catch binary_to_float(id(<<"0e12">>))), + {'EXIT',{badarg,_}} = (catch binary_to_float(id(<<"--0.0">>))), + + UBin = <<0:3,(id(<<"0.0">>))/binary,0:5>>, + <<_:3,UnAlignedBin:3/binary,0:5>> = id(UBin), + 0.0 = binary_to_float(UnAlignedBin), + + ABin = <<0:8,(id(<<"1.0">>))/binary,0:8>>, + <<_:8,AlignedBin:3/binary,0:8>> = id(ABin), + 1.0 = binary_to_float(AlignedBin), ok. %% This might crash the emulator... %% (Known to crash the Unix version of Erlang 4.4.1) -t_list_to_float_risky(Config) when is_list(Config) -> - ?line Many_Ones = lists:duplicate(25000, id($1)), - ?line id(list_to_float("2."++Many_Ones)), - ?line {'EXIT', {badarg, _}} = (catch list_to_float("2"++Many_Ones)), - ok. - -%% Tests list_to_integer/1. +t_string_to_float_risky(Config) when is_list(Config) -> + Many_Ones = lists:duplicate(25000, id($1)), + id(list_to_float("2."++Many_Ones)), + {'EXIT', {badarg, _}} = (catch list_to_float("2"++Many_Ones)), -t_list_to_integer(Config) when is_list(Config) -> - ?line 0 = list_to_integer(id("0")), - ?line 0 = list_to_integer(id("00")), - ?line 0 = list_to_integer(id("-0")), - ?line 1 = list_to_integer(id("1")), - ?line -1 = list_to_integer(id("-1")), - ?line 42 = list_to_integer(id("42")), - ?line -12 = list_to_integer(id("-12")), - ?line 32768 = list_to_integer(id("32768")), - ?line 268435455 = list_to_integer(id("268435455")), - ?line -268435455 = list_to_integer(id("-268435455")), - - %% Bignums. - ?line 123456932798748738738 = list_to_integer(id("123456932798748738738")), - ?line id(list_to_integer(lists:duplicate(2000, id($1)))), + id(binary_to_float(list_to_binary("2."++Many_Ones))), + {'EXIT', {badarg, _}} = (catch binary_to_float( + list_to_binary("2"++Many_Ones))), ok. +test_stf(Expect,List) -> + Expect = list_to_float(List), + Bin = list_to_binary(List), + Expect = binary_to_float(Bin). + %% Tests round/1. t_round(Config) when is_list(Config) -> - ?line 0 = round(id(0.0)), - ?line 0 = round(id(0.4)), - ?line 1 = round(id(0.5)), - ?line 0 = round(id(-0.4)), - ?line -1 = round(id(-0.5)), - ?line 255 = round(id(255.3)), - ?line 256 = round(id(255.6)), - ?line -1033 = round(id(-1033.3)), - ?line -1034 = round(id(-1033.6)), + 0 = round(id(0.0)), + 0 = round(id(0.4)), + 1 = round(id(0.5)), + 0 = round(id(-0.4)), + -1 = round(id(-0.5)), + 255 = round(id(255.3)), + 256 = round(id(255.6)), + -1033 = round(id(-1033.3)), + -1034 = round(id(-1033.6)), % OTP-3722: - ?line X = id((1 bsl 27) - 1), - ?line MX = -X, - ?line MXm1 = -X-1, - ?line MXp1 = -X+1, - ?line F = id(X + 0.0), - ?line X = round(F), - ?line X = round(F+1)-1, - ?line X = round(F-1)+1, - ?line MX = round(-F), - ?line MXm1 = round(-F-1), - ?line MXp1 = round(-F+1), - - ?line X = round(F+0.1), - ?line X = round(F+1+0.1)-1, - ?line X = round(F-1+0.1)+1, - ?line MX = round(-F+0.1), - ?line MXm1 = round(-F-1+0.1), - ?line MXp1 = round(-F+1+0.1), - - ?line X = round(F-0.1), - ?line X = round(F+1-0.1)-1, - ?line X = round(F-1-0.1)+1, - ?line MX = round(-F-0.1), - ?line MXm1 = round(-F-1-0.1), - ?line MXp1 = round(-F+1-0.1), - - ?line 0.5 = abs(round(F+0.5)-(F+0.5)), - ?line 0.5 = abs(round(F-0.5)-(F-0.5)), - ?line 0.5 = abs(round(-F-0.5)-(-F-0.5)), - ?line 0.5 = abs(round(-F+0.5)-(-F+0.5)), + X = id((1 bsl 27) - 1), + MX = -X, + MXm1 = -X-1, + MXp1 = -X+1, + F = id(X + 0.0), + X = round(F), + X = round(F+1)-1, + X = round(F-1)+1, + MX = round(-F), + MXm1 = round(-F-1), + MXp1 = round(-F+1), + + X = round(F+0.1), + X = round(F+1+0.1)-1, + X = round(F-1+0.1)+1, + MX = round(-F+0.1), + MXm1 = round(-F-1+0.1), + MXp1 = round(-F+1+0.1), + + X = round(F-0.1), + X = round(F+1-0.1)-1, + X = round(F-1-0.1)+1, + MX = round(-F-0.1), + MXm1 = round(-F-1-0.1), + MXp1 = round(-F+1-0.1), + + 0.5 = abs(round(F+0.5)-(F+0.5)), + 0.5 = abs(round(F-0.5)-(F-0.5)), + 0.5 = abs(round(-F-0.5)-(-F-0.5)), + 0.5 = abs(round(-F+0.5)-(-F+0.5)), %% Bignums. - ?line 4294967296 = round(id(4294967296.1)), - ?line 4294967297 = round(id(4294967296.9)), - ?line -4294967296 = -round(id(4294967296.1)), - ?line -4294967297 = -round(id(4294967296.9)), + 4294967296 = round(id(4294967296.1)), + 4294967297 = round(id(4294967296.9)), + -4294967296 = -round(id(4294967296.1)), + -4294967297 = -round(id(4294967296.9)), ok. t_trunc(Config) when is_list(Config) -> - ?line 0 = trunc(id(0.0)), - ?line 5 = trunc(id(5.3333)), - ?line -10 = trunc(id(-10.978987)), + 0 = trunc(id(0.0)), + 5 = trunc(id(5.3333)), + -10 = trunc(id(-10.978987)), % The largest smallnum, converted to float (OTP-3722): - ?line X = id((1 bsl 27) - 1), - ?line F = id(X + 0.0), + X = id((1 bsl 27) - 1), + F = id(X + 0.0), io:format("X = ~p/~w/~w, F = ~p/~w/~w, trunc(F) = ~p/~w/~w~n", [X, X, binary_to_list(term_to_binary(X)), F, F, binary_to_list(term_to_binary(F)), trunc(F), trunc(F), binary_to_list(term_to_binary(trunc(F)))]), - ?line X = trunc(F), - ?line X = trunc(F+1)-1, - ?line X = trunc(F-1)+1, - ?line X = -trunc(-F), - ?line X = -trunc(-F-1)-1, - ?line X = -trunc(-F+1)+1, + X = trunc(F), + X = trunc(F+1)-1, + X = trunc(F-1)+1, + X = -trunc(-F), + X = -trunc(-F-1)-1, + X = -trunc(-F+1)+1, %% Bignums. - ?line 4294967305 = trunc(id(4294967305.7)), - ?line -4294967305 = trunc(id(-4294967305.7)), + 4294967305 = trunc(id(4294967305.7)), + -4294967305 = trunc(id(-4294967305.7)), ok. + +%% Tests integer_to_binary/1. + +t_integer_to_string(Config) when is_list(Config) -> + test_its("0",0), + test_its("42",42), + test_its("-42",-42), + test_its("32768",32768), + test_its("268435455",268435455), + test_its("-268435455",-268435455), + test_its("123456932798748738738",123456932798748738738), + + %% 1 bsl 33, just beyond 32 bit + test_its("8589934592",8589934592), + test_its("-8589934592",-8589934592), + %% 1 bsl 65, just beyond 64 bit + test_its("36893488147419103232",36893488147419103232), + test_its("-36893488147419103232",-36893488147419103232), + + %% Bignums. + BigBin = id(list_to_binary(lists:duplicate(2000, id($1)))), + Big = erlang:binary_to_integer(BigBin), + BigBin = erlang:integer_to_binary(Big), + + %% Invalid types + lists:foreach(fun(Value) -> + {'EXIT', {badarg, _}} = + (catch erlang:integer_to_binary(Value)), + {'EXIT', {badarg, _}} = + (catch erlang:integer_to_list(Value)) + end,[atom,1.2,0.0,[$1,[$2]]]), + + ok. + +test_its(List,Int) -> + Int = list_to_integer(List), + Int = binary_to_integer(list_to_binary(List)). + +%% Tests binary_to_integer/1. + +t_string_to_integer(Config) when is_list(Config) -> + 0 = erlang:binary_to_integer(id(<<"00">>)), + 0 = erlang:binary_to_integer(id(<<"-0">>)), + 0 = erlang:binary_to_integer(id(<<"+0">>)), + + test_sti(0), + test_sti(1), + test_sti(-1), + test_sti(42), + test_sti(-12), + test_sti(32768), + test_sti(268435455), + test_sti(-268435455), + + %% 1 bsl 28 - 1, just before 32 bit bignum + test_sti(1 bsl 28 - 1), + %% 1 bsl 28, just beyond 32 bit small + test_sti(1 bsl 28), + %% 1 bsl 33, just beyond 32 bit + test_sti(1 bsl 33), + %% 1 bsl 60 - 1, just before 64 bit bignum + test_sti(1 bsl 60 - 1), + %% 1 bsl 60, just beyond 64 bit small + test_sti(1 bsl 60), + %% 1 bsl 65, just beyond 64 bit + test_sti(1 bsl 65), + %% Bignums. + test_sti(123456932798748738738,16), + test_sti(list_to_integer(lists:duplicate(2000, $1))), + + %% unalign string + Str = <<"10">>, + UnalignStr = <<0:3, (id(Str))/binary, 0:5>>, + <<_:3, SomeStr:2/binary, _:5>> = id(UnalignStr), + 10 = erlang:binary_to_integer(SomeStr), + + %% Invalid types + lists:foreach(fun(Value) -> + {'EXIT', {badarg, _}} = + (catch binary_to_integer(Value)), + {'EXIT', {badarg, _}} = + (catch erlang:list_to_integer(Value)) + end,[atom,1.2,0.0,[$1,[$2]]]), + + % Default base error cases + lists:foreach(fun(Value) -> + {'EXIT', {badarg, _}} = + (catch erlang:binary_to_integer( + list_to_binary(Value))), + {'EXIT', {badarg, _}} = + (catch erlang:list_to_integer(Value)) + end,["1.0"," 1"," -1",""]), + + % Custom base error cases + lists:foreach(fun({Value,Base}) -> + {'EXIT', {badarg, _}} = + (catch binary_to_integer( + list_to_binary(Value),Base)), + {'EXIT', {badarg, _}} = + (catch erlang:list_to_integer(Value,Base)) + end,[{" 1",1},{" 1",37},{"2",2},{"C",11}, + {"1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111z",16}, + {"1z111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111",16}, + {"111z11111111",16}]), + + ok. + +test_sti(Num) -> + [begin + io:format("Testing ~p:~p",[Num,Base]), + test_sti(Num,Base) + end|| Base <- lists:seq(2,36)]. + +test_sti(Num,Base) -> + Num = list_to_integer(int2list(Num,Base),Base), + Num = -1*list_to_integer(int2list(Num*-1,Base),Base), + Num = binary_to_integer(int2bin(Num,Base),Base), + Num = -1*binary_to_integer(int2bin(Num*-1,Base),Base). + % Calling this function (which is not supposed to be inlined) prevents % the compiler from calculating the answer, so we don't test the compiler % instead of the newest runtime system. id(X) -> X. + +%% Uses the printing library to to integer_to_binary conversions. +int2bin(Int,Base) when Base < 37 -> + iolist_to_binary(int2list(Int,Base)). + +int2list(Int,Base) when Base < 37 -> + lists:flatten(io_lib:format("~."++integer_to_list(Base)++"B",[Int])). diff --git a/erts/emulator/utils/gen_git_version b/erts/emulator/utils/gen_git_version index d93a97cbbb..ef06a4b8e2 100755 --- a/erts/emulator/utils/gen_git_version +++ b/erts/emulator/utils/gen_git_version @@ -24,8 +24,7 @@ then else VC=unset fi -echo "VSN = $VSN" -echo "VC = $VC" + if test "$VSN" != "$VC" then echo "# Automatically generated by $0 - DO NOT EDIT." > $OUTPUT_FILE diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c index 577554c43d..9d674a7c65 100644 --- a/erts/etc/common/erlexec.c +++ b/erts/etc/common/erlexec.c @@ -912,6 +912,16 @@ int main(int argc, char **argv) i++; } break; + case 'p': + if (argv[i][2] != 'c' || argv[i][3] != '\0') + goto the_default; + if (i+1 >= argc) + usage(argv[i]); + argv[i][0] = '-'; + add_Eargs(argv[i]); + add_Eargs(argv[i+1]); + i++; + break; case 'z': if (!is_one_of_strings(&argv[i][2], plusz_val_switches)) { goto the_default; diff --git a/erts/include/internal/ethread.h b/erts/include/internal/ethread.h index aef31e282a..6c006b3f07 100644 --- a/erts/include/internal/ethread.h +++ b/erts/include/internal/ethread.h @@ -59,10 +59,6 @@ # undef ETHR_TRY_INLINE_FUNCS #endif -#if !defined(ETHR_DISABLE_NATIVE_IMPLS) && (defined(PURIFY)||defined(VALGRIND)) -# define ETHR_DISABLE_NATIVE_IMPLS -#endif - /* Assume 64-byte cache line size */ #define ETHR_CACHE_LINE_SIZE 64 #define ETHR_CACHE_LINE_MASK (ETHR_CACHE_LINE_SIZE - 1) @@ -413,7 +409,11 @@ extern ethr_runtime_t ethr_runtime__; # endif #endif -#include "ethr_optimized_fallbacks.h" +#ifdef VALGRIND /* mutex as fallback for spinlock for VALGRIND */ +# undef ETHR_HAVE_NATIVE_SPINLOCKS +#else +# include "ethr_optimized_fallbacks.h" +#endif typedef struct { void *(*thread_create_prepare_func)(void); diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex 5b288ecc5c..50e87b3550 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam Binary files differindex f7b3aac376..360887de9d 100644 --- a/erts/preloaded/ebin/prim_file.beam +++ b/erts/preloaded/ebin/prim_file.beam diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 115e1b03c4..8e4a471a82 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -36,7 +36,8 @@ -export([set_cookie/2, get_cookie/0]). -export([nodes/0]). --export([list_to_integer/2,integer_to_list/2]). +-export([integer_to_list/2]). +-export([integer_to_binary/2]). -export([flush_monitor_message/2]). -export([set_cpu_topology/1, format_cpu_topology/1]). -export([await_proc_exit/3]). @@ -73,7 +74,9 @@ -export([adler32/1, adler32/2, adler32_combine/3, append_element/2]). -export([atom_to_binary/2, atom_to_list/1, binary_part/2, binary_part/3]). --export([binary_to_atom/2, binary_to_existing_atom/2, binary_to_list/1]). +-export([binary_to_atom/2, binary_to_existing_atom/2, binary_to_float/1]). +-export([binary_to_integer/1,binary_to_integer/2]). +-export([binary_to_list/1]). -export([binary_to_list/3, binary_to_term/1, binary_to_term/2]). -export([bit_size/1, bitsize/1, bitstr_to_list/1, bitstring_to_list/1]). -export([bump_reductions/1, byte_size/1, call_on_load_function/1]). @@ -84,18 +87,21 @@ -export([display_nl/0, display_string/1, dist_exit/3, erase/0, erase/1]). -export([error/1, error/2, exit/1, exit/2, external_size/1]). -export([external_size/2, finish_after_on_load/2, finish_loading/1, float/1]). --export([float_to_list/1, float_to_list/2]). +-export([float_to_binary/1, float_to_binary/2, + float_to_list/1, float_to_list/2]). -export([fun_info/2, fun_to_list/1, function_exported/3]). -export([garbage_collect/0, garbage_collect/1]). -export([garbage_collect_message_area/0, get/0, get/1, get_keys/1]). -export([get_module_info/1, get_stacktrace/0, group_leader/0]). -export([group_leader/2, halt/0, halt/1, halt/2, hash/2, hibernate/3]). -export([insert_element/3]). --export([integer_to_list/1, iolist_size/1, iolist_to_binary/1]). +-export([integer_to_binary/1, integer_to_list/1]). +-export([iolist_size/1, iolist_to_binary/1]). -export([is_alive/0, is_builtin/3, is_process_alive/1, length/1, link/1]). -export([list_to_atom/1, list_to_binary/1, list_to_bitstr/1]). -export([list_to_bitstring/1, list_to_existing_atom/1, list_to_float/1]). --export([list_to_integer/1, list_to_pid/1, list_to_tuple/1, loaded/0]). +-export([list_to_integer/1, list_to_integer/2]). +-export([list_to_pid/1, list_to_tuple/1, loaded/0]). -export([localtime/0, make_ref/0, match_spec_test/3, md5/1, md5_final/1]). -export([md5_init/0, md5_update/2, module_loaded/1, monitor/2]). -export([monitor_node/2, monitor_node/3, nif_error/1, nif_error/2 @@ -317,6 +323,25 @@ binary_to_atom(_Binary, _Encoding) -> binary_to_existing_atom(_Binary, _Encoding) -> erlang:nif_error(undefined). +%% binary_to_float/1 +-spec binary_to_float(Binary) -> float() when + Binary :: binary(). +binary_to_float(_Binary) -> + erlang:nif_error(undefined). + +%% binary_to_integer/1 +-spec binary_to_integer(Binary) -> integer() when + Binary :: binary(). +binary_to_integer(_Binary) -> + erlang:nif_error(undefined). + +%% binary_to_integer/2 +-spec binary_to_integer(Binary,Base) -> integer() when + Binary :: binary(), + Base :: 2..36. +binary_to_integer(_Binary,_Base) -> + erlang:nif_error(undefined). + %% binary_to_list/1 -spec binary_to_list(Binary) -> [byte()] when Binary :: binary(). @@ -706,6 +731,22 @@ finish_after_on_load(_P1, _P2) -> float(_Number) -> erlang:nif_error(undefined). +%% float_to_binary/1 +-spec float_to_binary(Float) -> binary() when + Float :: float(). +float_to_binary(_Float) -> + erlang:nif_error(undefined). + +%% float_to_binary/2 +-spec float_to_binary(Float, Options) -> binary() when + Float :: float(), + Options :: [Option], + Option :: {decimals, Decimals :: 0..253} | + {scientific, Decimals :: 0..249} | + compact. +float_to_binary(_Float, _Options) -> + erlang:nif_error(undefined). + %% float_to_list/1 -spec float_to_list(Float) -> string() when Float :: float(). @@ -716,8 +757,8 @@ float_to_list(_Float) -> -spec float_to_list(Float, Options) -> string() when Float :: float(), Options :: [Option], - Option :: {decimals, non_neg_integer()} | - {scientific, non_neg_integer()} | + Option :: {decimals, Decimals :: 0..253} | + {scientific, Decimals :: 0..249} | compact. float_to_list(_Float, _Options) -> erlang:nif_error(undefined). @@ -850,6 +891,12 @@ hibernate(_Module, _Function, _Args) -> insert_element(_Index, _Tuple1, _Term) -> erlang:nif_error(undefined). +%% integer_to_binary/1 +-spec integer_to_binary(Integer) -> binary() when + Integer :: integer(). +integer_to_binary(_Integer) -> + erlang:nif_error(undefined). + %% integer_to_list/1 -spec integer_to_list(Integer) -> string() when Integer :: integer(). @@ -942,6 +989,13 @@ list_to_float(_String) -> list_to_integer(_String) -> erlang:nif_error(undefined). +%% list_to_integer/2 +-spec list_to_integer(String, Base) -> integer() when + String :: string(), + Base :: 2..36. +list_to_integer(_String,_Base) -> + erlang:nif_error(undefined). + %% list_to_pid/1 -spec list_to_pid(String) -> pid() when String :: string(). @@ -2838,51 +2892,32 @@ integer_to_list(I0, Base, R0) -> integer_to_list(I1, Base, R1) end. - --spec list_to_integer(String, Base) -> integer() when - String :: string(), +-spec integer_to_binary(Integer, Base) -> binary() when + Integer :: integer(), Base :: 2..36. -list_to_integer(L, 10) -> - erlang:list_to_integer(L); -list_to_integer(L, Base) - when erlang:is_list(L), erlang:is_integer(Base), +integer_to_binary(I, 10) -> + erlang:integer_to_binary(I); +integer_to_binary(I, Base) + when erlang:is_integer(I), erlang:is_integer(Base), Base >= 2, Base =< 1+$Z-$A+10 -> - case list_to_integer_sign(L, Base) of - I when erlang:is_integer(I) -> - I; - Fault -> - erlang:error(Fault, [L,Base]) - end; -list_to_integer(L, Base) -> - erlang:error(badarg, [L,Base]). - -list_to_integer_sign([$-|[_|_]=L], Base) -> - case list_to_integer(L, Base, 0) of - I when erlang:is_integer(I) -> - -I; - I -> - I + if I < 0 -> + <<"$-",(integer_to_binary(-I, Base, []))/binary>>; + true -> + integer_to_binary(I, Base, <<>>) end; -list_to_integer_sign([$+|[_|_]=L], Base) -> - list_to_integer(L, Base, 0); -list_to_integer_sign([_|_]=L, Base) -> - list_to_integer(L, Base, 0); -list_to_integer_sign(_, _) -> - badarg. - -list_to_integer([D|L], Base, I) - when erlang:is_integer(D), D >= $0, D =< $9, D < Base+$0 -> - list_to_integer(L, Base, I*Base + D-$0); -list_to_integer([D|L], Base, I) - when erlang:is_integer(D), D >= $A, D < Base+$A-10 -> - list_to_integer(L, Base, I*Base + D-$A+10); -list_to_integer([D|L], Base, I) - when erlang:is_integer(D), D >= $a, D < Base+$a-10 -> - list_to_integer(L, Base, I*Base + D-$a+10); -list_to_integer([], _, I) -> - I; -list_to_integer(_, _, _) -> - badarg. +integer_to_binary(I, Base) -> + erlang:error(badarg, [I, Base]). + +integer_to_binary(0, _Base, R0) -> + R0; +integer_to_binary(I0, Base, R0) -> + D = I0 rem Base, + I1 = I0 div Base, + if D >= 10 -> + integer_to_binary(I1,Base,<<(D-10+$A),R0/binary>>); + true -> + integer_to_binary(I1,Base,<<(D+$0),R0/binary>>) + end. %% erlang:flush_monitor_message/2 is for internal use only! %% diff --git a/erts/preloaded/src/prim_file.erl b/erts/preloaded/src/prim_file.erl index bf8879c2a0..489e8ca4ea 100644 --- a/erts/preloaded/src/prim_file.erl +++ b/erts/preloaded/src/prim_file.erl @@ -933,7 +933,12 @@ list_dir_int(Port, Dir) -> fun(P) -> case list_dir_response(P, []) of {ok, RawNames} -> - {ok, list_dir_convert(RawNames)}; + try + {ok, list_dir_convert(RawNames)} + catch + throw:Reason -> + Reason + end; Error -> Error end @@ -979,7 +984,7 @@ list_dir_convert([Name|Names]) -> {error, ignore} -> list_dir_convert(Names); {error, error} -> - {error, {no_translation, Name}}; + throw({error, {no_translation, Name}}); Converted when is_list(Converted) -> [Converted|list_dir_convert(Names)] end; @@ -990,9 +995,9 @@ list_dir_convert_all([Name|Names]) -> %% a binary. case prim_file:internal_native2name(Name) of {error, _} -> - [Name|list_dir_convert(Names)]; + [Name|list_dir_convert_all(Names)]; Converted when is_list(Converted) -> - [Converted|list_dir_convert(Names)] + [Converted|list_dir_convert_all(Names)] end; list_dir_convert_all([]) -> []. diff --git a/erts/test/otp_SUITE.erl b/erts/test/otp_SUITE.erl index 51f07b5432..374255bbe6 100644 --- a/erts/test/otp_SUITE.erl +++ b/erts/test/otp_SUITE.erl @@ -273,7 +273,7 @@ call_to_size_1(Config) when is_list(Config) -> Server = ?config(xref_server, Config), %% Applications that do not call erlang:size/1: - Apps = [compiler,debugger,kernel,observer,parsetools, + Apps = [asn1,compiler,debugger,kernel,observer,parsetools, runtime_tools,stdlib,tools,webtool], Fs = [{erlang,size,1}], diff --git a/lib/Makefile b/lib/Makefile index 64b17a3cca..6a12334d8d 100644 --- a/lib/Makefile +++ b/lib/Makefile @@ -20,18 +20,17 @@ include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk ERTS_SUB_DIRECTORIES = stdlib sasl kernel compiler -OTHER_SUB_DIRECTORIES = tools test_server common_test runtime_tools +OTHER_SUB_DIRECTORIES = tools test_server common_test runtime_tools \ + inets xmerl edoc erl_docgen ifdef BUILD_ALL OTHER_SUB_DIRECTORIES += \ snmp otp_mibs appmon erl_interface asn1 jinterface \ - wx debugger reltool gs inets \ + wx debugger reltool gs \ ic mnesia crypto orber os_mon parsetools syntax_tools \ - pman public_key ssl toolbar tv observer odbc \ - diameter \ + pman public_key ssl toolbar tv observer odbc diameter \ cosTransactions cosEvent cosTime cosNotification \ cosProperty cosFileTransfer cosEventDomain et megaco webtool \ - xmerl edoc eunit ssh typer erl_docgen \ - percept eldap dialyzer hipe + eunit ssh typer percept eldap dialyzer hipe EXTRA_FILE := $(wildcard EXTRA-APPLICATIONS) EXTRA_APPLICATIONS := $(if $(EXTRA_FILE),$(shell cat $(EXTRA_FILE))) endif diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index dd77085c39..452862fcee 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -1263,13 +1263,13 @@ check_object_list(S,ClassRef,[ObjOrSet|Objs],Acc) -> check_object_list(S,ClassRef,Objs,[{{no_mod,no_name},Def}|Acc]); {'ObjectSetFromObjects',Os,FieldName} when is_tuple(Os) -> NewSet = - check_ObjectSetFromObjects(S,element(size(Os),Os), + check_ObjectSetFromObjects(S, element(tuple_size(Os), Os), FieldName,[]), check_object_list(S,ClassRef,Objs,NewSet++Acc); {{'ObjectSetFromObjects',Os,FieldName},InterSection} when is_tuple(Os) -> NewSet = - check_ObjectSetFromObjects(S, element(size(Os),Os), + check_ObjectSetFromObjects(S, element(tuple_size(Os), Os), FieldName,InterSection), check_object_list(S,ClassRef,Objs,NewSet++Acc); Other -> @@ -1570,7 +1570,7 @@ gen_incl_set(S,Fields,#typedef{typespec=#type{def=Eref}}) gen_incl_set(S,Fields,CDef); gen_incl_set(S,Fields,ClassDef) -> case catch get_unique_fieldname(S,ClassDef) of - Tuple when is_tuple(Tuple), size(Tuple) =:= 3 -> + Tuple when tuple_size(Tuple) =:= 3 -> false; _ -> gen_incl_set1(S,Fields, @@ -1589,7 +1589,7 @@ gen_incl_set1(_,['EXTENSIONMARK'],_) -> gen_incl_set1(_,['EXTENSIONMARK'|_],_) -> true; gen_incl_set1(S,[Object|Rest],CFields)-> - Fields = element(size(Object),Object), + Fields = element(tuple_size(Object), Object), case gen_incl1(S,Fields,CFields) of true -> true; @@ -3028,7 +3028,7 @@ is_record_normalized(S,Name,V = #'Externalvaluereference'{},NumComps) -> _ -> false end; is_record_normalized(_S,Name,Value,NumComps) when is_tuple(Value) -> - (size(Value) =:= (NumComps + 1)) andalso (element(1,Value)=:=Name); + (tuple_size(Value) =:= (NumComps + 1)) andalso (element(1, Value) =:= Name); is_record_normalized(_,_,_,_) -> false. @@ -3720,7 +3720,7 @@ maybe_open_type(S,ClassSpec=#objectclass{fields=Fs}, {typefieldreference,_} -> case {catch get_unique_fieldname(S,#classdef{typespec=ClassSpec}), asn1ct_gen:get_constraint(Constr,componentrelation)}of - {Tuple,_} when is_tuple(Tuple), size(Tuple) =:= 3 -> + {Tuple,_} when tuple_size(Tuple) =:= 3 -> OCFT#'ObjectClassFieldType'{fieldname=FieldNames, type='ASN1_OPEN_TYPE'}; {_,no} -> @@ -4167,7 +4167,7 @@ check_constraint(S,Ext) when is_record(Ext,'Externaltypereference') -> check_constraint(S,{'SizeConstraint',{Lb,Ub}}) - when is_list(Lb);is_tuple(Lb),size(Lb)==2 -> + when is_list(Lb); tuple_size(Lb) =:= 2 -> NewLb = range_check(resolv_tuple_or_list(S,Lb)), NewUb = range_check(resolv_tuple_or_list(S,Ub)), {'SizeConstraint',{NewLb,NewUb}}; @@ -5217,7 +5217,7 @@ imported1(_Name,[]) -> check_integer(_S,[],_C) -> []; check_integer(S,NamedNumberList,_C) -> - case [X||X<-NamedNumberList,is_tuple(X),size(X)=:=2] of + case [X || X <- NamedNumberList, tuple_size(X) =:= 2] of NamedNumberList -> %% An already checked integer with NamedNumberList NamedNumberList; diff --git a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl index e82212f0d8..341a04761b 100644 --- a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl @@ -528,14 +528,7 @@ gen_decode_sof(Erules,TypeName,_InnerTypeName,D) when is_record(D,type) -> Atom when is_atom(Atom) -> Atom; _ -> TypeNameSuffix end, -%% fix me - ObjFun = - case D#type.tablecinf of - [{objfun,_}|_R] -> - ", ObjFun"; - _ -> - [] - end, + ObjFun = false, gen_dec_line(Erules,TypeName,ContName,[],Cont,mandatory,ObjFun), %% gen_dec_line_sof(Erules,Typename,ContName,Cont,ObjFun), emit([" || ",{curr,v}," <- ",{curr,tlv},"].",nl,nl,nl]). diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index ebc52df1d9..76c4182160 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -657,9 +657,13 @@ gen_check_sof(Name,SOF,Type) -> end, emit({" ",{asis,NewName},"(DVs,Vs).",nl,nl}). +gen_check_sequence(Name, []) -> + emit([{asis,ensure_atom(Name)},"(_,_) ->",nl, + " throw(badval).",nl,nl]); gen_check_sequence(Name,Components) -> emit([{asis,ensure_atom(Name)},"(DefaultValue,Value) ->",nl]), gen_check_sequence(Name,Components,1). + gen_check_sequence(Name,[#'ComponentType'{name=N,typespec=Type}|Cs],Num) -> InnerType = get_inner(Type#type.def), NthDefV = ["element(",Num+1,",DefaultValue)"], @@ -671,9 +675,7 @@ gen_check_sequence(Name,[#'ComponentType'{name=N,typespec=Type}|Cs],Num) -> _ -> emit({",",nl}), gen_check_sequence(Name,Cs,Num+1) - end; -gen_check_sequence(_,[],_) -> - ok. + end. gen_check_choice(Name,CList=[#'ComponentType'{}|_Cs]) -> emit([{asis,ensure_atom(Name)},"({Id,DefaultValue},{Id,Value}) ->",nl]), diff --git a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl index f3a2486565..de0adef2b2 100644 --- a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl @@ -1162,7 +1162,7 @@ gen_objset_enc(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, emit({"'getenc_",ObjSetName,"'(_, _) ->",nl}), emit({indent(3),"fun(_, Val, _RestPrimFieldName) ->",nl}), emit({indent(6),"Len = case Val of",nl,indent(9), - "Bin when is_binary(Bin) -> size(Bin);",nl,indent(9), + "Bin when is_binary(Bin) -> byte_size(Bin);",nl,indent(9), "_ -> length(Val)",nl,indent(6),"end,"}), emit({indent(6),"{Val,Len}",nl}), emit({indent(3),"end.",nl,nl}), @@ -1270,7 +1270,7 @@ gen_inlined_enc_funs1(Fields,[{typefield,Name,_}|Rest],ObjSetName, %% treatment. emit([";",nl,indent(9),{asis,Name}," ->",nl]), emit([indent(12),"Len = case Val of",nl, - indent(15),"Bin when is_binary(Bin) -> size(Bin);",nl, + indent(15),"Bin when is_binary(Bin) -> byte_size(Bin);",nl, indent(15),"_ -> length(Val)",nl,indent(12),"end,",nl, indent(12),"{Val,Len}"]), {Acc,0} @@ -1449,7 +1449,7 @@ gen_inlined_dec_funs(Fields,[{typefield,Name,Prop}|Rest], nl,indent(6),"case Type of",nl, indent(9),{asis,Name}," ->",nl, indent(12),"Len = case Bytes of",nl, - indent(15),"B when is_binary(B) -> size(B);",nl, + indent(15),"B when is_binary(B) -> byte_size(B);",nl, indent(15),"_ -> length(Bytes)",nl, indent(12),"end,",nl, indent(12),"{Bytes,[],Len}"]), diff --git a/lib/asn1/src/asn1ct_gen_per.erl b/lib/asn1/src/asn1ct_gen_per.erl index 0d6620667f..fac233532b 100644 --- a/lib/asn1/src/asn1ct_gen_per.erl +++ b/lib/asn1/src/asn1ct_gen_per.erl @@ -1174,12 +1174,12 @@ gen_dec_imm_1('UTF8String', _Constraint, Aligned) -> asn1ct_imm:per_dec_restricted_string(Aligned); gen_dec_imm_1('REAL', _Constraint, Aligned) -> asn1ct_imm:per_dec_real(Aligned); -gen_dec_imm_1(#'ObjectClassFieldType'{}=TypeName, Constraint, Aligned) -> +gen_dec_imm_1(#'ObjectClassFieldType'{}=TypeName, _Constraint, Aligned) -> case asn1ct_gen:get_inner(TypeName) of - {fixedtypevaluefield,_,InnerType} -> - gen_dec_imm_1(InnerType, Constraint, Aligned); - T -> - gen_dec_imm_1(T, Constraint, Aligned) + {fixedtypevaluefield,_,#type{def=InnerType,constraint=C}} -> + gen_dec_imm_1(InnerType, C, Aligned); + #type{def=T,constraint=C} -> + gen_dec_imm_1(T, C, Aligned) end. gen_dec_bit_string(F, Imm) -> diff --git a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl index 5a409295fb..81d8cdcae6 100644 --- a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl +++ b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl @@ -610,9 +610,9 @@ gen_encode_objectfields(Erules,ClassName,[{typefield,Name,OptOrMand}|Rest], emit([" if",nl, " is_list(Val) ->",nl, " NewVal = list_to_binary(Val),",nl, - " [20,size(NewVal),NewVal];",nl, + " [20,byte_size(NewVal),NewVal];",nl, " is_binary(Val) ->",nl, - " [20,size(Val),Val]",nl, + " [20,byte_size(Val),Val]",nl, " end"]), []; {false,{'DEFAULT',DefaultType}} -> @@ -989,7 +989,7 @@ gen_objset_enc(_Erule,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, emit({indent(9),"is_list(Val) -> list_to_binary(Val);",nl}), emit({indent(9),"true -> Val",nl}), emit({indent(6),"end,",nl}), - emit({indent(6),"Size = size(BinVal),",nl}), + emit({indent(6),"Size = byte_size(BinVal),",nl}), emit({indent(6),"if",nl}), emit({indent(9),"Size < 256 ->",nl}), emit({indent(12),"[20,Size,BinVal];",nl}), diff --git a/lib/asn1/src/asn1rtt_ber.erl b/lib/asn1/src/asn1rtt_ber.erl index 88292aca99..5fbf116747 100644 --- a/lib/asn1/src/asn1rtt_ber.erl +++ b/lib/asn1/src/asn1rtt_ber.erl @@ -868,7 +868,7 @@ remove_unused_then_dotag(TagIn,Unused,BinBits) -> encode_tags(TagIn, <<0>>, 1); 0 -> Bin = <<Unused,BinBits/binary>>, - encode_tags(TagIn,Bin,size(Bin)); + encode_tags(TagIn, Bin, byte_size(Bin)); Num -> N = byte_size(BinBits)-1, <<BBits:N/binary,LastByte>> = BinBits, diff --git a/lib/asn1/src/asn1rtt_per.erl b/lib/asn1/src/asn1rtt_per.erl index d02f4f548e..84ff809912 100644 --- a/lib/asn1/src/asn1rtt_per.erl +++ b/lib/asn1/src/asn1rtt_per.erl @@ -613,11 +613,11 @@ bit_string_trailing_zeros1(BitList,Lb,Ub) -> encode_bin_bit_string(C, {Unused,BinBits}, _NamedBitList) when is_integer(C),C=<16 -> range_check(C, bit_size(BinBits) - Unused), - [45,C,size(BinBits),BinBits]; + [45,C,byte_size(BinBits),BinBits]; encode_bin_bit_string(C, {Unused,BinBits}, _NamedBitList) when is_integer(C), C =< 255 -> range_check(C, bit_size(BinBits) - Unused), - [2,45,C,size(BinBits),BinBits]; + [2,45,C,byte_size(BinBits),BinBits]; encode_bin_bit_string(C, {Unused,BinBits}, _NamedBitList) when is_integer(C), C =< 65535 -> range_check(C, bit_size(BinBits) - Unused), diff --git a/lib/asn1/src/asn1rtt_real_common.erl b/lib/asn1/src/asn1rtt_real_common.erl index 540f0d60a5..d1668f68b2 100644 --- a/lib/asn1/src/asn1rtt_real_common.erl +++ b/lib/asn1/src/asn1rtt_real_common.erl @@ -88,7 +88,7 @@ encode_real(_C, {Mantissa, Base, Exponent}) when Base =:= 2 -> end, %% ok = io:format("SignBitMask: ~w~n",[SignBitMask]), SFactor = 0, - OctExpLen = size(OctExp), + OctExpLen = byte_size(OctExp), if OctExpLen > 255 -> exit({error,{asn1, {to_big_exp_in_encode_real, OctExpLen}}}); true -> true %% make real assert later.. diff --git a/lib/asn1/test/Makefile b/lib/asn1/test/Makefile index 1fa495d8f1..10f8e2833b 100644 --- a/lib/asn1/test/Makefile +++ b/lib/asn1/test/Makefile @@ -109,6 +109,7 @@ MODULES= \ test_modified_x420 \ testX420 \ test_x691 \ + testWSParamClass \ asn1_test_lib \ asn1_app_test \ asn1_appup_test \ diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl index be9b82cddf..62418e554e 100644 --- a/lib/asn1/test/asn1_SUITE.erl +++ b/lib/asn1/test/asn1_SUITE.erl @@ -86,6 +86,7 @@ groups() -> testInvokeMod, per, ber_other, + der, h323test, per_GeneralString]}, testChoPrim, @@ -166,13 +167,13 @@ groups() -> testINSTANCE_OF, testTCAP, test_ParamTypeInfObj, - test_WS_ParamClass, test_Defed_ObjectIdentifier, testSelectionType, testSSLspecs, testNortel, - % Uses 'PKCS7' - {group, [], [test_modified_x420, + % Uses 'PKCS7', 'InformationFramework' + {group, [], [test_WS_ParamClass, + test_modified_x420, testX420]}, testTcapsystem, testNBAPsystem, @@ -200,8 +201,6 @@ parallel(Options) -> %%------------------------------------------------------------------------------ init_per_suite(Config) -> - PrivDir = ?config(priv_dir, Config), - true = code:add_patha(PrivDir), Config. end_per_suite(_Config) -> @@ -214,7 +213,7 @@ end_per_group(_GroupName, Config) -> Config. init_per_testcase(Func, Config) -> - CaseDir = filename:join([?config(priv_dir, Config), ?MODULE, Func]), + CaseDir = filename:join(?config(priv_dir, Config), Func), ok = filelib:ensure_dir(filename:join([CaseDir, dummy_file])), true = code:add_patha(CaseDir), @@ -351,7 +350,7 @@ testPrimStrings(Config, Rule, Opts) -> asn1_test_lib:compile_all(["PrimStrings", "BitStr"], Config, [compact_bit_string,Rule|Opts]), testPrimStrings:bit_string(Rule), - ?only_ber(testPrimStrings:more_strings(Rule)). + testPrimStrings:more_strings(Rule). testPrimStrings_cases(Rule) -> testPrimStrings:bit_string(Rule), @@ -368,10 +367,10 @@ testPrimExternal(Config, Rule, Opts) -> asn1_test_lib:compile_all(["External", "PrimExternal"], Config, [Rule|Opts]), testPrimExternal:external(Rule), - ?only_ber(asn1_test_lib:compile_all(["PrimStrings", "BitStr"], Config, - [Rule|Opts])), - ?only_ber(testPrimStrings_cases(Rule)), - ?only_ber(testPrimStrings:more_strings(Rule)). + asn1_test_lib:compile_all(["PrimStrings", "BitStr"], Config, + [Rule|Opts]), + testPrimStrings_cases(Rule), + testPrimStrings:more_strings(Rule). testChoPrim(Config) -> test(Config, fun testChoPrim/3). testChoPrim(Config, Rule, Opts) -> @@ -634,9 +633,10 @@ c_syntax(Config) -> "SeqBadComma"]]. c_string(Config) -> - test(Config, fun c_string/3, [per, ber]). + test(Config, fun c_string/3). c_string(Config, Rule, Opts) -> - asn1_test_lib:compile("String", Config, [Rule|Opts]). + asn1_test_lib:compile("String", Config, [Rule|Opts]), + asn1ct:test('String'). c_implicit_before_choice(Config) -> test(Config, fun c_implicit_before_choice/3, [ber]). @@ -688,6 +688,8 @@ ber_other(Config) -> ber_other(Config, Rule, Opts) -> [module_test(M, Config, Rule, Opts) || M <- ber_modules()]. +der(Config) -> + asn1_test_lib:compile_all(ber_modules(), Config, [der]). module_test(M, Config, Rule, Opts) -> asn1_test_lib:compile(M, Config, [Rule|Opts]), @@ -740,13 +742,9 @@ value_test(Config, Rule, Opts) -> 'ObjIdValues':'mobileDomainId'()). value_bad_enum_test(Config) -> - case ?MODULE of - asn1_SUITE -> - {error, _} = asn1ct:compile(?config(data_dir, Config) - ++ "BadEnumValue1", - [{outdir, ?config(case_dir, Config)}]); - _ -> {skip, "Runs in asn1_SUITE only"} - end. + {error, _} = asn1ct:compile(?config(data_dir, Config) ++ + "BadEnumValue1", + [{outdir, ?config(case_dir, Config)}]). constructed(Config) -> test(Config, fun constructed/3, [ber]). @@ -861,18 +859,13 @@ testInvokeMod(Config, Rule, Opts) -> {ok, _Result2} = 'PrimStrings':encode('Bs1', [1, 0, 1, 0]). testExport(Config) -> - case ?MODULE of - asn1_SUITE -> - {error, {asn1, _Reason}} = - asn1ct:compile(filename:join(?config(data_dir, Config), - "IllegalExport"), - [{outdir, ?config(case_dir, Config)}]); - _ -> - {skip, "Runs in asn1_SUITE only"} - end. + {error, {asn1, _Reason}} = + asn1ct:compile(filename:join(?config(data_dir, Config), + "IllegalExport"), + [{outdir, ?config(case_dir, Config)}]). testImport(Config) -> - test(Config, fun testImport/3, [ber]). + test(Config, fun testImport/3). testImport(Config, Rule, Opts) -> {error, _} = asn1ct:compile(filename:join(?config(data_dir, Config), "ImportsFrom"), @@ -910,18 +903,14 @@ testOpenTypeImplicitTag(Config, Rule, Opts) -> testOpenTypeImplicitTag:main(Rule). duplicate_tags(Config) -> - case ?MODULE of - asn1_SUITE -> - DataDir = ?config(data_dir, Config), - CaseDir = ?config(case_dir, Config), - {error, {asn1, [{error, {type, _, _, 'SeqOpt1Imp', {asn1, {duplicates_of_the_tags, _}}}}]}} = - asn1ct:compile(filename:join(DataDir, "SeqOptional2"), - [abs, {outdir, CaseDir}]); - _ -> - {skip, "Runs in asn1_SUITE only"} - end. + DataDir = ?config(data_dir, Config), + CaseDir = ?config(case_dir, Config), + {error, {asn1, [{error, {type, _, _, 'SeqOpt1Imp', + {asn1, {duplicates_of_the_tags, _}}}}]}} = + asn1ct:compile(filename:join(DataDir, "SeqOptional2"), + [abs, {outdir, CaseDir}]). -rtUI(Config) -> test(Config, fun rtUI/3, [per,ber]). +rtUI(Config) -> test(Config, fun rtUI/3). rtUI(Config, Rule, Opts) -> asn1_test_lib:compile("Prim", Config, [Rule|Opts]), {ok, _} = asn1rt:info('Prim'). @@ -937,7 +926,7 @@ testINSTANCE_OF(Config, Rule, Opts) -> testINSTANCE_OF:main(Rule). testTCAP(Config) -> - test(Config, fun testTCAP/3, [ber]). + test(Config, fun testTCAP/3). testTCAP(Config, Rule, Opts) -> testTCAP:compile(Config, [Rule|Opts]), testTCAP:test(Rule, Config), @@ -988,11 +977,16 @@ test_driver_load(Config, Rule, Opts) -> test_ParamTypeInfObj(Config) -> asn1_test_lib:compile("IN-CS-1-Datatypes", Config, [ber]). -test_WS_ParamClass(Config) -> - asn1_test_lib:compile("InformationFramework", Config, [ber]). +test_WS_ParamClass(Config) -> test(Config, fun test_WS_ParamClass/3). +test_WS_ParamClass(Config, Rule, Opts) -> + asn1_test_lib:compile("InformationFramework", Config, [Rule|Opts]), + ?only_ber(testWSParamClass:main(Rule)), + ok. test_Defed_ObjectIdentifier(Config) -> - asn1_test_lib:compile("UsefulDefinitions", Config, [ber]). + test(Config, fun test_Defed_ObjectIdentifier/3). +test_Defed_ObjectIdentifier(Config, Rule, Opts) -> + asn1_test_lib:compile("UsefulDefinitions", Config, [Rule|Opts]). testSelectionType(Config) -> test(Config, fun testSelectionType/3). testSelectionType(Config, Rule, Opts) -> @@ -1020,7 +1014,7 @@ test_undecoded_rest(Config, Rule, Opts) -> test_undecoded_rest:test(undec_rest, Config). testTcapsystem(Config) -> - test(Config, fun testTcapsystem/3, [ber]). + test(Config, fun testTcapsystem/3). testTcapsystem(Config, Rule, Opts) -> testTcapsystem:compile(Config, [Rule|Opts]). @@ -1123,6 +1117,7 @@ test_modules() -> "Int", "MAP-commonDataTypes", "Null", + "NullTest", "Octetstr", "One", "P-Record", @@ -1264,189 +1259,6 @@ smp(Config) -> {skipped,"No smp support"} end. -per_performance(Config) -> - PrivDir = proplists:get_value(priv_dir, Config), - NifDir = filename:join(PrivDir,"nif"), - ErlDir = filename:join(PrivDir,"erl"), - file:make_dir(NifDir),file:make_dir(ErlDir), - - Msg = {initiatingMessage, testNBAPsystem:cell_setup_req_msg()}, - ok = testNBAPsystem:compile([{priv_dir,NifDir}|Config], [per]), - ok = testNBAPsystem:compile([{priv_dir,ErlDir}|Config], [per]), - - Modules = ['NBAP-CommonDataTypes', - 'NBAP-Constants', - 'NBAP-Containers', - 'NBAP-IEs', - 'NBAP-PDU-Contents', - 'NBAP-PDU-Discriptions'], - - - PreNif = fun() -> - code:add_patha(NifDir), - lists:foreach(fun(M) -> - code:purge(M), - code:load_file(M) - end,Modules) - end, - - PreErl = fun() -> - code:add_patha(ErlDir), - lists:foreach(fun(M) -> - code:purge(M), - code:load_file(M) - end,Modules) - end, - - Func = fun() -> - element(1,timer:tc( - asn1_wrapper,encode,['NBAP-PDU-Discriptions', - 'NBAP-PDU', - Msg])) - end, - - nif_vs_erlang_performance({{{PreNif,Func},{PreErl,Func}},100000,32}). - -ber_performance(Config) -> - - Msg = {initiatingMessage, testNBAPsystem:cell_setup_req_msg()}, - ok = testNBAPsystem:compile(Config, [ber]), - - - BerFun = fun() -> - {ok,B} = asn1_wrapper:encode('NBAP-PDU-Discriptions', - 'NBAP-PDU', Msg), - asn1_wrapper:decode( - 'NBAP-PDU-Discriptions', - 'NBAP-PDU', - B) - end, - nif_vs_erlang_performance({BerFun,100000,32}). - -cert_pem_performance(Config) when is_list(Config) -> - cert_pem_performance({100000, 32}); -cert_pem_performance({N,S}) -> - nif_vs_erlang_performance({fun pem_performance:cert_pem/0,N,S}). - -dsa_pem_performance(Config) when is_list(Config) -> - dsa_pem_performance({100000, 32}); -dsa_pem_performance({N,S}) -> - nif_vs_erlang_performance({fun pem_performance:dsa_pem/0,N,S}). - - -nif_vs_erlang_performance({{TC1,TC2},N,Sched}) -> - random:seed({123,456,789}), - io:format("Running a ~p sample with ~p max procs...~n~n",[N,Sched]), - - {True,False} = exec(TC1,TC2,Sched,N+1), - - io:format("~ndone!~n"), - - io:format("~n"),TStats = print_stats(strip(True,N div 20)), - io:format("~n"),FStats = print_stats(strip(False,N div 20)), - Str = io_lib:format("~nNifs are ~.3f% faster than erlang!~n", - [(element(2,FStats) - element(2,TStats)) / - element(2,FStats) * 100]), - io:format(Str), - {comment, lists:flatten(Str)}; -nif_vs_erlang_performance({T,N,Sched}) -> - PTC1 = fun() -> - application:set_env(asn1, nif_loadable, true) - end, - PTC2 = fun() -> - application:set_env(asn1, nif_loadable, false) - end, - TC = fun() -> - element(1,timer:tc(T)) - end, - nif_vs_erlang_performance({{{PTC1,TC},{PTC2,TC}},N,Sched}). - - -print_stats(Data) -> - Length = length(Data), - Mean = lists:sum(Data) / Length, - Variance = lists:foldl(fun(N,Acc) -> math:pow(N - Mean, 2)+Acc end, 0, Data), - StdDev = math:sqrt(Variance / Length), - Median = lists:nth(round(Length/2),Data), - Min = lists:min(Data), - Max = lists:max(Data), - if Length < 20 -> - io:format("Data: ~w~n",[Data]); - true -> - ok - end, - io:format("Length: ~p~nMean: ~p~nStdDev: ~p~nMedian: ~p~nMin: ~p~nMax: ~p~n", - [Length,Mean,StdDev,Median,Min,Max]), - {Length,Mean,StdDev,Median,Min,Max}. - -collect(Acc) -> - receive - {Tag,Val} -> - Prev = proplists:get_value(Tag,Acc,[]), - collect(lists:keystore(Tag,1,Acc,{Tag,[Val|Prev]})) - after 100 -> - Acc - end. - -exec(One,Two,Max,N) -> - exec(One,Two,Max,N,{[],[]}). -exec(_,_,_,1,{D1,D2}) -> - {lists:flatten(D1),lists:flatten(D2)}; -exec({PreOne,One} = O,{PreTwo,Two} = T,MaxProcs, N, {D1,D2}) -> - Num = random:uniform(round(N/2)), - if Num rem 3 == 0 -> - timer:sleep(Num rem 1000); - true -> - ok - end, - Procs = random:uniform(MaxProcs), - io:format("\tBatch: ~p items in ~p processes, ~p left~n",[Num,Procs,N-Num]), - if Num rem 2 == 1 -> - erlang:garbage_collect(), - PreOne(), - MoreOne = pexec(One, Num, Procs, []), - erlang:garbage_collect(), - PreTwo(), - MoreTwo = pexec(Two, Num, Procs, []); - true -> - erlang:garbage_collect(), - PreTwo(), - MoreTwo = pexec(Two, Num, Procs, []), - erlang:garbage_collect(), - PreOne(), - MoreOne = pexec(One, Num, Procs, []) - end, - exec(O,T,MaxProcs,N-Num,{[MoreOne|D1], - [MoreTwo|D2]}). - -pexec(_Fun, _, 0, []) -> - []; -pexec(Fun, _, 0, [{Ref,Pid}|Rest]) -> - receive - {data,D} -> - [D|pexec(Fun,0,0,[{Ref,Pid}|Rest])]; - {'DOWN', Ref, process, Pid, normal} -> - pexec(Fun, 0,0,Rest) - end; -pexec(Fun, 0, 1, AccProcs) -> - pexec(Fun, 0, 0, AccProcs); -pexec(Fun, N, 1, AccProcs) -> - [Fun()|pexec(Fun, N - 1, 1, AccProcs)]; -pexec(Fun, N, Procs, AccProcs) -> - S = self(), - Pid = spawn(fun() -> - S ! {data,pexec(Fun,N,1,[])} - end), - Ref = erlang:monitor(process, Pid), - pexec(Fun, N, Procs - 1, [{Ref,Pid}|AccProcs]). - -strip(Data,Num) -> - {_,R} = lists:split(Num,lists:sort(Data)), - element(2,lists:split(Num,lists:reverse(R))). - -faster(A,B) -> - (B - A)/B * 100. - enc_dec(1, Msg, N) -> worker_loop(N, Msg); enc_dec(NumOfProcs,Msg, N) -> diff --git a/lib/asn1/test/asn1_SUITE_data/Def.py b/lib/asn1/test/asn1_SUITE_data/Def.py deleted file mode 100644 index ff08ed6386..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/Def.py +++ /dev/null @@ -1,31 +0,0 @@ -Def DEFINITIONS IMPLICIT TAGS ::= - -BEGIN - -Def1 ::= SEQUENCE -{ - bool0 [0] BOOLEAN, - bool1 [1] BOOLEAN DEFAULT false, - bool2 [2] BOOLEAN DEFAULT false, - bool3 [3] BOOLEAN DEFAULT false -} - - -Def2 ::= SEQUENCE -{ - bool10 [10] BOOLEAN, - bool11 [11] BOOLEAN DEFAULT false, - bool12 [12] BOOLEAN DEFAULT false, - bool13 [13] BOOLEAN -} - - -Def3 ::= SEQUENCE -{ - bool30 [30] BOOLEAN DEFAULT false, - bool31 [31] BOOLEAN DEFAULT false, - bool32 [32] BOOLEAN DEFAULT false, - bool33 [33] BOOLEAN DEFAULT false -} - -END diff --git a/lib/asn1/test/asn1_SUITE_data/NullTest.asn1 b/lib/asn1/test/asn1_SUITE_data/NullTest.asn1 new file mode 100644 index 0000000000..041b20a4c1 --- /dev/null +++ b/lib/asn1/test/asn1_SUITE_data/NullTest.asn1 @@ -0,0 +1,14 @@ +NullTest DEFINITIONS ::= +BEGIN + +NullTestData ::= SEQUENCE { + body NullBody, + tail INTEGER +} + +NullBody ::= CHOICE { + null [0] NULL, + notNull [1] INTEGER +} + +END diff --git a/lib/asn1/test/asn1_SUITE_data/Opt.py b/lib/asn1/test/asn1_SUITE_data/Opt.py deleted file mode 100644 index 48c2a09b64..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/Opt.py +++ /dev/null @@ -1,31 +0,0 @@ -Opt DEFINITIONS IMPLICIT TAGS ::= - -BEGIN - -Opt1 ::= SEQUENCE -{ - bool0 [0] BOOLEAN, - bool1 [1] BOOLEAN OPTIONAL, - bool2 [2] BOOLEAN OPTIONAL, - bool3 [3] BOOLEAN OPTIONAL -} - - -Opt2 ::= SEQUENCE -{ - bool10 [10] BOOLEAN, - bool11 [11] BOOLEAN OPTIONAL, - bool12 [12] BOOLEAN OPTIONAL, - bool13 [13] BOOLEAN -} - - -Opt3 ::= SEQUENCE -{ - bool30 [30] BOOLEAN OPTIONAL, - bool31 [31] BOOLEAN OPTIONAL, - bool32 [32] BOOLEAN OPTIONAL, - bool33 [33] BOOLEAN OPTIONAL -} - -END diff --git a/lib/asn1/test/asn1_SUITE_data/SeqOf.py b/lib/asn1/test/asn1_SUITE_data/SeqOf.py deleted file mode 100644 index c941418934..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/SeqOf.py +++ /dev/null @@ -1,45 +0,0 @@ -SeqOf DEFINITIONS IMPLICIT TAGS ::= - -BEGIN - - -Seq1 ::= SEQUENCE -{ - bool1 BOOLEAN, - int1 INTEGER, - seq1 SEQUENCE OF SeqIn DEFAULT {} -} - -Seq2 ::= SEQUENCE -{ - seq2 SEQUENCE OF SeqIn DEFAULT {}, - bool2 BOOLEAN, - int2 INTEGER -} - -Seq3 ::= SEQUENCE -{ - bool3 BOOLEAN, - seq3 SEQUENCE OF SeqIn DEFAULT {}, - int3 INTEGER -} - -Seq4 ::= SEQUENCE -{ - seq41 [41] SEQUENCE OF SeqIn DEFAULT {}, - seq42 [42] SEQUENCE OF SeqIn DEFAULT {}, - seq43 [43] SEQUENCE OF SeqIn DEFAULT {} -} - - - -SeqIn ::= SEQUENCE -{ - boolIn BOOLEAN, - intIn INTEGER -} - - - - -END diff --git a/lib/asn1/test/asn1_SUITE_data/SetOf.py b/lib/asn1/test/asn1_SUITE_data/SetOf.py deleted file mode 100644 index 4e2ea16fcc..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/SetOf.py +++ /dev/null @@ -1,42 +0,0 @@ -SetOf DEFINITIONS IMPLICIT TAGS ::= - -BEGIN - - -Set1 ::= SET -{ - bool1 BOOLEAN, - int1 INTEGER, - set1 SET OF SetIn DEFAULT {} -} - -Set2 ::= SET -{ - set2 SET OF SetIn DEFAULT {}, - bool2 BOOLEAN, - int2 INTEGER -} - -Set3 ::= SET -{ - bool3 BOOLEAN, - set3 SET OF SetIn DEFAULT {}, - int3 INTEGER -} - -Set4 ::= SET -{ - set41 [41] SET OF SetIn DEFAULT {}, - set42 [42] SET OF SetIn DEFAULT {}, - set43 [43] SET OF SetIn DEFAULT {} -} - - - -SetIn ::= SET -{ - boolIn BOOLEAN, - intIn INTEGER -} - -END diff --git a/lib/asn1/test/testTCAP.erl b/lib/asn1/test/testTCAP.erl index b723995e40..354b6c5ea4 100644 --- a/lib/asn1/test/testTCAP.erl +++ b/lib/asn1/test/testTCAP.erl @@ -37,7 +37,7 @@ compile_asn1config(Config, Options) -> asn1_test_lib:compile_all(Files, Config, Options), asn1_test_lib:compile_erlang("TCAPPackage_msg", Config, []). -test(ber=Erule,_Config) -> +test(Erule,_Config) -> % ?line OutDir = ?config(priv_dir,Config), %% testing OTP-4798, open type encoded with indefinite length ?line {ok,_Res} = asn1_wrapper:decode('TCAPMessages-simple','MessageType', val_OTP_4798(Erule)), diff --git a/lib/asn1/test/testWSParamClass.erl b/lib/asn1/test/testWSParamClass.erl new file mode 100644 index 0000000000..ae67ca8b81 --- /dev/null +++ b/lib/asn1/test/testWSParamClass.erl @@ -0,0 +1,17 @@ +-module(testWSParamClass). +-export([main/1]). + +main(_) -> + IF = 'InformationFramework', + roundtrip({'Attribute',IF:'id-at-objectClass'(), + [IF:'id-at-objectClass'()], + asn1_NOVALUE}), + roundtrip({'Attribute',IF:'id-at-objectClass'(), + [],[]}), + ok. + +roundtrip(Data) -> + IF = 'InformationFramework', + {ok,Enc} = asn1_wrapper:encode(IF, 'Attribute', Data), + {ok,Data} = IF:decode('Attribute', Enc), + ok. diff --git a/lib/common_test/priv/auxdir/config.guess b/lib/common_test/priv/auxdir/config.guess index 38a833903b..f475ceb413 100755 --- a/lib/common_test/priv/auxdir/config.guess +++ b/lib/common_test/priv/auxdir/config.guess @@ -1,14 +1,12 @@ #! /bin/sh # Attempt to guess a canonical system name. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, -# Inc. +# Copyright 1992-2013 Free Software Foundation, Inc. -timestamp='2007-05-17' +timestamp='2013-02-12' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or +# the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, but @@ -17,26 +15,22 @@ timestamp='2007-05-17' # General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. +# along with this program; if not, see <http://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - - -# Originally written by Per Bothner <[email protected]>. -# Please send patches to <[email protected]>. Submit a context -# diff and a properly formatted ChangeLog entry. +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). +# +# Originally written by Per Bothner. # -# This script attempts to guess a canonical system name similar to -# config.sub. If it succeeds, it prints the system name on stdout, and -# exits with 0. Otherwise, it exits with 1. +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD # -# The plan is that this can be called by configure scripts if you -# don't specify an explicit build system type. +# Please send patches with a ChangeLog entry to [email protected]. + me=`echo "$0" | sed -e 's,.*/,,'` @@ -56,8 +50,7 @@ version="\ GNU config.guess ($timestamp) Originally written by Per Bothner. -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 -Free Software Foundation, Inc. +Copyright 1992-2013 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -144,7 +137,7 @@ UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in *:NetBSD:*:*) # NetBSD (nbsd) targets should (where applicable) match one or - # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*, + # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*, # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently # switched to ELF, *-*-netbsd* would select the old # object file format. This provides both forward @@ -170,7 +163,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in arm*|i386|m68k|ns32k|sh3*|sparc|vax) eval $set_cc_for_build if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep __ELF__ >/dev/null + | grep -q __ELF__ then # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). # Return netbsd for either. FIX? @@ -180,7 +173,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in fi ;; *) - os=netbsd + os=netbsd ;; esac # The OS release @@ -201,6 +194,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. echo "${machine}-${os}${release}" exit ;; + *:Bitrig:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'` + echo ${UNAME_MACHINE_ARCH}-unknown-bitrig${UNAME_RELEASE} + exit ;; *:OpenBSD:*:*) UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} @@ -223,7 +220,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` ;; *5.*) - UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` ;; esac # According to Compaq, /usr/sbin/psrinfo has been available on @@ -269,7 +266,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # A Xn.n version is an unreleased experimental baselevel. # 1.2 uses "1.2" for uname -r. echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - exit ;; + # Reset EXIT trap before exiting to avoid spurious non-zero exit code. + exitcode=$? + trap '' 0 + exit $exitcode ;; Alpha\ *:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # Should we change UNAME_MACHINE based on the output of uname instead @@ -295,12 +295,12 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in echo s390-ibm-zvmoe exit ;; *:OS400:*:*) - echo powerpc-ibm-os400 + echo powerpc-ibm-os400 exit ;; arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) echo arm-acorn-riscix${UNAME_RELEASE} exit ;; - arm:riscos:*:*|arm:RISCOS:*:*) + arm*:riscos:*:*|arm*:RISCOS:*:*) echo arm-unknown-riscos exit ;; SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) @@ -324,14 +324,33 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in case `/usr/bin/uname -p` in sparc) echo sparc-icl-nx7; exit ;; esac ;; + s390x:SunOS:*:*) + echo ${UNAME_MACHINE}-ibm-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; sun4H:SunOS:5.*:*) echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; - i86pc:SunOS:5.*:* | ix86xen:SunOS:5.*:*) - echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) + echo i386-pc-auroraux${UNAME_RELEASE} + exit ;; + i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) + eval $set_cc_for_build + SUN_ARCH="i386" + # If there is a compiler, see if it is configured for 64-bit objects. + # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. + # This test works for both compilers. + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + SUN_ARCH="x86_64" + fi + fi + echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:6*:*) # According to config.sub, this is the proper way to canonicalize @@ -375,23 +394,23 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # MiNT. But MiNT is downward compatible to TOS, so this should # be no problem. atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} + echo m68k-atari-mint${UNAME_RELEASE} exit ;; atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) echo m68k-atari-mint${UNAME_RELEASE} - exit ;; + exit ;; *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} + echo m68k-atari-mint${UNAME_RELEASE} exit ;; milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) - echo m68k-milan-mint${UNAME_RELEASE} - exit ;; + echo m68k-milan-mint${UNAME_RELEASE} + exit ;; hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) - echo m68k-hades-mint${UNAME_RELEASE} - exit ;; + echo m68k-hades-mint${UNAME_RELEASE} + exit ;; *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) - echo m68k-unknown-mint${UNAME_RELEASE} - exit ;; + echo m68k-unknown-mint${UNAME_RELEASE} + exit ;; m68k:machten:*:*) echo m68k-apple-machten${UNAME_RELEASE} exit ;; @@ -461,8 +480,8 @@ EOF echo m88k-motorola-sysv3 exit ;; AViiON:dgux:*:*) - # DG/UX returns AViiON for all architectures - UNAME_PROCESSOR=`/usr/bin/uname -p` + # DG/UX returns AViiON for all architectures + UNAME_PROCESSOR=`/usr/bin/uname -p` if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] then if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ @@ -475,7 +494,7 @@ EOF else echo i586-dg-dgux${UNAME_RELEASE} fi - exit ;; + exit ;; M88*:DolphinOS:*:*) # DolphinOS (SVR3) echo m88k-dolphin-sysv3 exit ;; @@ -532,7 +551,7 @@ EOF echo rs6000-ibm-aix3.2 fi exit ;; - *:AIX:*:[45]) + *:AIX:*:[4567]) IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then IBM_ARCH=rs6000 @@ -575,52 +594,52 @@ EOF 9000/[678][0-9][0-9]) if [ -x /usr/bin/getconf ]; then sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` - sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` - case "${sc_cpu_version}" in - 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 - 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 - 532) # CPU_PA_RISC2_0 - case "${sc_kernel_bits}" in - 32) HP_ARCH="hppa2.0n" ;; - 64) HP_ARCH="hppa2.0w" ;; + sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` + case "${sc_cpu_version}" in + 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 + 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 + 532) # CPU_PA_RISC2_0 + case "${sc_kernel_bits}" in + 32) HP_ARCH="hppa2.0n" ;; + 64) HP_ARCH="hppa2.0w" ;; '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 - esac ;; - esac + esac ;; + esac fi if [ "${HP_ARCH}" = "" ]; then eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c + sed 's/^ //' << EOF >$dummy.c - #define _HPUX_SOURCE - #include <stdlib.h> - #include <unistd.h> + #define _HPUX_SOURCE + #include <stdlib.h> + #include <unistd.h> - int main () - { - #if defined(_SC_KERNEL_BITS) - long bits = sysconf(_SC_KERNEL_BITS); - #endif - long cpu = sysconf (_SC_CPU_VERSION); + int main () + { + #if defined(_SC_KERNEL_BITS) + long bits = sysconf(_SC_KERNEL_BITS); + #endif + long cpu = sysconf (_SC_CPU_VERSION); - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1"); break; - case CPU_PA_RISC2_0: - #if defined(_SC_KERNEL_BITS) - switch (bits) - { - case 64: puts ("hppa2.0w"); break; - case 32: puts ("hppa2.0n"); break; - default: puts ("hppa2.0"); break; - } break; - #else /* !defined(_SC_KERNEL_BITS) */ - puts ("hppa2.0"); break; - #endif - default: puts ("hppa1.0"); break; - } - exit (0); - } + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1"); break; + case CPU_PA_RISC2_0: + #if defined(_SC_KERNEL_BITS) + switch (bits) + { + case 64: puts ("hppa2.0w"); break; + case 32: puts ("hppa2.0n"); break; + default: puts ("hppa2.0"); break; + } break; + #else /* !defined(_SC_KERNEL_BITS) */ + puts ("hppa2.0"); break; + #endif + default: puts ("hppa1.0"); break; + } + exit (0); + } EOF (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` test -z "$HP_ARCH" && HP_ARCH=hppa @@ -640,7 +659,7 @@ EOF # => hppa64-hp-hpux11.23 if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | - grep __LP64__ >/dev/null + grep -q __LP64__ then HP_ARCH="hppa2.0w" else @@ -711,22 +730,22 @@ EOF exit ;; C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) echo c1-convex-bsd - exit ;; + exit ;; C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) if getsysinfo -f scalar_acc then echo c32-convex-bsd else echo c2-convex-bsd fi - exit ;; + exit ;; C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) echo c34-convex-bsd - exit ;; + exit ;; C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) echo c38-convex-bsd - exit ;; + exit ;; C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) echo c4-convex-bsd - exit ;; + exit ;; CRAY*Y-MP:*:*:*) echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; @@ -750,14 +769,14 @@ EOF exit ;; F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` - echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit ;; + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` + echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; 5000:UNIX_System_V:4.*:*) - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` - echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` + echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" exit ;; i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} @@ -769,40 +788,51 @@ EOF echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} exit ;; *:FreeBSD:*:*) - case ${UNAME_MACHINE} in - pc98) - echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + UNAME_PROCESSOR=`/usr/bin/uname -p` + case ${UNAME_PROCESSOR} in amd64) echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; *) - echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + echo ${UNAME_PROCESSOR}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; esac exit ;; i*:CYGWIN*:*) echo ${UNAME_MACHINE}-pc-cygwin exit ;; + *:MINGW64*:*) + echo ${UNAME_MACHINE}-pc-mingw64 + exit ;; *:MINGW*:*) echo ${UNAME_MACHINE}-pc-mingw32 exit ;; + i*:MSYS*:*) + echo ${UNAME_MACHINE}-pc-msys + exit ;; i*:windows32*:*) - # uname -m includes "-pc" on this system. - echo ${UNAME_MACHINE}-mingw32 + # uname -m includes "-pc" on this system. + echo ${UNAME_MACHINE}-mingw32 exit ;; i*:PW*:*) echo ${UNAME_MACHINE}-pc-pw32 exit ;; - *:Interix*:[3456]*) - case ${UNAME_MACHINE} in - x86) + *:Interix*:*) + case ${UNAME_MACHINE} in + x86) echo i586-pc-interix${UNAME_RELEASE} exit ;; - EM64T | authenticamd) + authenticamd | genuineintel | EM64T) echo x86_64-unknown-interix${UNAME_RELEASE} exit ;; + IA64) + echo ia64-unknown-interix${UNAME_RELEASE} + exit ;; esac ;; [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) echo i${UNAME_MACHINE}-pc-mks exit ;; + 8664:Windows_NT:*) + echo x86_64-pc-mks + exit ;; i*:Windows_NT*:* | Pentium*:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we @@ -832,20 +862,68 @@ EOF i*86:Minix:*:*) echo ${UNAME_MACHINE}-pc-minix exit ;; - arm*:Linux:*:*) + aarch64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + aarch64_be:Linux:*:*) + UNAME_MACHINE=aarch64_be echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; + alpha:Linux:*:*) + case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in + EV5) UNAME_MACHINE=alphaev5 ;; + EV56) UNAME_MACHINE=alphaev56 ;; + PCA56) UNAME_MACHINE=alphapca56 ;; + PCA57) UNAME_MACHINE=alphapca56 ;; + EV6) UNAME_MACHINE=alphaev6 ;; + EV67) UNAME_MACHINE=alphaev67 ;; + EV68*) UNAME_MACHINE=alphaev68 ;; + esac + objdump --private-headers /bin/sh | grep -q ld.so.1 + if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi + echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + exit ;; + arm*:Linux:*:*) + eval $set_cc_for_build + if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_EABI__ + then + echo ${UNAME_MACHINE}-unknown-linux-gnu + else + if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_PCS_VFP + then + echo ${UNAME_MACHINE}-unknown-linux-gnueabi + else + echo ${UNAME_MACHINE}-unknown-linux-gnueabihf + fi + fi + exit ;; avr32*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; cris:Linux:*:*) - echo cris-axis-linux-gnu + echo ${UNAME_MACHINE}-axis-linux-gnu exit ;; crisv32:Linux:*:*) - echo crisv32-axis-linux-gnu + echo ${UNAME_MACHINE}-axis-linux-gnu exit ;; frv:Linux:*:*) - echo frv-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + hexagon:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + i*86:Linux:*:*) + LIBC=gnu + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #ifdef __dietlibc__ + LIBC=dietlibc + #endif +EOF + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'` + echo "${UNAME_MACHINE}-pc-linux-${LIBC}" exit ;; ia64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu @@ -856,74 +934,36 @@ EOF m68*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - mips:Linux:*:*) - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #undef CPU - #undef mips - #undef mipsel - #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mipsel - #else - #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips - #else - CPU= - #endif - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" - test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } - ;; - mips64:Linux:*:*) + mips:Linux:*:* | mips64:Linux:*:*) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #undef CPU - #undef mips64 - #undef mips64el + #undef ${UNAME_MACHINE} + #undef ${UNAME_MACHINE}el #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mips64el + CPU=${UNAME_MACHINE}el #else #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips64 + CPU=${UNAME_MACHINE} #else CPU= #endif #endif EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'` test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } ;; - or32:Linux:*:*) - echo or32-unknown-linux-gnu + or1k:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - ppc:Linux:*:*) - echo powerpc-unknown-linux-gnu + or32:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - ppc64:Linux:*:*) - echo powerpc64-unknown-linux-gnu + padre:Linux:*:*) + echo sparc-unknown-linux-gnu exit ;; - alpha:Linux:*:*) - case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in - EV5) UNAME_MACHINE=alphaev5 ;; - EV56) UNAME_MACHINE=alphaev56 ;; - PCA56) UNAME_MACHINE=alphapca56 ;; - PCA57) UNAME_MACHINE=alphapca56 ;; - EV6) UNAME_MACHINE=alphaev6 ;; - EV67) UNAME_MACHINE=alphaev67 ;; - EV68*) UNAME_MACHINE=alphaev68 ;; - esac - objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null - if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi - echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + parisc64:Linux:*:* | hppa64:Linux:*:*) + echo hppa64-unknown-linux-gnu exit ;; parisc:Linux:*:* | hppa:Linux:*:*) # Look for CPU level @@ -933,14 +973,17 @@ EOF *) echo hppa-unknown-linux-gnu ;; esac exit ;; - parisc64:Linux:*:* | hppa64:Linux:*:*) - echo hppa64-unknown-linux-gnu + ppc64:Linux:*:*) + echo powerpc64-unknown-linux-gnu + exit ;; + ppc:Linux:*:*) + echo powerpc-unknown-linux-gnu exit ;; s390:Linux:*:* | s390x:Linux:*:*) echo ${UNAME_MACHINE}-ibm-linux exit ;; sh64*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; sh*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu @@ -948,81 +991,18 @@ EOF sparc:Linux:*:* | sparc64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - tile:Linux:*:*) - echo tile-unknown-linux-gnu + tile*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; vax:Linux:*:*) echo ${UNAME_MACHINE}-dec-linux-gnu exit ;; x86_64:Linux:*:*) - echo x86_64-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - xtensa:Linux:*:*) - echo xtensa-unknown-linux-gnu + xtensa*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - i*86:Linux:*:*) - # The BFD linker knows what the default object file format is, so - # first see if it will tell us. cd to the root directory to prevent - # problems with other programs or directories called `ld' in the path. - # Set LC_ALL=C to ensure ld outputs messages in English. - ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \ - | sed -ne '/supported targets:/!d - s/[ ][ ]*/ /g - s/.*supported targets: *// - s/ .*// - p'` - case "$ld_supported_targets" in - elf32-i386) - TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu" - ;; - a.out-i386-linux) - echo "${UNAME_MACHINE}-pc-linux-gnuaout" - exit ;; - coff-i386) - echo "${UNAME_MACHINE}-pc-linux-gnucoff" - exit ;; - "") - # Either a pre-BFD a.out linker (linux-gnuoldld) or - # one that does not give us useful --help. - echo "${UNAME_MACHINE}-pc-linux-gnuoldld" - exit ;; - esac - # Determine whether the default compiler is a.out or elf - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #include <features.h> - #ifdef __ELF__ - # ifdef __GLIBC__ - # if __GLIBC__ >= 2 - LIBC=gnu - # else - LIBC=gnulibc1 - # endif - # else - LIBC=gnulibc1 - # endif - #else - #if defined(__INTEL_COMPILER) || defined(__PGI) || defined(__SUNPRO_C) || defined(__SUNPRO_CC) - LIBC=gnu - #else - LIBC=gnuaout - #endif - #endif - #ifdef __dietlibc__ - LIBC=dietlibc - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^LIBC/{ - s: ::g - p - }'`" - test x"${LIBC}" != x && { - echo "${UNAME_MACHINE}-pc-linux-${LIBC}" - exit - } - test x"${TENTATIVE}" != x && { echo "${TENTATIVE}"; exit; } - ;; i*86:DYNIX/ptx:4*:*) # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. # earlier versions are messed up and put the nodename in both @@ -1030,11 +1010,11 @@ EOF echo i386-sequent-sysv4 exit ;; i*86:UNIX_SV:4.2MP:2.*) - # Unixware is an offshoot of SVR4, but it has its own version - # number series starting with 2... - # I am not positive that other SVR4 systems won't match this, + # Unixware is an offshoot of SVR4, but it has its own version + # number series starting with 2... + # I am not positive that other SVR4 systems won't match this, # I just have to hope. -- rms. - # Use sysv4.2uw... so that sysv4* matches it. + # Use sysv4.2uw... so that sysv4* matches it. echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} exit ;; i*86:OS/2:*:*) @@ -1051,7 +1031,7 @@ EOF i*86:syllable:*:*) echo ${UNAME_MACHINE}-pc-syllable exit ;; - i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*) + i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) echo i386-unknown-lynxos${UNAME_RELEASE} exit ;; i*86:*DOS:*:*) @@ -1066,7 +1046,7 @@ EOF fi exit ;; i*86:*:5:[678]*) - # UnixWare 7.x, OpenUNIX and OpenServer 6. + # UnixWare 7.x, OpenUNIX and OpenServer 6. case `/bin/uname -X | grep "^Machine"` in *486*) UNAME_MACHINE=i486 ;; *Pentium) UNAME_MACHINE=i586 ;; @@ -1094,10 +1074,13 @@ EOF exit ;; pc:*:*:*) # Left here for compatibility: - # uname -m prints for DJGPP always 'pc', but it prints nothing about - # the processor, so we play safe by assuming i386. - echo i386-pc-msdosdjgpp - exit ;; + # uname -m prints for DJGPP always 'pc', but it prints nothing about + # the processor, so we play safe by assuming i586. + # Note: whatever this is, it MUST be the same as what config.sub + # prints for the "djgpp" host, or else GDB configury will decide that + # this is a cross-build. + echo i586-pc-msdosdjgpp + exit ;; Intel:Mach:3*:*) echo i386-pc-mach3 exit ;; @@ -1132,8 +1115,18 @@ EOF /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4; exit; } ;; + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4; exit; } ;; + NCR*:*:4.2:* | MPRAS*:*:4.2:*) + OS_REL='.3' + test -r /etc/.relid \ + && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) echo m68k-unknown-lynxos${UNAME_RELEASE} exit ;; @@ -1146,7 +1139,7 @@ EOF rs6000:LynxOS:2.*:*) echo rs6000-unknown-lynxos${UNAME_RELEASE} exit ;; - PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*) + PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) echo powerpc-unknown-lynxos${UNAME_RELEASE} exit ;; SM[BE]S:UNIX_SV:*:*) @@ -1166,10 +1159,10 @@ EOF echo ns32k-sni-sysv fi exit ;; - PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort - # says <[email protected]> - echo i586-unisys-sysv4 - exit ;; + PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort + # says <[email protected]> + echo i586-unisys-sysv4 + exit ;; *:UNIX_System_V:4*:FTX*) # From Gerald Hewes <[email protected]>. # How about differentiating between stratus architectures? -djm @@ -1195,11 +1188,11 @@ EOF exit ;; R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) if [ -d /usr/nec ]; then - echo mips-nec-sysv${UNAME_RELEASE} + echo mips-nec-sysv${UNAME_RELEASE} else - echo mips-unknown-sysv${UNAME_RELEASE} + echo mips-unknown-sysv${UNAME_RELEASE} fi - exit ;; + exit ;; BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. echo powerpc-be-beos exit ;; @@ -1209,6 +1202,12 @@ EOF BePC:BeOS:*:*) # BeOS running on Intel PC compatible. echo i586-pc-beos exit ;; + BePC:Haiku:*:*) # Haiku running on Intel PC compatible. + echo i586-pc-haiku + exit ;; + x86_64:Haiku:*:*) + echo x86_64-unknown-haiku + exit ;; SX-4:SUPER-UX:*:*) echo sx4-nec-superux${UNAME_RELEASE} exit ;; @@ -1236,6 +1235,16 @@ EOF *:Darwin:*:*) UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown case $UNAME_PROCESSOR in + i386) + eval $set_cc_for_build + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + UNAME_PROCESSOR="x86_64" + fi + fi ;; unknown) UNAME_PROCESSOR=powerpc ;; esac echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} @@ -1251,7 +1260,10 @@ EOF *:QNX:*:4*) echo i386-pc-qnx exit ;; - NSE-?:NONSTOP_KERNEL:*:*) + NEO-?:NONSTOP_KERNEL:*:*) + echo neo-tandem-nsk${UNAME_RELEASE} + exit ;; + NSE-*:NONSTOP_KERNEL:*:*) echo nse-tandem-nsk${UNAME_RELEASE} exit ;; NSR-?:NONSTOP_KERNEL:*:*) @@ -1296,13 +1308,13 @@ EOF echo pdp10-unknown-its exit ;; SEI:*:*:SEIUX) - echo mips-sei-seiux${UNAME_RELEASE} + echo mips-sei-seiux${UNAME_RELEASE} exit ;; *:DragonFly:*:*) echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` exit ;; *:*VMS:*:*) - UNAME_MACHINE=`(uname -p) 2>/dev/null` + UNAME_MACHINE=`(uname -p) 2>/dev/null` case "${UNAME_MACHINE}" in A*) echo alpha-dec-vms ; exit ;; I*) echo ia64-dec-vms ; exit ;; @@ -1317,11 +1329,14 @@ EOF i*86:rdos:*:*) echo ${UNAME_MACHINE}-pc-rdos exit ;; + i*86:AROS:*:*) + echo ${UNAME_MACHINE}-pc-aros + exit ;; + x86_64:VMkernel:*:*) + echo ${UNAME_MACHINE}-unknown-esx + exit ;; esac -#echo '(No uname command or uname output not recognized.)' 1>&2 -#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 - eval $set_cc_for_build cat >$dummy.c <<EOF #ifdef _SEQUENT_ @@ -1339,11 +1354,11 @@ main () #include <sys/param.h> printf ("m68k-sony-newsos%s\n", #ifdef NEWSOS4 - "4" + "4" #else - "" + "" #endif - ); exit (0); + ); exit (0); #endif #endif @@ -1477,9 +1492,9 @@ This script, last modified $timestamp, has failed to recognize the operating system you are using. It is advised that you download the most up to date version of the config scripts from - http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.guess + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD and - http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.sub + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD If the version you run ($0) is already up to date, please send the following data and any information you think might be diff --git a/lib/common_test/priv/auxdir/config.sub b/lib/common_test/priv/auxdir/config.sub index f43233b104..bb6edbdb47 100755 --- a/lib/common_test/priv/auxdir/config.sub +++ b/lib/common_test/priv/auxdir/config.sub @@ -1,44 +1,40 @@ #! /bin/sh # Configuration validation subroutine script. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, -# Inc. +# Copyright 1992-2013 Free Software Foundation, Inc. -timestamp='2007-04-29' +timestamp='2013-02-12' -# This file is (in principle) common to ALL GNU software. -# The presence of a machine in this file suggests that SOME GNU software -# can handle that machine. It does not imply ALL GNU software can. -# -# This file is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or +# This file is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. +# along with this program; if not, see <http://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). -# Please send patches to <[email protected]>. Submit a context -# diff and a properly formatted ChangeLog entry. +# Please send patches with a ChangeLog entry to [email protected]. # # Configuration subroutine to validate and canonicalize a configuration type. # Supply the specified configuration type as an argument. # If it is invalid, we print an error message on stderr and exit with code 1. # Otherwise, we print the canonical config type on stdout and succeed. +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD + # This file is supposed to be the same for all GNU packages # and recognize all the CPU types, system types and aliases # that are meaningful with *any* GNU software. @@ -72,8 +68,7 @@ Report bugs and patches to <[email protected]>." version="\ GNU config.sub ($timestamp) -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 -Free Software Foundation, Inc. +Copyright 1992-2013 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -120,12 +115,18 @@ esac # Here we must recognize all the valid KERNEL-OS combinations. maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` case $maybe_os in - nto-qnx* | linux-gnu* | linux-dietlibc | linux-newlib* | linux-uclibc* | \ - uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* | \ + nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \ + linux-musl* | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \ + knetbsd*-gnu* | netbsd*-gnu* | \ + kopensolaris*-gnu* | \ storm-chaos* | os2-emx* | rtmk-nova*) os=-$maybe_os basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` ;; + android-linux) + os=-linux-android + basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-unknown + ;; *) basic_machine=`echo $1 | sed 's/-[^-]*$//'` if [ $basic_machine != $1 ] @@ -148,10 +149,13 @@ case $os in -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ - -apple | -axis | -knuth | -cray) + -apple | -axis | -knuth | -cray | -microblaze*) os= basic_machine=$1 ;; + -bluegene*) + os=-cnk + ;; -sim | -cisco | -oki | -wec | -winbond) os= basic_machine=$1 @@ -166,10 +170,10 @@ case $os in os=-chorusos basic_machine=$1 ;; - -chorusrdb) - os=-chorusrdb + -chorusrdb) + os=-chorusrdb basic_machine=$1 - ;; + ;; -hiux*) os=-hiuxwe2 ;; @@ -214,6 +218,12 @@ case $os in -isc*) basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; + -lynx*178) + os=-lynxos178 + ;; + -lynx*5) + os=-lynxos5 + ;; -lynx*) os=-lynxos ;; @@ -238,24 +248,34 @@ case $basic_machine in # Some are omitted here because they have special meanings below. 1750a | 580 \ | a29k \ + | aarch64 | aarch64_be \ | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ | am33_2.0 \ - | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr | avr32 \ + | arc \ + | arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv7[arm] \ + | avr | avr32 \ + | be32 | be64 \ | bfin \ | c4x | clipper \ | d10v | d30v | dlx | dsp16xx \ + | epiphany \ | fido | fr30 | frv \ | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ + | hexagon \ | i370 | i860 | i960 | ia64 \ | ip2k | iq2000 \ + | le32 | le64 \ + | lm32 \ | m32c | m32r | m32rle | m68000 | m68k | m88k \ - | maxq | mb | microblaze | mcore | mep \ + | maxq | mb | microblaze | microblazeel | mcore | mep | metag \ | mips | mipsbe | mipseb | mipsel | mipsle \ | mips16 \ | mips64 | mips64el \ - | mips64vr | mips64vrel \ + | mips64octeon | mips64octeonel \ | mips64orion | mips64orionel \ + | mips64r5900 | mips64r5900el \ + | mips64vr | mips64vrel \ | mips64vr4100 | mips64vr4100el \ | mips64vr4300 | mips64vr4300el \ | mips64vr5000 | mips64vr5000el \ @@ -266,31 +286,45 @@ case $basic_machine in | mipsisa64r2 | mipsisa64r2el \ | mipsisa64sb1 | mipsisa64sb1el \ | mipsisa64sr71k | mipsisa64sr71kel \ + | mipsr5900 | mipsr5900el \ | mipstx39 | mipstx39el \ | mn10200 | mn10300 \ + | moxie \ | mt \ | msp430 \ - | nios | nios2 \ + | nds32 | nds32le | nds32be \ + | nios | nios2 | nios2eb | nios2el \ | ns16k | ns32k \ - | or32 \ + | open8 \ + | or1k | or32 \ | pdp10 | pdp11 | pj | pjl \ - | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \ + | powerpc | powerpc64 | powerpc64le | powerpcle \ | pyramid \ + | rl78 | rx \ | score \ - | sh | sh[1234] | sh[24]a | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ + | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ | sh64 | sh64le \ | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ - | spu | strongarm \ - | tahoe | thumb | tic4x | tic80 | tron \ - | v850 | v850e \ + | spu \ + | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \ + | ubicom32 \ + | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \ | we32k \ - | x86 | xc16x | xscale | xscalee[bl] | xstormy16 | xtensa \ - | z8k) + | x86 | xc16x | xstormy16 | xtensa \ + | z8k | z80) basic_machine=$basic_machine-unknown ;; - m6811 | m68hc11 | m6812 | m68hc12) - # Motorola 68HC11/12. + c54x) + basic_machine=tic54x-unknown + ;; + c55x) + basic_machine=tic55x-unknown + ;; + c6x) + basic_machine=tic6x-unknown + ;; + m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | picochip) basic_machine=$basic_machine-unknown os=-none ;; @@ -300,6 +334,21 @@ case $basic_machine in basic_machine=mt-unknown ;; + strongarm | thumb | xscale) + basic_machine=arm-unknown + ;; + xgate) + basic_machine=$basic_machine-unknown + os=-none + ;; + xscaleeb) + basic_machine=armeb-unknown + ;; + + xscaleel) + basic_machine=armel-unknown + ;; + # We use `pc' rather than `unknown' # because (1) that's what they normally are, and # (2) the word "unknown" tends to confuse beginning users. @@ -314,29 +363,37 @@ case $basic_machine in # Recognize the basic CPU types with company name. 580-* \ | a29k-* \ + | aarch64-* | aarch64_be-* \ | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \ | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ | avr-* | avr32-* \ + | be32-* | be64-* \ | bfin-* | bs2000-* \ - | c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \ + | c[123]* | c30-* | [cjt]90-* | c4x-* \ | clipper-* | craynv-* | cydra-* \ | d10v-* | d30v-* | dlx-* \ | elxsi-* \ | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \ | h8300-* | h8500-* \ | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ + | hexagon-* \ | i*86-* | i860-* | i960-* | ia64-* \ | ip2k-* | iq2000-* \ + | le32-* | le64-* \ + | lm32-* \ | m32c-* | m32r-* | m32rle-* \ | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ - | m88110-* | m88k-* | maxq-* | mcore-* \ + | m88110-* | m88k-* | maxq-* | mcore-* | metag-* \ + | microblaze-* | microblazeel-* \ | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ | mips16-* \ | mips64-* | mips64el-* \ - | mips64vr-* | mips64vrel-* \ + | mips64octeon-* | mips64octeonel-* \ | mips64orion-* | mips64orionel-* \ + | mips64r5900-* | mips64r5900el-* \ + | mips64vr-* | mips64vrel-* \ | mips64vr4100-* | mips64vr4100el-* \ | mips64vr4300-* | mips64vr4300el-* \ | mips64vr5000-* | mips64vr5000el-* \ @@ -347,31 +404,41 @@ case $basic_machine in | mipsisa64r2-* | mipsisa64r2el-* \ | mipsisa64sb1-* | mipsisa64sb1el-* \ | mipsisa64sr71k-* | mipsisa64sr71kel-* \ + | mipsr5900-* | mipsr5900el-* \ | mipstx39-* | mipstx39el-* \ | mmix-* \ | mt-* \ | msp430-* \ - | nios-* | nios2-* \ + | nds32-* | nds32le-* | nds32be-* \ + | nios-* | nios2-* | nios2eb-* | nios2el-* \ | none-* | np1-* | ns16k-* | ns32k-* \ + | open8-* \ | orion-* \ | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ - | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \ + | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \ | pyramid-* \ - | romp-* | rs6000-* \ - | sh-* | sh[1234]-* | sh[24]a-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ + | rl78-* | romp-* | rs6000-* | rx-* \ + | sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ | sparclite-* \ - | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | strongarm-* | sv1-* | sx?-* \ - | tahoe-* | thumb-* \ + | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx?-* \ + | tahoe-* \ | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ + | tile*-* \ | tron-* \ - | v850-* | v850e-* | vax-* \ + | ubicom32-* \ + | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \ + | vax-* \ | we32k-* \ - | x86-* | x86_64-* | xc16x-* | xps100-* | xscale-* | xscalee[bl]-* \ - | xstormy16-* | xtensa-* \ + | x86-* | x86_64-* | xc16x-* | xps100-* \ + | xstormy16-* | xtensa*-* \ | ymp-* \ - | z8k-*) + | z8k-* | z80-*) + ;; + # Recognize the basic CPU types without company name, with glob match. + xtensa*) + basic_machine=$basic_machine-unknown ;; # Recognize the various machine names and aliases which stand # for a CPU type and a company and sometimes even an OS. @@ -389,7 +456,7 @@ case $basic_machine in basic_machine=a29k-amd os=-udi ;; - abacus) + abacus) basic_machine=abacus-unknown ;; adobe68k) @@ -435,6 +502,10 @@ case $basic_machine in basic_machine=m68k-apollo os=-bsd ;; + aros) + basic_machine=i386-pc + os=-aros + ;; aux) basic_machine=m68k-apple os=-aux @@ -443,10 +514,35 @@ case $basic_machine in basic_machine=ns32k-sequent os=-dynix ;; + blackfin) + basic_machine=bfin-unknown + os=-linux + ;; + blackfin-*) + basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; + bluegene*) + basic_machine=powerpc-ibm + os=-cnk + ;; + c54x-*) + basic_machine=tic54x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c55x-*) + basic_machine=tic55x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c6x-*) + basic_machine=tic6x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; c90) basic_machine=c90-cray os=-unicos ;; + cegcc) + basic_machine=arm-unknown + os=-cegcc + ;; convex-c1) basic_machine=c1-convex os=-bsd @@ -475,8 +571,8 @@ case $basic_machine in basic_machine=craynv-cray os=-unicosmp ;; - cr16c) - basic_machine=cr16c-unknown + cr16 | cr16-*) + basic_machine=cr16-unknown os=-elf ;; crds | unos) @@ -514,6 +610,10 @@ case $basic_machine in basic_machine=m88k-motorola os=-sysv3 ;; + dicos) + basic_machine=i686-pc + os=-dicos + ;; djgpp) basic_machine=i586-pc os=-msdosdjgpp @@ -629,7 +729,6 @@ case $basic_machine in i370-ibm* | ibm*) basic_machine=i370-ibm ;; -# I'm not sure what "Sysv32" means. Should this be sysv3.2? i*86v32) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv32 @@ -668,6 +767,14 @@ case $basic_machine in basic_machine=m68k-isi os=-sysv ;; + m68knommu) + basic_machine=m68k-unknown + os=-linux + ;; + m68knommu-*) + basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; m88k-omron*) basic_machine=m88k-omron ;; @@ -679,6 +786,13 @@ case $basic_machine in basic_machine=ns32k-utek os=-sysv ;; + microblaze*) + basic_machine=microblaze-xilinx + ;; + mingw64) + basic_machine=x86_64-pc + os=-mingw64 + ;; mingw32) basic_machine=i386-pc os=-mingw32 @@ -715,10 +829,18 @@ case $basic_machine in ms1-*) basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` ;; + msys) + basic_machine=i386-pc + os=-msys + ;; mvs) basic_machine=i370-ibm os=-mvs ;; + nacl) + basic_machine=le32-unknown + os=-nacl + ;; ncr3000) basic_machine=i486-ncr os=-sysv4 @@ -783,6 +905,12 @@ case $basic_machine in np1) basic_machine=np1-gould ;; + neo-tandem) + basic_machine=neo-tandem + ;; + nse-tandem) + basic_machine=nse-tandem + ;; nsr-tandem) basic_machine=nsr-tandem ;; @@ -813,6 +941,14 @@ case $basic_machine in basic_machine=i860-intel os=-osf ;; + parisc) + basic_machine=hppa-unknown + os=-linux + ;; + parisc-*) + basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; pbd) basic_machine=sparc-tti ;; @@ -857,9 +993,10 @@ case $basic_machine in ;; power) basic_machine=power-ibm ;; - ppc) basic_machine=powerpc-unknown + ppc | ppcbe) basic_machine=powerpc-unknown ;; - ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` + ppc-* | ppcbe-*) + basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppcle | powerpclittle | ppc-le | powerpc-little) basic_machine=powerpcle-unknown @@ -884,7 +1021,11 @@ case $basic_machine in basic_machine=i586-unknown os=-pw32 ;; - rdos) + rdos | rdos64) + basic_machine=x86_64-pc + os=-rdos + ;; + rdos32) basic_machine=i386-pc os=-rdos ;; @@ -953,6 +1094,9 @@ case $basic_machine in basic_machine=i860-stratus os=-sysv4 ;; + strongarm-* | thumb-*) + basic_machine=arm-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; sun2) basic_machine=m68000-sun ;; @@ -1009,17 +1153,9 @@ case $basic_machine in basic_machine=t90-cray os=-unicos ;; - tic54x | c54x*) - basic_machine=tic54x-unknown - os=-coff - ;; - tic55x | c55x*) - basic_machine=tic55x-unknown - os=-coff - ;; - tic6x | c6x*) - basic_machine=tic6x-unknown - os=-coff + tile*) + basic_machine=$basic_machine-unknown + os=-linux-gnu ;; tx39) basic_machine=mipstx39-unknown @@ -1027,10 +1163,6 @@ case $basic_machine in tx39el) basic_machine=mipstx39el-unknown ;; - tile*) - basic_machine=tile-tilera - os=-linux-gnu - ;; toad1) basic_machine=pdp10-xkl os=-tops20 @@ -1092,6 +1224,9 @@ case $basic_machine in xps | xps100) basic_machine=xps100-honeywell ;; + xscale-* | xscalee[bl]-*) + basic_machine=`echo $basic_machine | sed 's/^xscale/arm/'` + ;; ymp) basic_machine=ymp-cray os=-unicos @@ -1100,6 +1235,10 @@ case $basic_machine in basic_machine=z8k-unknown os=-sim ;; + z80-*-coff) + basic_machine=z80-unknown + os=-sim + ;; none) basic_machine=none-none os=-none @@ -1138,7 +1277,7 @@ case $basic_machine in we32k) basic_machine=we32k-att ;; - sh[1234] | sh[24]a | sh[34]eb | sh[1234]le | sh[23]ele) + sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele) basic_machine=sh-unknown ;; sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v) @@ -1185,9 +1324,12 @@ esac if [ x"$os" != x"" ] then case $os in - # First match some system type aliases - # that might get confused with valid system types. + # First match some system type aliases + # that might get confused with valid system types. # -solaris* is a basic system type, with this one exception. + -auroraux) + os=-auroraux + ;; -solaris1 | -solaris1.*) os=`echo $os | sed -e 's|solaris1|sunos4|'` ;; @@ -1208,21 +1350,23 @@ case $os in # Each alternative MUST END IN A *, to match a version number. # -sysv* is not here because it comes later, after sysvr4. -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ - | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\ - | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ + | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\ + | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \ + | -sym* | -kopensolaris* | -plan9* \ | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ - | -aos* \ + | -aos* | -aros* \ | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ - | -openbsd* | -solidbsd* \ + | -bitrig* | -openbsd* | -solidbsd* \ | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ - | -chorusos* | -chorusrdb* \ - | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ - | -mingw32* | -linux-gnu* | -linux-newlib* | -linux-uclibc* \ + | -chorusos* | -chorusrdb* | -cegcc* \ + | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ + | -mingw32* | -mingw64* | -linux-gnu* | -linux-android* \ + | -linux-newlib* | -linux-musl* | -linux-uclibc* \ | -uxpv* | -beos* | -mpeix* | -udk* \ | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ @@ -1230,7 +1374,7 @@ case $os in | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ - | -skyos* | -haiku* | -rdos* | -toppers* | -drops*) + | -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es*) # Remember, each alternative MUST END IN *, to match a version number. ;; -qnx*) @@ -1269,7 +1413,7 @@ case $os in -opened*) os=-openedition ;; - -os400*) + -os400*) os=-os400 ;; -wince*) @@ -1318,7 +1462,7 @@ case $os in -sinix*) os=-sysv4 ;; - -tpf*) + -tpf*) os=-tpf ;; -triton*) @@ -1354,12 +1498,14 @@ case $os in -aros*) os=-aros ;; - -kaos*) - os=-kaos - ;; -zvmoe) os=-zvmoe ;; + -dicos*) + os=-dicos + ;; + -nacl*) + ;; -none) ;; *) @@ -1382,10 +1528,10 @@ else # system, and we'll never get to this point. case $basic_machine in - score-*) + score-*) os=-elf ;; - spu-*) + spu-*) os=-elf ;; *-acorn) @@ -1397,8 +1543,20 @@ case $basic_machine in arm*-semi) os=-aout ;; - c4x-* | tic4x-*) - os=-coff + c4x-* | tic4x-*) + os=-coff + ;; + hexagon-*) + os=-elf + ;; + tic54x-*) + os=-coff + ;; + tic55x-*) + os=-coff + ;; + tic6x-*) + os=-coff ;; # This must come before the *-dec entry. pdp10-*) @@ -1418,14 +1576,11 @@ case $basic_machine in ;; m68000-sun) os=-sunos3 - # This also exists in the configure program, but was not the - # default. - # os=-sunos4 ;; m68*-cisco) os=-aout ;; - mep-*) + mep-*) os=-elf ;; mips*-cisco) @@ -1434,6 +1589,9 @@ case $basic_machine in mips*-*) os=-elf ;; + or1k-*) + os=-elf + ;; or32-*) os=-coff ;; @@ -1452,7 +1610,7 @@ case $basic_machine in *-ibm) os=-aix ;; - *-knuth) + *-knuth) os=-mmixware ;; *-wec) @@ -1557,7 +1715,7 @@ case $basic_machine in -sunos*) vendor=sun ;; - -aix*) + -cnk*|-aix*) vendor=ibm ;; -beos*) @@ -1628,3 +1786,4 @@ exit # time-stamp-format: "%:y-%02m-%02d" # time-stamp-end: "'" # End: + diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl index 5924930072..0b204a681a 100644 --- a/lib/common_test/src/ct_logs.erl +++ b/lib/common_test/src/ct_logs.erl @@ -397,9 +397,9 @@ tc_print(Category,Format,Args) -> %%% <p>This function is called by <code>ct</code> when printing %%% stuff from a testcase on the user console.</p> tc_print(Category,Importance,Format,Args) -> - VLvl = case ct_util:get_testdata({verbosity,Category}) of + VLvl = case ct_util:get_verbosity(Category) of undefined -> - ct_util:get_testdata({verbosity,'$unspecified'}); + ct_util:get_verbosity('$unspecified'); {error,bad_invocation} -> ?MAX_VERBOSITY; Val -> @@ -1475,8 +1475,9 @@ count_cases(Dir) -> write_summary(SumFile, Summary), Summary end; - {error, _Reason} -> - io:format("\nFailed to read ~p (skipped)\n", [LogFile]), + {error, Reason} -> + io:format("\nFailed to read ~p: ~p (skipped)\n", + [LogFile,Reason]), error end end. diff --git a/lib/common_test/src/ct_master.erl b/lib/common_test/src/ct_master.erl index e516f635d2..b42ff73846 100644 --- a/lib/common_test/src/ct_master.erl +++ b/lib/common_test/src/ct_master.erl @@ -428,7 +428,7 @@ master_loop(#state{node_ctrl_pids=[], log(all,"TEST RESULTS",Str,[]), log(all,"Info","Updating log files",[]), refresh_logs(LogDirs,[]), - + ct_master_event:stop(), ct_master_logs:stop(), ok; diff --git a/lib/common_test/src/ct_master_event.erl b/lib/common_test/src/ct_master_event.erl index 5877b7c6f2..fd97ab16f7 100644 --- a/lib/common_test/src/ct_master_event.erl +++ b/lib/common_test/src/ct_master_event.erl @@ -66,16 +66,30 @@ add_handler(Args) -> %% Description: Stops the event manager %%-------------------------------------------------------------------- stop() -> - flush(), - gen_event:stop(?CT_MEVMGR_REF). + case flush() of + {error,Reason} -> + ct_master_logs:log("Error", + "No response from CT Master Event.\n" + "Reason = ~p\n" + "Terminating now!\n",[Reason]), + %% communication with event manager fails, kill it + catch exit(whereis(?CT_MEVMGR_REF), kill); + _ -> + gen_event:stop(?CT_MEVMGR_REF) + end. flush() -> - case gen_event:call(?CT_MEVMGR_REF,?MODULE,flush) of + try gen_event:call(?CT_MEVMGR_REF,?MODULE,flush,1800000) of flushing -> timer:sleep(1), flush(); done -> - ok + ok; + Error = {error,_} -> + Error + catch + _:Reason -> + {error,Reason} end. %%-------------------------------------------------------------------- diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index c0bdbb2a09..49f00429ae 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -2291,8 +2291,12 @@ add_jobs([{TestDir,all,_}|Tests], Skip, Opts, CleanUp) -> {'EXIT',_} -> CleanUp; _ -> - wait_for_idle(), - add_jobs(Tests, Skip, Opts, CleanUp) + case wait_for_idle() of + ok -> + add_jobs(Tests, Skip, Opts, CleanUp); + _ -> + CleanUp + end end; add_jobs([{TestDir,[Suite],all}|Tests], Skip, Opts, CleanUp) when is_atom(Suite) -> @@ -2305,8 +2309,12 @@ add_jobs([{TestDir,Suites,all}|Tests], Skip, {'EXIT',_} -> CleanUp; _ -> - wait_for_idle(), - add_jobs(Tests, Skip, Opts, CleanUp) + case wait_for_idle() of + ok -> + add_jobs(Tests, Skip, Opts, CleanUp); + _ -> + CleanUp + end end; add_jobs([{TestDir,Suite,all}|Tests], Skip, Opts, CleanUp) -> case maybe_interpret(Suite, all, Opts) of @@ -2318,8 +2326,12 @@ add_jobs([{TestDir,Suite,all}|Tests], Skip, Opts, CleanUp) -> {'EXIT',_} -> CleanUp; _ -> - wait_for_idle(), - add_jobs(Tests, Skip, Opts, [Suite|CleanUp]) + case wait_for_idle() of + ok -> + add_jobs(Tests, Skip, Opts, [Suite|CleanUp]); + _ -> + CleanUp + end end; Error -> Error @@ -2358,8 +2370,12 @@ add_jobs([{TestDir,Suite,Confs}|Tests], Skip, Opts, CleanUp) when {'EXIT',_} -> CleanUp; _ -> - wait_for_idle(), - add_jobs(Tests, Skip, Opts, [Suite|CleanUp]) + case wait_for_idle() of + ok -> + add_jobs(Tests, Skip, Opts, [Suite|CleanUp]); + _ -> + CleanUp + end end; Error -> Error @@ -2384,8 +2400,12 @@ add_jobs([{TestDir,Suite,Cases}|Tests], {'EXIT',_} -> CleanUp; _ -> - wait_for_idle(), - add_jobs(Tests, Skip, Opts, [Suite|CleanUp]) + case wait_for_idle() of + ok -> + add_jobs(Tests, Skip, Opts, [Suite|CleanUp]); + _ -> + CleanUp + end end; Error -> Error @@ -2401,8 +2421,12 @@ add_jobs([{TestDir,Suite,Case}|Tests], Skip, Opts, CleanUp) when is_atom(Case) - {'EXIT',_} -> CleanUp; _ -> - wait_for_idle(), - add_jobs(Tests, Skip, Opts, [Suite|CleanUp]) + case wait_for_idle() of + ok -> + add_jobs(Tests, Skip, Opts, [Suite|CleanUp]); + _ -> + CleanUp + end end; Error -> Error @@ -2412,7 +2436,13 @@ add_jobs([], _, _, CleanUp) -> wait_for_idle() -> ct_util:update_last_run_index(), - Notify = fun(Me) -> Me ! idle end, + Notify = fun(Me,IdleState) -> Me ! {idle,IdleState}, + receive + {Me,proceed} -> ok + after + 30000 -> ok + end + end, case catch test_server_ctrl:idle_notify(Notify) of {'EXIT',_} -> error; @@ -2420,11 +2450,14 @@ wait_for_idle() -> %% so we don't hang forever if test_server dies Ref = erlang:monitor(process, TSPid), Result = receive - idle -> ok; + {idle,abort} -> aborted; + {idle,_} -> ok; {'DOWN', Ref, _, _, _} -> error end, erlang:demonitor(Ref, [flush]), ct_util:update_last_run_index(), + %% let test_server_ctrl proceed (and possibly shut down) now + TSPid ! {self(),proceed}, Result end. @@ -2921,11 +2954,11 @@ opts2args(EnvStartOpts) -> [{event_handler_init,[atom_to_list(EH),ArgStr]}]; ({event_handler,{EHs,Arg}}) when is_list(EHs) -> ArgStr = lists:flatten(io_lib:format("~p", [Arg])), - Strs = lists:map(fun(EH) -> - [atom_to_list(EH), - ArgStr,"and"] - end, EHs), - [_LastAnd|StrsR] = lists:reverse(lists:flatten(Strs)), + Strs = lists:flatmap(fun(EH) -> + [atom_to_list(EH), + ArgStr,"and"] + end, EHs), + [_LastAnd | StrsR] = lists:reverse(Strs), [{event_handler_init,lists:reverse(StrsR)}]; ({logopts,LOs}) when is_list(LOs) -> [{logopts,[atom_to_list(LO) || LO <- LOs]}]; diff --git a/lib/common_test/src/ct_testspec.erl b/lib/common_test/src/ct_testspec.erl index e341391a91..71b03c0ea6 100644 --- a/lib/common_test/src/ct_testspec.erl +++ b/lib/common_test/src/ct_testspec.erl @@ -1020,17 +1020,6 @@ add_tests([],Spec) -> % done %% check if it's a CT term that has bad format or if the user seems to %% have added something of his/her own, which we'll let pass if relaxed %% mode is enabled. -check_term(Atom) when is_atom(Atom) -> - Valid = valid_terms(), - case lists:member(Atom,Valid) of - true -> - valid; - false -> % ignore - case get(relaxed) of - true -> invalid; - false -> throw({error,{undefined_term_in_spec,Atom}}) - end - end; check_term(Term) when is_tuple(Term) -> Size = size(Term), [Name|_] = tuple_to_list(Term), @@ -1059,9 +1048,7 @@ check_term(Term) when is_tuple(Term) -> throw({error,{undefined_term_in_spec,Term}}) end end - end; -check_term(Other) -> - throw({error,{undefined_term_in_spec,Other}}). + end. %% specific data handling before saving in testspec record, e.g. %% converting relative paths to absolute for directories and files diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl index 0f2b2081d9..2e7e731595 100644 --- a/lib/common_test/src/ct_util.erl +++ b/lib/common_test/src/ct_util.erl @@ -39,7 +39,8 @@ delete_suite_data/0, delete_suite_data/1, match_delete_suite_data/1, delete_testdata/0, delete_testdata/1, set_testdata/1, get_testdata/1, get_testdata/2, - set_testdata_async/1, update_testdata/2, update_testdata/3]). + set_testdata_async/1, update_testdata/2, update_testdata/3, + set_verbosity/1, get_verbosity/1]). -export([override_silence_all_connections/0, override_silence_connections/1, get_overridden_silenced_connections/0, @@ -128,6 +129,10 @@ do_start(Parent, Mode, LogDir, Verbosity) -> create_table(?conn_table,#conn.handle), create_table(?board_table,2), create_table(?suite_table,#suite_data.key), + + create_table(?verbosity_table,1), + [ets:insert(?verbosity_table,{Cat,Lvl}) || {Cat,Lvl} <- Verbosity], + {ok,StartDir} = file:get_cwd(), case file:set_cwd(LogDir) of ok -> ok; @@ -202,7 +207,7 @@ do_start(Parent, Mode, LogDir, Verbosity) -> self() ! {{stop,{self(),{user_error,CTHReason}}}, {Parent,make_ref()}} end, - loop(Mode, [{{verbosity,Cat},Lvl} || {Cat,Lvl} <- Verbosity], StartDir). + loop(Mode, [], StartDir). create_table(TableName,KeyPos) -> create_table(TableName,set,KeyPos). @@ -278,6 +283,19 @@ reset_cwd() -> get_start_dir() -> call(get_start_dir). +%% handle verbosity outside ct_util_server (let the client read +%% the verbosity table) to avoid possible deadlock situations +set_verbosity(Elem = {_Category,_Level}) -> + ets:insert(?verbosity_table, Elem), + ok. +get_verbosity(Category) -> + case ets:lookup(?verbosity_table, Category) of + [{Category,Level}] -> + Level; + _ -> + undefined + end. + loop(Mode,TestData,StartDir) -> receive {update_last_run_index,From} -> @@ -377,6 +395,7 @@ loop(Mode,TestData,StartDir) -> ets:delete(?conn_table), ets:delete(?board_table), ets:delete(?suite_table), + ets:delete(?verbosity_table), ct_logs:close(Info, StartDir), ct_event:stop(), ct_config:stop(), diff --git a/lib/common_test/src/ct_util.hrl b/lib/common_test/src/ct_util.hrl index c9c6514fa4..7c2e31f40c 100644 --- a/lib/common_test/src/ct_util.hrl +++ b/lib/common_test/src/ct_util.hrl @@ -21,6 +21,7 @@ -define(conn_table,ct_connections). -define(board_table,ct_boards). -define(suite_table,ct_suite_data). +-define(verbosity_table,ct_verbosity_table). -record(conn, {handle, targetref, diff --git a/lib/common_test/test/ct_test_support.erl b/lib/common_test/test/ct_test_support.erl index 7c33fd404d..5e109e98e9 100644 --- a/lib/common_test/test/ct_test_support.erl +++ b/lib/common_test/test/ct_test_support.erl @@ -312,8 +312,10 @@ wait_for_ct_stop(Retries, CTNode) -> undefined -> true; Pid -> + Info = (catch process_info(Pid)), test_server:format(0, "Waiting for CT (~p) to finish (~p)...", [Pid,Retries]), + test_server:format(0, "Process info for ~p:~n~p", [Info]), timer:sleep(5000), wait_for_ct_stop(Retries-1, CTNode) end. @@ -328,12 +330,17 @@ handle_event(EH, Event) -> start_event_receiver(Config) -> CTNode = proplists:get_value(ct_node, Config), - spawn_link(CTNode, fun() -> er() end). + Level = proplists:get_value(trace_level, Config), + ER = spawn_link(CTNode, fun() -> er() end), + test_server:format(Level, "~nEvent receiver ~w started!~n", [ER]), + ER. get_events(_, Config) -> CTNode = proplists:get_value(ct_node, Config), + Level = proplists:get_value(trace_level, Config), {event_receiver,CTNode} ! {self(),get_events}, Events = receive {event_receiver,Evs} -> Evs end, + test_server:format(Level, "Stopping event receiver!~n", []), {event_receiver,CTNode} ! stop, Events. diff --git a/lib/common_test/test/ct_verbosity_SUITE.erl b/lib/common_test/test/ct_verbosity_SUITE.erl index 349319de94..ff4c05ce3a 100644 --- a/lib/common_test/test/ct_verbosity_SUITE.erl +++ b/lib/common_test/test/ct_verbosity_SUITE.erl @@ -44,8 +44,11 @@ %% there will be clashes with logging processes etc). %%-------------------------------------------------------------------- init_per_suite(Config) -> - Config1 = ct_test_support:init_per_suite(Config), - Config1. + DataDir = ?config(data_dir, Config), + EvH = filename:join(DataDir,"simple_evh.erl"), + ct:pal("Compiling ~s: ~p", [EvH,compile:file(EvH,[{outdir,DataDir}, + debug_info])]), + ct_test_support:init_per_suite([{path_dirs,[DataDir]} | Config]). end_per_suite(Config) -> ct_test_support:end_per_suite(Config). @@ -56,7 +59,8 @@ init_per_testcase(TestCase, Config) -> end_per_testcase(TestCase, Config) -> ct_test_support:end_per_testcase(TestCase, Config). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> [{timetrap,{minutes,2}}, + {ct_hooks,[ts_install_cth]}]. all() -> [ @@ -67,7 +71,8 @@ all() -> change_default, combine_categories, testspec_only, - merge_with_testspec + merge_with_testspec, + possible_deadlock ]. %%-------------------------------------------------------------------- @@ -173,6 +178,17 @@ merge_with_testspec(Config) -> ok = execute(TC, Opts, ERPid, Config). %%%----------------------------------------------------------------- +%%% +possible_deadlock(Config) -> + TC = possible_deadlock, + DataDir = ?config(data_dir, Config), + Suite = filename:join(DataDir, "io_test_SUITE"), + {Opts,ERPid} = setup([{suite,Suite},{label,TC}, + {event_handler,[simple_evh]}], Config), + ok = execute(TC, Opts, ERPid, Config). + + +%%%----------------------------------------------------------------- %%% HELP FUNCTIONS %%%----------------------------------------------------------------- @@ -180,7 +196,14 @@ setup(Test, Config) -> Opts0 = ct_test_support:get_opts(Config), Level = ?config(trace_level, Config), EvHArgs = [{cbm,ct_test_support},{trace_level,Level}], - Opts = Opts0 ++ [{event_handler,{?eh,EvHArgs}}|Test], + Opts = + case proplists:get_value(event_handler, Test) of + undefined -> + Opts0 ++ [{event_handler,{?eh,EvHArgs}} | Test]; + EvHs -> + Opts0 ++ [{event_handler,{[?eh|EvHs],EvHArgs}} | + proplists:delete(event_handler, Test)] + end, ERPid = ct_test_support:start_event_receiver(Config), {Opts,ERPid}. diff --git a/lib/common_test/test/ct_verbosity_SUITE_data/simple_evh.erl b/lib/common_test/test/ct_verbosity_SUITE_data/simple_evh.erl new file mode 100644 index 0000000000..b677e601fb --- /dev/null +++ b/lib/common_test/test/ct_verbosity_SUITE_data/simple_evh.erl @@ -0,0 +1,171 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2006-2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%%% @doc Common Test Framework Event Handler +%%% +%%% <p>This module implements an event handler that CT uses to +%%% handle status and progress notifications during test runs. +%%% The notifications are handled locally (per node) and passed +%%% on to ct_master when CT runs in distributed mode. This +%%% module may be used as a template for other event handlers +%%% that can be plugged in to handle local logging and reporting.</p> +-module(simple_evh). + +-behaviour(gen_event). + +%% gen_event callbacks +-export([init/1, handle_event/2, handle_call/2, + handle_info/2, terminate/2, code_change/3]). + +-include_lib("common_test/include/ct_event.hrl"). +-include_lib("common_test/src/ct_util.hrl"). + +%%==================================================================== +%% gen_event callbacks +%%==================================================================== +%%-------------------------------------------------------------------- +%% Function: init(Args) -> {ok, State} +%% Description: Whenever a new event handler is added to an event manager, +%% this function is called to initialize the event handler. +%%-------------------------------------------------------------------- +init(_) -> + io:format("Event handler ~w started!~n", [?MODULE]), + {ok,[]}. + +%%-------------------------------------------------------------------- +%% Function: +%% handle_event(Event, State) -> {ok, State} | +%% {swap_handler, Args1, State1, Mod2, Args2} | +%% remove_handler +%% Description:Whenever an event manager receives an event sent using +%% gen_event:notify/2 or gen_event:sync_notify/2, this function is called for +%% each installed event handler to handle the event. +%%-------------------------------------------------------------------- +handle_event(Event = #event{name = test_stats},State) -> + %% this could cause a deadlock + ct:pal("~p: ~p~n", [Event#event.name,Event#event.data]), + {ok,State}; +handle_event(_Event,State) -> + {ok,State}. + +%%============================== EVENTS ============================== +%% +%% Name = test_start +%% Data = {StartTime,LogDir} +%% +%% Name = start_info +%% Data = {Tests,Suites,Cases} +%% Tests = Suites = Cases = integer() +%% +%% Name = test_done +%% Data = EndTime +%% +%% Name = start_make +%% Data = Dir +%% +%% Name = finished_make +%% Data = Dir +%% +%% Name = tc_start +%% Data = {Suite,CaseOrGroup} +%% CaseOrGroup = atom() | {Conf,GroupName,GroupProperties} +%% Conf = init_per_group | end_per_group +%% GroupName = atom() +%% GroupProperties = list() +%% +%% Name = tc_done +%% Data = {Suite,CaseOrGroup,Result} +%% CaseOrGroup = atom() | {Conf,GroupName,GroupProperties} +%% Conf = init_per_group | end_per_group +%% GroupName = atom() +%% GroupProperties = list() +%% Result = ok | {skipped,Reason} | {failed,Reason} +%% +%% Name = tc_user_skip +%% Data = {Suite,Case,Comment} +%% Comment = string() +%% +%% Name = tc_auto_skip +%% Data = {Suite,Case,Comment} +%% Comment = string() +%% +%% Name = test_stats +%% Data = {Ok,Failed,Skipped} +%% Ok = Failed = integer() +%% Skipped = {UserSkipped,AutoSkipped} +%% UserSkipped = AutoSkipped = integer() +%% +%% Name = start_logging +%% Data = CtRunDir +%% +%% Name = stop_logging +%% Data = [] +%% +%% Name = start_write_file +%% Data = FullNameFile +%% +%% Name = finished_write_file +%% Data = FullNameFile +%% +%% Name = +%% Data = +%% + +%%-------------------------------------------------------------------- +%% Function: +%% handle_call(Request, State) -> {ok, Reply, State} | +%% {swap_handler, Reply, Args1, State1, +%% Mod2, Args2} | +%% {remove_handler, Reply} +%% Description: Whenever an event manager receives a request sent using +%% gen_event:call/3,4, this function is called for the specified event +%% handler to handle the request. +%%-------------------------------------------------------------------- +handle_call(_Req, State) -> + Reply = ok, + {ok, Reply, State}. + +%%-------------------------------------------------------------------- +%% Function: +%% handle_info(Info, State) -> {ok, State} | +%% {swap_handler, Args1, State1, Mod2, Args2} | +%% remove_handler +%% Description: This function is called for each installed event handler when +%% an event manager receives any other message than an event or a synchronous +%% request (or a system message). +%%-------------------------------------------------------------------- +handle_info(_Info, State) -> + {ok, State}. + +%%-------------------------------------------------------------------- +%% Function: terminate(Reason, State) -> void() +%% Description:Whenever an event handler is deleted from an event manager, +%% this function is called. It should be the opposite of Module:init/1 and +%% do any necessary cleaning up. +%%-------------------------------------------------------------------- +terminate(_Reason, _State) -> + ok. + +%%-------------------------------------------------------------------- +%% Function: code_change(OldVsn, State, Extra) -> {ok, NewState} +%% Description: Convert process state when code is changed +%%-------------------------------------------------------------------- +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl index 9ad2378d00..cc07f0b9bc 100644 --- a/lib/compiler/src/erl_bifs.erl +++ b/lib/compiler/src/erl_bifs.erl @@ -68,6 +68,8 @@ is_pure(erlang, atom_to_list, 1) -> true; is_pure(erlang, binary_part, 2) -> true; is_pure(erlang, binary_part, 3) -> true; is_pure(erlang, binary_to_atom, 2) -> true; +is_pure(erlang, binary_to_float, 1) -> true; +is_pure(erlang, binary_to_integer, 1) -> true; is_pure(erlang, binary_to_list, 1) -> true; is_pure(erlang, binary_to_list, 3) -> true; is_pure(erlang, bit_size, 1) -> true; @@ -75,8 +77,10 @@ is_pure(erlang, byte_size, 1) -> true; is_pure(erlang, element, 2) -> true; is_pure(erlang, float, 1) -> true; is_pure(erlang, float_to_list, 1) -> true; +is_pure(erlang, float_to_binary, 1) -> true; is_pure(erlang, hash, 2) -> false; is_pure(erlang, hd, 1) -> true; +is_pure(erlang, integer_to_binary, 1) -> true; is_pure(erlang, integer_to_list, 1) -> true; is_pure(erlang, is_atom, 1) -> true; is_pure(erlang, is_boolean, 1) -> true; diff --git a/lib/debugger/src/dbg_wx_trace.erl b/lib/debugger/src/dbg_wx_trace.erl index bd92cb4b42..eaea01822c 100644 --- a/lib/debugger/src/dbg_wx_trace.erl +++ b/lib/debugger/src/dbg_wx_trace.erl @@ -687,7 +687,7 @@ meta_cmd({trace_output, Str}, State) -> %% Reply on a user command meta_cmd({eval_rsp, Res}, State) -> - Str = io_lib:print(Res), + Str = io_lib_pretty:print(Res,[{encoding,unicode}]), dbg_wx_trace_win:eval_output(State#state.win, [$<,Str,10], normal), State. diff --git a/lib/debugger/src/dbg_wx_trace_win.erl b/lib/debugger/src/dbg_wx_trace_win.erl index 8b206ccd78..e54ce3913f 100644 --- a/lib/debugger/src/dbg_wx_trace_win.erl +++ b/lib/debugger/src/dbg_wx_trace_win.erl @@ -853,7 +853,7 @@ handle_event(#wx{id=?EVAL_ENTRY, event=#wxCommand{type=command_text_enter}}, handle_event(#wx{event=#wxList{type=command_list_item_selected, itemIndex=Row}},Wi) -> Bs = get(bindings), {Var,Val} = lists:nth(Row+1, Bs), - Str = io_lib:format("< ~s = ~p~n", [Var, Val]), + Str = io_lib:format("< ~s = ~lp~n", [Var, Val]), eval_output(Wi, Str, bold), ignore; handle_event(#wx{event=#wxList{type=command_list_item_activated, itemIndex=Row}},_Wi) -> diff --git a/lib/debugger/src/dbg_wx_win.erl b/lib/debugger/src/dbg_wx_win.erl index 3cb6edd953..eceacd7c88 100644 --- a/lib/debugger/src/dbg_wx_win.erl +++ b/lib/debugger/src/dbg_wx_win.erl @@ -254,7 +254,7 @@ notify(Win,Message) -> entry(Parent, Title, Prompt, {Type, Value}) -> Ted = wxTextEntryDialog:new(Parent, to_string(Prompt), [{caption, to_string(Title)}, - {value, to_string("~999999tp",Value)}]), + {value, to_string("~999999tp",[Value])}]), case wxDialog:showModal(Ted) of ?wxID_OK -> diff --git a/lib/dialyzer/doc/src/dialyzer.xml b/lib/dialyzer/doc/src/dialyzer.xml index 5e0c9b51e3..0ac96e8ac9 100644 --- a/lib/dialyzer/doc/src/dialyzer.xml +++ b/lib/dialyzer/doc/src/dialyzer.xml @@ -158,6 +158,9 @@ <item>Make Dialyzer a bit more quiet.</item> <tag><c><![CDATA[--verbose]]></c></tag> <item>Make Dialyzer a bit more verbose.</item> + <tag><c><![CDATA[--statistics]]></c></tag> + <item>Prints information about the progress of execution (analysis phases, + time spent in each and size of the relative input).</item> <tag><c><![CDATA[--build_plt]]></c></tag> <item>The analysis starts from an empty plt and creates a new one from the files specified with <c><![CDATA[-c]]></c> and @@ -228,6 +231,9 @@ match.</item> <tag><c><![CDATA[-Wno_opaque]]></c></tag> <item>Suppress warnings for violations of opaqueness of data types.</item> + <tag><c><![CDATA[-Wno_behaviours]]></c>***</tag> + <item>Suppress warnings about behaviour callbacks which drift from the + published recommended interfaces.</item> <tag><c><![CDATA[-Wunmatched_returns]]></c>***</tag> <item>Include warnings for function calls which ignore a structured return value or do not match against one of many possible return @@ -237,9 +243,6 @@ exception.</item> <tag><c><![CDATA[-Wrace_conditions]]></c>***</tag> <item>Include warnings for possible race conditions.</item> - <tag><c><![CDATA[-Wbehaviours]]></c>***</tag> - <item>Include warnings about behaviour callbacks which drift from the - published recommended interfaces.</item> <tag><c><![CDATA[-Wunderspecs]]></c>***</tag> <item>Warn about underspecified functions (the -spec is strictly more allowing than the success typing).</item> diff --git a/lib/dialyzer/src/dialyzer_behaviours.erl b/lib/dialyzer/src/dialyzer_behaviours.erl index 36aef2a37f..bf0d08cf8f 100644 --- a/lib/dialyzer/src/dialyzer_behaviours.erl +++ b/lib/dialyzer/src/dialyzer_behaviours.erl @@ -25,8 +25,6 @@ %%% %%% Created : 28 Oct 2009 by Stavros Aronis <[email protected]> %%%------------------------------------------------------------------- -%%% NOTE: This module is currently experimental -- do NOT rely on it! -%%%------------------------------------------------------------------- -module(dialyzer_behaviours). @@ -127,15 +125,12 @@ check_all_callbacks(Module, Behaviour, [Cb|Rest], erl_types:t_to_string(CbReturnType, Records)]}|Acc00] end end, - Acc02 = - case erl_types:any_none( - erl_types:t_inf_lists(ArgTypes, CbArgTypes)) of - false -> Acc01; - true -> - find_mismatching_args(type, ArgTypes, CbArgTypes, Behaviour, - Function, Arity, Records, 1, Acc01) - end, - Acc02 + case erl_types:any_none(erl_types:t_inf_lists(ArgTypes, CbArgTypes)) of + false -> Acc01; + true -> + find_mismatching_args(type, ArgTypes, CbArgTypes, Behaviour, + Function, Arity, Records, 1, Acc01) + end end, Acc2 = case dialyzer_codeserver:lookup_mfa_contract(CbMFA, Codeserver) of @@ -157,16 +152,14 @@ check_all_callbacks(Module, Behaviour, [Cb|Rest], erl_types:t_to_string(ExtraType, Records), erl_types:t_to_string(CbReturnType, Records)]}|Acc10] end, - Acc12 = - case erl_types:any_none( - erl_types:t_inf_lists(SpecArgTypes, CbArgTypes)) of - false -> Acc11; - true -> - find_mismatching_args({spec, File, Line}, SpecArgTypes, - CbArgTypes, Behaviour, Function, - Arity, Records, 1, Acc11) - end, - Acc12 + case erl_types:any_none( + erl_types:t_inf_lists(SpecArgTypes, CbArgTypes)) of + false -> Acc11; + true -> + find_mismatching_args({spec, File, Line}, SpecArgTypes, + CbArgTypes, Behaviour, Function, + Arity, Records, 1, Acc11) + end end, NewAcc = Acc2, check_all_callbacks(Module, Behaviour, Rest, State, NewAcc). diff --git a/lib/dialyzer/src/dialyzer_callgraph.erl b/lib/dialyzer/src/dialyzer_callgraph.erl index 64e0ee88af..9e9226fa5a 100644 --- a/lib/dialyzer/src/dialyzer_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_callgraph.erl @@ -798,10 +798,7 @@ condensation(G) -> fun({V1, V2}) -> I1 = ets:lookup_element(V2I, V1, 2), I2 = ets:lookup_element(V2I, V2, 2), - case I1 =:= I2 of - true -> true; - false -> ets:insert(I2I, {I1, I2}) - end + I1 =:= I2 orelse ets:insert(I2I, {I1, I2}) end, lists:foreach(Fun1, digraph:edges(G)), Fun3 = diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl index 6732d96b98..967aa989fb 100644 --- a/lib/dialyzer/src/dialyzer_cl.erl +++ b/lib/dialyzer/src/dialyzer_cl.erl @@ -488,6 +488,7 @@ expand_dependent_modules_1([Mod|Mods], Included, ModDeps) -> expand_dependent_modules_1([], Included, _ModDeps) -> Included. +-define(MIN_PARALLELISM, 7). -define(MIN_FILES_FOR_NATIVE_COMPILE, 20). -spec hipe_compile([file:filename()], #options{}) -> 'ok'. @@ -501,11 +502,14 @@ hipe_compile(Files, #options{erlang_mode = ErlangMode} = Options) -> case erlang:system_info(hipe_architecture) of undefined -> ok; _ -> - Mods = [lists, dict, gb_sets, gb_trees, ordsets, sets, + Mods = [lists, dict, digraph, digraph_utils, ets, + gb_sets, gb_trees, ordsets, sets, sofs, cerl, cerl_trees, erl_types, erl_bif_types, - dialyzer_analysis_callgraph, dialyzer_codeserver, - dialyzer_dataflow, dialyzer_dep, dialyzer_plt, - dialyzer_succ_typings, dialyzer_typesig], + dialyzer_analysis_callgraph, dialyzer, dialyzer_behaviours, + dialyzer_codeserver, dialyzer_contracts, + dialyzer_coordinator, dialyzer_dataflow, dialyzer_dep, + dialyzer_plt, dialyzer_succ_typings, dialyzer_typesig, + dialyzer_typesig, dialyzer_worker], report_native_comp(Options), {T1, _} = statistics(wall_clock), native_compile(Mods), @@ -515,12 +519,12 @@ hipe_compile(Files, #options{erlang_mode = ErlangMode} = Options) -> end. native_compile(Mods) -> - case erlang:system_info(schedulers) of - %% N when N > 1 -> - %% Parent = self(), - %% Pids = [spawn(fun () -> Parent ! {self(), hc(M)} end) || M <- Mods], - %% lists:foreach(fun (Pid) -> receive {Pid, Res} -> Res end end, Pids); - _ -> % 1 -> + case dialyzer_utils:parallelism() > ?MIN_PARALLELISM of + true -> + Parent = self(), + Pids = [spawn(fun () -> Parent ! {self(), hc(M)} end) || M <- Mods], + lists:foreach(fun (Pid) -> receive {Pid, Res} -> Res end end, Pids); + false -> lists:foreach(fun (Mod) -> hc(Mod) end, Mods) end. @@ -529,6 +533,7 @@ hc(Mod) -> case code:is_module_native(Mod) of true -> ok; false -> + %% io:format(" ~s", [Mod]), {ok, Mod} = hipe:c(Mod), ok end. diff --git a/lib/dialyzer/src/dialyzer_codeserver.erl b/lib/dialyzer/src/dialyzer_codeserver.erl index 9989118671..5109bf968a 100644 --- a/lib/dialyzer/src/dialyzer_codeserver.erl +++ b/lib/dialyzer/src/dialyzer_codeserver.erl @@ -100,10 +100,7 @@ ets_dict_to_dict(Table) -> ets:foldl(Fold, dict:new(), Table). ets_set_is_element(Key, Table) -> - case ets:lookup(Table, Key) of - [] -> false; - _ -> true - end. + ets:lookup(Table, Key) =/= []. ets_set_insert_set(Set, Table) -> ets_set_insert_list(sets:to_list(Set), Table). @@ -116,7 +113,7 @@ ets_set_to_set(Table) -> ets:foldl(Fold, sets:new(), Table). ets_read_concurrent_table(Name) -> - ets:new(Name,[{read_concurrency, true}]). + ets:new(Name, [{read_concurrency, true}]). %%-------------------------------------------------------------------- diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index 0df003a035..40d8936afa 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -1543,12 +1543,11 @@ get_bif_constr({erlang, '==', 2}, Dst, [Arg1, Arg2] = Args, _State) -> mk_constraint(Arg1, sub, ArgV1), mk_constraint(Arg2, sub, ArgV2)]); get_bif_constr({erlang, element, 2} = _BIF, Dst, Args, - #state{cs = Constrs} = State) -> + #state{cs = Constrs, opaques = Opaques}) -> GenType = erl_bif_types:type(erlang, element, 2), case t_is_none(GenType) of true -> ?debug("Bif: ~w failed\n", [_BIF]), throw(error); false -> - Opaques = State#state.opaques, Fun = fun(Map) -> [I, T] = ATs = lookup_type_list(Args, Map), ATs2 = case lists:member(T, Opaques) of @@ -2582,19 +2581,8 @@ enter_type(Key, Val, Map) when is_integer(Key) -> end end; enter_type(Key, Val, Map) -> - ?debug("Entering ~s :: ~s\n", [format_type(Key), format_type(Val)]), KeyName = t_var_name(Key), - case t_is_any(Val) of - true -> - erase_type(KeyName, Map); - false -> - LimitedVal = t_limit(Val, ?INTERNAL_TYPE_LIMIT), - case dict:find(KeyName, Map) of - {ok, LimitedVal} -> Map; - {ok, _} -> map_store(KeyName, LimitedVal, Map); - error -> map_store(KeyName, LimitedVal, Map) - end - end. + enter_type(KeyName, Val, Map). enter_type_lists([Key|KeyTail], [Val|ValTail], Map) -> Map1 = enter_type(Key, Val, Map), diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index 8046b48838..dc8e825199 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -219,15 +219,18 @@ get_record_and_type_info([], _Module, Records, RecDict) -> end. add_new_type(TypeOrOpaque, Name, TypeForm, ArgForms, Module, RecDict) -> - case erl_types:type_is_defined(TypeOrOpaque, Name, RecDict) of + Arity = length(ArgForms), + case erl_types:type_is_defined(TypeOrOpaque, Name, Arity, RecDict) of true -> - throw({error, flat_format("Type ~s already defined\n", [Name])}); + Msg = flat_format("Type ~s/~w already defined\n", [Name, Arity]), + throw({error, Msg}); false -> ArgTypes = [erl_types:t_from_form(X) || X <- ArgForms], case lists:all(fun erl_types:t_is_var/1, ArgTypes) of true -> ArgNames = [erl_types:t_var_name(X) || X <- ArgTypes], - dict:store({TypeOrOpaque, Name}, {Module, TypeForm, ArgNames}, RecDict); + dict:store({TypeOrOpaque, Name, Arity}, + {Module, TypeForm, ArgNames}, RecDict); false -> throw({error, flat_format("Type declaration for ~w does not " "have variables as parameters", [Name])}) diff --git a/lib/dialyzer/test/r9c_SUITE_data/results/inets b/lib/dialyzer/test/r9c_SUITE_data/results/inets index 629378d673..d377f34978 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/results/inets +++ b/lib/dialyzer/test/r9c_SUITE_data/results/inets @@ -1,5 +1,5 @@ -ftp.erl:1243: The pattern {'ok', {N, Bytes}} can never match the type 'eof' | {'error',atom()} | {'ok',binary() | string()} +ftp.erl:1243: The pattern {'ok', {N, Bytes}} can never match the type 'eof' | {'error',atom() | {'no_translation','unicode','latin1'}} | {'ok',binary() | string()} ftp.erl:640: The pattern {'closed', _Why} can never match the type 'perm_fname_not_allowed' | 'perm_neg_compl' | 'perm_no_space' | 'pos_compl' | 'pos_interm' | 'pos_interm_acct' | 'trans_neg_compl' | 'trans_no_space' | {'error' | 'perm_fname_not_allowed' | 'perm_neg_compl' | 'perm_no_space' | 'pos_compl' | 'pos_interm' | 'pos_interm_acct' | 'pos_prel' | 'trans_neg_compl' | 'trans_no_space',atom() | [any()] | {'invalid_server_response',[any(),...]}} http.erl:117: The pattern {'error', Reason} can never match the type #req_headers{connection::[45 | 97 | 101 | 105 | 107 | 108 | 112 | 118,...],content_length::[48,...],other::[{_,_}]} http.erl:138: Function close_session/2 will never be called @@ -34,7 +34,7 @@ mod_auth_plain.erl:100: The variable _ can never match since previous clauses co mod_auth_plain.erl:159: The variable _ can never match since previous clauses completely covered the type [[any()]] mod_auth_plain.erl:83: The variable O can never match since previous clauses completely covered the type [[any()]] mod_cgi.erl:372: The pattern {'http_response', NewAccResponse} can never match the type 'ok' -mod_dir.erl:101: The call lists:flatten(nonempty_improper_list(atom() | [any()] | char(),atom())) will never return since it differs in the 1st argument from the success typing arguments: ([any()]) +mod_dir.erl:101: The call lists:flatten(nonempty_improper_list(atom() | [any()] | char(),atom() | {'no_translation',binary()})) will never return since it differs in the 1st argument from the success typing arguments: ([any()]) mod_dir.erl:72: The pattern {'error', Reason} can never match the type {'ok',[[[any()] | char()],...]} mod_get.erl:135: The pattern <{'enfile', _}, _Info, Path> can never match the type <atom(),#mod{},atom() | binary() | [atom() | [any()] | char()]> mod_head.erl:80: The pattern <{'enfile', _}, _Info, Path> can never match the type <atom(),#mod{},atom() | binary() | [atom() | [any()] | char()]> diff --git a/lib/dialyzer/test/r9c_SUITE_data/results/mnesia b/lib/dialyzer/test/r9c_SUITE_data/results/mnesia index 1aac46f5b2..b73943422a 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/results/mnesia +++ b/lib/dialyzer/test/r9c_SUITE_data/results/mnesia @@ -20,8 +20,8 @@ mnesia_frag_hash.erl:24: Callback info about the mnesia_frag_hash behaviour is n mnesia_frag_old_hash.erl:23: Callback info about the mnesia_frag_hash behaviour is not available mnesia_index.erl:52: The call mnesia_lib:other_val(Var::{_,'commit_work' | 'index' | 'setorbag' | 'storage_type' | {'index',_}},_ReASoN_::any()) will never return since it differs in the 1st argument from the success typing arguments: ({_,'active_replicas' | 'where_to_read' | 'where_to_write'},any()) mnesia_lib.erl:1028: The pattern {'EXIT', Reason} can never match the type [any()] | {'error',_} -mnesia_lib.erl:957: The pattern {'ok', {0, _}} can never match the type 'eof' | {'error',atom()} | {'ok',binary() | string()} -mnesia_lib.erl:959: The pattern {'ok', {_, Bin}} can never match the type 'eof' | {'error',atom()} | {'ok',binary() | string()} +mnesia_lib.erl:957: The pattern {'ok', {0, _}} can never match the type 'eof' | {'error',atom() | {'no_translation','unicode','latin1'}} | {'ok',binary() | string()} +mnesia_lib.erl:959: The pattern {'ok', {_, Bin}} can never match the type 'eof' | {'error',atom() | {'no_translation','unicode','latin1'}} | {'ok',binary() | string()} mnesia_loader.erl:36: The call mnesia_lib:other_val(Var::{_,'access_mode' | 'cstruct' | 'db_nodes' | 'setorbag' | 'snmp' | 'storage_type'},Reason::any()) will never return since it differs in the 1st argument from the success typing arguments: ({_,'active_replicas' | 'where_to_read' | 'where_to_write'},any()) mnesia_locker.erl:1017: Function system_terminate/4 has no local return mnesia_log.erl:707: The test {'error',{[1..255,...],[any(),...]}} | {'ok',_} == atom() can never evaluate to 'true' diff --git a/lib/dialyzer/test/race_SUITE_data/results/extract_translations b/lib/dialyzer/test/race_SUITE_data/results/extract_translations index 62aa1aa511..295404bfed 100644 --- a/lib/dialyzer/test/race_SUITE_data/results/extract_translations +++ b/lib/dialyzer/test/race_SUITE_data/results/extract_translations @@ -1,5 +1,5 @@ -extract_translations.erl:140: The call ets:insert('files',{atom() | binary() | [atom() | [any()] | char()]}) might have an unintended effect due to a possible race condition caused by its combination with the ets:lookup('files',File::atom() | binary() | [atom() | [any()] | char()]) call in extract_translations.erl on line 135 +extract_translations.erl:140: The call ets:insert('files',{atom() | [atom() | [any()] | char()]}) might have an unintended effect due to a possible race condition caused by its combination with the ets:lookup('files',File::atom() | [atom() | [any()] | char()]) call in extract_translations.erl on line 135 extract_translations.erl:146: The call ets:insert('translations',{_,[]}) might have an unintended effect due to a possible race condition caused by its combination with the ets:lookup('translations',Str::any()) call in extract_translations.erl on line 126 -extract_translations.erl:152: The call ets:insert('files',{atom() | binary() | [atom() | [any()] | char()]}) might have an unintended effect due to a possible race condition caused by its combination with the ets:lookup('files',File::atom() | binary() | [atom() | [any()] | char()]) call in extract_translations.erl on line 148 +extract_translations.erl:152: The call ets:insert('files',{atom() | [atom() | [any()] | char()]}) might have an unintended effect due to a possible race condition caused by its combination with the ets:lookup('files',File::atom() | [atom() | [any()] | char()]) call in extract_translations.erl on line 148 extract_translations.erl:154: The call ets:insert('translations',{_,[]}) might have an unintended effect due to a possible race condition caused by its combination with the ets:lookup('translations',Str::any()) call in extract_translations.erl on line 126 diff --git a/lib/dialyzer/test/small_SUITE_data/results/flatten b/lib/dialyzer/test/small_SUITE_data/results/flatten index 8aa44dd002..0bd866770c 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/flatten +++ b/lib/dialyzer/test/small_SUITE_data/results/flatten @@ -1,2 +1,2 @@ -flatten.erl:17: The call lists:flatten(nonempty_improper_list(atom() | [any()] | char(),atom())) will never return since it differs in the 1st argument from the success typing arguments: ([any()]) +flatten.erl:17: The call lists:flatten(nonempty_improper_list(atom() | [any()] | char(),atom() | {'no_translation',binary()})) will never return since it differs in the 1st argument from the success typing arguments: ([any()]) diff --git a/lib/dialyzer/test/small_SUITE_data/results/types_arity b/lib/dialyzer/test/small_SUITE_data/results/types_arity new file mode 100644 index 0000000000..02641bd167 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/types_arity @@ -0,0 +1,2 @@ + +types_arity.erl:16: Invalid type specification for function types_arity:test2/0. The success typing is () -> {'node','a','nil','nil'} diff --git a/lib/dialyzer/test/small_SUITE_data/src/types_arity.erl b/lib/dialyzer/test/small_SUITE_data/src/types_arity.erl new file mode 100644 index 0000000000..4ddc986ea8 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/types_arity.erl @@ -0,0 +1,20 @@ +-module(types_arity). + +-export([ test1/0 + , test2/0 + , test3/0 + ]). + +-export_type([tree/0, tree/1]). + +-type tree(T) :: 'nil' | {'node', T, tree(T), tree(T)}. +-type tree() :: tree(integer()). + +-spec test1() -> tree(). +test1() -> {node, 7, nil, nil}. + +-spec test2() -> tree(). +test2() -> {node, a, nil, nil}. + +-spec test3() -> tree(atom()). +test3() -> {node, a, nil, nil}. diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml index ba9225da8b..379e9f0738 100644 --- a/lib/diameter/doc/src/diameter.xml +++ b/lib/diameter/doc/src/diameter.xml @@ -16,7 +16,7 @@ <header> <copyright> -<year>2011</year><year>2012</year> +<year>2011</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -188,7 +188,7 @@ Defaults to the value of the <c>alias</c> option if unspecified.</p> <item> <p> Specifies whether or not the &app_pick_peer; -application callback can modify the application state, +application callback can modify the application state. Defaults to <c>false</c> if unspecified.</p> <note> @@ -206,11 +206,13 @@ probably avoid it.</p> <item> <p> Determines the manner in which incoming answer messages containing -decode errors are handled. +decode errors are handled.</p> + +<p> If <c>callback</c> then errors result in a &app_handle_answer; callback in the same fashion as for &app_handle_request;, with errors communicated in the <c>errors</c> field of the -<c>#diameter_packet{}</c> record passed to the callback. +<c>#diameter_packet{}</c> passed to the callback. If <c>report</c> then an answer containing errors is discarded without a callback and a warning report is written to the log. If <c>discard</c> then an answer containing errors is silently @@ -224,6 +226,39 @@ question is as if a callback had taken place and returned Defaults to <c>report</c> if unspecified.</p> </item> +<tag><c>{request_errors, answer_3xxx|answer|callback}</c></tag> +<item> +<p> +Determines the manner in which incoming requests are handled when an +error other than 3007, DIAMETER_APPLICATION_UNSUPPORTED (which cannot +be associated with an application callback module), is detected.</p> + +<p> +If <c>answer_3xxx</c> then requests are answered without a +&app_handle_request; callback taking place. +If <c>answer</c> then even 5xxx errors are answered without a +callback unless the connection in question has configured the RFC 3588 +common dictionary as noted below. +If <c>callback</c> then a &app_handle_request; callback always takes +place and the return value determines the answer sent to the peer.</p> + +<p> +Defaults to <c>answer_3xxx</c> if unspecified.</p> + +<note> +<p> +Answers sent by diameter set the E-bit in the Diameter Header. +Since RFC 3588 allowed only 3xxx result codes in an +<c>answer-message</c>, <c>answer</c> has the same semantics as +<c>answer_3xxx</c> if the peer connection in question has configured +the RFC 3588 common dictionary, <c>diameter_gen_base_rfc3588</c>. +RFC 6733 allows both 3xxx and 5xxx result codes in an +<c>answer-message</c> so a connection configured with the RFC 6733 +common dictionary, <c>diameter_gen_base_rfc6733</c>, does +distinguish between <c>answer_3xxx</c> and <c>answer</c>.</p> +</note> +</item> + </taglist> <marker id="call_opt"/> @@ -534,7 +569,7 @@ Pkt = #diameter_packet{} The RFC 3539 watchdog state machine has transitioned into (<c>up</c>) or out of (<c>down</c>) the OKAY state. -If a <c>#diameter_packet{}</c> record is present in an <c>up</c> event +If a <c>#diameter_packet{}</c> is present in an <c>up</c> event then there has been a capabilties exchange on a newly established transport connection and the record contains the received CER or CEA. Otherwise a connection has reestablished without the loss or diff --git a/lib/diameter/doc/src/diameter_app.xml b/lib/diameter/doc/src/diameter_app.xml index f4db625c71..d0f1b22ebd 100644 --- a/lib/diameter/doc/src/diameter_app.xml +++ b/lib/diameter/doc/src/diameter_app.xml @@ -13,7 +13,7 @@ <header> <copyright> -<year>2011</year><year>2012</year> +<year>2011</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -475,6 +475,7 @@ not selected.</p> | discard | {eval|eval_packet, Action, PostF}</v> <v>Reply = {reply, &packet; | &message;} + | {answer_message, 3000..3999|5000..5999} | {protocol_error, 3000..3999}</v> <v>Opt = &mod_call_opt;</v> <v>PostF = &mod_evaluable;</v> @@ -509,14 +510,15 @@ Otherwise it contains the record representing the request as outlined in &dict;.</p> <p> -The <c>errors</c> field specifies any Result-Code's identifying errors -that were encountered in decoding the request. -In this case diameter will set both Result-Code and -Failed-AVP AVP's in a returned -answer &message; before sending it to the peer: -the returned &message; need only set any other required AVP's. -Note that the errors detected by diameter are all of the 5xxx series -(Permanent Failures). +The <c>errors</c> field specifies any results codes identifying errors +found while decoding the request. +This is used to set Result-Code and/or Failed-AVP in a returned +answer unless the callback returns a <c>#diameter_packet{}</c> +whose <c>errors</c> field is set to either a non-empty list of its +own, in which case this list is used instead, or the atom <c>false</c> +to disable any setting of Result-Code and Failed-AVP. +Note that the errors detected by diameter are of the 3xxx +and 5xxx series, Protocol Errors and Permanent Failures respectively. The <c>errors</c> list is empty if the request has been received in the relay application.</p> @@ -544,24 +546,25 @@ preserved in the outgoing answer, appropriate values otherwise being set by diameter.</p> </item> -<tag><c>{protocol_error, 3000..3999}</c></tag> +<tag><c>{answer_message, 3000..3999|5000..5999}</c></tag> <item> <p> Send an answer message to the peer containing the specified -protocol error. +Result-Code. Equivalent to</p> <pre> {reply, ['answer-message' | Avps] </pre> <p> where <c>Avps</c> sets the Origin-Host, Origin-Realm, the specified -Result-Code and (if the request sent one) Session-Id AVP's.</p> +Result-Code and (if the request contained one) Session-Id AVP's.</p> <p> -Note that &the_rfc; mandates that only answers with a 3xxx series -Result-Code (protocol errors) may set the E bit. -Returning a non-3xxx value in a <c>protocol_error</c> tuple -will cause the request process in question to fail.</p> +Returning a value other than 3xxx or 5xxx will cause the request +process in question to fail, as will returning a 5xxx value if the +peer connection in question has been configured with the RFC 3588 +common dictionary <c>diameter_gen_base_rfc3588</c>. +(Since RFC 3588 only allows 3xxx values in an answer-message.)</p> </item> <tag><c>{relay, Opts}</c></tag> @@ -614,11 +617,20 @@ containing the encoded binary. The return value is ignored.</p> </item> +<tag><c>{protocol_error, 3000..3999}</c></tag> +<item> +<p> +Equivalent to <c>{answer_message, 3000..3999}</c>.</p> +</item> + </taglist> +<note> <p> -Note that protocol errors detected by diameter will result in an -answer message without <c>handle_request/3</c> being invoked.</p> +Requests containing errors may be answered by diameter, without a +callback taking place, depending on the value of the +&mod_application_opt; <c>request_errors</c>.</p> +</note> </desc> </func> diff --git a/lib/diameter/include/diameter.hrl b/lib/diameter/include/diameter.hrl index 5ee898c3dd..79c4dce541 100644 --- a/lib/diameter/include/diameter.hrl +++ b/lib/diameter/include/diameter.hrl @@ -143,6 +143,6 @@ init_state, %% option 'state', initial callback state id, %% 32-bit unsigned application identifier = Dict:id() mutable = false, %% boolean(), do traffic callbacks modify state? - options = [{answer_errors, report}]}). %% | callback | discard - + options = [{answer_errors, report}, %% | callback | discard + {request_errors, answer_3xxx}]}). %% | callback | answer -endif. %% -ifdef(diameter_hrl). diff --git a/lib/diameter/src/Makefile b/lib/diameter/src/Makefile index 0e448c8912..df10c33268 100644 --- a/lib/diameter/src/Makefile +++ b/lib/diameter/src/Makefile @@ -109,7 +109,8 @@ ERL_COMPILE_FLAGS += \ +warn_unused_vars \ -pa $(ABS_EBIN) \ -I $(INCDIR) \ - -I gen + -I gen \ + $(STRICT_FLAGS) # -pa is to be able to include_lib from the include directory: the # path must contain the application name. @@ -124,6 +125,13 @@ gen/diameter_gen_%.erl gen/diameter_gen_%.hrl: dict/%.dia opt: $(TARGET_FILES) +# Compile with -Werror during development. Don't do this in the 'opt' +# target so that new warnings don't break the build. It's also +# convenient to have both targets when weeding out warnings isn't the +# priority. (Or when they're intentional, when debugging.) +strict: + $(MAKE) opt STRICT_FLAGS=-Werror + # Build unofficial patches with some degree of traceability. Refuse to # build if there are diffs from HEAD since that defeats the purpose. patch: @@ -251,13 +259,13 @@ release_docs_spec: # Dependencies # ---------------------------------------------------- -gen/diameter_gen_base_accounting.erl gen/diameter_gen_relay.erl \ -gen/diameter_gen_base_accounting.hrl gen/diameter_gen_relay.hrl: \ +gen/diameter_gen_base_accounting.erl gen/diameter_gen_base_accounting.hrl: \ $(EBIN)/diameter_gen_base_rfc3588.$(EMULATOR) gen/diameter_gen_acct_rfc6733.erl gen/diameter_gen_acct_rfc6733.hrl: \ $(EBIN)/diameter_gen_base_rfc6733.$(EMULATOR) +gen/diameter_gen_relay.erl gen/diameter_gen_relay.hrl \ gen/diameter_gen_base_rfc3588.erl gen/diameter_gen_base_rfc3588.hrl \ gen/diameter_gen_base_rfc6733.erl gen/diameter_gen_base_rfc6733.hrl: \ $(COMPILER_MODULES:%=$(EBIN)/%.$(EMULATOR)) @@ -281,7 +289,7 @@ depend.mk: depend.sed $(MODULES:%=%.erl) Makefile .PHONY: debug opt release_docs_spec release_spec .PHONY: $(TARGET_DIRS:%/=%) $(TARGET_DIRS:%/=release_src_%) .PHONY: $(EXAMPLE_DIRS:%/=release_examples_%) -.PHONY: plt dialyze patch +.PHONY: plt dialyze patch strict # Keep intermediate files. .SECONDARY: $(DICT_ERLS) $(DICT_HRLS) gen/$(DICT_YRL:%=%.erl) diff --git a/lib/diameter/src/base/diameter.appup.src b/lib/diameter/src/base/diameter.appup.src index f6d772b534..2ce89579ff 100644 --- a/lib/diameter/src/base/diameter.appup.src +++ b/lib/diameter/src/base/diameter.appup.src @@ -20,14 +20,15 @@ {"%VSN%", [ - {"0.9", [{restart_application, diameter}]}, - {"0.10", [{restart_application, diameter}]}, - {"1.0", [{restart_application, diameter}]}, - {"1.1", [{restart_application, diameter}]}, - {"1.2", [{restart_application, diameter}]}, + {"0.9", [{restart_application, diameter}]}, %% R14B03 + {"0.10", [{restart_application, diameter}]}, %% R14B04 + {"1.0", [{restart_application, diameter}]}, %% R15B + {"1.1", [{restart_application, diameter}]}, %% R15B01 + {"1.2", [{restart_application, diameter}]}, %% R15B02 {"1.2.1", [{restart_application, diameter}]}, - {"1.3", [{restart_application, diameter}]}, - {"1.3.1", [{restart_application, diameter}]} + {"1.3", [{restart_application, diameter}]}, %% R15B03 + {"1.3.1", [{restart_application, diameter}]}, + {"1.4", [{restart_application, diameter}]} %% R16A ], [ {"0.9", [{restart_application, diameter}]}, @@ -37,6 +38,7 @@ {"1.2", [{restart_application, diameter}]}, {"1.2.1", [{restart_application, diameter}]}, {"1.3", [{restart_application, diameter}]}, - {"1.3.1", [{restart_application, diameter}]} + {"1.3.1", [{restart_application, diameter}]}, + {"1.4", [{restart_application, diameter}]} ] }. diff --git a/lib/diameter/src/base/diameter.erl b/lib/diameter/src/base/diameter.erl index f563d244f6..c67fba5f89 100644 --- a/lib/diameter/src/base/diameter.erl +++ b/lib/diameter/src/base/diameter.erl @@ -306,7 +306,8 @@ call(SvcName, App, Message) -> | {module, app_module()} | {state, any()} | {call_mutates_state, boolean()} - | {answer_errors, callback|report|discard}. + | {answer_errors, callback|report|discard} + | {request_errors, answer_3xxx|answer|callback}. -type app_alias() :: any(). diff --git a/lib/diameter/src/base/diameter_config.erl b/lib/diameter/src/base/diameter_config.erl index 1486071573..9f73815756 100644 --- a/lib/diameter/src/base/diameter_config.erl +++ b/lib/diameter/src/base/diameter_config.erl @@ -670,15 +670,17 @@ app_acc({application, Opts}, Acc) -> [Dict, Mod] = get_opt([dictionary, module], Opts), Alias = get_opt(alias, Opts, Dict), ModS = get_opt(state, Opts, Alias), - M = get_opt(call_mutates_state, Opts, false), - A = get_opt(answer_errors, Opts, report), + M = get_opt(call_mutates_state, Opts, false, [true]), + A = get_opt(answer_errors, Opts, report, [callback, discard]), + P = get_opt(request_errors, Opts, answer_3xxx, [answer, callback]), [#diameter_app{alias = Alias, dictionary = Dict, id = cb(Dict, id), module = init_mod(Mod), init_state = ModS, - mutable = init_mutable(M), - options = [{answer_errors, init_answers(A)}]} + mutable = M, + options = [{answer_errors, A}, + {request_errors, P}]} | Acc]; app_acc(_, Acc) -> Acc. @@ -707,20 +709,16 @@ init_cb(List) -> V <- [proplists:get_value(F, List, D)]], #diameter_callback{} = list_to_tuple([diameter_callback | Values]). -init_mutable(M) - when M == true; - M == false -> - M; -init_mutable(M) -> - ?THROW({call_mutates_state, M}). - -init_answers(A) - when callback == A; - report == A; - discard == A -> - A; -init_answers(A) -> - ?THROW({answer_errors, A}). +%% Retreive and validate. +get_opt(Key, List, Def, Other) -> + init_opt(Key, get_opt(Key, List, Def), [Def|Other]). + +init_opt(_, V, [V|_]) -> + V; +init_opt(Name, V, [_|Vals]) -> + init_opt(Name, V, Vals); +init_opt(Name, V, []) -> + ?THROW({Name, V}). %% Get a single value at the specified key. get_opt(Keys, List) diff --git a/lib/diameter/src/base/diameter_traffic.erl b/lib/diameter/src/base/diameter_traffic.erl index 0de3825943..f527f7c754 100644 --- a/lib/diameter/src/base/diameter_traffic.erl +++ b/lib/diameter/src/base/diameter_traffic.erl @@ -20,7 +20,7 @@ %% %% Implements the handling of incoming and outgoing Diameter messages %% except CER/CEA, DWR/DWA and DPR/DPA. That is, the messages that a -%% diameter client sends of receives. +%% diameter client sends and receives. %% -module(diameter_traffic). @@ -38,7 +38,7 @@ failover/1, pending/1]). -%% Other callbacks. +%% towards ?MODULE -export([send/1]). %% send from remote node -include_lib("diameter/include/diameter.hrl"). @@ -187,37 +187,42 @@ recv_request(TPid, Dict0, #recvdata{peerT = PeerT, apps = Apps} = RecvData) -> - recv_request(diameter_service:find_incoming_app(PeerT, TPid, Id, Apps), - TPid, - Pkt, - Dict0, - RecvData). - -%% recv_request/5 - -recv_request({#diameter_app{id = Id, dictionary = Dict} = App, Caps}, - TPid, - Pkt, - Dict0, - RecvData) -> - recv_R(App, + send_A(recv_R(diameter_service:find_incoming_app(PeerT, TPid, Id, Apps), + TPid, + Pkt, + Dict0, + RecvData), TPid, - Caps, Dict0, - RecvData, - diameter_codec:decode(Id, Dict, Pkt)); + RecvData). + +%% recv_R/5 + +recv_R({#diameter_app{id = Id, dictionary = Dict} = App, Caps}, + TPid, + Pkt0, + Dict0, + RecvData) -> + Pkt = errors(Id, diameter_codec:decode(Id, Dict, Pkt0)), + {Caps, Pkt, App, recv_R(App, TPid, Dict0, Caps, RecvData, Pkt)}; %% Note that the decode is different depending on whether or not Id is %% ?APP_ID_RELAY. %% DIAMETER_APPLICATION_UNSUPPORTED 3007 %% A request was sent for an application that is not supported. -recv_request(#diameter_caps{} = Caps, TPid, Pkt, Dict0, _) -> - As = collect_avps(Pkt), - protocol_error(3007, TPid, Caps, Dict0, Pkt#diameter_packet{avps = As}); +recv_R(#diameter_caps{} + = Caps, + _TPid, + #diameter_packet{errors = Es} + = Pkt, + _Dict0, + _RecvData) -> + {Caps, Pkt#diameter_packet{avps = collect_avps(Pkt), + errors = [3007 | Es]}}; -recv_request(false, _, _, _, _) -> %% transport has gone down - ok. +recv_R(false = No, _, _, _, _) -> %% transport has gone down + No. collect_avps(Pkt) -> case diameter_codec:collect_avps(Pkt) of @@ -229,98 +234,51 @@ collect_avps(Pkt) -> %% recv_R/6 -%% Wrong number of bits somewhere in the message: reply. -%% -%% DIAMETER_INVALID_AVP_BITS 3009 -%% A request was received that included an AVP whose flag bits are -%% set to an unrecognized value, or that is inconsistent with the -%% AVP's definition. -%% -recv_R(_App, - TPid, - Caps, - Dict0, - _RecvData, - #diameter_packet{errors = [Bs | _]} = Pkt) - when is_bitstring(Bs) -> - protocol_error(3009, TPid, Caps, Dict0, Pkt); - -%% Either we support this application but don't recognize the command -%% or we're a relay and the command isn't proxiable. -%% -%% DIAMETER_COMMAND_UNSUPPORTED 3001 -%% The Request contained a Command-Code that the receiver did not -%% recognize or support. This MUST be used when a Diameter node -%% receives an experimental command that it does not understand. -%% -recv_R(#diameter_app{id = Id}, - TPid, - Caps, +%% Answer errors ourselves ... +recv_R(#diameter_app{options = [_, {request_errors, E} | _]}, + _TPid, Dict0, + _Caps, _RecvData, - #diameter_packet{header = #diameter_header{is_proxiable = P}, - msg = M} - = Pkt) - when ?APP_ID_RELAY /= Id, undefined == M; - ?APP_ID_RELAY == Id, not P -> - protocol_error(3001, TPid, Caps, Dict0, Pkt); - -%% Error bit was set on a request. -%% -%% DIAMETER_INVALID_HDR_BITS 3008 -%% A request was received whose bits in the Diameter header were -%% either set to an invalid combination, or to a value that is -%% inconsistent with the command code's definition. -%% -recv_R(_App, + #diameter_packet{errors = [RC|_]}) %% a detected 3xxx is hd + when E == answer, (Dict0 /= ?BASE orelse 3 == RC div 1000); + E == answer_3xxx, 3 == RC div 1000 -> + {{answer_message, rc(RC)}, [], []}; + +%% ... or make a handle_request callback. Note that +%% Pkt#diameter_packet.msg = undefined in the 3001 case. +recv_R(App, TPid, + _Dict0, Caps, - Dict0, - _RecvData, - #diameter_packet{header = #diameter_header{is_error = true}} - = Pkt) -> - protocol_error(3008, TPid, Caps, Dict0, Pkt); - -%% A message in a locally supported application or a proxiable message -%% in the relay application. Don't distinguish between the two since -%% each application has its own callback config. That is, the user can -%% easily distinguish between the two cases. -recv_R(App, TPid, Caps, Dict0, RecvData, Pkt) -> - request_cb(App, TPid, Caps, Dict0, RecvData, examine(Pkt)). - -%% Note that there may still be errors but these aren't protocol -%% (3xxx) errors that lead to an answer-message. - -request_cb(App, - TPid, - Caps, - Dict0, - #recvdata{service_name = SvcName} - = RecvData, - Pkt) -> + #recvdata{service_name = SvcName}, + Pkt) -> request_cb(cb(App, handle_request, [Pkt, SvcName, {TPid, Caps}]), App, - TPid, - Caps, - Dict0, - RecvData, [], - Pkt). + []). + +rc({N,_}) -> + N; +rc(N) -> + N. -%% examine/1 +%% errors/1 %% -%% Look for errors in a decoded message. It's odd/unfortunate that -%% 501[15] aren't protocol errors. +%% Look for additional errors in a decoded message, prepending the +%% errors field with the first detected error. It's odd/unfortunate +%% that 501[15] aren't protocol errors. With RFC 3588 this means that +%% a handle_request callback has to formulate the answer. With RFC +%% 6733 it's acceptable for 5xxx to be sent in an answer-message. %% DIAMETER_INVALID_MESSAGE_LENGTH 5015 -%% %% This error is returned when a request is received with an invalid %% message length. -examine(#diameter_packet{header = #diameter_header{length = Len}, - bin = Bin, - errors = Es} - = Pkt) +errors(_, #diameter_packet{header = #diameter_header{length = Len}, + bin = Bin, + errors = Es} + = Pkt) when Len < 20; 0 /= Len rem 4; 8*Len /= bit_size(Bin) -> @@ -330,57 +288,75 @@ examine(#diameter_packet{header = #diameter_header{length = Len}, %% This error is returned when a request was received, whose version %% number is unsupported. -examine(#diameter_packet{header = #diameter_header{version = V}, - errors = Es} - = Pkt) +errors(_, #diameter_packet{header = #diameter_header{version = V}, + errors = Es} + = Pkt) when V /= ?DIAMETER_VERSION -> Pkt#diameter_packet{errors = [5011 | Es]}; -examine(Pkt) -> +%% DIAMETER_INVALID_AVP_BITS 3009 +%% A request was received that included an AVP whose flag bits are +%% set to an unrecognized value, or that is inconsistent with the +%% AVP's definition. + +errors(_, #diameter_packet{errors = [Bs | Es]} = Pkt) + when is_bitstring(Bs) -> + Pkt#diameter_packet{errors = [3009 | Es]}; + +%% DIAMETER_COMMAND_UNSUPPORTED 3001 +%% The Request contained a Command-Code that the receiver did not +%% recognize or support. This MUST be used when a Diameter node +%% receives an experimental command that it does not understand. + +errors(Id, #diameter_packet{header = #diameter_header{is_proxiable = P}, + msg = M, + errors = Es} + = Pkt) + when ?APP_ID_RELAY /= Id, undefined == M; %% don't know the command + ?APP_ID_RELAY == Id, not P -> %% command isn't proxiable + Pkt#diameter_packet{errors = [3001 | Es]}; + +%% DIAMETER_INVALID_HDR_BITS 3008 +%% A request was received whose bits in the Diameter header were +%% either set to an invalid combination, or to a value that is +%% inconsistent with the command code's definition. + +errors(_, #diameter_packet{header = #diameter_header{is_request = true, + is_error = true}, + errors = Es} + = Pkt) -> + Pkt#diameter_packet{errors = [3008 | Es]}; + +%% Green. +errors(_, Pkt) -> Pkt. -%% request_cb/8 +%% request_cb/4 %% A reply may be an answer-message, constructed either here or by %% the handle_request callback. The header from the incoming request %% is passed into the encode so that it can retrieve the relevant %% command code in this case. It will also then ignore Dict and use %% the base encoder. -request_cb({reply, Ans}, - #diameter_app{dictionary = Dict}, - TPid, - _Caps, - Dict0, - _RecvData, - Fs, - Pkt) -> - reply(Ans, dict(Dict, Dict0, Ans), TPid, Fs, Pkt); +request_cb({reply, _Ans} = T, _App, EvalPktFs, EvalFs) -> + {T, EvalPktFs, EvalFs}; %% An 3xxx result code, for which the E-bit is set in the header. -request_cb({protocol_error, RC}, - _App, - TPid, - Caps, - Dict0, - _RecvData, - Fs, - Pkt) - when 3000 =< RC, RC < 4000 -> - protocol_error(RC, TPid, Caps, Dict0, Fs, Pkt); +request_cb({protocol_error, RC}, _App, EvalPktFs, EvalFs) + when 3 == RC div 1000 -> + {{answer_message, RC}, EvalPktFs, EvalFs}; + +request_cb({answer_message, RC} = T, _App, EvalPktFs, EvalFs) + when 3 == RC div 1000; + 5 == RC div 1000 -> + {T, EvalPktFs, EvalFs}; %% RFC 3588 says we must reply 3001 to anything unrecognized or %% unsupported. 'noreply' is undocumented (and inappropriately named) %% backwards compatibility for this, protocol_error the documented %% alternative. -request_cb(noreply, - _App, - TPid, - Caps, - Dict0, - _RecvData, - Fs, - Pkt) -> - protocol_error(3001, TPid, Caps, Dict0, Fs, Pkt); +request_cb(noreply, _App, EvalPktFs, EvalFs) -> + {{answer_message, 3001}, EvalPktFs, EvalFs}; %% Relay a request to another peer. This is equivalent to doing an %% explicit call/4 with the message in question except that (1) a loop @@ -397,29 +373,77 @@ request_cb(noreply, %% want to distinguish between the cases in the callback return value %% then 'resend' is a neutral alternative. %% -request_cb({A, Opts}, - #diameter_app{id = Id} - = App, - TPid, - Caps, - Dict0, - RecvData, - Fs, - Pkt) +request_cb({A, Opts}, #diameter_app{id = Id}, EvalPktFs, EvalFs) when A == relay, Id == ?APP_ID_RELAY; A == proxy, Id /= ?APP_ID_RELAY; A == resend -> - resend(Opts, App, TPid, Caps, Dict0, RecvData, Fs, Pkt); + {{call, Opts}, EvalPktFs, EvalFs}; -request_cb(discard, _, _, _, _, _, _, _) -> - ok; +request_cb(discard = No, _, _, _) -> + No; + +request_cb({eval_packet, RC, F}, App, Fs, EvalFs) -> + request_cb(RC, App, [F|Fs], EvalFs); + +request_cb({eval, RC, F}, App, EvalPktFs, Fs) -> + request_cb(RC, App, EvalPktFs, [F|Fs]); + +request_cb(T, App, _, _) -> + ?ERROR({invalid_return, T, handle_request, App}). + +%% send_A/4 -request_cb({eval_packet, RC, F}, App, TPid, Caps, Dict0, RecvData, Fs, Pkt) -> - request_cb(RC, App, TPid, Caps, Dict0, RecvData, [F|Fs], Pkt); +send_A({Caps, Pkt}, TPid, Dict0, _RecvData) -> %% unsupported application + #diameter_packet{errors = [RC|_]} = Pkt, + send_A(answer_message(RC, Caps, Dict0, Pkt), + TPid, + Dict0, + Pkt, + [], + []); + +send_A({Caps, Pkt, App, {T, EvalPktFs, EvalFs}}, TPid, Dict0, RecvData) -> + send_A(answer(T, Caps, Pkt, App, Dict0, RecvData), + TPid, + Dict0, + Pkt, + EvalPktFs, + EvalFs); + +send_A(_, _, _, _) -> + ok. + +%% send_A/6 + +send_A(T, TPid, Dict0, ReqPkt, EvalPktFs, EvalFs) -> + reply(T, TPid, Dict0, EvalPktFs, ReqPkt), + lists:foreach(fun diameter_lib:eval/1, EvalFs). + +%% answer/6 + +answer({reply, Ans}, _Caps, _Pkt, App, Dict0, _RecvData) -> + {dict(App#diameter_app.dictionary, Dict0, Ans), Ans}; + +answer({call, Opts}, Caps, Pkt, App, Dict0, RecvData) -> + #diameter_caps{origin_host = {OH,_}} + = Caps, + #diameter_packet{avps = Avps} + = Pkt, + {Code, _Flags, Vid} = Dict0:avp_header('Route-Record'), + resend(is_loop(Code, Vid, OH, Dict0, Avps), + Opts, + Caps, + Pkt, + App, + Dict0, + RecvData); -request_cb({eval, RC, F}, App, TPid, Caps, Dict0, RecvData, Fs, Pkt) -> - request_cb(RC, App, TPid, Caps, Dict0, RecvData, Fs, Pkt), - diameter_lib:eval(F). +%% RFC 3588 only allows 3xxx errors in an answer-message. RFC 6733 +%% added the possibility of setting 5xxx. +answer({answer_message, RC} = T, Caps, Pkt, App, Dict0, _RecvData) -> + Dict0 /= ?BASE orelse 3 == RC div 1000 + orelse ?ERROR({invalid_return, T, handle_request, App}), + answer_message(RC, Caps, Dict0, Pkt). %% dict/3 @@ -436,65 +460,31 @@ dict(Dict, Dict0, [Msg]) -> dict(Dict, Dict0, #diameter_packet{msg = Msg}) -> dict(Dict, Dict0, Msg); -dict(_Dict, Dict0, ['answer-message' | _]) -> - Dict0; +dict(Dict, Dict0, Msg) -> + choose(is_answer_message(Msg, Dict0), Dict0, Dict). -dict(Dict, Dict0, Rec) -> +is_answer_message([Name | _], _) -> + Name == 'answer-message'; + +is_answer_message(Rec, Dict) -> try - 'answer-message' = Dict0:rec2msg(element(1,Rec)), - Dict0 + 'answer-message' == Dict:rec2msg(element(1,Rec)) catch - error:_ -> Dict + error:_ -> false end. -%% protocol_error/6 - -protocol_error(RC, TPid, Caps, Dict0, Fs, Pkt) -> - #diameter_caps{origin_host = {OH,_}, - origin_realm = {OR,_}} - = Caps, - #diameter_packet{avps = Avps, errors = Es} - = Pkt, +%% answer_message/4 +answer_message(RC, + #diameter_caps{origin_host = {OH,_}, + origin_realm = {OR,_}}, + Dict0, + #diameter_packet{avps = Avps} + = Pkt) -> ?LOG({error, RC}, Pkt), - reply(answer_message({OH, OR, RC}, Dict0, Avps), - Dict0, - TPid, - Fs, - Pkt#diameter_packet{errors = [RC | Es]}). -%% Note that reply/5 may set the result code once more. It's set in -%% answer_message/3 in case reply/5 doesn't. - -%% protocol_error/5 - -protocol_error(RC, TPid, Caps, Dict0, Pkt) -> - protocol_error(RC, TPid, Caps, Dict0, [], Pkt). + {Dict0, answer_message(OH, OR, RC, Dict0, Avps)}. %% resend/7 -%% -%% Resend a message as a relay or proxy agent. - -resend(Opts, - #diameter_app{} - = App, - TPid, - #diameter_caps{origin_host = {OH,_}} - = Caps, - Dict0, - RecvData, - Fs, - #diameter_packet{avps = Avps} - = Pkt) -> - {Code, _Flags, Vid} = Dict0:avp_header('Route-Record'), - resend(is_loop(Code, Vid, OH, Dict0, Avps), - Opts, - App, - TPid, - Caps, - Dict0, - RecvData, - Fs, - Pkt). %% DIAMETER_LOOP_DETECTED 3005 %% An agent detected a loop while trying to get the message to the @@ -502,8 +492,8 @@ resend(Opts, %% if one is available, but the peer reporting the error has %% identified a configuration problem. -resend(true, _Opts, _App, TPid, Caps, Dict0, _RecvData, Fs, Pkt) -> - protocol_error(3005, TPid, Caps, Dict0, Fs, Pkt); +resend(true, _Opts, Caps, Pkt, _App, Dict0, _RecvData) -> + answer_message(3005, Caps, Dict0, Pkt); %% 6.1.8. Relaying and Proxying Requests %% @@ -513,22 +503,20 @@ resend(true, _Opts, _App, TPid, Caps, Dict0, _RecvData, Fs, Pkt) -> resend(false, Opts, - App, - TPid, #diameter_caps{origin_host = {_,OH}} = Caps, - Dict0, - #recvdata{service_name = SvcName, - sequence = Mask}, - Fs, #diameter_packet{header = Hdr0, avps = Avps} - = Pkt) -> + = Pkt, + App, + Dict0, + #recvdata{service_name = SvcName, + sequence = Mask}) -> Route = #diameter_avp{data = {Dict0, 'Route-Record', OH}}, Seq = diameter_session:sequence(Mask), Hdr = Hdr0#diameter_header{hop_by_hop_id = Seq}, Msg = [Hdr, Route | Avps], - resend(send_request(SvcName, App, Msg, Opts), TPid, Caps, Dict0, Fs, Pkt). + resend(send_request(SvcName, App, Msg, Opts), Caps, Dict0, Pkt). %% The incoming request is relayed with the addition of a %% Route-Record. Note the requirement on the return from call/4 below, %% which places a requirement on the value returned by the @@ -545,28 +533,24 @@ resend(false, %% RFC 6.3 says that a relay agent does not modify Origin-Host but %% says nothing about a proxy. Assume it should behave the same way. -%% resend/6 +%% resend/4 %% %% Relay a reply to a relayed request. %% Answer from the peer: reset the hop by hop identifier and send. resend(#diameter_packet{bin = B} = Pkt, - TPid, _Caps, _Dict0, - Fs, #diameter_packet{header = #diameter_header{hop_by_hop_id = Id}, transport_data = TD}) -> - P = Pkt#diameter_packet{bin = diameter_codec:hop_by_hop_id(Id, B), - transport_data = TD}, - eval_packet(P, Fs), - send(TPid, P); + Pkt#diameter_packet{bin = diameter_codec:hop_by_hop_id(Id, B), + transport_data = TD}; %% TODO: counters %% Or not: DIAMETER_UNABLE_TO_DELIVER. -resend(_, TPid, Caps, Dict0, Fs, Pkt) -> - protocol_error(3002, TPid, Caps, Dict0, Fs, Pkt). +resend(_, Caps, Dict0, Pkt) -> + answer_message(3002, Caps, Dict0, Pkt). %% is_loop/5 %% @@ -590,37 +574,110 @@ is_loop(Code, Vid, OH, Dict0, Avps) -> is_loop(Code, Vid, Dict0:avp(encode, OH, 'Route-Record'), Dict0, Avps). %% reply/5 + +%% Local answer ... +reply({Dict, Ans}, TPid, Dict0, Fs, ReqPkt) -> + reply(Ans, Dict, TPid, Dict0, Fs, ReqPkt); + +%% ... or relayed. +reply(#diameter_packet{} = Pkt, TPid, _Dict0, Fs, _ReqPkt) -> + eval_packet(Pkt, Fs), + send(TPid, Pkt). + +%% reply/6 %% %% Send a locally originating reply. %% Skip the setting of Result-Code and Failed-AVP's below. This is -%% currently undocumented. -reply([Msg], Dict, TPid, Fs, Pkt) +%% undocumented and shouldn't be relied on. +reply([Msg], Dict, TPid, Dict0, Fs, ReqPkt) when is_list(Msg); is_tuple(Msg) -> - reply(Msg, Dict, TPid, Fs, Pkt#diameter_packet{errors = []}); + reply(Msg, Dict, TPid, Dict0, Fs, ReqPkt#diameter_packet{errors = []}); %% No errors or a diameter_header/avp list. -reply(Msg, Dict, TPid, Fs, #diameter_packet{errors = Es} = ReqPkt) - when [] == Es; - is_record(hd(Msg), diameter_header) -> - Pkt = encode(Dict, make_answer_packet(Msg, ReqPkt), Fs), - incr(send, Pkt, Dict, TPid), %% count result codes in sent answers - send(TPid, Pkt); - -%% Or not: set Result-Code and Failed-AVP AVP's. -reply(Msg, Dict, TPid, Fs, #diameter_packet{errors = [H|_] = Es} = Pkt) -> - reply(rc(Msg, rc(H), [A || {_,A} <- Es], Dict), +reply(Msg, Dict, TPid, Dict0, Fs, ReqPkt) -> + Pkt = encode(Dict, reset(make_answer_packet(Msg, ReqPkt), Dict), Fs), + incr(send, Pkt, Dict, TPid, Dict0), %% count outgoing result codes + send(TPid, Pkt). + +%% reset/2 + +%% Header/avps list: send as is. +reset(#diameter_packet{msg = [#diameter_header{} | _]} = Pkt, _) -> + Pkt; + +%% No errors to set or errors explicitly ignored. +reset(#diameter_packet{errors = Es} = Pkt, _) + when Es == []; + Es == false -> + Pkt; + +%% Otherwise possibly set Result-Code and/or Failed-AVP. +reset(#diameter_packet{msg = Msg, errors = Es} = Pkt, Dict) -> + Pkt#diameter_packet{msg = reset(Msg, Dict, Es)}. + +%% reset/3 + +reset(Msg, Dict, Es) + when is_list(Es) -> + {E3, E5, Fs} = partition(Es), + FailedAVP = failed_avp(Msg, lists:reverse(Fs), Dict), + reset(set(Msg, FailedAVP, Dict), Dict, - TPid, - Fs, - Pkt#diameter_packet{errors = []}). + choose(is_answer_message(Msg, Dict), E3, E5)); + +reset(Msg, Dict, N) + when is_integer(N) -> + ResultCode = rc(Msg, {'Result-Code', N}, Dict), + set(Msg, ResultCode, Dict); + +reset(Msg, _, _) -> + Msg. + +partition(Es) -> + lists:foldl(fun pacc/2, {false, false, []}, Es). + +%% Note that the errors list can contain not only integer() and +%% {integer(), #diameter_avp{}} but also #diameter_avp{}. The latter +%% isn't something that's returned by decode but can be set in a reply +%% for encode. + +pacc({RC, #diameter_avp{} = A}, {E3, E5, Acc}) + when is_integer(RC) -> + pacc(RC, {E3, E5, [A|Acc]}); + +pacc(#diameter_avp{} = A, {E3, E5, Acc}) -> + {E3, E5, [A|Acc]}; + +pacc(RC, {false, E5, Acc}) + when 3 == RC div 1000 -> + {RC, E5, Acc}; + +pacc(RC, {E3, false, Acc}) + when 5 == RC div 1000 -> + {E3, RC, Acc}; + +pacc(_, Acc) -> + Acc. eval_packet(Pkt, Fs) -> lists:foreach(fun(F) -> diameter_lib:eval([F,Pkt]) end, Fs). %% make_answer_packet/2 +%% Use decode errors to set Result-Code and/or Failed-AVP unless the +%% the errors field has been explicitly set. Unfortunately, the +%% default value is the empty list rather than 'undefined' so use the +%% atom 'false' for "set nothing". (This is historical and changing +%% the default value would require modules including diameter.hrl to +%% be recompiled.) +make_answer_packet(#diameter_packet{errors = []} + = Pkt, + #diameter_packet{errors = [_|_] = Es} + = ReqPkt) -> + make_answer_packet(Pkt#diameter_packet{errors = Es}, ReqPkt); + %% A reply message clears the R and T flags and retains the P flag. %% The E flag will be set at encode. 6.2 of 3588 requires the same P %% flag on an answer as on the request. A #diameter_packet{} returned @@ -628,6 +685,7 @@ eval_packet(Pkt, Fs) -> %% own header values. make_answer_packet(#diameter_packet{header = Hdr, msg = Msg, + errors = Es, transport_data = TD}, #diameter_packet{header = ReqHdr}) -> Hdr0 = ReqHdr#diameter_header{version = ?DIAMETER_VERSION, @@ -636,6 +694,7 @@ make_answer_packet(#diameter_packet{header = Hdr, is_retransmitted = false}, #diameter_packet{header = fold_record(Hdr0, Hdr), msg = Msg, + errors = Es, transport_data = TD}; %% Binaries and header/avp lists are sent as-is. @@ -652,25 +711,6 @@ make_answer_packet([#diameter_header{} | _] = Msg, make_answer_packet(Msg, #diameter_packet{transport_data = TD} = Pkt) -> make_answer_packet(#diameter_packet{msg = Msg, transport_data = TD}, Pkt). -%% rc/1 - -rc({RC, _}) -> - RC; -rc(RC) -> - RC. - -%% rc/4 - -rc(#diameter_packet{msg = Rec} = Pkt, RC, Failed, DictT) -> - Pkt#diameter_packet{msg = rc(Rec, RC, Failed, DictT)}; - -rc(Rec, RC, Failed, DictT) - when is_integer(RC) -> - set(Rec, - lists:append([rc(Rec, {'Result-Code', RC}, DictT), - failed_avp(Rec, Failed, DictT)]), - DictT). - %% Reply as name and tuple list ... set([_|_] = Ans, Avps, _) -> Ans ++ Avps; %% Values nearer tail take precedence. @@ -796,9 +836,9 @@ fa(Rec, FailedAvp, Dict) -> %% Error-Message AVP is not intended to be useful in real-time, and %% SHOULD NOT be expected to be parsed by network entities. -%% answer_message/3 +%% answer_message/5 -answer_message({OH, OR, RC}, Dict0, Avps) -> +answer_message(OH, OR, RC, Dict0, Avps) -> {Code, _, Vid} = Dict0:avp_header('Session-Id'), ['answer-message', {'Origin-Host', OH}, {'Origin-Realm', OR}, @@ -892,32 +932,48 @@ find(Pred, [H|T]) -> %% incr/4 %% -%% Increment a stats counter for an incoming or outgoing message. +%% Increment a stats counter for result codes in incoming and outgoing +%% answers. %% Outgoing message as binary: don't count. (Sending binaries is only %% partially supported.) -incr(_, #diameter_packet{msg = undefined}, _, _) -> +incr(_, #diameter_packet{msg = undefined}, _, _, _) -> ok; -incr(recv = D, #diameter_packet{header = H, errors = [_|_]}, _, TPid) -> +%% Incoming with decode errors. +incr(recv = D, #diameter_packet{header = H, errors = [_|_]}, _, TPid, _) -> incr(TPid, {diameter_codec:msg_id(H), D, error}); -incr(Dir, Pkt, Dict, TPid) -> +%% Incoming without errors or outgoing. Outgoing with encode errors +%% never gets here since encode fails. +incr(Dir, Pkt, Dict, TPid, Dict0) -> #diameter_packet{header = #diameter_header{is_error = E} = Hdr, msg = Rec} = Pkt, RC = int(get_avp_value(Dict, 'Result-Code', Rec)), - PE = is_protocol_error(RC), - %% Check that the E bit is set only for 3xxx result codes. - (not (E orelse PE)) - orelse (E andalso PE) + %% Exit on an improper Result-Code. + is_result(RC, E, Dict0) orelse x({invalid_error_bit, RC}, answer, [Dir, Pkt]), irc(TPid, Hdr, Dir, rc_counter(Dict, Rec, RC)). +%% No E-bit: can't be 3xxx. +is_result(RC, false, _Dict0) -> + RC < 3000 orelse 4000 =< RC; + +%% E-bit in RFC 3588: only 3xxx. +is_result(RC, true, ?BASE) -> + 3000 =< RC andalso RC < 4000; + +%% E-bit in RFC 6733: 3xxx or 5xxx. +is_result(RC, true, _) -> + 3000 =< RC andalso RC < 4000 + orelse + 5000 =< RC andalso RC < 6000. + irc(_, _, _, undefined) -> false; @@ -929,7 +985,7 @@ irc(TPid, Hdr, Dir, Ctr) -> incr(TPid, Counter) -> diameter_stats:incr(Counter, TPid, 1). -%% error_counter/2 +%% rc_counter/2 %% RFC 3588, 7.6: %% @@ -969,9 +1025,6 @@ int(N) int(_) -> undefined. -is_protocol_error(RC) -> - 3000 =< RC andalso RC < 4000. - -spec x(any(), atom(), list()) -> no_return(). %% Warn and exit request process on errors in an incoming answer. @@ -1121,7 +1174,7 @@ send_R({eval_packet, RC, F}, Pkt, T, Opts, Caller, SvcName, Fs) -> send_R(RC, Pkt, T, Opts, Caller, SvcName, [F|Fs]); send_R(E, _, {_, _, App}, _, _, _, _) -> - ?ERROR({invalid_return, prepare_request, App, E}). + ?ERROR({invalid_return, E, prepare_request, App}). %% make_prepare_packet/2 %% @@ -1268,28 +1321,33 @@ handle_answer(SvcName, App, {error, Req, Reason}) -> handle_error(App, Req, Reason, SvcName); handle_answer(SvcName, - #diameter_app{dictionary = Dict} + #diameter_app{dictionary = Dict, + id = Id} = App, {answer, Req, Dict0, Pkt}) -> Mod = dict(Dict, Dict0, Pkt), - answer(examine(diameter_codec:decode(Mod, Pkt)), - SvcName, - Mod, - App, - Req). + handle_A(errors(Id, diameter_codec:decode(Mod, Pkt)), + SvcName, + Mod, + Dict0, + App, + Req). %% We don't really need to do a full decode if we're a relay and will %% just resend with a new hop by hop identifier, but might a proxy %% want to examine the answer? -answer(Pkt, SvcName, Dict, App, #request{transport = TPid} = Req) -> +handle_A(Pkt, SvcName, Dict, Dict0, App, #request{transport = TPid} = Req) -> try - incr(recv, Pkt, Dict, TPid) + incr(recv, Pkt, Dict, TPid, Dict0) %% count incoming result codes of _ -> answer(Pkt, SvcName, App, Req) catch - exit: {invalid_error_bit, _} = E -> - answer(Pkt#diameter_packet{errors = [E]}, SvcName, App, Req) + exit: {invalid_error_bit, RC} -> + #diameter_packet{errors = Es} + = Pkt, + E = {5004, #diameter_avp{name = 'Result-Code', value = RC}}, + answer(Pkt#diameter_packet{errors = [E|Es]}, SvcName, App, Req) end. answer(Pkt, @@ -1479,7 +1537,7 @@ retransmit({eval_packet, RC, F}, Transport, Req, SvcName, Timeout, Fs) -> retransmit(RC, Transport, Req, SvcName, Timeout, [F|Fs]); retransmit(T, {_, _, App}, _, _, _, _) -> - ?ERROR({invalid_return, prepare_retransmit, App, T}). + ?ERROR({invalid_return, T, prepare_retransmit, App}). resend_request(Pkt0, {TPid, Caps, #diameter_app{dictionary = Dict}}, diff --git a/lib/diameter/src/compiler/diameter_codegen.erl b/lib/diameter/src/compiler/diameter_codegen.erl index 1e31c40afe..80036879ea 100644 --- a/lib/diameter/src/compiler/diameter_codegen.erl +++ b/lib/diameter/src/compiler/diameter_codegen.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -128,8 +128,8 @@ gen(hrl, Spec, Mod, Path) -> gen(erl, Spec, Mod, Path) -> Forms = [{?attribute, module, Mod}, - {?attribute, compile, [{parse_transform, diameter_exprecs}]}, - {?attribute, compile, [{parse_transform, diameter_nowarn}]}, + {?attribute, compile, {parse_transform, diameter_exprecs}}, + {?attribute, compile, nowarn_unused_function}, {?attribute, export, [{name, 0}, {id, 0}, {vendor_id, 0}, diff --git a/lib/diameter/src/compiler/diameter_nowarn.erl b/lib/diameter/src/compiler/diameter_nowarn.erl deleted file mode 100644 index 6c17af6563..0000000000 --- a/lib/diameter/src/compiler/diameter_nowarn.erl +++ /dev/null @@ -1,41 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% A parse transform to work around dialyzer currently not -%% understanding nowarn_unused_function except on individual -%% functions. The include of diameter_gen.hrl by generated dictionary -%% modules contains code that may not be called depending on the -%% dictionary. (The relay dictionary for example.) -%% -%% Even called functions may contain cases that aren't used for a -%% particular dictionary. This also causes dialyzer to complain but -%% there's no way to silence it in this case. -%% - --module(diameter_nowarn). - --export([parse_transform/2]). - -parse_transform(Forms, _Options) -> - [{attribute, ?LINE, compile, {nowarn_unused_function, {F,A}}} - || {function, _, F, A, _} <- Forms] - ++ Forms. -%% Note that dialyzer also doesn't understand {nowarn_unused_function, FAs} -%% with FAs a list of tuples. diff --git a/lib/diameter/src/modules.mk b/lib/diameter/src/modules.mk index 2f3239e1aa..f8d3cf1d6f 100644 --- a/lib/diameter/src/modules.mk +++ b/lib/diameter/src/modules.mk @@ -70,7 +70,6 @@ CT_MODULES = \ base/diameter_info \ compiler/diameter_codegen \ compiler/diameter_exprecs \ - compiler/diameter_nowarn \ compiler/diameter_dict_scanner \ compiler/diameter_dict_util \ compiler/diameter_make diff --git a/lib/diameter/test/.gitignore b/lib/diameter/test/.gitignore index df38dfc5e3..4f19542bbe 100644 --- a/lib/diameter/test/.gitignore +++ b/lib/diameter/test/.gitignore @@ -1,3 +1,4 @@ /log /depend.mk +/coverspec diff --git a/lib/diameter/test/Makefile b/lib/diameter/test/Makefile index aa4b7eaeb1..061f0bcbef 100644 --- a/lib/diameter/test/Makefile +++ b/lib/diameter/test/Makefile @@ -56,7 +56,8 @@ DATA_DIRS = $(sort $(dir $(DATA))) ERL_COMPILE_FLAGS += +warn_export_vars \ +warn_unused_vars \ -I ../include \ - -I ../src/gen + -I ../src/gen \ + $(STRICT_FLAGS) # ---------------------------------------------------- # Targets @@ -64,6 +65,9 @@ ERL_COMPILE_FLAGS += +warn_export_vars \ all debug opt: $(TARGET_FILES) +strict: + $(MAKE) opt STRICT_FLAGS=-Werror + # Require success ... run: $(SUITES) @@ -73,7 +77,7 @@ any: opt clean: rm -f $(TARGET_FILES) - rm -f depend.mk + rm -f depend.mk coverspec realclean: clean rm -rf log @@ -114,7 +118,7 @@ help: @echo " Echo some relevant variables." @echo ======================================== -.PHONY: all any run clean debug docs help info opt realclean +.PHONY: all any run clean debug docs help info opt realclean strict # ---------------------------------------------------- # Special Targets @@ -132,10 +136,21 @@ $(SUITES): log opt | awk '{print} / FAILED /{rc=1} END{exit rc}' rc=0 # Shorter in sed but requires a GNU extension (ie. Q). +cover: log opt coverspec + $(ERL) -noinput \ + -pa $(realpath ../ebin) \ + -sname diameter_cover \ + -s diameter_ct cover \ + -s init stop \ + | awk '{print} / FAILED /{rc=1} END{exit rc}' rc=0 + +coverspec: diameter.cover + sed -f [email protected] $< > $@ + log: mkdir $@ -.PHONY: $(SUITES) +.PHONY: $(SUITES) cover # ---------------------------------------------------- # Release Targets diff --git a/lib/diameter/test/coverspec.sed b/lib/diameter/test/coverspec.sed new file mode 100644 index 0000000000..5e81621593 --- /dev/null +++ b/lib/diameter/test/coverspec.sed @@ -0,0 +1,33 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2013. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +# +# Morph diameter.cover into a legitimate cover spec. All that's being +# retained is the list of excluded modules. This is used by Makefile +# when running cover locally. +# + +/^{incl_app,/{ + i\ +{level, details}.\ +{incl_dirs, ["../ebin"]}. + d +} + +/^{excl_mods,/s@ .*@@ diff --git a/lib/diameter/test/diameter_3xxx_SUITE.erl b/lib/diameter/test/diameter_3xxx_SUITE.erl new file mode 100644 index 0000000000..89c78d8b57 --- /dev/null +++ b/lib/diameter/test/diameter_3xxx_SUITE.erl @@ -0,0 +1,509 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% Tests of application_opt() request_errors. There's some overlap +%% between this suite and the traffic suite but latter exercises more +%% config. +%% + +-module(diameter_3xxx_SUITE). + +-export([suite/0, + all/0, + groups/0, + init_per_suite/1, + end_per_suite/1, + init_per_group/2, + end_per_group/2, + init_per_testcase/2, + end_per_testcase/2]). + +%% testcases +-export([start/1, + send_unknown_application/1, + send_unknown_command/1, + send_ok/1, + send_invalid_avp_bits/1, + send_missing_avp/1, + send_ignore_missing_avp/1, + send_double_error/1, + send_3xxx/1, + send_5xxx/1, + stop/1]). + +%% diameter callbacks +-export([peer_up/3, + peer_down/3, + pick_peer/5, + prepare_request/4, + handle_answer/5, + handle_error/5, + handle_request/3]). + +-include("diameter.hrl"). +-include("diameter_gen_base_rfc6733.hrl"). +%% Use the fact that STR/STA is identical in RFC's 3588 and 6733. + +%% =========================================================================== + +-define(util, diameter_util). +-define(testcase(), proplists:get_value(testcase, get(?MODULE))). +-define(group(Config), begin + put(?MODULE, Config), + ?util:name(proplists:get_value(group, Config)) + end). + +-define(L, atom_to_list). +-define(A, list_to_atom). + +-define(CLIENT, "CLIENT"). +-define(SERVER, "SERVER"). +-define(REALM, "erlang.org"). +-define(HOST(Host, Realm), Host ++ [$.|Realm]). + +-define(ERRORS, [answer, answer_3xxx, callback]). +-define(RFCS, [rfc3588, rfc6733]). +-define(DICT(RFC), ?A("diameter_gen_base_" ++ ?L(RFC))). +-define(DICT, ?DICT(rfc6733)). + +-define(COMMON, ?DIAMETER_APP_ID_COMMON). + +%% Config for diameter:start_service/2. +-define(SERVICE(Name, Errors, RFC), + [{'Origin-Host', Name ++ "." ++ ?REALM}, + {'Origin-Realm', ?REALM}, + {'Host-IP-Address', [{127,0,0,1}]}, + {'Vendor-Id', 12345}, + {'Product-Name', "OTP/diameter"}, + {'Auth-Application-Id', [?COMMON]}, + {application, [{dictionary, ?DICT(RFC)}, + {module, ?MODULE}, + {answer_errors, callback}, + {request_errors, Errors}]}]). + +-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_LOGOUT'). + +%% =========================================================================== + +suite() -> + [{timetrap, {seconds, 60}}]. + +all() -> + [{group, ?util:name([E,D])} || E <- ?ERRORS, D <- ?RFCS]. + +groups() -> + Tc = tc(), + [{?util:name([E,D]), [], [start] ++ Tc ++ [stop]} + || E <- ?ERRORS, D <- ?RFCS]. + +init_per_suite(Config) -> + ok = diameter:start(), + Config. + +end_per_suite(_Config) -> + ok = diameter:stop(). + +init_per_group(Group, Config) -> + [{group, Group} | Config]. + +end_per_group(_, _) -> + ok. + +init_per_testcase(Name, Config) -> + [{testcase, Name} | Config]. + +end_per_testcase(_, _) -> + ok. + +tc() -> + [send_unknown_application, + send_unknown_command, + send_ok, + send_invalid_avp_bits, + send_missing_avp, + send_ignore_missing_avp, + send_double_error, + send_3xxx, + send_5xxx]. + +%% =========================================================================== + +%% start/1 + +start(Config) -> + Group = proplists:get_value(group, Config), + [Errors, RFC] = ?util:name(Group), + ok = diameter:start_service(?SERVER, ?SERVICE(?L(Group), + Errors, + RFC)), + ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT, + callback, + rfc6733)), + LRef = ?util:listen(?SERVER, tcp), + ?util:connect(?CLIENT, tcp, LRef). + +%% stop/1 + +stop(_Config) -> + ok = diameter:remove_transport(?CLIENT, true), + ok = diameter:remove_transport(?SERVER, true), + ok = diameter:stop_service(?SERVER), + ok = diameter:stop_service(?CLIENT). + +%% send_unknown_application/1 +%% +%% Send an unknown application that a callback (which shouldn't take +%% place) fails on. + +%% diameter answers. +send_unknown_application([_,_]) -> + #'diameter_base_answer-message'{'Result-Code' = 3007, + %% UNSUPPORTED_APPLICATION + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +send_unknown_application(Config) -> + send_unknown_application(?group(Config)). + +%% send_unknown_command/1 +%% +%% Send a unknown command that a callback discards. + +%% handle_request discards the request. +send_unknown_command([callback, _]) -> + {error, timeout} = call(); + +%% diameter answers. +send_unknown_command([_,_]) -> + #'diameter_base_answer-message'{'Result-Code' = 3001, + %% UNSUPPORTED_COMMAND + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +send_unknown_command(Config) -> + send_unknown_command(?group(Config)). + +%% send_ok/1 +%% +%% Send a correct STR that a callback answers with 5002. + +%% Callback answers. +send_ok([_,_]) -> + #diameter_base_STA{'Result-Code' = 5002, %% UNKNOWN_SESSION_ID + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +send_ok(Config) -> + send_ok(?group(Config)). + +%% send_invalid_avp_bits/1 +%% +%% Send a request with an incorrect length on the optional +%% Origin-State-Id that a callback ignores. + +%% Callback answers. +send_invalid_avp_bits([callback, _]) -> + #diameter_base_STA{'Result-Code' = 2001, %% SUCCESS + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +%% diameter answers. +send_invalid_avp_bits([_,_]) -> + #'diameter_base_answer-message'{'Result-Code' = 3009, %% INVALID_AVP_BITS + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +send_invalid_avp_bits(Config) -> + send_invalid_avp_bits(?group(Config)). + +%% send_missing_avp/1 +%% +%% Send a request with a missing AVP that a callback answers. + +%% diameter answers. +send_missing_avp([answer, rfc6733]) -> + #'diameter_base_answer-message'{'Result-Code' = 5005, %% MISSING_AVP + 'Failed-AVP' = [_], + 'AVP' = []} + = call(); + +%% Callback answers. +send_missing_avp([_,_]) -> + #diameter_base_STA{'Result-Code' = 5005, %% MISSING_AVP + 'Failed-AVP' = [_], + 'AVP' = []} + = call(); + +send_missing_avp(Config) -> + send_missing_avp(?group(Config)). + +%% send_ignore_missing_avp/1 +%% +%% Send a request with a missing AVP that a callback ignores. + +%% diameter answers. +send_ignore_missing_avp([answer, rfc6733]) -> + #'diameter_base_answer-message'{'Result-Code' = 5005, %% MISSING_AVP + 'Failed-AVP' = [_], + 'AVP' = []} + = call(); + +%% Callback answers, ignores the error +send_ignore_missing_avp([_,_]) -> + #diameter_base_STA{'Result-Code' = 2001, %% SUCCESS + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +send_ignore_missing_avp(Config) -> + send_ignore_missing_avp(?group(Config)). + +%% send_double_error/1 +%% +%% Send a request with both an incorrect length on the optional +%% Origin-State-Id and a missing AVP. + +%% Callback answers with STA. +send_double_error([callback, _]) -> + #diameter_base_STA{'Result-Code' = 5005, %% MISSING_AVP + 'Failed-AVP' = [_], + 'AVP' = []} + = call(); + +%% diameter answers with answer-message. +send_double_error([_,_]) -> + #'diameter_base_answer-message'{'Result-Code' = 3009, %% INVALID_AVP_BITS + 'Failed-AVP' = [_], + 'AVP' = []} + = call(); + +send_double_error(Config) -> + send_double_error(?group(Config)). + +%% send_3xxx/1 +%% +%% Send a request that's answered with a 3xxx result code. + +%% Callback answers. +send_3xxx([_,_]) -> + #'diameter_base_answer-message'{'Result-Code' = 3999, + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +send_3xxx(Config) -> + send_3xxx(?group(Config)). + +%% send_5xxx/1 +%% +%% Send a request that's answered with a 5xxx result code. + +%% Callback answers but fails since 5xxx isn't allowed in an RFC 3588 +%% answer-message. +send_5xxx([_, rfc3588]) -> + {error, timeout} = call(); + +%% Callback answers. +send_5xxx([_,_]) -> + #'diameter_base_answer-message'{'Result-Code' = 5999, + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +send_5xxx(Config) -> + send_5xxx(?group(Config)). + +%% =========================================================================== + +call() -> + Name = ?testcase(), + diameter:call(?CLIENT, + ?DICT, + #diameter_base_STR + {'Termination-Cause' = ?LOGOUT, + 'Auth-Application-Id' = ?COMMON, + 'Class' = [?L(Name)]}, + [{extra, [Name]}]). + +%% =========================================================================== +%% diameter callbacks + +%% peer_up/3 + +peer_up(_SvcName, _Peer, State) -> + State. + +%% peer_down/3 + +peer_down(_SvcName, _Peer, State) -> + State. + +%% pick_peer/5 + +pick_peer([Peer], _, ?CLIENT, _State, _Name) -> + {ok, Peer}. + +%% prepare_request/4 + +prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, Name) -> + {send, prepare(Pkt, Caps, Name)}. + +prepare(Pkt0, Caps, send_unknown_application) -> + Req = sta(Pkt0, Caps), + #diameter_packet{bin = <<H:8/binary, 0:32, T/binary>>} + = Pkt + = diameter_codec:encode(?DICT, Pkt0#diameter_packet{msg = Req}), + + Pkt#diameter_packet{bin = <<H/binary, 23:32, T/binary>>}; + +prepare(Pkt0, Caps, send_unknown_command) -> + Req = sta(Pkt0, Caps), + #diameter_packet{bin = <<H:5/binary, 275:24, T/binary>>} + = Pkt + = diameter_codec:encode(?DICT, Pkt0#diameter_packet{msg = Req}), + + Pkt#diameter_packet{bin = <<H/binary, 572:24, T/binary>>}; + +prepare(Pkt, Caps, T) + when T == send_ok; + T == send_3xxx; + T == send_5xxx -> + sta(Pkt, Caps); + +prepare(Pkt0, Caps, send_invalid_avp_bits) -> + Req0 = sta(Pkt0, Caps), + %% Append an Origin-State-Id with an incorrect AVP Length in order + %% to force 3009. + Req = Req0#diameter_base_STR{'Origin-State-Id' = [7]}, + #diameter_packet{bin = Bin} + = Pkt + = diameter_codec:encode(?DICT, Pkt0#diameter_packet{msg = Req}), + Offset = size(Bin) - 12 + 5, + <<H:Offset/binary, Len:24, T/binary>> = Bin, + Pkt#diameter_packet{bin = <<H/binary, (Len + 2):24, T/binary>>}; + +prepare(Pkt0, Caps, send_double_error) -> + dehost(prepare(Pkt0, Caps, send_invalid_avp_bits)); + +prepare(Pkt, Caps, T) + when T == send_missing_avp; + T == send_ignore_missing_avp -> + Req = sta(Pkt, Caps), + dehost(diameter_codec:encode(?DICT, Pkt#diameter_packet{msg = Req})). + +sta(Pkt, Caps) -> + #diameter_packet{msg = Req} + = Pkt, + #diameter_caps{origin_host = {OH, _}, + origin_realm = {OR, DR}} + = Caps, + Req#diameter_base_STR{'Session-Id' = diameter:session_id(OH), + 'Origin-Host' = OH, + 'Origin-Realm' = OR, + 'Destination-Realm' = DR}. + +%% Strip Origin-Host. +dehost(#diameter_packet{bin = Bin} = Pkt) -> + <<V, Len:24, H:16/binary, T0/binary>> + = Bin, + {SessionId, T1} = split_avp(T0), + {OriginHost, T} = split_avp(T1), + Delta = size(OriginHost), + Pkt#diameter_packet{bin = <<V, (Len - Delta):24, H/binary, + SessionId/binary, + T/binary>>}. + +%% handle_answer/5 + +handle_answer(Pkt, _Req, ?CLIENT, _Peer, _Name) -> + Pkt#diameter_packet.msg. + +%% handle_error/5 + +handle_error(Reason, _Req, ?CLIENT, _Peer, _Name) -> + {error, Reason}. + +split_avp(<<_:5/binary, Len:24, _/binary>> = Bin) -> + L = pad(Len), + <<Avp:L/binary, T/binary>> = Bin, + {Avp, T}. + +pad(N) + when 0 == N rem 4 -> + N; +pad(N) -> + N - (N rem 4) + 4. + +%% handle_request/3 + +handle_request(#diameter_packet{header = #diameter_header{application_id = 0}, + msg = Msg}, + ?SERVER, + {_, Caps}) -> + request(Msg, Caps). + +request(undefined, _) -> %% unknown command + discard; + +request(#diameter_base_STR{'Class' = [Name]} = Req, Caps) -> + request(?A(Name), Req, Caps). + +request(send_ok, Req, Caps) -> + {reply, #diameter_packet{msg = answer(Req, Caps), + errors = [5002]}}; %% UNKNOWN_SESSION_ID + +request(send_3xxx, _Req, _Caps) -> + {answer_message, 3999}; + +request(send_5xxx, _Req, _Caps) -> + {answer_message, 5999}; + +request(send_invalid_avp_bits, Req, Caps) -> + #diameter_base_STR{'Origin-State-Id' = []} + = Req, + %% Default errors field but a non-answer-message and only 3xxx + %% errors detected means diameter sets neither Result-Code nor + %% Failed-AVP. + {reply, #diameter_packet{msg = answer(Req, Caps)}}; + +request(T, Req, Caps) + when T == send_double_error; + T == send_missing_avp -> + {reply, answer(Req, Caps)}; + +request(send_ignore_missing_avp, Req, Caps) -> + {reply, #diameter_packet{msg = answer(Req, Caps), + errors = false}}. %% ignore errors + +answer(Req, Caps) -> + #diameter_base_STR{'Session-Id' = SId} + = Req, + #diameter_caps{origin_host = {OH,_}, + origin_realm = {OR,_}} + = Caps, + #diameter_base_STA{'Session-Id' = SId, + 'Origin-Host' = OH, + 'Origin-Realm' = OR, + 'Result-Code' = 2001}. %% SUCCESS diff --git a/lib/diameter/test/diameter_app_SUITE.erl b/lib/diameter/test/diameter_app_SUITE.erl index 53332af626..209f72adf1 100644 --- a/lib/diameter/test/diameter_app_SUITE.erl +++ b/lib/diameter/test/diameter_app_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -48,7 +48,6 @@ diameter_dict_parser, diameter_dict_util, diameter_exprecs, - diameter_nowarn, diameter_make]). -define(HELP_MODULES, [diameter_dbg, diff --git a/lib/diameter/test/diameter_ct.erl b/lib/diameter/test/diameter_ct.erl index ded50bf6c5..1697287a22 100644 --- a/lib/diameter/test/diameter_ct.erl +++ b/lib/diameter/test/diameter_ct.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -23,16 +23,23 @@ %% Module used to run suites from Makefile. %% --export([run/1]). +-export([run/1, + cover/0]). %% The makefile looks for signs of failure so ignore the ct:run_test/1 %% return value. -run([Suite]) -> +run(Suites) -> + ct_run([{suite, Suites}]). + +cover() -> + ct_run([{spec, "./testspec"}]). + +ct_run(Opts) -> Start = info(), - ct:run_test([{suite, Suite}, - {logdir, "./log"}, - {auto_compile, false}]), + ct:run_test([{logdir, "./log"}, + {auto_compile, false} + | Opts]), info(Start , info()). info() -> diff --git a/lib/diameter/test/diameter_failover_SUITE.erl b/lib/diameter/test/diameter_failover_SUITE.erl index bb820a8bf2..0ea8ae2d4e 100644 --- a/lib/diameter/test/diameter_failover_SUITE.erl +++ b/lib/diameter/test/diameter_failover_SUITE.erl @@ -103,9 +103,9 @@ -define(SUCCESS, 2001). %% Value of Termination-Cause determines client/server behaviour. --define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT'). --define(MOVED, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_USER_MOVED'). --define(TIMEOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_SESSION_TIMEOUT'). +-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_LOGOUT'). +-define(MOVED, ?'DIAMETER_BASE_TERMINATION-CAUSE_USER_MOVED'). +-define(TIMEOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_SESSION_TIMEOUT'). %% =========================================================================== diff --git a/lib/diameter/test/diameter_length_SUITE.erl b/lib/diameter/test/diameter_length_SUITE.erl index 4e413e6a42..ffb19d2288 100644 --- a/lib/diameter/test/diameter_length_SUITE.erl +++ b/lib/diameter/test/diameter_length_SUITE.erl @@ -41,10 +41,10 @@ %% diameter callbacks -export([peer_up/3, peer_down/3, - pick_peer/6, - prepare_request/5, - handle_answer/6, - handle_error/6, + pick_peer/5, + prepare_request/4, + handle_answer/5, + handle_error/5, handle_request/3]). -include("diameter.hrl"). @@ -73,14 +73,14 @@ {answer_errors, callback}]}]). -define(SUCCESS, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_SUCCESS'). + ?'DIAMETER_BASE_RESULT-CODE_SUCCESS'). -define(MISSING_AVP, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_MISSING_AVP'). + ?'DIAMETER_BASE_RESULT-CODE_MISSING_AVP'). -define(INVALID_MESSAGE_LENGTH, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_INVALID_MESSAGE_LENGTH'). + ?'DIAMETER_BASE_RESULT-CODE_INVALID_MESSAGE_LENGTH'). -define(LOGOUT, - ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT'). + ?'DIAMETER_BASE_TERMINATION-CAUSE_LOGOUT'). -define(GROUPS, [exit, handle, discard]). @@ -196,21 +196,18 @@ send(discard) -> = call(0); send(Config) -> - Group = proplists:get_value(group, Config), - put({?MODULE, group}, Group), - send(Group). + send(proplists:get_value(group, Config)). %% =========================================================================== call(Delta) -> - Group = get({?MODULE, group}), diameter:call(?CLIENT, ?DICT, #diameter_base_STR {'Termination-Cause' = ?LOGOUT, 'Auth-Application-Id' = ?DIAMETER_APP_ID_COMMON, 'Origin-State-Id' = [7]}, - [{extra, [Group, Delta]}]). + [{extra, [Delta]}]). %% =========================================================================== %% diameter callbacks @@ -225,14 +222,14 @@ peer_up(_SvcName, _Peer, State) -> peer_down(_SvcName, _Peer, State) -> State. -%% pick_peer/6 +%% pick_peer/5 -pick_peer([Peer], _, ?CLIENT, _State, _Group, _Delta) -> +pick_peer([Peer], _, ?CLIENT, _State, _Delta) -> {ok, Peer}. -%% prepare_request/5 +%% prepare_request/4 -prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, _Group, Delta) -> +prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, Delta) -> {send, resize(Delta, prepare(Pkt, Caps))}. prepare(#diameter_packet{msg = Req0} = Pkt, Caps) -> @@ -253,14 +250,14 @@ resize(Delta, #diameter_packet{bin = Bin} = Pkt) -> resize(Delta, <<V, Len:24, T/binary>>) -> <<V, (Len + Delta):24, T/binary>>. -%% handle_answer/6 +%% handle_answer/5 -handle_answer(Pkt, _Req, ?CLIENT, _Peer, _Group, _Delta) -> +handle_answer(Pkt, _Req, ?CLIENT, _Peer, _Delta) -> Pkt#diameter_packet.msg. -%% handle_error/6 +%% handle_error/5 -handle_error(Reason, _Req, ?CLIENT, _Peer, _Group, _Delta) -> +handle_error(Reason, _Req, ?CLIENT, _Peer, _Delta) -> {error, Reason}. %% handle_request/3 @@ -280,8 +277,12 @@ handle_request(Pkt, ?SERVER, {_Ref, Caps}) -> answer(Group, #diameter_packet{errors = Es}, Ans) -> answer(Group, Es, Ans); +%% No errors: just answer. answer(_, [], Ans) -> {reply, Ans}; + +%% Otherwise an invalid length should only reach the callback if +%% length_errors = handle. answer(Group, [RC|_], Ans) when RC == ?INVALID_MESSAGE_LENGTH, Group == handle; RC /= ?INVALID_MESSAGE_LENGTH -> diff --git a/lib/diameter/test/diameter_relay_SUITE.erl b/lib/diameter/test/diameter_relay_SUITE.erl index f10d82bdf8..614eb4d4ca 100644 --- a/lib/diameter/test/diameter_relay_SUITE.erl +++ b/lib/diameter/test/diameter_relay_SUITE.erl @@ -107,7 +107,7 @@ -define(LOOP_DETECTED, 3005). -define(UNABLE_TO_DELIVER, 3002). --define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT'). +-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_LOGOUT'). -define(AUTHORIZE_ONLY, ?'DIAMETER_BASE_RE-AUTH-REQUEST-TYPE_AUTHORIZE_ONLY'). %% =========================================================================== diff --git a/lib/diameter/test/diameter_tls_SUITE.erl b/lib/diameter/test/diameter_tls_SUITE.erl index 6cc34b20c5..92a1113758 100644 --- a/lib/diameter/test/diameter_tls_SUITE.erl +++ b/lib/diameter/test/diameter_tls_SUITE.erl @@ -122,7 +122,7 @@ {capabilities, Caps}]}). -define(SUCCESS, 2001). --define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT'). +-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_LOGOUT'). %% =========================================================================== diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl index 6727e88b66..781ed234cc 100644 --- a/lib/diameter/test/diameter_traffic_SUITE.erl +++ b/lib/diameter/test/diameter_traffic_SUITE.erl @@ -178,27 +178,27 @@ diameter_gen_acct_rfc6733]]]). -define(SUCCESS, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_SUCCESS'). + ?'DIAMETER_BASE_RESULT-CODE_SUCCESS'). -define(COMMAND_UNSUPPORTED, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_COMMAND_UNSUPPORTED'). + ?'DIAMETER_BASE_RESULT-CODE_COMMAND_UNSUPPORTED'). -define(TOO_BUSY, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_TOO_BUSY'). + ?'DIAMETER_BASE_RESULT-CODE_TOO_BUSY'). -define(APPLICATION_UNSUPPORTED, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_APPLICATION_UNSUPPORTED'). + ?'DIAMETER_BASE_RESULT-CODE_APPLICATION_UNSUPPORTED'). -define(INVALID_HDR_BITS, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_INVALID_HDR_BITS'). + ?'DIAMETER_BASE_RESULT-CODE_INVALID_HDR_BITS'). -define(INVALID_AVP_BITS, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_INVALID_AVP_BITS'). + ?'DIAMETER_BASE_RESULT-CODE_INVALID_AVP_BITS'). -define(AVP_UNSUPPORTED, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_AVP_UNSUPPORTED'). + ?'DIAMETER_BASE_RESULT-CODE_AVP_UNSUPPORTED'). -define(UNSUPPORTED_VERSION, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_UNSUPPORTED_VERSION'). + ?'DIAMETER_BASE_RESULT-CODE_UNSUPPORTED_VERSION'). -define(REALM_NOT_SERVED, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_REALM_NOT_SERVED'). + ?'DIAMETER_BASE_RESULT-CODE_REALM_NOT_SERVED'). -define(UNABLE_TO_DELIVER, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_UNABLE_TO_DELIVER'). + ?'DIAMETER_BASE_RESULT-CODE_UNABLE_TO_DELIVER'). -define(INVALID_AVP_LENGTH, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_INVALID_AVP_LENGTH'). + ?'DIAMETER_BASE_RESULT-CODE_INVALID_AVP_LENGTH'). -define(EVENT_RECORD, ?'DIAMETER_BASE_ACCOUNTING-RECORD-TYPE_EVENT_RECORD'). @@ -208,11 +208,11 @@ ?'DIAMETER_BASE_RE-AUTH-REQUEST-TYPE_AUTHORIZE_AUTHENTICATE'). -define(LOGOUT, - ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT'). + ?'DIAMETER_BASE_TERMINATION-CAUSE_LOGOUT'). -define(BAD_ANSWER, - ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_BAD_ANSWER'). + ?'DIAMETER_BASE_TERMINATION-CAUSE_BAD_ANSWER'). -define(USER_MOVED, - ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_USER_MOVED'). + ?'DIAMETER_BASE_TERMINATION-CAUSE_USER_MOVED'). %% =========================================================================== @@ -798,7 +798,8 @@ prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, Name, Group) -> prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, send_detach, Group, _) -> {eval_packet, {send, prepare(Pkt, Caps, Group)}, [fun log/2, detach]}. -log(#diameter_packet{} = P, T) -> +log(#diameter_packet{bin = Bin} = P, T) + when is_binary(Bin) -> io:format("~p: ~p~n", [T,P]). %% prepare/4 @@ -980,7 +981,8 @@ answer(T, {Tag, Action, Post}) -> {Tag, answer(T, Action), Post}; answer({A,C}, {reply, Ans}) -> answer(C, {reply, msg(Ans, A, diameter_gen_base_rfc3588)}); -answer(pkt, {reply, Ans}) -> +answer(pkt, {reply, Ans}) + when not is_record(Ans, diameter_packet) -> {reply, #diameter_packet{msg = Ans}}; answer(_, T) -> T. diff --git a/lib/diameter/test/modules.mk b/lib/diameter/test/modules.mk index f575085843..c4a713fb10 100644 --- a/lib/diameter/test/modules.mk +++ b/lib/diameter/test/modules.mk @@ -22,27 +22,28 @@ COVER_SPEC_FILE = diameter.cover MODULES = \ diameter_ct \ - diameter_util \ diameter_enum \ - diameter_compiler_SUITE \ + diameter_util \ + diameter_3xxx_SUITE \ + diameter_app_SUITE \ + diameter_capx_SUITE \ diameter_codec_SUITE \ diameter_codec_test \ - diameter_app_SUITE \ + diameter_compiler_SUITE \ diameter_dict_SUITE \ - diameter_reg_SUITE \ - diameter_sync_SUITE \ - diameter_stats_SUITE \ - diameter_watchdog_SUITE \ + diameter_dpr_SUITE \ + diameter_event_SUITE \ + diameter_failover_SUITE \ diameter_gen_sctp_SUITE \ - diameter_transport_SUITE \ - diameter_capx_SUITE \ - diameter_traffic_SUITE \ + diameter_length_SUITE \ + diameter_reg_SUITE \ diameter_relay_SUITE \ + diameter_stats_SUITE \ + diameter_sync_SUITE \ diameter_tls_SUITE \ - diameter_failover_SUITE \ - diameter_dpr_SUITE \ - diameter_event_SUITE \ - diameter_length_SUITE + diameter_traffic_SUITE \ + diameter_transport_SUITE \ + diameter_watchdog_SUITE HRL_FILES = \ diameter_ct.hrl diff --git a/lib/diameter/test/testspec b/lib/diameter/test/testspec new file mode 100644 index 0000000000..2fd8307281 --- /dev/null +++ b/lib/diameter/test/testspec @@ -0,0 +1,3 @@ + +{suites, ".", all}. +{cover, "./coverspec"}. diff --git a/lib/diameter/vsn.mk b/lib/diameter/vsn.mk index 74f4c57b70..98e719c50a 100644 --- a/lib/diameter/vsn.mk +++ b/lib/diameter/vsn.mk @@ -18,5 +18,5 @@ # %CopyrightEnd% APPLICATION = diameter -DIAMETER_VSN = 1.4 +DIAMETER_VSN = 1.4.1 APP_VSN = $(APPLICATION)-$(DIAMETER_VSN)$(PRE_VSN) diff --git a/lib/edoc/src/edoc.erl b/lib/edoc/src/edoc.erl index 599036f380..a87a8471e3 100644 --- a/lib/edoc/src/edoc.erl +++ b/lib/edoc/src/edoc.erl @@ -660,7 +660,7 @@ read_source(Name, Opts0) -> check_forms(Forms, Name), Forms; {error, R} -> - edoc_report:error({"error reading file '~s'.", + edoc_report:error({"error reading file '~ts'.", [edoc_lib:filename(Name)]}), exit({error, R}) end. @@ -677,7 +677,84 @@ read_source_2(Name, Opts) -> Includes = proplists:append_values(includes, Opts) ++ [filename:dirname(Name)], Macros = proplists:append_values(macros, Opts), - epp:parse_file(Name, Includes, Macros). + %% epp:parse_file(Name, Includes, Macros). + parse_file(Name, Includes, Macros). + +%% The code below has been copied from epp.erl. +%% +%% Copy the line of the last token to the last token that will be +%% part of the parse tree. +%% +%% The last line is used in edoc_extract:find_type_docs() to determine +%% if a type declaration is followed by a comment. +%% <example> +%% -type t() :: [ +%% {tag, integer()} +%% ]. +%% %% Protocol options. +%% </example> +%% The line of the dot token will be copied to the integer token. + +parse_file(Name, Includes, Macros) -> + case epp:open(Name, Includes, Macros) of + {ok, Epp} -> + try {ok, parse_file(Epp)} + after _ = epp:close(Epp) + end; + Error -> + Error + end. + +parse_file(Epp) -> + case scan_and_parse(Epp) of + {ok, Form} -> + case Form of + {attribute,La,record,{Record, Fields}} -> + case epp:normalize_typed_record_fields(Fields) of + {typed, NewFields} -> + [{attribute, La, record, {Record, NewFields}}, + {attribute, La, type, + {{record, Record}, Fields, []}} + | parse_file(Epp)]; + not_typed -> + [Form | parse_file(Epp)] + end; + _ -> + [Form | parse_file(Epp)] + end; + {error, E} -> + [{error, E} | parse_file(Epp)]; + {eof, Location} -> + [{eof, Location}] + end. + +scan_and_parse(Epp) -> + case epp:scan_erl_form(Epp) of + {ok, Toks0} -> + Toks = fix_last_line(Toks0), + case erl_parse:parse_form(Toks) of + {ok, Form} -> + {ok, Form}; + Else -> + Else + end; + Else -> + Else + end. + +fix_last_line(Toks0) -> + Toks1 = lists:reverse(Toks0), + {line, LastLine} = erl_scan:token_info(hd(Toks1), line), + fll(Toks1, LastLine, []). + +fll([{Category, Attributes0, Symbol} | L], LastLine, Ts) -> + F = fun(_OldLine) -> LastLine end, + Attributes = erl_scan:set_attribute(line, Attributes0, F), + lists:reverse(L, [{Category, Attributes, Symbol} | Ts]); +fll([T | L], LastLine, Ts) -> + fll(L, LastLine, [T | Ts]); +fll(L, _LastLine, Ts) -> + lists:reverse(L, Ts). check_forms(Fs, Name) -> Fun = fun (F) -> diff --git a/lib/edoc/src/edoc_doclet.erl b/lib/edoc/src/edoc_doclet.erl index a0c1ae1c0f..ce1e94a26a 100644 --- a/lib/edoc/src/edoc_doclet.erl +++ b/lib/edoc/src/edoc_doclet.erl @@ -200,7 +200,7 @@ source({M, P, Name, Path}, Dir, Suffix, Env, Set, Private, Hidden, {Set, Error} end; R -> - report("skipping source file '~s': ~W.", [File, R, 15]), + report("skipping source file '~ts': ~W.", [File, R, 15]), {Set, true} end. @@ -216,14 +216,14 @@ check_name(M, M0, P0, File) -> ok; _ -> if N =/= N0 -> - warning("file '~s' actually contains module '~s'.", + warning("file '~ts' actually contains module '~s'.", [File, M]); true -> ok end end, if P =/= P0 -> - warning("file '~s' belongs to package '~s', not '~s'.", + warning("file '~ts' belongs to package '~s', not '~s'.", [File, P, P0]); true -> ok diff --git a/lib/edoc/src/edoc_lib.erl b/lib/edoc/src/edoc_lib.erl index d9c225e099..276f48453e 100644 --- a/lib/edoc/src/edoc_lib.erl +++ b/lib/edoc/src/edoc_lib.erl @@ -466,20 +466,20 @@ uri_get("file://localhost/" ++ Path) -> uri_get_file(Path); uri_get("file://" ++ Path) -> Msg = io_lib:format("cannot handle 'file:' scheme with " - "nonlocal network-path: 'file://~s'.", + "nonlocal network-path: 'file://~ts'.", [Path]), {error, Msg}; uri_get("file:/" ++ Path) -> uri_get_file(Path); uri_get("file:" ++ Path) -> - Msg = io_lib:format("ignoring malformed URI: 'file:~s'.", [Path]), + Msg = io_lib:format("ignoring malformed URI: 'file:~ts'.", [Path]), {error, Msg}; uri_get("http:" ++ Path) -> uri_get_http("http:" ++ Path); uri_get("ftp:" ++ Path) -> uri_get_ftp("ftp:" ++ Path); uri_get("//" ++ Path) -> - Msg = io_lib:format("cannot access network-path: '//~s'.", [Path]), + Msg = io_lib:format("cannot access network-path: '//~ts'.", [Path]), {error, Msg}; uri_get([C, $:, $/ | _]=Path) when C >= $A, C =< $Z; C >= $a, C =< $z -> uri_get_file(Path); % special case for Windows @@ -490,7 +490,7 @@ uri_get(URI) -> true -> uri_get_file(URI); false -> - Msg = io_lib:format("cannot handle URI: '~s'.", [URI]), + Msg = io_lib:format("cannot handle URI: '~ts'.", [URI]), {error, Msg} end. @@ -555,12 +555,12 @@ uri_get_http_1(Result, URI) -> end. http_errmsg(Reason, URI) -> - io_lib:format("http error: ~s: '~s'", [Reason, URI]). + io_lib:format("http error: ~ts: '~ts'", [Reason, URI]). %% TODO: implement ftp access method uri_get_ftp(URI) -> - Msg = io_lib:format("cannot access ftp scheme yet: '~s'.", [URI]), + Msg = io_lib:format("cannot access ftp scheme yet: '~ts'.", [URI]), {error, Msg}. %% @private @@ -615,7 +615,7 @@ copy_file(From, To) -> {ok, _} -> ok; {error, R} -> R1 = file:format_error(R), - report("error copying '~s' to '~s': ~s.", [From, To, R1]), + report("error copying '~ts' to '~ts': ~ts.", [From, To, R1]), exit(error) end. @@ -631,7 +631,7 @@ list_dir(Dir, Error) -> fun (S, As) -> warning(S, As), [] end end, R1 = file:format_error(R), - F("could not read directory '~s': ~s.", [filename(Dir), R1]) + F("could not read directory '~ts': ~ts.", [filename(Dir), R1]) end. %% @private @@ -667,7 +667,7 @@ simplify_path(P) -> %% ok -> ok; %% {error, R} -> %% R1 = file:format_error(R), -%% report("cannot create directory '~s': ~s.", [Dir, R1]), +%% report("cannot create directory '~ts': ~ts.", [Dir, R1]), %% exit(error) %% end. @@ -707,7 +707,7 @@ write_file(Text, Dir, Name, Package, Options) -> ok = file:close(FD); {error, R} -> R1 = file:format_error(R), - report("could not write file '~s': ~s.", [File, R1]), + report("could not write file '~ts': ~ts.", [File, R1]), exit(error) end. @@ -761,7 +761,7 @@ read_info_file(Dir) -> parse_info_file(Text, File); {error, R} -> R1 = file:format_error(R), - warning("could not read '~s': ~s.", [File, R1]), + warning("could not read '~ts': ~ts.", [File, R1]), {?NO_APP, [], []} end; false -> @@ -776,7 +776,7 @@ uri_get_info_file(Base) -> {ok, Text} -> parse_info_file(Text, URI); {error, Msg} -> - warning("could not read '~s': ~s.", [URI, Msg]), + warning("could not read '~ts': ~ts.", [URI, Msg]), {?NO_APP, [], []} end. @@ -785,10 +785,10 @@ parse_info_file(Text, Name) -> {ok, Vs} -> info_file_data(Vs); {error, eof} -> - warning("unexpected end of file in '~s'.", [Name]), + warning("unexpected end of file in '~ts'.", [Name]), {?NO_APP, [], []}; {error, {_Line,Module,R}} -> - warning("~s: ~s.", [Module:format_error(R), Name]), + warning("~ts: ~ts.", [Module:format_error(R), Name]), {?NO_APP, [], []} end. @@ -1033,7 +1033,7 @@ run_plugin(Name, Key, Default, Fun, Opts) when is_atom(Name) -> {ok, Value} -> Value; R -> - report("error in ~s '~w': ~W.", [Name, Module, R, 20]), + report("error in ~ts '~w': ~W.", [Name, Module, R, 20]), exit(error) end. diff --git a/lib/edoc/src/edoc_macros.erl b/lib/edoc/src/edoc_macros.erl index 08686c4fb5..8efbfd00c7 100644 --- a/lib/edoc/src/edoc_macros.erl +++ b/lib/edoc/src/edoc_macros.erl @@ -88,7 +88,7 @@ link_macro(S, Line, Env) -> true -> " target=\"_top\""; % note the initial space false -> "" end, - lists:flatten(io_lib:fwrite("<a href=\"~s\"~s>~ts</a>", + lists:flatten(io_lib:fwrite("<a href=\"~ts\"~ts>~ts</a>", [URI, Target, Txt])). section_macro(S, _Line, _Env) -> @@ -102,7 +102,7 @@ type_macro(S, Line, Env) -> Def = edoc_parser:parse_typedef(S1, Line), {#t_typedef{type = T}, _} = Def, Txt = edoc_layout:type(edoc_data:type(T, Env)), - lists:flatten(io_lib:fwrite("<code>~s</code>", [Txt])). + lists:flatten(io_lib:fwrite("<code>~ts</code>", [Txt])). %% Expand inline macros in tag content. diff --git a/lib/edoc/src/edoc_parser.yrl b/lib/edoc/src/edoc_parser.yrl index cf1a2d6b11..a20f152f34 100644 --- a/lib/edoc/src/edoc_parser.yrl +++ b/lib/edoc/src/edoc_parser.yrl @@ -462,4 +462,4 @@ throw_error({parse_throws, E}, L) -> throw_error(parse_param, L) -> throw({error, L, "missing parameter name"}); throw_error({Where, E}, L) when is_list(Where) -> - throw({error,L,{"unknown error parsing ~s: ~P.",[Where,E,15]}}). + throw({error,L,{"unknown error parsing ~ts: ~P.",[Where,E,15]}}). diff --git a/lib/edoc/src/edoc_report.erl b/lib/edoc/src/edoc_report.erl index 9bec08ab97..dc6320df6d 100644 --- a/lib/edoc/src/edoc_report.erl +++ b/lib/edoc/src/edoc_report.erl @@ -83,13 +83,13 @@ report(L, Where, S, Vs) -> io:nl(). where({File, module}) -> - io_lib:fwrite("~s, in module header: ", [File]); + io_lib:fwrite("~ts, in module header: ", [File]); where({File, footer}) -> - io_lib:fwrite("~s, in module footer: ", [File]); + io_lib:fwrite("~ts, in module footer: ", [File]); where({File, header}) -> - io_lib:fwrite("~s, in header file: ", [File]); + io_lib:fwrite("~ts, in header file: ", [File]); where({File, {F, A}}) -> - io_lib:fwrite("~s, function ~s/~w: ", [File, F, A]); + io_lib:fwrite("~ts, function ~s/~w: ", [File, F, A]); where([]) -> io_lib:fwrite("~s: ", [?APPLICATION]); where(File) when is_list(File) -> diff --git a/lib/edoc/src/edoc_run.erl b/lib/edoc/src/edoc_run.erl index 48b6137ac1..b5a1ef713d 100644 --- a/lib/edoc/src/edoc_run.erl +++ b/lib/edoc/src/edoc_run.erl @@ -162,7 +162,7 @@ file(Args) -> -spec invalid_args(string(), list()) -> no_return(). invalid_args(Where, Args) -> - report("invalid arguments to ~s: ~w.", [Where, Args]), + report("invalid arguments to ~ts: ~w.", [Where, Args]), shutdown_error(). run(F) -> @@ -213,13 +213,13 @@ parse_arg(A) -> {ok, Expr} -> case catch erl_parse:normalise(Expr) of {'EXIT', _} -> - report("bad argument: '~s':", [A]), + report("bad argument: '~ts':", [A]), exit(error); Term -> Term end; {error, _, D} -> - report("error parsing argument '~s'", [A]), + report("error parsing argument '~ts'", [A]), error(D), exit(error) end. diff --git a/lib/edoc/src/edoc_tags.erl b/lib/edoc/src/edoc_tags.erl index 2d986988c2..eb41f1922a 100644 --- a/lib/edoc/src/edoc_tags.erl +++ b/lib/edoc/src/edoc_tags.erl @@ -391,10 +391,10 @@ parse_header(Data, Line, Env, Where) when is_list(Where) -> -spec throw_error(line(), err()) -> no_return(). throw_error(L, {read_file, File, R}) -> - throw_error(L, {"error reading file '~s': ~w", + throw_error(L, {"error reading file '~ts': ~w", [edoc_lib:filename(File), R]}); throw_error(L, {file_not_found, F}) -> - throw_error(L, {"file not found: ~s", [F]}); + throw_error(L, {"file not found: ~ts", [F]}); throw_error(L, file_not_string) -> throw_error(L, "expected file name as a string"); throw_error(L, D) -> diff --git a/lib/edoc/src/edoc_wiki.erl b/lib/edoc/src/edoc_wiki.erl index cc0529d2a9..5d0d78bf3c 100644 --- a/lib/edoc/src/edoc_wiki.erl +++ b/lib/edoc/src/edoc_wiki.erl @@ -295,7 +295,7 @@ expand_uri([], _, L, _Ss, Us, _As) -> expand_uri_error(Us, L) -> {Ps, _} = edoc_lib:split_at(lists:reverse(Us), $:), - throw_error(L, {"reference '[~s:...' ended unexpectedly", [Ps]}). + throw_error(L, {"reference '[~ts:...' ended unexpectedly", [Ps]}). push_uri(Us, Ss, As) -> diff --git a/lib/erl_interface/src/auxdir/config.guess b/lib/erl_interface/src/auxdir/config.guess index 38a833903b..f475ceb413 100755 --- a/lib/erl_interface/src/auxdir/config.guess +++ b/lib/erl_interface/src/auxdir/config.guess @@ -1,14 +1,12 @@ #! /bin/sh # Attempt to guess a canonical system name. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, -# Inc. +# Copyright 1992-2013 Free Software Foundation, Inc. -timestamp='2007-05-17' +timestamp='2013-02-12' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or +# the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, but @@ -17,26 +15,22 @@ timestamp='2007-05-17' # General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. +# along with this program; if not, see <http://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - - -# Originally written by Per Bothner <[email protected]>. -# Please send patches to <[email protected]>. Submit a context -# diff and a properly formatted ChangeLog entry. +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). +# +# Originally written by Per Bothner. # -# This script attempts to guess a canonical system name similar to -# config.sub. If it succeeds, it prints the system name on stdout, and -# exits with 0. Otherwise, it exits with 1. +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD # -# The plan is that this can be called by configure scripts if you -# don't specify an explicit build system type. +# Please send patches with a ChangeLog entry to [email protected]. + me=`echo "$0" | sed -e 's,.*/,,'` @@ -56,8 +50,7 @@ version="\ GNU config.guess ($timestamp) Originally written by Per Bothner. -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 -Free Software Foundation, Inc. +Copyright 1992-2013 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -144,7 +137,7 @@ UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in *:NetBSD:*:*) # NetBSD (nbsd) targets should (where applicable) match one or - # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*, + # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*, # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently # switched to ELF, *-*-netbsd* would select the old # object file format. This provides both forward @@ -170,7 +163,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in arm*|i386|m68k|ns32k|sh3*|sparc|vax) eval $set_cc_for_build if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep __ELF__ >/dev/null + | grep -q __ELF__ then # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). # Return netbsd for either. FIX? @@ -180,7 +173,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in fi ;; *) - os=netbsd + os=netbsd ;; esac # The OS release @@ -201,6 +194,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. echo "${machine}-${os}${release}" exit ;; + *:Bitrig:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'` + echo ${UNAME_MACHINE_ARCH}-unknown-bitrig${UNAME_RELEASE} + exit ;; *:OpenBSD:*:*) UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} @@ -223,7 +220,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` ;; *5.*) - UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` ;; esac # According to Compaq, /usr/sbin/psrinfo has been available on @@ -269,7 +266,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # A Xn.n version is an unreleased experimental baselevel. # 1.2 uses "1.2" for uname -r. echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - exit ;; + # Reset EXIT trap before exiting to avoid spurious non-zero exit code. + exitcode=$? + trap '' 0 + exit $exitcode ;; Alpha\ *:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # Should we change UNAME_MACHINE based on the output of uname instead @@ -295,12 +295,12 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in echo s390-ibm-zvmoe exit ;; *:OS400:*:*) - echo powerpc-ibm-os400 + echo powerpc-ibm-os400 exit ;; arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) echo arm-acorn-riscix${UNAME_RELEASE} exit ;; - arm:riscos:*:*|arm:RISCOS:*:*) + arm*:riscos:*:*|arm*:RISCOS:*:*) echo arm-unknown-riscos exit ;; SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) @@ -324,14 +324,33 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in case `/usr/bin/uname -p` in sparc) echo sparc-icl-nx7; exit ;; esac ;; + s390x:SunOS:*:*) + echo ${UNAME_MACHINE}-ibm-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; sun4H:SunOS:5.*:*) echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; - i86pc:SunOS:5.*:* | ix86xen:SunOS:5.*:*) - echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) + echo i386-pc-auroraux${UNAME_RELEASE} + exit ;; + i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) + eval $set_cc_for_build + SUN_ARCH="i386" + # If there is a compiler, see if it is configured for 64-bit objects. + # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. + # This test works for both compilers. + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + SUN_ARCH="x86_64" + fi + fi + echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:6*:*) # According to config.sub, this is the proper way to canonicalize @@ -375,23 +394,23 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # MiNT. But MiNT is downward compatible to TOS, so this should # be no problem. atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} + echo m68k-atari-mint${UNAME_RELEASE} exit ;; atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) echo m68k-atari-mint${UNAME_RELEASE} - exit ;; + exit ;; *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} + echo m68k-atari-mint${UNAME_RELEASE} exit ;; milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) - echo m68k-milan-mint${UNAME_RELEASE} - exit ;; + echo m68k-milan-mint${UNAME_RELEASE} + exit ;; hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) - echo m68k-hades-mint${UNAME_RELEASE} - exit ;; + echo m68k-hades-mint${UNAME_RELEASE} + exit ;; *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) - echo m68k-unknown-mint${UNAME_RELEASE} - exit ;; + echo m68k-unknown-mint${UNAME_RELEASE} + exit ;; m68k:machten:*:*) echo m68k-apple-machten${UNAME_RELEASE} exit ;; @@ -461,8 +480,8 @@ EOF echo m88k-motorola-sysv3 exit ;; AViiON:dgux:*:*) - # DG/UX returns AViiON for all architectures - UNAME_PROCESSOR=`/usr/bin/uname -p` + # DG/UX returns AViiON for all architectures + UNAME_PROCESSOR=`/usr/bin/uname -p` if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] then if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ @@ -475,7 +494,7 @@ EOF else echo i586-dg-dgux${UNAME_RELEASE} fi - exit ;; + exit ;; M88*:DolphinOS:*:*) # DolphinOS (SVR3) echo m88k-dolphin-sysv3 exit ;; @@ -532,7 +551,7 @@ EOF echo rs6000-ibm-aix3.2 fi exit ;; - *:AIX:*:[45]) + *:AIX:*:[4567]) IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then IBM_ARCH=rs6000 @@ -575,52 +594,52 @@ EOF 9000/[678][0-9][0-9]) if [ -x /usr/bin/getconf ]; then sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` - sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` - case "${sc_cpu_version}" in - 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 - 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 - 532) # CPU_PA_RISC2_0 - case "${sc_kernel_bits}" in - 32) HP_ARCH="hppa2.0n" ;; - 64) HP_ARCH="hppa2.0w" ;; + sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` + case "${sc_cpu_version}" in + 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 + 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 + 532) # CPU_PA_RISC2_0 + case "${sc_kernel_bits}" in + 32) HP_ARCH="hppa2.0n" ;; + 64) HP_ARCH="hppa2.0w" ;; '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 - esac ;; - esac + esac ;; + esac fi if [ "${HP_ARCH}" = "" ]; then eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c + sed 's/^ //' << EOF >$dummy.c - #define _HPUX_SOURCE - #include <stdlib.h> - #include <unistd.h> + #define _HPUX_SOURCE + #include <stdlib.h> + #include <unistd.h> - int main () - { - #if defined(_SC_KERNEL_BITS) - long bits = sysconf(_SC_KERNEL_BITS); - #endif - long cpu = sysconf (_SC_CPU_VERSION); + int main () + { + #if defined(_SC_KERNEL_BITS) + long bits = sysconf(_SC_KERNEL_BITS); + #endif + long cpu = sysconf (_SC_CPU_VERSION); - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1"); break; - case CPU_PA_RISC2_0: - #if defined(_SC_KERNEL_BITS) - switch (bits) - { - case 64: puts ("hppa2.0w"); break; - case 32: puts ("hppa2.0n"); break; - default: puts ("hppa2.0"); break; - } break; - #else /* !defined(_SC_KERNEL_BITS) */ - puts ("hppa2.0"); break; - #endif - default: puts ("hppa1.0"); break; - } - exit (0); - } + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1"); break; + case CPU_PA_RISC2_0: + #if defined(_SC_KERNEL_BITS) + switch (bits) + { + case 64: puts ("hppa2.0w"); break; + case 32: puts ("hppa2.0n"); break; + default: puts ("hppa2.0"); break; + } break; + #else /* !defined(_SC_KERNEL_BITS) */ + puts ("hppa2.0"); break; + #endif + default: puts ("hppa1.0"); break; + } + exit (0); + } EOF (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` test -z "$HP_ARCH" && HP_ARCH=hppa @@ -640,7 +659,7 @@ EOF # => hppa64-hp-hpux11.23 if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | - grep __LP64__ >/dev/null + grep -q __LP64__ then HP_ARCH="hppa2.0w" else @@ -711,22 +730,22 @@ EOF exit ;; C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) echo c1-convex-bsd - exit ;; + exit ;; C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) if getsysinfo -f scalar_acc then echo c32-convex-bsd else echo c2-convex-bsd fi - exit ;; + exit ;; C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) echo c34-convex-bsd - exit ;; + exit ;; C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) echo c38-convex-bsd - exit ;; + exit ;; C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) echo c4-convex-bsd - exit ;; + exit ;; CRAY*Y-MP:*:*:*) echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; @@ -750,14 +769,14 @@ EOF exit ;; F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` - echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit ;; + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` + echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; 5000:UNIX_System_V:4.*:*) - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` - echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` + echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" exit ;; i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} @@ -769,40 +788,51 @@ EOF echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} exit ;; *:FreeBSD:*:*) - case ${UNAME_MACHINE} in - pc98) - echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + UNAME_PROCESSOR=`/usr/bin/uname -p` + case ${UNAME_PROCESSOR} in amd64) echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; *) - echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + echo ${UNAME_PROCESSOR}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; esac exit ;; i*:CYGWIN*:*) echo ${UNAME_MACHINE}-pc-cygwin exit ;; + *:MINGW64*:*) + echo ${UNAME_MACHINE}-pc-mingw64 + exit ;; *:MINGW*:*) echo ${UNAME_MACHINE}-pc-mingw32 exit ;; + i*:MSYS*:*) + echo ${UNAME_MACHINE}-pc-msys + exit ;; i*:windows32*:*) - # uname -m includes "-pc" on this system. - echo ${UNAME_MACHINE}-mingw32 + # uname -m includes "-pc" on this system. + echo ${UNAME_MACHINE}-mingw32 exit ;; i*:PW*:*) echo ${UNAME_MACHINE}-pc-pw32 exit ;; - *:Interix*:[3456]*) - case ${UNAME_MACHINE} in - x86) + *:Interix*:*) + case ${UNAME_MACHINE} in + x86) echo i586-pc-interix${UNAME_RELEASE} exit ;; - EM64T | authenticamd) + authenticamd | genuineintel | EM64T) echo x86_64-unknown-interix${UNAME_RELEASE} exit ;; + IA64) + echo ia64-unknown-interix${UNAME_RELEASE} + exit ;; esac ;; [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) echo i${UNAME_MACHINE}-pc-mks exit ;; + 8664:Windows_NT:*) + echo x86_64-pc-mks + exit ;; i*:Windows_NT*:* | Pentium*:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we @@ -832,20 +862,68 @@ EOF i*86:Minix:*:*) echo ${UNAME_MACHINE}-pc-minix exit ;; - arm*:Linux:*:*) + aarch64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + aarch64_be:Linux:*:*) + UNAME_MACHINE=aarch64_be echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; + alpha:Linux:*:*) + case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in + EV5) UNAME_MACHINE=alphaev5 ;; + EV56) UNAME_MACHINE=alphaev56 ;; + PCA56) UNAME_MACHINE=alphapca56 ;; + PCA57) UNAME_MACHINE=alphapca56 ;; + EV6) UNAME_MACHINE=alphaev6 ;; + EV67) UNAME_MACHINE=alphaev67 ;; + EV68*) UNAME_MACHINE=alphaev68 ;; + esac + objdump --private-headers /bin/sh | grep -q ld.so.1 + if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi + echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + exit ;; + arm*:Linux:*:*) + eval $set_cc_for_build + if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_EABI__ + then + echo ${UNAME_MACHINE}-unknown-linux-gnu + else + if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_PCS_VFP + then + echo ${UNAME_MACHINE}-unknown-linux-gnueabi + else + echo ${UNAME_MACHINE}-unknown-linux-gnueabihf + fi + fi + exit ;; avr32*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; cris:Linux:*:*) - echo cris-axis-linux-gnu + echo ${UNAME_MACHINE}-axis-linux-gnu exit ;; crisv32:Linux:*:*) - echo crisv32-axis-linux-gnu + echo ${UNAME_MACHINE}-axis-linux-gnu exit ;; frv:Linux:*:*) - echo frv-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + hexagon:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + i*86:Linux:*:*) + LIBC=gnu + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #ifdef __dietlibc__ + LIBC=dietlibc + #endif +EOF + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'` + echo "${UNAME_MACHINE}-pc-linux-${LIBC}" exit ;; ia64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu @@ -856,74 +934,36 @@ EOF m68*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - mips:Linux:*:*) - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #undef CPU - #undef mips - #undef mipsel - #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mipsel - #else - #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips - #else - CPU= - #endif - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" - test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } - ;; - mips64:Linux:*:*) + mips:Linux:*:* | mips64:Linux:*:*) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #undef CPU - #undef mips64 - #undef mips64el + #undef ${UNAME_MACHINE} + #undef ${UNAME_MACHINE}el #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mips64el + CPU=${UNAME_MACHINE}el #else #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips64 + CPU=${UNAME_MACHINE} #else CPU= #endif #endif EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'` test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } ;; - or32:Linux:*:*) - echo or32-unknown-linux-gnu + or1k:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - ppc:Linux:*:*) - echo powerpc-unknown-linux-gnu + or32:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - ppc64:Linux:*:*) - echo powerpc64-unknown-linux-gnu + padre:Linux:*:*) + echo sparc-unknown-linux-gnu exit ;; - alpha:Linux:*:*) - case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in - EV5) UNAME_MACHINE=alphaev5 ;; - EV56) UNAME_MACHINE=alphaev56 ;; - PCA56) UNAME_MACHINE=alphapca56 ;; - PCA57) UNAME_MACHINE=alphapca56 ;; - EV6) UNAME_MACHINE=alphaev6 ;; - EV67) UNAME_MACHINE=alphaev67 ;; - EV68*) UNAME_MACHINE=alphaev68 ;; - esac - objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null - if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi - echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + parisc64:Linux:*:* | hppa64:Linux:*:*) + echo hppa64-unknown-linux-gnu exit ;; parisc:Linux:*:* | hppa:Linux:*:*) # Look for CPU level @@ -933,14 +973,17 @@ EOF *) echo hppa-unknown-linux-gnu ;; esac exit ;; - parisc64:Linux:*:* | hppa64:Linux:*:*) - echo hppa64-unknown-linux-gnu + ppc64:Linux:*:*) + echo powerpc64-unknown-linux-gnu + exit ;; + ppc:Linux:*:*) + echo powerpc-unknown-linux-gnu exit ;; s390:Linux:*:* | s390x:Linux:*:*) echo ${UNAME_MACHINE}-ibm-linux exit ;; sh64*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; sh*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu @@ -948,81 +991,18 @@ EOF sparc:Linux:*:* | sparc64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - tile:Linux:*:*) - echo tile-unknown-linux-gnu + tile*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; vax:Linux:*:*) echo ${UNAME_MACHINE}-dec-linux-gnu exit ;; x86_64:Linux:*:*) - echo x86_64-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - xtensa:Linux:*:*) - echo xtensa-unknown-linux-gnu + xtensa*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - i*86:Linux:*:*) - # The BFD linker knows what the default object file format is, so - # first see if it will tell us. cd to the root directory to prevent - # problems with other programs or directories called `ld' in the path. - # Set LC_ALL=C to ensure ld outputs messages in English. - ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \ - | sed -ne '/supported targets:/!d - s/[ ][ ]*/ /g - s/.*supported targets: *// - s/ .*// - p'` - case "$ld_supported_targets" in - elf32-i386) - TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu" - ;; - a.out-i386-linux) - echo "${UNAME_MACHINE}-pc-linux-gnuaout" - exit ;; - coff-i386) - echo "${UNAME_MACHINE}-pc-linux-gnucoff" - exit ;; - "") - # Either a pre-BFD a.out linker (linux-gnuoldld) or - # one that does not give us useful --help. - echo "${UNAME_MACHINE}-pc-linux-gnuoldld" - exit ;; - esac - # Determine whether the default compiler is a.out or elf - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #include <features.h> - #ifdef __ELF__ - # ifdef __GLIBC__ - # if __GLIBC__ >= 2 - LIBC=gnu - # else - LIBC=gnulibc1 - # endif - # else - LIBC=gnulibc1 - # endif - #else - #if defined(__INTEL_COMPILER) || defined(__PGI) || defined(__SUNPRO_C) || defined(__SUNPRO_CC) - LIBC=gnu - #else - LIBC=gnuaout - #endif - #endif - #ifdef __dietlibc__ - LIBC=dietlibc - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^LIBC/{ - s: ::g - p - }'`" - test x"${LIBC}" != x && { - echo "${UNAME_MACHINE}-pc-linux-${LIBC}" - exit - } - test x"${TENTATIVE}" != x && { echo "${TENTATIVE}"; exit; } - ;; i*86:DYNIX/ptx:4*:*) # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. # earlier versions are messed up and put the nodename in both @@ -1030,11 +1010,11 @@ EOF echo i386-sequent-sysv4 exit ;; i*86:UNIX_SV:4.2MP:2.*) - # Unixware is an offshoot of SVR4, but it has its own version - # number series starting with 2... - # I am not positive that other SVR4 systems won't match this, + # Unixware is an offshoot of SVR4, but it has its own version + # number series starting with 2... + # I am not positive that other SVR4 systems won't match this, # I just have to hope. -- rms. - # Use sysv4.2uw... so that sysv4* matches it. + # Use sysv4.2uw... so that sysv4* matches it. echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} exit ;; i*86:OS/2:*:*) @@ -1051,7 +1031,7 @@ EOF i*86:syllable:*:*) echo ${UNAME_MACHINE}-pc-syllable exit ;; - i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*) + i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) echo i386-unknown-lynxos${UNAME_RELEASE} exit ;; i*86:*DOS:*:*) @@ -1066,7 +1046,7 @@ EOF fi exit ;; i*86:*:5:[678]*) - # UnixWare 7.x, OpenUNIX and OpenServer 6. + # UnixWare 7.x, OpenUNIX and OpenServer 6. case `/bin/uname -X | grep "^Machine"` in *486*) UNAME_MACHINE=i486 ;; *Pentium) UNAME_MACHINE=i586 ;; @@ -1094,10 +1074,13 @@ EOF exit ;; pc:*:*:*) # Left here for compatibility: - # uname -m prints for DJGPP always 'pc', but it prints nothing about - # the processor, so we play safe by assuming i386. - echo i386-pc-msdosdjgpp - exit ;; + # uname -m prints for DJGPP always 'pc', but it prints nothing about + # the processor, so we play safe by assuming i586. + # Note: whatever this is, it MUST be the same as what config.sub + # prints for the "djgpp" host, or else GDB configury will decide that + # this is a cross-build. + echo i586-pc-msdosdjgpp + exit ;; Intel:Mach:3*:*) echo i386-pc-mach3 exit ;; @@ -1132,8 +1115,18 @@ EOF /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4; exit; } ;; + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4; exit; } ;; + NCR*:*:4.2:* | MPRAS*:*:4.2:*) + OS_REL='.3' + test -r /etc/.relid \ + && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) echo m68k-unknown-lynxos${UNAME_RELEASE} exit ;; @@ -1146,7 +1139,7 @@ EOF rs6000:LynxOS:2.*:*) echo rs6000-unknown-lynxos${UNAME_RELEASE} exit ;; - PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*) + PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) echo powerpc-unknown-lynxos${UNAME_RELEASE} exit ;; SM[BE]S:UNIX_SV:*:*) @@ -1166,10 +1159,10 @@ EOF echo ns32k-sni-sysv fi exit ;; - PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort - # says <[email protected]> - echo i586-unisys-sysv4 - exit ;; + PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort + # says <[email protected]> + echo i586-unisys-sysv4 + exit ;; *:UNIX_System_V:4*:FTX*) # From Gerald Hewes <[email protected]>. # How about differentiating between stratus architectures? -djm @@ -1195,11 +1188,11 @@ EOF exit ;; R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) if [ -d /usr/nec ]; then - echo mips-nec-sysv${UNAME_RELEASE} + echo mips-nec-sysv${UNAME_RELEASE} else - echo mips-unknown-sysv${UNAME_RELEASE} + echo mips-unknown-sysv${UNAME_RELEASE} fi - exit ;; + exit ;; BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. echo powerpc-be-beos exit ;; @@ -1209,6 +1202,12 @@ EOF BePC:BeOS:*:*) # BeOS running on Intel PC compatible. echo i586-pc-beos exit ;; + BePC:Haiku:*:*) # Haiku running on Intel PC compatible. + echo i586-pc-haiku + exit ;; + x86_64:Haiku:*:*) + echo x86_64-unknown-haiku + exit ;; SX-4:SUPER-UX:*:*) echo sx4-nec-superux${UNAME_RELEASE} exit ;; @@ -1236,6 +1235,16 @@ EOF *:Darwin:*:*) UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown case $UNAME_PROCESSOR in + i386) + eval $set_cc_for_build + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + UNAME_PROCESSOR="x86_64" + fi + fi ;; unknown) UNAME_PROCESSOR=powerpc ;; esac echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} @@ -1251,7 +1260,10 @@ EOF *:QNX:*:4*) echo i386-pc-qnx exit ;; - NSE-?:NONSTOP_KERNEL:*:*) + NEO-?:NONSTOP_KERNEL:*:*) + echo neo-tandem-nsk${UNAME_RELEASE} + exit ;; + NSE-*:NONSTOP_KERNEL:*:*) echo nse-tandem-nsk${UNAME_RELEASE} exit ;; NSR-?:NONSTOP_KERNEL:*:*) @@ -1296,13 +1308,13 @@ EOF echo pdp10-unknown-its exit ;; SEI:*:*:SEIUX) - echo mips-sei-seiux${UNAME_RELEASE} + echo mips-sei-seiux${UNAME_RELEASE} exit ;; *:DragonFly:*:*) echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` exit ;; *:*VMS:*:*) - UNAME_MACHINE=`(uname -p) 2>/dev/null` + UNAME_MACHINE=`(uname -p) 2>/dev/null` case "${UNAME_MACHINE}" in A*) echo alpha-dec-vms ; exit ;; I*) echo ia64-dec-vms ; exit ;; @@ -1317,11 +1329,14 @@ EOF i*86:rdos:*:*) echo ${UNAME_MACHINE}-pc-rdos exit ;; + i*86:AROS:*:*) + echo ${UNAME_MACHINE}-pc-aros + exit ;; + x86_64:VMkernel:*:*) + echo ${UNAME_MACHINE}-unknown-esx + exit ;; esac -#echo '(No uname command or uname output not recognized.)' 1>&2 -#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 - eval $set_cc_for_build cat >$dummy.c <<EOF #ifdef _SEQUENT_ @@ -1339,11 +1354,11 @@ main () #include <sys/param.h> printf ("m68k-sony-newsos%s\n", #ifdef NEWSOS4 - "4" + "4" #else - "" + "" #endif - ); exit (0); + ); exit (0); #endif #endif @@ -1477,9 +1492,9 @@ This script, last modified $timestamp, has failed to recognize the operating system you are using. It is advised that you download the most up to date version of the config scripts from - http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.guess + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD and - http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.sub + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD If the version you run ($0) is already up to date, please send the following data and any information you think might be diff --git a/lib/erl_interface/src/auxdir/config.sub b/lib/erl_interface/src/auxdir/config.sub index f43233b104..bb6edbdb47 100755 --- a/lib/erl_interface/src/auxdir/config.sub +++ b/lib/erl_interface/src/auxdir/config.sub @@ -1,44 +1,40 @@ #! /bin/sh # Configuration validation subroutine script. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, -# Inc. +# Copyright 1992-2013 Free Software Foundation, Inc. -timestamp='2007-04-29' +timestamp='2013-02-12' -# This file is (in principle) common to ALL GNU software. -# The presence of a machine in this file suggests that SOME GNU software -# can handle that machine. It does not imply ALL GNU software can. -# -# This file is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or +# This file is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. +# along with this program; if not, see <http://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). -# Please send patches to <[email protected]>. Submit a context -# diff and a properly formatted ChangeLog entry. +# Please send patches with a ChangeLog entry to [email protected]. # # Configuration subroutine to validate and canonicalize a configuration type. # Supply the specified configuration type as an argument. # If it is invalid, we print an error message on stderr and exit with code 1. # Otherwise, we print the canonical config type on stdout and succeed. +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD + # This file is supposed to be the same for all GNU packages # and recognize all the CPU types, system types and aliases # that are meaningful with *any* GNU software. @@ -72,8 +68,7 @@ Report bugs and patches to <[email protected]>." version="\ GNU config.sub ($timestamp) -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 -Free Software Foundation, Inc. +Copyright 1992-2013 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -120,12 +115,18 @@ esac # Here we must recognize all the valid KERNEL-OS combinations. maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` case $maybe_os in - nto-qnx* | linux-gnu* | linux-dietlibc | linux-newlib* | linux-uclibc* | \ - uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* | \ + nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \ + linux-musl* | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \ + knetbsd*-gnu* | netbsd*-gnu* | \ + kopensolaris*-gnu* | \ storm-chaos* | os2-emx* | rtmk-nova*) os=-$maybe_os basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` ;; + android-linux) + os=-linux-android + basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-unknown + ;; *) basic_machine=`echo $1 | sed 's/-[^-]*$//'` if [ $basic_machine != $1 ] @@ -148,10 +149,13 @@ case $os in -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ - -apple | -axis | -knuth | -cray) + -apple | -axis | -knuth | -cray | -microblaze*) os= basic_machine=$1 ;; + -bluegene*) + os=-cnk + ;; -sim | -cisco | -oki | -wec | -winbond) os= basic_machine=$1 @@ -166,10 +170,10 @@ case $os in os=-chorusos basic_machine=$1 ;; - -chorusrdb) - os=-chorusrdb + -chorusrdb) + os=-chorusrdb basic_machine=$1 - ;; + ;; -hiux*) os=-hiuxwe2 ;; @@ -214,6 +218,12 @@ case $os in -isc*) basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; + -lynx*178) + os=-lynxos178 + ;; + -lynx*5) + os=-lynxos5 + ;; -lynx*) os=-lynxos ;; @@ -238,24 +248,34 @@ case $basic_machine in # Some are omitted here because they have special meanings below. 1750a | 580 \ | a29k \ + | aarch64 | aarch64_be \ | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ | am33_2.0 \ - | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr | avr32 \ + | arc \ + | arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv7[arm] \ + | avr | avr32 \ + | be32 | be64 \ | bfin \ | c4x | clipper \ | d10v | d30v | dlx | dsp16xx \ + | epiphany \ | fido | fr30 | frv \ | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ + | hexagon \ | i370 | i860 | i960 | ia64 \ | ip2k | iq2000 \ + | le32 | le64 \ + | lm32 \ | m32c | m32r | m32rle | m68000 | m68k | m88k \ - | maxq | mb | microblaze | mcore | mep \ + | maxq | mb | microblaze | microblazeel | mcore | mep | metag \ | mips | mipsbe | mipseb | mipsel | mipsle \ | mips16 \ | mips64 | mips64el \ - | mips64vr | mips64vrel \ + | mips64octeon | mips64octeonel \ | mips64orion | mips64orionel \ + | mips64r5900 | mips64r5900el \ + | mips64vr | mips64vrel \ | mips64vr4100 | mips64vr4100el \ | mips64vr4300 | mips64vr4300el \ | mips64vr5000 | mips64vr5000el \ @@ -266,31 +286,45 @@ case $basic_machine in | mipsisa64r2 | mipsisa64r2el \ | mipsisa64sb1 | mipsisa64sb1el \ | mipsisa64sr71k | mipsisa64sr71kel \ + | mipsr5900 | mipsr5900el \ | mipstx39 | mipstx39el \ | mn10200 | mn10300 \ + | moxie \ | mt \ | msp430 \ - | nios | nios2 \ + | nds32 | nds32le | nds32be \ + | nios | nios2 | nios2eb | nios2el \ | ns16k | ns32k \ - | or32 \ + | open8 \ + | or1k | or32 \ | pdp10 | pdp11 | pj | pjl \ - | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \ + | powerpc | powerpc64 | powerpc64le | powerpcle \ | pyramid \ + | rl78 | rx \ | score \ - | sh | sh[1234] | sh[24]a | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ + | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ | sh64 | sh64le \ | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ - | spu | strongarm \ - | tahoe | thumb | tic4x | tic80 | tron \ - | v850 | v850e \ + | spu \ + | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \ + | ubicom32 \ + | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \ | we32k \ - | x86 | xc16x | xscale | xscalee[bl] | xstormy16 | xtensa \ - | z8k) + | x86 | xc16x | xstormy16 | xtensa \ + | z8k | z80) basic_machine=$basic_machine-unknown ;; - m6811 | m68hc11 | m6812 | m68hc12) - # Motorola 68HC11/12. + c54x) + basic_machine=tic54x-unknown + ;; + c55x) + basic_machine=tic55x-unknown + ;; + c6x) + basic_machine=tic6x-unknown + ;; + m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | picochip) basic_machine=$basic_machine-unknown os=-none ;; @@ -300,6 +334,21 @@ case $basic_machine in basic_machine=mt-unknown ;; + strongarm | thumb | xscale) + basic_machine=arm-unknown + ;; + xgate) + basic_machine=$basic_machine-unknown + os=-none + ;; + xscaleeb) + basic_machine=armeb-unknown + ;; + + xscaleel) + basic_machine=armel-unknown + ;; + # We use `pc' rather than `unknown' # because (1) that's what they normally are, and # (2) the word "unknown" tends to confuse beginning users. @@ -314,29 +363,37 @@ case $basic_machine in # Recognize the basic CPU types with company name. 580-* \ | a29k-* \ + | aarch64-* | aarch64_be-* \ | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \ | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ | avr-* | avr32-* \ + | be32-* | be64-* \ | bfin-* | bs2000-* \ - | c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \ + | c[123]* | c30-* | [cjt]90-* | c4x-* \ | clipper-* | craynv-* | cydra-* \ | d10v-* | d30v-* | dlx-* \ | elxsi-* \ | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \ | h8300-* | h8500-* \ | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ + | hexagon-* \ | i*86-* | i860-* | i960-* | ia64-* \ | ip2k-* | iq2000-* \ + | le32-* | le64-* \ + | lm32-* \ | m32c-* | m32r-* | m32rle-* \ | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ - | m88110-* | m88k-* | maxq-* | mcore-* \ + | m88110-* | m88k-* | maxq-* | mcore-* | metag-* \ + | microblaze-* | microblazeel-* \ | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ | mips16-* \ | mips64-* | mips64el-* \ - | mips64vr-* | mips64vrel-* \ + | mips64octeon-* | mips64octeonel-* \ | mips64orion-* | mips64orionel-* \ + | mips64r5900-* | mips64r5900el-* \ + | mips64vr-* | mips64vrel-* \ | mips64vr4100-* | mips64vr4100el-* \ | mips64vr4300-* | mips64vr4300el-* \ | mips64vr5000-* | mips64vr5000el-* \ @@ -347,31 +404,41 @@ case $basic_machine in | mipsisa64r2-* | mipsisa64r2el-* \ | mipsisa64sb1-* | mipsisa64sb1el-* \ | mipsisa64sr71k-* | mipsisa64sr71kel-* \ + | mipsr5900-* | mipsr5900el-* \ | mipstx39-* | mipstx39el-* \ | mmix-* \ | mt-* \ | msp430-* \ - | nios-* | nios2-* \ + | nds32-* | nds32le-* | nds32be-* \ + | nios-* | nios2-* | nios2eb-* | nios2el-* \ | none-* | np1-* | ns16k-* | ns32k-* \ + | open8-* \ | orion-* \ | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ - | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \ + | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \ | pyramid-* \ - | romp-* | rs6000-* \ - | sh-* | sh[1234]-* | sh[24]a-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ + | rl78-* | romp-* | rs6000-* | rx-* \ + | sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ | sparclite-* \ - | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | strongarm-* | sv1-* | sx?-* \ - | tahoe-* | thumb-* \ + | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx?-* \ + | tahoe-* \ | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ + | tile*-* \ | tron-* \ - | v850-* | v850e-* | vax-* \ + | ubicom32-* \ + | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \ + | vax-* \ | we32k-* \ - | x86-* | x86_64-* | xc16x-* | xps100-* | xscale-* | xscalee[bl]-* \ - | xstormy16-* | xtensa-* \ + | x86-* | x86_64-* | xc16x-* | xps100-* \ + | xstormy16-* | xtensa*-* \ | ymp-* \ - | z8k-*) + | z8k-* | z80-*) + ;; + # Recognize the basic CPU types without company name, with glob match. + xtensa*) + basic_machine=$basic_machine-unknown ;; # Recognize the various machine names and aliases which stand # for a CPU type and a company and sometimes even an OS. @@ -389,7 +456,7 @@ case $basic_machine in basic_machine=a29k-amd os=-udi ;; - abacus) + abacus) basic_machine=abacus-unknown ;; adobe68k) @@ -435,6 +502,10 @@ case $basic_machine in basic_machine=m68k-apollo os=-bsd ;; + aros) + basic_machine=i386-pc + os=-aros + ;; aux) basic_machine=m68k-apple os=-aux @@ -443,10 +514,35 @@ case $basic_machine in basic_machine=ns32k-sequent os=-dynix ;; + blackfin) + basic_machine=bfin-unknown + os=-linux + ;; + blackfin-*) + basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; + bluegene*) + basic_machine=powerpc-ibm + os=-cnk + ;; + c54x-*) + basic_machine=tic54x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c55x-*) + basic_machine=tic55x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c6x-*) + basic_machine=tic6x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; c90) basic_machine=c90-cray os=-unicos ;; + cegcc) + basic_machine=arm-unknown + os=-cegcc + ;; convex-c1) basic_machine=c1-convex os=-bsd @@ -475,8 +571,8 @@ case $basic_machine in basic_machine=craynv-cray os=-unicosmp ;; - cr16c) - basic_machine=cr16c-unknown + cr16 | cr16-*) + basic_machine=cr16-unknown os=-elf ;; crds | unos) @@ -514,6 +610,10 @@ case $basic_machine in basic_machine=m88k-motorola os=-sysv3 ;; + dicos) + basic_machine=i686-pc + os=-dicos + ;; djgpp) basic_machine=i586-pc os=-msdosdjgpp @@ -629,7 +729,6 @@ case $basic_machine in i370-ibm* | ibm*) basic_machine=i370-ibm ;; -# I'm not sure what "Sysv32" means. Should this be sysv3.2? i*86v32) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv32 @@ -668,6 +767,14 @@ case $basic_machine in basic_machine=m68k-isi os=-sysv ;; + m68knommu) + basic_machine=m68k-unknown + os=-linux + ;; + m68knommu-*) + basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; m88k-omron*) basic_machine=m88k-omron ;; @@ -679,6 +786,13 @@ case $basic_machine in basic_machine=ns32k-utek os=-sysv ;; + microblaze*) + basic_machine=microblaze-xilinx + ;; + mingw64) + basic_machine=x86_64-pc + os=-mingw64 + ;; mingw32) basic_machine=i386-pc os=-mingw32 @@ -715,10 +829,18 @@ case $basic_machine in ms1-*) basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` ;; + msys) + basic_machine=i386-pc + os=-msys + ;; mvs) basic_machine=i370-ibm os=-mvs ;; + nacl) + basic_machine=le32-unknown + os=-nacl + ;; ncr3000) basic_machine=i486-ncr os=-sysv4 @@ -783,6 +905,12 @@ case $basic_machine in np1) basic_machine=np1-gould ;; + neo-tandem) + basic_machine=neo-tandem + ;; + nse-tandem) + basic_machine=nse-tandem + ;; nsr-tandem) basic_machine=nsr-tandem ;; @@ -813,6 +941,14 @@ case $basic_machine in basic_machine=i860-intel os=-osf ;; + parisc) + basic_machine=hppa-unknown + os=-linux + ;; + parisc-*) + basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; pbd) basic_machine=sparc-tti ;; @@ -857,9 +993,10 @@ case $basic_machine in ;; power) basic_machine=power-ibm ;; - ppc) basic_machine=powerpc-unknown + ppc | ppcbe) basic_machine=powerpc-unknown ;; - ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` + ppc-* | ppcbe-*) + basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppcle | powerpclittle | ppc-le | powerpc-little) basic_machine=powerpcle-unknown @@ -884,7 +1021,11 @@ case $basic_machine in basic_machine=i586-unknown os=-pw32 ;; - rdos) + rdos | rdos64) + basic_machine=x86_64-pc + os=-rdos + ;; + rdos32) basic_machine=i386-pc os=-rdos ;; @@ -953,6 +1094,9 @@ case $basic_machine in basic_machine=i860-stratus os=-sysv4 ;; + strongarm-* | thumb-*) + basic_machine=arm-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; sun2) basic_machine=m68000-sun ;; @@ -1009,17 +1153,9 @@ case $basic_machine in basic_machine=t90-cray os=-unicos ;; - tic54x | c54x*) - basic_machine=tic54x-unknown - os=-coff - ;; - tic55x | c55x*) - basic_machine=tic55x-unknown - os=-coff - ;; - tic6x | c6x*) - basic_machine=tic6x-unknown - os=-coff + tile*) + basic_machine=$basic_machine-unknown + os=-linux-gnu ;; tx39) basic_machine=mipstx39-unknown @@ -1027,10 +1163,6 @@ case $basic_machine in tx39el) basic_machine=mipstx39el-unknown ;; - tile*) - basic_machine=tile-tilera - os=-linux-gnu - ;; toad1) basic_machine=pdp10-xkl os=-tops20 @@ -1092,6 +1224,9 @@ case $basic_machine in xps | xps100) basic_machine=xps100-honeywell ;; + xscale-* | xscalee[bl]-*) + basic_machine=`echo $basic_machine | sed 's/^xscale/arm/'` + ;; ymp) basic_machine=ymp-cray os=-unicos @@ -1100,6 +1235,10 @@ case $basic_machine in basic_machine=z8k-unknown os=-sim ;; + z80-*-coff) + basic_machine=z80-unknown + os=-sim + ;; none) basic_machine=none-none os=-none @@ -1138,7 +1277,7 @@ case $basic_machine in we32k) basic_machine=we32k-att ;; - sh[1234] | sh[24]a | sh[34]eb | sh[1234]le | sh[23]ele) + sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele) basic_machine=sh-unknown ;; sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v) @@ -1185,9 +1324,12 @@ esac if [ x"$os" != x"" ] then case $os in - # First match some system type aliases - # that might get confused with valid system types. + # First match some system type aliases + # that might get confused with valid system types. # -solaris* is a basic system type, with this one exception. + -auroraux) + os=-auroraux + ;; -solaris1 | -solaris1.*) os=`echo $os | sed -e 's|solaris1|sunos4|'` ;; @@ -1208,21 +1350,23 @@ case $os in # Each alternative MUST END IN A *, to match a version number. # -sysv* is not here because it comes later, after sysvr4. -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ - | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\ - | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ + | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\ + | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \ + | -sym* | -kopensolaris* | -plan9* \ | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ - | -aos* \ + | -aos* | -aros* \ | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ - | -openbsd* | -solidbsd* \ + | -bitrig* | -openbsd* | -solidbsd* \ | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ - | -chorusos* | -chorusrdb* \ - | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ - | -mingw32* | -linux-gnu* | -linux-newlib* | -linux-uclibc* \ + | -chorusos* | -chorusrdb* | -cegcc* \ + | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ + | -mingw32* | -mingw64* | -linux-gnu* | -linux-android* \ + | -linux-newlib* | -linux-musl* | -linux-uclibc* \ | -uxpv* | -beos* | -mpeix* | -udk* \ | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ @@ -1230,7 +1374,7 @@ case $os in | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ - | -skyos* | -haiku* | -rdos* | -toppers* | -drops*) + | -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es*) # Remember, each alternative MUST END IN *, to match a version number. ;; -qnx*) @@ -1269,7 +1413,7 @@ case $os in -opened*) os=-openedition ;; - -os400*) + -os400*) os=-os400 ;; -wince*) @@ -1318,7 +1462,7 @@ case $os in -sinix*) os=-sysv4 ;; - -tpf*) + -tpf*) os=-tpf ;; -triton*) @@ -1354,12 +1498,14 @@ case $os in -aros*) os=-aros ;; - -kaos*) - os=-kaos - ;; -zvmoe) os=-zvmoe ;; + -dicos*) + os=-dicos + ;; + -nacl*) + ;; -none) ;; *) @@ -1382,10 +1528,10 @@ else # system, and we'll never get to this point. case $basic_machine in - score-*) + score-*) os=-elf ;; - spu-*) + spu-*) os=-elf ;; *-acorn) @@ -1397,8 +1543,20 @@ case $basic_machine in arm*-semi) os=-aout ;; - c4x-* | tic4x-*) - os=-coff + c4x-* | tic4x-*) + os=-coff + ;; + hexagon-*) + os=-elf + ;; + tic54x-*) + os=-coff + ;; + tic55x-*) + os=-coff + ;; + tic6x-*) + os=-coff ;; # This must come before the *-dec entry. pdp10-*) @@ -1418,14 +1576,11 @@ case $basic_machine in ;; m68000-sun) os=-sunos3 - # This also exists in the configure program, but was not the - # default. - # os=-sunos4 ;; m68*-cisco) os=-aout ;; - mep-*) + mep-*) os=-elf ;; mips*-cisco) @@ -1434,6 +1589,9 @@ case $basic_machine in mips*-*) os=-elf ;; + or1k-*) + os=-elf + ;; or32-*) os=-coff ;; @@ -1452,7 +1610,7 @@ case $basic_machine in *-ibm) os=-aix ;; - *-knuth) + *-knuth) os=-mmixware ;; *-wec) @@ -1557,7 +1715,7 @@ case $basic_machine in -sunos*) vendor=sun ;; - -aix*) + -cnk*|-aix*) vendor=ibm ;; -beos*) @@ -1628,3 +1786,4 @@ exit # time-stamp-format: "%:y-%02m-%02d" # time-stamp-end: "'" # End: + diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index d93ad10bd4..0a2c6e822f 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -736,9 +736,6 @@ type(erlang, is_tuple, 1, Xs) -> %% Guard bif, needs to be here. type(erlang, length, 1, Xs) -> strict(arg_types(erlang, length, 1), Xs, fun (_) -> t_non_neg_fixnum() end); -type(erlang, list_to_integer, 2, Xs) -> - strict(arg_types(erlang, list_to_integer, 2), Xs, - fun (_) -> t_integer() end); type(erlang, make_tuple, 2, Xs) -> strict(arg_types(erlang, make_tuple, 2), Xs, fun ([Int, _]) -> @@ -1074,7 +1071,7 @@ type(hipe_bifs, ref_set, 2, Xs) -> strict(arg_types(hipe_bifs, ref_set, 2), Xs, fun (_) -> t_nil() end); type(hipe_bifs, remove_refs_from, 1, Xs) -> strict(arg_types(hipe_bifs, remove_refs_from, 1), Xs, - fun (_) -> t_nil() end); + fun (_) -> t_atom('ok') end); type(hipe_bifs, set_funinfo_native_address, 3, Xs) -> strict(arg_types(hipe_bifs, set_funinfo_native_address, 3), Xs, fun (_) -> t_nil() end); @@ -2231,8 +2228,6 @@ arg_types(erlang, is_tuple, 1) -> %% Guard bif, needs to be here. arg_types(erlang, length, 1) -> [t_list()]; -arg_types(erlang, list_to_integer, 2) -> - [t_list(t_byte()), t_from_range(2, 36)]; arg_types(erlang, make_tuple, 2) -> [t_non_neg_fixnum(), t_any()]; % the value 0 is OK as first argument arg_types(erlang, make_tuple, 3) -> diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 532b2e43cd..d1243b2325 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -205,7 +205,7 @@ t_var/1, t_var_name/1, %% t_assign_variables_to_subtype/2, - type_is_defined/3, + type_is_defined/4, record_field_diffs_to_string/2, subst_all_vars_to_any/1, lift_list_to_pos_empty/1, @@ -544,12 +544,12 @@ t_opaque_from_records(RecDict) -> OpaqueRecDict = dict:filter(fun(Key, _Value) -> case Key of - {opaque, _Name} -> true; + {opaque, _Name, _Arity} -> true; _ -> false end end, RecDict), OpaqueTypeDict = - dict:map(fun({opaque, Name}, {Module, Type, ArgNames}) -> + dict:map(fun({opaque, Name, _Arity}, {Module, Type, ArgNames}) -> case ArgNames of [] -> t_opaque(Module, Name, [], t_from_form(Type, RecDict)); @@ -707,8 +707,8 @@ t_solve_remote_type(#remote{mod = RemMod, name = Name, args = Args} = RemType, MFA = {RemMod, Name, ArgsLen}, case sets:is_element(MFA, ET) of true -> - case lookup_type(Name, RemDict) of - {type, {_Mod, Type, ArgNames}} when ArgsLen =:= length(ArgNames) -> + case lookup_type(Name, ArgsLen, RemDict) of + {type, {_Mod, Type, ArgNames}} -> {NewType, NewCycle, NewRR} = case can_unfold_more(RemType, C) of true -> @@ -726,7 +726,7 @@ t_solve_remote_type(#remote{mod = RemMod, name = Name, args = Args} = RemType, false -> RT end, {RT1, RetRR}; - {opaque, {Mod, Type, ArgNames}} when ArgsLen =:= length(ArgNames) -> + {opaque, {Mod, Type, ArgNames}} -> List = lists:zip(ArgNames, Args), TmpVarDict = dict:from_list(List), {Rep, NewCycle, NewRR} = @@ -746,12 +746,6 @@ t_solve_remote_type(#remote{mod = RemMod, name = Name, args = Args} = RemType, {t_from_form({opaque, -1, Name, {Mod, Args, RT1}}, RemDict, TmpVarDict), RetRR}; - {type, _} -> - Msg = io_lib:format("Unknown remote type ~w\n", [Name]), - throw({error, Msg}); - {opaque, _} -> - Msg = io_lib:format("Unknown remote opaque type ~w\n", [Name]), - throw({error, Msg}); error -> Msg = io_lib:format("Unable to find remote type ~w:~w()\n", [RemMod, Name]), @@ -3241,6 +3235,8 @@ t_to_string(?bitstr(0, 0), _RecDict) -> "<<>>"; t_to_string(?bitstr(8, 0), _RecDict) -> "binary()"; +t_to_string(?bitstr(1, 0), _RecDict) -> + "bitstring()"; t_to_string(?bitstr(0, B), _RecDict) -> lists:flatten(io_lib:format("<<_:~w>>", [B])); t_to_string(?bitstr(U, 0), _RecDict) -> @@ -3680,8 +3676,9 @@ t_from_form({type, _L, union, Args}, TypeNames, InOpaque, RecDict, VarDict) -> {L, R} = list_from_form(Args, TypeNames, InOpaque, RecDict, VarDict), {t_sup(L), R}; t_from_form({type, _L, Name, Args}, TypeNames, InOpaque, RecDict, VarDict) -> - case lookup_type(Name, RecDict) of - {type, {_Module, Type, ArgNames}} when length(Args) =:= length(ArgNames) -> + ArgsLen = length(Args), + case lookup_type(Name, ArgsLen, RecDict) of + {type, {_Module, Type, ArgNames}} -> case can_unfold_more({type, Name}, TypeNames) of true -> List = lists:zipwith( @@ -3701,7 +3698,7 @@ t_from_form({type, _L, Name, Args}, TypeNames, InOpaque, RecDict, VarDict) -> end; false -> {t_any(), [{type, Name}]} end; - {opaque, {Module, Type, ArgNames}} when length(Args) =:= length(ArgNames) -> + {opaque, {Module, Type, ArgNames}} -> {Rep, Rret} = case can_unfold_more({opaque, Name}, TypeNames) of true -> @@ -3730,12 +3727,9 @@ t_from_form({type, _L, Name, Args}, TypeNames, InOpaque, RecDict, VarDict) -> RecDict, VarDict) end, {Tret, Rret}; - {type, _} -> - throw({error, io_lib:format("Unknown type ~w\n", [Name])}); - {opaque, _} -> - throw({error, io_lib:format("Unknown opaque type ~w\n", [Name])}); error -> - throw({error, io_lib:format("Unable to find type ~w\n", [Name])}) + Msg = io_lib:format("Unable to find type ~w/~w\n", [Name, ArgsLen]), + throw({error, Msg}) end; t_from_form({opaque, _L, Name, {Mod, Args, Rep}}, _TypeNames, _InOpaque, _RecDict, _VarDict) -> @@ -3870,12 +3864,14 @@ t_form_to_string({type, _L, binary, [Base, Unit]} = Type) -> case {U, B} of {0, 0} -> "<<>>"; {8, 0} -> "binary()"; + {1, 0} -> "bitstring()"; {0, B} -> lists:flatten(io_lib:format("<<_:~w>>", [B])); {U, 0} -> lists:flatten(io_lib:format("<<_:_*~w>>", [U])); {U, B} -> lists:flatten(io_lib:format("<<_:~w,_:_*~w>>", [B, U])) end; _ -> io_lib:format("Badly formed bitstr type ~w", [Type]) end; +t_form_to_string({type, _L, bitstring, []}) -> "bitstring()"; t_form_to_string({type, _L, 'fun', []}) -> "fun()"; t_form_to_string({type, _L, 'fun', [{type, _, any}, Range]}) -> "fun(...) -> " ++ t_form_to_string(Range); @@ -3986,20 +3982,20 @@ lookup_record(Tag, Arity, RecDict) when is_atom(Tag) -> error -> error end. -lookup_type(Name, RecDict) -> - case dict:find({type, Name}, RecDict) of +lookup_type(Name, Arity, RecDict) -> + case dict:find({type, Name, Arity}, RecDict) of error -> - case dict:find({opaque, Name}, RecDict) of + case dict:find({opaque, Name, Arity}, RecDict) of error -> error; {ok, Found} -> {opaque, Found} end; {ok, Found} -> {type, Found} end. --spec type_is_defined('type' | 'opaque', atom(), dict()) -> boolean(). +-spec type_is_defined('type' | 'opaque', atom(), arity(), dict()) -> boolean(). -type_is_defined(TypeOrOpaque, Name, RecDict) -> - dict:is_key({TypeOrOpaque, Name}, RecDict). +type_is_defined(TypeOrOpaque, Name, Arity, RecDict) -> + dict:is_key({TypeOrOpaque, Name, Arity}, RecDict). can_unfold_more(TypeName, TypeNames) -> Fun = fun(E, Acc) -> case E of TypeName -> Acc + 1; _ -> Acc end end, diff --git a/lib/inets/doc/src/httpd.xml b/lib/inets/doc/src/httpd.xml index 3fced5dfcd..8438961511 100644 --- a/lib/inets/doc/src/httpd.xml +++ b/lib/inets/doc/src/httpd.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1997</year><year>2012</year> + <year>1997</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -163,11 +163,9 @@ </item> <marker id="prop_socket_type"></marker> - <tag>{socket_type, ip_comm | ssl | essl}</tag> + <tag>{socket_type, ip_comm | {essl, Config::proplist()}}</tag> <item> - <p>When using ssl, there are currently only one alternative. - <c>essl</c> specifically uses the Erlang based SSL. - <c>ssl</c> defaults to <c>essl</c>. </p> + <p> For ssl configuration options see <seealso marker="ssl:ssl#listen-2">ssl:listen/2</seealso> </p> <p>Defaults to <c>ip_comm</c>. </p> </item> @@ -395,71 +393,7 @@ bytes </item> </taglist> - - <marker id="props_ssl"></marker> - <p><em>ssl properties</em></p> - <taglist> - <marker id="prop_ssl_ca_cert_file"></marker> - <tag>{ssl_ca_certificate_file, path()}</tag> - <item> - <p>Used as cacertfile option in ssl:listen/2 see - <seealso marker="ssl:ssl">ssl(3)</seealso>. </p> - </item> - - <marker id="prop_ssl_cert_file"></marker> - <tag>{ssl_certificate_file, path()}</tag> - <item> - <p>Used as certfile option in ssl:listen/2 see - <seealso marker="ssl:ssl">ssl(3)</seealso>. </p> - </item> - - <marker id="prop_ssl_ciphers"></marker> - <tag>{ssl_ciphers, list()}</tag> - <item> - <p>Used as ciphers option in ssl:listen/2 see - <seealso marker="ssl:ssl">ssl(3)</seealso>. </p> - </item> - - <marker id="prop_ssl_verify_client"></marker> - <tag>{ssl_verify_client, integer()}</tag> - <item> - <p>Used as verify option in ssl:listen/2 see - <seealso marker="ssl:ssl">ssl(3)</seealso>. </p> - </item> - - <marker id="prop_ssl_verify_depth"></marker> - <tag>{ssl_verify_depth, integer()}</tag> - <item> - <p>Used as depth option in ssl:listen/2 see - <seealso marker="ssl:ssl">ssl(3)</seealso>. </p> - </item> - - <marker id="prop_ssl_passwd_callback_funct"></marker> - <tag>{ssl_password_callback_function, atom()}</tag> - <item> - <p>Used together with ssl_password_callback_module - to retrieve a value to use as password option to ssl:listen/2 - see <seealso marker="ssl:ssl">ssl(3)</seealso>. </p> - </item> - - <marker id="prop_ssl_passwd_callback_args"></marker> - <tag>{ssl_password_callback_arguments, list()}</tag> - <item> - <p>Used together with ssl_password_callback_function to supply a - list of arguments to the callback function. If not specified - the callback function will be assumed to have arity 0. </p> - </item> - - <marker id="prop_ssl_passwd_callback_mod"></marker> - <tag>{ssl_password_callback_module, atom()}</tag> - <item> - <p>Used together with ssl_password_callback_function - to retrieve a value to use as password option to ssl:listen/2 - see <seealso marker="ssl:ssl">ssl(3)</seealso>. </p> - </item> - - </taglist> - + <marker id="props_alias"></marker> <p><em>URL aliasing properties - requires mod_alias</em></p> <taglist> diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index 784a9c0019..857043bae2 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2012. All Rights Reserved. +%% Copyright Ericsson AB 2002-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -257,7 +257,7 @@ handle_call(#request{address = Addr} = Request, _, session = #session{type = pipeline} = Session, timers = Timers, options = #options{proxy = Proxy} = _Options, - profile_name = ProfileName} = State) + profile_name = ProfileName} = State0) when Status =/= undefined -> ?hcrv("new request on a pipeline session", @@ -274,18 +274,18 @@ handle_call(#request{address = Addr} = Request, _, ?hcrd("request sent", []), %% Activate the request time out for the new request - NewState = - activate_request_timeout(State#state{request = Request}), + State1 = + activate_request_timeout(State0#state{request = Request}), ClientClose = httpc_request:is_client_closing(Request#request.headers), - case State#state.request of - #request{} -> %% Old request not yet finished + case State0#state.request of + #request{} = OldRequest -> %% Old request not yet finished ?hcrd("old request still not finished", []), %% Make sure to use the new value of timers in state - NewTimers = NewState#state.timers, - NewPipeline = queue:in(Request, State#state.pipeline), + NewTimers = State1#state.timers, + NewPipeline = queue:in(Request, State1#state.pipeline), NewSession = Session#session{queue_length = %% Queue + current @@ -293,9 +293,11 @@ handle_call(#request{address = Addr} = Request, _, client_close = ClientClose}, insert_session(NewSession, ProfileName), ?hcrd("session updated", []), - {reply, ok, State#state{pipeline = NewPipeline, - session = NewSession, - timers = NewTimers}}; + {reply, ok, State1#state{ + request = OldRequest, + pipeline = NewPipeline, + session = NewSession, + timers = NewTimers}}; undefined -> %% Note: tcp-message receiving has already been %% activated by handle_pipeline/2. @@ -306,20 +308,15 @@ handle_call(#request{address = Addr} = Request, _, Session#session{queue_length = 1, client_close = ClientClose}, httpc_manager:insert_session(NewSession, ProfileName), - Relaxed = - (Request#request.settings)#http_options.relaxed, - MFA = {httpc_response, parse, - [State#state.max_header_size, Relaxed]}, NewTimers = Timers#timers{queue_timer = undefined}, ?hcrd("session created", []), - {reply, ok, NewState#state{request = Request, - session = NewSession, - mfa = MFA, - timers = NewTimers}} + State = init_wait_for_response_state(Request, State1#state{session = NewSession, + timers = NewTimers}), + {reply, ok, State} end; {error, Reason} -> ?hcri("failed sending request", [{reason, Reason}]), - {reply, {pipeline_failed, Reason}, State} + {reply, {pipeline_failed, Reason}, State0} end; handle_call(#request{address = Addr} = Request, _, @@ -327,7 +324,7 @@ handle_call(#request{address = Addr} = Request, _, session = #session{type = keep_alive} = Session, timers = Timers, options = #options{proxy = Proxy} = _Options, - profile_name = ProfileName} = State) + profile_name = ProfileName} = State0) when Status =/= undefined -> ?hcrv("new request on a keep-alive session", @@ -335,65 +332,54 @@ handle_call(#request{address = Addr} = Request, _, {profile, ProfileName}, {status, Status}]), - Address = handle_proxy(Addr, Proxy), - case httpc_request:send(Address, Session, Request) of - ok -> - - ?hcrd("request sent", []), - - %% Activate the request time out for the new request - NewState = - activate_request_timeout(State#state{request = Request}), - - ClientClose = - httpc_request:is_client_closing(Request#request.headers), - - case State#state.request of - #request{} -> %% Old request not yet finished - %% Make sure to use the new value of timers in state - ?hcrd("old request still not finished", []), - NewTimers = NewState#state.timers, - NewKeepAlive = queue:in(Request, State#state.keep_alive), - NewSession = - Session#session{queue_length = - %% Queue + current - queue:len(NewKeepAlive) + 1, - client_close = ClientClose}, - insert_session(NewSession, ProfileName), - ?hcrd("session updated", []), - {reply, ok, State#state{keep_alive = NewKeepAlive, - session = NewSession, - timers = NewTimers}}; - undefined -> - %% Note: tcp-message reciving has already been - %% activated by handle_pipeline/2. - ?hcrd("no current request", []), - cancel_timer(Timers#timers.queue_timer, - timeout_queue), - NewSession = - Session#session{queue_length = 1, - client_close = ClientClose}, - insert_session(NewSession, ProfileName), - Relaxed = - (Request#request.settings)#http_options.relaxed, - MFA = {httpc_response, parse, - [State#state.max_header_size, Relaxed]}, - {reply, ok, NewState#state{request = Request, - session = NewSession, - mfa = MFA}} - end; - - {error, Reason} -> - ?hcri("failed sending request", [{reason, Reason}]), - {reply, {request_failed, Reason}, State} + ClientClose = httpc_request:is_client_closing(Request#request.headers), + + case State0#state.request of + #request{} -> %% Old request not yet finished + %% Make sure to use the new value of timers in state + ?hcrd("old request still not finished", []), + NewKeepAlive = queue:in(Request, State0#state.keep_alive), + NewSession = + Session#session{queue_length = + %% Queue + current + queue:len(NewKeepAlive) + 1, + client_close = ClientClose}, + insert_session(NewSession, ProfileName), + ?hcrd("session updated", []), + {reply, ok, State0#state{keep_alive = NewKeepAlive, + session = NewSession}}; + undefined -> + %% Note: tcp-message reciving has already been + %% activated by handle_pipeline/2. + ?hcrd("no current request", []), + cancel_timer(Timers#timers.queue_timer, + timeout_queue), + Address = handle_proxy(Addr, Proxy), + case httpc_request:send(Address, Session, Request) of + ok -> + ?hcrd("request sent", []), + + %% Activate the request time out for the new request + State1 = + activate_request_timeout(State0#state{request = Request}), + NewTimers = State1#state.timers, + NewSession = + Session#session{queue_length = 1, + client_close = ClientClose}, + insert_session(NewSession, ProfileName), + State = init_wait_for_response_state(Request, State1#state{session = NewSession, + timers = NewTimers}), + {reply, ok, State}; + {error, Reason} -> + ?hcri("failed sending request", [{reason, Reason}]), + {reply, {request_failed, Reason}, State0} + end end; - handle_call(info, _, State) -> Info = handler_info(State), {reply, Info, State}. - %%-------------------------------------------------------------------- %% Function: handle_cast(Msg, State) -> {noreply, State} | %% {noreply, State, Timeout} | @@ -1239,8 +1225,7 @@ handle_queue(#state{status = pipeline} = State, Data) -> handle_pipeline(#state{status = pipeline, session = Session, profile_name = ProfileName, - options = #options{pipeline_timeout = TimeOut}} = - State, + options = #options{pipeline_timeout = TimeOut}} = State, Data) -> ?hcrd("handle pipeline", [{profile, ProfileName}, @@ -1250,25 +1235,7 @@ handle_pipeline(#state{status = pipeline, case queue:out(State#state.pipeline) of {empty, _} -> ?hcrd("pipeline queue empty", []), - - %% The server may choose too teminate an idle pipeline - %% in this case we want to receive the close message - %% at once and not when trying to pipeline the next - %% request. - activate_once(Session), - - %% If a pipeline that has been idle for some time is not - %% closed by the server, the client may want to close it. - NewState = activate_queue_timeout(TimeOut, State), - update_session(ProfileName, Session, #session.queue_length, 0), - %% Note mfa will be initilized when a new request - %% arrives. - {noreply, - NewState#state{request = undefined, - mfa = undefined, - status_line = undefined, - headers = undefined, - body = undefined}}; + handle_empty_queue(Session, ProfileName, TimeOut, State); {{value, NextRequest}, Pipeline} -> ?hcrd("pipeline queue non-empty", []), case lists:member(NextRequest#request.id, @@ -1286,38 +1253,17 @@ handle_pipeline(#state{status = pipeline, Session#session{queue_length = %% Queue + current queue:len(Pipeline) + 1}, - insert_session(NewSession, ProfileName), - Relaxed = - (NextRequest#request.settings)#http_options.relaxed, - MFA = {httpc_response, - parse, - [State#state.max_header_size, Relaxed]}, - NewState = - State#state{pipeline = Pipeline, - request = NextRequest, - mfa = MFA, - status_line = undefined, - headers = undefined, - body = undefined}, - case Data of - <<>> -> - activate_once(Session), - {noreply, NewState}; - _ -> - %% If we already received some bytes of - %% the next response - handle_info({httpc_handler, dummy, Data}, - NewState) - end + receive_response(NextRequest, + NewSession, Data, + State#state{pipeline = Pipeline}) end end. -handle_keep_alive_queue( - #state{status = keep_alive, - session = Session, - profile_name = ProfileName, - options = #options{keep_alive_timeout = TimeOut}} = State, - Data) -> +handle_keep_alive_queue(#state{status = keep_alive, + session = Session, + profile_name = ProfileName, + options = #options{keep_alive_timeout = TimeOut}} = State, + Data) -> ?hcrd("handle keep_alive", [{profile, ProfileName}, {session, Session}, @@ -1326,25 +1272,7 @@ handle_keep_alive_queue( case queue:out(State#state.keep_alive) of {empty, _} -> ?hcrd("keep_alive queue empty", []), - %% The server may choose too terminate an idle keep_alive session - %% in this case we want to receive the close message - %% at once and not when trying to send the next - %% request. - activate_once(Session), - %% If a keep_alive session has been idle for some time is not - %% closed by the server, the client may want to close it. - NewState = activate_queue_timeout(TimeOut, State), - update_session(ProfileName, Session, #session.queue_length, 0), - %% Note mfa will be initilized when a new request - %% arrives. - {noreply, - NewState#state{request = undefined, - mfa = undefined, - status_line = undefined, - headers = undefined, - body = undefined - } - }; + handle_empty_queue(Session, ProfileName, TimeOut, State); {{value, NextRequest}, KeepAlive} -> ?hcrd("keep_alive queue non-empty", []), case lists:member(NextRequest#request.id, @@ -1355,30 +1283,61 @@ handle_keep_alive_queue( State#state{keep_alive = KeepAlive}, Data); false -> ?hcrv("next request", [{request, NextRequest}]), - Relaxed = - (NextRequest#request.settings)#http_options.relaxed, - MFA = {httpc_response, parse, - [State#state.max_header_size, Relaxed]}, - NewState = - State#state{request = NextRequest, - keep_alive = KeepAlive, - mfa = MFA, - status_line = undefined, - headers = undefined, - body = undefined}, - case Data of - <<>> -> - activate_once(Session), - {noreply, NewState}; - _ -> - %% If we already received some bytes of - %% the next response - handle_info({httpc_handler, dummy, Data}, - NewState) + #request{address = Address} = NextRequest, + case httpc_request:send(Address, Session, NextRequest) of + ok -> + receive_response(NextRequest, + Session, <<>>, + State#state{keep_alive = KeepAlive}); + {error, Reason} -> + {reply, {keep_alive_failed, Reason}, State} end end end. +handle_empty_queue(Session, ProfileName, TimeOut, State) -> + %% The server may choose too terminate an idle pipline| keep_alive session + %% in this case we want to receive the close message + %% at once and not when trying to send the next + %% request. + activate_once(Session), + %% If a pipline | keep_alive session has been idle for some time is not + %% closed by the server, the client may want to close it. + NewState = activate_queue_timeout(TimeOut, State), + update_session(ProfileName, Session, #session.queue_length, 0), + %% Note mfa will be initilized when a new request + %% arrives. + {noreply, + NewState#state{request = undefined, + mfa = undefined, + status_line = undefined, + headers = undefined, + body = undefined + } + }. + +receive_response(Request, Session, Data, State) -> + NewState = init_wait_for_response_state(Request, State), + gather_data(Data, Session, NewState). + +init_wait_for_response_state(Request, State) -> + Relaxed = + (Request#request.settings)#http_options.relaxed, + MFA = {httpc_response, parse, + [State#state.max_header_size, Relaxed]}, + State#state{request = Request, + mfa = MFA, + status_line = undefined, + headers = undefined, + body = undefined}. + +gather_data(<<>>, Session, State) -> + activate_once(Session), + {noreply, State}; +gather_data(Data, _, State) -> + %% If we already received some bytes of + %% the next response + handle_info({httpc_handler, dummy, Data}, State). case_insensitive_header(Str) when is_list(Str) -> http_util:to_lower(Str); diff --git a/lib/inets/src/http_lib/http_transport.erl b/lib/inets/src/http_lib/http_transport.erl index 5eb827032f..df58fa1b81 100644 --- a/lib/inets/src/http_lib/http_transport.erl +++ b/lib/inets/src/http_lib/http_transport.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2011. All Rights Reserved. +%% Copyright Ericsson AB 2004-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -23,7 +23,7 @@ -export([ start/1, connect/3, connect/4, - listen/2, listen/3, listen/4, + listen/4, listen/5, accept/2, accept/3, close/2, send/3, @@ -155,41 +155,41 @@ connect({essl, SslConfig}, {Host, Port}, Opts0, Timeout) -> %% reason for this to enable a HTTP-server not running as root to use %% port 80. %%------------------------------------------------------------------------- -listen(SocketType, Port) -> - listen(SocketType, undefined, Port). +listen(ip_comm = _SocketType, Addr, Port, Fd, IpFamily) -> + listen_ip_comm(Addr, Port, Fd, IpFamily); + +listen({essl, SSLConfig}, Addr, Port, Fd, IpFamily) -> + listen_ssl(Addr, Port, Fd, SSLConfig, IpFamily). -listen(ip_comm = _SocketType, Addr, Port) -> - listen_ip_comm(Addr, Port, undefined); +listen(ip_comm = _SocketType, Addr, Port, IpFamily) -> + listen_ip_comm(Addr, Port, undefined, IpFamily); %% Wrapper for backaward compatibillity -listen({ssl, SSLConfig}, Addr, Port) -> +listen({ssl, SSLConfig}, Addr, Port, IpFamily) -> ?hlrt("listen (wrapper)", [{addr, Addr}, {port, Port}, {ssl_config, SSLConfig}]), - listen({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Addr, Port); + listen({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Addr, Port, IpFamily); -listen({essl, SSLConfig}, Addr, Port) -> + +listen({essl, SSLConfig}, Addr, Port, IpFamily) -> ?hlrt("listen (essl)", [{addr, Addr}, {port, Port}, {ssl_config, SSLConfig}]), - listen_ssl(Addr, Port, [{ssl_imp, new}, {reuseaddr, true} | SSLConfig]). - + listen_ssl(Addr, Port, undefined, SSLConfig, IpFamily). -listen(ip_comm, Addr, Port, Fd) -> - listen_ip_comm(Addr, Port, Fd). - -listen_ip_comm(Addr, Port, Fd) -> - case (catch do_listen_ip_comm(Addr, Port, Fd)) of +listen_ip_comm(Addr, Port, Fd, IpFamily) -> + case (catch do_listen_ip_comm(Addr, Port, Fd, IpFamily)) of {'EXIT', Reason} -> {error, {exit, Reason}}; Else -> Else end. -do_listen_ip_comm(Addr, Port, Fd) -> - {NewPort, Opts, IpFamily} = get_socket_info(Addr, Port, Fd), +do_listen_ip_comm(Addr, Port, Fd, IpFamily) -> + {NewPort, Opts} = get_socket_info(Addr, Port, Fd), case IpFamily of inet6fb4 -> Opts2 = [inet6 | Opts], @@ -222,10 +222,9 @@ do_listen_ip_comm(Addr, Port, Fd) -> end. -listen_ssl(Addr, Port, Opts0) -> - IpFamily = ipfamily_default(Addr, Port), - BaseOpts = [{backlog, 128}, {reuseaddr, true} | Opts0], - Opts = sock_opts(Addr, BaseOpts), +listen_ssl(Addr, Port, Fd, Opts0, IpFamily) -> + {NewPort, SockOpt} = get_socket_info(Addr, Port, Fd), + Opts = SockOpt ++ Opts0, case IpFamily of inet6fb4 -> Opts2 = [inet6 | Opts], @@ -236,13 +235,13 @@ listen_ssl(Addr, Port, Opts0) -> Opts3 = [inet | Opts], ?hlrt("ipv6 listen failed - try ipv4 instead", [{reason, Reason}, {opts, Opts3}]), - ssl:listen(Port, Opts3); + ssl:listen(NewPort, Opts3); {'EXIT', Reason} -> Opts3 = [inet | Opts], ?hlrt("ipv6 listen exit - try ipv4 instead", [{reason, Reason}, {opts, Opts3}]), - ssl:listen(Port, Opts3); + ssl:listen(NewPort, Opts3); Other -> ?hlrt("ipv6 listen done", [{other, Other}]), @@ -252,61 +251,21 @@ listen_ssl(Addr, Port, Opts0) -> _ -> Opts2 = [IpFamily | Opts], ?hlrt("listen", [{opts, Opts2}]), - ssl:listen(Port, Opts2) + ssl:listen(NewPort, Opts2) end. -ipfamily_default(Addr, Port) -> - httpd_conf:lookup(Addr, Port, ipfamily, inet6fb4). -get_socket_info(Addr, Port, Fd0) -> +get_socket_info(Addr, Port, Fd) -> BaseOpts = [{backlog, 128}, {reuseaddr, true}], - IpFamilyDefault = ipfamily_default(Addr, Port), %% The presence of a file descriptor takes precedence - case get_fd(Port, Fd0, IpFamilyDefault) of - {Fd, IpFamily} -> - {0, sock_opts(Addr, [{fd, Fd} | BaseOpts]), IpFamily}; + case Fd of undefined -> - {Port, sock_opts(Addr, BaseOpts), IpFamilyDefault} + {Port, sock_opts(Addr, BaseOpts)}; + Fd -> + {0, sock_opts(Addr, [{fd, Fd} | BaseOpts])} end. -get_fd(Port, undefined = _Fd, IpFamilyDefault) -> - FdKey = list_to_atom("httpd_" ++ integer_to_list(Port)), - case init:get_argument(FdKey) of - {ok, [[Value]]} -> - case string:tokens(Value, [$|]) of - [FdStr, IpFamilyStr] -> - {fd_of(FdStr), ip_family_of(IpFamilyStr)}; - [FdStr] -> - {fd_of(FdStr), IpFamilyDefault}; - _ -> - throw({error, {bad_descriptor, Value}}) - end; - error -> - undefined - end; -get_fd(_Port, Fd, IpFamilyDefault) -> - {Fd, IpFamilyDefault}. - - -fd_of(FdStr) -> - case (catch list_to_integer(FdStr)) of - Fd when is_integer(Fd) -> - Fd; - _ -> - throw({error, {bad_descriptor, FdStr}}) - end. - -ip_family_of(IpFamilyStr) -> - IpFamily = list_to_atom(IpFamilyStr), - case lists:member(IpFamily, [inet, inet6, inet6fb4]) of - true -> - IpFamily; - false -> - throw({error, {bad_ipfamily, IpFamilyStr}}) - end. - - %%------------------------------------------------------------------------- %% accept(SocketType, ListenSocket) -> {ok, Socket} | {error, Reason} %% accept(SocketType, ListenSocket, Timeout) -> ok | {error, Reason} diff --git a/lib/inets/src/http_server/httpd_acceptor.erl b/lib/inets/src/http_server/httpd_acceptor.erl index 08ee9ee0d0..1bffcc1f12 100644 --- a/lib/inets/src/http_server/httpd_acceptor.erl +++ b/lib/inets/src/http_server/httpd_acceptor.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -24,10 +24,10 @@ -include("inets_internal.hrl"). %% Internal application API --export([start_link/5, start_link/6]). +-export([start_link/6, start_link/7]). %% Other exports (for spawn's etc.) --export([acceptor_init/6, acceptor_init/7, acceptor_loop/5]). +-export([acceptor_init/7, acceptor_init/8, acceptor_loop/6]). %% %% External API @@ -35,27 +35,27 @@ %% start_link -start_link(Manager, SocketType, Addr, Port, ConfigDb, AcceptTimeout) -> +start_link(Manager, SocketType, Addr, Port, IpFamily, ConfigDb, AcceptTimeout) -> ?hdrd("start link", [{manager, Manager}, {socket_type, SocketType}, {address, Addr}, {port, Port}, {timeout, AcceptTimeout}]), - Args = [self(), Manager, SocketType, Addr, Port, ConfigDb, AcceptTimeout], + Args = [self(), Manager, SocketType, Addr, Port, IpFamily, ConfigDb, AcceptTimeout], proc_lib:start_link(?MODULE, acceptor_init, Args). -start_link(Manager, SocketType, ListenSocket, ConfigDb, AcceptTimeout) -> +start_link(Manager, SocketType, ListenSocket, IpFamily, ConfigDb, AcceptTimeout) -> ?hdrd("start link", [{manager, Manager}, {socket_type, SocketType}, {listen_socket, ListenSocket}, {timeout, AcceptTimeout}]), - Args = [self(), Manager, SocketType, ListenSocket, + Args = [self(), Manager, SocketType, ListenSocket, IpFamily, ConfigDb, AcceptTimeout], proc_lib:start_link(?MODULE, acceptor_init, Args). -acceptor_init(Parent, Manager, SocketType, {ListenOwner, ListenSocket}, +acceptor_init(Parent, Manager, SocketType, {ListenOwner, ListenSocket}, IpFamily, ConfigDb, AcceptTimeout) -> ?hdrd("acceptor init", [{parent, Parent}, @@ -66,9 +66,9 @@ acceptor_init(Parent, Manager, SocketType, {ListenOwner, ListenSocket}, {timeout, AcceptTimeout}]), link(ListenOwner), proc_lib:init_ack(Parent, {ok, self()}), - acceptor_loop(Manager, SocketType, ListenSocket, ConfigDb, AcceptTimeout). + acceptor_loop(Manager, SocketType, ListenSocket, IpFamily, ConfigDb, AcceptTimeout). -acceptor_init(Parent, Manager, SocketType, Addr, Port, +acceptor_init(Parent, Manager, SocketType, Addr, Port, IpFamily, ConfigDb, AcceptTimeout) -> ?hdrd("acceptor init", [{parent, Parent}, @@ -77,20 +77,20 @@ acceptor_init(Parent, Manager, SocketType, Addr, Port, {address, Addr}, {port, Port}, {timeout, AcceptTimeout}]), - case (catch do_init(SocketType, Addr, Port)) of + case (catch do_init(SocketType, Addr, Port, IpFamily)) of {ok, ListenSocket} -> proc_lib:init_ack(Parent, {ok, self()}), acceptor_loop(Manager, SocketType, - ListenSocket, ConfigDb, AcceptTimeout); + ListenSocket, IpFamily,ConfigDb, AcceptTimeout); Error -> proc_lib:init_ack(Parent, Error), error end. -do_init(SocketType, Addr, Port) -> +do_init(SocketType, Addr, Port, IpFamily) -> ?hdrt("do init", []), do_socket_start(SocketType), - ListenSocket = do_socket_listen(SocketType, Addr, Port), + ListenSocket = do_socket_listen(SocketType, Addr, Port, IpFamily), {ok, ListenSocket}. @@ -105,9 +105,9 @@ do_socket_start(SocketType) -> end. -do_socket_listen(SocketType, Addr, Port) -> +do_socket_listen(SocketType, Addr, Port, IpFamily) -> ?hdrt("do socket listen", []), - case http_transport:listen(SocketType, Addr, Port) of + case http_transport:listen(SocketType, Addr, Port, IpFamily) of {ok, ListenSocket} -> ListenSocket; {error, Reason} -> @@ -121,7 +121,7 @@ do_socket_listen(SocketType, Addr, Port) -> %% acceptor -acceptor_loop(Manager, SocketType, ListenSocket, ConfigDb, AcceptTimeout) -> +acceptor_loop(Manager, SocketType, ListenSocket, IpFamily, ConfigDb, AcceptTimeout) -> ?hdrd("awaiting accept", [{manager, Manager}, {socket_type, SocketType}, @@ -133,12 +133,12 @@ acceptor_loop(Manager, SocketType, ListenSocket, ConfigDb, AcceptTimeout) -> handle_connection(Manager, ConfigDb, AcceptTimeout, SocketType, Socket), ?MODULE:acceptor_loop(Manager, SocketType, - ListenSocket, ConfigDb,AcceptTimeout); + ListenSocket, IpFamily, ConfigDb,AcceptTimeout); {error, Reason} -> ?hdri("accept failed", [{reason, Reason}]), handle_error(Reason, ConfigDb), ?MODULE:acceptor_loop(Manager, SocketType, ListenSocket, - ConfigDb, AcceptTimeout); + IpFamily, ConfigDb, AcceptTimeout); {'EXIT', Reason} -> ?hdri("accept exited", [{reason, Reason}]), ReasonString = diff --git a/lib/inets/src/http_server/httpd_acceptor_sup.erl b/lib/inets/src/http_server/httpd_acceptor_sup.erl index 8b1e4b6c4f..df837b5a24 100644 --- a/lib/inets/src/http_server/httpd_acceptor_sup.erl +++ b/lib/inets/src/http_server/httpd_acceptor_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -27,7 +27,7 @@ -behaviour(supervisor). %% API --export([start_link/2, start_acceptor/5, start_acceptor/6, stop_acceptor/2]). +-export([start_link/2, start_acceptor/6, start_acceptor/7, stop_acceptor/2]). %% Supervisor callback -export([init/1]). @@ -43,11 +43,11 @@ start_link(Addr, Port) -> %% Function: [start|stop]_acceptor/5 %% Description: Starts/stops an [auth | security] worker (child) process %%---------------------------------------------------------------------- -start_acceptor(SocketType, Addr, Port, ConfigDb, AcceptTimeout) -> - start_worker(httpd_acceptor, SocketType, Addr, Port, +start_acceptor(SocketType, Addr, Port, IpFamily, ConfigDb, AcceptTimeout) -> + start_worker(httpd_acceptor, SocketType, Addr, Port, IpFamily, ConfigDb, AcceptTimeout, self(), []). -start_acceptor(SocketType, Addr, Port, ConfigDb, AcceptTimeout, ListenSocket) -> - start_worker(httpd_acceptor, SocketType, Addr, Port, +start_acceptor(SocketType, Addr, Port, IpFamily, ConfigDb, AcceptTimeout, ListenSocket) -> + start_worker(httpd_acceptor, SocketType, Addr, Port, IpFamily, ConfigDb, AcceptTimeout, ListenSocket, self(), []). @@ -69,18 +69,18 @@ init(_) -> make_name(Addr,Port) -> httpd_util:make_name("httpd_acc_sup", Addr, Port). -start_worker(M, SocketType, Addr, Port, ConfigDB, AcceptTimeout, Manager, Modules) -> +start_worker(M, SocketType, Addr, Port, IpFamily, ConfigDB, AcceptTimeout, Manager, Modules) -> SupName = make_name(Addr, Port), - Args = [Manager, SocketType, Addr, Port, ConfigDB, AcceptTimeout], + Args = [Manager, SocketType, Addr, Port, IpFamily, ConfigDB, AcceptTimeout], Spec = {{M, Addr, Port}, {M, start_link, Args}, permanent, timer:seconds(1), worker, [M] ++ Modules}, supervisor:start_child(SupName, Spec). -start_worker(M, SocketType, Addr, Port, ConfigDB, AcceptTimeout, ListenSocket, +start_worker(M, SocketType, Addr, Port, IpFamily, ConfigDB, AcceptTimeout, ListenSocket, Manager, Modules) -> SupName = make_name(Addr, Port), - Args = [Manager, SocketType, ListenSocket, ConfigDB, AcceptTimeout], + Args = [Manager, SocketType, ListenSocket, IpFamily, ConfigDB, AcceptTimeout], Spec = {{M, Addr, Port}, {M, start_link, Args}, permanent, timer:seconds(1), worker, [M] ++ Modules}, diff --git a/lib/inets/src/http_server/httpd_conf.erl b/lib/inets/src/http_server/httpd_conf.erl index a97bbd9b25..d45f3c0048 100644 --- a/lib/inets/src/http_server/httpd_conf.erl +++ b/lib/inets/src/http_server/httpd_conf.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -582,11 +582,17 @@ validate_config_params([{server_tokens, {private, Value}} | Rest]) validate_config_params([{server_tokens, Value} | _]) -> throw({server_tokens, Value}); +validate_config_params([{socket_type, ip_comm} | Rest]) -> + validate_config_params(Rest); + validate_config_params([{socket_type, Value} | Rest]) - when (Value =:= ip_comm) orelse - (Value =:= ssl) orelse - (Value =:= essl) -> + when Value == ssl; Value == essl -> validate_config_params(Rest); + +validate_config_params([{socket_type, {Value, _}} | Rest]) + when Value == essl orelse Value == ssl -> + validate_config_params(Rest); + validate_config_params([{socket_type, Value} | _]) -> throw({socket_type, Value}); @@ -916,6 +922,8 @@ lookup_socket_type(ConfigDB) -> case httpd_util:lookup(ConfigDB, socket_type, ip_comm) of ip_comm -> ip_comm; + {Tag, Conf} -> + {Tag, Conf}; SSL when (SSL =:= ssl) orelse (SSL =:= essl) -> SSLTag = if diff --git a/lib/inets/src/http_server/httpd_manager.erl b/lib/inets/src/http_server/httpd_manager.erl index b44bc77c41..672a70a394 100644 --- a/lib/inets/src/http_server/httpd_manager.erl +++ b/lib/inets/src/http_server/httpd_manager.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2010. All Rights Reserved. +%% Copyright Ericsson AB 2000-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -264,11 +264,12 @@ init([ConfigFile, ConfigList, AcceptTimeout, Addr, Port, ListenInfo]) -> end. do_init(ConfigFile, ConfigList, AcceptTimeout, Addr, Port) -> + IpFamily = proplists:get_value(ipfamily, ConfigList, inet6fb4), NewConfigFile = proplists:get_value(file, ConfigList, ConfigFile), ConfigDB = do_initial_store(ConfigList), SocketType = httpd_conf:lookup_socket_type(ConfigDB), case httpd_acceptor_sup:start_acceptor(SocketType, Addr, - Port, ConfigDB, AcceptTimeout) of + Port, IpFamily, ConfigDB, AcceptTimeout) of {ok, _Pid} -> Status = [{max_conn, 0}, {last_heavy_load, never}, @@ -284,11 +285,12 @@ do_init(ConfigFile, ConfigList, AcceptTimeout, Addr, Port) -> end. do_init(ConfigFile, ConfigList, AcceptTimeout, Addr, Port, ListenInfo) -> + IpFamily = proplists:get_value(ipfamily, ConfigList, inet6fb4), NewConfigFile = proplists:get_value(file, ConfigList, ConfigFile), ConfigDB = do_initial_store(ConfigList), SocketType = httpd_conf:lookup_socket_type(ConfigDB), case httpd_acceptor_sup:start_acceptor(SocketType, Addr, - Port, ConfigDB, + Port, IpFamily, ConfigDB, AcceptTimeout, ListenInfo) of {ok, _Pid} -> Status = [{max_conn,0}, {last_heavy_load,never}, diff --git a/lib/inets/src/http_server/httpd_response.erl b/lib/inets/src/http_server/httpd_response.erl index 2dedb088e4..6b6532266b 100644 --- a/lib/inets/src/http_server/httpd_response.erl +++ b/lib/inets/src/http_server/httpd_response.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -35,8 +35,7 @@ generate_and_send_response(#mod{init_data = #init_data{peername = {_,"unknown"}}}) -> ok; generate_and_send_response(#mod{config_db = ConfigDB} = ModData) -> - Modules = httpd_util:lookup(ConfigDB,modules, - [mod_get, mod_head, mod_log]), + Modules = httpd_util:lookup(ConfigDB,modules, ?DEFAULT_MODS), case traverse_modules(ModData, Modules) of done -> ok; @@ -71,7 +70,6 @@ traverse_modules(ModData,[Module|Rest]) -> ?hdrd("traverse modules", [{callback_module, Module}]), case (catch apply(Module, do, [ModData])) of {'EXIT', Reason} -> - ?hdrd("traverse modules - exit", [{reason, Reason}]), String = lists:flatten( io_lib:format("traverse exit from apply: ~p:do => ~n~p", diff --git a/lib/inets/src/http_server/httpd_sup.erl b/lib/inets/src/http_server/httpd_sup.erl index 8f3e8f9500..3b1e16cf78 100644 --- a/lib/inets/src/http_server/httpd_sup.erl +++ b/lib/inets/src/http_server/httpd_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2012. All Rights Reserved. +%% Copyright Ericsson AB 2004-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -196,7 +196,8 @@ httpd_child_spec(ConfigFile, AcceptTimeoutDef, DebugDef) -> end. httpd_child_spec(Config, AcceptTimeout, Debug, Addr, Port) -> - case (Port =:= 0) orelse proplists:is_defined(fd, Config) of + Fd = proplists:get_value(fd, Config, undefined), + case Port == 0 orelse Fd =/= undefined of true -> httpd_child_spec_listen(Config, AcceptTimeout, Debug, Addr, Port); false -> @@ -242,21 +243,27 @@ error_msg(F, A) -> error_logger:error_msg(F ++ "~n", A). listen(Address, Port, Config) -> - SocketType = proplists:get_value(socket_type, Config, ip_comm), - case http_transport:start(SocketType) of - ok -> - Fd = proplists:get_value(fd, Config), - case http_transport:listen(SocketType, Address, Port, Fd) of - {ok, ListenSocket} -> - NewConfig = proplists:delete(port, Config), - {ok, NewPort} = inet:port(ListenSocket), - {NewPort, [{port, NewPort} | NewConfig], ListenSocket}; + try socket_type(Config) of + SocketType -> + case http_transport:start(SocketType) of + ok -> + Fd = proplists:get_value(fd, Config), + IpFamily = proplists:get_value(ipfamily, Config, inet6fb4), + case http_transport:listen(SocketType, Address, Port, Fd, IpFamily) of + {ok, ListenSocket} -> + NewConfig = proplists:delete(port, Config), + {NewPort, _} = http_transport:sockname(SocketType, ListenSocket), + {NewPort, [{port, NewPort} | NewConfig], ListenSocket}; + {error, Reason} -> + {error, {listen, Reason}} + end; {error, Reason} -> - {error, {listen, Reason}} - end; - {error, Reason} -> + {error, {socket_start_failed, Reason}} + end + catch + _:Reason -> {error, {socket_start_failed, Reason}} - end. + end. start_listen(Address, Port, Config) -> Pid = listen_owner(Address, Port, Config), @@ -280,7 +287,82 @@ listen_loop() -> ok end. +socket_type(Config) -> + SocketType = proplists:get_value(socket_type, Config, ip_comm), + socket_type(SocketType, Config). + +socket_type(ip_comm = SocketType, _) -> + SocketType; +socket_type({essl, _} = SocketType, _) -> + SocketType; +socket_type(_, Config) -> + {essl, ssl_config(Config)}. + +%%% Backwards compatibility +ssl_config(Config) -> + ssl_certificate_key_file(Config) ++ + ssl_verify_client(Config) ++ + ssl_ciphers(Config) ++ + ssl_password(Config) ++ + ssl_verify_depth(Config) ++ + ssl_ca_certificate_file(Config). + +ssl_certificate_key_file(Config) -> + case proplists:get_value(ssl_certificate_key_file, Config) of + undefined -> + []; + SSLCertificateKeyFile -> + [{keyfile,SSLCertificateKeyFile}] + end. +ssl_verify_client(Config) -> + case proplists:get_value(ssl_verify_client, Config) of + undefined -> + []; + SSLVerifyClient -> + [{verify,SSLVerifyClient}] + end. +ssl_ciphers(Config) -> + case proplists:get_value(ssl_ciphers, Config) of + undefined -> + []; + Ciphers -> + [{ciphers, Ciphers}] + end. +ssl_password(Config) -> + case proplists:get_value(ssl_password_callback_module, Config) of + undefined -> + []; + Module -> + case proplists:get_value(ssl_password_callback_function, Config) of + undefined -> + []; + Function -> + Args = case proplists:get_value(ssl_password_callback_arguments, Config) of + undefined -> + []; + Arguments -> + [Arguments] + end, + Password = apply(Module, Function, Args), + [{password, Password}] + end + end. +ssl_verify_depth(Config) -> + case proplists:get_value(ssl_verify_client_depth, Config) of + undefined -> + []; + Depth -> + [{depth, Depth}] + end. + +ssl_ca_certificate_file(Config) -> + case proplists:get_value(ssl_ca_certificate_file, Config) of + undefined -> + []; + File -> + [{cacertfile, File}] + end. diff --git a/lib/inets/test/Makefile b/lib/inets/test/Makefile index 0ca99e8692..0e7954fba8 100644 --- a/lib/inets/test/Makefile +++ b/lib/inets/test/Makefile @@ -184,7 +184,8 @@ MODULES = \ inets_app_test \ inets_appup_test \ tftp_test_lib \ - tftp_SUITE + tftp_SUITE \ + uri_SUITE EBIN = . diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index 5a3bdaefcf..8df5964193 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -19,2656 +19,919 @@ %% %% -%% ts:run(inets, httpc_SUITE, [batch]). -%% +%% ct:run("../inets_test", httpc_SUITE). +%% -module(httpc_SUITE). --include_lib("common_test/include/ct.hrl"). --include("test_server_line.hrl"). - -include_lib("kernel/include/file.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("inets_test_lib.hrl"). %% Note: This directive should only be used in test suites. -compile(export_all). -%% Test server specific exports --define(IP_PORT, 8998). --define(SSL_PORT, 8999). +-define(URL_START, "http://"). +-define(TLS_URL_START, "https://"). -define(NOT_IN_USE_PORT, 8997). --define(LOCAL_HOST, {127,0,0,1}). --define(IPV6_LOCAL_HOST, "0:0:0:0:0:0:0:1"). --define(URL_START, "http://localhost:"). --define(SSL_URL_START, "https://localhost:"). --define(CR, $\r). -define(LF, $\n). -define(HTTP_MAX_HEADER_SIZE, 10240). - - +-record(sslsocket, {fd = nil, pid = nil}). %%-------------------------------------------------------------------- -%% all(Arg) -> [Doc] | [Case] | {skip, Comment} -%% Arg - doc | suite -%% Doc - string() -%% Case - atom() -%% Name of a test case function. -%% Comment - string() -%% Description: Returns documentation/test cases in this test suite -%% or a skip tuple if the platform is not supported. +%% Common Test interface functions ----------------------------------- %%-------------------------------------------------------------------- +suite() -> + [{ct_hooks,[ts_install_cth]}]. -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> +all() -> [ - http_options, - http_head, - http_get, - http_post, - http_post_streaming, - http_dummy_pipe, - http_inets_pipe, - http_trace, - http_async, - http_save_to_file, - http_save_to_file_async, - http_headers, - http_headers_dummy, - http_bad_response, - http_redirect, - http_redirect_loop, - http_internal_server_error, - http_userinfo, http_cookie, - http_server_does_not_exist, - http_invalid_http, - http_emulate_lower_versions, - http_relaxed, - page_does_not_exist, - parse_url, - options, - headers_as_is, - selecting_session, - {group, ssl}, - {group, stream}, - {group, ipv6}, - {group, tickets}, - initial_server_connect + {group, http}, + {group, sim_http}, + {group, https}, + {group, sim_https}, + {group, misc} ]. -groups() -> +groups() -> [ - {ssl, [], [ssl_head, - essl_head, - ssl_get, - essl_get, - ssl_trace, - essl_trace]}, - {stream, [], [http_stream, - http_stream_once]}, - {tickets, [], [hexed_query_otp_6191, - empty_body_otp_6243, - empty_response_header_otp_6830, - transfer_encoding_otp_6807, - no_content_204_otp_6982, - missing_CR_otp_7304, - {group, otp_7883}, - {group, otp_8154}, - {group, otp_8106}, - otp_8056, - otp_8352, - otp_8371, - otp_8739]}, - {otp_7883, [], [otp_7883_1, - otp_7883_2]}, - {otp_8154, [], [otp_8154_1]}, - {otp_8106, [], [otp_8106_pid, - otp_8106_fun, - otp_8106_mfa]}, - {ipv6, [], [ipv6_ipcomm, ipv6_essl]} + {http, [], real_requests()}, + {sim_http, [], only_simulated()}, + {https, [], real_requests()}, + {sim_https, [], only_simulated()}, + {misc, [], misc()} ]. +real_requests()-> + [ + head, + get, + post, + post_stream, + async, + pipeline, + persistent_connection, + save_to_file, + save_to_file_async, + headers_as_is, + page_does_not_exist, + emulate_lower_versions, + headers, + headers_as_is, + empty_body, + stream, + stream_to_pid, + stream_through_fun, + stream_through_mfa, + streaming_error, + inet_opts + ]. -init_per_group(ipv6 = _GroupName, Config) -> - case inets_test_lib:has_ipv6_support() of - {ok, _} -> - Config; - _ -> - {skip, "Host does not support IPv6"} - end; -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. +only_simulated() -> + [ + cookie, + trace, + stream_once, + no_content_204, + tolerate_missing_CR, + userinfo, + bad_response, + internal_server_error, + invalid_http, + headers_dummy, + empty_response_header, + remote_socket_close, + remote_socket_close_async, + transfer_encoding, + redirect_loop, + redirect_moved_permanently, + redirect_multiple_choises, + redirect_found, + redirect_see_other, + redirect_temporary_redirect, + port_in_host_header, + relaxed + ]. +misc() -> + [ + server_does_not_exist, + timeout_memory_leak, + wait_for_whole_response + ]. %%-------------------------------------------------------------------- -%% Function: init_per_suite(Config) -> Config -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Initiation before the whole suite -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. -%%-------------------------------------------------------------------- -init_per_suite(Config) -> - - ?PRINT_SYSTEM_INFO([]), +init_per_suite(Config) -> PrivDir = ?config(priv_dir, Config), DataDir = ?config(data_dir, Config), + inets_test_lib:start_apps([inets]), ServerRoot = filename:join(PrivDir, "server_root"), DocRoot = filename:join(ServerRoot, "htdocs"), - IpConfFile = integer_to_list(?IP_PORT) ++ ".conf", - SslConfFile = integer_to_list(?SSL_PORT) ++ ".conf", - setup_server_dirs(ServerRoot, DocRoot, DataDir), - create_config(IpConfFile, ip_comm, ?IP_PORT, PrivDir, ServerRoot, - DocRoot, DataDir), - create_config(SslConfFile, ssl, ?SSL_PORT, PrivDir, ServerRoot, - DocRoot, DataDir), - - Cgi = case test_server:os_type() of - {win32, _} -> - filename:join([ServerRoot, "cgi-bin", "cgi_echo.exe"]); - _ -> - filename:join([ServerRoot, "cgi-bin", "cgi_echo"]) - end, - - {ok, FileInfo} = file:read_file_info(Cgi), - ok = file:write_file_info(Cgi, FileInfo#file_info{mode = 8#00755}), - - [{has_ipv6_support, inets_test_lib:has_ipv6_support()}, - {server_root, ServerRoot}, - {doc_root, DocRoot}, - {local_port, ?IP_PORT}, - {local_ssl_port, ?SSL_PORT} | Config]. + [{server_root, ServerRoot}, {doc_root, DocRoot} | Config]. - -%%-------------------------------------------------------------------- -%% Function: end_per_suite(Config) -> _ -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Cleanup after the whole suite -%%-------------------------------------------------------------------- end_per_suite(Config) -> - PrivDir = ?config(priv_dir, Config), + inets_test_lib:stop_apps([inets]), + PrivDir = ?config(priv_dir, Config), inets_test_lib:del_dirs(PrivDir), - application:stop(inets), - application:stop(ssl), ok. - %%-------------------------------------------------------------------- -%% Function: init_per_testcase(Case, Config) -> Config -%% Case - atom() -%% Name of the test case that is about to be run. -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% -%% Description: Initiation before each test case -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. +init_per_group(misc = Group, Config) -> + start_apps(Group), + Inet = inet_version(), + ok = httpc:set_options([{ipfamily, Inet}]), + Config; + +init_per_group(Group, Config0) -> + start_apps(Group), + Config = proplists:delete(port, Config0), + Port = server_start(Group, server_config(Group, Config)), + [{port, Port} | Config]. + +end_per_group(_, _Config) -> + ok. + %%-------------------------------------------------------------------- +init_per_testcase(pipeline, Config) -> + inets:start(httpc, [{profile, pipeline}]), + httpc:set_options([{pipeline_timeout, 50000}, + {max_pipeline_length, 3}], pipeline), -init_per_testcase(otp_8154_1 = Case, Config) -> - init_per_testcase(Case, 5, Config); - -init_per_testcase(initial_server_connect = Case, Config) -> - %% Try to check if crypto actually exist or not, - %% this test case does not work unless it does - try - begin - ?ENSURE_STARTED([crypto, public_key, ssl]), - inets:start(), - Config - end - catch - throw:{error, {failed_starting, App, ActualError}} -> - tsp("init_per_testcase(~w) -> failed starting ~w: " - "~n ~p", [Case, App, ActualError]), - SkipString = - "Could not start " ++ atom_to_list(App), - skip(SkipString); - _:X -> - SkipString = - lists:flatten( - io_lib:format("Failed starting apps: ~p", [X])), - skip(SkipString) - end; + Config; +init_per_testcase(persistent_connection, Config) -> + inets:start(httpc, [{profile, persistent}]), + httpc:set_options([{keep_alive_timeout, 50000}, + {max_keep_alive_length, 3}], persistent_connection), -init_per_testcase(Case, Config) -> - init_per_testcase(Case, 2, Config). + Config; -init_per_testcase(Case, Timeout, Config) -> - io:format(user, - "~n~n*** INIT ~w:~w[~w] ***" - "~n~n", [?MODULE, Case, Timeout]), +init_per_testcase(_Case, Config) -> + Config. - PrivDir = ?config(priv_dir, Config), - application:stop(inets), - Dog = test_server:timetrap(inets_test_lib:minutes(Timeout)), - TmpConfig = lists:keydelete(watchdog, 1, Config), - IpConfFile = integer_to_list(?IP_PORT) ++ ".conf", - SslConfFile = integer_to_list(?SSL_PORT) ++ ".conf", - - %% inets:enable_trace(max, io, httpd), - %% inets:enable_trace(max, io, httpc), - %% inets:enable_trace(max, io, all), - - NewConfig = - case atom_to_list(Case) of - [$s, $s, $l | _] -> - ?ENSURE_STARTED([crypto, public_key, ssl]), - init_per_testcase_ssl(ssl, PrivDir, SslConfFile, - [{watchdog, Dog} | TmpConfig]); - - [$e, $s, $s, $l | _] -> - ?ENSURE_STARTED([crypto, public_key, ssl]), - init_per_testcase_ssl(essl, PrivDir, SslConfFile, - [{watchdog, Dog} | TmpConfig]); - - "ipv6_" ++ _Rest -> - %% Ensure needed apps (crypto, public_key and ssl) are started - try ?ENSURE_STARTED([crypto, public_key, ssl]) of - ok -> - Profile = ipv6, - %% A stand-alone profile is represented by a pid() - {ok, ProfilePid} = - inets:start(httpc, - [{profile, Profile}, - {data_dir, PrivDir}], stand_alone), - ok = httpc:set_options([{ipfamily, inet6}], - ProfilePid), - tsp("httpc profile pid: ~p", [ProfilePid]), - [{watchdog, Dog}, {profile, ProfilePid}| TmpConfig] - catch - throw:{error, {failed_starting, App, ActualError}} -> - tsp("init_per_testcase(~w) -> failed starting ~w: " - "~n ~p", [Case, App, ActualError]), - SkipString = - "Could not start " ++ atom_to_list(App), - skip(SkipString); - _:X -> - SkipString = - lists:flatten( - io_lib:format("Failed starting apps: ~p", [X])), - skip(SkipString) - end; - - _ -> - %% Try inet6fb4 on windows... - %% No need? Since it is set above? - - %% tsp("init_per_testcase -> allways try IPv6 on windows"), - %% ?RUN_ON_WINDOWS( - %% fun() -> - %% tsp("init_per_testcase:set_options_fun -> " - %% "set-option ipfamily to inet6fb4"), - %% Res = httpc:set_options([{ipfamily, inet6fb4}]), - %% tsp("init_per_testcase:set_options_fun -> " - %% "~n Res: ~p", [Res]), - %% Res - %% end), - - TmpConfig2 = lists:keydelete(local_server, 1, TmpConfig), - %% Will start inets - tsp("init_per_testcase -> try start server"), - Server = start_http_server(PrivDir, IpConfFile), - [{watchdog, Dog}, {local_server, Server} | TmpConfig2] - end, - - %% <IPv6> - %% Set default ipfamily to the same as the main server has by default - %% This makes the client try w/ ipv6 before falling back to ipv4, - %% as that is what the server is configured to do. - %% Note that this is required for the tests to run on *BSD w/ ipv6 enabled - %% as well as on Windows. The Linux behaviour of allowing ipv4 connects - %% to ipv6 sockets is not required or even encouraged. - - tsp("init_per_testcase -> Options before ipfamily set: ~n~p", - [httpc:get_options(all)]), - ok = httpc:set_options([{ipfamily, inet6fb4}]), - tsp("init_per_testcase -> Options after ipfamily set: ~n~p", - [httpc:get_options(all)]), - - %% Note that the IPv6 test case(s) *must* use inet6, - %% so this value will be overwritten (see "ipv6_" below). - %% </IPv6> - - %% inets:enable_trace(max, io, all), - %% snmp:set_trace([gen_tcp]), - tsp("init_per_testcase(~w) -> done when" - "~n NewConfig: ~p" - "~n~n", [Case, NewConfig]), - NewConfig. - - -init_per_testcase_ssl(Tag, PrivDir, SslConfFile, Config) -> - tsp("init_per_testcase_ssl(~w) -> stop ssl", [Tag]), - application:stop(ssl), - Config2 = lists:keydelete(local_ssl_server, 1, Config), - %% Will start inets - tsp("init_per_testcase_ssl(~w) -> try start http server (including inets)", - [Tag]), - Server = inets_test_lib:start_http_server( - filename:join(PrivDir, SslConfFile), Tag), - tsp("init_per_testcase(~w) -> Server: ~p", [Tag, Server]), - [{local_ssl_server, Server} | Config2]. - -start_http_server(ConfDir, ConfFile) -> - inets_test_lib:start_http_server( filename:join(ConfDir, ConfFile) ). +end_per_testcase(pipeline, _Config) -> + inets:stop(httpc, pipeline); +end_per_testcase(persistent_connection, _Config) -> + inets:stop(httpc, persistent); +end_per_testcase(_Case, _Config) -> + ok. %%-------------------------------------------------------------------- -%% Function: end_per_testcase(Case, Config) -> _ -%% Case - atom() -%% Name of the test case that is about to be run. -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Cleanup after each test case +%% Test Cases -------------------------------------------------------- %%-------------------------------------------------------------------- -end_per_testcase(http_save_to_file = Case, Config) -> - io:format(user, "~n~n*** END ~w:~w ***~n~n", - [?MODULE, Case]), - PrivDir = ?config(priv_dir, Config), - FullPath = filename:join(PrivDir, "dummy.html"), - file:delete(FullPath), - finish(Config); - -end_per_testcase(Case, Config) -> - io:format(user, "~n~n*** END ~w:~w ***~n~n", - [?MODULE, Case]), - case atom_to_list(Case) of - "ipv6_" ++ _Rest -> - tsp("end_per_testcase(~w) -> stop ssl", [Case]), - application:stop(ssl), - tsp("end_per_testcase(~w) -> stop public_key", [Case]), - application:stop(public_key), - tsp("end_per_testcase(~w) -> stop crypto", [Case]), - application:stop(crypto), - ProfilePid = ?config(profile, Config), - tsp("end_per_testcase(~w) -> stop httpc profile (~p)", - [Case, ProfilePid]), - unlink(ProfilePid), - inets:stop(stand_alone, ProfilePid), - tsp("end_per_testcase(~w) -> httpc profile (~p) stopped", - [Case, ProfilePid]), - ok; - _ -> - ok - end, - finish(Config). -finish(Config) -> - Dog = ?config(watchdog, Config), - case Dog of - undefined -> - ok; - _ -> - tsp("finish -> stop watchdog (~p)", [Dog]), - test_server:timetrap_cancel(Dog) - end. - -%%------------------------------------------------------------------------- -%% Test cases starts here. -%%------------------------------------------------------------------------- +head() -> + [{doc, "Test http head request against local server."}]. +head(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/dummy.html", Config), []}, + {ok, {{_,200,_}, [_ | _], []}} = httpc:request(head, Request, [], []). +%%-------------------------------------------------------------------- +get() -> + [{doc, "Test http get request against local server"}]. +get(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/dummy.html", Config), []}, + {ok, {{_,200,_}, [_ | _], Body = [_ | _]}} = httpc:request(get, Request, [], []), + inets_test_lib:check_body(Body), -%%------------------------------------------------------------------------- - -http_options(doc) -> - ["Test http options request against local server."]; -http_options(suite) -> - []; -http_options(Config) when is_list(Config) -> - skip("Not supported by httpd"). + {ok, {{_,200,_}, [_ | _], BinBody}} = httpc:request(get, Request, [], [{body_format, binary}]), + true = is_binary(BinBody). +%%-------------------------------------------------------------------- +post() -> + [{"Test http post request against local server. We do in this case " + "only care about the client side of the the post. The server " + "script will not actually use the post data."}]. +post(Config) when is_list(Config) -> + CGI = case test_server:os_type() of + {win32, _} -> + "/cgi-bin/cgi_echo.exe"; + _ -> + "/cgi-bin/cgi_echo" + end, -http_head(doc) -> - ["Test http head request against local server."]; -http_head(suite) -> - []; -http_head(Config) when is_list(Config) -> - tsp("http_head -> entry with" - "~n Config: ~p", [Config]), - Method = head, - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - Request = {URL, []}, - HttpOpts = [], - Opts = [], - VerifyResult = - fun({ok, {{_,200,_}, [_ | _], []}}) -> - ok; - ({ok, UnexpectedReply}) -> - tsp("http_head:verify_fun -> Unexpected Reply: " - "~n ~p", [UnexpectedReply]), - tsf({unexpected_reply, UnexpectedReply}); - ({error, Reason} = Error) -> - tsp("http_head:verify_fun -> Error reply: " - "~n Reason: ~p", [Reason]), - tsf({bad_reply, Error}) - end, - simple_request_and_verify(Config, - Method, Request, HttpOpts, Opts, VerifyResult). + URL = url(group_name(Config), CGI, Config), + %% Cgi-script expects the body length to be 100 + Body = lists:duplicate(100, "1"), -%%------------------------------------------------------------------------- + {ok, {{_,200,_}, [_ | _], [_ | _]}} = + httpc:request(post, {URL, [{"expect","100-continue"}], + "text/plain", Body}, [], []), -http_get(doc) -> - ["Test http get request against local server"]; -http_get(suite) -> - []; -http_get(Config) when is_list(Config) -> - tsp("http_get -> entry with" - "~n Config: ~p", [Config]), - case ?config(local_server, Config) of - ok -> - tsp("local-server running"), - Method = get, - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - Request = {URL, []}, - Timeout = timer:seconds(1), - ConnTimeout = Timeout + timer:seconds(1), - HttpOptions1 = [{timeout, Timeout}, - {connect_timeout, ConnTimeout}], - Options1 = [], - Body = - case httpc:request(Method, Request, HttpOptions1, Options1) of - {ok, {{_,200,_}, [_ | _], ReplyBody = [_ | _]}} -> - ReplyBody; - {ok, UnexpectedReply1} -> - tsf({unexpected_reply, UnexpectedReply1}); - {error, _} = Error1 -> - tsf({bad_reply, Error1}) - end, - - %% eqvivivalent to httpc:request(get, {URL, []}, [], []), - inets_test_lib:check_body(Body), - - HttpOptions2 = [], - Options2 = [{body_format, binary}], - case httpc:request(Method, Request, HttpOptions2, Options2) of - {ok, {{_,200,_}, [_ | _], Bin}} when is_binary(Bin) -> - ok; - {ok, {{_,200,_}, [_ | _], BadBin}} -> - tsf({body_format_not_binary, BadBin}); - {ok, UnexpectedReply2} -> - tsf({unexpected_reply, UnexpectedReply2}); - {error, _} = Error2 -> - tsf({bad_reply, Error2}) - end; - _ -> - skip("Failed to start local http-server") - end. + {ok, {{_,504,_}, [_ | _], []}} = + httpc:request(post, {URL, [{"expect","100-continue"}], + "text/plain", "foobar"}, [], []). -%%------------------------------------------------------------------------- +%%-------------------------------------------------------------------- +post_stream() -> + [{"Test streaming http post request against local server. " + "We only care about the client side of the the post. " + "The server script will not actually use the post data."}]. +post_stream(Config) when is_list(Config) -> + CGI = case test_server:os_type() of + {win32, _} -> + "/cgi-bin/cgi_echo.exe"; + _ -> + "/cgi-bin/cgi_echo" + end, -http_post(doc) -> - ["Test http post request against local server. We do in this case " - "only care about the client side of the the post. The server " - "script will not actually use the post data."]; -http_post(suite) -> - []; -http_post(Config) when is_list(Config) -> - case ?config(local_server, Config) of - ok -> - Port = ?config(local_port, Config), - - URL = case test_server:os_type() of - {win32, _} -> - ?URL_START ++ integer_to_list(Port) ++ - "/cgi-bin/cgi_echo.exe"; - _ -> - ?URL_START ++ integer_to_list(Port) ++ - "/cgi-bin/cgi_echo" - - end, - %% Cgi-script expects the body length to be 100 - Body = lists:duplicate(100, "1"), - - {ok, {{_,200,_}, [_ | _], [_ | _]}} = - httpc:request(post, {URL, [{"expect","100-continue"}], - "text/plain", Body}, [], []), - - {ok, {{_,504,_}, [_ | _], []}} = - httpc:request(post, {URL, [{"expect","100-continue"}], - "text/plain", "foobar"}, [], []); - _ -> - skip("Failed to start local http-server") - end. + URL = url(group_name(Config), CGI, Config), -%%------------------------------------------------------------------------- -http_post_streaming(doc) -> - ["Test streaming http post request against local server. " - "We only care about the client side of the the post. " - "The server script will not actually use the post data."]; -http_post_streaming(suite) -> - []; -http_post_streaming(Config) when is_list(Config) -> - case ?config(local_server, Config) of - ok -> - Port = ?config(local_port, Config), - URL = case test_server:os_type() of - {win32, _} -> - ?URL_START ++ integer_to_list(Port) ++ - "/cgi-bin/cgi_echo.exe"; - _ -> - ?URL_START ++ integer_to_list(Port) ++ - "/cgi-bin/cgi_echo" - end, - %% Cgi-script expects the body length to be 100 - BodyFun = fun(0) -> - io:format("~w:http_post_streaming_fun -> " - "zero~n", [?MODULE]), - eof; - (LenLeft) -> - io:format("~w:http_post_streaming_fun -> " - "LenLeft: ~p~n", [?MODULE, LenLeft]), - {ok, lists:duplicate(10, "1"), LenLeft - 10} - end, - - {ok, {{_,200,_}, [_ | _], [_ | _]}} = - httpc:request(post, {URL, - [{"expect", "100-continue"}, - {"content-length", "100"}], - "text/plain", {BodyFun, 100}}, [], []), - - {ok, {{_,504,_}, [_ | _], []}} = - httpc:request(post, {URL, - [{"expect", "100-continue"}, - {"content-length", "10"}], - "text/plain", {BodyFun, 10}}, [], []); - - _ -> - skip("Failed to start local http-server") - end. + %% Cgi-script expects the body length to be 100 + BodyFun = fun(0) -> + eof; + (LenLeft) -> + {ok, lists:duplicate(10, "1"), LenLeft - 10} + end, + {ok, {{_,200,_}, [_ | _], [_ | _]}} = + httpc:request(post, {URL, + [{"expect", "100-continue"}, + {"content-length", "100"}], + "text/plain", {BodyFun, 100}}, [], []), -%%------------------------------------------------------------------------- -http_emulate_lower_versions(doc) -> - ["Perform request as 0.9 and 1.0 clients."]; -http_emulate_lower_versions(suite) -> - []; -http_emulate_lower_versions(Config) when is_list(Config) -> - case ?config(local_server, Config) of - ok -> - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - {ok, Body0} = - httpc:request(get, {URL, []}, [{version, "HTTP/0.9"}], []), - inets_test_lib:check_body(Body0), - {ok, {{"HTTP/1.0", 200, _}, [_ | _], Body1 = [_ | _]}} = - httpc:request(get, {URL, []}, [{version, "HTTP/1.0"}], []), - inets_test_lib:check_body(Body1), - {ok, {{"HTTP/1.1", 200, _}, [_ | _], Body2 = [_ | _]}} = - httpc:request(get, {URL, []}, [{version, "HTTP/1.1"}], []), - inets_test_lib:check_body(Body2); - _-> - skip("Failed to start local http-server") - end. + {ok, {{_,504,_}, [_ | _], []}} = + httpc:request(post, {URL, + [{"expect", "100-continue"}, + {"content-length", "10"}], + "text/plain", {BodyFun, 10}}, [], []). +%%-------------------------------------------------------------------- +trace() -> + [{doc, "Perform a TRACE request."}]. +trace(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/trace.html", Config), []}, + case httpc:request(trace, Request, [], []) of + {ok, {{_,200,_}, [_ | _], "TRACE /trace.html" ++ _}} -> + ok; + Other -> + ct:fail({unexpected, Other}) + end. -%%------------------------------------------------------------------------- +%%-------------------------------------------------------------------- -http_relaxed(doc) -> - ["Test relaxed mode"]; -http_relaxed(suite) -> - []; -http_relaxed(Config) when is_list(Config) -> - ok = httpc:set_options([{ipv6, disabled}]), % also test the old option - %% ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(ipv4), +pipeline(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/dummy.html", Config), []}, + {ok, _} = httpc:request(get, Request, [], [], pipeline), - URL = ?URL_START ++ integer_to_list(Port) ++ - "/missing_reason_phrase.html", - - {error, Reason} = - httpc:request(get, {URL, []}, [{relaxed, false}], []), + %% Make sure pipeline session is registerd + test_server:sleep(4000), + keep_alive_requests(Request, pipeline). - test_server:format("Not relaxed: ~p~n", [Reason]), - - {ok, {{_, 200, _}, [_ | _], [_ | _]}} = - httpc:request(get, {URL, []}, [{relaxed, true}], []), +%%-------------------------------------------------------------------- - DummyServerPid ! stop, - ok = httpc:set_options([{ipv6, enabled}]), - %% ok = httpc:set_options([{ipfamily, inet6fb4}]), - ok. +persistent_connection(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/dummy.html", Config), []}, + {ok, _} = httpc:request(get, Request, [], [], persistent), + %% Make sure pipeline session is registerd + test_server:sleep(4000), + keep_alive_requests(Request, persistent). %%------------------------------------------------------------------------- -http_dummy_pipe(doc) -> - ["Test pipelining code."]; -http_dummy_pipe(suite) -> - []; -http_dummy_pipe(Config) when is_list(Config) -> - ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(ipv4), - - URL = ?URL_START ++ integer_to_list(Port) ++ "/foobar.html", - - test_pipeline(URL), - - DummyServerPid ! stop, - ok = httpc:set_options([{ipfamily, inet6fb4}]), - ok. - -http_inets_pipe(doc) -> - ["Test pipelining code."]; -http_inets_pipe(suite) -> - []; -http_inets_pipe(Config) when is_list(Config) -> - - case ?config(local_server, Config) of - ok -> - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - test_pipeline(URL); - _ -> - skip("Failed to start local http-server") - end. +async() -> + [{doc, "Test an asynchrony http request."}]. +async(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/dummy.html", Config), []}, + {ok, RequestId} = + httpc:request(get, Request, [], [{sync, false}]), + Body = + receive + {http, {RequestId, {{_, 200, _}, _, BinBody}}} -> + BinBody; + {http, Msg} -> + ct:fail(Msg) + end, + inets_test_lib:check_body(binary_to_list(Body)), -test_pipeline(URL) -> - p("test_pipeline -> entry with" - "~n URL: ~p", [URL]), - - httpc:set_options([{pipeline_timeout, 50000}]), - - p("test_pipeline -> issue (async) request 1" - "~n when profile info: ~p", [httpc:info()]), - {ok, RequestIdA1} = - httpc:request(get, {URL, []}, [], [{sync, false}]), - tsp("RequestIdA1: ~p", [RequestIdA1]), - p("test_pipeline -> RequestIdA1: ~p" - "~n when profile info: ~p", [RequestIdA1, httpc:info()]), - - %% Make sure pipeline is initiated - p("test_pipeline -> sleep some", []), - test_server:sleep(4000), - - p("test_pipeline -> issue (async) request A2, A3 and A4" - "~n when profile info: ~p", [httpc:info()]), - {ok, RequestIdA2} = - httpc:request(get, {URL, []}, [], [{sync, false}]), - {ok, RequestIdA3} = - httpc:request(get, {URL, []}, [], [{sync, false}]), - {ok, RequestIdA4} = - httpc:request(get, {URL, []}, [], [{sync, false}]), - tsp("RequestIdAs => A2: ~p, A3: ~p and A4: ~p", - [RequestIdA2, RequestIdA3, RequestIdA4]), - p("test_pipeline -> RequestIds => A2: ~p, A3: ~p and A4: ~p" - "~n when profile info: ~p", - [RequestIdA2, RequestIdA3, RequestIdA4, httpc:info()]), - - p("test_pipeline -> issue (sync) request 3"), - {ok, {{_,200,_}, [_ | _], [_ | _]}} = - httpc:request(get, {URL, []}, [], []), - - p("test_pipeline -> expect reply for (async) request A1, A2, A3 and A4" - "~n when profile info: ~p", [httpc:info()]), - pipeline_await_async_reply([{RequestIdA1, a1, 200}, - {RequestIdA2, a2, 200}, - {RequestIdA3, a3, 200}, - {RequestIdA4, a4, 200}], ?MINS(1)), - - p("test_pipeline -> sleep some" - "~n when profile info: ~p", [httpc:info()]), - test_server:sleep(4000), - - p("test_pipeline -> issue (async) request B1, B2, B3 and B4" - "~n when profile info: ~p", [httpc:info()]), - {ok, RequestIdB1} = - httpc:request(get, {URL, []}, [], [{sync, false}]), - {ok, RequestIdB2} = - httpc:request(get, {URL, []}, [], [{sync, false}]), - {ok, RequestIdB3} = - httpc:request(get, {URL, []}, [], [{sync, false}]), - {ok, RequestIdB4} = - httpc:request(get, {URL, []}, [], [{sync, false}]), - tsp("RequestIdBs => B1: ~p, B2: ~p, B3: ~p and B4: ~p", - [RequestIdB1, RequestIdB2, RequestIdB3, RequestIdB4]), - p("test_pipeline -> RequestIdBs => B1: ~p, B2: ~p, B3: ~p and B4: ~p" - "~n when profile info: ~p", - [RequestIdB1, RequestIdB2, RequestIdB3, RequestIdB4, httpc:info()]), - - p("test_pipeline -> cancel (async) request B2" - "~n when profile info: ~p", [httpc:info()]), - ok = httpc:cancel_request(RequestIdB2), - - p("test_pipeline -> " - "expect *no* reply for cancelled (async) request B2 (for 3 secs)" - "~n when profile info: ~p", [httpc:info()]), + {ok, NewRequestId} = + httpc:request(get, Request, [], [{sync, false}]), + ok = httpc:cancel_request(NewRequestId), receive - {http, {RequestIdB2, _}} -> - tsf(http_cancel_request_failed) + {http, {NewRequestId, _}} -> + ct:fail(http_cancel_request_failed) after 3000 -> ok - end, - - p("test_pipeline -> expect reply for (async) request B1, B3 and B4" - "~n when profile info: ~p", [httpc:info()]), - Bodies = pipeline_await_async_reply([{RequestIdB1, b1, 200}, - {RequestIdB3, b3, 200}, - {RequestIdB4, b4, 200}], ?MINS(1)), - [{b1, Body}|_] = Bodies, - - p("test_pipeline -> check reply for (async) request B1" - "~n when profile info: ~p", [httpc:info()]), - inets_test_lib:check_body(binary_to_list(Body)), - - p("test_pipeline -> ensure no unexpected incomming" - "~n when profile info: ~p", [httpc:info()]), - receive - {http, Any} -> - tsf({unexpected_message, Any}) - after 500 -> - ok - end, - - p("test_pipeline -> done" - "~n when profile info: ~p", [httpc:info()]), - ok. - -pipeline_await_async_reply(ReqIds, Timeout) -> - pipeline_await_async_reply(ReqIds, Timeout, []). + end. +%%------------------------------------------------------------------------- +save_to_file() -> + [{doc, "Test to save the http body to a file"}]. +save_to_file(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + FilePath = filename:join(PrivDir, "dummy.html"), + URL = url(group_name(Config), "/dummy.html", Config), + Request = {URL, []}, + {ok, saved_to_file} + = httpc:request(get, Request, [], [{stream, FilePath}]), + {ok, Bin} = file:read_file(FilePath), + {ok, {{_,200,_}, [_ | _], Body}} = httpc:request(URL), + Bin == Body. -pipeline_await_async_reply([], _, Acc) -> - lists:keysort(1, Acc); -pipeline_await_async_reply(ReqIds, Timeout, Acc) when Timeout > 0 -> - T1 = inets_test_lib:timestamp(), - p("pipeline_await_async_reply -> await replies" - "~n ReqIds: ~p" - "~n Timeout: ~p", [ReqIds, Timeout]), +%%------------------------------------------------------------------------- +save_to_file_async() -> + [{doc,"Test to save the http body to a file"}]. +save_to_file_async(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + FilePath = filename:join(PrivDir, "dummy.html"), + URL = url(group_name(Config), "/dummy.html", Config), + Request = {URL, []}, + {ok, RequestId} = httpc:request(get, Request, [], + [{stream, FilePath}, + {sync, false}]), receive - {http, {RequestId, {{_, Status, _}, _, Body}}} -> - p("pipeline_await_async_reply -> received reply for" - "~n RequestId: ~p" - "~n Status: ~p", [RequestId, Status]), - case lists:keysearch(RequestId, 1, ReqIds) of - {value, {RequestId, N, Status}} -> - p("pipeline_await_async_reply -> " - "found expected request ~w", [N]), - ReqIds2 = lists:keydelete(RequestId, 1, ReqIds), - NewTimeout = Timeout - (inets_test_lib:timestamp()-T1), - pipeline_await_async_reply(ReqIds2, NewTimeout, - [{N, Body} | Acc]); - {value, {RequestId, N, WrongStatus}} -> - p("pipeline_await_async_reply -> " - "found request ~w with wrong status", [N]), - tsf({reply_with_unexpected_status, - {RequestId, N, WrongStatus}}); - false -> - tsf({unexpected_reply, {RequestId, Status}}) - end; + {http, {RequestId, saved_to_file}} -> + ok; {http, Msg} -> - tsf({unexpected_reply, Msg}) - after Timeout -> - receive - Any -> - tsp("pipeline_await_async_reply -> " - "received unknown data after timeout: " - "~n ~p", [Any]), - tsf({timeout, {unknown, Any}}) - end - end; -pipeline_await_async_reply(ReqIds, _, Acc) -> - tsp("pipeline_await_async_reply -> " - "timeout: " - "~n ~p" - "~nwhen" - "~n ~p", [ReqIds, Acc]), - tsf({timeout, ReqIds, Acc}). - + ct:fail(Msg) + end, - + {ok, Bin} = file:read_file(FilePath), + {ok, {{_,200,_}, [_ | _], Body}} = httpc:request(URL), + Bin == Body. %%------------------------------------------------------------------------- -http_trace(doc) -> - ["Perform a TRACE request."]; -http_trace(suite) -> - []; -http_trace(Config) when is_list(Config) -> - case ?config(local_server, Config) of - ok -> - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - case httpc:request(trace, {URL, []}, [], []) of - {ok, {{_,200,_}, [_ | _], "TRACE /dummy.html" ++ _}} -> - ok; - {ok, {{_,200,_}, [_ | _], WrongBody}} -> - tsf({wrong_body, WrongBody}); - {ok, WrongReply} -> - tsf({wrong_reply, WrongReply}); - Error -> - tsf({failed, Error}) - end; - _ -> - skip("Failed to start local http-server") - end. +stream() -> + [{doc, "Test the option stream for asynchrony requests"}]. +stream(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/dummy.html", Config), []}, + stream_test(Request, {stream, self}). %%------------------------------------------------------------------------- -http_async(doc) -> - ["Test an asynchrony http request."]; -http_async(suite) -> - []; -http_async(Config) when is_list(Config) -> - case ?config(local_server, Config) of - ok -> - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - {ok, RequestId} = - httpc:request(get, {URL, []}, [], [{sync, false}]), - - Body = - receive - {http, {RequestId, {{_, 200, _}, _, BinBody}}} -> - BinBody; - {http, Msg} -> - tsf(Msg) - end, - - inets_test_lib:check_body(binary_to_list(Body)), - - {ok, NewRequestId} = - httpc:request(get, {URL, []}, [], [{sync, false}]), - ok = httpc:cancel_request(NewRequestId), - receive - {http, {NewRequestId, _NewResult}} -> - tsf(http_cancel_request_failed) - after 3000 -> - ok - end; - _ -> - skip("Failed to start local http-server") - end. +stream_once() -> + [{doc, "Test the option stream for asynchrony requests"}]. +stream_once(Config) when is_list(Config) -> + Request0 = {url(group_name(Config), "/dummy.html", Config), []}, + stream_test(Request0, {stream, {self, once}}), -%%------------------------------------------------------------------------- -http_save_to_file(doc) -> - ["Test to save the http body to a file"]; -http_save_to_file(suite) -> - []; -http_save_to_file(Config) when is_list(Config) -> - case ?config(local_server, Config) of - ok -> - PrivDir = ?config(priv_dir, Config), - FilePath = filename:join(PrivDir, "dummy.html"), - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - {ok, saved_to_file} - = httpc:request(get, {URL, []}, [], [{stream, FilePath}]), - {ok, Bin} = file:read_file(FilePath), - {ok, {{_,200,_}, [_ | _], Body}} = httpc:request(URL), - Bin == Body; - _ -> - skip("Failed to start local http-server") - end. + Request1 = {url(group_name(Config), "/once.html", Config), []}, + stream_test(Request1, {stream, {self, once}}), + Request2 = {url(group_name(Config), "/once_chunked.html", Config), []}, + stream_test(Request2, {stream, {self, once}}). %%------------------------------------------------------------------------- -http_save_to_file_async(doc) -> - ["Test to save the http body to a file"]; -http_save_to_file_async(suite) -> - []; -http_save_to_file_async(Config) when is_list(Config) -> - case ?config(local_server, Config) of - ok -> - PrivDir = ?config(priv_dir, Config), - FilePath = filename:join(PrivDir, "dummy.html"), - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - {ok, RequestId} = httpc:request(get, {URL, []}, [], - [{stream, FilePath}, - {sync, false}]), - receive - {http, {RequestId, saved_to_file}} -> - ok; - {http, Msg} -> - tsf(Msg) - end, +redirect_multiple_choises() -> + [{doc, "The user agent, selection of the most appropriate choice MAY " + "be performed automatically."}]. +redirect_multiple_choises(Config) when is_list(Config) -> + URL300 = url(group_name(Config), "/300.html", Config), - {ok, Bin} = file:read_file(FilePath), - {ok, {{_,200,_}, [_ | _], Body}} = httpc:request(URL), - Bin == Body; - _ -> - skip("Failed to start local http-server") - end. -%%------------------------------------------------------------------------- -http_headers(doc) -> - ["Use as many request headers as possible not used in proxy_headers"]; -http_headers(suite) -> - []; -http_headers(Config) when is_list(Config) -> - - case ?config(local_server, Config) of - ok -> - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - DocRoot = ?config(doc_root, Config), - {ok, FileInfo} = - file:read_file_info(filename:join([DocRoot,"dummy.html"])), - CreatedSec = - calendar:datetime_to_gregorian_seconds( - FileInfo#file_info.mtime), - - Mod = httpd_util:rfc1123_date( - calendar:gregorian_seconds_to_datetime( - CreatedSec-1)), - - Date = httpd_util:rfc1123_date({date(), time()}), - - {ok, {{_,200,_}, [_ | _], [_ | _]}} = - httpc:request(get, {URL, [{"If-Modified-Since", - Mod}, - {"From","[email protected]"}, - {"Date", Date} - ]}, [], []), - - Mod1 = httpd_util:rfc1123_date( - calendar:gregorian_seconds_to_datetime( - CreatedSec+1)), - - {ok, {{_,200,_}, [_ | _], [_ | _]}} = - httpc:request(get, {URL, [{"If-UnModified-Since", - Mod1} - ]}, [], []), - - Tag = httpd_util:create_etag(FileInfo), - - - {ok, {{_,200,_}, [_ | _], [_ | _]}} = - httpc:request(get, {URL, [{"If-Match", - Tag} - ]}, [], []), - - {ok, {{_,200,_}, [_ | _], _}} = - httpc:request(get, {URL, [{"If-None-Match", - "NotEtag,NeihterEtag"}, - {"Connection", "Close"} - ]}, [], []), - ok; - _ -> - skip("Failed to start local http-server") - end. + catch {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, {URL300, []}, [], []), + {ok, {{_,300,_}, [_ | _], _}} = + httpc:request(get, {URL300, []}, [{autoredirect, false}], []). %%------------------------------------------------------------------------- -http_headers_dummy(doc) -> - ["Test the code for handling headers we do not want/can send " - "to a real server. Note it is not logical to send" - "all of these headers together, we only want to test that" - "the code for handling headers will not crash."]; -http_headers_dummy(suite) -> - []; -http_headers_dummy(Config) when is_list(Config) -> - ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(ipv4), - - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy_headers.html", - - Foo = http_chunk:encode("foobar") ++ - binary_to_list(http_chunk:encode_last()), - FooBar = Foo ++ "\r\n\r\nOther:inets_test\r\n\r\n", +redirect_moved_permanently() -> + [{doc, "If the 301 status code is received in response to a request other " + "than GET or HEAD, the user agent MUST NOT automatically redirect the request " + "unless it can be confirmed by the user, since this might change " + "the conditions under which the request was issued."}]. +redirect_moved_permanently(Config) when is_list(Config) -> - UserPasswd = base64:encode_to_string("Alladin:Sesame"), - Auth = "Basic " ++ UserPasswd, + URL301 = url(group_name(Config), "/301.html", Config), - %% The dummy server will ignore the headers, we only want to test - %% that the client header-handling code. This would not - %% be a vaild http-request! - {ok, {{_,200,_}, [_ | _], [_|_]}} = - httpc:request(post, - {URL, - [{"Via", - "1.0 fred, 1.1 nowhere.com (Apache/1.1)"}, - {"Warning","1#pseudonym foobar"}, - {"Vary","*"}, - {"Upgrade","HTTP/2.0"}, - {"Pragma", "1#no-cache"}, - {"Cache-Control", "no-cache"}, - {"Connection", "close"}, - {"Date", "Sat, 29 Oct 1994 19:43:31 GMT"}, - {"Accept", " text/plain; q=0.5, text/html"}, - {"Accept-Language", "en"}, - {"Accept-Encoding","chunked"}, - {"Accept-Charset", "ISO8859-1"}, - {"Authorization", Auth}, - {"Expect", "1#100-continue"}, - {"User-Agent","inets"}, - {"Transfer-Encoding","chunked"}, - {"Range", " bytes=0-499"}, - {"If-Range", "Sat, 29 Oct 1994 19:43:31 GMT"}, - {"If-Match", "*"}, - {"Content-Type", "text/plain"}, - {"Content-Encoding", "chunked"}, - {"Content-Length", "6"}, - {"Content-Language", "en"}, - {"Content-Location", "http://www.foobar.se"}, - {"Content-MD5", - "104528739076276072743283077410617235478"}, - {"Content-Range", "bytes 0-499/1234"}, - {"Allow", "GET"}, - {"Proxy-Authorization", Auth}, - {"Expires", "Sat, 29 Oct 1994 19:43:31 GMT"}, - {"Upgrade", "HTTP/2.0"}, - {"Last-Modified", "Sat, 29 Oct 1994 19:43:31 GMT"}, - {"Trailer","1#User-Agent"} - ], "text/plain", FooBar}, - [], []), - DummyServerPid ! stop, - ok = httpc:set_options([{ipfamily, inet6fb4}]), - ok. - - -%%------------------------------------------------------------------------- -http_bad_response(doc) -> - ["Test what happens when the server does not follow the protocol"]; -http_bad_response(suite) -> - []; -http_bad_response(Config) when is_list(Config) -> - ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(ipv4), - - URL = ?URL_START ++ integer_to_list(Port) ++ "/missing_crlf.html", - - URL1 = ?URL_START ++ integer_to_list(Port) ++ "/wrong_statusline.html", - - {error, timeout} = httpc:request(get, {URL, []}, [{timeout, 400}], []), - - {error, Reason} = httpc:request(URL1), - - test_server:format("Wrong Statusline: ~p~n", [Reason]), - - DummyServerPid ! stop, - ok = httpc:set_options([{ipfamily, inet6fb4}]), - ok. + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, {URL301, []}, [], []), + {ok, {{_,200,_}, [_ | _], []}} + = httpc:request(head, {URL301, []}, [], []), + {ok, {{_,301,_}, [_ | _], [_|_]}} + = httpc:request(post, {URL301, [],"text/plain", "foobar"}, + [], []). %%------------------------------------------------------------------------- -ssl_head(doc) -> - ["Same as http_head/1 but over ssl sockets."]; -ssl_head(suite) -> - []; -ssl_head(Config) when is_list(Config) -> - ssl_head(ssl, Config). - -essl_head(doc) -> - ["Same as http_head/1 but over ssl sockets."]; -essl_head(suite) -> - []; -essl_head(Config) when is_list(Config) -> - ssl_head(essl, Config). - -ssl_head(SslTag, Config) -> - tsp("ssl_head -> entry with" - "~n SslTag: ~p" - "~n Config: ~p", [SslTag, Config]), - case ?config(local_ssl_server, Config) of - ok -> - DataDir = ?config(data_dir, Config), - Port = ?config(local_ssl_port, Config), - URL = ?SSL_URL_START ++ integer_to_list(Port) ++ "/dummy.html", - CertFile = filename:join(DataDir, "ssl_client_cert.pem"), - SSLOptions = [{certfile, CertFile}, {keyfile, CertFile}], - SSLConfig = - case SslTag of - ssl -> - SSLOptions; - essl -> - {essl, SSLOptions} - end, - tsp("ssl_head -> make request using: " - "~n URL: ~p" - "~n SslTag: ~p" - "~n SSLOptions: ~p", [URL, SslTag, SSLOptions]), - {ok, {{_,200, _}, [_ | _], []}} = - httpc:request(head, {URL, []}, [{ssl, SSLConfig}], []); - {ok, _} -> - skip("local http-server not started"); - _ -> - skip("SSL not started") - end. - - -%%------------------------------------------------------------------------- -ssl_get(doc) -> - ["Same as http_get/1 but over ssl sockets."]; -ssl_get(suite) -> - []; -ssl_get(Config) when is_list(Config) -> - ssl_get(ssl, Config). +redirect_found() -> + [{doc," If the 302 status code is received in response to a request other " + "than GET or HEAD, the user agent MUST NOT automatically redirect the " + "request unless it can be confirmed by the user, since this might change " + "the conditions under which the request was issued."}]. +redirect_found(Config) when is_list(Config) -> -essl_get(doc) -> - ["Same as http_get/1 but over ssl sockets."]; -essl_get(suite) -> - []; -essl_get(Config) when is_list(Config) -> - ssl_get(essl, Config). + URL302 = url(group_name(Config), "/302.html", Config), -ssl_get(SslTag, Config) when is_list(Config) -> - case ?config(local_ssl_server, Config) of - ok -> - DataDir = ?config(data_dir, Config), - Port = ?config(local_ssl_port, Config), - URL = ?SSL_URL_START ++ integer_to_list(Port) ++ "/dummy.html", - CertFile = filename:join(DataDir, "ssl_client_cert.pem"), - SSLOptions = [{certfile, CertFile}, {keyfile, CertFile}], - SSLConfig = - case SslTag of - ssl -> - SSLOptions; - essl -> - {essl, SSLOptions} - end, - tsp("ssl_get -> make request using: " - "~n URL: ~p" - "~n SslTag: ~p" - "~n SSLOptions: ~p", [URL, SslTag, SSLOptions]), - case httpc:request(get, {URL, []}, [{ssl, SSLConfig}], []) of - {ok, {{_,200, _}, [_ | _], Body = [_ | _]}} -> - inets_test_lib:check_body(Body), - ok; - {ok, {StatusLine, Headers, _Body}} -> - tsp("ssl_get -> unexpected result: " - "~n StatusLine: ~p" - "~n Headers: ~p", [StatusLine, Headers]), - tsf({unexpected_response, StatusLine, Headers}); - {error, Reason} -> - tsp("ssl_get -> request failed: " - "~n Reason: ~p", [Reason]), - tsf({request_failed, Reason}) - end; - {ok, _} -> - skip("local http-server not started"); - _ -> - skip("SSL not started") - end. + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, {URL302, []}, [], []), + {ok, {{_,200,_}, [_ | _], []}} + = httpc:request(head, {URL302, []}, [], []), + {ok, {{_,302,_}, [_ | _], [_|_]}} + = httpc:request(post, {URL302, [],"text/plain", "foobar"}, + [], []). %%------------------------------------------------------------------------- -ssl_trace(doc) -> - ["Same as http_trace/1 but over ssl sockets."]; -ssl_trace(suite) -> - []; -ssl_trace(Config) when is_list(Config) -> - ssl_trace(ssl, Config). +redirect_see_other() -> + [{doc, "The different URI SHOULD be given by the Location field in the response. " + "Unless the request method was HEAD, the entity of the response SHOULD contain a short " + "hypertext note with a hyperlink to the new URI(s). "}]. +redirect_see_other(Config) when is_list(Config) -> -essl_trace(doc) -> - ["Same as http_trace/1 but over ssl sockets."]; -essl_trace(suite) -> - []; -essl_trace(Config) when is_list(Config) -> - ssl_trace(essl, Config). + URL303 = url(group_name(Config), "/303.html", Config), -ssl_trace(SslTag, Config) when is_list(Config) -> - case ?config(local_ssl_server, Config) of - ok -> - DataDir = ?config(data_dir, Config), - Port = ?config(local_ssl_port, Config), - URL = ?SSL_URL_START ++ integer_to_list(Port) ++ "/dummy.html", - CertFile = filename:join(DataDir, "ssl_client_cert.pem"), - SSLOptions = [{certfile, CertFile}, {keyfile, CertFile}], - SSLConfig = - case SslTag of - ssl -> - SSLOptions; - essl -> - {essl, SSLOptions} - end, - tsp("ssl_trace -> make request using: " - "~n URL: ~p" - "~n SslTag: ~p" - "~n SSLOptions: ~p", [URL, SslTag, SSLOptions]), - case httpc:request(trace, {URL, []}, [{ssl, SSLConfig}], []) of - {ok, {{_,200, _}, [_ | _], "TRACE /dummy.html" ++ _}} -> - ok; - {ok, {{_,200,_}, [_ | _], WrongBody}} -> - tsf({wrong_body, WrongBody}); - {ok, WrongReply} -> - tsf({wrong_reply, WrongReply}); - Error -> - tsf({failed, Error}) - end; - {ok, _} -> - skip("local http-server not started"); - _ -> - skip("SSL not started") - end. + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, {URL303, []}, [], []), + {ok, {{_,200,_}, [_ | _], []}} + = httpc:request(head, {URL303, []}, [], []), + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(post, {URL303, [],"text/plain", "foobar"}, + [], []). %%------------------------------------------------------------------------- -http_redirect(doc) -> - ["Test redirect with dummy server as httpd does not implement" - " server redirect"]; -http_redirect(suite) -> - []; -http_redirect(Config) when is_list(Config) -> - tsp("http_redirect -> entry with" - "~n Config: ~p", [Config]), - case ?config(local_server, Config) of - ok -> - %% tsp("http_redirect -> set ipfamily option to inet"), - %% ok = httpc:set_options([{ipfamily, inet}]), +redirect_temporary_redirect() -> + [{doc," If the 307 status code is received in response to a request other " + "than GET or HEAD, the user agent MUST NOT automatically redirect the request " + "unless it can be confirmed by the user, since this might change " + "the conditions under which the request was issued."}]. +redirect_temporary_redirect(Config) when is_list(Config) -> - tsp("http_redirect -> start dummy server inet"), - {DummyServerPid, Port} = dummy_server(ipv4), - tsp("http_redirect -> server port = ~p", [Port]), - - URL300 = ?URL_START ++ integer_to_list(Port) ++ "/300.html", - - tsp("http_redirect -> issue request 1: " - "~n ~p", [URL300]), - {ok, {{_,200,_}, [_ | _], [_|_]}} - = httpc:request(get, {URL300, []}, [], []), - - tsp("http_redirect -> issue request 2: " - "~n ~p", [URL300]), - {ok, {{_,300,_}, [_ | _], _}} = - httpc:request(get, {URL300, []}, [{autoredirect, false}], []), - - URL301 = ?URL_START ++ integer_to_list(Port) ++ "/301.html", - - tsp("http_redirect -> issue request 3: " - "~n ~p", [URL301]), - {ok, {{_,200,_}, [_ | _], [_|_]}} - = httpc:request(get, {URL301, []}, [], []), - - tsp("http_redirect -> issue request 4: " - "~n ~p", [URL301]), - {ok, {{_,200,_}, [_ | _], []}} - = httpc:request(head, {URL301, []}, [], []), - - tsp("http_redirect -> issue request 5: " - "~n ~p", [URL301]), - {ok, {{_,301,_}, [_ | _], [_|_]}} - = httpc:request(post, {URL301, [],"text/plain", "foobar"}, - [], []), - - URL302 = ?URL_START ++ integer_to_list(Port) ++ "/302.html", - - tsp("http_redirect -> issue request 6: " - "~n ~p", [URL302]), - {ok, {{_,200,_}, [_ | _], [_|_]}} - = httpc:request(get, {URL302, []}, [], []), - case httpc:request(get, {URL302, []}, [], []) of - {ok, Reply7} -> - case Reply7 of - {{_,200,_}, [_ | _], [_|_]} -> - tsp("http_redirect -> " - "expected reply for request 7"), - ok; - {StatusLine, Headers, Body} -> - tsp("http_redirect -> " - "unexpected reply for request 7: " - "~n StatusLine: ~p" - "~n Headers: ~p" - "~n Body: ~p", - [StatusLine, Headers, Body]), - tsf({unexpected_reply, Reply7}) - end; - Error7 -> - tsp("http_redirect -> " - "unexpected result for request 7: " - "~n Error7: ~p", - [Error7]), - tsf({unexpected_result, Error7}) - end, - - tsp("http_redirect -> issue request 7: " - "~n ~p", [URL302]), - {ok, {{_,200,_}, [_ | _], []}} - = httpc:request(head, {URL302, []}, [], []), - - tsp("http_redirect -> issue request 8: " - "~n ~p", [URL302]), - {ok, {{_,302,_}, [_ | _], [_|_]}} - = httpc:request(post, {URL302, [],"text/plain", "foobar"}, - [], []), - - URL303 = ?URL_START ++ integer_to_list(Port) ++ "/303.html", - - tsp("http_redirect -> issue request 9: " - "~n ~p", [URL303]), - {ok, {{_,200,_}, [_ | _], [_|_]}} - = httpc:request(get, {URL303, []}, [], []), - - tsp("http_redirect -> issue request 10: " - "~n ~p", [URL303]), - {ok, {{_,200,_}, [_ | _], []}} - = httpc:request(head, {URL303, []}, [], []), - - tsp("http_redirect -> issue request 11: " - "~n ~p", [URL303]), - {ok, {{_,200,_}, [_ | _], [_|_]}} - = httpc:request(post, {URL303, [],"text/plain", "foobar"}, - [], []), - - URL307 = ?URL_START ++ integer_to_list(Port) ++ "/307.html", - - tsp("http_redirect -> issue request 12: " - "~n ~p", [URL307]), - {ok, {{_,200,_}, [_ | _], [_|_]}} - = httpc:request(get, {URL307, []}, [], []), - - tsp("http_redirect -> issue request 13: " - "~n ~p", [URL307]), - {ok, {{_,200,_}, [_ | _], []}} - = httpc:request(head, {URL307, []}, [], []), - - tsp("http_redirect -> issue request 14: " - "~n ~p", [URL307]), - {ok, {{_,307,_}, [_ | _], [_|_]}} - = httpc:request(post, {URL307, [],"text/plain", "foobar"}, - [], []), - - tsp("http_redirect -> stop dummy server"), - DummyServerPid ! stop, - tsp("http_redirect -> reset ipfamily option (to inet6fb4)"), - ok = httpc:set_options([{ipfamily, inet6fb4}]), - tsp("http_redirect -> done"), - ok; - - _ -> - skip("Failed to start local http-server") - end. + URL307 = url(group_name(Config), "/307.html", Config), + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, {URL307, []}, [], []), + {ok, {{_,200,_}, [_ | _], []}} + = httpc:request(head, {URL307, []}, [], []), -%%------------------------------------------------------------------------- -http_redirect_loop(doc) -> - ["Test redirect loop detection"]; -http_redirect_loop(suite) -> - []; -http_redirect_loop(Config) when is_list(Config) -> - ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(ipv4), - - URL = ?URL_START ++ integer_to_list(Port) ++ "/redirectloop.html", - - {ok, {{_,300,_}, [_ | _], _}} - = httpc:request(get, {URL, []}, [], []), - DummyServerPid ! stop, - ok = httpc:set_options([{ipfamily, inet6fb4}]), - ok. + {ok, {{_,307,_}, [_ | _], [_|_]}} + = httpc:request(post, {URL307, [],"text/plain", "foobar"}, + [], []). %%------------------------------------------------------------------------- -http_internal_server_error(doc) -> - ["Test 50X codes"]; -http_internal_server_error(suite) -> - []; -http_internal_server_error(Config) when is_list(Config) -> - ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(ipv4), - - URL500 = ?URL_START ++ integer_to_list(Port) ++ "/500.html", - - {ok, {{_,500,_}, [_ | _], _}} - = httpc:request(get, {URL500, []}, [], []), +redirect_loop() -> + [{"doc, Test redirect loop detection"}]. +redirect_loop(Config) when is_list(Config) -> + URL = url(group_name(Config), "/redirectloop.html", Config), - URL503 = ?URL_START ++ integer_to_list(Port) ++ "/503.html", + {ok, {{_,300,_}, [_ | _], _}} + = httpc:request(get, {URL, []}, [], []). - %% Used to be able to make the service available after retry. - ets:new(unavailable, [named_table, public, set]), - ets:insert(unavailable, {503, unavailable}), - - {ok, {{_,200, _}, [_ | _], [_|_]}} = - httpc:request(get, {URL503, []}, [], []), - - ets:insert(unavailable, {503, long_unavailable}), +%%------------------------------------------------------------------------- +cookie() -> + [{doc, "Test cookies."}]. +cookie(Config) when is_list(Config) -> + ok = httpc:set_options([{cookies, enabled}]), - {ok, {{_,503, _}, [_ | _], [_|_]}} = - httpc:request(get, {URL503, []}, [], []), + Request0 = {url(group_name(Config), "/cookie.html", Config), []}, - ets:delete(unavailable), - DummyServerPid ! stop, - ok = httpc:set_options([{ipfamily, inet6fb4}]), - ok. + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, Request0, [], []), + %% Populate table to be used by the "dummy" server + ets:new(cookie, [named_table, public, set]), + ets:insert(cookie, {cookies, true}), -%%------------------------------------------------------------------------- -http_userinfo(doc) -> - ["Test user info e.i. http://user:passwd@host:port/"]; -http_userinfo(suite) -> - []; -http_userinfo(Config) when is_list(Config) -> - ok = httpc:set_options([{ipfamily, inet}]), + Request1 = {url(group_name(Config), "/", Config), []}, - {DummyServerPid, Port} = dummy_server(ipv4), - - URLAuth = "http://alladin:sesame@localhost:" - ++ integer_to_list(Port) ++ "/userinfo.html", - - {ok, {{_,200,_}, [_ | _], _}} - = httpc:request(get, {URLAuth, []}, [], []), + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, Request1, [], []), - URLUnAuth = "http://alladin:foobar@localhost:" - ++ integer_to_list(Port) ++ "/userinfo.html", - - {ok, {{_,401, _}, [_ | _], _}} = - httpc:request(get, {URLUnAuth, []}, [], []), - - DummyServerPid ! stop, - ok = httpc:set_options([{ipfamily, inet6fb4}]), - ok. + ets:delete(cookie), + ok = httpc:set_options([{cookies, disabled}]). +%%------------------------------------------------------------------------- +headers_as_is(doc) -> + ["Test the option headers_as_is"]; +headers_as_is(Config) when is_list(Config) -> + URL = url(group_name(Config), "/dummy.html", Config), + {ok, {{_,200,_}, [_|_], [_|_]}} = + httpc:request(get, {URL, [{"Host", "localhost"},{"Te", ""}]}, + [], [{headers_as_is, true}]), + {ok, {{_,400,_}, [_|_], [_|_]}} = + httpc:request(get, {URL, [{"Te", ""}]},[], [{headers_as_is, true}]). %%------------------------------------------------------------------------- -http_cookie(doc) -> - ["Test cookies."]; -http_cookie(suite) -> - []; -http_cookie(Config) when is_list(Config) -> - ok = httpc:set_options([{cookies, enabled}, {ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(ipv4), + +userinfo(doc) -> + [{doc, "Test user info e.i. http://user:passwd@host:port/"}]; +userinfo(Config) when is_list(Config) -> - URLStart = ?URL_START - ++ integer_to_list(Port), + {ok,Host} = inet:gethostname(), - URLCookie = URLStart ++ "/cookie.html", - - {ok, {{_,200,_}, [_ | _], [_|_]}} - = httpc:request(get, {URLCookie, []}, [], []), + URLAuth = url(group_name(Config), "alladin:sesame@" ++ Host ++ ":","/userinfo.html", Config), - ets:new(cookie, [named_table, public, set]), - ets:insert(cookie, {cookies, true}), + {ok, {{_,200,_}, [_ | _], _}} + = httpc:request(get, {URLAuth, []}, [], []), - {ok, {{_,200,_}, [_ | _], [_|_]}} - = httpc:request(get, {URLStart ++ "/", []}, [], []), - - ets:delete(cookie), + URLUnAuth = url(group_name(Config), "alladin:foobar@" ++ Host ++ ":","/userinfo.html", Config), - ok = httpc:set_options([{cookies, disabled}]), - DummyServerPid ! stop, - ok = httpc:set_options([{ipfamily, inet6fb4}]), - ok. + {ok, {{_,401, _}, [_ | _], _}} = + httpc:request(get, {URLUnAuth, []}, [], []). %%------------------------------------------------------------------------- -http_server_does_not_exist(doc) -> - ["Test that we get an error message back when the server " - "does note exist."]; -http_server_does_not_exist(suite) -> - []; -http_server_does_not_exist(Config) when is_list(Config) -> - {error, _} = - httpc:request(get, {"http://localhost:" ++ - integer_to_list(?NOT_IN_USE_PORT) - ++ "/", []},[], []), - ok. - -%%------------------------------------------------------------------------- page_does_not_exist(doc) -> ["Test that we get a 404 when the page is not found."]; -page_does_not_exist(suite) -> - []; page_does_not_exist(Config) when is_list(Config) -> - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/doesnotexist.html", - {ok, {{_,404,_}, [_ | _], [_ | _]}} - = httpc:request(get, {URL, []}, [], []), - ok. - - + URL = url(group_name(Config), "/doesnotexist.html", Config), + {ok, {{_,404,_}, [_ | _], [_ | _]}} + = httpc:request(get, {URL, []}, [], []). %%------------------------------------------------------------------------- -http_stream(doc) -> - ["Test the option stream for asynchrony requests"]; -http_stream(suite) -> - []; -http_stream(Config) when is_list(Config) -> - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - {ok, {{_,200,_}, [_ | _], Body}} = - httpc:request(get, {URL, []}, [], []), - - {ok, RequestId} = - httpc:request(get, {URL, []}, [], [{sync, false}, - {stream, self}]), - - receive - {http, {RequestId, stream_start, _Headers}} -> - ok; - {http, Msg} -> - tsf(Msg) - end, - - StreamedBody = receive_streamed_body(RequestId, <<>>), - - Body == binary_to_list(StreamedBody). - +streaming_error(doc) -> + [{doc, "Only async requests can be stremed - Solves OTP-8056"}]; +streaming_error(Config) when is_list(Config) -> + Method = get, + Request = {url(group_name(Config), "/dummy.html", Config), []}, + {error, streaming_error} = httpc:request(Method, Request, + [], [{sync, true}, {stream, {self, once}}]), + {error, streaming_error} = httpc:request(Method, Request, + [], [{sync, true}, {stream, self}]). %%------------------------------------------------------------------------- -http_stream_once(doc) -> - ["Test the option stream for asynchrony requests"]; -http_stream_once(suite) -> - []; -http_stream_once(Config) when is_list(Config) -> - p("http_stream_once -> entry with" - "~n Config: ~p", [Config]), - - p("http_stream_once -> set ipfamily to inet", []), - ok = httpc:set_options([{ipfamily, inet}]), - p("http_stream_once -> start dummy server", []), - {DummyServerPid, Port} = dummy_server(ipv4), - - PortStr = integer_to_list(Port), - p("http_stream_once -> once", []), - once(?URL_START ++ PortStr ++ "/once.html"), - p("http_stream_once -> once_chunked", []), - once(?URL_START ++ PortStr ++ "/once_chunked.html"), - p("http_stream_once -> dummy", []), - once(?URL_START ++ PortStr ++ "/dummy.html"), - - p("http_stream_once -> stop dummy server", []), - DummyServerPid ! stop, - p("http_stream_once -> set ipfamily to inet6fb4", []), - ok = httpc:set_options([{ipfamily, inet6fb4}]), - p("http_stream_once -> done", []), - ok. - -once(URL) -> - p("once -> issue sync request for ~p", [URL]), - {ok, {{_,200,_}, [_ | _], Body}} = - httpc:request(get, {URL, []}, [], []), - - p("once -> issue async (self stream) request for ~p", [URL]), - {ok, RequestId} = - httpc:request(get, {URL, []}, [], [{sync, false}, - {stream, {self, once}}]), - - p("once -> await stream_start reply for (async) request ~p", [RequestId]), - NewPid = - receive - {http, {RequestId, stream_start, _Headers, Pid}} -> - p("once -> received stream_start reply for (async) request ~p: ~p", - [RequestId, Pid]), - Pid; - {http, Msg} -> - tsf(Msg) - end, - - tsp("once -> request handler: ~p", [NewPid]), - - p("once -> await stream reply for (async) request ~p", [RequestId]), - BodyPart = - receive - {http, {RequestId, stream, BinBodyPart}} -> - p("once -> received stream reply for (async) request ~p: " - "~n~p", [RequestId, binary_to_list(BinBodyPart)]), - BinBodyPart - end, - - tsp("once -> first body part '~p' received", [binary_to_list(BodyPart)]), - - StreamedBody = receive_streamed_body(RequestId, BinBodyPart, NewPid), - - Body = binary_to_list(StreamedBody), - - p("once -> done when Bode: ~p", [Body]), - ok. - - +server_does_not_exist(doc) -> + [{doc, "Test that we get an error message back when the server " + "does note exist."}]; +server_does_not_exist(Config) when is_list(Config) -> + {error, _} = + httpc:request(get, {"http://localhost:" ++ + integer_to_list(?NOT_IN_USE_PORT) + ++ "/", []},[], []). %%------------------------------------------------------------------------- -parse_url(doc) -> - ["Test that an url is parsed correctly"]; -parse_url(suite) -> - []; -parse_url(Config) when is_list(Config) -> - %% ipv6 - {ok, {http,[],"2010:836B:4179::836B:4179",80,"/foobar.html",[]}} = - http_uri:parse("http://[2010:836B:4179::836B:4179]/foobar.html"), - {ok, {http,[],"[2010:836B:4179::836B:4179]",80,"/foobar.html",[]}} = - http_uri:parse("http://[2010:836B:4179::836B:4179]/foobar.html", - [{ipv6_host_with_brackets, true}]), - {ok, {http,[],"2010:836B:4179::836B:4179",80,"/foobar.html",[]}} = - http_uri:parse("http://[2010:836B:4179::836B:4179]/foobar.html", - [{ipv6_host_with_brackets, false}]), - {ok, {http,[],"2010:836B:4179::836B:4179",80,"/foobar.html",[]}} = - http_uri:parse("http://[2010:836B:4179::836B:4179]/foobar.html", - [{foo, false}]), - {error, - {malformed_url, _, "http://2010:836B:4179::836B:4179/foobar.html"}} = - http_uri:parse("http://2010:836B:4179::836B:4179/foobar.html"), - - %% ipv4 - {ok, {http,[],"127.0.0.1",80,"/foobar.html",[]}} = - http_uri:parse("http://127.0.0.1/foobar.html"), - - %% host - {ok, {http,[],"localhost",8888,"/foobar.html",[]}} = - http_uri:parse("http://localhost:8888/foobar.html"), - - %% Userinfo - {ok, {http,"nisse:foobar","localhost",8888,"/foobar.html",[]}} = - http_uri:parse("http://nisse:foobar@localhost:8888/foobar.html"), - - %% Scheme error - {error, no_scheme} = http_uri:parse("localhost/foobar.html"), - {error, {malformed_url, _, _}} = - http_uri:parse("localhost:8888/foobar.html"), - - %% Query - {ok, {http,[],"localhost",8888,"/foobar.html","?foo=bar&foobar=42"}} = - http_uri:parse("http://localhost:8888/foobar.html?foo=bar&foobar=42"), - - %% Esc chars - {ok, {http,[],"www.somedomain.com",80,"/%2Eabc",[]}} = - http_uri:parse("http://www.somedomain.com/%2Eabc"), - {ok, {http,[],"www.somedomain.com",80,"/%252Eabc",[]}} = - http_uri:parse("http://www.somedomain.com/%252Eabc"), - {ok, {http,[],"www.somedomain.com",80,"/%25abc",[]}} = - http_uri:parse("http://www.somedomain.com/%25abc"), - {ok, {http,[],"www.somedomain.com",80,"/%25abc", "?foo=bar"}} = - http_uri:parse("http://www.somedomain.com/%25abc?foo=bar"), - - - ok. +no_content_204(doc) -> + ["Test the case that the HTTP 204 no content header - Solves OTP 6982"]; +no_content_204(Config) when is_list(Config) -> + URL = url(group_name(Config), "/no_content.html", Config), + {ok, {{_,204,_}, [], []}} = httpc:request(URL). %%------------------------------------------------------------------------- -ipv6_ipcomm() -> - [{require, ipv6_hosts}]. -ipv6_ipcomm(doc) -> - ["Test ip_comm ipv6."]; -ipv6_ipcomm(suite) -> - []; -ipv6_ipcomm(Config) when is_list(Config) -> - HTTPOptions = [], - SocketType = ip_comm, - Scheme = "http", - Extra = [], - ipv6(SocketType, Scheme, HTTPOptions, Extra, Config). - - +tolerate_missing_CR() -> + [{doc, "Test the case that the HTTP server uses only LF instead of CRLF" + "as delimitor. Solves OTP-7304"}]. +tolerate_missing_CR(Config) when is_list(Config) -> + URL = url(group_name(Config), "/missing_CR.html", Config), + {ok, {{_,200,_}, _, [_ | _]}} = httpc:request(URL). %%------------------------------------------------------------------------- -ipv6_essl() -> - [{require, ipv6_hosts}]. -ipv6_essl(doc) -> - ["Test essl ipv6."]; -ipv6_essl(suite) -> - []; -ipv6_essl(Config) when is_list(Config) -> - DataDir = ?config(data_dir, Config), - CertFile = filename:join(DataDir, "ssl_client_cert.pem"), - SSLOptions = [{certfile, CertFile}, {keyfile, CertFile}], - SSLConfig = {essl, SSLOptions}, - tsp("ssl_ipv6 -> make request using: " - "~n SSLOptions: ~p", [SSLOptions]), - HTTPOptions = [{ssl, SSLConfig}], - SocketType = essl, - Scheme = "https", - Extra = SSLOptions, - ipv6(SocketType, Scheme, HTTPOptions, Extra, Config). - +empty_body() -> + [{doc, "An empty body was not returned directly. There was a delay for several" + "seconds. Solves OTP-6243."}]. +empty_body(Config) when is_list(Config) -> + URL = url(group_name(Config), "/empty.html", Config), + {ok, {{_,200,_}, [_ | _], []}} = + httpc:request(get, {URL, []}, [{timeout, 500}], []). %%------------------------------------------------------------------------- -ipv6(SocketType, Scheme, HTTPOptions, Extra, Config) -> - %% Check if we are a IPv6 host - tsp("ipv6 -> verify ipv6 support"), - case inets_test_lib:has_ipv6_support(Config) of - {ok, Addr} -> - tsp("ipv6 -> ipv6 supported: ~p", [Addr]), - {DummyServerPid, Port} = dummy_server(SocketType, ipv6, Extra), - Profile = ?config(profile, Config), - URL = - Scheme ++ - "://[" ++ http_transport:ipv6_name(Addr) ++ "]:" ++ - integer_to_list(Port) ++ "/foobar.html", - tsp("ipv6 -> issue request with: " - "~n URL: ~p" - "~n HTTPOptions: ~p", [URL, HTTPOptions]), - case httpc:request(get, {URL, []}, HTTPOptions, [], Profile) of - {ok, {{_,200,_}, [_ | _], [_|_]}} -> - tsp("ipv6 -> expected result"), - DummyServerPid ! stop, - ok; - {ok, Unexpected} -> - tsp("ipv6 -> unexpected result: " - "~n ~p", [Unexpected]), - DummyServerPid ! stop, - tsf({unexpected_result, Unexpected}); - {error, Reason} -> - tsp("ipv6 -> error: " - "~n Reason: ~p", [Reason]), - DummyServerPid ! stop, - tsf(Reason) - end, - ok; - _ -> - tsp("ipv6 -> ipv6 not supported"), - skip("Host does not support IPv6") - end. - +transfer_encoding() -> + [{doc, "Transfer encoding is case insensitive. Solves OTP-6807"}]. +transfer_encoding(Config) when is_list(Config) -> + URL = url(group_name(Config), "/capital_transfer_encoding.html", Config), + {ok, {{_,200,_}, [_|_], [_ | _]}} = httpc:request(URL). %%------------------------------------------------------------------------- -headers_as_is(doc) -> - ["Test the option headers_as_is"]; -headers_as_is(suite) -> - []; -headers_as_is(Config) when is_list(Config) -> - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - {ok, {{_,200,_}, [_|_], [_|_]}} = - httpc:request(get, {URL, [{"Host", "localhost"},{"Te", ""}]}, - [], [{headers_as_is, true}]), - - {ok, {{_,400,_}, [_|_], [_|_]}} = - httpc:request(get, {URL, [{"Te", ""}]},[], [{headers_as_is, true}]), - ok. - +empty_response_header() -> + [{doc, "Test the case that the HTTP server does not send any headers. Solves OTP-6830"}]. +empty_response_header(Config) when is_list(Config) -> + URL = url(group_name(Config), "/no_headers.html", Config), + {ok, {{_,200,_}, [], [_ | _]}} = httpc:request(URL). %%------------------------------------------------------------------------- -selecting_session(doc) -> - ["Test selection of sessions - OTP-9847"]; -selecting_session(suite) -> - []; -selecting_session(Config) when is_list(Config) -> - tsp("selecting_session -> entry with" - "~n Config: ~p", [Config]), - - tsp("selecting_session -> set ipfamily to inet"), - ok = httpc:set_options([{ipfamily, inet}]), - - tsp("selecting_session -> start server"), - {ServerPid, Port} = otp_9847_server(), - - PortStr = integer_to_list(Port), - URL = ?URL_START ++ PortStr ++ "/index.html", - - tsp("selecting_session -> issue the first batch (three) requests"), - lists:foreach(fun(P) -> - tsp("selecting_session:fun1 -> " - "send stop request to ~p", [P]), - P ! stop - end, - reqs(URL, ServerPid, 3, 3, false)), - tsp("selecting_session -> sleep some (1) to make sure nothing lingers"), - ?SLEEP(5000), - tsp("selecting_session -> " - "instruct the server to reply to the first request"), - ServerPid ! {answer, true}, - receive - {answer, true} -> - tsp("selecting_session -> " - "received ack from server to reply to the first request"), - ok - end, - tsp("selecting_session -> issue the second batch (four) requests"), - lists:foreach(fun(P) -> - tsp("selecting_session:fun2 -> " - "send stop request to ~p", [P]), - P ! stop - end, - reqs(URL, ServerPid, 4, 1, true)), - tsp("selecting_session -> sleep some (2) to make sure nothing lingers"), - ?SLEEP(5000), - - tsp("selecting_session -> stop server"), - ServerPid ! stop, - tsp("selecting_session -> set ipfamily (back) to inet6fb4"), - ok = httpc:set_options([{ipfamily, inet6fb4}]), - tsp("selecting_session -> done"), - ok. - -reqs(URL, ServerPid, NumReqs, NumHandlers, InitialSync) -> - tsp("reqs -> entry with" - "~n URL: ~p" - "~n ServerPid: ~w" - "~n NumReqs: ~w" - "~n NumHandlers: ~w" - "~n InitialSync: ~w", - [URL, ServerPid, NumReqs, NumHandlers, InitialSync]), - Handlers = reqs2(URL, NumReqs, [], InitialSync), - tsp("reqs -> " - "~n Handlers: ~w", [Handlers]), - case length(Handlers) of - NumHandlers -> - tsp("reqs -> " - "~n NumHandlers: ~w", [NumHandlers]), - ServerPid ! num_handlers, - receive - {num_handlers, NumHandlers} -> - tsp("reqs -> received num_handlers with" - "~n NumHandlers: ~w", [NumHandlers]), - Handlers; - {num_handlers, WrongNumHandlers} -> - tsp("reqs -> received num_handlers with" - "~n WrongNumHandlers: ~w", [WrongNumHandlers]), - exit({wrong_num_handlers1, WrongNumHandlers, NumHandlers}) - end; - WrongNumHandlers -> - tsp("reqs -> " - "~n WrongNumHandlers: ~w", [WrongNumHandlers]), - exit({wrong_num_handlers2, WrongNumHandlers, NumHandlers}) - end. - - -reqs2(_URL, 0, Acc, _Sync) -> - lists:reverse(Acc); -reqs2(URL, Num, Acc, Sync) -> - tsp("reqs2 -> entry with" - "~n Num: ~w" - "~n Sync: ~w", [Num, Sync]), - case httpc:request(get, {URL, []}, [], [{sync, Sync}]) of - {ok, _Reply} -> - tsp("reqs2 -> successful request: ~p", [_Reply]), - receive - {handler, Handler, _Manager} -> - %% This is when a new handler is created - tsp("reqs2 -> received handler: ~p", [Handler]), - case lists:member(Handler, Acc) of - true -> - tsp("reqs2 -> duplicate handler"), - exit({duplicate_handler, Handler, Num, Acc}); - false -> - tsp("reqs2 -> wait for data ack"), - receive - {data_received, Handler} -> - tsp("reqs2 -> " - "received data ack from ~p", [Handler]), - case Sync of - true -> - reqs2(URL, Num-1, [Handler|Acc], - false); - false -> - reqs2(URL, Num-1, [Handler|Acc], - Sync) - end - end - end; - - {data_received, Handler} -> - tsp("reqs2 -> " - "received data ack from ~p", [Handler]), - reqs2(URL, Num-1, Acc, false) +bad_response(doc) -> + [{doc, "Test what happens when the server does not follow the protocol"}]; - end; +bad_response(Config) when is_list(Config) -> - {error, Reason} -> - tsp("reqs2 -> request ~w failed: ~p", [Num, Reason]), - exit({request_failed, Reason, Num, Acc}) - end. + URL0 = url(group_name(Config), "/missing_crlf.html", Config), + URL1 = url(group_name(Config), "/wrong_statusline.html", Config), -otp_9847_server() -> - TC = self(), - Pid = spawn_link(fun() -> otp_9847_server_init(TC) end), - receive - {port, Port} -> - {Pid, Port} - end. + {error, timeout} = httpc:request(get, {URL0, []}, [{timeout, 400}], []), + {error, Reason} = httpc:request(URL1), -otp_9847_server_init(TC) -> - tsp("otp_9847_server_init -> entry with" - "~n TC: ~p", [TC]), - {ok, ListenSocket} = - gen_tcp:listen(0, [binary, inet, {packet, 0}, - {reuseaddr,true}, - {active, false}]), - tsp("otp_9847_server_init -> listen socket created: " - "~n ListenSocket: ~p", [ListenSocket]), - {ok, Port} = inet:port(ListenSocket), - tsp("otp_9847_server_init -> Port: ~p", [Port]), - TC ! {port, Port}, - otp_9847_server_main(TC, ListenSocket, false, []). - -otp_9847_server_main(TC, ListenSocket, Answer, Handlers) -> - tsp("otp_9847_server_main -> entry with" - "~n TC: ~p" - "~n ListenSocket: ~p" - "~n Answer: ~p" - "~n Handlers: ~p", [TC, ListenSocket, Answer, Handlers]), - case gen_tcp:accept(ListenSocket, 1000) of - {ok, Sock} -> - tsp("otp_9847_server_main -> accepted" - "~n Sock: ~p", [Sock]), - {Handler, Mon, Port} = otp_9847_handler(TC, Sock, Answer), - tsp("otp_9847_server_main -> handler ~p created for ~w", - [Handler, Port]), - gen_tcp:controlling_process(Sock, Handler), - tsp("otp_9847_server_main -> control transfer"), - Handler ! owner, - tsp("otp_9847_server_main -> " - "handler ~p informed of owner transfer", [Handler]), - TC ! {handler, Handler, self()}, - tsp("otp_9847_server_main -> " - "TC ~p informed of handler ~p", [TC, Handler]), - otp_9847_server_main(TC, ListenSocket, Answer, - [{Handler, Mon, Sock, Port}|Handlers]); + ct:print("Wrong Statusline: ~p~n", [Reason]). +%%------------------------------------------------------------------------- - {error, timeout} -> - tsp("otp_9847_server_main -> timeout"), - receive - {answer, true} -> - tsp("otp_9847_server_main -> received answer request"), - TC ! {answer, true}, - otp_9847_server_main(TC, ListenSocket, true, Handlers); - - {'DOWN', _Mon, process, Pid, _Reason} -> - %% Could be one of the handlers - tsp("otp_9847_server_main -> received DOWN for ~p", [Pid]), - otp_9847_server_main(TC, ListenSocket, Answer, - lists:keydelete(Pid, 1, Handlers)); - - num_handlers -> - tsp("otp_9847_server_main -> " - "received request for number of handlers (~w)", - [length(Handlers)]), - TC ! {num_handlers, length(Handlers)}, - otp_9847_server_main(TC, ListenSocket, Answer, Handlers); +internal_server_error(doc) -> + ["Test 50X codes"]; +internal_server_error(Config) when is_list(Config) -> - stop -> - tsp("otp_9847_server_main -> received stop request"), - %% Stop all handlers (just in case) - Pids = [Handler || {Handler, _, _} <- Handlers], - lists:foreach(fun(Pid) -> Pid ! stop end, Pids), - exit(normal); + URL500 = url(group_name(Config), "/500.html", Config), - Any -> - tsp("otp_9847_server_main -> received" - "~n Any: ~p", [Any]), - exit({crap, Any}) + {ok, {{_,500,_}, [_ | _], _}} + = httpc:request(get, {URL500, []}, [], []), - after 0 -> - tsp("otp_9847_server_main -> nothing in queue"), - otp_9847_server_main(TC, ListenSocket, Answer, Handlers) - end; + URL503 = url(group_name(Config), "/503.html", Config), - Error -> - exit(Error) - end. + %% Used to be able to make the service available after retry. + ets:new(unavailable, [named_table, public, set]), + ets:insert(unavailable, {503, unavailable}), + {ok, {{_,200, _}, [_ | _], [_|_]}} = + httpc:request(get, {URL503, []}, [], []), -otp_9847_handler(TC, Sock, Answer) -> - tsp("otp_9847_handler -> entry with" - "~n TC: ~p" - "~n Sock: ~p" - "~n Answer: ~p", [TC, Sock, Answer]), - Self = self(), - {Pid, Mon} = - spawn_opt(fun() -> - otp_9847_handler_init(TC, Self, Sock, Answer) - end, - [monitor]), - receive - {port, Port} -> - tsp("otp_9847_handler -> received port message (from ~p)" - "~n Port: ~p", [Pid, Port]), - {Pid, Mon, Port} - end. - + ets:insert(unavailable, {503, long_unavailable}), -otp_9847_handler_init(TC, Server, Sock, Answer) -> - tsp("otp_9847_handler_init -> entry with" - "~n TC: ~p" - "~n Server: ~p" - "~n Sock: ~p" - "~n Answer: ~p", [TC, Server, Sock, Answer]), - {ok, Port} = inet:port(Sock), - Server ! {port, Port}, - receive - owner -> - tsp("otp_9847_handler_init -> " - "received owner message - activate socket"), - inet:setopts(Sock, [{active, true}]), - otp_9847_handler_main(TC, Server, Sock, Answer, [?HTTP_MAX_HEADER_SIZE]) - end. - -otp_9847_handler_main(TC, Server, Sock, Answer, ParseArgs) -> - tsp("otp_9847_handler_main -> entry with" - "~n TC: ~p" - "~n Server: ~p" - "~n Sock: ~p" - "~n Answer: ~p" - "~n ParseArgs: ~p", [TC, Server, Sock, Answer, ParseArgs]), - receive - stop -> - tsp("otp_9847_handler_main -> received stop request"), - exit(normal); - - {tcp, Sock, _Data} when Answer =:= false -> - tsp("otp_9847_handler_main -> received tcp data - no answer"), - TC ! {data_received, self()}, - inet:setopts(Sock, [{active, true}]), - %% Ignore all data - otp_9847_handler_main(TC, Server, Sock, Answer, ParseArgs); - - {tcp, Sock, Data} when Answer =:= true -> - tsp("otp_9847_handler_main -> received tcp data - answer"), - TC ! {data_received, self()}, - inet:setopts(Sock, [{active, true}]), - NewParseArgs = otp_9847_handler_request(Sock, [Data|ParseArgs]), - otp_9847_handler_main(TC, Server, Sock, Answer, NewParseArgs); - - {tcp_closed, Sock} -> - tsp("otp_9847_handler_main -> received tcp socket closed"), - exit(normal); - - {tcp_error, Sock, Reason} -> - tsp("otp_9847_handler_main -> socket error: ~p", [Reason]), - (catch gen_tcp:close(Sock)), - exit(normal) - - %% after 30000 -> - %% gen_tcp:close(Sock), - %% exit(normal) - end. - -otp_9847_handler_request(Sock, Args) -> - Msg = - case httpd_request:parse(Args) of - {ok, {_, "/index.html" = _RelUrl, _, _, _}} -> - B = - "<HTML><BODY>" ++ - "...some body part..." ++ - "</BODY></HTML>", - Len = integer_to_list(length(B)), - "HTTP/1.1 200 ok\r\n" ++ - "Content-Length:" ++ Len ++ "\r\n\r\n" ++ B - end, - gen_tcp:send(Sock, Msg), - [?HTTP_MAX_HEADER_SIZE]. - + {ok, {{_,503, _}, [_ | _], [_|_]}} = + httpc:request(get, {URL503, []}, [], []), + ets:delete(unavailable). %%------------------------------------------------------------------------- -options(doc) -> - ["Test the option parameters."]; -options(suite) -> +invalid_http(doc) -> + ["Test parse error"]; +invalid_http(suite) -> []; -options(Config) when is_list(Config) -> - case ?config(local_server, Config) of - ok -> - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - {ok, {{_,200,_}, [_ | _], Bin}} - = httpc:request(get, {URL, []}, [{foo, bar}], - %% Ignore unknown options - [{body_format, binary}, {foo, bar}]), - - true = is_binary(Bin), - {ok, {200, [_|_]}} - = httpc:request(get, {URL, []}, [{timeout, infinity}], - [{full_result, false}]); - _ -> - skip("Failed to start local http-server") - end. - +invalid_http(Config) when is_list(Config) -> -%%------------------------------------------------------------------------- + URL = url(group_name(Config), "/invalid_http.html", Config), -http_invalid_http(doc) -> - ["Test parse error"]; -http_invalid_http(suite) -> - []; -http_invalid_http(Config) when is_list(Config) -> - ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(ipv4), - - URL = ?URL_START ++ integer_to_list(Port) ++ "/invalid_http.html", - {error, {could_not_parse_as_http, _} = Reason} = httpc:request(get, {URL, []}, [], []), - - test_server:format("Parse error: ~p ~n", [Reason]), - DummyServerPid ! stop, - ok = httpc:set_options([{ipfamily, inet6fb4}]), - ok. + ct:print("Parse error: ~p ~n", [Reason]). %%------------------------------------------------------------------------- - --define(GOOGLE, "www.google.com"). - -hexed_query_otp_6191(doc) -> - []; -hexed_query_otp_6191(suite) -> - []; -hexed_query_otp_6191(Config) when is_list(Config) -> - Google = ?GOOGLE, - GoogleSearch = "http://" ++ Google ++ "/search", - Search1 = "?hl=en&q=a%D1%85%D1%83%D0%B9&btnG=Google+Search", - URI1 = GoogleSearch ++ Search1, - Search2 = "?hl=en&q=%25%25", - URI2 = GoogleSearch ++ Search2, - Search3 = "?hl=en&q=%foo", - URI3 = GoogleSearch ++ Search3, - - Verify1 = - fun({http, [], ?GOOGLE, 80, "/search", _}) -> ok; - (_) -> error - end, - Verify2 = Verify1, - Verify3 = Verify1, - verify_uri(URI1, Verify1), - verify_uri(URI2, Verify2), - verify_uri(URI3, Verify3), - ok. - -verify_uri(URI, Verify) -> - case http_uri:parse(URI) of - {ok, ParsedURI} -> - case Verify(ParsedURI) of - ok -> - ok; - error -> - Reason = {unexpected_parse_result, URI, ParsedURI}, - ERROR = {error, Reason}, - throw(ERROR) - end; - {error, _} = ERROR -> - throw(ERROR) - end. - - -%%------------------------------------------------------------------------- - -empty_body_otp_6243(doc) -> - ["An empty body was not returned directly. There was a delay for several" - "seconds."]; -empty_body_otp_6243(suite) -> - []; -empty_body_otp_6243(Config) when is_list(Config) -> - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/empty.html", - {ok, {{_,200,_}, [_ | _], []}} = - httpc:request(get, {URL, []}, [{timeout, 500}], []). - +emulate_lower_versions(doc) -> + [{doc, "Perform request as 0.9 and 1.0 clients."}]; +emulate_lower_versions(Config) when is_list(Config) -> + + URL = url(group_name(Config), "/dummy.html", Config), + + {ok, Body0} = + httpc:request(get, {URL, []}, [{version, "HTTP/0.9"}], []), + inets_test_lib:check_body(Body0), + {ok, {{"HTTP/1.0", 200, _}, [_ | _], Body1 = [_ | _]}} = + httpc:request(get, {URL, []}, [{version, "HTTP/1.0"}], []), + inets_test_lib:check_body(Body1), + {ok, {{"HTTP/1.1", 200, _}, [_ | _], Body2 = [_ | _]}} = + httpc:request(get, {URL, []}, [{version, "HTTP/1.1"}], []), + inets_test_lib:check_body(Body2). %%------------------------------------------------------------------------- -transfer_encoding_otp_6807(doc) -> - ["Transfer encoding is case insensitive"]; -transfer_encoding_otp_6807(suite) -> - []; -transfer_encoding_otp_6807(Config) when is_list(Config) -> - ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(ipv4), - - URL = ?URL_START ++ integer_to_list(Port) ++ - "/capital_transfer_encoding.html", - {ok, {{_,200,_}, [_|_], [_ | _]}} = httpc:request(URL), - DummyServerPid ! stop, - ok = httpc:set_options([{ipfamily, inet6fb4}]), - ok. +relaxed(doc) -> + ["Test relaxed mode"]; +relaxed(Config) when is_list(Config) -> + URL = url(group_name(Config), "/missing_reason_phrase.html", Config), -%%------------------------------------------------------------------------- + {error, Reason} = + httpc:request(get, {URL, []}, [{relaxed, false}], []), -empty_response_header_otp_6830(doc) -> - ["Test the case that the HTTP server does not send any headers"]; -empty_response_header_otp_6830(suite) -> - []; -empty_response_header_otp_6830(Config) when is_list(Config) -> - ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(ipv4), - - URL = ?URL_START ++ integer_to_list(Port) ++ "/no_headers.html", - {ok, {{_,200,_}, [], [_ | _]}} = httpc:request(URL), - DummyServerPid ! stop, - ok = httpc:set_options([{ipfamily, inet6fb4}]), - ok. + ct:print("Not relaxed: ~p~n", [Reason]), + {ok, {{_, 200, _}, [_ | _], [_ | _]}} = + httpc:request(get, {URL, []}, [{relaxed, true}], []). %%------------------------------------------------------------------------- -no_content_204_otp_6982(doc) -> - ["Test the case that the HTTP 204 no content header"]; -no_content_204_otp_6982(suite) -> - []; -no_content_204_otp_6982(Config) when is_list(Config) -> - ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(ipv4), - - URL = ?URL_START ++ integer_to_list(Port) ++ "/no_content.html", - {ok, {{_,204,_}, [], []}} = httpc:request(URL), - DummyServerPid ! stop, - ok = httpc:set_options([{ipfamily, inet6fb4}]), - ok. - - -%%------------------------------------------------------------------------- +headers() -> + [{doc,"Use as many request headers as possible not used in proxy_headers"}]. +headers(Config) when is_list(Config) -> -missing_CR_otp_7304(doc) -> - ["Test the case that the HTTP server uses only LF instead of CRLF" - "as delimitor"]; -missing_CR_otp_7304(suite) -> - []; -missing_CR_otp_7304(Config) when is_list(Config) -> - ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(ipv4), - - URL = ?URL_START ++ integer_to_list(Port) ++ "/missing_CR.html", - {ok, {{_,200,_}, _, [_ | _]}} = httpc:request(URL), - DummyServerPid ! stop, - ok = httpc:set_options([{ipfamily, inet6fb4}]), - ok. + URL = url(group_name(Config), "/dummy.html", Config), + DocRoot = ?config(doc_root, Config), + {ok, FileInfo} = + file:read_file_info(filename:join([DocRoot,"dummy.html"])), + CreatedSec = + calendar:datetime_to_gregorian_seconds( + FileInfo#file_info.mtime), -%%------------------------------------------------------------------------- + Mod = httpd_util:rfc1123_date( + calendar:gregorian_seconds_to_datetime( + CreatedSec-1)), + Date = httpd_util:rfc1123_date({date(), time()}), -otp_7883_1(doc) -> - ["OTP-7883-sync"]; -otp_7883_1(suite) -> - []; -otp_7883_1(Config) when is_list(Config) -> - ok = httpc:set_options([{ipfamily, inet}]), - - {DummyServerPid, Port} = dummy_server(ipv4), - - URL = ?URL_START ++ integer_to_list(Port) ++ "/just_close.html", - {error, socket_closed_remotely} = httpc:request(URL), - DummyServerPid ! stop, - - ok = httpc:set_options([{ipfamily, inet6fb4}]), - ok. + {ok, {{_,200,_}, [_ | _], [_ | _]}} = + httpc:request(get, {URL, [{"If-Modified-Since", + Mod}, + {"From","[email protected]"}, + {"Date", Date} + ]}, [], []), -otp_7883_2(doc) -> - ["OTP-7883-async"]; -otp_7883_2(suite) -> - []; -otp_7883_2(Config) when is_list(Config) -> - ok = httpc:set_options([{ipfamily, inet}]), + Mod1 = httpd_util:rfc1123_date( + calendar:gregorian_seconds_to_datetime( + CreatedSec+1)), - {DummyServerPid, Port} = dummy_server(ipv4), - - URL = ?URL_START ++ integer_to_list(Port) ++ "/just_close.html", - Method = get, - Request = {URL, []}, - HttpOptions = [], - Options = [{sync, false}], - Profile = httpc:default_profile(), - {ok, RequestId} = - httpc:request(Method, Request, HttpOptions, Options, Profile), - ok = - receive - {http, {RequestId, {error, socket_closed_remotely}}} -> - ok - end, - DummyServerPid ! stop, + {ok, {{_,200,_}, [_ | _], [_ | _]}} = + httpc:request(get, {URL, [{"If-UnModified-Since", + Mod1} + ]}, [], []), - ok = httpc:set_options([{ipfamily, inet6fb4}]), - ok. + Tag = httpd_util:create_etag(FileInfo), + {ok, {{_,200,_}, [_ | _], [_ | _]}} = + httpc:request(get, {URL, [{"If-Match", + Tag} + ]}, [], []), + + {ok, {{_,200,_}, [_ | _], _}} = + httpc:request(get, {URL, [{"If-None-Match", + "NotEtag,NeihterEtag"}, + {"Connection", "Close"} + ]}, [], []). %%------------------------------------------------------------------------- +headers_dummy() -> + ["Test the code for handling headers we do not want/can send " + "to a real server. Note it is not logical to send" + "all of these headers together, we only want to test that" + "the code for handling headers will not crash."]. +headers_dummy(Config) when is_list(Config) -> -otp_8154_1(doc) -> - ["OTP-8154"]; -otp_8154_1(suite) -> - []; -otp_8154_1(Config) when is_list(Config) -> - start_inets(), - ReqSeqNumServer = start_sequence_number_server(), - RespSeqNumServer = start_sequence_number_server(), - {ok, Server, Port} = start_slow_server(RespSeqNumServer), - Clients = run_clients(105, Port, ReqSeqNumServer), - %% ok = wait_for_clients(Clients), - ok = wait4clients(Clients, timer:minutes(3)), - Server ! shutdown, - RespSeqNumServer ! shutdown, - ReqSeqNumServer ! shutdown, - ok. - -start_inets() -> - inets:start(), - ok. - - -%% ----------------------------------------------------- -%% A sequence number handler -%% The purpose is to be able to pair requests with responses. - -start_sequence_number_server() -> - proc_lib:spawn(fun() -> loop_sequence_number(1) end). - -loop_sequence_number(N) -> - receive - shutdown -> - ok; - {From, get_next} -> - From ! {next_is, N}, - loop_sequence_number(N + 1) - end. - -get_next_sequence_number(SeqNumServer) -> - SeqNumServer ! {self(), get_next}, - receive {next_is, N} -> N end. - -%% ----------------------------------------------------- -%% Client part -%% Sends requests randomly parallel - -run_clients(NumClients, ServerPort, SeqNumServer) -> - io:format("start clients when" - "~n NumClients: ~w" - "~n ServerPort: ~w" - "~n SeqNumServer: ~w" - "~n", [NumClients, ServerPort, SeqNumServer]), - set_random_seed(), - lists:map( - fun(Id) -> - io:format("starting client ~w~n", [Id]), - Req = f("req~3..0w", [get_next_sequence_number(SeqNumServer)]), - Url = f(?URL_START ++ "~w/~s", [ServerPort, Req]), - Pid = proc_lib:spawn( - fun() -> - io:format("[~w] client started - " - "issue request~n", [Id]), - case httpc:request(Url) of - {ok, {{_,200,_}, _, Resp}} -> - io:format("[~w] 200 response: " - "~p~n", [Id, Resp]), - case lists:prefix(Req++"->", Resp) of - true -> exit(normal); - false -> exit({bad_resp,Req,Resp}) - end; - {ok, {{_,EC,Reason},_,Resp}} -> - io:format("[~w] ~w response: " - "~s~n~s~n", - [Id, EC, Reason, Resp]), - exit({bad_resp,Req,Resp}); - Crap -> - io:format("[~w] bad response: ~p", - [Id, Crap]), - exit({bad_resp, Req, Crap}) - end - end), - MRef = erlang:monitor(process, Pid), - timer:sleep(10 + random:uniform(1334)), - {Id, Pid, MRef} - - end, - lists:seq(1, NumClients)). - -%% wait_for_clients(Clients) -> -%% lists:foreach( -%% fun({Id, Pid, MRef}) -> -%% io:format("waiting for client ~w termination~n", [Id]), -%% receive -%% {'DOWN', MRef, process, Pid, normal} -> -%% io:format("waiting for clients: " -%% "normal exit from ~w (~p)~n", -%% [Id, Pid]), -%% ok; -%% {'DOWN', MRef, process, Pid, Reason} -> -%% io:format("waiting for clients: " -%% "unexpected exit from ~w (~p):" -%% "~n Reason: ~p" -%% "~n", [Id, Pid, Reason]), -%% erlang:error(Reason) -%% end -%% end, -%% Clients). - - -wait4clients([], _Timeout) -> - ok; -wait4clients(Clients, Timeout) when Timeout > 0 -> - io:format("wait4clients -> entry with" - "~n length(Clients): ~w" - "~n Timeout: ~w" - "~n", [length(Clients), Timeout]), - T = t(), - receive - {'DOWN', _MRef, process, Pid, normal} -> - case lists:keysearch(Pid, 2, Clients) of - {value, {Id, _, _}} -> - io:format("receive normal exit message " - "from client ~p (~p)", [Id, Pid]), - NewClients = - lists:keydelete(Id, 1, Clients), - wait4clients(NewClients, - Timeout - (t() - T)); - false -> - io:format("receive normal exit message " - "from unknown process: ~p", [Pid]), - wait4clients(Clients, Timeout - (t() - T)) - end; - - {'DOWN', _MRef, process, Pid, Reason} -> - case lists:keysearch(Pid, 2, Clients) of - {value, {Id, _, _}} -> - io:format("receive bad exit message " - "from client ~p (~p):" - "~n ~p", [Id, Pid, Reason]), - erlang:error({bad_client_termination, Id, Reason}); - false -> - io:format("receive normal exit message " - "from unknown process: ~p", [Pid]), - wait4clients(Clients, Timeout - (t() - T)) - end - - after Timeout -> - erlang:error({client_timeout, Clients}) - end; -wait4clients(Clients, _) -> - erlang:error({client_timeout, Clients}). - - -%% Time in milli seconds -t() -> - {A,B,C} = erlang:now(), - A*1000000000+B*1000+(C div 1000). + URL = url(group_name(Config), "/dummy_headers.html", Config), + Foo = http_chunk:encode("foobar") ++ + binary_to_list(http_chunk:encode_last()), + FooBar = Foo ++ "\r\n\r\nOther:inets_test\r\n\r\n", -%% ----------------------------------------------------- -%% Webserver part: -%% Implements a web server that sends responses one character -%% at a time, with random delays between the characters. + UserPasswd = base64:encode_to_string("Alladin:Sesame"), + Auth = "Basic " ++ UserPasswd, -start_slow_server(SeqNumServer) -> - io:format("start slow server when" - "~n SeqNumServer: ~w" - "~n", [SeqNumServer]), - proc_lib:start( - erlang, apply, [fun() -> init_slow_server(SeqNumServer) end, []]). + %% The dummy server will ignore the headers, we only want to test + %% that the client header-handling code. This would not + %% be a vaild http-request! + {ok, {{_,200,_}, [_ | _], [_|_]}} = + httpc:request(post, + {URL, + [{"Via", + "1.0 fred, 1.1 nowhere.com (Apache/1.1)"}, + {"Warning","1#pseudonym foobar"}, + {"Vary","*"}, + {"Upgrade","HTTP/2.0"}, + {"Pragma", "1#no-cache"}, + {"Cache-Control", "no-cache"}, + {"Connection", "close"}, + {"Date", "Sat, 29 Oct 1994 19:43:31 GMT"}, + {"Accept", " text/plain; q=0.5, text/html"}, + {"Accept-Language", "en"}, + {"Accept-Encoding","chunked"}, + {"Accept-Charset", "ISO8859-1"}, + {"Authorization", Auth}, + {"Expect", "1#100-continue"}, + {"User-Agent","inets"}, + {"Transfer-Encoding","chunked"}, + {"Range", " bytes=0-499"}, + {"If-Range", "Sat, 29 Oct 1994 19:43:31 GMT"}, + {"If-Match", "*"}, + {"Content-Type", "text/plain"}, + {"Content-Encoding", "chunked"}, + {"Content-Length", "6"}, + {"Content-Language", "en"}, + {"Content-Location", "http://www.foobar.se"}, + {"Content-MD5", + "104528739076276072743283077410617235478"}, + {"Content-Range", "bytes 0-499/1234"}, + {"Allow", "GET"}, + {"Proxy-Authorization", Auth}, + {"Expires", "Sat, 29 Oct 1994 19:43:31 GMT"}, + {"Upgrade", "HTTP/2.0"}, + {"Last-Modified", "Sat, 29 Oct 1994 19:43:31 GMT"}, + {"Trailer","1#User-Agent"} + ], "text/plain", FooBar}, + [], []). -init_slow_server(SeqNumServer) -> - io:format("[webserver ~w] init slow server" - "~n", [SeqNumServer]), - {ok, LSock} = gen_tcp:listen(0, [binary, {packet,0}, {active,true}, - {backlog, 100}]), - io:format("[webserver ~w] LSock: ~p" - "~n", [SeqNumServer, LSock]), - {ok, {_IP, Port}} = inet:sockname(LSock), - io:format("[webserver ~w] Port: ~w" - "~n", [SeqNumServer, Port]), - proc_lib:init_ack({ok, self(), Port}), - loop_slow_server(LSock, SeqNumServer). -loop_slow_server(LSock, SeqNumServer) -> - io:format("[webserver ~w] entry with" - "~n LSock: ~p" - "~n", [SeqNumServer, LSock]), - Master = self(), - Acceptor = proc_lib:spawn( - fun() -> client_handler(Master, LSock, SeqNumServer) end), - io:format("[webserver ~w] acceptor started" - "~n Acceptor: ~p" - "~n", [SeqNumServer, Acceptor]), - receive - {accepted, Acceptor} -> - io:format("[webserver ~w] accepted" - "~n", [SeqNumServer]), - loop_slow_server(LSock, SeqNumServer); - shutdown -> - gen_tcp:close(LSock), - exit(Acceptor, kill) - end. +%%------------------------------------------------------------------------- +remote_socket_close(Config) when is_list(Config) -> + URL = url(group_name(Config), "/just_close.html", Config), + {error, socket_closed_remotely} = httpc:request(URL). -%% Handle one client connection -client_handler(Master, LSock, SeqNumServer) -> - io:format("[acceptor ~w] await accept" - "~n", [SeqNumServer]), - {ok, CSock} = gen_tcp:accept(LSock), - io:format("[acceptor ~w] accepted" - "~n CSock: ~p" - "~n", [SeqNumServer, CSock]), - Master ! {accepted, self()}, - set_random_seed(), - loop_client(1, CSock, SeqNumServer). +%%------------------------------------------------------------------------- -loop_client(N, CSock, SeqNumServer) -> - %% Await request, don't bother parsing it too much, - %% assuming the entire request arrives in one packet. - io:format("[acceptor ~w] await request" - "~n N: ~p" - "~n", [SeqNumServer, N]), +remote_socket_close_async(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/just_close.html", Config), []}, + Options = [{sync, false}], + Profile = httpc:default_profile(), + {ok, RequestId} = + httpc:request(get, Request, [], Options, Profile), receive - {tcp, CSock, Req} -> - ReqNum = parse_req_num(Req), - RespSeqNum = get_next_sequence_number(SeqNumServer), - Response = f("~s->resp~3..0w/~2..0w", [ReqNum, RespSeqNum, N]), - Txt = f("Slow server (~p) got ~p, answering with ~p", - [self(), Req, Response]), - io:format("~s...~n", [Txt]), - slowly_send_response(CSock, Response), - case parse_connection_type(Req) of - keep_alive -> - io:format("~s...done~n", [Txt]), - loop_client(N+1, CSock, SeqNumServer); - close -> - io:format("~s...done (closing)~n", [Txt]), - gen_tcp:close(CSock) - end + {http, {RequestId, {error, socket_closed_remotely}}} -> + ok end. -slowly_send_response(CSock, Answer) -> - Response = f("HTTP/1.1 200 OK\r\nContent-Length: ~w\r\n\r\n~s", - [length(Answer), Answer]), - lists:foreach( - fun(Char) -> - timer:sleep(random:uniform(500)), - gen_tcp:send(CSock, <<Char>>) - end, - Response). +%%------------------------------------------------------------------------- -parse_req_num(Request) -> - Opts = [caseless,{capture,all_but_first,list}], - {match, [ReqNum]} = re:run(Request, "GET /(.*) HTTP", Opts), - ReqNum. +stream_to_pid(Config) when is_list(Config) -> + ReceiverPid = create_receiver(pid), + Receiver = ReceiverPid, -parse_connection_type(Request) -> - Opts = [caseless,{capture,all_but_first,list}], - {match,[CType]} = re:run(Request, "connection: *(keep-alive|close)", Opts), - case string:to_lower(CType) of - "close" -> close; - "keep-alive" -> keep_alive - end. + stream(ReceiverPid, Receiver, Config), + stop_receiver(ReceiverPid). -set_random_seed() -> - {_, _, Micros} = now(), - A = erlang:phash2([make_ref(), self(), Micros]), - random:seed(A, A, A). +stream_through_fun(Config) when is_list(Config) -> + ReceiverPid = create_receiver(function), + Receiver = stream_deliver_fun(ReceiverPid), -f(F, A) -> lists:flatten(io_lib:format(F,A)). + stream(ReceiverPid, Receiver, Config), + stop_receiver(ReceiverPid). +stream_through_mfa(Config) when is_list(Config) -> + ReceiverPid = create_receiver(mfa), + Receiver = {?MODULE, stream_deliver, [mfa, ReceiverPid]}, + stream(ReceiverPid, Receiver, Config). %%------------------------------------------------------------------------- +inet_opts(Config) when is_list(Config) -> + MaxSessions = 5, + MaxKeepAlive = 10, + KeepAliveTimeout = timer:minutes(2), + ConnOptions = [{max_sessions, MaxSessions}, + {max_keep_alive_length, MaxKeepAlive}, + {keep_alive_timeout, KeepAliveTimeout}], + httpc:set_options(ConnOptions), + + Request = {url(group_name(Config), "/dummy.html", Config), []}, + Timeout = timer:seconds(1), + ConnTimeout = Timeout + timer:seconds(1), + HttpOptions = [{timeout, Timeout}, {connect_timeout, ConnTimeout}], + Options0 = [{socket_opts, [{tos, 87}, + {recbuf, 16#FFFF}, + {sndbuf, 16#FFFF}]}], + + {ok, {{_,200,_}, [_ | _], ReplyBody0 = [_ | _]}} = httpc:request(get, Request, HttpOptions, Options0), + inets_test_lib:check_body(ReplyBody0), + + Options1 = [{socket_opts, [{tos, 84}, + {recbuf, 32#1FFFF}, + {sndbuf, 32#1FFFF}]}], + {ok, {{_,200,_}, [_ | _], ReplyBody1 = [_ | _]}} = httpc:request(get, Request, [], Options1), + inets_test_lib:check_body(ReplyBody1). +%%------------------------------------------------------------------------- +port_in_host_header(Config) when is_list(Config) -> -otp_8106_pid(doc) -> - ["OTP-8106 - deliver reply info using \"other\" pid"]; -otp_8106_pid(suite) -> - []; -otp_8106_pid(Config) when is_list(Config) -> - case ?config(local_server, Config) of - ok -> - ReceiverPid = create_receiver(pid), - Receiver = ReceiverPid, - - otp8106(ReceiverPid, Receiver, Config), - - stop_receiver(ReceiverPid), - - ok; - _ -> - skip("Failed to start local http-server") - end. - - -otp_8106_fun(doc) -> - ["OTP-8106 - deliver reply info using fun"]; -otp_8106_fun(suite) -> - []; -otp_8106_fun(Config) when is_list(Config) -> - case ?config(local_server, Config) of - ok -> - ReceiverPid = create_receiver(function), - Receiver = otp_8106_deliver_fun(ReceiverPid), - - otp8106(ReceiverPid, Receiver, Config), + Request = {url(group_name(Config), "/ensure_host_header_with_port.html", Config), []}, + {ok, {{_, 200, _}, _, Body}} = httpc:request(get, Request, [], []), + inets_test_lib:check_body(Body). - stop_receiver(ReceiverPid), - - ok; - _ -> - skip("Failed to start local http-server") +%%------------------------------------------------------------------------- +timeout_memory_leak() -> + [{doc, "Check OTP-8739"}]. +timeout_memory_leak(Config) when is_list(Config) -> + {_DummyServerPid, Port} = otp_8739_dummy_server(), + {ok,Host} = inet:gethostname(), + Request = {?URL_START ++ Host ++ ":" ++ integer_to_list(Port) ++ "/dummy.html", []}, + case httpc:request(get, Request, [{connect_timeout, 500}, {timeout, 1}], [{sync, true}]) of + {error, timeout} -> + %% And now we check the size of the handler db + Info = httpc:info(), + ct:print("Info: ~p", [Info]), + {value, {handlers, Handlers}} = + lists:keysearch(handlers, 1, Info), + case Handlers of + [] -> + ok; + _ -> + ct:fail({unexpected_handlers, Handlers}) + end; + Unexpected -> + ct:fail({unexpected, Unexpected}) end. +%%-------------------------------------------------------------------- -otp_8106_mfa(doc) -> - ["OTP-8106 - deliver reply info using mfa callback"]; -otp_8106_mfa(suite) -> - []; -otp_8106_mfa(Config) when is_list(Config) -> - case ?config(local_server, Config) of - ok -> - ReceiverPid = create_receiver(mfa), - Receiver = {?MODULE, otp_8106_deliver, [mfa, ReceiverPid]}, - - otp8106(ReceiverPid, Receiver, Config), - - stop_receiver(ReceiverPid), - - ok; - _ -> - skip("Failed to start local http-server") - end. - - - otp8106(ReceiverPid, Receiver, Config) -> - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - Request = {URL, []}, - HTTPOptions = [], - Options = [{sync, false}, {receiver, Receiver}], +wait_for_whole_response() -> + [{doc, "Check OTP-8154"}]. +wait_for_whole_response(Config) when is_list(Config) -> - {ok, RequestId} = - httpc:request(get, Request, HTTPOptions, Options), + ReqSeqNumServer = start_sequence_number_server(), + RespSeqNumServer = start_sequence_number_server(), + {ok, Server, Port} = start_slow_server(RespSeqNumServer), + Clients = run_clients(105, Port, ReqSeqNumServer), + ok = wait4clients(Clients, timer:minutes(3)), + Server ! shutdown, + RespSeqNumServer ! shutdown, + ReqSeqNumServer ! shutdown. - Body = - receive +%%-------------------------------------------------------------------- +%% Internal Functions ------------------------------------------------ +%%-------------------------------------------------------------------- +stream(ReceiverPid, Receiver, Config) -> + Request = {url(group_name(Config), "/dummy.html", Config), []}, + Options = [{sync, false}, {receiver, Receiver}], + {ok, RequestId} = + httpc:request(get, Request, [], Options), + Body = + receive {reply, ReceiverPid, {RequestId, {{_, 200, _}, _, B}}} -> B; {reply, ReceiverPid, Msg} -> - tsf(Msg); + ct:fail(Msg); {bad_reply, ReceiverPid, Msg} -> - tsf(Msg) + ct:fail(Msg) end, - inets_test_lib:check_body(binary_to_list(Body)), - ok. - + inets_test_lib:check_body(binary_to_list(Body)). create_receiver(Type) -> - Parent = self(), + Parent = self(), Receiver = fun() -> receiver(Type, Parent) end, spawn_link(Receiver). @@ -2678,8 +941,7 @@ stop_receiver(Pid) -> receiver(Type, Parent) -> receive {stop, Parent} -> - exit(normal); - + ok; {http, ReplyInfo} when (Type =:= pid) -> Parent ! {reply, self(), ReplyInfo}, receiver(Type, Parent); @@ -2687,258 +949,116 @@ receiver(Type, Parent) -> {Type, ReplyInfo} -> Parent ! {reply, self(), ReplyInfo}, receiver(Type, Parent); - + Crap -> Parent ! {reply, self(), {bad_reply, Crap}}, receiver(Type, Parent) end. +stream_deliver_fun(ReceiverPid) -> + fun(ReplyInfo) -> stream_deliver(ReplyInfo, function, ReceiverPid) end. -otp_8106_deliver_fun(ReceiverPid) -> - fun(ReplyInfo) -> otp_8106_deliver(ReplyInfo, function, ReceiverPid) end. - -otp_8106_deliver(ReplyInfo, Type, ReceiverPid) -> +stream_deliver(ReplyInfo, Type, ReceiverPid) -> ReceiverPid ! {Type, ReplyInfo}, ok. +stream_test(Request, To) -> + {ok, {{_,200,_}, [_ | _], Body}} = + httpc:request(get, Request, [], []), + {ok, RequestId} = + httpc:request(get, Request, [], [{sync, false}, To]), + StreamedBody = + receive + {http, {RequestId, stream_start, _Headers}} -> + receive_streamed_body(RequestId, <<>>); + {http, {RequestId, stream_start, _Headers, Pid}} -> + receive_streamed_body(RequestId, <<>>, Pid); + {http, Msg} -> + ct:fail(Msg) + end, -%%------------------------------------------------------------------------- - -otp_8056(doc) -> - "OTP-8056"; -otp_8056(suite) -> - []; -otp_8056(Config) when is_list(Config) -> - Method = get, - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - Request = {URL, []}, - HTTPOptions = [], - Options1 = [{sync, true}, {stream, {self, once}}], - Options2 = [{sync, true}, {stream, self}], - {error, streaming_error} = httpc:request(Method, Request, - HTTPOptions, Options1), - tsp("request 1 failed as expected"), - {error, streaming_error} = httpc:request(Method, Request, - HTTPOptions, Options2), - tsp("request 2 failed as expected"), - ok. - - -%%------------------------------------------------------------------------- - -otp_8352(doc) -> - "OTP-8352"; -otp_8352(suite) -> - []; -otp_8352(Config) when is_list(Config) -> - tsp("otp_8352 -> entry with" - "~n Config: ~p", [Config]), - case ?config(local_server, Config) of - ok -> - tsp("local-server running"), - - tsp("initial profile info(1): ~p", [httpc:info()]), - - MaxSessions = 5, - MaxKeepAlive = 10, - KeepAliveTimeout = timer:minutes(2), - ConnOptions = [{max_sessions, MaxSessions}, - {max_keep_alive_length, MaxKeepAlive}, - {keep_alive_timeout, KeepAliveTimeout}], - httpc:set_options(ConnOptions), - - Method = get, - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - Request = {URL, []}, - Timeout = timer:seconds(1), - ConnTimeout = Timeout + timer:seconds(1), - HttpOptions1 = [{timeout, Timeout}, {connect_timeout, ConnTimeout}], - Options1 = [{socket_opts, [{tos, 87}, - {recbuf, 16#FFFF}, - {sndbuf, 16#FFFF}]}], - case httpc:request(Method, Request, HttpOptions1, Options1) of - {ok, {{_,200,_}, [_ | _], ReplyBody1 = [_ | _]}} -> - %% equivaliant to httpc:request(get, {URL, []}, [], []), - inets_test_lib:check_body(ReplyBody1); - {ok, UnexpectedReply1} -> - tsf({unexpected_reply, UnexpectedReply1}); - {error, _} = Error1 -> - tsf({bad_reply, Error1}) - end, - - tsp("profile info (2): ~p", [httpc:info()]), - - HttpOptions2 = [], - Options2 = [{socket_opts, [{tos, 84}, - {recbuf, 32#1FFFF}, - {sndbuf, 32#1FFFF}]}], - case httpc:request(Method, Request, HttpOptions2, Options2) of - {ok, {{_,200,_}, [_ | _], ReplyBody2 = [_ | _]}} -> - %% equivaliant to httpc:request(get, {URL, []}, [], []), - inets_test_lib:check_body(ReplyBody2); - {ok, UnexpectedReply2} -> - tsf({unexpected_reply, UnexpectedReply2}); - {error, _} = Error2 -> - tsf({bad_reply, Error2}) - end, - tsp("profile info (3): ~p", [httpc:info()]), - ok; - - _ -> - skip("Failed to start local http-server") - end. - - -%%------------------------------------------------------------------------- - -otp_8371(doc) -> - ["OTP-8371"]; -otp_8371(suite) -> - []; -otp_8371(Config) when is_list(Config) -> - ok = httpc:set_options([{ipv6, disabled}]), % also test the old option - {DummyServerPid, Port} = dummy_server(ipv4), - - URL = ?URL_START ++ integer_to_list(Port) ++ - "/ensure_host_header_with_port.html", - - case httpc:request(get, {URL, []}, [], []) of - {ok, Result} -> - case Result of - {{_, 200, _}, _Headers, Body} -> - tsp("expected response with" - "~n Body: ~p", [Body]), - ok; - {StatusLine, Headers, Body} -> - tsp("expected response with" - "~n StatusLine: ~p" - "~n Headers: ~p" - "~n Body: ~p", [StatusLine, Headers, Body]), - tsf({unexpected_result, - [{status_line, StatusLine}, - {headers, Headers}, - {body, Body}]}); - _ -> - tsf({unexpected_result, Result}) - end; - Error -> - tsf({request_failed, Error}) - end, + Body == binary_to_list(StreamedBody). - DummyServerPid ! stop, - ok = httpc:set_options([{ipv6, enabled}]), +url(http, End, Config) -> + Port = ?config(port, Config), + {ok,Host} = inet:gethostname(), + ?URL_START ++ Host ++ ":" ++ integer_to_list(Port) ++ End; +url(https, End, Config) -> + Port = ?config(port, Config), + {ok,Host} = inet:gethostname(), + ?TLS_URL_START ++ Host ++ ":" ++ integer_to_list(Port) ++ End; +url(sim_http, End, Config) -> + url(http, End, Config); +url(sim_https, End, Config) -> + url(https, End, Config). +url(http, UserInfo, End, Config) -> + Port = ?config(port, Config), + ?URL_START ++ UserInfo ++ integer_to_list(Port) ++ End; +url(https, UserInfo, End, Config) -> + Port = ?config(port, Config), + ?TLS_URL_START ++ UserInfo ++ integer_to_list(Port) ++ End; +url(sim_http, UserInfo, End, Config) -> + url(http, UserInfo, End, Config); +url(sim_https, UserInfo, End, Config) -> + url(https, UserInfo, End, Config). + +group_name(Config) -> + GroupProp = ?config(tc_group_properties, Config), + proplists:get_value(name, GroupProp). + +server_start(sim_http, _) -> + Inet = inet_version(), + ok = httpc:set_options([{ipfamily, Inet}]), + {_Pid, Port} = dummy_server(Inet), + Port; + +server_start(sim_https, SslConfig) -> + Inet = inet_version(), + ok = httpc:set_options([{ipfamily, Inet}]), + {_Pid, Port} = dummy_server(ssl, Inet, SslConfig), + Port; + +server_start(_, HttpdConfig) -> + {ok, Pid} = inets:start(httpd, HttpdConfig), + Serv = inets:services_info(), + {value, {_, _, Info}} = lists:keysearch(Pid, 2, Serv), + proplists:get_value(port, Info). + +server_config(http, Config) -> + ServerRoot = ?config(server_root, Config), + [{port, 0}, + {server_name,"httpc_test"}, + {server_root, ServerRoot}, + {document_root, ?config(doc_root, Config)}, + {bind_address, any}, + {ipfamily, inet_version()}, + {mime_type, "text/plain"}, + {script_alias, {"/cgi-bin/", filename:join(ServerRoot, "cgi-bin") ++ "/"}} + ]; + +server_config(https, Config) -> + [{socket_type, {essl, ssl_config(Config)}} | server_config(http, Config)]; +server_config(sim_https, Config) -> + ssl_config(Config); +server_config(_, _) -> + []. + +start_apps(https) -> + inets_test_lib:start_apps([crypto, public_key, ssl]); +start_apps(_) -> ok. - -%%------------------------------------------------------------------------- - -otp_8739(doc) -> - ["OTP-8739"]; -otp_8739(suite) -> - []; -otp_8739(Config) when is_list(Config) -> - {_DummyServerPid, Port} = otp_8739_dummy_server(), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - Method = get, - Request = {URL, []}, - HttpOptions = [{connect_timeout, 500}, {timeout, 1}], - Options = [{sync, true}], - case httpc:request(Method, Request, HttpOptions, Options) of - {error, timeout} -> - %% And now we check the size of the handler db - Info = httpc:info(), - tsp("Info: ~p", [Info]), - {value, {handlers, Handlers}} = - lists:keysearch(handlers, 1, Info), - case Handlers of - [] -> - ok; - _ -> - tsf({unexpected_handlers, Handlers}) - end; - Unexpected -> - tsf({unexpected, Unexpected}) - end. - - -otp_8739_dummy_server() -> - Parent = self(), - Pid = spawn_link(fun() -> otp_8739_dummy_server_init(Parent) end), - receive - {port, Port} -> - {Pid, Port} - end. - -otp_8739_dummy_server_init(Parent) -> - {ok, ListenSocket} = - gen_tcp:listen(0, [binary, inet, {packet, 0}, - {reuseaddr,true}, - {active, false}]), - {ok, Port} = inet:port(ListenSocket), - Parent ! {port, Port}, - otp_8739_dummy_server_main(Parent, ListenSocket). - -otp_8739_dummy_server_main(_Parent, ListenSocket) -> - case gen_tcp:accept(ListenSocket) of - {ok, Sock} -> - %% Ignore the request, and simply wait for the socket to close - receive - {tcp_closed, Sock} -> - (catch gen_tcp:close(ListenSocket)), - exit(normal); - {tcp_error, Sock, Reason} -> - tsp("socket error: ~p", [Reason]), - (catch gen_tcp:close(ListenSocket)), - exit(normal) - after 10000 -> - %% Just in case - (catch gen_tcp:close(Sock)), - (catch gen_tcp:close(ListenSocket)), - exit(timeout) - end; - Error -> - exit(Error) - end. - - -%%------------------------------------------------------------------------- - -initial_server_connect(doc) -> - ["If this test cases times out the init of httpc_handler process is" - "blocking the manager/client process (implementation dependent which) but nither" - "should be blocked."]; -initial_server_connect(suite) -> - []; -initial_server_connect(Config) when is_list(Config) -> +ssl_config(Config) -> DataDir = ?config(data_dir, Config), - ok = httpc:set_options([{ipfamily, inet}]), - - CertFile = filename:join(DataDir, "ssl_server_cert.pem"), - SSLOptions = [{certfile, CertFile}, {keyfile, CertFile}], - - {DummyServerPid, Port} = dummy_ssl_server_hang(self(), ipv4, SSLOptions), - - URL = ?SSL_URL_START ++ integer_to_list(Port) ++ "/index.html", - - httpc:request(get, {URL, []}, [{ssl,{essl,[]}}], [{sync, false}]), - - [{session_cookies,[]}] = httpc:which_cookies(), + [{certfile, filename:join(DataDir, "ssl_server_cert.pem")}, + {verify, verify_none} + ]. - DummyServerPid ! stop, - ok = httpc:set_options([{ipfamily, inet6fb4}]). - -%%-------------------------------------------------------------------- -%% Internal functions -%%-------------------------------------------------------------------- setup_server_dirs(ServerRoot, DocRoot, DataDir) -> - ConfDir = filename:join(ServerRoot, "conf"), CgiDir = filename:join(ServerRoot, "cgi-bin"), ok = file:make_dir(ServerRoot), ok = file:make_dir(DocRoot), - ok = file:make_dir(ConfDir), ok = file:make_dir(CgiDir), {ok, Files} = file:list_dir(DataDir), @@ -2961,77 +1081,41 @@ setup_server_dirs(ServerRoot, DocRoot, DataDir) -> end, inets_test_lib:copy_file(Cgi, DataDir, CgiDir), - inets_test_lib:copy_file("mime.types", DataDir, ConfDir). - -create_config(FileName, ComType, Port, PrivDir, ServerRoot, DocRoot, - SSLDir) -> - MaxHdrSz = io_lib:format("~p", [256]), - MaxHdrAct = io_lib:format("~p", [close]), - SSL = - case ComType of - ssl -> - [cline(["SSLCertificateFile ", - filename:join(SSLDir, "ssl_server_cert.pem")]), - cline(["SSLCertificateKeyFile ", - filename:join(SSLDir, "ssl_server_cert.pem")]), - cline(["SSLVerifyClient 0"])]; - _ -> - [] - end, + AbsCgi = filename:join([CgiDir, Cgi]), + {ok, FileInfo} = file:read_file_info(AbsCgi), + ok = file:write_file_info(AbsCgi, FileInfo#file_info{mode = 8#00755}). - Mod_order = "Modules mod_alias mod_auth mod_esi mod_actions mod_cgi" - " mod_include mod_dir mod_get mod_head" - " mod_log mod_disk_log mod_trace", - - %% BindAddress = "*|inet", % Force the use of IPv4 - BindAddress = "*", % This corresponds to using IpFamily inet6fb4 - - HttpConfig = [ - cline(["BindAddress ", BindAddress]), - cline(["Port ", integer_to_list(Port)]), - cline(["ServerName ", "httpc_test"]), - cline(["SocketType ", atom_to_list(ComType)]), - cline([Mod_order]), - cline(["ServerRoot ", ServerRoot]), - cline(["DocumentRoot ", DocRoot]), - cline(["MaxHeaderSize ",MaxHdrSz]), - cline(["MaxHeaderAction ",MaxHdrAct]), - cline(["DirectoryIndex ", "index.html "]), - cline(["DefaultType ", "text/plain"]), - cline(["ScriptAlias /cgi-bin/ ", - filename:join(ServerRoot, "cgi-bin"), "/"]), - SSL], - ConfigFile = filename:join([PrivDir,FileName]), - {ok, Fd} = file:open(ConfigFile, [write]), - ok = file:write(Fd, lists:flatten(HttpConfig)), - ok = file:close(Fd). - -cline(List) -> - lists:flatten([List, "\r\n"]). -receive_streamed_body(RequestId, Body) -> - receive - {http, {RequestId, stream, BinBodyPart}} -> - receive_streamed_body(RequestId, - <<Body/binary, BinBodyPart/binary>>); - {http, {RequestId, stream_end, _Headers}} -> - Body; - {http, Msg} -> - tsf(Msg) - end. +keep_alive_requests(Request, Profile) -> + {ok, RequestIdA0} = + httpc:request(get, Request, [], [{sync, false}], Profile), + {ok, RequestIdA1} = + httpc:request(get, Request, [], [{sync, false}], Profile), + {ok, RequestIdA2} = + httpc:request(get, Request, [], [{sync, false}], Profile), -receive_streamed_body(RequestId, Body, Pid) -> - httpc:stream_next(Pid), - test_server:format("~p:receive_streamed_body -> requested next stream ~n", [?MODULE]), - receive - {http, {RequestId, stream, BinBodyPart}} -> - receive_streamed_body(RequestId, - <<Body/binary, BinBodyPart/binary>>, - Pid); - {http, {RequestId, stream_end, _Headers}} -> - Body; - {http, Msg} -> - tsf(Msg) + receive_replys([RequestIdA0, RequestIdA1, RequestIdA2]), + + {ok, RequestIdB0} = + httpc:request(get, Request, [], [{sync, false}], Profile), + {ok, RequestIdB1} = + httpc:request(get, Request, [], [{sync, false}], Profile), + {ok, RequestIdB2} = + httpc:request(get, Request, [], [{sync, false}], Profile), + + ok = httpc:cancel_request(RequestIdB1, Profile), + ct:print("Cancel ~p~n", [RequestIdB1]), + receive_replys([RequestIdB0, RequestIdB2]). + + +receive_replys([]) -> + ok; +receive_replys([ID|IDs]) -> + receive + {http, {ID, {{_, 200, _}, [_|_], _}}} -> + receive_replys(IDs); + {http, {Other, {{_, 200, _}, [_|_], _}}} -> + ct:fail({recived_canceld_id, Other}) end. %% Perform a synchronous stop @@ -3042,55 +1126,46 @@ dummy_server_stop(Pid) -> ok end. -dummy_server(IpV) -> - dummy_server(self(), ip_comm, IpV, []). +inet_version() -> + inet. %% Just run inet for now + %% case gen_tcp:listen(0,[inet6]) of + %% {ok, S} -> + %% gen_tcp:close(S), + %% inet6; + %% _ -> + %% inet + %%end. + +dummy_server(Inet) -> + dummy_server(self(), ip_comm, Inet, []). -dummy_server(SocketType, IpV, Extra) -> - dummy_server(self(), SocketType, IpV, Extra). +dummy_server(SocketType, Inet, Extra) -> + dummy_server(self(), SocketType, Inet, Extra). -dummy_server(Caller, SocketType, IpV, Extra) -> - Args = [Caller, SocketType, IpV, Extra], +dummy_server(Caller, SocketType, Inet, Extra) -> + Args = [Caller, SocketType, Inet, Extra], Pid = spawn(httpc_SUITE, dummy_server_init, Args), receive {port, Port} -> {Pid, Port} end. -dummy_server_init(Caller, ip_comm, IpV, _) -> +dummy_server_init(Caller, ip_comm, Inet, _) -> BaseOpts = [binary, {packet, 0}, {reuseaddr,true}, {active, false}], - {ok, ListenSocket} = - case IpV of - ipv4 -> - tsp("ip_comm ipv4 listen", []), - gen_tcp:listen(0, [inet | BaseOpts]); - ipv6 -> - tsp("ip_comm ipv6 listen", []), - gen_tcp:listen(0, [inet6 | BaseOpts]) - end, + {ok, ListenSocket} = gen_tcp:listen(0, [Inet | BaseOpts]), {ok, Port} = inet:port(ListenSocket), - tsp("dummy_server_init(ip_comm) -> Port: ~p", [Port]), Caller ! {port, Port}, dummy_ipcomm_server_loop({httpd_request, parse, [?HTTP_MAX_HEADER_SIZE]}, [], ListenSocket); -dummy_server_init(Caller, essl, IpV, SSLOptions) -> - BaseOpts = [{ssl_imp, new}, - {backlog, 128}, binary, {reuseaddr,true}, {active, false} | + +dummy_server_init(Caller, ssl, Inet, SSLOptions) -> + BaseOpts = [binary, {reuseaddr,true}, {active, false} | SSLOptions], - dummy_ssl_server_init(Caller, BaseOpts, IpV). - -dummy_ssl_server_init(Caller, BaseOpts, IpV) -> - {ok, ListenSocket} = - case IpV of - ipv4 -> - tsp("dummy_ssl_server_init -> ssl ipv4 listen", []), - ssl:listen(0, [inet | BaseOpts]); - ipv6 -> - tsp("dummy_ssl_server_init -> ssl ipv6 listen", []), - ssl:listen(0, [inet6 | BaseOpts]) - end, - tsp("dummy_ssl_server_init -> ListenSocket: ~p", [ListenSocket]), + dummy_ssl_server_init(Caller, BaseOpts, Inet). + +dummy_ssl_server_init(Caller, BaseOpts, Inet) -> + {ok, ListenSocket} = ssl:listen(0, [Inet | BaseOpts]), {ok, {_, Port}} = ssl:sockname(ListenSocket), - tsp("dummy_ssl_server_init -> Port: ~p", [Port]), Caller ! {port, Port}, dummy_ssl_server_loop({httpd_request, parse, [?HTTP_MAX_HEADER_SIZE]}, [], ListenSocket). @@ -3098,85 +1173,56 @@ dummy_ssl_server_init(Caller, BaseOpts, IpV) -> dummy_ipcomm_server_loop(MFA, Handlers, ListenSocket) -> receive stop -> - tsp("dummy_ipcomm_server_loop -> stop handlers", []), lists:foreach(fun(Handler) -> Handler ! stop end, Handlers); {stop, From} -> - tsp("dummy_ipcomm_server_loop -> " - "stop command from ~p for handlers (~p)", [From, Handlers]), Stopper = fun(Handler) -> Handler ! stop end, lists:foreach(Stopper, Handlers), From ! {stopped, self()} after 0 -> - tsp("dummy_ipcomm_server_loop -> await accept", []), {ok, Socket} = gen_tcp:accept(ListenSocket), - tsp("dummy_ipcomm_server_loop -> accepted: ~p", [Socket]), HandlerPid = dummy_request_handler(MFA, Socket), - tsp("dummy_icomm_server_loop -> handler created: ~p", [HandlerPid]), gen_tcp:controlling_process(Socket, HandlerPid), - tsp("dummy_ipcomm_server_loop -> " - "control transfered to handler", []), HandlerPid ! ipcomm_controller, - tsp("dummy_ipcomm_server_loop -> " - "handler informed about control transfer", []), dummy_ipcomm_server_loop(MFA, [HandlerPid | Handlers], - ListenSocket) + ListenSocket) end. dummy_ssl_server_loop(MFA, Handlers, ListenSocket) -> receive stop -> - tsp("dummy_ssl_server_loop -> stop handlers", []), lists:foreach(fun(Handler) -> Handler ! stop end, Handlers); {stop, From} -> - tsp("dummy_ssl_server_loop -> " - "stop command from ~p for handlers (~p)", [From, Handlers]), Stopper = fun(Handler) -> Handler ! stop end, lists:foreach(Stopper, Handlers), From ! {stopped, self()} after 0 -> - tsp("dummy_ssl_server_loop -> await accept", []), {ok, Socket} = ssl:transport_accept(ListenSocket), - tsp("dummy_ssl_server_loop -> accepted: ~p", [Socket]), HandlerPid = dummy_request_handler(MFA, Socket), - tsp("dummy_ssl_server_loop -> handler created: ~p", [HandlerPid]), ssl:controlling_process(Socket, HandlerPid), - tsp("dummy_ssl_server_loop -> control transfered to handler", []), HandlerPid ! ssl_controller, - tsp("dummy_ssl_server_loop -> " - "handler informed about control transfer", []), dummy_ssl_server_loop(MFA, [HandlerPid | Handlers], ListenSocket) end. dummy_request_handler(MFA, Socket) -> - tsp("spawn request handler", []), spawn(httpc_SUITE, dummy_request_handler_init, [MFA, Socket]). dummy_request_handler_init(MFA, Socket) -> SockType = receive ipcomm_controller -> - tsp("dummy_request_handler_init -> " - "received ip_comm controller - activate", []), inet:setopts(Socket, [{active, true}]), ip_comm; ssl_controller -> - tsp("dummy_request_handler_init -> " - "received ssl controller - activate", []), ssl:setopts(Socket, [{active, true}]), ssl end, dummy_request_handler_loop(MFA, SockType, Socket). dummy_request_handler_loop({Module, Function, Args}, SockType, Socket) -> - tsp("dummy_request_handler_loop -> entry with" - "~n Module: ~p" - "~n Function: ~p" - "~n Args: ~p", [Module, Function, Args]), receive {Proto, _, Data} when (Proto =:= tcp) orelse (Proto =:= ssl) -> - tsp("dummy_request_handler_loop -> [~w] Data ~p", [Proto, Data]), - case handle_request(Module, Function, [Data | Args], Socket, Proto) of + case handle_request(Module, Function, [Data | Args], Socket) of stop when Proto =:= tcp -> gen_tcp:close(Socket); stop when Proto =:= ssl -> @@ -3190,49 +1236,26 @@ dummy_request_handler_loop({Module, Function, Args}, SockType, Socket) -> ssl:close(Socket) end. - -mk_close(tcp) -> fun(Sock) -> gen_tcp:close(Sock) end; -mk_close(ssl) -> fun(Sock) -> ssl:close(Sock) end. - -mk_send(tcp) -> fun(Sock, Data) -> gen_tcp:send(Sock, Data) end; -mk_send(ssl) -> fun(Sock, Data) -> ssl:send(Sock, Data) end. - -handle_request(Module, Function, Args, Socket, Proto) -> - Close = mk_close(Proto), - Send = mk_send(Proto), - handle_request(Module, Function, Args, Socket, Close, Send). - -handle_request(Module, Function, Args, Socket, Close, Send) -> - tsp("handle_request -> entry with" - "~n Module: ~p" - "~n Function: ~p" - "~n Args: ~p", [Module, Function, Args]), +handle_request(Module, Function, Args, Socket) -> case Module:Function(Args) of {ok, Result} -> - tsp("handle_request -> ok" - "~n Result: ~p", [Result]), - case (catch handle_http_msg(Result, Socket, Close, Send)) of + case handle_http_msg(Result, Socket) of stop -> stop; <<>> -> - tsp("handle_request -> empty data"), {httpd_request, parse, [[<<>>, ?HTTP_MAX_HEADER_SIZE]]}; Data -> handle_request(httpd_request, parse, - [Data |[?HTTP_MAX_HEADER_SIZE]], Socket, - Close, Send) + [Data |[?HTTP_MAX_HEADER_SIZE]], Socket) end; NewMFA -> - tsp("handle_request -> " - "~n NewMFA: ~p", [NewMFA]), NewMFA end. -handle_http_msg({_, RelUri, _, {_, Headers}, Body}, Socket, Close, Send) -> - tsp("handle_http_msg -> entry with: " - "~n RelUri: ~p" - "~n Headers: ~p" - "~n Body: ~p", [RelUri, Headers, Body]), +handle_http_msg({Method, RelUri, _, {_, Headers}, Body}, Socket) -> + + ct:print("Request: ~p ~p", [Method, RelUri]), + NextRequest = case RelUri of "/dummy_headers.html" -> @@ -3253,225 +1276,69 @@ handle_http_msg({_, RelUri, _, {_, Headers}, Body}, Socket, Close, Send) -> end end, - tsp("handle_http_msg -> NextRequest: ~p", [NextRequest]), case (catch ets:lookup(cookie, cookies)) of [{cookies, true}]-> - tsp("handle_http_msg -> check cookies ~p", []), check_cookie(Headers); _ -> ok end, - + + {ok, {_, Port}} = sockname(Socket), + + DefaultResponse = "HTTP/1.1 200 ok\r\n" ++ "Content-Length:32\r\n\r\n" "<HTML><BODY>foobar</BODY></HTML>", - Msg = - case RelUri of - "/just_close.html" -> - close; - "/no_content.html" -> - "HTTP/1.0 204 No Content\r\n\r\n"; - "/no_headers.html" -> - "HTTP/1.0 200 OK\r\n\r\nTEST"; - "/ensure_host_header_with_port.html" -> - %% tsp("handle_http_msg -> validate host with port"), - case ensure_host_header_with_port(Headers) of - true -> - B = - "<HTML><BODY>" ++ - "host with port" ++ - "</BODY></HTML>", - Len = integer_to_list(length(B)), - "HTTP/1.1 200 ok\r\n" ++ - "Content-Length:" ++ Len ++ "\r\n\r\n" ++ B; - false -> - B = - "<HTML><BODY>" ++ - "Internal Server Error - host without port" ++ - "</BODY></HTML>", - Len = integer_to_list(length(B)), - "HTTP/1.1 500 Internal Server Error\r\n" ++ - "Content-Length:" ++ Len ++ "\r\n\r\n" ++ B - end; - "/300.html" -> - NewUri = ?URL_START ++ - integer_to_list(?IP_PORT) ++ "/dummy.html", - "HTTP/1.1 300 Multiple Choices\r\n" ++ - "Location:" ++ NewUri ++ "\r\n" ++ - "Content-Length:0\r\n\r\n"; - "/301.html" -> - NewUri = ?URL_START ++ - integer_to_list(?IP_PORT) ++ "/dummy.html", - "HTTP/1.1 301 Moved Permanently\r\n" ++ - "Location:" ++ NewUri ++ "\r\n" ++ - "Content-Length:80\r\n\r\n" ++ - "<HTML><BODY><a href=" ++ NewUri ++ - ">New place</a></BODY></HTML>"; - "/302.html" -> - NewUri = ?URL_START ++ - integer_to_list(?IP_PORT) ++ "/dummy.html", - "HTTP/1.1 302 Found \r\n" ++ - "Location:" ++ NewUri ++ "\r\n" ++ - "Content-Length:80\r\n\r\n" ++ - "<HTML><BODY><a href=" ++ NewUri ++ - ">New place</a></BODY></HTML>"; - "/303.html" -> - NewUri = ?URL_START ++ - integer_to_list(?IP_PORT) ++ "/dummy.html", - "HTTP/1.1 303 See Other \r\n" ++ - "Location:" ++ NewUri ++ "\r\n" ++ - "Content-Length:80\r\n\r\n" ++ - "<HTML><BODY><a href=" ++ NewUri ++ - ">New place</a></BODY></HTML>"; - "/307.html" -> - NewUri = ?URL_START ++ - integer_to_list(?IP_PORT) ++ "/dummy.html", - "HTTP/1.1 307 Temporary Rediect \r\n" ++ - "Location:" ++ NewUri ++ "\r\n" ++ - "Content-Length:80\r\n\r\n" ++ - "<HTML><BODY><a href=" ++ NewUri ++ - ">New place</a></BODY></HTML>"; - "/500.html" -> - "HTTP/1.1 500 Internal Server Error\r\n" ++ - "Content-Length:47\r\n\r\n" ++ - "<HTML><BODY>Internal Server Error</BODY></HTML>"; - "/503.html" -> - case ets:lookup(unavailable, 503) of - [{503, unavailable}] -> - ets:insert(unavailable, {503, available}), - "HTTP/1.1 503 Service Unavailable\r\n" ++ - "Retry-After:5\r\n" ++ - "Content-Length:47\r\n\r\n" ++ - "<HTML><BODY>Internal Server Error</BODY></HTML>"; - [{503, available}] -> - DefaultResponse; - [{503, long_unavailable}] -> - "HTTP/1.1 503 Service Unavailable\r\n" ++ - "Retry-After:120\r\n" ++ - "Content-Length:47\r\n\r\n" ++ - "<HTML><BODY>Internal Server Error</BODY></HTML>" - end; - "/redirectloop.html" -> %% Create a potential endless loop! - {ok, Port} = inet:port(Socket), - NewUri = ?URL_START ++ - integer_to_list(Port) ++ "/redirectloop.html", - "HTTP/1.1 300 Multiple Choices\r\n" ++ - "Location:" ++ NewUri ++ "\r\n" ++ - "Content-Length:0\r\n\r\n"; - "/userinfo.html" -> - Challange = "HTTP/1.1 401 Unauthorized \r\n" ++ - "WWW-Authenticate:Basic" ++"\r\n" ++ - "Content-Length:0\r\n\r\n", - case auth_header(Headers) of - {ok, Value} -> - handle_auth(Value, Challange, DefaultResponse); - _ -> - Challange - end; - "/dummy_headers.html" -> - %% The client will only care about the Transfer-Encoding - %% header the rest of these headers are left to the - %% user to evaluate. This is not a valid response - %% it only tests that the header handling code works. - Head = "HTTP/1.1 200 ok\r\n" ++ - "Content-Length:32\r\n" ++ - "Pragma:1#no-cache\r\n" ++ - "Via:1.0 fred, 1.1 nowhere.com (Apache/1.1)\r\n" ++ - "Warning:1#pseudonym foobar\r\n" ++ - "Vary:*\r\n" ++ - "Trailer:Other:inets_test\r\n" ++ - "Upgrade:HTTP/2.0\r\n" ++ - "Age:4711\r\n" ++ - "Transfer-Encoding:chunked\r\n" ++ - "Content-Encoding:foo\r\n" ++ - "Content-Language:en\r\n" ++ - "Content-Location:http://www.foobar.se\r\n" ++ - "Content-MD5:104528739076276072743283077410617235478\r\n" - ++ - "Content-Range:Sat, 29 Oct 1994 19:43:31 GMT\r\n" ++ - "Expires:Sat, 29 Oct 1994 19:43:31 GMT\r\n" ++ - "Proxy-Authenticate:#1Basic" ++ - "\r\n\r\n", - Send(Socket, Head), - Send(Socket, http_chunk:encode("<HTML><BODY>fo")), - Send(Socket, http_chunk:encode("obar</BODY></HTML>")), - http_chunk:encode_last(); - "/capital_transfer_encoding.html" -> - Head = "HTTP/1.1 200 ok\r\n" ++ - "Transfer-Encoding:Chunked\r\n\r\n", - Send(Socket, Head), - Send(Socket, http_chunk:encode("<HTML><BODY>fo")), - Send(Socket, http_chunk:encode("obar</BODY></HTML>")), - http_chunk:encode_last(); - "/cookie.html" -> - "HTTP/1.1 200 ok\r\n" ++ - "set-cookie:" ++ "test_cookie=true; path=/;" ++ - "max-age=60000\r\n" ++ - "Content-Length:32\r\n\r\n"++ - "<HTML><BODY>foobar</BODY></HTML>"; - "/missing_crlf.html" -> - "HTTP/1.1 200 ok" ++ - "Content-Length:32\r\n" ++ - "<HTML><BODY>foobar</BODY></HTML>"; - "/wrong_statusline.html" -> - "ok 200 HTTP/1.1\r\n\r\n" ++ - "Content-Length:32\r\n\r\n" ++ - "<HTML><BODY>foobar</BODY></HTML>"; - "/once_chunked.html" -> - Head = "HTTP/1.1 200 ok\r\n" ++ - "Transfer-Encoding:Chunked\r\n\r\n", - Send(Socket, Head), - Send(Socket, http_chunk:encode("<HTML><BODY>fo")), - Send(Socket, - http_chunk:encode("obar</BODY></HTML>")), - http_chunk:encode_last(); - "/once.html" -> - Head = "HTTP/1.1 200 ok\r\n" ++ - "Content-Length:32\r\n\r\n", - Send(Socket, Head), - Send(Socket, "<HTML><BODY>fo"), - test_server:sleep(1000), - Send(Socket, "ob"), - test_server:sleep(1000), - Send(Socket, "ar</BODY></HTML>"); - "/invalid_http.html" -> - "HTTP/1.1 301\r\nDate:Sun, 09 Dec 2007 13:04:18 GMT\r\n" ++ - "Transfer-Encoding:chunked\r\n\r\n"; - "/missing_reason_phrase.html" -> - "HTTP/1.1 200\r\n" ++ - "Content-Length: 32\r\n\r\n" - "<HTML><BODY>foobar</BODY></HTML>"; - "/missing_CR.html" -> - "HTTP/1.1 200 ok\n" ++ - "Content-Length:32\r\n\n" - "<HTML><BODY>foobar</BODY></HTML>"; - _ -> - DefaultResponse - end, - - tsp("handle_http_msg -> Msg: ~p", [Msg]), + Msg = handle_uri(Method,RelUri, Port, Headers, Socket, DefaultResponse), + case Msg of ok -> - %% Previously, this resulted in an {error, einval}. Now what? ok; close -> %% Nothing to send, just close - Close(Socket); + close(Socket); _ when is_list(Msg) orelse is_binary(Msg) -> - Send(Socket, Msg) + case Msg of + [] -> + ct:print("Empty Msg", []); + _ -> + ct:print("Response: ~p", [Msg]), + send(Socket, Msg) + end end, - tsp("handle_http_msg -> done"), NextRequest. +dummy_ssl_server_hang(Caller, Inet, SslOpt) -> + Pid = spawn(httpc_SUITE, dummy_ssl_server_hang_init, [Caller, Inet, SslOpt]), + receive + {port, Port} -> + {Pid, Port} + end. + +dummy_ssl_server_hang_init(Caller, Inet, SslOpt) -> + {ok, ListenSocket} = + ssl:listen(0, [binary, Inet, {packet, 0}, + {reuseaddr,true}, + {active, false}] ++ SslOpt), + {ok, {_,Port}} = ssl:sockname(ListenSocket), + Caller ! {port, Port}, + {ok, AcceptSocket} = ssl:transport_accept(ListenSocket), + dummy_ssl_server_hang_loop(AcceptSocket). + +dummy_ssl_server_hang_loop(_) -> + %% Do not do ssl:ssl_accept as we + %% want to time out the underlying gen_tcp:connect + receive + stop -> + ok + end. + ensure_host_header_with_port([]) -> false; ensure_host_header_with_port(["host: " ++ Host| _]) -> case string:tokens(Host, [$:]) of - [ActualHost, Port] -> - tsp("ensure_host_header_with_port -> " - "~n ActualHost: ~p" - "~n Port: ~p", [ActualHost, Port]), + [_ActualHost, _Port] -> true; _ -> false @@ -3489,15 +1356,15 @@ auth_header([_ | Tail]) -> handle_auth("Basic " ++ UserInfo, Challange, DefaultResponse) -> case string:tokens(base64:decode_to_string(UserInfo), ":") of ["alladin", "sesame"] = Auth -> - test_server:format("Auth: ~p~n", [Auth]), + ct:print("Auth: ~p~n", [Auth]), DefaultResponse; Other -> - test_server:format("UnAuth: ~p~n", [Other]), + ct:print("UnAuth: ~p~n", [Other]), Challange end. check_cookie([]) -> - tsf(no_cookie_header); + ct:fail(no_cookie_header); check_cookie(["cookie:" ++ _Value | _]) -> ok; check_cookie([_Head | Tail]) -> @@ -3510,86 +1377,532 @@ content_length(["content-length:" ++ Value | _]) -> content_length([_Head | Tail]) -> content_length(Tail). -%% ------------------------------------------------------------------------- - -simple_request_and_verify(Config, - Method, Request, HttpOpts, Opts, VerifyResult) - when (is_list(Config) andalso - is_atom(Method) andalso - is_list(HttpOpts) andalso - is_list(Opts) andalso - is_function(VerifyResult, 1)) -> - tsp("request_and_verify -> entry with" - "~n Method: ~p" - "~n Request: ~p" - "~n HttpOpts: ~p" - "~n Opts: ~p", [Method, Request, HttpOpts, Opts]), - case ?config(local_server, Config) of - ok -> - tsp("request_and_verify -> local-server running"), - Result = (catch httpc:request(Method, Request, HttpOpts, Opts)), - VerifyResult(Result); +handle_uri(_,"/just_close.html",_,_,_,_) -> + close; +handle_uri(_,"/no_content.html",_,_,_,_) -> + "HTTP/1.0 204 No Content\r\n\r\n"; + +handle_uri(_,"/no_headers.html",_,_,_,_) -> + "HTTP/1.0 200 OK\r\n\r\nTEST"; + +handle_uri("TRACE","/trace.html",_,_,_,_) -> + Body = "TRACE /trace.html simulate HTTP TRACE ", + "HTTP/1.1 200 OK\r\n" ++ "Content-Length:" ++ integer_to_list(length(Body)) ++ "\r\n\r\n" ++ Body; + +handle_uri(_,"/ensure_host_header_with_port.html",_,Headers,_,_) -> + case ensure_host_header_with_port(Headers) of + true -> + B = + "<HTML><BODY>" ++ + "host with port" ++ + "</BODY></HTML>", + Len = integer_to_list(length(B)), + "HTTP/1.1 200 ok\r\n" ++ + "Content-Length:" ++ Len ++ "\r\n\r\n" ++ B; + false -> + B = + "<HTML><BODY>" ++ + "Internal Server Error - host without port" ++ + "</BODY></HTML>", + Len = integer_to_list(length(B)), + "HTTP/1.1 500 Internal Server Error\r\n" ++ + "Content-Length:" ++ Len ++ "\r\n\r\n" ++ B + end; + +handle_uri(_,"/300.html",Port,_,Socket,_) -> + NewUri = url_start(Socket) ++ + integer_to_list(Port) ++ "/dummy.html", + Body = "<HTML><BODY><a href=" ++ NewUri ++ + ">New place</a></BODY></HTML>", + "HTTP/1.1 300 Multiple Choices\r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:" ++ integer_to_list(length(Body)) + ++ "\r\n\r\n" ++ Body; + +handle_uri("HEAD","/301.html",Port,_,Socket,_) -> + NewUri = url_start(Socket) ++ + integer_to_list(Port) ++ "/dummy.html", + "HTTP/1.1 301 Moved Permanently\r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:0\r\n\r\n"; + +handle_uri(_,"/301.html",Port,_,Socket,_) -> + NewUri = url_start(Socket) ++ + integer_to_list(Port) ++ "/dummy.html", + Body = "<HTML><BODY><a href=" ++ NewUri ++ + ">New place</a></BODY></HTML>", + "HTTP/1.1 301 Moved Permanently\r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:" ++ integer_to_list(length(Body)) + ++ "\r\n\r\n" ++ Body; + +handle_uri("HEAD","/302.html",Port,_,Socket,_) -> + NewUri = url_start(Socket) ++ + integer_to_list(Port) ++ "/dummy.html", + "HTTP/1.1 302 Found \r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:0\r\n\r\n"; + +handle_uri(_,"/302.html",Port, _,Socket,_) -> + NewUri = url_start(Socket) ++ + integer_to_list(Port) ++ "/dummy.html", + Body = "<HTML><BODY><a href=" ++ NewUri ++ + ">New place</a></BODY></HTML>", + "HTTP/1.1 302 Found \r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:" ++ integer_to_list(length(Body)) + ++ "\r\n\r\n" ++ Body; + +handle_uri("HEAD","/303.html",Port,_,Socket,_) -> + NewUri = url_start(Socket) ++ + integer_to_list(Port) ++ "/dummy.html", + "HTTP/1.1 302 See Other \r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:0\r\n\r\n"; +handle_uri(_,"/303.html",Port,_,Socket,_) -> + NewUri = url_start(Socket) ++ + integer_to_list(Port) ++ "/dummy.html", + Body = "<HTML><BODY><a href=" ++ NewUri ++ + ">New place</a></BODY></HTML>", + "HTTP/1.1 303 See Other \r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:" ++ integer_to_list(length(Body)) + ++ "\r\n\r\n" ++ Body; +handle_uri("HEAD","/307.html",Port,_,Socket,_) -> + NewUri = url_start(Socket) ++ + integer_to_list(Port) ++ "/dummy.html", + "HTTP/1.1 307 Temporary Rediect \r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:0\r\n\r\n"; +handle_uri(_,"/307.html",Port,_,Socket,_) -> + NewUri = url_start(Socket) ++ + integer_to_list(Port) ++ "/dummy.html", + Body = "<HTML><BODY><a href=" ++ NewUri ++ + ">New place</a></BODY></HTML>", + "HTTP/1.1 307 Temporary Rediect \r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:" ++ integer_to_list(length(Body)) + ++ "\r\n\r\n" ++ Body; + +handle_uri(_,"/500.html",_,_,_,_) -> + "HTTP/1.1 500 Internal Server Error\r\n" ++ + "Content-Length:47\r\n\r\n" ++ + "<HTML><BODY>Internal Server Error</BODY></HTML>"; + +handle_uri(_,"/503.html",_,_,_,DefaultResponse) -> + case ets:lookup(unavailable, 503) of + [{503, unavailable}] -> + ets:insert(unavailable, {503, available}), + "HTTP/1.1 503 Service Unavailable\r\n" ++ + "Retry-After:5\r\n" ++ + "Content-Length:47\r\n\r\n" ++ + "<HTML><BODY>Internal Server Error</BODY></HTML>"; + [{503, available}] -> + DefaultResponse; + [{503, long_unavailable}] -> + "HTTP/1.1 503 Service Unavailable\r\n" ++ + "Retry-After:120\r\n" ++ + "Content-Length:47\r\n\r\n" ++ + "<HTML><BODY>Internal Server Error</BODY></HTML>" + end; + +handle_uri(_,"/redirectloop.html",Port,_,Socket,_) -> + %% Create a potential endless loop! + NewUri = url_start(Socket) ++ + integer_to_list(Port) ++ "/redirectloop.html", + Body = "<HTML><BODY><a href=" ++ NewUri ++ + ">New place</a></BODY></HTML>", + "HTTP/1.1 300 Multiple Choices\r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:" ++ integer_to_list(length(Body)) + ++ "\r\n\r\n" ++ Body; + +handle_uri(_,"/userinfo.html", _,Headers,_, DefaultResponse) -> + Challange = "HTTP/1.1 401 Unauthorized \r\n" ++ + "WWW-Authenticate:Basic" ++"\r\n" ++ + "Content-Length:0\r\n\r\n", + case auth_header(Headers) of + {ok, Value} -> + handle_auth(Value, Challange, DefaultResponse); _ -> - tsp("request_and_verify -> local-server *not* running - skip"), - hard_skip("Local http-server not running") + Challange + end; + +handle_uri(_,"/dummy_headers.html",_,_,Socket,_) -> + %% The client will only care about the Transfer-Encoding + %% header the rest of these headers are left to the + %% user to evaluate. This is not a valid response + %% it only tests that the header handling code works. + Head = "HTTP/1.1 200 ok\r\n" ++ + "Content-Length:32\r\n" ++ + "Pragma:1#no-cache\r\n" ++ + "Via:1.0 fred, 1.1 nowhere.com (Apache/1.1)\r\n" ++ + "Warning:1#pseudonym foobar\r\n" ++ + "Vary:*\r\n" ++ + "Trailer:Other:inets_test\r\n" ++ + "Upgrade:HTTP/2.0\r\n" ++ + "Age:4711\r\n" ++ + "Transfer-Encoding:chunked\r\n" ++ + "Content-Encoding:foo\r\n" ++ + "Content-Language:en\r\n" ++ + "Content-Location:http://www.foobar.se\r\n" ++ + "Content-MD5:104528739076276072743283077410617235478\r\n" + ++ + "Content-Range:Sat, 29 Oct 1994 19:43:31 GMT\r\n" ++ + "Expires:Sat, 29 Oct 1994 19:43:31 GMT\r\n" ++ + "Proxy-Authenticate:#1Basic" ++ + "\r\n\r\n", + send(Socket, Head), + send(Socket, http_chunk:encode("<HTML><BODY>fo")), + send(Socket, http_chunk:encode("obar</BODY></HTML>")), + http_chunk:encode_last(); + +handle_uri(_,"/capital_transfer_encoding.html",_,_,Socket,_) -> + Head = "HTTP/1.1 200 ok\r\n" ++ + "Transfer-Encoding:Chunked\r\n\r\n", + send(Socket, Head), + send(Socket, http_chunk:encode("<HTML><BODY>fo")), + send(Socket, http_chunk:encode("obar</BODY></HTML>")), + http_chunk:encode_last(); + +handle_uri(_,"/cookie.html",_,_,_,_) -> + "HTTP/1.1 200 ok\r\n" ++ + "set-cookie:" ++ "test_cookie=true; path=/;" ++ + "max-age=60000\r\n" ++ + "Content-Length:32\r\n\r\n"++ + "<HTML><BODY>foobar</BODY></HTML>"; + +handle_uri(_,"/missing_crlf.html",_,_,_,_) -> + "HTTP/1.1 200 ok" ++ + "Content-Length:32\r\n" ++ + "<HTML><BODY>foobar</BODY></HTML>"; + +handle_uri(_,"/wrong_statusline.html",_,_,_,_) -> + "ok 200 HTTP/1.1\r\n\r\n" ++ + "Content-Length:32\r\n\r\n" ++ + "<HTML><BODY>foobar</BODY></HTML>"; + +handle_uri(_,"/once_chunked.html",_,_,Socket,_) -> + Head = "HTTP/1.1 200 ok\r\n" ++ + "Transfer-Encoding:Chunked\r\n\r\n", + send(Socket, Head), + send(Socket, http_chunk:encode("<HTML><BODY>fo")), + send(Socket, + http_chunk:encode("obar</BODY></HTML>")), + http_chunk:encode_last(); + +handle_uri(_,"/once.html",_,_,Socket,_) -> + Head = "HTTP/1.1 200 ok\r\n" ++ + "Content-Length:32\r\n\r\n", + send(Socket, Head), + send(Socket, "<HTML><BODY>fo"), + test_server:sleep(1000), + send(Socket, "ob"), + test_server:sleep(1000), + send(Socket, "ar</BODY></HTML>"); + +handle_uri(_,"/invalid_http.html",_,_,_,_) -> + "HTTP/1.1 301\r\nDate:Sun, 09 Dec 2007 13:04:18 GMT\r\n" ++ + "Transfer-Encoding:chunked\r\n\r\n"; + +handle_uri(_,"/missing_reason_phrase.html",_,_,_,_) -> + "HTTP/1.1 200\r\n" ++ + "Content-Length: 32\r\n\r\n" + "<HTML><BODY>foobar</BODY></HTML>"; + +handle_uri(_,"/missing_CR.html",_,_,_,_) -> + "HTTP/1.1 200 ok\n" ++ + "Content-Length:32\r\n\n" ++ + "<HTML><BODY>foobar</BODY></HTML>"; + +handle_uri("HEAD",_,_,_,_,_) -> + "HTTP/1.1 200 ok\r\n" ++ + "Content-Length:0\r\n\r\n"; +handle_uri(_,_,_,_,_,DefaultResponse) -> + DefaultResponse. + +url_start(#sslsocket{}) -> + {ok,Host} = inet:gethostname(), + ?TLS_URL_START ++ Host ++ ":"; +url_start(_) -> + {ok,Host} = inet:gethostname(), + ?URL_START ++ Host ++ ":". + +send(#sslsocket{} = S, Msg) -> + ssl:send(S, Msg); +send(S, Msg) -> + gen_tcp:send(S, Msg). + +close(#sslsocket{} = S) -> + ssl:close(S); +close(S) -> + gen_tcp:close(S). + +sockname(#sslsocket{}= S) -> + ssl:sockname(S); +sockname(S) -> + inet:sockname(S). + +receive_streamed_body(RequestId, Body) -> + receive + {http, {RequestId, stream, BinBodyPart}} -> + receive_streamed_body(RequestId, + <<Body/binary, BinBodyPart/binary>>); + {http, {RequestId, stream_end, _Headers}} -> + Body; + {http, Msg} -> + ct:fail(Msg) end. +receive_streamed_body(RequestId, Body, Pid) -> + httpc:stream_next(Pid), + ct:print("~p:receive_streamed_body -> requested next stream ~n", [?MODULE]), + receive + {http, {RequestId, stream, BinBodyPart}} -> + receive_streamed_body(RequestId, + <<Body/binary, BinBodyPart/binary>>, + Pid); + {http, {RequestId, stream_end, _Headers}} -> + Body; + {http, Msg} -> + ct:fail(Msg) + end. +%% ----------------------------------------------------- +%% A sequence number handler +%% The purpose is to be able to pair requests with responses. +start_sequence_number_server() -> + proc_lib:spawn(fun() -> loop_sequence_number(1) end). -not_implemented_yet() -> - exit(not_implemented_yet). +loop_sequence_number(N) -> + receive + shutdown -> + ok; + {From, get_next} -> + From ! {next_is, N}, + loop_sequence_number(N + 1) + end. -p(F) -> - p(F, []). +get_next_sequence_number(SeqNumServer) -> + SeqNumServer ! {self(), get_next}, + receive {next_is, N} -> N end. -p(F, A) -> - io:format("~p ~w:" ++ F ++ "~n", [self(), ?MODULE | A]). +%% ----------------------------------------------------- +%% Client part +%% Sends requests randomly parallel -tsp(F) -> - inets_test_lib:tsp("[~w]" ++ F, [?MODULE]). -tsp(F, A) -> - inets_test_lib:tsp("[~w]" ++ F, [?MODULE|A]). +run_clients(NumClients, ServerPort, SeqNumServer) -> + {ok,Host} = inet:gethostname(), + set_random_seed(), + lists:map( + fun(Id) -> + Req = lists:flatten(io_lib:format("req~3..0w", [get_next_sequence_number(SeqNumServer)])), + Url = ?URL_START ++ Host ++ ":" ++ integer_to_list(ServerPort) ++ "/" ++ Req, + Pid = proc_lib:spawn( + fun() -> + case httpc:request(Url) of + {ok, {{_,200,_}, _, Resp}} -> + ct:print("[~w] 200 response: " + "~p~n", [Id, Resp]), + case lists:prefix(Req++"->", Resp) of + true -> exit(normal); + false -> exit({bad_resp,Req,Resp}) + end; + {ok, {{_,EC,Reason},_,Resp}} -> + ct:print("[~w] ~w response: " + "~s~n~s~n", + [Id, EC, Reason, Resp]), + exit({bad_resp,Req,Resp}); + Crap -> + ct:print("[~w] bad response: ~p", + [Id, Crap]), + exit({bad_resp, Req, Crap}) + end + end), + MRef = erlang:monitor(process, Pid), + timer:sleep(10 + random:uniform(1334)), + {Id, Pid, MRef} + end, + lists:seq(1, NumClients)). -tsf(Reason) -> - test_server:fail(Reason). +wait4clients([], _Timeout) -> + ok; +wait4clients(Clients, Timeout) when Timeout > 0 -> + Time = now_ms(), + receive + {'DOWN', _MRef, process, Pid, normal} -> + {value, {Id, _, _}} = lists:keysearch(Pid, 2, Clients), + NewClients = lists:keydelete(Id, 1, Clients), + wait4clients(NewClients, Timeout - (now_ms() - Time)); + {'DOWN', _MRef, process, Pid, Reason} -> + {value, {Id, _, _}} = lists:keysearch(Pid, 2, Clients), + ct:fail({bad_client_termination, Id, Reason}) + after Timeout -> + ct:fail({client_timeout, Clients}) + end; +wait4clients(Clients, _) -> + ct:fail({client_timeout, Clients}). -dummy_ssl_server_hang(Caller, IpV, SslOpt) -> - Pid = spawn(httpc_SUITE, dummy_ssl_server_hang_init, [Caller, IpV, SslOpt]), +%% ----------------------------------------------------- +%% Webserver part: +%% Implements a web server that sends responses one character +%% at a time, with random delays between the characters. + +start_slow_server(SeqNumServer) -> + proc_lib:start( + erlang, apply, [fun() -> init_slow_server(SeqNumServer) end, []]). + +init_slow_server(SeqNumServer) -> + Inet = inet_version(), + {ok, LSock} = gen_tcp:listen(0, [binary, Inet, {packet,0}, {active,true}, + {backlog, 100}]), + {ok, {_IP, Port}} = inet:sockname(LSock), + proc_lib:init_ack({ok, self(), Port}), + loop_slow_server(LSock, SeqNumServer). + +loop_slow_server(LSock, SeqNumServer) -> + Master = self(), + Acceptor = proc_lib:spawn( + fun() -> client_handler(Master, LSock, SeqNumServer) end), receive - {port, Port} -> - {Pid, Port} + {accepted, Acceptor} -> + loop_slow_server(LSock, SeqNumServer); + shutdown -> + gen_tcp:close(LSock), + exit(Acceptor, kill) end. -dummy_ssl_server_hang_init(Caller, IpV, SslOpt) -> - {ok, ListenSocket} = - case IpV of - ipv4 -> - ssl:listen(0, [binary, inet, {packet, 0}, - {reuseaddr,true}, - {active, false}] ++ SslOpt); - ipv6 -> - ssl:listen(0, [binary, inet6, {packet, 0}, - {reuseaddr,true}, - {active, false}] ++ SslOpt) - end, - {ok, {_,Port}} = ssl:sockname(ListenSocket), - tsp("dummy_ssl_server_hang_init -> Port: ~p", [Port]), - Caller ! {port, Port}, - {ok, AcceptSocket} = ssl:transport_accept(ListenSocket), - dummy_ssl_server_hang_loop(AcceptSocket). -dummy_ssl_server_hang_loop(_) -> - %% Do not do ssl:ssl_accept as we - %% want to time out the underlying gen_tcp:connect +%% Handle one client connection +client_handler(Master, LSock, SeqNumServer) -> + {ok, CSock} = gen_tcp:accept(LSock), + Master ! {accepted, self()}, + set_random_seed(), + loop_client(1, CSock, SeqNumServer). + +loop_client(N, CSock, SeqNumServer) -> + %% Await request, don't bother parsing it too much, + %% assuming the entire request arrives in one packet. receive - stop -> - ok + {tcp, CSock, Req} -> + ReqNum = parse_req_num(Req), + RespSeqNum = get_next_sequence_number(SeqNumServer), + Response = lists:flatten(io_lib:format("~s->resp~3..0w/~2..0w", [ReqNum, RespSeqNum, N])), + Txt = lists:flatten(io_lib:format("Slow server (~p) got ~p, answering with ~p", + [self(), Req, Response])), + ct:print("~s...~n", [Txt]), + slowly_send_response(CSock, Response), + case parse_connection_type(Req) of + keep_alive -> + ct:print("~s...done~n", [Txt]), + loop_client(N+1, CSock, SeqNumServer); + close -> + ct:print("~s...done (closing)~n", [Txt]), + gen_tcp:close(CSock) + end end. -hard_skip(Reason) -> - throw(skip(Reason)). +slowly_send_response(CSock, Answer) -> + Response = lists:flatten(io_lib:format("HTTP/1.1 200 OK\r\nContent-Length: ~w\r\n\r\n~s", + [length(Answer), Answer])), + lists:foreach( + fun(Char) -> + timer:sleep(random:uniform(500)), + gen_tcp:send(CSock, <<Char>>) + end, + Response). -skip(Reason) -> - {skip, Reason}. +parse_req_num(Request) -> + Opts = [caseless,{capture,all_but_first,list}], + {match, [ReqNum]} = re:run(Request, "GET /(.*) HTTP", Opts), + ReqNum. + +parse_connection_type(Request) -> + Opts = [caseless,{capture,all_but_first,list}], + {match,[CType]} = re:run(Request, "connection: *(keep-alive|close)", Opts), + case string:to_lower(CType) of + "close" -> close; + "keep-alive" -> keep_alive + end. + +%% Time in milli seconds +now_ms() -> + {A,B,C} = erlang:now(), + A*1000000000+B*1000+(C div 1000). + +set_random_seed() -> + {_, _, Micros} = now(), + A = erlang:phash2([make_ref(), self(), Micros]), + random:seed(A, A, A). + + +otp_8739(doc) -> + ["OTP-8739"]; +otp_8739(suite) -> + []; +otp_8739(Config) when is_list(Config) -> + {_DummyServerPid, Port} = otp_8739_dummy_server(), + {ok,Host} = inet:gethostname(), + URL = ?URL_START ++ Host ++ ":" ++ integer_to_list(Port) ++ "/dummy.html", + Method = get, + Request = {URL, []}, + HttpOptions = [{connect_timeout, 500}, {timeout, 1}], + Options = [{sync, true}], + case httpc:request(Method, Request, HttpOptions, Options) of + {error, timeout} -> + %% And now we check the size of the handler db + Info = httpc:info(), + ct:print("Info: ~p", [Info]), + {value, {handlers, Handlers}} = + lists:keysearch(handlers, 1, Info), + case Handlers of + [] -> + ok; + _ -> + ct:fail({unexpected_handlers, Handlers}) + end; + Unexpected -> + ct:fail({unexpected, Unexpected}) + end. + +otp_8739_dummy_server() -> + Parent = self(), + Pid = spawn_link(fun() -> otp_8739_dummy_server_init(Parent) end), + receive + {port, Port} -> + {Pid, Port} + end. + +otp_8739_dummy_server_init(Parent) -> + Inet = inet_version(), + {ok, ListenSocket} = + gen_tcp:listen(0, [binary, Inet, {packet, 0}, + {reuseaddr,true}, + {active, false}]), + {ok, Port} = inet:port(ListenSocket), + Parent ! {port, Port}, + otp_8739_dummy_server_main(Parent, ListenSocket). + +otp_8739_dummy_server_main(_Parent, ListenSocket) -> + case gen_tcp:accept(ListenSocket) of + {ok, Sock} -> + %% Ignore the request, and simply wait for the socket to close + receive + {tcp_closed, Sock} -> + (catch gen_tcp:close(ListenSocket)), + exit(normal); + {tcp_error, Sock, Reason} -> + ct:fail("socket error: ~p", [Reason]), + (catch gen_tcp:close(ListenSocket)), + exit(normal) + after 10000 -> + %% Just in case + (catch gen_tcp:close(Sock)), + (catch gen_tcp:close(ListenSocket)), + exit(timeout) + end; + Error -> + exit(Error) + end. diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index 592469a12f..1efa78a63e 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2012. All Rights Reserved. +%% Copyright Ericsson AB 2005-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -67,97 +67,36 @@ ]). -export([ - pssl_mod_alias/1, essl_mod_alias/1, - - pssl_mod_actions/1, essl_mod_actions/1, - - pssl_mod_security/1, essl_mod_security/1, - - pssl_mod_auth/1, essl_mod_auth/1, - - pssl_mod_auth_api/1, essl_mod_auth_api/1, - - pssl_mod_auth_mnesia_api/1, essl_mod_auth_mnesia_api/1, - - pssl_mod_htaccess/1, essl_mod_htaccess/1, - - pssl_mod_cgi/1, essl_mod_cgi/1, - - pssl_mod_esi/1, essl_mod_esi/1, - - pssl_mod_get/1, essl_mod_get/1, - - pssl_mod_head/1, essl_mod_head/1, - - pssl_mod_all/1, essl_mod_all/1, - - pssl_load_light/1, essl_load_light/1, - - pssl_load_medium/1, essl_load_medium/1, - - pssl_load_heavy/1, essl_load_heavy/1, - - pssl_dos_hostname/1, essl_dos_hostname/1, - - pssl_time_test/1, essl_time_test/1, - - pssl_restart_no_block/1, essl_restart_no_block/1, - - pssl_restart_disturbing_block/1, essl_restart_disturbing_block/1, - - pssl_restart_non_disturbing_block/1, essl_restart_non_disturbing_block/1, - - pssl_block_disturbing_idle/1, essl_block_disturbing_idle/1, - - pssl_block_non_disturbing_idle/1, essl_block_non_disturbing_idle/1, - - pssl_block_503/1, essl_block_503/1, - - pssl_block_disturbing_active/1, essl_block_disturbing_active/1, - - pssl_block_non_disturbing_active/1, essl_block_non_disturbing_active/1, - - pssl_block_disturbing_active_timeout_not_released/1, essl_block_disturbing_active_timeout_not_released/1, - - pssl_block_disturbing_active_timeout_released/1, essl_block_disturbing_active_timeout_released/1, - - pssl_block_non_disturbing_active_timeout_not_released/1, essl_block_non_disturbing_active_timeout_not_released/1, - - pssl_block_non_disturbing_active_timeout_released/1, essl_block_non_disturbing_active_timeout_released/1, - - pssl_block_disturbing_blocker_dies/1, essl_block_disturbing_blocker_dies/1, - - pssl_block_non_disturbing_blocker_dies/1, essl_block_non_disturbing_blocker_dies/1 ]). @@ -242,26 +181,7 @@ groups() -> ip_block_non_disturbing_active_timeout_released, ip_block_disturbing_blocker_dies, ip_block_non_disturbing_blocker_dies]}, - {ssl, [], [{group, pssl}, {group, essl}]}, - {pssl, [], - [pssl_mod_alias, pssl_mod_actions, pssl_mod_security, - pssl_mod_auth, pssl_mod_auth_api, - pssl_mod_auth_mnesia_api, pssl_mod_htaccess, - pssl_mod_cgi, pssl_mod_esi, pssl_mod_get, pssl_mod_head, - pssl_mod_all, pssl_load_light, pssl_load_medium, - pssl_load_heavy, pssl_dos_hostname, pssl_time_test, - pssl_restart_no_block, pssl_restart_disturbing_block, - pssl_restart_non_disturbing_block, - pssl_block_disturbing_idle, - pssl_block_non_disturbing_idle, pssl_block_503, - pssl_block_disturbing_active, - pssl_block_non_disturbing_active, - pssl_block_disturbing_active_timeout_not_released, - pssl_block_disturbing_active_timeout_released, - pssl_block_non_disturbing_active_timeout_not_released, - pssl_block_non_disturbing_active_timeout_released, - pssl_block_disturbing_blocker_dies, - pssl_block_non_disturbing_blocker_dies]}, + {ssl, [], [{group, essl}]}, {essl, [], [essl_mod_alias, essl_mod_actions, essl_mod_security, essl_mod_auth, essl_mod_auth_api, @@ -375,8 +295,8 @@ init_per_testcase(Case, Config) -> init_per_testcase2(Case, Config) -> - tsp("init_per_testcase2 -> entry with" - "~n Config: ~p", [Config]), + %% tsp("init_per_testcase2 -> entry with" + %% "~n Config: ~p", [Config]), IpNormal = integer_to_list(?IP_PORT) ++ ".conf", IpHtaccess = integer_to_list(?IP_PORT) ++ "htaccess.conf", @@ -386,33 +306,33 @@ init_per_testcase2(Case, Config) -> DataDir = ?config(data_dir, Config), SuiteTopDir = ?config(suite_top_dir, Config), - tsp("init_per_testcase2 -> " - "~n SuiteDir: ~p" - "~n DataDir: ~p", [SuiteTopDir, DataDir]), + %% tsp("init_per_testcase2 -> " + %% "~n SuiteDir: ~p" + %% "~n DataDir: ~p", [SuiteTopDir, DataDir]), TcTopDir = filename:join(SuiteTopDir, Case), ?line ok = file:make_dir(TcTopDir), - tsp("init_per_testcase2 -> " - "~n TcTopDir: ~p", [TcTopDir]), + %% tsp("init_per_testcase2 -> " + %% "~n TcTopDir: ~p", [TcTopDir]), DataSrc = filename:join([DataDir, "server_root"]), ServerRoot = filename:join([TcTopDir, "server_root"]), - tsp("init_per_testcase2 -> " - "~n DataSrc: ~p" - "~n ServerRoot: ~p", [DataSrc, ServerRoot]), + %% tsp("init_per_testcase2 -> " + %% "~n DataSrc: ~p" + %% "~n ServerRoot: ~p", [DataSrc, ServerRoot]), ok = file:make_dir(ServerRoot), ok = file:make_dir(filename:join([TcTopDir, "logs"])), NewConfig = [{tc_top_dir, TcTopDir}, {server_root, ServerRoot} | Config], - tsp("init_per_testcase2 -> copy DataSrc to ServerRoot"), + %% tsp("init_per_testcase2 -> copy DataSrc to ServerRoot"), inets_test_lib:copy_dirs(DataSrc, ServerRoot), - tsp("init_per_testcase2 -> fix cgi"), + %% tsp("init_per_testcase2 -> fix cgi"), EnvCGI = filename:join([ServerRoot, "cgi-bin", "printenv.sh"]), {ok, FileInfo} = file:read_file_info(EnvCGI), ok = file:write_file_info(EnvCGI, @@ -432,14 +352,14 @@ init_per_testcase2(Case, Config) -> FileInfo1#file_info{mode = 8#00755}), %% To be used by IP test cases - tsp("init_per_testcase2 -> ip testcase setups"), + %% tsp("init_per_testcase2 -> ip testcase setups"), create_config([{port, ?IP_PORT}, {sock_type, ip_comm} | NewConfig], normal_access, IpNormal), create_config([{port, ?IP_PORT}, {sock_type, ip_comm} | NewConfig], mod_htaccess, IpHtaccess), %% To be used by SSL test cases - tsp("init_per_testcase2 -> ssl testcase setups"), + %% tsp("init_per_testcase2 -> ssl testcase setups"), SocketType = case atom_to_list(Case) of [X, $s, $s, $l | _] -> @@ -504,8 +424,8 @@ init_per_testcase2(Case, Config) -> NewConfig end, - tsp("init_per_testcase2 -> done when" - "~n NewConfig2: ~p", [NewConfig2]), + %% tsp("init_per_testcase2 -> done when" + %% "~n NewConfig2: ~p", [NewConfig2]), NewConfig2. @@ -537,6 +457,7 @@ init_per_testcase3(Case, Config) -> Dog = test_server:timetrap(inets_test_lib:minutes(10)), NewConfig = lists:keydelete(watchdog, 1, Config), TcTopDir = ?config(tc_top_dir, Config), + CaseRest = case atom_to_list(Case) of "ip_mod_htaccess" -> @@ -1069,13 +990,6 @@ ip_restart_non_disturbing_block(Config) when is_list(Config) -> %%------------------------------------------------------------------------- -pssl_mod_alias(doc) -> - ["Module test: mod_alias - old SSL config"]; -pssl_mod_alias(suite) -> - []; -pssl_mod_alias(Config) when is_list(Config) -> - ssl_mod_alias(ssl, Config). - essl_mod_alias(doc) -> ["Module test: mod_alias - using new of configure new SSL"]; essl_mod_alias(suite) -> @@ -1092,13 +1006,6 @@ ssl_mod_alias(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_mod_actions(doc) -> - ["Module test: mod_actions - old SSL config"]; -pssl_mod_actions(suite) -> - []; -pssl_mod_actions(Config) when is_list(Config) -> - ssl_mod_actions(ssl, Config). - essl_mod_actions(doc) -> ["Module test: mod_actions - using new of configure new SSL"]; essl_mod_actions(suite) -> @@ -1117,13 +1024,6 @@ ssl_mod_actions(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_mod_security(doc) -> - ["Module test: mod_security - old SSL config"]; -pssl_mod_security(suite) -> - []; -pssl_mod_security(Config) when is_list(Config) -> - ssl_mod_security(ssl, Config). - essl_mod_security(doc) -> ["Module test: mod_security - using new of configure new SSL"]; essl_mod_security(suite) -> @@ -1143,13 +1043,6 @@ ssl_mod_security(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_mod_auth(doc) -> - ["Module test: mod_auth - old SSL config"]; -pssl_mod_auth(suite) -> - []; -pssl_mod_auth(Config) when is_list(Config) -> - ssl_mod_auth(ssl, Config). - essl_mod_auth(doc) -> ["Module test: mod_auth - using new of configure new SSL"]; essl_mod_auth(suite) -> @@ -1167,12 +1060,6 @@ ssl_mod_auth(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_mod_auth_api(doc) -> - ["Module test: mod_auth - old SSL config"]; -pssl_mod_auth_api(suite) -> - []; -pssl_mod_auth_api(Config) when is_list(Config) -> - ssl_mod_auth_api(ssl, Config). essl_mod_auth_api(doc) -> ["Module test: mod_auth - using new of configure new SSL"]; @@ -1193,12 +1080,6 @@ ssl_mod_auth_api(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_mod_auth_mnesia_api(doc) -> - ["Module test: mod_auth_mnesia_api - old SSL config"]; -pssl_mod_auth_mnesia_api(suite) -> - []; -pssl_mod_auth_mnesia_api(Config) when is_list(Config) -> - ssl_mod_auth_mnesia_api(ssl, Config). essl_mod_auth_mnesia_api(doc) -> ["Module test: mod_auth_mnesia_api - using new of configure new SSL"]; @@ -1217,13 +1098,6 @@ ssl_mod_auth_mnesia_api(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_mod_htaccess(doc) -> - ["Module test: mod_htaccess - old SSL config"]; -pssl_mod_htaccess(suite) -> - []; -pssl_mod_htaccess(Config) when is_list(Config) -> - ssl_mod_htaccess(ssl, Config). - essl_mod_htaccess(doc) -> ["Module test: mod_htaccess - using new of configure new SSL"]; essl_mod_htaccess(suite) -> @@ -1241,13 +1115,6 @@ ssl_mod_htaccess(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_mod_cgi(doc) -> - ["Module test: mod_cgi - old SSL config"]; -pssl_mod_cgi(suite) -> - []; -pssl_mod_cgi(Config) when is_list(Config) -> - ssl_mod_cgi(ssl, Config). - essl_mod_cgi(doc) -> ["Module test: mod_cgi - using new of configure new SSL"]; essl_mod_cgi(suite) -> @@ -1265,13 +1132,6 @@ ssl_mod_cgi(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_mod_esi(doc) -> - ["Module test: mod_esi - old SSL config"]; -pssl_mod_esi(suite) -> - []; -pssl_mod_esi(Config) when is_list(Config) -> - ssl_mod_esi(ssl, Config). - essl_mod_esi(doc) -> ["Module test: mod_esi - using new of configure new SSL"]; essl_mod_esi(suite) -> @@ -1289,13 +1149,6 @@ ssl_mod_esi(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_mod_get(doc) -> - ["Module test: mod_get - old SSL config"]; -pssl_mod_get(suite) -> - []; -pssl_mod_get(Config) when is_list(Config) -> - ssl_mod_get(ssl, Config). - essl_mod_get(doc) -> ["Module test: mod_get - using new of configure new SSL"]; essl_mod_get(suite) -> @@ -1313,13 +1166,6 @@ ssl_mod_get(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_mod_head(doc) -> - ["Module test: mod_head - old SSL config"]; -pssl_mod_head(suite) -> - []; -pssl_mod_head(Config) when is_list(Config) -> - ssl_mod_head(ssl, Config). - essl_mod_head(doc) -> ["Module test: mod_head - using new of configure new SSL"]; essl_mod_head(suite) -> @@ -1337,13 +1183,6 @@ ssl_mod_head(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_mod_all(doc) -> - ["All modules test - old SSL config"]; -pssl_mod_all(suite) -> - []; -pssl_mod_all(Config) when is_list(Config) -> - ssl_mod_all(ssl, Config). - essl_mod_all(doc) -> ["All modules test - using new of configure new SSL"]; essl_mod_all(suite) -> @@ -1361,13 +1200,6 @@ ssl_mod_all(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_load_light(doc) -> - ["Test light load - old SSL config"]; -pssl_load_light(suite) -> - []; -pssl_load_light(Config) when is_list(Config) -> - ssl_load_light(ssl, Config). - essl_load_light(doc) -> ["Test light load - using new of configure new SSL"]; essl_load_light(suite) -> @@ -1386,13 +1218,6 @@ ssl_load_light(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_load_medium(doc) -> - ["Test medium load - old SSL config"]; -pssl_load_medium(suite) -> - []; -pssl_load_medium(Config) when is_list(Config) -> - ssl_load_medium(ssl, Config). - essl_load_medium(doc) -> ["Test medium load - using new of configure new SSL"]; essl_load_medium(suite) -> @@ -1417,13 +1242,6 @@ ssl_load_medium(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_load_heavy(doc) -> - ["Test heavy load - old SSL config"]; -pssl_load_heavy(suite) -> - []; -pssl_load_heavy(Config) when is_list(Config) -> - ssl_load_heavy(ssl, Config). - essl_load_heavy(doc) -> ["Test heavy load - using new of configure new SSL"]; essl_load_heavy(suite) -> @@ -1448,12 +1266,6 @@ ssl_load_heavy(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_dos_hostname(doc) -> - ["Denial Of Service (DOS) attack test case - old SSL config"]; -pssl_dos_hostname(suite) -> - []; -pssl_dos_hostname(Config) when is_list(Config) -> - ssl_dos_hostname(ssl, Config). essl_dos_hostname(doc) -> ["Denial Of Service (DOS) attack test case - using new of configure new SSL"]; @@ -1473,12 +1285,6 @@ ssl_dos_hostname(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_time_test(doc) -> - ["old SSL config"]; -pssl_time_test(suite) -> - []; -pssl_time_test(Config) when is_list(Config) -> - ssl_time_test(ssl, Config). essl_time_test(doc) -> ["using new of configure new SSL"]; @@ -1511,13 +1317,6 @@ ssl_time_test(Tag, Config) when is_list(Config) -> %%------------------------------------------------------------------------- -pssl_block_503(doc) -> - ["Check that you will receive status code 503 when the server" - " is blocked and 200 when its not blocked - old SSL config."]; -pssl_block_503(suite) -> - []; -pssl_block_503(Config) when is_list(Config) -> - ssl_block_503(ssl, Config). essl_block_503(doc) -> ["Check that you will receive status code 503 when the server" @@ -1537,15 +1336,6 @@ ssl_block_503(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_block_disturbing_idle(doc) -> - ["Check that you can block/unblock an idle server. The strategy " - "distribing does not really make a difference in this case." - "Old SSL config"]; -pssl_block_disturbing_idle(suite) -> - []; -pssl_block_disturbing_idle(Config) when is_list(Config) -> - ssl_block_disturbing_idle(ssl, Config). - essl_block_disturbing_idle(doc) -> ["Check that you can block/unblock an idle server. The strategy " "distribing does not really make a difference in this case." @@ -1565,15 +1355,6 @@ ssl_block_disturbing_idle(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_block_non_disturbing_idle(doc) -> - ["Check that you can block/unblock an idle server. The strategy " - "non distribing does not really make a difference in this case." - "Old SSL config"]; -pssl_block_non_disturbing_idle(suite) -> - []; -pssl_block_non_disturbing_idle(Config) when is_list(Config) -> - ssl_block_non_disturbing_idle(ssl, Config). - essl_block_non_disturbing_idle(doc) -> ["Check that you can block/unblock an idle server. The strategy " "non distribing does not really make a difference in this case." @@ -1593,15 +1374,6 @@ ssl_block_non_disturbing_idle(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_block_disturbing_active(doc) -> - ["Check that you can block/unblock an active server. The strategy " - "distribing means ongoing requests should be terminated." - "Old SSL config"]; -pssl_block_disturbing_active(suite) -> - []; -pssl_block_disturbing_active(Config) when is_list(Config) -> - ssl_block_disturbing_active(ssl, Config). - essl_block_disturbing_active(doc) -> ["Check that you can block/unblock an active server. The strategy " "distribing means ongoing requests should be terminated." @@ -1621,15 +1393,6 @@ ssl_block_disturbing_active(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_block_non_disturbing_active(doc) -> - ["Check that you can block/unblock an idle server. The strategy " - "non distribing means the ongoing requests should be compleated." - "Old SSL config"]; -pssl_block_non_disturbing_active(suite) -> - []; -pssl_block_non_disturbing_active(Config) when is_list(Config) -> - ssl_block_non_disturbing_active(ssl, Config). - essl_block_non_disturbing_active(doc) -> ["Check that you can block/unblock an idle server. The strategy " "non distribing means the ongoing requests should be compleated." @@ -1649,17 +1412,6 @@ ssl_block_non_disturbing_active(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_block_disturbing_active_timeout_not_released(doc) -> - ["Check that you can block an active server. The strategy " - "distribing means ongoing requests should be compleated" - "if the timeout does not occur." - "Old SSL config"]; -pssl_block_disturbing_active_timeout_not_released(suite) -> - []; -pssl_block_disturbing_active_timeout_not_released(Config) - when is_list(Config) -> - ssl_block_disturbing_active_timeout_not_released(ssl, Config). - essl_block_disturbing_active_timeout_not_released(doc) -> ["Check that you can block an active server. The strategy " "distribing means ongoing requests should be compleated" @@ -1682,17 +1434,6 @@ ssl_block_disturbing_active_timeout_not_released(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_block_disturbing_active_timeout_released(doc) -> - ["Check that you can block an active server. The strategy " - "distribing means ongoing requests should be terminated when" - "the timeout occurs." - "Old SSL config"]; -pssl_block_disturbing_active_timeout_released(suite) -> - []; -pssl_block_disturbing_active_timeout_released(Config) - when is_list(Config) -> - ssl_block_disturbing_active_timeout_released(ssl, Config). - essl_block_disturbing_active_timeout_released(doc) -> ["Check that you can block an active server. The strategy " "distribing means ongoing requests should be terminated when" @@ -1717,16 +1458,6 @@ ssl_block_disturbing_active_timeout_released(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_block_non_disturbing_active_timeout_not_released(doc) -> - ["Check that you can block an active server. The strategy " - "non non distribing means ongoing requests should be completed." - "Old SSL config"]; -pssl_block_non_disturbing_active_timeout_not_released(suite) -> - []; -pssl_block_non_disturbing_active_timeout_not_released(Config) - when is_list(Config) -> - ssl_block_non_disturbing_active_timeout_not_released(ssl, Config). - essl_block_non_disturbing_active_timeout_not_released(doc) -> ["Check that you can block an active server. The strategy " "non non distribing means ongoing requests should be completed." @@ -1750,16 +1481,6 @@ ssl_block_non_disturbing_active_timeout_not_released(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_block_non_disturbing_active_timeout_released(doc) -> - ["Check that you can block an active server. The strategy " - "non distribing means ongoing requests should be completed. " - "When the timeout occurs the block operation sohould be canceled." - "Old SSL config"]; -pssl_block_non_disturbing_active_timeout_released(suite) -> - []; -pssl_block_non_disturbing_active_timeout_released(Config) - when is_list(Config) -> - ssl_block_non_disturbing_active_timeout_released(ssl, Config). essl_block_non_disturbing_active_timeout_released(doc) -> ["Check that you can block an active server. The strategy " @@ -1787,12 +1508,6 @@ ssl_block_non_disturbing_active_timeout_released(Tag, Config) %%------------------------------------------------------------------------- -pssl_block_disturbing_blocker_dies(doc) -> - ["old SSL config"]; -pssl_block_disturbing_blocker_dies(suite) -> - []; -pssl_block_disturbing_blocker_dies(Config) when is_list(Config) -> - ssl_block_disturbing_blocker_dies(ssl, Config). essl_block_disturbing_blocker_dies(doc) -> ["using new of configure new SSL"]; @@ -1811,13 +1526,6 @@ ssl_block_disturbing_blocker_dies(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_block_non_disturbing_blocker_dies(doc) -> - ["old SSL config"]; -pssl_block_non_disturbing_blocker_dies(suite) -> - []; -pssl_block_non_disturbing_blocker_dies(Config) when is_list(Config) -> - ssl_block_non_disturbing_blocker_dies(ssl, Config). - essl_block_non_disturbing_blocker_dies(doc) -> ["using new of configure new SSL"]; essl_block_non_disturbing_blocker_dies(suite) -> @@ -1835,12 +1543,6 @@ ssl_block_non_disturbing_blocker_dies(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_restart_no_block(doc) -> - ["old SSL config"]; -pssl_restart_no_block(suite) -> - []; -pssl_restart_no_block(Config) when is_list(Config) -> - ssl_restart_no_block(ssl, Config). essl_restart_no_block(doc) -> ["using new of configure new SSL"]; @@ -1859,12 +1561,6 @@ ssl_restart_no_block(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_restart_disturbing_block(doc) -> - ["old SSL config"]; -pssl_restart_disturbing_block(suite) -> - []; -pssl_restart_disturbing_block(Config) when is_list(Config) -> - ssl_restart_disturbing_block(ssl, Config). essl_restart_disturbing_block(doc) -> ["using new of configure new SSL"]; @@ -1916,12 +1612,6 @@ ssl_restart_disturbing_block(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_restart_non_disturbing_block(doc) -> - ["old SSL config"]; -pssl_restart_non_disturbing_block(suite) -> - []; -pssl_restart_non_disturbing_block(Config) when is_list(Config) -> - ssl_restart_non_disturbing_block(ssl, Config). essl_restart_non_disturbing_block(doc) -> ["using new of configure new SSL"]; @@ -2314,7 +2004,7 @@ create_config(Config, Access, FileName) -> "~n Type: ~p" "~n Port: ~p" "~n Host: ~p" - "~n", [ServerRoot, TcTopDir, Port, Type, Host]), + "~n", [ServerRoot, TcTopDir, Type, Port, Host]), SSL = if @@ -2752,3 +2442,4 @@ tsp(F, A) -> tsf(Reason) -> inets_test_lib:tsf(Reason). + diff --git a/lib/inets/test/httpd_mod.erl b/lib/inets/test/httpd_mod.erl index 387263ce58..df4ed6b179 100644 --- a/lib/inets/test/httpd_mod.erl +++ b/lib/inets/test/httpd_mod.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2012. All Rights Reserved. +%% Copyright Ericsson AB 2005-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -40,7 +40,6 @@ %%------------------------------------------------------------------------- alias(Type, Port, Host, Node) -> %% This is very crude, but... - tsp("alias -> Has IPv6 support: ~p", [inets_test_lib:has_ipv6_support()]), Opts = [], ok = httpd_test_lib:verify_request(Type, Host, Port, Opts, Node, "GET /pics/icon.sheet.gif " @@ -85,16 +84,7 @@ actions(Type, Port, Host, Node) -> %%------------------------------------------------------------------------- security(ServerRoot, Type, Port, Host, Node) -> - tsp("security -> " - "entry with" - "~n ServerRoot: ~p" - "~n Type: ~p" - "~n Port: ~p" - "~n Host: ~p" - "~n Node: ~p", [ServerRoot, Type, Port, Host, Node]), - - tsp("security -> " - "register - receive security events"), + global:register_name(mod_security_test, self()), % Receive events tsp("security -> " @@ -333,13 +323,7 @@ security(ServerRoot, Type, Port, Host, Node) -> %%------------------------------------------------------------------------- auth(Type, Port, Host, Node) -> - tsp("auth -> " - "entry with" - "~n Type: ~p" - "~n Port: ~p" - "~n Host: ~p" - "~n Node: ~p", [Type, Port, Host, Node]), - + %% Authentication required! ok = httpd_test_lib:verify_request(Type,Host,Port,Node, "GET /open/ HTTP/1.0\r\n\r\n", @@ -750,11 +734,6 @@ htaccess(Type, Port, Host, Node) -> {header, "WWW-Authenticate"}]). %%-------------------------------------------------------------------- cgi(Type, Port, Host, Node) -> -%% tsp("cgi -> entry with" -%% "~n Type: ~p" -%% "~n Port: ~p" -%% "~n Host: ~p" -%% "~n Node: ~p", []), {Script, Script2, Script3} = case test_server:os_type() of {win32, _} -> diff --git a/lib/inets/test/httpd_test_lib.erl b/lib/inets/test/httpd_test_lib.erl index 4b33350cf2..13584c50f6 100644 --- a/lib/inets/test/httpd_test_lib.erl +++ b/lib/inets/test/httpd_test_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2012. All Rights Reserved. +%% Copyright Ericsson AB 2001-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -91,7 +91,7 @@ verify_request(SocketType, Host, Port, Node, RequestStr, Options, TimeOut) when (is_integer(TimeOut) orelse (TimeOut =:= infinity)) -> verify_request(SocketType, Host, Port, [], Node, RequestStr, Options, TimeOut). -verify_request(SocketType, Host, Port, TranspOpts, Node, RequestStr, Options, TimeOut) -> +verify_request(SocketType, Host, Port, TranspOpts0, Node, RequestStr, Options, TimeOut) -> tsp("verify_request -> entry with" "~n SocketType: ~p" "~n Host: ~p" @@ -100,7 +100,17 @@ verify_request(SocketType, Host, Port, TranspOpts, Node, RequestStr, Options, Ti "~n Node: ~p" "~n Options: ~p" "~n TimeOut: ~p", - [SocketType, Host, Port, TranspOpts, Node, Options, TimeOut]), + [SocketType, Host, Port, TranspOpts0, Node, Options, TimeOut]), + + %% For now, until we modernize the httpd tests + TranspOpts = + case lists:member(inet6, TranspOpts0) of + true -> + TranspOpts0; + false -> + [inet | TranspOpts0] + end, + try inets_test_lib:connect_bin(SocketType, Host, Port, TranspOpts) of {ok, Socket} -> tsp("verify_request -> connected - now send message"), @@ -293,8 +303,7 @@ validate(RequestStr, #state{status_line = {Version, StatusCode, _}, list_to_integer(Headers#http_response_h.'content-length'), Body). - -%%-------------------------------------------------------------------- +%-------------------------------------------------------------------- %% Internal functions %%------------------------------------------------------------------ check_version(Version, Options) -> diff --git a/lib/inets/test/inets_test_lib.erl b/lib/inets/test/inets_test_lib.erl index 0f8671b682..6ccc7b0da1 100644 --- a/lib/inets/test/inets_test_lib.erl +++ b/lib/inets/test/inets_test_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2012. All Rights Reserved. +%% Copyright Ericsson AB 2001-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -22,26 +22,8 @@ -include("inets_test_lib.hrl"). -include_lib("inets/src/http_lib/http_internal.hrl"). -%% Various small utility functions --export([start_http_server/1, start_http_server/2]). --export([start_http_server_ssl/1, start_http_server_ssl/2]). --export([hostname/0]). --export([connect_bin/3, connect_bin/4, - connect_byte/3, connect_byte/4, - send/3, close/2]). --export([copy_file/3, copy_files/2, copy_dirs/2, del_dirs/1]). --export([info/4, log/4, debug/4, print/4]). --export([timestamp/0, formated_timestamp/0]). --export([tsp/1, tsp/2, tsf/1, tss/1]). --export([check_body/1]). --export([millis/0, millis_diff/2, hours/1, minutes/1, seconds/1, sleep/1]). --export([oscmd/1, has_ipv6_support/0, has_ipv6_support/1, print_system_info/1]). --export([run_on_os/2, run_on_windows/1]). --export([ensure_started/1]). --export([non_pc_tc_maybe_skip/4, os_based_skip/1, skip/3, fail/3]). --export([flush/0]). --export([start_node/1, stop_node/1]). - +%% Note: This directive should only be used in test suites. +-compile(export_all). %% -- Misc os command and stuff @@ -474,7 +456,7 @@ connect_bin(ssl, Host, Port, Opts0) -> Opts = [binary, {packet,0} | Opts0], connect(ssl, Host, Port, Opts); connect_bin(essl, Host, Port, Opts0) -> - Opts = [{ssl_imp, new}, binary, {packet,0}, {reuseaddr, true} | Opts0], + Opts = [{ssl_imp, new}, binary, {packet,0}| Opts0], connect(ssl, Host, Port, Opts); connect_bin(ip_comm, Host, Port, Opts0) -> Opts = [binary, {packet, 0} | Opts0], @@ -494,74 +476,10 @@ connect_byte(ip_comm, Host, Port, Opts0) -> Opts = [{packet,0} | Opts0], connect(ip_comm, Host, Port, Opts). - -%% This always falls back on IPV4, but tries IPV6 first. -connect(Proto, Host, Port, Opts0) -> - Opts = Opts0 -- [inet, inet6], - connect(Proto, Host, Port, Opts ++ [inet6], inet6). - -connect(ssl, Host, Port, Opts, Type) -> - tsp("connect(ssl) -> entry with" - "~n Host: ~p" - "~n Port: ~p" - "~n Opts: ~p" - "~n Type: ~p", [Host, Port, Opts, Type]), - ssl:start(), - %% We ignore this option for ssl... - %% ...maybe we should really treat this in the same way as ip_comm... - case ssl:connect(Host, Port, Opts) of - {ok, Socket} -> - {ok, Socket}; - {error, Reason} when Type =:= inet6 -> - tsp("connect(ssl) -> failed connecting with inet6: " - "~n Reason: ~p" - "~n trying inet", [Reason]), - connect(ssl, Host, Port, Opts -- [inet6], inet); - {error, Reason} -> - tsp("connect(ssl) -> failed connecting: " - "~n Reason: ~p", [Reason]), - {error, Reason}; - Error -> - Error - end; -connect(ip_comm, Host, Port, Opts, Type) -> - tsp("connect(ip_comm) -> entry with" - "~n Host: ~p" - "~n Port: ~p" - "~n Opts: ~p" - "~n Type: ~p", [Host, Port, Opts, Type]), - - case gen_tcp:connect(Host, Port, Opts, timer:seconds(10)) of - {ok, Socket} -> - tsp("connect success"), - {ok, Socket}; - - {error, Reason} when ((Type =:= inet6) andalso - ((Reason =:= timeout) orelse - (Reason =:= nxdomain) orelse - (Reason =:= eafnosupport) orelse - (Reason =:= econnreset) orelse - (Reason =:= enetunreach) orelse - (Reason =:= econnrefused) orelse - (Reason =:= ehostunreach))) -> - tsp("connect(ip_comm) -> Connect error: " - "~n Reason: ~p" - "~n Type: ~p" - "~n Opts: ~p", [Reason, Type, Opts]), - connect(ip_comm, Host, Port, Opts -- [inet6], inet); - - Error -> - tsp("connect(ip_comm) -> Fatal connect error: " - "~n Error: ~p" - "~nwhen" - "~n Host: ~p" - "~n Port: ~p" - "~n Opts: ~p" - "~n Type: ~p" - "~n", [Error, Host, Port, Opts, Type]), - Error - end. - +connect(ip_comm, Host, Port, Opts) -> + gen_tcp:connect(Host, Port, Opts); +connect(ssl, Host, Port, Opts) -> + ssl:connect(Host, Port, Opts). send(ssl, Socket, Data) -> ssl:send(Socket, Data); @@ -651,3 +569,13 @@ format_timestamp({_N1, _N2, N3} = Now) -> [YYYY,MM,DD,Hour,Min,Sec,round(N3/1000)]), lists:flatten(FormatDate). +start_apps(Apps) -> + lists:foreach(fun(App) -> + application:stop(App), + application:start(App) + end, Apps). +stop_apps(Apps) -> + lists:foreach(fun(App) -> + application:stop(App) + end, Apps). + diff --git a/lib/inets/test/old_httpc_SUITE.erl b/lib/inets/test/old_httpc_SUITE.erl new file mode 100644 index 0000000000..3d7de71052 --- /dev/null +++ b/lib/inets/test/old_httpc_SUITE.erl @@ -0,0 +1,3602 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2013. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +%% +%% ts:run(inets, httpc_SUITE, [batch]). +%% + +-module(old_httpc_SUITE). + +-include_lib("common_test/include/ct.hrl"). +-include("test_server_line.hrl"). + +-include_lib("kernel/include/file.hrl"). +-include("inets_test_lib.hrl"). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +%% Test server specific exports +-define(IP_PORT, 8998). +-define(SSL_PORT, 8999). +-define(NOT_IN_USE_PORT, 8997). +-define(LOCAL_HOST, {127,0,0,1}). +-define(IPV6_LOCAL_HOST, "0:0:0:0:0:0:0:1"). +-define(URL_START, "http://localhost:"). +-define(SSL_URL_START, "https://localhost:"). +-define(CR, $\r). +-define(LF, $\n). +-define(HTTP_MAX_HEADER_SIZE, 10240). + + +%%-------------------------------------------------------------------- +%% all(Arg) -> [Doc] | [Case] | {skip, Comment} +%% Arg - doc | suite +%% Doc - string() +%% Case - atom() +%% Name of a test case function. +%% Comment - string() +%% Description: Returns documentation/test cases in this test suite +%% or a skip tuple if the platform is not supported. +%%-------------------------------------------------------------------- + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [ + http_options, + %% http_head, + %% http_get, + %%http_post, + %%http_post_streaming, + %% http_dummy_pipe, + %% http_inets_pipe, + %% http_trace, + %% http_async, + %% http_save_to_file, + %% http_save_to_file_async, + %%http_headers, + %%http_headers_dummy, + + %%http_bad_response, + + http_redirect, + http_redirect_loop, + + %%http_internal_server_error, + %%http_userinfo, + + %%http_cookie, + %%http_server_does_not_exist, + %%http_invalid_http, + %%http_emulate_lower_versions, + %%http_relaxed, + %%page_does_not_exist, + %%parse_url, + options, + %%headers_as_is, + selecting_session, + + %%{group, ssl}, + %%{group, stream}, + {group, ipv6}, + {group, tickets}, + initial_server_connect + ]. + +groups() -> + [ + %% {ssl, [], [ssl_head, + %% essl_head, + %% ssl_get, + %% essl_get, + %% ssl_trace, + %% essl_trace]}, + %% {stream, [], [http_stream, + %% http_stream_once]}, + {tickets, [], [%%hexed_query_otp_6191, + %%empty_body_otp_6243, + %%empty_response_header_otp_6830, + %%transfer_encoding_otp_6807, + %%no_content_204_otp_6982, + %%missing_CR_otp_7304, + %% {group, otp_7883}, + %% {group, otp_8154}, + %% {group, otp_8106}, + otp_8056, + otp_8352, + otp_8371, + otp_8739]}, + %% {otp_7883, [], [otp_7883_1, + %% otp_7883_2]}, + {otp_8154, [], [otp_8154_1]}, + %%{otp_8106, [], [otp_8106_pid, + %% otp_8106_fun, + %% otp_8106_mfa]}, + {ipv6, [], [ipv6_ipcomm, ipv6_essl]} + ]. + + +init_per_group(ipv6 = _GroupName, Config) -> + case inets_test_lib:has_ipv6_support() of + {ok, _} -> + Config; + _ -> + {skip, "Host does not support IPv6"} + end; +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + +%%-------------------------------------------------------------------- +%% Function: init_per_suite(Config) -> Config +%% Config - [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% Description: Initiation before the whole suite +%% +%% Note: This function is free to add any key/value pairs to the Config +%% variable, but should NOT alter/remove any existing entries. +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + + ?PRINT_SYSTEM_INFO([]), + + PrivDir = ?config(priv_dir, Config), + DataDir = ?config(data_dir, Config), + ServerRoot = filename:join(PrivDir, "server_root"), + DocRoot = filename:join(ServerRoot, "htdocs"), + IpConfFile = integer_to_list(?IP_PORT) ++ ".conf", + SslConfFile = integer_to_list(?SSL_PORT) ++ ".conf", + + setup_server_dirs(ServerRoot, DocRoot, DataDir), + create_config(IpConfFile, ip_comm, ?IP_PORT, PrivDir, ServerRoot, + DocRoot, DataDir), + create_config(SslConfFile, ssl, ?SSL_PORT, PrivDir, ServerRoot, + DocRoot, DataDir), + + Cgi = case test_server:os_type() of + {win32, _} -> + filename:join([ServerRoot, "cgi-bin", "cgi_echo.exe"]); + _ -> + filename:join([ServerRoot, "cgi-bin", "cgi_echo"]) + end, + + {ok, FileInfo} = file:read_file_info(Cgi), + ok = file:write_file_info(Cgi, FileInfo#file_info{mode = 8#00755}), + + [{has_ipv6_support, inets_test_lib:has_ipv6_support()}, + {server_root, ServerRoot}, + {doc_root, DocRoot}, + {local_port, ?IP_PORT}, + {local_ssl_port, ?SSL_PORT} | Config]. + + +%%-------------------------------------------------------------------- +%% Function: end_per_suite(Config) -> _ +%% Config - [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% Description: Cleanup after the whole suite +%%-------------------------------------------------------------------- +end_per_suite(Config) -> + PrivDir = ?config(priv_dir, Config), + inets_test_lib:del_dirs(PrivDir), + application:stop(inets), + application:stop(ssl), + ok. + + +%%-------------------------------------------------------------------- +%% Function: init_per_testcase(Case, Config) -> Config +%% Case - atom() +%% Name of the test case that is about to be run. +%% Config - [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% +%% Description: Initiation before each test case +%% +%% Note: This function is free to add any key/value pairs to the Config +%% variable, but should NOT alter/remove any existing entries. +%%-------------------------------------------------------------------- + +init_per_testcase(otp_8154_1 = Case, Config) -> + init_per_testcase(Case, 5, Config); + +init_per_testcase(initial_server_connect = Case, Config) -> + %% Try to check if crypto actually exist or not, + %% this test case does not work unless it does + try + begin + ?ENSURE_STARTED([crypto, public_key, ssl]), + inets:start(), + Config + end + catch + throw:{error, {failed_starting, App, ActualError}} -> + tsp("init_per_testcase(~w) -> failed starting ~w: " + "~n ~p", [Case, App, ActualError]), + SkipString = + "Could not start " ++ atom_to_list(App), + skip(SkipString); + _:X -> + SkipString = + lists:flatten( + io_lib:format("Failed starting apps: ~p", [X])), + skip(SkipString) + end; + +init_per_testcase(Case, Config) -> + init_per_testcase(Case, 2, Config). + +init_per_testcase(Case, Timeout, Config) -> + io:format(user, + "~n~n*** INIT ~w:~w[~w] ***" + "~n~n", [?MODULE, Case, Timeout]), + + PrivDir = ?config(priv_dir, Config), + application:stop(inets), + Dog = test_server:timetrap(inets_test_lib:minutes(Timeout)), + TmpConfig = lists:keydelete(watchdog, 1, Config), + IpConfFile = integer_to_list(?IP_PORT) ++ ".conf", + SslConfFile = integer_to_list(?SSL_PORT) ++ ".conf", + + %% inets:enable_trace(max, io, httpd), + %% inets:enable_trace(max, io, httpc), + %% inets:enable_trace(max, io, all), + + NewConfig = + case atom_to_list(Case) of + [$s, $s, $l | _] -> + ?ENSURE_STARTED([crypto, public_key, ssl]), + init_per_testcase_ssl(ssl, PrivDir, SslConfFile, + [{watchdog, Dog} | TmpConfig]); + + [$e, $s, $s, $l | _] -> + ?ENSURE_STARTED([crypto, public_key, ssl]), + init_per_testcase_ssl(essl, PrivDir, SslConfFile, + [{watchdog, Dog} | TmpConfig]); + + "ipv6_" ++ _Rest -> + %% Ensure needed apps (crypto, public_key and ssl) are started + try ?ENSURE_STARTED([crypto, public_key, ssl]) of + ok -> + Profile = ipv6, + %% A stand-alone profile is represented by a pid() + {ok, ProfilePid} = + inets:start(httpc, + [{profile, Profile}, + {data_dir, PrivDir}], stand_alone), + ok = httpc:set_options([{ipfamily, inet6}], + ProfilePid), + tsp("httpc profile pid: ~p", [ProfilePid]), + [{watchdog, Dog}, {profile, ProfilePid}| TmpConfig] + catch + throw:{error, {failed_starting, App, ActualError}} -> + tsp("init_per_testcase(~w) -> failed starting ~w: " + "~n ~p", [Case, App, ActualError]), + SkipString = + "Could not start " ++ atom_to_list(App), + skip(SkipString); + _:X -> + SkipString = + lists:flatten( + io_lib:format("Failed starting apps: ~p", [X])), + skip(SkipString) + end; + + _ -> + %% Try inet6fb4 on windows... + %% No need? Since it is set above? + + %% tsp("init_per_testcase -> allways try IPv6 on windows"), + %% ?RUN_ON_WINDOWS( + %% fun() -> + %% tsp("init_per_testcase:set_options_fun -> " + %% "set-option ipfamily to inet6fb4"), + %% Res = httpc:set_options([{ipfamily, inet6fb4}]), + %% tsp("init_per_testcase:set_options_fun -> " + %% "~n Res: ~p", [Res]), + %% Res + %% end), + + TmpConfig2 = lists:keydelete(local_server, 1, TmpConfig), + %% Will start inets + tsp("init_per_testcase -> try start server"), + Server = start_http_server(PrivDir, IpConfFile), + [{watchdog, Dog}, {local_server, Server} | TmpConfig2] + end, + + %% <IPv6> + %% Set default ipfamily to the same as the main server has by default + %% This makes the client try w/ ipv6 before falling back to ipv4, + %% as that is what the server is configured to do. + %% Note that this is required for the tests to run on *BSD w/ ipv6 enabled + %% as well as on Windows. The Linux behaviour of allowing ipv4 connects + %% to ipv6 sockets is not required or even encouraged. + + tsp("init_per_testcase -> Options before ipfamily set: ~n~p", + [httpc:get_options(all)]), + ok = httpc:set_options([{ipfamily, inet6fb4}]), + tsp("init_per_testcase -> Options after ipfamily set: ~n~p", + [httpc:get_options(all)]), + + %% Note that the IPv6 test case(s) *must* use inet6, + %% so this value will be overwritten (see "ipv6_" below). + %% </IPv6> + + %% inets:enable_trace(max, io, all), + %% snmp:set_trace([gen_tcp]), + tsp("init_per_testcase(~w) -> done when" + "~n NewConfig: ~p" + "~n~n", [Case, NewConfig]), + NewConfig. + + +init_per_testcase_ssl(Tag, PrivDir, SslConfFile, Config) -> + tsp("init_per_testcase_ssl(~w) -> stop ssl", [Tag]), + application:stop(ssl), + Config2 = lists:keydelete(local_ssl_server, 1, Config), + %% Will start inets + tsp("init_per_testcase_ssl(~w) -> try start http server (including inets)", + [Tag]), + Server = inets_test_lib:start_http_server( + filename:join(PrivDir, SslConfFile), Tag), + tsp("init_per_testcase(~w) -> Server: ~p", [Tag, Server]), + [{local_ssl_server, Server} | Config2]. + +start_http_server(ConfDir, ConfFile) -> + inets_test_lib:start_http_server( filename:join(ConfDir, ConfFile) ). + + +%%-------------------------------------------------------------------- +%% Function: end_per_testcase(Case, Config) -> _ +%% Case - atom() +%% Name of the test case that is about to be run. +%% Config - [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% Description: Cleanup after each test case +%%-------------------------------------------------------------------- +end_per_testcase(http_save_to_file = Case, Config) -> + io:format(user, "~n~n*** END ~w:~w ***~n~n", + [?MODULE, Case]), + PrivDir = ?config(priv_dir, Config), + FullPath = filename:join(PrivDir, "dummy.html"), + file:delete(FullPath), + finish(Config); + +end_per_testcase(Case, Config) -> + io:format(user, "~n~n*** END ~w:~w ***~n~n", + [?MODULE, Case]), + case atom_to_list(Case) of + "ipv6_" ++ _Rest -> + tsp("end_per_testcase(~w) -> stop ssl", [Case]), + application:stop(ssl), + tsp("end_per_testcase(~w) -> stop public_key", [Case]), + application:stop(public_key), + tsp("end_per_testcase(~w) -> stop crypto", [Case]), + application:stop(crypto), + ProfilePid = ?config(profile, Config), + tsp("end_per_testcase(~w) -> stop httpc profile (~p)", + [Case, ProfilePid]), + unlink(ProfilePid), + inets:stop(stand_alone, ProfilePid), + tsp("end_per_testcase(~w) -> httpc profile (~p) stopped", + [Case, ProfilePid]), + ok; + _ -> + ok + end, + finish(Config). + +finish(Config) -> + Dog = ?config(watchdog, Config), + case Dog of + undefined -> + ok; + _ -> + tsp("finish -> stop watchdog (~p)", [Dog]), + test_server:timetrap_cancel(Dog) + end. + +%%------------------------------------------------------------------------- +%% Test cases starts here. +%%------------------------------------------------------------------------- + + + +%%------------------------------------------------------------------------- + +http_options(doc) -> + ["Test http options request against local server."]; +http_options(suite) -> + []; +http_options(Config) when is_list(Config) -> + skip("Not supported by httpd"). + +http_head(doc) -> + ["Test http head request against local server."]; +http_head(suite) -> + []; +http_head(Config) when is_list(Config) -> + tsp("http_head -> entry with" + "~n Config: ~p", [Config]), + Method = head, + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + Request = {URL, []}, + HttpOpts = [], + Opts = [], + VerifyResult = + fun({ok, {{_,200,_}, [_ | _], []}}) -> + ok; + ({ok, UnexpectedReply}) -> + tsp("http_head:verify_fun -> Unexpected Reply: " + "~n ~p", [UnexpectedReply]), + tsf({unexpected_reply, UnexpectedReply}); + ({error, Reason} = Error) -> + tsp("http_head:verify_fun -> Error reply: " + "~n Reason: ~p", [Reason]), + tsf({bad_reply, Error}) + end, + simple_request_and_verify(Config, + Method, Request, HttpOpts, Opts, VerifyResult). + + +%%------------------------------------------------------------------------- + +http_get(doc) -> + ["Test http get request against local server"]; +http_get(suite) -> + []; +http_get(Config) when is_list(Config) -> + tsp("http_get -> entry with" + "~n Config: ~p", [Config]), + case ?config(local_server, Config) of + ok -> + tsp("local-server running"), + Method = get, + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + Request = {URL, []}, + Timeout = timer:seconds(1), + ConnTimeout = Timeout + timer:seconds(1), + HttpOptions1 = [{timeout, Timeout}, + {connect_timeout, ConnTimeout}], + Options1 = [], + Body = + case httpc:request(Method, Request, HttpOptions1, Options1) of + {ok, {{_,200,_}, [_ | _], ReplyBody = [_ | _]}} -> + ReplyBody; + {ok, UnexpectedReply1} -> + tsf({unexpected_reply, UnexpectedReply1}); + {error, _} = Error1 -> + tsf({bad_reply, Error1}) + end, + + %% eqvivivalent to httpc:request(get, {URL, []}, [], []), + inets_test_lib:check_body(Body), + + HttpOptions2 = [], + Options2 = [{body_format, binary}], + case httpc:request(Method, Request, HttpOptions2, Options2) of + {ok, {{_,200,_}, [_ | _], Bin}} when is_binary(Bin) -> + ok; + {ok, {{_,200,_}, [_ | _], BadBin}} -> + tsf({body_format_not_binary, BadBin}); + {ok, UnexpectedReply2} -> + tsf({unexpected_reply, UnexpectedReply2}); + {error, _} = Error2 -> + tsf({bad_reply, Error2}) + end; + _ -> + skip("Failed to start local http-server") + end. + +%%------------------------------------------------------------------------- + +http_post(doc) -> + ["Test http post request against local server. We do in this case " + "only care about the client side of the the post. The server " + "script will not actually use the post data."]; +http_post(suite) -> + []; +http_post(Config) when is_list(Config) -> + case ?config(local_server, Config) of + ok -> + Port = ?config(local_port, Config), + + URL = case test_server:os_type() of + {win32, _} -> + ?URL_START ++ integer_to_list(Port) ++ + "/cgi-bin/cgi_echo.exe"; + _ -> + ?URL_START ++ integer_to_list(Port) ++ + "/cgi-bin/cgi_echo" + + end, + %% Cgi-script expects the body length to be 100 + Body = lists:duplicate(100, "1"), + + {ok, {{_,200,_}, [_ | _], [_ | _]}} = + httpc:request(post, {URL, [{"expect","100-continue"}], + "text/plain", Body}, [], []), + + {ok, {{_,504,_}, [_ | _], []}} = + httpc:request(post, {URL, [{"expect","100-continue"}], + "text/plain", "foobar"}, [], []); + _ -> + skip("Failed to start local http-server") + end. + +%%------------------------------------------------------------------------- +http_post_streaming(doc) -> + ["Test streaming http post request against local server. " + "We only care about the client side of the the post. " + "The server script will not actually use the post data."]; +http_post_streaming(suite) -> + []; +http_post_streaming(Config) when is_list(Config) -> + case ?config(local_server, Config) of + ok -> + Port = ?config(local_port, Config), + URL = case test_server:os_type() of + {win32, _} -> + ?URL_START ++ integer_to_list(Port) ++ + "/cgi-bin/cgi_echo.exe"; + _ -> + ?URL_START ++ integer_to_list(Port) ++ + "/cgi-bin/cgi_echo" + end, + %% Cgi-script expects the body length to be 100 + BodyFun = fun(0) -> + io:format("~w:http_post_streaming_fun -> " + "zero~n", [?MODULE]), + eof; + (LenLeft) -> + io:format("~w:http_post_streaming_fun -> " + "LenLeft: ~p~n", [?MODULE, LenLeft]), + {ok, lists:duplicate(10, "1"), LenLeft - 10} + end, + + {ok, {{_,200,_}, [_ | _], [_ | _]}} = + httpc:request(post, {URL, + [{"expect", "100-continue"}, + {"content-length", "100"}], + "text/plain", {BodyFun, 100}}, [], []), + + {ok, {{_,504,_}, [_ | _], []}} = + httpc:request(post, {URL, + [{"expect", "100-continue"}, + {"content-length", "10"}], + "text/plain", {BodyFun, 10}}, [], []); + + _ -> + skip("Failed to start local http-server") + end. + + +%%------------------------------------------------------------------------- +http_emulate_lower_versions(doc) -> + ["Perform request as 0.9 and 1.0 clients."]; +http_emulate_lower_versions(suite) -> + []; +http_emulate_lower_versions(Config) when is_list(Config) -> + case ?config(local_server, Config) of + ok -> + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + {ok, Body0} = + httpc:request(get, {URL, []}, [{version, "HTTP/0.9"}], []), + inets_test_lib:check_body(Body0), + {ok, {{"HTTP/1.0", 200, _}, [_ | _], Body1 = [_ | _]}} = + httpc:request(get, {URL, []}, [{version, "HTTP/1.0"}], []), + inets_test_lib:check_body(Body1), + {ok, {{"HTTP/1.1", 200, _}, [_ | _], Body2 = [_ | _]}} = + httpc:request(get, {URL, []}, [{version, "HTTP/1.1"}], []), + inets_test_lib:check_body(Body2); + _-> + skip("Failed to start local http-server") + end. + + +%%------------------------------------------------------------------------- + +http_relaxed(doc) -> + ["Test relaxed mode"]; +http_relaxed(suite) -> + []; +http_relaxed(Config) when is_list(Config) -> + ok = httpc:set_options([{ipv6, disabled}]), % also test the old option + %% ok = httpc:set_options([{ipfamily, inet}]), + {DummyServerPid, Port} = dummy_server(ipv4), + + URL = ?URL_START ++ integer_to_list(Port) ++ + "/missing_reason_phrase.html", + + {error, Reason} = + httpc:request(get, {URL, []}, [{relaxed, false}], []), + + test_server:format("Not relaxed: ~p~n", [Reason]), + + {ok, {{_, 200, _}, [_ | _], [_ | _]}} = + httpc:request(get, {URL, []}, [{relaxed, true}], []), + + DummyServerPid ! stop, + ok = httpc:set_options([{ipv6, enabled}]), + %% ok = httpc:set_options([{ipfamily, inet6fb4}]), + ok. + + +%%------------------------------------------------------------------------- +http_dummy_pipe(doc) -> + ["Test pipelining code."]; +http_dummy_pipe(suite) -> + []; +http_dummy_pipe(Config) when is_list(Config) -> + ok = httpc:set_options([{ipfamily, inet}]), + {DummyServerPid, Port} = dummy_server(ipv4), + + URL = ?URL_START ++ integer_to_list(Port) ++ "/foobar.html", + + test_pipeline(URL), + + DummyServerPid ! stop, + ok = httpc:set_options([{ipfamily, inet6fb4}]), + ok. + +http_inets_pipe(doc) -> + ["Test pipelining code."]; +http_inets_pipe(suite) -> + []; +http_inets_pipe(Config) when is_list(Config) -> + + case ?config(local_server, Config) of + ok -> + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + test_pipeline(URL); + _ -> + skip("Failed to start local http-server") + end. + + +test_pipeline(URL) -> + p("test_pipeline -> entry with" + "~n URL: ~p", [URL]), + + httpc:set_options([{pipeline_timeout, 50000}, + {max_pipeline_length, 5}]), + + p("test_pipeline -> issue (async) request 1" + "~n when profile info: ~p", [httpc:info()]), + {ok, RequestIdA1} = + httpc:request(get, {URL, []}, [], [{sync, false}]), + tsp("RequestIdA1: ~p", [RequestIdA1]), + p("test_pipeline -> RequestIdA1: ~p" + "~n when profile info: ~p", [RequestIdA1, httpc:info()]), + + %% Make sure pipeline is initiated + p("test_pipeline -> sleep some", []), + test_server:sleep(4000), + + p("test_pipeline -> issue (async) request A2, A3 and A4" + "~n when profile info: ~p", [httpc:info()]), + {ok, RequestIdA2} = + httpc:request(get, {URL, []}, [], [{sync, false}]), + {ok, RequestIdA3} = + httpc:request(get, {URL, []}, [], [{sync, false}]), + {ok, RequestIdA4} = + httpc:request(get, {URL, []}, [], [{sync, false}]), + tsp("RequestIdAs => A2: ~p, A3: ~p and A4: ~p", + [RequestIdA2, RequestIdA3, RequestIdA4]), + p("test_pipeline -> RequestIds => A2: ~p, A3: ~p and A4: ~p" + "~n when profile info: ~p", + [RequestIdA2, RequestIdA3, RequestIdA4, httpc:info()]), + + p("test_pipeline -> issue (sync) request 3"), + {ok, {{_,200,_}, [_ | _], [_ | _]}} = + httpc:request(get, {URL, []}, [], []), + + p("test_pipeline -> expect reply for (async) request A1, A2, A3 and A4" + "~n when profile info: ~p", [httpc:info()]), + pipeline_await_async_reply([{RequestIdA1, a1, 200}, + {RequestIdA2, a2, 200}, + {RequestIdA3, a3, 200}, + {RequestIdA4, a4, 200}], ?MINS(2)), + + p("test_pipeline -> sleep some" + "~n when profile info: ~p", [httpc:info()]), + test_server:sleep(4000), + + p("test_pipeline -> issue (async) request B1, B2, B3 and B4" + "~n when profile info: ~p", [httpc:info()]), + {ok, RequestIdB1} = + httpc:request(get, {URL, []}, [], [{sync, false}]), + {ok, RequestIdB2} = + httpc:request(get, {URL, []}, [], [{sync, false}]), + {ok, RequestIdB3} = + httpc:request(get, {URL, []}, [], [{sync, false}]), + {ok, RequestIdB4} = + httpc:request(get, {URL, []}, [], [{sync, false}]), + tsp("RequestIdBs => B1: ~p, B2: ~p, B3: ~p and B4: ~p", + [RequestIdB1, RequestIdB2, RequestIdB3, RequestIdB4]), + p("test_pipeline -> RequestIdBs => B1: ~p, B2: ~p, B3: ~p and B4: ~p" + "~n when profile info: ~p", + [RequestIdB1, RequestIdB2, RequestIdB3, RequestIdB4, httpc:info()]), + + p("test_pipeline -> cancel (async) request B2" + "~n when profile info: ~p", [httpc:info()]), + ok = httpc:cancel_request(RequestIdB2), + + p("test_pipeline -> " + "expect *no* reply for cancelled (async) request B2 (for 3 secs)" + "~n when profile info: ~p", [httpc:info()]), + receive + {http, {RequestIdB2, _}} -> + tsf(http_cancel_request_failed) + after 3000 -> + ok + end, + + p("test_pipeline -> expect reply for (async) request B1, B3 and B4" + "~n when profile info: ~p", [httpc:info()]), + Bodies = pipeline_await_async_reply([{RequestIdB1, b1, 200}, + {RequestIdB3, b3, 200}, + {RequestIdB4, b4, 200}], ?MINS(1)), + [{b1, Body}|_] = Bodies, + + p("test_pipeline -> check reply for (async) request B1" + "~n when profile info: ~p", [httpc:info()]), + inets_test_lib:check_body(binary_to_list(Body)), + + p("test_pipeline -> ensure no unexpected incomming" + "~n when profile info: ~p", [httpc:info()]), + receive + {http, Any} -> + tsf({unexpected_message, Any}) + after 500 -> + ok + end, + + p("test_pipeline -> done" + "~n when profile info: ~p", [httpc:info()]), + ok. + +pipeline_await_async_reply(ReqIds, Timeout) -> + pipeline_await_async_reply(ReqIds, Timeout, []). + +pipeline_await_async_reply([], _, Acc) -> + lists:keysort(1, Acc); +pipeline_await_async_reply(ReqIds, Timeout, Acc) when Timeout > 0 -> + T1 = inets_test_lib:timestamp(), + p("pipeline_await_async_reply -> await replies" + "~n ReqIds: ~p" + "~n Timeout: ~p", [ReqIds, Timeout]), + receive + {http, {RequestId, {{_, Status, _}, _, Body}}} -> + p("pipeline_await_async_reply -> received reply for" + "~n RequestId: ~p" + "~n Status: ~p", [RequestId, Status]), + case lists:keysearch(RequestId, 1, ReqIds) of + {value, {RequestId, N, Status}} -> + p("pipeline_await_async_reply -> " + "found expected request ~w", [N]), + ReqIds2 = lists:keydelete(RequestId, 1, ReqIds), + NewTimeout = Timeout - (inets_test_lib:timestamp()-T1), + pipeline_await_async_reply(ReqIds2, NewTimeout, + [{N, Body} | Acc]); + {value, {RequestId, N, WrongStatus}} -> + p("pipeline_await_async_reply -> " + "found request ~w with wrong status", [N]), + tsf({reply_with_unexpected_status, + {RequestId, N, WrongStatus}}); + false -> + tsf({unexpected_reply, {RequestId, Status}}) + end; + {http, Msg} -> + tsf({unexpected_reply, Msg}) + after Timeout -> + receive + Any -> + tsp("pipeline_await_async_reply -> " + "received unknown data after timeout: " + "~n ~p", [Any]), + tsf({timeout, {unknown, Any}}) + end + end; +pipeline_await_async_reply(ReqIds, _, Acc) -> + tsp("pipeline_await_async_reply -> " + "timeout: " + "~n ~p" + "~nwhen" + "~n ~p", [ReqIds, Acc]), + tsf({timeout, ReqIds, Acc}). + + + +%%------------------------------------------------------------------------- +http_trace(doc) -> + ["Perform a TRACE request."]; +http_trace(suite) -> + []; +http_trace(Config) when is_list(Config) -> + case ?config(local_server, Config) of + ok -> + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + case httpc:request(trace, {URL, []}, [], []) of + {ok, {{_,200,_}, [_ | _], "TRACE /dummy.html" ++ _}} -> + ok; + {ok, {{_,200,_}, [_ | _], WrongBody}} -> + tsf({wrong_body, WrongBody}); + {ok, WrongReply} -> + tsf({wrong_reply, WrongReply}); + Error -> + tsf({failed, Error}) + end; + _ -> + skip("Failed to start local http-server") + end. +%%------------------------------------------------------------------------- +http_async(doc) -> + ["Test an asynchrony http request."]; +http_async(suite) -> + []; +http_async(Config) when is_list(Config) -> + case ?config(local_server, Config) of + ok -> + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + {ok, RequestId} = + httpc:request(get, {URL, []}, [], [{sync, false}]), + + Body = + receive + {http, {RequestId, {{_, 200, _}, _, BinBody}}} -> + BinBody; + {http, Msg} -> + tsf(Msg) + end, + + inets_test_lib:check_body(binary_to_list(Body)), + + {ok, NewRequestId} = + httpc:request(get, {URL, []}, [], [{sync, false}]), + ok = httpc:cancel_request(NewRequestId), + receive + {http, {NewRequestId, _NewResult}} -> + tsf(http_cancel_request_failed) + after 3000 -> + ok + end; + _ -> + skip("Failed to start local http-server") + end. + +%%------------------------------------------------------------------------- +http_save_to_file(doc) -> + ["Test to save the http body to a file"]; +http_save_to_file(suite) -> + []; +http_save_to_file(Config) when is_list(Config) -> + case ?config(local_server, Config) of + ok -> + PrivDir = ?config(priv_dir, Config), + FilePath = filename:join(PrivDir, "dummy.html"), + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + {ok, saved_to_file} + = httpc:request(get, {URL, []}, [], [{stream, FilePath}]), + {ok, Bin} = file:read_file(FilePath), + {ok, {{_,200,_}, [_ | _], Body}} = httpc:request(URL), + Bin == Body; + _ -> + skip("Failed to start local http-server") + end. + + +%%------------------------------------------------------------------------- +http_save_to_file_async(doc) -> + ["Test to save the http body to a file"]; +http_save_to_file_async(suite) -> + []; +http_save_to_file_async(Config) when is_list(Config) -> + case ?config(local_server, Config) of + ok -> + PrivDir = ?config(priv_dir, Config), + FilePath = filename:join(PrivDir, "dummy.html"), + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + {ok, RequestId} = httpc:request(get, {URL, []}, [], + [{stream, FilePath}, + {sync, false}]), + receive + {http, {RequestId, saved_to_file}} -> + ok; + {http, Msg} -> + tsf(Msg) + end, + + {ok, Bin} = file:read_file(FilePath), + {ok, {{_,200,_}, [_ | _], Body}} = httpc:request(URL), + Bin == Body; + _ -> + skip("Failed to start local http-server") + end. +%%------------------------------------------------------------------------- +http_headers(doc) -> + ["Use as many request headers as possible not used in proxy_headers"]; +http_headers(suite) -> + []; +http_headers(Config) when is_list(Config) -> + + case ?config(local_server, Config) of + ok -> + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + DocRoot = ?config(doc_root, Config), + {ok, FileInfo} = + file:read_file_info(filename:join([DocRoot,"dummy.html"])), + CreatedSec = + calendar:datetime_to_gregorian_seconds( + FileInfo#file_info.mtime), + + Mod = httpd_util:rfc1123_date( + calendar:gregorian_seconds_to_datetime( + CreatedSec-1)), + + Date = httpd_util:rfc1123_date({date(), time()}), + + {ok, {{_,200,_}, [_ | _], [_ | _]}} = + httpc:request(get, {URL, [{"If-Modified-Since", + Mod}, + {"From","[email protected]"}, + {"Date", Date} + ]}, [], []), + + Mod1 = httpd_util:rfc1123_date( + calendar:gregorian_seconds_to_datetime( + CreatedSec+1)), + + {ok, {{_,200,_}, [_ | _], [_ | _]}} = + httpc:request(get, {URL, [{"If-UnModified-Since", + Mod1} + ]}, [], []), + + Tag = httpd_util:create_etag(FileInfo), + + + {ok, {{_,200,_}, [_ | _], [_ | _]}} = + httpc:request(get, {URL, [{"If-Match", + Tag} + ]}, [], []), + + {ok, {{_,200,_}, [_ | _], _}} = + httpc:request(get, {URL, [{"If-None-Match", + "NotEtag,NeihterEtag"}, + {"Connection", "Close"} + ]}, [], []), + ok; + _ -> + skip("Failed to start local http-server") + end. + +%%------------------------------------------------------------------------- +http_headers_dummy(doc) -> + ["Test the code for handling headers we do not want/can send " + "to a real server. Note it is not logical to send" + "all of these headers together, we only want to test that" + "the code for handling headers will not crash."]; +http_headers_dummy(suite) -> + []; +http_headers_dummy(Config) when is_list(Config) -> + ok = httpc:set_options([{ipfamily, inet}]), + {DummyServerPid, Port} = dummy_server(ipv4), + + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy_headers.html", + + Foo = http_chunk:encode("foobar") ++ + binary_to_list(http_chunk:encode_last()), + FooBar = Foo ++ "\r\n\r\nOther:inets_test\r\n\r\n", + + UserPasswd = base64:encode_to_string("Alladin:Sesame"), + Auth = "Basic " ++ UserPasswd, + + %% The dummy server will ignore the headers, we only want to test + %% that the client header-handling code. This would not + %% be a vaild http-request! + {ok, {{_,200,_}, [_ | _], [_|_]}} = + httpc:request(post, + {URL, + [{"Via", + "1.0 fred, 1.1 nowhere.com (Apache/1.1)"}, + {"Warning","1#pseudonym foobar"}, + {"Vary","*"}, + {"Upgrade","HTTP/2.0"}, + {"Pragma", "1#no-cache"}, + {"Cache-Control", "no-cache"}, + {"Connection", "close"}, + {"Date", "Sat, 29 Oct 1994 19:43:31 GMT"}, + {"Accept", " text/plain; q=0.5, text/html"}, + {"Accept-Language", "en"}, + {"Accept-Encoding","chunked"}, + {"Accept-Charset", "ISO8859-1"}, + {"Authorization", Auth}, + {"Expect", "1#100-continue"}, + {"User-Agent","inets"}, + {"Transfer-Encoding","chunked"}, + {"Range", " bytes=0-499"}, + {"If-Range", "Sat, 29 Oct 1994 19:43:31 GMT"}, + {"If-Match", "*"}, + {"Content-Type", "text/plain"}, + {"Content-Encoding", "chunked"}, + {"Content-Length", "6"}, + {"Content-Language", "en"}, + {"Content-Location", "http://www.foobar.se"}, + {"Content-MD5", + "104528739076276072743283077410617235478"}, + {"Content-Range", "bytes 0-499/1234"}, + {"Allow", "GET"}, + {"Proxy-Authorization", Auth}, + {"Expires", "Sat, 29 Oct 1994 19:43:31 GMT"}, + {"Upgrade", "HTTP/2.0"}, + {"Last-Modified", "Sat, 29 Oct 1994 19:43:31 GMT"}, + {"Trailer","1#User-Agent"} + ], "text/plain", FooBar}, + [], []), + DummyServerPid ! stop, + ok = httpc:set_options([{ipfamily, inet6fb4}]), + ok. + + +%%------------------------------------------------------------------------- +http_bad_response(doc) -> + ["Test what happens when the server does not follow the protocol"]; +http_bad_response(suite) -> + []; +http_bad_response(Config) when is_list(Config) -> + ok = httpc:set_options([{ipfamily, inet}]), + {DummyServerPid, Port} = dummy_server(ipv4), + + URL = ?URL_START ++ integer_to_list(Port) ++ "/missing_crlf.html", + + URL1 = ?URL_START ++ integer_to_list(Port) ++ "/wrong_statusline.html", + + {error, timeout} = httpc:request(get, {URL, []}, [{timeout, 400}], []), + + {error, Reason} = httpc:request(URL1), + + test_server:format("Wrong Statusline: ~p~n", [Reason]), + + DummyServerPid ! stop, + ok = httpc:set_options([{ipfamily, inet6fb4}]), + ok. + + +%%------------------------------------------------------------------------- +ssl_head(doc) -> + ["Same as http_head/1 but over ssl sockets."]; +ssl_head(suite) -> + []; +ssl_head(Config) when is_list(Config) -> + ssl_head(ssl, Config). + +essl_head(doc) -> + ["Same as http_head/1 but over ssl sockets."]; +essl_head(suite) -> + []; +essl_head(Config) when is_list(Config) -> + ssl_head(essl, Config). + +ssl_head(SslTag, Config) -> + tsp("ssl_head -> entry with" + "~n SslTag: ~p" + "~n Config: ~p", [SslTag, Config]), + case ?config(local_ssl_server, Config) of + ok -> + DataDir = ?config(data_dir, Config), + Port = ?config(local_ssl_port, Config), + URL = ?SSL_URL_START ++ integer_to_list(Port) ++ "/dummy.html", + CertFile = filename:join(DataDir, "ssl_client_cert.pem"), + SSLOptions = [{certfile, CertFile}, {keyfile, CertFile}], + SSLConfig = + case SslTag of + ssl -> + SSLOptions; + essl -> + {essl, SSLOptions} + end, + tsp("ssl_head -> make request using: " + "~n URL: ~p" + "~n SslTag: ~p" + "~n SSLOptions: ~p", [URL, SslTag, SSLOptions]), + {ok, {{_,200, _}, [_ | _], []}} = + httpc:request(head, {URL, []}, [{ssl, SSLConfig}], []); + {ok, _} -> + skip("local http-server not started"); + _ -> + skip("SSL not started") + end. + + +%%------------------------------------------------------------------------- +ssl_get(doc) -> + ["Same as http_get/1 but over ssl sockets."]; +ssl_get(suite) -> + []; +ssl_get(Config) when is_list(Config) -> + ssl_get(ssl, Config). + +essl_get(doc) -> + ["Same as http_get/1 but over ssl sockets."]; +essl_get(suite) -> + []; +essl_get(Config) when is_list(Config) -> + ssl_get(essl, Config). + +ssl_get(SslTag, Config) when is_list(Config) -> + case ?config(local_ssl_server, Config) of + ok -> + DataDir = ?config(data_dir, Config), + Port = ?config(local_ssl_port, Config), + URL = ?SSL_URL_START ++ integer_to_list(Port) ++ "/dummy.html", + CertFile = filename:join(DataDir, "ssl_client_cert.pem"), + SSLOptions = [{certfile, CertFile}, {keyfile, CertFile}], + SSLConfig = + case SslTag of + ssl -> + SSLOptions; + essl -> + {essl, SSLOptions} + end, + tsp("ssl_get -> make request using: " + "~n URL: ~p" + "~n SslTag: ~p" + "~n SSLOptions: ~p", [URL, SslTag, SSLOptions]), + case httpc:request(get, {URL, []}, [{ssl, SSLConfig}], []) of + {ok, {{_,200, _}, [_ | _], Body = [_ | _]}} -> + inets_test_lib:check_body(Body), + ok; + {ok, {StatusLine, Headers, _Body}} -> + tsp("ssl_get -> unexpected result: " + "~n StatusLine: ~p" + "~n Headers: ~p", [StatusLine, Headers]), + tsf({unexpected_response, StatusLine, Headers}); + {error, Reason} -> + tsp("ssl_get -> request failed: " + "~n Reason: ~p", [Reason]), + tsf({request_failed, Reason}) + end; + {ok, _} -> + skip("local http-server not started"); + _ -> + skip("SSL not started") + end. + + +%%------------------------------------------------------------------------- +ssl_trace(doc) -> + ["Same as http_trace/1 but over ssl sockets."]; +ssl_trace(suite) -> + []; +ssl_trace(Config) when is_list(Config) -> + ssl_trace(ssl, Config). + +essl_trace(doc) -> + ["Same as http_trace/1 but over ssl sockets."]; +essl_trace(suite) -> + []; +essl_trace(Config) when is_list(Config) -> + ssl_trace(essl, Config). + +ssl_trace(SslTag, Config) when is_list(Config) -> + case ?config(local_ssl_server, Config) of + ok -> + DataDir = ?config(data_dir, Config), + Port = ?config(local_ssl_port, Config), + URL = ?SSL_URL_START ++ integer_to_list(Port) ++ "/dummy.html", + CertFile = filename:join(DataDir, "ssl_client_cert.pem"), + SSLOptions = [{certfile, CertFile}, {keyfile, CertFile}], + SSLConfig = + case SslTag of + ssl -> + SSLOptions; + essl -> + {essl, SSLOptions} + end, + tsp("ssl_trace -> make request using: " + "~n URL: ~p" + "~n SslTag: ~p" + "~n SSLOptions: ~p", [URL, SslTag, SSLOptions]), + case httpc:request(trace, {URL, []}, [{ssl, SSLConfig}], []) of + {ok, {{_,200, _}, [_ | _], "TRACE /dummy.html" ++ _}} -> + ok; + {ok, {{_,200,_}, [_ | _], WrongBody}} -> + tsf({wrong_body, WrongBody}); + {ok, WrongReply} -> + tsf({wrong_reply, WrongReply}); + Error -> + tsf({failed, Error}) + end; + {ok, _} -> + skip("local http-server not started"); + _ -> + skip("SSL not started") + end. + + +%%------------------------------------------------------------------------- +http_redirect(doc) -> + ["Test redirect with dummy server as httpd does not implement" + " server redirect"]; +http_redirect(suite) -> + []; +http_redirect(Config) when is_list(Config) -> + tsp("http_redirect -> entry with" + "~n Config: ~p", [Config]), + case ?config(local_server, Config) of + ok -> + %% tsp("http_redirect -> set ipfamily option to inet"), + %% ok = httpc:set_options([{ipfamily, inet}]), + + tsp("http_redirect -> start dummy server inet"), + {DummyServerPid, Port} = dummy_server(ipv4), + tsp("http_redirect -> server port = ~p", [Port]), + + URL300 = ?URL_START ++ integer_to_list(Port) ++ "/300.html", + + tsp("http_redirect -> issue request 1: " + "~n ~p", [URL300]), + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, {URL300, []}, [], []), + + tsp("http_redirect -> issue request 2: " + "~n ~p", [URL300]), + {ok, {{_,300,_}, [_ | _], _}} = + httpc:request(get, {URL300, []}, [{autoredirect, false}], []), + + URL301 = ?URL_START ++ integer_to_list(Port) ++ "/301.html", + + tsp("http_redirect -> issue request 3: " + "~n ~p", [URL301]), + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, {URL301, []}, [], []), + + tsp("http_redirect -> issue request 4: " + "~n ~p", [URL301]), + {ok, {{_,200,_}, [_ | _], []}} + = httpc:request(head, {URL301, []}, [], []), + + tsp("http_redirect -> issue request 5: " + "~n ~p", [URL301]), + {ok, {{_,301,_}, [_ | _], [_|_]}} + = httpc:request(post, {URL301, [],"text/plain", "foobar"}, + [], []), + + URL302 = ?URL_START ++ integer_to_list(Port) ++ "/302.html", + + tsp("http_redirect -> issue request 6: " + "~n ~p", [URL302]), + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, {URL302, []}, [], []), + case httpc:request(get, {URL302, []}, [], []) of + {ok, Reply7} -> + case Reply7 of + {{_,200,_}, [_ | _], [_|_]} -> + tsp("http_redirect -> " + "expected reply for request 7"), + ok; + {StatusLine, Headers, Body} -> + tsp("http_redirect -> " + "unexpected reply for request 7: " + "~n StatusLine: ~p" + "~n Headers: ~p" + "~n Body: ~p", + [StatusLine, Headers, Body]), + tsf({unexpected_reply, Reply7}) + end; + Error7 -> + tsp("http_redirect -> " + "unexpected result for request 7: " + "~n Error7: ~p", + [Error7]), + tsf({unexpected_result, Error7}) + end, + + tsp("http_redirect -> issue request 7: " + "~n ~p", [URL302]), + {ok, {{_,200,_}, [_ | _], []}} + = httpc:request(head, {URL302, []}, [], []), + + tsp("http_redirect -> issue request 8: " + "~n ~p", [URL302]), + {ok, {{_,302,_}, [_ | _], [_|_]}} + = httpc:request(post, {URL302, [],"text/plain", "foobar"}, + [], []), + + URL303 = ?URL_START ++ integer_to_list(Port) ++ "/303.html", + + tsp("http_redirect -> issue request 9: " + "~n ~p", [URL303]), + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, {URL303, []}, [], []), + + tsp("http_redirect -> issue request 10: " + "~n ~p", [URL303]), + {ok, {{_,200,_}, [_ | _], []}} + = httpc:request(head, {URL303, []}, [], []), + + tsp("http_redirect -> issue request 11: " + "~n ~p", [URL303]), + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(post, {URL303, [],"text/plain", "foobar"}, + [], []), + + URL307 = ?URL_START ++ integer_to_list(Port) ++ "/307.html", + + tsp("http_redirect -> issue request 12: " + "~n ~p", [URL307]), + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, {URL307, []}, [], []), + + tsp("http_redirect -> issue request 13: " + "~n ~p", [URL307]), + {ok, {{_,200,_}, [_ | _], []}} + = httpc:request(head, {URL307, []}, [], []), + + tsp("http_redirect -> issue request 14: " + "~n ~p", [URL307]), + {ok, {{_,307,_}, [_ | _], [_|_]}} + = httpc:request(post, {URL307, [],"text/plain", "foobar"}, + [], []), + + tsp("http_redirect -> stop dummy server"), + DummyServerPid ! stop, + tsp("http_redirect -> reset ipfamily option (to inet6fb4)"), + ok = httpc:set_options([{ipfamily, inet6fb4}]), + tsp("http_redirect -> done"), + ok; + + _ -> + skip("Failed to start local http-server") + end. + + + +%%------------------------------------------------------------------------- +http_redirect_loop(doc) -> + ["Test redirect loop detection"]; +http_redirect_loop(suite) -> + []; +http_redirect_loop(Config) when is_list(Config) -> + ok = httpc:set_options([{ipfamily, inet}]), + {DummyServerPid, Port} = dummy_server(ipv4), + + URL = ?URL_START ++ integer_to_list(Port) ++ "/redirectloop.html", + + {ok, {{_,300,_}, [_ | _], _}} + = httpc:request(get, {URL, []}, [], []), + DummyServerPid ! stop, + ok = httpc:set_options([{ipfamily, inet6fb4}]), + ok. + +%%------------------------------------------------------------------------- +http_internal_server_error(doc) -> + ["Test 50X codes"]; +http_internal_server_error(suite) -> + []; +http_internal_server_error(Config) when is_list(Config) -> + ok = httpc:set_options([{ipfamily, inet}]), + {DummyServerPid, Port} = dummy_server(ipv4), + + URL500 = ?URL_START ++ integer_to_list(Port) ++ "/500.html", + + {ok, {{_,500,_}, [_ | _], _}} + = httpc:request(get, {URL500, []}, [], []), + + + URL503 = ?URL_START ++ integer_to_list(Port) ++ "/503.html", + + %% Used to be able to make the service available after retry. + ets:new(unavailable, [named_table, public, set]), + ets:insert(unavailable, {503, unavailable}), + + {ok, {{_,200, _}, [_ | _], [_|_]}} = + httpc:request(get, {URL503, []}, [], []), + + ets:insert(unavailable, {503, long_unavailable}), + + {ok, {{_,503, _}, [_ | _], [_|_]}} = + httpc:request(get, {URL503, []}, [], []), + + ets:delete(unavailable), + DummyServerPid ! stop, + ok = httpc:set_options([{ipfamily, inet6fb4}]), + ok. + + +%%------------------------------------------------------------------------- +http_userinfo(doc) -> + ["Test user info e.i. http://user:passwd@host:port/"]; +http_userinfo(suite) -> + []; +http_userinfo(Config) when is_list(Config) -> + ok = httpc:set_options([{ipfamily, inet}]), + + {DummyServerPid, Port} = dummy_server(ipv4), + + URLAuth = "http://alladin:sesame@localhost:" + ++ integer_to_list(Port) ++ "/userinfo.html", + + {ok, {{_,200,_}, [_ | _], _}} + = httpc:request(get, {URLAuth, []}, [], []), + + URLUnAuth = "http://alladin:foobar@localhost:" + ++ integer_to_list(Port) ++ "/userinfo.html", + + {ok, {{_,401, _}, [_ | _], _}} = + httpc:request(get, {URLUnAuth, []}, [], []), + + DummyServerPid ! stop, + ok = httpc:set_options([{ipfamily, inet6fb4}]), + ok. + + +%%------------------------------------------------------------------------- +http_cookie(doc) -> + ["Test cookies."]; +http_cookie(suite) -> + []; +http_cookie(Config) when is_list(Config) -> + ok = httpc:set_options([{cookies, enabled}, {ipfamily, inet}]), + {DummyServerPid, Port} = dummy_server(ipv4), + + URLStart = ?URL_START + ++ integer_to_list(Port), + + URLCookie = URLStart ++ "/cookie.html", + + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, {URLCookie, []}, [], []), + + ets:new(cookie, [named_table, public, set]), + ets:insert(cookie, {cookies, true}), + + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, {URLStart ++ "/", []}, [], []), + + ets:delete(cookie), + + ok = httpc:set_options([{cookies, disabled}]), + DummyServerPid ! stop, + ok = httpc:set_options([{ipfamily, inet6fb4}]), + ok. + +%%------------------------------------------------------------------------- +http_server_does_not_exist(doc) -> + ["Test that we get an error message back when the server " + "does note exist."]; +http_server_does_not_exist(suite) -> + []; +http_server_does_not_exist(Config) when is_list(Config) -> + {error, _} = + httpc:request(get, {"http://localhost:" ++ + integer_to_list(?NOT_IN_USE_PORT) + ++ "/", []},[], []), + ok. + + +%%------------------------------------------------------------------------- +page_does_not_exist(doc) -> + ["Test that we get a 404 when the page is not found."]; +page_does_not_exist(suite) -> + []; +page_does_not_exist(Config) when is_list(Config) -> + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/doesnotexist.html", + {ok, {{_,404,_}, [_ | _], [_ | _]}} + = httpc:request(get, {URL, []}, [], []), + ok. + + +%%------------------------------------------------------------------------- + +http_stream(doc) -> + ["Test the option stream for asynchrony requests"]; +http_stream(suite) -> + []; +http_stream(Config) when is_list(Config) -> + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + {ok, {{_,200,_}, [_ | _], Body}} = + httpc:request(get, {URL, []}, [], []), + + {ok, RequestId} = + httpc:request(get, {URL, []}, [], [{sync, false}, + {stream, self}]), + + receive + {http, {RequestId, stream_start, _Headers}} -> + ok; + {http, Msg} -> + tsf(Msg) + end, + + StreamedBody = receive_streamed_body(RequestId, <<>>), + + Body == binary_to_list(StreamedBody). + + +%%------------------------------------------------------------------------- + +http_stream_once(doc) -> + ["Test the option stream for asynchrony requests"]; +http_stream_once(suite) -> + []; +http_stream_once(Config) when is_list(Config) -> + p("http_stream_once -> entry with" + "~n Config: ~p", [Config]), + + p("http_stream_once -> set ipfamily to inet", []), + ok = httpc:set_options([{ipfamily, inet}]), + p("http_stream_once -> start dummy server", []), + {DummyServerPid, Port} = dummy_server(ipv4), + + PortStr = integer_to_list(Port), + p("http_stream_once -> once", []), + once(?URL_START ++ PortStr ++ "/once.html"), + p("http_stream_once -> once_chunked", []), + once(?URL_START ++ PortStr ++ "/once_chunked.html"), + p("http_stream_once -> dummy", []), + once(?URL_START ++ PortStr ++ "/dummy.html"), + + p("http_stream_once -> stop dummy server", []), + DummyServerPid ! stop, + p("http_stream_once -> set ipfamily to inet6fb4", []), + ok = httpc:set_options([{ipfamily, inet6fb4}]), + p("http_stream_once -> done", []), + ok. + +once(URL) -> + p("once -> issue sync request for ~p", [URL]), + {ok, {{_,200,_}, [_ | _], Body}} = + httpc:request(get, {URL, []}, [], []), + + p("once -> issue async (self stream) request for ~p", [URL]), + {ok, RequestId} = + httpc:request(get, {URL, []}, [], [{sync, false}, + {stream, {self, once}}]), + + p("once -> await stream_start reply for (async) request ~p", [RequestId]), + NewPid = + receive + {http, {RequestId, stream_start, _Headers, Pid}} -> + p("once -> received stream_start reply for (async) request ~p: ~p", + [RequestId, Pid]), + Pid; + {http, Msg} -> + tsf(Msg) + end, + + tsp("once -> request handler: ~p", [NewPid]), + + p("once -> await stream reply for (async) request ~p", [RequestId]), + BodyPart = + receive + {http, {RequestId, stream, BinBodyPart}} -> + p("once -> received stream reply for (async) request ~p: " + "~n~p", [RequestId, binary_to_list(BinBodyPart)]), + BinBodyPart + end, + + tsp("once -> first body part '~p' received", [binary_to_list(BodyPart)]), + + StreamedBody = receive_streamed_body(RequestId, BinBodyPart, NewPid), + + Body = binary_to_list(StreamedBody), + + p("once -> done when Bode: ~p", [Body]), + ok. + + +%%------------------------------------------------------------------------- +parse_url(doc) -> + ["Test that an url is parsed correctly"]; +parse_url(suite) -> + []; +parse_url(Config) when is_list(Config) -> + %% ipv6 + {ok, {http,[],"2010:836B:4179::836B:4179",80,"/foobar.html",[]}} = + http_uri:parse("http://[2010:836B:4179::836B:4179]/foobar.html"), + {ok, {http,[],"[2010:836B:4179::836B:4179]",80,"/foobar.html",[]}} = + http_uri:parse("http://[2010:836B:4179::836B:4179]/foobar.html", + [{ipv6_host_with_brackets, true}]), + {ok, {http,[],"2010:836B:4179::836B:4179",80,"/foobar.html",[]}} = + http_uri:parse("http://[2010:836B:4179::836B:4179]/foobar.html", + [{ipv6_host_with_brackets, false}]), + {ok, {http,[],"2010:836B:4179::836B:4179",80,"/foobar.html",[]}} = + http_uri:parse("http://[2010:836B:4179::836B:4179]/foobar.html", + [{foo, false}]), + {error, + {malformed_url, _, "http://2010:836B:4179::836B:4179/foobar.html"}} = + http_uri:parse("http://2010:836B:4179::836B:4179/foobar.html"), + + %% ipv4 + {ok, {http,[],"127.0.0.1",80,"/foobar.html",[]}} = + http_uri:parse("http://127.0.0.1/foobar.html"), + + %% host + {ok, {http,[],"localhost",8888,"/foobar.html",[]}} = + http_uri:parse("http://localhost:8888/foobar.html"), + + %% Userinfo + {ok, {http,"nisse:foobar","localhost",8888,"/foobar.html",[]}} = + http_uri:parse("http://nisse:foobar@localhost:8888/foobar.html"), + + %% Scheme error + {error, no_scheme} = http_uri:parse("localhost/foobar.html"), + {error, {malformed_url, _, _}} = + http_uri:parse("localhost:8888/foobar.html"), + + %% Query + {ok, {http,[],"localhost",8888,"/foobar.html","?foo=bar&foobar=42"}} = + http_uri:parse("http://localhost:8888/foobar.html?foo=bar&foobar=42"), + + %% Esc chars + {ok, {http,[],"www.somedomain.com",80,"/%2Eabc",[]}} = + http_uri:parse("http://www.somedomain.com/%2Eabc"), + {ok, {http,[],"www.somedomain.com",80,"/%252Eabc",[]}} = + http_uri:parse("http://www.somedomain.com/%252Eabc"), + {ok, {http,[],"www.somedomain.com",80,"/%25abc",[]}} = + http_uri:parse("http://www.somedomain.com/%25abc"), + {ok, {http,[],"www.somedomain.com",80,"/%25abc", "?foo=bar"}} = + http_uri:parse("http://www.somedomain.com/%25abc?foo=bar"), + + + ok. + + +%%------------------------------------------------------------------------- + +ipv6_ipcomm() -> + [{require, ipv6_hosts}]. +ipv6_ipcomm(doc) -> + ["Test ip_comm ipv6."]; +ipv6_ipcomm(suite) -> + []; +ipv6_ipcomm(Config) when is_list(Config) -> + HTTPOptions = [], + SocketType = ip_comm, + Scheme = "http", + Extra = [], + ipv6(SocketType, Scheme, HTTPOptions, Extra, Config). + + +%%------------------------------------------------------------------------- + +ipv6_essl() -> + [{require, ipv6_hosts}]. +ipv6_essl(doc) -> + ["Test essl ipv6."]; +ipv6_essl(suite) -> + []; +ipv6_essl(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + CertFile = filename:join(DataDir, "ssl_client_cert.pem"), + SSLOptions = [{certfile, CertFile}, {keyfile, CertFile}], + SSLConfig = {essl, SSLOptions}, + tsp("ssl_ipv6 -> make request using: " + "~n SSLOptions: ~p", [SSLOptions]), + HTTPOptions = [{ssl, SSLConfig}], + SocketType = essl, + Scheme = "https", + Extra = SSLOptions, + ipv6(SocketType, Scheme, HTTPOptions, Extra, Config). + + +%%------------------------------------------------------------------------- + +ipv6(SocketType, Scheme, HTTPOptions, Extra, Config) -> + %% Check if we are a IPv6 host + tsp("ipv6 -> verify ipv6 support"), + case inets_test_lib:has_ipv6_support(Config) of + {ok, Addr} -> + tsp("ipv6 -> ipv6 supported: ~p", [Addr]), + {DummyServerPid, Port} = dummy_server(SocketType, ipv6, Extra), + Profile = ?config(profile, Config), + URL = + Scheme ++ + "://[" ++ http_transport:ipv6_name(Addr) ++ "]:" ++ + integer_to_list(Port) ++ "/foobar.html", + tsp("ipv6 -> issue request with: " + "~n URL: ~p" + "~n HTTPOptions: ~p", [URL, HTTPOptions]), + case httpc:request(get, {URL, []}, HTTPOptions, [], Profile) of + {ok, {{_,200,_}, [_ | _], [_|_]}} -> + tsp("ipv6 -> expected result"), + DummyServerPid ! stop, + ok; + {ok, Unexpected} -> + tsp("ipv6 -> unexpected result: " + "~n ~p", [Unexpected]), + DummyServerPid ! stop, + tsf({unexpected_result, Unexpected}); + {error, Reason} -> + tsp("ipv6 -> error: " + "~n Reason: ~p", [Reason]), + DummyServerPid ! stop, + tsf(Reason) + end, + ok; + _ -> + tsp("ipv6 -> ipv6 not supported"), + skip("Host does not support IPv6") + end. + + +%%------------------------------------------------------------------------- + +headers_as_is(doc) -> + ["Test the option headers_as_is"]; +headers_as_is(suite) -> + []; +headers_as_is(Config) when is_list(Config) -> + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + {ok, {{_,200,_}, [_|_], [_|_]}} = + httpc:request(get, {URL, [{"Host", "localhost"},{"Te", ""}]}, + [], [{headers_as_is, true}]), + + {ok, {{_,400,_}, [_|_], [_|_]}} = + httpc:request(get, {URL, [{"Te", ""}]},[], [{headers_as_is, true}]), + ok. + + +%%------------------------------------------------------------------------- + +selecting_session(doc) -> + ["Test selection of sessions - OTP-9847"]; +selecting_session(suite) -> + []; +selecting_session(Config) when is_list(Config) -> + tsp("selecting_session -> entry with" + "~n Config: ~p", [Config]), + + tsp("selecting_session -> set ipfamily to inet"), + ok = httpc:set_options([{ipfamily, inet}]), + + tsp("selecting_session -> start server"), + {ServerPid, Port} = otp_9847_server(), + + PortStr = integer_to_list(Port), + URL = ?URL_START ++ PortStr ++ "/index.html", + + tsp("selecting_session -> issue the first batch (three) requests"), + lists:foreach(fun(P) -> + tsp("selecting_session:fun1 -> " + "send stop request to ~p", [P]), + P ! stop + end, + reqs(URL, ServerPid, 3, 3, false)), + tsp("selecting_session -> sleep some (1) to make sure nothing lingers"), + ?SLEEP(5000), + tsp("selecting_session -> " + "instruct the server to reply to the first request"), + ServerPid ! {answer, true}, + receive + {answer, true} -> + tsp("selecting_session -> " + "received ack from server to reply to the first request"), + ok + end, + tsp("selecting_session -> issue the second batch (four) requests"), + lists:foreach(fun(P) -> + tsp("selecting_session:fun2 -> " + "send stop request to ~p", [P]), + P ! stop + end, + reqs(URL, ServerPid, 4, 1, true)), + tsp("selecting_session -> sleep some (2) to make sure nothing lingers"), + ?SLEEP(5000), + + tsp("selecting_session -> stop server"), + ServerPid ! stop, + tsp("selecting_session -> set ipfamily (back) to inet6fb4"), + ok = httpc:set_options([{ipfamily, inet6fb4}]), + tsp("selecting_session -> done"), + ok. + +reqs(URL, ServerPid, NumReqs, NumHandlers, InitialSync) -> + tsp("reqs -> entry with" + "~n URL: ~p" + "~n ServerPid: ~w" + "~n NumReqs: ~w" + "~n NumHandlers: ~w" + "~n InitialSync: ~w", + [URL, ServerPid, NumReqs, NumHandlers, InitialSync]), + Handlers = reqs2(URL, NumReqs, [], InitialSync), + tsp("reqs -> " + "~n Handlers: ~w", [Handlers]), + case length(Handlers) of + NumHandlers -> + tsp("reqs -> " + "~n NumHandlers: ~w", [NumHandlers]), + ServerPid ! num_handlers, + receive + {num_handlers, NumHandlers} -> + tsp("reqs -> received num_handlers with" + "~n NumHandlers: ~w", [NumHandlers]), + Handlers; + {num_handlers, WrongNumHandlers} -> + tsp("reqs -> received num_handlers with" + "~n WrongNumHandlers: ~w", [WrongNumHandlers]), + exit({wrong_num_handlers1, WrongNumHandlers, NumHandlers}) + end; + WrongNumHandlers -> + tsp("reqs -> " + "~n WrongNumHandlers: ~w", [WrongNumHandlers]), + exit({wrong_num_handlers2, WrongNumHandlers, NumHandlers}) + end. + + +reqs2(_URL, 0, Acc, _Sync) -> + lists:reverse(Acc); +reqs2(URL, Num, Acc, Sync) -> + tsp("reqs2 -> entry with" + "~n Num: ~w" + "~n Sync: ~w", [Num, Sync]), + case httpc:request(get, {URL, []}, [], [{sync, Sync}]) of + {ok, _Reply} -> + tsp("reqs2 -> successful request: ~p", [_Reply]), + receive + {handler, Handler, _Manager} -> + %% This is when a new handler is created + tsp("reqs2 -> received handler: ~p", [Handler]), + case lists:member(Handler, Acc) of + true -> + tsp("reqs2 -> duplicate handler"), + exit({duplicate_handler, Handler, Num, Acc}); + false -> + tsp("reqs2 -> wait for data ack"), + receive + {data_received, Handler} -> + tsp("reqs2 -> " + "received data ack from ~p", [Handler]), + case Sync of + true -> + reqs2(URL, Num-1, [Handler|Acc], + false); + false -> + reqs2(URL, Num-1, [Handler|Acc], + Sync) + end + end + end; + + {data_received, Handler} -> + tsp("reqs2 -> " + "received data ack from ~p", [Handler]), + reqs2(URL, Num-1, Acc, false) + + end; + + {error, Reason} -> + tsp("reqs2 -> request ~w failed: ~p", [Num, Reason]), + exit({request_failed, Reason, Num, Acc}) + end. + +otp_9847_server() -> + TC = self(), + Pid = spawn_link(fun() -> otp_9847_server_init(TC) end), + receive + {port, Port} -> + {Pid, Port} + end. + +otp_9847_server_init(TC) -> + tsp("otp_9847_server_init -> entry with" + "~n TC: ~p", [TC]), + {ok, ListenSocket} = + gen_tcp:listen(0, [binary, inet, {packet, 0}, + {reuseaddr,true}, + {active, false}]), + tsp("otp_9847_server_init -> listen socket created: " + "~n ListenSocket: ~p", [ListenSocket]), + {ok, Port} = inet:port(ListenSocket), + tsp("otp_9847_server_init -> Port: ~p", [Port]), + TC ! {port, Port}, + otp_9847_server_main(TC, ListenSocket, false, []). + +otp_9847_server_main(TC, ListenSocket, Answer, Handlers) -> + tsp("otp_9847_server_main -> entry with" + "~n TC: ~p" + "~n ListenSocket: ~p" + "~n Answer: ~p" + "~n Handlers: ~p", [TC, ListenSocket, Answer, Handlers]), + case gen_tcp:accept(ListenSocket, 1000) of + {ok, Sock} -> + tsp("otp_9847_server_main -> accepted" + "~n Sock: ~p", [Sock]), + {Handler, Mon, Port} = otp_9847_handler(TC, Sock, Answer), + tsp("otp_9847_server_main -> handler ~p created for ~w", + [Handler, Port]), + gen_tcp:controlling_process(Sock, Handler), + tsp("otp_9847_server_main -> control transfer"), + Handler ! owner, + tsp("otp_9847_server_main -> " + "handler ~p informed of owner transfer", [Handler]), + TC ! {handler, Handler, self()}, + tsp("otp_9847_server_main -> " + "TC ~p informed of handler ~p", [TC, Handler]), + otp_9847_server_main(TC, ListenSocket, Answer, + [{Handler, Mon, Sock, Port}|Handlers]); + + {error, timeout} -> + tsp("otp_9847_server_main -> timeout"), + receive + {answer, true} -> + tsp("otp_9847_server_main -> received answer request"), + TC ! {answer, true}, + otp_9847_server_main(TC, ListenSocket, true, Handlers); + + {'DOWN', _Mon, process, Pid, _Reason} -> + %% Could be one of the handlers + tsp("otp_9847_server_main -> received DOWN for ~p", [Pid]), + otp_9847_server_main(TC, ListenSocket, Answer, + lists:keydelete(Pid, 1, Handlers)); + + num_handlers -> + tsp("otp_9847_server_main -> " + "received request for number of handlers (~w)", + [length(Handlers)]), + TC ! {num_handlers, length(Handlers)}, + otp_9847_server_main(TC, ListenSocket, Answer, Handlers); + + stop -> + tsp("otp_9847_server_main -> received stop request"), + %% Stop all handlers (just in case) + Pids = [Handler || {Handler, _, _} <- Handlers], + lists:foreach(fun(Pid) -> Pid ! stop end, Pids), + exit(normal); + + Any -> + tsp("otp_9847_server_main -> received" + "~n Any: ~p", [Any]), + exit({crap, Any}) + + after 0 -> + tsp("otp_9847_server_main -> nothing in queue"), + otp_9847_server_main(TC, ListenSocket, Answer, Handlers) + end; + + Error -> + exit(Error) + end. + + +otp_9847_handler(TC, Sock, Answer) -> + tsp("otp_9847_handler -> entry with" + "~n TC: ~p" + "~n Sock: ~p" + "~n Answer: ~p", [TC, Sock, Answer]), + Self = self(), + {Pid, Mon} = + spawn_opt(fun() -> + otp_9847_handler_init(TC, Self, Sock, Answer) + end, + [monitor]), + receive + {port, Port} -> + tsp("otp_9847_handler -> received port message (from ~p)" + "~n Port: ~p", [Pid, Port]), + {Pid, Mon, Port} + end. + + +otp_9847_handler_init(TC, Server, Sock, Answer) -> + tsp("otp_9847_handler_init -> entry with" + "~n TC: ~p" + "~n Server: ~p" + "~n Sock: ~p" + "~n Answer: ~p", [TC, Server, Sock, Answer]), + {ok, Port} = inet:port(Sock), + Server ! {port, Port}, + receive + owner -> + tsp("otp_9847_handler_init -> " + "received owner message - activate socket"), + inet:setopts(Sock, [{active, true}]), + otp_9847_handler_main(TC, Server, Sock, Answer, [?HTTP_MAX_HEADER_SIZE]) + end. + +otp_9847_handler_main(TC, Server, Sock, Answer, ParseArgs) -> + tsp("otp_9847_handler_main -> entry with" + "~n TC: ~p" + "~n Server: ~p" + "~n Sock: ~p" + "~n Answer: ~p" + "~n ParseArgs: ~p", [TC, Server, Sock, Answer, ParseArgs]), + receive + stop -> + tsp("otp_9847_handler_main -> received stop request"), + exit(normal); + + {tcp, Sock, _Data} when Answer =:= false -> + tsp("otp_9847_handler_main -> received tcp data - no answer"), + TC ! {data_received, self()}, + inet:setopts(Sock, [{active, true}]), + %% Ignore all data + otp_9847_handler_main(TC, Server, Sock, Answer, ParseArgs); + + {tcp, Sock, Data} when Answer =:= true -> + tsp("otp_9847_handler_main -> received tcp data - answer"), + TC ! {data_received, self()}, + inet:setopts(Sock, [{active, true}]), + NewParseArgs = otp_9847_handler_request(Sock, [Data|ParseArgs]), + otp_9847_handler_main(TC, Server, Sock, Answer, NewParseArgs); + + {tcp_closed, Sock} -> + tsp("otp_9847_handler_main -> received tcp socket closed"), + exit(normal); + + {tcp_error, Sock, Reason} -> + tsp("otp_9847_handler_main -> socket error: ~p", [Reason]), + (catch gen_tcp:close(Sock)), + exit(normal) + + %% after 30000 -> + %% gen_tcp:close(Sock), + %% exit(normal) + end. + +otp_9847_handler_request(Sock, Args) -> + Msg = + case httpd_request:parse(Args) of + {ok, {_, "/index.html" = _RelUrl, _, _, _}} -> + B = + "<HTML><BODY>" ++ + "...some body part..." ++ + "</BODY></HTML>", + Len = integer_to_list(length(B)), + "HTTP/1.1 200 ok\r\n" ++ + "Content-Length:" ++ Len ++ "\r\n\r\n" ++ B + end, + gen_tcp:send(Sock, Msg), + [?HTTP_MAX_HEADER_SIZE]. + + + +%%------------------------------------------------------------------------- + +options(doc) -> + ["Test the option parameters."]; +options(suite) -> + []; +options(Config) when is_list(Config) -> + case ?config(local_server, Config) of + ok -> + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + {ok, {{_,200,_}, [_ | _], Bin}} + = httpc:request(get, {URL, []}, [{foo, bar}], + %% Ignore unknown options + [{body_format, binary}, {foo, bar}]), + + true = is_binary(Bin), + {ok, {200, [_|_]}} + = httpc:request(get, {URL, []}, [{timeout, infinity}], + [{full_result, false}]); + _ -> + skip("Failed to start local http-server") + end. + + +%%------------------------------------------------------------------------- + +http_invalid_http(doc) -> + ["Test parse error"]; +http_invalid_http(suite) -> + []; +http_invalid_http(Config) when is_list(Config) -> + ok = httpc:set_options([{ipfamily, inet}]), + {DummyServerPid, Port} = dummy_server(ipv4), + + URL = ?URL_START ++ integer_to_list(Port) ++ "/invalid_http.html", + + {error, {could_not_parse_as_http, _} = Reason} = + httpc:request(get, {URL, []}, [], []), + + test_server:format("Parse error: ~p ~n", [Reason]), + DummyServerPid ! stop, + ok = httpc:set_options([{ipfamily, inet6fb4}]), + ok. + + +%%------------------------------------------------------------------------- + +-define(GOOGLE, "www.google.com"). + +hexed_query_otp_6191(doc) -> + []; +hexed_query_otp_6191(suite) -> + []; +hexed_query_otp_6191(Config) when is_list(Config) -> + Google = ?GOOGLE, + GoogleSearch = "http://" ++ Google ++ "/search", + Search1 = "?hl=en&q=a%D1%85%D1%83%D0%B9&btnG=Google+Search", + URI1 = GoogleSearch ++ Search1, + Search2 = "?hl=en&q=%25%25", + URI2 = GoogleSearch ++ Search2, + Search3 = "?hl=en&q=%foo", + URI3 = GoogleSearch ++ Search3, + + Verify1 = + fun({http, [], ?GOOGLE, 80, "/search", _}) -> ok; + (_) -> error + end, + Verify2 = Verify1, + Verify3 = Verify1, + verify_uri(URI1, Verify1), + verify_uri(URI2, Verify2), + verify_uri(URI3, Verify3), + ok. + +verify_uri(URI, Verify) -> + case http_uri:parse(URI) of + {ok, ParsedURI} -> + case Verify(ParsedURI) of + ok -> + ok; + error -> + Reason = {unexpected_parse_result, URI, ParsedURI}, + ERROR = {error, Reason}, + throw(ERROR) + end; + {error, _} = ERROR -> + throw(ERROR) + end. + + +%%------------------------------------------------------------------------- + +empty_body_otp_6243(doc) -> + ["An empty body was not returned directly. There was a delay for several" + "seconds."]; +empty_body_otp_6243(suite) -> + []; +empty_body_otp_6243(Config) when is_list(Config) -> + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/empty.html", + {ok, {{_,200,_}, [_ | _], []}} = + httpc:request(get, {URL, []}, [{timeout, 500}], []). + + +%%------------------------------------------------------------------------- + +transfer_encoding_otp_6807(doc) -> + ["Transfer encoding is case insensitive"]; +transfer_encoding_otp_6807(suite) -> + []; +transfer_encoding_otp_6807(Config) when is_list(Config) -> + ok = httpc:set_options([{ipfamily, inet}]), + {DummyServerPid, Port} = dummy_server(ipv4), + + URL = ?URL_START ++ integer_to_list(Port) ++ + "/capital_transfer_encoding.html", + {ok, {{_,200,_}, [_|_], [_ | _]}} = httpc:request(URL), + DummyServerPid ! stop, + ok = httpc:set_options([{ipfamily, inet6fb4}]), + ok. + + +%%------------------------------------------------------------------------- + +empty_response_header_otp_6830(doc) -> + ["Test the case that the HTTP server does not send any headers"]; +empty_response_header_otp_6830(suite) -> + []; +empty_response_header_otp_6830(Config) when is_list(Config) -> + ok = httpc:set_options([{ipfamily, inet}]), + {DummyServerPid, Port} = dummy_server(ipv4), + + URL = ?URL_START ++ integer_to_list(Port) ++ "/no_headers.html", + {ok, {{_,200,_}, [], [_ | _]}} = httpc:request(URL), + DummyServerPid ! stop, + ok = httpc:set_options([{ipfamily, inet6fb4}]), + ok. + + +%%------------------------------------------------------------------------- + +no_content_204_otp_6982(doc) -> + ["Test the case that the HTTP 204 no content header"]; +no_content_204_otp_6982(suite) -> + []; +no_content_204_otp_6982(Config) when is_list(Config) -> + ok = httpc:set_options([{ipfamily, inet}]), + {DummyServerPid, Port} = dummy_server(ipv4), + + URL = ?URL_START ++ integer_to_list(Port) ++ "/no_content.html", + {ok, {{_,204,_}, [], []}} = httpc:request(URL), + DummyServerPid ! stop, + ok = httpc:set_options([{ipfamily, inet6fb4}]), + ok. + + +%%------------------------------------------------------------------------- + +missing_CR_otp_7304(doc) -> + ["Test the case that the HTTP server uses only LF instead of CRLF" + "as delimitor"]; +missing_CR_otp_7304(suite) -> + []; +missing_CR_otp_7304(Config) when is_list(Config) -> + ok = httpc:set_options([{ipfamily, inet}]), + {DummyServerPid, Port} = dummy_server(ipv4), + + URL = ?URL_START ++ integer_to_list(Port) ++ "/missing_CR.html", + {ok, {{_,200,_}, _, [_ | _]}} = httpc:request(URL), + DummyServerPid ! stop, + ok = httpc:set_options([{ipfamily, inet6fb4}]), + ok. + + +%%------------------------------------------------------------------------- + + +otp_7883_1(doc) -> + ["OTP-7883-sync"]; +otp_7883_1(suite) -> + []; +otp_7883_1(Config) when is_list(Config) -> + ok = httpc:set_options([{ipfamily, inet}]), + + {DummyServerPid, Port} = dummy_server(ipv4), + + URL = ?URL_START ++ integer_to_list(Port) ++ "/just_close.html", + {error, socket_closed_remotely} = httpc:request(URL), + DummyServerPid ! stop, + + ok = httpc:set_options([{ipfamily, inet6fb4}]), + ok. + +otp_7883_2(doc) -> + ["OTP-7883-async"]; +otp_7883_2(suite) -> + []; +otp_7883_2(Config) when is_list(Config) -> + ok = httpc:set_options([{ipfamily, inet}]), + + {DummyServerPid, Port} = dummy_server(ipv4), + + URL = ?URL_START ++ integer_to_list(Port) ++ "/just_close.html", + Method = get, + Request = {URL, []}, + HttpOptions = [], + Options = [{sync, false}], + Profile = httpc:default_profile(), + {ok, RequestId} = + httpc:request(Method, Request, HttpOptions, Options, Profile), + ok = + receive + {http, {RequestId, {error, socket_closed_remotely}}} -> + ok + end, + DummyServerPid ! stop, + + ok = httpc:set_options([{ipfamily, inet6fb4}]), + ok. + + +%%------------------------------------------------------------------------- + + +otp_8154_1(doc) -> + ["OTP-8154"]; +otp_8154_1(suite) -> + []; +otp_8154_1(Config) when is_list(Config) -> + start_inets(), + ReqSeqNumServer = start_sequence_number_server(), + RespSeqNumServer = start_sequence_number_server(), + {ok, Server, Port} = start_slow_server(RespSeqNumServer), + Clients = run_clients(105, Port, ReqSeqNumServer), + %% ok = wait_for_clients(Clients), + ok = wait4clients(Clients, timer:minutes(3)), + Server ! shutdown, + RespSeqNumServer ! shutdown, + ReqSeqNumServer ! shutdown, + ok. + +start_inets() -> + inets:start(), + ok. + + +%% ----------------------------------------------------- +%% A sequence number handler +%% The purpose is to be able to pair requests with responses. + +start_sequence_number_server() -> + proc_lib:spawn(fun() -> loop_sequence_number(1) end). + +loop_sequence_number(N) -> + receive + shutdown -> + ok; + {From, get_next} -> + From ! {next_is, N}, + loop_sequence_number(N + 1) + end. + +get_next_sequence_number(SeqNumServer) -> + SeqNumServer ! {self(), get_next}, + receive {next_is, N} -> N end. + +%% ----------------------------------------------------- +%% Client part +%% Sends requests randomly parallel + +run_clients(NumClients, ServerPort, SeqNumServer) -> + io:format("start clients when" + "~n NumClients: ~w" + "~n ServerPort: ~w" + "~n SeqNumServer: ~w" + "~n", [NumClients, ServerPort, SeqNumServer]), + set_random_seed(), + lists:map( + fun(Id) -> + io:format("starting client ~w~n", [Id]), + Req = f("req~3..0w", [get_next_sequence_number(SeqNumServer)]), + Url = f(?URL_START ++ "~w/~s", [ServerPort, Req]), + Pid = proc_lib:spawn( + fun() -> + io:format("[~w] client started - " + "issue request~n", [Id]), + case httpc:request(Url) of + {ok, {{_,200,_}, _, Resp}} -> + io:format("[~w] 200 response: " + "~p~n", [Id, Resp]), + case lists:prefix(Req++"->", Resp) of + true -> exit(normal); + false -> exit({bad_resp,Req,Resp}) + end; + {ok, {{_,EC,Reason},_,Resp}} -> + io:format("[~w] ~w response: " + "~s~n~s~n", + [Id, EC, Reason, Resp]), + exit({bad_resp,Req,Resp}); + Crap -> + io:format("[~w] bad response: ~p", + [Id, Crap]), + exit({bad_resp, Req, Crap}) + end + end), + MRef = erlang:monitor(process, Pid), + timer:sleep(10 + random:uniform(1334)), + {Id, Pid, MRef} + + end, + lists:seq(1, NumClients)). + +%% wait_for_clients(Clients) -> +%% lists:foreach( +%% fun({Id, Pid, MRef}) -> +%% io:format("waiting for client ~w termination~n", [Id]), +%% receive +%% {'DOWN', MRef, process, Pid, normal} -> +%% io:format("waiting for clients: " +%% "normal exit from ~w (~p)~n", +%% [Id, Pid]), +%% ok; +%% {'DOWN', MRef, process, Pid, Reason} -> +%% io:format("waiting for clients: " +%% "unexpected exit from ~w (~p):" +%% "~n Reason: ~p" +%% "~n", [Id, Pid, Reason]), +%% erlang:error(Reason) +%% end +%% end, +%% Clients). + + +wait4clients([], _Timeout) -> + ok; +wait4clients(Clients, Timeout) when Timeout > 0 -> + io:format("wait4clients -> entry with" + "~n length(Clients): ~w" + "~n Timeout: ~w" + "~n", [length(Clients), Timeout]), + T = t(), + receive + {'DOWN', _MRef, process, Pid, normal} -> + case lists:keysearch(Pid, 2, Clients) of + {value, {Id, _, _}} -> + io:format("receive normal exit message " + "from client ~p (~p)", [Id, Pid]), + NewClients = + lists:keydelete(Id, 1, Clients), + wait4clients(NewClients, + Timeout - (t() - T)); + false -> + io:format("receive normal exit message " + "from unknown process: ~p", [Pid]), + wait4clients(Clients, Timeout - (t() - T)) + end; + + {'DOWN', _MRef, process, Pid, Reason} -> + case lists:keysearch(Pid, 2, Clients) of + {value, {Id, _, _}} -> + io:format("receive bad exit message " + "from client ~p (~p):" + "~n ~p", [Id, Pid, Reason]), + erlang:error({bad_client_termination, Id, Reason}); + false -> + io:format("receive normal exit message " + "from unknown process: ~p", [Pid]), + wait4clients(Clients, Timeout - (t() - T)) + end + + after Timeout -> + erlang:error({client_timeout, Clients}) + end; +wait4clients(Clients, _) -> + erlang:error({client_timeout, Clients}). + + +%% Time in milli seconds +t() -> + {A,B,C} = erlang:now(), + A*1000000000+B*1000+(C div 1000). + + +%% ----------------------------------------------------- +%% Webserver part: +%% Implements a web server that sends responses one character +%% at a time, with random delays between the characters. + +start_slow_server(SeqNumServer) -> + io:format("start slow server when" + "~n SeqNumServer: ~w" + "~n", [SeqNumServer]), + proc_lib:start( + erlang, apply, [fun() -> init_slow_server(SeqNumServer) end, []]). + +init_slow_server(SeqNumServer) -> + io:format("[webserver ~w] init slow server" + "~n", [SeqNumServer]), + {ok, LSock} = gen_tcp:listen(0, [binary, {packet,0}, {active,true}, + {backlog, 100}]), + io:format("[webserver ~w] LSock: ~p" + "~n", [SeqNumServer, LSock]), + {ok, {_IP, Port}} = inet:sockname(LSock), + io:format("[webserver ~w] Port: ~w" + "~n", [SeqNumServer, Port]), + proc_lib:init_ack({ok, self(), Port}), + loop_slow_server(LSock, SeqNumServer). + +loop_slow_server(LSock, SeqNumServer) -> + io:format("[webserver ~w] entry with" + "~n LSock: ~p" + "~n", [SeqNumServer, LSock]), + Master = self(), + Acceptor = proc_lib:spawn( + fun() -> client_handler(Master, LSock, SeqNumServer) end), + io:format("[webserver ~w] acceptor started" + "~n Acceptor: ~p" + "~n", [SeqNumServer, Acceptor]), + receive + {accepted, Acceptor} -> + io:format("[webserver ~w] accepted" + "~n", [SeqNumServer]), + loop_slow_server(LSock, SeqNumServer); + shutdown -> + gen_tcp:close(LSock), + exit(Acceptor, kill) + end. + + +%% Handle one client connection +client_handler(Master, LSock, SeqNumServer) -> + io:format("[acceptor ~w] await accept" + "~n", [SeqNumServer]), + {ok, CSock} = gen_tcp:accept(LSock), + io:format("[acceptor ~w] accepted" + "~n CSock: ~p" + "~n", [SeqNumServer, CSock]), + Master ! {accepted, self()}, + set_random_seed(), + loop_client(1, CSock, SeqNumServer). + +loop_client(N, CSock, SeqNumServer) -> + %% Await request, don't bother parsing it too much, + %% assuming the entire request arrives in one packet. + io:format("[acceptor ~w] await request" + "~n N: ~p" + "~n", [SeqNumServer, N]), + receive + {tcp, CSock, Req} -> + ReqNum = parse_req_num(Req), + RespSeqNum = get_next_sequence_number(SeqNumServer), + Response = f("~s->resp~3..0w/~2..0w", [ReqNum, RespSeqNum, N]), + Txt = f("Slow server (~p) got ~p, answering with ~p", + [self(), Req, Response]), + io:format("~s...~n", [Txt]), + slowly_send_response(CSock, Response), + case parse_connection_type(Req) of + keep_alive -> + io:format("~s...done~n", [Txt]), + loop_client(N+1, CSock, SeqNumServer); + close -> + io:format("~s...done (closing)~n", [Txt]), + gen_tcp:close(CSock) + end + end. + +slowly_send_response(CSock, Answer) -> + Response = f("HTTP/1.1 200 OK\r\nContent-Length: ~w\r\n\r\n~s", + [length(Answer), Answer]), + lists:foreach( + fun(Char) -> + timer:sleep(random:uniform(500)), + gen_tcp:send(CSock, <<Char>>) + end, + Response). + +parse_req_num(Request) -> + Opts = [caseless,{capture,all_but_first,list}], + {match, [ReqNum]} = re:run(Request, "GET /(.*) HTTP", Opts), + ReqNum. + +parse_connection_type(Request) -> + Opts = [caseless,{capture,all_but_first,list}], + {match,[CType]} = re:run(Request, "connection: *(keep-alive|close)", Opts), + case string:to_lower(CType) of + "close" -> close; + "keep-alive" -> keep_alive + end. + + +set_random_seed() -> + {_, _, Micros} = now(), + A = erlang:phash2([make_ref(), self(), Micros]), + random:seed(A, A, A). + +f(F, A) -> lists:flatten(io_lib:format(F,A)). + + + + +%%------------------------------------------------------------------------- + + + +otp_8106_pid(doc) -> + ["OTP-8106 - deliver reply info using \"other\" pid"]; +otp_8106_pid(suite) -> + []; +otp_8106_pid(Config) when is_list(Config) -> + case ?config(local_server, Config) of + ok -> + ReceiverPid = create_receiver(pid), + Receiver = ReceiverPid, + + otp8106(ReceiverPid, Receiver, Config), + + stop_receiver(ReceiverPid), + + ok; + _ -> + skip("Failed to start local http-server") + end. + + +otp_8106_fun(doc) -> + ["OTP-8106 - deliver reply info using fun"]; +otp_8106_fun(suite) -> + []; +otp_8106_fun(Config) when is_list(Config) -> + case ?config(local_server, Config) of + ok -> + ReceiverPid = create_receiver(function), + Receiver = otp_8106_deliver_fun(ReceiverPid), + + otp8106(ReceiverPid, Receiver, Config), + + stop_receiver(ReceiverPid), + + ok; + _ -> + skip("Failed to start local http-server") + end. + + +otp_8106_mfa(doc) -> + ["OTP-8106 - deliver reply info using mfa callback"]; +otp_8106_mfa(suite) -> + []; +otp_8106_mfa(Config) when is_list(Config) -> + case ?config(local_server, Config) of + ok -> + ReceiverPid = create_receiver(mfa), + Receiver = {?MODULE, otp_8106_deliver, [mfa, ReceiverPid]}, + + otp8106(ReceiverPid, Receiver, Config), + + stop_receiver(ReceiverPid), + + ok; + _ -> + skip("Failed to start local http-server") + end. + + + otp8106(ReceiverPid, Receiver, Config) -> + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + Request = {URL, []}, + HTTPOptions = [], + Options = [{sync, false}, {receiver, Receiver}], + + {ok, RequestId} = + httpc:request(get, Request, HTTPOptions, Options), + + Body = + receive + {reply, ReceiverPid, {RequestId, {{_, 200, _}, _, B}}} -> + B; + {reply, ReceiverPid, Msg} -> + tsf(Msg); + {bad_reply, ReceiverPid, Msg} -> + tsf(Msg) + end, + + inets_test_lib:check_body(binary_to_list(Body)), + ok. + + +create_receiver(Type) -> + Parent = self(), + Receiver = fun() -> receiver(Type, Parent) end, + spawn_link(Receiver). + +stop_receiver(Pid) -> + Pid ! {stop, self()}. + +receiver(Type, Parent) -> + receive + {stop, Parent} -> + exit(normal); + + {http, ReplyInfo} when (Type =:= pid) -> + Parent ! {reply, self(), ReplyInfo}, + receiver(Type, Parent); + + {Type, ReplyInfo} -> + Parent ! {reply, self(), ReplyInfo}, + receiver(Type, Parent); + + Crap -> + Parent ! {reply, self(), {bad_reply, Crap}}, + receiver(Type, Parent) + end. + + +otp_8106_deliver_fun(ReceiverPid) -> + fun(ReplyInfo) -> otp_8106_deliver(ReplyInfo, function, ReceiverPid) end. + +otp_8106_deliver(ReplyInfo, Type, ReceiverPid) -> + ReceiverPid ! {Type, ReplyInfo}, + ok. + + + +%%------------------------------------------------------------------------- + +otp_8056(doc) -> + "OTP-8056"; +otp_8056(suite) -> + []; +otp_8056(Config) when is_list(Config) -> + Method = get, + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + Request = {URL, []}, + HTTPOptions = [], + Options1 = [{sync, true}, {stream, {self, once}}], + Options2 = [{sync, true}, {stream, self}], + {error, streaming_error} = httpc:request(Method, Request, + HTTPOptions, Options1), + tsp("request 1 failed as expected"), + {error, streaming_error} = httpc:request(Method, Request, + HTTPOptions, Options2), + tsp("request 2 failed as expected"), + ok. + + +%%------------------------------------------------------------------------- + +otp_8352(doc) -> + "OTP-8352"; +otp_8352(suite) -> + []; +otp_8352(Config) when is_list(Config) -> + tsp("otp_8352 -> entry with" + "~n Config: ~p", [Config]), + case ?config(local_server, Config) of + ok -> + tsp("local-server running"), + + tsp("initial profile info(1): ~p", [httpc:info()]), + + MaxSessions = 5, + MaxKeepAlive = 10, + KeepAliveTimeout = timer:minutes(2), + ConnOptions = [{max_sessions, MaxSessions}, + {max_keep_alive_length, MaxKeepAlive}, + {keep_alive_timeout, KeepAliveTimeout}], + httpc:set_options(ConnOptions), + + Method = get, + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + Request = {URL, []}, + Timeout = timer:seconds(1), + ConnTimeout = Timeout + timer:seconds(1), + HttpOptions1 = [{timeout, Timeout}, {connect_timeout, ConnTimeout}], + Options1 = [{socket_opts, [{tos, 87}, + {recbuf, 16#FFFF}, + {sndbuf, 16#FFFF}]}], + case httpc:request(Method, Request, HttpOptions1, Options1) of + {ok, {{_,200,_}, [_ | _], ReplyBody1 = [_ | _]}} -> + %% equivaliant to httpc:request(get, {URL, []}, [], []), + inets_test_lib:check_body(ReplyBody1); + {ok, UnexpectedReply1} -> + tsf({unexpected_reply, UnexpectedReply1}); + {error, _} = Error1 -> + tsf({bad_reply, Error1}) + end, + + tsp("profile info (2): ~p", [httpc:info()]), + + HttpOptions2 = [], + Options2 = [{socket_opts, [{tos, 84}, + {recbuf, 32#1FFFF}, + {sndbuf, 32#1FFFF}]}], + case httpc:request(Method, Request, HttpOptions2, Options2) of + {ok, {{_,200,_}, [_ | _], ReplyBody2 = [_ | _]}} -> + %% equivaliant to httpc:request(get, {URL, []}, [], []), + inets_test_lib:check_body(ReplyBody2); + {ok, UnexpectedReply2} -> + tsf({unexpected_reply, UnexpectedReply2}); + {error, _} = Error2 -> + tsf({bad_reply, Error2}) + end, + tsp("profile info (3): ~p", [httpc:info()]), + ok; + + _ -> + skip("Failed to start local http-server") + end. + + +%%------------------------------------------------------------------------- + +otp_8371(doc) -> + ["OTP-8371"]; +otp_8371(suite) -> + []; +otp_8371(Config) when is_list(Config) -> + ok = httpc:set_options([{ipv6, disabled}]), % also test the old option + {DummyServerPid, Port} = dummy_server(ipv4), + + URL = ?URL_START ++ integer_to_list(Port) ++ + "/ensure_host_header_with_port.html", + + case httpc:request(get, {URL, []}, [], []) of + {ok, Result} -> + case Result of + {{_, 200, _}, _Headers, Body} -> + tsp("expected response with" + "~n Body: ~p", [Body]), + ok; + {StatusLine, Headers, Body} -> + tsp("expected response with" + "~n StatusLine: ~p" + "~n Headers: ~p" + "~n Body: ~p", [StatusLine, Headers, Body]), + tsf({unexpected_result, + [{status_line, StatusLine}, + {headers, Headers}, + {body, Body}]}); + _ -> + tsf({unexpected_result, Result}) + end; + Error -> + tsf({request_failed, Error}) + end, + + DummyServerPid ! stop, + ok = httpc:set_options([{ipv6, enabled}]), + ok. + + +%%------------------------------------------------------------------------- + +otp_8739(doc) -> + ["OTP-8739"]; +otp_8739(suite) -> + []; +otp_8739(Config) when is_list(Config) -> + {_DummyServerPid, Port} = otp_8739_dummy_server(), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + Method = get, + Request = {URL, []}, + HttpOptions = [{connect_timeout, 500}, {timeout, 1}], + Options = [{sync, true}], + case httpc:request(Method, Request, HttpOptions, Options) of + {error, timeout} -> + %% And now we check the size of the handler db + Info = httpc:info(), + tsp("Info: ~p", [Info]), + {value, {handlers, Handlers}} = + lists:keysearch(handlers, 1, Info), + case Handlers of + [] -> + ok; + _ -> + tsf({unexpected_handlers, Handlers}) + end; + Unexpected -> + tsf({unexpected, Unexpected}) + end. + + +otp_8739_dummy_server() -> + Parent = self(), + Pid = spawn_link(fun() -> otp_8739_dummy_server_init(Parent) end), + receive + {port, Port} -> + {Pid, Port} + end. + +otp_8739_dummy_server_init(Parent) -> + {ok, ListenSocket} = + gen_tcp:listen(0, [binary, inet, {packet, 0}, + {reuseaddr,true}, + {active, false}]), + {ok, Port} = inet:port(ListenSocket), + Parent ! {port, Port}, + otp_8739_dummy_server_main(Parent, ListenSocket). + +otp_8739_dummy_server_main(_Parent, ListenSocket) -> + case gen_tcp:accept(ListenSocket) of + {ok, Sock} -> + %% Ignore the request, and simply wait for the socket to close + receive + {tcp_closed, Sock} -> + (catch gen_tcp:close(ListenSocket)), + exit(normal); + {tcp_error, Sock, Reason} -> + tsp("socket error: ~p", [Reason]), + (catch gen_tcp:close(ListenSocket)), + exit(normal) + after 10000 -> + %% Just in case + (catch gen_tcp:close(Sock)), + (catch gen_tcp:close(ListenSocket)), + exit(timeout) + end; + Error -> + exit(Error) + end. + + +%%------------------------------------------------------------------------- + +initial_server_connect(doc) -> + ["If this test cases times out the init of httpc_handler process is" + "blocking the manager/client process (implementation dependent which) but nither" + "should be blocked."]; +initial_server_connect(suite) -> + []; +initial_server_connect(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + ok = httpc:set_options([{ipfamily, inet}]), + + CertFile = filename:join(DataDir, "ssl_server_cert.pem"), + SSLOptions = [{certfile, CertFile}, {keyfile, CertFile}], + + {DummyServerPid, Port} = dummy_ssl_server_hang(self(), ipv4, SSLOptions), + + URL = ?SSL_URL_START ++ integer_to_list(Port) ++ "/index.html", + + httpc:request(get, {URL, []}, [{ssl,{essl,[]}}], [{sync, false}]), + + [{session_cookies,[]}] = httpc:which_cookies(), + + DummyServerPid ! stop, + ok = httpc:set_options([{ipfamily, inet6fb4}]). + +%%-------------------------------------------------------------------- +%% Internal functions +%%-------------------------------------------------------------------- +setup_server_dirs(ServerRoot, DocRoot, DataDir) -> + ConfDir = filename:join(ServerRoot, "conf"), + CgiDir = filename:join(ServerRoot, "cgi-bin"), + ok = file:make_dir(ServerRoot), + ok = file:make_dir(DocRoot), + ok = file:make_dir(ConfDir), + ok = file:make_dir(CgiDir), + + {ok, Files} = file:list_dir(DataDir), + + lists:foreach(fun(File) -> case lists:suffix(".html", File) of + true -> + inets_test_lib:copy_file(File, + DataDir, + DocRoot); + false -> + ok + end + end, Files), + + Cgi = case test_server:os_type() of + {win32, _} -> + "cgi_echo.exe"; + _ -> + "cgi_echo" + end, + + inets_test_lib:copy_file(Cgi, DataDir, CgiDir), + inets_test_lib:copy_file("mime.types", DataDir, ConfDir). + +create_config(FileName, ComType, Port, PrivDir, ServerRoot, DocRoot, + SSLDir) -> + MaxHdrSz = io_lib:format("~p", [256]), + MaxHdrAct = io_lib:format("~p", [close]), + SSL = + case ComType of + ssl -> + [cline(["SSLCertificateFile ", + filename:join(SSLDir, "ssl_server_cert.pem")]), + cline(["SSLCertificateKeyFile ", + filename:join(SSLDir, "ssl_server_cert.pem")]), + cline(["SSLVerifyClient 0"])]; + _ -> + [] + end, + + Mod_order = "Modules mod_alias mod_auth mod_esi mod_actions mod_cgi" + " mod_include mod_dir mod_get mod_head" + " mod_log mod_disk_log mod_trace", + + %% BindAddress = "*|inet", % Force the use of IPv4 + BindAddress = "*", % This corresponds to using IpFamily inet6fb4 + + HttpConfig = [ + cline(["BindAddress ", BindAddress]), + cline(["Port ", integer_to_list(Port)]), + cline(["ServerName ", "httpc_test"]), + cline(["SocketType ", atom_to_list(ComType)]), + cline([Mod_order]), + cline(["ServerRoot ", ServerRoot]), + cline(["DocumentRoot ", DocRoot]), + cline(["MaxHeaderSize ",MaxHdrSz]), + cline(["MaxHeaderAction ",MaxHdrAct]), + cline(["DirectoryIndex ", "index.html "]), + cline(["DefaultType ", "text/plain"]), + cline(["ScriptAlias /cgi-bin/ ", + filename:join(ServerRoot, "cgi-bin"), "/"]), + SSL], + ConfigFile = filename:join([PrivDir,FileName]), + {ok, Fd} = file:open(ConfigFile, [write]), + ok = file:write(Fd, lists:flatten(HttpConfig)), + ok = file:close(Fd). + +cline(List) -> + lists:flatten([List, "\r\n"]). + +receive_streamed_body(RequestId, Body) -> + receive + {http, {RequestId, stream, BinBodyPart}} -> + receive_streamed_body(RequestId, + <<Body/binary, BinBodyPart/binary>>); + {http, {RequestId, stream_end, _Headers}} -> + Body; + {http, Msg} -> + tsf(Msg) + end. + +receive_streamed_body(RequestId, Body, Pid) -> + httpc:stream_next(Pid), + test_server:format("~p:receive_streamed_body -> requested next stream ~n", [?MODULE]), + receive + {http, {RequestId, stream, BinBodyPart}} -> + receive_streamed_body(RequestId, + <<Body/binary, BinBodyPart/binary>>, + Pid); + {http, {RequestId, stream_end, _Headers}} -> + Body; + {http, Msg} -> + tsf(Msg) + end. + +%% Perform a synchronous stop +dummy_server_stop(Pid) -> + Pid ! {stop, self()}, + receive + {stopped, Pid} -> + ok + end. + +dummy_server(IpV) -> + dummy_server(self(), ip_comm, IpV, []). + +dummy_server(SocketType, IpV, Extra) -> + dummy_server(self(), SocketType, IpV, Extra). + +dummy_server(Caller, SocketType, IpV, Extra) -> + Args = [Caller, SocketType, IpV, Extra], + Pid = spawn(httpc_SUITE, dummy_server_init, Args), + receive + {port, Port} -> + {Pid, Port} + end. + +dummy_server_init(Caller, ip_comm, IpV, _) -> + BaseOpts = [binary, {packet, 0}, {reuseaddr,true}, {active, false}], + {ok, ListenSocket} = + case IpV of + ipv4 -> + tsp("ip_comm ipv4 listen", []), + gen_tcp:listen(0, [inet | BaseOpts]); + ipv6 -> + tsp("ip_comm ipv6 listen", []), + gen_tcp:listen(0, [inet6 | BaseOpts]) + end, + {ok, Port} = inet:port(ListenSocket), + tsp("dummy_server_init(ip_comm) -> Port: ~p", [Port]), + Caller ! {port, Port}, + dummy_ipcomm_server_loop({httpd_request, parse, [?HTTP_MAX_HEADER_SIZE]}, + [], ListenSocket); +dummy_server_init(Caller, essl, IpV, SSLOptions) -> + BaseOpts = [{ssl_imp, new}, + {backlog, 128}, binary, {reuseaddr,true}, {active, false} | + SSLOptions], + dummy_ssl_server_init(Caller, BaseOpts, IpV). + +dummy_ssl_server_init(Caller, BaseOpts, IpV) -> + {ok, ListenSocket} = + case IpV of + ipv4 -> + tsp("dummy_ssl_server_init -> ssl ipv4 listen", []), + ssl:listen(0, [inet | BaseOpts]); + ipv6 -> + tsp("dummy_ssl_server_init -> ssl ipv6 listen", []), + ssl:listen(0, [inet6 | BaseOpts]) + end, + tsp("dummy_ssl_server_init -> ListenSocket: ~p", [ListenSocket]), + {ok, {_, Port}} = ssl:sockname(ListenSocket), + tsp("dummy_ssl_server_init -> Port: ~p", [Port]), + Caller ! {port, Port}, + dummy_ssl_server_loop({httpd_request, parse, [?HTTP_MAX_HEADER_SIZE]}, + [], ListenSocket). + +dummy_ipcomm_server_loop(MFA, Handlers, ListenSocket) -> + receive + stop -> + tsp("dummy_ipcomm_server_loop -> stop handlers", []), + lists:foreach(fun(Handler) -> Handler ! stop end, Handlers); + {stop, From} -> + tsp("dummy_ipcomm_server_loop -> " + "stop command from ~p for handlers (~p)", [From, Handlers]), + Stopper = fun(Handler) -> Handler ! stop end, + lists:foreach(Stopper, Handlers), + From ! {stopped, self()} + after 0 -> + tsp("dummy_ipcomm_server_loop -> await accept", []), + {ok, Socket} = gen_tcp:accept(ListenSocket), + tsp("dummy_ipcomm_server_loop -> accepted: ~p", [Socket]), + HandlerPid = dummy_request_handler(MFA, Socket), + tsp("dummy_icomm_server_loop -> handler created: ~p", [HandlerPid]), + gen_tcp:controlling_process(Socket, HandlerPid), + tsp("dummy_ipcomm_server_loop -> " + "control transfered to handler", []), + HandlerPid ! ipcomm_controller, + tsp("dummy_ipcomm_server_loop -> " + "handler informed about control transfer", []), + dummy_ipcomm_server_loop(MFA, [HandlerPid | Handlers], + ListenSocket) + end. + +dummy_ssl_server_loop(MFA, Handlers, ListenSocket) -> + receive + stop -> + tsp("dummy_ssl_server_loop -> stop handlers", []), + lists:foreach(fun(Handler) -> Handler ! stop end, Handlers); + {stop, From} -> + tsp("dummy_ssl_server_loop -> " + "stop command from ~p for handlers (~p)", [From, Handlers]), + Stopper = fun(Handler) -> Handler ! stop end, + lists:foreach(Stopper, Handlers), + From ! {stopped, self()} + after 0 -> + tsp("dummy_ssl_server_loop -> await accept", []), + {ok, Socket} = ssl:transport_accept(ListenSocket), + tsp("dummy_ssl_server_loop -> accepted: ~p", [Socket]), + HandlerPid = dummy_request_handler(MFA, Socket), + tsp("dummy_ssl_server_loop -> handler created: ~p", [HandlerPid]), + ssl:controlling_process(Socket, HandlerPid), + tsp("dummy_ssl_server_loop -> control transfered to handler", []), + HandlerPid ! ssl_controller, + tsp("dummy_ssl_server_loop -> " + "handler informed about control transfer", []), + dummy_ssl_server_loop(MFA, [HandlerPid | Handlers], + ListenSocket) + end. + +dummy_request_handler(MFA, Socket) -> + tsp("spawn request handler", []), + spawn(httpc_SUITE, dummy_request_handler_init, [MFA, Socket]). + +dummy_request_handler_init(MFA, Socket) -> + SockType = + receive + ipcomm_controller -> + tsp("dummy_request_handler_init -> " + "received ip_comm controller - activate", []), + inet:setopts(Socket, [{active, true}]), + ip_comm; + ssl_controller -> + tsp("dummy_request_handler_init -> " + "received ssl controller - activate", []), + ssl:setopts(Socket, [{active, true}]), + ssl + end, + dummy_request_handler_loop(MFA, SockType, Socket). + +dummy_request_handler_loop({Module, Function, Args}, SockType, Socket) -> + tsp("dummy_request_handler_loop -> entry with" + "~n Module: ~p" + "~n Function: ~p" + "~n Args: ~p", [Module, Function, Args]), + receive + {Proto, _, Data} when (Proto =:= tcp) orelse (Proto =:= ssl) -> + tsp("dummy_request_handler_loop -> [~w] Data ~p", [Proto, Data]), + case handle_request(Module, Function, [Data | Args], Socket, Proto) of + stop when Proto =:= tcp -> + gen_tcp:close(Socket); + stop when Proto =:= ssl -> + ssl:close(Socket); + NewMFA -> + dummy_request_handler_loop(NewMFA, SockType, Socket) + end; + stop when SockType =:= ip_comm -> + gen_tcp:close(Socket); + stop when SockType =:= ssl -> + ssl:close(Socket) + end. + + +mk_close(tcp) -> fun(Sock) -> gen_tcp:close(Sock) end; +mk_close(ssl) -> fun(Sock) -> ssl:close(Sock) end. + +mk_send(tcp) -> fun(Sock, Data) -> gen_tcp:send(Sock, Data) end; +mk_send(ssl) -> fun(Sock, Data) -> ssl:send(Sock, Data) end. + +handle_request(Module, Function, Args, Socket, Proto) -> + Close = mk_close(Proto), + Send = mk_send(Proto), + handle_request(Module, Function, Args, Socket, Close, Send). + +handle_request(Module, Function, Args, Socket, Close, Send) -> + tsp("handle_request -> entry with" + "~n Module: ~p" + "~n Function: ~p" + "~n Args: ~p", [Module, Function, Args]), + case Module:Function(Args) of + {ok, Result} -> + tsp("handle_request -> ok" + "~n Result: ~p", [Result]), + case (catch handle_http_msg(Result, Socket, Close, Send)) of + stop -> + stop; + <<>> -> + tsp("handle_request -> empty data"), + {httpd_request, parse, [[<<>>, ?HTTP_MAX_HEADER_SIZE]]}; + Data -> + handle_request(httpd_request, parse, + [Data |[?HTTP_MAX_HEADER_SIZE]], Socket, + Close, Send) + end; + NewMFA -> + tsp("handle_request -> " + "~n NewMFA: ~p", [NewMFA]), + NewMFA + end. + +handle_http_msg({_, RelUri, _, {_, Headers}, Body}, Socket, Close, Send) -> + tsp("handle_http_msg -> entry with: " + "~n RelUri: ~p" + "~n Headers: ~p" + "~n Body: ~p", [RelUri, Headers, Body]), + NextRequest = + case RelUri of + "/dummy_headers.html" -> + <<>>; + "/no_headers.html" -> + stop; + "/just_close.html" -> + stop; + _ -> + ContentLength = content_length(Headers), + case size(Body) - ContentLength of + 0 -> + <<>>; + _ -> + <<_BodyThisReq:ContentLength/binary, + Next/binary>> = Body, + Next + end + end, + + tsp("handle_http_msg -> NextRequest: ~p", [NextRequest]), + case (catch ets:lookup(cookie, cookies)) of + [{cookies, true}]-> + tsp("handle_http_msg -> check cookies ~p", []), + check_cookie(Headers); + _ -> + ok + end, + + DefaultResponse = "HTTP/1.1 200 ok\r\n" ++ + "Content-Length:32\r\n\r\n" + "<HTML><BODY>foobar</BODY></HTML>", + + Msg = + case RelUri of + "/just_close.html" -> + close; + "/no_content.html" -> + "HTTP/1.0 204 No Content\r\n\r\n"; + "/no_headers.html" -> + "HTTP/1.0 200 OK\r\n\r\nTEST"; + "/ensure_host_header_with_port.html" -> + %% tsp("handle_http_msg -> validate host with port"), + case ensure_host_header_with_port(Headers) of + true -> + B = + "<HTML><BODY>" ++ + "host with port" ++ + "</BODY></HTML>", + Len = integer_to_list(length(B)), + "HTTP/1.1 200 ok\r\n" ++ + "Content-Length:" ++ Len ++ "\r\n\r\n" ++ B; + false -> + B = + "<HTML><BODY>" ++ + "Internal Server Error - host without port" ++ + "</BODY></HTML>", + Len = integer_to_list(length(B)), + "HTTP/1.1 500 Internal Server Error\r\n" ++ + "Content-Length:" ++ Len ++ "\r\n\r\n" ++ B + end; + "/300.html" -> + NewUri = ?URL_START ++ + integer_to_list(?IP_PORT) ++ "/dummy.html", + "HTTP/1.1 300 Multiple Choices\r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:0\r\n\r\n"; + "/301.html" -> + NewUri = ?URL_START ++ + integer_to_list(?IP_PORT) ++ "/dummy.html", + "HTTP/1.1 301 Moved Permanently\r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:80\r\n\r\n" ++ + "<HTML><BODY><a href=" ++ NewUri ++ + ">New place</a></BODY></HTML>"; + "/302.html" -> + NewUri = ?URL_START ++ + integer_to_list(?IP_PORT) ++ "/dummy.html", + "HTTP/1.1 302 Found \r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:80\r\n\r\n" ++ + "<HTML><BODY><a href=" ++ NewUri ++ + ">New place</a></BODY></HTML>"; + "/303.html" -> + NewUri = ?URL_START ++ + integer_to_list(?IP_PORT) ++ "/dummy.html", + "HTTP/1.1 303 See Other \r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:80\r\n\r\n" ++ + "<HTML><BODY><a href=" ++ NewUri ++ + ">New place</a></BODY></HTML>"; + "/307.html" -> + NewUri = ?URL_START ++ + integer_to_list(?IP_PORT) ++ "/dummy.html", + "HTTP/1.1 307 Temporary Rediect \r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:80\r\n\r\n" ++ + "<HTML><BODY><a href=" ++ NewUri ++ + ">New place</a></BODY></HTML>"; + "/500.html" -> + "HTTP/1.1 500 Internal Server Error\r\n" ++ + "Content-Length:47\r\n\r\n" ++ + "<HTML><BODY>Internal Server Error</BODY></HTML>"; + "/503.html" -> + case ets:lookup(unavailable, 503) of + [{503, unavailable}] -> + ets:insert(unavailable, {503, available}), + "HTTP/1.1 503 Service Unavailable\r\n" ++ + "Retry-After:5\r\n" ++ + "Content-Length:47\r\n\r\n" ++ + "<HTML><BODY>Internal Server Error</BODY></HTML>"; + [{503, available}] -> + DefaultResponse; + [{503, long_unavailable}] -> + "HTTP/1.1 503 Service Unavailable\r\n" ++ + "Retry-After:120\r\n" ++ + "Content-Length:47\r\n\r\n" ++ + "<HTML><BODY>Internal Server Error</BODY></HTML>" + end; + "/redirectloop.html" -> %% Create a potential endless loop! + {ok, Port} = inet:port(Socket), + NewUri = ?URL_START ++ + integer_to_list(Port) ++ "/redirectloop.html", + "HTTP/1.1 300 Multiple Choices\r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:0\r\n\r\n"; + "/userinfo.html" -> + Challange = "HTTP/1.1 401 Unauthorized \r\n" ++ + "WWW-Authenticate:Basic" ++"\r\n" ++ + "Content-Length:0\r\n\r\n", + case auth_header(Headers) of + {ok, Value} -> + handle_auth(Value, Challange, DefaultResponse); + _ -> + Challange + end; + "/dummy_headers.html" -> + %% The client will only care about the Transfer-Encoding + %% header the rest of these headers are left to the + %% user to evaluate. This is not a valid response + %% it only tests that the header handling code works. + Head = "HTTP/1.1 200 ok\r\n" ++ + "Content-Length:32\r\n" ++ + "Pragma:1#no-cache\r\n" ++ + "Via:1.0 fred, 1.1 nowhere.com (Apache/1.1)\r\n" ++ + "Warning:1#pseudonym foobar\r\n" ++ + "Vary:*\r\n" ++ + "Trailer:Other:inets_test\r\n" ++ + "Upgrade:HTTP/2.0\r\n" ++ + "Age:4711\r\n" ++ + "Transfer-Encoding:chunked\r\n" ++ + "Content-Encoding:foo\r\n" ++ + "Content-Language:en\r\n" ++ + "Content-Location:http://www.foobar.se\r\n" ++ + "Content-MD5:104528739076276072743283077410617235478\r\n" + ++ + "Content-Range:Sat, 29 Oct 1994 19:43:31 GMT\r\n" ++ + "Expires:Sat, 29 Oct 1994 19:43:31 GMT\r\n" ++ + "Proxy-Authenticate:#1Basic" ++ + "\r\n\r\n", + Send(Socket, Head), + Send(Socket, http_chunk:encode("<HTML><BODY>fo")), + Send(Socket, http_chunk:encode("obar</BODY></HTML>")), + http_chunk:encode_last(); + "/capital_transfer_encoding.html" -> + Head = "HTTP/1.1 200 ok\r\n" ++ + "Transfer-Encoding:Chunked\r\n\r\n", + Send(Socket, Head), + Send(Socket, http_chunk:encode("<HTML><BODY>fo")), + Send(Socket, http_chunk:encode("obar</BODY></HTML>")), + http_chunk:encode_last(); + "/cookie.html" -> + "HTTP/1.1 200 ok\r\n" ++ + "set-cookie:" ++ "test_cookie=true; path=/;" ++ + "max-age=60000\r\n" ++ + "Content-Length:32\r\n\r\n"++ + "<HTML><BODY>foobar</BODY></HTML>"; + "/missing_crlf.html" -> + "HTTP/1.1 200 ok" ++ + "Content-Length:32\r\n" ++ + "<HTML><BODY>foobar</BODY></HTML>"; + "/wrong_statusline.html" -> + "ok 200 HTTP/1.1\r\n\r\n" ++ + "Content-Length:32\r\n\r\n" ++ + "<HTML><BODY>foobar</BODY></HTML>"; + "/once_chunked.html" -> + Head = "HTTP/1.1 200 ok\r\n" ++ + "Transfer-Encoding:Chunked\r\n\r\n", + Send(Socket, Head), + Send(Socket, http_chunk:encode("<HTML><BODY>fo")), + Send(Socket, + http_chunk:encode("obar</BODY></HTML>")), + http_chunk:encode_last(); + "/once.html" -> + Head = "HTTP/1.1 200 ok\r\n" ++ + "Content-Length:32\r\n\r\n", + Send(Socket, Head), + Send(Socket, "<HTML><BODY>fo"), + test_server:sleep(1000), + Send(Socket, "ob"), + test_server:sleep(1000), + Send(Socket, "ar</BODY></HTML>"); + "/invalid_http.html" -> + "HTTP/1.1 301\r\nDate:Sun, 09 Dec 2007 13:04:18 GMT\r\n" ++ + "Transfer-Encoding:chunked\r\n\r\n"; + "/missing_reason_phrase.html" -> + "HTTP/1.1 200\r\n" ++ + "Content-Length: 32\r\n\r\n" + "<HTML><BODY>foobar</BODY></HTML>"; + "/missing_CR.html" -> + "HTTP/1.1 200 ok\n" ++ + "Content-Length:32\r\n\n" + "<HTML><BODY>foobar</BODY></HTML>"; + _ -> + DefaultResponse + end, + + tsp("handle_http_msg -> Msg: ~p", [Msg]), + case Msg of + ok -> + %% Previously, this resulted in an {error, einval}. Now what? + ok; + close -> + %% Nothing to send, just close + Close(Socket); + _ when is_list(Msg) orelse is_binary(Msg) -> + Send(Socket, Msg) + end, + tsp("handle_http_msg -> done"), + NextRequest. + +ensure_host_header_with_port([]) -> + false; +ensure_host_header_with_port(["host: " ++ Host| _]) -> + case string:tokens(Host, [$:]) of + [ActualHost, Port] -> + tsp("ensure_host_header_with_port -> " + "~n ActualHost: ~p" + "~n Port: ~p", [ActualHost, Port]), + true; + _ -> + false + end; +ensure_host_header_with_port([_|T]) -> + ensure_host_header_with_port(T). + +auth_header([]) -> + auth_header_not_found; +auth_header(["authorization:" ++ Value | _]) -> + {ok, string:strip(Value)}; +auth_header([_ | Tail]) -> + auth_header(Tail). + +handle_auth("Basic " ++ UserInfo, Challange, DefaultResponse) -> + case string:tokens(base64:decode_to_string(UserInfo), ":") of + ["alladin", "sesame"] = Auth -> + test_server:format("Auth: ~p~n", [Auth]), + DefaultResponse; + Other -> + test_server:format("UnAuth: ~p~n", [Other]), + Challange + end. + +check_cookie([]) -> + tsf(no_cookie_header); +check_cookie(["cookie:" ++ _Value | _]) -> + ok; +check_cookie([_Head | Tail]) -> + check_cookie(Tail). + +content_length([]) -> + 0; +content_length(["content-length:" ++ Value | _]) -> + list_to_integer(string:strip(Value)); +content_length([_Head | Tail]) -> + content_length(Tail). + +%% ------------------------------------------------------------------------- + +simple_request_and_verify(Config, + Method, Request, HttpOpts, Opts, VerifyResult) + when (is_list(Config) andalso + is_atom(Method) andalso + is_list(HttpOpts) andalso + is_list(Opts) andalso + is_function(VerifyResult, 1)) -> + tsp("request_and_verify -> entry with" + "~n Method: ~p" + "~n Request: ~p" + "~n HttpOpts: ~p" + "~n Opts: ~p", [Method, Request, HttpOpts, Opts]), + case ?config(local_server, Config) of + ok -> + tsp("request_and_verify -> local-server running"), + Result = (catch httpc:request(Method, Request, HttpOpts, Opts)), + VerifyResult(Result); + _ -> + tsp("request_and_verify -> local-server *not* running - skip"), + hard_skip("Local http-server not running") + end. + + + + +not_implemented_yet() -> + exit(not_implemented_yet). + +p(F) -> + p(F, []). + +p(F, A) -> + io:format("~p ~w:" ++ F ++ "~n", [self(), ?MODULE | A]). + +tsp(F) -> + inets_test_lib:tsp("[~w]" ++ F, [?MODULE]). +tsp(F, A) -> + inets_test_lib:tsp("[~w]" ++ F, [?MODULE|A]). + +tsf(Reason) -> + test_server:fail(Reason). + + +dummy_ssl_server_hang(Caller, IpV, SslOpt) -> + Pid = spawn(httpc_SUITE, dummy_ssl_server_hang_init, [Caller, IpV, SslOpt]), + receive + {port, Port} -> + {Pid, Port} + end. + +dummy_ssl_server_hang_init(Caller, IpV, SslOpt) -> + {ok, ListenSocket} = + case IpV of + ipv4 -> + ssl:listen(0, [binary, inet, {packet, 0}, + {reuseaddr,true}, + {active, false}] ++ SslOpt); + ipv6 -> + ssl:listen(0, [binary, inet6, {packet, 0}, + {reuseaddr,true}, + {active, false}] ++ SslOpt) + end, + {ok, {_,Port}} = ssl:sockname(ListenSocket), + tsp("dummy_ssl_server_hang_init -> Port: ~p", [Port]), + Caller ! {port, Port}, + {ok, AcceptSocket} = ssl:transport_accept(ListenSocket), + dummy_ssl_server_hang_loop(AcceptSocket). + +dummy_ssl_server_hang_loop(_) -> + %% Do not do ssl:ssl_accept as we + %% want to time out the underlying gen_tcp:connect + receive + stop -> + ok + end. + +hard_skip(Reason) -> + throw(skip(Reason)). + +skip(Reason) -> + {skip, Reason}. diff --git a/lib/inets/test/uri_SUITE.erl b/lib/inets/test/uri_SUITE.erl new file mode 100644 index 0000000000..9ba09e1474 --- /dev/null +++ b/lib/inets/test/uri_SUITE.erl @@ -0,0 +1,159 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2013. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +%% +%% ct:run("../inets_test", uri_SUITE). +%% + +-module(uri_SUITE). + +-include_lib("common_test/include/ct.hrl"). +-include("inets_test_lib.hrl"). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-define(GOOGLE, "www.google.com"). + +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> + [ + ipv4, + ipv6, + host, + userinfo, + scheme, + queries, + escaped, + hexed_query + ]. + +%%-------------------------------------------------------------------- + +init_per_suite(Config) -> + Config. +end_per_suite(_Config) -> + ok. + +%%-------------------------------------------------------------------- + +init_per_testcase(_Case, Config) -> + Config. +end_per_testcase(_Case, _Config) -> + ok. + +%%------------------------------------------------------------------------- +%% Test cases starts here. +%%------------------------------------------------------------------------- + +ipv4(Config) when is_list(Config) -> + {ok, {http,[],"127.0.0.1",80,"/foobar.html",[]}} = + http_uri:parse("http://127.0.0.1/foobar.html"). + +ipv6(Config) when is_list(Config) -> + {ok, {http,[],"2010:836B:4179::836B:4179",80,"/foobar.html",[]}} = + http_uri:parse("http://[2010:836B:4179::836B:4179]/foobar.html"), + {ok, {http,[],"[2010:836B:4179::836B:4179]",80,"/foobar.html",[]}} = + http_uri:parse("http://[2010:836B:4179::836B:4179]/foobar.html", + [{ipv6_host_with_brackets, true}]), + {ok, {http,[],"2010:836B:4179::836B:4179",80,"/foobar.html",[]}} = + http_uri:parse("http://[2010:836B:4179::836B:4179]/foobar.html", + [{ipv6_host_with_brackets, false}]), + {ok, {http,[],"2010:836B:4179::836B:4179",80,"/foobar.html",[]}} = + http_uri:parse("http://[2010:836B:4179::836B:4179]/foobar.html", + [{foo, false}]), + {error, + {malformed_url, _, "http://2010:836B:4179::836B:4179/foobar.html"}} = + http_uri:parse("http://2010:836B:4179::836B:4179/foobar.html"). + +host(Config) when is_list(Config) -> + {ok, {http,[],"localhost",8888,"/foobar.html",[]}} = + http_uri:parse("http://localhost:8888/foobar.html"). + +userinfo(Config) when is_list(Config) -> + {ok, {http,"nisse:foobar","localhost",8888,"/foobar.html",[]}} = + http_uri:parse("http://nisse:foobar@localhost:8888/foobar.html"). + +scheme(Config) when is_list(Config) -> + {error, no_scheme} = http_uri:parse("localhost/foobar.html"), + {error, {malformed_url, _, _}} = + http_uri:parse("localhost:8888/foobar.html"). + +queries(Config) when is_list(Config) -> + {ok, {http,[],"localhost",8888,"/foobar.html","?foo=bar&foobar=42"}} = + http_uri:parse("http://localhost:8888/foobar.html?foo=bar&foobar=42"). + +escaped(Config) when is_list(Config) -> + {ok, {http,[],"www.somedomain.com",80,"/%2Eabc",[]}} = + http_uri:parse("http://www.somedomain.com/%2Eabc"), + {ok, {http,[],"www.somedomain.com",80,"/%252Eabc",[]}} = + http_uri:parse("http://www.somedomain.com/%252Eabc"), + {ok, {http,[],"www.somedomain.com",80,"/%25abc",[]}} = + http_uri:parse("http://www.somedomain.com/%25abc"), + {ok, {http,[],"www.somedomain.com",80,"/%25abc", "?foo=bar"}} = + http_uri:parse("http://www.somedomain.com/%25abc?foo=bar"). + +hexed_query(doc) -> + [{doc, "Solves OTP-6191"}]; +hexed_query(Config) when is_list(Config) -> + Google = ?GOOGLE, + GoogleSearch = "http://" ++ Google ++ "/search", + Search1 = "?hl=en&q=a%D1%85%D1%83%D0%B9&btnG=Google+Search", + URI1 = GoogleSearch ++ Search1, + Search2 = "?hl=en&q=%25%25", + URI2 = GoogleSearch ++ Search2, + Search3 = "?hl=en&q=%foo", + URI3 = GoogleSearch ++ Search3, + + Verify1 = + fun({http, [], ?GOOGLE, 80, "/search", _}) -> ok; + (_) -> error + end, + Verify2 = Verify1, + Verify3 = Verify1, + verify_uri(URI1, Verify1), + verify_uri(URI2, Verify2), + verify_uri(URI3, Verify3). + + +%%-------------------------------------------------------------------- +%% Internal Functions ------------------------------------------------ +%%-------------------------------------------------------------------- + + +verify_uri(URI, Verify) -> + case http_uri:parse(URI) of + {ok, ParsedURI} -> + case Verify(ParsedURI) of + ok -> + ok; + error -> + Reason = {unexpected_parse_result, URI, ParsedURI}, + ERROR = {error, Reason}, + throw(ERROR) + end; + {error, _} = ERROR -> + throw(ERROR) + end. diff --git a/lib/kernel/doc/src/file.xml b/lib/kernel/doc/src/file.xml index 069b13eacf..66ecba1bf2 100644 --- a/lib/kernel/doc/src/file.xml +++ b/lib/kernel/doc/src/file.xml @@ -60,14 +60,6 @@ converted, why the Unicode mode for file names is not default on systems having completely transparent file naming.</p> - <note> - <p>As of R14B01, the most basic file handling modules - (<c>file</c>, <c>prim_file</c>, <c>filelib</c> and - <c>filename</c>) accept raw file names, but the rest of OTP is not - guaranteed to handle them, why Unicode file naming on systems - where it is not default is still considered experimental.</p> - </note> - <p>Raw file names is a new feature in OTP R14B01, which allows the user to supply completely uninterpreted file names to the underlying OS/filesystem. They are supplied as binaries, where it @@ -125,6 +117,14 @@ <desc> <p>If VM is in Unicode filename mode, <c>string()</c> and <c>char()</c> are allowed to be > 255. + </p> + </desc> + </datatype> + <datatype> + <name name="name_all"/> + <desc> + <p>If VM is in Unicode filename mode, <c>string()</c> and <c>char()</c> + are allowed to be > 255. <c><anno>RawFilename</anno></c> is a filename not subject to Unicode translation, meaning that it can contain characters not conforming to @@ -504,7 +504,8 @@ <name name="list_dir" arity="1"/> <fsummary>List files in a directory</fsummary> <desc> - <p>Lists all the files in a directory. Returns + <p>Lists all files in a directory, <b>except</b> files + with "raw" names. Returns <c>{ok, <anno>Filenames</anno>}</c> if successful. Otherwise, it returns <c>{error, <anno>Reason</anno>}</c>. <c><anno>Filenames</anno></c> is a list of @@ -521,6 +522,37 @@ <item> <p>The directory does not exist.</p> </item> + <tag><c>{no_translation, <anno>Filename</anno>}</c></tag> + <item> + <p><c><anno>Filename</anno></c> is a <c>binary()</c> with + characters coded in ISO-latin-1 and the VM was started + with the parameter <c>+fnue</c>.</p> + </item> + </taglist> + </desc> + </func> + <func> + <name name="list_dir_all" arity="1"/> + <fsummary>List all files in a directory</fsummary> + <desc> + <p>Lists all the files in a directory, including files with + "raw" names. + Returns <c>{ok, <anno>Filenames</anno>}</c> if successful. + Otherwise, it returns <c>{error, <anno>Reason</anno>}</c>. + <c><anno>Filenames</anno></c> is a list of + the names of all the files in the directory. The names are + not sorted.</p> + <p>Typical error reasons are:</p> + <taglist> + <tag><c>eacces</c></tag> + <item> + <p>Missing search or write permissions for <c><anno>Dir</anno></c> + or one of its parent directories.</p> + </item> + <tag><c>enoent</c></tag> + <item> + <p>The directory does not exist.</p> + </item> </taglist> </desc> </func> @@ -1409,10 +1441,41 @@ <fsummary>See what a link is pointing to</fsummary> <desc> <p>This function returns <c>{ok, <anno>Filename</anno>}</c> if + <c><anno>Name</anno></c> refers to a symbolic link that is + not a "raw" file name, or <c>{error, <anno>Reason</anno>}</c> + otherwise. + On platforms that do not support symbolic links, the return + value will be <c>{error,enotsup}</c>.</p> + <p>Typical error reasons:</p> + <taglist> + <tag><c>einval</c></tag> + <item> + <p><c><anno>Name</anno></c> does not refer to a symbolic link + or the name of the file that it refers to does not conform + to the expected encoding.</p> + </item> + <tag><c>enoent</c></tag> + <item> + <p>The file does not exist.</p> + </item> + <tag><c>enotsup</c></tag> + <item> + <p>Symbolic links are not supported on this platform.</p> + </item> + </taglist> + </desc> + </func> + <func> + <name name="read_link_all" arity="1"/> + <fsummary>See what a link is pointing to</fsummary> + <desc> + <p>This function returns <c>{ok, <anno>Filename</anno>}</c> if <c><anno>Name</anno></c> refers to a symbolic link or <c>{error, <anno>Reason</anno>}</c> otherwise. On platforms that do not support symbolic links, the return value will be <c>{error,enotsup}</c>.</p> + <p>Note that <c><anno>Filename</anno></c> can be either a list + or a binary.</p> <p>Typical error reasons:</p> <taglist> <tag><c>einval</c></tag> @@ -1580,6 +1643,12 @@ <p><c><anno>Dir</anno></c> had an improper type, such as tuple.</p> </item> + <tag><c>no_translation</c></tag> + <item> + <p><c><anno>Dir</anno></c> is a <c>binary()</c> with + characters coded in ISO-latin-1 and the VM was started + with the parameter <c>+fnue</c>.</p> + </item> </taglist> <warning> <p>In a future release, a bad type for the diff --git a/lib/kernel/src/auth.erl b/lib/kernel/src/auth.erl index 1e12a647d7..7d463103e3 100644 --- a/lib/kernel/src/auth.erl +++ b/lib/kernel/src/auth.erl @@ -391,7 +391,7 @@ create_cookie(Name) -> {error,Reason} -> {error, lists:flatten( - io_lib:format("Failed to create cookie file '~s': ~p", [Name, Reason]))} + io_lib:format("Failed to create cookie file '~ts': ~p", [Name, Reason]))} end. random_cookie(0, _, Result) -> diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl index 5f52f94270..a4c56b346f 100644 --- a/lib/kernel/src/file.erl +++ b/lib/kernel/src/file.erl @@ -68,7 +68,7 @@ %% Types that can be used from other modules -- alphabetically ordered. -export_type([date_time/0, fd/0, file_info/0, filename/0, filename_all/0, - io_device/0, name/0, posix/0]). + io_device/0, name/0, name_all/0, posix/0]). %%% Includes and defines -include("file.hrl"). @@ -97,7 +97,8 @@ | 'read_ahead' | 'compressed' | {'encoding', unicode:encoding()}. -type deep_list() :: [char() | atom() | deep_list()]. --type name() :: string() | atom() | deep_list() | (RawFilename :: binary()). +-type name() :: string() | atom() | deep_list(). +-type name_all() :: string() | atom() | deep_list() | (RawFilename :: binary()). -type posix() :: 'eacces' | 'eagain' | 'ebadf' | 'ebusy' | 'edquot' | 'eexist' | 'efault' | 'efbig' | 'eintr' | 'einval' | 'eio' | 'eisdir' | 'eloop' | 'emfile' | 'emlink' @@ -117,7 +118,7 @@ -export([file_info/1, native_name_encoding/0]). -spec file_info(Filename) -> {ok, FileInfo} | {error, Reason} when - Filename :: name(), + Filename :: name_all(), FileInfo :: file_info(), Reason :: posix() | badarg. @@ -160,7 +161,7 @@ format_error(ErrorId) -> erl_posix_msg:message(ErrorId). -spec pid2name(Pid) -> {ok, Filename} | undefined when - Filename :: filename(), + Filename :: filename_all(), Pid :: pid(). pid2name(Pid) when is_pid(Pid) -> @@ -197,42 +198,42 @@ get_cwd(Drive) -> -spec set_cwd(Dir) -> ok | {error, Reason} when Dir :: name(), - Reason :: posix() | badarg. + Reason :: posix() | badarg | no_translation. set_cwd(Dirname) -> check_and_call(set_cwd, [file_name(Dirname)]). -spec delete(Filename) -> ok | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Reason :: posix() | badarg. delete(Name) -> check_and_call(delete, [file_name(Name)]). -spec rename(Source, Destination) -> ok | {error, Reason} when - Source :: name(), - Destination :: name(), + Source :: name_all(), + Destination :: name_all(), Reason :: posix() | badarg. rename(From, To) -> check_and_call(rename, [file_name(From), file_name(To)]). -spec make_dir(Dir) -> ok | {error, Reason} when - Dir :: name(), + Dir :: name_all(), Reason :: posix() | badarg. make_dir(Name) -> check_and_call(make_dir, [file_name(Name)]). -spec del_dir(Dir) -> ok | {error, Reason} when - Dir :: name(), + Dir :: name_all(), Reason :: posix() | badarg. del_dir(Name) -> check_and_call(del_dir, [file_name(Name)]). -spec read_file_info(Filename) -> {ok, FileInfo} | {error, Reason} when - Filename :: name(), + Filename :: name_all(), FileInfo :: file_info(), Reason :: posix() | badarg. @@ -240,7 +241,7 @@ read_file_info(Name) -> check_and_call(read_file_info, [file_name(Name)]). -spec read_file_info(Filename, Opts) -> {ok, FileInfo} | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Opts :: [file_info_option()], FileInfo :: file_info(), Reason :: posix() | badarg. @@ -248,13 +249,13 @@ read_file_info(Name) -> read_file_info(Name, Opts) when is_list(Opts) -> check_and_call(read_file_info, [file_name(Name), Opts]). --spec altname(Name :: name()) -> any(). +-spec altname(Name :: name_all()) -> any(). altname(Name) -> check_and_call(altname, [file_name(Name)]). -spec read_link_info(Name) -> {ok, FileInfo} | {error, Reason} when - Name :: name(), + Name :: name_all(), FileInfo :: file_info(), Reason :: posix() | badarg. @@ -262,7 +263,7 @@ read_link_info(Name) -> check_and_call(read_link_info, [file_name(Name)]). -spec read_link_info(Name, Opts) -> {ok, FileInfo} | {error, Reason} when - Name :: name(), + Name :: name_all(), Opts :: [file_info_option()], FileInfo :: file_info(), Reason :: posix() | badarg. @@ -272,7 +273,7 @@ read_link_info(Name, Opts) when is_list(Opts) -> -spec read_link(Name) -> {ok, Filename} | {error, Reason} when - Name :: name(), + Name :: name_all(), Filename :: filename(), Reason :: posix() | badarg. @@ -280,7 +281,7 @@ read_link(Name) -> check_and_call(read_link, [file_name(Name)]). -spec read_link_all(Name) -> {ok, Filename} | {error, Reason} when - Name :: name(), + Name :: name_all(), Filename :: filename_all(), Reason :: posix() | badarg. @@ -288,7 +289,7 @@ read_link_all(Name) -> check_and_call(read_link_all, [file_name(Name)]). -spec write_file_info(Filename, FileInfo) -> ok | {error, Reason} when - Filename :: name(), + Filename :: name_all(), FileInfo :: file_info(), Reason :: posix() | badarg. @@ -296,7 +297,7 @@ write_file_info(Name, Info = #file_info{}) -> check_and_call(write_file_info, [file_name(Name), Info]). -spec write_file_info(Filename, FileInfo, Opts) -> ok | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Opts :: [file_info_option()], FileInfo :: file_info(), Reason :: posix() | badarg. @@ -305,15 +306,17 @@ write_file_info(Name, Info = #file_info{}, Opts) when is_list(Opts) -> check_and_call(write_file_info, [file_name(Name), Info, Opts]). -spec list_dir(Dir) -> {ok, Filenames} | {error, Reason} when - Dir :: name(), + Dir :: name_all(), Filenames :: [filename()], - Reason :: posix() | badarg. + Reason :: posix() + | badarg + | {no_translation, Filename :: unicode:latin1_binary()}. list_dir(Name) -> check_and_call(list_dir, [file_name(Name)]). -spec list_dir_all(Dir) -> {ok, Filenames} | {error, Reason} when - Dir :: name(), + Dir :: name_all(), Filenames :: [filename_all()], Reason :: posix() | badarg. @@ -321,7 +324,7 @@ list_dir_all(Name) -> check_and_call(list_dir_all, [file_name(Name)]). -spec read_file(Filename) -> {ok, Binary} | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Binary :: binary(), Reason :: posix() | badarg | terminated | system_limit. @@ -329,23 +332,23 @@ read_file(Name) -> check_and_call(read_file, [file_name(Name)]). -spec make_link(Existing, New) -> ok | {error, Reason} when - Existing :: name(), - New :: name(), + Existing :: name_all(), + New :: name_all(), Reason :: posix() | badarg. make_link(Old, New) -> check_and_call(make_link, [file_name(Old), file_name(New)]). -spec make_symlink(Existing, New) -> ok | {error, Reason} when - Existing :: name(), - New :: name(), + Existing :: name_all(), + New :: name_all(), Reason :: posix() | badarg. make_symlink(Old, New) -> check_and_call(make_symlink, [file_name(Old), file_name(New)]). -spec write_file(Filename, Bytes) -> ok | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Bytes :: iodata(), Reason :: posix() | badarg | terminated | system_limit. @@ -357,7 +360,7 @@ write_file(Name, Bin) -> %% Meanwhile, it is implemented here, slightly less efficient. -spec write_file(Filename, Bytes, Modes) -> ok | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Bytes :: iodata(), Modes :: [mode()], Reason :: posix() | badarg | terminated | system_limit. @@ -416,7 +419,7 @@ raw_write_file_info(Name, #file_info{} = Info) -> -spec open(File, Modes) -> {ok, IoDevice} | {error, Reason} when File :: Filename | iodata(), - Filename :: name(), + Filename :: name_all(), Modes :: [mode() | ram], IoDevice :: io_device(), Reason :: posix() | badarg | system_limit. @@ -523,7 +526,10 @@ allocate(#file_descriptor{module = Module} = Handle, Offset, Length) -> IoDevice :: io_device() | atom(), Number :: non_neg_integer(), Data :: string() | binary(), - Reason :: posix() | badarg | terminated. + Reason :: posix() + | badarg + | terminated + | {no_translation, unicode, latin1}. read(File, Sz) when (is_pid(File) orelse is_atom(File)), is_integer(Sz), Sz >= 0 -> case io:request(File, {get_chars, '', Sz}) of @@ -541,7 +547,10 @@ read(_, _) -> -spec read_line(IoDevice) -> {ok, Data} | eof | {error, Reason} when IoDevice :: io_device() | atom(), Data :: string() | binary(), - Reason :: posix() | badarg | terminated. + Reason :: posix() + | badarg + | terminated + | {no_translation, unicode, latin1}. read_line(File) when (is_pid(File) orelse is_atom(File)) -> case io:request(File, {get_line, ''}) of @@ -709,7 +718,7 @@ truncate(_) -> -spec copy(Source, Destination) -> {ok, BytesCopied} | {error, Reason} when Source :: io_device() | Filename | {Filename, Modes}, Destination :: io_device() | Filename | {Filename, Modes}, - Filename :: name(), + Filename :: name_all(), Modes :: [mode()], BytesCopied :: non_neg_integer(), Reason :: posix() | badarg | terminated. @@ -721,7 +730,7 @@ copy(Source, Dest) -> {ok, BytesCopied} | {error, Reason} when Source :: io_device() | Filename | {Filename, Modes}, Destination :: io_device() | Filename | {Filename, Modes}, - Filename :: name(), + Filename :: name_all(), Modes :: [mode()], ByteCount :: non_neg_integer() | infinity, BytesCopied :: non_neg_integer(), @@ -948,7 +957,7 @@ ipread_s32bu_p32bu_2(File, %%% provide a higher-lever interface to files. -spec consult(Filename) -> {ok, Terms} | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Terms :: [term()], Reason :: posix() | badarg | terminated | system_limit | {Line :: integer(), Mod :: module(), Term :: term()}. @@ -965,10 +974,10 @@ consult(File) -> -spec path_consult(Path, Filename) -> {ok, Terms, FullName} | {error, Reason} when Path :: [Dir], - Dir :: name(), - Filename :: name(), + Dir :: name_all(), + Filename :: name_all(), Terms :: [term()], - FullName :: filename(), + FullName :: filename_all(), Reason :: posix() | badarg | terminated | system_limit | {Line :: integer(), Mod :: module(), Term :: term()}. @@ -988,7 +997,7 @@ path_consult(Path, File) -> end. -spec eval(Filename) -> ok | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Reason :: posix() | badarg | terminated | system_limit | {Line :: integer(), Mod :: module(), Term :: term()}. @@ -996,7 +1005,7 @@ eval(File) -> eval(File, erl_eval:new_bindings()). -spec eval(Filename, Bindings) -> ok | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Bindings :: erl_eval:binding_struct(), Reason :: posix() | badarg | terminated | system_limit | {Line :: integer(), Mod :: module(), Term :: term()}. @@ -1012,9 +1021,9 @@ eval(File, Bs) -> end. -spec path_eval(Path, Filename) -> {ok, FullName} | {error, Reason} when - Path :: [Dir :: name()], - Filename :: name(), - FullName :: filename(), + Path :: [Dir :: name_all()], + Filename :: name_all(), + FullName :: filename_all(), Reason :: posix() | badarg | terminated | system_limit | {Line :: integer(), Mod :: module(), Term :: term()}. @@ -1023,10 +1032,10 @@ path_eval(Path, File) -> -spec path_eval(Path, Filename, Bindings) -> {ok, FullName} | {error, Reason} when - Path :: [Dir :: name()], - Filename :: name(), + Path :: [Dir :: name_all()], + Filename :: name_all(), Bindings :: erl_eval:binding_struct(), - FullName :: filename(), + FullName :: filename_all(), Reason :: posix() | badarg | terminated | system_limit | {Line :: integer(), Mod :: module(), Term :: term()}. @@ -1046,7 +1055,7 @@ path_eval(Path, File, Bs) -> end. -spec script(Filename) -> {ok, Value} | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Value :: term(), Reason :: posix() | badarg | terminated | system_limit | {Line :: integer(), Mod :: module(), Term :: term()}. @@ -1055,7 +1064,7 @@ script(File) -> script(File, erl_eval:new_bindings()). -spec script(Filename, Bindings) -> {ok, Value} | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Bindings :: erl_eval:binding_struct(), Value :: term(), Reason :: posix() | badarg | terminated | system_limit @@ -1073,10 +1082,10 @@ script(File, Bs) -> -spec path_script(Path, Filename) -> {ok, Value, FullName} | {error, Reason} when - Path :: [Dir :: name()], - Filename :: name(), + Path :: [Dir :: name_all()], + Filename :: name_all(), Value :: term(), - FullName :: filename(), + FullName :: filename_all(), Reason :: posix() | badarg | terminated | system_limit | {Line :: integer(), Mod :: module(), Term :: term()}. @@ -1085,11 +1094,11 @@ path_script(Path, File) -> -spec path_script(Path, Filename, Bindings) -> {ok, Value, FullName} | {error, Reason} when - Path :: [Dir :: name()], - Filename :: name(), + Path :: [Dir :: name_all()], + Filename :: name_all(), Bindings :: erl_eval:binding_struct(), Value :: term(), - FullName :: filename(), + FullName :: filename_all(), Reason :: posix() | badarg | terminated | system_limit | {Line :: integer(), Mod :: module(), Term :: term()}. @@ -1118,11 +1127,11 @@ path_script(Path, File, Bs) -> -spec path_open(Path, Filename, Modes) -> {ok, IoDevice, FullName} | {error, Reason} when - Path :: [Dir :: name()], - Filename :: name(), + Path :: [Dir :: name_all()], + Filename :: name_all(), Modes :: [mode()], IoDevice :: io_device(), - FullName :: filename(), + FullName :: filename_all(), Reason :: posix() | badarg | system_limit. path_open(PathList, Name, Mode) -> @@ -1144,7 +1153,7 @@ path_open(PathList, Name, Mode) -> end. -spec change_mode(Filename, Mode) -> ok | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Mode :: integer(), Reason :: posix() | badarg. @@ -1153,7 +1162,7 @@ change_mode(Name, Mode) write_file_info(Name, #file_info{mode=Mode}). -spec change_owner(Filename, Uid) -> ok | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Uid :: integer(), Reason :: posix() | badarg. @@ -1162,7 +1171,7 @@ change_owner(Name, OwnerId) write_file_info(Name, #file_info{uid=OwnerId}). -spec change_owner(Filename, Uid, Gid) -> ok | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Uid :: integer(), Gid :: integer(), Reason :: posix() | badarg. @@ -1172,7 +1181,7 @@ change_owner(Name, OwnerId, GroupId) write_file_info(Name, #file_info{uid=OwnerId, gid=GroupId}). -spec change_group(Filename, Gid) -> ok | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Gid :: integer(), Reason :: posix() | badarg. @@ -1181,7 +1190,7 @@ change_group(Name, GroupId) write_file_info(Name, #file_info{gid=GroupId}). -spec change_time(Filename, Mtime) -> ok | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Mtime :: date_time(), Reason :: posix() | badarg. @@ -1191,7 +1200,7 @@ change_time(Name, {{Y, M, D}, {H, Min, Sec}}=Time) write_file_info(Name, #file_info{mtime=Time}). -spec change_time(Filename, Atime, Mtime) -> ok | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Atime :: date_time(), Mtime :: date_time(), Reason :: posix() | badarg. @@ -1239,7 +1248,7 @@ sendfile(File, Sock, Offset, Bytes, Opts) -> -spec sendfile(Filename, Socket) -> {'ok', non_neg_integer()} | {'error', inet:posix() | closed | badarg | not_owner} - when Filename :: name(), + when Filename :: name_all(), Socket :: inet:socket(). sendfile(Filename, Sock) -> case file:open(Filename, [read, raw, binary]) of diff --git a/lib/kernel/src/file_server.erl b/lib/kernel/src/file_server.erl index 73202319b9..6b413ff630 100644 --- a/lib/kernel/src/file_server.erl +++ b/lib/kernel/src/file_server.erl @@ -170,7 +170,7 @@ handle_call({read_link_info, Name, Opts}, _From, Handle) -> handle_call({read_link, Name}, _From, Handle) -> {reply, ?PRIM_FILE:read_link(Handle, Name), Handle}; handle_call({read_link_all, Name}, _From, Handle) -> - {reply, ?PRIM_FILE:read_link(Handle, Name), Handle}; + {reply, ?PRIM_FILE:read_link_all(Handle, Name), Handle}; handle_call({make_link, Old, New}, _From, Handle) -> {reply, ?PRIM_FILE:make_link(Handle, Old, New), Handle}; diff --git a/lib/kernel/src/gen_tcp.erl b/lib/kernel/src/gen_tcp.erl index ec13ab6d2e..23867300a5 100644 --- a/lib/kernel/src/gen_tcp.erl +++ b/lib/kernel/src/gen_tcp.erl @@ -256,7 +256,7 @@ close(S) -> -spec send(Socket, Packet) -> ok | {error, Reason} when Socket :: socket(), Packet :: iodata(), - Reason :: inet:posix(). + Reason :: closed | inet:posix(). send(S, Packet) when is_port(S) -> case inet_db:lookup_socket(S) of diff --git a/lib/kernel/src/hipe_unified_loader.erl b/lib/kernel/src/hipe_unified_loader.erl index 06d404905d..e676ca997d 100644 --- a/lib/kernel/src/hipe_unified_loader.erl +++ b/lib/kernel/src/hipe_unified_loader.erl @@ -218,7 +218,7 @@ load_common(Mod, Bin, Beam, OldReferencesToPatch) -> {MFAs,Addresses} = exports(ExportMap, CodeAddress), %% Remove references to old versions of the module. ReferencesToPatch = get_refs_from(MFAs, []), - remove_refs_from(MFAs), + ok = remove_refs_from(MFAs), %% Patch all dynamic references in the code. %% Function calls, Atoms, Constants, System calls patch(Refs, CodeAddress, ConstMap2, Addresses, TrampolineMap), @@ -802,7 +802,7 @@ patch_to_emu_step1(Mod) -> %% Find all call sites that call these MFAs. As a side-effect, %% create native stubs for any MFAs that are referred. ReferencesToPatch = get_refs_from(MFAs, []), - remove_refs_from(MFAs), + ok = remove_refs_from(MFAs), ReferencesToPatch; false -> %% The first time we load the module, no redirection needs to be done. @@ -846,11 +846,8 @@ get_refs_from(MFAs, []) -> mark_referred_from(MFAs), MFAs. -mark_referred_from([MFA|MFAs]) -> - hipe_bifs:mark_referred_from(MFA), - mark_referred_from(MFAs); -mark_referred_from([]) -> - []. +mark_referred_from(MFAs) -> + lists:foreach(fun(MFA) -> hipe_bifs:mark_referred_from(MFA) end, MFAs). %%-------------------------------------------------------------------- %% Given a list of MFAs with referred_from references, update their @@ -858,11 +855,8 @@ mark_referred_from([]) -> %% %% The {MFA,Refs} list must come from get_refs_from/2. %% -redirect([MFA|Rest]) -> - hipe_bifs:redirect_referred_from(MFA), - redirect(Rest); -redirect([]) -> - ok. +redirect(MFAs) -> + lists:foreach(fun(MFA) -> hipe_bifs:redirect_referred_from(MFA) end, MFAs). %%-------------------------------------------------------------------- %% Given a list of MFAs, remove all referred_from references having @@ -874,11 +868,8 @@ redirect([]) -> %% list. The refers_to list is used here to find the CalleeMFAs whose %% referred_from lists should be updated. %% -remove_refs_from([CallerMFA|CallerMFAs]) -> - hipe_bifs:remove_refs_from(CallerMFA), - remove_refs_from(CallerMFAs); -remove_refs_from([]) -> - []. +remove_refs_from(MFAs) -> + lists:foreach(fun(MFA) -> hipe_bifs:remove_refs_from(MFA) end, MFAs). %%-------------------------------------------------------------------- diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index 4c040f0a0e..79d11c155c 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -716,7 +716,7 @@ analyse([], [This={M,F,A}|Path], Visited, ErrCnt0) -> %% These modules should be loaded by code.erl before %% the code_server is started. OK = [erlang, os, prim_file, erl_prim_loader, init, ets, - code_server, lists, lists_sort, unicode, binary, filename, packages, + code_server, lists, lists_sort, unicode, binary, filename, gb_sets, gb_trees, hipe_unified_loader, hipe_bifs, prim_zip, zlib], ErrCnt1 = @@ -822,6 +822,10 @@ check_funs({'$M_EXPR','$F_EXPR',2}, check_funs({'$M_EXPR','$F_EXPR',1}, [{lists,foreach,2}, {hipe_unified_loader,patch_consts,3} | _]) -> 0; +check_funs({'$M_EXPR','$F_EXPR',1}, + [{lists,foreach,2}, + {hipe_unified_loader,mark_referred_from,1}, + {hipe_unified_loader,get_refs_from,2}| _]) -> 0; check_funs({'$M_EXPR',warning_msg,2}, [{code_server,finish_on_load_report,2} | _]) -> 0; %% This is cheating! /raimo @@ -1590,7 +1594,7 @@ native_early_modules_1(Architecture) -> ?line true = lists:all(fun code:is_module_native/1, [ets,file,filename,gb_sets,gb_trees, %%hipe_unified_loader, no_native as workaround - lists,os,packages]), + lists,os]), ok end. diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl index fd4d5bd24e..c604e7073f 100644 --- a/lib/kernel/test/file_SUITE.erl +++ b/lib/kernel/test/file_SUITE.erl @@ -46,6 +46,7 @@ read_write_file/1, names/1]). -export([cur_dir_0/1, cur_dir_1/1, make_del_dir/1, list_dir/1,list_dir_error/1, + untranslatable_names/1, untranslatable_names_error/1, pos1/1, pos2/1]). -export([close/1, consult1/1, path_consult/1, delete/1]). -export([ eval1/1, path_eval/1, script1/1, path_script/1, @@ -56,7 +57,7 @@ -export([rename/1, access/1, truncate/1, datasync/1, sync/1, read_write/1, pread_write/1, append/1, exclusive/1]). -export([ e_delete/1, e_rename/1, e_make_dir/1, e_del_dir/1]). --export([otp_5814/1]). +-export([otp_5814/1, otp_10852/1]). -export([ read_not_really_compressed/1, read_compressed_cooked/1, read_compressed_cooked_binary/1, @@ -111,13 +112,14 @@ all() -> {group, files}, delete, rename, names, {group, errors}, {group, compression}, {group, links}, copy, delayed_write, read_ahead, segment_read, segment_write, - ipread, pid2name, interleaved_read_write, otp_5814, + ipread, pid2name, interleaved_read_write, otp_5814, otp_10852, large_file, large_write, read_line_1, read_line_2, read_line_3, read_line_4, standard_io]. groups() -> [{dirs, [], [make_del_dir, cur_dir_0, cur_dir_1, - list_dir, list_dir_error]}, + list_dir, list_dir_error, untranslatable_names, + untranslatable_names_error]}, {files, [], [{group, open}, {group, pos}, {group, file_info}, {group, consult}, {group, eval}, {group, script}, @@ -557,6 +559,112 @@ list_dir_1(TestDir, Cnt, Sorted0) -> Sorted = lists:sort(DirList1), list_dir_1(TestDir, Cnt-1, Sorted). +untranslatable_names(Config) -> + case no_untranslatable_names() of + true -> + {skip,"Not a problem on this OS"}; + false -> + untranslatable_names_1(Config) + end. + +untranslatable_names_1(Config) -> + {ok,OldCwd} = file:get_cwd(), + PrivDir = ?config(priv_dir, Config), + Dir = filename:join(PrivDir, "untranslatable_names"), + ok = file:make_dir(Dir), + Node = start_node(untranslatable_names, "+fnu"), + try + ok = file:set_cwd(Dir), + [ok = file:write_file(F, F) || {_,F} <- untranslatable_names()], + + ExpectedListDir0 = [unicode:characters_to_list(N, utf8) || + {utf8,N} <- untranslatable_names()], + ExpectedListDir = lists:sort(ExpectedListDir0), + io:format("ExpectedListDir: ~p\n", [ExpectedListDir]), + ExpectedListDir = call_and_sort(Node, file, list_dir, [Dir]), + + ExpectedListDirAll0 = [case Enc of + utf8 -> + unicode:characters_to_list(N, utf8); + latin1 -> + N + end || {Enc,N} <- untranslatable_names()], + ExpectedListDirAll = lists:sort(ExpectedListDirAll0), + io:format("ExpectedListDirAll: ~p\n", [ExpectedListDirAll]), + ExpectedListDirAll = call_and_sort(Node, file, list_dir_all, [Dir]) + after + catch test_server:stop_node(Node), + file:set_cwd(OldCwd), + [file:delete(F) || {_,F} <- untranslatable_names()], + file:del_dir(Dir) + end, + ok. + +untranslatable_names_error(Config) -> + case no_untranslatable_names() of + true -> + {skip,"Not a problem on this OS"}; + false -> + untranslatable_names_error_1(Config) + end. + +untranslatable_names_error_1(Config) -> + {ok,OldCwd} = file:get_cwd(), + PrivDir = ?config(priv_dir, Config), + Dir = filename:join(PrivDir, "untranslatable_names_error"), + ok = file:make_dir(Dir), + Node = start_node(untranslatable_names, "+fnue"), + try + ok = file:set_cwd(Dir), + [ok = file:write_file(F, F) || {_,F} <- untranslatable_names()], + + ExpectedListDir0 = [unicode:characters_to_list(N, utf8) || + {utf8,N} <- untranslatable_names()], + ExpectedListDir = lists:sort(ExpectedListDir0), + io:format("ExpectedListDir: ~p\n", [ExpectedListDir]), + {error,{no_translation,BadFile}} = + rpc:call(Node, file, list_dir, [Dir]), + true = lists:keymember(BadFile, 2, untranslatable_names()) + + after + catch test_server:stop_node(Node), + file:set_cwd(OldCwd), + [file:delete(F) || {_,F} <- untranslatable_names()], + file:del_dir(Dir) + end, + ok. + +untranslatable_names() -> + [{utf8,<<"abc">>}, + {utf8,<<"def">>}, + {utf8,<<"Lagerl",195,182,"f">>}, + {utf8,<<195,150,"stra Emterwik">>}, + {latin1,<<"M",229,"rbacka">>}, + {latin1,<<"V",228,"rmland">>}]. + +call_and_sort(Node, M, F, A) -> + {ok,Res} = rpc:call(Node, M, F, A), + lists:sort(Res). + +no_untranslatable_names() -> + case os:type() of + {unix,darwin} -> true; + {win32,_} -> true; + _ -> false + end. + +start_node(Name, Args) -> + [_,Host] = string:tokens(atom_to_list(node()), "@"), + ct:log("Trying to start ~w@~s~n", [Name,Host]), + case test_server:start_node(Name, peer, [{args,Args}]) of + {error,Reason} -> + test_server:fail(Reason); + {ok,Node} -> + ct:log("Node ~p started~n", [Node]), + Node + end. + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -3410,6 +3518,49 @@ otp_5814(Config) when is_list(Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +otp_10852(suite) -> + []; +otp_10852(doc) -> + ["OTP-10852. +fnu and latin1 filenames"]; +otp_10852(Config) when is_list(Config) -> + Node = start_node(erl_pp_helper, "+fnu"), + Dir = ?config(priv_dir, Config), + B = filename:join(Dir, <<"\xE4">>), + ok = rpc_call(Node, get_cwd, [B]), + {error, no_translation} = rpc_call(Node, set_cwd, [B]), + ok = rpc_call(Node, delete, [B]), + ok = rpc_call(Node, rename, [B, B]), + ok = rpc_call(Node, read_file_info, [B]), + ok = rpc_call(Node, read_link_info, [B]), + ok = rpc_call(Node, read_link, [B]), + ok = rpc_call(Node, write_file_info, [B,#file_info{}]), + ok = rpc_call(Node, list_dir, [B]), + ok = rpc_call(Node, list_dir_all, [B]), + ok = rpc_call(Node, read_file, [B]), + ok = rpc_call(Node, make_link, [B,B]), + ok = rpc_call(Node, make_symlink, [B,B]), + ok = rpc_call(Node, delete, [B]), + ok = rpc_call(Node, make_dir, [B]), + ok = rpc_call(Node, del_dir, [B]), + ok = rpc_call(Node, write_file, [B,B]), + {ok, Fd} = rpc_call(Node, open, [B,[read]]), + ok = rpc_call(Node, close, [Fd]), + {ok,0} = rpc_call(Node, copy, [B,B]), + {ok, Fd2, B} = rpc_call(Node, path_open, [["."], B, [read]]), + ok = rpc_call(Node, close, [Fd2]), + true = test_server:stop_node(Node), + ok. + +rpc_call(N, F, As) -> + case rpc:call(N, ?FILE_MODULE, F, As) of + {error, enotsup} -> ok; + {error, enoent} -> ok; + {error, badarg} -> ok; + Else -> Else + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + large_file(suite) -> []; large_file(doc) -> diff --git a/lib/kernel/test/file_name_SUITE.erl b/lib/kernel/test/file_name_SUITE.erl index e8529db1dc..808a10ee27 100644 --- a/lib/kernel/test/file_name_SUITE.erl +++ b/lib/kernel/test/file_name_SUITE.erl @@ -340,9 +340,9 @@ check_icky(Mod) -> ?line true=(length("åäö") =:= 3), ?line UniMode = file:native_name_encoding() =/= latin1, ?line make_icky_dir(Mod), - ?line {ok, L0} = Mod:list_dir("."), + {ok, L0} = Mod:list_dir_all("."), ?line L1 = lists:sort(L0), - io:format("~p ~p~n",[L1,list(icky_dir())]), + io:format("~p~n~p~n~n",[L1,lists:sort(list(icky_dir()))]), ?line L1 = lists:sort(convlist(list(icky_dir()))), ?line {ok,D2} = Mod:get_cwd(), ?line true = is_list(D2), @@ -357,7 +357,8 @@ check_icky(Mod) -> ?line Syms = [ {S,conv(Targ),list_to_binary(get_data(Targ,icky_dir()))} || {T,S,Targ} <- icky_dir(), T =:= symlink ], ?line [ {ok, Cont} = Mod:read_file(SymL) || {SymL,_,Cont} <- Syms ], - ?line [ {ok, Targ} = fixlink(Mod:read_link(SymL)) || {SymL,Targ,_} <- Syms ], + [ {ok, Targ} = fixlink(Mod:read_link_all(SymL)) || + {SymL,Targ,_} <- Syms ], ?line chk_cre_dir(Mod,[{directory,"åäö_dir",icky_dir()}]), ?line {ok,BeginAt} = Mod:get_cwd(), ?line true = is_list(BeginAt), @@ -369,7 +370,7 @@ check_icky(Mod) -> ?line ok = Mod:set_cwd(".."), ?line {ok,BeginAt} = Mod:get_cwd(), ?line rm_r2(Mod,"åäö_dir"), - {OS,TYPE} = os:type(), + {OS,_} = os:type(), % Check that treat_icky really converts to the same as the OS case UniMode of true -> @@ -377,7 +378,7 @@ check_icky(Mod) -> ?line ok = Mod:set_cwd("åäö_dir"), ?line ok = Mod:write_file(<<"ååå">>,<<"hello">>), ?line Treated = treat_icky(<<"ååå">>), - ?line {ok,[Treated]} = Mod:list_dir("."), + {ok,[Treated]} = Mod:list_dir_all("."), ?line ok = Mod:delete(<<"ååå">>), ?line {ok,[]} = Mod:list_dir("."), ?line ok = Mod:set_cwd(".."), @@ -393,15 +394,7 @@ check_icky(Mod) -> true -> ok end, - ?line ok = Mod:set_cwd(treat_icky(<<"åäö_dir">>)), - ?line {ok, NowAt2} = Mod:get_cwd(), - io:format("~p~n",[NowAt2]), - % Cannot create raw unicode-breaking filenames on windows or macos - ?line true = ((((not UniMode) or (OS =:= win32) or (TYPE=:=darwin)) and is_list(NowAt2)) orelse ((UniMode) and is_binary(NowAt2))), - ?line true = BeginAt =/= NowAt2, - ?line ok = Mod:set_cwd(".."), ?line {ok,BeginAt} = Mod:get_cwd(), - ?line rm_r2(Mod,conv(treat_icky(<<"åäö_dir">>))), case has_links() of true -> ?line ok = Mod:make_link("fil1","nisseö"), @@ -485,7 +478,7 @@ check_very_icky(Mod) -> ok end, ?line make_very_icky_dir(Mod), - ?line {ok, L0} = Mod:list_dir("."), + {ok, L0} = Mod:list_dir_all("."), ?line L1 = lists:sort(L0), ?line L1 = lists:sort(convlist(list(very_icky_dir()))), ?line {ok,D2} = Mod:get_cwd(), @@ -494,7 +487,8 @@ check_very_icky(Mod) -> ?line Syms = [ {S,conv(Targ),list_to_binary(get_data(Targ,very_icky_dir()))} || {T,S,Targ} <- very_icky_dir(), T =:= symlink ], ?line [ {ok, Cont} = Mod:read_file(SymL) || {SymL,_,Cont} <- Syms ], - ?line [ {ok, Targ} = fixlink(Mod:read_link(SymL)) || {SymL,Targ,_} <- Syms ], + ?line [ {ok, Targ} = fixlink(Mod:read_link_all(SymL)) || + {SymL,Targ,_} <- Syms ], ?line chk_cre_dir(Mod,[{directory,[1088,1079,1091]++"_dir",very_icky_dir()}]), ?line {ok,BeginAt} = Mod:get_cwd(), ?line true = is_list(BeginAt), @@ -559,22 +553,6 @@ check_very_icky(Mod) -> FI#file_info{mode = NewMode2}), ?line {ok,#file_info{mode = NewMode2}} = Mod:read_file_info([956,965,963,954,959,49]), - ?line NumOK0 = case has_links() of - true -> 5; - false -> 3 - end, - ?line NumNOK0 = case has_links() of - true -> 4; - false -> 3 - end, - ?line {NumOK,NumNOK} = case is_binary(treat_icky(<<"foo">>)) of - false -> - {NumOK0+NumNOK0,0}; - true -> - {NumOK0,NumNOK0} - end, - ?line {NumOK,NumNOK} = filelib:fold_files(".",".*",true,fun(_F,{N,M}) when is_list(_F) -> io:format("~ts~n",[_F]),{N+1,M}; (_F,{N,M}) -> io:format("~p~n",[_F]),{N,M+1} end,{0,0}), - ?line ok = filelib:fold_files(".",[1076,1089,1072,124,46,42],true,fun(_F,_) -> ok end,false), ok catch throw:need_unicode_mode -> @@ -593,7 +571,7 @@ check_very_icky(Mod) -> rm_rf(Mod,Dir) -> case Mod:read_link_info(Dir) of {ok, #file_info{type = directory}} -> - {ok, Content} = Mod:list_dir(Dir), + {ok, Content} = Mod:list_dir_all(Dir), [ rm_rf(Mod,filename:join(Dir,C)) || C <- Content ], Mod:del_dir(Dir), ok; @@ -608,7 +586,7 @@ rm_r(Mod,Dir) -> case Mod:read_link_info(Dir) of {ok, #file_info{type = directory}} -> {ok,#file_info{type = directory}} = Mod:read_file_info(Dir), - {ok, Content} = Mod:list_dir(Dir), + {ok, Content} = Mod:list_dir_all(Dir), [ true = is_list(Part) || Part <- Content ], [ true = is_list(filename:join(Dir,Part)) || Part <- Content ], [ rm_r(Mod,filename:join(Dir,C)) || C <- Content ], @@ -626,7 +604,7 @@ rm_r2(Mod,Dir) -> case Mod:read_link_info(Dir) of {ok, #file_info{type = directory}} -> {ok,#file_info{type = directory}} = Mod:read_file_info(Dir), - {ok, Content} = Mod:list_dir(Dir), + {ok, Content} = Mod:list_dir_all(Dir), UniMode = file:native_name_encoding() =/= latin1, [ true = (is_list(Part) orelse UniMode) || Part <- Content ], [ true = (is_list(filename:join(Dir,Part)) orelse UniMode) || Part <- Content ], diff --git a/lib/odbc/test/odbc_connect_SUITE.erl b/lib/odbc/test/odbc_connect_SUITE.erl index b06384fc94..74ae2c96e6 100644 --- a/lib/odbc/test/odbc_connect_SUITE.erl +++ b/lib/odbc/test/odbc_connect_SUITE.erl @@ -277,13 +277,19 @@ port_dies(_Config) -> {ok, Ref} = odbc:connect(?RDBMS:connection_string(), odbc_test_lib:platform_options()), {status, _} = process_info(Ref, status), process_flag(trap_exit, true), - Port = lists:last(erlang:ports()), - exit(Port, kill), - %% Wait for exit_status from port 5000 ms (will not get a exit - %% status in this case), then wait a little longer to make sure - %% the port and the controlprocess has had time to terminate. - test_server:sleep(10000), - undefined = process_info(Ref, status). + NamedPorts = [{P, erlang:port_info(P, name)} || P <- erlang:ports()], + case [P || {P, {name, Name}} <- NamedPorts, is_odbcserver(Name)] of + [Port] -> + exit(Port, kill), + %% Wait for exit_status from port 5000 ms (will not get a exit + %% status in this case), then wait a little longer to make sure + %% the port and the controlprocess has had time to terminate. + test_server:sleep(10000), + undefined = process_info(Ref, status); + [] -> + ct:fail([erlang:port_info(P, name) || P <- erlang:ports()]) + end. + %%------------------------------------------------------------------------- control_process_dies(doc) -> @@ -292,13 +298,17 @@ control_process_dies(suite) -> []; control_process_dies(_Config) -> {ok, Ref} = odbc:connect(?RDBMS:connection_string(), odbc_test_lib:platform_options()), process_flag(trap_exit, true), - Port = lists:last(erlang:ports()), - {connected, Ref} = erlang:port_info(Port, connected), - exit(Ref, kill), - test_server:sleep(500), - undefined = erlang:port_info(Port, connected). - %% Check for c-program still running, how? - + NamedPorts = [{P, erlang:port_info(P, name)} || P <- erlang:ports()], + case [P || {P, {name, Name}} <- NamedPorts, is_odbcserver(Name)] of + [Port] -> + {connected, Ref} = erlang:port_info(Port, connected), + exit(Ref, kill), + test_server:sleep(500), + undefined = erlang:port_info(Port, connected); + %% Check for c-program still running, how? + [] -> + ct:fail([erlang:port_info(P, name) || P <- erlang:ports()]) + end. %%------------------------------------------------------------------------- client_dies_normal(doc) -> @@ -868,3 +878,13 @@ extended_errors(Config) when is_list(Config)-> ok = odbc:disconnect(Ref), ok = odbc:disconnect(RefExtended). + + +is_odbcserver(Name) -> + case re:run(Name, "odbcserver") of + {match, _} -> + true; + _ -> + false + end. + diff --git a/lib/parsetools/src/leex.erl b/lib/parsetools/src/leex.erl index 22b496258f..e531b78a5b 100644 --- a/lib/parsetools/src/leex.erl +++ b/lib/parsetools/src/leex.erl @@ -127,7 +127,7 @@ file(File, Opts0) -> leex_ret(St). format_error({file_error, Reason}) -> - io_lib:fwrite("~s",[file:format_error(Reason)]); + io_lib:fwrite("~ts",[file:format_error(Reason)]); format_error(missing_defs) -> "missing Definitions"; format_error(missing_rules) -> "missing Rules"; format_error(missing_code) -> "missing Erlang code"; @@ -301,10 +301,10 @@ pack_warnings([]) -> report_errors(St) -> when_opt(fun () -> foreach(fun({File,{none,Mod,E}}) -> - io:fwrite("~s: ~ts\n", + io:fwrite("~ts: ~ts\n", [File,Mod:format_error(E)]); ({File,{Line,Mod,E}}) -> - io:fwrite("~s:~w: ~ts\n", + io:fwrite("~ts:~w: ~ts\n", [File,Line,Mod:format_error(E)]) end, sort(St#leex.errors)) end, report_errors, St#leex.opts). @@ -319,11 +319,11 @@ report_warnings(St) -> ShouldReport = member(report_warnings, St#leex.opts) orelse ReportWerror, when_bool(fun () -> foreach(fun({File,{none,Mod,W}}) -> - io:fwrite("~s: ~s~ts\n", + io:fwrite("~ts: ~s~ts\n", [File,Prefix, Mod:format_error(W)]); ({File,{Line,Mod,W}}) -> - io:fwrite("~s:~w: ~s~ts\n", + io:fwrite("~ts:~w: ~s~ts\n", [File,Line,Prefix, Mod:format_error(W)]) end, sort(St#leex.warnings)) @@ -401,7 +401,7 @@ parse_file(St0) -> {ok,Xfile} -> St1 = St0#leex{encoding = epp:set_encoding(Xfile)}, try - verbose_print(St1, "Parsing file ~s, ", [St1#leex.xfile]), + verbose_print(St1, "Parsing file ~ts, ", [St1#leex.xfile]), %% We KNOW that errors throw so we can ignore them here. {ok,Line1,St2} = parse_head(Xfile, St1), {ok,Line2,Macs,St3} = parse_defs(Xfile, Line1, St2), @@ -1292,7 +1292,7 @@ pack_dfa([], _, Rs, PDFA) -> {PDFA,Rs}. %% the code for the actions. out_file(St0, DFA, DF, Actions, Code) -> - verbose_print(St0, "Writing file ~s, ", [St0#leex.efile]), + verbose_print(St0, "Writing file ~ts, ", [St0#leex.efile]), case open_inc_file(St0) of {ok,Ifile} -> try @@ -1582,7 +1582,7 @@ pp_sep(_, _, _, _) -> " ". %% with Graphviz. out_dfa_graph(St, DFA, DF) -> - verbose_print(St, "Writing DFA to file ~s, ", [St#leex.gfile]), + verbose_print(St, "Writing DFA to file ~ts, ", [St#leex.gfile]), case file:open(St#leex.gfile, [write]) of {ok,Gfile} -> try @@ -1644,7 +1644,7 @@ output_encoding_comment(File, #leex{encoding = Encoding}) -> io:fwrite(File, <<"%% ~s\n">>, [epp:encoding_to_string(Encoding)]). output_file_directive(File, Filename, Line) -> - io:fwrite(File, <<"-file(~s, ~w).\n">>, + io:fwrite(File, <<"-file(~ts, ~w).\n">>, [format_filename(Filename), Line]). format_filename(Filename) -> diff --git a/lib/parsetools/src/yecc.erl b/lib/parsetools/src/yecc.erl index 30e0db421e..53292b037a 100644 --- a/lib/parsetools/src/yecc.erl +++ b/lib/parsetools/src/yecc.erl @@ -185,7 +185,7 @@ format_error({endsymbol_is_terminal, Symbol}) -> format_error({error, Module, Error}) -> Module:format_error(Error); format_error({file_error, Reason}) -> - io_lib:fwrite("~s",[file:format_error(Reason)]); + io_lib:fwrite("~ts",[file:format_error(Reason)]); format_error(illegal_empty) -> io_lib:fwrite("illegal use of empty symbol", []); format_error({internal_error, Error}) -> @@ -481,7 +481,7 @@ generate(St0) -> ?PASS(action_conflicts), ?PASS(write_file)], F = case member(time, St1#yecc.options) of true -> - io:fwrite(<<"Generating parser from grammar in ~s\n">>, + io:fwrite(<<"Generating parser from grammar in ~ts\n">>, [format_filename(St1#yecc.infile)]), fun timeit/3; false -> @@ -858,10 +858,10 @@ report_errors(St) -> case member(report_errors, St#yecc.options) of true -> foreach(fun({File,{none,Mod,E}}) -> - io:fwrite(<<"~s: ~ts\n">>, + io:fwrite(<<"~ts: ~ts\n">>, [File,Mod:format_error(E)]); ({File,{Line,Mod,E}}) -> - io:fwrite(<<"~s:~w: ~ts\n">>, + io:fwrite(<<"~ts:~w: ~ts\n">>, [File,Line,Mod:format_error(E)]) end, sort(St#yecc.errors)); false -> @@ -878,11 +878,11 @@ report_warnings(St) -> case member(report_warnings, St#yecc.options) orelse ReportWerror of true -> foreach(fun({File,{none,Mod,W}}) -> - io:fwrite(<<"~s: ~s~ts\n">>, + io:fwrite(<<"~ts: ~s~ts\n">>, [File,Prefix, Mod:format_error(W)]); ({File,{Line,Mod,W}}) -> - io:fwrite(<<"~s:~w: ~s~ts\n">>, + io:fwrite(<<"~ts:~w: ~s~ts\n">>, [File,Line,Prefix, Mod:format_error(W)]) end, sort(St#yecc.warnings)); @@ -2518,7 +2518,7 @@ output_encoding_comment(#yecc{encoding = Encoding}=St) -> fwrite(St, <<"%% ~s\n">>, [epp:encoding_to_string(Encoding)]). output_file_directive(St, Filename, Line) when St#yecc.file_attrs -> - fwrite(St, <<"-file(~s, ~w).\n">>, + fwrite(St, <<"-file(~ts, ~w).\n">>, [format_filename(Filename), Line]); output_file_directive(St, _Filename, _Line) -> St. diff --git a/lib/reltool/examples/display_args b/lib/reltool/examples/display_args index bf0994ab7c..a8882f7bda 100644 --- a/lib/reltool/examples/display_args +++ b/lib/reltool/examples/display_args @@ -1,8 +1,9 @@ #!/usr/bin/env escript %% -*- erlang -*- -%%! -smp disable +%%! -emuarg emuvalue main(Args) -> + {ok,[Emuvalue]} = init:get_argument(emuarg), io:format("Root dir: ~s\n", [code:root_dir()]), io:format("Script args: ~p\n", [Args]), - io:format("Smp: ~p\n", [erlang:system_info(smp_support)]). + io:format("Emuarg: ~p\n", [Emuvalue]). diff --git a/lib/reltool/src/reltool.erl b/lib/reltool/src/reltool.erl index 2bdf222aa0..8ab2c2399e 100644 --- a/lib/reltool/src/reltool.erl +++ b/lib/reltool/src/reltool.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2012. All Rights Reserved. +%% Copyright Ericsson AB 2009-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -120,7 +120,7 @@ apply_fun(Pid, false, Fun) -> apply_fun(Pid, true, Fun) -> case get_status(Pid) of {ok, Warnings} -> - [io:format("~p: ~s\n", [?APPLICATION, W]) || W <- Warnings], + [io:format("~w: ~ts\n", [?APPLICATION, W]) || W <- Warnings], apply_fun(Pid, false, Fun); {error, _Reason} = Error -> stop(Pid), diff --git a/lib/reltool/src/reltool_app_win.erl b/lib/reltool/src/reltool_app_win.erl index 6cd0d2f90b..81ab1687fb 100644 --- a/lib/reltool/src/reltool_app_win.erl +++ b/lib/reltool/src/reltool_app_win.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2012. All Rights Reserved. +%% Copyright Ericsson AB 2009-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -173,7 +173,7 @@ loop(#state{xref_pid = Xref, common = C, app = App} = S) -> S#state.mod_wins)}, ?MODULE:loop(S2); Msg -> - error_logger:format("~p~p got unexpected message:\n\t~p\n", + error_logger:format("~w~w got unexpected message:\n\t~p\n", [?MODULE, self(), Msg]), ?MODULE:loop(S) end. @@ -181,7 +181,7 @@ loop(#state{xref_pid = Xref, common = C, app = App} = S) -> exit_warning({'EXIT', _Pid, shutdown}) -> ok; exit_warning({'EXIT', _Pid, _Reason} = Msg) -> - error_logger:format("~p~p got unexpected message:\n\t~p\n", + error_logger:format("~w~w got unexpected message:\n\t~p\n", [?MODULE, self(), Msg]). create_window(#state{app = App} = S) -> @@ -627,7 +627,7 @@ handle_event(#state{sys = Sys, app = App} = S, Wx) -> Items = reltool_utils:get_items(ListCtrl), handle_mod_button(S, Items, Action); _ -> - error_logger:format("~p~p got unexpected app event from " + error_logger:format("~w~w got unexpected app event from " "wx:\n\t~p\n", [?MODULE, self(), Wx]), S @@ -674,8 +674,8 @@ move_mod(App, {_ItemNo, ModStr}, Action) -> blacklist_del -> undefined; _ -> - error_logger:format("~p~p got unexpected mod " - "button event: ~p\n\t ~p\n", + error_logger:format("~w~w got unexpected mod " + "button event: ~w\n\t ~p\n", [?MODULE, self(), ModName, Action]), M#mod.incl_cond end, diff --git a/lib/reltool/src/reltool_fgraph_win.erl b/lib/reltool/src/reltool_fgraph_win.erl index b0deb1bab2..66bc2b5ab3 100644 --- a/lib/reltool/src/reltool_fgraph_win.erl +++ b/lib/reltool/src/reltool_fgraph_win.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2010. All Rights Reserved. +%% Copyright Ericsson AB 2009-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -525,7 +525,7 @@ loop(S, G) -> exit(Reason); Other -> - error_logger:format("~p~p got unexpected message:\n\t~p\n", + error_logger:format("~w~w got unexpected message:\n\t~p\n", [?MODULE, self(), Other]), loop(S, G) end. diff --git a/lib/reltool/src/reltool_mod_win.erl b/lib/reltool/src/reltool_mod_win.erl index 899423bb6d..b0193a2ae4 100644 --- a/lib/reltool/src/reltool_mod_win.erl +++ b/lib/reltool/src/reltool_mod_win.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2012. All Rights Reserved. +%% Copyright Ericsson AB 2009-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -130,7 +130,7 @@ do_init(Parent, WxEnv, Xref, RelPid, C, ModName) -> loop(#state{xref_pid = Xref, common = C, mod = Mod} = S) -> receive Msg -> - %% io:format("~s~p -> ~p\n", [S#state.name, self(), Msg]), + %% io:format("~ts~w -> ~p\n", [S#state.name, self(), Msg]), case Msg of {system, From, SysMsg} -> Dbg = C#common.sys_debug, @@ -170,7 +170,7 @@ loop(#state{xref_pid = Xref, common = C, mod = Mod} = S) -> S2 = handle_event(S, Wx), ?MODULE:loop(S2); _ -> - error_logger:format("~p~p got unexpected message:\n\t~p\n", + error_logger:format("~w~w got unexpected message:\n\t~p\n", [?MODULE, self(), Msg]), ?MODULE:loop(S) end @@ -335,23 +335,37 @@ find_regular_bin(App, Mod) -> SrcDir = filename:join([ActiveDir, "src"]), ModStr = atom_to_list(Mod#mod.name), Base = "^" ++ ModStr ++ "\\.erl$", - Find = fun(F, _Acc) -> throw(file:read_file(F)) end, + Find = fun(F, _Acc) -> throw({file:read_file(F),epp:read_encoding(F)}) end, case catch filelib:fold_files(SrcDir, Base, true, Find, {error, enoent}) of - {ok, Bin} -> - Bin; + {{ok, Bin},Encoding0} -> + Encoding = + case Encoding0 of + none -> epp:default_encoding(); + _ -> Encoding0 + end, + unicode:characters_to_binary(Bin,Encoding,utf8); {error, enoent} -> %% Reconstructing the source code from debug info if possible BeamFile = filename:join([ActiveDir, "ebin", ModStr ++ ".beam"]), - case beam_lib:chunks(BeamFile, [abstract_code]) of - {ok,{_,[{abstract_code,{_,AC}}]}} -> - IoList = erl_prettypr:format(erl_syntax:form_list(AC)), - list_to_binary(IoList); - _ -> - list_to_binary(["%% Bad luck, cannot find any " - "debug info in the file \"", BeamFile]) + case source_from_beam(BeamFile) of + {ok,Source} -> + Source; + error -> + unicode:characters_to_binary( + ["%% Bad luck, cannot find any " + "debug info in the file \"", BeamFile]) end end. +source_from_beam(Beam) -> + case beam_lib:chunks(Beam, [abstract_code]) of + {ok,{_,[{abstract_code,{_,AC}}]}} -> + IoList = [erl_pp:form(F,[{encoding,utf8}]) || F <- AC], + {ok,unicode:characters_to_binary(IoList)}; + _ -> + error + end. + find_escript_bin(#app{active_dir = ActiveDir}, Mod) -> NotFound = false, ModName = Mod#mod.name, @@ -366,16 +380,10 @@ find_escript_bin(#app{active_dir = ActiveDir}, Mod) -> case beam_lib:version(Bin) of {ok,{M, _}} when M =:= ModName; FullName =:= "." -> - case beam_lib:chunks(Bin, - [abstract_code]) of - {ok,{_,[{abstract_code,{_,AC}}]}} -> - Form = - erl_syntax:form_list(AC), - IoList = - erl_prettypr:format(Form), - {obj, - list_to_binary(IoList)}; - _ -> + case source_from_beam(Bin) of + {ok,Source} -> + {obj,Source}; + error -> Acc end; _ -> @@ -396,12 +404,9 @@ find_escript_bin(#app{active_dir = ActiveDir}, Mod) -> case filename:split(FullName) of [_AppName, "ebin", F] when F =:= ObjFile, Acc =:= NotFound -> - case beam_lib:chunks(GetBin(), - [abstract_code]) of - {ok,{_,[{abstract_code,{_,AC}}]}} -> - Form = erl_syntax:form_list(AC), - IoList = erl_prettypr:format(Form), - {obj, list_to_binary(IoList)}; + case source_from_beam(GetBin()) of + {ok,Source} -> + {obj,Source}; _ -> Acc end; @@ -420,13 +425,15 @@ find_escript_bin(#app{active_dir = ActiveDir}, Mod) -> {ok, {obj, Bin}} -> Bin; _ -> - list_to_binary(["%% Bad luck, cannot find the " - "code in the escript ", Escript, "."]) + unicode:characters_to_binary( + ["%% Bad luck, cannot find the " + "code in the escript ", Escript, "."]) end catch throw:Reason when is_list(Reason) -> - list_to_binary(["%% Bad luck, cannot find the code " - "in the escript ", Escript, ": ", Reason]) + unicode:characters_to_binary( + ["%% Bad luck, cannot find the code " + "in the escript ", Escript, ": ", Reason]) end. create_config_page(S) -> @@ -478,7 +485,7 @@ handle_event(#state{xref_pid = Xref} = S, Wx) -> wxWindow:setFocus(ObjRef), S; _ -> - error_logger:format("~p~p got unexpected mod event from " + error_logger:format("~w~w got unexpected mod event from " "wx:\n\t~p\n", [?MODULE, self(), Wx]), S diff --git a/lib/reltool/src/reltool_server.erl b/lib/reltool/src/reltool_server.erl index c56e29152d..5e25f22a6f 100644 --- a/lib/reltool/src/reltool_server.erl +++ b/lib/reltool/src/reltool_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2012. All Rights Reserved. +%% Copyright Ericsson AB 2009-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -399,12 +399,12 @@ loop(#state{sys = Sys} = S) -> {'EXIT', Pid, Reason} when Pid =:= S#state.parent_pid -> exit(Reason); {call, ReplyTo, Ref, Msg} when is_pid(ReplyTo), is_reference(Ref) -> - error_logger:format("~p~p got unexpected call:\n\t~p\n", + error_logger:format("~w~w got unexpected call:\n\t~p\n", [?MODULE, self(), Msg]), reltool_utils:reply(ReplyTo, Ref, {error, {invalid_call, Msg}}), ?MODULE:loop(S); Msg -> - error_logger:format("~p~p got unexpected message:\n\t~p\n", + error_logger:format("~w~w got unexpected message:\n\t~p\n", [?MODULE, self(), Msg]), ?MODULE:loop(S) end. @@ -422,7 +422,7 @@ do_set_apps(#state{sys = Sys} = S, ChangedApps) -> %% 2) removing #app records if no configurable fields are set %% 3) keeping #app records that are not changed app_update_config([#app{name=Name,is_escript={inlined,Escript}}|_],_SysApps) -> - reltool_utils:throw_error("Application ~p is inlined in ~p. Can not change " + reltool_utils:throw_error("Application ~w is inlined in ~w. Can not change " "configuration for an inlined application.", [Name,Escript]); app_update_config([Config|Configs],SysApps) -> @@ -580,8 +580,8 @@ apps_in_rel(#rel{name = RelName, rel_apps = RelApps}, Apps) -> IA; false -> reltool_utils:throw_error( - "Release ~p uses non existing " - "application ~p", + "Release ~tp uses non existing " + "application ~w", [RelName,RA#rel_app.name]) end; IA -> @@ -602,7 +602,7 @@ more_apps_in_rels([{RelName, AppName} = RA | RelApps], Apps, Acc) -> more_apps_in_rels(RelApps, Apps, Acc2); false -> reltool_utils:throw_error( - "Release ~p uses non existing application ~p", + "Release ~tp uses non existing application ~w", [RelName,AppName]) end end; @@ -640,7 +640,7 @@ app_init_is_included(#state{app_tab = AppTab, mod_tab = ModTab, sys=Sys}, {undefined, false, false, Status}; {exclude, [RelName | _]} -> % App is included in at least one rel reltool_utils:throw_error( - "Application ~p is used in release ~p and cannot be excluded", + "Application ~w is used in release ~tp and cannot be excluded", [AppName,RelName]); {derived, []} -> {undefined, undefined, undefined, Status}; @@ -665,7 +665,7 @@ app_init_is_included(#state{app_tab = AppTab, mod_tab = ModTab, sys=Sys}, Status3. mod_init_is_included(ModTab, M, ModCond, AppCond, Default, Status) -> - %% print(M#mod.name, hipe, "incl_cond -> ~p\n", [AppCond]), + %% print(M#mod.name, hipe, "incl_cond -> ~w\n", [AppCond]), IsIncl = case AppCond of include -> @@ -677,7 +677,7 @@ mod_init_is_included(ModTab, M, ModCond, AppCond, Default, Status) -> derived -> undefined; undefined -> - %% print(M#mod.name, hipe, "mod_cond -> ~p\n", + %% print(M#mod.name, hipe, "mod_cond -> ~w\n", %% [ModCond]), case ModCond of all -> true; @@ -711,23 +711,23 @@ mod_init_is_included(ModTab, M, ModCond, AppCond, Default, Status) -> {false,_} -> ets:insert(ModTab, M2), reltool_utils:add_warning( - "Module ~p exists in applications ~p and ~p. " - "Using module from application ~p.", + "Module ~w exists in applications ~w and ~w. " + "Using module from application ~w.", [M#mod.name, Existing#mod.app_name, M#mod.app_name, M#mod.app_name], Status); {_,false} -> %% Don't insert in ModTab - using Existing reltool_utils:add_warning( - "Module ~p exists in applications ~p and ~p. " - "Using module from application ~p.", + "Module ~w exists in applications ~w and ~w. " + "Using module from application ~w.", [M#mod.name, Existing#mod.app_name, M#mod.app_name,Existing#mod.app_name], Status); {_,_} -> reltool_utils:throw_error( - "Module ~p potentially included by two different " - "applications: ~p and ~p.", + "Module ~w potentially included by two different " + "applications: ~w and ~w.", [M#mod.name,Existing#mod.app_name,M#mod.app_name]) end; [] -> @@ -735,7 +735,7 @@ mod_init_is_included(ModTab, M, ModCond, AppCond, Default, Status) -> Status end, - %% print(M#mod.name, hipe, "~p -> ~p\n", [M2, IsIncl]), + %% print(M#mod.name, hipe, "~p -> ~w\n", [M2, IsIncl]), {M2,Status2}. false_to_undefined(Bool) -> @@ -888,7 +888,7 @@ mod_recap_dependencies(S, A, [#mod{name = ModName}=M1 | Mods], Acc, IsIncl) -> case ets:lookup(S#state.mod_tab, ModName) of [M2] when M2#mod.app_name=:=A#app.name -> ModStatus = do_get_status(M2), - %% print(M2#mod.name, hipe, "status -> ~p\n", [ModStatus]), + %% print(M2#mod.name, hipe, "status -> ~w\n", [ModStatus]), {IsIncl2, M3} = case M2#mod.is_included of true -> @@ -910,8 +910,8 @@ mod_recap_dependencies(S, A, [#mod{name = ModName}=M1 | Mods], Acc, IsIncl) -> %% A module is potensially included by multiple %% applications. This is not allowed! reltool_utils:throw_error( - "Module ~p potentially included by two different applications: " - "~p and ~p", [ModName,A#app.name, " and ", M2#mod.app_name, "."]) + "Module ~w potentially included by two different applications: " + "~w and ~w.", [ModName,A#app.name, M2#mod.app_name]) end; mod_recap_dependencies(_S, _A, [], Acc, IsIncl) -> {lists:reverse(Acc), IsIncl}. @@ -939,7 +939,7 @@ verify_config(#state{app_tab=AppTab, sys=#sys{boot_rel = BootRel, rels = Rels}}, Rels); false -> reltool_utils:throw_error( - "Release ~p is mandatory (used as boot_rel)",[BootRel]) + "Release ~tp is mandatory (used as boot_rel)",[BootRel]) end. check_app(AppTab, {RelName, AppName}, Status) -> @@ -949,7 +949,7 @@ check_app(AppTab, {RelName, AppName}, Status) -> Status; _ -> reltool_utils:throw_error( - "Release ~p uses non included application ~p",[RelName,AppName]) + "Release ~tp uses non included application ~w",[RelName,AppName]) end. check_rel(RelName, RelApps, Status) -> @@ -960,8 +960,8 @@ check_rel(RelName, RelApps, Status) -> Acc; false -> reltool_utils:throw_error( - "Mandatory application ~p is not included in " - "release ~p", [AppName,RelName]) + "Mandatory application ~w is not included in " + "release ~tp", [AppName,RelName]) end end, Mandatory = [kernel, stdlib], @@ -1015,8 +1015,8 @@ refresh_app(#app{name = AppName, lists:foldl( fun(M,S) -> reltool_utils:add_warning( - "Module ~p duplicated in app file for " - "application ~p.", [M, AppName], S) + "Module ~w duplicated in app file for " + "application ~w.", [M, AppName], S) end, Status3, DuplicatedMods) @@ -1074,18 +1074,18 @@ read_app_info(AppFileOrBin, AppFile, AppName, DefaultVsn, Status) -> parse_app_info(AppFile, Info, AI, Status); {ok, _BadApp} -> {missing_app_info(DefaultVsn), - reltool_utils:add_warning("~p: Illegal contents in app file ~p, " + reltool_utils:add_warning("~w: Illegal contents in app file ~tp, " "application tuple with arity 3 expected.", [AppName,AppFile], Status)}; {error, Text} when Text =:= EnoentText -> {missing_app_info(DefaultVsn), - reltool_utils:add_warning("~p: Missing app file ~p.", + reltool_utils:add_warning("~w: Missing app file ~tp.", [AppName,AppFile], Status)}; {error, Text} -> {missing_app_info(DefaultVsn), - reltool_utils:add_warning("~p: Cannot parse app file ~p (~p).", + reltool_utils:add_warning("~w: Cannot parse app file ~tp (~tp).", [AppName,AppFile,Text], Status)} end. @@ -1122,7 +1122,7 @@ parse_app_info(File, [{Key, Val} | KeyVals], AI, Status) -> Status); _ -> Status2 = - reltool_utils:add_warning("Unexpected item ~p in app file ~p.", + reltool_utils:add_warning("Unexpected item ~p in app file ~tp.", [Key,File], Status), parse_app_info(File, KeyVals, AI, Status2) @@ -1212,7 +1212,7 @@ wait_for_processto_die(Ref, Pid, File) -> {'DOWN', Ref, _Type, _Object, _Info} -> ok after timer:seconds(30) -> - error_logger:error_msg("~p(~p): Waiting for process ~p to die ~p\n", + error_logger:error_msg("~w(~w): Waiting for process ~w to die ~tp\n", [?MODULE, ?LINE, Pid, File]), wait_for_processto_die(Ref, Pid, File) end. @@ -1223,7 +1223,7 @@ add_missing_mods(AppName, EbinMods, AppModNames) -> [missing_mod(ModName, AppName) || ModName <- MissingModNames]. missing_mod(ModName, AppName) -> - %% io:format("Missing: ~p -> ~p\n", [AppName, ModName]), + %% io:format("Missing: ~w -> ~w\n", [AppName, ModName]), #mod{name = ModName, app_name = AppName, incl_cond = undefined, @@ -1323,7 +1323,7 @@ read_config(OldSys, Filename) when is_list(Filename) -> {ok, Content} -> reltool_utils:throw_error("Illegal file content: ~p",[Content]); {error, Reason} -> - reltool_utils:throw_error("Illegal config file ~p: ~s", + reltool_utils:throw_error("Illegal config file ~tp: ~ts", [Filename,file:format_error(Reason)]) end; read_config(OldSys, {sys, KeyVals}) -> @@ -1341,7 +1341,7 @@ read_config(OldSys, {sys, KeyVals}) -> NewSys2; false -> reltool_utils:throw_error( - "Release ~p is mandatory (used as boot_rel)", + "Release ~tp is mandatory (used as boot_rel)", [NewSys2#sys.boot_rel]) end; read_config(_OldSys, BadConfig) -> @@ -1510,7 +1510,7 @@ decode(#app{} = App, [{Key, Val} | KeyVals]) -> active_dir = Dir, sorted_dirs = [Dir]}; false -> - reltool_utils:throw_error("Illegal lib dir for ~p: ~p", + reltool_utils:throw_error("Illegal lib dir for ~w: ~p", [App#app.name, Val]) end; SelectVsn when SelectVsn=:=vsn; SelectVsn=:=lib_dir -> @@ -1642,7 +1642,7 @@ patch_erts_version(RootDir, Apps, Status) -> end; false -> reltool_utils:throw_error( - "erts cannot be found in the root directory ~p", [RootDir]) + "erts cannot be found in the root directory ~tp", [RootDir]) end. libs_to_dirs(RootDir, LibDirs) -> @@ -1669,10 +1669,10 @@ libs_to_dirs(RootDir, LibDirs) -> lists:prefix("erts", F)], app_dirs2(AllLibDirs, [ErtsFiles]); [Duplicate | _] -> - reltool_utils:throw_error("Duplicate library: ~p",[Duplicate]) + reltool_utils:throw_error("Duplicate library: ~tp",[Duplicate]) end; {error, Reason} -> - reltool_utils:throw_error("Missing root library ~p: ~s", + reltool_utils:throw_error("Missing root library ~tp: ~ts", [RootDir,file:format_error(Reason)]) end. @@ -1697,7 +1697,7 @@ app_dirs2([Lib | Libs], Acc) -> Files2 = lists:zf(Filter, Files), app_dirs2(Libs, [Files2 | Acc]); {error, Reason} -> - reltool_utils:throw_error("Illegal library ~p: ~s", + reltool_utils:throw_error("Illegal library ~tp: ~ts", [Lib, file:format_error(Reason)]) end; app_dirs2([], Acc) -> @@ -1756,7 +1756,7 @@ escripts_to_apps([Escript | Escripts], Apps, Status) -> {ok, AF} -> AF; {error, Reason1} -> - reltool_utils:throw_error("Illegal escript ~p: ~p", + reltool_utils:throw_error("Illegal escript ~tp: ~p", [Escript,Reason1]) end, @@ -1838,7 +1838,7 @@ escripts_to_apps([Escript | Escripts], Apps, Status) -> Status2), escripts_to_apps(Escripts, Apps2, Status3); {error, Reason2} -> - reltool_utils:throw_error("Illegal escript ~p: ~p", + reltool_utils:throw_error("Illegal escript ~tp: ~p", [Escript,Reason2]) end; escripts_to_apps([], Apps, Status) -> @@ -1901,7 +1901,7 @@ init_escript_app(AppName, EscriptAppName, Dir, Info, Mods, Apps, Status) -> case lists:keymember(AppName, #app.name, Apps) of true -> reltool_utils:throw_error( - "~p: Application name clash. Escript ~p contains application ~p.", + "~w: Application name clash. Escript ~tp contains application ~tp.", [AppName,Dir,AppName]); false -> {App2, Status} @@ -1986,7 +1986,7 @@ ensure_app_info(#app{is_escript = IsEscript, active_dir = Dir, info = Info}, %% Escript or application which is inlined in an escript {Info, Dir, Status}; ensure_app_info(#app{name = Name, sorted_dirs = []}, _Status) -> - reltool_utils:throw_error("~p: : Missing application directory.",[Name]); + reltool_utils:throw_error("~w: : Missing application directory.",[Name]); ensure_app_info(#app{name = Name, vsn = Vsn, use_selected_vsn = UseSelectedVsn, @@ -2011,8 +2011,8 @@ ensure_app_info(#app{name = Name, Status2; [BadVsn | _] -> reltool_utils:throw_error( - "~p: Application version clash. " - "Multiple directories contains version ~p.", + "~w: Application version clash. " + "Multiple directories contains version ~tp.", [Name,BadVsn]) end, FirstInfo = hd(AllInfo), @@ -2034,8 +2034,8 @@ ensure_app_info(#app{name = Name, {Info, VsnDir, Status3}; false -> reltool_utils:throw_error( - "~p: No application directory contains " - "selected version ~p", [Name,Vsn]) + "~w: No application directory contains " + "selected version ~tp", [Name,Vsn]) end end; true -> diff --git a/lib/reltool/src/reltool_sys_win.erl b/lib/reltool/src/reltool_sys_win.erl index 8e182d02ed..b5d54e6d3e 100644 --- a/lib/reltool/src/reltool_sys_win.erl +++ b/lib/reltool/src/reltool_sys_win.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2012. All Rights Reserved. +%% Copyright Ericsson AB 2009-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -181,7 +181,7 @@ do_init([{safe_config, Safe}, {parent, Parent} | Options]) -> end. restart_server_safe_config(true,Parent,Reason) -> - io:format("~p(~p): <ERROR> ~p\n", [?MODULE, ?LINE, Reason]), + io:format("~w(~w): <ERROR> ~p\n", [?MODULE, ?LINE, Reason]), proc_lib:init_ack(Parent, {error,Reason}); restart_server_safe_config(false,Parent,Reason) -> wx:new(), @@ -198,7 +198,7 @@ restart_server_safe_config(false,Parent,Reason) -> ?wxID_OK -> do_init([{safe_config,true},{parent,Parent},?safe_config]); ?wxID_CANCEL -> - io:format("~p(~p): <ERROR> ~p\n", [?MODULE, ?LINE, Reason]), + io:format("~w(~w): <ERROR> ~p\n", [?MODULE, ?LINE, Reason]), proc_lib:init_ack(Parent,{error,Reason}) end. @@ -211,7 +211,7 @@ exit_dialog(Warnings) -> ?wxID_OK -> ok; ?wxID_CANCEL -> - io:format("~p(~p): <ERROR> ~s\n", [?MODULE, ?LINE, Details]), + io:format("~w(~w): <ERROR> ~ts\n", [?MODULE, ?LINE, Details]), exit(Details) end. @@ -249,7 +249,7 @@ loop(S) -> WWs2 = lists:delete(ObjRef, WWs), ?MODULE:loop(S#state{warning_wins = WWs2}); false -> - error_logger:format("~p~p got unexpected " + error_logger:format("~w~w got unexpected " "message:\n\t~p\n", [?MODULE, self(), Msg]), ?MODULE:loop(S) @@ -291,7 +291,7 @@ loop(S) -> S#state.app_wins), ?MODULE:loop(S#state{fgraph_wins = FWs, app_wins = AWs}); Msg -> - error_logger:format("~p~p got unexpected message:\n\t~p\n", + error_logger:format("~w~w got unexpected message:\n\t~p\n", [?MODULE, self(), Msg]), ?MODULE:loop(S) end. @@ -315,7 +315,7 @@ handle_child_exit({'EXIT', Pid, _Reason} = Exit, FWs, AWs) -> msg_warning({'EXIT', _Pid, shutdown}, Type) when Type =/= unknown -> ok; msg_warning(Exit, Type) -> - error_logger:format("~p~p got unexpected message (~p):\n\t~p\n", + error_logger:format("~w~w got unexpected message (~w):\n\t~p\n", [?MODULE, self(), Type, Exit]). create_window(S) -> @@ -1161,7 +1161,7 @@ handle_system_event(#state{sys = Sys} = S, Sys2 = Sys#sys{incl_cond = AppCond}, do_set_sys(S#state{sys = Sys2}); handle_system_event(S, Event, ObjRef, UserData) -> - error_logger:format("~p~p got unexpected wx sys event to ~p " + error_logger:format("~w~w got unexpected wx sys event to ~p " "with user data: ~p\n\t ~p\n", [?MODULE, self(), ObjRef, UserData, Event]), S. @@ -1177,13 +1177,13 @@ handle_source_event(S, _UserData) -> case wxTreeCtrl:getItemData(ObjRef, Item) of #root_data{dir = _Dir} -> - %% io:format("Root dialog: ~p\n", [Dir]), + %% io:format("Root dialog: ~tp\n", [Dir]), S; #lib_data{dir = _Dir} -> - %% io:format("Lib dialog: ~p\n", [Dir]), + %% io:format("Lib dialog: ~tp\n", [Dir]), S; #escript_data{file = _File} -> - %% io:format("Escript dialog: ~p\n", [File]), + %% io:format("Escript dialog: ~tp\n", [File]), S; #app_data{name = Name} -> do_open_app(S, Name); @@ -1203,7 +1203,7 @@ handle_source_event(S, #escript_data{file = File} -> wx:batch(fun() -> escript_popup(S, File, Tree, Item) end); #app_data{name = Name} -> - io:format("App menu: ~p\n", [Name]), + io:format("App menu: ~tp\n", [Name]), S; undefined -> S @@ -1223,7 +1223,7 @@ handle_app_event(S, Items = reltool_utils:get_items(ListCtrl), handle_app_button(S, Items, Action); handle_app_event(S, Event, ObjRef, UserData) -> - error_logger:format("~p~p got unexpected wx app event to " + error_logger:format("~w~w got unexpected wx app event to " "~p with user data: ~p\n\t ~p\n", [?MODULE, self(), ObjRef, UserData, Event]), S. @@ -1267,7 +1267,7 @@ move_app(S, {_ItemNo, AppBase}, Action) -> blacklist_del -> undefined; _ -> - error_logger:format("~p~p got unexpected app " + error_logger:format("~w~w got unexpected app " "button event: ~p ~p\n", [?MODULE, self(), Action, AppBase]), OldApp#app.incl_cond diff --git a/lib/reltool/src/reltool_target.erl b/lib/reltool/src/reltool_target.erl index 1f4ce7226a..f7a5932b7b 100644 --- a/lib/reltool/src/reltool_target.erl +++ b/lib/reltool/src/reltool_target.erl @@ -296,7 +296,7 @@ do_gen_rel(#rel{name = RelName, vsn = RelVsn, rel_apps = RelApps}, {ErtsName, Erts#app.vsn}, [strip_rel_info(App, RelApps) || App <- MergedApps]}; false -> - reltool_utils:throw_error("Mandatory application ~p is " + reltool_utils:throw_error("Mandatory application ~w is " "not included", [ErtsName]) end. @@ -383,8 +383,8 @@ merge_app(RelName, [] -> App#app{app_type = Type2, info = Info#app_info{incl_apps = InclApps}}; BadIncl -> - reltool_utils:throw_error("~p: These applications are " - "used by release ~s but are " + reltool_utils:throw_error("~w: These applications are " + "used by release ~ts but are " "missing as included_applications " "in the app file: ~p", [Name, RelName, BadIncl]) @@ -865,7 +865,7 @@ strip_sys_files(Relocatable, SysFiles, Apps, ExclRegexps) -> case File of "erts" -> reltool_utils:throw_error("This system is not installed. " - "The directory ~s is missing.", + "The directory ~ts is missing.", [Erts#app.label]); _ when File =:= Erts#app.label -> replace_dyn_erl(Relocatable, Spec); @@ -987,7 +987,7 @@ check_sys(Mandatory, SysFiles) -> do_check_sys(Prefix, Specs) -> case lookup_spec(Prefix, Specs) of [] -> - reltool_utils:throw_error("Mandatory system directory ~s " + reltool_utils:throw_error("Mandatory system directory ~ts " "is not included", [Prefix]); _ -> @@ -1008,8 +1008,8 @@ lookup_spec(Prefix, Specs) -> safe_lookup_spec(Prefix, Specs) -> case lookup_spec(Prefix, Specs) of [] -> - %% io:format("lookup fail ~s:\n\t~p\n", [Prefix, Specs]), - reltool_utils:throw_error("Mandatory system file ~s is " + %% io:format("lookup fail ~ts:\n\t~p\n", [Prefix, Specs]), + reltool_utils:throw_error("Mandatory system file ~ts is " "not included", [Prefix]); Match -> Match @@ -1053,7 +1053,7 @@ spec_lib_files(#sys{root_dir = RootDir, check_apps([Mandatory | Names], Apps) -> case lists:keymember(Mandatory, #app.name, Apps) of false -> - reltool_utils:throw_error("Mandatory application ~p is " + reltool_utils:throw_error("Mandatory application ~w is " "not included in ~p", [Mandatory, Apps]); true -> @@ -1144,13 +1144,13 @@ spec_dir(Dir) -> Base, [spec_dir(filename:join([Dir, F])) || F <- Files]}; error -> - reltool_utils:throw_error("list dir ~s failed", [Dir]) + reltool_utils:throw_error("list dir ~ts failed", [Dir]) end; {ok, #file_info{type = regular}} -> %% Plain file {copy_file, Base}; _ -> - reltool_utils:throw_error("read file info ~s failed", [Dir]) + reltool_utils:throw_error("read file info ~ts failed", [Dir]) end. spec_mod(Mod, DebugInfo) -> @@ -1284,7 +1284,7 @@ do_eval_spec({archive, Archive, Options, Files}, {ok, _} -> ok; {error, Reason} -> - reltool_utils:throw_error("create archive ~s failed: ~p", + reltool_utils:throw_error("create archive ~ts failed: ~p", [ArchiveFile, Reason]) end; do_eval_spec({copy_file, File}, _OrigSourceDir, SourceDir, TargetDir) -> @@ -1473,7 +1473,7 @@ do_install(RelName, TargetDir) -> ok = release_handler:create_RELEASES(TargetDir2, RelFile), ok; _ -> - reltool_utils:throw_error("~s: Illegal data file syntax", [DataFile]) + reltool_utils:throw_error("~ts: Illegal data file syntax",[DataFile]) end. nativename(Dir) -> diff --git a/lib/reltool/src/reltool_utils.erl b/lib/reltool/src/reltool_utils.erl index 6149d6ef06..edccb889b1 100644 --- a/lib/reltool/src/reltool_utils.erl +++ b/lib/reltool/src/reltool_utils.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2012. All Rights Reserved. +%% Copyright Ericsson AB 2009-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -106,7 +106,7 @@ normalize_dir([], Path) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% prim_consult(Bin) when is_binary(Bin) -> - case erl_scan:string(binary_to_list(Bin)) of + case erl_scan:string(unicode:characters_to_list(Bin,encoding(Bin))) of {ok, Tokens, _EndLine} -> prim_parse(Tokens, []); {error, {_ErrorLine, Module, Reason}, _EndLine} -> @@ -120,6 +120,14 @@ prim_consult(FullName) when is_list(FullName) -> {error, file:format_error(enoent)} end. +encoding(Bin) when is_binary(Bin) -> + case epp:read_encoding_from_binary(Bin) of + none -> + epp:default_encoding(); + E -> + E + end. + prim_parse(Tokens, Acc) -> case lists:splitwith(fun(T) -> element(1,T) =/= dot end, Tokens) of {[], []} -> @@ -423,7 +431,7 @@ scroll_size(ObjRef) -> safe_keysearch(Key, Pos, List, Mod, Line) -> case lists:keysearch(Key, Pos, List) of false -> - io:format("~p(~p): lists:keysearch(~p, ~p, ~p) -> false\n", + io:format("~w(~w): lists:keysearch(~p, ~w, ~p) -> false\n", [Mod, Line, Key, Pos, List]), erlang:error({Mod, Line, lists, keysearch, [Key, Pos, List]}); {value, Val} -> @@ -455,7 +463,7 @@ create_dir(Dir) -> ok; {error, Reason} -> Text = file:format_error(Reason), - throw_error("create dir ~s: ~s", [Dir, Text]) + throw_error("create dir ~ts: ~ts", [Dir, Text]) end. list_dir(Dir) -> @@ -464,7 +472,7 @@ list_dir(Dir) -> Files; error -> Text = file:format_error(enoent), - throw_error("list dir ~s: ~s", [Dir, Text]) + throw_error("list dir ~ts: ~ts", [Dir, Text]) end. read_file_info(File) -> @@ -473,7 +481,7 @@ read_file_info(File) -> Info; {error, Reason} -> Text = file:format_error(Reason), - throw_error("read file info ~s: ~s", [File, Text]) + throw_error("read file info ~ts: ~ts", [File, Text]) end. write_file_info(File, Info) -> @@ -482,7 +490,7 @@ write_file_info(File, Info) -> ok; {error, Reason} -> Text = file:format_error(Reason), - throw_error("write file info ~s: ~s", [File, Text]) + throw_error("write file info ~ts: ~ts", [File, Text]) end. read_file(File) -> @@ -491,7 +499,7 @@ read_file(File) -> Bin; {error, Reason} -> Text = file:format_error(Reason), - throw_error("read file ~s: ~s", [File, Text]) + throw_error("read file ~ts: ~ts", [File, Text]) end. write_file(File, IoList) -> @@ -500,7 +508,7 @@ write_file(File, IoList) -> ok; {error, Reason} -> Text = file:format_error(Reason), - throw_error("write file ~s: ~s", [File, Text]) + throw_error("write file ~ts: ~ts", [File, Text]) end. recursive_delete(Dir) -> @@ -516,7 +524,7 @@ recursive_delete(Dir) -> ok; {error, Reason} -> Text = file:format_error(Reason), - throw_error("delete file ~s: ~s\n", [Dir, Text]) + throw_error("delete file ~ts: ~ts\n", [Dir, Text]) end; false -> delete(Dir, regular) @@ -530,7 +538,7 @@ delete(File, Type) -> ok; {error, Reason} -> Text = file:format_error(Reason), - throw_error("delete file ~s: ~s\n", [File, Text]) + throw_error("delete file ~ts: ~ts\n", [File, Text]) end. do_delete(File, regular) -> @@ -569,11 +577,11 @@ copy_file(From, To) -> ok; {error, Reason} -> Text = file:format_error(Reason), - throw_error("copy file ~s -> ~s: ~s\n", [From, To, Text]) + throw_error("copy file ~ts -> ~ts: ~ts\n", [From, To, Text]) end; error -> Text = file:format_error(enoent), - throw_error("copy file ~s -> ~s: ~s\n", [From, To, Text]) + throw_error("copy file ~ts -> ~ts: ~ts\n", [From, To, Text]) end. throw_error(Format, Args) -> @@ -586,13 +594,10 @@ decode_regexps(Key, {add, Regexps}, Old) when is_list(Regexps) -> decode_regexps(_Key, {del, Regexps}, Old) when is_list(Regexps) -> [Re || Re <- Old, not lists:member(Re#regexp.source, Regexps)]; decode_regexps(Key, Regexps, _Old) when is_list(Regexps) -> - do_decode_regexps(Key, Regexps, []); -decode_regexps(Key, Regexps, _Old) when is_list(Regexps) -> - Text = lists:flatten(io_lib:format("~p", [{Key, Regexps}])), - throw({error, "Illegal option: " ++ Text}). + do_decode_regexps(Key, Regexps, []). do_decode_regexps(Key, [Regexp | Regexps], Acc) -> - case catch re:compile(Regexp, []) of + case catch re:compile(Regexp, [unicode]) of {ok, MP} -> do_decode_regexps(Key, Regexps, diff --git a/lib/reltool/test/reltool_server_SUITE.erl b/lib/reltool/test/reltool_server_SUITE.erl index 8d71865508..23338d9ecd 100644 --- a/lib/reltool/test/reltool_server_SUITE.erl +++ b/lib/reltool/test/reltool_server_SUITE.erl @@ -1,7 +1,8 @@ +%% -*- coding: utf-8 -*- %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2012. All Rights Reserved. +%% Copyright Ericsson AB 2009-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -42,6 +43,11 @@ end_per_suite(Config) -> reltool_test_lib:end_per_suite(Config). init_per_testcase(Func,Config) -> + Node = full_node_name(?NODE_NAME), + case net_adm:ping(Node) of + pong -> stop_node(Node); + pang -> ok + end, reltool_test_lib:init_per_testcase(Func,Config). end_per_testcase(Func,Config) -> reltool_test_lib:end_per_testcase(Func,Config). @@ -60,6 +66,7 @@ all() -> create_script, create_script_sort, create_target, + create_target_unicode, create_embedded, create_standalone, create_standalone_beam, @@ -750,6 +757,72 @@ create_target(_Config) -> ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Generate target system + +create_target_unicode(Config) -> + DataDir = ?config(data_dir,Config), + + %% If file name translation mode is unicode, then use unicode + %% characters release name (which will be used as file name for + %% .rel, .script and .boot) + RelNamePrefix = + case file:native_name_encoding() of + utf8 -> + "Unicode test αβ"; + latin1 -> + "Unicode test" + end, + + %% Configure the server + RelName1 = RelNamePrefix, + RelName2 = RelNamePrefix ++ " with SASL", + RelVsn = "1.0", + Sys = + {sys, + [ + {root_dir, code:root_dir()}, + {lib_dirs, [filename:join(DataDir,"unicode")]}, + {app_file, all}, + {incl_cond,exclude}, + {boot_rel, RelName2}, + {rel, RelName1, RelVsn, [stdlib, kernel, ua]}, + {rel, RelName2, RelVsn, [sasl, stdlib, kernel, ua]}, + {app, kernel, [{incl_cond, include}]}, + {app, stdlib, [{incl_cond, include}]}, + {app, sasl, [{incl_cond, include}]}, + {app, ua, [{incl_cond, include}]} + ]}, + + %% Generate target file + TargetDir = filename:join([?WORK_DIR, "target_unicode"]), + ?m(ok, reltool_utils:recursive_delete(TargetDir)), + ?m(ok, file:make_dir(TargetDir)), + ?log("SPEC: ~p\n", [reltool:get_target_spec([{config, Sys}])]), + ok = ?m(ok, reltool:create_target([{config, Sys}], TargetDir)), + + %% Start a node + Erl = filename:join([TargetDir, "bin", "erl"]), + {ok, Node} = ?msym({ok, _}, start_node(?NODE_NAME, Erl)), + + + %% The ua application has a unicode string as description - check + %% that it is translated correctly. + wait_for_app(Node,ua,50), + Apps = rpc:call(Node,application,which_applications,[]), + ?m({ua,"Application for testing unicode in reltool - αβ","1.0"}, + lists:keyfind(ua,1,Apps)), + + %% Check that the release name is correct (really only + %% insteresting if file name translation mode is utf8) + [{RelName,_,_,_}] = + ?msym([{_,_,_,_}],rpc:call(Node,release_handler,which_releases,[])), + ?m(true,lists:prefix(RelNamePrefix,RelName)), + + ?msym(ok, stop_node(Node)), + + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Generate embedded target system create_embedded(_Config) -> @@ -810,11 +883,11 @@ create_standalone(_Config) -> ?msym(ok, stop_node(Node)), %% Execute escript - Expected = iolist_to_binary(["Root dir: ", RootDir, "\n" - "Script args: [\"-arg1\",\"arg2\",\"arg3\"]\n", - "Smp: false\n", - "ExitCode:0"]), - io:format("Expected: ~s\n", [Expected]), + Expected = s2b(["Root dir: ", RootDir, "\n" + "Script args: [\"-arg1\",\"arg2\",\"arg3\"]\n", + "Emuarg: [\"emuvalue\"]\n", + "ExitCode:0"]), + io:format("Expected: ~ts\n", [Expected]), ?m(Expected, run(BinDir, EscriptName, "-arg1 arg2 arg3")), ok. @@ -857,10 +930,11 @@ create_standalone_beam(Config) -> ?msym(ok, stop_node(Node)), %% Execute escript - Expected = iolist_to_binary(["Root dir: ", RootDir, "\n" - "Script args: [\"-arg1\",\"arg2\",\"arg3\"]\n", - "ExitCode:0"]), - io:format("Expected: ~s\n", [Expected]), + Expected = s2b(["Module: mymod\n" + "Root dir: ", RootDir, "\n" + "Script args: [\"-arg1\",\"arg2\",\"arg3\"]\n", + "ExitCode:0"]), + io:format("Expected: ~ts\n", [Expected]), ?m(Expected, run(BinDir, EscriptName, "-arg1 arg2 arg3")), ok. @@ -909,10 +983,11 @@ create_standalone_app(Config) -> ?msym(ok, stop_node(Node)), %% Execute escript - Expected = iolist_to_binary(["Root dir: ", RootDir, "\n" - "Script args: [\"-arg1\",\"arg2\",\"arg3\"]\n", - "ExitCode:0"]), - io:format("Expected: ~s\n", [Expected]), + Expected = s2b(["Module: mymod\n" + "Root dir: ", RootDir, "\n" + "Script args: [\"-arg1\",\"arg2\",\"arg3\"]\n", + "ExitCode:0"]), + io:format("Expected: ~ts\n", [Expected]), ?m(Expected, run(BinDir, EscriptName, "-arg1 arg2 arg3")), ok. @@ -995,19 +1070,20 @@ create_multiple_standalone(Config) -> ?msym(ok, stop_node(Node)), %% Execute escript1 - Expected1 = iolist_to_binary(["Root dir: ", RootDir, "\n" - "Script args: [\"-arg1\",\"arg2\",\"arg3\"]\n", - "Smp: false\n", - "ExitCode:0"]), - io:format("Expected1: ~s\n", [Expected1]), + Expected1 = s2b(["Root dir: ", RootDir, "\n" + "Script args: [\"-arg1\",\"arg2\",\"arg3\"]\n", + "Emuarg: [\"emuvalue\"]\n", + "ExitCode:0"]), + io:format("Expected1: ~ts\n", [Expected1]), ?m(Expected1, run(BinDir, EscriptName1, "-arg1 arg2 arg3")), %% Execute escript2 - Expected2 = iolist_to_binary(["Root dir: ", RootDir, "\n" - "Script args: [\"-arg1\",\"arg2\",\"arg3\"]\n", - "ExitCode:0"]), - io:format("Expected2: ~s\n", [Expected2]), + Expected2 = s2b(["Module: mymod\n" + "Root dir: ", RootDir, "\n" + "Script args: [\"-arg1\",\"arg2\",\"arg3\"]\n", + "ExitCode:0"]), + io:format("Expected2: ~ts\n", [Expected2]), ?m(Expected2, run(BinDir, EscriptName2, "-arg1 arg2 arg3")), ok. @@ -1094,6 +1170,7 @@ create_slim(Config) -> "-sasl", "releases_dir", EscapedQuote++TargetRelDir++EscapedQuote], {ok, Node} = ?msym({ok, _}, start_node(?NODE_NAME, Erl, Args)), ?msym(RootDir, rpc:call(Node, code, root_dir, [])), + wait_for_app(Node,sasl,50), ?msym([{RelName,RelVsn,_,permanent}], rpc:call(Node,release_handler,which_releases,[])), ?msym(ok, stop_node(Node)), @@ -2420,7 +2497,7 @@ start_node(Name, ErlPath) -> start_node(Name, ErlPath, Args0) -> FullName = full_node_name(Name), Args = mk_node_args(Name, Args0), - io:format("Starting node ~p: ~s~n", + io:format("Starting node ~p: ~ts~n", [FullName, lists:flatten([[X," "] || X <- [ErlPath|Args]])]), %io:format("open_port({spawn_executable, ~p}, [{args,~p}])~n",[ErlPath,Args]), case open_port({spawn_executable, ErlPath}, [{args,Args}]) of @@ -2436,9 +2513,19 @@ start_node(Name, ErlPath, Args0) -> end. stop_node(Node) -> - monitor_node(Node, true), - spawn(Node, fun () -> halt() end), - receive {nodedown, Node} -> ok end. + rpc:call(Node,erlang,halt,[]), + wait_for_node_down(Node,50). + +wait_for_node_down(Node,0) -> + test_server:fail({cant_terminate_node,Node}); +wait_for_node_down(Node,N) -> + case net_adm:ping(Node) of + pong -> + timer:sleep(1000), + wait_for_node_down(Node,N-1); + pang -> + ok + end. mk_node_args(Name, Args) -> Pa = filename:dirname(code:which(?MODULE)), @@ -2485,6 +2572,22 @@ wait_for_process(Node, Name, N) when is_integer(N), N > 0 -> ok end. +wait_for_app(_Node, Name, 0) -> + {error, Name}; +wait_for_app(Node, Name, N) when is_integer(N), N > 0 -> + case rpc:call(Node,application,which_applications,[]) of + {badrpc,Reason} -> + test_server:fail({failed_to_get_applications,Reason}); + Apps -> + case lists:member(Name,Apps) of + false -> + timer:sleep(1000), + wait_for_app(Node, Name, N-1); + true -> + ok + end + end. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Run escript @@ -2513,7 +2616,7 @@ do_run(Dir, Cmd) -> Res = get_data(Port, []), receive {Port,{exit_status,ExitCode}} -> - iolist_to_binary([Res,"ExitCode:"++integer_to_list(ExitCode)]) + s2b([Res,"ExitCode:"++integer_to_list(ExitCode)]) end. get_data(Port, SoFar) -> @@ -2537,3 +2640,9 @@ expected_output([], _) -> []; expected_output(Bin, _) when is_binary(Bin) -> Bin. + +%% Convert the given list to a binary with the same encoding as the +%% file name translation mode +s2b(List) -> + Enc = file:native_name_encoding(), + unicode:characters_to_binary(List,Enc,Enc). diff --git a/lib/reltool/test/reltool_server_SUITE_data/escript/someapp-1.0/src/mymod.erl b/lib/reltool/test/reltool_server_SUITE_data/escript/someapp-1.0/src/mymod.erl index b6c71c666d..c315f926d3 100644 --- a/lib/reltool/test/reltool_server_SUITE_data/escript/someapp-1.0/src/mymod.erl +++ b/lib/reltool/test/reltool_server_SUITE_data/escript/someapp-1.0/src/mymod.erl @@ -22,5 +22,6 @@ %%%----------------------------------------------------------------- %%% escript main function main(Args) -> + io:format("Module: ~w\n", [?MODULE]), io:format("Root dir: ~s\n", [code:root_dir()]), io:format("Script args: ~p\n", [Args]). diff --git a/lib/reltool/test/reltool_server_SUITE_data/unicode/ua-1.0/ebin/ua.app b/lib/reltool/test/reltool_server_SUITE_data/unicode/ua-1.0/ebin/ua.app new file mode 100644 index 0000000000..6f571b7179 --- /dev/null +++ b/lib/reltool/test/reltool_server_SUITE_data/unicode/ua-1.0/ebin/ua.app @@ -0,0 +1,7 @@ +% -*- coding: utf-8 -*- +{application, ua, + [{description, "Application for testing unicode in reltool - αβ"}, + {vsn, "1.0"}, + {modules,[]}, + {registered, []}, + {applications, [kernel, stdlib]}]}. diff --git a/lib/sasl/src/release_handler.erl b/lib/sasl/src/release_handler.erl index 1ff3eb96eb..c1b715b970 100644 --- a/lib/sasl/src/release_handler.erl +++ b/lib/sasl/src/release_handler.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -41,7 +41,8 @@ %% Internal exports, a client release_handler may call this functions. -export([do_write_release/3, do_copy_file/2, do_copy_files/2, do_copy_files/1, do_rename_files/1, do_remove_files/1, - remove_file/1, do_write_file/2, do_ensure_RELEASES/1]). + remove_file/1, do_write_file/2, do_write_file/3, + do_ensure_RELEASES/1]). -record(state, {unpurged = [], root, @@ -254,7 +255,7 @@ check_timeout(_Else) -> false. new_emulator_upgrade(Vsn, Opts) -> Result = call({install_release, Vsn, reboot, Opts}), error_logger:info_msg( - "~p:install_release(~p,~p) completed after node restart " + "~w:install_release(~p,~p) completed after node restart " "with new emulator version~nResult: ~p~n",[?MODULE,Vsn,Opts,Result]), Result. @@ -1128,7 +1129,7 @@ new_emulator_make_hybrid_config(CurrentVsn,ToVsn,TmpVsn,RelDir,Masters) -> {ok,[FC]} -> FC; {error,Error1} -> - io:format("Warning: ~p can not read ~p: ~p~n", + io:format("Warning: ~w can not read ~p: ~p~n", [?MODULE,FromFile,Error1]), [] end, @@ -1138,7 +1139,7 @@ new_emulator_make_hybrid_config(CurrentVsn,ToVsn,TmpVsn,RelDir,Masters) -> {ok,[ToConfig]} -> [lists:keyfind(App,1,ToConfig) || App <- [kernel,stdlib,sasl]]; {error,Error2} -> - io:format("Warning: ~p can not read ~p: ~p~n", + io:format("Warning: ~w can not read ~p: ~p~n", [?MODULE,ToFile,Error2]), [false,false,false] end, @@ -1597,7 +1598,9 @@ remove_file(File) -> end. do_write_file(File, Str) -> - case file:open(File, [write]) of + do_write_file(File, Str, []). +do_write_file(File, Str, FileOpts) -> + case file:open(File, [write | FileOpts]) of {ok, Fd} -> io:put_chars(Fd, Str), file:close(Fd), diff --git a/lib/sasl/src/release_handler_1.erl b/lib/sasl/src/release_handler_1.erl index 93d12cf609..b37ae2f944 100644 --- a/lib/sasl/src/release_handler_1.erl +++ b/lib/sasl/src/release_handler_1.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -624,7 +624,7 @@ get_proc_state(Proc) -> maybe_supervisor_which_children(suspended, Name, Pid) -> error_logger:error_msg("release_handler: a which_children call" - " to ~p (~p) was avoided. This supervisor" + " to ~p (~w) was avoided. This supervisor" " is suspended and should likely be upgraded" " differently. Exiting ...~n", [Name, Pid]), error(suspended_supervisor); @@ -635,7 +635,7 @@ maybe_supervisor_which_children(State, Name, Pid) -> Res; Other -> error_logger:error_msg("release_handler: ~p~nerror during" - " a which_children call to ~p (~p)." + " a which_children call to ~p (~w)." " [State: ~p] Exiting ... ~n", [Other, Name, Pid, State]), error(which_children_failed) @@ -647,7 +647,7 @@ maybe_get_dynamic_mods(Name, Pid) -> Res; Other -> error_logger:error_msg("release_handler: ~p~nerror during a" - " get_modules call to ~p (~p)," + " get_modules call to ~p (~w)," " there may be an error in it's" " childspec. Exiting ...~n", [Other, Name, Pid]), diff --git a/lib/sasl/src/systools_lib.erl b/lib/sasl/src/systools_lib.erl index 1b6ea125d9..6618baa2aa 100644 --- a/lib/sasl/src/systools_lib.erl +++ b/lib/sasl/src/systools_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -42,7 +42,11 @@ file_term2binary(FileIn, FileOut) -> %%______________________________________________________________________ %% read_term(File) -> {ok, Term} | Error - +%% +%% This is really an own implementation of file:consult/1, except it +%% returns one term and not a list of terms. Keeping the function +%% instead of using file:consult - for backwards compatibility with +%% error reasons. read_term(File) -> case file:open(File, [read]) of {ok, Stream} -> @@ -54,6 +58,7 @@ read_term(File) -> end. read_term_from_stream(Stream, File) -> + _ = epp:set_encoding(Stream), R = io:request(Stream, {get_until,'',erl_scan,tokens,[1]}), case R of {ok,Toks,_EndLine} -> @@ -176,11 +181,11 @@ add_dirs(RegName, Dirs, Root) -> regexp_match(RegName, D0, Root) -> case file:list_dir(D0) of {ok, Files} when length(Files) > 0 -> - case re:compile(RegName) of + case re:compile(RegName,[unicode]) of {ok, MP} -> FR = fun(F) -> - case re:run(F, MP) of - {match,[{0,N}]} when N == length(F) -> + case re:run(F, MP, [{capture,first,list}]) of + {match,[F]} -> % All of F matches DirF = join(D0, F, Root), case dir_p(DirF) of true -> diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl index 9b2e2c809b..193dbb64bf 100644 --- a/lib/sasl/src/systools_make.erl +++ b/lib/sasl/src/systools_make.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -156,10 +156,10 @@ return(ok,Warnings,Flags) -> _ -> case member(warnings_as_errors,Flags) of true -> - io:format("~s",[format_warning(Warnings, true)]), + io:format("~ts",[format_warning(Warnings, true)]), error; false -> - io:format("~s",[format_warning(Warnings)]), + io:format("~ts",[format_warning(Warnings)]), ok end end; @@ -168,7 +168,7 @@ return({error,Mod,Error},_,Flags) -> true -> {error,Mod,Error}; _ -> - io:format("~s",[Mod:format_error(Error)]), + io:format("~ts",[Mod:format_error(Error)]), error end. @@ -1970,17 +1970,11 @@ is_app_type(_) -> false. % check if a term is a string. -string_p([H|T]) when is_integer(H), H >= $ , H < 255 -> - string_p(T); -string_p([$\n|T]) -> string_p(T); -string_p([$\r|T]) -> string_p(T); -string_p([$\t|T]) -> string_p(T); -string_p([$\v|T]) -> string_p(T); -string_p([$\b|T]) -> string_p(T); -string_p([$\f|T]) -> string_p(T); -string_p([$\e|T]) -> string_p(T); -string_p([]) -> true; -string_p(_) -> false. +string_p(S) -> + case unicode:characters_to_list(S) of + S -> true; + _ -> false + end. % check if a term is a list of two tuples with the first % element as an atom. @@ -2203,31 +2197,31 @@ format_error({illegal_applications,Names}) -> io_lib:format("Illegal applications in the release file: ~p~n", [Names]); format_error({missing_mandatory_app,Name}) -> - io_lib:format("Mandatory application ~p must be specified in the release file~n", + io_lib:format("Mandatory application ~w must be specified in the release file~n", [Name]); format_error({mandatory_app,Name,Type}) -> - io_lib:format("Mandatory application ~p must be of type 'permanent' in the release file. Is '~p'.~n", + io_lib:format("Mandatory application ~w must be of type 'permanent' in the release file. Is '~p'.~n", [Name,Type]); format_error({duplicate_register,Dups}) -> - io_lib:format("Duplicated register names: ~n~s", + io_lib:format("Duplicated register names: ~n~ts", [map(fun({{Reg,App1,_,_},{Reg,App2,_,_}}) -> - io_lib:format("\t~p registered in ~p and ~p~n", + io_lib:format("\t~w registered in ~w and ~w~n", [Reg,App1,App2]) end, Dups)]); format_error({undefined_applications,Apps}) -> io_lib:format("Undefined applications: ~p~n",[Apps]); format_error({duplicate_modules,Dups}) -> - io_lib:format("Duplicated modules: ~n~s", + io_lib:format("Duplicated modules: ~n~ts", [map(fun({{Mod,_,App1,_,_},{Mod,_,App2,_,_}}) -> - io_lib:format("\t~p specified in ~p and ~p~n", + io_lib:format("\t~w specified in ~w and ~w~n", [Mod,App1,App2]) end, Dups)]); format_error({included_and_used, Dups}) -> io_lib:format("Applications both used and included: ~p~n",[Dups]); format_error({duplicate_include, Dups}) -> - io_lib:format("Duplicated application included: ~n~s", + io_lib:format("Duplicated application included: ~n~ts", [map(fun({{Name,App1,_,_},{Name,App2,_,_}}) -> - io_lib:format("\t~p included in ~p and ~p~n", + io_lib:format("\t~w included in ~w and ~w~n", [Name,App1,App2]) end, Dups)]); format_error({modules,ModErrs}) -> @@ -2238,11 +2232,11 @@ format_error({not_found,File}) -> io_lib:format("File not found: ~p~n",[File]); format_error({parse,File,{Line,Mod,What}}) -> Str = Mod:format_error(What), - io_lib:format("~s:~p: ~s\n",[File, Line, Str]); + io_lib:format("~ts:~w: ~ts\n",[File, Line, Str]); format_error({read,File}) -> io_lib:format("Cannot read ~p~n",[File]); format_error({open,File,Error}) -> - io_lib:format("Cannot open ~p - ~s~n", + io_lib:format("Cannot open ~p - ~ts~n", [File,file:format_error(Error)]); format_error({tar_error,What}) -> form_tar_err(What); @@ -2258,24 +2252,21 @@ format_errors(ListOfErrors) -> form_err({bad_application_name,{Name,Found}}) -> io_lib:format("~p: Mismatched application id: ~p~n",[Name,Found]); form_err({error_reading, {Name, What}}) -> - io_lib:format("~p: ~s~n",[Name,form_reading(What)]); + io_lib:format("~p: ~ts~n",[Name,form_reading(What)]); form_err({module_not_found,App,Mod}) -> - io_lib:format("~p: Module (~p) not found~n",[App,Mod]); -form_err({{vsn_diff,File},{Mod,Vsn,App,_,_}}) -> - io_lib:format("~p: Module (~p) version (~p) differs in file ~p~n", - [App,Mod,Vsn,File]); + io_lib:format("~w: Module (~w) not found~n",[App,Mod]); form_err({error_add_appl, {Name, {tar_error, What}}}) -> - io_lib:format("~p: ~s~n",[Name,form_tar_err(What)]); + io_lib:format("~p: ~ts~n",[Name,form_tar_err(What)]); form_err(E) -> io_lib:format("~p~n",[E]). form_reading({not_found,File}) -> io_lib:format("File not found: ~p~n",[File]); form_reading({application_vsn, {Name,Vsn}}) -> - io_lib:format("Application ~s with version ~p not found~n",[Name, Vsn]); + io_lib:format("Application ~ts with version ~p not found~n",[Name, Vsn]); form_reading({parse,File,{Line,Mod,What}}) -> Str = Mod:format_error(What), - io_lib:format("~s:~p: ~s\n",[File, Line, Str]); + io_lib:format("~ts:~w: ~ts\n",[File, Line, Str]); form_reading({read,File}) -> io_lib:format("Cannot read ~p~n",[File]); form_reading({{bad_param, P},_}) -> @@ -2291,15 +2282,15 @@ form_reading({no_valid_version, {{_, SVsn}, {_, File, FVsn}}}) -> io_lib:format("No valid version (~p) of .app file found. Found file ~p with version ~p~n", [SVsn, File, FVsn]); form_reading({parse_error, {File, Line, Error}}) -> - io_lib:format("Parse error in file: ~p. Line: ~p Error: ~p; ~n", [File, Line, Error]); + io_lib:format("Parse error in file: ~p. Line: ~w Error: ~p; ~n", [File, Line, Error]); form_reading(W) -> io_lib:format("~p~n",[W]). form_tar_err({open, File, Error}) -> - io_lib:format("Cannot open tar file ~s - ~p~n", + io_lib:format("Cannot open tar file ~ts - ~ts~n", [File, erl_tar:format_error(Error)]); form_tar_err({add, File, Error}) -> - io_lib:format("Cannot add file ~s to tar file - ~s~n", + io_lib:format("Cannot add file ~ts to tar file - ~ts~n", [File, erl_tar:format_error(Error)]). %% Format warning @@ -2317,23 +2308,23 @@ format_warning(Warnings, Werror) -> map(fun({warning,W}) -> form_warn(Prefix, W) end, Warnings). form_warn(Prefix, {source_not_found,{Mod,_,App,_,_}}) -> - io_lib:format("~s~p: Source code not found: ~p.erl~n", + io_lib:format("~ts~w: Source code not found: ~w.erl~n", [Prefix,App,Mod]); form_warn(Prefix, {{parse_error, File},{_,_,App,_,_}}) -> - io_lib:format("~s~p: Parse error: ~p~n", + io_lib:format("~ts~w: Parse error: ~p~n", [Prefix,App,File]); form_warn(Prefix, {obj_out_of_date,{Mod,_,App,_,_}}) -> - io_lib:format("~s~p: Object code (~p) out of date~n", + io_lib:format("~ts~w: Object code (~w) out of date~n", [Prefix,App,Mod]); form_warn(Prefix, {exref_undef, Undef}) -> F = fun({M,F,A}) -> - io_lib:format("~sUndefined function ~p:~p/~p~n", + io_lib:format("~tsUndefined function ~w:~w/~w~n", [Prefix,M,F,A]) end, map(F, Undef); form_warn(Prefix, missing_sasl) -> - io_lib:format("~s: Missing application sasl. " + io_lib:format("~ts: Missing application sasl. " "Can not upgrade with this release~n", [Prefix]); form_warn(Prefix, What) -> - io_lib:format("~s ~p~n", [Prefix,What]). + io_lib:format("~ts ~p~n", [Prefix,What]). diff --git a/lib/sasl/src/systools_rc.erl b/lib/sasl/src/systools_rc.erl index cf5cca7cb3..54c327410d 100644 --- a/lib/sasl/src/systools_rc.erl +++ b/lib/sasl/src/systools_rc.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -904,7 +904,7 @@ format_error({bad_op_before_point_of_no_return, Instruction}) -> io_lib:format("Bad instruction ~p~nbefore point_of_no_return~n", [Instruction]); format_error({no_object_code, Mod}) -> - io_lib:format("No load_object_code found for module: ~p~n", [Mod]); + io_lib:format("No load_object_code found for module: ~w~n", [Mod]); format_error({suspended_not_resumed, Mods}) -> io_lib:format("Suspended but not resumed: ~p~n", [Mods]); format_error({resumed_not_suspended, Mods}) -> @@ -916,19 +916,19 @@ format_error({start_not_stop, Mods}) -> format_error({stop_not_start, Mods}) -> io_lib:format("Stopped but not started: ~p~n", [Mods]); format_error({no_such_application, App}) -> - io_lib:format("Started undefined application: ~p~n", [App]); + io_lib:format("Started undefined application: ~w~n", [App]); format_error({removed_application_present, App}) -> - io_lib:format("Removed application present: ~p~n", [App]); + io_lib:format("Removed application present: ~w~n", [App]); format_error(dup_mnesia_backup) -> io_lib:format("Duplicate mnesia_backup~n", []); format_error(bad_mnesia_backup) -> io_lib:format("mnesia_backup in bad position~n", []); format_error({conflicting_versions, Lib, V1, V2}) -> - io_lib:format("Conflicting versions for ~p, ~p and ~p~n", [Lib, V1, V2]); + io_lib:format("Conflicting versions for ~w, ~ts and ~ts~n", [Lib, V1, V2]); format_error({no_appl_vsn, Appl}) -> - io_lib:format("No version specified for application: ~p~n", [Appl]); + io_lib:format("No version specified for application: ~w~n", [Appl]); format_error({no_such_module, Mod}) -> - io_lib:format("No such module: ~p~n", [Mod]); + io_lib:format("No such module: ~w~n", [Mod]); format_error(too_many_point_of_no_return) -> io_lib:format("Too many point_of_no_return~n", []); diff --git a/lib/sasl/src/systools_relup.erl b/lib/sasl/src/systools_relup.erl index 7048184426..716dc2b5ff 100644 --- a/lib/sasl/src/systools_relup.erl +++ b/lib/sasl/src/systools_relup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -494,21 +494,18 @@ get_script_from_appup(Mode, TopApp, BaseVsn, Ws, RUs) -> throw({error, ?MODULE, {no_relup, FName, TopApp, BaseVsn}}) end. -appup_search_for_version(BaseVsn, VsnRUs) -> - appup_search_for_version(BaseVsn, length(BaseVsn), VsnRUs). - -appup_search_for_version(BaseVsn,_,[{BaseVsn,RU}|_]) -> +appup_search_for_version(BaseVsn,[{BaseVsn,RU}|_]) -> {ok,RU}; -appup_search_for_version(BaseVsn,Size,[{Vsn,RU}|VsnRUs]) when is_binary(Vsn) -> - case re:run(BaseVsn,Vsn,[unicode,{capture,first,index}]) of - {match,[{0,Size}]} -> +appup_search_for_version(BaseVsn,[{Vsn,RU}|VsnRUs]) when is_binary(Vsn) -> + case re:run(BaseVsn,Vsn,[unicode,{capture,first,list}]) of + {match,[BaseVsn]} -> {ok, RU}; _ -> - appup_search_for_version(BaseVsn,Size,VsnRUs) + appup_search_for_version(BaseVsn,VsnRUs) end; -appup_search_for_version(BaseVsn,Size,[_|VsnRUs]) -> - appup_search_for_version(BaseVsn,Size,VsnRUs); -appup_search_for_version(_,_,[]) -> +appup_search_for_version(BaseVsn,[_|VsnRUs]) -> + appup_search_for_version(BaseVsn,VsnRUs); +appup_search_for_version(_,[]) -> error. @@ -603,14 +600,15 @@ print_error(Other) -> format_error({file_problem, {"relup", _Posix}}) -> io_lib:format("Could not open file relup~n", []); format_error({file_problem, {File, What}}) -> - io_lib:format("Could not ~p file ~p~n", [get_reason(What), File]); + io_lib:format("Could not ~w file ~ts~n", [get_reason(What), File]); format_error({no_relup, File, App, Vsn}) -> - io_lib:format("No release upgrade script entry for ~p-~s to ~p-~s " - "in file ~p~n", + io_lib:format("No release upgrade script entry for ~w-~ts to ~w-~ts " + "in file ~ts~n", [App#application.name, App#application.vsn, App#application.name, Vsn, File]); format_error({missing_sasl,Release}) -> - io_lib:format("No sasl application in release ~p, ~p. Can not be upgraded.", + io_lib:format("No sasl application in release ~ts, ~ts. " + "Can not be upgraded.", [Release#release.name, Release#release.vsn]); format_error(Error) -> io:format("~p~n", [Error]). @@ -629,16 +627,16 @@ print_warning(W, Opts) -> "*WARNING* " end, S = format_warning(Prefix, W), - io:format("~s", [S]). + io:format("~ts", [S]). format_warning(W) -> format_warning("*WARNING* ", W). format_warning(Prefix, {erts_vsn_changed, {Rel1, Rel2}}) -> - io_lib:format("~sThe ERTS version changed between ~p and ~p~n", + io_lib:format("~tsThe ERTS version changed between ~p and ~p~n", [Prefix, Rel1, Rel2]); format_warning(Prefix, What) -> - io_lib:format("~s~p~n",[Prefix, What]). + io_lib:format("~ts~p~n",[Prefix, What]). get_reason({error, {open, _, _}}) -> open; diff --git a/lib/sasl/test/systools_SUITE.erl b/lib/sasl/test/systools_SUITE.erl index 878d582e6b..367cab1d77 100644 --- a/lib/sasl/test/systools_SUITE.erl +++ b/lib/sasl/test/systools_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012. All Rights Reserved. +%% Copyright Ericsson AB 2012-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -40,7 +40,8 @@ -export([all/0,suite/0,groups/0,init_per_group/2,end_per_group/2]). --export([script_options/1, normal_script/1, no_mod_vsn_script/1, +-export([script_options/1, normal_script/1, unicode_script/1, + unicode_script/2, no_mod_vsn_script/1, wildcard_script/1, variable_script/1, no_sasl_script/1, abnormal_script/1, src_tests_script/1, crazy_script/1, included_script/1, included_override_script/1, @@ -75,7 +76,7 @@ all() -> groups() -> [{script, [], - [script_options, normal_script, no_mod_vsn_script, + [script_options, normal_script, unicode_script, no_mod_vsn_script, wildcard_script, variable_script, abnormal_script, no_sasl_script, src_tests_script, crazy_script, included_script, included_override_script, @@ -250,6 +251,62 @@ normal_script(Config) when is_list(Config) -> ok. +%% make_script: Test make_script with unicode .app file +unicode_script(Config) when is_list(Config) -> + UnicodeStr = [945,946], % alhpa beta in greek letters + + {LatestDir, LatestName} = create_script({unicode,UnicodeStr},Config), + + DataDir = filename:absname(?copydir), + UnicodeApp = fname([DataDir, "d_unicode", "lib", "ua-1.0"]), + TarFile = fname(?privdir, "unicode_app.tgz"), + {ok, Tar} = erl_tar:open(TarFile, [write, compressed]), + ok = erl_tar:add(Tar, UnicodeApp, "ua-1.0", [compressed]), + ok = erl_tar:close(Tar), + + UnicodeLibDir = fname([DataDir, "d_unicode", UnicodeStr]), + P1 = fname([UnicodeLibDir, "ua-1.0", "ebin"]), + + %% Need to do this on a separate node to make sure it has unicode + %% filename mode (+fnu*) + {ok,HostStr} = inet:gethostname(), + Host = list_to_atom(HostStr), + {ok,Node} = ct_slave:start(Host,unicode_script_node,[{erl_flags,"+fnui"}]), + + ok = rpc:call(Node,erl_tar,extract, + [TarFile, [{cwd,UnicodeLibDir},compressed]]), + + true = rpc:call(Node,code,add_patha,[P1]), + + ok = rpc:call(Node,file,set_cwd,[LatestDir]), + + ok = rpc:call(Node,systools,make_script,[filename:basename(LatestName), + [local]]), + + {ok, Script} = rpc:call(Node,file,consult,[LatestName++".script"]), + + %% For debug purpose - print script to log + io:format("~tp~n",[Script]), + + %% check that script contains unicode strings in + %% 1. release version (set in ?MODULE:do_create_script) + [{script,{"Test release",UnicodeStr},Instr}] = Script, + + %% 2. application description (set in ua.app in data dir) + [AppInfo] = [X || {apply,{application,load,[{application,ua,X}]}} <- Instr], + {description,UnicodeStr} = lists:keyfind(description,1,AppInfo), + + %% 3. path (directory name where unicode_app.tgz is extracted) + true = lists:member({path,[P1]},Instr), + + ok. + +unicode_script(cleanup,Config) -> + _ = ct_slave:stop(unicode_script_node), + file:delete(fname(?privdir, "unicode_app.tgz")), + ok. + + %% make_script: %% Modules specified without version in .app file (db-3.1). %% Note that this is now the normal way - i.e. systools now ignores @@ -2090,15 +2147,20 @@ create_script(current_all_future_erts,Config) -> do_create_script(current_all_future_erts,Config,"99.99",Apps); create_script(current_all_future_sasl,Config) -> Apps = [{kernel,current},{stdlib,current},{sasl,"9.9"},{db,"2.1"},{fe,"3.1"}], - do_create_script(current_all_future_sasl,Config,current,Apps). + do_create_script(current_all_future_sasl,Config,current,Apps); +create_script({unicode,RelVsn},Config) -> + Apps = core_apps(current) ++ [{ua,"1.0"}], + do_create_script(unicode,RelVsn,Config,current,Apps). do_create_script(Id,Config,ErtsVsn,AppVsns) -> + do_create_script(Id,string:to_upper(atom_to_list(Id)),Config,ErtsVsn,AppVsns). +do_create_script(Id,RelVsn,Config,ErtsVsn,AppVsns) -> PrivDir = ?privdir, Name = fname(PrivDir, Id), {ok,Fd} = file:open(Name++".rel",write), RelfileContent = - {release,{"Test release", string:to_upper(atom_to_list(Id))}, + {release,{"Test release", RelVsn}, {erts,erts_vsn(ErtsVsn)}, app_vsns(AppVsns)}, io:format(Fd,"~p.~n",[RelfileContent]), diff --git a/lib/sasl/test/systools_SUITE_data/d_unicode/lib/ua-1.0/ebin/ua.app b/lib/sasl/test/systools_SUITE_data/d_unicode/lib/ua-1.0/ebin/ua.app new file mode 100644 index 0000000000..3d38a3dde4 --- /dev/null +++ b/lib/sasl/test/systools_SUITE_data/d_unicode/lib/ua-1.0/ebin/ua.app @@ -0,0 +1,9 @@ +%% -*- coding: utf-8 -*- +{application, ua, + [{description, "αβ"}, + {vsn, "1.0"}, + {modules, [ua1]}, + {registered, []}, + {applications, []}, + {env, []}, + {start, {ua1, start, []}}]}. diff --git a/lib/sasl/test/systools_SUITE_data/d_unicode/lib/ua-1.0/src/ua1.erl b/lib/sasl/test/systools_SUITE_data/d_unicode/lib/ua-1.0/src/ua1.erl new file mode 100644 index 0000000000..e988e80f3d --- /dev/null +++ b/lib/sasl/test/systools_SUITE_data/d_unicode/lib/ua-1.0/src/ua1.erl @@ -0,0 +1,2 @@ +-module(ua1). +-vsn("1.0"). diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index f57ee13460..bd0d3d49dd 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -91,7 +91,8 @@ </type> <desc> <p>Connects to an SSH server. No channel is started. This is done - by calling ssh_connect:session_channel/2.</p> + by calling + <seealso marker="ssh_connection#session_channel/2">ssh_connection:session_channel/[2, 4]</seealso>.</p> <p>Options are:</p> <taglist> <tag><c><![CDATA[{user_dir, string()}]]></c></tag> diff --git a/lib/ssh/src/ssh.appup.src b/lib/ssh/src/ssh.appup.src index 5ba3742de7..c4b5aa256b 100644 --- a/lib/ssh/src/ssh.appup.src +++ b/lib/ssh/src/ssh.appup.src @@ -19,6 +19,7 @@ {"%VSN%", [ + {<<"2.1.3">>, [{restart_application, ssh}]}, {<<"2.1.2">>, [{restart_application, ssh}]}, {<<"2.1.1">>, [{restart_application, ssh}]}, {<<"2.1">>, [{restart_application, ssh}]}, @@ -26,6 +27,7 @@ {<<"1\\.*">>, [{restart_application, ssh}]} ], [ + {<<"2.1.3">>, [{restart_application, ssh}]}, {<<"2.1.2">>, [{restart_application, ssh}]}, {<<"2.1.1">>, [{restart_application, ssh}]}, {<<"2.1">>,[{restart_application, ssh}]}, diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 787d82c4db..74a6ac7d19 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -223,11 +223,13 @@ key_exchange(#ssh_msg_kexdh_reply{} = Msg, catch #ssh_msg_disconnect{} = DisconnectMsg -> handle_disconnect(DisconnectMsg, State); + {ErrorToDisplay, #ssh_msg_disconnect{} = DisconnectMsg} -> + handle_disconnect(DisconnectMsg, State, ErrorToDisplay); _:Error -> Desc = log_error(Error), handle_disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = Desc, - language = "en"}, State) + description = Desc, + language = "en"}, State) end; key_exchange(#ssh_msg_kex_dh_gex_group{} = Msg, @@ -673,6 +675,11 @@ terminate({shutdown, #ssh_msg_disconnect{} = Msg}, StateName, #state{ssh_params send_msg(SshPacket, State), ssh_connection_manager:event(Pid, Msg), terminate(normal, StateName, State#state{ssh_params = Ssh}); +terminate({shutdown, {#ssh_msg_disconnect{} = Msg, ErrorMsg}}, StateName, #state{ssh_params = Ssh0, manager = Pid} = State) -> + {SshPacket, Ssh} = ssh_transport:ssh_packet(Msg, Ssh0), + send_msg(SshPacket, State), + ssh_connection_manager:event(Pid, Msg, ErrorMsg), + terminate(normal, StateName, State#state{ssh_params = Ssh}); terminate(Reason, StateName, #state{ssh_params = Ssh0, manager = Pid} = State) -> log_error(Reason), DisconnectMsg = @@ -950,6 +957,8 @@ handle_ssh_packet(Length, StateName, #state{decoded_data_buffer = DecData0, handle_disconnect(#ssh_msg_disconnect{} = Msg, State) -> {stop, {shutdown, Msg}, State}. +handle_disconnect(#ssh_msg_disconnect{} = Msg, State, ErrorMsg) -> + {stop, {shutdown, {Msg, ErrorMsg}}, State}. counterpart_versions(NumVsn, StrVsn, #ssh{role = server} = Ssh) -> Ssh#ssh{c_vsn = NumVsn , c_version = StrVsn}; diff --git a/lib/ssh/src/ssh_connection_manager.erl b/lib/ssh/src/ssh_connection_manager.erl index 94a9ed505f..9536eb9dec 100644 --- a/lib/ssh/src/ssh_connection_manager.erl +++ b/lib/ssh/src/ssh_connection_manager.erl @@ -40,8 +40,7 @@ close/2, stop/1, send/5, send_eof/2]). --export([open_channel/6, reply_request/3, request/6, request/7, global_request/4, event/2, - cast/2]). +-export([open_channel/6, reply_request/3, request/6, request/7, global_request/4, event/2, event/3, cast/2]). %% Internal application API and spawn -export([send_msg/1, ssh_channel_info_handler/3]). @@ -110,10 +109,11 @@ global_request(ConnectionManager, Type, true = Reply, Data) -> global_request(ConnectionManager, Type, false = Reply, Data) -> cast(ConnectionManager, {global_request, self(), Type, Reply, Data}). - + +event(ConnectionManager, BinMsg, ErrorMsg) -> + call(ConnectionManager, {ssh_msg, self(), BinMsg, ErrorMsg}). event(ConnectionManager, BinMsg) -> call(ConnectionManager, {ssh_msg, self(), BinMsg}). - info(ConnectionManager) -> info(ConnectionManager, {info, all}). @@ -262,8 +262,7 @@ handle_call({ssh_msg, Pid, Msg}, From, %% To avoid that not all data sent by the other side is processes before %% possible crash in ssh_connection_handler takes down the connection. - gen_server:reply(From, ok), - + gen_server:reply(From, ok), ConnectionMsg = decode_ssh_msg(Msg), try ssh_connection:handle_msg(ConnectionMsg, Connection0, Pid, Role) of {{replies, Replies}, Connection} -> @@ -294,7 +293,45 @@ handle_call({ssh_msg, Pid, Msg}, From, disconnect_fun(Reason, SSHOpts), {stop, {shutdown, Error}, State#state{connection_state = Connection}} end; +handle_call({ssh_msg, Pid, Msg, ErrorMsg}, From, + #state{connection_state = Connection0, + role = Role, opts = Opts, connected = IsConnected, + client = ClientPid} + = State) -> + %% To avoid that not all data sent by the other side is processes before + %% possible crash in ssh_connection_handler takes down the connection. + gen_server:reply(From, ok), + ConnectionMsg = decode_ssh_msg(Msg), + try ssh_connection:handle_msg(ConnectionMsg, Connection0, Pid, Role) of + {{replies, Replies}, Connection} -> + lists:foreach(fun send_msg/1, Replies), + {noreply, State#state{connection_state = Connection}}; + {noreply, Connection} -> + {noreply, State#state{connection_state = Connection}}; + {disconnect, {_, Reason}, {{replies, Replies}, Connection}} + when Role == client andalso (not IsConnected) -> + lists:foreach(fun send_msg/1, Replies), + ClientPid ! {self(), not_connected, {Reason, ErrorMsg}}, + {stop, {shutdown, normal}, State#state{connection = Connection}}; + {disconnect, Reason, {{replies, Replies}, Connection}} -> + lists:foreach(fun send_msg/1, Replies), + SSHOpts = proplists:get_value(ssh_opts, Opts), + disconnect_fun(Reason, SSHOpts), + {stop, {shutdown, normal}, State#state{connection_state = Connection}} + catch + _:Error -> + {disconnect, Reason, {{replies, Replies}, Connection}} = + ssh_connection:handle_msg( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, + description = "Internal error", + language = "en"}, Connection0, undefined, + Role), + lists:foreach(fun send_msg/1, Replies), + SSHOpts = proplists:get_value(ssh_opts, Opts), + disconnect_fun(Reason, SSHOpts), + {stop, {shutdown, Error}, State#state{connection_state = Connection}} + end; handle_call({global_request, Pid, _, _, _} = Request, From, #state{connection_state = #connection{channel_cache = Cache}} = State0) -> diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 1abb69921d..a47a55b707 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -356,12 +356,12 @@ handle_kexdh_reply(#ssh_msg_kexdh_reply{public_host_key = HostKey, f = F, {ok, SshPacket, Ssh#ssh{shared_secret = K, exchanged_hash = H, session_id = sid(Ssh, H)}}; - _Error -> + Error -> Disconnect = #ssh_msg_disconnect{ code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, description = "Key exchange failed", language = "en"}, - throw(Disconnect) + throw({Error, Disconnect}) end. handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request{min = _Min, diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index 71666a3179..9fc4b0522e 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,5 +1,5 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 2.1.3 +SSH_VSN = 2.1.4 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index ab468c8d6b..6979fb5b5e 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -278,11 +278,18 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | <p> {bad_cert, cert_expired}, {bad_cert, invalid_issuer}, {bad_cert, invalid_signature}, {bad_cert, unknown_ca},{bad_cert, selfsigned_peer}, {bad_cert, name_not_permitted}, {bad_cert, missing_basic_constraint}, {bad_cert, invalid_key_usage}</p> </item> + <tag>{versions, [protocol()]}</tag> + <item>TLS protocol versions that will be supported by started clients and servers. + This option overrides the application environment option <c>protocol_version</c>. If the + environment option is not set it defaults to all versions supported by the SSL application. See also + <seealso marker="ssl:ssl_app">ssl(6)</seealso> + </item> + <tag>{hibernate_after, integer()|undefined}</tag> - <item>When an integer-value is specified, the <code>ssl_connection</code> + <item>When an integer-value is specified, the <c>ssl_connection</c> will go into hibernation after the specified number of milliseconds of inactivity, thus reducing its memory footprint. When - <code>undefined</code> is specified (this is the default), the process + <c>undefined</c> is specified (this is the default), the process will never go into hibernation. </item> </taglist> diff --git a/lib/ssl/doc/src/ssl_app.xml b/lib/ssl/doc/src/ssl_app.xml index 84ad483617..0ee5b23e47 100644 --- a/lib/ssl/doc/src/ssl_app.xml +++ b/lib/ssl/doc/src/ssl_app.xml @@ -41,8 +41,9 @@ <section> <title>ENVIRONMENT</title> <p>The following application environment configuration parameters - are defined for the SSL application. Refer to application(3) for - more information about configuration parameters. + are defined for the SSL application. See <seealso + marker="kernel:application">application(3)</seealso>for more + information about configuration parameters. </p> <p>Note that the environment parameters can be set on the command line, for instance,</p> @@ -87,7 +88,7 @@ <section> <title>SEE ALSO</title> - <p>application(3)</p> + <p><seealso marker="kernel:application">application(3)</seealso></p> </section> </appref> diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index 76e14860ec..a8a494b2fc 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,12 +1,14 @@ %% -*- erlang -*- {"%VSN%", [ + {<<"5.2">>, [{restart_application, ssl}]}, {<<"5.1\\*">>, [{restart_application, ssl}]}, {<<"5.0\\*">>, [{restart_application, ssl}]}, {<<"4\\.*">>, [{restart_application, ssl}]}, {<<"3\\.*">>, [{restart_application, ssl}]} ], [ + {<<"5.2">>, [{restart_application, ssl}]}, {<<"5.1\\*">>, [{restart_application, ssl}]}, {<<"5.0\\*">>, [{restart_application, ssl}]}, {<<"4\\.*">>, [{restart_application, ssl}]}, diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 647daeb1ac..0ba59cede2 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -162,7 +162,7 @@ connect(Host, Port, Options, Timeout) -> %% Description: Creates an ssl listen socket. %%-------------------------------------------------------------------- listen(_Port, []) -> - {error, enooptions}; + {error, nooptions}; listen(Port, Options0) -> try {ok, Config} = handle_options(Options0, server), @@ -380,13 +380,13 @@ getopts(#sslsocket{pid = {ListenSocket, #config{cb = {Transport,_,_,_}}}}, {ok, _} = Result -> Result; {error, InetError} -> - {error, {eoptions, {socket_options, OptionTags, InetError}}} + {error, {options, {socket_options, OptionTags, InetError}}} catch _:_ -> - {error, {eoptions, {socket_options, OptionTags}}} + {error, {options, {socket_options, OptionTags}}} end; getopts(#sslsocket{}, OptionTags) -> - {error, {eoptions, {socket_options, OptionTags}}}. + {error, {options, {socket_options, OptionTags}}}. %%-------------------------------------------------------------------- -spec setopts(#sslsocket{}, [gen_tcp:option()]) -> ok | {error, reason()}. @@ -400,7 +400,7 @@ setopts(#sslsocket{pid = Pid}, Options0) when is_pid(Pid), is_list(Options0) -> ssl_connection:set_opts(Pid, Options) catch _:_ -> - {error, {eoptions, {not_a_proplist, Options0}}} + {error, {options, {not_a_proplist, Options0}}} end; setopts(#sslsocket{pid = {ListenSocket, #config{cb = {Transport,_,_,_}}}}, Options) when is_list(Options) -> @@ -408,13 +408,13 @@ setopts(#sslsocket{pid = {ListenSocket, #config{cb = {Transport,_,_,_}}}}, Optio ok -> ok; {error, InetError} -> - {error, {eoptions, {socket_options, Options, InetError}}} + {error, {options, {socket_options, Options, InetError}}} catch _:Error -> - {error, {eoptions, {socket_options, Options, Error}}} + {error, {options, {socket_options, Options, Error}}} end; setopts(#sslsocket{}, Options) -> - {error, {eoptions,{not_a_proplist, Options}}}. + {error, {options,{not_a_proplist, Options}}}. %%--------------------------------------------------------------- -spec shutdown(#sslsocket{}, read | write | read_write) -> ok | {error, reason()}. @@ -503,24 +503,26 @@ format_error({error, Reason}) -> format_error(Reason) when is_list(Reason) -> Reason; format_error(closed) -> - "The connection is closed"; -format_error({ecacertfile, _}) -> - "Own CA certificate file is invalid."; -format_error({ecertfile, _}) -> - "Own certificate file is invalid."; -format_error({ekeyfile, _}) -> - "Own private key file is invalid."; -format_error({essl, Description}) -> - Description; -format_error({eoptions, Options}) -> - lists:flatten(io_lib:format("Error in options list: ~p~n", [Options])); + "TLS connection is closed"; +format_error({tls_alert, Description}) -> + "TLS Alert: " ++ Description; +format_error({options,{FileType, File, Reason}}) when FileType == cacertfile; + FileType == certfile; + FileType == keyfile; + FileType == dhfile -> + Error = file_error_format(Reason), + file_desc(FileType) ++ File ++ ": " ++ Error; +format_error({options, {socket_options, Option, Error}}) -> + lists:flatten(io_lib:format("Invalid transport socket option ~p: ~s", [Option, format_error(Error)])); +format_error({options, {socket_options, Option}}) -> + lists:flatten(io_lib:format("Invalid socket option: ~p", [Option])); +format_error({options, Options}) -> + lists:flatten(io_lib:format("Invalid TLS option: ~p", [Options])); format_error(Error) -> - case (catch inet:format_error(Error)) of - "unkknown POSIX" ++ _ -> - no_format(Error); - {'EXIT', _} -> - no_format(Error); + case inet:format_error(Error) of + "unknown POSIX" ++ _ -> + unexpected_format(Error); Other -> Other end. @@ -541,8 +543,6 @@ random_bytes(N) -> crypto:rand_bytes(N) end. - - %%%-------------------------------------------------------------- %%% Internal functions %%%-------------------------------------------------------------------- @@ -559,11 +559,11 @@ do_connect(Address, Port, {error, Reason} catch exit:{function_clause, _} -> - {error, {eoptions, {cb_info, CbInfo}}}; + {error, {options, {cb_info, CbInfo}}}; exit:badarg -> - {error, {eoptions, {socket_options, UserOpts}}}; + {error, {options, {socket_options, UserOpts}}}; exit:{badarg, _} -> - {error, {eoptions, {socket_options, UserOpts}}} + {error, {options, {socket_options, UserOpts}}} end. handle_options(Opts0, _Role) -> @@ -607,7 +607,7 @@ handle_options(Opts0, _Role) -> {verify_peer, UserFailIfNoPeerCert, ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun}; Value -> - throw({error, {eoptions, {verify, Value}}}) + throw({error, {options, {verify, Value}}}) end, CertFile = handle_option(certfile, Opts, <<>>), @@ -754,9 +754,9 @@ validate_option(ciphers, Value) when is_list(Value) -> try cipher_suites(Version, Value) catch exit:_ -> - throw({error, {eoptions, {ciphers, Value}}}); + throw({error, {options, {ciphers, Value}}}); error:_-> - throw({error, {eoptions, {ciphers, Value}}}) + throw({error, {options, {ciphers, Value}}}) end; validate_option(reuse_session, Value) when is_function(Value) -> Value; @@ -781,7 +781,7 @@ validate_option(client_preferred_next_protocols = Opt, {Precedence, PreferredPro when is_list(PreferredProtocols) -> case ssl_record:highest_protocol_version([]) of {3,0} -> - throw({error, {eoptions, {not_supported_in_sslv3, {Opt, Value}}}}); + throw({error, {options, {not_supported_in_sslv3, {Opt, Value}}}}); _ -> validate_binary_list(client_preferred_next_protocols, PreferredProtocols), validate_npn_ordering(Precedence), @@ -792,7 +792,7 @@ validate_option(client_preferred_next_protocols = Opt, {Precedence, PreferredPro byte_size(Default) > 0, byte_size(Default) < 256 -> case ssl_record:highest_protocol_version([]) of {3,0} -> - throw({error, {eoptions, {not_supported_in_sslv3, {Opt, Value}}}}); + throw({error, {options, {not_supported_in_sslv3, {Opt, Value}}}}); _ -> validate_binary_list(client_preferred_next_protocols, PreferredProtocols), validate_npn_ordering(Precedence), @@ -804,7 +804,7 @@ validate_option(client_preferred_next_protocols, undefined) -> validate_option(next_protocols_advertised = Opt, Value) when is_list(Value) -> case ssl_record:highest_protocol_version([]) of {3,0} -> - throw({error, {eoptions, {not_supported_in_sslv3, {Opt, Value}}}}); + throw({error, {options, {not_supported_in_sslv3, {Opt, Value}}}}); _ -> validate_binary_list(next_protocols_advertised, Value), Value @@ -813,14 +813,14 @@ validate_option(next_protocols_advertised = Opt, Value) when is_list(Value) -> validate_option(next_protocols_advertised, undefined) -> undefined; validate_option(Opt, Value) -> - throw({error, {eoptions, {Opt, Value}}}). + throw({error, {options, {Opt, Value}}}). validate_npn_ordering(client) -> ok; validate_npn_ordering(server) -> ok; validate_npn_ordering(Value) -> - throw({error, {eoptions, {client_preferred_next_protocols, {invalid_precedence, Value}}}}). + throw({error, {options, {client_preferred_next_protocols, {invalid_precedence, Value}}}}). validate_binary_list(Opt, List) -> lists:foreach( @@ -829,7 +829,7 @@ validate_binary_list(Opt, List) -> byte_size(Bin) < 256 -> ok; (Bin) -> - throw({error, {eoptions, {Opt, {invalid_protocol, Bin}}}}) + throw({error, {options, {Opt, {invalid_protocol, Bin}}}}) end, List). validate_versions([], Versions) -> @@ -840,23 +840,23 @@ validate_versions([Version | Rest], Versions) when Version == 'tlsv1.2'; Version == sslv3 -> validate_versions(Rest, Versions); validate_versions([Ver| _], Versions) -> - throw({error, {eoptions, {Ver, {versions, Versions}}}}). + throw({error, {options, {Ver, {versions, Versions}}}}). validate_inet_option(mode, Value) when Value =/= list, Value =/= binary -> - throw({error, {eoptions, {mode,Value}}}); + throw({error, {options, {mode,Value}}}); validate_inet_option(packet, Value) when not (is_atom(Value) orelse is_integer(Value)) -> - throw({error, {eoptions, {packet,Value}}}); + throw({error, {options, {packet,Value}}}); validate_inet_option(packet_size, Value) when not is_integer(Value) -> - throw({error, {eoptions, {packet_size,Value}}}); + throw({error, {options, {packet_size,Value}}}); validate_inet_option(header, Value) when not is_integer(Value) -> - throw({error, {eoptions, {header,Value}}}); + throw({error, {options, {header,Value}}}); validate_inet_option(active, Value) when Value =/= true, Value =/= false, Value =/= once -> - throw({error, {eoptions, {active,Value}}}); + throw({error, {options, {active,Value}}}); validate_inet_option(_, _) -> ok. @@ -935,8 +935,27 @@ cipher_suites(Version, Ciphers0) -> Ciphers = [ssl_cipher:openssl_suite(C) || C <- string:tokens(Ciphers0, ":")], cipher_suites(Version, Ciphers). -no_format(Error) -> - lists:flatten(io_lib:format("No format string for error: \"~p\" available.", [Error])). +unexpected_format(Error) -> + lists:flatten(io_lib:format("Unexpected error: ~p", [Error])). + +file_error_format({error, Error})-> + case file:format_error(Error) of + "unknown POSIX error" -> + "decoding error"; + Str -> + Str + end; +file_error_format(_) -> + "decoding error". + +file_desc(cacertfile) -> + "Invalid CA certificate file "; +file_desc(certfile) -> + "Invalid certificate file "; +file_desc(keyfile) -> + "Invalid key file "; +file_desc(dhfile) -> + "Invalid DH params file ". detect(_Pred, []) -> undefined; diff --git a/lib/ssl/src/ssl_alert.erl b/lib/ssl/src/ssl_alert.erl index f94a1136a0..94e95d3cd3 100644 --- a/lib/ssl/src/ssl_alert.erl +++ b/lib/ssl/src/ssl_alert.erl @@ -45,7 +45,7 @@ reason_code(#alert{description = ?CLOSE_NOTIFY}, _) -> closed; reason_code(#alert{description = Description}, _) -> - {essl, description_txt(Description)}. + {tls_alert, description_txt(Description)}. %%-------------------------------------------------------------------- -spec alert_txt(#alert{}) -> string(). diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index f51f1c6115..8f4fd88d42 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -987,7 +987,7 @@ handle_info({ErrorTag, Socket, econnaborted}, StateName, #state{socket = Socket, transport_cb = Transport, start_or_recv_from = StartFrom, role = Role, error_tag = ErrorTag} = State) when StateName =/= connection -> - alert_user(Transport, Socket, StartFrom, ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE), Role), + alert_user(Transport, Socket, StartFrom, ?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), Role), {stop, normal, State}; handle_info({ErrorTag, Socket, Reason}, StateName, #state{socket = Socket, @@ -1136,9 +1136,8 @@ init_certificates(#ssl_options{cacerts = CaCerts, end, {ok, _, _, _, _, _} = ssl_manager:connection_init(Certs, Role) catch - Error:Reason -> - handle_file_error(?LINE, Error, Reason, CACertFile, {ecacertfile, Reason}, - erlang:get_stacktrace()) + _:Reason -> + file_error(CACertFile, {cacertfile, Reason}) end, init_certificates(Cert, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheHandle, CertFile, Role). @@ -1158,9 +1157,8 @@ init_certificates(undefined, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHan [OwnCert] = ssl_certificate:file_to_certificats(CertFile, PemCacheHandle), {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheRef, OwnCert} catch - Error:Reason -> - handle_file_error(?LINE, Error, Reason, CertFile, {ecertfile, Reason}, - erlang:get_stacktrace()) + _:Reason -> + file_error(CertFile, {certfile, Reason}) end; init_certificates(Cert, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheRef, _, _) -> {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheRef, Cert}. @@ -1177,9 +1175,8 @@ init_private_key(DbHandle, undefined, KeyFile, Password, _) -> ], private_key(public_key:pem_entry_decode(PemEntry, Password)) catch - Error:Reason -> - handle_file_error(?LINE, Error, Reason, KeyFile, {ekeyfile, Reason}, - erlang:get_stacktrace()) + _:Reason -> + file_error(KeyFile, {keyfile, Reason}) end; %% First two clauses are for backwards compatibility @@ -1205,18 +1202,14 @@ private_key(#'PrivateKeyInfo'{privateKeyAlgorithm = private_key(Key) -> Key. --spec(handle_file_error(_,_,_,_,_,_) -> no_return()). -handle_file_error(Line, Error, {badmatch, Reason}, File, Throw, Stack) -> - file_error(Line, Error, Reason, File, Throw, Stack); -handle_file_error(Line, Error, Reason, File, Throw, Stack) -> - file_error(Line, Error, Reason, File, Throw, Stack). - --spec(file_error(_,_,_,_,_,_) -> no_return()). -file_error(Line, Error, Reason, File, Throw, Stack) -> - Report = io_lib:format("SSL: ~p: ~p:~p ~s~n ~p~n", - [Line, Error, Reason, File, Stack]), - error_logger:error_report(Report), - throw(Throw). +-spec(file_error(_,_) -> no_return()). +file_error(File, Throw) -> + case Throw of + {Opt,{badmatch, {error, {badmatch, Error}}}} -> + throw({options, {Opt, binary_to_list(File), Error}}); + _ -> + throw(Throw) + end. init_diffie_hellman(_,Params, _,_) when is_binary(Params)-> public_key:der_decode('DHParameter', Params); @@ -1234,9 +1227,8 @@ init_diffie_hellman(DbHandle,_, DHParamFile, server) -> ?DEFAULT_DIFFIE_HELLMAN_PARAMS end catch - Error:Reason -> - handle_file_error(?LINE, Error, Reason, - DHParamFile, {edhfile, Reason}, erlang:get_stacktrace()) + _:Reason -> + file_error(DHParamFile, {dhfile, Reason}) end. sync_send_all_state_event(FsmPid, Event) -> @@ -2179,13 +2171,13 @@ get_socket_opts(Transport, Socket, [Tag | Tags], SockOpts, Acc) -> {ok, [Opt]} -> get_socket_opts(Transport, Socket, Tags, SockOpts, [Opt | Acc]); {error, Error} -> - {error, {eoptions, {socket_option, Tag, Error}}} + {error, {options, {socket_options, Tag, Error}}} catch %% So that inet behavior does not crash our process - _:Error -> {error, {eoptions, {socket_option, Tag, Error}}} + _:Error -> {error, {options, {socket_options, Tag, Error}}} end; get_socket_opts(_, _,Opts, _,_) -> - {error, {eoptions, {socket_options, Opts, function_clause}}}. + {error, {options, {socket_options, Opts, function_clause}}}. set_socket_opts(_,_, [], SockOpts, []) -> {ok, SockOpts}; @@ -2195,18 +2187,18 @@ set_socket_opts(Transport, Socket, [], SockOpts, Other) -> ok -> {ok, SockOpts}; {error, InetError} -> - {{error, {eoptions, {socket_option, Other, InetError}}}, SockOpts} + {{error, {options, {socket_options, Other, InetError}}}, SockOpts} catch _:Error -> %% So that inet behavior does not crash our process - {{error, {eoptions, {socket_option, Other, Error}}}, SockOpts} + {{error, {options, {socket_options, Other, Error}}}, SockOpts} end; set_socket_opts(Transport,Socket, [{mode, Mode}| Opts], SockOpts, Other) when Mode == list; Mode == binary -> set_socket_opts(Transport, Socket, Opts, SockOpts#socket_options{mode = Mode}, Other); set_socket_opts(_, _, [{mode, _} = Opt| _], SockOpts, _) -> - {{error, {eoptions, {socket_option, Opt}}}, SockOpts}; + {{error, {options, {socket_options, Opt}}}, SockOpts}; set_socket_opts(Transport,Socket, [{packet, Packet}| Opts], SockOpts, Other) when Packet == raw; Packet == 0; Packet == 1; @@ -2225,19 +2217,19 @@ set_socket_opts(Transport,Socket, [{packet, Packet}| Opts], SockOpts, Other) whe set_socket_opts(Transport, Socket, Opts, SockOpts#socket_options{packet = Packet}, Other); set_socket_opts(_, _, [{packet, _} = Opt| _], SockOpts, _) -> - {{error, {eoptions, {socket_option, Opt}}}, SockOpts}; + {{error, {options, {socket_options, Opt}}}, SockOpts}; set_socket_opts(Transport, Socket, [{header, Header}| Opts], SockOpts, Other) when is_integer(Header) -> set_socket_opts(Transport, Socket, Opts, SockOpts#socket_options{header = Header}, Other); set_socket_opts(_, _, [{header, _} = Opt| _], SockOpts, _) -> - {{error,{eoptions, {socket_option, Opt}}}, SockOpts}; + {{error,{options, {socket_options, Opt}}}, SockOpts}; set_socket_opts(Transport, Socket, [{active, Active}| Opts], SockOpts, Other) when Active == once; Active == true; Active == false -> set_socket_opts(Transport, Socket, Opts, SockOpts#socket_options{active = Active}, Other); set_socket_opts(_, _, [{active, _} = Opt| _], SockOpts, _) -> - {{error, {eoptions, {socket_option, Opt}} }, SockOpts}; + {{error, {options, {socket_options, Opt}} }, SockOpts}; set_socket_opts(Transport, Socket, [Opt | Opts], SockOpts, Other) -> set_socket_opts(Transport, Socket, Opts, SockOpts, [Opt | Other]). diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index db203a47c4..b5c6a1da49 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -99,10 +99,10 @@ options_tests() -> invalid_inet_set_option_not_list, invalid_inet_set_option_improper_list, dh_params, - ecertfile, - ecacertfile, - ekeyfile, - eoptions, + invalid_certfile, + invalid_cacertfile, + invalid_keyfile, + invalid_options, protocol_versions, empty_protocol_versions, ipv6, @@ -822,7 +822,7 @@ invalid_inet_get_option_not_list(Config) when is_list(Config) -> get_invalid_inet_option_not_list(Socket) -> - {error, {eoptions, {socket_options, some_invalid_atom_here}}} + {error, {options, {socket_options, some_invalid_atom_here}}} = ssl:getopts(Socket, some_invalid_atom_here), ok. @@ -854,7 +854,7 @@ invalid_inet_get_option_improper_list(Config) when is_list(Config) -> get_invalid_inet_option_improper_list(Socket) -> - {error, {eoptions, {socket_options, foo,_}}} = ssl:getopts(Socket, [packet | foo]), + {error, {options, {socket_options, foo,_}}} = ssl:getopts(Socket, [packet | foo]), ok. %%-------------------------------------------------------------------- @@ -884,10 +884,10 @@ invalid_inet_set_option(Config) when is_list(Config) -> ssl_test_lib:close(Client). set_invalid_inet_option(Socket) -> - {error, {eoptions, {socket_option, {packet, foo}}}} = ssl:setopts(Socket, [{packet, foo}]), - {error, {eoptions, {socket_option, {header, foo}}}} = ssl:setopts(Socket, [{header, foo}]), - {error, {eoptions, {socket_option, {active, foo}}}} = ssl:setopts(Socket, [{active, foo}]), - {error, {eoptions, {socket_option, {mode, foo}}}} = ssl:setopts(Socket, [{mode, foo}]), + {error, {options, {socket_options, {packet, foo}}}} = ssl:setopts(Socket, [{packet, foo}]), + {error, {options, {socket_options, {header, foo}}}} = ssl:setopts(Socket, [{header, foo}]), + {error, {options, {socket_options, {active, foo}}}} = ssl:setopts(Socket, [{active, foo}]), + {error, {options, {socket_options, {mode, foo}}}} = ssl:setopts(Socket, [{mode, foo}]), ok. %%-------------------------------------------------------------------- invalid_inet_set_option_not_list() -> @@ -917,7 +917,7 @@ invalid_inet_set_option_not_list(Config) when is_list(Config) -> set_invalid_inet_option_not_list(Socket) -> - {error, {eoptions, {not_a_proplist, some_invalid_atom_here}}} + {error, {options, {not_a_proplist, some_invalid_atom_here}}} = ssl:setopts(Socket, some_invalid_atom_here), ok. @@ -948,7 +948,7 @@ invalid_inet_set_option_improper_list(Config) when is_list(Config) -> ssl_test_lib:close(Client). set_invalid_inet_option_improper_list(Socket) -> - {error, {eoptions, {not_a_proplist, [{packet, 0} | {foo, 2}]}}} = + {error, {options, {not_a_proplist, [{packet, 0} | {foo, 2}]}}} = ssl:setopts(Socket, [{packet, 0} | {foo, 2}]), ok. @@ -1286,9 +1286,9 @@ ipv6(Config) when is_list(Config) -> %%-------------------------------------------------------------------- -ekeyfile() -> +invalid_keyfile() -> [{doc,"Test what happens with an invalid key file"}]. -ekeyfile(Config) when is_list(Config) -> +invalid_keyfile(Config) when is_list(Config) -> ClientOpts = ?config(client_opts, Config), BadOpts = ?config(server_bad_key, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -1304,16 +1304,17 @@ ekeyfile(Config) when is_list(Config) -> ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, {options, ClientOpts}]), - - ssl_test_lib:check_result(Server, {error, ekeyfile}, Client, - {error, closed}). + + File = proplists:get_value(keyfile,BadOpts), + ssl_test_lib:check_result(Server, {error,{options, {keyfile, File, {error,enoent}}}}, Client, + {error, closed}). %%-------------------------------------------------------------------- -ecertfile() -> +invalid_certfile() -> [{doc,"Test what happens with an invalid cert file"}]. -ecertfile(Config) when is_list(Config) -> +invalid_certfile(Config) when is_list(Config) -> ClientOpts = ?config(client_opts, Config), ServerBadOpts = ?config(server_bad_cert, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -1330,16 +1331,16 @@ ecertfile(Config) when is_list(Config) -> {port, Port}, {host, Hostname}, {from, self()}, {options, ClientOpts}]), - - ssl_test_lib:check_result(Server, {error, ecertfile}, Client, - {error, closed}). + File = proplists:get_value(certfile, ServerBadOpts), + ssl_test_lib:check_result(Server, {error,{options, {certfile, File, {error,enoent}}}}, + Client, {error, closed}). %%-------------------------------------------------------------------- -ecacertfile() -> +invalid_cacertfile() -> [{doc,"Test what happens with an invalid cacert file"}]. -ecacertfile(Config) when is_list(Config) -> +invalid_cacertfile(Config) when is_list(Config) -> ClientOpts = [{reuseaddr, true}|?config(client_opts, Config)], ServerBadOpts = [{reuseaddr, true}|?config(server_bad_ca, Config)], {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -1357,11 +1358,12 @@ ecacertfile(Config) when is_list(Config) -> {port, Port0}, {host, Hostname}, {from, self()}, {options, ClientOpts}]), + + File0 = proplists:get_value(cacertfile, ServerBadOpts), - ssl_test_lib:check_result(Server0, {error, ecacertfile}, + ssl_test_lib:check_result(Server0, {error, {options, {cacertfile, File0,{error,enoent}}}}, Client0, {error, closed}), - File0 = proplists:get_value(cacertfile, ServerBadOpts), File = File0 ++ "do_not_exit.pem", ServerBadOpts1 = [{cacertfile, File}|proplists:delete(cacertfile, ServerBadOpts)], @@ -1378,31 +1380,32 @@ ecacertfile(Config) when is_list(Config) -> {from, self()}, {options, ClientOpts}]), - ssl_test_lib:check_result(Server1, {error, ecacertfile}, + + ssl_test_lib:check_result(Server1, {error, {options, {cacertfile, File,{error,enoent}}}}, Client1, {error, closed}), ok. %%-------------------------------------------------------------------- -eoptions() -> +invalid_options() -> [{doc,"Test what happens when we give invalid options"}]. -eoptions(Config) when is_list(Config) -> +invalid_options(Config) when is_list(Config) -> ClientOpts = ?config(client_opts, Config), ServerOpts = ?config(server_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Check = fun(Client, Server, {versions, [sslv2, sslv3]} = Option) -> ssl_test_lib:check_result(Server, - {error, {eoptions, {sslv2, Option}}}, + {error, {options, {sslv2, Option}}}, Client, - {error, {eoptions, {sslv2, Option}}}); + {error, {options, {sslv2, Option}}}); (Client, Server, Option) -> ssl_test_lib:check_result(Server, - {error, {eoptions, Option}}, + {error, {options, Option}}, Client, - {error, {eoptions, Option}}) + {error, {options, Option}}) end, TestOpts = [{versions, [sslv2, sslv3]}, @@ -1593,8 +1596,8 @@ default_reject_anonymous(Config) when is_list(Config) -> [{ciphers,[Cipher]} | ClientOpts]}]), - ssl_test_lib:check_result(Server, {error, {essl, "insufficient security"}}, - Client, {error, {essl, "insufficient security"}}). + ssl_test_lib:check_result(Server, {error, {tls_alert, "insufficient security"}}, + Client, {error, {tls_alert, "insufficient security"}}). %%-------------------------------------------------------------------- reuse_session() -> @@ -3147,7 +3150,7 @@ treashold(N, _) -> N + 1. get_invalid_inet_option(Socket) -> - {error, {eoptions, {socket_option, foo, _}}} = ssl:getopts(Socket, [foo]), + {error, {options, {socket_options, foo, _}}} = ssl:getopts(Socket, [foo]), ok. shutdown_result(Socket, server) -> diff --git a/lib/ssl/test/ssl_certificate_verify_SUITE.erl b/lib/ssl/test/ssl_certificate_verify_SUITE.erl index 86e1d47be7..26938bda50 100644 --- a/lib/ssl/test/ssl_certificate_verify_SUITE.erl +++ b/lib/ssl/test/ssl_certificate_verify_SUITE.erl @@ -252,8 +252,8 @@ server_require_peer_cert_fail(Config) when is_list(Config) -> {from, self()}, {options, [{active, false} | BadClientOpts]}]), - ssl_test_lib:check_result(Server, {error, {essl, "handshake failure"}}, - Client, {error, {essl, "handshake failure"}}). + ssl_test_lib:check_result(Server, {error, {tls_alert, "handshake failure"}}, + Client, {error, {tls_alert, "handshake failure"}}). %%-------------------------------------------------------------------- @@ -293,14 +293,14 @@ verify_fun_always_run_client(Config) when is_list(Config) -> [{verify, verify_peer}, {verify_fun, FunAndState} | ClientOpts]}]), - %% Server error may be {essl,"handshake failure"} or closed depending on timing + %% Server error may be {tls_alert,"handshake failure"} or closed depending on timing %% this is not a bug it is a circumstance of how tcp works! receive {Server, ServerError} -> ct:print("Server Error ~p~n", [ServerError]) end, - ssl_test_lib:check_result(Client, {error, {essl, "handshake failure"}}). + ssl_test_lib:check_result(Client, {error, {tls_alert, "handshake failure"}}). %%-------------------------------------------------------------------- verify_fun_always_run_server() -> @@ -342,14 +342,14 @@ verify_fun_always_run_server(Config) when is_list(Config) -> [{verify, verify_peer} | ClientOpts]}]), - %% Client error may be {essl, "handshake failure" } or closed depending on timing + %% Client error may be {tls_alert, "handshake failure" } or closed depending on timing %% this is not a bug it is a circumstance of how tcp works! receive {Client, ClientError} -> ct:print("Client Error ~p~n", [ClientError]) end, - ssl_test_lib:check_result(Server, {error, {essl, "handshake failure"}}). + ssl_test_lib:check_result(Server, {error, {tls_alert, "handshake failure"}}). %%-------------------------------------------------------------------- @@ -432,8 +432,8 @@ cert_expired(Config) when is_list(Config) -> {from, self()}, {options, [{verify, verify_peer} | ClientOpts]}]), - ssl_test_lib:check_result(Server, {error, {essl, "certificate expired"}}, - Client, {error, {essl, "certificate expired"}}). + ssl_test_lib:check_result(Server, {error, {tls_alert, "certificate expired"}}, + Client, {error, {tls_alert, "certificate expired"}}). two_digits_str(N) when N < 10 -> lists:flatten(io_lib:format("0~p", [N])); @@ -710,8 +710,8 @@ invalid_signature_server(Config) when is_list(Config) -> {from, self()}, {options, [{verify, verify_peer} | ClientOpts]}]), - tcp_delivery_workaround(Server, {error, {essl, "bad certificate"}}, - Client, {error, {essl, "bad certificate"}}). + tcp_delivery_workaround(Server, {error, {tls_alert, "bad certificate"}}, + Client, {error, {tls_alert, "bad certificate"}}). %%-------------------------------------------------------------------- @@ -747,8 +747,8 @@ invalid_signature_client(Config) when is_list(Config) -> {from, self()}, {options, NewClientOpts}]), - tcp_delivery_workaround(Server, {error, {essl, "bad certificate"}}, - Client, {error, {essl, "bad certificate"}}). + tcp_delivery_workaround(Server, {error, {tls_alert, "bad certificate"}}, + Client, {error, {tls_alert, "bad certificate"}}). %%-------------------------------------------------------------------- @@ -792,7 +792,7 @@ server_verify_no_cacerts(Config) when is_list(Config) -> {options, [{verify, verify_peer} | ServerOpts]}]), - ssl_test_lib:check_result(Server, {error, {eoptions, {cacertfile, ""}}}). + ssl_test_lib:check_result(Server, {error, {options, {cacertfile, ""}}}). %%-------------------------------------------------------------------- @@ -829,8 +829,8 @@ unknown_server_ca_fail(Config) when is_list(Config) -> {verify_fun, FunAndState} | ClientOpts]}]), - ssl_test_lib:check_result(Server, {error, {essl, "unknown ca"}}, - Client, {error, {essl, "unknown ca"}}). + ssl_test_lib:check_result(Server, {error, {tls_alert, "unknown ca"}}, + Client, {error, {tls_alert, "unknown ca"}}). %%-------------------------------------------------------------------- unknown_server_ca_accept_verify_none() -> diff --git a/lib/ssl/test/ssl_npn_handshake_SUITE.erl b/lib/ssl/test/ssl_npn_handshake_SUITE.erl index 4e848095a5..862690cd7b 100644 --- a/lib/ssl/test/ssl_npn_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_npn_handshake_SUITE.erl @@ -106,15 +106,15 @@ end_per_group(_GroupName, Config) -> %%-------------------------------------------------------------------- validate_empty_protocols_are_not_allowed(Config) when is_list(Config) -> - {error, {eoptions, {next_protocols_advertised, {invalid_protocol, <<>>}}}} + {error, {options, {next_protocols_advertised, {invalid_protocol, <<>>}}}} = (catch ssl:listen(9443, [{next_protocols_advertised, [<<"foo/1">>, <<"">>]}])), - {error, {eoptions, {client_preferred_next_protocols, {invalid_protocol, <<>>}}}} + {error, {options, {client_preferred_next_protocols, {invalid_protocol, <<>>}}}} = (catch ssl:connect({127,0,0,1}, 9443, [{client_preferred_next_protocols, {client, [<<"foo/1">>, <<"">>], <<"foox/1">>}}], infinity)), Option = {client_preferred_next_protocols, {invalid_protocol, <<"">>}}, - {error, {eoptions, Option}} = (catch ssl:connect({127,0,0,1}, 9443, [Option], infinity)). + {error, {options, Option}} = (catch ssl:connect({127,0,0,1}, 9443, [Option], infinity)). %-------------------------------------------------------------------------------- @@ -126,12 +126,12 @@ validate_empty_advertisement_list_is_allowed(Config) when is_list(Config) -> validate_advertisement_must_be_a_binary_list(Config) when is_list(Config) -> Option = {next_protocols_advertised, blah}, - {error, {eoptions, Option}} = (catch ssl:listen(9443, [Option])). + {error, {options, Option}} = (catch ssl:listen(9443, [Option])). %-------------------------------------------------------------------------------- validate_client_protocols_must_be_a_tuple(Config) when is_list(Config) -> Option = {client_preferred_next_protocols, [<<"foo/1">>]}, - {error, {eoptions, Option}} = (catch ssl:connect({127,0,0,1}, 9443, [Option])). + {error, {options, Option}} = (catch ssl:connect({127,0,0,1}, 9443, [Option])). %-------------------------------------------------------------------------------- @@ -220,7 +220,7 @@ npn_not_supported_client(Config) when is_list(Config) -> {from, self()}, {options, ClientOpts}]), ssl_test_lib:check_result(Client, {error, - {eoptions, + {options, {not_supported_in_sslv3, PrefProtocols}}}). %-------------------------------------------------------------------------------- @@ -229,7 +229,7 @@ npn_not_supported_server(Config) when is_list(Config)-> AdvProtocols = {next_protocols_advertised, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}, ServerOpts = [AdvProtocols] ++ ServerOpts0, - {error, {eoptions, {not_supported_in_sslv3, AdvProtocols}}} = ssl:listen(0, ServerOpts). + {error, {options, {not_supported_in_sslv3, AdvProtocols}}} = ssl:listen(0, ServerOpts). %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ diff --git a/lib/ssl/test/ssl_packet_SUITE.erl b/lib/ssl/test/ssl_packet_SUITE.erl index 158c40e372..4116bb39d1 100644 --- a/lib/ssl/test/ssl_packet_SUITE.erl +++ b/lib/ssl/test/ssl_packet_SUITE.erl @@ -55,6 +55,13 @@ all() -> {group, 'sslv3'} ]. +groups() -> + [{'tlsv1.2', [], packet_tests()}, + {'tlsv1.1', [], packet_tests()}, + {'tlsv1', [], packet_tests()}, + {'sslv3', [], packet_tests()} + ]. + packet_tests() -> active_packet_tests() ++ active_once_packet_tests() ++ passive_packet_tests() ++ [packet_send_to_large, @@ -133,7 +140,6 @@ init_per_suite(Config) -> try crypto:start() of ok -> application:start(public_key), - ssl:start(), Result = (catch make_certs:all(?config(data_dir, Config), ?config(priv_dir, Config))), @@ -184,7 +190,7 @@ packet_raw_passive_many_small() -> packet_raw_passive_many_small(Config) when is_list(Config) -> Data = "Packet option is {packet, raw}", - packet(Config, Data, send, passive_recv_packet, ?MANY, raw, false). + packet(Config, Data, send, passive_raw, ?MANY, raw, false). %%-------------------------------------------------------------------- @@ -193,14 +199,14 @@ packet_raw_passive_some_big() -> packet_raw_passive_some_big(Config) when is_list(Config) -> Data = lists:append(lists:duplicate(100, "1234567890")), - packet(Config, Data, send, passive_recv_packet, ?SOME, raw, false). + packet(Config, Data, send, passive_raw, ?SOME, raw, false). %%-------------------------------------------------------------------- packet_0_passive_many_small() -> [{doc,"Test packet option {packet, 0} in passive mode."}]. packet_0_passive_many_small(Config) when is_list(Config) -> Data = "Packet option is {packet, 0}, equivalent to packet raw.", - packet(Config, Data, send, passive_recv_packet, ?MANY, 0, false). + packet(Config, Data, send, passive_raw, ?MANY, 0, false). %%-------------------------------------------------------------------- packet_0_passive_some_big() -> @@ -208,7 +214,7 @@ packet_0_passive_some_big() -> packet_0_passive_some_big(Config) when is_list(Config) -> Data = lists:append(lists:duplicate(100, "1234567890")), - packet(Config, Data, send, passive_recv_packet, ?SOME, 0, false). + packet(Config, Data, send, passive_raw, ?SOME, 0, false). %%-------------------------------------------------------------------- packet_1_passive_many_small() -> @@ -296,7 +302,7 @@ packet_1_active_once_many_small() -> packet_1_active_once_many_small(Config) when is_list(Config) -> Data = "Packet option is {packet, 1}", - packet(Config, Data, send_raw, active_once_raw, ?MANY, 1, once). + packet(Config, Data, send, active_once_packet, ?MANY, 1, once). %%-------------------------------------------------------------------- packet_1_active_once_some_big() -> @@ -304,7 +310,7 @@ packet_1_active_once_some_big() -> packet_1_active_once_some_big(Config) when is_list(Config) -> Data = lists:append(lists:duplicate(255, "1")), - packet(Config, Data, send_raw, active_once_raw, ?SOME, 1, once). + packet(Config, Data, send, active_once_packet, ?SOME, 1, once). %%-------------------------------------------------------------------- @@ -313,7 +319,7 @@ packet_2_active_once_many_small() -> packet_2_active_once_many_small(Config) when is_list(Config) -> Data = "Packet option is {packet, 2}", - packet(Config, Data, send_raw, active_once_raw, ?MANY, 2, once). + packet(Config, Data, send, active_once_packet, ?MANY, 2, once). %%-------------------------------------------------------------------- packet_2_active_once_some_big() -> @@ -321,7 +327,7 @@ packet_2_active_once_some_big() -> packet_2_active_once_some_big(Config) when is_list(Config) -> Data = lists:append(lists:duplicate(100, "1234567890")), - packet(Config, Data, send_raw, active_once_raw, ?SOME, 2, once). + packet(Config, Data, send, active_once_raw, ?SOME, 2, once). %%-------------------------------------------------------------------- packet_4_active_once_many_small() -> @@ -329,7 +335,7 @@ packet_4_active_once_many_small() -> packet_4_active_once_many_small(Config) when is_list(Config) -> Data = "Packet option is {packet, 4}", - packet(Config, Data, send_raw, active_once_raw, ?MANY, 4, once). + packet(Config, Data, send, active_once_packet, ?MANY, 4, once). %%-------------------------------------------------------------------- packet_4_active_once_some_big() -> @@ -337,7 +343,7 @@ packet_4_active_once_some_big() -> packet_4_active_once_some_big(Config) when is_list(Config) -> Data = lists:append(lists:duplicate(100, "1234567890")), - packet(Config, Data, send_raw, active_once_raw, ?SOME, 4, once). + packet(Config, Data, send, active_once_packet, ?SOME, 4, once). %%-------------------------------------------------------------------- packet_raw_active_many_small() -> @@ -345,7 +351,7 @@ packet_raw_active_many_small() -> packet_raw_active_many_small(Config) when is_list(Config) -> Data = "Packet option is {packet, raw}", - packet(Config, Data, send_raw, active_raw, ?MANY, raw, active). + packet(Config, Data, send_raw, active_raw, ?MANY, raw, true). %%-------------------------------------------------------------------- packet_raw_active_some_big() -> @@ -353,7 +359,7 @@ packet_raw_active_some_big() -> packet_raw_active_some_big(Config) when is_list(Config) -> Data = lists:append(lists:duplicate(100, "1234567890")), - packet(Config, Data, send_raw, active_raw, ?SOME, raw, active). + packet(Config, Data, send_raw, active_raw, ?SOME, raw, true). %%-------------------------------------------------------------------- packet_0_active_many_small() -> @@ -361,7 +367,7 @@ packet_0_active_many_small() -> packet_0_active_many_small(Config) when is_list(Config) -> Data = "Packet option is {packet, 0}", - packet(Config, Data, send_raw, active_raw, ?MANY, 0, active). + packet(Config, Data, send_raw, active_raw, ?MANY, 0, true). %%-------------------------------------------------------------------- packet_0_active_some_big() -> @@ -369,7 +375,7 @@ packet_0_active_some_big() -> packet_0_active_some_big(Config) when is_list(Config) -> Data = lists:append(lists:duplicate(100, "1234567890")), - packet(Config, Data, send_raw, active_raw, ?SOME, 0, active). + packet(Config, Data, send, active_raw, ?SOME, 0, true). %%-------------------------------------------------------------------- packet_1_active_many_small() -> @@ -377,7 +383,7 @@ packet_1_active_many_small() -> packet_1_active_many_small(Config) when is_list(Config) -> Data = "Packet option is {packet, 1}", - packet(Config, Data, send_raw, active_raw, ?MANY, 1, active). + packet(Config, Data, send, active_packet, ?MANY, 1, true). %%-------------------------------------------------------------------- packet_1_active_some_big() -> @@ -385,7 +391,7 @@ packet_1_active_some_big() -> packet_1_active_some_big(Config) when is_list(Config) -> Data = lists:append(lists:duplicate(255, "1")), - packet(Config, Data, send_raw, active_raw, ?SOME, 1, active). + packet(Config, Data, send, active_packet, ?SOME, 1, true). %%-------------------------------------------------------------------- packet_2_active_many_small() -> @@ -393,7 +399,7 @@ packet_2_active_many_small() -> packet_2_active_many_small(Config) when is_list(Config) -> Data = "Packet option is {packet, 2}", - packet(Config, Data, send_raw, active_raw, ?MANY, 2, active). + packet(Config, Data, send, active_packet, ?MANY, 2, true). %%-------------------------------------------------------------------- packet_2_active_some_big() -> @@ -401,7 +407,7 @@ packet_2_active_some_big() -> packet_2_active_some_big(Config) when is_list(Config) -> Data = lists:append(lists:duplicate(100, "1234567890")), - packet(Config, Data, send_raw, active_raw, ?SOME, 2, active). + packet(Config, Data, send, active_packet, ?SOME, 2, true). %%-------------------------------------------------------------------- packet_4_active_many_small() -> @@ -409,7 +415,7 @@ packet_4_active_many_small() -> packet_4_active_many_small(Config) when is_list(Config) -> Data = "Packet option is {packet, 4}", - packet(Config, Data, send_raw, active_raw, ?MANY, 4, active). + packet(Config, Data, send, active_packet, ?MANY, 4, true). %%-------------------------------------------------------------------- packet_4_active_some_big() -> @@ -417,7 +423,7 @@ packet_4_active_some_big() -> packet_4_active_some_big(Config) when is_list(Config) -> Data = lists:append(lists:duplicate(100, "1234567890")), - packet(Config, Data, send_raw, active_raw, ?SOME, 4, active). + packet(Config, Data, send, active_packet, ?SOME, 4, true). %%-------------------------------------------------------------------- packet_send_to_large() -> @@ -1879,7 +1885,7 @@ packet(Config, Data, Send, Recv, Quantity, Packet, Active) -> Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, {from, self()}, {mfa, {?MODULE, Send ,[Data, Quantity]}}, - {options, ServerOpts}]), + {options, [{packet, Packet} | ServerOpts]}]), Port = ssl_test_lib:inet_port(Server), Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, {host, Hostname}, diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 8d96a70a6e..76b302b1cb 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -203,67 +203,6 @@ close(Pid) -> ct:print("Pid: ~p down due to:~p ~n", [Pid, Reason]) end. - -check_result(Server, {error, SReason} = ServerMsg, Client, {error, closed} = ClientMsg) -> - receive - {Server, {error, {SReason, _}}} -> - receive - {Client, ClientMsg} -> - ok; - Unexpected -> - Reason = {{expected, {Client, ClientMsg}}, - {got, Unexpected}}, - ct:fail(Reason) - end; - {Client, ClientMsg} -> - receive - {Server, {error, {SReason, _}}} -> - ok; - Unexpected -> - Reason = {{expected, {Server,{error, {SReason, 'term()'}}}, - {got, Unexpected}}}, - ct:fail(Reason) - end; - {Port, {data,Debug}} when is_port(Port) -> - io:format("openssl ~s~n",[Debug]), - check_result(Server, ServerMsg, Client, ClientMsg); - - Unexpected -> - Reason = {{expected, {Client, ClientMsg}}, - {expected, {Server, {error, {SReason, 'term()'}}}, {got, Unexpected}}}, - ct:fail(Reason) - end; - -check_result(Server, {error, closed} = ServerMsg, Client, {error, CReson} = ClientMsg) -> - receive - {Server, ServerMsg} -> - receive - {Client, {error, {CReson, _}}} -> - ok; - Unexpected -> - Reason = {{expected, {Client, {error, {CReson, 'term()'}}}, - {got, Unexpected}}}, - ct:fail(Reason) - end; - {Client, {error, {CReson, _}}} -> - receive - {Server, ServerMsg} -> - ok; - Unexpected -> - Reason = {{expected, {Server, ServerMsg}}, - {got, Unexpected}}, - ct:fail(Reason) - end; - {Port, {data,Debug}} when is_port(Port) -> - io:format("openssl ~s~n",[Debug]), - check_result(Server, ServerMsg, Client, ClientMsg); - - Unexpected -> - Reason = {{expected, {Client, {error, {CReson, 'term()'}}}, - {expected, {Server, ServerMsg}}, {got, Unexpected}}}, - ct:fail(Reason) - end; - check_result(Server, ServerMsg, Client, ClientMsg) -> receive {Server, ServerMsg} -> @@ -294,22 +233,6 @@ check_result(Server, ServerMsg, Client, ClientMsg) -> ct:fail(Reason) end. -check_result(Pid, {error, Reason} = Err) when Reason == ecertfile; - Reason == ecacertfile; - Reason == ekeyfile; - Reason == edhfile -> - receive - {Pid, {error, {Reason, Str}}} when is_list(Str) -> - ok; - {Port, {data,Debug}} when is_port(Port) -> - io:format("openssl ~s~n",[Debug]), - check_result(Pid, Err); - Unexpected -> - Reason = {{expected, {Pid, {error, {Reason, "'appropriate error string'"}}}}, - {got, Unexpected}}, - ct:fail(Reason) - end; - check_result(Pid, Msg) -> receive {Pid, Msg} -> diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index 7c0c00bf36..4f53132d5d 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -902,7 +902,7 @@ ssl2_erlang_server_openssl_client(Config) when is_list(Config) -> ok end, - ssl_test_lib:check_result(Server, {error, {essl, "protocol version"}}), + ssl_test_lib:check_result(Server, {error, {tls_alert, "protocol version"}}), process_flag(trap_exit, false). %%-------------------------------------------------------------------- diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index cb73e86ede..1f3bef83c8 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 5.2 +SSL_VSN = 5.2.1 diff --git a/lib/stdlib/doc/src/filelib.xml b/lib/stdlib/doc/src/filelib.xml index ac67596f3c..bd780b2b2f 100644 --- a/lib/stdlib/doc/src/filelib.xml +++ b/lib/stdlib/doc/src/filelib.xml @@ -36,8 +36,9 @@ <description> <p>This module contains utilities on a higher level than the <c>file</c> module.</p> - <p>The module supports Unicode file names, so that it will match against regular expressions given in Unicode and that it will find and process raw file names (i.e. files named in a way that does not confirm to the expected encoding).</p> - <p>If the VM operates in Unicode file naming mode on a machine with transparent file naming, the <c>fun()</c> provided to <c>fold_files/5</c> needs to be prepared to handle binary file names.</p> + <p>This module does not support "raw" file names (i.e. files whose names + do not comply with the expected encoding). Such files will be ignored + by the functions in this module.</p> <p>For more information about raw file names, see the <seealso marker="kernel:file">file</seealso> module.</p> </description> diff --git a/lib/stdlib/doc/src/io.xml b/lib/stdlib/doc/src/io.xml index fa475804eb..90f24c4cbc 100644 --- a/lib/stdlib/doc/src/io.xml +++ b/lib/stdlib/doc/src/io.xml @@ -211,6 +211,18 @@ </desc> </func> <func> + <name name="printable_range" arity="0"/> + <fsummary>Get user requested printable character range</fsummary> + <desc> + <p>Return the user requested range of printable Unicode characters.</p> + <p>The user can request a range of characters that are to be considered printable in heuristic detection of strings by the shell and by the formatting functions. This is done by supplying <c>+pc <range></c> when starting Erlang.</p> + <p>Currently the only valid values for <c><range></c> are <c>latin1</c> and <c>unicode</c>. <c>latin1</c> means that only code points below 256 (with the exception of control characters etc) will be considered printable. <c>unicode</c> means that all printable characters in all unicode character ranges are considered printable by the io functions.</p> + <p>By default, Erlang is started so that only the <c>latin1</c> range of characters will indicate that a list of integers is a string.</p> + <p>The simplest way to utilize the setting is to call <seealso marker="io_lib#printable_list/1">io_lib:printable_list/1</seealso>, which will use the return value of this function to decide if a list is a string of printable characters or not.</p> + <note><p>In the future, this function may return more values and ranges. It is recommended to use the io_lib:printable_list/1 function to avoid compatibility problems.</p></note> + </desc> + </func> + <func> <name name="setopts" arity="1"/> <name name="setopts" arity="2"/> <fsummary>Set options</fsummary> @@ -390,10 +402,11 @@ ok</pre> applicable, it is used for both the field width and precision. The default padding character is <c>' '</c> (space).</p> <p><c>Mod</c> is the control sequence modifier. It is either a - single character (currently only <c>t</c>, for Unicode translation, - is supported) that changes the interpretation of Data.</p> - - <p>The following control sequences are available:</p> + single character (currently only <c>t</c>, for Unicode + translation, and <c>l</c>, for stopping <c>p</c> and + <c>P</c> from detecting printable characters, are supported) + that changes the interpretation of Data.</p> + <p>The following control sequences are available:</p> <taglist> <tag><c>~</c></tag> <item> @@ -407,7 +420,7 @@ ok</pre> which in turn defaults to 1. The following example illustrates:</p> <pre> -2> <input>io:fwrite("|~10.5c|~-10.5c|~5c|~n", [$a, $b, $c]).</input> +1> <input>io:fwrite("|~10.5c|~-10.5c|~5c|~n", [$a, $b, $c]).</input> | aaaaa|bbbbb |ccccc| ok</pre> <p>If the Unicode translation modifier (<c>t</c>) is in effect, @@ -415,10 +428,10 @@ ok</pre> valid Unicode codepoint, otherwise it should be an integer less than or equal to 255, otherwise it is masked with 16#FF:</p> <pre> -1> <input>io:fwrite("~tc~n",[1024]).</input> +2> <input>io:fwrite("~tc~n",[1024]).</input> \x{400} ok -2> <input>io:fwrite("~c~n",[1024]).</input> +3> <input>io:fwrite("~c~n",[1024]).</input> ^@ ok</pre> @@ -462,20 +475,20 @@ ok</pre> <p>This format can be used for printing any object and truncating the output so it fits a specified field:</p> <pre> -3> <input>io:fwrite("|~10w|~n", [{hey, hey, hey}]).</input> +1> <input>io:fwrite("|~10w|~n", [{hey, hey, hey}]).</input> |**********| ok -4> <input>io:fwrite("|~10s|~n", [io_lib:write({hey, hey, hey})]).</input> +2> <input>io:fwrite("|~10s|~n", [io_lib:write({hey, hey, hey})]).</input> |{hey,hey,h| -5> <input>io:fwrite("|~-10.8s|~n", [io_lib:write({hey, hey, hey})]).</input> +3> <input>io:fwrite("|~-10.8s|~n", [io_lib:write({hey, hey, hey})]).</input> |{hey,hey | ok</pre> <p>A list with integers larger than 255 is considered an error if the Unicode translation modifier is not given:</p> <pre> -1> <input>io:fwrite("~ts~n",[[1024]]).</input> +4> <input>io:fwrite("~ts~n",[[1024]]).</input> \x{400} ok -2> io:fwrite("~s~n",[[1024]]). +5> <input>io:fwrite("~s~n",[[1024]]).</input> ** exception exit: {badarg,[{io,format,[<0.26.0>,"~s~n",[[1024]]]}, ...</pre> </item> @@ -493,20 +506,21 @@ ok <c>~w</c>, but breaks terms whose printed representation is longer than one line into many lines and indents each line sensibly. It also tries to detect lists of - printable characters and to output these as strings. - For example:</p> + printable characters and to output these as strings. The + Unicode translation modifier is used for determining + what characters are printable. For example:</p> <pre> -5> <input>T = [{attributes,[[{id,age,1.50000},{mode,explicit},</input> +1> <input>T = [{attributes,[[{id,age,1.50000},{mode,explicit},</input> <input>{typename,"INTEGER"}], [{id,cho},{mode,explicit},{typename,'Cho'}]]},</input> <input>{typename,'Person'},{tag,{'PRIVATE',3}},{mode,implicit}].</input> ... -6> <input>io:fwrite("~w~n", [T]).</input> +2> <input>io:fwrite("~w~n", [T]).</input> [{attributes,[[{id,age,1.5},{mode,explicit},{typename, [73,78,84,69,71,69,82]}],[{id,cho},{mode,explicit},{typena me,'Cho'}]]},{typename,'Person'},{tag,{'PRIVATE',3}},{mode ,implicit}] ok -7> <input>io:fwrite("~62p~n", [T]).</input> +3> <input>io:fwrite("~62p~n", [T]).</input> [{attributes,[[{id,age,1.5}, {mode,explicit}, {typename,"INTEGER"}], @@ -522,7 +536,7 @@ ok</pre> <c>io:fwrite</c> or <c>io:format</c>. For example, using <c>T</c> above:</p> <pre> -8> <input>io:fwrite("Here T = ~62p~n", [T]).</input> +4> <input>io:fwrite("Here T = ~62p~n", [T]).</input> Here T = [{attributes,[[{id,age,1.5}, {mode,explicit}, {typename,"INTEGER"}], @@ -533,6 +547,31 @@ Here T = [{attributes,[[{id,age,1.5}, {tag,{'PRIVATE',3}}, {mode,implicit}] ok</pre> + <p>When the modifier <c>l</c> is given no detection of + printable character lists will take place. For example:</p> + <pre> +5> <input>S = [{a,"a"}, {b, "b"}].</input> +6> <input>io:fwrite("~15p~n", [S]).</input> +[{a,"a"}, + {b,"b"}] +ok +7> <input>io:fwrite("~15lp~n", [S]).</input> +[{a,[97]}, + {b,[98]}] +ok</pre> + <p>Binaries that look like UTF-8 encoded strings will be + output with the string syntax if the Unicode translation + modifier is given:</p> + <pre> +9> <input>io:fwrite("~p~n",[[1024]]).</input> +[1024] +10> <input>io:fwrite("~tp~n",[[1024]]).</input> +"\x{400}" +11> <input>io:fwrite("~tp~n", [<<128,128>>]).</input> +<<128,128>> +12> <input>io:fwrite("~tp~n", [<<208,128>>]).</input> +<<"\x{400}"/utf8>> +ok</pre> </item> <tag><c>W</c></tag> <item> @@ -541,7 +580,7 @@ ok</pre> are printed. Anything below this depth is replaced with <c>...</c>. For example, using <c>T</c> above:</p> <pre> -9> <input>io:fwrite("~W~n", [T,9]).</input> +8> <input>io:fwrite("~W~n", [T,9]).</input> [{attributes,[[{id,age,1.5},{mode,explicit},{typename,...}], [{id,cho},{mode,...},{...}]]},{typename,'Person'}, {tag,{'PRIVATE',3}},{mode,implicit}] @@ -558,7 +597,7 @@ ok</pre> are printed. Anything below this depth is replaced with <c>...</c>. For example:</p> <pre> -10> <input>io:fwrite("~62P~n", [T,9]).</input> +9> <input>io:fwrite("~62P~n", [T,9]).</input> [{attributes,[[{id,age,1.5},{mode,explicit},{typename,...}], [{id,cho},{mode,...},{...}]]}, {typename,'Person'}, @@ -572,13 +611,13 @@ ok</pre> 10. A leading dash is printed for negative integers.</p> <p>The precision field selects base. For example:</p> <pre> -11> <input>io:fwrite("~.16B~n", [31]).</input> +1> <input>io:fwrite("~.16B~n", [31]).</input> 1F ok -12> <input>io:fwrite("~.2B~n", [-19]).</input> +2> <input>io:fwrite("~.2B~n", [-19]).</input> -10011 ok -13> <input>io:fwrite("~.36B~n", [5*36+35]).</input> +3> <input>io:fwrite("~.36B~n", [5*36+35]).</input> 5Z ok</pre> </item> @@ -590,10 +629,10 @@ ok</pre> <p>The prefix can be a possibly deep list of characters or an atom.</p> <pre> -14> <input>io:fwrite("~X~n", [31,"10#"]).</input> +1> <input>io:fwrite("~X~n", [31,"10#"]).</input> 10#31 ok -15> <input>io:fwrite("~.16X~n", [-31,"0x"]).</input> +2> <input>io:fwrite("~.16X~n", [-31,"0x"]).</input> -0x1F ok</pre> </item> @@ -602,10 +641,10 @@ ok</pre> <p>Like <c>B</c>, but prints the number with an Erlang style <c>#</c>-separated base prefix.</p> <pre> -16> <input>io:fwrite("~.10#~n", [31]).</input> +1> <input>io:fwrite("~.10#~n", [31]).</input> 10#31 ok -17> <input>io:fwrite("~.16#~n", [-31]).</input> +2> <input>io:fwrite("~.16#~n", [-31]).</input> -16#1F ok</pre> </item> @@ -639,10 +678,10 @@ ok</pre> </taglist> <p>If an error occurs, there is no output. For example:</p> <pre> -18> <input>io:fwrite("~s ~w ~i ~w ~c ~n",['abc def', 'abc def', {foo, 1},{foo, 1}, 65]).</input> +1> <input>io:fwrite("~s ~w ~i ~w ~c ~n",['abc def', 'abc def', {foo, 1},{foo, 1}, 65]).</input> abc def 'abc def' {foo,1} A ok -19> <input>io:fwrite("~s", [65]).</input> +2> <input>io:fwrite("~s", [65]).</input> ** exception exit: {badarg,[{io,format,[<0.22.0>,"~s","A"]}, {erl_eval,do_apply,5}, {shell,exprs,6}, diff --git a/lib/stdlib/doc/src/io_lib.xml b/lib/stdlib/doc/src/io_lib.xml index 001d34a7c2..3dac259477 100644 --- a/lib/stdlib/doc/src/io_lib.xml +++ b/lib/stdlib/doc/src/io_lib.xml @@ -301,7 +301,11 @@ <fsummary>Test for a list of printable characters</fsummary> <desc> <p>Returns <c>true</c> if <c><anno>Term</anno></c> is a flat list of - printable Unicode characters, otherwise it returns <c>false</c>.</p> + printable characters, otherwise it returns <c>false</c>.</p> + <p>What is a printable character in this case is determined by the + <c>+pc</c> start up flag to the Erlang VM. See + <seealso marker="io#printable_range/0">io:printable_range/0</seealso> + and <seealso marker="erts:erl#erl">erl(1)</seealso>.</p> </desc> </func> <func> @@ -312,6 +316,14 @@ printable ISO-latin-1 characters, otherwise it returns <c>false</c>.</p> </desc> </func> + <func> + <name name="printable_unicode_list" arity="1"/> + <fsummary>Test for a list of printable Unicode characters</fsummary> + <desc> + <p>Returns <c>true</c> if <c><anno>Term</anno></c> is a flat list of + printable Unicode characters, otherwise it returns <c>false</c>.</p> + </desc> + </func> </funcs> </erlref> diff --git a/lib/stdlib/doc/src/shell.xml b/lib/stdlib/doc/src/shell.xml index bc2120c37d..7f251c863e 100644 --- a/lib/stdlib/doc/src/shell.xml +++ b/lib/stdlib/doc/src/shell.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2011</year> + <year>1996</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -781,7 +781,7 @@ loop(N) -> </desc> </func> <func> - <name>catch_exception(Bool) -> Bool</name> + <name>catch_exception(Bool) -> boolean()</name> <fsummary>Sets the exception handling of the shell</fsummary> <type> <v>Bool = boolean()</v> @@ -801,8 +801,8 @@ loop(N) -> <name name="prompt_func" arity="1"/> <fsummary>Sets the shell prompt</fsummary> <desc> - <p>Sets the shell prompt function to <c>PromptFunc</c>. The - previous prompt function is returned.</p> + <p>Sets the shell prompt function to <c><anno>PromptFunc</anno></c>. + The previous prompt function is returned.</p> </desc> </func> <func> @@ -827,6 +827,20 @@ loop(N) -> is meant to be called from the shell.</p> </desc> </func> + <func> + <name name="strings" arity="1"/> + <fsummary>Sets the shell's string recognition flag.</fsummary> + <desc> + <p>Sets pretty printing of lists to <c><anno>Strings</anno></c>. + The previous value of the flag is returned.</p> + <p>The flag can also be set by the STDLIB application variable + <c>shell_strings</c>. The default is + <c>true</c> which means that lists of integers will be + printed using the string syntax, when possible. The value + <c>false</c> means that no lists will be printed using the + string syntax.</p> + </desc> + </func> </funcs> </erlref> diff --git a/lib/stdlib/doc/src/stdlib_app.xml b/lib/stdlib/doc/src/stdlib_app.xml index a615c1bf88..2391bb6f03 100644 --- a/lib/stdlib/doc/src/stdlib_app.xml +++ b/lib/stdlib/doc/src/stdlib_app.xml @@ -4,7 +4,7 @@ <appref> <header> <copyright> - <year>2005</year><year>2010</year> + <year>2005</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -51,7 +51,7 @@ <p>This parameter can be used to run the Erlang shell in restricted mode.</p> </item> - <tag><c>shell_catch_exception = bool()</c></tag> + <tag><c>shell_catch_exception = boolean()</c></tag> <item> <p>This parameter can be used to set the exception handling of the Erlang shell's evaluator process.</p> @@ -76,6 +76,11 @@ <p>This parameter can be used to determine how many results are saved by the Erlang shell.</p> </item> + <tag><c>shell_strings = boolean()</c></tag> + <item> + <p>This parameter can be used to determine how the Erlang + shell outputs lists of integers.</p> + </item> </taglist> </section> diff --git a/lib/stdlib/src/binary.erl b/lib/stdlib/src/binary.erl index 41b6ab1d5f..1fb241fd1d 100644 --- a/lib/stdlib/src/binary.erl +++ b/lib/stdlib/src/binary.erl @@ -58,7 +58,7 @@ bin_to_list(_, _) -> -spec bin_to_list(Subject, Pos, Len) -> [byte()] when Subject :: binary(), Pos :: non_neg_integer(), - Len :: non_neg_integer(). + Len :: integer(). bin_to_list(_, _, _) -> erlang:nif_error(undef). @@ -186,7 +186,7 @@ part(_, _) -> -spec part(Subject, Pos, Len) -> binary() when Subject :: binary(), Pos :: non_neg_integer(), - Len :: non_neg_integer(). + Len :: integer(). part(_, _, _) -> erlang:nif_error(undef). diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl index e31ae6b9ef..91d317489c 100644 --- a/lib/stdlib/src/c.erl +++ b/lib/stdlib/src/c.erl @@ -512,7 +512,7 @@ m(M) -> print_object_file(Mod) -> case code:is_loaded(Mod) of {file,File} -> - format("Object file: ~s\n", [File]); + format("Object file: ~ts\n", [File]); _ -> ignore end. diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index 1bb3b95ae2..0a1caa7178 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -614,7 +614,7 @@ enter_file_reply(From, Name, Location, AtLocation) -> %% Flatten filename to a string. Must be a valid filename. -file_name([C | T]) when is_integer(C), C > 0, C =< 255 -> +file_name([C | T]) when is_integer(C), C > 0 -> [C | file_name(T)]; file_name([H|T]) -> file_name(H) ++ file_name(T); diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl index 254384e877..378e629ac9 100644 --- a/lib/stdlib/src/erl_internal.erl +++ b/lib/stdlib/src/erl_internal.erl @@ -254,6 +254,9 @@ bif(binary_part, 2) -> true; bif(binary_part, 3) -> true; bif(binary_to_atom, 2) -> true; bif(binary_to_existing_atom, 2) -> true; +bif(binary_to_integer, 1) -> true; +bif(binary_to_integer, 2) -> true; +bif(binary_to_float, 1) -> true; bif(binary_to_list, 1) -> true; bif(binary_to_list, 3) -> true; bif(binary_to_term, 1) -> true; @@ -279,6 +282,8 @@ bif(exit, 2) -> true; bif(float, 1) -> true; bif(float_to_list, 1) -> true; bif(float_to_list, 2) -> true; +bif(float_to_binary, 1) -> true; +bif(float_to_binary, 2) -> true; bif(garbage_collect, 0) -> true; bif(garbage_collect, 1) -> true; bif(get, 0) -> true; @@ -290,6 +295,8 @@ bif(halt, 0) -> true; bif(halt, 1) -> true; bif(halt, 2) -> true; bif(hd, 1) -> true; +bif(integer_to_binary, 1) -> true; +bif(integer_to_binary, 2) -> true; bif(integer_to_list, 1) -> true; bif(integer_to_list, 2) -> true; bif(iolist_size, 1) -> true; diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 12505b33d1..68a8534f15 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -3483,6 +3483,12 @@ extract_sequence(4, [$t, $P | Fmt], Need) -> extract_sequence(5, [$P|Fmt], Need); extract_sequence(4, [$t, C | _Fmt], _Need) -> {error,"invalid control ~t" ++ [C]}; +extract_sequence(4, [$l, $p | Fmt], Need) -> + extract_sequence(5, [$p|Fmt], Need); +extract_sequence(4, [$l, $P | Fmt], Need) -> + extract_sequence(5, [$P|Fmt], Need); +extract_sequence(4, [$l, C | _Fmt], _Need) -> + {error,"invalid control ~l" ++ [C]}; extract_sequence(4, Fmt, Need) -> extract_sequence(5, Fmt, Need); extract_sequence(5, [C|Fmt], Need0) -> diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index a868867a81..7c7566e4ec 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -61,7 +61,8 @@ form(Thing) -> Options :: options()). form(Thing, Options) -> - frmt(lform(Thing, options(Options)), state(Options)). + State = state(Options), + frmt(lform(Thing, options(Options), State), State). -spec(attribute(Attribute) -> io_lib:chars() when Attribute :: erl_parse:abstract_form()). @@ -74,7 +75,8 @@ attribute(Thing) -> Options :: options()). attribute(Thing, Options) -> - frmt(lattribute(Thing, options(Options)), state(Options)). + State = state(Options), + frmt(lattribute(Thing, options(Options), State), State). -spec(function(Function) -> io_lib:chars() when Function :: erl_parse:abstract_form()). @@ -193,47 +195,47 @@ encoding(Options) -> unicode -> unicode end. -lform({attribute,Line,Name,Arg}, Opts) -> - lattribute({attribute,Line,Name,Arg}, Opts); -lform({function,Line,Name,Arity,Clauses}, Opts) -> +lform({attribute,Line,Name,Arg}, Opts, State) -> + lattribute({attribute,Line,Name,Arg}, Opts, State); +lform({function,Line,Name,Arity,Clauses}, Opts, _State) -> lfunction({function,Line,Name,Arity,Clauses}, Opts); -lform({rule,Line,Name,Arity,Clauses}, Opts) -> +lform({rule,Line,Name,Arity,Clauses}, Opts, _State) -> lrule({rule,Line,Name,Arity,Clauses}, Opts); %% These are specials to make it easier for the compiler. -lform({error,E}, _Opts) -> +lform({error,E}, _Opts, _State) -> leaf(format("~p\n", [{error,E}])); -lform({warning,W}, _Opts) -> +lform({warning,W}, _Opts, _State) -> leaf(format("~p\n", [{warning,W}])); -lform({eof,_Line}, _Opts) -> +lform({eof,_Line}, _Opts, _State) -> $\n. -lattribute({attribute,_Line,type,Type}, Opts) -> +lattribute({attribute,_Line,type,Type}, Opts, _State) -> [typeattr(type, Type, Opts),leaf(".\n")]; -lattribute({attribute,_Line,opaque,Type}, Opts) -> +lattribute({attribute,_Line,opaque,Type}, Opts, _State) -> [typeattr(opaque, Type, Opts),leaf(".\n")]; -lattribute({attribute,_Line,spec,Arg}, _Opts) -> +lattribute({attribute,_Line,spec,Arg}, _Opts, _State) -> [specattr(Arg),leaf(".\n")]; -lattribute({attribute,_Line,Name,Arg}, Opts) -> - [lattribute(Name, Arg, Opts),leaf(".\n")]. +lattribute({attribute,_Line,Name,Arg}, Opts, State) -> + [lattribute(Name, Arg, Opts, State),leaf(".\n")]. -lattribute(module, {M,Vs}, _Opts) -> +lattribute(module, {M,Vs}, _Opts, _State) -> attr("module",[{var,0,pname(M)}, foldr(fun(V, C) -> {cons,0,{var,0,V},C} end, {nil,0}, Vs)]); -lattribute(module, M, _Opts) -> +lattribute(module, M, _Opts, _State) -> attr("module", [{var,0,pname(M)}]); -lattribute(export, Falist, _Opts) -> +lattribute(export, Falist, _Opts, _State) -> call({var,0,"-export"}, [falist(Falist)], 0, none); -lattribute(import, Name, _Opts) when is_list(Name) -> +lattribute(import, Name, _Opts, _State) when is_list(Name) -> attr("import", [{var,0,pname(Name)}]); -lattribute(import, {From,Falist}, _Opts) -> +lattribute(import, {From,Falist}, _Opts, _State) -> attr("import",[{var,0,pname(From)},falist(Falist)]); -lattribute(file, {Name,Line}, _Opts) -> - attr("file", [{var,0,format("~p", [Name])},{integer,0,Line}]); -lattribute(record, {Name,Is}, Opts) -> +lattribute(file, {Name,Line}, _Opts, State) -> + attr("file", [{var,0,(State#pp.string_fun)(Name)},{integer,0,Line}]); +lattribute(record, {Name,Is}, Opts, _State) -> Nl = leaf(format("-record(~w,", [Name])), [{first,Nl,record_fields(Is, Opts)},$)]; -lattribute(Name, Arg, #options{encoding = Encoding}) -> +lattribute(Name, Arg, #options{encoding = Encoding}, _State) -> attr(write(Name), [erl_parse:abstract(Arg, [{encoding,Encoding}])]). typeattr(Tag, {TypeName,Type,Args}, _Opts) -> @@ -423,7 +425,7 @@ lexpr(E, Opts) -> lexpr({var,_,V}, _, _) when is_integer(V) -> %Special hack for Robert leaf(format("_~w", [V])); -lexpr({var,_,V}, _, _) -> leaf(format("~s", [V])); +lexpr({var,_,V}, _, _) -> leaf(format("~ts", [V])); lexpr({char,_,C}, _, _) -> {char,C}; lexpr({integer,_,N}, _, _) -> leaf(write(N)); lexpr({float,_,F}, _, _) -> leaf(write(F)); @@ -799,7 +801,7 @@ maybe_paren(_P, _Prec, Expr) -> Expr. leaf(S) -> - {leaf,iolist_size(S),S}. + {leaf,chars_size(S),S}. %%% Do the formatting. Currently nothing fancy. Could probably have %%% done it in one single pass. @@ -1009,7 +1011,7 @@ incr(I, Incr) -> I+Incr. indentation(E, I) when I < 0 -> - iolist_size(E); + chars_size(E); indentation(E, I0) -> I = io_lib_format:indentation(E, I0), case has_nl(E) of @@ -1064,6 +1066,15 @@ write_char(C, PP) -> %% Utilities %% +chars_size([C | Es]) when is_integer(C) -> + 1 + chars_size(Es); +chars_size([E | Es]) -> + chars_size(E) + chars_size(Es); +chars_size([]) -> + 0; +chars_size(B) when is_binary(B) -> + byte_size(B). + -define(N_SPACES, 30). spacetab() -> diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl index e944dd4c43..66e54ef221 100644 --- a/lib/stdlib/src/filename.erl +++ b/lib/stdlib/src/filename.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -62,14 +62,14 @@ -spec absname(Filename) -> file:filename_all() when - Filename :: file:name(). + Filename :: file:name_all(). absname(Name) -> {ok, Cwd} = file:get_cwd(), absname(Name, Cwd). -spec absname(Filename, Dir) -> file:filename_all() when - Filename :: file:name(), - Dir :: file:name(). + Filename :: file:name_all(), + Dir :: file:name_all(). absname(Name, AbsBase) when is_binary(Name), is_list(AbsBase) -> absname(Name,filename_string_to_binary(AbsBase)); absname(Name, AbsBase) when is_list(Name), is_binary(AbsBase) -> @@ -123,8 +123,8 @@ absname_vr([[X, $:]|Name], _, _AbsBase) -> %% AbsBase must be absolute and Name must be relative. -spec absname_join(Dir, Filename) -> file:filename_all() when - Dir :: file:name(), - Filename :: file:name(). + Dir :: file:name_all(), + Filename :: file:name_all(). absname_join(AbsBase, Name) -> join(AbsBase, flatten(Name)). @@ -137,7 +137,7 @@ absname_join(AbsBase, Name) -> %% basename("/") -> [] -spec basename(Filename) -> file:filename_all() when - Filename :: file:name(). + Filename :: file:name_all(). basename(Name) when is_binary(Name) -> case os:type() of {win32,_} -> @@ -202,8 +202,8 @@ skip_prefix(Name, _) -> %% rootname(basename("xxx.erl")) -> "xxx" -spec basename(Filename, Ext) -> file:filename_all() when - Filename :: file:name(), - Ext :: file:name(). + Filename :: file:name_all(), + Ext :: file:name_all(). basename(Name, Ext) when is_binary(Name), is_list(Ext) -> basename(Name,filename_string_to_binary(Ext)); basename(Name, Ext) when is_list(Name), is_binary(Ext) -> @@ -252,7 +252,7 @@ basename([], _Ext, Tail, _DrvSep2) -> %% dirname("kalle.erl") -> "." -spec dirname(Filename) -> file:filename_all() when - Filename :: file:name(). + Filename :: file:name_all(). dirname(Name) when is_binary(Name) -> {Dsep,Drivesep} = separators(), SList = case Dsep of @@ -345,7 +345,7 @@ dirjoin1([H|T],Acc,Sep) -> %% On Windows: fn:dirname("\\usr\\src/kalle.erl") -> "/usr/src" -spec extension(Filename) -> file:filename_all() when - Filename :: file:name(). + Filename :: file:name_all(). extension(Name) when is_binary(Name) -> {Dsep,_} = separators(), SList = case Dsep of @@ -388,7 +388,7 @@ extension([], Result, _OsType) -> %% Joins a list of filenames with directory separators. -spec join(Components) -> file:filename_all() when - Components :: [file:name()]. + Components :: [file:name_all()]. join([Name1, Name2|Rest]) -> join([join(Name1, Name2)|Rest]); join([Name]) when is_list(Name) -> @@ -401,8 +401,8 @@ join([Name]) when is_atom(Name) -> %% Joins two filenames with directory separators. -spec join(Name1, Name2) -> file:filename_all() when - Name1 :: file:name(), - Name2 :: file:name(). + Name1 :: file:name_all(), + Name2 :: file:name_all(). join(Name1, Name2) when is_list(Name1), is_list(Name2) -> OsType = major_os_type(), case pathtype(Name2) of @@ -488,7 +488,7 @@ maybe_remove_dirsep(Name, _) -> %% a given base directory, which is is assumed to be normalised %% by a previous call to join/{1,2}. --spec append(file:filename_all(), file:name()) -> file:filename_all(). +-spec append(file:filename_all(), file:name_all()) -> file:filename_all(). append(Dir, Name) when is_binary(Dir), is_binary(Name) -> <<Dir/binary,$/:8,Name/binary>>; append(Dir, Name) when is_binary(Dir) -> @@ -511,7 +511,7 @@ append(Dir, Name) -> %% Example: a:bar.erl, /temp/foo.erl -spec pathtype(Path) -> 'absolute' | 'relative' | 'volumerelative' when - Path :: file:name(). + Path :: file:name_all(). pathtype(Atom) when is_atom(Atom) -> pathtype(atom_to_list(Atom)); pathtype(Name) when is_list(Name) or is_binary(Name) -> @@ -565,7 +565,7 @@ win32_pathtype(_) -> relative. %% rootname("/jam.src/foo.erl") -> "/jam.src/foo" -spec rootname(Filename) -> file:filename_all() when - Filename :: file:name(). + Filename :: file:name_all(). rootname(Name) when is_binary(Name) -> list_to_binary(rootname(binary_to_list(Name))); % No need to handle unicode, . is < 128 rootname(Name0) -> @@ -595,8 +595,8 @@ rootname([], Root, _Ext, _OsType) -> %% rootname("/jam.src/foo.erl", ".erl") -> "/jam.src/foo" -spec rootname(Filename, Ext) -> file:filename_all() when - Filename :: file:name(), - Ext :: file:name(). + Filename :: file:name_all(), + Ext :: file:name_all(). rootname(Name, Ext) when is_binary(Name), is_binary(Ext) -> list_to_binary(rootname(binary_to_list(Name),binary_to_list(Ext))); rootname(Name, Ext) when is_binary(Name) -> @@ -623,8 +623,8 @@ rootname2([Char|Rest], Ext, Result) when is_integer(Char) -> %% split("a:\\msdev\\include") -> ["a:/", "msdev", "include"] -spec split(Filename) -> Components when - Filename :: file:name(), - Components :: [file:name()]. + Filename :: file:name_all(), + Components :: [file:name_all()]. split(Name) when is_binary(Name) -> case os:type() of {win32, _} -> win32_splitb(Name); @@ -718,7 +718,7 @@ split([], Comp, Components, OsType) -> %% name will be normalized as done by join/1. -spec nativename(Path) -> file:filename_all() when - Path :: file:name(). + Path :: file:name_all(). nativename(Name0) -> Name = join([Name0]), %Normalize. case os:type() of @@ -922,7 +922,7 @@ major_os_type() -> %% Flatten a list, also accepting atoms. -spec flatten(Filename) -> file:filename_all() when - Filename :: file:name(). + Filename :: file:name_all(). flatten(Bin) when is_binary(Bin) -> Bin; flatten(List) -> diff --git a/lib/stdlib/src/io.erl b/lib/stdlib/src/io.erl index 3dddb0d6e7..c92e9e3ade 100644 --- a/lib/stdlib/src/io.erl +++ b/lib/stdlib/src/io.erl @@ -32,6 +32,8 @@ parse_erl_exprs/4,parse_erl_form/1,parse_erl_form/2, parse_erl_form/3,parse_erl_form/4]). -export([request/1,request/2,requests/1,requests/2]). +%% Implemented in native code +-export([printable_range/0]). -export_type([device/0, format/0, server_no_data/0]). @@ -66,6 +68,11 @@ o_request(Io, Request, Func) -> Other end. +%% Request what the user considers printable characters +-spec printable_range() -> 'unicode' | 'latin1'. +printable_range() -> + erlang:nif_error(undefined). + %% Put chars takes mixed *unicode* list from R13 onwards. -spec put_chars(CharData) -> 'ok' when CharData :: unicode:chardata(). diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl index b7ec848e1e..a9b6d4131e 100644 --- a/lib/stdlib/src/io_lib.erl +++ b/lib/stdlib/src/io_lib.erl @@ -72,7 +72,7 @@ -export([quote_atom/2, char_list/1, latin1_char_list/1, deep_char_list/1, deep_latin1_char_list/1, - printable_list/1, printable_latin1_list/1]). + printable_list/1, printable_latin1_list/1, printable_unicode_list/1]). %% Utilities for collecting characters. -export([collect_chars/3, collect_chars/4, @@ -533,27 +533,45 @@ printable_latin1_list(_) -> false. %Everything else is false %% Return true if CharList is a list of printable characters, else %% false. The notion of printable in Unicode terms is somewhat floating. %% Everything that is not a control character and not invalid unicode -%% will be considered printable. +%% will be considered printable. +%% What the user has noted as printable characters is what actually +%% specifies when this function will return true. If the VM is started +%% with +pc latin1, only the latin1 range will be deemed as printable +%% if on the other hand +pc unicode is given, all characters in the Unicode +%% character set are deemed printable. latin1 is default. -spec printable_list(Term) -> boolean() when Term :: term(). -printable_list([C|Cs]) when is_integer(C), C >= $\040, C =< $\176 -> - printable_list(Cs); -printable_list([C|Cs]) +printable_list(L) -> + %% There will be more alternatives returns from io:printable range + %% in the future. To not have a catch-all clause is deliberate. + case io:printable_range() of + latin1 -> + printable_latin1_list(L); + unicode -> + printable_unicode_list(L) + end. + +-spec printable_unicode_list(Term) -> boolean() when + Term :: term(). + +printable_unicode_list([C|Cs]) when is_integer(C), C >= $\040, C =< $\176 -> + printable_unicode_list(Cs); +printable_unicode_list([C|Cs]) when is_integer(C), C >= 16#A0, C < 16#D800; is_integer(C), C > 16#DFFF, C < 16#FFFE; is_integer(C), C > 16#FFFF, C =< 16#10FFFF -> - printable_list(Cs); -printable_list([$\n|Cs]) -> printable_list(Cs); -printable_list([$\r|Cs]) -> printable_list(Cs); -printable_list([$\t|Cs]) -> printable_list(Cs); -printable_list([$\v|Cs]) -> printable_list(Cs); -printable_list([$\b|Cs]) -> printable_list(Cs); -printable_list([$\f|Cs]) -> printable_list(Cs); -printable_list([$\e|Cs]) -> printable_list(Cs); -printable_list([]) -> true; -printable_list(_) -> false. %Everything else is false + printable_unicode_list(Cs); +printable_unicode_list([$\n|Cs]) -> printable_unicode_list(Cs); +printable_unicode_list([$\r|Cs]) -> printable_unicode_list(Cs); +printable_unicode_list([$\t|Cs]) -> printable_unicode_list(Cs); +printable_unicode_list([$\v|Cs]) -> printable_unicode_list(Cs); +printable_unicode_list([$\b|Cs]) -> printable_unicode_list(Cs); +printable_unicode_list([$\f|Cs]) -> printable_unicode_list(Cs); +printable_unicode_list([$\e|Cs]) -> printable_unicode_list(Cs); +printable_unicode_list([]) -> true; +printable_unicode_list(_) -> false. %Everything else is false %% List = nl() %% Return a list of characters to generate a newline. diff --git a/lib/stdlib/src/io_lib_format.erl b/lib/stdlib/src/io_lib_format.erl index 64d19ccf48..56e15a17ec 100644 --- a/lib/stdlib/src/io_lib_format.erl +++ b/lib/stdlib/src/io_lib_format.erl @@ -58,14 +58,22 @@ collect_cseq(Fmt0, Args0) -> {P,Fmt2,Args2} = precision(Fmt1, Args1), {Pad,Fmt3,Args3} = pad_char(Fmt2, Args2), {Encoding,Fmt4,Args4} = encoding(Fmt3, Args3), - {C,As,Fmt5,Args5} = collect_cc(Fmt4, Args4), - {{C,As,F,Ad,P,Pad,Encoding},Fmt5,Args5}. + {Strings,Fmt5,Args5} = strings(Fmt4, Args4), + {C,As,Fmt6,Args6} = collect_cc(Fmt5, Args5), + {{C,As,F,Ad,P,Pad,Encoding,Strings},Fmt6,Args6}. encoding([$t|Fmt],Args) -> + true = hd(Fmt) =/= $l, {unicode,Fmt,Args}; encoding(Fmt,Args) -> {latin1,Fmt,Args}. +strings([$l|Fmt],Args) -> + true = hd(Fmt) =/= $t, + {false,Fmt,Args}; +strings(Fmt,Args) -> + {true,Fmt,Args}. + field_width([$-|Fmt0], Args0) -> {F,Fmt,Args} = field_value(Fmt0, Args0), field_width(-F, Fmt, Args); @@ -128,8 +136,8 @@ collect_cc([$i|Fmt], [A|Args]) -> {$i,[A],Fmt,Args}. pcount(Cs) -> pcount(Cs, 0). -pcount([{$p,_As,_F,_Ad,_P,_Pad,_Enc}|Cs], Acc) -> pcount(Cs, Acc+1); -pcount([{$P,_As,_F,_Ad,_P,_Pad,_Enc}|Cs], Acc) -> pcount(Cs, Acc+1); +pcount([{$p,_As,_F,_Ad,_P,_Pad,_Enc,_Str}|Cs], Acc) -> pcount(Cs, Acc+1); +pcount([{$P,_As,_F,_Ad,_P,_Pad,_Enc,_Str}|Cs], Acc) -> pcount(Cs, Acc+1); pcount([_|Cs], Acc) -> pcount(Cs, Acc); pcount([], Acc) -> Acc. @@ -138,8 +146,8 @@ pcount([], Acc) -> Acc. %% remaining and only calculate indentation when necessary. Must also %% be smart when calculating indentation for characters in format. -build([{C,As,F,Ad,P,Pad,Enc}|Cs], Pc0, I) -> - S = control(C, As, F, Ad, P, Pad, Enc, I), +build([{C,As,F,Ad,P,Pad,Enc,Str}|Cs], Pc0, I) -> + S = control(C, As, F, Ad, P, Pad, Enc, Str, I), Pc1 = decr_pc(C, Pc0), if Pc1 > 0 -> [S|build(Cs, Pc1, indentation(S, I))]; @@ -171,59 +179,59 @@ indentation([], I) -> I. %% This is the main dispatch function for the various formatting commands. %% Field widths and precisions have already been calculated. -control($w, [A], F, Adj, P, Pad, _Enc,_I) -> +control($w, [A], F, Adj, P, Pad, _Enc, _Str, _I) -> term(io_lib:write(A, -1), F, Adj, P, Pad); -control($p, [A], F, Adj, P, Pad, Enc, I) -> - print(A, -1, F, Adj, P, Pad, Enc, I); -control($W, [A,Depth], F, Adj, P, Pad, _Enc, _I) when is_integer(Depth) -> +control($p, [A], F, Adj, P, Pad, Enc, Str, I) -> + print(A, -1, F, Adj, P, Pad, Enc, Str, I); +control($W, [A,Depth], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(Depth) -> term(io_lib:write(A, Depth), F, Adj, P, Pad); -control($P, [A,Depth], F, Adj, P, Pad, Enc, I) when is_integer(Depth) -> - print(A, Depth, F, Adj, P, Pad, Enc, I); -control($s, [A], F, Adj, P, Pad, _Enc, _I) when is_atom(A) -> +control($P, [A,Depth], F, Adj, P, Pad, Enc, Str, I) when is_integer(Depth) -> + print(A, Depth, F, Adj, P, Pad, Enc, Str, I); +control($s, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_atom(A) -> string(atom_to_list(A), F, Adj, P, Pad); -control($s, [L0], F, Adj, P, Pad, latin1, _I) -> +control($s, [L0], F, Adj, P, Pad, latin1, _Str, _I) -> L = iolist_to_chars(L0), string(L, F, Adj, P, Pad); -control($s, [L0], F, Adj, P, Pad, unicode, _I) -> +control($s, [L0], F, Adj, P, Pad, unicode, _Str, _I) -> L = cdata_to_chars(L0), uniconv(string(L, F, Adj, P, Pad)); -control($e, [A], F, Adj, P, Pad, _Enc, _I) when is_float(A) -> +control($e, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_float(A) -> fwrite_e(A, F, Adj, P, Pad); -control($f, [A], F, Adj, P, Pad, _Enc, _I) when is_float(A) -> +control($f, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_float(A) -> fwrite_f(A, F, Adj, P, Pad); -control($g, [A], F, Adj, P, Pad, _Enc, _I) when is_float(A) -> +control($g, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_float(A) -> fwrite_g(A, F, Adj, P, Pad); -control($b, [A], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($b, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> unprefixed_integer(A, F, Adj, base(P), Pad, true); -control($B, [A], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($B, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> unprefixed_integer(A, F, Adj, base(P), Pad, false); -control($x, [A,Prefix], F, Adj, P, Pad, _Enc, _I) when is_integer(A), +control($x, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A), is_atom(Prefix) -> prefixed_integer(A, F, Adj, base(P), Pad, atom_to_list(Prefix), true); -control($x, [A,Prefix], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($x, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> true = io_lib:deep_char_list(Prefix), %Check if Prefix a character list prefixed_integer(A, F, Adj, base(P), Pad, Prefix, true); -control($X, [A,Prefix], F, Adj, P, Pad, _Enc, _I) when is_integer(A), +control($X, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A), is_atom(Prefix) -> prefixed_integer(A, F, Adj, base(P), Pad, atom_to_list(Prefix), false); -control($X, [A,Prefix], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($X, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> true = io_lib:deep_char_list(Prefix), %Check if Prefix a character list prefixed_integer(A, F, Adj, base(P), Pad, Prefix, false); -control($+, [A], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($+, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> Base = base(P), Prefix = [integer_to_list(Base), $#], prefixed_integer(A, F, Adj, Base, Pad, Prefix, true); -control($#, [A], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($#, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> Base = base(P), Prefix = [integer_to_list(Base), $#], prefixed_integer(A, F, Adj, Base, Pad, Prefix, false); -control($c, [A], F, Adj, P, Pad, unicode, _I) when is_integer(A) -> +control($c, [A], F, Adj, P, Pad, unicode, _Str, _I) when is_integer(A) -> char(A, F, Adj, P, Pad); -control($c, [A], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($c, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> char(A band 255, F, Adj, P, Pad); -control($~, [], F, Adj, P, Pad, _Enc, _I) -> char($~, F, Adj, P, Pad); -control($n, [], F, Adj, P, Pad, _Enc, _I) -> newline(F, Adj, P, Pad); -control($i, [_A], _F, _Adj, _P, _Pad, _Enc, _I) -> []. +control($~, [], F, Adj, P, Pad, _Enc, _Str, _I) -> char($~, F, Adj, P, Pad); +control($n, [], F, Adj, P, Pad, _Enc, _Str, _I) -> newline(F, Adj, P, Pad); +control($i, [_A], _F, _Adj, _P, _Pad, _Enc, _Str, _I) -> []. -ifdef(UNICODE_AS_BINARIES). uniconv(C) -> @@ -259,12 +267,16 @@ term(T, F, Adj, P0, Pad) -> %% Indentation) %% Print a term. -print(T, D, none, Adj, P, Pad, E, I) -> print(T, D, 80, Adj, P, Pad, E, I); -print(T, D, F, Adj, none, Pad, E, I) -> print(T, D, F, Adj, I+1, Pad, E, I); -print(T, D, F, right, P, _Pad, latin1, _I) -> - io_lib_pretty:print(T, P, F, D); -print(T, D, F, right, P, _Pad, Enc, _I) -> - Options = [{column, P}, {line_length, F}, {depth, D}, {encoding, Enc}], +print(T, D, none, Adj, P, Pad, E, Str, I) -> + print(T, D, 80, Adj, P, Pad, E, Str, I); +print(T, D, F, Adj, none, Pad, E, Str, I) -> + print(T, D, F, Adj, I+1, Pad, E, Str, I); +print(T, D, F, right, P, _Pad, Enc, Str, _I) -> + Options = [{column, P}, + {line_length, F}, + {depth, D}, + {encoding, Enc}, + {strings, Str}], io_lib_pretty:print(T, Options). %% fwrite_e(Float, Field, Adjust, Precision, PadChar) diff --git a/lib/stdlib/src/io_lib_pretty.erl b/lib/stdlib/src/io_lib_pretty.erl index b05db3d290..7637ad7a3d 100644 --- a/lib/stdlib/src/io_lib_pretty.erl +++ b/lib/stdlib/src/io_lib_pretty.erl @@ -56,6 +56,7 @@ print(Term) -> | {depth, depth()} | {max_chars, max_chars()} | {record_print_fun, rec_print_fun()} + | {strings, boolean()} | {encoding, latin1 | utf8 | unicode}. -type options() :: [option()]. @@ -69,7 +70,8 @@ print(Term, Options) when is_list(Options) -> M = proplists:get_value(max_chars, Options, -1), RecDefFun = proplists:get_value(record_print_fun, Options, no_fun), Encoding = proplists:get_value(encoding, Options, epp:default_encoding()), - print(Term, Col, Ll, D, M, RecDefFun, Encoding); + Strings = proplists:get_value(strings, Options, true), + print(Term, Col, Ll, D, M, RecDefFun, Encoding, Strings); print(Term, RecDefFun) -> print(Term, -1, RecDefFun). @@ -81,7 +83,7 @@ print(Term, Depth, RecDefFun) -> -spec print(term(), column(), line_length(), depth()) -> chars(). print(Term, Col, Ll, D) -> - print(Term, Col, Ll, D, _M=-1, no_fun, latin1). + print(Term, Col, Ll, D, _M=-1, no_fun, latin1, true). -spec print(term(), column(), line_length(), depth(), rec_print_fun()) -> chars(). @@ -92,15 +94,15 @@ print(Term, Col, Ll, D, RecDefFun) -> rec_print_fun()) -> chars(). print(Term, Col, Ll, D, M, RecDefFun) -> - print(Term, Col, Ll, D, M, RecDefFun, latin1). - -print(_, _, _, 0, _M, _RF, _Enc) -> "..."; -print(Term, Col, Ll, D, M, RecDefFun, Enc) when Col =< 0 -> - print(Term, 1, Ll, D, M, RecDefFun, Enc); -print(Term, Col, Ll, D, M0, RecDefFun, Enc) when is_tuple(Term); - is_list(Term); - is_bitstring(Term) -> - If = {_S, Len} = print_length(Term, D, RecDefFun, Enc), + print(Term, Col, Ll, D, M, RecDefFun, latin1, true). + +print(_, _, _, 0, _M, _RF, _Enc, _Str) -> "..."; +print(Term, Col, Ll, D, M, RecDefFun, Enc, Str) when Col =< 0 -> + print(Term, 1, Ll, D, M, RecDefFun, Enc, Str); +print(Term, Col, Ll, D, M0, RecDefFun, Enc, Str) when is_tuple(Term); + is_list(Term); + is_bitstring(Term) -> + If = {_S, Len} = print_length(Term, D, RecDefFun, Enc, Str), M = max_cs(M0, Len), if Len < Ll - Col, Len =< M -> @@ -111,7 +113,7 @@ print(Term, Col, Ll, D, M0, RecDefFun, Enc) when is_tuple(Term); 1), pp(If, Col, Ll, M, TInd, indent(Col), 0, 0) end; -print(Term, _Col, _Ll, _D, _M, _RF, _Enc) -> +print(Term, _Col, _Ll, _D, _M, _RF, _Enc, _Str) -> io_lib:write(Term). %%% @@ -325,12 +327,12 @@ write_tail(E, S) -> %% counted but need to be added later. %% D =/= 0 -print_length([], _D, _RF, _Enc) -> +print_length([], _D, _RF, _Enc, _Str) -> {"[]", 2}; -print_length({}, _D, _RF, _Enc) -> +print_length({}, _D, _RF, _Enc, _Str) -> {"{}", 2}; -print_length(List, D, RF, Enc) when is_list(List) -> - case printable_list(List, D, Enc) of +print_length(List, D, RF, Enc, Str) when is_list(List) -> + case Str andalso printable_list(List, D, Enc) of true -> S = write_string(List, Enc), {S, length(S)}; @@ -339,30 +341,30 @@ print_length(List, D, RF, Enc) when is_list(List) -> % S = write_string(Prefix, Enc), % {[S | "..."], 3 + length(S)}; false -> - print_length_list(List, D, RF, Enc) + print_length_list(List, D, RF, Enc, Str) end; -print_length(Fun, _D, _RF, _Enc) when is_function(Fun) -> +print_length(Fun, _D, _RF, _Enc, _Str) when is_function(Fun) -> S = io_lib:write(Fun), {S, iolist_size(S)}; -print_length(R, D, RF, Enc) when is_atom(element(1, R)), - is_function(RF) -> +print_length(R, D, RF, Enc, Str) when is_atom(element(1, R)), + is_function(RF) -> case RF(element(1, R), tuple_size(R) - 1) of no -> - print_length_tuple(R, D, RF, Enc); + print_length_tuple(R, D, RF, Enc, Str); RDefs -> - print_length_record(R, D, RF, RDefs, Enc) + print_length_record(R, D, RF, RDefs, Enc, Str) end; -print_length(Tuple, D, RF, Enc) when is_tuple(Tuple) -> - print_length_tuple(Tuple, D, RF, Enc); -print_length(<<>>, _D, _RF, _Enc) -> +print_length(Tuple, D, RF, Enc, Str) when is_tuple(Tuple) -> + print_length_tuple(Tuple, D, RF, Enc, Str); +print_length(<<>>, _D, _RF, _Enc, _Str) -> {"<<>>", 4}; -print_length(<<_/bitstring>>, 1, _RF, _Enc) -> +print_length(<<_/bitstring>>, 1, _RF, _Enc, _Str) -> {"<<...>>", 7}; -print_length(<<_/bitstring>>=Bin, D, _RF, Enc) -> +print_length(<<_/bitstring>>=Bin, D, _RF, Enc, Str) -> case bit_size(Bin) rem 8 of 0 -> D1 = D - 1, - case printable_bin(Bin, D1, Enc) of + case Str andalso printable_bin(Bin, D1, Enc) of {true, List} when is_list(List) -> S = io_lib:write_string(List, $"), %" {[$<,$<,S,$>,$>], 4 + length(S)}; @@ -383,51 +385,53 @@ print_length(<<_/bitstring>>=Bin, D, _RF, Enc) -> S = io_lib:write(Bin, D), {{bin,S}, iolist_size(S)} end; -print_length(Term, _D, _RF, _Enc) -> +print_length(Term, _D, _RF, _Enc, _Str) -> S = io_lib:write(Term), {S, lists:flatlength(S)}. -print_length_tuple(_Tuple, 1, _RF, _Enc) -> +print_length_tuple(_Tuple, 1, _RF, _Enc, _Str) -> {"{...}", 5}; -print_length_tuple(Tuple, D, RF, Enc) -> - L = print_length_list1(tuple_to_list(Tuple), D, RF, Enc), +print_length_tuple(Tuple, D, RF, Enc, Str) -> + L = print_length_list1(tuple_to_list(Tuple), D, RF, Enc, Str), IsTagged = is_atom(element(1, Tuple)) and (tuple_size(Tuple) > 1), {{tuple,IsTagged,L}, list_length(L, 2)}. -print_length_record(_Tuple, 1, _RF, _RDefs, _Enc) -> +print_length_record(_Tuple, 1, _RF, _RDefs, _Enc, _Str) -> {"{...}", 5}; -print_length_record(Tuple, D, RF, RDefs, Enc) -> +print_length_record(Tuple, D, RF, RDefs, Enc, Str) -> Name = [$# | io_lib:write_atom(element(1, Tuple))], NameL = length(Name), - L = print_length_fields(RDefs, D - 1, tl(tuple_to_list(Tuple)), RF, Enc), + Elements = tl(tuple_to_list(Tuple)), + L = print_length_fields(RDefs, D - 1, Elements, RF, Enc, Str), {{record, [{Name,NameL} | L]}, list_length(L, NameL + 2)}. -print_length_fields([], _D, [], _RF, _Enc) -> +print_length_fields([], _D, [], _RF, _Enc, _Str) -> []; -print_length_fields(_, 1, _, _RF, _Enc) -> +print_length_fields(_, 1, _, _RF, _Enc, _Str) -> {dots, 3}; -print_length_fields([Def | Defs], D, [E | Es], RF, Enc) -> - [print_length_field(Def, D - 1, E, RF, Enc) | - print_length_fields(Defs, D - 1, Es, RF, Enc)]. +print_length_fields([Def | Defs], D, [E | Es], RF, Enc, Str) -> + [print_length_field(Def, D - 1, E, RF, Enc, Str) | + print_length_fields(Defs, D - 1, Es, RF, Enc, Str)]. -print_length_field(Def, D, E, RF, Enc) -> +print_length_field(Def, D, E, RF, Enc, Str) -> Name = io_lib:write_atom(Def), - {S, L} = print_length(E, D, RF, Enc), + {S, L} = print_length(E, D, RF, Enc, Str), NameL = length(Name) + 3, {{field, Name, NameL, {S, L}}, NameL + L}. -print_length_list(List, D, RF, Enc) -> - L = print_length_list1(List, D, RF, Enc), +print_length_list(List, D, RF, Enc, Str) -> + L = print_length_list1(List, D, RF, Enc, Str), {{list, L}, list_length(L, 2)}. -print_length_list1([], _D, _RF, _Enc) -> +print_length_list1([], _D, _RF, _Enc, _Str) -> []; -print_length_list1(_, 1, _RF, _Enc) -> +print_length_list1(_, 1, _RF, _Enc, _Str) -> {dots, 3}; -print_length_list1([E | Es], D, RF, Enc) -> - [print_length(E, D - 1, RF, Enc) | print_length_list1(Es, D - 1, RF, Enc)]; -print_length_list1(E, D, RF, Enc) -> - print_length(E, D - 1, RF, Enc). +print_length_list1([E | Es], D, RF, Enc, Str) -> + [print_length(E, D - 1, RF, Enc, Str) | + print_length_list1(Es, D - 1, RF, Enc, Str)]; +print_length_list1(E, D, RF, Enc, Str) -> + print_length(E, D - 1, RF, Enc, Str). list_length([], Acc) -> Acc; @@ -481,13 +485,18 @@ printable_bin(Bin, Len, D, latin1) -> false end; printable_bin(Bin, Len, D, _Uni) -> - case printable_unicode(Bin, Len, []) of - {_, <<>>, L} -> - {byte_size(Bin) =:= length(L), L}; - {NC, Bin1, L} when D > 0, Len - NC >= D -> - {byte_size(Bin)-byte_size(Bin1) =:= length(L), true, L}; - {_NC, _Bin, _L} -> - false + case valid_utf8(Bin,Len) of + true -> + case printable_unicode(Bin, Len, [], io:printable_range()) of + {_, <<>>, L} -> + {byte_size(Bin) =:= length(L), L}; + {NC, Bin1, L} when D > 0, Len - NC >= D -> + {byte_size(Bin)-byte_size(Bin1) =:= length(L), true, L}; + {_NC, _Bin, _L} -> + false + end; + false -> + printable_bin(Bin, Len, D, latin1) end. printable_bin1(_Bin, _Start, 0) -> @@ -518,24 +527,36 @@ printable_latin1_list([$\e | Cs], N) -> printable_latin1_list(Cs, N - 1); printable_latin1_list([], _) -> all; printable_latin1_list(_, N) -> N. -printable_unicode(<<C/utf8, R/binary>>=Bin, I, L) when I > 0 -> - case printable_char(C) of +valid_utf8(<<>>,_) -> + true; +valid_utf8(_,0) -> + true; +valid_utf8(<<_/utf8, R/binary>>,N) -> + valid_utf8(R,N-1); +valid_utf8(_,_) -> + false. + +printable_unicode(<<C/utf8, R/binary>>=Bin, I, L, Range) when I > 0 -> + case printable_char(C,Range) of true -> - printable_unicode(R, I - 1, [C | L]); + printable_unicode(R, I - 1, [C | L],Range); false -> {I, Bin, lists:reverse(L)} end; -printable_unicode(Bin, I, L) -> +printable_unicode(Bin, I, L,_) -> {I, Bin, lists:reverse(L)}. -printable_char($\n) -> true; -printable_char($\r) -> true; -printable_char($\t) -> true; -printable_char($\v) -> true; -printable_char($\b) -> true; -printable_char($\f) -> true; -printable_char($\e) -> true; -printable_char(C) -> +printable_char($\n,_) -> true; +printable_char($\r,_) -> true; +printable_char($\t,_) -> true; +printable_char($\v,_) -> true; +printable_char($\b,_) -> true; +printable_char($\f,_) -> true; +printable_char($\e,_) -> true; +printable_char(C,latin1) -> + C >= $\s andalso C =< $~ orelse + C >= 16#A0 andalso C =< 16#FF; +printable_char(C,unicode) -> C >= $\s andalso C =< $~ orelse C >= 16#A0 andalso C < 16#D800 orelse C > 16#DFFF andalso C < 16#FFFE orelse diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl index 6a27cff589..48f6622565 100644 --- a/lib/stdlib/src/qlc.erl +++ b/lib/stdlib/src/qlc.erl @@ -3709,7 +3709,7 @@ maybe_error_logger(Name, Why) -> Trimmer = fun(M, _F, _A) -> M =:= erl_eval end, Formater = fun(Term, I) -> io_lib:print(Term, I, 80, -1) end, X = lib:format_stacktrace(1, Stacktrace, Trimmer, Formater), - error_logger:Name("qlc: temporary file was needed for ~w\n~s\n", + error_logger:Name("qlc: temporary file was needed for ~w\n~ts\n", [Why, lists:flatten(X)]). expand_stacktrace() -> diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl index c94f052b24..c6c706c3a7 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -22,7 +22,7 @@ -export([whereis_evaluator/0, whereis_evaluator/1]). -export([start_restricted/1, stop_restricted/0]). -export([local_allowed/3, non_local_allowed/3]). --export([prompt_func/1]). +-export([prompt_func/1, strings/1]). -define(LINEMAX, 30). -define(CHAR_MAX, 60). @@ -30,6 +30,7 @@ -define(DEF_RESULTS, 20). -define(DEF_CATCH_EXCEPTION, false). -define(DEF_PROMPT_FUNC, default). +-define(DEF_STRINGS, true). -define(RECORDS, shell_records). @@ -128,7 +129,7 @@ start_restricted(RShMod) when is_atom(RShMod) -> error_logger:error_report( lists:flatten( io_lib:fwrite( - "Restricted shell module ~w not found: ~"++cs_p() ++"\n", + "Restricted shell module ~w not found: ~tp\n", [RShMod,What]))), Error end. @@ -213,8 +214,7 @@ server(StartSync) -> ok; {RShMod2,What2} -> io:fwrite( - ("Warning! Restricted shell module ~w not found: ~" - ++cs_p()++".\n" + ("Warning! Restricted shell module ~w not found: ~tp.\n" "Only the commands q() and init:stop() will be allowed!\n"), [RShMod2,What2]), application:set_env(stdlib, restricted_shell, ?MODULE) @@ -283,7 +283,12 @@ get_command(Prompt, Eval, Bs, RT, Ds) -> eof; {error,ErrorInfo,_EndPos} -> %% Skip the rest of the line: + Opts = io:getopts(), + TmpOpts = lists:keyreplace(echo, 1, Opts, + {echo, false}), + _ = io:setopts(TmpOpts), _ = io:get_line(''), + _ = io:setopts(Opts), {error,ErrorInfo}; Else -> Else @@ -336,7 +341,7 @@ get_prompt_func() -> end. bad_prompt_func(M) -> - fwrite_severity(benign, "Bad prompt function: ~"++cs_p(), [M]). + fwrite_severity(benign, "Bad prompt function: ~tp", [M]). default_prompt(N) -> %% Don't bother flattening the list irrespective of what the @@ -1366,32 +1371,31 @@ pp(V, I, RT) -> pp(V, I, RT, enc()). pp(V, I, RT, Enc) -> + Strings = + case application:get_env(stdlib, shell_strings) of + {ok, false} -> + false; + _ -> + true + end, io_lib_pretty:print(V, ([{column, I}, {line_length, columns()}, {depth, ?LINEMAX}, {max_chars, ?CHAR_MAX}, + {strings, Strings}, {record_print_fun, record_print_fun(RT)}] ++ Enc)). -%% Control sequence 'p' possibly with Unicode translation modifier -cs_p() -> - case encoding() of - latin1 -> "p"; - unicode -> "tp" - end. - columns() -> case io:columns() of {ok,N} -> N; _ -> 80 end. - encoding() -> [{encoding, Encoding}] = enc(), Encoding. - enc() -> case lists:keyfind(encoding, 1, io:getopts()) of - false -> [{encoding,latin1}]; % should never happen - Enc -> [Enc] + false -> [{encoding,latin1}]; % should never happen + Enc -> [Enc] end. garb(Shell) -> @@ -1415,10 +1419,9 @@ check_env(V) -> {ok, Val} when is_integer(Val), Val >= 0 -> ok; {ok, Val} -> - Txt = io_lib:fwrite( - ("Invalid value of STDLIB configuration parameter ~w: ~" - ++cs_p()++"\n"), - [V, Val]), + Txt = io_lib:fwrite + ("Invalid value of STDLIB configuration parameter" + "~w: ~tp\n", [V, Val]), error_logger:info_report(lists:flatten(Txt)) end. @@ -1444,14 +1447,22 @@ history(L) when is_integer(L), L >= 0 -> results(L) when is_integer(L), L >= 0 -> set_env(stdlib, shell_saved_results, L, ?DEF_RESULTS). --spec catch_exception(Bool) -> Bool when +-spec catch_exception(Bool) -> boolean() when Bool :: boolean(). catch_exception(Bool) -> set_env(stdlib, shell_catch_exception, Bool, ?DEF_CATCH_EXCEPTION). --spec prompt_func(PromptFunc) -> PromptFunc when - PromptFunc :: 'default' | {module(),atom()}. +-spec prompt_func(PromptFunc) -> PromptFunc2 when + PromptFunc :: 'default' | {module(),atom()}, + PromptFunc2 :: 'default' | {module(),atom()}. prompt_func(String) -> set_env(stdlib, shell_prompt_func, String, ?DEF_PROMPT_FUNC). + +-spec strings(Strings) -> Strings2 when + Strings :: boolean(), + Strings2 :: boolean(). + +strings(Strings) -> + set_env(stdlib, shell_strings, Strings, ?DEF_STRINGS). diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl index 041d521514..b2f1aa955a 100644 --- a/lib/stdlib/test/epp_SUITE.erl +++ b/lib/stdlib/test/epp_SUITE.erl @@ -25,7 +25,7 @@ variable_1/1, otp_4870/1, otp_4871/1, otp_5362/1, pmod/1, not_circular/1, skip_header/1, otp_6277/1, otp_7702/1, otp_8130/1, overload_mac/1, otp_8388/1, otp_8470/1, otp_8503/1, - otp_8562/1, otp_8665/1, otp_8911/1, otp_10302/1]). + otp_8562/1, otp_8665/1, otp_8911/1, otp_10302/1, otp_10820/1]). -export([epp_parse_erl_form/2]). @@ -67,7 +67,7 @@ all() -> {group, variable}, otp_4870, otp_4871, otp_5362, pmod, not_circular, skip_header, otp_6277, otp_7702, otp_8130, overload_mac, otp_8388, otp_8470, otp_8503, otp_8562, - otp_8665, otp_8911, otp_10302]. + otp_8665, otp_8911, otp_10302, otp_10820]. groups() -> [{upcase_mac, [], [upcase_mac_1, upcase_mac_2]}, @@ -1359,6 +1359,30 @@ encoding_nocom(Enc, File) -> ok = file:close(Fd), E = epp:read_encoding(File, Options). +otp_10820(doc) -> + "OTP-10820. Unicode filenames."; +otp_10820(suite) -> + []; +otp_10820(Config) when is_list(Config) -> + L = [915,953,959,973,957,953,954,959,957,964], + Dir = ?config(priv_dir, Config), + File = filename:join(Dir, L++".erl"), + C1 = <<"%% coding: utf-8\n -module(any).">>, + ok = do_otp_10820(File, C1, "+pc latin1"), + ok = do_otp_10820(File, C1, "+pc unicode"), + C2 = <<"\n-module(any).">>, + ok = do_otp_10820(File, C2, "+pc latin1"), + ok = do_otp_10820(File, C2, "+pc unicode"). + +do_otp_10820(File, C, PC) -> + {ok,Node} = start_node(erl_pp_helper, "+fnu " ++ PC), + ok = rpc:call(Node, file, write_file, [File, C]), + {ok,[{attribute,1,file,{File,1}}, + {attribute,2,module,any}, + {eof,2}]} = rpc:call(Node, epp, parse_file, [File, [],[]]), + true = test_server:stop_node(Node), + ok. + check(Config, Tests) -> eval_tests(Config, fun check_test/2, Tests). @@ -1475,3 +1499,8 @@ ln2({error,M}) -> {error,ln2(M)}; ln2(M) -> M. + +%% +fnu means a peer node has to be started; slave will not do +start_node(Name, Xargs) -> + ?line PA = filename:dirname(code:which(?MODULE)), + test_server:start_node(Name, peer, [{args, "-pa " ++ PA ++ " " ++ Xargs}]). diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index 37be61d665..9c0a43abcc 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2012. All Rights Reserved. +%% Copyright Ericsson AB 2006-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -49,7 +49,7 @@ otp_6321/1, otp_6911/1, otp_6914/1, otp_8150/1, otp_8238/1, otp_8473/1, otp_8522/1, otp_8567/1, otp_8664/1, otp_9147/1, - otp_10302/1]). + otp_10302/1, otp_10820/1]). %% Internal export. -export([ehook/6]). @@ -80,7 +80,8 @@ groups() -> {attributes, [], [misc_attrs, import_export]}, {tickets, [], [otp_6321, otp_6911, otp_6914, otp_8150, otp_8238, - otp_8473, otp_8522, otp_8567, otp_8664, otp_9147, otp_10302]}]. + otp_8473, otp_8522, otp_8567, otp_8664, otp_9147, + otp_10302, otp_10820]}]. init_per_suite(Config) -> Config. @@ -1074,6 +1075,34 @@ otp_10302(Config) when is_list(Config) -> unicode_hook({foo,E}, I, P, H) -> erl_pp:expr({call,0,{atom,0,foo},[E]}, I, P, H). +otp_10820(doc) -> + "OTP-10820. Unicode filenames."; +otp_10820(suite) -> []; +otp_10820(Config) when is_list(Config) -> + C1 = <<"%% coding: utf-8\n -module(any).">>, + ok = do_otp_10820(Config, C1, "+pc latin1"), + ok = do_otp_10820(Config, C1, "+pc unicode"), + C2 = <<"-module(any).">>, + ok = do_otp_10820(Config, C2, "+pc latin1"), + ok = do_otp_10820(Config, C2, "+pc unicode"). + +do_otp_10820(Config, C, PC) -> + {ok,Node} = start_node(erl_pp_helper, "+fnu " ++ PC), + L = [915,953,959,973,957,953,954,959,957,964], + FileName = filename(L++".erl", Config), + ok = rpc:call(Node, file, write_file, [FileName, C]), + {ok, _, []} = rpc:call(Node, compile, file, + [FileName, [return,'P',{outdir,?privdir}]]), + PFileName = filename(L++".P", Config), + {ok, Bin} = rpc:call(Node, file, read_file, [PFileName]), + true = test_server:stop_node(Node), + true = file_attr_is_string(binary_to_list(Bin)), + ok. + +file_attr_is_string("-file(\"" ++ _) -> true; +file_attr_is_string([_ | L]) -> + file_attr_is_string(L). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% compile(Config, Tests) -> @@ -1247,3 +1276,8 @@ filename(Name, Config) -> fail() -> io:format("failed~n"), ?t:fail(). + +%% +fnu means a peer node has to be started; slave will not do +start_node(Name, Xargs) -> + ?line PA = filename:dirname(code:which(?MODULE)), + test_server:start_node(Name, peer, [{args, "-pa " ++ PA ++ " " ++ Xargs}]). diff --git a/lib/stdlib/test/escript_SUITE.erl b/lib/stdlib/test/escript_SUITE.erl index be8fb1b37a..cf5fb12686 100644 --- a/lib/stdlib/test/escript_SUITE.erl +++ b/lib/stdlib/test/escript_SUITE.erl @@ -913,7 +913,7 @@ unicode(Config) when is_list(Config) -> run(Dir, "unicode1", [<<"escript: exception error: an error occurred when evaluating" " an arithmetic expression\n in operator '/'/2\n " - "called as <<170>> / <<170>>\nExitCode:127">>]), + "called as <<224,170,170>> / <<224,170,170>>\nExitCode:127">>]), run(Dir, "unicode2", [<<"escript: exception error: an error occurred when evaluating" " an arithmetic expression\n in operator '/'/2\n " diff --git a/lib/stdlib/test/escript_SUITE_data/unicode1 b/lib/stdlib/test/escript_SUITE_data/unicode1 index a77574625e..351bb785e5 100755 --- a/lib/stdlib/test/escript_SUITE_data/unicode1 +++ b/lib/stdlib/test/escript_SUITE_data/unicode1 @@ -6,7 +6,7 @@ main(_) -> ok = io:setopts([{encoding,unicode}]), _D = erlang:system_flag(backtrace_depth, 0), - A = <<"\x{aa}">>, + A = <<"\x{aaa}"/utf8>>, S = lists:flatten(io_lib:format("~p/~p.", [A, A])), {ok, Ts, _} = erl_scan:string(S, 1, [unicode]), {ok, Es} = erl_parse:parse_exprs(Ts), diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index dc17e5d33c..4a51ef564c 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -96,7 +96,7 @@ misc1_do/1, safe_fixtable_do/1, info_do/1, dups_do/1, heavy_lookup_do/1, heavy_lookup_element_do/1, member_do/1, otp_5340_do/1, otp_7665_do/1, meta_wb_do/1, do_heavy_concurrent/1, tab2file2_do/2, exit_large_table_owner_do/2, - types_do/1, sleeper/0, rpc_externals/0, memory_do/1, + types_do/1, sleeper/0, memory_do/1, ms_tracee_dummy/1, ms_tracee_dummy/2, ms_tracee_dummy/3, ms_tracee_dummy/4 ]). @@ -5989,33 +5989,103 @@ make_ext_ref() -> init_externals() -> case get(externals) of undefined -> - SysDistSz = ets:info(sys_dist,size), - ?line Pa = filename:dirname(code:which(?MODULE)), - ?line {ok, Node} = test_server:start_node(plopp, slave, [{args, " -pa " ++ Pa}]), - ?line Res = case rpc:call(Node, ?MODULE, rpc_externals, []) of - {badrpc, {'EXIT', E}} -> - test_server:fail({rpcresult, E}); - R -> R - end, - ?line test_server:stop_node(Node), - - %% Wait for table 'sys_dist' to stabilize - repeat_while(fun() -> - case ets:info(sys_dist,size) of - SysDistSz -> false; - Sz -> - io:format("Waiting for sys_dist to revert size from ~p to size ~p\n", - [Sz, SysDistSz]), - receive after 1000 -> true end - end - end), + OtherNode = {gurka@sallad, 1}, + Res = {mk_pid(OtherNode, 7645, 8123), + mk_port(OtherNode, 187489773), + mk_ref(OtherNode, [262143, 1293964255, 3291964278])}, put(externals, Res); {_,_,_} -> ok end. -rpc_externals() -> - {self(), make_port(), make_ref()}. +%% +%% Node container constructor functions +%% + +-define(VERSION_MAGIC, 131). +-define(PORT_EXT, 102). +-define(PID_EXT, 103). +-define(NEW_REFERENCE_EXT, 114). + +uint32_be(Uint) when is_integer(Uint), 0 =< Uint, Uint < 1 bsl 32 -> + [(Uint bsr 24) band 16#ff, + (Uint bsr 16) band 16#ff, + (Uint bsr 8) band 16#ff, + Uint band 16#ff]; +uint32_be(Uint) -> + exit({badarg, uint32_be, [Uint]}). + +uint16_be(Uint) when is_integer(Uint), 0 =< Uint, Uint < 1 bsl 16 -> + [(Uint bsr 8) band 16#ff, + Uint band 16#ff]; +uint16_be(Uint) -> + exit({badarg, uint16_be, [Uint]}). + +uint8(Uint) when is_integer(Uint), 0 =< Uint, Uint < 1 bsl 8 -> + Uint band 16#ff; +uint8(Uint) -> + exit({badarg, uint8, [Uint]}). + +mk_pid({NodeName, Creation}, Number, Serial) when is_atom(NodeName) -> + <<?VERSION_MAGIC, NodeNameExt/binary>> = term_to_binary(NodeName), + mk_pid({NodeNameExt, Creation}, Number, Serial); +mk_pid({NodeNameExt, Creation}, Number, Serial) -> + case catch binary_to_term(list_to_binary([?VERSION_MAGIC, + ?PID_EXT, + NodeNameExt, + uint32_be(Number), + uint32_be(Serial), + uint8(Creation)])) of + Pid when is_pid(Pid) -> + Pid; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_pid, [{NodeNameExt, Creation}, Number, Serial]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) + end. + +mk_port({NodeName, Creation}, Number) when is_atom(NodeName) -> + <<?VERSION_MAGIC, NodeNameExt/binary>> = term_to_binary(NodeName), + mk_port({NodeNameExt, Creation}, Number); +mk_port({NodeNameExt, Creation}, Number) -> + case catch binary_to_term(list_to_binary([?VERSION_MAGIC, + ?PORT_EXT, + NodeNameExt, + uint32_be(Number), + uint8(Creation)])) of + Port when is_port(Port) -> + Port; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_port, [{NodeNameExt, Creation}, Number]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) + end. + +mk_ref({NodeName, Creation}, Numbers) when is_atom(NodeName), + is_integer(Creation), + is_list(Numbers) -> + <<?VERSION_MAGIC, NodeNameExt/binary>> = term_to_binary(NodeName), + mk_ref({NodeNameExt, Creation}, Numbers); +mk_ref({NodeNameExt, Creation}, Numbers) when is_binary(NodeNameExt), + is_integer(Creation), + is_list(Numbers) -> + case catch binary_to_term(list_to_binary([?VERSION_MAGIC, + ?NEW_REFERENCE_EXT, + uint16_be(length(Numbers)), + NodeNameExt, + uint8(Creation), + lists:map(fun (N) -> + uint32_be(N) + end, + Numbers)])) of + Ref when is_reference(Ref) -> + Ref; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_ref, [{NodeNameExt, Creation}, Numbers]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) + end. + make_sub_binary(Bin) when is_binary(Bin) -> {_,B} = split_binary(list_to_binary([0,1,3,Bin]), 3), diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl index 65a112c966..9f828c6d2d 100644 --- a/lib/stdlib/test/io_SUITE.erl +++ b/lib/stdlib/test/io_SUITE.erl @@ -29,7 +29,11 @@ manpage/1, otp_6708/1, otp_7084/1, otp_7421/1, io_lib_collect_line_3_wb/1, cr_whitespace_in_string/1, io_fread_newlines/1, otp_8989/1, io_lib_fread_literal/1, - io_lib_print_binary_depth_one/1, otp_10302/1, otp_10836/1]). + printable_range/1, + io_lib_print_binary_depth_one/1, otp_10302/1, otp_10755/1, + otp_10836/1]). + +-export([pretty/2]). %-define(debug, true). @@ -65,7 +69,8 @@ all() -> manpage, otp_6708, otp_7084, otp_7421, io_lib_collect_line_3_wb, cr_whitespace_in_string, io_fread_newlines, otp_8989, io_lib_fread_literal, - io_lib_print_binary_depth_one, otp_10302, otp_10836]. + printable_range, + io_lib_print_binary_depth_one, otp_10302, otp_10755, otp_10836]. groups() -> []. @@ -2025,6 +2030,79 @@ io_lib_fread_literal(Suite) when is_list(Suite) -> ?line {done,{ok,[]},[]} = io_lib:fread(C2, "d\n", " d"), ok. + +printable_range(doc) -> + "Check that the printable range set by the user actually works"; +printable_range(Suite) when is_list(Suite) -> + Pa = filename:dirname(code:which(?MODULE)), + {ok, UNode} = test_server:start_node(printable_range_unicode, slave, + [{args, " +pc unicode -pa " ++ Pa}]), + {ok, LNode} = test_server:start_node(printable_range_latin1, slave, + [{args, " +pc latin1 -pa " ++ Pa}]), + {ok, DNode} = test_server:start_node(printable_range_default, slave, + [{args, " -pa " ++ Pa}]), + unicode = rpc:call(UNode,io,printable_range,[]), + latin1 = rpc:call(LNode,io,printable_range,[]), + latin1 = rpc:call(DNode,io,printable_range,[]), + test_server:stop_node(UNode), + test_server:stop_node(LNode), + {ok, UNode} = test_server:start_node(printable_range_unicode, slave, + [{args, " +pcunicode -pa " ++ Pa}]), + {ok, LNode} = test_server:start_node(printable_range_latin1, slave, + [{args, " +pclatin1 -pa " ++ Pa}]), + unicode = rpc:call(UNode,io,printable_range,[]), + latin1 = rpc:call(LNode,io,printable_range,[]), + {error, _} = test_server:start_node(printable_range_unnicode, slave, + [{args, " +pcunnicode -pa " ++ Pa}]), + PrettyOptions = [{column,1}, + {line_length,109}, + {depth,30}, + {max_chars,60}, + {record_print_fun, + fun(_,_) -> no end}, + {encoding,unicode}], + 1025 = lists:max(lists:flatten(rpc:call(UNode,io_lib_pretty,print, + [{hello, [1024,1025]}, + PrettyOptions]))), + 125 = lists:max(lists:flatten(rpc:call(LNode,io_lib_pretty,print, + [{hello, [1024,1025]}, + PrettyOptions]))), + 125 = lists:max(lists:flatten(rpc:call(DNode,io_lib_pretty,print, + [{hello, [1024,1025]}, + PrettyOptions]))), + 1025 = lists:max(lists:flatten(rpc:call(UNode,io_lib_pretty,print, + [{hello, <<1024/utf8,1025/utf8>>}, + PrettyOptions]))), + 125 = lists:max(lists:flatten(rpc:call(LNode,io_lib_pretty,print, + [{hello, <<1024/utf8,1025/utf8>>}, + PrettyOptions]))), + 125 = lists:max(lists:flatten(rpc:call(DNode,io_lib_pretty,print, + [{hello, <<1024/utf8,1025/utf8>>}, + PrettyOptions]))), + + 1025 = lists:max(lists:flatten(rpc:call(UNode,io_lib,format, + ["~tp",[{hello, [1024,1025]}]]))), + 125 = lists:max(lists:flatten(rpc:call(LNode,io_lib,format, + ["~tp",[{hello, [1024,1025]}]]))), + 125 = lists:max(lists:flatten(rpc:call(DNode,io_lib,format, + ["~tp",[{hello, [1024,1025]}]]))), + 1025 = lists:max(lists:flatten(rpc:call(UNode,io_lib,format, + ["~tp", + [{hello, + <<1024/utf8,1025/utf8>>}]]))), + 125 = lists:max(lists:flatten(rpc:call(LNode,io_lib,format, + ["~tp", + [{hello, + <<1024/utf8,1025/utf8>>}]]))), + 125 = lists:max(lists:flatten(rpc:call(DNode,io_lib,format, + ["~tp", + [{hello, + <<1024/utf8,1025/utf8>>}]]))), + test_server:stop_node(UNode), + test_server:stop_node(LNode), + test_server:stop_node(DNode), + ok. + io_lib_print_binary_depth_one(doc) -> "Test binaries printed with a depth of one behave correctly"; io_lib_print_binary_depth_one(Suite) when is_list(Suite) -> @@ -2039,16 +2117,30 @@ io_lib_print_binary_depth_one(Suite) when is_list(Suite) -> otp_10302(doc) -> "OTP-10302. Unicode"; otp_10302(Suite) when is_list(Suite) -> - "\"\x{400}\"" = pretty("\x{400}", -1), - "<<\"\x{400}\"/utf8>>" = pretty(<<"\x{400}"/utf8>>, -1), + Pa = filename:dirname(code:which(?MODULE)), + {ok, UNode} = test_server:start_node(printable_range_unicode, slave, + [{args, " +pc unicode -pa " ++ Pa}]), + {ok, LNode} = test_server:start_node(printable_range_latin1, slave, + [{args, " +pc latin1 -pa " ++ Pa}]), + "\"\x{400}\"" = rpc:call(UNode,?MODULE,pretty,["\x{400}", -1]), + "<<\"\x{400}\"/utf8>>" = rpc:call(UNode,?MODULE,pretty, + [<<"\x{400}"/utf8>>, -1]), + + "<<\"\x{400}foo\"/utf8>>" = rpc:call(UNode,?MODULE,pretty, + [<<"\x{400}foo"/utf8>>, 2]), + "[1024]" = rpc:call(LNode,?MODULE,pretty,["\x{400}", -1]), + "<<208,128>>" = rpc:call(LNode,?MODULE,pretty,[<<"\x{400}"/utf8>>, -1]), + + "<<208,...>>" = rpc:call(LNode,?MODULE,pretty,[<<"\x{400}foo"/utf8>>, 2]), + test_server:stop_node(UNode), + test_server:stop_node(LNode), - "<<\"\x{400}foo\"/utf8>>" = pretty(<<"\x{400}foo"/utf8>>, 2), "<<\"äppl\"/utf8>>" = pretty(<<"äppl"/utf8>>, 2), "<<\"äppl\"/utf8...>>" = pretty(<<"äpple"/utf8>>, 2), "<<\"apel\">>" = pretty(<<"apel">>, 2), "<<\"apel\"...>>" = pretty(<<"apelsin">>, 2), - "<<228,112,112,108>>" = fmt("~tp", [<<"äppl">>]), - "<<228,...>>" = fmt("~tP", [<<"äppl">>, 2]), + "<<\"äppl\">>" = fmt("~tp", [<<"äppl">>]), + "<<\"äppl\"...>>" = fmt("~tP", [<<"äpple">>, 2]), "<<0,0,0,0,0,0,1,0>>" = fmt("~p", [<<256:64/unsigned-integer>>]), "<<0,0,0,0,0,0,1,0>>" = fmt("~tp", [<<256:64/unsigned-integer>>]), @@ -2085,3 +2177,40 @@ otp_10836(Suite) when is_list(Suite) -> S = io_lib:format("~ts", [[<<"äpple"/utf8>>, <<"äpple">>]]), "äppleäpple" = lists:flatten(S), ok. + +otp_10755(doc) -> + "OTP-10755. The 'l' modifier"; +otp_10755(Suite) when is_list(Suite) -> + S = "string", + "\"string\"" = fmt("~p", [S]), + "[115,116,114,105,110,103]" = fmt("~lp", [S]), + "\"string\"" = fmt("~P", [S, 2]), + "[115|...]" = fmt("~lP", [S, 2]), + {'EXIT',{badarg,_}} = (catch fmt("~ltp", [S])), + {'EXIT',{badarg,_}} = (catch fmt("~tlp", [S])), + {'EXIT',{badarg,_}} = (catch fmt("~ltP", [S])), + {'EXIT',{badarg,_}} = (catch fmt("~tlP", [S])), + Text = + "-module(l_mod).\n" + "-export([t/0]).\n" + "t() ->\n" + " S = \"string\",\n" + " io:format(\"~ltp\", [S]),\n" + " io:format(\"~tlp\", [S]),\n" + " io:format(\"~ltP\", [S, 1]),\n" + " io:format(\"~tlP\", [S, 1]).\n", + {ok,l_mod,[{_File,Ws}]} = compile_file("l_mod.erl", Text, Suite), + ["format string invalid (invalid control ~lt)", + "format string invalid (invalid control ~tl)", + "format string invalid (invalid control ~lt)", + "format string invalid (invalid control ~tl)"] = + [lists:flatten(M:format_error(E)) || {_L,M,E} <- Ws], + ok. + +compile_file(File, Text, Config) -> + PrivDir = ?privdir(Config), + Fname = filename:join(PrivDir, File), + ok = file:write_file(Fname, Text), + try compile:file(Fname, [return]) + after ok %file:delete(Fname) + end. diff --git a/lib/stdlib/test/io_proto_SUITE.erl b/lib/stdlib/test/io_proto_SUITE.erl index 299daf0e42..ddcc8dfdab 100644 --- a/lib/stdlib/test/io_proto_SUITE.erl +++ b/lib/stdlib/test/io_proto_SUITE.erl @@ -716,7 +716,7 @@ binary_options(Config) when is_list(Config) -> {getline, "<<\"hej\\n\">>"}, {putline, "io:get_line('')."}, {putline, binary_to_list(<<"\345\344\366"/utf8>>)}, - {getline, "<<\""++binary_to_list(unicode:characters_to_binary(<<"\345\344\366"/utf8>>,latin1,utf8))++"\\n\">>"} + {getline, "<<\""++binary_to_list(<<"\345\344\366"/utf8>>)++"\\n\"/utf8>>"} ],[]) end, %% And one with oldshell @@ -1784,8 +1784,8 @@ get_default_shell() -> {putline, "whereis(user_drv)."}, {getline, "undefined"}],[]), old - catch E:R -> - ?dbg({E,R}), + catch _E:_R -> + ?dbg({_E,_R}), new end. diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index f22df96697..990b1f5eb2 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2012. All Rights Reserved. +%% Copyright Ericsson AB 2004-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -2742,6 +2742,9 @@ otp_10302(doc) -> "OTP-10302. Unicode."; otp_10302(suite) -> []; otp_10302(Config) when is_list(Config) -> + {ok,Node} = start_node(shell_suite_helper_2, + "-pa "++?config(priv_dir,Config)++ + " +pc unicode"), Test1 = <<"begin io:setopts([{encoding,utf8}]), @@ -2749,13 +2752,13 @@ otp_10302(Config) when is_list(Config) -> rd(rec, {a = \"\\x{400}\"}), ok = rl(rec) end.">>, - "-record(rec,{a = \"\x{400}\"}).\nok.\n" = t(Test1), + "-record(rec,{a = \"\x{400}\"}).\nok.\n" = t({Node,Test1}), Test3 = <<"io:setopts([{encoding,utf8}]). rd(rec, {a = \"\\x{400}\"}). ok = rp(#rec{}).">>, - "ok.\nrec\n#rec{a = \"\x{400}\"}.\nok.\n" = t(Test3), + "ok.\nrec\n#rec{a = \"\x{400}\"}.\nok.\n" = t({Node,Test3}), Test4 = <<"io:setopts([{encoding,utf8}]). @@ -2766,7 +2769,7 @@ otp_10302(Config) when is_list(Config) -> "ok.\n\"\x{400}\"\nA = \"\x{400}\".\nok.\n" "1: io:setopts([{encoding,utf8}])\n-> ok.\n" "2: A = [1024] = \"\x{400}\"\n-> \"\x{400}\"\n" - "3: b()\n-> ok.\nok.\n" = t(Test4), + "3: b()\n-> ok.\nok.\n" = t({Node,Test4}), Test5 = <<"begin @@ -2776,18 +2779,20 @@ otp_10302(Config) when is_list(Config) -> b(), h() end.">>, - "A = \"\x{400}\".\nok.\n" = t(Test5), + "A = \"\x{400}\".\nok.\n" = t({Node,Test5}), %% One $" is "lost": true = "\x{400}\": command not found" =:= - prompt_err({<<"io:setopts([{encoding,utf8}]). v(\"\x{400}\")."/utf8>>, + prompt_err({Node, + <<"io:setopts([{encoding,utf8}]). v(\"\x{400}\")."/utf8>>, unicode}), "ok.\ndefault\n* Bad prompt function: \"\x{400}\".\n" = - t({<<"io:setopts([{encoding,utf8}]). " + t({Node,<<"io:setopts([{encoding,utf8}]). " "shell:prompt_func(\"\x{400}\")."/utf8>>, unicode}), + rpc:call(Node,shell, prompt_func, [default]), _ = shell:prompt_func(default), %% Test lib:format_exception() (cf. OTP-6554) @@ -2812,10 +2817,10 @@ otp_10302(Config) when is_list(Config) -> {ok, Es} = erl_parse:parse_exprs(Ts), B = erl_eval:new_bindings(), erl_eval:exprs(Es, B).">>, - + "ok.\n** exception error: an error occurred when evaluating" " an arithmetic expression\n in operator '/'/2\n" - " called as <<170>> / <<170>>.\n" = t(Test7), + " called as <<\"�\">> / <<\"�\">>.\n" = t({Node,Test7}), Test8 = <<"begin A = [1089], @@ -2839,7 +2844,7 @@ otp_10302(Config) when is_list(Config) -> "ok.\n** exception error: an error occurred when evaluating" " an arithmetic expression\n in operator '/'/2\n" - " called as \"\x{441}\" / \"\x{441}\".\n" = t(Test9), + " called as \"\x{441}\" / \"\x{441}\".\n" = t({Node,Test9}), Test10 = <<"A = {\"1\\xaa\", $\\xaa, @@ -2861,7 +2866,7 @@ otp_10302(Config) when is_list(Config) -> "ok.\n** exception error: no function clause matching \n" " erl_eval:'-inside-an-interpreted-fun-'" "({\"1\xaa\",170,<<\"hi\">>,\n " - " <<\"1\xaa\"/utf8>>}) .\n" = t(Test11), + " <<\"1\xaa\"/utf8>>}) .\n" = t({Node,Test11}), Test12 = <<"fun(a, b) -> false end(65, [1089]).">>, "** exception error: no function clause matching \n" " erl_eval:'-inside-an-interpreted-fun-'(65,[1089])" @@ -2871,8 +2876,9 @@ otp_10302(Config) when is_list(Config) -> fun(a, b) -> false end(65, [1089]).">>, "ok.\n** exception error: no function clause matching \n" " erl_eval:'-inside-an-interpreted-fun-'(65,\"\x{441}\")" - " .\n" = t(Test13), + " .\n" = t({Node,Test13}), + test_server:stop_node(Node), ok. scan(B) -> @@ -2895,6 +2901,8 @@ scan(S0, F) -> [] end. +t({Node,Bin,Enc}) when is_atom(Node),is_binary(Bin), is_atom(Enc) -> + t0({Bin,Enc}, fun() -> start_new_shell(Node) end); t({Node,Bin}) when is_atom(Node),is_binary(Bin) -> t0({Bin,latin1}, fun() -> start_new_shell(Node) end); t(Bin) when is_binary(Bin) -> diff --git a/lib/syntax_tools/src/erl_comment_scan.erl b/lib/syntax_tools/src/erl_comment_scan.erl index a70e7ba413..dae7530ce7 100644 --- a/lib/syntax_tools/src/erl_comment_scan.erl +++ b/lib/syntax_tools/src/erl_comment_scan.erl @@ -282,7 +282,7 @@ join_lines([], Txt, L, Col, Ind) -> %% ===================================================================== %% Utility functions for internal use -filename([C|T]) when is_integer(C), C > 0, C =< 255 -> +filename([C|T]) when is_integer(C), C > 0 -> [C | filename(T)]; filename([]) -> []; @@ -291,7 +291,7 @@ filename(N) -> exit(error). error_read_file(Name) -> - report_error("error reading file `~s'.", [Name]). + report_error("error reading file `~ts'.", [Name]). report_error(S, Vs) -> error_logger:error_msg(lists:concat([?MODULE, ": ", S, "\n"]), Vs). diff --git a/lib/syntax_tools/src/erl_tidy.erl b/lib/syntax_tools/src/erl_tidy.erl index e9a88caff3..0c149634f6 100644 --- a/lib/syntax_tools/src/erl_tidy.erl +++ b/lib/syntax_tools/src/erl_tidy.erl @@ -151,7 +151,7 @@ dir_1(Dir, Regexp, Env) -> lists:foreach(fun (X) -> dir_2(X, Regexp, Dir, Env) end, Files); {error, _} -> - report_error("error reading directory `~s'", + report_error("error reading directory `~ts'", [filename(Dir)]), exit(error) end. @@ -180,7 +180,7 @@ dir_2(Name, Regexp, Dir, Env) -> dir_3(Name, Dir, Regexp, Env) -> Dir1 = filename:join(Dir, Name), - verbose("tidying directory `~s'.", [Dir1], Env#dir.options), + verbose("tidying directory `~ts'.", [Dir1], Env#dir.options), dir_1(Dir1, Regexp, Env). dir_4(File, Regexp, Env) -> @@ -189,7 +189,7 @@ dir_4(File, Regexp, Env) -> Opts = [{outfile, File}, {dir, ""} | Env#dir.options], case catch file(File, Opts) of {'EXIT', Value} -> - warn("error tidying `~s'.~n~p", [File,Value], Opts); + warn("error tidying `~ts'.~n~p", [File,Value], Opts); _ -> ok end; @@ -314,7 +314,7 @@ file_2(Name, Opts) -> end. read_module(Name, Opts) -> - verbose("reading module `~s'.", [filename(Name)], Opts), + verbose("reading module `~ts'.", [filename(Name)], Opts), case epp_dodger:parse_file(Name, [no_fail]) of {ok, Forms} -> check_forms(Forms, Name), @@ -335,7 +335,7 @@ check_forms(Fs, Name) -> "unknown error" end, report_error({Name, erl_syntax:get_pos(F), - "\n ~s"}, [S]), + "\n ~ts"}, [S]), exit(error); _ -> ok @@ -357,18 +357,18 @@ write_module(Tree, Name, Opts) -> {value, directory} -> ok; {value, _} -> - report_error("`~s' is not a directory.", + report_error("`~ts' is not a directory.", [filename(Dir)]), exit(error); none -> case file:make_dir(Dir) of ok -> - verbose("created directory `~s'.", + verbose("created directory `~ts'.", [filename(Dir)], Opts), ok; E -> report_error("failed to create " - "directory `~s'.", + "directory `~ts'.", [filename(Dir)]), exit({make_dir, E}) end @@ -385,7 +385,7 @@ write_module(Tree, Name, Opts) -> end, Printer = proplists:get_value(printer, Opts), FD = open_output_file(File, Encoding), - verbose("writing to file `~s'.", [File], Opts), + verbose("writing to file `~ts'.", [File], Opts), V = (catch {ok, output(FD, Printer, Tree, Opts++Encoding)}), ok = file:close(FD), case V of @@ -435,7 +435,6 @@ file_type(Name, Links) -> end. open_output_file(FName, Options) -> -io:format("Options ~p~n", [Options]), case catch file:open(FName, [write]++Options) of {ok, FD} -> FD; @@ -472,7 +471,7 @@ backup_file_1(Name, Opts) -> filename:basename(Name) ++ Suffix), case catch file:rename(Name, Dest) of ok -> - verbose("made backup of file `~s'.", [Name], Opts); + verbose("made backup of file `~ts'.", [Name], Opts); {error, R} -> error_backup_file(Name), exit({error, R}); @@ -1805,7 +1804,7 @@ get_free_vars_1([{free, B} | _Bs]) -> B; get_free_vars_1([_ | Bs]) -> get_free_vars_1(Bs); get_free_vars_1([]) -> []. -filename([C | T]) when is_integer(C), C > 0, C =< 255 -> +filename([C | T]) when is_integer(C), C > 0 -> [C | filename(T)]; filename([H|T]) -> filename(H) ++ filename(T); @@ -1840,17 +1839,17 @@ report_export_vars(F, L, Type, Opts) -> [Type], Opts). error_read_file(Name) -> - report_error("error reading file `~s'.", [filename(Name)]). + report_error("error reading file `~ts'.", [filename(Name)]). error_write_file(Name) -> - report_error("error writing to file `~s'.", [filename(Name)]). + report_error("error writing to file `~ts'.", [filename(Name)]). error_backup_file(Name) -> - report_error("could not create backup of file `~s'.", + report_error("could not create backup of file `~ts'.", [filename(Name)]). error_open_output(Name) -> - report_error("cannot open file `~s' for output.", [filename(Name)]). + report_error("cannot open file `~ts' for output.", [filename(Name)]). verbosity(Opts) -> case proplists:get_bool(quiet, Opts) of @@ -1909,9 +1908,9 @@ format({"", L, D}, Vs) when is_integer(L), L > 0 -> format({"", _L, D}, Vs) -> format(D, Vs); format({F, L, D}, Vs) when is_integer(L), L > 0 -> - [io_lib:fwrite("~s:~w: ", [filename(F), L]), format(D, Vs)]; + [io_lib:fwrite("~ts:~w: ", [filename(F), L]), format(D, Vs)]; format({F, _L, D}, Vs) -> - [io_lib:fwrite("~s: ", [filename(F)]), format(D, Vs)]; + [io_lib:fwrite("~ts: ", [filename(F)]), format(D, Vs)]; format(S, Vs) when is_list(S) -> [io_lib:fwrite(S, Vs), $\n]. diff --git a/lib/syntax_tools/src/igor.erl b/lib/syntax_tools/src/igor.erl index 8abc3f41cb..d385c2b690 100644 --- a/lib/syntax_tools/src/igor.erl +++ b/lib/syntax_tools/src/igor.erl @@ -2749,7 +2749,7 @@ read_module(Name, Options) -> end. read_module_1(Name, Options) -> - verbose("reading module `~s'.", [filename(Name)], Options), + verbose("reading module `~ts'.", [filename(Name)], Options), {Forms, Enc} = read_module_2(Name, Options), case proplists:get_bool(comments, Options) of false -> @@ -2794,7 +2794,7 @@ check_forms([F | Fs], File) -> _ -> "unknown error" end, - report_error("in file `~s' at line ~w:\n ~ts", + report_error("in file `~ts' at line ~w:\n ~ts", [filename(File), erl_syntax:get_pos(F), S]), exit(error); _ -> @@ -2841,18 +2841,18 @@ write_module(Tree, Name, Dir, Opts) -> {value, directory} -> ok; {value, _} -> - report_error("`~s' is not a directory.", + report_error("`~ts' is not a directory.", [Dir1]), exit(error); none -> case file:make_dir(Dir1) of ok -> - verbose("created directory `~s'.", + verbose("created directory `~ts'.", [Dir1], Opts), ok; E -> report_error("failed to create " - "directory `~s'.", + "directory `~ts'.", [Dir1]), exit({make_dir, E}) end @@ -2870,7 +2870,7 @@ write_module(Tree, Name, Dir, Opts) -> Printer = proplists:get_value(printer, Opts), FD = open_output_file(File), ok = output_encoding(FD, Opts), - verbose("writing to file `~s'.", [File], Opts), + verbose("writing to file `~ts'.", [File], Opts), V = (catch {ok, output(FD, Printer, Tree, Opts)}), ok = file:close(FD), case V of @@ -2911,7 +2911,7 @@ backup_file_1(Name, Opts) -> filename:basename(Name1) ++ Suffix), case catch file:rename(Name1, Dest) of ok -> - verbose("made backup of file `~s'.", [Name1], Opts); + verbose("made backup of file `~ts'.", [Name1], Opts); {error, R} -> error_backup_file(Name1), exit({error, R}); @@ -2956,7 +2956,7 @@ timestamp() -> "~2.2.0w:~2.2.0w:~2.2.0w.", [Yr, Mth, Dy, Hr, Mt, Sc])). -filename([C | T]) when is_integer(C), C > 0, C =< 255 -> +filename([C | T]) when is_integer(C), C > 0 -> [C | filename(T)]; filename([H|T]) -> filename(H) ++ filename(T); @@ -3036,19 +3036,19 @@ warning_apply_2(Module, Target) -> "possibly unsafe in `~s'.", [Module, Target]). error_open_output(Name) -> - report_error("cannot open file `~s' for output.", [filename(Name)]). + report_error("cannot open file `~ts' for output.", [filename(Name)]). error_read_file(Name) -> - report_error("error reading file `~s'.", [filename(Name)]). + report_error("error reading file `~ts'.", [filename(Name)]). error_read_file_info(Name) -> - report_error("error getting file info: `~s'.", [filename(Name)]). + report_error("error getting file info: `~ts'.", [filename(Name)]). error_write_file(Name) -> - report_error("error writing to file `~s'.", [filename(Name)]). + report_error("error writing to file `~ts'.", [filename(Name)]). error_backup_file(Name) -> - report_error("could not create backup of file `~s'.", + report_error("could not create backup of file `~ts'.", [filename(Name)]). verbose(S, Opts) -> diff --git a/lib/test_server/src/config.guess b/lib/test_server/src/config.guess index 38a833903b..f475ceb413 100755 --- a/lib/test_server/src/config.guess +++ b/lib/test_server/src/config.guess @@ -1,14 +1,12 @@ #! /bin/sh # Attempt to guess a canonical system name. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, -# Inc. +# Copyright 1992-2013 Free Software Foundation, Inc. -timestamp='2007-05-17' +timestamp='2013-02-12' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or +# the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, but @@ -17,26 +15,22 @@ timestamp='2007-05-17' # General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. +# along with this program; if not, see <http://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - - -# Originally written by Per Bothner <[email protected]>. -# Please send patches to <[email protected]>. Submit a context -# diff and a properly formatted ChangeLog entry. +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). +# +# Originally written by Per Bothner. # -# This script attempts to guess a canonical system name similar to -# config.sub. If it succeeds, it prints the system name on stdout, and -# exits with 0. Otherwise, it exits with 1. +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD # -# The plan is that this can be called by configure scripts if you -# don't specify an explicit build system type. +# Please send patches with a ChangeLog entry to [email protected]. + me=`echo "$0" | sed -e 's,.*/,,'` @@ -56,8 +50,7 @@ version="\ GNU config.guess ($timestamp) Originally written by Per Bothner. -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 -Free Software Foundation, Inc. +Copyright 1992-2013 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -144,7 +137,7 @@ UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in *:NetBSD:*:*) # NetBSD (nbsd) targets should (where applicable) match one or - # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*, + # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*, # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently # switched to ELF, *-*-netbsd* would select the old # object file format. This provides both forward @@ -170,7 +163,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in arm*|i386|m68k|ns32k|sh3*|sparc|vax) eval $set_cc_for_build if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep __ELF__ >/dev/null + | grep -q __ELF__ then # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). # Return netbsd for either. FIX? @@ -180,7 +173,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in fi ;; *) - os=netbsd + os=netbsd ;; esac # The OS release @@ -201,6 +194,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. echo "${machine}-${os}${release}" exit ;; + *:Bitrig:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'` + echo ${UNAME_MACHINE_ARCH}-unknown-bitrig${UNAME_RELEASE} + exit ;; *:OpenBSD:*:*) UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} @@ -223,7 +220,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` ;; *5.*) - UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` ;; esac # According to Compaq, /usr/sbin/psrinfo has been available on @@ -269,7 +266,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # A Xn.n version is an unreleased experimental baselevel. # 1.2 uses "1.2" for uname -r. echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - exit ;; + # Reset EXIT trap before exiting to avoid spurious non-zero exit code. + exitcode=$? + trap '' 0 + exit $exitcode ;; Alpha\ *:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # Should we change UNAME_MACHINE based on the output of uname instead @@ -295,12 +295,12 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in echo s390-ibm-zvmoe exit ;; *:OS400:*:*) - echo powerpc-ibm-os400 + echo powerpc-ibm-os400 exit ;; arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) echo arm-acorn-riscix${UNAME_RELEASE} exit ;; - arm:riscos:*:*|arm:RISCOS:*:*) + arm*:riscos:*:*|arm*:RISCOS:*:*) echo arm-unknown-riscos exit ;; SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) @@ -324,14 +324,33 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in case `/usr/bin/uname -p` in sparc) echo sparc-icl-nx7; exit ;; esac ;; + s390x:SunOS:*:*) + echo ${UNAME_MACHINE}-ibm-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; sun4H:SunOS:5.*:*) echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; - i86pc:SunOS:5.*:* | ix86xen:SunOS:5.*:*) - echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) + echo i386-pc-auroraux${UNAME_RELEASE} + exit ;; + i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) + eval $set_cc_for_build + SUN_ARCH="i386" + # If there is a compiler, see if it is configured for 64-bit objects. + # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. + # This test works for both compilers. + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + SUN_ARCH="x86_64" + fi + fi + echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:6*:*) # According to config.sub, this is the proper way to canonicalize @@ -375,23 +394,23 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # MiNT. But MiNT is downward compatible to TOS, so this should # be no problem. atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} + echo m68k-atari-mint${UNAME_RELEASE} exit ;; atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) echo m68k-atari-mint${UNAME_RELEASE} - exit ;; + exit ;; *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} + echo m68k-atari-mint${UNAME_RELEASE} exit ;; milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) - echo m68k-milan-mint${UNAME_RELEASE} - exit ;; + echo m68k-milan-mint${UNAME_RELEASE} + exit ;; hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) - echo m68k-hades-mint${UNAME_RELEASE} - exit ;; + echo m68k-hades-mint${UNAME_RELEASE} + exit ;; *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) - echo m68k-unknown-mint${UNAME_RELEASE} - exit ;; + echo m68k-unknown-mint${UNAME_RELEASE} + exit ;; m68k:machten:*:*) echo m68k-apple-machten${UNAME_RELEASE} exit ;; @@ -461,8 +480,8 @@ EOF echo m88k-motorola-sysv3 exit ;; AViiON:dgux:*:*) - # DG/UX returns AViiON for all architectures - UNAME_PROCESSOR=`/usr/bin/uname -p` + # DG/UX returns AViiON for all architectures + UNAME_PROCESSOR=`/usr/bin/uname -p` if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] then if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ @@ -475,7 +494,7 @@ EOF else echo i586-dg-dgux${UNAME_RELEASE} fi - exit ;; + exit ;; M88*:DolphinOS:*:*) # DolphinOS (SVR3) echo m88k-dolphin-sysv3 exit ;; @@ -532,7 +551,7 @@ EOF echo rs6000-ibm-aix3.2 fi exit ;; - *:AIX:*:[45]) + *:AIX:*:[4567]) IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then IBM_ARCH=rs6000 @@ -575,52 +594,52 @@ EOF 9000/[678][0-9][0-9]) if [ -x /usr/bin/getconf ]; then sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` - sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` - case "${sc_cpu_version}" in - 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 - 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 - 532) # CPU_PA_RISC2_0 - case "${sc_kernel_bits}" in - 32) HP_ARCH="hppa2.0n" ;; - 64) HP_ARCH="hppa2.0w" ;; + sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` + case "${sc_cpu_version}" in + 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 + 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 + 532) # CPU_PA_RISC2_0 + case "${sc_kernel_bits}" in + 32) HP_ARCH="hppa2.0n" ;; + 64) HP_ARCH="hppa2.0w" ;; '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 - esac ;; - esac + esac ;; + esac fi if [ "${HP_ARCH}" = "" ]; then eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c + sed 's/^ //' << EOF >$dummy.c - #define _HPUX_SOURCE - #include <stdlib.h> - #include <unistd.h> + #define _HPUX_SOURCE + #include <stdlib.h> + #include <unistd.h> - int main () - { - #if defined(_SC_KERNEL_BITS) - long bits = sysconf(_SC_KERNEL_BITS); - #endif - long cpu = sysconf (_SC_CPU_VERSION); + int main () + { + #if defined(_SC_KERNEL_BITS) + long bits = sysconf(_SC_KERNEL_BITS); + #endif + long cpu = sysconf (_SC_CPU_VERSION); - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1"); break; - case CPU_PA_RISC2_0: - #if defined(_SC_KERNEL_BITS) - switch (bits) - { - case 64: puts ("hppa2.0w"); break; - case 32: puts ("hppa2.0n"); break; - default: puts ("hppa2.0"); break; - } break; - #else /* !defined(_SC_KERNEL_BITS) */ - puts ("hppa2.0"); break; - #endif - default: puts ("hppa1.0"); break; - } - exit (0); - } + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1"); break; + case CPU_PA_RISC2_0: + #if defined(_SC_KERNEL_BITS) + switch (bits) + { + case 64: puts ("hppa2.0w"); break; + case 32: puts ("hppa2.0n"); break; + default: puts ("hppa2.0"); break; + } break; + #else /* !defined(_SC_KERNEL_BITS) */ + puts ("hppa2.0"); break; + #endif + default: puts ("hppa1.0"); break; + } + exit (0); + } EOF (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` test -z "$HP_ARCH" && HP_ARCH=hppa @@ -640,7 +659,7 @@ EOF # => hppa64-hp-hpux11.23 if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | - grep __LP64__ >/dev/null + grep -q __LP64__ then HP_ARCH="hppa2.0w" else @@ -711,22 +730,22 @@ EOF exit ;; C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) echo c1-convex-bsd - exit ;; + exit ;; C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) if getsysinfo -f scalar_acc then echo c32-convex-bsd else echo c2-convex-bsd fi - exit ;; + exit ;; C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) echo c34-convex-bsd - exit ;; + exit ;; C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) echo c38-convex-bsd - exit ;; + exit ;; C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) echo c4-convex-bsd - exit ;; + exit ;; CRAY*Y-MP:*:*:*) echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; @@ -750,14 +769,14 @@ EOF exit ;; F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` - echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit ;; + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` + echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; 5000:UNIX_System_V:4.*:*) - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` - echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` + echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" exit ;; i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} @@ -769,40 +788,51 @@ EOF echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} exit ;; *:FreeBSD:*:*) - case ${UNAME_MACHINE} in - pc98) - echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + UNAME_PROCESSOR=`/usr/bin/uname -p` + case ${UNAME_PROCESSOR} in amd64) echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; *) - echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + echo ${UNAME_PROCESSOR}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; esac exit ;; i*:CYGWIN*:*) echo ${UNAME_MACHINE}-pc-cygwin exit ;; + *:MINGW64*:*) + echo ${UNAME_MACHINE}-pc-mingw64 + exit ;; *:MINGW*:*) echo ${UNAME_MACHINE}-pc-mingw32 exit ;; + i*:MSYS*:*) + echo ${UNAME_MACHINE}-pc-msys + exit ;; i*:windows32*:*) - # uname -m includes "-pc" on this system. - echo ${UNAME_MACHINE}-mingw32 + # uname -m includes "-pc" on this system. + echo ${UNAME_MACHINE}-mingw32 exit ;; i*:PW*:*) echo ${UNAME_MACHINE}-pc-pw32 exit ;; - *:Interix*:[3456]*) - case ${UNAME_MACHINE} in - x86) + *:Interix*:*) + case ${UNAME_MACHINE} in + x86) echo i586-pc-interix${UNAME_RELEASE} exit ;; - EM64T | authenticamd) + authenticamd | genuineintel | EM64T) echo x86_64-unknown-interix${UNAME_RELEASE} exit ;; + IA64) + echo ia64-unknown-interix${UNAME_RELEASE} + exit ;; esac ;; [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) echo i${UNAME_MACHINE}-pc-mks exit ;; + 8664:Windows_NT:*) + echo x86_64-pc-mks + exit ;; i*:Windows_NT*:* | Pentium*:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we @@ -832,20 +862,68 @@ EOF i*86:Minix:*:*) echo ${UNAME_MACHINE}-pc-minix exit ;; - arm*:Linux:*:*) + aarch64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + aarch64_be:Linux:*:*) + UNAME_MACHINE=aarch64_be echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; + alpha:Linux:*:*) + case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in + EV5) UNAME_MACHINE=alphaev5 ;; + EV56) UNAME_MACHINE=alphaev56 ;; + PCA56) UNAME_MACHINE=alphapca56 ;; + PCA57) UNAME_MACHINE=alphapca56 ;; + EV6) UNAME_MACHINE=alphaev6 ;; + EV67) UNAME_MACHINE=alphaev67 ;; + EV68*) UNAME_MACHINE=alphaev68 ;; + esac + objdump --private-headers /bin/sh | grep -q ld.so.1 + if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi + echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + exit ;; + arm*:Linux:*:*) + eval $set_cc_for_build + if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_EABI__ + then + echo ${UNAME_MACHINE}-unknown-linux-gnu + else + if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_PCS_VFP + then + echo ${UNAME_MACHINE}-unknown-linux-gnueabi + else + echo ${UNAME_MACHINE}-unknown-linux-gnueabihf + fi + fi + exit ;; avr32*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; cris:Linux:*:*) - echo cris-axis-linux-gnu + echo ${UNAME_MACHINE}-axis-linux-gnu exit ;; crisv32:Linux:*:*) - echo crisv32-axis-linux-gnu + echo ${UNAME_MACHINE}-axis-linux-gnu exit ;; frv:Linux:*:*) - echo frv-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + hexagon:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + i*86:Linux:*:*) + LIBC=gnu + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #ifdef __dietlibc__ + LIBC=dietlibc + #endif +EOF + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'` + echo "${UNAME_MACHINE}-pc-linux-${LIBC}" exit ;; ia64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu @@ -856,74 +934,36 @@ EOF m68*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - mips:Linux:*:*) - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #undef CPU - #undef mips - #undef mipsel - #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mipsel - #else - #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips - #else - CPU= - #endif - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" - test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } - ;; - mips64:Linux:*:*) + mips:Linux:*:* | mips64:Linux:*:*) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #undef CPU - #undef mips64 - #undef mips64el + #undef ${UNAME_MACHINE} + #undef ${UNAME_MACHINE}el #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mips64el + CPU=${UNAME_MACHINE}el #else #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips64 + CPU=${UNAME_MACHINE} #else CPU= #endif #endif EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'` test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } ;; - or32:Linux:*:*) - echo or32-unknown-linux-gnu + or1k:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - ppc:Linux:*:*) - echo powerpc-unknown-linux-gnu + or32:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - ppc64:Linux:*:*) - echo powerpc64-unknown-linux-gnu + padre:Linux:*:*) + echo sparc-unknown-linux-gnu exit ;; - alpha:Linux:*:*) - case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in - EV5) UNAME_MACHINE=alphaev5 ;; - EV56) UNAME_MACHINE=alphaev56 ;; - PCA56) UNAME_MACHINE=alphapca56 ;; - PCA57) UNAME_MACHINE=alphapca56 ;; - EV6) UNAME_MACHINE=alphaev6 ;; - EV67) UNAME_MACHINE=alphaev67 ;; - EV68*) UNAME_MACHINE=alphaev68 ;; - esac - objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null - if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi - echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + parisc64:Linux:*:* | hppa64:Linux:*:*) + echo hppa64-unknown-linux-gnu exit ;; parisc:Linux:*:* | hppa:Linux:*:*) # Look for CPU level @@ -933,14 +973,17 @@ EOF *) echo hppa-unknown-linux-gnu ;; esac exit ;; - parisc64:Linux:*:* | hppa64:Linux:*:*) - echo hppa64-unknown-linux-gnu + ppc64:Linux:*:*) + echo powerpc64-unknown-linux-gnu + exit ;; + ppc:Linux:*:*) + echo powerpc-unknown-linux-gnu exit ;; s390:Linux:*:* | s390x:Linux:*:*) echo ${UNAME_MACHINE}-ibm-linux exit ;; sh64*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; sh*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu @@ -948,81 +991,18 @@ EOF sparc:Linux:*:* | sparc64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - tile:Linux:*:*) - echo tile-unknown-linux-gnu + tile*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; vax:Linux:*:*) echo ${UNAME_MACHINE}-dec-linux-gnu exit ;; x86_64:Linux:*:*) - echo x86_64-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - xtensa:Linux:*:*) - echo xtensa-unknown-linux-gnu + xtensa*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - i*86:Linux:*:*) - # The BFD linker knows what the default object file format is, so - # first see if it will tell us. cd to the root directory to prevent - # problems with other programs or directories called `ld' in the path. - # Set LC_ALL=C to ensure ld outputs messages in English. - ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \ - | sed -ne '/supported targets:/!d - s/[ ][ ]*/ /g - s/.*supported targets: *// - s/ .*// - p'` - case "$ld_supported_targets" in - elf32-i386) - TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu" - ;; - a.out-i386-linux) - echo "${UNAME_MACHINE}-pc-linux-gnuaout" - exit ;; - coff-i386) - echo "${UNAME_MACHINE}-pc-linux-gnucoff" - exit ;; - "") - # Either a pre-BFD a.out linker (linux-gnuoldld) or - # one that does not give us useful --help. - echo "${UNAME_MACHINE}-pc-linux-gnuoldld" - exit ;; - esac - # Determine whether the default compiler is a.out or elf - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #include <features.h> - #ifdef __ELF__ - # ifdef __GLIBC__ - # if __GLIBC__ >= 2 - LIBC=gnu - # else - LIBC=gnulibc1 - # endif - # else - LIBC=gnulibc1 - # endif - #else - #if defined(__INTEL_COMPILER) || defined(__PGI) || defined(__SUNPRO_C) || defined(__SUNPRO_CC) - LIBC=gnu - #else - LIBC=gnuaout - #endif - #endif - #ifdef __dietlibc__ - LIBC=dietlibc - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^LIBC/{ - s: ::g - p - }'`" - test x"${LIBC}" != x && { - echo "${UNAME_MACHINE}-pc-linux-${LIBC}" - exit - } - test x"${TENTATIVE}" != x && { echo "${TENTATIVE}"; exit; } - ;; i*86:DYNIX/ptx:4*:*) # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. # earlier versions are messed up and put the nodename in both @@ -1030,11 +1010,11 @@ EOF echo i386-sequent-sysv4 exit ;; i*86:UNIX_SV:4.2MP:2.*) - # Unixware is an offshoot of SVR4, but it has its own version - # number series starting with 2... - # I am not positive that other SVR4 systems won't match this, + # Unixware is an offshoot of SVR4, but it has its own version + # number series starting with 2... + # I am not positive that other SVR4 systems won't match this, # I just have to hope. -- rms. - # Use sysv4.2uw... so that sysv4* matches it. + # Use sysv4.2uw... so that sysv4* matches it. echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} exit ;; i*86:OS/2:*:*) @@ -1051,7 +1031,7 @@ EOF i*86:syllable:*:*) echo ${UNAME_MACHINE}-pc-syllable exit ;; - i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*) + i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) echo i386-unknown-lynxos${UNAME_RELEASE} exit ;; i*86:*DOS:*:*) @@ -1066,7 +1046,7 @@ EOF fi exit ;; i*86:*:5:[678]*) - # UnixWare 7.x, OpenUNIX and OpenServer 6. + # UnixWare 7.x, OpenUNIX and OpenServer 6. case `/bin/uname -X | grep "^Machine"` in *486*) UNAME_MACHINE=i486 ;; *Pentium) UNAME_MACHINE=i586 ;; @@ -1094,10 +1074,13 @@ EOF exit ;; pc:*:*:*) # Left here for compatibility: - # uname -m prints for DJGPP always 'pc', but it prints nothing about - # the processor, so we play safe by assuming i386. - echo i386-pc-msdosdjgpp - exit ;; + # uname -m prints for DJGPP always 'pc', but it prints nothing about + # the processor, so we play safe by assuming i586. + # Note: whatever this is, it MUST be the same as what config.sub + # prints for the "djgpp" host, or else GDB configury will decide that + # this is a cross-build. + echo i586-pc-msdosdjgpp + exit ;; Intel:Mach:3*:*) echo i386-pc-mach3 exit ;; @@ -1132,8 +1115,18 @@ EOF /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4; exit; } ;; + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4; exit; } ;; + NCR*:*:4.2:* | MPRAS*:*:4.2:*) + OS_REL='.3' + test -r /etc/.relid \ + && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) echo m68k-unknown-lynxos${UNAME_RELEASE} exit ;; @@ -1146,7 +1139,7 @@ EOF rs6000:LynxOS:2.*:*) echo rs6000-unknown-lynxos${UNAME_RELEASE} exit ;; - PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*) + PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) echo powerpc-unknown-lynxos${UNAME_RELEASE} exit ;; SM[BE]S:UNIX_SV:*:*) @@ -1166,10 +1159,10 @@ EOF echo ns32k-sni-sysv fi exit ;; - PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort - # says <[email protected]> - echo i586-unisys-sysv4 - exit ;; + PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort + # says <[email protected]> + echo i586-unisys-sysv4 + exit ;; *:UNIX_System_V:4*:FTX*) # From Gerald Hewes <[email protected]>. # How about differentiating between stratus architectures? -djm @@ -1195,11 +1188,11 @@ EOF exit ;; R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) if [ -d /usr/nec ]; then - echo mips-nec-sysv${UNAME_RELEASE} + echo mips-nec-sysv${UNAME_RELEASE} else - echo mips-unknown-sysv${UNAME_RELEASE} + echo mips-unknown-sysv${UNAME_RELEASE} fi - exit ;; + exit ;; BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. echo powerpc-be-beos exit ;; @@ -1209,6 +1202,12 @@ EOF BePC:BeOS:*:*) # BeOS running on Intel PC compatible. echo i586-pc-beos exit ;; + BePC:Haiku:*:*) # Haiku running on Intel PC compatible. + echo i586-pc-haiku + exit ;; + x86_64:Haiku:*:*) + echo x86_64-unknown-haiku + exit ;; SX-4:SUPER-UX:*:*) echo sx4-nec-superux${UNAME_RELEASE} exit ;; @@ -1236,6 +1235,16 @@ EOF *:Darwin:*:*) UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown case $UNAME_PROCESSOR in + i386) + eval $set_cc_for_build + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + UNAME_PROCESSOR="x86_64" + fi + fi ;; unknown) UNAME_PROCESSOR=powerpc ;; esac echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} @@ -1251,7 +1260,10 @@ EOF *:QNX:*:4*) echo i386-pc-qnx exit ;; - NSE-?:NONSTOP_KERNEL:*:*) + NEO-?:NONSTOP_KERNEL:*:*) + echo neo-tandem-nsk${UNAME_RELEASE} + exit ;; + NSE-*:NONSTOP_KERNEL:*:*) echo nse-tandem-nsk${UNAME_RELEASE} exit ;; NSR-?:NONSTOP_KERNEL:*:*) @@ -1296,13 +1308,13 @@ EOF echo pdp10-unknown-its exit ;; SEI:*:*:SEIUX) - echo mips-sei-seiux${UNAME_RELEASE} + echo mips-sei-seiux${UNAME_RELEASE} exit ;; *:DragonFly:*:*) echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` exit ;; *:*VMS:*:*) - UNAME_MACHINE=`(uname -p) 2>/dev/null` + UNAME_MACHINE=`(uname -p) 2>/dev/null` case "${UNAME_MACHINE}" in A*) echo alpha-dec-vms ; exit ;; I*) echo ia64-dec-vms ; exit ;; @@ -1317,11 +1329,14 @@ EOF i*86:rdos:*:*) echo ${UNAME_MACHINE}-pc-rdos exit ;; + i*86:AROS:*:*) + echo ${UNAME_MACHINE}-pc-aros + exit ;; + x86_64:VMkernel:*:*) + echo ${UNAME_MACHINE}-unknown-esx + exit ;; esac -#echo '(No uname command or uname output not recognized.)' 1>&2 -#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 - eval $set_cc_for_build cat >$dummy.c <<EOF #ifdef _SEQUENT_ @@ -1339,11 +1354,11 @@ main () #include <sys/param.h> printf ("m68k-sony-newsos%s\n", #ifdef NEWSOS4 - "4" + "4" #else - "" + "" #endif - ); exit (0); + ); exit (0); #endif #endif @@ -1477,9 +1492,9 @@ This script, last modified $timestamp, has failed to recognize the operating system you are using. It is advised that you download the most up to date version of the config scripts from - http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.guess + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD and - http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.sub + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD If the version you run ($0) is already up to date, please send the following data and any information you think might be diff --git a/lib/test_server/src/config.sub b/lib/test_server/src/config.sub index f43233b104..bb6edbdb47 100755 --- a/lib/test_server/src/config.sub +++ b/lib/test_server/src/config.sub @@ -1,44 +1,40 @@ #! /bin/sh # Configuration validation subroutine script. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, -# Inc. +# Copyright 1992-2013 Free Software Foundation, Inc. -timestamp='2007-04-29' +timestamp='2013-02-12' -# This file is (in principle) common to ALL GNU software. -# The presence of a machine in this file suggests that SOME GNU software -# can handle that machine. It does not imply ALL GNU software can. -# -# This file is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or +# This file is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. +# along with this program; if not, see <http://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). -# Please send patches to <[email protected]>. Submit a context -# diff and a properly formatted ChangeLog entry. +# Please send patches with a ChangeLog entry to [email protected]. # # Configuration subroutine to validate and canonicalize a configuration type. # Supply the specified configuration type as an argument. # If it is invalid, we print an error message on stderr and exit with code 1. # Otherwise, we print the canonical config type on stdout and succeed. +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD + # This file is supposed to be the same for all GNU packages # and recognize all the CPU types, system types and aliases # that are meaningful with *any* GNU software. @@ -72,8 +68,7 @@ Report bugs and patches to <[email protected]>." version="\ GNU config.sub ($timestamp) -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 -Free Software Foundation, Inc. +Copyright 1992-2013 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -120,12 +115,18 @@ esac # Here we must recognize all the valid KERNEL-OS combinations. maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` case $maybe_os in - nto-qnx* | linux-gnu* | linux-dietlibc | linux-newlib* | linux-uclibc* | \ - uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* | \ + nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \ + linux-musl* | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \ + knetbsd*-gnu* | netbsd*-gnu* | \ + kopensolaris*-gnu* | \ storm-chaos* | os2-emx* | rtmk-nova*) os=-$maybe_os basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` ;; + android-linux) + os=-linux-android + basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-unknown + ;; *) basic_machine=`echo $1 | sed 's/-[^-]*$//'` if [ $basic_machine != $1 ] @@ -148,10 +149,13 @@ case $os in -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ - -apple | -axis | -knuth | -cray) + -apple | -axis | -knuth | -cray | -microblaze*) os= basic_machine=$1 ;; + -bluegene*) + os=-cnk + ;; -sim | -cisco | -oki | -wec | -winbond) os= basic_machine=$1 @@ -166,10 +170,10 @@ case $os in os=-chorusos basic_machine=$1 ;; - -chorusrdb) - os=-chorusrdb + -chorusrdb) + os=-chorusrdb basic_machine=$1 - ;; + ;; -hiux*) os=-hiuxwe2 ;; @@ -214,6 +218,12 @@ case $os in -isc*) basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; + -lynx*178) + os=-lynxos178 + ;; + -lynx*5) + os=-lynxos5 + ;; -lynx*) os=-lynxos ;; @@ -238,24 +248,34 @@ case $basic_machine in # Some are omitted here because they have special meanings below. 1750a | 580 \ | a29k \ + | aarch64 | aarch64_be \ | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ | am33_2.0 \ - | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr | avr32 \ + | arc \ + | arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv7[arm] \ + | avr | avr32 \ + | be32 | be64 \ | bfin \ | c4x | clipper \ | d10v | d30v | dlx | dsp16xx \ + | epiphany \ | fido | fr30 | frv \ | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ + | hexagon \ | i370 | i860 | i960 | ia64 \ | ip2k | iq2000 \ + | le32 | le64 \ + | lm32 \ | m32c | m32r | m32rle | m68000 | m68k | m88k \ - | maxq | mb | microblaze | mcore | mep \ + | maxq | mb | microblaze | microblazeel | mcore | mep | metag \ | mips | mipsbe | mipseb | mipsel | mipsle \ | mips16 \ | mips64 | mips64el \ - | mips64vr | mips64vrel \ + | mips64octeon | mips64octeonel \ | mips64orion | mips64orionel \ + | mips64r5900 | mips64r5900el \ + | mips64vr | mips64vrel \ | mips64vr4100 | mips64vr4100el \ | mips64vr4300 | mips64vr4300el \ | mips64vr5000 | mips64vr5000el \ @@ -266,31 +286,45 @@ case $basic_machine in | mipsisa64r2 | mipsisa64r2el \ | mipsisa64sb1 | mipsisa64sb1el \ | mipsisa64sr71k | mipsisa64sr71kel \ + | mipsr5900 | mipsr5900el \ | mipstx39 | mipstx39el \ | mn10200 | mn10300 \ + | moxie \ | mt \ | msp430 \ - | nios | nios2 \ + | nds32 | nds32le | nds32be \ + | nios | nios2 | nios2eb | nios2el \ | ns16k | ns32k \ - | or32 \ + | open8 \ + | or1k | or32 \ | pdp10 | pdp11 | pj | pjl \ - | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \ + | powerpc | powerpc64 | powerpc64le | powerpcle \ | pyramid \ + | rl78 | rx \ | score \ - | sh | sh[1234] | sh[24]a | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ + | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ | sh64 | sh64le \ | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ - | spu | strongarm \ - | tahoe | thumb | tic4x | tic80 | tron \ - | v850 | v850e \ + | spu \ + | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \ + | ubicom32 \ + | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \ | we32k \ - | x86 | xc16x | xscale | xscalee[bl] | xstormy16 | xtensa \ - | z8k) + | x86 | xc16x | xstormy16 | xtensa \ + | z8k | z80) basic_machine=$basic_machine-unknown ;; - m6811 | m68hc11 | m6812 | m68hc12) - # Motorola 68HC11/12. + c54x) + basic_machine=tic54x-unknown + ;; + c55x) + basic_machine=tic55x-unknown + ;; + c6x) + basic_machine=tic6x-unknown + ;; + m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | picochip) basic_machine=$basic_machine-unknown os=-none ;; @@ -300,6 +334,21 @@ case $basic_machine in basic_machine=mt-unknown ;; + strongarm | thumb | xscale) + basic_machine=arm-unknown + ;; + xgate) + basic_machine=$basic_machine-unknown + os=-none + ;; + xscaleeb) + basic_machine=armeb-unknown + ;; + + xscaleel) + basic_machine=armel-unknown + ;; + # We use `pc' rather than `unknown' # because (1) that's what they normally are, and # (2) the word "unknown" tends to confuse beginning users. @@ -314,29 +363,37 @@ case $basic_machine in # Recognize the basic CPU types with company name. 580-* \ | a29k-* \ + | aarch64-* | aarch64_be-* \ | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \ | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ | avr-* | avr32-* \ + | be32-* | be64-* \ | bfin-* | bs2000-* \ - | c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \ + | c[123]* | c30-* | [cjt]90-* | c4x-* \ | clipper-* | craynv-* | cydra-* \ | d10v-* | d30v-* | dlx-* \ | elxsi-* \ | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \ | h8300-* | h8500-* \ | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ + | hexagon-* \ | i*86-* | i860-* | i960-* | ia64-* \ | ip2k-* | iq2000-* \ + | le32-* | le64-* \ + | lm32-* \ | m32c-* | m32r-* | m32rle-* \ | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ - | m88110-* | m88k-* | maxq-* | mcore-* \ + | m88110-* | m88k-* | maxq-* | mcore-* | metag-* \ + | microblaze-* | microblazeel-* \ | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ | mips16-* \ | mips64-* | mips64el-* \ - | mips64vr-* | mips64vrel-* \ + | mips64octeon-* | mips64octeonel-* \ | mips64orion-* | mips64orionel-* \ + | mips64r5900-* | mips64r5900el-* \ + | mips64vr-* | mips64vrel-* \ | mips64vr4100-* | mips64vr4100el-* \ | mips64vr4300-* | mips64vr4300el-* \ | mips64vr5000-* | mips64vr5000el-* \ @@ -347,31 +404,41 @@ case $basic_machine in | mipsisa64r2-* | mipsisa64r2el-* \ | mipsisa64sb1-* | mipsisa64sb1el-* \ | mipsisa64sr71k-* | mipsisa64sr71kel-* \ + | mipsr5900-* | mipsr5900el-* \ | mipstx39-* | mipstx39el-* \ | mmix-* \ | mt-* \ | msp430-* \ - | nios-* | nios2-* \ + | nds32-* | nds32le-* | nds32be-* \ + | nios-* | nios2-* | nios2eb-* | nios2el-* \ | none-* | np1-* | ns16k-* | ns32k-* \ + | open8-* \ | orion-* \ | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ - | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \ + | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \ | pyramid-* \ - | romp-* | rs6000-* \ - | sh-* | sh[1234]-* | sh[24]a-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ + | rl78-* | romp-* | rs6000-* | rx-* \ + | sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ | sparclite-* \ - | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | strongarm-* | sv1-* | sx?-* \ - | tahoe-* | thumb-* \ + | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx?-* \ + | tahoe-* \ | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ + | tile*-* \ | tron-* \ - | v850-* | v850e-* | vax-* \ + | ubicom32-* \ + | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \ + | vax-* \ | we32k-* \ - | x86-* | x86_64-* | xc16x-* | xps100-* | xscale-* | xscalee[bl]-* \ - | xstormy16-* | xtensa-* \ + | x86-* | x86_64-* | xc16x-* | xps100-* \ + | xstormy16-* | xtensa*-* \ | ymp-* \ - | z8k-*) + | z8k-* | z80-*) + ;; + # Recognize the basic CPU types without company name, with glob match. + xtensa*) + basic_machine=$basic_machine-unknown ;; # Recognize the various machine names and aliases which stand # for a CPU type and a company and sometimes even an OS. @@ -389,7 +456,7 @@ case $basic_machine in basic_machine=a29k-amd os=-udi ;; - abacus) + abacus) basic_machine=abacus-unknown ;; adobe68k) @@ -435,6 +502,10 @@ case $basic_machine in basic_machine=m68k-apollo os=-bsd ;; + aros) + basic_machine=i386-pc + os=-aros + ;; aux) basic_machine=m68k-apple os=-aux @@ -443,10 +514,35 @@ case $basic_machine in basic_machine=ns32k-sequent os=-dynix ;; + blackfin) + basic_machine=bfin-unknown + os=-linux + ;; + blackfin-*) + basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; + bluegene*) + basic_machine=powerpc-ibm + os=-cnk + ;; + c54x-*) + basic_machine=tic54x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c55x-*) + basic_machine=tic55x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c6x-*) + basic_machine=tic6x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; c90) basic_machine=c90-cray os=-unicos ;; + cegcc) + basic_machine=arm-unknown + os=-cegcc + ;; convex-c1) basic_machine=c1-convex os=-bsd @@ -475,8 +571,8 @@ case $basic_machine in basic_machine=craynv-cray os=-unicosmp ;; - cr16c) - basic_machine=cr16c-unknown + cr16 | cr16-*) + basic_machine=cr16-unknown os=-elf ;; crds | unos) @@ -514,6 +610,10 @@ case $basic_machine in basic_machine=m88k-motorola os=-sysv3 ;; + dicos) + basic_machine=i686-pc + os=-dicos + ;; djgpp) basic_machine=i586-pc os=-msdosdjgpp @@ -629,7 +729,6 @@ case $basic_machine in i370-ibm* | ibm*) basic_machine=i370-ibm ;; -# I'm not sure what "Sysv32" means. Should this be sysv3.2? i*86v32) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv32 @@ -668,6 +767,14 @@ case $basic_machine in basic_machine=m68k-isi os=-sysv ;; + m68knommu) + basic_machine=m68k-unknown + os=-linux + ;; + m68knommu-*) + basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; m88k-omron*) basic_machine=m88k-omron ;; @@ -679,6 +786,13 @@ case $basic_machine in basic_machine=ns32k-utek os=-sysv ;; + microblaze*) + basic_machine=microblaze-xilinx + ;; + mingw64) + basic_machine=x86_64-pc + os=-mingw64 + ;; mingw32) basic_machine=i386-pc os=-mingw32 @@ -715,10 +829,18 @@ case $basic_machine in ms1-*) basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` ;; + msys) + basic_machine=i386-pc + os=-msys + ;; mvs) basic_machine=i370-ibm os=-mvs ;; + nacl) + basic_machine=le32-unknown + os=-nacl + ;; ncr3000) basic_machine=i486-ncr os=-sysv4 @@ -783,6 +905,12 @@ case $basic_machine in np1) basic_machine=np1-gould ;; + neo-tandem) + basic_machine=neo-tandem + ;; + nse-tandem) + basic_machine=nse-tandem + ;; nsr-tandem) basic_machine=nsr-tandem ;; @@ -813,6 +941,14 @@ case $basic_machine in basic_machine=i860-intel os=-osf ;; + parisc) + basic_machine=hppa-unknown + os=-linux + ;; + parisc-*) + basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; pbd) basic_machine=sparc-tti ;; @@ -857,9 +993,10 @@ case $basic_machine in ;; power) basic_machine=power-ibm ;; - ppc) basic_machine=powerpc-unknown + ppc | ppcbe) basic_machine=powerpc-unknown ;; - ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` + ppc-* | ppcbe-*) + basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppcle | powerpclittle | ppc-le | powerpc-little) basic_machine=powerpcle-unknown @@ -884,7 +1021,11 @@ case $basic_machine in basic_machine=i586-unknown os=-pw32 ;; - rdos) + rdos | rdos64) + basic_machine=x86_64-pc + os=-rdos + ;; + rdos32) basic_machine=i386-pc os=-rdos ;; @@ -953,6 +1094,9 @@ case $basic_machine in basic_machine=i860-stratus os=-sysv4 ;; + strongarm-* | thumb-*) + basic_machine=arm-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; sun2) basic_machine=m68000-sun ;; @@ -1009,17 +1153,9 @@ case $basic_machine in basic_machine=t90-cray os=-unicos ;; - tic54x | c54x*) - basic_machine=tic54x-unknown - os=-coff - ;; - tic55x | c55x*) - basic_machine=tic55x-unknown - os=-coff - ;; - tic6x | c6x*) - basic_machine=tic6x-unknown - os=-coff + tile*) + basic_machine=$basic_machine-unknown + os=-linux-gnu ;; tx39) basic_machine=mipstx39-unknown @@ -1027,10 +1163,6 @@ case $basic_machine in tx39el) basic_machine=mipstx39el-unknown ;; - tile*) - basic_machine=tile-tilera - os=-linux-gnu - ;; toad1) basic_machine=pdp10-xkl os=-tops20 @@ -1092,6 +1224,9 @@ case $basic_machine in xps | xps100) basic_machine=xps100-honeywell ;; + xscale-* | xscalee[bl]-*) + basic_machine=`echo $basic_machine | sed 's/^xscale/arm/'` + ;; ymp) basic_machine=ymp-cray os=-unicos @@ -1100,6 +1235,10 @@ case $basic_machine in basic_machine=z8k-unknown os=-sim ;; + z80-*-coff) + basic_machine=z80-unknown + os=-sim + ;; none) basic_machine=none-none os=-none @@ -1138,7 +1277,7 @@ case $basic_machine in we32k) basic_machine=we32k-att ;; - sh[1234] | sh[24]a | sh[34]eb | sh[1234]le | sh[23]ele) + sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele) basic_machine=sh-unknown ;; sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v) @@ -1185,9 +1324,12 @@ esac if [ x"$os" != x"" ] then case $os in - # First match some system type aliases - # that might get confused with valid system types. + # First match some system type aliases + # that might get confused with valid system types. # -solaris* is a basic system type, with this one exception. + -auroraux) + os=-auroraux + ;; -solaris1 | -solaris1.*) os=`echo $os | sed -e 's|solaris1|sunos4|'` ;; @@ -1208,21 +1350,23 @@ case $os in # Each alternative MUST END IN A *, to match a version number. # -sysv* is not here because it comes later, after sysvr4. -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ - | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\ - | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ + | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\ + | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \ + | -sym* | -kopensolaris* | -plan9* \ | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ - | -aos* \ + | -aos* | -aros* \ | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ - | -openbsd* | -solidbsd* \ + | -bitrig* | -openbsd* | -solidbsd* \ | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ - | -chorusos* | -chorusrdb* \ - | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ - | -mingw32* | -linux-gnu* | -linux-newlib* | -linux-uclibc* \ + | -chorusos* | -chorusrdb* | -cegcc* \ + | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ + | -mingw32* | -mingw64* | -linux-gnu* | -linux-android* \ + | -linux-newlib* | -linux-musl* | -linux-uclibc* \ | -uxpv* | -beos* | -mpeix* | -udk* \ | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ @@ -1230,7 +1374,7 @@ case $os in | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ - | -skyos* | -haiku* | -rdos* | -toppers* | -drops*) + | -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es*) # Remember, each alternative MUST END IN *, to match a version number. ;; -qnx*) @@ -1269,7 +1413,7 @@ case $os in -opened*) os=-openedition ;; - -os400*) + -os400*) os=-os400 ;; -wince*) @@ -1318,7 +1462,7 @@ case $os in -sinix*) os=-sysv4 ;; - -tpf*) + -tpf*) os=-tpf ;; -triton*) @@ -1354,12 +1498,14 @@ case $os in -aros*) os=-aros ;; - -kaos*) - os=-kaos - ;; -zvmoe) os=-zvmoe ;; + -dicos*) + os=-dicos + ;; + -nacl*) + ;; -none) ;; *) @@ -1382,10 +1528,10 @@ else # system, and we'll never get to this point. case $basic_machine in - score-*) + score-*) os=-elf ;; - spu-*) + spu-*) os=-elf ;; *-acorn) @@ -1397,8 +1543,20 @@ case $basic_machine in arm*-semi) os=-aout ;; - c4x-* | tic4x-*) - os=-coff + c4x-* | tic4x-*) + os=-coff + ;; + hexagon-*) + os=-elf + ;; + tic54x-*) + os=-coff + ;; + tic55x-*) + os=-coff + ;; + tic6x-*) + os=-coff ;; # This must come before the *-dec entry. pdp10-*) @@ -1418,14 +1576,11 @@ case $basic_machine in ;; m68000-sun) os=-sunos3 - # This also exists in the configure program, but was not the - # default. - # os=-sunos4 ;; m68*-cisco) os=-aout ;; - mep-*) + mep-*) os=-elf ;; mips*-cisco) @@ -1434,6 +1589,9 @@ case $basic_machine in mips*-*) os=-elf ;; + or1k-*) + os=-elf + ;; or32-*) os=-coff ;; @@ -1452,7 +1610,7 @@ case $basic_machine in *-ibm) os=-aix ;; - *-knuth) + *-knuth) os=-mmixware ;; *-wec) @@ -1557,7 +1715,7 @@ case $basic_machine in -sunos*) vendor=sun ;; - -aix*) + -cnk*|-aix*) vendor=ibm ;; -beos*) @@ -1628,3 +1786,4 @@ exit # time-stamp-format: "%:y-%02m-%02d" # time-stamp-end: "'" # End: + diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl index 70cb6fa220..5d4d392166 100644 --- a/lib/test_server/src/test_server_ctrl.erl +++ b/lib/test_server/src/test_server_ctrl.erl @@ -681,7 +681,7 @@ handle_call({abort_current_testcase,Reason}, _From, State) -> handle_call({finish,Fini}, _From, State) -> case State#state.jobs of [] -> - lists:foreach(fun({Cli,Fun}) -> Fun(Cli) end, + lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Fini) end, State#state.idle_notify), State2 = State#state{finish=false}, {stop,shutdown,{ok,self()}, State2}; @@ -699,14 +699,11 @@ handle_call({finish,Fini}, _From, State) -> handle_call({idle_notify,Fun}, {Cli,_Ref}, State) -> case State#state.jobs of - [] -> - Fun(Cli), - {reply, {ok,self()}, State}; - _ -> - Subscribed = State#state.idle_notify, - {reply, {ok,self()}, - State#state{idle_notify=[{Cli,Fun}|Subscribed]}} - end; + [] -> self() ! report_idle; + _ -> ok + end, + Subscribed = State#state.idle_notify, + {reply, {ok,self()}, State#state{idle_notify=[{Cli,Fun}|Subscribed]}}; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% handle_call(start_get_totals, From, State) -> {ok,Pid} @@ -1000,6 +997,13 @@ handle_cast({node_started,Node}, State) -> %% lost contact with target. The test_server_ctrl process is %% terminated, and teminate/2 will do the cleanup +handle_info(report_idle, State) -> + Finish = State#state.finish, + lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Finish) end, + State#state.idle_notify), + {noreply,State#state{idle_notify=[]}}; + + handle_info({'EXIT',Pid,Reason}, State) -> case lists:keysearch(Pid,2,State#state.jobs) of false -> @@ -1017,11 +1021,12 @@ handle_info({'EXIT',Pid,Reason}, State) -> [Name,Reason]) end, State2 = State#state{jobs=NewJobs}, + Finish = State2#state.finish, case NewJobs of [] -> - lists:foreach(fun({Cli,Fun}) -> Fun(Cli) end, + lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Finish) end, State2#state.idle_notify), - case State2#state.finish of + case Finish of false -> {noreply,State2#state{idle_notify=[]}}; _ -> % true | abort @@ -1031,9 +1036,9 @@ handle_info({'EXIT',Pid,Reason}, State) -> {stop,shutdown,State2#state{finish=false}} end; _ -> % pending jobs - case State2#state.finish of + case Finish of abort -> % abort test now! - lists:foreach(fun({Cli,Fun}) -> Fun(Cli) end, + lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Finish) end, State2#state.idle_notify), {stop,shutdown,State2#state{finish=false}}; _ -> % true | false diff --git a/lib/test_server/src/ts_run.erl b/lib/test_server/src/ts_run.erl index 741dd483f5..2be892d8d3 100644 --- a/lib/test_server/src/ts_run.erl +++ b/lib/test_server/src/ts_run.erl @@ -261,13 +261,17 @@ run_batch(Vars, _Spec, State) -> ts_lib:progress(Vars, 1, "Command: ~s~n", [Command]), io:format(user, "Command: ~s~n",[Command]), Port = open_port({spawn, Command}, [stream, in, eof]), - tricky_print_data(Port). + Timeout = 30000 * case os:getenv("TS_RUN_VALGRIND") of + false -> 1; + _ -> 100 + end, + tricky_print_data(Port, Timeout). -tricky_print_data(Port) -> +tricky_print_data(Port, Timeout) -> receive {Port, {data, Bytes}} -> io:put_chars(Bytes), - tricky_print_data(Port); + tricky_print_data(Port, Timeout); {Port, eof} -> Port ! {self(), close}, receive @@ -280,7 +284,7 @@ tricky_print_data(Port) -> after 1 -> % force context switch ok end - after 30000 -> + after Timeout -> case erl_epmd:names() of {ok,Names} -> case is_testnode_dead(Names) of @@ -288,10 +292,10 @@ tricky_print_data(Port) -> io:put_chars("WARNING: No EOF, but " "test_server node is down!\n"); false -> - tricky_print_data(Port) + tricky_print_data(Port, Timeout) end; _ -> - tricky_print_data(Port) + tricky_print_data(Port, Timeout) end end. diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index d6d4457920..ddd22707dd 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -728,6 +728,8 @@ resulting regexp is surrounded by \\_< and \\_>." "atom_to_list" "binary_to_atom" "binary_to_existing_atom" + "binary_to_float" + "binary_to_integer" "binary_to_list" "binary_to_term" "binary_part" @@ -746,6 +748,7 @@ resulting regexp is surrounded by \\_< and \\_>." "error" "exit" "float" + "float_to_binary" "float_to_list" "garbage_collect" "get" @@ -754,6 +757,7 @@ resulting regexp is surrounded by \\_< and \\_>." "halt" "hd" "integer_to_list" + "integer_to_binary" "iolist_size" "iolist_to_binary" "is_alive" diff --git a/lib/wx/autoconf/config.guess b/lib/wx/autoconf/config.guess index ec46d18caf..f475ceb413 100755 --- a/lib/wx/autoconf/config.guess +++ b/lib/wx/autoconf/config.guess @@ -1,14 +1,12 @@ #! /bin/sh # Attempt to guess a canonical system name. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, -# Inc. +# Copyright 1992-2013 Free Software Foundation, Inc. -timestamp='2006-02-27' +timestamp='2013-02-12' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or +# the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, but @@ -17,26 +15,22 @@ timestamp='2006-02-27' # General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. +# along with this program; if not, see <http://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - - -# Originally written by Per Bothner <[email protected]>. -# Please send patches to <[email protected]>. Submit a context -# diff and a properly formatted ChangeLog entry. +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). +# +# Originally written by Per Bothner. # -# This script attempts to guess a canonical system name similar to -# config.sub. If it succeeds, it prints the system name on stdout, and -# exits with 0. Otherwise, it exits with 1. +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD # -# The plan is that this can be called by configure scripts if you -# don't specify an explicit build system type. +# Please send patches with a ChangeLog entry to [email protected]. + me=`echo "$0" | sed -e 's,.*/,,'` @@ -56,8 +50,7 @@ version="\ GNU config.guess ($timestamp) Originally written by Per Bothner. -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 -Free Software Foundation, Inc. +Copyright 1992-2013 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -144,7 +137,7 @@ UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in *:NetBSD:*:*) # NetBSD (nbsd) targets should (where applicable) match one or - # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*, + # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*, # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently # switched to ELF, *-*-netbsd* would select the old # object file format. This provides both forward @@ -161,6 +154,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in arm*) machine=arm-unknown ;; sh3el) machine=shl-unknown ;; sh3eb) machine=sh-unknown ;; + sh5el) machine=sh5le-unknown ;; *) machine=${UNAME_MACHINE_ARCH}-unknown ;; esac # The Operating System including object format, if it has switched @@ -169,7 +163,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in arm*|i386|m68k|ns32k|sh3*|sparc|vax) eval $set_cc_for_build if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep __ELF__ >/dev/null + | grep -q __ELF__ then # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). # Return netbsd for either. FIX? @@ -179,7 +173,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in fi ;; *) - os=netbsd + os=netbsd ;; esac # The OS release @@ -200,6 +194,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. echo "${machine}-${os}${release}" exit ;; + *:Bitrig:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'` + echo ${UNAME_MACHINE_ARCH}-unknown-bitrig${UNAME_RELEASE} + exit ;; *:OpenBSD:*:*) UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} @@ -211,7 +209,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in echo ${UNAME_MACHINE}-unknown-solidbsd${UNAME_RELEASE} exit ;; macppc:MirBSD:*:*) - echo powerppc-unknown-mirbsd${UNAME_RELEASE} + echo powerpc-unknown-mirbsd${UNAME_RELEASE} exit ;; *:MirBSD:*:*) echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE} @@ -222,7 +220,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` ;; *5.*) - UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` ;; esac # According to Compaq, /usr/sbin/psrinfo has been available on @@ -268,7 +266,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # A Xn.n version is an unreleased experimental baselevel. # 1.2 uses "1.2" for uname -r. echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - exit ;; + # Reset EXIT trap before exiting to avoid spurious non-zero exit code. + exitcode=$? + trap '' 0 + exit $exitcode ;; Alpha\ *:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # Should we change UNAME_MACHINE based on the output of uname instead @@ -294,12 +295,12 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in echo s390-ibm-zvmoe exit ;; *:OS400:*:*) - echo powerpc-ibm-os400 + echo powerpc-ibm-os400 exit ;; arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) echo arm-acorn-riscix${UNAME_RELEASE} exit ;; - arm:riscos:*:*|arm:RISCOS:*:*) + arm*:riscos:*:*|arm*:RISCOS:*:*) echo arm-unknown-riscos exit ;; SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) @@ -323,14 +324,33 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in case `/usr/bin/uname -p` in sparc) echo sparc-icl-nx7; exit ;; esac ;; + s390x:SunOS:*:*) + echo ${UNAME_MACHINE}-ibm-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; sun4H:SunOS:5.*:*) echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; - i86pc:SunOS:5.*:*) - echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) + echo i386-pc-auroraux${UNAME_RELEASE} + exit ;; + i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) + eval $set_cc_for_build + SUN_ARCH="i386" + # If there is a compiler, see if it is configured for 64-bit objects. + # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. + # This test works for both compilers. + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + SUN_ARCH="x86_64" + fi + fi + echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:6*:*) # According to config.sub, this is the proper way to canonicalize @@ -374,23 +394,23 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # MiNT. But MiNT is downward compatible to TOS, so this should # be no problem. atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} + echo m68k-atari-mint${UNAME_RELEASE} exit ;; atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) echo m68k-atari-mint${UNAME_RELEASE} - exit ;; + exit ;; *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} + echo m68k-atari-mint${UNAME_RELEASE} exit ;; milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) - echo m68k-milan-mint${UNAME_RELEASE} - exit ;; + echo m68k-milan-mint${UNAME_RELEASE} + exit ;; hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) - echo m68k-hades-mint${UNAME_RELEASE} - exit ;; + echo m68k-hades-mint${UNAME_RELEASE} + exit ;; *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) - echo m68k-unknown-mint${UNAME_RELEASE} - exit ;; + echo m68k-unknown-mint${UNAME_RELEASE} + exit ;; m68k:machten:*:*) echo m68k-apple-machten${UNAME_RELEASE} exit ;; @@ -460,8 +480,8 @@ EOF echo m88k-motorola-sysv3 exit ;; AViiON:dgux:*:*) - # DG/UX returns AViiON for all architectures - UNAME_PROCESSOR=`/usr/bin/uname -p` + # DG/UX returns AViiON for all architectures + UNAME_PROCESSOR=`/usr/bin/uname -p` if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] then if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ @@ -474,7 +494,7 @@ EOF else echo i586-dg-dgux${UNAME_RELEASE} fi - exit ;; + exit ;; M88*:DolphinOS:*:*) # DolphinOS (SVR3) echo m88k-dolphin-sysv3 exit ;; @@ -531,7 +551,7 @@ EOF echo rs6000-ibm-aix3.2 fi exit ;; - *:AIX:*:[45]) + *:AIX:*:[4567]) IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then IBM_ARCH=rs6000 @@ -574,52 +594,52 @@ EOF 9000/[678][0-9][0-9]) if [ -x /usr/bin/getconf ]; then sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` - sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` - case "${sc_cpu_version}" in - 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 - 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 - 532) # CPU_PA_RISC2_0 - case "${sc_kernel_bits}" in - 32) HP_ARCH="hppa2.0n" ;; - 64) HP_ARCH="hppa2.0w" ;; + sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` + case "${sc_cpu_version}" in + 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 + 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 + 532) # CPU_PA_RISC2_0 + case "${sc_kernel_bits}" in + 32) HP_ARCH="hppa2.0n" ;; + 64) HP_ARCH="hppa2.0w" ;; '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 - esac ;; - esac + esac ;; + esac fi if [ "${HP_ARCH}" = "" ]; then eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c + sed 's/^ //' << EOF >$dummy.c - #define _HPUX_SOURCE - #include <stdlib.h> - #include <unistd.h> + #define _HPUX_SOURCE + #include <stdlib.h> + #include <unistd.h> - int main () - { - #if defined(_SC_KERNEL_BITS) - long bits = sysconf(_SC_KERNEL_BITS); - #endif - long cpu = sysconf (_SC_CPU_VERSION); + int main () + { + #if defined(_SC_KERNEL_BITS) + long bits = sysconf(_SC_KERNEL_BITS); + #endif + long cpu = sysconf (_SC_CPU_VERSION); - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1"); break; - case CPU_PA_RISC2_0: - #if defined(_SC_KERNEL_BITS) - switch (bits) - { - case 64: puts ("hppa2.0w"); break; - case 32: puts ("hppa2.0n"); break; - default: puts ("hppa2.0"); break; - } break; - #else /* !defined(_SC_KERNEL_BITS) */ - puts ("hppa2.0"); break; - #endif - default: puts ("hppa1.0"); break; - } - exit (0); - } + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1"); break; + case CPU_PA_RISC2_0: + #if defined(_SC_KERNEL_BITS) + switch (bits) + { + case 64: puts ("hppa2.0w"); break; + case 32: puts ("hppa2.0n"); break; + default: puts ("hppa2.0"); break; + } break; + #else /* !defined(_SC_KERNEL_BITS) */ + puts ("hppa2.0"); break; + #endif + default: puts ("hppa1.0"); break; + } + exit (0); + } EOF (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` test -z "$HP_ARCH" && HP_ARCH=hppa @@ -639,7 +659,7 @@ EOF # => hppa64-hp-hpux11.23 if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | - grep __LP64__ >/dev/null + grep -q __LP64__ then HP_ARCH="hppa2.0w" else @@ -710,22 +730,22 @@ EOF exit ;; C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) echo c1-convex-bsd - exit ;; + exit ;; C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) if getsysinfo -f scalar_acc then echo c32-convex-bsd else echo c2-convex-bsd fi - exit ;; + exit ;; C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) echo c34-convex-bsd - exit ;; + exit ;; C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) echo c38-convex-bsd - exit ;; + exit ;; C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) echo c4-convex-bsd - exit ;; + exit ;; CRAY*Y-MP:*:*:*) echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; @@ -749,14 +769,14 @@ EOF exit ;; F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` - echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit ;; + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` + echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; 5000:UNIX_System_V:4.*:*) - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` - echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` + echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" exit ;; i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} @@ -768,38 +788,51 @@ EOF echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} exit ;; *:FreeBSD:*:*) - case ${UNAME_MACHINE} in - pc98) - echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + UNAME_PROCESSOR=`/usr/bin/uname -p` + case ${UNAME_PROCESSOR} in + amd64) + echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; *) - echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + echo ${UNAME_PROCESSOR}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; esac exit ;; i*:CYGWIN*:*) echo ${UNAME_MACHINE}-pc-cygwin exit ;; - i*:MINGW*:*) - echo ${UNAME_MACHINE}-pc-mingw32 + *:MINGW64*:*) + echo ${UNAME_MACHINE}-pc-mingw64 exit ;; - i*:MSYS_NT-*:*:*) + *:MINGW*:*) echo ${UNAME_MACHINE}-pc-mingw32 exit ;; + i*:MSYS*:*) + echo ${UNAME_MACHINE}-pc-msys + exit ;; i*:windows32*:*) - # uname -m includes "-pc" on this system. - echo ${UNAME_MACHINE}-mingw32 + # uname -m includes "-pc" on this system. + echo ${UNAME_MACHINE}-mingw32 exit ;; i*:PW*:*) echo ${UNAME_MACHINE}-pc-pw32 exit ;; - x86:Interix*:[345]*) - echo i586-pc-interix${UNAME_RELEASE} - exit ;; - EM64T:Interix*:[345]*) - echo x86_64-unknown-interix${UNAME_RELEASE} - exit ;; + *:Interix*:*) + case ${UNAME_MACHINE} in + x86) + echo i586-pc-interix${UNAME_RELEASE} + exit ;; + authenticamd | genuineintel | EM64T) + echo x86_64-unknown-interix${UNAME_RELEASE} + exit ;; + IA64) + echo ia64-unknown-interix${UNAME_RELEASE} + exit ;; + esac ;; [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) echo i${UNAME_MACHINE}-pc-mks exit ;; + 8664:Windows_NT:*) + echo x86_64-pc-mks + exit ;; i*:Windows_NT*:* | Pentium*:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we @@ -829,17 +862,68 @@ EOF i*86:Minix:*:*) echo ${UNAME_MACHINE}-pc-minix exit ;; + aarch64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + aarch64_be:Linux:*:*) + UNAME_MACHINE=aarch64_be + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + alpha:Linux:*:*) + case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in + EV5) UNAME_MACHINE=alphaev5 ;; + EV56) UNAME_MACHINE=alphaev56 ;; + PCA56) UNAME_MACHINE=alphapca56 ;; + PCA57) UNAME_MACHINE=alphapca56 ;; + EV6) UNAME_MACHINE=alphaev6 ;; + EV67) UNAME_MACHINE=alphaev67 ;; + EV68*) UNAME_MACHINE=alphaev68 ;; + esac + objdump --private-headers /bin/sh | grep -q ld.so.1 + if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi + echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + exit ;; arm*:Linux:*:*) + eval $set_cc_for_build + if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_EABI__ + then + echo ${UNAME_MACHINE}-unknown-linux-gnu + else + if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_PCS_VFP + then + echo ${UNAME_MACHINE}-unknown-linux-gnueabi + else + echo ${UNAME_MACHINE}-unknown-linux-gnueabihf + fi + fi + exit ;; + avr32*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; cris:Linux:*:*) - echo cris-axis-linux-gnu + echo ${UNAME_MACHINE}-axis-linux-gnu exit ;; crisv32:Linux:*:*) - echo crisv32-axis-linux-gnu + echo ${UNAME_MACHINE}-axis-linux-gnu exit ;; frv:Linux:*:*) - echo frv-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + hexagon:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + i*86:Linux:*:*) + LIBC=gnu + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #ifdef __dietlibc__ + LIBC=dietlibc + #endif +EOF + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'` + echo "${UNAME_MACHINE}-pc-linux-${LIBC}" exit ;; ia64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu @@ -850,74 +934,36 @@ EOF m68*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - mips:Linux:*:*) - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #undef CPU - #undef mips - #undef mipsel - #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mipsel - #else - #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips - #else - CPU= - #endif - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" - test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } - ;; - mips64:Linux:*:*) + mips:Linux:*:* | mips64:Linux:*:*) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #undef CPU - #undef mips64 - #undef mips64el + #undef ${UNAME_MACHINE} + #undef ${UNAME_MACHINE}el #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mips64el + CPU=${UNAME_MACHINE}el #else #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips64 + CPU=${UNAME_MACHINE} #else CPU= #endif #endif EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'` test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } ;; - or32:Linux:*:*) - echo or32-unknown-linux-gnu + or1k:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - ppc:Linux:*:*) - echo powerpc-unknown-linux-gnu + or32:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - ppc64:Linux:*:*) - echo powerpc64-unknown-linux-gnu + padre:Linux:*:*) + echo sparc-unknown-linux-gnu exit ;; - alpha:Linux:*:*) - case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in - EV5) UNAME_MACHINE=alphaev5 ;; - EV56) UNAME_MACHINE=alphaev56 ;; - PCA56) UNAME_MACHINE=alphapca56 ;; - PCA57) UNAME_MACHINE=alphapca56 ;; - EV6) UNAME_MACHINE=alphaev6 ;; - EV67) UNAME_MACHINE=alphaev67 ;; - EV68*) UNAME_MACHINE=alphaev68 ;; - esac - objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null - if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi - echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + parisc64:Linux:*:* | hppa64:Linux:*:*) + echo hppa64-unknown-linux-gnu exit ;; parisc:Linux:*:* | hppa:Linux:*:*) # Look for CPU level @@ -927,14 +973,17 @@ EOF *) echo hppa-unknown-linux-gnu ;; esac exit ;; - parisc64:Linux:*:* | hppa64:Linux:*:*) - echo hppa64-unknown-linux-gnu + ppc64:Linux:*:*) + echo powerpc64-unknown-linux-gnu + exit ;; + ppc:Linux:*:*) + echo powerpc-unknown-linux-gnu exit ;; s390:Linux:*:* | s390x:Linux:*:*) echo ${UNAME_MACHINE}-ibm-linux exit ;; sh64*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; sh*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu @@ -942,75 +991,18 @@ EOF sparc:Linux:*:* | sparc64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; + tile*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; vax:Linux:*:*) echo ${UNAME_MACHINE}-dec-linux-gnu exit ;; x86_64:Linux:*:*) - echo x86_64-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + xtensa*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - i*86:Linux:*:*) - # The BFD linker knows what the default object file format is, so - # first see if it will tell us. cd to the root directory to prevent - # problems with other programs or directories called `ld' in the path. - # Set LC_ALL=C to ensure ld outputs messages in English. - ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \ - | sed -ne '/supported targets:/!d - s/[ ][ ]*/ /g - s/.*supported targets: *// - s/ .*// - p'` - case "$ld_supported_targets" in - elf32-i386) - TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu" - ;; - a.out-i386-linux) - echo "${UNAME_MACHINE}-pc-linux-gnuaout" - exit ;; - coff-i386) - echo "${UNAME_MACHINE}-pc-linux-gnucoff" - exit ;; - "") - # Either a pre-BFD a.out linker (linux-gnuoldld) or - # one that does not give us useful --help. - echo "${UNAME_MACHINE}-pc-linux-gnuoldld" - exit ;; - esac - # Determine whether the default compiler is a.out or elf - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #include <features.h> - #ifdef __ELF__ - # ifdef __GLIBC__ - # if __GLIBC__ >= 2 - LIBC=gnu - # else - LIBC=gnulibc1 - # endif - # else - LIBC=gnulibc1 - # endif - #else - #if defined(__INTEL_COMPILER) || defined(__PGI) || defined(__sun) - LIBC=gnu - #else - LIBC=gnuaout - #endif - #endif - #ifdef __dietlibc__ - LIBC=dietlibc - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^LIBC/{ - s: ::g - p - }'`" - test x"${LIBC}" != x && { - echo "${UNAME_MACHINE}-pc-linux-${LIBC}" - exit - } - test x"${TENTATIVE}" != x && { echo "${TENTATIVE}"; exit; } - ;; i*86:DYNIX/ptx:4*:*) # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. # earlier versions are messed up and put the nodename in both @@ -1018,11 +1010,11 @@ EOF echo i386-sequent-sysv4 exit ;; i*86:UNIX_SV:4.2MP:2.*) - # Unixware is an offshoot of SVR4, but it has its own version - # number series starting with 2... - # I am not positive that other SVR4 systems won't match this, + # Unixware is an offshoot of SVR4, but it has its own version + # number series starting with 2... + # I am not positive that other SVR4 systems won't match this, # I just have to hope. -- rms. - # Use sysv4.2uw... so that sysv4* matches it. + # Use sysv4.2uw... so that sysv4* matches it. echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} exit ;; i*86:OS/2:*:*) @@ -1039,7 +1031,7 @@ EOF i*86:syllable:*:*) echo ${UNAME_MACHINE}-pc-syllable exit ;; - i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*) + i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) echo i386-unknown-lynxos${UNAME_RELEASE} exit ;; i*86:*DOS:*:*) @@ -1054,7 +1046,7 @@ EOF fi exit ;; i*86:*:5:[678]*) - # UnixWare 7.x, OpenUNIX and OpenServer 6. + # UnixWare 7.x, OpenUNIX and OpenServer 6. case `/bin/uname -X | grep "^Machine"` in *486*) UNAME_MACHINE=i486 ;; *Pentium) UNAME_MACHINE=i586 ;; @@ -1082,10 +1074,13 @@ EOF exit ;; pc:*:*:*) # Left here for compatibility: - # uname -m prints for DJGPP always 'pc', but it prints nothing about - # the processor, so we play safe by assuming i386. - echo i386-pc-msdosdjgpp - exit ;; + # uname -m prints for DJGPP always 'pc', but it prints nothing about + # the processor, so we play safe by assuming i586. + # Note: whatever this is, it MUST be the same as what config.sub + # prints for the "djgpp" host, or else GDB configury will decide that + # this is a cross-build. + echo i586-pc-msdosdjgpp + exit ;; Intel:Mach:3*:*) echo i386-pc-mach3 exit ;; @@ -1120,8 +1115,18 @@ EOF /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4; exit; } ;; + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4; exit; } ;; + NCR*:*:4.2:* | MPRAS*:*:4.2:*) + OS_REL='.3' + test -r /etc/.relid \ + && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) echo m68k-unknown-lynxos${UNAME_RELEASE} exit ;; @@ -1134,7 +1139,7 @@ EOF rs6000:LynxOS:2.*:*) echo rs6000-unknown-lynxos${UNAME_RELEASE} exit ;; - PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*) + PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) echo powerpc-unknown-lynxos${UNAME_RELEASE} exit ;; SM[BE]S:UNIX_SV:*:*) @@ -1154,10 +1159,10 @@ EOF echo ns32k-sni-sysv fi exit ;; - PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort - # says <[email protected]> - echo i586-unisys-sysv4 - exit ;; + PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort + # says <[email protected]> + echo i586-unisys-sysv4 + exit ;; *:UNIX_System_V:4*:FTX*) # From Gerald Hewes <[email protected]>. # How about differentiating between stratus architectures? -djm @@ -1183,11 +1188,11 @@ EOF exit ;; R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) if [ -d /usr/nec ]; then - echo mips-nec-sysv${UNAME_RELEASE} + echo mips-nec-sysv${UNAME_RELEASE} else - echo mips-unknown-sysv${UNAME_RELEASE} + echo mips-unknown-sysv${UNAME_RELEASE} fi - exit ;; + exit ;; BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. echo powerpc-be-beos exit ;; @@ -1197,6 +1202,12 @@ EOF BePC:BeOS:*:*) # BeOS running on Intel PC compatible. echo i586-pc-beos exit ;; + BePC:Haiku:*:*) # Haiku running on Intel PC compatible. + echo i586-pc-haiku + exit ;; + x86_64:Haiku:*:*) + echo x86_64-unknown-haiku + exit ;; SX-4:SUPER-UX:*:*) echo sx4-nec-superux${UNAME_RELEASE} exit ;; @@ -1206,6 +1217,15 @@ EOF SX-6:SUPER-UX:*:*) echo sx6-nec-superux${UNAME_RELEASE} exit ;; + SX-7:SUPER-UX:*:*) + echo sx7-nec-superux${UNAME_RELEASE} + exit ;; + SX-8:SUPER-UX:*:*) + echo sx8-nec-superux${UNAME_RELEASE} + exit ;; + SX-8R:SUPER-UX:*:*) + echo sx8r-nec-superux${UNAME_RELEASE} + exit ;; Power*:Rhapsody:*:*) echo powerpc-apple-rhapsody${UNAME_RELEASE} exit ;; @@ -1215,6 +1235,16 @@ EOF *:Darwin:*:*) UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown case $UNAME_PROCESSOR in + i386) + eval $set_cc_for_build + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + UNAME_PROCESSOR="x86_64" + fi + fi ;; unknown) UNAME_PROCESSOR=powerpc ;; esac echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} @@ -1230,7 +1260,10 @@ EOF *:QNX:*:4*) echo i386-pc-qnx exit ;; - NSE-?:NONSTOP_KERNEL:*:*) + NEO-?:NONSTOP_KERNEL:*:*) + echo neo-tandem-nsk${UNAME_RELEASE} + exit ;; + NSE-*:NONSTOP_KERNEL:*:*) echo nse-tandem-nsk${UNAME_RELEASE} exit ;; NSR-?:NONSTOP_KERNEL:*:*) @@ -1275,13 +1308,13 @@ EOF echo pdp10-unknown-its exit ;; SEI:*:*:SEIUX) - echo mips-sei-seiux${UNAME_RELEASE} + echo mips-sei-seiux${UNAME_RELEASE} exit ;; *:DragonFly:*:*) echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` exit ;; *:*VMS:*:*) - UNAME_MACHINE=`(uname -p) 2>/dev/null` + UNAME_MACHINE=`(uname -p) 2>/dev/null` case "${UNAME_MACHINE}" in A*) echo alpha-dec-vms ; exit ;; I*) echo ia64-dec-vms ; exit ;; @@ -1296,11 +1329,14 @@ EOF i*86:rdos:*:*) echo ${UNAME_MACHINE}-pc-rdos exit ;; + i*86:AROS:*:*) + echo ${UNAME_MACHINE}-pc-aros + exit ;; + x86_64:VMkernel:*:*) + echo ${UNAME_MACHINE}-unknown-esx + exit ;; esac -#echo '(No uname command or uname output not recognized.)' 1>&2 -#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 - eval $set_cc_for_build cat >$dummy.c <<EOF #ifdef _SEQUENT_ @@ -1318,11 +1354,11 @@ main () #include <sys/param.h> printf ("m68k-sony-newsos%s\n", #ifdef NEWSOS4 - "4" + "4" #else - "" + "" #endif - ); exit (0); + ); exit (0); #endif #endif @@ -1456,9 +1492,9 @@ This script, last modified $timestamp, has failed to recognize the operating system you are using. It is advised that you download the most up to date version of the config scripts from - http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.guess + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD and - http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.sub + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD If the version you run ($0) is already up to date, please send the following data and any information you think might be diff --git a/lib/wx/autoconf/config.sub b/lib/wx/autoconf/config.sub index 9772e87d24..bb6edbdb47 100755 --- a/lib/wx/autoconf/config.sub +++ b/lib/wx/autoconf/config.sub @@ -1,42 +1,40 @@ #! /bin/sh # Configuration validation subroutine script. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003 Free Software Foundation, Inc. +# Copyright 1992-2013 Free Software Foundation, Inc. -timestamp='2003-02-22' +timestamp='2013-02-12' -# This file is (in principle) common to ALL GNU software. -# The presence of a machine in this file suggests that SOME GNU software -# can handle that machine. It does not imply ALL GNU software can. -# -# This file is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or +# This file is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. - +# along with this program; if not, see <http://www.gnu.org/licenses/>. +# # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). -# Please send patches to <[email protected]>. Submit a context -# diff and a properly formatted ChangeLog entry. + +# Please send patches with a ChangeLog entry to [email protected]. # # Configuration subroutine to validate and canonicalize a configuration type. # Supply the specified configuration type as an argument. # If it is invalid, we print an error message on stderr and exit with code 1. # Otherwise, we print the canonical config type on stdout and succeed. +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD + # This file is supposed to be the same for all GNU packages # and recognize all the CPU types, system types and aliases # that are meaningful with *any* GNU software. @@ -70,8 +68,7 @@ Report bugs and patches to <[email protected]>." version="\ GNU config.sub ($timestamp) -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001 -Free Software Foundation, Inc. +Copyright 1992-2013 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -83,11 +80,11 @@ Try \`$me --help' for more information." while test $# -gt 0 ; do case $1 in --time-stamp | --time* | -t ) - echo "$timestamp" ; exit 0 ;; + echo "$timestamp" ; exit ;; --version | -v ) - echo "$version" ; exit 0 ;; + echo "$version" ; exit ;; --help | --h* | -h ) - echo "$usage"; exit 0 ;; + echo "$usage"; exit ;; -- ) # Stop option processing shift; break ;; - ) # Use stdin as input. @@ -99,7 +96,7 @@ while test $# -gt 0 ; do *local*) # First pass through any local machine types. echo $1 - exit 0;; + exit ;; * ) break ;; @@ -118,10 +115,18 @@ esac # Here we must recognize all the valid KERNEL-OS combinations. maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` case $maybe_os in - nto-qnx* | linux-gnu* | freebsd*-gnu* | netbsd*-gnu* | storm-chaos* | os2-emx* | rtmk-nova*) + nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \ + linux-musl* | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \ + knetbsd*-gnu* | netbsd*-gnu* | \ + kopensolaris*-gnu* | \ + storm-chaos* | os2-emx* | rtmk-nova*) os=-$maybe_os basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` ;; + android-linux) + os=-linux-android + basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-unknown + ;; *) basic_machine=`echo $1 | sed 's/-[^-]*$//'` if [ $basic_machine != $1 ] @@ -144,10 +149,13 @@ case $os in -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ - -apple | -axis) + -apple | -axis | -knuth | -cray | -microblaze*) os= basic_machine=$1 ;; + -bluegene*) + os=-cnk + ;; -sim | -cisco | -oki | -wec | -winbond) os= basic_machine=$1 @@ -162,13 +170,17 @@ case $os in os=-chorusos basic_machine=$1 ;; - -chorusrdb) - os=-chorusrdb + -chorusrdb) + os=-chorusrdb basic_machine=$1 - ;; + ;; -hiux*) os=-hiuxwe2 ;; + -sco6) + os=-sco5v6 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; -sco5) os=-sco3.2v5 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` @@ -185,6 +197,10 @@ case $os in # Don't forget version if it is 3.2v4 or newer. basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; + -sco5v6*) + # Don't forget version if it is 3.2v4 or newer. + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; -sco*) os=-sco3.2v2 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` @@ -202,6 +218,12 @@ case $os in -isc*) basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; + -lynx*178) + os=-lynxos178 + ;; + -lynx*5) + os=-lynxos5 + ;; -lynx*) os=-lynxos ;; @@ -226,55 +248,106 @@ case $basic_machine in # Some are omitted here because they have special meanings below. 1750a | 580 \ | a29k \ + | aarch64 | aarch64_be \ | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ - | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr \ - | clipper \ + | am33_2.0 \ + | arc \ + | arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv7[arm] \ + | avr | avr32 \ + | be32 | be64 \ + | bfin \ + | c4x | clipper \ | d10v | d30v | dlx | dsp16xx \ - | fr30 | frv \ + | epiphany \ + | fido | fr30 | frv \ | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ + | hexagon \ | i370 | i860 | i960 | ia64 \ - | ip2k \ - | m32r | m68000 | m68k | m88k | mcore \ + | ip2k | iq2000 \ + | le32 | le64 \ + | lm32 \ + | m32c | m32r | m32rle | m68000 | m68k | m88k \ + | maxq | mb | microblaze | microblazeel | mcore | mep | metag \ | mips | mipsbe | mipseb | mipsel | mipsle \ | mips16 \ | mips64 | mips64el \ - | mips64vr | mips64vrel \ + | mips64octeon | mips64octeonel \ | mips64orion | mips64orionel \ + | mips64r5900 | mips64r5900el \ + | mips64vr | mips64vrel \ | mips64vr4100 | mips64vr4100el \ | mips64vr4300 | mips64vr4300el \ | mips64vr5000 | mips64vr5000el \ + | mips64vr5900 | mips64vr5900el \ | mipsisa32 | mipsisa32el \ | mipsisa32r2 | mipsisa32r2el \ | mipsisa64 | mipsisa64el \ + | mipsisa64r2 | mipsisa64r2el \ | mipsisa64sb1 | mipsisa64sb1el \ | mipsisa64sr71k | mipsisa64sr71kel \ + | mipsr5900 | mipsr5900el \ | mipstx39 | mipstx39el \ | mn10200 | mn10300 \ + | moxie \ + | mt \ | msp430 \ + | nds32 | nds32le | nds32be \ + | nios | nios2 | nios2eb | nios2el \ | ns16k | ns32k \ - | openrisc | or32 \ + | open8 \ + | or1k | or32 \ | pdp10 | pdp11 | pj | pjl \ - | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \ + | powerpc | powerpc64 | powerpc64le | powerpcle \ | pyramid \ - | sh | sh[1234] | sh[23]e | sh[34]eb | shbe | shle | sh[1234]le | sh3ele \ + | rl78 | rx \ + | score \ + | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ | sh64 | sh64le \ - | sparc | sparc64 | sparc86x | sparclet | sparclite | sparcv9 | sparcv9b \ - | strongarm \ - | tahoe | thumb | tic80 | tron \ - | v850 | v850e \ + | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ + | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ + | spu \ + | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \ + | ubicom32 \ + | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \ | we32k \ - | x86 | xscale | xstormy16 | xtensa \ - | z8k) + | x86 | xc16x | xstormy16 | xtensa \ + | z8k | z80) basic_machine=$basic_machine-unknown ;; - m6811 | m68hc11 | m6812 | m68hc12) - # Motorola 68HC11/12. + c54x) + basic_machine=tic54x-unknown + ;; + c55x) + basic_machine=tic55x-unknown + ;; + c6x) + basic_machine=tic6x-unknown + ;; + m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | picochip) basic_machine=$basic_machine-unknown os=-none ;; m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k) ;; + ms1) + basic_machine=mt-unknown + ;; + + strongarm | thumb | xscale) + basic_machine=arm-unknown + ;; + xgate) + basic_machine=$basic_machine-unknown + os=-none + ;; + xscaleeb) + basic_machine=armeb-unknown + ;; + + xscaleel) + basic_machine=armel-unknown + ;; # We use `pc' rather than `unknown' # because (1) that's what they normally are, and @@ -290,58 +363,82 @@ case $basic_machine in # Recognize the basic CPU types with company name. 580-* \ | a29k-* \ + | aarch64-* | aarch64_be-* \ | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \ | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ - | avr-* \ - | bs2000-* \ - | c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \ - | clipper-* | cydra-* \ + | avr-* | avr32-* \ + | be32-* | be64-* \ + | bfin-* | bs2000-* \ + | c[123]* | c30-* | [cjt]90-* | c4x-* \ + | clipper-* | craynv-* | cydra-* \ | d10v-* | d30v-* | dlx-* \ | elxsi-* \ - | f30[01]-* | f700-* | fr30-* | frv-* | fx80-* \ + | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \ | h8300-* | h8500-* \ | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ + | hexagon-* \ | i*86-* | i860-* | i960-* | ia64-* \ - | ip2k-* \ - | m32r-* \ + | ip2k-* | iq2000-* \ + | le32-* | le64-* \ + | lm32-* \ + | m32c-* | m32r-* | m32rle-* \ | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ - | m88110-* | m88k-* | mcore-* \ + | m88110-* | m88k-* | maxq-* | mcore-* | metag-* \ + | microblaze-* | microblazeel-* \ | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ | mips16-* \ | mips64-* | mips64el-* \ - | mips64vr-* | mips64vrel-* \ + | mips64octeon-* | mips64octeonel-* \ | mips64orion-* | mips64orionel-* \ + | mips64r5900-* | mips64r5900el-* \ + | mips64vr-* | mips64vrel-* \ | mips64vr4100-* | mips64vr4100el-* \ | mips64vr4300-* | mips64vr4300el-* \ | mips64vr5000-* | mips64vr5000el-* \ + | mips64vr5900-* | mips64vr5900el-* \ | mipsisa32-* | mipsisa32el-* \ | mipsisa32r2-* | mipsisa32r2el-* \ | mipsisa64-* | mipsisa64el-* \ + | mipsisa64r2-* | mipsisa64r2el-* \ | mipsisa64sb1-* | mipsisa64sb1el-* \ | mipsisa64sr71k-* | mipsisa64sr71kel-* \ + | mipsr5900-* | mipsr5900el-* \ | mipstx39-* | mipstx39el-* \ + | mmix-* \ + | mt-* \ | msp430-* \ - | none-* | np1-* | nv1-* | ns16k-* | ns32k-* \ + | nds32-* | nds32le-* | nds32be-* \ + | nios-* | nios2-* | nios2eb-* | nios2el-* \ + | none-* | np1-* | ns16k-* | ns32k-* \ + | open8-* \ | orion-* \ | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ - | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \ + | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \ | pyramid-* \ - | romp-* | rs6000-* \ - | sh-* | sh[1234]-* | sh[23]e-* | sh[34]eb-* | shbe-* \ + | rl78-* | romp-* | rs6000-* | rx-* \ + | sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ - | sparc-* | sparc64-* | sparc86x-* | sparclet-* | sparclite-* \ - | sparcv9-* | sparcv9b-* | strongarm-* | sv1-* | sx?-* \ - | tahoe-* | thumb-* \ + | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ + | sparclite-* \ + | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx?-* \ + | tahoe-* \ | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ + | tile*-* \ | tron-* \ - | v850-* | v850e-* | vax-* \ + | ubicom32-* \ + | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \ + | vax-* \ | we32k-* \ - | x86-* | x86_64-* | xps100-* | xscale-* | xstormy16-* \ - | xtensa-* \ + | x86-* | x86_64-* | xc16x-* | xps100-* \ + | xstormy16-* | xtensa*-* \ | ymp-* \ - | z8k-*) + | z8k-* | z80-*) + ;; + # Recognize the basic CPU types without company name, with glob match. + xtensa*) + basic_machine=$basic_machine-unknown ;; # Recognize the various machine names and aliases which stand # for a CPU type and a company and sometimes even an OS. @@ -359,6 +456,9 @@ case $basic_machine in basic_machine=a29k-amd os=-udi ;; + abacus) + basic_machine=abacus-unknown + ;; adobe68k) basic_machine=m68010-adobe os=-scout @@ -373,6 +473,12 @@ case $basic_machine in basic_machine=a29k-none os=-bsd ;; + amd64) + basic_machine=x86_64-pc + ;; + amd64-*) + basic_machine=x86_64-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; amdahl) basic_machine=580-amdahl os=-sysv @@ -396,6 +502,10 @@ case $basic_machine in basic_machine=m68k-apollo os=-bsd ;; + aros) + basic_machine=i386-pc + os=-aros + ;; aux) basic_machine=m68k-apple os=-aux @@ -404,10 +514,35 @@ case $basic_machine in basic_machine=ns32k-sequent os=-dynix ;; + blackfin) + basic_machine=bfin-unknown + os=-linux + ;; + blackfin-*) + basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; + bluegene*) + basic_machine=powerpc-ibm + os=-cnk + ;; + c54x-*) + basic_machine=tic54x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c55x-*) + basic_machine=tic55x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c6x-*) + basic_machine=tic6x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; c90) basic_machine=c90-cray os=-unicos ;; + cegcc) + basic_machine=arm-unknown + os=-cegcc + ;; convex-c1) basic_machine=c1-convex os=-bsd @@ -432,12 +567,27 @@ case $basic_machine in basic_machine=j90-cray os=-unicos ;; + craynv) + basic_machine=craynv-cray + os=-unicosmp + ;; + cr16 | cr16-*) + basic_machine=cr16-unknown + os=-elf + ;; crds | unos) basic_machine=m68k-crds ;; + crisv32 | crisv32-* | etraxfs*) + basic_machine=crisv32-axis + ;; cris | cris-* | etrax*) basic_machine=cris-axis ;; + crx) + basic_machine=crx-unknown + os=-elf + ;; da30 | da30-*) basic_machine=m68k-da30 ;; @@ -460,6 +610,14 @@ case $basic_machine in basic_machine=m88k-motorola os=-sysv3 ;; + dicos) + basic_machine=i686-pc + os=-dicos + ;; + djgpp) + basic_machine=i586-pc + os=-msdosdjgpp + ;; dpx20 | dpx20-*) basic_machine=rs6000-bull os=-bosx @@ -571,7 +729,6 @@ case $basic_machine in i370-ibm* | ibm*) basic_machine=i370-ibm ;; -# I'm not sure what "Sysv32" means. Should this be sysv3.2? i*86v32) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv32 @@ -610,6 +767,14 @@ case $basic_machine in basic_machine=m68k-isi os=-sysv ;; + m68knommu) + basic_machine=m68k-unknown + os=-linux + ;; + m68knommu-*) + basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; m88k-omron*) basic_machine=m88k-omron ;; @@ -621,10 +786,21 @@ case $basic_machine in basic_machine=ns32k-utek os=-sysv ;; + microblaze*) + basic_machine=microblaze-xilinx + ;; + mingw64) + basic_machine=x86_64-pc + os=-mingw64 + ;; mingw32) basic_machine=i386-pc os=-mingw32 ;; + mingw32ce) + basic_machine=arm-unknown + os=-mingw32ce + ;; miniframe) basic_machine=m68000-convergent ;; @@ -638,10 +814,6 @@ case $basic_machine in mips3*) basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown ;; - mmix*) - basic_machine=mmix-knuth - os=-mmixware - ;; monitor) basic_machine=m68k-rom68k os=-coff @@ -654,10 +826,21 @@ case $basic_machine in basic_machine=i386-pc os=-msdos ;; + ms1-*) + basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` + ;; + msys) + basic_machine=i386-pc + os=-msys + ;; mvs) basic_machine=i370-ibm os=-mvs ;; + nacl) + basic_machine=le32-unknown + os=-nacl + ;; ncr3000) basic_machine=i486-ncr os=-sysv4 @@ -722,9 +905,11 @@ case $basic_machine in np1) basic_machine=np1-gould ;; - nv1) - basic_machine=nv1-cray - os=-unicosmp + neo-tandem) + basic_machine=neo-tandem + ;; + nse-tandem) + basic_machine=nse-tandem ;; nsr-tandem) basic_machine=nsr-tandem @@ -733,9 +918,12 @@ case $basic_machine in basic_machine=hppa1.1-oki os=-proelf ;; - or32 | or32-*) + openrisc | openrisc-*) basic_machine=or32-unknown - os=-coff + ;; + os400) + basic_machine=powerpc-ibm + os=-os400 ;; OSE68000 | ose68000) basic_machine=m68000-ericsson @@ -753,6 +941,14 @@ case $basic_machine in basic_machine=i860-intel os=-osf ;; + parisc) + basic_machine=hppa-unknown + os=-linux + ;; + parisc-*) + basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; pbd) basic_machine=sparc-tti ;; @@ -762,32 +958,45 @@ case $basic_machine in pc532 | pc532-*) basic_machine=ns32k-pc532 ;; + pc98) + basic_machine=i386-pc + ;; + pc98-*) + basic_machine=i386-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; pentium | p5 | k5 | k6 | nexgen | viac3) basic_machine=i586-pc ;; pentiumpro | p6 | 6x86 | athlon | athlon_*) basic_machine=i686-pc ;; - pentiumii | pentium2) + pentiumii | pentium2 | pentiumiii | pentium3) basic_machine=i686-pc ;; + pentium4) + basic_machine=i786-pc + ;; pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*) basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pentiumpro-* | p6-* | 6x86-* | athlon-*) basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` ;; - pentiumii-* | pentium2-*) + pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*) basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` ;; + pentium4-*) + basic_machine=i786-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; pn) basic_machine=pn-gould ;; power) basic_machine=power-ibm ;; - ppc) basic_machine=powerpc-unknown + ppc | ppcbe) basic_machine=powerpc-unknown ;; - ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` + ppc-* | ppcbe-*) + basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppcle | powerpclittle | ppc-le | powerpc-little) basic_machine=powerpcle-unknown @@ -812,6 +1021,14 @@ case $basic_machine in basic_machine=i586-unknown os=-pw32 ;; + rdos | rdos64) + basic_machine=x86_64-pc + os=-rdos + ;; + rdos32) + basic_machine=i386-pc + os=-rdos + ;; rom68k) basic_machine=m68k-rom68k os=-coff @@ -838,6 +1055,14 @@ case $basic_machine in sb1el) basic_machine=mipsisa64sb1el-unknown ;; + sde) + basic_machine=mipsisa32-sde + os=-elf + ;; + sei) + basic_machine=mips-sei + os=-seiux + ;; sequent) basic_machine=i386-sequent ;; @@ -845,6 +1070,12 @@ case $basic_machine in basic_machine=sh-hitachi os=-hms ;; + sh5el) + basic_machine=sh5le-unknown + ;; + sh64) + basic_machine=sh64-unknown + ;; sparclite-wrs | simso-wrs) basic_machine=sparclite-wrs os=-vxworks @@ -863,6 +1094,9 @@ case $basic_machine in basic_machine=i860-stratus os=-sysv4 ;; + strongarm-* | thumb-*) + basic_machine=arm-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; sun2) basic_machine=m68000-sun ;; @@ -919,21 +1153,9 @@ case $basic_machine in basic_machine=t90-cray os=-unicos ;; - tic4x | c4x*) - basic_machine=tic4x-unknown - os=-coff - ;; - tic54x | c54x*) - basic_machine=tic54x-unknown - os=-coff - ;; - tic55x | c55x*) - basic_machine=tic55x-unknown - os=-coff - ;; - tic6x | c6x*) - basic_machine=tic6x-unknown - os=-coff + tile*) + basic_machine=$basic_machine-unknown + os=-linux-gnu ;; tx39) basic_machine=mipstx39-unknown @@ -948,6 +1170,10 @@ case $basic_machine in tower | tower-32) basic_machine=m68k-ncr ;; + tpf) + basic_machine=s390x-ibm + os=-tpf + ;; udi29k) basic_machine=a29k-amd os=-udi @@ -991,9 +1217,16 @@ case $basic_machine in basic_machine=hppa1.1-winbond os=-proelf ;; + xbox) + basic_machine=i686-pc + os=-mingw32 + ;; xps | xps100) basic_machine=xps100-honeywell ;; + xscale-* | xscalee[bl]-*) + basic_machine=`echo $basic_machine | sed 's/^xscale/arm/'` + ;; ymp) basic_machine=ymp-cray os=-unicos @@ -1002,6 +1235,10 @@ case $basic_machine in basic_machine=z8k-unknown os=-sim ;; + z80-*-coff) + basic_machine=z80-unknown + os=-sim + ;; none) basic_machine=none-none os=-none @@ -1021,6 +1258,9 @@ case $basic_machine in romp) basic_machine=romp-ibm ;; + mmix) + basic_machine=mmix-knuth + ;; rs6000) basic_machine=rs6000-ibm ;; @@ -1037,13 +1277,10 @@ case $basic_machine in we32k) basic_machine=we32k-att ;; - sh3 | sh4 | sh[34]eb | sh[1234]le | sh[23]ele) + sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele) basic_machine=sh-unknown ;; - sh64) - basic_machine=sh64-unknown - ;; - sparc | sparcv9 | sparcv9b) + sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v) basic_machine=sparc-sun ;; cydra) @@ -1087,9 +1324,12 @@ esac if [ x"$os" != x"" ] then case $os in - # First match some system type aliases - # that might get confused with valid system types. + # First match some system type aliases + # that might get confused with valid system types. # -solaris* is a basic system type, with this one exception. + -auroraux) + os=-auroraux + ;; -solaris1 | -solaris1.*) os=`echo $os | sed -e 's|solaris1|sunos4|'` ;; @@ -1110,25 +1350,31 @@ case $os in # Each alternative MUST END IN A *, to match a version number. # -sysv* is not here because it comes later, after sysvr4. -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ - | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\ - | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ + | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\ + | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \ + | -sym* | -kopensolaris* | -plan9* \ | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ - | -aos* \ + | -aos* | -aros* \ | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ - | -hiux* | -386bsd* | -netbsd* | -openbsd* | -freebsd* | -riscix* \ - | -lynxos* | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ + | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ + | -bitrig* | -openbsd* | -solidbsd* \ + | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ + | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ - | -chorusos* | -chorusrdb* \ - | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ - | -mingw32* | -linux-gnu* | -uxpv* | -beos* | -mpeix* | -udk* \ + | -chorusos* | -chorusrdb* | -cegcc* \ + | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ + | -mingw32* | -mingw64* | -linux-gnu* | -linux-android* \ + | -linux-newlib* | -linux-musl* | -linux-uclibc* \ + | -uxpv* | -beos* | -mpeix* | -udk* \ | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \ | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ - | -powermax* | -dnix*) + | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ + | -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es*) # Remember, each alternative MUST END IN *, to match a version number. ;; -qnx*) @@ -1146,12 +1392,15 @@ case $os in os=`echo $os | sed -e 's|nto|nto-qnx|'` ;; -sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \ - | -windows* | -osx | -abug | -netware* | -os9* | -beos* \ + | -windows* | -osx | -abug | -netware* | -os9* | -beos* | -haiku* \ | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*) ;; -mac*) os=`echo $os | sed -e 's|mac|macos|'` ;; + -linux-dietlibc) + os=-linux-dietlibc + ;; -linux*) os=`echo $os | sed -e 's|linux|linux-gnu|'` ;; @@ -1164,6 +1413,9 @@ case $os in -opened*) os=-openedition ;; + -os400*) + os=-os400 + ;; -wince*) os=-wince ;; @@ -1185,6 +1437,9 @@ case $os in -atheos*) os=-atheos ;; + -syllable*) + os=-syllable + ;; -386bsd) os=-bsd ;; @@ -1207,6 +1462,9 @@ case $os in -sinix*) os=-sysv4 ;; + -tpf*) + os=-tpf + ;; -triton*) os=-sysv3 ;; @@ -1240,8 +1498,13 @@ case $os in -aros*) os=-aros ;; - -kaos*) - os=-kaos + -zvmoe) + os=-zvmoe + ;; + -dicos*) + os=-dicos + ;; + -nacl*) ;; -none) ;; @@ -1265,6 +1528,12 @@ else # system, and we'll never get to this point. case $basic_machine in + score-*) + os=-elf + ;; + spu-*) + os=-elf + ;; *-acorn) os=-riscix1.2 ;; @@ -1274,6 +1543,21 @@ case $basic_machine in arm*-semi) os=-aout ;; + c4x-* | tic4x-*) + os=-coff + ;; + hexagon-*) + os=-elf + ;; + tic54x-*) + os=-coff + ;; + tic55x-*) + os=-coff + ;; + tic6x-*) + os=-coff + ;; # This must come before the *-dec entry. pdp10-*) os=-tops20 @@ -1292,19 +1576,22 @@ case $basic_machine in ;; m68000-sun) os=-sunos3 - # This also exists in the configure program, but was not the - # default. - # os=-sunos4 ;; m68*-cisco) os=-aout ;; + mep-*) + os=-elf + ;; mips*-cisco) os=-elf ;; mips*-*) os=-elf ;; + or1k-*) + os=-elf + ;; or32-*) os=-coff ;; @@ -1317,9 +1604,15 @@ case $basic_machine in *-be) os=-beos ;; + *-haiku) + os=-haiku + ;; *-ibm) os=-aix ;; + *-knuth) + os=-mmixware + ;; *-wec) os=-proelf ;; @@ -1422,7 +1715,7 @@ case $basic_machine in -sunos*) vendor=sun ;; - -aix*) + -cnk*|-aix*) vendor=ibm ;; -beos*) @@ -1452,9 +1745,15 @@ case $basic_machine in -mvs* | -opened*) vendor=ibm ;; + -os400*) + vendor=ibm + ;; -ptx*) vendor=sequent ;; + -tpf*) + vendor=ibm + ;; -vxsim* | -vxworks* | -windiss*) vendor=wrs ;; @@ -1479,7 +1778,7 @@ case $basic_machine in esac echo $basic_machine$os -exit 0 +exit # Local variables: # eval: (add-hook 'write-file-hooks 'time-stamp) @@ -1487,3 +1786,4 @@ exit 0 # time-stamp-format: "%:y-%02m-%02d" # time-stamp-end: "'" # End: + diff --git a/make/otp.mk.in b/make/otp.mk.in index 91e2d8a95e..785926b997 100644 --- a/make/otp.mk.in +++ b/make/otp.mk.in @@ -270,44 +270,44 @@ $(SPECDIR)/specs_%.xml: $(SPECS_ESRC)/%.erl $(MAN1DIR)/%.1: %.xml - date=`date +"%B %e %Y"`; \ + date=`date +"%B %e, %Y"`; \ xsltproc --output "$@" --stringparam company "Ericsson AB" --stringparam docgen "$(DOCGEN)" --stringparam gendate "$$date" --stringparam appname "$(APPLICATION)" --stringparam appver "$(VSN)" --xinclude -path $(DOCGEN)/priv/dtd -path $(DOCGEN)/priv/dtd_man_entities $(DOCGEN)/priv/xsl/db_man.xsl $< $(MAN2DIR)/%.2: %.xml - date=`date +"%B %e %Y"`; \ + date=`date +"%B %e, %Y"`; \ xsltproc --output "$@" --stringparam company "Ericsson AB" --stringparam docgen "$(DOCGEN)" --stringparam gendate "$$date" --stringparam appname "$(APPLICATION)" --stringparam appver "$(VSN)" --xinclude -path $(DOCGEN)/priv/dtd -path $(DOCGEN)/priv/dtd_man_entities $(DOCGEN)/priv/xsl/db_man.xsl $< ifneq ($(wildcard $(SPECDIR)),) $(MAN3DIR)/%.3: %.xml $(SPECDIR)/specs_%.xml - date=`date +"%B %e %Y"`; \ + date=`date +"%B %e, %Y"`; \ specs_file=`pwd`/$(SPECDIR)/specs_$*.xml; \ xsltproc --output "$@" --stringparam company "Ericsson AB" --stringparam docgen "$(DOCGEN)" --stringparam gendate "$$date" --stringparam appname "$(APPLICATION)" --stringparam appver "$(VSN)" --stringparam specs_file "$$specs_file" --xinclude -path $(DOCGEN)/priv/dtd -path $(DOCGEN)/priv/dtd_man_entities $(DOCGEN)/priv/xsl/db_man.xsl $< else $(MAN3DIR)/%.3: %.xml - date=`date +"%B %e %Y"`; \ + date=`date +"%B %e, %Y"`; \ xsltproc --output "$@" --stringparam company "Ericsson AB" --stringparam docgen "$(DOCGEN)" --stringparam gendate "$$date" --stringparam appname "$(APPLICATION)" --stringparam appver "$(VSN)" --xinclude -path $(DOCGEN)/priv/dtd -path $(DOCGEN)/priv/dtd_man_entities $(DOCGEN)/priv/xsl/db_man.xsl $< endif # left for compatibility $(MAN4DIR)/%.4: %.xml - date=`date +"%B %e %Y"`; \ + date=`date +"%B %e, %Y"`; \ xsltproc --output "$@" --stringparam company "Ericsson AB" --stringparam docgen "$(DOCGEN)" --stringparam gendate "$$date" --stringparam appname "$(APPLICATION)" --stringparam appver "$(VSN)" --xinclude -path $(DOCGEN)/priv/dtd -path $(DOCGEN)/priv/dtd_man_entities $(DOCGEN)/priv/xsl/db_man.xsl $< $(MAN4DIR)/%.5: %.xml - date=`date +"%B %e %Y"`; \ + date=`date +"%B %e, %Y"`; \ xsltproc --output "$@" --stringparam company "Ericsson AB" --stringparam docgen "$(DOCGEN)" --stringparam gendate "$$date" --stringparam appname "$(APPLICATION)" --stringparam appver "$(VSN)" --xinclude -path $(DOCGEN)/priv/dtd -path $(DOCGEN)/priv/dtd_man_entities $(DOCGEN)/priv/xsl/db_man.xsl $< # left for compatibility $(MAN6DIR)/%.6: %_app.xml - date=`date +"%B %e %Y"`; \ + date=`date +"%B %e, %Y"`; \ xsltproc --output "$@" --stringparam company "Ericsson AB" --stringparam docgen "$(DOCGEN)" --stringparam gendate "$$date" --stringparam appname "$(APPLICATION)" --stringparam appver "$(VSN)" --xinclude -path $(DOCGEN)/priv/dtd -path $(DOCGEN)/priv/dtd_man_entities $(DOCGEN)/priv/xsl/db_man.xsl $< $(MAN6DIR)/%.7: %_app.xml - date=`date +"%B %e %Y"`; \ + date=`date +"%B %e, %Y"`; \ xsltproc --output "$@" --stringparam company "Ericsson AB" --stringparam docgen "$(DOCGEN)" --stringparam gendate "$$date" --stringparam appname "$(APPLICATION)" --stringparam appver "$(VSN)" --xinclude -path $(DOCGEN)/priv/dtd -path $(DOCGEN)/priv/dtd_man_entities $(DOCGEN)/priv/xsl/db_man.xsl $< $(MAN9DIR)/%.9: %.xml - date=`date +"%B %e %Y"`; \ + date=`date +"%B %e, %Y"`; \ xsltproc --output "$@" --stringparam company "Ericsson AB" --stringparam docgen "$(DOCGEN)" --stringparam gendate "$$date" --stringparam appname "$(APPLICATION)" --stringparam appver "$(VSN)" --xinclude -path $(DOCGEN)/priv/dtd -path $(DOCGEN)/priv/dtd_man_entities $(DOCGEN)/priv/xsl/db_man.xsl $< diff --git a/make/otp_release_targets.mk b/make/otp_release_targets.mk index 998e25a436..b6afcd1c8b 100644 --- a/make/otp_release_targets.mk +++ b/make/otp_release_targets.mk @@ -32,7 +32,7 @@ endif ifeq ($(TOPDOC),) $(HTMLDIR)/index.html: $(XML_FILES) $(SPECS_FILES) - date=`date +"%B %e %Y"`; \ + date=`date +"%B %e, %Y"`; \ $(XSLTPROC) --noout \ --stringparam outdir $(HTMLDIR) \ --stringparam docgen "$(DOCGEN)" \ @@ -53,7 +53,7 @@ $(HTMLDIR)/index.html: $(XML_FILES) $(SPECS_FILES) endif $(HTMLDIR)/users_guide.html: $(XML_FILES) - date=`date +"%B %e %Y"`; \ + date=`date +"%B %e, %Y"`; \ $(XSLTPROC) --noout \ --stringparam outdir $(HTMLDIR) \ --stringparam docgen "$(DOCGEN)" \ @@ -72,7 +72,7 @@ $(HTMLDIR)/users_guide.html: $(XML_FILES) $(DOCGEN)/priv/xsl/db_html.xsl book.xml %.fo: $(XML_FILES) $(SPECS_FILES) - date=`date +"%B %e %Y"`; \ + date=`date +"%B %e, %Y"`; \ $(XSLTPROC) \ --stringparam docgen "$(DOCGEN)" \ --stringparam gendate "$$date" \ @@ -94,7 +94,7 @@ ifneq ($(XML_FILES),) # Generation of application index data # ---------------------------------------------------- $(HTMLDIR)/$(APPLICATION).eix: $(XML_FILES) $(SPECS_FILES) - date=`date +"%B %e %Y"`; \ + date=`date +"%B %e, %Y"`; \ $(XSLTPROC) --stringparam docgen "$(DOCGEN)" \ --stringparam gendate "$$date" \ --stringparam appname "$(APPLICATION)" \ diff --git a/system/doc/reference_manual/data_types.xml b/system/doc/reference_manual/data_types.xml index df1c0f8fa8..73ec6e2b82 100644 --- a/system/doc/reference_manual/data_types.xml +++ b/system/doc/reference_manual/data_types.xml @@ -393,7 +393,15 @@ hello 12> <input>term_to_binary({a,b,c}).</input> <<131,104,3,100,0,1,97,100,0,1,98,100,0,1,99>> 13> <input>binary_to_term(<<131,104,3,100,0,1,97,100,0,1,98,100,0,1,99>>).</input> -{a,b,c}</pre> +{a,b,c} +14> <input>binary_to_integer(<<"77">>).</input> +77 +15> <input>integer_to_binary(77).</input> +<<"77">> +16> <input>float_to_binary(7.0).</input> +<<"7.00000000000000000000e+00">> +17> <input>binary_to_float(<<"7.000e+00>>").</input> +7.0</pre> </section> </chapter> diff --git a/system/doc/reference_manual/typespec.xml b/system/doc/reference_manual/typespec.xml index 9207d536d5..1279493ba8 100644 --- a/system/doc/reference_manual/typespec.xml +++ b/system/doc/reference_manual/typespec.xml @@ -1,4 +1,4 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="iso-8859-1" ?> <!DOCTYPE chapter SYSTEM "chapter.dtd"> <chapter> @@ -13,12 +13,12 @@ compliance with the License. You should have received a copy of the Erlang Public License along with this software. If not, it can be retrieved online at http://www.erlang.org/. - + Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. - + </legalnotice> <title>Types and Function Specifications</title> @@ -30,111 +30,121 @@ </header> <section> - <title>Introduction of Types</title> - <p> - Erlang is a dynamically typed language. Still, it comes with a - language extension for declaring sets of Erlang terms to form a - particular type, effectively forming a specific sub-type of the set - of all Erlang terms. - </p> - <p> - Subsequently, these types can be used to specify types of record fields - and the argument and return types of functions. - </p> - <p> - Type information can be used to document function interfaces, - provide more information for bug detection tools such as <c>Dialyzer</c>, - and can be exploited by documentation tools such as <c>Edoc</c> for - generating program documentation of various forms. - It is expected that the type language described in this document will - supersede and replace the purely comment-based <c>@type</c> and - <c>@spec</c> declarations used by <c>Edoc</c>. - </p> + <title>The Erlang Type Language</title> + <p> + Erlang is a dynamically typed language. Still, it comes with a + notation for declaring sets of Erlang terms to form a particular + type, effectively forming a specific sub-type of the set of all + Erlang terms. + </p> + <p> + Subsequently, these types can be used to specify types of record fields + and the argument and return types of functions. + </p> + <p> + Type information can be used to document function interfaces, + provide more information for bug detection tools such as <c>Dialyzer</c>, + and can be exploited by documentation tools such as <c>Edoc</c> for + generating program documentation of various forms. + It is expected that the type language described in this document will + supersede and replace the purely comment-based <c>@type</c> and + <c>@spec</c> declarations used by <c>Edoc</c>. + </p> </section> <section> <marker id="syntax"></marker> <title>Types and their Syntax</title> <p> - Types describe sets of Erlang terms. - Types consist and are built from a set of predefined types (e.g. <c>integer()</c>, - <c>atom()</c>, <c>pid()</c>, ...) described below. - Predefined types represent a typically infinite set of Erlang terms which - belong to this type. - For example, the type <c>atom()</c> stands for the set of all Erlang atoms. - </p> - <p> - For integers and atoms, we allow for singleton types (e.g. the integers <c>-1</c> - and <c>42</c> or the atoms <c>'foo'</c> and <c>'bar'</c>). + Types describe sets of Erlang terms. + Types consist and are built from a set of predefined types + (e.g. <c>integer()</c>, <c>atom()</c>, <c>pid()</c>, ...) + described below. + Predefined types represent a typically infinite set of Erlang terms which + belong to this type. For example, the type <c>atom()</c> stands for the + set of all Erlang atoms. + </p> + <p> + For integers and atoms, we allow for singleton types (e.g. the integers + <c>-1</c> and <c>42</c> or the atoms <c>'foo'</c> and <c>'bar'</c>). - All other types are built using unions of either predefined types or singleton - types. In a type union between a type and one of its sub-types the sub-type is - absorbed by the super-type and the union is subsequently treated as if the - sub-type was not a constituent of the union. For example, the type union: + All other types are built using unions of either predefined + types or singleton types. In a type union between a type and one + of its sub-types the sub-type is absorbed by the super-type and + the union is subsequently treated as if the sub-type was not a + constituent of the union. For example, the type union: </p> - <pre> - atom() | 'bar' | integer() | 42</pre> - <p> - describes the same set of terms as the type union: - </p> - <pre> -atom() | integer()</pre> - <p> - Because of sub-type relations that exist between types, types form a lattice - where the topmost element, any(), denotes the set of all Erlang terms and - the bottom-most element, none(), denotes the empty set of terms. - </p> - <p> - The set of predefined types and the syntax for types is given below: - </p> - <pre><![CDATA[ -Type :: any() %% The top type, the set of all Erlang terms. - | none() %% The bottom type, contains no terms. - | pid() - | port() - | reference() - | [] %% nil - | Atom - | Binary - | float() - | Fun - | Integer - | List - | Tuple - | Union - | UserDefined %% described in Section 2 + <pre> atom() | 'bar' | integer() | 42</pre> + <p> + describes the same set of terms as the type union: + </p> + <pre> atom() | integer()</pre> + <p> + Because of sub-type relations that exist between types, types + form a lattice where the topmost element, <c>any()</c>, denotes + the set of all Erlang terms and the bottom-most element, <c>none()</c>, + denotes the empty set of terms. + </p> + <p> + The set of predefined types and the syntax for types is given below: + </p> + <pre><![CDATA[ + Type :: any() %% The top type, the set of all Erlang terms + | none() %% The bottom type, contains no terms + | pid() + | port() + | reference() + | [] %% nil + | Atom + | Bitstring + | float() + | Fun + | Integer + | List + | Tuple + | Union + | UserDefined %% described in Section 6.3 -Union :: Type1 | Type2 + Atom :: atom() + | Erlang_Atom %% 'foo', 'bar', ... -Atom :: atom() - | Erlang_Atom %% 'foo', 'bar', ... + Bitstring :: <<>> + | <<_:M>> %% M is a positive integer + | <<_:_*N>> %% N is a positive integer + | <<_:M, _:_*N>> -Binary :: binary() %% <<_:_ * 8>> - | <<>> - | <<_:Erlang_Integer>> %% Base size - | <<_:_*Erlang_Integer>> %% Unit size - | <<_:Erlang_Integer, _:_*Erlang_Integer>> + Fun :: fun() %% any function + | fun((...) -> Type) %% any arity, returning Type + | fun(() -> Type) + | fun((TList) -> Type) -Fun :: fun() %% any function - | fun((...) -> Type) %% any arity, returning Type - | fun(() -> Type) - | fun((TList) -> Type) + Integer :: integer() + | Erlang_Integer %% ..., -1, 0, 1, ... 42 ... + | Erlang_Integer..Erlang_Integer %% specifies an integer range -Integer :: integer() - | Erlang_Integer %% ..., -1, 0, 1, ... 42 ... - | Erlang_Integer..Erlang_Integer %% specifies an integer range + List :: list(Type) %% Proper list ([]-terminated) + | improper_list(Type1, Type2) %% Type1=contents, Type2=termination + | maybe_improper_list(Type1, Type2) %% Type1 and Type2 as above -List :: list(Type) %% Proper list ([]-terminated) - | improper_list(Type1, Type2) %% Type1=contents, Type2=termination - | maybe_improper_list(Type1, Type2) %% Type1 and Type2 as above + Tuple :: tuple() %% stands for a tuple of any size + | {} + | {TList} -Tuple :: tuple() %% stands for a tuple of any size - | {} - | {TList} + TList :: Type + | Type, TList -TList :: Type - | Type, TList + Union :: Type1 | Type2 ]]></pre> <p> + The general form of bitstrings is <c><<_:M, _:_*N>></c>, + where <c>M</c> and <c>N</c> are positive integers. It denotes a + bitstring that is <c>M + (k*N)</c> bits long (i.e., a bitstring that + starts with <c>M</c> bits and continues with <c>k</c> segments of + <c>N</c> bits each, where <c>k</c> is also a positive integer). + The notations <c><<_:_*N>></c>, <c><<_:M>></c>, + and <c><<>></c> are convenient shorthands for the cases + that <c>M</c>, <c>N</c>, or both, respectively, are zero. + </p> + <p> Because lists are commonly used, they have shorthand type notations. The type <c>list(T)</c> has the shorthand <c>[T]</c>. The shorthand <c>[T,...]</c> stands for @@ -154,11 +164,17 @@ TList :: Type </p> <table> <row> - <cell><b>Built-in type</b></cell><cell><b>Stands for</b></cell> + <cell><b>Built-in type</b></cell><cell><b>Defined as</b></cell> </row> <row> <cell><c>term()</c></cell><cell><c>any()</c></cell> </row> + <row> + <cell><c>binary()</c></cell><cell><c><<_:*8>></c></cell> + </row> + <row> + <cell><c>bitstring()</c></cell><cell><c><<_:*1>></c></cell> + </row> <row> <cell><c>boolean()</c></cell><cell><c>'false' | 'true'</c></cell> </row> @@ -169,15 +185,6 @@ TList :: Type <cell><c>char()</c></cell><cell><c>0..16#10ffff</c></cell> </row> <row> - <cell><c>non_neg_integer()</c></cell><cell><c>0..</c></cell> - </row> - <row> - <cell><c>pos_integer()</c></cell><cell><c>1..</c></cell> - </row> - <row> - <cell><c>neg_integer()</c></cell><cell><c>..-1</c></cell> - </row> - <row> <cell><c>number()</c></cell><cell><c>integer() | float()</c></cell> </row> <row> @@ -214,35 +221,54 @@ TList :: Type <cell><c>no_return()</c></cell><cell><c>none()</c></cell> </row> </table> + <p> + In addition, the following three built-in types exist and can be + thought as defined below, though strictly their "type definition" is + not valid syntax according to the type language defined above. + </p> + <table> + <row> + <cell><b>Built-in type</b></cell><cell><b>Could be thought defined by the syntax</b></cell> + </row> + <row> + <cell><c>non_neg_integer()</c></cell><cell><c>0..</c></cell> + </row> + <row> + <cell><c>pos_integer()</c></cell><cell><c>1..</c></cell> + </row> + <row> + <cell><c>neg_integer()</c></cell><cell><c>..-1</c></cell> + </row> + </table> <p> Users are not allowed to define types with the same names as the predefined or built-in ones. This is checked by the compiler and its violation results in a compilation error. - (For bootstrapping purposes, it can also result to just a warning if this - involves a built-in type which has just been introduced.) + (For bootstrapping purposes, it can also result to just a warning + if this involves a built-in type which has just been introduced.) </p> <note> The following built-in list types also exist, but they are expected to be rarely used. Hence, they have long names: </note> <pre> -nonempty_maybe_improper_list(Type) :: nonempty_maybe_improper_list(Type, any()) -nonempty_maybe_improper_list() :: nonempty_maybe_improper_list(any())</pre> + nonempty_maybe_improper_list(Type) :: nonempty_maybe_improper_list(Type, any()) + nonempty_maybe_improper_list() :: nonempty_maybe_improper_list(any())</pre> <p> where the following two types define the set of Erlang terms one would expect: </p> <pre> -nonempty_improper_list(Type1, Type2) -nonempty_maybe_improper_list(Type1, Type2)</pre> + nonempty_improper_list(Type1, Type2) + nonempty_maybe_improper_list(Type1, Type2)</pre> <p> Also for convenience, we allow for record notation to be used. Records are just shorthands for the corresponding tuples. </p> <pre> -Record :: #Erlang_Atom{} - | #Erlang_Atom{Fields}</pre> + Record :: #Erlang_Atom{} + | #Erlang_Atom{Fields}</pre> <p> Records have been extended to possibly contain type information. This is described in the sub-section <seealso marker="#typeinrecords">"Type information in record declarations"</seealso> below. @@ -257,8 +283,8 @@ Record :: #Erlang_Atom{} compiler attributes as in the following: </p> <pre> --type my_struct_type() :: Type. --opaque my_opaq_type() :: Type.</pre> + -type my_struct_type() :: Type. + -opaque my_opaq_type() :: Type.</pre> <p> where the type name is an atom (<c>'my_struct_type'</c> in the above) followed by parentheses. Type is a type as defined in the @@ -279,23 +305,23 @@ Record :: #Erlang_Atom{} definition. A concrete example appears below: </p> <pre> --type orddict(Key, Val) :: [{Key, Val}].</pre> + -type orddict(Key, Val) :: [{Key, Val}].</pre> <p> A module can export some types in order to declare that other modules are allowed to refer to them as <em>remote types</em>. This declaration has the following form: <pre> --export_type([T1/A1, ..., Tk/Ak]).</pre> + -export_type([T1/A1, ..., Tk/Ak]).</pre> where the Ti's are atoms (the name of the type) and the Ai's are their arguments. An example is given below: <pre> --export_type([my_struct_type/0, orddict/2]).</pre> + -export_type([my_struct_type/0, orddict/2]).</pre> Assuming that these types are exported from module <c>'mod'</c> then one can refer to them from other modules using remote type expressions like those below: <pre> -mod:my_struct_type() -mod:orddict(atom(), term())</pre> + mod:my_struct_type() + mod:orddict(atom(), term())</pre> One is not allowed to refer to types which are not declared as exported. </p> <p> @@ -317,19 +343,19 @@ mod:orddict(atom(), term())</pre> record. The syntax for this is: </p> <pre> --record(rec, {field1 :: Type1, field2, field3 :: Type3}).</pre> + -record(rec, {field1 :: Type1, field2, field3 :: Type3}).</pre> <p> For fields without type annotations, their type defaults to any(). I.e., the above is a shorthand for: </p> <pre> --record(rec, {field1 :: Type1, field2 :: any(), field3 :: Type3}).</pre> + -record(rec, {field1 :: Type1, field2 :: any(), field3 :: Type3}).</pre> <p> In the presence of initial values for fields, the type must be declared after the initialization as in the following: </p> <pre> --record(rec, {field1 = [] :: Type1, field2, field3 = 42 :: Type3}).</pre> + -record(rec, {field1 = [] :: Type1, field2, field3 = 42 :: Type3}).</pre> <p> Naturally, the initial values for fields should be compatible with (i.e. a member of) the corresponding types. @@ -340,13 +366,13 @@ mod:orddict(atom(), term())</pre> effects: </p> <pre> --record(rec, {f1 = 42 :: integer(), - f2 :: float(), - f3 :: 'a' | 'b'}). + -record(rec, {f1 = 42 :: integer(), + f2 :: float(), + f3 :: 'a' | 'b'}). --record(rec, {f1 = 42 :: integer(), - f2 :: 'undefined' | float(), - f3 :: 'undefined' | 'a' | 'b'}).</pre> + -record(rec, {f1 = 42 :: integer(), + f2 :: 'undefined' | float(), + f3 :: 'undefined' | 'a' | 'b'}).</pre> <p> For this reason, it is recommended that records contain initializers, whenever possible. @@ -355,15 +381,13 @@ mod:orddict(atom(), term())</pre> Any record, containing type information or not, once defined, can be used as a type using the syntax: </p> - <pre> -#rec{}</pre> + <pre> #rec{}</pre> <p> In addition, the record fields can be further specified when using a record type by adding type information about the field in the following manner: </p> - <pre> -#rec{some_field :: Type}</pre> + <pre> #rec{some_field :: Type}</pre> <p> Any unspecified fields are assumed to have the type in the original record declaration. @@ -377,7 +401,7 @@ mod:orddict(atom(), term())</pre> compiler attribute <c>'-spec'</c>. The general format is as follows: </p> <pre> --spec Module:Function(ArgType1, ..., ArgTypeN) -> ReturnType.</pre> + -spec Module:Function(ArgType1, ..., ArgTypeN) -> ReturnType.</pre> <p> The arity of the function has to match the number of arguments, or else a compilation error occurs. @@ -392,19 +416,19 @@ mod:orddict(atom(), term())</pre> For most uses within a given module, the following shorthand suffices: </p> <pre> --spec Function(ArgType1, ..., ArgTypeN) -> ReturnType.</pre> + -spec Function(ArgType1, ..., ArgTypeN) -> ReturnType.</pre> <p> Also, for documentation purposes, argument names can be given: </p> <pre> --spec Function(ArgName1 :: Type1, ..., ArgNameN :: TypeN) -> RT.</pre> + -spec Function(ArgName1 :: Type1, ..., ArgNameN :: TypeN) -> RT.</pre> <p> A function specification can be overloaded. That is, it can have several types, separated by a semicolon (<c>;</c>): </p> <pre> --spec foo(T1, T2) -> T3 - ; (T4, T5) -> T6.</pre> + -spec foo(T1, T2) -> T3 + ; (T4, T5) -> T6.</pre> <p> A current restriction, which currently results in a warning (OBS: not an error) by the compiler, is that the domains of @@ -412,8 +436,8 @@ mod:orddict(atom(), term())</pre> For example, the following specification results in a warning: </p> <pre> --spec foo(pos_integer()) -> pos_integer() - ; (integer()) -> integer().</pre> + -spec foo(pos_integer()) -> pos_integer() + ; (integer()) -> integer().</pre> <p> Type variables can be used in specifications to specify relations for the input and output arguments of a function. @@ -421,47 +445,66 @@ mod:orddict(atom(), term())</pre> polymorphic identity function: </p> <pre> --spec id(X) -> X.</pre> + -spec id(X) -> X.</pre> <p> However, note that the above specification does not restrict the input and output type in any way. - We can constrain these types by guard-like subtype constraints: + We can constrain these types by guard-like subtype constraints + and provide bounded quantification: </p> - <pre> --spec id(X) -> X when is_subtype(X, tuple()).</pre> + <pre> -spec id(X) -> X when X :: tuple().</pre> <p> - or equivalently by the more succinct and more modern form of the above: - </p> - <pre> --spec id(X) -> X when X :: tuple().</pre> - <p> - and provide bounded quantification. Currently, the <c>::</c> constraint - (the <c>is_subtype/2</c> guard) is the only guard constraint which can - be used in the <c>'when'</c> part of a <c>'-spec'</c> attribute. + Currently, the <c>::</c> constraint (read as <c>is_subtype</c>) is + the only guard constraint which can be used in the <c>'when'</c> + part of a <c>'-spec'</c> attribute. </p> + <note> + <p> + The above function specification, using multiple occurrences of + the same type variable, provides more type information than the + function specification below where the type variables are missing: + </p> + <pre> -spec id(tuple()) -> tuple().</pre> + <p> + The latter specification says that the function takes some tuple + and returns some tuple, while the one with the <c>X</c> type + variable specifies that the function takes a tuple and returns + <em>the same</em> tuple. + </p> + <p> + However, it's up to the tools that process the specs to choose + whether to take this extra information into account or ignore it. + </p> + </note> <p> The scope of an <c>::</c> constraint is the <c>(...) -> RetType</c> specification after which it appears. To avoid confusion, we suggest that different variables are used in different - constituents of an overloaded contract as in the example below: + constituents of an overloaded contract as in the example below: </p> <pre> --spec foo({X, integer()}) -> X when X :: atom() - ; ([Y]) -> Y when Y :: number().</pre> + -spec foo({X, integer()}) -> X when X :: atom() + ; ([Y]) -> Y when Y :: number().</pre> + <note> + For backwards compatibility the following form is also allowed: + <pre> -spec id(X) -> X when is_subtype(X, tuple()).</pre> + <p> + but its use is discouraged. It will be taken out in a future + Erlang/OTP release. + </p> + </note> <p> Some functions in Erlang are not meant to return; either because they define servers or because they are used to throw exceptions as the function below: </p> - <pre> -my_error(Err) -> erlang:throw({error, Err}).</pre> + <pre> my_error(Err) -> erlang:throw({error, Err}).</pre> <p> - For such functions we recommend the use of the special no_return() + For such functions we recommend the use of the special <c>no_return()</c> type for their "return", via a contract of the form: </p> - <pre> --spec my_error(term()) -> no_return().</pre> + <pre> -spec my_error(term()) -> no_return().</pre> </section> </chapter> diff --git a/system/doc/top/Makefile b/system/doc/top/Makefile index 673ba44c94..37466fa2d9 100644 --- a/system/doc/top/Makefile +++ b/system/doc/top/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1999-2012. All Rights Reserved. +# Copyright Ericsson AB 1999-2013. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -162,7 +162,7 @@ $(MAN_INDEX): $(MAN_INDEX_SCRIPT) #-------------------------------------------------------------------------- $(HTMLDIR)/highlights.html: highlights.xml - date=`date +"%B %e %Y"`; \ + date=`date +"%B %e, %Y"`; \ $(XSLTPROC) --output $(@) \ --stringparam docgen "$(DOCGEN)" \ --stringparam topdocdir "$(TOPDOCDIR)" \ @@ -179,7 +179,7 @@ $(HTMLDIR)/highlights.html: highlights.xml $(HTMLDIR)/incompatible.html: incompatible.xml - date=`date +"%B %e %Y"`; \ + date=`date +"%B %e, %Y"`; \ $(XSLTPROC) --output $(@) --stringparam docgen "$(DOCGEN)" \ --stringparam topdocdir "$(TOPDOCDIR)" \ --stringparam pdfdir "$(PDFREFDIR)" \ diff --git a/xcomp/erl-xcomp-powerpc64-bgq-linux.conf b/xcomp/erl-xcomp-powerpc64-bgq-linux.conf new file mode 100644 index 0000000000..1c45aaf86b --- /dev/null +++ b/xcomp/erl-xcomp-powerpc64-bgq-linux.conf @@ -0,0 +1,272 @@ +## -*-shell-script-*- +## +## %CopyrightBegin% +## +## Copyright Ericsson AB 2009-2013. All Rights Reserved. +## +## The contents of this file are subject to the Erlang Public License, +## Version 1.1, (the "License"); you may not use this file except in +## compliance with the License. You should have received a copy of the +## Erlang Public License along with this software. If not, it can be +## retrieved online at http://www.erlang.org/. +## +## Software distributed under the License is distributed on an "AS IS" +## basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +## the License for the specific language governing rights and limitations +## under the License. +## +## %CopyrightEnd% +## +## File: erl-xcomp.conf.template +## Author: Rickard Green +## +## ----------------------------------------------------------------------------- +## When cross compiling Erlang/OTP using `otp_build', copy this file and set +## the variables needed below. Then pass the path to the copy of this file as +## an argument to `otp_build' in the configure stage: +## `otp_build configure --xcomp-conf=<FILE>' +## ----------------------------------------------------------------------------- + +## Note that you cannot define arbitrary variables in a cross compilation +## configuration file. Only the ones listed below will be guaranteed to be +## visible throughout the whole execution of all `configure' scripts. Other +## variables needs to be defined as arguments to `configure' or exported in +## the environment. + +## -- Variables for `otp_build' Only ------------------------------------------- + +## Variables in this section are only used, when configuring Erlang/OTP for +## cross compilation using `$ERL_TOP/otp_build configure'. + +## *NOTE*! These variables currently have *no* effect if you configure using +## the `configure' script directly. + +# * `erl_xcomp_build' - The build system used. This value will be passed as +# `--build=$erl_xcomp_build' argument to the `configure' script. It does +# not have to be a full `CPU-VENDOR-OS' triplet, but can be. The full +# `CPU-VENDOR-OS' triplet will be created by +# `$ERL_TOP/erts/autoconf/config.sub $erl_xcomp_build'. If set to `guess', +# the build system will be guessed using +# `$ERL_TOP/erts/autoconf/config.guess'. +erl_xcomp_build=guess + +# * `erl_xcomp_host' - Cross host/target system to build for. This value will +# be passed as `--host=$erl_xcomp_host' argument to the `configure' script. +# It does not have to be a full `CPU-VENDOR-OS' triplet, but can be. The +# full `CPU-VENDOR-OS' triplet will be created by +# `$ERL_TOP/erts/autoconf/config.sub $erl_xcomp_host'. +erl_xcomp_host=powerpc64-bgq-linux + +# * `erl_xcomp_configure_flags' - Extra configure flags to pass to the +# `configure' script. +erl_xcomp_configure_flags="--without-termcap" + +## -- Cross Compiler and Other Tools ------------------------------------------- + +## If the cross compilation tools are prefixed by `<HOST>-' you probably do +## not need to set these variables (where `<HOST>' is what has been passed as +## `--host=<HOST>' argument to `configure'). + +## This path should really be part of the user's PATH environment, but +## since it is highly unlikely that it will differ between Blue Gene/Q +## installations, the path is hard-coded here for convenience. +TOP_BIN=/bgsys/drivers/ppcfloor/gnu-linux/bin + +## All variables in this section can also be used when native compiling. + +# * `CC' - C compiler. +CC=${TOP_BIN}/${erl_xcomp_host}-gcc + +# * `CFLAGS' - C compiler flags. +#CFLAGS= + +# * `STATIC_CFLAGS' - Static C compiler flags. +#STATIC_CFLAGS= + +# * `CFLAG_RUNTIME_LIBRARY_PATH' - This flag should set runtime library +# search path for the shared libraries. Note that this actually is a +# linker flag, but it needs to be passed via the compiler. +#CFLAG_RUNTIME_LIBRARY_PATH= + +# * `CPP' - C pre-processor. +#CPP= + +# * `CPPFLAGS' - C pre-processor flags. +#CPPFLAGS= + +# * `CXX' - C++ compiler. +CXX=${TOP_BIN}/${erl_xcomp_host}-g++ + +# * `CXXFLAGS' - C++ compiler flags. +#CXXFLAGS= + +# * `LD' - Linker. +LD=${TOP_BIN}/${erl_xcomp_host}-ld + +# * `LDFLAGS' - Linker flags. +#LDFLAGS= + +# * `LIBS' - Libraries. +#LIBS= + +## -- *D*ynamic *E*rlang *D*river Linking -- + +## *NOTE*! Either set all or none of the `DED_LD*' variables. + +# * `DED_LD' - Linker for Dynamically loaded Erlang Drivers. +#DED_LD= + +# * `DED_LDFLAGS' - Linker flags to use with `DED_LD'. +#DED_LDFLAGS= + +# * `DED_LD_FLAG_RUNTIME_LIBRARY_PATH' - This flag should set runtime library +# search path for shared libraries when linking with `DED_LD'. +#DED_LD_FLAG_RUNTIME_LIBRARY_PATH= + +## -- Large File Support -- + +## *NOTE*! Either set all or none of the `LFS_*' variables. + +# * `LFS_CFLAGS' - Large file support C compiler flags. +#LFS_CFLAGS= + +# * `LFS_LDFLAGS' - Large file support linker flags. +#LFS_LDFLAGS= + +# * `LFS_LIBS' - Large file support libraries. +#LFS_LIBS= + +## -- Other Tools -- + +# * `RANLIB' - `ranlib' archive index tool. +RANLIB=${TOP_BIN}/${erl_xcomp_host}-ranlib + +# * `AR' - `ar' archiving tool. +AR=${TOP_BIN}/${erl_xcomp_host}-ar + +# * `GETCONF' - `getconf' system configuration inspection tool. `getconf' is +# currently used for finding out large file support flags to use, and +# on Linux systems for finding out if we have an NPTL thread library or +# not. +#GETCONF= + +## -- Cross System Root Locations ---------------------------------------------- + +# * `erl_xcomp_sysroot' - The absolute path to the system root of the cross +# compilation environment. Currently, the `crypto', `odbc', `ssh' and +# `ssl' applications need the system root. These applications will be +# skipped if the system root has not been set. The system root might be +# needed for other things too. If this is the case and the system root +# has not been set, `configure' will fail and request you to set it. +#erl_xcomp_sysroot= + +# * `erl_xcomp_isysroot' - The absolute path to the system root for includes +# of the cross compilation environment. If not set, this value defaults +# to `$erl_xcomp_sysroot', i.e., only set this value if the include system +# root path is not the same as the system root path. +#erl_xcomp_isysroot= + +## -- Optional Feature, and Bug Tests ------------------------------------------ + +## These tests cannot (always) be done automatically when cross compiling. You +## usually do not need to set these variables. Only set these if you really +## know what you are doing. + +## Note that some of these values will override results of tests performed +## by `configure', and some will not be used until `configure' is sure that +## it cannot figure the result out. + +## The `configure' script will issue a warning when a default value is used. +## When a variable has been set, no warning will be issued. + +# * `erl_xcomp_after_morecore_hook' - `yes|no'. Defaults to `no'. If `yes', +# the target system must have a working `__after_morecore_hook' that can be +# used for tracking used `malloc()' implementations core memory usage. +# This is currently only used by unsupported features. +#erl_xcomp_after_morecore_hook= + +# * `erl_xcomp_bigendian' - `yes|no'. No default. If `yes', the target system +# must be big endian. If `no', little endian. This can often be +# automatically detected, but not always. If not automatically detected, +# `configure' will fail unless this variable is set. Since no default +# value is used, `configure' will try to figure this out automatically. +#erl_xcomp_bigendian= + +# * `erl_xcomp_double_middle` - `yes|no`. No default. If `yes`, the +# target system must have doubles in "middle-endian" format. If +# `no`, it has "regular" endianness. This can often be automatically +# detected, but not always. If not automatically detected, +# `configure` will fail unless this variable is set. Since no +# default value is used, `configure` will try to figure this out +# automatically. +#erl_xcomp_double_middle_endian + +# * `erl_xcomp_clock_gettime_cpu_time' - `yes|no'. Defaults to `no'. If `yes', +# the target system must have a working `clock_gettime()' implementation +# that can be used for retrieving process CPU time. +#erl_xcomp_clock_gettime_cpu_time= + +# * `erl_xcomp_getaddrinfo' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have a working `getaddrinfo()' implementation that can +# handle both IPv4 and IPv6. +#erl_xcomp_getaddrinfo= + +# * `erl_xcomp_gethrvtime_procfs_ioctl' - `yes|no'. Defaults to `no'. If `yes', +# the target system must have a working `gethrvtime()' implementation and +# is used with procfs `ioctl()'. +#erl_xcomp_gethrvtime_procfs_ioctl= + +# * `erl_xcomp_dlsym_brk_wrappers' - `yes|no'. Defaults to `no'. If `yes', the +# target system must have a working `dlsym(RTLD_NEXT, <S>)' implementation +# that can be used on `brk' and `sbrk' symbols used by the `malloc()' +# implementation in use, and by this track the `malloc()' implementations +# core memory usage. This is currently only used by unsupported features. +#erl_xcomp_dlsym_brk_wrappers= + +# * `erl_xcomp_kqueue' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have a working `kqueue()' implementation that returns a file +# descriptor which can be used by `poll()' and/or `select()'. If `no' and +# the target system has not got `epoll()' or `/dev/poll', the kernel-poll +# feature will be disabled. +#erl_xcomp_kqueue= + +# * `erl_xcomp_linux_clock_gettime_correction' - `yes|no'. Defaults to `yes' on +# Linux; otherwise, `no'. If `yes', `clock_gettime(CLOCK_MONOTONIC, _)' on +# the target system must work. This variable is recommended to be set to +# `no' on Linux systems with kernel versions less than 2.6. +#erl_xcomp_linux_clock_gettime_correction= + +# * `erl_xcomp_linux_nptl' - `yes|no'. Defaults to `yes' on Linux; otherwise, +# `no'. If `yes', the target system must have NPTL (Native POSIX Thread +# Library). Older Linux systems have LinuxThreads instead of NPTL (Linux +# kernel versions typically less than 2.6). +#erl_xcomp_linux_nptl= + +# * `erl_xcomp_linux_usable_sigaltstack' - `yes|no'. Defaults to `yes' on Linux; +# otherwise, `no'. If `yes', `sigaltstack()' must be usable on the target +# system. `sigaltstack()' on Linux kernel versions less than 2.4 are +# broken. +#erl_xcomp_linux_usable_sigaltstack= + +# * `erl_xcomp_linux_usable_sigusrx' - `yes|no'. Defaults to `yes'. If `yes', +# the `SIGUSR1' and `SIGUSR2' signals must be usable by the ERTS. Old +# LinuxThreads thread libraries (Linux kernel versions typically less than +# 2.2) used these signals and made them unusable by the ERTS. +#erl_xcomp_linux_usable_sigusrx= + +# * `erl_xcomp_poll' - `yes|no'. Defaults to `no' on Darwin/MacOSX; otherwise, +# `yes'. If `yes', the target system must have a working `poll()' +# implementation that also can handle devices. If `no', `select()' will be +# used instead of `poll()'. +#erl_xcomp_poll= + +# * `erl_xcomp_putenv_copy' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have a `putenv()' implementation that stores a copy of the +# key/value pair. +#erl_xcomp_putenv_copy= + +# * `erl_xcomp_reliable_fpe' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have reliable floating point exceptions. +#erl_xcomp_reliable_fpe= + +## ----------------------------------------------------------------------------- |