File otp_src_19.2-erts-lib.patch of Package erlang

diff -Ndurp otp_src_19.2/erts/lib_src/common/erl_printf.c otp_src_19.2-erts-lib/erts/lib_src/common/erl_printf.c
--- otp_src_19.2/erts/lib_src/common/erl_printf.c	2016-12-09 12:45:24.000000000 +0200
+++ otp_src_19.2-erts-lib/erts/lib_src/common/erl_printf.c	2016-12-13 23:03:20.926032248 +0200
@@ -126,10 +126,7 @@ printf_fwrite(const void *ptr, size_t si
 static int
 get_error_result(void)
 {
-    int res = errno;
-    if (res <= 0)
-	res = EIO;
-    return -res;
+    return (errno <= 0) ? EIO : -errno;
 }
 
 
@@ -139,9 +136,8 @@ write_f_add_cr(void *vfp, char* buf, siz
     size_t i;
     ASSERT(vfp);
     for (i = 0; i < len; i++) {
-        if (buf[i] == '\n' && printf_putc('\r', (FILE *) vfp) == EOF)
-            return get_error_result();
-        if (printf_putc(buf[i], (FILE *) vfp) == EOF)
+        if ((buf[i] == '\n' && printf_putc('\r', (FILE *) vfp) == EOF) ||
+            printf_putc(buf[i], (FILE *) vfp) == EOF)
             return get_error_result();
     }
     return len;
@@ -168,12 +164,11 @@ write_f(void *vfp, char* buf, size_t len
 int
 erts_write_fd(void *vfdp, char* buf, size_t len)
 {
-    ssize_t size;
     size_t res = len;
     ASSERT(vfdp);
 
     while (len) {
-	size = write(*((int *) vfdp), (void *) buf, len);
+	ssize_t size = write(*((int *) vfdp), (void *) buf, len);
 	if (size < 0) {
 #ifdef EINTR
 	    if (errno == EINTR)
@@ -315,10 +310,7 @@ erts_sprintf(char *buf, const char *form
     va_start(arglist, format);
     errno = 0;
     res = erts_printf_format(write_s, (void *) &p, (char *) format, arglist);
-    if (res < 0)
-	buf[0] = '\0';
-    else
-	buf[res] = '\0';
+    buf[res <= 0 ? 0 : res] = '\0';
     va_end(arglist);
     return res;
 }
@@ -356,12 +348,8 @@ erts_dsprintf(erts_dsprintf_buf_t *dsbuf
     va_start(arglist, format);
     errno = 0;
     res = erts_printf_format(erts_write_ds, (void *)dsbufp, (char *)format, arglist);
-    if (dsbufp->str) {
-	if (res < 0)
-	    dsbufp->str[0] = '\0';
-	else
-	    dsbufp->str[dsbufp->str_len] = '\0';
-    }
+    if (dsbufp->str)
+	dsbufp->str[res <= 0 ? 0 : dsbufp->str_len] = '\0';
     va_end(arglist);
     return res;
 }
@@ -383,29 +371,22 @@ int erts_cbprintf(fmtfn_t cb_fn, void* c
 int
 erts_vprintf(const char *format, va_list arglist)
 {	
-    int res;
     if (erts_printf_stdout_func)
-	res = (*erts_printf_stdout_func)((char *) format, arglist);
+	return (*erts_printf_stdout_func)((char *) format, arglist);
     else {
 	errno = 0;
-	res = erts_printf_format(erts_printf_add_cr_to_stdout
-				 ? write_f_add_cr
-				 : write_f,
-				 (void *) stdout,
-				 (char *) format,
-				 arglist);
+	return erts_printf_format(erts_printf_add_cr_to_stdout ? write_f_add_cr : write_f,
+				  (void *) stdout, (char *) format, arglist);
     }
-    return res;
 }
 
 int
 erts_vfprintf(FILE *filep, const char *format, va_list arglist)
 {
-    int res;
     if (erts_printf_stdout_func && filep == stdout)
-	res = (*erts_printf_stdout_func)((char *) format, arglist);
+	return (*erts_printf_stdout_func)((char *) format, arglist);
     else if (erts_printf_stderr_func && filep == stderr)
-	res = (*erts_printf_stderr_func)((char *) format, arglist);
+	return (*erts_printf_stderr_func)((char *) format, arglist);
     else {
 	int (*fmt_f)(void*, char*, size_t);
 	errno = 0;
@@ -415,18 +396,15 @@ erts_vfprintf(FILE *filep, const char *f
 	    fmt_f = write_f_add_cr;
 	else
 	    fmt_f = write_f;
-	res = erts_printf_format(fmt_f,(void *)filep,(char *)format,arglist);
+	return erts_printf_format(fmt_f,(void *)filep,(char *)format,arglist);
     }
-    return res;
 }
 
 int
 erts_vfdprintf(int fd, const char *format, va_list arglist)
 {
-    int res;
     errno = 0;
-    res = erts_printf_format(erts_write_fd,(void *)&fd,(char *)format,arglist);
-    return res;
+    return erts_printf_format(erts_write_fd,(void *)&fd,(char *)format,arglist);
 }
 
 int
@@ -436,10 +414,7 @@ erts_vsprintf(char *buf, const char *for
     char *p = buf;
     errno = 0;
     res = erts_printf_format(write_s, (void *) &p, (char *) format, arglist);
-    if (res < 0)
-	buf[0] = '\0';
-    else
-	buf[res] = '\0';
+    buf[res <= 0 ? 0 : res] = '\0';
     return res;
 }
 
@@ -471,12 +446,8 @@ erts_vdsprintf(erts_dsprintf_buf_t *dsbu
 	return -EINVAL;
     errno = 0;
     res = erts_printf_format(erts_write_ds, (void *)dsbufp, (char *)format, arglist);
-    if (dsbufp->str) {
-	if (res < 0)
-	    dsbufp->str[0] = '\0';
-	else
-	    dsbufp->str[dsbufp->str_len] = '\0';
-    }
+    if (dsbufp->str)
+	dsbufp->str[res <= 0 ? 0 : dsbufp->str_len] = '\0';
     return res;
 }
 
diff -Ndurp otp_src_19.2/erts/lib_src/common/ethr_aux.c otp_src_19.2-erts-lib/erts/lib_src/common/ethr_aux.c
--- otp_src_19.2/erts/lib_src/common/ethr_aux.c	2016-12-09 12:45:24.000000000 +0200
+++ otp_src_19.2-erts-lib/erts/lib_src/common/ethr_aux.c	2016-12-13 22:56:44.350186606 +0200
@@ -408,20 +402,15 @@ static int init_ts_event_alloc(void)
 {
     free_ts_ev = ts_event_pool(ERTS_TS_EV_ALLOC_DEFAULT_POOL_SIZE,
 			       NULL);
-    if (!free_ts_ev)
-	return ENOMEM;
-    return ethr_spinlock_init(&ts_ev_alloc_lock);
+    return free_ts_ev ? ethr_spinlock_init(&ts_ev_alloc_lock) : ENOMEM;
 }
 
 static ethr_ts_event *ts_event_alloc(void)
 {
     ethr_ts_event *ts_ev;
     ethr_spin_lock(&ts_ev_alloc_lock);
-    if (free_ts_ev) {
+    if (free_ts_ev)
 	ts_ev = free_ts_ev;
-	free_ts_ev = ts_ev->next;
-	ethr_spin_unlock(&ts_ev_alloc_lock);
-    }
     else {
 	ethr_ts_event *ts_ev_pool_end;
 	ethr_spin_unlock(&ts_ev_alloc_lock);
@@ -432,9 +421,9 @@ static ethr_ts_event *ts_event_alloc(voi
 
 	ethr_spin_lock(&ts_ev_alloc_lock);
 	ts_ev_pool_end->next = free_ts_ev;
-	free_ts_ev = ts_ev->next;
-	ethr_spin_unlock(&ts_ev_alloc_lock);
     }
+    free_ts_ev = ts_ev->next;
+    ethr_spin_unlock(&ts_ev_alloc_lock);
     return ts_ev;
 }
 
@@ -485,7 +474,6 @@ int ethr_make_ts_event__(ethr_ts_event *
 
 int ethr_get_tmp_ts_event__(ethr_ts_event **tsepp)
 {
-    int res;
     ethr_ts_event *tsep = *tsepp;
 
     if (!tsep) {
@@ -495,7 +483,7 @@ int ethr_get_tmp_ts_event__(ethr_ts_even
     }
 
     if ((tsep->iflgs & ETHR_TS_EV_INITED) == 0) {
-	res = ethr_event_init(&tsep->event);
+	int res = ethr_event_init(&tsep->event);
 	if (res != 0) {
 	    ts_event_free(tsep);
 	    return res;
@@ -547,14 +535,10 @@ int ethr_set_main_thr_status(int on, int
 int ethr_get_main_thr_status(int *on)
 {
     ethr_ts_event *tsep = ethr_get_tse__();
-    if (!tsep)
+    if (tsep && (tsep->iflgs & ETHR_TS_EV_MAIN_THR))
+	*on = 1;
+    else
 	*on = 0;
-    else {
-	if (tsep->iflgs & ETHR_TS_EV_MAIN_THR)
-	    *on = 1;
-	else
-	    *on = 0;
-    }
     return 0;
 }
 
openSUSE Build Service is sponsored by