diff -Nrcpad gcc-4.6.3/gcc/fortran/ChangeLog gcc-4.6.4/gcc/fortran/ChangeLog *** gcc-4.6.3/gcc/fortran/ChangeLog Thu Mar 1 11:55:03 2012 --- gcc-4.6.4/gcc/fortran/ChangeLog Fri Apr 12 09:51:17 2013 *************** *** 1,3 **** --- 1,178 ---- + 2013-04-12 Release Manager + + * GCC 4.6.4 released. + + 2013-03-15 Tobias Burnus + + PR fortran/56615 + * trans-intrinsic.c (gfc_conv_intrinsic_transfer): Pack arrays + if they are not simply contiguous. + + 2013-03-13 Paul Thomas + + PR fortran/56575 + * expr.c (gfc_default_initializer): Check that a class declared + type has any components. + * resolve.c (resolve_fl_derived0): On failing the test for C437 + set the type to BT_UNKNOWN to prevent repeat error messages. + + 2013-03-10 Paul Thomas + + PR fortran/55362 + * check.c (array_check): It is an error if a procedure is + passed. + + 2013-02-23 Janus Weil + + PR fortran/56385 + * trans-array.c (structure_alloc_comps): Handle procedure-pointer + components with allocatable result. + + 2013-02-15 Tobias Burnus + Mikael Morin + + PR fortran/56318 + * simplify.c (gfc_simplify_matmul): Fix result shape + and matmul result. + + 2013-02-13 Tobias Burnus + + Backported from mainline + 2013-01-07 Tobias Burnus + Thomas Koenig + Jakub Jelinek + + PR fortran/55852 + * expr.c (gfc_build_intrinsic_call): Avoid clashes + with user's procedures. + * gfortran.h (gfc_build_intrinsic_call): Update prototype. + (GFC_PREFIX): Define. + * simplify.c (gfc_simplify_size): Update call. + + 2013-02-03 Thomas Koenig + + Backport from trunk + PR fortran/50627 + PR fortran/56054 + * decl.c (gfc_match_end): Remove half-ready namespace + from parent if the end of a block is missing. + * parse.c (parse_module): Do not put namespace into + gsymbol on error. + + 2013-01-14 Janus Weil + + PR fortran/55072 + * trans-array.c (gfc_conv_array_parameter): No packing was done for + full arrays of derived type. + + 2013-01-14 Paul Thomas + + PR fortran/55618 + * trans-expr.c (gfc_conv_procedure_call): Dereference scalar + character function arguments to elemental procedures in + scalarization loops. + + 2013-01-08 Mikael Morin + + PR fortran/42769 + PR fortran/45836 + PR fortran/45900 + * module.c (read_module): Don't reuse local symtree if the associated + symbol isn't exactly the one wanted. Don't reuse local symtree if it is + ambiguous. + * resolve.c (resolve_call): Use symtree's name instead of symbol's to + lookup the symtree. + + 2013-01-07 Steven G. Kargl + Mikael Morin + + PR fortran/55827 + * trans-expr.c (gfc_conv_function_expr): Init sym earlier. Use it. + + 2012-11-24 Thomas Koenig + + PR fortran/55314 + Backport from trunk + * resolve.c (resolve_allocate_deallocate): Compare all + subscripts when deciding if to reject a (de)allocate + statement. + + 2012-09-13 Tobias Burnus + + PR fortran/54225 + PR fortran/53306 + * array.c (match_subscript, gfc_match_array_ref): Fix + diagnostic of coarray's '*'. + + 2012-09-13 Tobias Burnus + + PR fortran/54556 + * resolve.c (gfc_impure_variable): Don't check gfc_pure such + that the function also works for gfc_implicit_pure procedures. + + 2012-09-12 Mikael Morin + + PR fortran/54208 + * simplify.c (simplify_bound_dim): Resolve array spec before + proceeding with simplification. + + 2012-07-14 Mikael Morin + + Backport from trunk: + 2012-01-09 Mikael Morin + + PR fortran/51758 + * trans-array.c (gfc_walk_elemental_function_args): + Skip over NULL() actual arguments. + + 2012-06-14 Tobias Burnus + + PR fortran/53597 + * decl.c (match_attr_spec): Only mark module variables + as SAVE_IMPLICIT for Fortran 2008 and later. + + 2012-06-05 Tobias Burnus + + PR fortran/50619 + * resolve.c (build_default_init_expr): Don't initialize + ASSOCIATE names. + + 2012-06-01 Tobias Burnus + + PR fortran/53521 + * trans.c (gfc_deallocate_scalar_with_status): Properly + handle the case size == 0. + + 2012-05-23 Tobias Burnus + + PR fortran/53389 + * trans-array.c (gfc_add_loop_ss_code): Don't evaluate + expression, if ss->is_alloc_lhs is set. + + 2012-05-02 Tobias Burnus + + Backport from mainline + 2012-04-12 Tobias Burnus + + PR fortran/52864 + * expr.c (gfc_check_vardef_context): Fix assignment check for + pointer components. + + 2012-03-10 Tobias Burnus + + PR fortran/52469 + * trans-types.c (gfc_get_function_type): Handle backend_decl + of a procedure pointer. + + 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-03-01 Release Manager * GCC 4.6.3 released. diff -Nrcpad gcc-4.6.3/gcc/fortran/array.c gcc-4.6.4/gcc/fortran/array.c *** gcc-4.6.3/gcc/fortran/array.c Mon Aug 22 20:03:00 2011 --- gcc-4.6.4/gcc/fortran/array.c Thu Sep 13 18:19:22 2012 *************** match_subscript (gfc_array_ref *ar, int *** 91,99 **** else if (!star) m = gfc_match_expr (&ar->start[i]); ! if (m == MATCH_NO && gfc_match_char ('*') == MATCH_YES) ! return MATCH_NO; ! else if (m == MATCH_NO) gfc_error ("Expected array subscript at %C"); if (m != MATCH_YES) return MATCH_ERROR; --- 91,97 ---- else if (!star) m = gfc_match_expr (&ar->start[i]); ! if (m == MATCH_NO) gfc_error ("Expected array subscript at %C"); if (m != MATCH_YES) return MATCH_ERROR; *************** coarray: *** 224,230 **** for (ar->codimen = 0; ar->codimen + ar->dimen < GFC_MAX_DIMENSIONS; ar->codimen++) { ! m = match_subscript (ar, init, ar->codimen == (corank - 1)); if (m == MATCH_ERROR) return MATCH_ERROR; --- 222,228 ---- for (ar->codimen = 0; ar->codimen + ar->dimen < GFC_MAX_DIMENSIONS; ar->codimen++) { ! m = match_subscript (ar, init, true); if (m == MATCH_ERROR) return MATCH_ERROR; *************** coarray: *** 249,254 **** --- 247,259 ---- gfc_error ("Invalid form of coarray reference at %C"); return MATCH_ERROR; } + else if (ar->dimen_type[ar->codimen + ar->dimen] == DIMEN_STAR) + { + gfc_error ("Unexpected '*' for codimension %d of %d at %C", + ar->codimen + 1, corank); + return MATCH_ERROR; + } + if (ar->codimen >= corank) { gfc_error ("Invalid codimension %d at %C, only %d codimensions exist", diff -Nrcpad gcc-4.6.3/gcc/fortran/check.c gcc-4.6.4/gcc/fortran/check.c *** gcc-4.6.3/gcc/fortran/check.c Tue Jan 24 08:35:10 2012 --- gcc-4.6.4/gcc/fortran/check.c Sun Mar 10 21:02:44 2013 *************** is_coarray (gfc_expr *e) *** 220,226 **** if (ref->type == REF_COMPONENT) coarray = ref->u.c.component->attr.codimension; else if (ref->type != REF_ARRAY || ref->u.ar.dimen != 0 ! || ref->u.ar.codimen != 0) coarray = false; } --- 220,226 ---- if (ref->type == REF_COMPONENT) coarray = ref->u.c.component->attr.codimension; else if (ref->type != REF_ARRAY || ref->u.ar.dimen != 0 ! || ref->u.ar.codimen != 0) coarray = false; } *************** coarray_check (gfc_expr *e, int n) *** 240,246 **** } return SUCCESS; ! } /* Make sure the expression is a logical array. */ --- 240,246 ---- } return SUCCESS; ! } /* Make sure the expression is a logical array. */ *************** logical_array_check (gfc_expr *array, in *** 265,271 **** static gfc_try array_check (gfc_expr *e, int n) { ! if (e->rank != 0) return SUCCESS; gfc_error ("'%s' argument of '%s' intrinsic at %L must be an array", --- 265,271 ---- static gfc_try array_check (gfc_expr *e, int n) { ! if (e->rank != 0 && e->ts.type != BT_PROCEDURE) return SUCCESS; gfc_error ("'%s' argument of '%s' intrinsic at %L must be an array", *************** less_than_bitsizekind (const char *arg, *** 346,352 **** if (expr->expr_type != EXPR_CONSTANT) return SUCCESS; ! i = gfc_validate_kind (BT_INTEGER, k, false); gfc_extract_int (expr, &val); --- 346,352 ---- if (expr->expr_type != EXPR_CONSTANT) return SUCCESS; ! i = gfc_validate_kind (BT_INTEGER, k, false); gfc_extract_int (expr, &val); *************** variable_check (gfc_expr *e, int n, bool *** 501,507 **** || (ref->u.c.component->ts.type != BT_CLASS && ref->u.c.component->attr.pointer))) break; ! } if (!ref) { --- 501,507 ---- || (ref->u.c.component->ts.type != BT_CLASS && ref->u.c.component->attr.pointer))) break; ! } if (!ref) { *************** identical_dimen_shape (gfc_expr *a, int *** 651,657 **** { if (mpz_cmp (a_size, b_size) != 0) ret = 0; ! mpz_clear (b_size); } mpz_clear (a_size); --- 651,657 ---- { if (mpz_cmp (a_size, b_size) != 0) ret = 0; ! mpz_clear (b_size); } mpz_clear (a_size); *************** gfc_check_allocated (gfc_expr *array) *** 824,830 **** return FAILURE; if (allocatable_check (array, 0) == FAILURE) return FAILURE; ! return SUCCESS; } --- 824,830 ---- return FAILURE; if (allocatable_check (array, 0) == FAILURE) return FAILURE; ! return SUCCESS; } *************** gfc_check_ichar_iachar (gfc_expr *c, gfc *** 1752,1758 **** return SUCCESS; i = mpz_get_si (c->ts.u.cl->length->value.integer); } ! else return SUCCESS; } else --- 1752,1758 ---- return SUCCESS; i = mpz_get_si (c->ts.u.cl->length->value.integer); } ! else return SUCCESS; } else *************** gfc_check_ichar_iachar (gfc_expr *c, gfc *** 1774,1780 **** if (i != 1) { ! gfc_error ("Argument of %s at %L must be of length one", gfc_current_intrinsic, &c->where); return FAILURE; } --- 1774,1780 ---- if (i != 1) { ! gfc_error ("Argument of %s at %L must be of length one", gfc_current_intrinsic, &c->where); return FAILURE; } *************** gfc_check_reshape (gfc_expr *source, gfc *** 3022,3028 **** if (order_size != shape_size) { gfc_error ("'%s' argument of '%s' intrinsic at %L " ! "has wrong number of elements (%d/%d)", gfc_current_intrinsic_arg[3]->name, gfc_current_intrinsic, &order->where, order_size, shape_size); --- 3022,3028 ---- if (order_size != shape_size) { gfc_error ("'%s' argument of '%s' intrinsic at %L " ! "has wrong number of elements (%d/%d)", gfc_current_intrinsic_arg[3]->name, gfc_current_intrinsic, &order->where, order_size, shape_size); *************** gfc_check_reshape (gfc_expr *source, gfc *** 3040,3046 **** if (dim < 1 || dim > order_size) { gfc_error ("'%s' argument of '%s' intrinsic at %L " ! "has out-of-range dimension (%d)", gfc_current_intrinsic_arg[3]->name, gfc_current_intrinsic, &e->where, dim); return FAILURE; --- 3040,3046 ---- if (dim < 1 || dim > order_size) { gfc_error ("'%s' argument of '%s' intrinsic at %L " ! "has out-of-range dimension (%d)", gfc_current_intrinsic_arg[3]->name, gfc_current_intrinsic, &e->where, dim); return FAILURE; *************** gfc_check_reshape (gfc_expr *source, gfc *** 3072,3078 **** gfc_constructor *c; bool test; ! mpz_init_set_ui (size, 1); for (c = gfc_constructor_first (shape->value.constructor); c; c = gfc_constructor_next (c)) --- 3072,3078 ---- gfc_constructor *c; bool test; ! mpz_init_set_ui (size, 1); for (c = gfc_constructor_first (shape->value.constructor); c; c = gfc_constructor_next (c)) *************** gfc_check_spread (gfc_expr *source, gfc_ *** 3434,3440 **** return FAILURE; /* dim_rank_check() does not apply here. */ ! if (dim && dim->expr_type == EXPR_CONSTANT && (mpz_cmp_ui (dim->value.integer, 1) < 0 || mpz_cmp_ui (dim->value.integer, source->rank + 1) > 0)) --- 3434,3440 ---- return FAILURE; /* dim_rank_check() does not apply here. */ ! if (dim && dim->expr_type == EXPR_CONSTANT && (mpz_cmp_ui (dim->value.integer, 1) < 0 || mpz_cmp_ui (dim->value.integer, source->rank + 1) > 0)) *************** gfc_check_unpack (gfc_expr *vector, gfc_ *** 3886,3892 **** if (mask->rank != field->rank && field->rank != 0) { gfc_error ("'%s' argument of '%s' intrinsic at %L must have " ! "the same rank as '%s' or be a scalar", gfc_current_intrinsic_arg[2]->name, gfc_current_intrinsic, &field->where, gfc_current_intrinsic_arg[1]->name); return FAILURE; --- 3886,3892 ---- if (mask->rank != field->rank && field->rank != 0) { gfc_error ("'%s' argument of '%s' intrinsic at %L must have " ! "the same rank as '%s' or be a scalar", gfc_current_intrinsic_arg[2]->name, gfc_current_intrinsic, &field->where, gfc_current_intrinsic_arg[1]->name); return FAILURE; *************** gfc_check_unpack (gfc_expr *vector, gfc_ *** 3899,3905 **** if (! identical_dimen_shape (mask, i, field, i)) { gfc_error ("'%s' and '%s' arguments of '%s' intrinsic at %L " ! "must have identical shape.", gfc_current_intrinsic_arg[2]->name, gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic, &field->where); --- 3899,3905 ---- if (! identical_dimen_shape (mask, i, field, i)) { gfc_error ("'%s' and '%s' arguments of '%s' intrinsic at %L " ! "must have identical shape.", gfc_current_intrinsic_arg[2]->name, gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic, &field->where); diff -Nrcpad gcc-4.6.3/gcc/fortran/decl.c gcc-4.6.4/gcc/fortran/decl.c *** gcc-4.6.3/gcc/fortran/decl.c Thu Jun 2 19:53:02 2011 --- gcc-4.6.4/gcc/fortran/decl.c Sun Feb 3 13:15:18 2013 *************** match_attr_spec (void) *** 3623,3630 **** } } ! /* Module variables implicitly have the SAVE attribute. */ ! if (gfc_current_state () == COMP_MODULE && !current_attr.save) current_attr.save = SAVE_IMPLICIT; colon_seen = 1; --- 3623,3631 ---- } } ! /* Since Fortran 2008 module variables implicitly have the SAVE attribute. */ ! if (gfc_current_state () == COMP_MODULE && !current_attr.save ! && (gfc_option.allow_std & GFC_STD_F2008) != 0) current_attr.save = SAVE_IMPLICIT; colon_seen = 1; *************** gfc_match_end (gfc_statement *st) *** 5731,5736 **** --- 5732,5739 ---- const char *target; int eos_ok; match m; + gfc_namespace *parent_ns, *ns, *prev_ns; + gfc_namespace **nsp; old_loc = gfc_current_locus; if (gfc_match ("end") != MATCH_YES) *************** syntax: *** 5955,5960 **** --- 5958,5992 ---- cleanup: gfc_current_locus = old_loc; + + /* If we are missing an END BLOCK, we created a half-ready namespace. + Remove it from the parent namespace's sibling list. */ + + if (state == COMP_BLOCK) + { + parent_ns = gfc_current_ns->parent; + + nsp = &(gfc_state_stack->previous->tail->ext.block.ns); + + prev_ns = NULL; + ns = *nsp; + while (ns) + { + if (ns == gfc_current_ns) + { + if (prev_ns == NULL) + *nsp = NULL; + else + prev_ns->sibling = ns->sibling; + } + prev_ns = ns; + ns = ns->sibling; + } + + gfc_free_namespace (gfc_current_ns); + gfc_current_ns = parent_ns; + } + return MATCH_ERROR; } diff -Nrcpad gcc-4.6.3/gcc/fortran/expr.c gcc-4.6.4/gcc/fortran/expr.c *** gcc-4.6.3/gcc/fortran/expr.c Thu Jan 19 22:21:43 2012 --- gcc-4.6.4/gcc/fortran/expr.c Wed Mar 13 06:36:02 2013 *************** gfc_default_initializer (gfc_typespec *t *** 3704,3710 **** types (otherwise we could use gfc_has_default_initializer()). */ for (comp = ts->u.derived->components; comp; comp = comp->next) if (comp->initializer || comp->attr.allocatable ! || (comp->ts.type == BT_CLASS && CLASS_DATA (comp)->attr.allocatable)) break; if (!comp) --- 3704,3711 ---- types (otherwise we could use gfc_has_default_initializer()). */ for (comp = ts->u.derived->components; comp; comp = comp->next) if (comp->initializer || comp->attr.allocatable ! || (comp->ts.type == BT_CLASS && CLASS_DATA (comp) ! && CLASS_DATA (comp)->attr.allocatable)) break; if (!comp) *************** gfc_is_simply_contiguous (gfc_expr *expr *** 4345,4373 **** want to add arguments but with a NULL-expression. */ gfc_expr* ! gfc_build_intrinsic_call (const char* name, locus where, unsigned numarg, ...) { gfc_expr* result; gfc_actual_arglist* atail; gfc_intrinsic_sym* isym; va_list ap; unsigned i; ! isym = gfc_find_function (name); gcc_assert (isym); result = gfc_get_expr (); result->expr_type = EXPR_FUNCTION; result->ts = isym->ts; result->where = where; ! result->value.function.name = name; result->value.function.isym = isym; ! result->symtree = gfc_find_symtree (gfc_current_ns->sym_root, name); gcc_assert (result->symtree && (result->symtree->n.sym->attr.flavor == FL_PROCEDURE || result->symtree->n.sym->attr.flavor == FL_UNKNOWN)); va_start (ap, numarg); atail = NULL; for (i = 0; i < numarg; ++i) --- 4346,4381 ---- want to add arguments but with a NULL-expression. */ gfc_expr* ! gfc_build_intrinsic_call (gfc_namespace *ns, gfc_isym_id id, const char* name, ! locus where, unsigned numarg, ...) { gfc_expr* result; gfc_actual_arglist* atail; gfc_intrinsic_sym* isym; va_list ap; unsigned i; + const char *mangled_name = gfc_get_string (GFC_PREFIX ("%s"), name); ! isym = gfc_intrinsic_function_by_id (id); gcc_assert (isym); result = gfc_get_expr (); result->expr_type = EXPR_FUNCTION; result->ts = isym->ts; result->where = where; ! result->value.function.name = mangled_name; result->value.function.isym = isym; ! gfc_get_sym_tree (mangled_name, ns, &result->symtree, false); ! gfc_commit_symbol (result->symtree->n.sym); gcc_assert (result->symtree && (result->symtree->n.sym->attr.flavor == FL_PROCEDURE || result->symtree->n.sym->attr.flavor == FL_UNKNOWN)); + result->symtree->n.sym->intmod_sym_id = id; + result->symtree->n.sym->attr.flavor = FL_PROCEDURE; + result->symtree->n.sym->attr.intrinsic = 1; + va_start (ap, numarg); atail = NULL; for (i = 0; i < numarg; ++i) *************** gfc_check_vardef_context (gfc_expr* e, b *** 4474,4480 **** if (ptr_component && ref->type == REF_COMPONENT) check_intentin = false; if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer) ! ptr_component = true; } if (check_intentin && sym->attr.intent == INTENT_IN) { --- 4482,4492 ---- if (ptr_component && ref->type == REF_COMPONENT) check_intentin = false; if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer) ! { ! ptr_component = true; ! if (!pointer) ! check_intentin = false; ! } } if (check_intentin && sym->attr.intent == INTENT_IN) { diff -Nrcpad gcc-4.6.3/gcc/fortran/gfortran.h gcc-4.6.4/gcc/fortran/gfortran.h *** gcc-4.6.3/gcc/fortran/gfortran.h Mon Aug 22 20:03:00 2011 --- gcc-4.6.4/gcc/fortran/gfortran.h Wed Feb 13 17:51:11 2013 *************** along with GCC; see the file COPYING3. *** 63,68 **** --- 63,77 ---- #define PREFIX(x) "_gfortran_" x #define PREFIX_LEN 10 + /* A prefix for internal variables, which are not user-visible. */ + #if !defined (NO_DOT_IN_LABEL) + # define GFC_PREFIX(x) "_F." x + #elif !defined (NO_DOLLAR_IN_LABEL) + # define GFC_PREFIX(x) "_F$" x + #else + # define GFC_PREFIX(x) "_F_" x + #endif + #define BLANK_COMMON_NAME "__BLNK__" /* Macro to initialize an mstring structure. */ *************** int gfc_get_corank (gfc_expr *); *** 2733,2739 **** bool gfc_has_ultimate_allocatable (gfc_expr *); bool gfc_has_ultimate_pointer (gfc_expr *); ! gfc_expr* gfc_build_intrinsic_call (const char*, locus, unsigned, ...); gfc_try gfc_check_vardef_context (gfc_expr*, bool, const char*); --- 2742,2749 ---- bool gfc_has_ultimate_allocatable (gfc_expr *); bool gfc_has_ultimate_pointer (gfc_expr *); ! gfc_expr* gfc_build_intrinsic_call (gfc_namespace *, gfc_isym_id, const char*, ! locus, unsigned, ...); gfc_try gfc_check_vardef_context (gfc_expr*, bool, const char*); diff -Nrcpad gcc-4.6.3/gcc/fortran/gfortran.info gcc-4.6.4/gcc/fortran/gfortran.info *** gcc-4.6.3/gcc/fortran/gfortran.info Thu Mar 1 12:38:52 2012 --- gcc-4.6.4/gcc/fortran/gfortran.info Fri Apr 12 10:36:23 2013 *************** *** 1,5 **** This is doc/gfortran.info, produced by makeinfo version 4.13 from ! /d//gcc-4.6.3/gcc-4.6.3/gcc/fortran/gfortran.texi. Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. --- 1,5 ---- This is doc/gfortran.info, produced by makeinfo version 4.13 from ! /home/jakub/gcc-4.6.4/gcc-4.6.4/gcc/fortran/gfortran.texi. Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. *************** Keyword Index *** 17490,17843 ****  Tag Table: ! Node: Top2125 ! Node: Introduction3503 ! Node: About GNU Fortran4250 ! Node: GNU Fortran and GCC8238 ! Node: Preprocessing and conditional compilation10352 ! Node: GNU Fortran and G7711996 ! Node: Project Status12569 ! Node: Standards15016 ! Node: Varying Length Character Strings15954 ! Node: Invoking GNU Fortran16490 ! Node: Option Summary18213 ! Node: Fortran Dialect Options21915 ! Node: Preprocessing Options28951 ! Node: Error and Warning Options37181 ! Node: Debugging Options45274 ! Node: Directory Options47890 ! Node: Link Options49325 ! Node: Runtime Options49949 ! Node: Code Gen Options52199 ! Node: Environment Variables67549 ! Node: Runtime68154 ! Node: GFORTRAN_STDIN_UNIT69382 ! Node: GFORTRAN_STDOUT_UNIT69749 ! Node: GFORTRAN_STDERR_UNIT70150 ! Node: GFORTRAN_USE_STDERR70548 ! Node: GFORTRAN_TMPDIR70994 ! Node: GFORTRAN_UNBUFFERED_ALL71445 ! Node: GFORTRAN_UNBUFFERED_PRECONNECTED71969 ! Node: GFORTRAN_SHOW_LOCUS72611 ! Node: GFORTRAN_OPTIONAL_PLUS73106 ! Node: GFORTRAN_DEFAULT_RECL73582 ! Node: GFORTRAN_LIST_SEPARATOR74073 ! Node: GFORTRAN_CONVERT_UNIT74682 ! Node: GFORTRAN_ERROR_DUMPCORE77544 ! Node: GFORTRAN_ERROR_BACKTRACE78093 ! Node: Fortran 2003 and 2008 status78645 ! Node: Fortran 2003 status78885 ! Node: Fortran 2008 status83532 ! Node: Compiler Characteristics88186 ! Node: KIND Type Parameters88702 ! Node: Internal representation of LOGICAL variables89952 ! Node: Thread-safety of the runtime library91309 ! Node: Extensions92696 ! Node: Extensions implemented in GNU Fortran93297 ! Node: Old-style kind specifications94655 ! Node: Old-style variable initialization95762 ! Node: Extensions to namelist97074 ! Node: X format descriptor without count field99071 ! Node: Commas in FORMAT specifications99598 ! Node: Missing period in FORMAT specifications100115 ! Node: I/O item lists100677 ! Node: `Q' exponent-letter101066 ! Node: BOZ literal constants101672 ! Node: Real array indices104247 ! Node: Unary operators104544 ! Node: Implicitly convert LOGICAL and INTEGER values104958 ! Node: Hollerith constants support105918 ! Node: Cray pointers107690 ! Node: CONVERT specifier113137 ! Node: OpenMP115135 ! Node: Argument list functions117386 ! Node: Extensions not implemented in GNU Fortran118992 ! Node: STRUCTURE and RECORD119914 ! Node: ENCODE and DECODE statements121971 ! Node: Variable FORMAT expressions123330 ! Node: Alternate complex function syntax124435 ! Node: Mixed-Language Programming124955 ! Node: Interoperability with C125499 ! Node: Intrinsic Types126837 ! Node: Derived Types and struct127352 ! Node: Interoperable Global Variables128708 ! Node: Interoperable Subroutines and Functions129984 ! Node: Working with Pointers133597 ! Node: Further Interoperability of Fortran with C137914 ! Node: GNU Fortran Compiler Directives138896 ! Node: Non-Fortran Main Program141097 ! Node: _gfortran_set_args143239 ! Node: _gfortran_set_options144174 ! Node: _gfortran_set_convert147080 ! Node: _gfortran_set_record_marker147944 ! Node: _gfortran_set_fpe148769 ! Node: _gfortran_set_max_subrecord_length149983 ! Node: Intrinsic Procedures150939 ! Node: Introduction to Intrinsics166170 ! Node: ABORT168522 ! Node: ABS169279 ! Node: ACCESS170896 ! Node: ACHAR172817 ! Node: ACOS174018 ! Node: ACOSH175255 ! Node: ADJUSTL176243 ! Node: ADJUSTR177184 ! Node: AIMAG178131 ! Node: AINT179512 ! Node: ALARM181099 ! Node: ALL182733 ! Node: ALLOCATED184651 ! Node: AND185788 ! Node: ANINT187085 ! Node: ANY188563 ! Node: ASIN190493 ! Node: ASINH191719 ! Node: ASSOCIATED192717 ! Node: ATAN195722 ! Node: ATAN2197141 ! Node: ATANH198776 ! Node: BESSEL_J0199772 ! Node: BESSEL_J1200816 ! Node: BESSEL_JN201868 ! Node: BESSEL_Y0203750 ! Node: BESSEL_Y1204750 ! Node: BESSEL_YN205750 ! Node: BGE207582 ! Node: BGT208271 ! Node: BIT_SIZE208918 ! Node: BLE209739 ! Node: BLT210418 ! Node: BTEST211053 ! Node: C_ASSOCIATED211936 ! Node: C_FUNLOC213145 ! Node: C_F_PROCPOINTER214514 ! Node: C_F_POINTER216015 ! Node: C_LOC217433 ! Node: C_SIZEOF218710 ! Node: CEILING220119 ! Node: CHAR221124 ! Node: CHDIR222328 ! Node: CHMOD223496 ! Node: CMPLX225291 ! Node: COMMAND_ARGUMENT_COUNT226755 ! Node: COMPILER_OPTIONS227669 ! Node: COMPILER_VERSION228682 ! Node: COMPLEX229650 ! Node: CONJG230804 ! Node: COS231884 ! Node: COSH233330 ! Node: COUNT234495 ! Node: CPU_TIME236511 ! Node: CSHIFT237865 ! Node: CTIME239521 ! Node: DATE_AND_TIME241174 ! Node: DBLE243635 ! Node: DCMPLX244428 ! Node: DIGITS245622 ! Node: DIM246588 ! Node: DOT_PRODUCT247846 ! Node: DPROD249502 ! Node: DREAL250419 ! Node: DSHIFTL251085 ! Node: DSHIFTR251878 ! Node: DTIME252672 ! Node: EOSHIFT255475 ! Node: EPSILON257548 ! Node: ERF258274 ! Node: ERFC259048 ! Node: ERFC_SCALED259852 ! Node: ETIME260544 ! Node: EXECUTE_COMMAND_LINE262785 ! Node: EXIT265365 ! Node: EXP266239 ! Node: EXPONENT267512 ! Node: EXTENDS_TYPE_OF268272 ! Node: FDATE269125 ! Node: FGET270607 ! Node: FGETC272425 ! Node: FLOOR274224 ! Node: FLUSH275208 ! Node: FNUM277083 ! Node: FPUT277805 ! Node: FPUTC279430 ! Node: FRACTION281201 ! Node: FREE282102 ! Node: FSEEK282937 ! Node: FSTAT285231 ! Node: FTELL286311 ! Node: GAMMA287289 ! Node: GERROR288330 ! Node: GETARG289049 ! Node: GET_COMMAND290813 ! Node: GET_COMMAND_ARGUMENT292177 ! Node: GETCWD294211 ! Node: GETENV295183 ! Node: GET_ENVIRONMENT_VARIABLE296606 ! Node: GETGID298759 ! Node: GETLOG299296 ! Node: GETPID300156 ! Node: GETUID300886 ! Node: GMTIME301402 ! Node: HOSTNM302891 ! Node: HUGE303809 ! Node: HYPOT304530 ! Node: IACHAR305350 ! Node: IALL306530 ! Node: IAND308007 ! Node: IANY308991 ! Node: IARGC310477 ! Node: IBCLR311498 ! Node: IBITS312159 ! Node: IBSET313074 ! Node: ICHAR313730 ! Node: IDATE315902 ! Node: IEOR316929 ! Node: IERRNO317805 ! Node: IMAGE_INDEX318354 ! Node: INDEX intrinsic319378 ! Node: INT320919 ! Node: INT2322621 ! Node: INT8323386 ! Node: IOR324098 ! Node: IPARITY324950 ! Node: IRAND326474 ! Node: IS_IOSTAT_END327830 ! Node: IS_IOSTAT_EOR328927 ! Node: ISATTY330054 ! Node: ISHFT330837 ! Node: ISHFTC331817 ! Node: ISNAN333033 ! Node: ITIME333781 ! Node: KILL334806 ! Node: KIND335710 ! Node: LBOUND336555 ! Node: LCOBOUND337888 ! Node: LEADZ339018 ! Node: LEN339878 ! Node: LEN_TRIM341159 ! Node: LGE342141 ! Node: LGT343643 ! Node: LINK345110 ! Node: LLE346145 ! Node: LLT347639 ! Node: LNBLNK349099 ! Node: LOC349875 ! Node: LOG350606 ! Node: LOG10352009 ! Node: LOG_GAMMA352983 ! Node: LOGICAL354072 ! Node: LONG354880 ! Node: LSHIFT355636 ! Node: LSTAT356721 ! Node: LTIME357915 ! Node: MALLOC359326 ! Node: MASKL360785 ! Node: MASKR361548 ! Node: MATMUL362314 ! Node: MAX363403 ! Node: MAXEXPONENT364902 ! Node: MAXLOC365718 ! Node: MAXVAL367737 ! Node: MCLOCK369370 ! Node: MCLOCK8370373 ! Node: MERGE371585 ! Node: MERGE_BITS372334 ! Node: MIN373195 ! Node: MINEXPONENT374696 ! Node: MINLOC375326 ! Node: MINVAL377345 ! Node: MOD378997 ! Node: MODULO380604 ! Node: MOVE_ALLOC381818 ! Node: MVBITS382847 ! Node: NEAREST383906 ! Node: NEW_LINE385029 ! Node: NINT385800 ! Node: NORM2387203 ! Node: NOT388341 ! Node: NULL388925 ! Node: NUM_IMAGES389830 ! Node: OR390646 ! Node: PACK391930 ! Node: PARITY393922 ! Node: PERROR395137 ! Node: PRECISION395758 ! Node: POPCNT396644 ! Node: POPPAR397515 ! Node: PRESENT398566 ! Node: PRODUCT399672 ! Node: RADIX401197 ! Node: RAN402019 ! Node: RAND402475 ! Node: RANDOM_NUMBER403807 ! Node: RANDOM_SEED405525 ! Node: RANGE407410 ! Node: REAL408098 ! Node: RENAME409872 ! Node: REPEAT410891 ! Node: RESHAPE411617 ! Node: RRSPACING413086 ! Node: RSHIFT413779 ! Node: SAME_TYPE_AS414917 ! Node: SCALE415747 ! Node: SCAN416527 ! Node: SECNDS418077 ! Node: SECOND419165 ! Node: SELECTED_CHAR_KIND420041 ! Node: SELECTED_INT_KIND421632 ! Node: SELECTED_REAL_KIND422807 ! Node: SET_EXPONENT425473 ! Node: SHAPE426469 ! Node: SHIFTA427884 ! Node: SHIFTL428845 ! Node: SHIFTR429680 ! Node: SIGN430516 ! Node: SIGNAL431800 ! Node: SIN433297 ! Node: SINH434395 ! Node: SIZE435391 ! Node: SIZEOF436699 ! Node: SLEEP438110 ! Node: SPACING438670 ! Node: SPREAD439683 ! Node: SQRT440828 ! Node: SRAND442182 ! Node: STAT443350 ! Node: STORAGE_SIZE446517 ! Node: SUM447397 ! Node: SYMLNK448880 ! Node: SYSTEM450012 ! Node: SYSTEM_CLOCK451263 ! Node: TAN453421 ! Node: TANH454393 ! Node: THIS_IMAGE455550 ! Node: TIME457042 ! Node: TIME8458146 ! Node: TINY459275 ! Node: TRAILZ459875 ! Node: TRANSFER460692 ! Node: TRANSPOSE462726 ! Node: TRIM463413 ! Node: TTYNAM464270 ! Node: UBOUND465185 ! Node: UCOBOUND466575 ! Node: UMASK467707 ! Node: UNLINK468385 ! Node: UNPACK469362 ! Node: VERIFY470650 ! Node: XOR472371 ! Node: Intrinsic Modules473743 ! Node: ISO_FORTRAN_ENV473986 ! Node: ISO_C_BINDING477826 ! Node: OpenMP Modules OMP_LIB and OMP_LIB_KINDS481688 ! Node: Contributing483014 ! Node: Contributors483866 ! Node: Projects485533 ! Node: Proposed Extensions486337 ! Node: Copying488348 ! Node: GNU Free Documentation License525912 ! Node: Funding551055 ! Node: Option Index553580 ! Node: Keyword Index566538  End Tag Table --- 17490,17843 ----  Tag Table: ! Node: Top2133 ! Node: Introduction3511 ! Node: About GNU Fortran4258 ! Node: GNU Fortran and GCC8246 ! Node: Preprocessing and conditional compilation10360 ! Node: GNU Fortran and G7712004 ! Node: Project Status12577 ! Node: Standards15024 ! Node: Varying Length Character Strings15962 ! Node: Invoking GNU Fortran16498 ! Node: Option Summary18221 ! Node: Fortran Dialect Options21923 ! Node: Preprocessing Options28959 ! Node: Error and Warning Options37189 ! Node: Debugging Options45282 ! Node: Directory Options47898 ! Node: Link Options49333 ! Node: Runtime Options49957 ! Node: Code Gen Options52207 ! Node: Environment Variables67557 ! Node: Runtime68162 ! Node: GFORTRAN_STDIN_UNIT69390 ! Node: GFORTRAN_STDOUT_UNIT69757 ! Node: GFORTRAN_STDERR_UNIT70158 ! Node: GFORTRAN_USE_STDERR70556 ! Node: GFORTRAN_TMPDIR71002 ! Node: GFORTRAN_UNBUFFERED_ALL71453 ! Node: GFORTRAN_UNBUFFERED_PRECONNECTED71977 ! Node: GFORTRAN_SHOW_LOCUS72619 ! Node: GFORTRAN_OPTIONAL_PLUS73114 ! Node: GFORTRAN_DEFAULT_RECL73590 ! Node: GFORTRAN_LIST_SEPARATOR74081 ! Node: GFORTRAN_CONVERT_UNIT74690 ! Node: GFORTRAN_ERROR_DUMPCORE77552 ! Node: GFORTRAN_ERROR_BACKTRACE78101 ! Node: Fortran 2003 and 2008 status78653 ! Node: Fortran 2003 status78893 ! Node: Fortran 2008 status83540 ! Node: Compiler Characteristics88194 ! Node: KIND Type Parameters88710 ! Node: Internal representation of LOGICAL variables89960 ! Node: Thread-safety of the runtime library91317 ! Node: Extensions92704 ! Node: Extensions implemented in GNU Fortran93305 ! Node: Old-style kind specifications94663 ! Node: Old-style variable initialization95770 ! Node: Extensions to namelist97082 ! Node: X format descriptor without count field99079 ! Node: Commas in FORMAT specifications99606 ! Node: Missing period in FORMAT specifications100123 ! Node: I/O item lists100685 ! Node: `Q' exponent-letter101074 ! Node: BOZ literal constants101680 ! Node: Real array indices104255 ! Node: Unary operators104552 ! Node: Implicitly convert LOGICAL and INTEGER values104966 ! Node: Hollerith constants support105926 ! Node: Cray pointers107698 ! Node: CONVERT specifier113145 ! Node: OpenMP115143 ! Node: Argument list functions117394 ! Node: Extensions not implemented in GNU Fortran119000 ! Node: STRUCTURE and RECORD119922 ! Node: ENCODE and DECODE statements121979 ! Node: Variable FORMAT expressions123338 ! Node: Alternate complex function syntax124443 ! Node: Mixed-Language Programming124963 ! Node: Interoperability with C125507 ! Node: Intrinsic Types126845 ! Node: Derived Types and struct127360 ! Node: Interoperable Global Variables128716 ! Node: Interoperable Subroutines and Functions129992 ! Node: Working with Pointers133605 ! Node: Further Interoperability of Fortran with C137922 ! Node: GNU Fortran Compiler Directives138904 ! Node: Non-Fortran Main Program141105 ! Node: _gfortran_set_args143247 ! Node: _gfortran_set_options144182 ! Node: _gfortran_set_convert147088 ! Node: _gfortran_set_record_marker147952 ! Node: _gfortran_set_fpe148777 ! Node: _gfortran_set_max_subrecord_length149991 ! Node: Intrinsic Procedures150947 ! Node: Introduction to Intrinsics166178 ! Node: ABORT168530 ! Node: ABS169287 ! Node: ACCESS170904 ! Node: ACHAR172825 ! Node: ACOS174026 ! Node: ACOSH175263 ! Node: ADJUSTL176251 ! Node: ADJUSTR177192 ! Node: AIMAG178139 ! Node: AINT179520 ! Node: ALARM181107 ! Node: ALL182741 ! Node: ALLOCATED184659 ! Node: AND185796 ! Node: ANINT187093 ! Node: ANY188571 ! Node: ASIN190501 ! Node: ASINH191727 ! Node: ASSOCIATED192725 ! Node: ATAN195730 ! Node: ATAN2197149 ! Node: ATANH198784 ! Node: BESSEL_J0199780 ! Node: BESSEL_J1200824 ! Node: BESSEL_JN201876 ! Node: BESSEL_Y0203758 ! Node: BESSEL_Y1204758 ! Node: BESSEL_YN205758 ! Node: BGE207590 ! Node: BGT208279 ! Node: BIT_SIZE208926 ! Node: BLE209747 ! Node: BLT210426 ! Node: BTEST211061 ! Node: C_ASSOCIATED211944 ! Node: C_FUNLOC213153 ! Node: C_F_PROCPOINTER214522 ! Node: C_F_POINTER216023 ! Node: C_LOC217441 ! Node: C_SIZEOF218718 ! Node: CEILING220127 ! Node: CHAR221132 ! Node: CHDIR222336 ! Node: CHMOD223504 ! Node: CMPLX225299 ! Node: COMMAND_ARGUMENT_COUNT226763 ! Node: COMPILER_OPTIONS227677 ! Node: COMPILER_VERSION228690 ! Node: COMPLEX229658 ! Node: CONJG230812 ! Node: COS231892 ! Node: COSH233338 ! Node: COUNT234503 ! Node: CPU_TIME236519 ! Node: CSHIFT237873 ! Node: CTIME239529 ! Node: DATE_AND_TIME241182 ! Node: DBLE243643 ! Node: DCMPLX244436 ! Node: DIGITS245630 ! Node: DIM246596 ! Node: DOT_PRODUCT247854 ! Node: DPROD249510 ! Node: DREAL250427 ! Node: DSHIFTL251093 ! Node: DSHIFTR251886 ! Node: DTIME252680 ! Node: EOSHIFT255483 ! Node: EPSILON257556 ! Node: ERF258282 ! Node: ERFC259056 ! Node: ERFC_SCALED259860 ! Node: ETIME260552 ! Node: EXECUTE_COMMAND_LINE262793 ! Node: EXIT265373 ! Node: EXP266247 ! Node: EXPONENT267520 ! Node: EXTENDS_TYPE_OF268280 ! Node: FDATE269133 ! Node: FGET270615 ! Node: FGETC272433 ! Node: FLOOR274232 ! Node: FLUSH275216 ! Node: FNUM277091 ! Node: FPUT277813 ! Node: FPUTC279438 ! Node: FRACTION281209 ! Node: FREE282110 ! Node: FSEEK282945 ! Node: FSTAT285239 ! Node: FTELL286319 ! Node: GAMMA287297 ! Node: GERROR288338 ! Node: GETARG289057 ! Node: GET_COMMAND290821 ! Node: GET_COMMAND_ARGUMENT292185 ! Node: GETCWD294219 ! Node: GETENV295191 ! Node: GET_ENVIRONMENT_VARIABLE296614 ! Node: GETGID298767 ! Node: GETLOG299304 ! Node: GETPID300164 ! Node: GETUID300894 ! Node: GMTIME301410 ! Node: HOSTNM302899 ! Node: HUGE303817 ! Node: HYPOT304538 ! Node: IACHAR305358 ! Node: IALL306538 ! Node: IAND308015 ! Node: IANY308999 ! Node: IARGC310485 ! Node: IBCLR311506 ! Node: IBITS312167 ! Node: IBSET313082 ! Node: ICHAR313738 ! Node: IDATE315910 ! Node: IEOR316937 ! Node: IERRNO317813 ! Node: IMAGE_INDEX318362 ! Node: INDEX intrinsic319386 ! Node: INT320927 ! Node: INT2322629 ! Node: INT8323394 ! Node: IOR324106 ! Node: IPARITY324958 ! Node: IRAND326482 ! Node: IS_IOSTAT_END327838 ! Node: IS_IOSTAT_EOR328935 ! Node: ISATTY330062 ! Node: ISHFT330845 ! Node: ISHFTC331825 ! Node: ISNAN333041 ! Node: ITIME333789 ! Node: KILL334814 ! Node: KIND335718 ! Node: LBOUND336563 ! Node: LCOBOUND337896 ! Node: LEADZ339026 ! Node: LEN339886 ! Node: LEN_TRIM341167 ! Node: LGE342149 ! Node: LGT343651 ! Node: LINK345118 ! Node: LLE346153 ! Node: LLT347647 ! Node: LNBLNK349107 ! Node: LOC349883 ! Node: LOG350614 ! Node: LOG10352017 ! Node: LOG_GAMMA352991 ! Node: LOGICAL354080 ! Node: LONG354888 ! Node: LSHIFT355644 ! Node: LSTAT356729 ! Node: LTIME357923 ! Node: MALLOC359334 ! Node: MASKL360793 ! Node: MASKR361556 ! Node: MATMUL362322 ! Node: MAX363411 ! Node: MAXEXPONENT364910 ! Node: MAXLOC365726 ! Node: MAXVAL367745 ! Node: MCLOCK369378 ! Node: MCLOCK8370381 ! Node: MERGE371593 ! Node: MERGE_BITS372342 ! Node: MIN373203 ! Node: MINEXPONENT374704 ! Node: MINLOC375334 ! Node: MINVAL377353 ! Node: MOD379005 ! Node: MODULO380612 ! Node: MOVE_ALLOC381826 ! Node: MVBITS382855 ! Node: NEAREST383914 ! Node: NEW_LINE385037 ! Node: NINT385808 ! Node: NORM2387211 ! Node: NOT388349 ! Node: NULL388933 ! Node: NUM_IMAGES389838 ! Node: OR390654 ! Node: PACK391938 ! Node: PARITY393930 ! Node: PERROR395145 ! Node: PRECISION395766 ! Node: POPCNT396652 ! Node: POPPAR397523 ! Node: PRESENT398574 ! Node: PRODUCT399680 ! Node: RADIX401205 ! Node: RAN402027 ! Node: RAND402483 ! Node: RANDOM_NUMBER403815 ! Node: RANDOM_SEED405533 ! Node: RANGE407418 ! Node: REAL408106 ! Node: RENAME409880 ! Node: REPEAT410899 ! Node: RESHAPE411625 ! Node: RRSPACING413094 ! Node: RSHIFT413787 ! Node: SAME_TYPE_AS414925 ! Node: SCALE415755 ! Node: SCAN416535 ! Node: SECNDS418085 ! Node: SECOND419173 ! Node: SELECTED_CHAR_KIND420049 ! Node: SELECTED_INT_KIND421640 ! Node: SELECTED_REAL_KIND422815 ! Node: SET_EXPONENT425481 ! Node: SHAPE426477 ! Node: SHIFTA427892 ! Node: SHIFTL428853 ! Node: SHIFTR429688 ! Node: SIGN430524 ! Node: SIGNAL431808 ! Node: SIN433305 ! Node: SINH434403 ! Node: SIZE435399 ! Node: SIZEOF436707 ! Node: SLEEP438118 ! Node: SPACING438678 ! Node: SPREAD439691 ! Node: SQRT440836 ! Node: SRAND442190 ! Node: STAT443358 ! Node: STORAGE_SIZE446525 ! Node: SUM447405 ! Node: SYMLNK448888 ! Node: SYSTEM450020 ! Node: SYSTEM_CLOCK451271 ! Node: TAN453429 ! Node: TANH454401 ! Node: THIS_IMAGE455558 ! Node: TIME457050 ! Node: TIME8458154 ! Node: TINY459283 ! Node: TRAILZ459883 ! Node: TRANSFER460700 ! Node: TRANSPOSE462734 ! Node: TRIM463421 ! Node: TTYNAM464278 ! Node: UBOUND465193 ! Node: UCOBOUND466583 ! Node: UMASK467715 ! Node: UNLINK468393 ! Node: UNPACK469370 ! Node: VERIFY470658 ! Node: XOR472379 ! Node: Intrinsic Modules473751 ! Node: ISO_FORTRAN_ENV473994 ! Node: ISO_C_BINDING477834 ! Node: OpenMP Modules OMP_LIB and OMP_LIB_KINDS481696 ! Node: Contributing483022 ! Node: Contributors483874 ! Node: Projects485541 ! Node: Proposed Extensions486345 ! Node: Copying488356 ! Node: GNU Free Documentation License525920 ! Node: Funding551063 ! Node: Option Index553588 ! Node: Keyword Index566546  End Tag Table diff -Nrcpad gcc-4.6.3/gcc/fortran/module.c gcc-4.6.4/gcc/fortran/module.c *** gcc-4.6.3/gcc/fortran/module.c Fri Oct 7 21:01:02 2011 --- gcc-4.6.4/gcc/fortran/module.c Tue Jan 8 20:01:49 2013 *************** read_module (void) *** 4427,4434 **** if (p == NULL) { st = gfc_find_symtree (gfc_current_ns->sym_root, name); ! if (st != NULL) ! info->u.rsym.symtree = st; continue; } --- 4427,4440 ---- if (p == NULL) { st = gfc_find_symtree (gfc_current_ns->sym_root, name); ! if (st != NULL ! && strcmp (st->n.sym->name, info->u.rsym.true_name) == 0 ! && st->n.sym->module != NULL ! && strcmp (st->n.sym->module, info->u.rsym.module) == 0) ! { ! info->u.rsym.symtree = st; ! info->u.rsym.sym = st->n.sym; ! } continue; } *************** read_module (void) *** 4449,4455 **** /* Check for ambiguous symbols. */ if (check_for_ambiguous (st->n.sym, info)) st->ambiguous = 1; ! info->u.rsym.symtree = st; } else { --- 4455,4462 ---- /* Check for ambiguous symbols. */ if (check_for_ambiguous (st->n.sym, info)) st->ambiguous = 1; ! else ! info->u.rsym.symtree = st; } else { diff -Nrcpad gcc-4.6.3/gcc/fortran/parse.c gcc-4.6.4/gcc/fortran/parse.c *** gcc-4.6.3/gcc/fortran/parse.c Sat Aug 20 14:22:22 2011 --- gcc-4.6.4/gcc/fortran/parse.c Sun Feb 3 13:15:18 2013 *************** parse_module (void) *** 4099,4104 **** --- 4099,4105 ---- { gfc_statement st; gfc_gsymbol *s; + bool error; s = gfc_get_gsymbol (gfc_new_block->name); if (s->defined || (s->type != GSYM_UNKNOWN && s->type != GSYM_MODULE)) *************** parse_module (void) *** 4112,4117 **** --- 4113,4119 ---- st = parse_spec (ST_NONE); + error = false; loop: switch (st) { *************** loop: *** 4130,4141 **** gfc_error ("Unexpected %s statement in MODULE at %C", gfc_ascii_statement (st)); reject_statement (); st = next_statement (); goto loop; } ! s->ns = gfc_current_ns; } --- 4132,4146 ---- gfc_error ("Unexpected %s statement in MODULE at %C", gfc_ascii_statement (st)); + error = true; reject_statement (); st = next_statement (); goto loop; } ! /* Make sure not to free the namespace twice on error. */ ! if (!error) ! s->ns = gfc_current_ns; } diff -Nrcpad gcc-4.6.3/gcc/fortran/resolve.c gcc-4.6.4/gcc/fortran/resolve.c *** gcc-4.6.3/gcc/fortran/resolve.c Wed Jan 25 08:11:56 2012 --- gcc-4.6.4/gcc/fortran/resolve.c Wed Mar 13 06:36:02 2013 *************** resolve_intrinsic (gfc_symbol *sym, locu *** 1452,1458 **** if (sym->intmod_sym_id) isym = gfc_intrinsic_function_by_id ((gfc_isym_id) sym->intmod_sym_id); ! else isym = gfc_find_function (sym->name); if (isym) --- 1452,1458 ---- if (sym->intmod_sym_id) isym = gfc_intrinsic_function_by_id ((gfc_isym_id) sym->intmod_sym_id); ! else if (!sym->attr.subroutine) isym = gfc_find_function (sym->name); if (isym) *************** resolve_call (gfc_code *c) *** 3564,3570 **** if (csym && gfc_current_ns->parent && csym->ns != gfc_current_ns) { gfc_symtree *st; ! gfc_find_sym_tree (csym->name, gfc_current_ns, 1, &st); sym = st ? st->n.sym : NULL; if (sym && csym != sym && sym->ns == gfc_current_ns --- 3564,3570 ---- if (csym && gfc_current_ns->parent && csym->ns != gfc_current_ns) { gfc_symtree *st; ! gfc_find_sym_tree (c->symtree->name, gfc_current_ns, 1, &st); sym = st ? st->n.sym : NULL; if (sym && csym != sym && sym->ns == gfc_current_ns *************** resolve_allocate_deallocate (gfc_code *c *** 7087,7097 **** if (pr->next && qr->next) { gfc_array_ref *par = &(pr->u.ar); gfc_array_ref *qar = &(qr->u.ar); ! if (gfc_dep_compare_expr (par->start[0], ! qar->start[0]) != 0) ! break; } } else --- 7087,7104 ---- if (pr->next && qr->next) { + int i; gfc_array_ref *par = &(pr->u.ar); gfc_array_ref *qar = &(qr->u.ar); ! ! for (i=0; idimen; i++) ! { ! if ((par->start[i] != NULL ! || qar->start[i] != NULL) ! && gfc_dep_compare_expr (par->start[i], ! qar->start[i]) != 0) ! goto break_label; ! } } } else *************** resolve_allocate_deallocate (gfc_code *c *** 7103,7108 **** --- 7110,7117 ---- pr = pr->next; qr = qr->next; } + break_label: + ; } } } *************** build_default_init_expr (gfc_symbol *sym *** 9700,9706 **** || sym->attr.data || sym->module || sym->attr.cray_pointee ! || sym->attr.cray_pointer) return NULL; /* Now we'll try to build an initializer expression. */ --- 9709,9716 ---- || sym->attr.data || sym->module || sym->attr.cray_pointee ! || sym->attr.cray_pointer ! || sym->assoc) return NULL; /* Now we'll try to build an initializer expression. */ *************** resolve_fl_derived0 (gfc_symbol *sym) *** 11749,11754 **** --- 11759,11766 ---- { gfc_error ("Component '%s' with CLASS at %L must be allocatable " "or pointer", c->name, &c->loc); + /* Prevent a recurrence of the error. */ + c->ts.type = BT_UNKNOWN; return FAILURE; } *************** gfc_impure_variable (gfc_symbol *sym) *** 12908,12917 **** } proc = sym->ns->proc_name; ! if (sym->attr.dummy && gfc_pure (proc) ! && ((proc->attr.subroutine && sym->attr.intent == INTENT_IN) ! || ! proc->attr.function)) return 1; /* TODO: Sort out what can be storage associated, if anything, and include --- 12920,12928 ---- } proc = sym->ns->proc_name; ! if (sym->attr.dummy ! && ((proc->attr.subroutine && sym->attr.intent == INTENT_IN) ! || proc->attr.function)) return 1; /* TODO: Sort out what can be storage associated, if anything, and include diff -Nrcpad gcc-4.6.3/gcc/fortran/simplify.c gcc-4.6.4/gcc/fortran/simplify.c *** gcc-4.6.3/gcc/fortran/simplify.c Fri Feb 3 20:37:36 2012 --- gcc-4.6.4/gcc/fortran/simplify.c Fri Feb 15 14:20:49 2013 *************** simplify_bound_dim (gfc_expr *array, gfc *** 3296,3301 **** --- 3296,3304 ---- gcc_assert (array->expr_type == EXPR_VARIABLE); gcc_assert (as); + if (gfc_resolve_array_spec (as, 0) == FAILURE) + return NULL; + /* The last dimension of an assumed-size array is special. */ if ((!coarray && d == as->rank && as->type == AS_ASSUMED_SIZE && !upper) || (coarray && d == as->rank + as->corank)) *************** gfc_simplify_matmul (gfc_expr *matrix_a, *** 3881,3887 **** if (matrix_a->rank == 1 && matrix_b->rank == 2) { result_rows = 1; ! result_columns = mpz_get_si (matrix_b->shape[0]); stride_a = 1; stride_b = mpz_get_si (matrix_b->shape[0]); --- 3884,3890 ---- if (matrix_a->rank == 1 && matrix_b->rank == 2) { result_rows = 1; ! result_columns = mpz_get_si (matrix_b->shape[1]); stride_a = 1; stride_b = mpz_get_si (matrix_b->shape[0]); *************** gfc_simplify_matmul (gfc_expr *matrix_a, *** 3891,3897 **** } else if (matrix_a->rank == 2 && matrix_b->rank == 1) { ! result_rows = mpz_get_si (matrix_b->shape[0]); result_columns = 1; stride_a = mpz_get_si (matrix_a->shape[0]); stride_b = 1; --- 3894,3900 ---- } else if (matrix_a->rank == 2 && matrix_b->rank == 1) { ! result_rows = mpz_get_si (matrix_a->shape[0]); result_columns = 1; stride_a = mpz_get_si (matrix_a->shape[0]); stride_b = 1; *************** gfc_simplify_matmul (gfc_expr *matrix_a, *** 3904,3910 **** { result_rows = mpz_get_si (matrix_a->shape[0]); result_columns = mpz_get_si (matrix_b->shape[1]); ! stride_a = mpz_get_si (matrix_a->shape[1]); stride_b = mpz_get_si (matrix_b->shape[0]); result->rank = 2; --- 3907,3913 ---- { result_rows = mpz_get_si (matrix_a->shape[0]); result_columns = mpz_get_si (matrix_b->shape[1]); ! stride_a = mpz_get_si (matrix_a->shape[0]); stride_b = mpz_get_si (matrix_b->shape[0]); result->rank = 2; *************** gfc_simplify_size (gfc_expr *array, gfc_ *** 5612,5618 **** /* Otherwise, we build a new SIZE call. This is hopefully at least simpler than the original one. */ if (!simplified) ! simplified = gfc_build_intrinsic_call ("size", array->where, 3, gfc_copy_expr (replacement), gfc_copy_expr (dim), gfc_copy_expr (kind)); --- 5615,5623 ---- /* Otherwise, we build a new SIZE call. This is hopefully at least simpler than the original one. */ if (!simplified) ! simplified = gfc_build_intrinsic_call (gfc_current_ns, ! GFC_ISYM_SIZE, "size", ! array->where, 3, gfc_copy_expr (replacement), gfc_copy_expr (dim), gfc_copy_expr (kind)); diff -Nrcpad gcc-4.6.3/gcc/fortran/trans-array.c gcc-4.6.4/gcc/fortran/trans-array.c *** gcc-4.6.3/gcc/fortran/trans-array.c Thu Dec 8 20:54:57 2011 --- gcc-4.6.4/gcc/fortran/trans-array.c Sat Feb 23 14:40:49 2013 *************** gfc_add_loop_ss_code (gfc_loopinfo * loo *** 2056,2061 **** --- 2056,2066 ---- gfc_se se; int n; + /* Don't evaluate the arguments for realloc_lhs_loop_for_fcn_call; otherwise, + arguments could get evaluated multiple times. */ + if (ss->is_alloc_lhs) + return; + /* TODO: This can generate bad code if there are ordering dependencies, e.g., a callee allocated function and an unknown size constructor. */ gcc_assert (ss != NULL); *************** gfc_conv_array_parameter (gfc_se * se, g *** 6009,6028 **** this_array_result = false; /* Passing address of the array if it is not pointer or assumed-shape. */ ! if (full_array_var && g77 && !this_array_result) { tmp = gfc_get_symbol_decl (sym); if (sym->ts.type == BT_CHARACTER) se->string_length = sym->ts.u.cl->backend_decl; - if (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS) - { - gfc_conv_expr_descriptor (se, expr, ss); - se->expr = gfc_conv_array_data (se->expr); - return; - } - if (!sym->attr.pointer && sym->as && sym->as->type != AS_ASSUMED_SHAPE --- 6014,6027 ---- this_array_result = false; /* Passing address of the array if it is not pointer or assumed-shape. */ ! if (full_array_var && g77 && !this_array_result ! && sym->ts.type != BT_DERIVED && sym->ts.type != BT_CLASS) { tmp = gfc_get_symbol_decl (sym); if (sym->ts.type == BT_CHARACTER) se->string_length = sym->ts.u.cl->backend_decl; if (!sym->attr.pointer && sym->as && sym->as->type != AS_ASSUMED_SHAPE *************** structure_alloc_comps (gfc_symbol * der_ *** 6561,6567 **** gfc_add_expr_to_block (&fnblock, tmp); } ! if (c->attr.allocatable && c->attr.dimension) { comp = fold_build3_loc (input_location, COMPONENT_REF, ctype, decl, cdecl, NULL_TREE); --- 6560,6566 ---- gfc_add_expr_to_block (&fnblock, tmp); } ! if (c->attr.allocatable && c->attr.dimension && !c->attr.proc_pointer) { comp = fold_build3_loc (input_location, COMPONENT_REF, ctype, decl, cdecl, NULL_TREE); *************** structure_alloc_comps (gfc_symbol * der_ *** 6660,6666 **** cdecl, NULL_TREE); dcmp = fold_convert (TREE_TYPE (comp), dcmp); ! if (c->attr.allocatable && !cmp_has_alloc_comps) { rank = c->as ? c->as->rank : 0; tmp = gfc_duplicate_allocatable (dcmp, comp, ctype, rank); --- 6659,6666 ---- cdecl, NULL_TREE); dcmp = fold_convert (TREE_TYPE (comp), dcmp); ! if (c->attr.allocatable && !c->attr.proc_pointer ! && !cmp_has_alloc_comps) { rank = c->as ? c->as->rank : 0; tmp = gfc_duplicate_allocatable (dcmp, comp, ctype, rank); *************** gfc_walk_elemental_function_args (gfc_ss *** 7548,7554 **** scalar = 1; for (; arg; arg = arg->next) { ! if (!arg->expr) continue; newss = gfc_walk_subexpr (head, arg->expr); --- 7548,7554 ---- scalar = 1; for (; arg; arg = arg->next) { ! if (!arg->expr || arg->expr->expr_type == EXPR_NULL) continue; newss = gfc_walk_subexpr (head, arg->expr); diff -Nrcpad gcc-4.6.3/gcc/fortran/trans-expr.c gcc-4.6.4/gcc/fortran/trans-expr.c *** gcc-4.6.3/gcc/fortran/trans-expr.c Wed Feb 29 21:24:05 2012 --- gcc-4.6.4/gcc/fortran/trans-expr.c Mon Jan 14 17:59:07 2013 *************** gfc_conv_missing_dummy (gfc_se * se, gfc *** 177,183 **** tmp = gfc_get_int_type (kind); tmp = fold_convert (tmp, build_fold_indirect_ref_loc (input_location, se->expr)); ! /* Test for a NULL value. */ tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp), present, tmp, fold_convert (TREE_TYPE (tmp), integer_one_node)); --- 177,183 ---- tmp = gfc_get_int_type (kind); tmp = fold_convert (tmp, build_fold_indirect_ref_loc (input_location, se->expr)); ! /* Test for a NULL value. */ tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp), present, tmp, fold_convert (TREE_TYPE (tmp), integer_one_node)); *************** gfc_get_expr_charlen (gfc_expr *e) *** 214,222 **** gfc_ref *r; tree length; ! gcc_assert (e->expr_type == EXPR_VARIABLE && e->ts.type == BT_CHARACTER); ! length = NULL; /* To silence compiler warning. */ if (is_subref_array (e) && e->ts.u.cl->length) --- 214,222 ---- gfc_ref *r; tree length; ! gcc_assert (e->expr_type == EXPR_VARIABLE && e->ts.type == BT_CHARACTER); ! length = NULL; /* To silence compiler warning. */ if (is_subref_array (e) && e->ts.u.cl->length) *************** flatten_array_ctors_without_strlen (gfc_ *** 278,285 **** { case EXPR_OP: ! flatten_array_ctors_without_strlen (e->value.op.op1); ! flatten_array_ctors_without_strlen (e->value.op.op2); break; case EXPR_COMPCALL: --- 278,285 ---- { case EXPR_OP: ! flatten_array_ctors_without_strlen (e->value.op.op1); ! flatten_array_ctors_without_strlen (e->value.op.op2); break; case EXPR_COMPCALL: *************** gfc_conv_variable (gfc_se * se, gfc_expr *** 639,645 **** se_expr = gfc_get_fake_result_decl (sym, parent_flag); /* Similarly for alternate entry points. */ ! else if (alternate_entry && (sym->ns->proc_name->backend_decl == current_function_decl || parent_flag)) { --- 639,645 ---- se_expr = gfc_get_fake_result_decl (sym, parent_flag); /* Similarly for alternate entry points. */ ! else if (alternate_entry && (sym->ns->proc_name->backend_decl == current_function_decl || parent_flag)) { *************** gfc_conv_variable (gfc_se * se, gfc_expr *** 675,681 **** /* Dereference the expression, where needed. Since characters ! are entirely different from other types, they are treated separately. */ if (sym->ts.type == BT_CHARACTER) { --- 675,681 ---- /* Dereference the expression, where needed. Since characters ! are entirely different from other types, they are treated separately. */ if (sym->ts.type == BT_CHARACTER) { *************** gfc_conv_variable (gfc_se * se, gfc_expr *** 704,710 **** se->expr = build_fold_indirect_ref_loc (input_location, se->expr); ! /* Dereference non-character pointer variables. These must be dummies, results, or scalars. */ if ((sym->attr.pointer || sym->attr.allocatable || gfc_is_associate_pointer (sym)) --- 704,710 ---- se->expr = build_fold_indirect_ref_loc (input_location, se->expr); ! /* Dereference non-character pointer variables. These must be dummies, results, or scalars. */ if ((sym->attr.pointer || sym->attr.allocatable || gfc_is_associate_pointer (sym)) *************** gfc_conv_variable (gfc_se * se, gfc_expr *** 774,780 **** { if (expr->ts.type == BT_CHARACTER && !gfc_is_proc_ptr_comp (expr, NULL)) gfc_conv_string_parameter (se); ! else se->expr = gfc_build_addr_expr (NULL_TREE, se->expr); } } --- 774,780 ---- { if (expr->ts.type == BT_CHARACTER && !gfc_is_proc_ptr_comp (expr, NULL)) gfc_conv_string_parameter (se); ! else se->expr = gfc_build_addr_expr (NULL_TREE, se->expr); } } *************** static const unsigned char powi_table[PO *** 856,866 **** 124, 166, 125, 214, 126, 138, 127, 153, /* 248 - 255 */ }; ! /* If n is larger than lookup table's max index, we use the "window method". */ #define POWI_WINDOW_SIZE 3 ! /* Recursive function to expand the power operator. The temporary values are put in tmpvar. The function returns tmpvar[1] ** n. */ static tree gfc_conv_powi (gfc_se * se, unsigned HOST_WIDE_INT n, tree * tmpvar) --- 856,866 ---- 124, 166, 125, 214, 126, 138, 127, 153, /* 248 - 255 */ }; ! /* If n is larger than lookup table's max index, we use the "window method". */ #define POWI_WINDOW_SIZE 3 ! /* Recursive function to expand the power operator. The temporary values are put in tmpvar. The function returns tmpvar[1] ** n. */ static tree gfc_conv_powi (gfc_se * se, unsigned HOST_WIDE_INT n, tree * tmpvar) *************** gfc_conv_cst_int_power (gfc_se * se, tre *** 923,929 **** /* There's no ABS for HOST_WIDE_INT, so here we go. It also takes care of the asymmetric range of the integer type. */ n = (unsigned HOST_WIDE_INT) (m < 0 ? -m : m); ! type = TREE_TYPE (lhs); sgn = tree_int_cst_sgn (rhs); --- 923,929 ---- /* There's no ABS for HOST_WIDE_INT, so here we go. It also takes care of the asymmetric range of the integer type. */ n = (unsigned HOST_WIDE_INT) (m < 0 ? -m : m); ! type = TREE_TYPE (lhs); sgn = tree_int_cst_sgn (rhs); *************** gfc_conv_power_op (gfc_se * se, gfc_expr *** 1034,1040 **** case 4: ikind = 0; break; ! case 8: ikind = 1; break; --- 1034,1040 ---- case 4: ikind = 0; break; ! case 8: ikind = 1; break; *************** gfc_conv_power_op (gfc_se * se, gfc_expr *** 1062,1068 **** case 4: kind = 0; break; ! case 8: kind = 1; break; --- 1062,1068 ---- case 4: kind = 0; break; ! case 8: kind = 1; break; *************** gfc_conv_power_op (gfc_se * se, gfc_expr *** 1078,1084 **** default: gcc_unreachable (); } ! switch (expr->value.op.op1->ts.type) { case BT_INTEGER: --- 1078,1084 ---- default: gcc_unreachable (); } ! switch (expr->value.op.op1->ts.type) { case BT_INTEGER: *************** gfc_conv_power_op (gfc_se * se, gfc_expr *** 1096,1102 **** case 0: fndecl = built_in_decls[BUILT_IN_POWIF]; break; ! case 1: fndecl = built_in_decls[BUILT_IN_POWI]; break; --- 1096,1102 ---- case 0: fndecl = built_in_decls[BUILT_IN_POWIF]; break; ! case 1: fndecl = built_in_decls[BUILT_IN_POWI]; break; *************** gfc_conv_power_op (gfc_se * se, gfc_expr *** 1106,1112 **** break; case 3: ! /* Use the __builtin_powil() only if real(kind=16) is actually the C long double type. */ if (!gfc_real16_is_float128) fndecl = built_in_decls[BUILT_IN_POWIL]; --- 1106,1112 ---- break; case 3: ! /* Use the __builtin_powil() only if real(kind=16) is actually the C long double type. */ if (!gfc_real16_is_float128) fndecl = built_in_decls[BUILT_IN_POWIL]; *************** gfc_conv_power_op (gfc_se * se, gfc_expr *** 1117,1123 **** } } ! /* If we don't have a good builtin for this, go for the library function. */ if (!fndecl) fndecl = gfor_fndecl_math_powi[kind][ikind].real; --- 1117,1123 ---- } } ! /* If we don't have a good builtin for this, go for the library function. */ if (!fndecl) fndecl = gfor_fndecl_math_powi[kind][ikind].real; *************** gfc_conv_scalar_char_value (gfc_symbol * *** 1524,1530 **** (int)(*expr)->value.character.string[0]); if ((*expr)->ts.kind != gfc_c_int_kind) { ! /* The expr needs to be compatible with a C int. If the conversion fails, then the 2 causes an ICE. */ ts.type = BT_INTEGER; ts.kind = gfc_c_int_kind; --- 1524,1530 ---- (int)(*expr)->value.character.string[0]); if ((*expr)->ts.kind != gfc_c_int_kind) { ! /* The expr needs to be compatible with a C int. If the conversion fails, then the 2 causes an ICE. */ ts.type = BT_INTEGER; ts.kind = gfc_c_int_kind; *************** gfc_add_interface_mapping (gfc_interface *** 1937,1944 **** else if (!sym->attr.dimension || sym->attr.pointer || sym->attr.allocatable) value = build_fold_indirect_ref_loc (input_location, se->expr); ! ! /* For character(*), use the actual argument's descriptor. */ else if (sym->ts.type == BT_CHARACTER && !new_sym->ts.u.cl->length) value = build_fold_indirect_ref_loc (input_location, se->expr); --- 1937,1944 ---- else if (!sym->attr.dimension || sym->attr.pointer || sym->attr.allocatable) value = build_fold_indirect_ref_loc (input_location, se->expr); ! ! /* For character(*), use the actual argument's descriptor. */ else if (sym->ts.type == BT_CHARACTER && !new_sym->ts.u.cl->length) value = build_fold_indirect_ref_loc (input_location, se->expr); *************** gfc_conv_subref_array_arg (gfc_se * parm *** 2348,2354 **** rss = gfc_walk_expr (expr); gcc_assert (rss != gfc_ss_terminator); ! /* Initialize the scalarizer. */ gfc_init_loopinfo (&loop); gfc_add_ss_to_loop (&loop, rss); --- 2348,2354 ---- rss = gfc_walk_expr (expr); gcc_assert (rss != gfc_ss_terminator); ! /* Initialize the scalarizer. */ gfc_init_loopinfo (&loop); gfc_add_ss_to_loop (&loop, rss); *************** gfc_conv_subref_array_arg (gfc_se * parm *** 2511,2517 **** tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, false, false, true); gfc_add_expr_to_block (&body, tmp); ! /* Generate the copying loops. */ gfc_trans_scalarizing_loops (&loop2, &body); --- 2511,2517 ---- tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, false, false, true); gfc_add_expr_to_block (&body, tmp); ! /* Generate the copying loops. */ gfc_trans_scalarizing_loops (&loop2, &body); *************** gfc_conv_subref_array_arg (gfc_se * parm *** 2538,2544 **** if (formal_ptr) { size = gfc_index_one_node; ! offset = gfc_index_zero_node; for (n = 0; n < dimen; n++) { tmp = gfc_conv_descriptor_ubound_get (parmse->expr, --- 2538,2544 ---- if (formal_ptr) { size = gfc_index_one_node; ! offset = gfc_index_zero_node; for (n = 0; n < dimen; n++) { tmp = gfc_conv_descriptor_ubound_get (parmse->expr, *************** conv_arglist_function (gfc_se *se, gfc_e *** 2608,2614 **** /* Takes a derived type expression and returns the address of a temporary ! class object of the 'declared' type. */ static void gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts) --- 2608,2614 ---- /* Takes a derived type expression and returns the address of a temporary ! class object of the 'declared' type. */ static void gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts) *************** conv_isocbinding_procedure (gfc_se * se, *** 2681,2687 **** { gfc_symbol *fsym; gfc_ss *argss; ! if (sym->intmod_sym_id == ISOCBINDING_LOC) { if (arg->expr->rank == 0) --- 2681,2687 ---- { gfc_symbol *fsym; gfc_ss *argss; ! if (sym->intmod_sym_id == ISOCBINDING_LOC) { if (arg->expr->rank == 0) *************** conv_isocbinding_procedure (gfc_se * se, *** 2698,2704 **** && !(fsym->attr.pointer || fsym->attr.allocatable) && fsym->as->type != AS_ASSUMED_SHAPE; f = f || !sym->attr.always_explicit; ! argss = gfc_walk_expr (arg->expr); gfc_conv_array_parameter (se, arg->expr, argss, f, NULL, NULL, NULL); --- 2698,2704 ---- && !(fsym->attr.pointer || fsym->attr.allocatable) && fsym->as->type != AS_ASSUMED_SHAPE; f = f || !sym->attr.always_explicit; ! argss = gfc_walk_expr (arg->expr); gfc_conv_array_parameter (se, arg->expr, argss, f, NULL, NULL, NULL); *************** conv_isocbinding_procedure (gfc_se * se, *** 2719,2725 **** arg->expr->ts.f90_type = sym->ts.u.derived->ts.f90_type; arg->expr->ts.kind = sym->ts.u.derived->ts.kind; gfc_conv_expr_reference (se, arg->expr); ! return 1; } else if ((sym->intmod_sym_id == ISOCBINDING_F_POINTER --- 2719,2725 ---- arg->expr->ts.f90_type = sym->ts.u.derived->ts.f90_type; arg->expr->ts.kind = sym->ts.u.derived->ts.kind; gfc_conv_expr_reference (se, arg->expr); ! return 1; } else if ((sym->intmod_sym_id == ISOCBINDING_F_POINTER *************** conv_isocbinding_procedure (gfc_se * se, *** 2744,2755 **** gfc_conv_expr (&fptrse, arg->next->expr); gfc_add_block_to_block (&se->pre, &fptrse.pre); gfc_add_block_to_block (&se->post, &fptrse.post); ! if (arg->next->expr->symtree->n.sym->attr.proc_pointer && arg->next->expr->symtree->n.sym->attr.dummy) fptrse.expr = build_fold_indirect_ref_loc (input_location, fptrse.expr); ! se->expr = fold_build2_loc (input_location, MODIFY_EXPR, TREE_TYPE (fptrse.expr), fptrse.expr, --- 2744,2755 ---- gfc_conv_expr (&fptrse, arg->next->expr); gfc_add_block_to_block (&se->pre, &fptrse.pre); gfc_add_block_to_block (&se->post, &fptrse.post); ! if (arg->next->expr->symtree->n.sym->attr.proc_pointer && arg->next->expr->symtree->n.sym->attr.dummy) fptrse.expr = build_fold_indirect_ref_loc (input_location, fptrse.expr); ! se->expr = fold_build2_loc (input_location, MODIFY_EXPR, TREE_TYPE (fptrse.expr), fptrse.expr, *************** conv_isocbinding_procedure (gfc_se * se, *** 2783,2789 **** { tree eq_expr; tree not_null_expr; ! /* Given two arguments so build the arg2se from second arg. */ gfc_init_se (&arg2se, NULL); gfc_conv_expr (&arg2se, arg->next->expr); --- 2783,2789 ---- { tree eq_expr; tree not_null_expr; ! /* Given two arguments so build the arg2se from second arg. */ gfc_init_se (&arg2se, NULL); gfc_conv_expr (&arg2se, arg->next->expr); *************** conv_isocbinding_procedure (gfc_se * se, *** 2807,2813 **** return 1; } ! /* Nothing was done. */ return 0; } --- 2807,2813 ---- return 1; } ! /* Nothing was done. */ return 0; } *************** gfc_conv_procedure_call (gfc_se * se, gf *** 2959,2964 **** --- 2959,2968 ---- /* An elemental function inside a scalarized loop. */ gfc_init_se (&parmse, se); gfc_conv_expr_reference (&parmse, e); + if (e->ts.type == BT_CHARACTER && !e->rank + && e->expr_type == EXPR_FUNCTION) + parmse.expr = build_fold_indirect_ref_loc (input_location, + parmse.expr); parm_kind = ELEMENTAL; } else *************** gfc_conv_procedure_call (gfc_se * se, gf *** 3023,3029 **** { gfc_conv_expr_reference (&parmse, e); ! /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is allocated on entry, it must be deallocated. */ if (fsym && fsym->attr.allocatable && fsym->attr.intent == INTENT_OUT) --- 3027,3033 ---- { gfc_conv_expr_reference (&parmse, e); ! /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is allocated on entry, it must be deallocated. */ if (fsym && fsym->attr.allocatable && fsym->attr.intent == INTENT_OUT) *************** gfc_conv_procedure_call (gfc_se * se, gf *** 3094,3100 **** /* If the argument is a function call that may not create a temporary for the result, we have to check that we ! can do it, i.e. that there is no alias between this argument and another one. */ if (gfc_get_noncopying_intrinsic_argument (e) != NULL) { --- 3098,3104 ---- /* If the argument is a function call that may not create a temporary for the result, we have to check that we ! can do it, i.e. that there is no alias between this argument and another one. */ if (gfc_get_noncopying_intrinsic_argument (e) != NULL) { *************** gfc_conv_procedure_call (gfc_se * se, gf *** 3143,3149 **** gfc_conv_array_parameter (&parmse, e, argss, f, fsym, sym->name, NULL); ! /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is allocated on entry, it must be deallocated. */ if (fsym && fsym->attr.allocatable && fsym->attr.intent == INTENT_OUT) --- 3147,3153 ---- gfc_conv_array_parameter (&parmse, e, argss, f, fsym, sym->name, NULL); ! /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is allocated on entry, it must be deallocated. */ if (fsym && fsym->attr.allocatable && fsym->attr.intent == INTENT_OUT) *************** gfc_conv_procedure_call (gfc_se * se, gf *** 3160,3166 **** tmp, build_empty_stmt (input_location)); gfc_add_expr_to_block (&se->pre, tmp); } ! } } /* The case with fsym->attr.optional is that of a user subroutine --- 3164,3170 ---- tmp, build_empty_stmt (input_location)); gfc_add_expr_to_block (&se->pre, tmp); } ! } } /* The case with fsym->attr.optional is that of a user subroutine *************** gfc_conv_procedure_call (gfc_se * se, gf *** 3186,3192 **** && ((e->rank > 0 && sym->attr.elemental) || e->representation.length || e->ts.type == BT_CHARACTER || (e->rank > 0 ! && (fsym == NULL || (fsym-> as && (fsym->as->type == AS_ASSUMED_SHAPE || fsym->as->type == AS_DEFERRED)))))) --- 3190,3196 ---- && ((e->rank > 0 && sym->attr.elemental) || e->representation.length || e->ts.type == BT_CHARACTER || (e->rank > 0 ! && (fsym == NULL || (fsym-> as && (fsym->as->type == AS_ASSUMED_SHAPE || fsym->as->type == AS_DEFERRED)))))) *************** gfc_conv_procedure_call (gfc_se * se, gf *** 3339,3345 **** fold_convert (TREE_TYPE (tmp), null_pointer_node)); } ! gfc_trans_runtime_check (true, false, cond, &se->pre, &e->where, msg); gfc_free (msg); --- 3343,3349 ---- fold_convert (TREE_TYPE (tmp), null_pointer_node)); } ! gfc_trans_runtime_check (true, false, cond, &se->pre, &e->where, msg); gfc_free (msg); *************** gfc_conv_procedure_call (gfc_se * se, gf *** 3406,3412 **** gfc_conv_expr (&parmse, ts.u.cl->length); gfc_add_block_to_block (&se->pre, &parmse.pre); gfc_add_block_to_block (&se->post, &parmse.post); ! tmp = fold_convert (gfc_charlen_type_node, parmse.expr); tmp = fold_build2_loc (input_location, MAX_EXPR, gfc_charlen_type_node, tmp, --- 3410,3416 ---- gfc_conv_expr (&parmse, ts.u.cl->length); gfc_add_block_to_block (&se->pre, &parmse.pre); gfc_add_block_to_block (&se->post, &parmse.post); ! tmp = fold_convert (gfc_charlen_type_node, parmse.expr); tmp = fold_build2_loc (input_location, MAX_EXPR, gfc_charlen_type_node, tmp, *************** gfc_conv_function_expr (gfc_se * se, gfc *** 4066,4085 **** return; } /* We distinguish statement functions from general functions to improve runtime performance. */ ! if (expr->symtree->n.sym->attr.proc == PROC_ST_FUNCTION) { gfc_conv_statement_function (se, expr); return; } - /* expr.value.function.esym is the resolved (specific) function symbol for - most functions. However this isn't set for dummy procedures. */ - sym = expr->value.function.esym; - if (!sym) - sym = expr->symtree->n.sym; - gfc_conv_procedure_call (se, sym, expr->value.function.actual, expr, NULL); } --- 4070,4089 ---- return; } + /* expr.value.function.esym is the resolved (specific) function symbol for + most functions. However this isn't set for dummy procedures. */ + sym = expr->value.function.esym; + if (!sym) + sym = expr->symtree->n.sym; + /* We distinguish statement functions from general functions to improve runtime performance. */ ! if (sym->attr.proc == PROC_ST_FUNCTION) { gfc_conv_statement_function (se, expr); return; } gfc_conv_procedure_call (se, sym, expr->value.function.actual, expr, NULL); } *************** gfc_conv_array_constructor_expr (gfc_se *** 4132,4138 **** /* Build a static initializer. EXPR is the expression for the initial value. ! The other parameters describe the variable of the component being initialized. EXPR may be null. */ tree --- 4136,4142 ---- /* Build a static initializer. EXPR is the expression for the initial value. ! The other parameters describe the variable of the component being initialized. EXPR may be null. */ tree *************** gfc_conv_initializer (gfc_expr * expr, g *** 4163,4169 **** gcc_assert (TREE_CODE (se.expr) != CONSTRUCTOR); return se.expr; } ! if (array && !procptr) { tree ctor; --- 4167,4173 ---- gcc_assert (TREE_CODE (se.expr) != CONSTRUCTOR); return se.expr; } ! if (array && !procptr) { tree ctor; *************** gfc_conv_initializer (gfc_expr * expr, g *** 4221,4227 **** } } } ! static tree gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr) { --- 4225,4231 ---- } } } ! static tree gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr) { *************** gfc_trans_subarray_assign (tree dest, gf *** 4275,4281 **** cm->as->lower[n]->value.integer); mpz_add_ui (lss->shape[n], lss->shape[n], 1); } ! /* Associate the SS with the loop. */ gfc_add_ss_to_loop (&loop, lss); gfc_add_ss_to_loop (&loop, rss); --- 4279,4285 ---- cm->as->lower[n]->value.integer); mpz_add_ui (lss->shape[n], lss->shape[n], 1); } ! /* Associate the SS with the loop. */ gfc_add_ss_to_loop (&loop, lss); gfc_add_ss_to_loop (&loop, rss); *************** gfc_trans_alloc_subarray_assign (tree de *** 4341,4347 **** gfc_start_block (&block); gfc_init_se (&se, NULL); ! /* Get the descriptor for the expressions. */ rss = gfc_walk_expr (expr); se.want_pointer = 0; gfc_conv_expr_descriptor (&se, expr, rss); --- 4345,4351 ---- gfc_start_block (&block); gfc_init_se (&se, NULL); ! /* Get the descriptor for the expressions. */ rss = gfc_walk_expr (expr); se.want_pointer = 0; gfc_conv_expr_descriptor (&se, expr, rss); *************** gfc_trans_structure_assign (tree dest, g *** 4596,4602 **** fold_convert (TREE_TYPE (lse.expr), se.expr)); return gfc_finish_block (&block); ! } for (c = gfc_constructor_first (expr->value.constructor); c; c = gfc_constructor_next (c), cm = cm->next) --- 4600,4606 ---- fold_convert (TREE_TYPE (lse.expr), se.expr)); return gfc_finish_block (&block); ! } for (c = gfc_constructor_first (expr->value.constructor); c; c = gfc_constructor_next (c), cm = cm->next) *************** gfc_conv_structure (gfc_se * se, gfc_exp *** 4678,4684 **** } } se->expr = build_constructor (type, v); ! if (init) TREE_CONSTANT (se->expr) = 1; } --- 4682,4688 ---- } } se->expr = build_constructor (type, v); ! if (init) TREE_CONSTANT (se->expr) = 1; } *************** gfc_conv_expr (gfc_se * se, gfc_expr * e *** 4752,4758 **** expr->ts.kind = expr->ts.u.derived->ts.kind; } } ! switch (expr->expr_type) { case EXPR_OP: --- 4756,4762 ---- expr->ts.kind = expr->ts.u.derived->ts.kind; } } ! switch (expr->expr_type) { case EXPR_OP: *************** gfc_trans_pointer_assignment (gfc_expr * *** 5009,5015 **** for (remap = expr1->ref; remap; remap = remap->next) if (!remap->next && remap->type == REF_ARRAY && remap->u.ar.type == AR_SECTION) ! { remap->u.ar.type = AR_FULL; break; } --- 5013,5019 ---- for (remap = expr1->ref; remap; remap = remap->next) if (!remap->next && remap->type == REF_ARRAY && remap->u.ar.type == AR_SECTION) ! { remap->u.ar.type = AR_FULL; break; } *************** gfc_trans_scalar_assign (gfc_se * lse, g *** 5307,5313 **** else if (ts.type == BT_DERIVED && ts.u.derived->attr.alloc_comp) { cond = NULL_TREE; ! /* Are the rhs and the lhs the same? */ if (r_is_var) { --- 5311,5317 ---- else if (ts.type == BT_DERIVED && ts.u.derived->attr.alloc_comp) { cond = NULL_TREE; ! /* Are the rhs and the lhs the same? */ if (r_is_var) { *************** arrayfunc_assign_needs_temporary (gfc_ex *** 5403,5409 **** /* Functions returning pointers or allocatables need temporaries. */ c = expr2->value.function.esym ! ? (expr2->value.function.esym->attr.pointer || expr2->value.function.esym->attr.allocatable) : (expr2->symtree->n.sym->attr.pointer || expr2->symtree->n.sym->attr.allocatable); --- 5407,5413 ---- /* Functions returning pointers or allocatables need temporaries. */ c = expr2->value.function.esym ! ? (expr2->value.function.esym->attr.pointer || expr2->value.function.esym->attr.allocatable) : (expr2->symtree->n.sym->attr.pointer || expr2->symtree->n.sym->attr.allocatable); *************** gfc_trans_arrayfunc_assign (gfc_expr * e *** 5694,5700 **** correctly take care of the reallocation internally. For intrinsic calls, the array data is freed and the library takes care of allocation. TODO: Add logic of trans-array.c: gfc_alloc_allocatable_for_assignment ! to the library. */ if (gfc_option.flag_realloc_lhs && gfc_is_reallocatable_lhs (expr1) && !gfc_expr_attr (expr1).codimension --- 5698,5704 ---- correctly take care of the reallocation internally. For intrinsic calls, the array data is freed and the library takes care of allocation. TODO: Add logic of trans-array.c: gfc_alloc_allocatable_for_assignment ! to the library. */ if (gfc_option.flag_realloc_lhs && gfc_is_reallocatable_lhs (expr1) && !gfc_expr_attr (expr1).codimension *************** alloc_scalar_allocatable_for_assignment *** 5967,5973 **** gfc_init_se (&lse, NULL); lse.want_pointer = 1; gfc_conv_expr (&lse, expr1); ! jump_label1 = gfc_build_label_decl (NULL_TREE); jump_label2 = gfc_build_label_decl (NULL_TREE); --- 5971,5977 ---- gfc_init_se (&lse, NULL); lse.want_pointer = 1; gfc_conv_expr (&lse, expr1); ! jump_label1 = gfc_build_label_decl (NULL_TREE); jump_label2 = gfc_build_label_decl (NULL_TREE); *************** gfc_trans_class_init_assign (gfc_code *c *** 6405,6411 **** gfc_add_block_to_block (&block, &src.pre); tmp = gfc_build_memcpy_call (dst.expr, src.expr, memsz.expr); gfc_add_expr_to_block (&block, tmp); ! return gfc_finish_block (&block); } --- 6409,6415 ---- gfc_add_block_to_block (&block, &src.pre); tmp = gfc_build_memcpy_call (dst.expr, src.expr, memsz.expr); gfc_add_expr_to_block (&block, tmp); ! return gfc_finish_block (&block); } diff -Nrcpad gcc-4.6.3/gcc/fortran/trans-intrinsic.c gcc-4.6.4/gcc/fortran/trans-intrinsic.c *** gcc-4.6.3/gcc/fortran/trans-intrinsic.c Sat Mar 12 10:28:01 2011 --- gcc-4.6.4/gcc/fortran/trans-intrinsic.c Fri Mar 15 12:06:08 2013 *************** gfc_conv_intrinsic_transfer (gfc_se * se *** 4780,4788 **** source = gfc_conv_descriptor_data_get (argse.expr); source_type = gfc_get_element_type (TREE_TYPE (argse.expr)); ! /* Repack the source if not a full variable array. */ ! if (arg->expr->expr_type == EXPR_VARIABLE ! && arg->expr->ref->u.ar.type != AR_FULL) { tmp = gfc_build_addr_expr (NULL_TREE, argse.expr); --- 4780,4787 ---- source = gfc_conv_descriptor_data_get (argse.expr); source_type = gfc_get_element_type (TREE_TYPE (argse.expr)); ! /* Repack the source if not simply contiguous. */ ! if (!gfc_is_simply_contiguous (arg->expr, false)) { tmp = gfc_build_addr_expr (NULL_TREE, argse.expr); diff -Nrcpad gcc-4.6.3/gcc/fortran/trans-types.c gcc-4.6.4/gcc/fortran/trans-types.c *** gcc-4.6.3/gcc/fortran/trans-types.c Fri Nov 25 17:18:05 2011 --- gcc-4.6.4/gcc/fortran/trans-types.c Sat Mar 10 09:20:22 2012 *************** gfc_get_function_type (gfc_symbol * sym) *** 2519,2525 **** || sym->attr.flavor == FL_PROGRAM); if (sym->backend_decl) ! return TREE_TYPE (sym->backend_decl); alternate_return = 0; typelist = NULL_TREE; --- 2519,2529 ---- || sym->attr.flavor == FL_PROGRAM); if (sym->backend_decl) ! { ! if (sym->attr.proc_pointer) ! return TREE_TYPE (TREE_TYPE (sym->backend_decl)); ! return TREE_TYPE (sym->backend_decl); ! } alternate_return = 0; typelist = NULL_TREE; diff -Nrcpad gcc-4.6.3/gcc/fortran/trans.c gcc-4.6.4/gcc/fortran/trans.c *** gcc-4.6.3/gcc/fortran/trans.c Wed Feb 23 22:38:27 2011 --- gcc-4.6.4/gcc/fortran/trans.c Fri Jun 1 20:06:39 2012 *************** internal_realloc (void *mem, size_t size *** 1005,1019 **** if (!res && size != 0) _gfortran_os_error ("Allocation would exceed memory limit"); - if (size == 0) - return NULL; - return res; } */ tree gfc_call_realloc (stmtblock_t * block, tree mem, tree size) { ! tree msg, res, nonzero, zero, null_result, tmp; tree type = TREE_TYPE (mem); size = gfc_evaluate_now (size, block); --- 1005,1016 ---- if (!res && size != 0) _gfortran_os_error ("Allocation would exceed memory limit"); return res; } */ tree gfc_call_realloc (stmtblock_t * block, tree mem, tree size) { ! tree msg, res, nonzero, null_result, tmp; tree type = TREE_TYPE (mem); size = gfc_evaluate_now (size, block); *************** gfc_call_realloc (stmtblock_t * block, t *** 1044,1058 **** build_empty_stmt (input_location)); gfc_add_expr_to_block (block, tmp); - /* if (size == 0) then the result is NULL. */ - tmp = fold_build2_loc (input_location, MODIFY_EXPR, type, res, - build_int_cst (type, 0)); - zero = fold_build1_loc (input_location, TRUTH_NOT_EXPR, boolean_type_node, - nonzero); - tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, zero, tmp, - build_empty_stmt (input_location)); - gfc_add_expr_to_block (block, tmp); - return res; } --- 1041,1046 ---- diff -Nrcpad gcc-4.6.3/libgfortran/ChangeLog gcc-4.6.4/libgfortran/ChangeLog *** gcc-4.6.3/libgfortran/ChangeLog Thu Mar 1 11:53:40 2012 --- gcc-4.6.4/libgfortran/ChangeLog Fri Apr 12 09:52:03 2013 *************** *** 1,3 **** --- 1,48 ---- + 2013-04-12 Release Manager + + * GCC 4.6.4 released. + + 2013-04-04 Tobias Burnus + + Backport from mainline: + 2013-03-29 Tobias Burnus + + PR fortran/56737 + * io/format.c (parse_format): With caching, copy + dtp->format string. + (save_parsed_format): Use dtp->format directly without + copying. + + 2012-03-29 Tobias Burnus + + PR fortran/56737 + * io/format.c (parse_format_list): Also cache FMT_STRING. + (parse_format): Update call. + + 2013-04-04 Tobias Burnus + + Backport from mainline: + 2013-03-28 Tobias Burnus + + PR fortran/56735 + * io/list_read.c (nml_query): Only abort when + an error occured. + (namelist_read): Add goto instead of falling through. + + 2012-10-21 Thomas König + + PR libfortran/54736 + Backport from trunk + * runtime/environ.c (search_unit): Correct logic + for binary search. + (mark_single): Fix index errors. + + 2012-05-12 Tobias Burnus + + PR fortran/53310 + * intrinsics/eoshift2.c (eoshift2): Do not leak + memory by allocating it in the loop. + 2012-03-01 Release Manager * GCC 4.6.3 released. diff -Nrcpad gcc-4.6.3/libgfortran/intrinsics/eoshift2.c gcc-4.6.4/libgfortran/intrinsics/eoshift2.c *** gcc-4.6.3/libgfortran/intrinsics/eoshift2.c Sun Jul 19 15:07:21 2009 --- gcc-4.6.4/libgfortran/intrinsics/eoshift2.c Fri May 11 22:33:21 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.6.3/libgfortran/io/format.c gcc-4.6.4/libgfortran/io/format.c *** gcc-4.6.3/libgfortran/io/format.c Sat Aug 7 12:03:23 2010 --- gcc-4.6.4/libgfortran/io/format.c Thu Apr 4 09:31:53 2013 *************** save_parsed_format (st_parameter_dt *dtp *** 151,158 **** if (u->format_hash_table[hash].key != NULL) free (u->format_hash_table[hash].key); ! u->format_hash_table[hash].key = get_mem (dtp->format_len); ! memcpy (u->format_hash_table[hash].key, dtp->format, dtp->format_len); u->format_hash_table[hash].key_len = dtp->format_len; u->format_hash_table[hash].hashed_fmt = dtp->u.p.fmt; --- 151,157 ---- if (u->format_hash_table[hash].key != NULL) free (u->format_hash_table[hash].key); ! u->format_hash_table[hash].key = dtp->format; u->format_hash_table[hash].key_len = dtp->format_len; u->format_hash_table[hash].hashed_fmt = dtp->u.p.fmt; *************** format_lex (format_data *fmt) *** 590,605 **** * parenthesis node which contains the rest of the list. */ static fnode * ! parse_format_list (st_parameter_dt *dtp, bool *save_ok, bool *seen_dd) { fnode *head, *tail; format_token t, u, t2; int repeat; format_data *fmt = dtp->u.p.fmt; ! bool saveit, seen_data_desc = false; head = tail = NULL; - saveit = *save_ok; /* Get the next format item */ format_item: --- 589,603 ---- * parenthesis node which contains the rest of the list. */ static fnode * ! parse_format_list (st_parameter_dt *dtp, bool *seen_dd) { fnode *head, *tail; format_token t, u, t2; int repeat; format_data *fmt = dtp->u.p.fmt; ! bool seen_data_desc = false; head = tail = NULL; /* Get the next format item */ format_item: *************** parse_format_list (st_parameter_dt *dtp, *** 616,622 **** } get_fnode (fmt, &head, &tail, FMT_LPAREN); tail->repeat = -2; /* Signifies unlimited format. */ ! tail->u.child = parse_format_list (dtp, &saveit, &seen_data_desc); if (fmt->error != NULL) goto finished; if (!seen_data_desc) --- 614,620 ---- } get_fnode (fmt, &head, &tail, FMT_LPAREN); tail->repeat = -2; /* Signifies unlimited format. */ ! tail->u.child = parse_format_list (dtp, &seen_data_desc); if (fmt->error != NULL) goto finished; if (!seen_data_desc) *************** parse_format_list (st_parameter_dt *dtp, *** 635,641 **** case FMT_LPAREN: get_fnode (fmt, &head, &tail, FMT_LPAREN); tail->repeat = repeat; ! tail->u.child = parse_format_list (dtp, &saveit, &seen_data_desc); *seen_dd = seen_data_desc; if (fmt->error != NULL) goto finished; --- 633,639 ---- case FMT_LPAREN: get_fnode (fmt, &head, &tail, FMT_LPAREN); tail->repeat = repeat; ! tail->u.child = parse_format_list (dtp, &seen_data_desc); *seen_dd = seen_data_desc; if (fmt->error != NULL) goto finished; *************** parse_format_list (st_parameter_dt *dtp, *** 663,669 **** case FMT_LPAREN: get_fnode (fmt, &head, &tail, FMT_LPAREN); tail->repeat = 1; ! tail->u.child = parse_format_list (dtp, &saveit, &seen_data_desc); *seen_dd = seen_data_desc; if (fmt->error != NULL) goto finished; --- 661,667 ---- case FMT_LPAREN: get_fnode (fmt, &head, &tail, FMT_LPAREN); tail->repeat = 1; ! tail->u.child = parse_format_list (dtp, &seen_data_desc); *seen_dd = seen_data_desc; if (fmt->error != NULL) goto finished; *************** parse_format_list (st_parameter_dt *dtp, *** 727,734 **** goto between_desc; case FMT_STRING: - /* TODO: Find out why it is necessary to turn off format caching. */ - saveit = false; get_fnode (fmt, &head, &tail, FMT_STRING); tail->u.string.p = fmt->string; tail->u.string.length = fmt->value; --- 725,730 ---- *************** parse_format_list (st_parameter_dt *dtp, *** 1108,1115 **** finished: - *save_ok = saveit; - return head; } --- 1104,1109 ---- *************** parse_format (st_parameter_dt *dtp) *** 1225,1230 **** --- 1219,1231 ---- /* Not found so proceed as follows. */ + if (format_cache_ok) + { + char *fmt_string = get_mem (dtp->format_len); + memcpy (fmt_string, dtp->format, dtp->format_len); + dtp->format = fmt_string; + } + dtp->u.p.fmt = fmt = get_mem (sizeof (format_data)); fmt->format_string = dtp->format; fmt->format_string_len = dtp->format_len; *************** parse_format (st_parameter_dt *dtp) *** 1251,1264 **** fmt->avail++; if (format_lex (fmt) == FMT_LPAREN) ! fmt->array.array[0].u.child = parse_format_list (dtp, &format_cache_ok, ! &seen_data_desc); else fmt->error = "Missing initial left parenthesis in format"; if (fmt->error) { format_error (dtp, NULL, fmt->error); free_format_hash_table (dtp->u.p.current_unit); return; } --- 1252,1266 ---- fmt->avail++; if (format_lex (fmt) == FMT_LPAREN) ! fmt->array.array[0].u.child = parse_format_list (dtp, &seen_data_desc); else fmt->error = "Missing initial left parenthesis in format"; if (fmt->error) { format_error (dtp, NULL, fmt->error); + if (format_cache_ok) + free (dtp->format); free_format_hash_table (dtp->u.p.current_unit); return; } diff -Nrcpad gcc-4.6.3/libgfortran/io/list_read.c gcc-4.6.4/libgfortran/io/list_read.c *** gcc-4.6.3/libgfortran/io/list_read.c Fri Aug 19 09:14:55 2011 --- gcc-4.6.4/libgfortran/io/list_read.c Thu Apr 4 08:37:35 2013 *************** nml_query (st_parameter_dt *dtp, char c) *** 2327,2337 **** index_type len; char * p; #ifdef HAVE_CRLF ! static const index_type endlen = 3; static const char endl[] = "\r\n"; static const char nmlend[] = "&end\r\n"; #else ! static const index_type endlen = 2; static const char endl[] = "\n"; static const char nmlend[] = "&end\n"; #endif --- 2327,2337 ---- index_type len; char * p; #ifdef HAVE_CRLF ! static const index_type endlen = 2; static const char endl[] = "\r\n"; static const char nmlend[] = "&end\r\n"; #else ! static const index_type endlen = 1; static const char endl[] = "\n"; static const char nmlend[] = "&end\n"; #endif *************** nml_query (st_parameter_dt *dtp, char c) *** 2361,2372 **** /* "&namelist_name\n" */ len = dtp->namelist_name_len; ! p = write_block (dtp, len + endlen); if (!p) goto query_return; memcpy (p, "&", 1); memcpy ((char*)(p + 1), dtp->namelist_name, len); ! memcpy ((char*)(p + len + 1), &endl, endlen - 1); for (nl = dtp->u.p.ionml; nl; nl = nl->next) { /* " var_name\n" */ --- 2361,2372 ---- /* "&namelist_name\n" */ len = dtp->namelist_name_len; ! p = write_block (dtp, len - 1 + endlen); if (!p) goto query_return; memcpy (p, "&", 1); memcpy ((char*)(p + 1), dtp->namelist_name, len); ! memcpy ((char*)(p + len + 1), &endl, endlen); for (nl = dtp->u.p.ionml; nl; nl = nl->next) { /* " var_name\n" */ *************** nml_query (st_parameter_dt *dtp, char c) *** 2377,2390 **** goto query_return; memcpy (p, " ", 1); memcpy ((char*)(p + 1), nl->var_name, len); ! memcpy ((char*)(p + len + 1), &endl, endlen - 1); } /* "&end\n" */ ! p = write_block (dtp, endlen + 3); goto query_return; ! memcpy (p, &nmlend, endlen + 3); } /* Flush the stream to force immediate output. */ --- 2377,2391 ---- goto query_return; memcpy (p, " ", 1); memcpy ((char*)(p + 1), nl->var_name, len); ! memcpy ((char*)(p + len + 1), &endl, endlen); } /* "&end\n" */ ! p = write_block (dtp, endlen + 4); ! if (!p) goto query_return; ! memcpy (p, &nmlend, endlen + 4); } /* Flush the stream to force immediate output. */ *************** find_nml_name: *** 3015,3020 **** --- 3016,3022 ---- case '?': nml_query (dtp, '?'); + goto find_nml_name; case EOF: return; diff -Nrcpad gcc-4.6.3/libgfortran/runtime/environ.c gcc-4.6.4/libgfortran/runtime/environ.c *** gcc-4.6.3/libgfortran/runtime/environ.c Thu Apr 9 15:00:19 2009 --- gcc-4.6.4/libgfortran/runtime/environ.c Sun Oct 21 13:43:32 2012 *************** search_unit (int unit, int *ip) *** 453,473 **** { int low, high, mid; ! low = -1; ! high = n_elist; ! while (high - low > 1) { mid = (low + high) / 2; ! if (unit <= elist[mid].unit) ! high = mid; else ! low = mid; ! } ! *ip = high; ! if (elist[high].unit == unit) ! return 1; else ! return 0; } /* This matches a keyword. If it is found, return the token supplied, --- 453,487 ---- { int low, high, mid; ! if (n_elist == 0) ! { ! *ip = 0; ! return 0; ! } ! ! low = 0; ! high = n_elist - 1; ! ! do { mid = (low + high) / 2; ! if (unit == elist[mid].unit) ! { ! *ip = mid; ! return 1; ! } ! else if (unit > elist[mid].unit) ! low = mid + 1; else ! high = mid - 1; ! } while (low <= high); ! ! if (unit > elist[mid].unit) ! *ip = mid + 1; else ! *ip = mid; ! ! return 0; } /* This matches a keyword. If it is found, return the token supplied, *************** mark_single (int unit) *** 582,594 **** } if (search_unit (unit, &i)) { ! elist[unit].conv = endian; } else { ! for (j=n_elist; j>=i; j--) elist[j+1] = elist[j]; ! n_elist += 1; elist[i].unit = unit; elist[i].conv = endian; --- 596,608 ---- } if (search_unit (unit, &i)) { ! elist[i].conv = endian; } else { ! for (j=n_elist-1; j>=i; j--) elist[j+1] = elist[j]; ! n_elist += 1; elist[i].unit = unit; elist[i].conv = endian;