diff options
39 files changed, 935 insertions, 294 deletions
diff --git a/Makefile.in b/Makefile.in index 77dbd58181..ea95751401 100644 --- a/Makefile.in +++ b/Makefile.in @@ -175,12 +175,14 @@ BOOTSTRAP_ONLY = @BOOTSTRAP_ONLY@ CROSS_COMPILING = @CROSS_COMPILING@ ifeq ($(CROSS_COMPILING),yes) INSTALL_CROSS = -cross +TARGET_HOST=$(shell $(ERL_TOP)/erts/autoconf/config.guess) else ifneq ($(DESTDIR),) INSTALL_CROSS = -cross else INSTALL_CROSS = endif +TARGET_HOST= endif # A BSD compatible install program @@ -228,10 +230,10 @@ BOOTSTRAP_ROOT = $(ERL_TOP) LOCAL_PATH = $(ERL_TOP)/erts/bin/$(TARGET):$(ERL_TOP)/erts/bin ifeq ($(TARGET),win32) BOOT_PREFIX=$(WIN32_WRAPPER_PATH):$(BOOTSTRAP_ROOT)/bootstrap/bin: -TEST_PATH_PREFIX=$(WIN32_WRAPPER_PATH):$(ERL_TOP)/bin: +TEST_PATH_PREFIX=$(WIN32_WRAPPER_PATH):$(ERL_TOP)/bin/win32: else BOOT_PREFIX=$(BOOTSTRAP_ROOT)/bootstrap/bin: -TEST_PATH_PREFIX=$(ERL_TOP)/bin: +TEST_PATH_PREFIX=$(ERL_TOP)/bin/$(TARGET_HOST): endif # ---------------------------------------------------------------------- @@ -651,6 +653,8 @@ tertiary_bootstrap_copy: if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/wx/include ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/wx/include ; fi if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/test_server ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/test_server ; fi if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/test_server/include ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/test_server/include ; fi + if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/common_test ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/common_test ; fi + if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/common_test/include ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/common_test/include ; fi for x in lib/ic/ebin/*.beam; do \ BN=`basename $$x`; \ TF=$(BOOTSTRAP_ROOT)/bootstrap/lib/ic/ebin/$$BN; \ @@ -728,6 +732,7 @@ tertiary_bootstrap_copy: true; \ done +# copy test includes to be able to compile tests with bootstrap compiler for x in lib/test_server/include/*.hrl; do \ BN=`basename $$x`; \ TF=$(BOOTSTRAP_ROOT)/bootstrap/lib/test_server/include/$$BN; \ @@ -738,6 +743,17 @@ tertiary_bootstrap_copy: cp $$x $$TF; \ true; \ done + + for x in lib/common_test/include/*.hrl; do \ + BN=`basename $$x`; \ + TF=$(BOOTSTRAP_ROOT)/bootstrap/lib/common_test/include/$$BN; \ + test -f $$TF && \ + test '!' -z "`find $$x -newer $$TF -print`" && \ + cp $$x $$TF; \ + test '!' -f $$TF && \ + cp $$x $$TF; \ + true; \ + done # cp lib/syntax_tools/ebin/*.beam $(BOOTSTRAP_ROOT)/bootstrap/lib/syntax_tools/ebin .PHONY: check_recreate_primary_bootstrap recreate_primary_bootstrap diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index bf376f0494..76a9b55179 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -3124,6 +3124,7 @@ static int tcp_message(inet_descriptor* desc, const char* buf, int len) int i = 0; DEBUGF(("tcp_message(%ld): len = %d\r\n", (long)desc->port, len)); + /* XXX fprintf(stderr,"tcp_message send.\r\n"); */ i = LOAD_ATOM(spec, i, am_tcp); i = LOAD_PORT(spec, i, desc->dport); @@ -5426,6 +5427,7 @@ static int inet_set_opts(inet_descriptor* desc, char* ptr, int len) if (IS_SCTP(desc)) return sctp_set_opts(desc, ptr, len); #endif + /* XXX { int i; for(i=0;i<len;++i) fprintf(stderr,"0x%02X, ", (unsigned) ptr[i]); fprintf(stderr,"\r\n");} */ while(len >= 5) { opt = *ptr++; @@ -5755,10 +5757,16 @@ skip_os_setopt: if (desc->active != old_active) sock_select(desc, (FD_READ|FD_CLOSE), (desc->active>0)); + /* XXX: UDP sockets could also trigger immediate read here NIY */ if ((desc->stype==SOCK_STREAM) && desc->active) { if (!old_active || (desc->htype != old_htype)) { /* passive => active change OR header type change in active mode */ - return 1; + /* Return > 1 if only active changed to INET_ONCE -> direct read if + header type is unchanged. */ + /* XXX fprintf(stderr,"desc->htype == %d, old_htype == %d, + desc->active == %d, old_active == %d\r\n",(int)desc->htype, + (int) old_htype, (int) desc->active, (int) old_active );*/ + return 1+(desc->htype == old_htype && desc->active == INET_ONCE); } return 0; } @@ -7592,17 +7600,27 @@ static ErlDrvSSizeT inet_ctl(inet_descriptor* desc, int cmd, char* buf, case INET_REQ_SETOPTS: { /* set options */ DEBUGF(("inet_ctl(%ld): SETOPTS\r\n", (long)desc->port)); + /* XXX fprintf(stderr,"inet_ctl(%ld): SETOPTS (len = %d)\r\n", (long)desc->port,(int) len); */ switch(inet_set_opts(desc, buf, len)) { case -1: return ctl_error(EINVAL, rbuf, rsize); case 0: return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize); - default: /* active/passive change!! */ + case 1: /* * Let's hope that the descriptor really is a tcp_descriptor here. */ + /* fprintf(stderr,"Triggered tcp_deliver by setopt.\r\n"); */ tcp_deliver((tcp_descriptor *) desc, 0); return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize); + default: + /* fprintf(stderr,"Triggered tcp_recv by setopt.\r\n"); */ + /* + * Same as above, but active changed to once w/o header type + * change, so try a read instead of just deliver. + */ + tcp_recv((tcp_descriptor *) desc, 0); + return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize); } } @@ -9196,6 +9214,7 @@ static int tcp_inet_input(tcp_descriptor* desc, HANDLE event) #endif ASSERT(!INETP(desc)->is_ignored); DEBUGF(("tcp_inet_input(%ld) {s=%d\r\n", port, desc->inet.s)); + /* XXX fprintf(stderr,"tcp_inet_input(%ld) {s=%d}\r\n",(long) desc->inet.port, desc->inet.s); */ if (desc->inet.state == INET_STATE_ACCEPTING) { SOCKET s; unsigned int len; diff --git a/erts/etc/unix/run_erl.c b/erts/etc/unix/run_erl.c index 8db8e09bee..6b350e8bd5 100644 --- a/erts/etc/unix/run_erl.c +++ b/erts/etc/unix/run_erl.c @@ -126,7 +126,7 @@ /* prototypes */ static void usage(char *); static int create_fifo(char *name, int perm); -static int open_pty_master(char **name); +static int open_pty_master(char **name, int *sfd); static int open_pty_slave(char *name); static void pass_on(pid_t); static void exec_shell(char **); @@ -150,6 +150,10 @@ static int write_all(int fd, const char* buf, int len); static int extract_ctrl_seq(char* buf, int len); static void set_window_size(unsigned col, unsigned row); +static ssize_t sf_write(int fd, const void *buffer, size_t len); +static ssize_t sf_read(int fd, void *buffer, size_t len); +static int sf_open(const char *path, int flags, mode_t mode); +static int sf_close(int fd); #ifdef DEBUG static void show_terminal_settings(struct termios *t); @@ -216,7 +220,7 @@ static char* outbuf_in; int main(int argc, char **argv) { int childpid; - int sfd; + int sfd = -1; int fd; char *p, *ptyslave=NULL; int i = 1; @@ -338,9 +342,9 @@ int main(int argc, char **argv) strn_cat(fifo2, sizeof(fifo2), ".w"); /* Check that nobody is running run_erl already */ - if ((fd = open (fifo2, O_WRONLY|DONT_BLOCK_PLEASE, 0)) >= 0) { + if ((fd = sf_open(fifo2, O_WRONLY|DONT_BLOCK_PLEASE, 0)) >= 0) { /* Open as client succeeded -- run_erl is already running! */ - close(fd); + sf_close(fd); if (calculated_pipename) { ++highest_pipe_num; strn_catf(pipename, sizeof(pipename), "%s.%d", @@ -361,7 +365,7 @@ int main(int argc, char **argv) * Open master pseudo-terminal */ - if ((mfd = open_pty_master(&ptyslave)) < 0) { + if ((mfd = open_pty_master(&ptyslave, &sfd)) < 0) { ERRNO_ERR0(LOG_ERR,"Could not open pty master"); exit(1); } @@ -376,7 +380,7 @@ int main(int argc, char **argv) } if (childpid == 0) { /* Child */ - close(mfd); + sf_close(mfd); /* disassociate from control terminal */ #ifdef USE_SETPGRP_NOARGS /* SysV */ setpgrp(); @@ -386,15 +390,30 @@ int main(int argc, char **argv) setsid(); #endif /* Open the slave pty */ - if ((sfd = open_pty_slave(ptyslave)) < 0) { - ERRNO_ERR1(LOG_ERR,"Could not open pty slave '%s'", ptyslave); - exit(1); + if (sfd < 0) { + /* not allocated by open_pty_master */ + if ((sfd = open_pty_slave(ptyslave)) < 0) { + ERRNO_ERR1(LOG_ERR,"Could not open pty slave '%s'", ptyslave); + exit(1); + } + /* But sfd may be one of the stdio fd's now, and we should be unmodern and not use dup2... */ + /* easiest to dup it up... */ + while (sfd < 3) { + sfd = dup(sfd); + } } - /* But sfd may be one of the stdio fd's now, and we should be unmodern and not use dup2... */ - /* easiest to dup it up... */ - while (sfd < 3) { - sfd = dup(sfd); +#if defined(HAVE_OPENPTY) && defined(TIOCSCTTY) + else { + /* sfd is from open_pty_master + * openpty -> fork -> login_tty (forkpty) + * + * It would be preferable to implement a portable + * forkpty instead of open_pty_master / open_pty_slave + */ + /* login_tty(sfd); <- FAIL */ + ioctl(sfd, TIOCSCTTY, (char *)NULL); } +#endif #ifndef NO_SYSLOG /* Before fiddling with file descriptors we make sure syslog is turned off @@ -407,14 +426,14 @@ int main(int argc, char **argv) #endif /* Close stdio */ - close(0); - close(1); - close(2); + sf_close(0); + sf_close(1); + sf_close(2); if (dup(sfd) != 0 || dup(sfd) != 1 || dup(sfd) != 2) { status("Cannot dup\n"); } - close(sfd); + sf_close(sfd); exec_shell(argv+off_argv); /* exec_shell expects argv[2] to be */ /* the command name, so we have to */ /* adjust. */ @@ -466,7 +485,7 @@ static void pass_on(pid_t childpid) * We can't open the writing side because nobody is reading and * we'd either hang or get an error. */ - if ((rfd = open(fifo2, O_RDONLY|DONT_BLOCK_PLEASE, 0)) < 0) { + if ((rfd = sf_open(fifo2, O_RDONLY|DONT_BLOCK_PLEASE, 0)) < 0) { ERRNO_ERR1(LOG_ERR,"Could not open FIFO '%s' for reading.", fifo2); exit(1); } @@ -559,7 +578,7 @@ static void pass_on(pid_t childpid) char* buf = outbuf_first(); len = outbuf_size(); - written = write(wfd, buf, len); + written = sf_write(wfd, buf, len); if (written < 0 && errno == EAGAIN) { /* * Nothing was written - this is really strange because @@ -570,7 +589,7 @@ static void pass_on(pid_t childpid) * A write error. Assume that to_erl has terminated. */ clear_outbuf(); - close(wfd); + sf_close(wfd); wfd = 0; } else { /* Delete the written part (or all) from the buffer. */ @@ -585,10 +604,10 @@ static void pass_on(pid_t childpid) #ifdef DEBUG status("Pty master read; "); #endif - if ((len = read(mfd, buf, BUFSIZ)) <= 0) { - close(rfd); - if(wfd) close(wfd); - close(mfd); + if ((len = sf_read(mfd, buf, BUFSIZ)) <= 0) { + sf_close(rfd); + if(wfd) sf_close(wfd); + sf_close(mfd); unlink(fifo1); unlink(fifo2); if (len < 0) { @@ -619,10 +638,10 @@ static void pass_on(pid_t childpid) #ifdef DEBUG status("FIFO read; "); #endif - if ((len = read(rfd, buf, BUFSIZ)) < 0) { - close(rfd); - if(wfd) close(wfd); - close(mfd); + if ((len = sf_read(rfd, buf, BUFSIZ)) < 0) { + sf_close(rfd); + if(wfd) sf_close(wfd); + sf_close(mfd); unlink(fifo1); unlink(fifo2); ERRNO_ERR0(LOG_ERR,"Error in reading from FIFO."); @@ -631,8 +650,8 @@ static void pass_on(pid_t childpid) if(!len) { /* to_erl closed its end of the pipe */ - close(rfd); - rfd = open(fifo2, O_RDONLY|DONT_BLOCK_PLEASE, 0); + sf_close(rfd); + rfd = sf_open(fifo2, O_RDONLY|DONT_BLOCK_PLEASE, 0); if (rfd < 0) { ERRNO_ERR1(LOG_ERR,"Could not open FIFO '%s' for reading.", fifo2); exit(1); @@ -645,11 +664,11 @@ static void pass_on(pid_t childpid) * from to_erl, to_erl should already be reading this pipe - open * should succeed. But in case of error, we just ignore it. */ - if ((wfd = open(fifo1, O_WRONLY|DONT_BLOCK_PLEASE, 0)) < 0) { + if ((wfd = sf_open(fifo1, O_WRONLY|DONT_BLOCK_PLEASE, 0)) < 0) { status("Client expected on FIFO %s, but can't open (len=%d)\n", fifo1, len); - close(rfd); - rfd = open(fifo2, O_RDONLY|DONT_BLOCK_PLEASE, 0); + sf_close(rfd); + rfd = sf_open(fifo2, O_RDONLY|DONT_BLOCK_PLEASE, 0); if (rfd < 0) { ERRNO_ERR1(LOG_ERR,"Could not open FIFO '%s' for reading.", fifo2); exit(1); @@ -683,9 +702,9 @@ static void pass_on(pid_t childpid) } else if (len>0 && write_all(mfd, buf, len) != len) { ERRNO_ERR0(LOG_ERR,"Error in writing to terminal."); - close(rfd); - if(wfd) close(wfd); - close(mfd); + sf_close(rfd); + if(wfd) sf_close(wfd); + sf_close(mfd); exit(1); } } @@ -797,7 +816,7 @@ static int open_log(int log_num, int flags) /* Create or continue on the current log file */ sn_printf(buf, sizeof(buf), "%s/%s%d", log_dir, LOG_STUBNAME, log_num); - if((lfd = open(buf, flags, LOG_PERM))<0){ + if((lfd = sf_open(buf, flags, LOG_PERM))<0){ ERRNO_ERR1(LOG_ERR,"Can't open log file '%s'.", buf); exit(1); } @@ -841,7 +860,7 @@ static void write_to_log(int* lfd, int* log_num, char* buf, int len) size = lseek(*lfd,0,SEEK_END); if(size+len > log_maxsize) { - close(*lfd); + sf_close(*lfd); *log_num = next_log(*log_num); *lfd = open_log(*log_num, O_RDWR|O_CREAT|O_TRUNC|O_SYNC); } @@ -872,7 +891,7 @@ static int create_fifo(char *name, int perm) * Find a master device, open and return fd and slave device name. */ -static int open_pty_master(char **ptyslave) +static int open_pty_master(char **ptyslave, int *sfdp) { int mfd; @@ -882,7 +901,9 @@ static int open_pty_master(char **ptyslave) # ifdef HAVE_WORKING_POSIX_OPENPT if ((mfd = posix_openpt(O_RDWR)) >= 0) { # elif defined(__sun) && defined(__SVR4) - if ((mfd = open("/dev/ptmx", O_RDWR)) >= 0) { + mfd = sf_open("/dev/ptmx", O_RDWR, 0); + + if (mfd >= 0) { # endif if ((*ptyslave = ptsname(mfd)) != NULL && grantpt(mfd) == 0 && @@ -890,12 +911,12 @@ static int open_pty_master(char **ptyslave) return mfd; } - close(mfd); + sf_close(mfd); } /* fallback to openpty if it exist */ #endif -#ifdef HAVE_OPENPTY +#if defined(HAVE_OPENPTY) # ifdef PATH_MAX # define SLAVE_SIZE PATH_MAX # else @@ -903,11 +924,8 @@ static int open_pty_master(char **ptyslave) # endif { static char slave[SLAVE_SIZE]; - int sfd; # undef SLAVE_SIZE - - if (openpty(&mfd, &sfd, slave, NULL, NULL) == 0) { - close(sfd); + if (openpty(&mfd, sfdp, slave, NULL, NULL) == 0) { *ptyslave = slave; return mfd; } @@ -939,7 +957,8 @@ static int open_pty_master(char **ptyslave) for (minor = minorchars; *minor; minor++) { ptyname[10] = *minor; - if ((mfd = open(ptyname, O_RDWR, 0)) >= 0) { + + if ((mfd = sf_open(ptyname, O_RDWR, 0)) >= 0) { ptyname[9] = 's'; *ptyslave = ptyname; return mfd; @@ -957,7 +976,7 @@ static int open_pty_master(char **ptyslave) ptyname[13] = *major; for (minor = minorchars; *minor; minor++) { ptyname[14] = *minor; - if ((mfd = open(ptyname, O_RDWR, 0)) >= 0) { + if ((mfd = sf_open(ptyname, O_RDWR, 0)) >= 0) { ttyname[12] = *major; ttyname[13] = *minor; *ptyslave = ttyname; @@ -976,7 +995,7 @@ static int open_pty_master(char **ptyslave) ptyname[8] = *major; for (minor = minorchars; *minor; minor++) { ptyname[9] = *minor; - if ((mfd = open(ptyname, O_RDWR, 0)) >= 0) { + if ((mfd = sf_open(ptyname, O_RDWR, 0)) >= 0) { ptyname[5] = 't'; *ptyslave = ptyname; return mfd; @@ -993,7 +1012,7 @@ static int open_pty_slave(char *name) int sfd; struct termios tty_rmode; - if ((sfd = open(name, O_RDWR, 0)) < 0) { + if ((sfd = sf_open(name, O_RDWR, 0)) < 0) { return -1; } @@ -1120,7 +1139,7 @@ static void daemon_init(void) would be backward incompatible */ for (i = 0; i < maxfd; ++i ) { - close(i); + sf_close(i); } OPEN_SYSLOG(); @@ -1246,7 +1265,7 @@ static int write_all(int fd, const char* buf, int len) int left = len; int written; for (;;) { - written = write(fd,buf,left); + written = sf_write(fd,buf,left); if (written == left) { return len; } @@ -1258,6 +1277,36 @@ static int write_all(int fd, const char* buf, int len) } } +static ssize_t sf_read(int fd, void *buffer, size_t len) { + ssize_t n = 0; + + do { n = read(fd, buffer, len); } while (n < 0 && errno == EINTR); + + return n; +} + +static ssize_t sf_write(int fd, const void *buffer, size_t len) { + ssize_t n = 0; + + do { n = write(fd, buffer, len); } while (n < 0 && errno == EINTR); + + return n; +} + +static int sf_open(const char *path, int type, mode_t mode) { + int fd = 0; + + do { fd = open(path, type, mode); } while(fd < 0 && errno == EINTR); + + return fd; +} +static int sf_close(int fd) { + int res = 0; + + do { res = close(fd); } while(fd < 0 && errno == EINTR); + + return res; +} /* Extract any control sequences that are ment only for run_erl * and should not be forwarded to the pty. */ diff --git a/erts/test/erl_print_SUITE_data/Makefile.src b/erts/test/erl_print_SUITE_data/Makefile.src index dec5650416..ebcbb10c15 100644 --- a/erts/test/erl_print_SUITE_data/Makefile.src +++ b/erts/test/erl_print_SUITE_data/Makefile.src @@ -22,6 +22,8 @@ include @erts_lib_include_internal_generated@@[email protected] CC = @CC@ CFLAGS = @ERTS_CFLAGS@ LIBS = @ERTS_LIBS@ +CP=cp +CHMOD=chmod EPTF_CFLAGS = -Wall $(CFLAGS) @DEFS@ -I@erts_lib_include_internal@ -I@erts_lib_include_internal_generated@ EPTF_LIBS = $(LIBS) -L@erts_lib_internal_path@ -lerts_internal@type_marker@ @@ -31,12 +33,18 @@ EPTT_LIBS = -L@erts_lib_internal_path@ -lerts_internal_r@type_marker@ $(ETHR_LIB GCC = .@DS@gccifier -CC"$(CC)" -PROGS = erl_print_tests.@emu_threads@@exe@ +PROGS = erl_print_tests.true@exe@ erl_print_tests.false@exe@ all: $(PROGS) +@IFEQ@ (@cross@, yes) +gccifier@exe@: + $(CP) ..@DS@utils@[email protected] gccifier@exe@ + $(CHMOD) a+x gccifier@exe@ +@ELSE@ gccifier@exe@: ..@DS@utils@[email protected] $(CC) $(CFLAGS) -o gccifier@exe@ ..@DS@utils@[email protected] $(LIBS) +@ENDIF@ erl_print_tests.false@exe@: gccifier@exe@ erl_print_tests.c $(GCC) $(EPTF_CFLAGS) -o erl_print_tests.false@exe@ erl_print_tests.c $(EPTF_LIBS) diff --git a/erts/test/erlexec_SUITE_data/Makefile.src b/erts/test/erlexec_SUITE_data/Makefile.src index b751547b8f..970a905c32 100644 --- a/erts/test/erlexec_SUITE_data/Makefile.src +++ b/erts/test/erlexec_SUITE_data/Makefile.src @@ -20,6 +20,8 @@ CC = @CC@ CFLAGS = @ERTS_CFLAGS@ LIBS = @ERTS_LIBS@ +CP=cp +CHMOD=chmod ERLX_T_CFLAGS = -Wall $(ERLX_DEFS) $(CFLAGS) @DEFS@ @@ -29,8 +31,14 @@ PROGS = erlexec_tests@exe@ all: $(PROGS) +@IFEQ@ (@cross@, yes) +gccifier@exe@: + $(CP) ..@DS@utils@[email protected] gccifier@exe@ + $(CHMOD) a+x gccifier@exe@ +@ELSE@ gccifier@exe@: ..@DS@utils@[email protected] $(CC) $(CFLAGS) -o gccifier@exe@ ..@DS@utils@[email protected] $(LIBS) +@ENDIF@ erlexec_tests@exe@: gccifier@exe@ erlexec_tests.c $(GCC) $(ERLX_T_CFLAGS) -o erlexec_tests@exe@ erlexec_tests.c diff --git a/erts/test/ethread_SUITE_data/Makefile.src b/erts/test/ethread_SUITE_data/Makefile.src index 132b23344c..f93a31178b 100644 --- a/erts/test/ethread_SUITE_data/Makefile.src +++ b/erts/test/ethread_SUITE_data/Makefile.src @@ -23,6 +23,8 @@ include @erts_lib_include_internal_generated@@DS@erts_internal.mk CC = @CC@ CFLAGS = @ERTS_CFLAGS@ LIBS = @ERTS_LIBS@ +CP=cp +CHMOD=chmod ETHR_T_CFLAGS = -Wall $(ETHR_DEFS) $(CFLAGS) @DEFS@ -I@erts_lib_include_internal@ -I@erts_lib_include_internal_generated@ ETHR_T_LIBS = $(LIBS) -L@erts_lib_internal_path@ $(ETHR_LIBS) $(ERTS_INTERNAL_X_LIBS) @@ -33,8 +35,14 @@ PROGS = ethread_tests@exe@ all: $(PROGS) +@IFEQ@ (@cross@, yes) +gccifier@exe@: + $(CP) ..@DS@utils@[email protected] gccifier@exe@ + $(CHMOD) a+x gccifier@exe@ +@ELSE@ gccifier@exe@: ..@DS@utils@[email protected] $(CC) $(CFLAGS) -o gccifier@exe@ ..@DS@utils@[email protected] $(LIBS) +@ENDIF@ ethread_tests@exe@: gccifier@exe@ ethread_tests.c $(GCC) $(ETHR_T_CFLAGS) -o ethread_tests@exe@ ethread_tests.c -lerts_internal_r $(ETHR_T_LIBS) diff --git a/erts/test/utils/gccifier.sh b/erts/test/utils/gccifier.sh new file mode 100755 index 0000000000..4c6ba35db2 --- /dev/null +++ b/erts/test/utils/gccifier.sh @@ -0,0 +1,26 @@ +#!/bin/sh +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2005-2009. 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% +# + +CC=`echo "$1" | sed -e "s/-CC//"` +shift +echo "->" +echo "$CC $*" +$CC $* +echo "" diff --git a/lib/cosNotification/test/Makefile b/lib/cosNotification/test/Makefile index f509370430..ddd809ec65 100644 --- a/lib/cosNotification/test/Makefile +++ b/lib/cosNotification/test/Makefile @@ -128,6 +128,7 @@ ERL_COMPILE_FLAGS += \ $(ERL_IDL_FLAGS) \ -pa $(ERL_TOP)/lib/orber/include \ -pa $(ERL_TOP)/internal_tools/test_server/ebin \ + -pa $(ERL_TOP)/lib/cosEvent/ebin \ -pa $(ERL_TOP)/lib/cosNotification/ebin \ -pa $(ERL_TOP)/lib/cosNotification/test/idl_output \ -pa $(ERL_TOP)/lib/cosTime/ebin \ diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl index 04a0db890f..6d3b1f0531 100644 --- a/lib/dialyzer/src/dialyzer_cl.erl +++ b/lib/dialyzer/src/dialyzer_cl.erl @@ -188,6 +188,7 @@ plt_common(#options{init_plts = [InitPlt]} = Opts, RemoveFiles, AddFiles) -> ok -> case Opts#options.output_plt of none -> ok; + InitPlt -> ok; OutPlt -> {ok, Binary} = file:read_file(InitPlt), ok = file:write_file(OutPlt, Binary) diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index 2b78b736ab..76f23d00b9 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -344,7 +344,7 @@ insert_constraints([{subtype, Type1, Type2}|Left], Dict) -> false -> %% A lot of things should change to add supertypes throw({error, io_lib:format("First argument of is_subtype constraint " - "must be a type variable\n", [])}) + "must be a type variable: ~p\n", [Type1])}) end; insert_constraints([], Dict) -> Dict. @@ -385,9 +385,8 @@ contract_from_form([{type, _L1, bounded_fun, RecDict, FileLine, TypeAcc, FormAcc) -> TypeFun = fun(ExpTypes, AllRecords) -> - Constr1 = [constraint_from_form(C, RecDict, ExpTypes, AllRecords) - || C <- Constr], - VarDict = insert_constraints(Constr1, dict:new()), + {Constr1, VarDict} = + process_constraints(Constr, RecDict, ExpTypes, AllRecords), Type = erl_types:t_from_form(Form, RecDict, VarDict), NewType = erl_types:t_solve_remote(Type, ExpTypes, AllRecords), {NewType, Constr1} @@ -398,18 +397,66 @@ contract_from_form([{type, _L1, bounded_fun, contract_from_form([], _RecDict, _FileLine, TypeAcc, FormAcc) -> {lists:reverse(TypeAcc), lists:reverse(FormAcc)}. -constraint_from_form({type, _, constraint, [{atom, _, is_subtype}, - [Type1, Type2]]}, RecDict, - ExpTypes, AllRecords) -> - T1 = erl_types:t_from_form(Type1, RecDict), - T2 = erl_types:t_from_form(Type2, RecDict), - T3 = erl_types:t_solve_remote(T1, ExpTypes, AllRecords), - T4 = erl_types:t_solve_remote(T2, ExpTypes, AllRecords), - {subtype, T3, T4}; -constraint_from_form({type, _, constraint, [{atom,_,Name}, List]}, _RecDict, - _ExpTypes, _AllRecords) -> - N = length(List), - throw({error, io_lib:format("Unsupported type guard ~w/~w\n", [Name, N])}). +process_constraints(Constrs, RecDict, ExpTypes, AllRecords) -> + Init = initialize_constraints(Constrs, RecDict, ExpTypes, AllRecords), + constraints_fixpoint(Init, RecDict, ExpTypes, AllRecords). + +initialize_constraints(Constrs, RecDict, ExpTypes, AllRecords) -> + initialize_constraints(Constrs, RecDict, ExpTypes, AllRecords, []). + +initialize_constraints([], _RecDict, _ExpTypes, _AllRecords, Acc) -> + Acc; +initialize_constraints([Constr|Rest], RecDict, ExpTypes, AllRecords, Acc) -> + case Constr of + {type, _, constraint, [{atom, _, is_subtype}, [Type1, Type2]]} -> + T1 = final_form(Type1, RecDict, ExpTypes, AllRecords, dict:new()), + Entry = {T1, Type2}, + initialize_constraints(Rest, RecDict, ExpTypes, AllRecords, [Entry|Acc]); + {type, _, constraint, [{atom,_,Name}, List]} -> + N = length(List), + throw({error, + io_lib:format("Unsupported type guard ~w/~w\n", [Name, N])}) + end. + +constraints_fixpoint(Constrs, RecDict, ExpTypes, AllRecords) -> + VarDict = + constraints_to_dict(Constrs, RecDict, ExpTypes, AllRecords, dict:new()), + constraints_fixpoint(VarDict, Constrs, RecDict, ExpTypes, AllRecords). + +constraints_fixpoint(OldVarDict, Constrs, RecDict, ExpTypes, AllRecords) -> + NewVarDict = + constraints_to_dict(Constrs, RecDict, ExpTypes, AllRecords, OldVarDict), + case NewVarDict of + OldVarDict -> + DictFold = + fun(Key, Value, Acc) -> + [{subtype, erl_types:t_var(Key), Value}|Acc] + end, + FinalConstrs = dict:fold(DictFold, [], NewVarDict), + {FinalConstrs, NewVarDict}; + _Other -> + constraints_fixpoint(NewVarDict, Constrs, RecDict, ExpTypes, AllRecords) + end. + +-define(TYPE_LIMIT, 4). + +final_form(Form, RecDict, ExpTypes, AllRecords, VarDict) -> + T1 = erl_types:t_from_form(Form, RecDict, VarDict), + T2 = erl_types:t_solve_remote(T1, ExpTypes, AllRecords), + erl_types:t_limit(T2, ?TYPE_LIMIT). + +constraints_to_dict(Constrs, RecDict, ExpTypes, AllRecords, VarDict) -> + Subtypes = + constraints_to_subs(Constrs, RecDict, ExpTypes, AllRecords, VarDict, []), + insert_constraints(Subtypes, dict:new()). + +constraints_to_subs([], _RecDict, _ExpTypes, _AllRecords, _VarDict, Acc) -> + Acc; +constraints_to_subs([C|Rest], RecDict, ExpTypes, AllRecords, VarDict, Acc) -> + {T1, Form2} = C, + T2 = final_form(Form2, RecDict, ExpTypes, AllRecords, VarDict), + NewAcc = [{subtype, T1, T2}|Acc], + constraints_to_subs(Rest, RecDict, ExpTypes, AllRecords, VarDict, NewAcc). %% Gets the most general domain of a list of domains of all %% the overloaded contracts diff --git a/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes new file mode 100644 index 0000000000..8dc0361b0d --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes @@ -0,0 +1,31 @@ + +contracts_with_subtypes.erl:106: The call contracts_with_subtypes:rec_arg({'a','b'}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A} | {'b',B}), is_subtype(A,'a' | {'b',B}), is_subtype(B,'b' | {'a',A}) +contracts_with_subtypes.erl:107: The call contracts_with_subtypes:rec_arg({'b','a'}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A} | {'b',B}), is_subtype(A,'a' | {'b',B}), is_subtype(B,'b' | {'a',A}) +contracts_with_subtypes.erl:108: The call contracts_with_subtypes:rec_arg({'a',{'b','a'}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A} | {'b',B}), is_subtype(A,'a' | {'b',B}), is_subtype(B,'b' | {'a',A}) +contracts_with_subtypes.erl:109: The call contracts_with_subtypes:rec_arg({'b',{'a','b'}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A} | {'b',B}), is_subtype(A,'a' | {'b',B}), is_subtype(B,'b' | {'a',A}) +contracts_with_subtypes.erl:110: The call contracts_with_subtypes:rec_arg({'a',{'b',{'a','b'}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A} | {'b',B}), is_subtype(A,'a' | {'b',B}), is_subtype(B,'b' | {'a',A}) +contracts_with_subtypes.erl:111: The call contracts_with_subtypes:rec_arg({'b',{'a',{'b','a'}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A} | {'b',B}), is_subtype(A,'a' | {'b',B}), is_subtype(B,'b' | {'a',A}) +contracts_with_subtypes.erl:142: The pattern 1 can never match the type binary() | string() +contracts_with_subtypes.erl:145: The pattern 'alpha' can never match the type {'ok',X} | {'ok',X,binary() | string()} +contracts_with_subtypes.erl:147: The pattern 42 can never match the type {'ok',_} | {'ok',_,binary() | string()} +contracts_with_subtypes.erl:163: The pattern 'alpha' can never match the type {'ok',X} +contracts_with_subtypes.erl:165: The pattern 42 can never match the type {'ok',X} +contracts_with_subtypes.erl:183: The pattern 'alpha' can never match the type {'ok',X} +contracts_with_subtypes.erl:185: The pattern 42 can never match the type {'ok',X} +contracts_with_subtypes.erl:202: The pattern 1 can never match the type binary() | string() +contracts_with_subtypes.erl:205: The pattern {'ok', _} can never match the type {'ok',X,binary() | string()} +contracts_with_subtypes.erl:206: The pattern 'alpha' can never match the type {'ok',X,binary() | string()} +contracts_with_subtypes.erl:207: The pattern {'ok', 42} can never match the type {'ok',X,binary() | string()} +contracts_with_subtypes.erl:208: The pattern 42 can never match the type {'ok',X,binary() | string()} +contracts_with_subtypes.erl:234: Function flat_ets_new_t/0 has no local return +contracts_with_subtypes.erl:235: The call contracts_with_subtypes:flat_ets_new(12,[]) breaks the contract (Name,Options) -> atom() when is_subtype(Name,atom()), is_subtype(Options,[Option]), is_subtype(Option,'set' | 'ordered_set' | 'bag' | 'duplicate_bag' | 'public' | 'protected' | 'private' | 'named_table' | {'keypos',integer()} | {'heir',pid(),term()} | {'heir','none'} | {'write_concurrency',boolean()} | {'read_concurrency',boolean()} | 'compressed') +contracts_with_subtypes.erl:23: Invalid type specification for function contracts_with_subtypes:extract2/0. The success typing is () -> 'something' +contracts_with_subtypes.erl:261: Function factored_ets_new_t/0 has no local return +contracts_with_subtypes.erl:262: The call contracts_with_subtypes:factored_ets_new(12,[]) breaks the contract (Name,Options) -> atom() when is_subtype(Name,atom()), is_subtype(Options,[Option]), is_subtype(Option,Type | Access | 'named_table' | {'keypos',Pos} | {'heir',Pid::pid(),HeirData} | {'heir','none'} | Tweaks), is_subtype(Type,type()), is_subtype(Access,access()), is_subtype(Tweaks,{'write_concurrency',boolean()} | {'read_concurrency',boolean()} | 'compressed'), is_subtype(Pos,pos_integer()), is_subtype(HeirData,term()) +contracts_with_subtypes.erl:77: The call contracts_with_subtypes:foo1(5) breaks the contract (Arg1) -> Res when is_subtype(Arg1,atom()), is_subtype(Res,atom()) +contracts_with_subtypes.erl:78: The call contracts_with_subtypes:foo2(5) breaks the contract (Arg1) -> Res when is_subtype(Arg1,Arg2), is_subtype(Arg2,atom()), is_subtype(Res,atom()) +contracts_with_subtypes.erl:79: The call contracts_with_subtypes:foo3(5) breaks the contract (Arg1) -> Res when is_subtype(Arg2,atom()), is_subtype(Arg1,Arg2), is_subtype(Res,atom()) +contracts_with_subtypes.erl:7: Invalid type specification for function contracts_with_subtypes:extract/0. The success typing is () -> 'something' +contracts_with_subtypes.erl:80: The call contracts_with_subtypes:foo4(5) breaks the contract (Type) -> Type when is_subtype(Type,atom()) +contracts_with_subtypes.erl:81: The call contracts_with_subtypes:foo5(5) breaks the contract (Type::atom()) -> Type::atom() +contracts_with_subtypes.erl:82: The call contracts_with_subtypes:foo6(5) breaks the contract (Type) -> Type when is_subtype(Type,atom()) diff --git a/lib/dialyzer/test/small_SUITE_data/src/collapse_lists/a.erl b/lib/dialyzer/test/small_SUITE_data/src/collapse_lists/a.erl new file mode 100644 index 0000000000..7efe870b0d --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/collapse_lists/a.erl @@ -0,0 +1,9 @@ +-module(a). +-export([g/1]). + +-export_type([a/0, t/0]). +-type a() :: integer(). +-type t() :: a() | maybe_improper_list(t(), t()). + +-spec g(t()) -> t(). +g(X) -> X. diff --git a/lib/dialyzer/test/small_SUITE_data/src/collapse_lists/b.erl b/lib/dialyzer/test/small_SUITE_data/src/collapse_lists/b.erl new file mode 100644 index 0000000000..b08bc5e66c --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/collapse_lists/b.erl @@ -0,0 +1,5 @@ +-module(b). +-export([f/1]). + +-spec f(a:t()) -> a:t(). +f(X) -> a:g(X). diff --git a/lib/dialyzer/test/small_SUITE_data/src/contracts_with_subtypes.erl b/lib/dialyzer/test/small_SUITE_data/src/contracts_with_subtypes.erl new file mode 100644 index 0000000000..d72138d509 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/contracts_with_subtypes.erl @@ -0,0 +1,267 @@ +-module(contracts_with_subtypes). + +-compile(export_all). + +%=============================================================================== + +-spec extract() -> 'ok'. + +extract() -> + case dz_extract() of + {ok, Val} -> Val; + error -> exit(boom) + end. + +-spec dz_extract() -> RetValue when + FileList :: something, + RetValue :: {ok, FileList} | error. + +dz_extract() -> get(foo). + +%------------------------------------------------------------------------------- + +-spec extract2() -> 'ok'. + +extract2() -> + case dz_extract2() of + {ok, Val} -> Val; + error -> exit(boom) + end. + +-spec dz_extract2() -> RetValue when + RetValue :: {ok, FileList} | error, + FileList :: something. + +dz_extract2() -> get(foo). + +%=============================================================================== + +-spec foo1(Arg1) -> Res when + Arg1 :: atom(), + Res :: atom(). + +foo1(X) -> X. + +-spec foo2(Arg1) -> Res when + Arg1 :: Arg2, + Arg2 :: atom(), + Res :: atom(). + +foo2(X) -> X. + +-spec foo3(Arg1) -> Res when + Arg2 :: atom(), + Arg1 :: Arg2, + Res :: atom(). + +foo3(X) -> X. + +-spec foo4(Type) -> Type when is_subtype(Type, atom()). + +foo4(X) -> X. + +-spec foo5(Type :: atom()) -> Type :: atom(). + +foo5(X) -> X. + +-spec foo6(Type) -> Type when Type :: atom(). + +foo6(X) -> X. + +-spec foo7(Type) -> Type. + +foo7(X) -> X. + +%------------------------------------------------------------------------------- + +bar(1) -> foo1(5); +bar(2) -> foo2(5); +bar(3) -> foo3(5); +bar(4) -> foo4(5); +bar(5) -> foo5(5); +bar(6) -> foo6(5); +bar(7) -> foo7(5). + +wrong_foo6() -> + b = foo6(a). + +%=============================================================================== + +-spec rec_arg(Arg) -> ok when + Arg :: {a, A} | {b, B}, + A :: a | {b, B}, + B :: b | {a, A}. + +rec_arg(X) -> get(X). + +c(aa) -> rec_arg({a, a}); +c(bb) -> rec_arg({b, b}); +c(abb) -> rec_arg({a, {b, b}}); +c(baa) -> rec_arg({b, {a, a}}); +c(abaa) -> rec_arg({a, {b, {a, a}}}); +c(babb) -> rec_arg({b, {a, {b, b}}}); +c(ababb) -> rec_arg({a, {b, {a, {b, b}}}}); +c(babaa) -> rec_arg({b, {a, {b, {a, a}}}}). + +w(ab) -> rec_arg({a, b}); +w(ba) -> rec_arg({b, a}); +w(aba) -> rec_arg({a, {b, a}}); +w(bab) -> rec_arg({b, {a, b}}); +w(abab) -> rec_arg({a, {b, {a, b}}}); +w(baba) -> rec_arg({b, {a, {b, a}}}); +w(ababa) -> rec_arg({a, {b, {a, {b, a}}}}); +w(babab) -> rec_arg({b, {a, {b, {a, b}}}}). + +%=============================================================================== + +-type dublo(X) :: {X, X}. + +-type weird(X,Y) :: {X, Y, X, X}. + +-spec forfun(dublo(Var)) -> ok when Var :: atom(). + +forfun(_) -> ok. + +-spec forfun2(weird(Var, Var)) -> ok when Var :: atom(). + +forfun2(_) -> ok. + +%=============================================================================== + +-spec shallow(X) -> {ok, X} | {ok, X, file:filename()} | err1 | err2. + +shallow(X) -> get(X). + +st(X) when is_atom(X) -> + case shallow(X) of + err1 -> ok; + err2 -> ok; + {ok, X} -> ok; + {ok, X, Res} -> + case Res of + 1 -> bad; + _Other -> ok + end; + alpha -> bad; + {ok, 42} -> bad; + 42 -> bad + end. + +%------------------------------------------------------------------------------- + +-spec deep(X) -> Ret when + Ret :: {ok, X} | Err, + Err :: err1 | err2. + +deep(X) -> get(X). + +dt(X) when is_atom(X) -> + case deep(X) of + err1 -> ok; + err2 -> ok; + {ok, X} -> ok; + alpha -> bad; + {ok, 42} -> bad; + 42 -> bad + end. + +%------------------------------------------------------------------------------- + +-type local_errors() :: err1 | err2. + +-spec deep2(X) -> Ret when + Ret :: {ok, X} | Err, + Err :: local_errors(). + +deep2(X) -> get(X). + +dt2(X) when is_atom(X) -> + case deep2(X) of + err1 -> ok; + err2 -> ok; + {ok, X} -> ok; + alpha -> bad; + {ok, 42} -> bad; + 42 -> bad + end. + +%------------------------------------------------------------------------------- + +-spec deep3(X) -> Ret when + Ret :: {ok, X, file:filename()} | Err, + Err :: local_errors(). + +deep3(X) -> get(X). + +dt3(X) when is_atom(X) -> + case deep3(X) of + err1 -> ok; + err2 -> ok; + {ok, X, Res} -> + case Res of + 1 -> bad; + _Other -> ok + end; + {ok, X} -> bad; + alpha -> bad; + {ok, 42} -> bad; + 42 -> bad + end. + +%=============================================================================== + +-spec flat_ets_new(Name, Options) -> atom() when + Name :: atom(), + Options :: [Option], + Option :: set + | ordered_set + | bag + | duplicate_bag + | public + | protected + | private + | named_table + | {keypos, integer()} + | {heir, pid(), term()} + | {heir, none} + | {write_concurrency, boolean()} + | {read_concurrency, boolean()} + | compressed. + +flat_ets_new(Name, Options) -> + get({Name, Options}). + +flat_ets_new_t() -> + flat_ets_new(12,[]), + flat_ets_new({a,b},[]), + flat_ets_new(name,[foo]), + flat_ets_new(name,{bag}), + flat_ets_new(name,bag), + ok. + +-type access() :: public | protected | private. +-type type() :: set | ordered_set | bag | duplicate_bag. + +-spec factored_ets_new(Name, Options) -> atom() when + Name :: atom(), + Options :: [Option], + Option :: Type | Access | named_table | {keypos,Pos} + | {heir, Pid :: pid(), HeirData} | {heir, none} | Tweaks, + Type :: type(), + Access :: access(), + Tweaks :: {write_concurrency, boolean()} + | {read_concurrency, boolean()} + | compressed, + Pos :: pos_integer(), + HeirData :: term(). + +factored_ets_new(Name, Options) -> + get({Name, Options}). + +factored_ets_new_t() -> + factored_ets_new(12,[]), + factored_ets_new({a,b},[]), + factored_ets_new(name,[foo]), + factored_ets_new(name,{bag}), + factored_ets_new(name,bag), + ok. diff --git a/lib/eldap/test/Makefile b/lib/eldap/test/Makefile index a17d4f56b2..2349e4b292 100644 --- a/lib/eldap/test/Makefile +++ b/lib/eldap/test/Makefile @@ -50,7 +50,7 @@ RELSYSDIR = $(RELEASE_PATH)/eldap_test # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- -ERL_COMPILE_FLAGS += $(INCLUDES) +ERL_COMPILE_FLAGS += $(INCLUDES) -pa $(ERL_TOP)/lib/eldap/ebin EBIN = . diff --git a/lib/erl_interface/test/all_SUITE_data/Makefile.src b/lib/erl_interface/test/all_SUITE_data/Makefile.src index 70652e47c5..39085def2d 100644 --- a/lib/erl_interface/test/all_SUITE_data/Makefile.src +++ b/lib/erl_interface/test/all_SUITE_data/Makefile.src @@ -32,7 +32,7 @@ all: $(ALL_OBJS) $(EI_COMMON_OBJS): gccifier@exe@ -@IFEQ@ (@erl_interface_cross_compile@, true) +@IFEQ@ (@cross@, yes) gccifier@exe@: $(CP) gccifier.sh gccifier@exe@ $(CHMOD) a+x gccifier@exe@ diff --git a/lib/erl_interface/test/all_SUITE_data/init_tc.erl b/lib/erl_interface/test/all_SUITE_data/init_tc.erl index 7a599994fc..60c965eda3 100644 --- a/lib/erl_interface/test/all_SUITE_data/init_tc.erl +++ b/lib/erl_interface/test/all_SUITE_data/init_tc.erl @@ -48,8 +48,7 @@ run1(Name) -> generate(TcName, Cases) -> Hrl = TcName ++ "_cases.hrl", {ok, HrlFile} = file:open(Hrl, write), - {ok, Dir} = file:get_cwd(), - generate_hrl(Cases, HrlFile, {filename:join(Dir, TcName), 0}), + generate_hrl(Cases, HrlFile, {TcName, 0}), file:close(HrlFile), C = TcName ++ "_decl.c", {ok, CFile} = file:open(C, write), @@ -57,7 +56,7 @@ generate(TcName, Cases) -> file:close(CFile). generate_hrl([Case|Rest], File, {Name, Number}) -> - io:format(File, "-define(~s, {\"~s\", ~w}).~n", [Case, Name, Number]), + io:format(File, "-define(~s, {filename:join(proplists:get_value(data_dir,Config),\"~s\"), ~w}).~n", [Case, Name, Number]), generate_hrl(Rest, File, {Name, Number+1}); generate_hrl([], _, _) -> ok. diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index ceec31742e..1789fc79fa 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -2555,8 +2555,8 @@ t_subst_dict(?list(Contents, Termination, Size), Dict) -> ?nil -> ?list(NewContents, ?nil, Size); ?any -> ?list(NewContents, ?any, Size); Other -> - ?list(NewContents, NewTermination, _) = t_cons(NewContents, Other), - ?list(NewContents, NewTermination, Size) + ?list(NewContents2, NewTermination, _) = t_cons(NewContents, Other), + ?list(NewContents2, NewTermination, Size) end end; t_subst_dict(?function(Domain, Range), Dict) -> @@ -2597,8 +2597,8 @@ t_subst_aux(?list(Contents, Termination, Size), VarMap) -> ?nil -> ?list(NewContents, ?nil, Size); ?any -> ?list(NewContents, ?any, Size); Other -> - ?list(NewContents, NewTermination, _) = t_cons(NewContents, Other), - ?list(NewContents, NewTermination, Size) + ?list(NewContents2, NewTermination, _) = t_cons(NewContents, Other), + ?list(NewContents2, NewTermination, Size) end end; t_subst_aux(?function(Domain, Range), VarMap) -> @@ -3186,8 +3186,8 @@ t_abstract_records(?list(Contents, Termination, Size), RecDict) -> ?nil -> ?list(NewContents, ?nil, Size); ?any -> ?list(NewContents, ?any, Size); Other -> - ?list(NewContents, NewTermination, _) = t_cons(NewContents, Other), - ?list(NewContents, NewTermination, Size) + ?list(NewContents2, NewTermination, _) = t_cons(NewContents, Other), + ?list(NewContents2, NewTermination, Size) end end; t_abstract_records(?function(Domain, Range), RecDict) -> diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl index c74a258af9..0c53b1e85b 100644 --- a/lib/kernel/test/gen_tcp_misc_SUITE.erl +++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl @@ -2044,7 +2044,7 @@ send_timeout_active(Config) when is_list(Config) -> ?line {error,timeout} = Loop(fun() -> receive - {tcp, Sock, _Data} -> + {tcp, _Sock, _Data} -> inet:setopts(A, [{active, once}]), Res = gen_tcp:send(A,lists:duplicate(1000, $a)), %erlang:display(Res), @@ -2536,7 +2536,7 @@ otp_8102_do(LSocket, PortNum, {Bin,PType}) -> otp_9389(doc) -> ["Verify packet_size handles long HTTP header lines"]; otp_9389(suite) -> []; otp_9389(Config) when is_list(Config) -> - ?line {ok, LS} = gen_tcp:listen(0, []), + ?line {ok, LS} = gen_tcp:listen(0, [{active,false}]), ?line {ok, {_, PortNum}} = inet:sockname(LS), io:format("Listening on ~w with port number ~p\n", [LS, PortNum]), OrigLinkHdr = "/" ++ string:chars($S, 8192), diff --git a/lib/observer/src/observer_app_wx.erl b/lib/observer/src/observer_app_wx.erl index 7eac2b8fab..f9be11e05a 100644 --- a/lib/observer/src/observer_app_wx.erl +++ b/lib/observer/src/observer_app_wx.erl @@ -147,11 +147,11 @@ setup_scrollbar({CW, CH}, AppWin, #app{dim={W0,H0}}) -> H = max(H0,CH), PPC = 20, if W0 =< CW, H0 =< CH -> - wxScrolledWindow:setScrollbars(AppWin, W, H, 1, 1); + wxScrolledWindow:setScrollbars(AppWin, W, H, 0, 0); H0 =< CH -> - wxScrolledWindow:setScrollbars(AppWin, PPC, H, W div PPC+1, 1); + wxScrolledWindow:setScrollbars(AppWin, PPC, H, W div PPC+1, 0); W0 =< CW -> - wxScrolledWindow:setScrollbars(AppWin, W, PPC, 1, H div PPC+1); + wxScrolledWindow:setScrollbars(AppWin, W, PPC, 0, H div PPC+1); true -> wxScrolledWindow:setScrollbars(AppWin, PPC, PPC, W div PPC+1, H div PPC+1) end; @@ -204,7 +204,7 @@ handle_event(#wx{id=?ID_PROC_MSG, event=#wxCommand{type=command_menu_selected}}, handle_event(#wx{id=?ID_PROC_KILL, event=#wxCommand{type=command_menu_selected}}, State = #state{panel=Panel, sel={#box{s1=#str{pid=Pid}},_}}) -> - case observer_lib:user_term(Panel, "Enter Exit Reason", "") of + case observer_lib:user_term(Panel, "Enter Exit Reason", "kill") of cancel -> ok; {ok, Term} -> exit(Pid, Term); {error, Error} -> observer_lib:display_info_dialog(Error) @@ -267,24 +267,17 @@ handle_call(Event, From, _State) -> handle_cast(Event, _State) -> error({unhandled_cast, Event}). %%%%%%%%%% -handle_info({active, Node}, State = #state{parent=Parent, current=Curr, appmon=Appmon}) -> +handle_info({active, Node}, State = #state{parent=Parent, current=Curr}) -> create_menus(Parent, []), {ok, Pid} = appmon_info:start_link(Node, self(), []), - case Appmon of - undefined -> ok; - Pid -> ok; - _ -> %% Deregister me as client (and stop appmon if last) - exit(Appmon, normal) - end, appmon_info:app_ctrl(Pid, Node, true, []), (Curr =/= undefined) andalso appmon_info:app(Pid, Curr, true, []), {noreply, State#state{appmon=Pid}}; - -handle_info(not_active, State = #state{appmon=AppMon, current=Prev}) -> +handle_info(not_active, State = #state{appmon=AppMon}) -> appmon_info:app_ctrl(AppMon, node(AppMon), false, []), - (Prev =/= undefined) andalso appmon_info:app(AppMon, Prev, false, []), - {noreply, State}; - + lists:member(node(AppMon), nodes()) andalso exit(AppMon, normal), + observer_wx:set_status(""), + {noreply, State#state{appmon=undefined}}; handle_info({delivery, Pid, app_ctrl, _, Apps0}, State = #state{appmon=Pid, apps_w=LBox, current=Curr0}) -> Apps = [atom_to_list(App) || {_, App, {_, _, _}} <- Apps0], @@ -341,6 +334,7 @@ handle_mouse_click(Node = {#box{s1=#str{pid=Pid}},_}, Type, right_down -> popup_menu(Panel); _ -> ok end, + observer_wx:set_status(io_lib:format("Pid: ~p", [Pid])), wxWindow:refresh(AppWin), State#state{sel=Node}; handle_mouse_click(_, _, State = #state{sel=undefined}) -> @@ -349,6 +343,7 @@ handle_mouse_click(_, right_down, State=#state{panel=Panel}) -> popup_menu(Panel), State; handle_mouse_click(_, _, State=#state{app_w=AppWin}) -> + observer_wx:set_status(""), wxWindow:refresh(AppWin), State#state{sel=undefined}. @@ -376,10 +371,11 @@ popup_menu(Panel) -> wxMenu:append(Menu, ?ID_TRACE_NAME, "Trace named process"), wxMenu:append(Menu, ?ID_TRACE_TREE_PIDS, "Trace process tree"), wxMenu:append(Menu, ?ID_TRACE_TREE_NAMES, "Trace named process tree"), + wxMenu:append(Menu, ?ID_PROC_MSG, "Send Msg"), + wxMenu:append(Menu, ?ID_PROC_KILL, "Kill process"), wxWindow:popupMenu(Panel, Menu), wxMenu:destroy(Menu). - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% locate_node(X, _Y, [{Box=#box{x=BX}, _Chs}|_Rest]) when X < BX -> diff --git a/lib/observer/src/observer_pro_wx.erl b/lib/observer/src/observer_pro_wx.erl index 7578215ff9..e2f3ddb02b 100644 --- a/lib/observer/src/observer_pro_wx.erl +++ b/lib/observer/src/observer_pro_wx.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011. All Rights Reserved. +%% Copyright Ericsson AB 2011-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 @@ -191,13 +191,20 @@ dump_to_file(Parent, FileName, Holder) -> start_procinfo(undefined, _Frame, Opened) -> Opened; start_procinfo(Pid, Frame, Opened) -> - case lists:member(Pid, Opened) of - true -> - Opened; - false -> - observer_procinfo:start(Pid, Frame, self()), - [Pid | Opened] + %% This code doesn't work until we collect which windows have been + %% closed maybe it should moved to observer_wx.erl + %% and add a global menu which remembers windows. + %% case lists:keyfind(Pid, 1, Opened) of + %% false -> + case observer_procinfo:start(Pid, Frame, self()) of + {error, _} -> Opened; + PI -> [{Pid, PI} | Opened] end. + %%; + %% {_, PI} -> + %% wxFrame:raise(PI), + %% Opened + %% end. call(Holder, What) -> Ref = erlang:monitor(process, Holder), diff --git a/lib/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl index ec08d3aff1..13e41cfe33 100644 --- a/lib/observer/src/observer_procinfo.erl +++ b/lib/observer/src/observer_procinfo.erl @@ -49,7 +49,8 @@ init([Pid, ParentFrame, Parent]) -> try Title=case observer_wx:try_rpc(node(Pid), erlang, process_info, [Pid, registered_name]) of [] -> io_lib:format("~p",[Pid]); - {registered_name, Registered} -> atom_to_list(Registered) + {registered_name, Registered} -> io_lib:format("~p (~p)",[Registered, Pid]); + undefined -> throw(process_undefined) end, Frame=wxFrame:new(ParentFrame, ?wxID_ANY, [atom_to_list(node(Pid)), $:, Title], [{style, ?wxDEFAULT_FRAME_STYLE}, {size, {850,600}}]), @@ -75,7 +76,10 @@ init([Pid, ParentFrame, Parent]) -> }} catch error:{badrpc, _} -> observer_wx:return_to_localnode(ParentFrame, node(Pid)), - {stop, badrpc, #state{parent=Parent, pid=Pid}} + {stop, badrpc}; + process_undefined -> + observer_lib:display_info_dialog("No such alive process"), + {stop, normal} end. init_panel(Notebook, Str, Pid, Fun) -> @@ -94,8 +98,11 @@ handle_event(#wx{event=#wxClose{type=close_window}}, State) -> handle_event(#wx{id=?wxID_CLOSE, event=#wxCommand{type=command_menu_selected}}, State) -> {stop, normal, State}; -handle_event(#wx{id=?REFRESH}, #state{pages=Pages}=State) -> - [(W#worker.callback)() || W <- Pages], +handle_event(#wx{id=?REFRESH}, #state{frame=Frame, pid=Pid, pages=Pages}=State) -> + try [(W#worker.callback)() || W <- Pages] + catch process_undefined -> + wxFrame:setTitle(Frame, io_lib:format("*DEAD* ~p",[Pid])) + end, {noreply, State}; handle_event(Event, _State) -> @@ -162,7 +169,8 @@ init_message_page(Parent, Pid) -> false -> wxTextCtrl:writeText(Text, Messages) end; - _ -> ok + _ -> + throw(process_undefined) end end, Update(), @@ -178,7 +186,8 @@ init_dict_page(Parent, Pid) -> Last = wxTextCtrl:getLastPosition(Text), wxTextCtrl:remove(Text, 0, Last), wxTextCtrl:writeText(Text, Dict); - _ -> ok + _ -> + throw(process_undefined) end end, Update(), @@ -216,7 +225,8 @@ init_stack_page(Parent, Pid) -> wxListCtrl:setItem(LCtrl, Row, 1, FileLine), Row+1 end, 0, RawBt); - _ -> ok + _ -> + throw(process_undefined) end end, Resize = fun(#wx{event=#wxSize{size={W,_}}},Ev) -> @@ -266,7 +276,7 @@ process_info_fields(Pid) -> RawInfo when is_list(RawInfo) -> observer_lib:fill_info(Struct, RawInfo); _ -> - ok + throw(process_undefined) end. item_list() -> diff --git a/lib/observer/src/observer_traceoptions_wx.erl b/lib/observer/src/observer_traceoptions_wx.erl index 6a634e06f0..e27f565abc 100644 --- a/lib/observer/src/observer_traceoptions_wx.erl +++ b/lib/observer/src/observer_traceoptions_wx.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011. All Rights Reserved. +%% Copyright Ericsson AB 2011-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 @@ -167,8 +167,10 @@ module_selector(Parent, Node) -> function_selector(Parent, Node, Module) -> Functions = observer_wx:try_rpc(Node, Module, module_info, [functions]), - Choices = lists:sort([{Name, Arity} || {Name, Arity} <- Functions, - not(erl_internal:guard_bif(Name, Arity))]), + Externals = observer_wx:try_rpc(Node, Module, module_info, [exports]), + + Choices = lists:usort([{Name, Arity} || {Name, Arity} <- Externals ++ Functions, + not(erl_internal:guard_bif(Name, Arity))]), ParsedChoices = parse_function_names(Choices), case check_selector(Parent, ParsedChoices) of [] -> [{Module, '_', '_'}]; diff --git a/lib/observer/src/observer_tv_table.erl b/lib/observer/src/observer_tv_table.erl index f432173f57..3930f9ee26 100644 --- a/lib/observer/src/observer_tv_table.erl +++ b/lib/observer/src/observer_tv_table.erl @@ -453,7 +453,7 @@ get_attr(Table, Item) -> Ref = erlang:monitor(process, Table), Table ! {get_attr, self(), Item}, receive - {'DOWN', Ref, _, _, _} -> ""; + {'DOWN', Ref, _, _, _} -> wx:null(); {Table, Res} -> erlang:demonitor(Ref), Res diff --git a/lib/observer/src/observer_wx.erl b/lib/observer/src/observer_wx.erl index e2b256d768..ce3f48a05d 100644 --- a/lib/observer/src/observer_wx.erl +++ b/lib/observer/src/observer_wx.erl @@ -20,7 +20,7 @@ -behaviour(wx_object). -export([start/0]). --export([create_menus/2, get_attrib/1, get_tracer/0, +-export([create_menus/2, get_attrib/1, get_tracer/0, set_status/1, create_txt_dialog/4, try_rpc/4, return_to_localnode/2]). -export([init/1, handle_event/2, handle_cast/2, terminate/2, code_change/3, @@ -58,7 +58,8 @@ perf_panel, active_tab, node, - nodes + nodes, + prev_node="" }). start() -> @@ -73,6 +74,9 @@ create_menus(Object, Menus) when is_list(Menus) -> get_attrib(What) -> wx_object:call(observer, {get_attrib, What}). +set_status(What) -> + wx_object:cast(observer, {status_bar, What}). + get_tracer() -> wx_object:call(observer, get_tracer). @@ -258,20 +262,21 @@ handle_event(#wx{id = ?ID_CONNECT, event = #wxCommand{type = command_menu_select handle_event(#wx{id = ?ID_PING, event = #wxCommand{type = command_menu_selected}}, #state{frame = Frame} = State) -> UpdState = case create_connect_dialog(ping, State) of - cancel -> State; + cancel -> State; {value, Value} when is_list(Value) -> try Node = list_to_atom(Value), case net_adm:ping(Node) of pang -> create_txt_dialog(Frame, "Connect failed", "Pang", ?wxICON_EXCLAMATION), - State; + State#state{prev_node=Value}; pong -> - change_node_view(Node, State) + State1 = change_node_view(Node, State), + State1#state{prev_node=Value} end catch _:_ -> create_txt_dialog(Frame, "Connect failed", "Pang", ?wxICON_EXCLAMATION), - State + State#state{prev_node=Value} end end, {noreply, UpdState}; @@ -288,6 +293,10 @@ handle_event(Event, State) -> Pid ! Event, {noreply, State}. +handle_cast({status_bar, Msg}, State=#state{status_bar=SB}) -> + wxStatusBar:setStatusText(SB, Msg), + {noreply, State}; + handle_cast(_Cast, State) -> {noreply, State}. @@ -439,8 +448,8 @@ pid2panel(Pid, #state{pro_panel=Pro, sys_panel=Sys, end. -create_connect_dialog(ping, #state{frame = Frame}) -> - Dialog = wxTextEntryDialog:new(Frame, "Connect to node"), +create_connect_dialog(ping, #state{frame = Frame, prev_node=Prev}) -> + Dialog = wxTextEntryDialog:new(Frame, "Connect to node", [{value, Prev}]), case wxDialog:showModal(Dialog) of ?wxID_OK -> Value = wxTextEntryDialog:getValue(Dialog), @@ -560,7 +569,16 @@ remove_menu_items([], _MB) -> ok. get_nodes() -> - Nodes = [node()| nodes()], + Nodes0 = case erlang:is_alive() of + false -> []; + true -> + case net_adm:names() of + {error, _} -> nodes(); + {ok, Names} -> + epmd_nodes(Names) ++ nodes() + end + end, + Nodes = lists:usort(Nodes0), {_, Menues} = lists:foldl(fun(Node, {Id, Acc}) when Id < ?LAST_NODES_MENU_ID -> {Id + 1, [#create_menu{id=Id + ?FIRST_NODES_MENU_ID, @@ -568,6 +586,10 @@ get_nodes() -> end, {1, []}, Nodes), {Nodes, lists:reverse(Menues)}. +epmd_nodes(Names) -> + [_, Host] = string:tokens(atom_to_list(node()),"@"), + [list_to_atom(Name ++ [$@|Host]) || {Name, _} <- Names]. + update_node_list(State = #state{menubar=MenuBar}) -> {Nodes, NodesMenuItems} = get_nodes(), NodeMenuId = wxMenuBar:findMenu(MenuBar, "Nodes"), diff --git a/lib/public_key/test/Makefile b/lib/public_key/test/Makefile index b7f91981a5..397a0eb2d5 100644 --- a/lib/public_key/test/Makefile +++ b/lib/public_key/test/Makefile @@ -21,7 +21,7 @@ include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk -INCLUDES= -I. -I ../include +INCLUDES= -I. -I ../include -pa $(ERL_TOP)/lib/public_key/ebin # ---------------------------------------------------- # Target Specs diff --git a/lib/reltool/test/Makefile b/lib/reltool/test/Makefile index d8a7adb837..932532d811 100644 --- a/lib/reltool/test/Makefile +++ b/lib/reltool/test/Makefile @@ -49,7 +49,7 @@ RELSYSDIR = $(RELEASE_PATH)/reltool_test # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- -#ERL_COMPILE_FLAGS += +ERL_COMPILE_FLAGS += -pa $(ERL_TOP)/lib/reltool/ebin/ EBIN = . diff --git a/lib/ssh/src/ssh_connection.erl b/lib/ssh/src/ssh_connection.erl index 46f0c7e688..c46f799b6d 100644 --- a/lib/ssh/src/ssh_connection.erl +++ b/lib/ssh/src/ssh_connection.erl @@ -720,12 +720,17 @@ handle_msg(#ssh_msg_channel_request{request_type = "env"}, handle_msg(#ssh_msg_channel_request{recipient_channel = ChannelId, request_type = _Other, - want_reply = WantReply}, Connection, + want_reply = WantReply}, #connection{channel_cache = Cache} = Connection, ConnectionPid, _) -> if WantReply == true -> - FailMsg = channel_failure_msg(ChannelId), - {{replies, [{connection_reply, ConnectionPid, FailMsg}]}, - Connection}; + case ssh_channel:cache_lookup(Cache, ChannelId) of + #channel{remote_id = RemoteId} -> + FailMsg = channel_failure_msg(RemoteId), + {{replies, [{connection_reply, ConnectionPid, FailMsg}]}, + Connection}; + undefined -> %% Chanel has been closed + {noreply, Connection} + end; true -> {noreply, Connection} end; diff --git a/lib/ssh/src/ssh_connection_manager.erl b/lib/ssh/src/ssh_connection_manager.erl index 8c1f88e572..a0ea04a2c2 100644 --- a/lib/ssh/src/ssh_connection_manager.erl +++ b/lib/ssh/src/ssh_connection_manager.erl @@ -267,7 +267,7 @@ handle_call({ssh_msg, Pid, Msg}, From, disconnect_fun(Reason, SSHOpts), {stop, {shutdown, normal}, State#state{connection_state = Connection}} catch - _:Reason -> + _:Error -> {disconnect, Reason, {{replies, Replies}, Connection}} = ssh_connection:handle_msg( #ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, @@ -277,7 +277,7 @@ handle_call({ssh_msg, Pid, Msg}, From, lists:foreach(fun send_msg/1, Replies), SSHOpts = proplists:get_value(ssh_opts, Opts), disconnect_fun(Reason, SSHOpts), - {stop, {shutdown, Reason}, State#state{connection_state = Connection}} + {stop, {shutdown, Error}, State#state{connection_state = Connection}} end; handle_call({global_request, Pid, _, _, _} = Request, From, diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index e019654685..28bf82b406 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -193,13 +193,13 @@ </item> <tag>{depth, integer()}</tag> - <item>Specifies the maximum - verification depth, i.e. how far in a chain of certificates the - verification process can proceed before the verification is - considered to fail. Peer certificate = 0, CA certificate = 1, - higher level CA certificate = 2, etc. The value 2 thus means - that a chain can at most contain peer cert, CA cert, next CA - cert, and an additional CA cert. The default value is 1. + <item> + The depth is the maximum number of non-self-issued + intermediate certificates that may follow the peer certificate + in a valid certification path. So if depth is 0 the PEER must + be signed by the trusted ROOT-CA directly, if 1 the path can + be PEER, CA, ROOT-CA, if it is 2 PEER, CA, CA, ROOT-CA and so + on. The default value is 1. </item> <tag>{verify_fun, {Verifyfun :: fun(), InitialUserState :: term()}}</tag> diff --git a/lib/test_server/src/configure.in b/lib/test_server/src/configure.in index 097853bcfc..77bc993ccd 100644 --- a/lib/test_server/src/configure.in +++ b/lib/test_server/src/configure.in @@ -108,7 +108,7 @@ AC_CHECK_HEADER(poll.h, AC_DEFINE(HAVE_POLL_H)) # for the system. AC_MSG_CHECKING([system version (for dynamic loading)]) -system=`uname -s`-`uname -r` +system=`./config.sub $host` AC_MSG_RESULT($system) # Step 2: check for existence of -ldl library. This is needed because @@ -119,10 +119,9 @@ AC_CHECK_LIB(dl, dlopen, have_dl=yes, have_dl=no) # Step 3: set configuration options based on system name and version. SHLIB_LDLIBS= - fullSrcDir=`cd $srcdir; pwd` case $system in - Linux*) + *-linux-*) SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" if test "$have_dl" = yes; then @@ -136,7 +135,7 @@ case $system in fi SHLIB_EXTRACT_ALL="" ;; - NetBSD-*|FreeBSD-*|OpenBSD-*|DragonFly*) + *-netbsd*|*-freebsd*|*-openbsd*|*-dragonfly*) # Not available on all versions: check for include file. AC_CHECK_HEADER(dlfcn.h, [ SHLIB_CFLAGS="-fpic" @@ -153,28 +152,21 @@ case $system in ]) SHLIB_EXTRACT_ALL="" ;; - SunOS-4*) - SHLIB_CFLAGS="-PIC" - SHLIB_LD="ld" - SHLIB_LDFLAGS="$LDFLAGS" - SHLIB_SUFFIX=".so" - SHLIB_EXTRACT_ALL="" - ;; - SunOS-5*|UNIX_SV-4.2*) + *-solaris2*|*-sysv4*) SHLIB_CFLAGS="-KPIC" SHLIB_LD="/usr/ccs/bin/ld" SHLIB_LDFLAGS="$LDFLAGS -G -z text" SHLIB_SUFFIX=".so" SHLIB_EXTRACT_ALL="-z allextract" ;; - Darwin*) + *darwin*) SHLIB_CFLAGS="-fno-common" SHLIB_LD="cc" SHLIB_LDFLAGS="$LDFLAGS -bundle -flat_namespace -undefined suppress" SHLIB_SUFFIX=".so" SHLIB_EXTRACT_ALL="" ;; - OSF1*) + *osf1*) SHLIB_CFLAGS="-fPIC" SHLIB_LD="ld" SHLIB_LDFLAGS="$LDFLAGS -shared" @@ -206,19 +198,19 @@ esac if test "$CC" = "gcc" -o `$CC -v 2>&1 | grep -c gcc` != "0" ; then case $system in - AIX-*) + *-aix) ;; - BSD/OS*) + *-bsd*) ;; - IRIX*) + *-irix) ;; - NetBSD-*|FreeBSD-*|OpenBSD-*) + *-netbsd|*-freebsd|*-openbsd) ;; - RISCos-*) + *-riscos) ;; - ULTRIX-4.*) + *ultrix4.*) ;; - Darwin*) + *darwin*) ;; *) SHLIB_CFLAGS="-fPIC" diff --git a/lib/test_server/src/ts.erl b/lib/test_server/src/ts.erl index cb06264adb..4899f38d2b 100644 --- a/lib/test_server/src/ts.erl +++ b/lib/test_server/src/ts.erl @@ -27,9 +27,10 @@ -export([run/0, run/1, run/2, run/3, run/4, clean/0, clean/1, tests/0, tests/1, - install/0, install/1, install/2, index/0, + install/0, install/1, index/0, estone/0, estone/1, cross_cover_analyse/1, + compile_testcases/0, compile_testcases/1, help/0]). -export([i/0, l/1, r/0, r/1, r/2, r/3]). @@ -88,35 +89,25 @@ -define( install_help, [ - " ts:install() - Install TS for local target with no Options.\n" - " ts:install([Options])\n", - " - Install TS for local target with Options\n" - " ts:install({Architecture, Target_name})\n", - " - Install TS for a remote target architecture.\n", - " and target network name (e.g. {vxworks_cpu32, sauron}).\n", - " ts:install({Architecture, Target_name}, [Options])\n", - " - Install TS as above, and with Options.\n", + " ts:install() - Install TS with no Options.\n" + " ts:install([Options]) - Install TS with Options\n" "\n", "Installation options supported:\n", " {longnames, true} - Use fully qualified hostnames\n", - " {hosts, [HostList]}\n" - " - Use theese hosts for distributed testing.\n" " {verbose, Level} - Sets verbosity level for TS output (0,1,2), 0 is\n" " quiet(default).\n" - " {slavetargets, SlaveTarges}\n" - " - Available hosts for starting slave nodes for\n" - " platforms which cannot have more than one erlang\n" - " node per host.\n" - " {crossroot, TargetErlRoot}\n" - " - Erlang root directory on target host\n" - " Mandatory for remote targets\n" - " {master, {MasterHost, MasterCookie}}\n" - " - Master host and cookie for targets which are\n" - " started as slave nodes.\n" - " erl_boot_server must be started on master before\n" - " test is run.\n" - " Optional, default is controller host and then\n" - " erl_boot_server is started autmatically\n" + " {crossroot, ErlTop}\n" + " - Erlang root directory on build host, ~n" + " normally same value as $ERL_TOP\n" + " {crossenv, [{Key,Val}]}\n" + " - Environmentals used by test configure on build host\n" + " {crossflags, FlagsString}\n" + " - Flags used by test configure on build host\n" + " {xcomp, XCompFile}\n" + " - The xcomp file to use for cross compiling the~n" + " testcases. Using this option will override any~n" + " cross* configurations given to ts. Note that you~n" + " have to have a correct ERL_TOP as well.~n" ]). help() -> @@ -183,26 +174,24 @@ help(installed) -> " cover_details. Analyses modules specified in\n" " cross.cover.\n" " Level can be 'overview' or 'details'.\n", + " ts:compile_testcases()~n" + " ts:compile_testcases(Apps)~n" + " - Compile all testcases for usage in a cross ~n" + " compile environment." " \n" "Installation (already done):\n" ], show_help([H,?install_help]). show_help(H) -> - io:put_chars(lists:flatten(H)). + io:format(lists:flatten(H)). %% Installs tests. install() -> ts_install:install(install_local,[]). -install({Architecture, Target_name}) -> - ts_install:install({ts_lib:maybe_atom_to_list(Architecture), - ts_lib:maybe_atom_to_list(Target_name)}, []); install(Options) when is_list(Options) -> ts_install:install(install_local,Options). -install({Architecture, Target_name}, Options) when is_list(Options)-> - ts_install:install({ts_lib:maybe_atom_to_list(Architecture), - ts_lib:maybe_atom_to_list(Target_name)}, Options). %% Updates the local index page. @@ -728,3 +717,23 @@ cover_type(cover_details) -> details. do_load(Mod) -> code:purge(Mod), code:load_file(Mod). + + +compile_testcases() -> + compile_datadirs("../*/*_data"). + +compile_testcases(App) when is_atom(App) -> + compile_testcases([App]); +compile_testcases([App | T]) -> + compile_datadirs(io_lib:format("../~s_test/*_data", [App])), + compile_testcases(T); +compile_testcases([]) -> + ok. + +compile_datadirs(DataDirs) -> + {ok,Variables} = file:consult("variables"), + + lists:foreach(fun(Dir) -> + ts_lib:make_non_erlang(Dir, Variables) + end, + filelib:wildcard(DataDirs)). diff --git a/lib/test_server/src/ts.hrl b/lib/test_server/src/ts.hrl index 885a726c54..db804d23a1 100644 --- a/lib/test_server/src/ts.hrl +++ b/lib/test_server/src/ts.hrl @@ -28,6 +28,7 @@ -define(run_summary, "suite.summary"). -define(cover_total,"total_cover.log"). -define(variables, "variables"). +-define(cross_variables, "variables-cross"). -define(LF, [10]). % Newline in VxWorks script -define(CHAR_PER_LINE, 60). % Characters per VxWorks script building line -define(CROSS_COOKIE, "cross"). % cookie used when cross platform testing diff --git a/lib/test_server/src/ts_erl_config.erl b/lib/test_server/src/ts_erl_config.erl index 5585e8ccd3..ed26156180 100644 --- a/lib/test_server/src/ts_erl_config.erl +++ b/lib/test_server/src/ts_erl_config.erl @@ -220,10 +220,6 @@ erl_interface(Vars,OsType) -> _ -> "" % VxWorks end, - CrossCompile = case OsType of - vxworks -> "true"; - _ -> "false" - end, [{erl_interface_libpath, filename:nativename(LibPath)}, {erl_interface_sock_libs, sock_libraries(OsType)}, {erl_interface_lib, Lib}, @@ -232,8 +228,8 @@ erl_interface(Vars,OsType) -> {erl_interface_eilib_drv, Lib1Drv}, {erl_interface_threadlib, ThreadLib}, {erl_interface_include, filename:nativename(Incl)}, - {erl_interface_mk_include, filename:nativename(MkIncl)}, - {erl_interface_cross_compile, CrossCompile} | Vars]. + {erl_interface_mk_include, filename:nativename(MkIncl)} + | Vars]. ic(Vars, OsType) -> {ClassPath, LibPath, Incl} = @@ -276,8 +272,6 @@ lib_dir(Vars, Lib) -> case {get_var(crossroot, Vars), LibLibDir} of {{error, _}, _} -> %no crossroot LibLibDir; - {_, {error, _}} -> %no lib - LibLibDir; {CrossRoot, _} -> %% XXX: Ugly. So ugly I won't comment it %% /Patrik @@ -299,18 +293,16 @@ lib_dir(Vars, Lib) -> end. erl_root(Vars) -> - Root = code:root_dir(), - case ts_lib:erlang_type() of + Root = case get_var(crossroot,Vars) of + {error, notfound} -> code:root_dir(); + CrossRoot -> CrossRoot + end, + case ts_lib:erlang_type(Root) of {srctree, _Version} -> Target = get_var(target, Vars), {srctree, Root, Target}; {_, _Version} -> - case get_var(crossroot,Vars) of - {error, notfound} -> - {installed, Root}; - CrossRoot -> - {installed, CrossRoot} - end + {installed, Root} end. diff --git a/lib/test_server/src/ts_install.erl b/lib/test_server/src/ts_install.erl index 9703478f20..c70a41be4b 100644 --- a/lib/test_server/src/ts_install.erl +++ b/lib/test_server/src/ts_install.erl @@ -28,12 +28,25 @@ install(install_local, Options) -> install(os:type(), Options); install(TargetSystem, Options) -> - io:format("Running configure for cross architecture, network target name~n" - "~p~n", [TargetSystem]), - case autoconf(TargetSystem) of + case file:consult(?variables) of + {ok, Vars} -> + case proplists:get_value(cross,Vars) of + "yes" when Options == []-> + target_install(Vars); + _ -> + build_install(TargetSystem, Options) + end; + _ -> + build_install(TargetSystem, Options) + end. + + +build_install(TargetSystem, Options) -> + XComp = parse_xcomp_file(proplists:get_value(xcomp,Options)), + case autoconf(TargetSystem, XComp++Options) of {ok, Vars0} -> OsType = os_type(TargetSystem), - Vars1 = ts_erl_config:variables(merge(Vars0,Options),OsType), + Vars1 = ts_erl_config:variables(Vars0++XComp++Options,OsType), {Options1, Vars2} = add_vars(Vars1, Options), Vars3 = lists:flatten([Options1|Vars2]), write_terms(?variables, Vars3); @@ -45,32 +58,43 @@ os_type({unix,_}=OsType) -> OsType; os_type({win32,_}=OsType) -> OsType; os_type(_Other) -> vxworks. -merge(Vars,[]) -> - Vars; -merge(Vars,[{crossroot,X}| Tail]) -> - merge([{crossroot, X} | Vars], Tail); -merge(Vars,[_X | Tail]) -> - merge(Vars,Tail). +target_install(CrossVars) -> + io:format("Cross installation detected, skipping configure and data_dir make~n"), + case file:rename(?variables,?cross_variables) of + ok -> + ok; + _ -> + io:format("Could not find variables file from cross make~n"), + throw(cross_installation_failed) + end, + CPU = proplists:get_value('CPU',CrossVars), + OS = proplists:get_value(os,CrossVars), + {Options,Vars} = add_vars([{cross,"yes"},{'CPU',CPU},{os,OS}],[]), + Variables = lists:flatten([Options|Vars]), + write_terms(?variables, Variables). %% Autoconf for various platforms. %% unix uses the configure script %% win32 uses ts_autoconf_win32 %% VxWorks uses ts_autoconf_vxworks. -autoconf(TargetSystem) -> - case autoconf1(TargetSystem) of +autoconf(TargetSystem, XComp) -> + case autoconf1(TargetSystem, XComp) of ok -> autoconf2(file:read_file("conf_vars")); Error -> Error end. -autoconf1({win32, _}) -> +autoconf1({win32, _},[{cross,"no"}]) -> ts_autoconf_win32:configure(); -autoconf1({unix, _}) -> - unix_autoconf(); -autoconf1(Other) -> - ts_autoconf_vxworks:configure(Other). +autoconf1({unix, _},XCompFile) -> + unix_autoconf(XCompFile); +autoconf1(Other,[{cross,"no"}]) -> + ts_autoconf_vxworks:configure(Other); +autoconf1(_,_) -> + io:format("cross compilation not supported for that this platform~n"), + throw(cross_installation_failed). autoconf2({ok, Bin}) -> get_vars(binary_to_list(Bin), name, [], []); @@ -92,27 +116,40 @@ get_vars([], name, [], Result) -> get_vars(_, _, _, _) -> {error, fatal_bad_conf_vars}. -unix_autoconf() -> +unix_autoconf(XConf) -> Configure = filename:absname("configure"), - Args = case catch erlang:system_info(threads) of - false -> ""; - _ -> " --enable-shlib-thread-safety" - end - ++ case catch string:str(erlang:system_info(system_version), - "debug") > 0 of - false -> ""; - _ -> " --enable-debug-mode" - end, + Flags = proplists:get_value(crossflags,XConf,[]), + Env = proplists:get_value(crossenv,XConf,[]), + Host = get_xcomp_flag("host", Flags), + Build = get_xcomp_flag("build", Flags), + Threads = [" --enable-shlib-thread-safety" || + erlang:system_info(threads) /= false], + Debug = [" --enable-debug-mode" || + string:str(erlang:system_info(system_version),"debug") > 0], + Args = Host ++ Build ++ Threads ++ Debug, case filelib:is_file(Configure) of true -> - Env = macosx_cflags(), - Port = open_port({spawn, Configure ++ Args}, - [stream, eof, {env,Env}]), + OSXEnv = macosx_cflags(), + io:format("Running ~sEnv: ~p~n", + [lists:flatten(Configure ++ Args),Env++OSXEnv]), + Port = open_port({spawn, lists:flatten(Configure ++ Args)}, + [stream, eof, {env,Env++OSXEnv}]), ts_lib:print_data(Port); false -> {error, no_configure_script} end. + +get_xcomp_flag(Flag, Flags) -> + get_xcomp_flag(Flag, Flag, Flags). +get_xcomp_flag(Flag, Tag, Flags) -> + case proplists:get_value(Flag,Flags) of + undefined -> ""; + "guess" -> [" --",Tag,"=",os:cmd("$ERL_TOP/erts/autoconf/config.guess")]; + HostVal -> [" --",Tag,"=",HostVal] + end. + + macosx_cflags() -> case os:type() of {unix, darwin} -> @@ -125,10 +162,33 @@ macosx_cflags() -> [] end. +parse_xcomp_file(undefined) -> + [{cross,"no"}]; +parse_xcomp_file(Filepath) -> + {ok,Bin} = file:read_file(Filepath), + Lines = binary:split(Bin,<<"\n">>,[global,trim]), + {Envs,Flags} = parse_xcomp_file(Lines,[],[]), + [{cross,"yes"},{crossroot,os:getenv("ERL_TOP")}, + {crossenv,Envs},{crossflags,Flags}]. + +parse_xcomp_file([<<A:8,_/binary>> = Line|R],Envs,Flags) + when $A =< A, A =< $Z -> + [Var,Value] = binary:split(Line,<<"=">>), + parse_xcomp_file(R,[{binary_to_list(Var), + binary_to_list(Value)}|Envs],Flags); +parse_xcomp_file([<<"erl_xcomp_",Line/binary>>|R],Envs,Flags) -> + [Var,Value] = binary:split(Line,<<"=">>), + parse_xcomp_file(R,Envs,[{binary_to_list(Var), + binary_to_list(Value)}|Flags]); +parse_xcomp_file([_|R],Envs,Flags) -> + parse_xcomp_file(R,Envs,Flags); +parse_xcomp_file([],Envs,Flags) -> + {lists:reverse(Envs),lists:reverse(Flags)}. + write_terms(Name, Terms) -> case file:open(Name, [write]) of {ok, Fd} -> - Result = write_terms1(Fd, Terms), + Result = write_terms1(Fd, remove_duplicates(Terms)), file:close(Fd), Result; {error, Reason} -> @@ -141,6 +201,17 @@ write_terms1(Fd, [Term|Rest]) -> write_terms1(_, []) -> ok. +remove_duplicates(List) -> + lists:reverse( + lists:foldl(fun({Key,Val},Acc) -> + R = make_ref(), + case proplists:get_value(Key,Acc,R) of + R -> [{Key,Val}|Acc]; + _Else -> + Acc + end + end,[],List)). + add_vars(Vars0, Opts0) -> {Opts,LongNames} = case lists:keymember(longnames, 1, Opts0) of diff --git a/lib/test_server/src/ts_install_cth.erl b/lib/test_server/src/ts_install_cth.erl index a41916fd0a..67f2df0cae 100644 --- a/lib/test_server/src/ts_install_cth.erl +++ b/lib/test_server/src/ts_install_cth.erl @@ -95,17 +95,12 @@ pre_init_per_suite(_Suite,Config,State) -> try {ok,Variables} = file:consult(filename:join(State#state.ts_conf_dir,"variables")), - - %% Make the stuff in all_SUITE_data if it exists - AllDir = filename:join(DataDir,"../all_SUITE_data"), - case filelib:is_dir(AllDir) of - true -> - make_non_erlang(AllDir,Variables); - false -> - ok + case proplists:get_value(cross,Variables) of + "yes" -> + ct:log("Not making data dir as tests have been cross compiled"); + _ -> + ts_lib:make_non_erlang(DataDir, Variables) end, - - make_non_erlang(DataDir, Variables), {add_node_name(Config, State), State} catch Error:Reason -> @@ -219,39 +214,6 @@ terminate(_State) -> %%% ============================================================================ %%% Local functions %%% ============================================================================ -%% Configure and run all the Makefiles in the data dirs of the suite -%% in question -make_non_erlang(DataDir, Variables) -> - {ok,CurrWD} = file:get_cwd(), - try - file:set_cwd(DataDir), - MakeCommand = proplists:get_value(make_command,Variables), - - FirstMakefile = filename:join(DataDir,"Makefile.first"), - case filelib:is_regular(FirstMakefile) of - true -> - ct:log("Making ~p",[FirstMakefile]), - ok = ts_make:make( - MakeCommand, DataDir, filename:basename(FirstMakefile)); - false -> - ok - end, - - MakefileSrc = filename:join(DataDir,"Makefile.src"), - MakefileDest = filename:join(DataDir,"Makefile"), - case filelib:is_regular(MakefileSrc) of - true -> - ok = ts_lib:subst_file(MakefileSrc,MakefileDest,Variables), - ct:log("Making ~p",[MakefileDest]), - ok = ts_make:make([{makefile,"Makefile"},{data_dir,DataDir} - | Variables]); - false -> - ok - end - after - file:set_cwd(CurrWD), - timer:sleep(100) - end. %% Add a nodename to config if it does not exist add_node_name(Config, State) -> diff --git a/lib/test_server/src/ts_lib.erl b/lib/test_server/src/ts_lib.erl index 2f0a4ea8c0..d521d2beda 100644 --- a/lib/test_server/src/ts_lib.erl +++ b/lib/test_server/src/ts_lib.erl @@ -24,10 +24,12 @@ %% Avoid warning for local function error/1 clashing with autoimported BIF. -compile({no_auto_import,[error/1]}). -export([error/1, var/2, erlang_type/0, + erlang_type/1, initial_capital/1, interesting_logs/1, specs/1, suites/2, last_test/1, force_write_file/2, force_delete/1, subst_file/3, subst/2, print_data/1, + make_non_erlang/2, maybe_atom_to_list/1, progress/4 ]). @@ -73,8 +75,10 @@ progress(Vars, Level, Format, Args) -> %% Returns: {Type, Version} where Type is otp|src erlang_type() -> + erlang_type(code:root_dir()). +erlang_type(RootDir) -> {_, Version} = init:script_id(), - RelDir = filename:join(code:root_dir(), "releases"), % Only in installed + RelDir = filename:join(RootDir, "releases"), % Only in installed case filelib:is_file(RelDir) of true -> {otp,Version}; % installed OTP false -> {srctree,Version} % source code tree @@ -333,3 +337,45 @@ maybe_atom_to_list(To_list) when is_list(To_list) -> maybe_atom_to_list(To_list) when is_atom(To_list)-> atom_to_list(To_list). + +%% Configure and run all the Makefiles in the data dir of the suite +%% in question +make_non_erlang(DataDir, Variables) -> + %% Make the stuff in all_SUITE_data if it exists + AllDir = filename:join(DataDir,"../all_SUITE_data"), + case filelib:is_dir(AllDir) of + true -> + make_non_erlang_do(AllDir,Variables); + false -> + ok + end, + make_non_erlang_do(DataDir, Variables). + +make_non_erlang_do(DataDir, Variables) -> + try + MakeCommand = proplists:get_value(make_command,Variables), + + FirstMakefile = filename:join(DataDir,"Makefile.first"), + case filelib:is_regular(FirstMakefile) of + true -> + io:format("Making ~p",[FirstMakefile]), + ok = ts_make:make( + MakeCommand, DataDir, filename:basename(FirstMakefile)); + false -> + ok + end, + + MakefileSrc = filename:join(DataDir,"Makefile.src"), + MakefileDest = filename:join(DataDir,"Makefile"), + case filelib:is_regular(MakefileSrc) of + true -> + ok = ts_lib:subst_file(MakefileSrc,MakefileDest,Variables), + io:format("Making ~p",[MakefileDest]), + ok = ts_make:make([{makefile,"Makefile"},{data_dir,DataDir} + | Variables]); + false -> + ok + end + after + timer:sleep(100) %% maybe unnecessary now when we don't do set_cwd anymore + end. diff --git a/lib/test_server/src/ts_make.erl b/lib/test_server/src/ts_make.erl index 3df66111a3..f0db60013a 100644 --- a/lib/test_server/src/ts_make.erl +++ b/lib/test_server/src/ts_make.erl @@ -25,12 +25,12 @@ %% Functions to be called from make test cases. make(Config) when is_list(Config) -> - DataDir = ?config(data_dir, Config), - Makefile = ?config(makefile, Config), - Make = ?config(make_command, Config), + DataDir = proplists:get_value(data_dir, Config), + Makefile = proplists:get_value(makefile, Config), + Make = proplists:get_value(make_command, Config), case make(Make, DataDir, Makefile) of ok -> ok; - {error,Reason} -> ?t:fail({make_failed,Reason}) + {error,Reason} -> exit({make_failed,Reason}) end. unmake(Config) when is_list(Config) -> diff --git a/xcomp/README.md b/xcomp/README.md index 2d79107283..5f4b36bdca 100644 --- a/xcomp/README.md +++ b/xcomp/README.md @@ -291,6 +291,38 @@ and then do the cross build of the system. `otp_build release -a` will do the same as (5), and you will after this have to do a manual install either by doing (6), or (7). +Testing the cross compiled system +-------------------------------------- +Some of the tests that come with erlang use native code to test. This means +that when cross compiling erlang you also have to cross compile test suites +in order to run tests on the target host. To do this you first have to release +the tests as usual. + + $ make release_tests + +or + + $ ./otp_build tests + +The tests will be released into `$ERL_TOP/release/tests`. After releasing the +tests you have to install the tests on the build machine. You supply the same +xcomp file as to `./otp_build` in (9). + + $ cd $ERL_TOP/release/tests/test_server/ + $ $ERL_TOP/bootstrap/bin/erl -eval 'ts:install([{xcomp,"<FILE>"}])' -s ts compile_testcases -s init stop + +You should get a lot of printouts as the testcases are compiled. Once done you +should copy the entire `$ERL_TOP/release/tests` folder to the cross host system. + +Then go to the cross host system and setup the erlang installed in (4) or (5) +to be in your `$PATH`. Then go to what previously was +`$ERL_TOP/release/tests/test_server` and issue the following command. + + $ erl -s ts install -s ts run all_tests -s init stop + +The configure should be skipped and all tests should hopefully pass. For more +details about how to use ts run `erl -s ts help -s init stop` + Currently Used Configuration Variables -------------------------------------- |