diff -Nrcpad gcc-4.5.3/gcc/fortran/ChangeLog gcc-4.5.4/gcc/fortran/ChangeLog *** gcc-4.5.3/gcc/fortran/ChangeLog Thu Apr 28 14:12:20 2011 --- gcc-4.5.4/gcc/fortran/ChangeLog Mon Jul 2 09:28:13 2012 *************** *** 1,3 **** --- 1,77 ---- + 2012-07-02 Release Manager + + * GCC 4.5.4 released. + + 2012-06-01 Tobias Burnus + + PR fortran/53521 + * trans.c (gfc_deallocate_scalar_with_status): Properly + handle the case size == 0. + + 2012-03-06 Tobias Burnus + + Backport from mainline + 2012-03-02 Tobias Burnus + + PR fortran/52452 + * resolve.c (resolve_intrinsic): Don't search for a + function if we know that it is a subroutine. + + 2012-02-23 Tobias Burnus + + PR fortran/52335 + * io.c (gfc_match_open): Remove bogus F2003 DELIM= check. + + 2012-01-28 Tobias Burnus + + PR fortran/52022 + * trans-expr.c (gfc_conv_procedure_call): Fix passing + of functions, which return allocatables. + + 2011-10-13 Janus Weil + + PR fortran/50659 + * expr.c (replace_symbol): Only do replacement if the symbol is a dummy. + + 2011-10-11 Tobias Burnus + + PR fortran/50273 + * trans-common.c (translate_common): Fix -Walign-commons check. + + 2011-09-01 Mikael Morin + + PR fortran/50050 + * resolve.c (gfc_expr_to_initialize): Don't copy rank. + Free copied shape. Recalculate shape and rank. + + 2011-08-30 Tobias Burnus + + PR fortran/50163 + * check_init_expr (check_init_expr): Return when an error occured. + + 2011-08-16 Paul Thomas + + PR fortran/42051 + PR fortran/43896 + PR fortran/49962 + * trans-expr.c (gfc_conv_derived_to_class): Handle array-valued + functions with CLASS formal arguments. + + 2011-07-23 Janus Weil + + PR fortran/49708 + * resolve.c (resolve_allocate_expr): Fix diagnostics for pointers. + + 2011-06-02 Thomas Koenig + + Backport from trunk + PR fortran/45786 + * interface.c (gfc_equivalent_op): New function. + (gfc_check_interface): Use gfc_equivalent_op instead + of switch statement. + * decl.c (access_attr_decl): Also set access to an + equivalent operator. + 2011-04-28 Release Manager * GCC 4.5.3 released. diff -Nrcpad gcc-4.5.3/gcc/fortran/decl.c gcc-4.5.4/gcc/fortran/decl.c *** gcc-4.5.3/gcc/fortran/decl.c Wed Mar 17 09:53:40 2010 --- gcc-4.5.4/gcc/fortran/decl.c Thu Jun 2 09:09:53 2011 *************** access_attr_decl (gfc_statement st) *** 6062,6069 **** --- 6062,6080 ---- case INTERFACE_INTRINSIC_OP: if (gfc_current_ns->operator_access[op] == ACCESS_UNKNOWN) { + gfc_intrinsic_op other_op; + gfc_current_ns->operator_access[op] = (st == ST_PUBLIC) ? ACCESS_PUBLIC : ACCESS_PRIVATE; + + /* Handle the case if there is another op with the same + function, for INTRINSIC_EQ vs. INTRINSIC_EQ_OS and so on. */ + other_op = gfc_equivalent_op (op); + + if (other_op != INTRINSIC_NONE) + gfc_current_ns->operator_access[other_op] = + (st == ST_PUBLIC) ? ACCESS_PUBLIC : ACCESS_PRIVATE; + } else { diff -Nrcpad gcc-4.5.3/gcc/fortran/expr.c gcc-4.5.4/gcc/fortran/expr.c *** gcc-4.5.3/gcc/fortran/expr.c Wed May 19 07:22:00 2010 --- gcc-4.5.4/gcc/fortran/expr.c Thu Oct 13 15:03:58 2011 *************** check_init_expr (gfc_expr *e) *** 2335,2340 **** --- 2335,2343 ---- m = MATCH_ERROR; } + if (m == MATCH_ERROR) + return FAILURE; + /* Try to scalarize an elemental intrinsic function that has an array argument. */ isym = gfc_find_function (e->symtree->n.sym->name); *************** gfc_expr_check_typed (gfc_expr* e, gfc_n *** 3777,3784 **** return error_found ? FAILURE : SUCCESS; } ! /* Walk an expression tree and replace all symbols with a corresponding symbol ! in the formal_ns of "sym". Needed for copying interfaces in PROCEDURE statements. The boolean return value is required by gfc_traverse_expr. */ static bool --- 3780,3788 ---- return error_found ? FAILURE : SUCCESS; } ! ! /* Walk an expression tree and replace all dummy symbols by the corresponding ! symbol in the formal_ns of "sym". Needed for copying interfaces in PROCEDURE statements. The boolean return value is required by gfc_traverse_expr. */ static bool *************** replace_symbol (gfc_expr *expr, gfc_symb *** 3787,3800 **** if ((expr->expr_type == EXPR_VARIABLE || (expr->expr_type == EXPR_FUNCTION && !gfc_is_intrinsic (expr->symtree->n.sym, 0, expr->where))) ! && expr->symtree->n.sym->ns == sym->ts.interface->formal_ns) { ! gfc_symtree *stree; ! gfc_namespace *ns = sym->formal_ns; ! /* Don't use gfc_get_symtree as we prefer to fail badly if we don't find ! the symtree rather than create a new one (and probably fail later). */ ! stree = gfc_find_symtree (ns ? ns->sym_root : gfc_current_ns->sym_root, ! expr->symtree->n.sym->name); gcc_assert (stree); stree->n.sym->attr = expr->symtree->n.sym->attr; expr->symtree = stree; --- 3791,3802 ---- if ((expr->expr_type == EXPR_VARIABLE || (expr->expr_type == EXPR_FUNCTION && !gfc_is_intrinsic (expr->symtree->n.sym, 0, expr->where))) ! && expr->symtree->n.sym->ns == sym->ts.interface->formal_ns ! && expr->symtree->n.sym->attr.dummy) { ! gfc_symtree *root = sym->formal_ns ? sym->formal_ns->sym_root ! : gfc_current_ns->sym_root; ! gfc_symtree *stree = gfc_find_symtree (root, expr->symtree->n.sym->name); gcc_assert (stree); stree->n.sym->attr = expr->symtree->n.sym->attr; expr->symtree = stree; *************** gfc_expr_replace_symbols (gfc_expr *expr *** 3808,3813 **** --- 3810,3816 ---- gfc_traverse_expr (expr, dest, &replace_symbol, 0); } + /* The following is analogous to 'replace_symbol', and needed for copying interfaces for procedure pointer components. The argument 'sym' must formally be a gfc_symbol, so that the function can be passed to gfc_traverse_expr. diff -Nrcpad gcc-4.5.3/gcc/fortran/gfortran.h gcc-4.5.4/gcc/fortran/gfortran.h *** gcc-4.5.3/gcc/fortran/gfortran.h Tue Jan 25 17:01:06 2011 --- gcc-4.5.4/gcc/fortran/gfortran.h Thu Jun 2 09:09:53 2011 *************** void gfc_set_current_interface_head (gfc *** 2718,2723 **** --- 2718,2724 ---- gfc_symtree* gfc_find_sym_in_symtree (gfc_symbol*); bool gfc_arglist_matches_symbol (gfc_actual_arglist**, gfc_symbol*); bool gfc_check_operator_interface (gfc_symbol*, gfc_intrinsic_op, locus); + gfc_intrinsic_op gfc_equivalent_op (gfc_intrinsic_op); /* io.c */ extern gfc_st_label format_asterisk; diff -Nrcpad gcc-4.5.3/gcc/fortran/gfortran.info gcc-4.5.4/gcc/fortran/gfortran.info *** gcc-4.5.3/gcc/fortran/gfortran.info Thu Apr 28 15:20:25 2011 --- gcc-4.5.4/gcc/fortran/gfortran.info Mon Jul 2 10:19:01 2012 *************** *** 1,5 **** This is doc/gfortran.info, produced by makeinfo version 4.12 from ! /space/rguenther/gcc-4.5.3/gcc-4.5.3/gcc/fortran/gfortran.texi. Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. --- 1,5 ---- This is doc/gfortran.info, produced by makeinfo version 4.12 from ! /space/rguenther/gcc-4.5.4/gcc-4.5.4/gcc/fortran/gfortran.texi. Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. diff -Nrcpad gcc-4.5.3/gcc/fortran/interface.c gcc-4.5.4/gcc/fortran/interface.c *** gcc-4.5.3/gcc/fortran/interface.c Mon Feb 14 06:38:44 2011 --- gcc-4.5.4/gcc/fortran/interface.c Thu Jun 2 09:09:53 2011 *************** check_uop_interfaces (gfc_user_op *uop) *** 1213,1218 **** --- 1213,1266 ---- } } + /* Given an intrinsic op, return an equivalent op if one exists, + or INTRINSIC_NONE otherwise. */ + + gfc_intrinsic_op + gfc_equivalent_op (gfc_intrinsic_op op) + { + switch(op) + { + case INTRINSIC_EQ: + return INTRINSIC_EQ_OS; + + case INTRINSIC_EQ_OS: + return INTRINSIC_EQ; + + case INTRINSIC_NE: + return INTRINSIC_NE_OS; + + case INTRINSIC_NE_OS: + return INTRINSIC_NE; + + case INTRINSIC_GT: + return INTRINSIC_GT_OS; + + case INTRINSIC_GT_OS: + return INTRINSIC_GT; + + case INTRINSIC_GE: + return INTRINSIC_GE_OS; + + case INTRINSIC_GE_OS: + return INTRINSIC_GE; + + case INTRINSIC_LT: + return INTRINSIC_LT_OS; + + case INTRINSIC_LT_OS: + return INTRINSIC_LT; + + case INTRINSIC_LE: + return INTRINSIC_LE_OS; + + case INTRINSIC_LE_OS: + return INTRINSIC_LE; + + default: + return INTRINSIC_NONE; + } + } /* For the namespace, check generic, user operator and intrinsic operator interfaces for consistency and to remove duplicate *************** gfc_check_interfaces (gfc_namespace *ns) *** 1253,1327 **** for (ns2 = ns; ns2; ns2 = ns2->parent) { if (check_interface1 (ns->op[i], ns2->op[i], 0, interface_name, true)) goto done; ! switch (i) ! { ! case INTRINSIC_EQ: ! if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_EQ_OS], ! 0, interface_name, true)) goto done; ! break; ! ! case INTRINSIC_EQ_OS: ! if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_EQ], ! 0, interface_name, true)) goto done; ! break; ! ! case INTRINSIC_NE: ! if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_NE_OS], ! 0, interface_name, true)) goto done; ! break; ! ! case INTRINSIC_NE_OS: ! if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_NE], ! 0, interface_name, true)) goto done; ! break; ! ! case INTRINSIC_GT: ! if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_GT_OS], ! 0, interface_name, true)) goto done; ! break; ! ! case INTRINSIC_GT_OS: ! if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_GT], ! 0, interface_name, true)) goto done; ! break; ! ! case INTRINSIC_GE: ! if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_GE_OS], ! 0, interface_name, true)) goto done; ! break; ! ! case INTRINSIC_GE_OS: ! if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_GE], ! 0, interface_name, true)) goto done; ! break; ! ! case INTRINSIC_LT: ! if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_LT_OS], ! 0, interface_name, true)) goto done; ! break; ! ! case INTRINSIC_LT_OS: ! if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_LT], ! 0, interface_name, true)) goto done; ! break; ! ! case INTRINSIC_LE: ! if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_LE_OS], ! 0, interface_name, true)) goto done; ! break; ! ! case INTRINSIC_LE_OS: ! if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_LE], ! 0, interface_name, true)) goto done; ! break; ! ! default: ! break; ! } } } --- 1301,1319 ---- for (ns2 = ns; ns2; ns2 = ns2->parent) { + gfc_intrinsic_op other_op; + if (check_interface1 (ns->op[i], ns2->op[i], 0, interface_name, true)) goto done; ! /* i should be gfc_intrinsic_op, but has to be int with this cast ! here for stupid C++ compatibility rules. */ ! other_op = gfc_equivalent_op ((gfc_intrinsic_op) i); ! if (other_op != INTRINSIC_NONE ! && check_interface1 (ns->op[i], ns2->op[other_op], ! 0, interface_name, true)) ! goto done; } } diff -Nrcpad gcc-4.5.3/gcc/fortran/io.c gcc-4.5.4/gcc/fortran/io.c *** gcc-4.5.3/gcc/fortran/io.c Sat Nov 28 12:13:21 2009 --- gcc-4.5.4/gcc/fortran/io.c Thu Feb 23 22:54:26 2012 *************** gfc_match_open (void) *** 1893,1902 **** /* Checks on the DELIM specifier. */ if (open->delim) { - if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: DELIM= at %C " - "not allowed in Fortran 95") == FAILURE) - goto cleanup; - if (open->delim->expr_type == EXPR_CONSTANT) { static const char *delim[] = { "APOSTROPHE", "QUOTE", "NONE", NULL }; --- 1893,1898 ---- diff -Nrcpad gcc-4.5.3/gcc/fortran/resolve.c gcc-4.5.4/gcc/fortran/resolve.c *** gcc-4.5.3/gcc/fortran/resolve.c Tue Jan 25 17:01:06 2011 --- gcc-4.5.4/gcc/fortran/resolve.c Tue Mar 6 17:09:48 2012 *************** resolve_intrinsic (gfc_symbol *sym, locu *** 1211,1217 **** gfc_find_subroutine directly to check whether it is a function or subroutine. */ ! if ((isym = gfc_find_function (sym->name))) { if (sym->ts.type != BT_UNKNOWN && gfc_option.warn_surprising && !sym->attr.implicit_type) --- 1211,1217 ---- gfc_find_subroutine directly to check whether it is a function or subroutine. */ ! if (!sym->attr.subroutine && (isym = gfc_find_function (sym->name))) { if (sym->ts.type != BT_UNKNOWN && gfc_option.warn_surprising && !sym->attr.implicit_type) *************** gfc_expr_to_initialize (gfc_expr *e) *** 6172,6181 **** for (i = 0; i < ref->u.ar.dimen; i++) ref->u.ar.start[i] = ref->u.ar.end[i] = ref->u.ar.stride[i] = NULL; - result->rank = ref->u.ar.dimen; break; } return result; } --- 6172,6190 ---- for (i = 0; i < ref->u.ar.dimen; i++) ref->u.ar.start[i] = ref->u.ar.end[i] = ref->u.ar.stride[i] = NULL; break; } + if (result->shape != NULL) + { + for (i = 0; i < result->rank; i++) + mpz_clear (result->shape[i]); + gfc_free (result->shape); + result->shape = NULL; + } + + /* Recalculate rank, shape, etc. */ + gfc_resolve_expr (result); return result; } *************** resolve_allocate_expr (gfc_expr *e, gfc_ *** 6402,6408 **** } } ! if (pointer || dimension == 0) return SUCCESS; /* Make sure the next-to-last reference node is an array specification. */ --- 6411,6417 ---- } } ! if (dimension == 0) return SUCCESS; /* Make sure the next-to-last reference node is an array specification. */ diff -Nrcpad gcc-4.5.3/gcc/fortran/trans-common.c gcc-4.5.4/gcc/fortran/trans-common.c *** gcc-4.5.3/gcc/fortran/trans-common.c Sat Nov 13 17:23:49 2010 --- gcc-4.5.4/gcc/fortran/trans-common.c Tue Oct 11 12:33:22 2011 *************** translate_common (gfc_common_head *commo *** 1060,1073 **** HOST_WIDE_INT offset; HOST_WIDE_INT current_offset; unsigned HOST_WIDE_INT align; - unsigned HOST_WIDE_INT max_align; bool saw_equiv; common_segment = NULL; offset = 0; current_offset = 0; align = 1; - max_align = 1; saw_equiv = false; /* Add symbols to the segment. */ --- 1060,1071 ---- *************** translate_common (gfc_common_head *commo *** 1110,1116 **** if (gfc_option.flag_align_commons) offset = align_segment (&align); ! if (offset & (max_align - 1)) { /* The required offset conflicts with previous alignment requirements. Insert padding immediately before this --- 1108,1114 ---- if (gfc_option.flag_align_commons) offset = align_segment (&align); ! if (offset) { /* The required offset conflicts with previous alignment requirements. Insert padding immediately before this *************** translate_common (gfc_common_head *commo *** 1133,1140 **** /* Apply the offset to the new segments. */ apply_segment_offset (current_segment, offset); current_offset += offset; - if (max_align < align) - max_align = align; /* Add the new segments to the common block. */ common_segment = add_segments (common_segment, current_segment); --- 1131,1136 ---- *************** translate_common (gfc_common_head *commo *** 1154,1164 **** if (common_segment->offset != 0 && gfc_option.warn_align_commons) { if (strcmp (common->name, BLANK_COMMON_NAME)) ! gfc_warning ("COMMON '%s' at %L requires %d bytes of padding at start; " "reorder elements or use -fno-align-commons", common->name, &common->where, (int)common_segment->offset); else ! gfc_warning ("COMMON at %L requires %d bytes of padding at start; " "reorder elements or use -fno-align-commons", &common->where, (int)common_segment->offset); } --- 1150,1160 ---- if (common_segment->offset != 0 && gfc_option.warn_align_commons) { if (strcmp (common->name, BLANK_COMMON_NAME)) ! gfc_warning ("COMMON '%s' at %L requires %d bytes of padding; " "reorder elements or use -fno-align-commons", common->name, &common->where, (int)common_segment->offset); else ! gfc_warning ("COMMON at %L requires %d bytes of padding; " "reorder elements or use -fno-align-commons", &common->where, (int)common_segment->offset); } diff -Nrcpad gcc-4.5.3/gcc/fortran/trans-expr.c gcc-4.5.4/gcc/fortran/trans-expr.c *** gcc-4.5.3/gcc/fortran/trans-expr.c Sat Feb 19 08:57:10 2011 --- gcc-4.5.4/gcc/fortran/trans-expr.c Sat Jan 28 10:59:18 2012 *************** gfc_conv_derived_to_class (gfc_se *parms *** 2638,2649 **** --- 2638,2651 ---- ss = gfc_walk_expr (e); if (ss == gfc_ss_terminator) { + parmse->ss = NULL; gfc_conv_expr_reference (parmse, e); tmp = fold_convert (TREE_TYPE (ctree), parmse->expr); gfc_add_modify (&parmse->pre, ctree, tmp); } else { + parmse->ss = ss; gfc_conv_expr (parmse, e); gfc_add_modify (&parmse->pre, ctree, parmse->expr); } *************** gfc_conv_procedure_call (gfc_se * se, gf *** 3035,3041 **** && e->symtree->n.sym->attr.dummy)) || (e->expr_type == EXPR_VARIABLE && gfc_is_proc_ptr_comp (e, NULL)) ! || fsym->attr.allocatable)) { /* Scalar pointer dummy args require an extra level of indirection. The null pointer already contains --- 3037,3044 ---- && e->symtree->n.sym->attr.dummy)) || (e->expr_type == EXPR_VARIABLE && gfc_is_proc_ptr_comp (e, NULL)) ! || (fsym->attr.allocatable ! && fsym->attr.flavor != FL_PROCEDURE))) { /* Scalar pointer dummy args require an extra level of indirection. The null pointer already contains diff -Nrcpad gcc-4.5.3/gcc/fortran/trans.c gcc-4.5.4/gcc/fortran/trans.c *** gcc-4.5.3/gcc/fortran/trans.c Fri Aug 20 08:41:00 2010 --- gcc-4.5.4/gcc/fortran/trans.c Fri Jun 1 20:40:36 2012 *************** internal_realloc (void *mem, size_t size *** 920,934 **** if (!res && size != 0) _gfortran_os_error ("Out of memory"); - if (size == 0) - return NULL; - return res; } */ tree gfc_call_realloc (stmtblock_t * block, tree mem, tree size) { ! tree msg, res, negative, nonzero, zero, null_result, tmp; tree type = TREE_TYPE (mem); size = gfc_evaluate_now (size, block); --- 920,931 ---- if (!res && size != 0) _gfortran_os_error ("Out of memory"); return res; } */ tree gfc_call_realloc (stmtblock_t * block, tree mem, tree size) { ! tree msg, res, negative, nonzero, null_result, tmp; tree type = TREE_TYPE (mem); size = gfc_evaluate_now (size, block); *************** gfc_call_realloc (stmtblock_t * block, t *** 969,981 **** build_empty_stmt (input_location)); gfc_add_expr_to_block (block, tmp); - /* if (size == 0) then the result is NULL. */ - tmp = fold_build2 (MODIFY_EXPR, type, res, build_int_cst (type, 0)); - zero = fold_build1 (TRUTH_NOT_EXPR, boolean_type_node, nonzero); - tmp = fold_build3 (COND_EXPR, void_type_node, zero, tmp, - build_empty_stmt (input_location)); - gfc_add_expr_to_block (block, tmp); - return res; } --- 966,971 ---- diff -Nrcpad gcc-4.5.3/libgfortran/ChangeLog gcc-4.5.4/libgfortran/ChangeLog *** gcc-4.5.3/libgfortran/ChangeLog Thu Apr 28 14:09:02 2011 --- gcc-4.5.4/libgfortran/ChangeLog Mon Jul 2 09:24:52 2012 *************** *** 1,3 **** --- 1,40 ---- + 2012-07-02 Release Manager + + * GCC 4.5.4 released. + + 2012-05-12 Tobias Burnus + + PR fortran/53310 + * intrinsics/eoshift2.c (eoshift2): Do not leak + memory by allocating it in the loop. + + 2011-08-30 Thomas Koenig + + Backport from trunk + PR libfortran/50192 + * intrinsics/string_intrinsics.c (memcmp_char4): New function. + * intrinsics/string_intrinsics_inc.c: New macro MEMCMP, either + set to memcmp or memcmp_char4. + (compare_string): Use MEMCMP, with correct size for it. + * libgfortran.h: Add prototype for memcmp_char4. + + 2011-08-19 Tobias Burnus + + Backport from mainline + 2011-08-18 Tobias Burnus + + PR fortran/50109 + * io/list_read.c (eat_separator): Fix skipping over "!" lines. + + 2011-07-27 Tobias Burnus + + Backport from mainline + 2011-07-23 Tobias Burnus + + PR fortran/49791 + * io/list_read.c (nml_parse_qualifier): Remove check to + enabled extended read for another case. + 2011-04-28 Release Manager * GCC 4.5.3 released. diff -Nrcpad gcc-4.5.3/libgfortran/intrinsics/eoshift2.c gcc-4.5.4/libgfortran/intrinsics/eoshift2.c *** gcc-4.5.3/libgfortran/intrinsics/eoshift2.c Sun Jul 19 15:07:21 2009 --- gcc-4.5.4/libgfortran/intrinsics/eoshift2.c Fri May 11 23:09:30 2012 *************** eoshift2 (gfc_array_char *ret, const gfc *** 77,82 **** --- 77,88 ---- ret->offset = 0; ret->dtype = array->dtype; + + if (arraysize > 0) + ret->data = internal_malloc_size (size * arraysize); + else + ret->data = internal_malloc_size (1); + for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { index_type ub, str; *************** eoshift2 (gfc_array_char *ret, const gfc *** 90,101 **** * GFC_DESCRIPTOR_STRIDE(ret,i-1); GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); - - if (arraysize > 0) - ret->data = internal_malloc_size (size * arraysize); - else - ret->data = internal_malloc_size (1); - } } else if (unlikely (compile_options.bounds_check)) --- 96,101 ---- diff -Nrcpad gcc-4.5.3/libgfortran/intrinsics/string_intrinsics.c gcc-4.5.4/libgfortran/intrinsics/string_intrinsics.c *** gcc-4.5.3/libgfortran/intrinsics/string_intrinsics.c Thu Apr 9 15:00:19 2009 --- gcc-4.5.4/libgfortran/intrinsics/string_intrinsics.c Tue Aug 30 21:36:48 2011 *************** memset_char4 (gfc_char4_t *b, gfc_char4_ *** 51,56 **** --- 51,73 ---- return b; } + /* Compare wide character types, which are handled internally as + unsigned 4-byte integers. */ + int + memcmp_char4 (const void *a, const void *b, size_t len) + { + const GFC_UINTEGER_4 *pa = a; + const GFC_UINTEGER_4 *pb = b; + while (len-- > 0) + { + if (*pa != *pb) + return *pa < *pb ? -1 : 1; + pa ++; + pb ++; + } + return 0; + } + /* All other functions are defined using a few generic macros in string_intrinsics_inc.c, so we avoid code duplication between the *************** memset_char4 (gfc_char4_t *b, gfc_char4_ *** 64,69 **** --- 81,88 ---- #define SUFFIX(x) x #undef MEMSET #define MEMSET memset + #undef MEMCMP + #define MEMCMP memcmp #include "string_intrinsics_inc.c" *************** memset_char4 (gfc_char4_t *b, gfc_char4_ *** 76,81 **** --- 95,102 ---- #define SUFFIX(x) x ## _char4 #undef MEMSET #define MEMSET memset_char4 + #undef MEMCMP + #define MEMCMP memcmp_char4 #include "string_intrinsics_inc.c" diff -Nrcpad gcc-4.5.3/libgfortran/intrinsics/string_intrinsics_inc.c gcc-4.5.4/libgfortran/intrinsics/string_intrinsics_inc.c *** gcc-4.5.3/libgfortran/intrinsics/string_intrinsics_inc.c Fri Aug 14 19:30:13 2009 --- gcc-4.5.4/libgfortran/intrinsics/string_intrinsics_inc.c Tue Aug 30 21:36:48 2011 *************** compare_string (gfc_charlen_type len1, c *** 90,96 **** gfc_charlen_type len; int res; ! res = memcmp (s1, s2, ((len1 < len2) ? len1 : len2) * sizeof (CHARTYPE)); if (res != 0) return res; --- 90,96 ---- gfc_charlen_type len; int res; ! res = MEMCMP (s1, s2, ((len1 < len2) ? len1 : len2)); if (res != 0) return res; diff -Nrcpad gcc-4.5.3/libgfortran/io/list_read.c gcc-4.5.4/libgfortran/io/list_read.c *** gcc-4.5.3/libgfortran/io/list_read.c Mon Mar 7 02:06:27 2011 --- gcc-4.5.4/libgfortran/io/list_read.c Fri Aug 19 09:16:03 2011 *************** eat_separator (st_parameter_dt *dtp) *** 353,364 **** if (c == '!') { eat_line (dtp); ! c = next_char (dtp); ! if (c == '!') ! { ! eat_line (dtp); ! c = next_char (dtp); ! } } } while (c == '\n' || c == '\r' || c == ' ' || c == '\t'); --- 353,359 ---- if (c == '!') { eat_line (dtp); ! c = '\n'; } } while (c == '\n' || c == '\r' || c == ' ' || c == '\t'); *************** nml_parse_qualifier (st_parameter_dt *dt *** 2078,2084 **** do not allow excess data to be processed. */ if (is_array_section == 1 || !(compile_options.allow_std & GFC_STD_GNU) - || !dtp->u.p.ionml->touched || dtp->u.p.ionml->type == GFC_DTYPE_DERIVED) ls[dim].end = ls[dim].start; else --- 2073,2078 ---- diff -Nrcpad gcc-4.5.3/libgfortran/libgfortran.h gcc-4.5.4/libgfortran/libgfortran.h *** gcc-4.5.3/libgfortran/libgfortran.h Thu Apr 1 18:22:00 2010 --- gcc-4.5.4/libgfortran/libgfortran.h Tue Aug 30 21:36:48 2011 *************** extern int compare_string_char4 (gfc_cha *** 1286,1291 **** --- 1286,1295 ---- gfc_charlen_type, const gfc_char4_t *); iexport_proto(compare_string_char4); + extern int memcmp_char4 (const void *, const void *, size_t); + internal_proto(memcmp_char4); + + /* random.c */ extern void random_seed_i4 (GFC_INTEGER_4 * size, gfc_array_i4 * put,