diff -Nrcpad gcc-4.4.5/gcc/fortran/ChangeLog gcc-4.4.6/gcc/fortran/ChangeLog *** gcc-4.4.5/gcc/fortran/ChangeLog Fri Oct 1 08:03:02 2010 --- gcc-4.4.6/gcc/fortran/ChangeLog Sat Apr 16 08:00:09 2011 *************** *** 1,3 **** --- 1,79 ---- + 2011-04-16 Release Manager + + * GCC 4.4.6 released. + + 2011-01-27 Tobias Burnus + + Backport from mainline + 2011-02-26 Tobias Burnus + + PR fortran/47886 + * openmp.c (gfc_resolve_omp_directive): Resolve if() + condition of OpenMP's task. + + 2011-02-19 Tobias Burnus + + PR fortran/47775 + * trans-expr.c (arrayfunc_assign_needs_temporary): Use + esym to check whether the specific procedure returns an + allocatable or pointer. + + 2011-02-14 Tobias Burnus + + PR fortran/47569 + * interface.c (compare_parameter): Avoid ICE with + character components. + + 2011-01-16 Jakub Jelinek + + Backport from mainline + 2010-12-14 Jakub Jelinek + + PR fortran/46874 + * trans-openmp.c (gfc_trans_omp_array_reduction): Handle allocatable + dummy variables. + + 2010-12-09 Daniel Kraft + + PR fortran/46794 + * trans-expr.c (gfc_conv_power_op): Handle kind of result expression + correctly for integer kind 1 and 2 operands. + + 2010-12-09 Paul Thomas + + PR fortran/45081 + * simplify.c (is_constant_array_expr): Allow structure array + elements as well as constants. + (gfc_simplify_reshape): Copy the derived type of source to + the result. + + 2010-12-07 Jakub Jelinek + + Backport from mainline + 2010-12-02 Jakub Jelinek + + PR fortran/46753 + * trans-openmp.c (gfc_trans_omp_do): Use build2_loc instead of + fold_build2_loc for OMP_FOR conditions. + + 2010-11-25 Tobias Burnus + + PR fortran/46638 + * target-memory.c (gfc_interpret_derived): Correctly handle + component offset. + + 2010-11-13 Tobias Burnus + + PR fortran/45742 + * trans-common.c (build_field): Add TREE_SIDE_EFFECTS for volatile. + * trans-decl.c (gfc_finish_var_decl): Ditto. + (create_function_arglist): Handle volatile dummy arguments. + + 2010-10-25 Steven G. Kargl + + PR fortran/46140 + * fortran/scanner.c (include_line): Check return value of load_file. + 2010-10-01 Release Manager * GCC 4.4.5 released. diff -Nrcpad gcc-4.4.5/gcc/fortran/gfortran.info gcc-4.4.6/gcc/fortran/gfortran.info *** gcc-4.4.5/gcc/fortran/gfortran.info Fri Oct 1 09:30:45 2010 --- gcc-4.4.6/gcc/fortran/gfortran.info Sat Apr 16 08:41:04 2011 *************** *** 1,5 **** This is doc/gfortran.info, produced by makeinfo version 4.13 from ! /d/gcc-4.4.5/gcc-4.4.5/gcc/fortran/gfortran.texi. Copyright (C) 1999-2008 Free Software Foundation, Inc. --- 1,5 ---- This is doc/gfortran.info, produced by makeinfo version 4.13 from ! /d/gcc-4.4.6/gcc-4.4.6/gcc/fortran/gfortran.texi. Copyright (C) 1999-2008 Free Software Foundation, Inc. diff -Nrcpad gcc-4.4.5/gcc/fortran/interface.c gcc-4.4.6/gcc/fortran/interface.c *** gcc-4.4.5/gcc/fortran/interface.c Fri May 14 22:40:01 2010 --- gcc-4.4.6/gcc/fortran/interface.c Mon Feb 14 14:05:52 2011 *************** compare_parameter (gfc_symbol *formal, g *** 1436,1442 **** int ranks_must_agree, int is_elemental, locus *where) { gfc_ref *ref; ! bool rank_check; /* If the formal arg has type BT_VOID, it's to one of the iso_c_binding procs c_f_pointer or c_f_procpointer, and we need to accept most --- 1436,1442 ---- int ranks_must_agree, int is_elemental, locus *where) { gfc_ref *ref; ! bool rank_check, is_pointer; /* If the formal arg has type BT_VOID, it's to one of the iso_c_binding procs c_f_pointer or c_f_procpointer, and we need to accept most *************** compare_parameter (gfc_symbol *formal, g *** 1511,1532 **** return 1; /* At this point, we are considering a scalar passed to an array. This ! is valid (cf. F95 12.4.1.1; F2003 12.4.1.2), - if the actual argument is (a substring of) an element of a ! non-assumed-shape/non-pointer array; ! - (F2003) if the actual argument is of type character. */ for (ref = actual->ref; ref; ref = ref->next) ! if (ref->type == REF_ARRAY && ref->u.ar.type == AR_ELEMENT) ! break; ! /* Not an array element. */ ! if (formal->ts.type == BT_CHARACTER ! && (ref == NULL ! || (actual->expr_type == EXPR_VARIABLE ! && (actual->symtree->n.sym->as->type == AS_ASSUMED_SHAPE ! || actual->symtree->n.sym->attr.pointer)))) { if (where && (gfc_option.allow_std & GFC_STD_F2003) == 0) { gfc_error ("Fortran 2003: Scalar CHARACTER actual argument with " --- 1511,1558 ---- return 1; /* At this point, we are considering a scalar passed to an array. This ! is valid (cf. F95 12.4.1.1, F2003 12.4.1.2, and F2008 12.5.2.4), - if the actual argument is (a substring of) an element of a ! non-assumed-shape/non-pointer/non-polymorphic array; or ! - (F2003) if the actual argument is of type character of default/c_char ! kind. */ ! ! is_pointer = actual->expr_type == EXPR_VARIABLE ! ? actual->symtree->n.sym->attr.pointer : false; for (ref = actual->ref; ref; ref = ref->next) ! { ! if (ref->type == REF_COMPONENT) ! is_pointer = ref->u.c.component->attr.pointer; ! else if (ref->type == REF_ARRAY && ref->u.ar.type == AR_ELEMENT ! && ref->u.ar.dimen > 0 ! && (!ref->next ! || (ref->next->type == REF_SUBSTRING && !ref->next->next))) ! break; ! } ! if (actual->expr_type != EXPR_NULL && ref && actual->ts.type != BT_CHARACTER ! && (is_pointer || ref->u.ar.as->type == AS_ASSUMED_SHAPE)) ! { ! if (where) ! gfc_error ("Element of assumed-shaped or pointer " ! "array passed to array dummy argument '%s' at %L", ! formal->name, &actual->where); ! return 0; ! } ! ! if (actual->ts.type == BT_CHARACTER && actual->expr_type != EXPR_NULL ! && (!ref || is_pointer || ref->u.ar.as->type == AS_ASSUMED_SHAPE)) { + if (formal->ts.kind != 1 && (gfc_option.allow_std & GFC_STD_GNU) == 0) + { + if (where) + gfc_error ("Extension: Scalar non-default-kind, non-C_CHAR-kind " + "CHARACTER actual argument with array dummy argument " + "'%s' at %L", formal->name, &actual->where); + return 0; + } + if (where && (gfc_option.allow_std & GFC_STD_F2003) == 0) { gfc_error ("Fortran 2003: Scalar CHARACTER actual argument with " *************** compare_parameter (gfc_symbol *formal, g *** 1539,1545 **** else return 1; } ! else if (ref == NULL) { if (where) gfc_error ("Rank mismatch in argument '%s' at %L (%d and %d)", --- 1565,1572 ---- else return 1; } ! ! if (ref == NULL && actual->expr_type != EXPR_NULL) { if (where) gfc_error ("Rank mismatch in argument '%s' at %L (%d and %d)", *************** compare_parameter (gfc_symbol *formal, g *** 1548,1564 **** return 0; } - if (actual->expr_type == EXPR_VARIABLE - && actual->symtree->n.sym->as - && (actual->symtree->n.sym->as->type == AS_ASSUMED_SHAPE - || actual->symtree->n.sym->attr.pointer)) - { - if (where) - gfc_error ("Element of assumed-shaped array passed to dummy " - "argument '%s' at %L", formal->name, &actual->where); - return 0; - } - return 1; } --- 1575,1580 ---- diff -Nrcpad gcc-4.4.5/gcc/fortran/openmp.c gcc-4.4.6/gcc/fortran/openmp.c *** gcc-4.4.5/gcc/fortran/openmp.c Wed Sep 8 17:23:52 2010 --- gcc-4.4.6/gcc/fortran/openmp.c Sun Feb 27 14:36:53 2011 *************** gfc_resolve_omp_directive (gfc_code *cod *** 1518,1523 **** --- 1518,1524 ---- case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_SECTIONS: case EXEC_OMP_SINGLE: + case EXEC_OMP_TASK: if (code->ext.omp_clauses) resolve_omp_clauses (code); break; diff -Nrcpad gcc-4.4.5/gcc/fortran/scanner.c gcc-4.4.6/gcc/fortran/scanner.c *** gcc-4.4.5/gcc/fortran/scanner.c Sun Aug 8 01:59:15 2010 --- gcc-4.4.6/gcc/fortran/scanner.c Mon Oct 25 16:11:54 2010 *************** include_line (gfc_char_t *line) *** 1770,1776 **** read by anything else. */ filename = gfc_widechar_to_char (begin, -1); ! load_file (filename, NULL, false); gfc_free (filename); return true; } --- 1770,1778 ---- read by anything else. */ filename = gfc_widechar_to_char (begin, -1); ! if (load_file (filename, NULL, false) == FAILURE) ! exit (1); ! gfc_free (filename); return true; } diff -Nrcpad gcc-4.4.5/gcc/fortran/simplify.c gcc-4.4.6/gcc/fortran/simplify.c *** gcc-4.4.5/gcc/fortran/simplify.c Wed Jun 3 19:39:09 2009 --- gcc-4.4.6/gcc/fortran/simplify.c Thu Dec 9 08:09:52 2010 *************** is_constant_array_expr (gfc_expr *e) *** 3448,3454 **** return false; for (c = e->value.constructor; c; c = c->next) ! if (c->expr->expr_type != EXPR_CONSTANT) return false; return true; --- 3448,3455 ---- return false; for (c = e->value.constructor; c; c = c->next) ! if (c->expr->expr_type != EXPR_CONSTANT ! && c->expr->expr_type != EXPR_STRUCTURE) return false; return true; *************** inc: *** 3679,3684 **** --- 3680,3690 ---- e->ts = source->ts; e->rank = rank; + if (source->ts.type == BT_CHARACTER) + e->ts.cl = source->ts.cl; + else if (source->ts.type == BT_DERIVED) + e->ts.derived = source->ts.derived; + return e; bad_reshape: diff -Nrcpad gcc-4.4.5/gcc/fortran/target-memory.c gcc-4.4.6/gcc/fortran/target-memory.c *** gcc-4.4.5/gcc/fortran/target-memory.c Sat Jan 10 00:15:37 2009 --- gcc-4.4.6/gcc/fortran/target-memory.c Thu Nov 25 08:04:46 2010 *************** gfc_interpret_derived (unsigned char *bu *** 484,490 **** } } ! ptr = TREE_INT_CST_LOW (DECL_FIELD_OFFSET (cmp->backend_decl)); gfc_target_interpret_expr (&buffer[ptr], buffer_size - ptr, tail->expr); --- 484,499 ---- } } ! /* Calculate the offset, which consists of the the FIELD_OFFSET in ! bytes, which appears in multiples of DECL_OFFSET_ALIGN-bit-sized, ! and additional bits of FIELD_BIT_OFFSET. The code assumes that all ! sizes of the components are multiples of BITS_PER_UNIT, ! i.e. there are, e.g., no bit fields. */ ! ! ptr = TREE_INT_CST_LOW (DECL_FIELD_BIT_OFFSET (cmp->backend_decl)); ! gcc_assert (ptr % 8 == 0); ! ptr = ptr/8 + TREE_INT_CST_LOW (DECL_FIELD_OFFSET (cmp->backend_decl)); ! gfc_target_interpret_expr (&buffer[ptr], buffer_size - ptr, tail->expr); diff -Nrcpad gcc-4.4.5/gcc/fortran/trans-common.c gcc-4.4.6/gcc/fortran/trans-common.c *** gcc-4.4.5/gcc/fortran/trans-common.c Mon Sep 22 11:45:02 2008 --- gcc-4.4.6/gcc/fortran/trans-common.c Sat Nov 13 17:25:28 2010 *************** build_field (segment_info *h, tree union *** 323,328 **** --- 323,329 ---- { tree new_type; TREE_THIS_VOLATILE (field) = 1; + TREE_SIDE_EFFECTS (field) = 1; new_type = build_qualified_type (TREE_TYPE (field), TYPE_QUAL_VOLATILE); TREE_TYPE (field) = new_type; } diff -Nrcpad gcc-4.4.5/gcc/fortran/trans-decl.c gcc-4.4.6/gcc/fortran/trans-decl.c *** gcc-4.4.5/gcc/fortran/trans-decl.c Mon Oct 5 09:19:13 2009 --- gcc-4.4.6/gcc/fortran/trans-decl.c Sat Nov 13 17:25:28 2010 *************** gfc_finish_var_decl (tree decl, gfc_symb *** 539,544 **** --- 539,545 ---- if (sym->attr.volatile_) { TREE_THIS_VOLATILE (decl) = 1; + TREE_SIDE_EFFECTS (decl) = 1; new_type = build_qualified_type (TREE_TYPE (decl), TYPE_QUAL_VOLATILE); TREE_TYPE (decl) = new_type; } *************** create_function_arglist (gfc_symbol * sy *** 1655,1664 **** --- 1656,1674 ---- if (f->sym->attr.proc_pointer) type = build_pointer_type (type); + + if (f->sym->attr.volatile_) + type = build_qualified_type (type, TYPE_QUAL_VOLATILE); /* Build the argument declaration. */ parm = build_decl (PARM_DECL, gfc_sym_identifier (f->sym), type); + if (f->sym->attr.volatile_) + { + TREE_THIS_VOLATILE (parm) = 1; + TREE_SIDE_EFFECTS (parm) = 1; + } + /* Fill in arg stuff. */ DECL_CONTEXT (parm) = fndecl; DECL_ARG_TYPE (parm) = TREE_VALUE (typelist); diff -Nrcpad gcc-4.4.5/gcc/fortran/trans-expr.c gcc-4.4.6/gcc/fortran/trans-expr.c *** gcc-4.4.5/gcc/fortran/trans-expr.c Sat Jul 10 17:08:48 2010 --- gcc-4.4.6/gcc/fortran/trans-expr.c Sat Feb 19 11:27:52 2011 *************** gfc_conv_power_op (gfc_se * se, gfc_expr *** 917,922 **** --- 917,923 ---- tree gfc_int4_type_node; int kind; int ikind; + int res_ikind_1, res_ikind_2; gfc_se lse; gfc_se rse; tree fndecl; *************** gfc_conv_power_op (gfc_se * se, gfc_expr *** 937,942 **** --- 938,950 ---- gfc_int4_type_node = gfc_get_int_type (4); + /* In case of integer operands with kinds 1 or 2, we call the integer kind 4 + library routine. But in the end, we have to convert the result back + if this case applies -- with res_ikind_K, we keep track whether operand K + falls into this case. */ + res_ikind_1 = -1; + res_ikind_2 = -1; + kind = expr->value.op.op1->ts.kind; switch (expr->value.op.op2->ts.type) { *************** gfc_conv_power_op (gfc_se * se, gfc_expr *** 947,952 **** --- 955,961 ---- case 1: case 2: rse.expr = convert (gfc_int4_type_node, rse.expr); + res_ikind_2 = ikind; /* Fall through. */ case 4: *************** gfc_conv_power_op (gfc_se * se, gfc_expr *** 969,975 **** case 1: case 2: if (expr->value.op.op1->ts.type == BT_INTEGER) ! lse.expr = convert (gfc_int4_type_node, lse.expr); else gcc_unreachable (); /* Fall through. */ --- 978,987 ---- case 1: case 2: if (expr->value.op.op1->ts.type == BT_INTEGER) ! { ! lse.expr = convert (gfc_int4_type_node, lse.expr); ! res_ikind_1 = kind; ! } else gcc_unreachable (); /* Fall through. */ *************** gfc_conv_power_op (gfc_se * se, gfc_expr *** 1080,1085 **** --- 1092,1106 ---- } se->expr = build_call_expr (fndecl, 2, lse.expr, rse.expr); + + /* Convert the result back if it is of wrong integer kind. */ + if (res_ikind_1 != -1 && res_ikind_2 != -1) + { + /* We want the maximum of both operand kinds as result. */ + if (res_ikind_1 < res_ikind_2) + res_ikind_1 = res_ikind_2; + se->expr = convert (gfc_get_int_type (res_ikind_1), se->expr); + } } *************** arrayfunc_assign_needs_temporary (gfc_ex *** 4384,4392 **** if (gfc_ref_needs_temporary_p (expr1->ref)) return true; ! /* Functions returning pointers need temporaries. */ ! if (expr2->symtree->n.sym->attr.pointer ! || expr2->symtree->n.sym->attr.allocatable) return true; /* Character array functions need temporaries unless the --- 4405,4417 ---- if (gfc_ref_needs_temporary_p (expr1->ref)) return true; ! /* 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); ! if (c) return true; /* Character array functions need temporaries unless the diff -Nrcpad gcc-4.4.5/gcc/fortran/trans-openmp.c gcc-4.4.6/gcc/fortran/trans-openmp.c *** gcc-4.4.5/gcc/fortran/trans-openmp.c Tue Jun 15 12:27:01 2010 --- gcc-4.4.6/gcc/fortran/trans-openmp.c Sun Jan 16 22:54:37 2011 *************** gfc_trans_omp_array_reduction (tree c, g *** 477,489 **** gfc_symbol init_val_sym, outer_sym, intrinsic_sym; gfc_expr *e1, *e2, *e3, *e4; gfc_ref *ref; ! tree decl, backend_decl, stmt; locus old_loc = gfc_current_locus; const char *iname; gfc_try t; decl = OMP_CLAUSE_DECL (c); gfc_current_locus = where; /* Create a fake symbol for init value. */ memset (&init_val_sym, 0, sizeof (init_val_sym)); --- 477,499 ---- gfc_symbol init_val_sym, outer_sym, intrinsic_sym; gfc_expr *e1, *e2, *e3, *e4; gfc_ref *ref; ! tree decl, backend_decl, stmt, type, outer_decl; locus old_loc = gfc_current_locus; const char *iname; gfc_try t; decl = OMP_CLAUSE_DECL (c); gfc_current_locus = where; + type = TREE_TYPE (decl); + outer_decl = create_tmp_var_raw (type, NULL); + if (TREE_CODE (decl) == PARM_DECL + && TREE_CODE (type) == REFERENCE_TYPE + && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (type)) + && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (type)) == GFC_ARRAY_ALLOCATABLE) + { + decl = build_fold_indirect_ref (decl); + type = TREE_TYPE (type); + } /* Create a fake symbol for init value. */ memset (&init_val_sym, 0, sizeof (init_val_sym)); *************** gfc_trans_omp_array_reduction (tree c, g *** 502,508 **** outer_sym.attr.dummy = 0; outer_sym.attr.result = 0; outer_sym.attr.flavor = FL_VARIABLE; ! outer_sym.backend_decl = create_tmp_var_raw (TREE_TYPE (decl), NULL); /* Create fake symtrees for it. */ symtree1 = gfc_new_symtree (&root1, sym->name); --- 512,520 ---- outer_sym.attr.dummy = 0; outer_sym.attr.result = 0; outer_sym.attr.flavor = FL_VARIABLE; ! outer_sym.backend_decl = outer_decl; ! if (decl != OMP_CLAUSE_DECL (c)) ! outer_sym.backend_decl = build_fold_indirect_ref (outer_decl); /* Create fake symtrees for it. */ symtree1 = gfc_new_symtree (&root1, sym->name); *************** gfc_trans_omp_array_reduction (tree c, g *** 619,630 **** /* Create the init statement list. */ pushlevel (0); ! if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)) ! && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (decl)) == GFC_ARRAY_ALLOCATABLE) { /* If decl is an allocatable array, it needs to be allocated with the same bounds as the outer var. */ ! tree type = TREE_TYPE (decl), rank, size, esize, ptr; stmtblock_t block; gfc_start_block (&block); --- 631,642 ---- /* Create the init statement list. */ pushlevel (0); ! if (GFC_DESCRIPTOR_TYPE_P (type) ! && GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE) { /* If decl is an allocatable array, it needs to be allocated with the same bounds as the outer var. */ ! tree rank, size, esize, ptr; stmtblock_t block; gfc_start_block (&block); *************** gfc_trans_omp_array_reduction (tree c, g *** 660,667 **** /* Create the merge statement list. */ pushlevel (0); ! if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)) ! && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (decl)) == GFC_ARRAY_ALLOCATABLE) { /* If decl is an allocatable array, it needs to be deallocated afterwards. */ --- 672,679 ---- /* Create the merge statement list. */ pushlevel (0); ! if (GFC_DESCRIPTOR_TYPE_P (type) ! && GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE) { /* If decl is an allocatable array, it needs to be deallocated afterwards. */ *************** gfc_trans_omp_array_reduction (tree c, g *** 681,687 **** OMP_CLAUSE_REDUCTION_MERGE (c) = stmt; /* And stick the placeholder VAR_DECL into the clause as well. */ ! OMP_CLAUSE_REDUCTION_PLACEHOLDER (c) = outer_sym.backend_decl; gfc_current_locus = old_loc; --- 693,699 ---- OMP_CLAUSE_REDUCTION_MERGE (c) = stmt; /* And stick the placeholder VAR_DECL into the clause as well. */ ! OMP_CLAUSE_REDUCTION_PLACEHOLDER (c) = outer_decl; gfc_current_locus = old_loc; *************** gfc_trans_omp_do (gfc_code *code, stmtbl *** 1240,1247 **** if (simple) { TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, dovar, from); ! TREE_VEC_ELT (cond, i) = fold_build2 (simple > 0 ? LE_EXPR : GE_EXPR, ! boolean_type_node, dovar, to); TREE_VEC_ELT (incr, i) = fold_build2 (PLUS_EXPR, type, dovar, step); TREE_VEC_ELT (incr, i) = fold_build2 (MODIFY_EXPR, type, dovar, TREE_VEC_ELT (incr, i)); --- 1252,1260 ---- if (simple) { TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, dovar, from); ! /* The condition should not be folded. */ ! TREE_VEC_ELT (cond, i) = build2 (simple > 0 ? LE_EXPR : GE_EXPR, ! boolean_type_node, dovar, to); TREE_VEC_ELT (incr, i) = fold_build2 (PLUS_EXPR, type, dovar, step); TREE_VEC_ELT (incr, i) = fold_build2 (MODIFY_EXPR, type, dovar, TREE_VEC_ELT (incr, i)); *************** gfc_trans_omp_do (gfc_code *code, stmtbl *** 1262,1269 **** count = gfc_create_var (type, "count"); TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, count, build_int_cst (type, 0)); ! TREE_VEC_ELT (cond, i) = fold_build2 (LT_EXPR, boolean_type_node, ! count, tmp); TREE_VEC_ELT (incr, i) = fold_build2 (PLUS_EXPR, type, count, build_int_cst (type, 1)); TREE_VEC_ELT (incr, i) = fold_build2 (MODIFY_EXPR, type, --- 1275,1283 ---- count = gfc_create_var (type, "count"); TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, count, build_int_cst (type, 0)); ! /* The condition should not be folded. */ ! TREE_VEC_ELT (cond, i) = build2 (LT_EXPR, boolean_type_node, ! count, tmp); TREE_VEC_ELT (incr, i) = fold_build2 (PLUS_EXPR, type, count, build_int_cst (type, 1)); TREE_VEC_ELT (incr, i) = fold_build2 (MODIFY_EXPR, type, diff -Nrcpad gcc-4.4.5/libgfortran/ChangeLog gcc-4.4.6/libgfortran/ChangeLog *** gcc-4.4.5/libgfortran/ChangeLog Fri Oct 1 08:04:41 2010 --- gcc-4.4.6/libgfortran/ChangeLog Sat Apr 16 08:02:02 2011 *************** *** 1,3 **** --- 1,61 ---- + 2011-04-16 Release Manager + + * GCC 4.4.6 released. + + 2011-03-06 Jakub Jelinek + + Backport from mainline + PR fortran/47878 + * io/transfer.c (read_sf): Call fbuf_getptr only at the end, + and subtract n, dtp->u.p.sf_seen_eor and seen_comma from it. + + 2011-03-06 Janne Blomqvist + Jerry DeLisle + + Backport from mainline + PR libfortran/47694 + * io/io.h (fbuf_getptr): New inline function. + * io/transfer.c (read_sf): Use fbuf_getptr and fbuf_getc to scan + through the string instead of fbuf_read. + + 2011-02-22 Tobias Burnus + Kai-Uwe Eckhardt + + PR libfortran/47830 + * intrinsics/c99_functions.c (roundl): Make C valid for + HAVE_NEXTAFTERL. + + 2010-11-10 Jerry DeLisle + + PR libgfortran/46373 + Backport from mainline: + * io/transfer.c (data_transfer_init): Do not call flush_if_preconnected + if this is an internal unit. + + 2010-11-03 Jerry DeLisle + + PR libgfortran/46010 + Backport from mainline: + * io/list_read.c (nml_parse_qualifier): Add additional conditions for + setting the end index for loop specification. Fix some whitespace. + + 2010-10-16 John David Anglin + + Backport from mainline: + 2009-03-29 John David Anglin + + PR fortran/33595 + * intrinsics/c99_functions.c (round): Use floor instead of ceil. + Revise checks to round up. + (roundf): Likewise. + + 2010-10-06 Jerry DeLisle + + Backport from mainline: + PR libfortran/45710 + * io/write.c (namelist_write_newline): Pad character array internal + unit records with spaces. + 2010-10-01 Release Manager * GCC 4.4.5 released. diff -Nrcpad gcc-4.4.5/libgfortran/intrinsics/c99_functions.c gcc-4.4.6/libgfortran/intrinsics/c99_functions.c *** gcc-4.4.5/libgfortran/intrinsics/c99_functions.c Thu Apr 9 23:23:07 2009 --- gcc-4.4.6/libgfortran/intrinsics/c99_functions.c Tue Feb 22 12:43:38 2011 *************** roundl(long double x) *** 538,544 **** if (x > DBL_MAX || x < -DBL_MAX) { #ifdef HAVE_NEXTAFTERL ! static long double prechalf = nexafterl (0.5L, LDBL_MAX); #else static long double prechalf = 0.5L; #endif --- 538,544 ---- if (x > DBL_MAX || x < -DBL_MAX) { #ifdef HAVE_NEXTAFTERL ! long double prechalf = nextafterl (0.5L, LDBL_MAX); #else static long double prechalf = 0.5L; #endif *************** round(double x) *** 566,581 **** if (x >= 0.0) { ! t = ceil(x); ! if (t - x > 0.5) ! t -= 1.0; return (t); } else { ! t = ceil(-x); ! if (t + x > 0.5) ! t -= 1.0; return (-t); } } --- 566,581 ---- if (x >= 0.0) { ! t = floor(x); ! if (t - x <= -0.5) ! t += 1.0; return (t); } else { ! t = floor(-x); ! if (t + x <= -0.5) ! t += 1.0; return (-t); } } *************** roundf(float x) *** 595,610 **** if (x >= 0.0) { ! t = ceilf(x); ! if (t - x > 0.5) ! t -= 1.0; return (t); } else { ! t = ceilf(-x); ! if (t + x > 0.5) ! t -= 1.0; return (-t); } } --- 595,610 ---- if (x >= 0.0) { ! t = floorf(x); ! if (t - x <= -0.5) ! t += 1.0; return (t); } else { ! t = floorf(-x); ! if (t + x <= -0.5) ! t += 1.0; return (-t); } } diff -Nrcpad gcc-4.4.5/libgfortran/io/io.h gcc-4.4.6/libgfortran/io/io.h *** gcc-4.4.5/libgfortran/io/io.h Wed Mar 31 02:00:51 2010 --- gcc-4.4.6/libgfortran/io/io.h Mon Mar 7 03:08:08 2011 *************** fbuf_getc (gfc_unit * u) *** 1013,1018 **** --- 1013,1024 ---- return fbuf_getc_refill (u); } + static inline char * + fbuf_getptr (gfc_unit * u) + { + return (char*) (u->fbuf->buf + u->fbuf->pos); + } + /* lock.c */ extern void free_ionml (st_parameter_dt *); internal_proto(free_ionml); diff -Nrcpad gcc-4.4.5/libgfortran/io/list_read.c gcc-4.4.6/libgfortran/io/list_read.c *** gcc-4.4.5/libgfortran/io/list_read.c Thu Sep 23 01:19:13 2010 --- gcc-4.4.6/libgfortran/io/list_read.c Thu Nov 4 00:34:16 2010 *************** nml_parse_qualifier (st_parameter_dt *dt *** 2077,2084 **** /* If -std=f95/2003 or an array section is specified, do not allow excess data to be processed. */ ! if (is_array_section == 1 ! || compile_options.allow_std < GFC_STD_GNU) ls[dim].end = ls[dim].start; else dtp->u.p.expanded_read = 1; --- 2077,2086 ---- /* If -std=f95/2003 or an array section is specified, 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 dtp->u.p.expanded_read = 1; *************** nml_parse_qualifier (st_parameter_dt *dt *** 2093,2104 **** } if (is_array_section == 1 && dtp->u.p.expanded_read == 1) ! { int i; dtp->u.p.expanded_read = 0; for (i = 0; i < dim; i++) ls[i].end = ls[i].start; ! } /* Check the values of the triplet indices. */ if ((ls[dim].start > (ssize_t)ad[dim].ubound) --- 2095,2106 ---- } if (is_array_section == 1 && dtp->u.p.expanded_read == 1) ! { int i; dtp->u.p.expanded_read = 0; for (i = 0; i < dim; i++) ls[i].end = ls[i].start; ! } /* Check the values of the triplet indices. */ if ((ls[dim].start > (ssize_t)ad[dim].ubound) diff -Nrcpad gcc-4.4.5/libgfortran/io/transfer.c gcc-4.4.6/libgfortran/io/transfer.c *** gcc-4.4.5/libgfortran/io/transfer.c Tue Mar 30 03:54:36 2010 --- gcc-4.4.6/libgfortran/io/transfer.c Mon Mar 7 03:08:08 2011 *************** static char * *** 222,228 **** read_sf (st_parameter_dt *dtp, int * length) { static char *empty_string[0]; ! char *base, *p, q; int n, lorig, seen_comma; /* If we have seen an eor previously, return a length of 0. The --- 222,228 ---- read_sf (st_parameter_dt *dtp, int * length) { static char *empty_string[0]; ! int q, q2; int n, lorig, seen_comma; /* If we have seen an eor previously, return a length of 0. The *************** read_sf (st_parameter_dt *dtp, int * len *** 239,256 **** /* Read data into format buffer and scan through it. */ lorig = *length; - base = p = fbuf_read (dtp->u.p.current_unit, length); - if (base == NULL) - return NULL; while (n < *length) { ! q = *p; ! ! if (q == '\n' || q == '\r') { /* Unexpected end of line. Set the position. */ - fbuf_seek (dtp->u.p.current_unit, n + 1 ,SEEK_CUR); dtp->u.p.sf_seen_eor = 1; /* If we see an EOR during non-advancing I/O, we need to skip --- 239,253 ---- /* Read data into format buffer and scan through it. */ lorig = *length; while (n < *length) { ! q = fbuf_getc (dtp->u.p.current_unit); ! if (q == EOF) ! break; ! else if (q == '\n' || q == '\r') { /* Unexpected end of line. Set the position. */ dtp->u.p.sf_seen_eor = 1; /* If we see an EOR during non-advancing I/O, we need to skip *************** read_sf (st_parameter_dt *dtp, int * len *** 261,275 **** /* If we encounter a CR, it might be a CRLF. */ if (q == '\r') /* Probably a CRLF */ { ! /* See if there is an LF. Use fbuf_read rather then fbuf_getc so ! the position is not advanced unless it really is an LF. */ ! int readlen = 1; ! p = fbuf_read (dtp->u.p.current_unit, &readlen); ! if (*p == '\n' && readlen == 1) ! { ! dtp->u.p.sf_seen_eor = 2; ! fbuf_seek (dtp->u.p.current_unit, 1 ,SEEK_CUR); ! } } /* Without padding, terminate the I/O statement without assigning --- 258,269 ---- /* If we encounter a CR, it might be a CRLF. */ if (q == '\r') /* Probably a CRLF */ { ! /* See if there is an LF. */ ! q2 = fbuf_getc (dtp->u.p.current_unit); ! if (q2 == '\n') ! dtp->u.p.sf_seen_eor = 2; ! else if (q2 != EOF) /* Oops, seek back. */ ! fbuf_seek (dtp->u.p.current_unit, -1, SEEK_CUR); } /* Without padding, terminate the I/O statement without assigning *************** read_sf (st_parameter_dt *dtp, int * len *** 287,306 **** /* Short circuit the read if a comma is found during numeric input. The flag is set to zero during character reads so that commas in strings are not ignored */ ! if (q == ',') if (dtp->u.p.sf_read_comma == 1) { ! seen_comma = 1; notify_std (&dtp->common, GFC_STD_GNU, "Comma in formatted numeric read."); - *length = n; break; } n++; ! p++; ! } ! fbuf_seek (dtp->u.p.current_unit, n + seen_comma, SEEK_CUR); /* A short read implies we hit EOF, unless we hit EOR, a comma, or some other stuff. Set the relevant flags. */ --- 281,298 ---- /* Short circuit the read if a comma is found during numeric input. The flag is set to zero during character reads so that commas in strings are not ignored */ ! else if (q == ',') if (dtp->u.p.sf_read_comma == 1) { ! seen_comma = 1; notify_std (&dtp->common, GFC_STD_GNU, "Comma in formatted numeric read."); break; } n++; ! } ! *length = n; /* A short read implies we hit EOF, unless we hit EOR, a comma, or some other stuff. Set the relevant flags. */ *************** read_sf (st_parameter_dt *dtp, int * len *** 338,344 **** if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) dtp->u.p.size_used += (GFC_IO_INT) n; ! return base; } --- 330,341 ---- if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) dtp->u.p.size_used += (GFC_IO_INT) n; ! /* We can't call fbuf_getptr before the loop doing fbuf_getc, because ! fbuf_getc might reallocate the buffer. So return current pointer ! minus all the advances, which is n plus up to two characters ! of newline or comma. */ ! return fbuf_getptr (dtp->u.p.current_unit) ! - n - dtp->u.p.sf_seen_eor - seen_comma; } *************** data_transfer_init (st_parameter_dt *dtp *** 2450,2456 **** } /* Bugware for badly written mixed C-Fortran I/O. */ ! flush_if_preconnected(dtp->u.p.current_unit->s); dtp->u.p.current_unit->mode = dtp->u.p.mode; --- 2447,2454 ---- } /* Bugware for badly written mixed C-Fortran I/O. */ ! if (!is_internal_unit (dtp)) ! flush_if_preconnected(dtp->u.p.current_unit->s); dtp->u.p.current_unit->mode = dtp->u.p.mode; diff -Nrcpad gcc-4.4.5/libgfortran/io/write.c gcc-4.4.6/libgfortran/io/write.c *** gcc-4.4.5/libgfortran/io/write.c Wed May 27 01:21:22 2009 --- gcc-4.4.6/libgfortran/io/write.c Thu Oct 7 02:31:14 2010 *************** namelist_write_newline (st_parameter_dt *** 1194,1203 **** if (is_array_io (dtp)) { gfc_offset record; ! int finished, length; - length = (int) dtp->u.p.current_unit->bytes_left; - /* Now that the current record has been padded out, determine where the next record in the array is. */ record = next_array_record (dtp, dtp->u.p.current_unit->ls, --- 1194,1208 ---- if (is_array_io (dtp)) { gfc_offset record; ! int finished; ! char *p; ! int length = dtp->u.p.current_unit->bytes_left; ! ! p = write_block (dtp, length); ! if (p == NULL) ! return; ! memset (p, ' ', length); /* Now that the current record has been padded out, determine where the next record in the array is. */ record = next_array_record (dtp, dtp->u.p.current_unit->ls,