From patchwork Fri Aug 16 14:31:36 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Janne Blomqvist X-Patchwork-Id: 1148257 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-507129-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="A5YMJssT"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="Ap2qwjAr"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4695P95pr6z9sNC for ; Sat, 17 Aug 2019 00:31:55 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id; q=dns; s=default; b=tKZrZtOhd3Zg DeSptRRvqp2TslVkT/p9KxlLOM6pW4fOu80xp4HvgbbJ8RInvmHP3u2sef4khB3C 9/eIz4mb2UU/fb0vxp4X5uzcHcVjngy92l967zA8YhNPfLdCEynEpRu9o6CCWbzl OWEiQvx+GBavvIJrS13dfpECnDywiDM= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id; s=default; bh=8YRYi6jcSkMmynoa5k 1yHmbbqqY=; b=A5YMJssTWgv2wwQIZL+Zwg2A5b90y1GDcK1vlQYHv/ORh68jRv 2s2LDSP5cveJ6PUBUTMkgW8juiM/H7Rki2to6dHh0SZSJxBs9KX0p1m3V18HPbiK +bGBaUdkxj00rJBU/bBhILfd2+jQBfcLZuzpOlP/JO/vfvU5YuCewa3Pk= Received: (qmail 61817 invoked by alias); 16 Aug 2019 14:31:47 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 61801 invoked by uid 89); 16 Aug 2019 14:31:47 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.8 required=5.0 tests=AWL, BAYES_00, FREEMAIL_FROM, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.1 spammy=Modify, msgid X-HELO: mail-lf1-f66.google.com Received: from mail-lf1-f66.google.com (HELO mail-lf1-f66.google.com) (209.85.167.66) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Fri, 16 Aug 2019 14:31:45 +0000 Received: by mail-lf1-f66.google.com with SMTP id v16so1134894lfg.11; Fri, 16 Aug 2019 07:31:44 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:date:message-id; bh=QJXe/roqe6lhMwF4auLktYUgNny58djceuPPck6o2Qw=; b=Ap2qwjArTB0ryfk5hcIuvowOocEb0x/fkyJ2HiKiqNTXAUkGM+0+2n1YRKci2i6f0I kMm+GMrsdfTmJ+r4NMa5nIO/VD+70rgtaPbKeX+Mss4bKKW+XluR0JTTib86AucOjZv6 oxPu+SSSgI/bzfrlYTkEe+3xayhOmxCYqL9Qi6qyDKFRCsgFSNyfgS2oRj3aoIEd4Nuz nIkfdAVKXBfMLFz/ORrdVXuNvsdiH/YzF4IcGDT8bHpjv7Llv90RyIKpk+yeYISEvxcb AFvX3Uuyv5lyNPMy6kaKb0BgBoEy6bSyhaA5hz/r2KkztU5LL2QFhc//Mqqj9yOp8jpW 3s+g== Received: from ws.lan (88-114-247-254.elisa-laajakaista.fi. [88.114.247.254]) by smtp.gmail.com with ESMTPSA id j17sm1053936lfh.9.2019.08.16.07.31.41 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 16 Aug 2019 07:31:41 -0700 (PDT) From: Janne Blomqvist To: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org Cc: Janne Blomqvist Subject: [PATCH] PR fortran/68401 Improve allocation error message Date: Fri, 16 Aug 2019 17:31:36 +0300 Message-Id: <20190816143136.10583-1-blomqvist.janne@gmail.com> Improve the error message that is printed when a memory allocation fails, by including the location, and the size of the allocation that failed. Regtested on x86_64-pc-linux-gnu, Ok for trunk? (libgomp.fortran/appendix-a/a.28.5.f90 fails, but that seems unrelated) gcc/fortran/ChangeLog: 2019-08-16 Janne Blomqvist PR fortran/68401 * trans-decl.c (gfc_build_builtin_function_decls): Replace os_error with os_error_at decl. * trans.c (trans_runtime_error_vararg): Modify so the error function decl is passed directly. (gfc_trans_runtime_error): Pass correct error function decl. (gfc_trans_runtime_check): Likewise. (trans_os_error_at): New function. (gfc_call_malloc): Use trans_os_error_at. (gfc_allocate_using_malloc): Likewise. (gfc_call_realloc): Likewise. * trans.h (gfor_fndecl_os_error): Replace with gfor_fndecl_os_error_at. libgfortran/ChangeLog: 2019-08-16 Janne Blomqvist PR fortran/68401 * gfortran.map: Add GFORTRAN_10 node, add _gfortran_os_error_at symbol. * libgfortran.h (os_error_at): New prototype. * runtime/error.c (os_error_at): New function. --- gcc/fortran/trans-decl.c | 12 +++---- gcc/fortran/trans.c | 68 ++++++++++++++++++++++--------------- gcc/fortran/trans.h | 2 +- libgfortran/gfortran.map | 5 +++ libgfortran/libgfortran.h | 4 +++ libgfortran/runtime/error.c | 46 ++++++++++++++++++++++++- 6 files changed, 102 insertions(+), 35 deletions(-) diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 2a9b852568a..3c6ab60e9b2 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -102,7 +102,7 @@ tree gfor_fndecl_error_stop_string; tree gfor_fndecl_runtime_error; tree gfor_fndecl_runtime_error_at; tree gfor_fndecl_runtime_warning_at; -tree gfor_fndecl_os_error; +tree gfor_fndecl_os_error_at; tree gfor_fndecl_generate_error; tree gfor_fndecl_set_args; tree gfor_fndecl_set_fpe; @@ -3679,11 +3679,11 @@ gfc_build_builtin_function_decls (void) void_type_node, 3, pvoid_type_node, integer_type_node, pchar_type_node); - gfor_fndecl_os_error = gfc_build_library_function_decl_with_spec ( - get_identifier (PREFIX("os_error")), ".R", - void_type_node, 1, pchar_type_node); - /* The runtime_error function does not return. */ - TREE_THIS_VOLATILE (gfor_fndecl_os_error) = 1; + gfor_fndecl_os_error_at = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("os_error_at")), ".RR", + void_type_node, -2, pchar_type_node, pchar_type_node); + /* The os_error_at function does not return. */ + TREE_THIS_VOLATILE (gfor_fndecl_os_error_at) = 1; gfor_fndecl_set_args = gfc_build_library_function_decl ( get_identifier (PREFIX("set_args")), diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 84511477b39..583f6e3b25b 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -447,7 +447,7 @@ gfc_build_array_ref (tree base, tree offset, tree decl, tree vptr) arguments and a locus. */ static tree -trans_runtime_error_vararg (bool error, locus* where, const char* msgid, +trans_runtime_error_vararg (tree errorfunc, locus* where, const char* msgid, va_list ap) { stmtblock_t block; @@ -501,18 +501,13 @@ trans_runtime_error_vararg (bool error, locus* where, const char* msgid, /* Build the function call to runtime_(warning,error)_at; because of the variable number of arguments, we can't use build_call_expr_loc dinput_location, irectly. */ - if (error) - fntype = TREE_TYPE (gfor_fndecl_runtime_error_at); - else - fntype = TREE_TYPE (gfor_fndecl_runtime_warning_at); + fntype = TREE_TYPE (errorfunc); loc = where ? where->lb->location : input_location; tmp = fold_build_call_array_loc (loc, TREE_TYPE (fntype), fold_build1_loc (loc, ADDR_EXPR, build_pointer_type (fntype), - error - ? gfor_fndecl_runtime_error_at - : gfor_fndecl_runtime_warning_at), + errorfunc), nargs + 2, argarray); gfc_add_expr_to_block (&block, tmp); @@ -527,7 +522,10 @@ gfc_trans_runtime_error (bool error, locus* where, const char* msgid, ...) tree result; va_start (ap, msgid); - result = trans_runtime_error_vararg (error, where, msgid, ap); + result = trans_runtime_error_vararg (error + ? gfor_fndecl_runtime_error_at + : gfor_fndecl_runtime_warning_at, + where, msgid, ap); va_end (ap); return result; } @@ -566,8 +564,10 @@ gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock, /* The code to generate the error. */ va_start (ap, msgid); gfc_add_expr_to_block (&block, - trans_runtime_error_vararg (error, where, - msgid, ap)); + trans_runtime_error_vararg + (error ? gfor_fndecl_runtime_error_at + : gfor_fndecl_runtime_warning_at, + where, msgid, ap)); va_end (ap); if (once) @@ -595,13 +595,28 @@ gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock, } +static tree +trans_os_error_at (locus* where, const char* msgid, ...) +{ + va_list ap; + tree result; + + va_start (ap, msgid); + result = trans_runtime_error_vararg (gfor_fndecl_os_error_at, + where, msgid, ap); + va_end (ap); + return result; +} + + + /* Call malloc to allocate size bytes of memory, with special conditions: + if size == 0, return a malloced area of size 1, + if malloc returns NULL, issue a runtime error. */ tree gfc_call_malloc (stmtblock_t * block, tree type, tree size) { - tree tmp, msg, malloc_result, null_result, res, malloc_tree; + tree tmp, malloc_result, null_result, res, malloc_tree; stmtblock_t block2; /* Create a variable to hold the result. */ @@ -626,13 +641,14 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size) null_result = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, res, build_int_cst (pvoid_type_node, 0)); - msg = gfc_build_addr_expr (pchar_type_node, - gfc_build_localized_cstring_const ("Memory allocation failed")); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, null_result, - build_call_expr_loc (input_location, - gfor_fndecl_os_error, 1, msg), - build_empty_stmt (input_location)); + trans_os_error_at (NULL, + "Error allocating %lu bytes", + fold_convert + (long_unsigned_type_node, + size)), + build_empty_stmt (input_location)); gfc_add_expr_to_block (&block2, tmp); } @@ -701,11 +717,9 @@ gfc_allocate_using_malloc (stmtblock_t * block, tree pointer, } else { - /* Here, os_error already implies PRED_NORETURN. */ - tmp = build_call_expr_loc (input_location, gfor_fndecl_os_error, 1, - gfc_build_addr_expr (pchar_type_node, - gfc_build_localized_cstring_const - ("Allocation would exceed memory limit"))); + /* Here, os_error_at already implies PRED_NORETURN. */ + tree lusize = fold_convert (long_unsigned_type_node, size); + tmp = trans_os_error_at (NULL, "Error allocating %lu bytes", lusize); gfc_add_expr_to_block (&on_error, tmp); } @@ -1664,7 +1678,7 @@ internal_realloc (void *mem, size_t size) tree gfc_call_realloc (stmtblock_t * block, tree mem, tree size) { - tree msg, res, nonzero, null_result, tmp; + tree res, nonzero, null_result, tmp; tree type = TREE_TYPE (mem); /* Only evaluate the size once. */ @@ -1684,12 +1698,12 @@ gfc_call_realloc (stmtblock_t * block, tree mem, tree size) build_int_cst (size_type_node, 0)); null_result = fold_build2_loc (input_location, TRUTH_AND_EXPR, logical_type_node, null_result, nonzero); - msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const - ("Allocation would exceed memory limit")); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, null_result, - build_call_expr_loc (input_location, - gfor_fndecl_os_error, 1, msg), + trans_os_error_at (NULL, + "Error reallocating to %lu bytes", + fold_convert + (long_unsigned_type_node, size)), build_empty_stmt (input_location)); gfc_add_expr_to_block (block, tmp); diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index a3726e84140..8082b414df1 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -803,7 +803,7 @@ extern GTY(()) tree gfor_fndecl_error_stop_string; extern GTY(()) tree gfor_fndecl_runtime_error; extern GTY(()) tree gfor_fndecl_runtime_error_at; extern GTY(()) tree gfor_fndecl_runtime_warning_at; -extern GTY(()) tree gfor_fndecl_os_error; +extern GTY(()) tree gfor_fndecl_os_error_at; extern GTY(()) tree gfor_fndecl_generate_error; extern GTY(()) tree gfor_fndecl_set_fpe; extern GTY(()) tree gfor_fndecl_set_options; diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map index 2b2243b4fd4..3601bc24414 100644 --- a/libgfortran/gfortran.map +++ b/libgfortran/gfortran.map @@ -1602,3 +1602,8 @@ GFORTRAN_9.2 { _gfortran_mfindloc1_r10; _gfortran_sfindloc1_r10; } GFORTRAN_9; + +GFORTRAN_10 { + global: + _gfortran_os_error_at; +} GFORTRAN_9.2; diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h index c0db96f02a8..9f535b12e73 100644 --- a/libgfortran/libgfortran.h +++ b/libgfortran/libgfortran.h @@ -728,6 +728,10 @@ internal_proto(gfc_xtoa); extern _Noreturn void os_error (const char *); iexport_proto(os_error); +extern _Noreturn void os_error_at (const char *, const char *, ...) + __attribute__ ((format (gfc_printf, 2, 3))); +iexport_proto(os_error_at); + extern void show_locus (st_parameter_common *); internal_proto(show_locus); diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c index 0335a165edc..cbe0642f3f8 100644 --- a/libgfortran/runtime/error.c +++ b/libgfortran/runtime/error.c @@ -403,7 +403,51 @@ os_error (const char *message) estr_writev (iov, 5); exit_error (1); } -iexport(os_error); +iexport(os_error); /* TODO, DEPRECATED, ABI: Should not be exported + anymore when bumping so version. */ + + +/* Improved version of os_error with a printf style format string and + a locus. */ + +void +os_error_at (const char *where, const char *message, ...) +{ + char errmsg[STRERR_MAXSZ]; + char buffer[STRERR_MAXSZ]; + struct iovec iov[6]; + va_list ap; + recursion_check (); + int written; + + iov[0].iov_base = (char*) where; + iov[0].iov_len = strlen (where); + + iov[1].iov_base = (char*) ": "; + iov[1].iov_len = strlen (iov[1].iov_base); + + va_start (ap, message); + written = vsnprintf (buffer, STRERR_MAXSZ, message, ap); + va_end (ap); + iov[2].iov_base = buffer; + if (written >= 0) + iov[2].iov_len = written; + else + iov[2].iov_len = 0; + + iov[3].iov_base = (char*) ": "; + iov[3].iov_len = strlen (iov[3].iov_base); + + iov[4].iov_base = gf_strerror (errno, errmsg, STRERR_MAXSZ); + iov[4].iov_len = strlen (iov[4].iov_base); + + iov[5].iov_base = (char*) "\n"; + iov[5].iov_len = 1; + + estr_writev (iov, 6); + exit_error (1); +} +iexport(os_error_at); /* void runtime_error()-- These are errors associated with an