From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 16673 invoked by alias); 11 Jul 2011 18:16:48 -0000 Received: (qmail 16660 invoked by uid 22791); 11 Jul 2011 18:16:45 -0000 X-SWARE-Spam-Status: No, hits=-2.6 required=5.0 tests=AWL,BAYES_00,DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,FREEMAIL_FROM,RCVD_IN_DNSWL_LOW,TW_TM X-Spam-Check-By: sourceware.org Received: from mail-fx0-f49.google.com (HELO mail-fx0-f49.google.com) (209.85.161.49) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Mon, 11 Jul 2011 18:16:27 +0000 Received: by fxd20 with SMTP id 20so3575738fxd.22 for ; Mon, 11 Jul 2011 11:16:26 -0700 (PDT) Received: by 10.223.72.149 with SMTP id m21mr8029664faj.52.1310408185946; Mon, 11 Jul 2011 11:16:25 -0700 (PDT) Received: from [192.168.10.107] (h-187-67.a189.priv.bahnhof.se [85.24.187.67]) by mx.google.com with ESMTPS id k17sm6797378fah.13.2011.07.11.11.16.23 (version=SSLv3 cipher=OTHER); Mon, 11 Jul 2011 11:16:24 -0700 (PDT) Message-ID: <4E1B3DF9.7000800@gmail.com> Date: Mon, 11 Jul 2011 18:26:00 -0000 From: Daniel Carrera User-Agent: Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.9.2.17) Gecko/20110424 Thunderbird/3.1.10 MIME-Version: 1.0 To: gfortran , gcc-patches@gcc.gnu.org Subject: [Patch, Fortran] Allocate + CAF library Content-Type: multipart/mixed; boundary="------------020500090407080301080108" Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org X-SW-Source: 2011-07/txt/msg00839.txt.bz2 This is a multi-part message in MIME format. --------------020500090407080301080108 Content-Type: text/plain; charset=ISO-8859-1; format=flowed Content-Transfer-Encoding: 7bit Content-length: 528 Hello, This is my largest patch so far and the first that I'll commit myself. This patch improves support for the ALLOCATE statement when using the coarray library. Specifically, it adds support for the stat= and errmsg= attributes: ALLOCATE( x(n)[*] , stat=i , errmsg=str ) These attributes are now written by the CAF library. This patch also involves a good amount of code cleanup. ChangeLog is attached. As soon as I get the go-ahead, I'll commit this patch. Cheers, Daniel. -- I'm not overweight, I'm undertall. --------------020500090407080301080108 Content-Type: text/x-patch; name="allocate.diff" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="allocate.diff" Content-length: 21693 Index: gcc/fortran/trans-array.c =================================================================== --- gcc/fortran/trans-array.c (revision 176148) +++ gcc/fortran/trans-array.c (working copy) @@ -4366,7 +4366,8 @@ gfc_array_init_size (tree descriptor, in /*GCC ARRAYS*/ bool -gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree pstat) +gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, + tree errlen) { tree tmp; tree pointer; @@ -4460,22 +4461,15 @@ gfc_array_allocate (gfc_se * se, gfc_exp error = build_call_expr_loc (input_location, gfor_fndecl_runtime_error, 1, msg); - if (pstat != NULL_TREE && !integer_zerop (pstat)) + if (status != NULL_TREE) { - /* Set the status variable if it's present. */ + tree status_type = TREE_TYPE (status); stmtblock_t set_status_block; - tree status_type = pstat ? TREE_TYPE (TREE_TYPE (pstat)) : NULL_TREE; gfc_start_block (&set_status_block); - gfc_add_modify (&set_status_block, - fold_build1_loc (input_location, INDIRECT_REF, - status_type, pstat), - build_int_cst (status_type, LIBERROR_ALLOCATION)); - - tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, - pstat, build_int_cst (TREE_TYPE (pstat), 0)); - error = fold_build3_loc (input_location, COND_EXPR, void_type_node, tmp, - error, gfc_finish_block (&set_status_block)); + gfc_add_modify (&set_status_block, status, + build_int_cst (status_type, LIBERROR_ALLOCATION)); + error = gfc_finish_block (&set_status_block); } gfc_start_block (&elseblock); @@ -4484,14 +4478,15 @@ gfc_array_allocate (gfc_se * se, gfc_exp pointer = gfc_conv_descriptor_data_get (se->expr); STRIP_NOPS (pointer); - /* The allocate_array variants take the old pointer as first argument. */ + /* The allocatable variant takes the old pointer as first argument. */ if (allocatable) - tmp = gfc_allocate_allocatable_with_status (&elseblock, - pointer, size, pstat, expr); + tmp = gfc_allocate_allocatable (&elseblock, pointer, size, + status, errmsg, errlen, expr); else - tmp = gfc_allocate_with_status (&elseblock, size, pstat, false); - tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, pointer, - tmp); + tmp = gfc_allocate_using_malloc (&elseblock, size, status); + + tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, + pointer, tmp); gfc_add_expr_to_block (&elseblock, tmp); Index: gcc/fortran/trans-array.h =================================================================== --- gcc/fortran/trans-array.h (revision 176148) +++ gcc/fortran/trans-array.h (working copy) @@ -24,7 +24,7 @@ tree gfc_array_deallocate (tree, tree, g /* Generate code to initialize an allocate an array. Statements are added to se, which should contain an expression for the array descriptor. */ -bool gfc_array_allocate (gfc_se *, gfc_expr *, tree); +bool gfc_array_allocate (gfc_se *, gfc_expr *, tree, tree, tree); /* Allow the bounds of a loop to be set from a callee's array spec. */ void gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping *, Index: gcc/fortran/trans-openmp.c =================================================================== --- gcc/fortran/trans-openmp.c (revision 176148) +++ gcc/fortran/trans-openmp.c (working copy) @@ -188,9 +188,9 @@ gfc_omp_clause_default_ctor (tree clause size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, size, esize); size = gfc_evaluate_now (fold_convert (size_type_node, size), &cond_block); - ptr = gfc_allocate_allocatable_with_status (&cond_block, - build_int_cst (pvoid_type_node, 0), - size, NULL, NULL); + ptr = gfc_allocate_allocatable (&cond_block, + build_int_cst (pvoid_type_node, 0), + size, NULL_TREE, NULL_TREE, NULL_TREE, NULL); gfc_conv_descriptor_data_set (&cond_block, decl, ptr); then_b = gfc_finish_block (&cond_block); @@ -241,9 +241,9 @@ gfc_omp_clause_copy_ctor (tree clause, t size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, size, esize); size = gfc_evaluate_now (fold_convert (size_type_node, size), &block); - ptr = gfc_allocate_allocatable_with_status (&block, - build_int_cst (pvoid_type_node, 0), - size, NULL, NULL); + ptr = gfc_allocate_allocatable (&block, + build_int_cst (pvoid_type_node, 0), + size, NULL_TREE, NULL_TREE, NULL_TREE, NULL); gfc_conv_descriptor_data_set (&block, dest, ptr); call = build_call_expr_loc (input_location, built_in_decls[BUILT_IN_MEMCPY], 3, ptr, @@ -663,9 +663,9 @@ gfc_trans_omp_array_reduction (tree c, g size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, size, esize); size = gfc_evaluate_now (fold_convert (size_type_node, size), &block); - ptr = gfc_allocate_allocatable_with_status (&block, - build_int_cst (pvoid_type_node, 0), - size, NULL, NULL); + ptr = gfc_allocate_allocatable (&block, + build_int_cst (pvoid_type_node, 0), + size, NULL_TREE, NULL_TREE, NULL_TREE, NULL); gfc_conv_descriptor_data_set (&block, decl, ptr); gfc_add_expr_to_block (&block, gfc_trans_assignment (e1, e2, false, false)); Index: gcc/fortran/trans-stmt.c =================================================================== --- gcc/fortran/trans-stmt.c (revision 176148) +++ gcc/fortran/trans-stmt.c (working copy) @@ -4686,8 +4686,10 @@ gfc_trans_allocate (gfc_code * code) tree tmp; tree parm; tree stat; - tree pstat; - tree error_label; + tree errmsg; + tree errlen; + tree label_errmsg; + tree label_finish; tree memsz; tree expr3; tree slen3; @@ -4699,7 +4701,8 @@ gfc_trans_allocate (gfc_code * code) if (!code->ext.alloc.list) return NULL_TREE; - pstat = stat = error_label = tmp = memsz = NULL_TREE; + stat = tmp = memsz = NULL_TREE; + label_errmsg = label_finish = errmsg = errlen = NULL_TREE; gfc_init_block (&block); gfc_init_block (&post); @@ -4707,13 +4710,27 @@ gfc_trans_allocate (gfc_code * code) /* Either STAT= and/or ERRMSG is present. */ if (code->expr1 || code->expr2) { + /* STAT= */ tree gfc_int4_type_node = gfc_get_int_type (4); - stat = gfc_create_var (gfc_int4_type_node, "stat"); - pstat = gfc_build_addr_expr (NULL_TREE, stat); - error_label = gfc_build_label_decl (NULL_TREE); - TREE_USED (error_label) = 1; + /* ERRMSG= */ + errmsg = null_pointer_node; + errlen = build_int_cst (gfc_charlen_type_node, 0); + if (code->expr2) + { + gfc_init_se (&se, NULL); + gfc_conv_expr_lhs (&se, code->expr2); + + errlen = gfc_get_expr_charlen (code->expr2); + errmsg = gfc_build_addr_expr (pchar_type_node, se.expr); + } + + /* GOTO destinations. */ + label_errmsg = gfc_build_label_decl (NULL_TREE); + label_finish = gfc_build_label_decl (NULL_TREE); + TREE_USED (label_errmsg) = 1; + TREE_USED (label_finish) = 1; } expr3 = NULL_TREE; @@ -4732,7 +4749,7 @@ gfc_trans_allocate (gfc_code * code) se.descriptor_only = 1; gfc_conv_expr (&se, expr); - if (!gfc_array_allocate (&se, expr, pstat)) + if (!gfc_array_allocate (&se, expr, stat, errmsg, errlen)) { /* A scalar or derived type. */ @@ -4847,10 +4864,10 @@ gfc_trans_allocate (gfc_code * code) /* Allocate - for non-pointers with re-alloc checking. */ if (gfc_expr_attr (expr).allocatable) - tmp = gfc_allocate_allocatable_with_status (&se.pre, se.expr, memsz, - pstat, expr); + tmp = gfc_allocate_allocatable (&se.pre, se.expr, memsz, + stat, errmsg, errlen, expr); else - tmp = gfc_allocate_with_status (&se.pre, memsz, pstat, false); + tmp = gfc_allocate_using_malloc (&se.pre, memsz, stat); tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, se.expr, @@ -4859,7 +4876,13 @@ gfc_trans_allocate (gfc_code * code) if (code->expr1 || code->expr2) { - tmp = build1_v (GOTO_EXPR, error_label); + /* The coarray library already sets the errmsg. */ + if (gfc_option.coarray == GFC_FCOARRAY_LIB + && gfc_expr_attr (expr).codimension) + tmp = build1_v (GOTO_EXPR, label_finish); + else + tmp = build1_v (GOTO_EXPR, label_errmsg); + parm = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, stat, build_int_cst (TREE_TYPE (stat), 0)); @@ -5005,16 +5028,11 @@ gfc_trans_allocate (gfc_code * code) } - /* STAT block. */ - if (code->expr1) + /* STAT or ERRMSG. */ + if (code->expr1 || code->expr2) { - tmp = build1_v (LABEL_EXPR, error_label); + tmp = build1_v (LABEL_EXPR, label_errmsg); gfc_add_expr_to_block (&block, tmp); - - gfc_init_se (&se, NULL); - gfc_conv_expr_lhs (&se, code->expr1); - tmp = convert (TREE_TYPE (se.expr), stat); - gfc_add_modify (&block, se.expr, tmp); } /* ERRMSG block. */ @@ -5022,7 +5040,7 @@ gfc_trans_allocate (gfc_code * code) { /* A better error message may be possible, but not required. */ const char *msg = "Attempt to allocate an allocated object"; - tree errmsg, slen, dlen; + tree slen, dlen; gfc_init_se (&se, NULL); gfc_conv_expr_lhs (&se, code->expr2); @@ -5050,6 +5068,22 @@ gfc_trans_allocate (gfc_code * code) gfc_add_expr_to_block (&block, tmp); } + /* STAT or ERRMSG. */ + if (code->expr1 || code->expr2) + { + tmp = build1_v (LABEL_EXPR, label_finish); + gfc_add_expr_to_block (&block, tmp); + } + + /* STAT block. */ + if (code->expr1) + { + gfc_init_se (&se, NULL); + gfc_conv_expr_lhs (&se, code->expr1); + tmp = convert (TREE_TYPE (se.expr), stat); + gfc_add_modify (&block, se.expr, tmp); + } + gfc_add_block_to_block (&block, &se.post); gfc_add_block_to_block (&block, &post); Index: gcc/fortran/trans.c =================================================================== --- gcc/fortran/trans.c (revision 176148) +++ gcc/fortran/trans.c (working copy) @@ -567,12 +567,12 @@ gfc_call_malloc (stmtblock_t * block, tr This function follows the following pseudo-code: void * - allocate (size_t size, integer_type* stat) + allocate (size_t size, integer_type stat) { void *newmem; - if (stat) - *stat = 0; + if (stat requested) + stat = 0; newmem = malloc (MAX (size, 1)); if (newmem == NULL) @@ -585,12 +585,11 @@ gfc_call_malloc (stmtblock_t * block, tr return newmem; } */ tree -gfc_allocate_with_status (stmtblock_t * block, tree size, tree status, - bool coarray_lib) +gfc_allocate_using_malloc (stmtblock_t * block, tree size, tree status) { stmtblock_t alloc_block; - tree res, tmp, msg, cond; - tree status_type = status ? TREE_TYPE (TREE_TYPE (status)) : NULL_TREE; + tree res, tmp, on_error; + tree status_type = status ? TREE_TYPE (status) : NULL_TREE; /* Evaluate size only once, and make sure it has the right type. */ size = gfc_evaluate_now (size, block); @@ -601,74 +600,37 @@ gfc_allocate_with_status (stmtblock_t * res = gfc_create_var (prvoid_type_node, NULL); /* Set the optional status variable to zero. */ - if (status != NULL_TREE && !integer_zerop (status)) - { - tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type, - fold_build1_loc (input_location, INDIRECT_REF, - status_type, status), - build_int_cst (status_type, 0)); - tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, - fold_build2_loc (input_location, NE_EXPR, - boolean_type_node, status, - build_int_cst (TREE_TYPE (status), 0)), - tmp, build_empty_stmt (input_location)); - gfc_add_expr_to_block (block, tmp); - } + if (status != NULL_TREE) + gfc_add_expr_to_block (block, + fold_build2_loc (input_location, MODIFY_EXPR, status_type, + status, build_int_cst (status_type, 0))); /* The allocation itself. */ gfc_start_block (&alloc_block); - if (coarray_lib) - { - gfc_add_modify (&alloc_block, res, - fold_convert (prvoid_type_node, - build_call_expr_loc (input_location, - gfor_fndecl_caf_register, 6, - fold_build2_loc (input_location, - MAX_EXPR, size_type_node, size, - build_int_cst (size_type_node, 1)), - build_int_cst (integer_type_node, - GFC_CAF_COARRAY_ALLOC), - null_pointer_node, /* token */ - null_pointer_node, /* stat */ - null_pointer_node, /* errmsg, errmsg_len */ - build_int_cst (integer_type_node, 0)))); - } + gfc_add_modify (&alloc_block, res, + fold_convert (prvoid_type_node, + build_call_expr_loc (input_location, + built_in_decls[BUILT_IN_MALLOC], 1, + fold_build2_loc (input_location, + MAX_EXPR, size_type_node, size, + build_int_cst (size_type_node, 1))))); + + /* What to do in case of error. */ + if (status != NULL_TREE) + on_error = fold_build2_loc (input_location, MODIFY_EXPR, status_type, + status, build_int_cst (status_type, LIBERROR_ALLOCATION)); else - { - gfc_add_modify (&alloc_block, res, - fold_convert (prvoid_type_node, - build_call_expr_loc (input_location, - built_in_decls[BUILT_IN_MALLOC], 1, - fold_build2_loc (input_location, - MAX_EXPR, size_type_node, size, - build_int_cst (size_type_node, 1))))); - } - - msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const - ("Allocation would exceed memory limit")); - tmp = build_call_expr_loc (input_location, - gfor_fndecl_os_error, 1, msg); - - if (status != NULL_TREE && !integer_zerop (status)) - { - /* Set the status variable if it's present. */ - tree tmp2; - - cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, - status, build_int_cst (TREE_TYPE (status), 0)); - tmp2 = fold_build2_loc (input_location, MODIFY_EXPR, status_type, - fold_build1_loc (input_location, INDIRECT_REF, - status_type, status), - build_int_cst (status_type, LIBERROR_ALLOCATION)); - tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, - tmp, tmp2); - } + on_error = 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"))); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, res, build_int_cst (prvoid_type_node, 0)), - tmp, build_empty_stmt (input_location)); + on_error, build_empty_stmt (input_location)); + gfc_add_expr_to_block (&alloc_block, tmp); gfc_add_expr_to_block (block, gfc_finish_block (&alloc_block)); @@ -676,6 +638,76 @@ gfc_allocate_with_status (stmtblock_t * } +/* Allocate memory, using an optional status argument. + + This function follows the following pseudo-code: + + void * + allocate (size_t size, integer_type stat) + { + void *newmem; + + if (stat requested) + stat = 0; + + newmem = _caf_register ( size, regtype, NULL, &stat, NULL, NULL); + if (newmem == NULL) + { + if (!stat requested) + runtime_error ("Allocation would exceed memory limit"); + } + return newmem; + } */ +tree +gfc_allocate_using_lib (stmtblock_t * block, tree size, tree status, + tree errmsg, tree errlen) +{ + tree res, pstat; + tree status_type = status ? TREE_TYPE (status) : NULL_TREE; + + /* Evaluate size only once, and make sure it has the right type. */ + size = gfc_evaluate_now (size, block); + if (TREE_TYPE (size) != TREE_TYPE (size_type_node)) + size = fold_convert (size_type_node, size); + + /* Create a variable to hold the result. */ + res = gfc_create_var (prvoid_type_node, NULL); + + /* Set the optional status variable to zero. */ + if (status != NULL_TREE) + gfc_add_expr_to_block (block, + fold_build2_loc (input_location, MODIFY_EXPR, status_type, + status, build_int_cst (status_type, 0))); + + /* The allocation itself. */ + if (status == NULL_TREE) + pstat = null_pointer_node; + else + pstat = gfc_build_addr_expr (NULL_TREE, status); + + if (errmsg == NULL_TREE) + { + gcc_assert(errlen == NULL_TREE); + errmsg = null_pointer_node; + errlen = build_int_cst (integer_type_node, 0); + } + + gfc_add_modify (block, res, + fold_convert (prvoid_type_node, + build_call_expr_loc (input_location, + gfor_fndecl_caf_register, 6, + fold_build2_loc (input_location, + MAX_EXPR, size_type_node, size, + build_int_cst (size_type_node, 1)), + build_int_cst (integer_type_node, + GFC_CAF_COARRAY_ALLOC), + null_pointer_node, /* token */ + pstat, errmsg, errlen))); + + return res; +} + + /* Generate code for an ALLOCATE statement when the argument is an allocatable variable. If the variable is currently allocated, it is an error to allocate it again. @@ -683,7 +715,7 @@ gfc_allocate_with_status (stmtblock_t * This function follows the following pseudo-code: void * - allocate_allocatable (void *mem, size_t size, integer_type *stat) + allocate_allocatable (void *mem, size_t size, integer_type stat) { if (mem == NULL) return allocate (size, stat); @@ -693,7 +725,7 @@ gfc_allocate_with_status (stmtblock_t * { free (mem); mem = allocate (size, stat); - *stat = LIBERROR_ALLOCATION; + stat = LIBERROR_ALLOCATION; return mem; } else @@ -704,8 +736,8 @@ gfc_allocate_with_status (stmtblock_t * expr must be set to the original expression being allocated for its locus and variable name in case a runtime error has to be printed. */ tree -gfc_allocate_allocatable_with_status (stmtblock_t * block, tree mem, tree size, - tree status, gfc_expr* expr) +gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, tree status, + tree errmsg, tree errlen, gfc_expr* expr) { stmtblock_t alloc_block; tree res, tmp, null_mem, alloc, error; @@ -720,11 +752,16 @@ gfc_allocate_allocatable_with_status (st boolean_type_node, mem, build_int_cst (type, 0))); - /* If mem is NULL, we call gfc_allocate_with_status. */ + /* If mem is NULL, we call gfc_allocate_using_malloc or + gfc_allocate_using_lib. */ gfc_start_block (&alloc_block); - tmp = gfc_allocate_with_status (&alloc_block, size, status, - gfc_option.coarray == GFC_FCOARRAY_LIB - && gfc_expr_attr (expr).codimension); + + if (gfc_option.coarray == GFC_FCOARRAY_LIB + && gfc_expr_attr (expr).codimension) + tmp = gfc_allocate_using_lib (&alloc_block, size, status, + errmsg, errlen); + else + tmp = gfc_allocate_using_malloc (&alloc_block, size, status); gfc_add_modify (&alloc_block, res, fold_convert (type, tmp)); alloc = gfc_finish_block (&alloc_block); @@ -749,9 +786,9 @@ gfc_allocate_allocatable_with_status (st "Attempting to allocate already allocated" " variable"); - if (status != NULL_TREE && !integer_zerop (status)) + if (status != NULL_TREE) { - tree status_type = TREE_TYPE (TREE_TYPE (status)); + tree status_type = TREE_TYPE (status); stmtblock_t set_status_block; gfc_start_block (&set_status_block); @@ -760,18 +797,12 @@ gfc_allocate_allocatable_with_status (st fold_convert (pvoid_type_node, mem)); gfc_add_expr_to_block (&set_status_block, tmp); - tmp = gfc_allocate_with_status (&set_status_block, size, status, false); + tmp = gfc_allocate_using_malloc (&set_status_block, size, status); gfc_add_modify (&set_status_block, res, fold_convert (type, tmp)); - gfc_add_modify (&set_status_block, - fold_build1_loc (input_location, INDIRECT_REF, - status_type, status), - build_int_cst (status_type, LIBERROR_ALLOCATION)); - - tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, - status, build_int_cst (status_type, 0)); - error = fold_build3_loc (input_location, COND_EXPR, void_type_node, tmp, - error, gfc_finish_block (&set_status_block)); + gfc_add_modify (&set_status_block, status, + build_int_cst (status_type, LIBERROR_ALLOCATION)); + error = gfc_finish_block (&set_status_block); } tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, null_mem, Index: gcc/fortran/trans.h =================================================================== --- gcc/fortran/trans.h (revision 176148) +++ gcc/fortran/trans.h (working copy) @@ -541,11 +541,12 @@ tree gfc_call_malloc (stmtblock_t *, tre tree gfc_build_memcpy_call (tree, tree, tree); /* Allocate memory for allocatable variables, with optional status variable. */ -tree gfc_allocate_allocatable_with_status (stmtblock_t*, - tree, tree, tree, gfc_expr*); +tree gfc_allocate_allocatable (stmtblock_t*, tree, tree, + tree, tree, tree, gfc_expr*); /* Allocate memory, with optional status variable. */ -tree gfc_allocate_with_status (stmtblock_t *, tree, tree, bool); +tree gfc_allocate_using_malloc (stmtblock_t *, tree, tree); +tree gfc_allocate_using_lib (stmtblock_t *, tree, tree, tree, tree); /* Generate code to deallocate an array. */ tree gfc_deallocate_with_status (tree, tree, bool, gfc_expr*); --------------020500090407080301080108 Content-Type: text/plain; name="ChangeLog" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="ChangeLog" Content-length: 1050 2011-07-11 Daniel Carrera * trans.c (gfc_allocate_with_status): Split into two functions gfc_allocate_using_malloc ad gfc_allocate_usig_lib. (gfc_allocate_using_malloc): The status parameter is now the actual status rather than a pointer. Code cleanup. (gfc_allocate_using_lib): Ditto. Add new parametrs errmsg and errlen. Pass these to the coarray lib. * trans-openmp.c (gfc_omp_clause_default_ctor): Update calls to gfc_allocate_allocatable. (gfc_omp_clause_copy_ctor): Ditto. (gfc_trans_omp_array_reduction): Ditto. * trans-stmt.c (gfc_trans_allocate): Ditto. Update call to gfc_allocate_using_malloc. Pass stat rather than pstat to the allocate fuctions. If using coarray lib, pass errmsg and errlen to the allocate functions. * trans-array.c (gfc_array_allocate): Add new parameters errmsg and errlen. Replace parameter pstat by status. Code cleanup. Update calls to gfc_allocate_allocatable and gfc_allocate_using_malloc. * trans-array.h (gfc_array_allocate): Update signature of gfc_array_allocate. --------------020500090407080301080108--