diff -Nrcpad gcc-4.4.3/gcc/fortran/ChangeLog gcc-4.4.4/gcc/fortran/ChangeLog *** gcc-4.4.3/gcc/fortran/ChangeLog Thu Jan 21 09:36:41 2010 --- gcc-4.4.4/gcc/fortran/ChangeLog Thu Apr 29 07:49:35 2010 *************** *** 1,3 **** --- 1,112 ---- + 2010-04-29 Release Manager + + * GCC 4.4.4 released. + + 2010-04-21 Jakub Jelinek + + PR fortran/43836 + * f95-lang.c (gfc_define_builtin): Set TREE_NOTHROW on + the decl. + + 2010-04-20 Harald Anlauf + + * intrinsic.c (sort_actual): Remove 'is' in error message. + + 2010-04-20 Jakub Jelinek + + PR fortran/43339 + * openmp.c (gfc_resolve_do_iterator): Only make iteration vars for + sequential loops private in the innermost containing task region. + + 2010-04-07 Janne Blomqvist + + PR fortran/43539 + * gfortran.texi: Add section about representation of + LOGICAL variables. + + 2010-03-30 Jerry DeLisle + + PR fortran/43409 + Back port from trunk. + * ioparm.def: Change inquire size variable to type pointer to + GFC_IO_INT type. + + 2010-03-11 Tobias Burnus result. + + 2010-02-16 Paul Thomas + + PR fortran/41869 + * module.c (fix_mio_expr): Fix for private generic procedures. + + 2010-02-11 Jakub Jelinek + + PR fortran/43030 + * resolve.c (gfc_resolve_dim_arg): Call gfc_clear_ts. + + PR fortran/43029 + * decl.c (enumerator_decl): Don't call gfc_free_enum_history + here. + (gfc_match_enumerator_def): But here whenever enumerator_decl returns + MATCH_ERROR. + + 2010-02-10 Jakub Jelinek + + PR fortran/42309 + * trans-expr.c (gfc_conv_subref_array_arg): Avoid accessing + info->dimen after info has been freed. + + 2010-02-06 Paul Thomas + + PR fortran/42309 + * trans-expr.c (gfc_conv_subref_array_arg): Add new argument + 'formal_ptr'. If this is true, give returned descriptor unity + lbounds, in all dimensions, and the appropriate offset. + (gfc_conv_procedure_call); If formal is a pointer, set the last + argument of gfc_conv_subref_array_arg to true. + * trans.h : Add last argument for gfc_conv_subref_array_arg. + * trans-io.c (set_internal_unit, gfc_trans_transfer): Set the + new arg of gfc_conv_subref_array_arg to false. + * trans-stmt.c (forall_make_variable_temp): The same. + + 2010-02-02 Tobias Burnus + + PR fortran/42650 + * parse.c (decode_specification_statement): Use sym->result not sym. + + 2010-01-31 Paul Thomas + + PR fortran/38324 + * expr.c (gfc_get_full_arrayspec_from_expr): New function. + * gfortran.h : Add prototype for above. + * trans-expr.c (gfc_trans_alloc_subarray_assign): New function. + (gfc_trans_subcomponent_assign): Call new function to replace + the code to deal with allocatable components. + * trans-intrinsic.c (gfc_conv_intrinsic_bound): Call + gfc_get_full_arrayspec_from_expr to replace existing code. + + 2010-01-30 Paul Thomas + + PR fortran/41044 + PR fortran/41167 + * expr.c (remove_subobject_ref): If the constructor is NULL use + the expression as the source. + (simplify_const_ref): Change the type of expression if + there are component references. Allow for substring to be at + the end of an arbitrarily long chain of references. If an + element is found that is not in an EXPR_ARRAY, assume that this + is scalar initialization of array. Call remove_subobject_ref in + this case with NULL second argument. + + 2010-01-27 Paul Thomas + + PR fortran/42736 + * trans-stmt.c (gfc_conv_elemental_dependencies): If temporary + is required, turn any trailing array elements after a range + into ranges so that offsets can be calculated. + 2010-01-21 Release Manager * GCC 4.4.3 released. diff -Nrcpad gcc-4.4.3/gcc/fortran/decl.c gcc-4.4.4/gcc/fortran/decl.c *** gcc-4.4.3/gcc/fortran/decl.c Thu Oct 1 16:09:13 2009 --- gcc-4.4.4/gcc/fortran/decl.c Thu Feb 11 19:35:12 2010 *************** *** 1,5 **** /* Declaration statement matcher ! Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. Contributed by Andy Vaught --- 1,5 ---- /* Declaration statement matcher ! Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. Contributed by Andy Vaught *************** enumerator_decl (void) *** 6597,6606 **** if (initializer == NULL || initializer->ts.type != BT_INTEGER) { ! gfc_error("ENUMERATOR %L not initialized with integer expression", ! &var_locus); m = MATCH_ERROR; - gfc_free_enum_history (); goto cleanup; } --- 6597,6605 ---- if (initializer == NULL || initializer->ts.type != BT_INTEGER) { ! gfc_error ("ENUMERATOR %L not initialized with integer expression", ! &var_locus); m = MATCH_ERROR; goto cleanup; } *************** gfc_match_enumerator_def (void) *** 6666,6672 **** { m = enumerator_decl (); if (m == MATCH_ERROR) ! goto cleanup; if (m == MATCH_NO) break; --- 6665,6674 ---- { m = enumerator_decl (); if (m == MATCH_ERROR) ! { ! gfc_free_enum_history (); ! goto cleanup; ! } if (m == MATCH_NO) break; diff -Nrcpad gcc-4.4.3/gcc/fortran/expr.c gcc-4.4.4/gcc/fortran/expr.c *** gcc-4.4.3/gcc/fortran/expr.c Fri Feb 20 15:20:38 2009 --- gcc-4.4.4/gcc/fortran/expr.c Sun Jan 31 14:57:13 2010 *************** remove_subobject_ref (gfc_expr *p, gfc_c *** 1123,1130 **** { gfc_expr *e; ! e = cons->expr; ! cons->expr = NULL; e->ref = p->ref->next; p->ref->next = NULL; gfc_replace_expr (p, e); --- 1123,1135 ---- { gfc_expr *e; ! if (cons) ! { ! e = cons->expr; ! cons->expr = NULL; ! } ! else ! e = gfc_copy_expr (p); e->ref = p->ref->next; p->ref->next = NULL; gfc_replace_expr (p, e); *************** simplify_const_ref (gfc_expr *p) *** 1428,1433 **** --- 1433,1439 ---- { gfc_constructor *cons; gfc_expr *newp; + gfc_ref *last_ref; while (p->ref) { *************** simplify_const_ref (gfc_expr *p) *** 1437,1442 **** --- 1443,1455 ---- switch (p->ref->u.ar.type) { case AR_ELEMENT: + /* , parameter :: x() = scalar_expr + will generate this. */ + if (p->expr_type != EXPR_ARRAY) + { + remove_subobject_ref (p, NULL); + break; + } if (find_array_element (p->value.constructor, &p->ref->u.ar, &cons) == FAILURE) return FAILURE; *************** simplify_const_ref (gfc_expr *p) *** 1466,1483 **** return FAILURE; } ! /* If this is a CHARACTER array and we possibly took a ! substring out of it, update the type-spec's character ! length according to the first element (as all should have ! the same length). */ ! if (p->ts.type == BT_CHARACTER) { ! int string_len; ! gcc_assert (p->ref->next); ! gcc_assert (!p->ref->next->next); ! gcc_assert (p->ref->next->type == REF_SUBSTRING); if (p->value.constructor) { const gfc_expr* first = p->value.constructor->expr; --- 1479,1503 ---- return FAILURE; } ! if (p->ts.type == BT_DERIVED ! && p->ref->next ! && p->value.constructor) { ! /* There may have been component references. */ ! p->ts = p->value.constructor->expr->ts; ! } ! last_ref = p->ref; ! for (; last_ref->next; last_ref = last_ref->next) {}; + if (p->ts.type == BT_CHARACTER + && last_ref->type == REF_SUBSTRING) + { + /* If this is a CHARACTER array and we possibly took + a substring out of it, update the type-spec's + character length according to the first element + (as all should have the same length). */ + int string_len; if (p->value.constructor) { const gfc_expr* first = p->value.constructor->expr; *************** gfc_get_variable_expr (gfc_symtree *var) *** 3327,3332 **** --- 3347,3404 ---- } + /* Returns the array_spec of a full array expression. A NULL is + returned otherwise. */ + gfc_array_spec * + gfc_get_full_arrayspec_from_expr (gfc_expr *expr) + { + gfc_array_spec *as; + gfc_ref *ref; + + if (expr->rank == 0) + return NULL; + + /* Follow any component references. */ + if (expr->expr_type == EXPR_VARIABLE + || expr->expr_type == EXPR_CONSTANT) + { + as = expr->symtree->n.sym->as; + for (ref = expr->ref; ref; ref = ref->next) + { + switch (ref->type) + { + case REF_COMPONENT: + as = ref->u.c.component->as; + continue; + + case REF_SUBSTRING: + continue; + + case REF_ARRAY: + { + switch (ref->u.ar.type) + { + case AR_ELEMENT: + case AR_SECTION: + case AR_UNKNOWN: + as = NULL; + continue; + + case AR_FULL: + break; + } + break; + } + } + } + } + else + as = NULL; + + return as; + } + + /* General expression traversal function. */ bool diff -Nrcpad gcc-4.4.3/gcc/fortran/f95-lang.c gcc-4.4.4/gcc/fortran/f95-lang.c *** gcc-4.4.3/gcc/fortran/f95-lang.c Wed Apr 22 11:37:04 2009 --- gcc-4.4.4/gcc/fortran/f95-lang.c Wed Apr 21 21:26:11 2010 *************** *** 1,5 **** /* gfortran backend interface ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. Contributed by Paul Brook. --- 1,5 ---- /* gfortran backend interface ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2010 Free Software Foundation, Inc. Contributed by Paul Brook. *************** gfc_define_builtin (const char *name, *** 687,692 **** --- 687,693 ---- library_name, NULL_TREE); if (const_p) TREE_READONLY (decl) = 1; + TREE_NOTHROW (decl) = 1; built_in_decls[code] = decl; implicit_built_in_decls[code] = decl; diff -Nrcpad gcc-4.4.3/gcc/fortran/gfortran.h gcc-4.4.4/gcc/fortran/gfortran.h *** gcc-4.4.3/gcc/fortran/gfortran.h Sat Feb 21 22:25:06 2009 --- gcc-4.4.4/gcc/fortran/gfortran.h Sun Jan 31 14:57:13 2010 *************** gfc_try gfc_check_assign_symbol (gfc_sym *** 2450,2455 **** --- 2450,2457 ---- gfc_expr *gfc_default_initializer (gfc_typespec *); gfc_expr *gfc_get_variable_expr (gfc_symtree *); + gfc_array_spec *gfc_get_full_arrayspec_from_expr (gfc_expr *expr); + bool gfc_traverse_expr (gfc_expr *, gfc_symbol *, bool (*)(gfc_expr *, gfc_symbol *, int*), int); diff -Nrcpad gcc-4.4.3/gcc/fortran/gfortran.info gcc-4.4.4/gcc/fortran/gfortran.info *** gcc-4.4.3/gcc/fortran/gfortran.info Thu Jan 21 11:33:05 2010 --- gcc-4.4.4/gcc/fortran/gfortran.info Thu Apr 29 09:36:17 2010 *************** *** 1,5 **** This is doc/gfortran.info, produced by makeinfo version 4.13 from ! /d/gcc-4.4.3/gcc-4.4.3/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.4/gcc-4.4.4/gcc/fortran/gfortran.texi. Copyright (C) 1999-2008 Free Software Foundation, Inc. *************** Part I: Invoking GNU Fortran *** 71,77 **** Part II: Language Reference * Fortran 2003 and 2008 status:: Fortran 2003 and 2008 features supported by GNU Fortran. ! * Compiler Characteristics:: KIND type parameters supported. * Extensions:: Language extensions implemented by GNU Fortran. * Intrinsic Procedures:: Intrinsic procedures supported by GNU Fortran. * Intrinsic Modules:: Intrinsic modules supported by GNU Fortran. --- 71,77 ---- Part II: Language Reference * Fortran 2003 and 2008 status:: Fortran 2003 and 2008 features supported by GNU Fortran. ! * Compiler Characteristics:: User-visible implementation details. * Extensions:: Language extensions implemented by GNU Fortran. * Intrinsic Procedures:: Intrinsic procedures supported by GNU Fortran. * Intrinsic Modules:: Intrinsic modules supported by GNU Fortran. *************** File: gfortran.info, Node: Compiler Cha *** 1753,1766 **** ************************** This chapter describes certain characteristics of the GNU Fortran ! compiler, namely the KIND type parameter values supported. * Menu: * KIND Type Parameters::  ! File: gfortran.info, Node: KIND Type Parameters, Up: Compiler Characteristics 5.1 KIND Type Parameters ======================== --- 1753,1768 ---- ************************** This chapter describes certain characteristics of the GNU Fortran ! compiler, that are not specified by the Fortran standard, but which ! might in some way or another become visible to the programmer. * Menu: * KIND Type Parameters:: + * Internal representation of LOGICAL variables::  ! File: gfortran.info, Node: KIND Type Parameters, Next: Internal representation of LOGICAL variables, Up: Compiler Characteristics 5.1 KIND Type Parameters ======================== *************** imaginary part are a real value of the g *** 1796,1801 **** --- 1798,1829 ---- to use the `SELECT_*_KIND' intrinsics instead of the concrete values.  + File: gfortran.info, Node: Internal representation of LOGICAL variables, Prev: KIND Type Parameters, Up: Compiler Characteristics + + 5.2 Internal representation of LOGICAL variables + ================================================ + + The Fortran standard does not specify how variables of `LOGICAL' type + are represented, beyond requiring that `LOGICAL' variables of default + kind have the same storage size as default `INTEGER' and `REAL' + variables. The GNU Fortran internal representation is as follows. + + A `LOGICAL(KIND=N)' variable is represented as an `INTEGER(KIND=N)' + variable, however, with only two permissible values: `1' for `.TRUE.' + and `0' for `.FALSE.'. Any other integer value results in undefined + behavior. + + Note that for mixed-language programming using the `ISO_C_BINDING' + feature, there is a `C_BOOL' kind that can be used to create + `LOGICAL(KIND=C_BOOL)' variables which are interoperable with the C99 + _Bool type. The C99 _Bool type has an internal representation + described in the C99 standard, which is identical to the above + description, i.e. with 1 for true and 0 for false being the only + permissible values. Thus the internal representation of `LOGICAL' + variables in GNU Fortran is identical to C99 _Bool, except for a + possible difference in storage size depending on the kind. + +  File: gfortran.info, Node: Extensions, Next: Intrinsic Procedures, Prev: Compiler Characteristics, Up: Top 6 Extensions *************** Keyword Index *** 14347,14352 **** --- 14375,14382 ---- * logical not, bitwise: NOT. (line 6) * logical or, bitwise <1>: OR. (line 6) * logical or, bitwise: IOR. (line 6) + * logical, variable representation: Internal representation of LOGICAL variables. + (line 6) * login name: GETLOG. (line 6) * LONG: LONG. (line 6) * LSHIFT: LSHIFT. (line 6) *************** Keyword Index *** 14740,15040 ****  Tag Table: Node: Top1990 ! Node: Introduction3305 ! Node: About GNU Fortran4052 ! Node: GNU Fortran and GCC8080 ! Node: Preprocessing and conditional compilation10192 ! Node: GNU Fortran and G7711833 ! Node: Project Status12406 ! Node: Standards14921 ! Node: Invoking GNU Fortran16132 ! Node: Option Summary17855 ! Node: Fortran Dialect Options21343 ! Node: Preprocessing Options28153 ! Node: Error and Warning Options36279 ! Node: Debugging Options43706 ! Node: Directory Options45869 ! Node: Link Options47384 ! Node: Runtime Options48008 ! Node: Code Gen Options50088 ! Node: Environment Variables62313 ! Node: Runtime62918 ! Node: GFORTRAN_STDIN_UNIT64146 ! Node: GFORTRAN_STDOUT_UNIT64513 ! Node: GFORTRAN_STDERR_UNIT64914 ! Node: GFORTRAN_USE_STDERR65312 ! Node: GFORTRAN_TMPDIR65757 ! Node: GFORTRAN_UNBUFFERED_ALL66198 ! Node: GFORTRAN_UNBUFFERED_PRECONNECTED66721 ! Node: GFORTRAN_SHOW_LOCUS67363 ! Node: GFORTRAN_OPTIONAL_PLUS67857 ! Node: GFORTRAN_DEFAULT_RECL68332 ! Node: GFORTRAN_LIST_SEPARATOR68823 ! Node: GFORTRAN_CONVERT_UNIT69432 ! Node: GFORTRAN_ERROR_DUMPCORE72294 ! Node: GFORTRAN_ERROR_BACKTRACE72841 ! Node: Fortran 2003 and 2008 status73392 ! Node: Fortran 2003 status73632 ! Node: Fortran 2008 status75323 ! Node: Compiler Characteristics76292 ! Node: KIND Type Parameters76630 ! Node: Extensions77557 ! Node: Extensions implemented in GNU Fortran78156 ! Node: Old-style kind specifications79490 ! Node: Old-style variable initialization80596 ! Node: Extensions to namelist81908 ! Node: X format descriptor without count field83904 ! Node: Commas in FORMAT specifications84431 ! Node: Missing period in FORMAT specifications84948 ! Node: I/O item lists85510 ! Node: BOZ literal constants85899 ! Node: Real array indices88468 ! Node: Unary operators88765 ! Node: Implicitly convert LOGICAL and INTEGER values89179 ! Node: Hollerith constants support90139 ! Node: Cray pointers91911 ! Node: CONVERT specifier97321 ! Node: OpenMP99319 ! Node: Argument list functions101574 ! Node: Extensions not implemented in GNU Fortran103168 ! Node: STRUCTURE and RECORD104020 ! Node: ENCODE and DECODE statements106076 ! Node: Intrinsic Procedures107394 ! Node: Introduction to Intrinsics121084 ! Node: ABORT123436 ! Node: ABS124193 ! Node: ACCESS125695 ! Node: ACHAR127616 ! Node: ACOS128817 ! Node: ACOSH129815 ! Node: ADJUSTL130692 ! Node: ADJUSTR131633 ! Node: AIMAG132580 ! Node: AINT133900 ! Node: ALARM135372 ! Node: ALL137006 ! Node: ALLOCATED138924 ! Node: AND139805 ! Node: ANINT141102 ! Node: ANY142465 ! Node: ASIN144395 ! Node: ASINH145407 ! Node: ASSOCIATED146289 ! Node: ATAN149294 ! Node: ATAN2150183 ! Node: ATANH151527 ! Node: BESSEL_J0152407 ! Node: BESSEL_J1153451 ! Node: BESSEL_JN154503 ! Node: BESSEL_Y0155670 ! Node: BESSEL_Y1156670 ! Node: BESSEL_YN157670 ! Node: BIT_SIZE158887 ! Node: BTEST159716 ! Node: C_ASSOCIATED160604 ! Node: C_FUNLOC161813 ! Node: C_F_PROCPOINTER163182 ! Node: C_F_POINTER164811 ! Node: C_LOC166229 ! Node: C_SIZEOF167346 ! Node: CEILING168699 ! Node: CHAR169704 ! Node: CHDIR170768 ! Node: CHMOD171936 ! Node: CMPLX173731 ! Node: COMMAND_ARGUMENT_COUNT175195 ! Node: COMPLEX176102 ! Node: CONJG177245 ! Node: COS178255 ! Node: COSH179526 ! Node: COUNT180495 ! Node: CPU_TIME182351 ! Node: CSHIFT183705 ! Node: CTIME185361 ! Node: DATE_AND_TIME186620 ! Node: DBLE189081 ! Node: DCMPLX189905 ! Node: DFLOAT191099 ! Node: DIGITS191793 ! Node: DIM192759 ! Node: DOT_PRODUCT193902 ! Node: DPROD195558 ! Node: DREAL196284 ! Node: DTIME196948 ! Node: EOSHIFT199754 ! Node: EPSILON201827 ! Node: ERF202553 ! Node: ERFC203327 ! Node: ERFC_SCALED204131 ! Node: ETIME204823 ! Node: EXIT207054 ! Node: EXP207913 ! Node: EXPONENT209071 ! Node: FDATE209821 ! Node: FLOAT211096 ! Node: FGET211810 ! Node: FGETC213604 ! Node: FLOOR215372 ! Node: FLUSH216356 ! Node: FNUM216994 ! Node: FPUT217716 ! Node: FPUTC219317 ! Node: FRACTION221057 ! Node: FREE221958 ! Node: FSEEK222795 ! Node: FSTAT225089 ! Node: FTELL226129 ! Node: GAMMA227107 ! Node: GERROR228148 ! Node: GETARG228867 ! Node: GET_COMMAND230631 ! Node: GET_COMMAND_ARGUMENT231577 ! Node: GETCWD233545 ! Node: GETENV234491 ! Node: GET_ENVIRONMENT_VARIABLE235713 ! Node: GETGID237413 ! Node: GETLOG237948 ! Node: GETPID238806 ! Node: GETUID239534 ! Node: GMTIME240048 ! Node: HOSTNM241537 ! Node: HUGE242453 ! Node: HYPOT243172 ! Node: IACHAR243992 ! Node: IAND245172 ! Node: IARGC246159 ! Node: IBCLR247182 ! Node: IBITS247843 ! Node: IBSET248758 ! Node: ICHAR249414 ! Node: IDATE251395 ! Node: IEOR252422 ! Node: IERRNO253298 ! Node: INDEX intrinsic253853 ! Node: INT255199 ! Node: INT2256786 ! Node: INT8257551 ! Node: IOR258263 ! Node: IRAND259113 ! Node: IS_IOSTAT_END260465 ! Node: IS_IOSTAT_EOR261560 ! Node: ISATTY262685 ! Node: ISHFT263468 ! Node: ISHFTC264448 ! Node: ISNAN265664 ! Node: ITIME266412 ! Node: KILL267437 ! Node: KIND268310 ! Node: LBOUND269155 ! Node: LEADZ270467 ! Node: LEN271271 ! Node: LEN_TRIM272362 ! Node: LGE273350 ! Node: LGT274663 ! Node: LINK275940 ! Node: LLE276975 ! Node: LLT278279 ! Node: LNBLNK279549 ! Node: LOC280325 ! Node: LOG281056 ! Node: LOG10282347 ! Node: LOG_GAMMA283319 ! Node: LOGICAL284407 ! Node: LONG285211 ! Node: LSHIFT285967 ! Node: LSTAT286921 ! Node: LTIME288075 ! Node: MALLOC289490 ! Node: MATMUL290950 ! Node: MAX292040 ! Node: MAXEXPONENT293539 ! Node: MAXLOC294355 ! Node: MAXVAL296404 ! Node: MCLOCK298067 ! Node: MCLOCK8299070 ! Node: MERGE300284 ! Node: MIN301026 ! Node: MINEXPONENT302522 ! Node: MINLOC303152 ! Node: MINVAL305201 ! Node: MOD306883 ! Node: MODULO308375 ! Node: MOVE_ALLOC309589 ! Node: MVBITS310613 ! Node: NEAREST311672 ! Node: NEW_LINE312795 ! Node: NINT313566 ! Node: NOT314834 ! Node: NULL315417 ! Node: OR316315 ! Node: PACK317593 ! Node: PERROR319585 ! Node: PRECISION320207 ! Node: PRESENT321033 ! Node: PRODUCT322139 ! Node: RADIX323664 ! Node: RAN324441 ! Node: RAND324897 ! Node: RANDOM_NUMBER326232 ! Node: RANDOM_SEED327950 ! Node: RANGE329833 ! Node: REAL330457 ! Node: RENAME331899 ! Node: REPEAT332918 ! Node: RESHAPE333644 ! Node: RRSPACING335113 ! Node: RSHIFT335806 ! Node: SCALE336768 ! Node: SCAN337542 ! Node: SECNDS339092 ! Node: SECOND340180 ! Node: SELECTED_CHAR_KIND341056 ! Node: SELECTED_INT_KIND342053 ! Node: SELECTED_REAL_KIND343228 ! Node: SET_EXPONENT345167 ! Node: SHAPE346163 ! Node: SIGN347276 ! Node: SIGNAL348359 ! Node: SIN349856 ! Node: SINH350898 ! Node: SIZE351710 ! Node: SIZEOF353018 ! Node: SLEEP354312 ! Node: SNGL354869 ! Node: SPACING355540 ! Node: SPREAD356552 ! Node: SQRT357697 ! Node: SRAND358936 ! Node: STAT360104 ! Node: SUM363216 ! Node: SYMLNK364685 ! Node: SYSTEM365817 ! Node: SYSTEM_CLOCK366765 ! Node: TAN368109 ! Node: TANH368945 ! Node: TIME369812 ! Node: TIME8370916 ! Node: TINY372053 ! Node: TRAILZ372653 ! Node: TRANSFER373438 ! Node: TRANSPOSE375472 ! Node: TRIM376159 ! Node: TTYNAM377016 ! Node: UBOUND377931 ! Node: UMASK379300 ! Node: UNLINK379855 ! Node: UNPACK380832 ! Node: VERIFY382120 ! Node: XOR383836 ! Node: Intrinsic Modules385144 ! Node: Contributing390935 ! Node: Contributors391787 ! Node: Projects393410 ! Node: Proposed Extensions394213 ! Node: Copying396264 ! Node: GNU Free Documentation License433828 ! Node: Funding456240 ! Node: Option Index458765 ! Node: Keyword Index470647  End Tag Table --- 14770,15071 ----  Tag Table: Node: Top1990 ! Node: Introduction3310 ! Node: About GNU Fortran4057 ! Node: GNU Fortran and GCC8085 ! Node: Preprocessing and conditional compilation10197 ! Node: GNU Fortran and G7711838 ! Node: Project Status12411 ! Node: Standards14926 ! Node: Invoking GNU Fortran16137 ! Node: Option Summary17860 ! Node: Fortran Dialect Options21348 ! Node: Preprocessing Options28158 ! Node: Error and Warning Options36284 ! Node: Debugging Options43711 ! Node: Directory Options45874 ! Node: Link Options47389 ! Node: Runtime Options48013 ! Node: Code Gen Options50093 ! Node: Environment Variables62318 ! Node: Runtime62923 ! Node: GFORTRAN_STDIN_UNIT64151 ! Node: GFORTRAN_STDOUT_UNIT64518 ! Node: GFORTRAN_STDERR_UNIT64919 ! Node: GFORTRAN_USE_STDERR65317 ! Node: GFORTRAN_TMPDIR65762 ! Node: GFORTRAN_UNBUFFERED_ALL66203 ! Node: GFORTRAN_UNBUFFERED_PRECONNECTED66726 ! Node: GFORTRAN_SHOW_LOCUS67368 ! Node: GFORTRAN_OPTIONAL_PLUS67862 ! Node: GFORTRAN_DEFAULT_RECL68337 ! Node: GFORTRAN_LIST_SEPARATOR68828 ! Node: GFORTRAN_CONVERT_UNIT69437 ! Node: GFORTRAN_ERROR_DUMPCORE72299 ! Node: GFORTRAN_ERROR_BACKTRACE72846 ! Node: Fortran 2003 and 2008 status73397 ! Node: Fortran 2003 status73637 ! Node: Fortran 2008 status75328 ! Node: Compiler Characteristics76297 ! Node: KIND Type Parameters76756 ! Node: Internal representation of LOGICAL variables77736 ! Node: Extensions79047 ! Node: Extensions implemented in GNU Fortran79646 ! Node: Old-style kind specifications80980 ! Node: Old-style variable initialization82086 ! Node: Extensions to namelist83398 ! Node: X format descriptor without count field85394 ! Node: Commas in FORMAT specifications85921 ! Node: Missing period in FORMAT specifications86438 ! Node: I/O item lists87000 ! Node: BOZ literal constants87389 ! Node: Real array indices89958 ! Node: Unary operators90255 ! Node: Implicitly convert LOGICAL and INTEGER values90669 ! Node: Hollerith constants support91629 ! Node: Cray pointers93401 ! Node: CONVERT specifier98811 ! Node: OpenMP100809 ! Node: Argument list functions103064 ! Node: Extensions not implemented in GNU Fortran104658 ! Node: STRUCTURE and RECORD105510 ! Node: ENCODE and DECODE statements107566 ! Node: Intrinsic Procedures108884 ! Node: Introduction to Intrinsics122574 ! Node: ABORT124926 ! Node: ABS125683 ! Node: ACCESS127185 ! Node: ACHAR129106 ! Node: ACOS130307 ! Node: ACOSH131305 ! Node: ADJUSTL132182 ! Node: ADJUSTR133123 ! Node: AIMAG134070 ! Node: AINT135390 ! Node: ALARM136862 ! Node: ALL138496 ! Node: ALLOCATED140414 ! Node: AND141295 ! Node: ANINT142592 ! Node: ANY143955 ! Node: ASIN145885 ! Node: ASINH146897 ! Node: ASSOCIATED147779 ! Node: ATAN150784 ! Node: ATAN2151673 ! Node: ATANH153017 ! Node: BESSEL_J0153897 ! Node: BESSEL_J1154941 ! Node: BESSEL_JN155993 ! Node: BESSEL_Y0157160 ! Node: BESSEL_Y1158160 ! Node: BESSEL_YN159160 ! Node: BIT_SIZE160377 ! Node: BTEST161206 ! Node: C_ASSOCIATED162094 ! Node: C_FUNLOC163303 ! Node: C_F_PROCPOINTER164672 ! Node: C_F_POINTER166301 ! Node: C_LOC167719 ! Node: C_SIZEOF168836 ! Node: CEILING170189 ! Node: CHAR171194 ! Node: CHDIR172258 ! Node: CHMOD173426 ! Node: CMPLX175221 ! Node: COMMAND_ARGUMENT_COUNT176685 ! Node: COMPLEX177592 ! Node: CONJG178735 ! Node: COS179745 ! Node: COSH181016 ! Node: COUNT181985 ! Node: CPU_TIME183841 ! Node: CSHIFT185195 ! Node: CTIME186851 ! Node: DATE_AND_TIME188110 ! Node: DBLE190571 ! Node: DCMPLX191395 ! Node: DFLOAT192589 ! Node: DIGITS193283 ! Node: DIM194249 ! Node: DOT_PRODUCT195392 ! Node: DPROD197048 ! Node: DREAL197774 ! Node: DTIME198438 ! Node: EOSHIFT201244 ! Node: EPSILON203317 ! Node: ERF204043 ! Node: ERFC204817 ! Node: ERFC_SCALED205621 ! Node: ETIME206313 ! Node: EXIT208544 ! Node: EXP209403 ! Node: EXPONENT210561 ! Node: FDATE211311 ! Node: FLOAT212586 ! Node: FGET213300 ! Node: FGETC215094 ! Node: FLOOR216862 ! Node: FLUSH217846 ! Node: FNUM218484 ! Node: FPUT219206 ! Node: FPUTC220807 ! Node: FRACTION222547 ! Node: FREE223448 ! Node: FSEEK224285 ! Node: FSTAT226579 ! Node: FTELL227619 ! Node: GAMMA228597 ! Node: GERROR229638 ! Node: GETARG230357 ! Node: GET_COMMAND232121 ! Node: GET_COMMAND_ARGUMENT233067 ! Node: GETCWD235035 ! Node: GETENV235981 ! Node: GET_ENVIRONMENT_VARIABLE237203 ! Node: GETGID238903 ! Node: GETLOG239438 ! Node: GETPID240296 ! Node: GETUID241024 ! Node: GMTIME241538 ! Node: HOSTNM243027 ! Node: HUGE243943 ! Node: HYPOT244662 ! Node: IACHAR245482 ! Node: IAND246662 ! Node: IARGC247649 ! Node: IBCLR248672 ! Node: IBITS249333 ! Node: IBSET250248 ! Node: ICHAR250904 ! Node: IDATE252885 ! Node: IEOR253912 ! Node: IERRNO254788 ! Node: INDEX intrinsic255343 ! Node: INT256689 ! Node: INT2258276 ! Node: INT8259041 ! Node: IOR259753 ! Node: IRAND260603 ! Node: IS_IOSTAT_END261955 ! Node: IS_IOSTAT_EOR263050 ! Node: ISATTY264175 ! Node: ISHFT264958 ! Node: ISHFTC265938 ! Node: ISNAN267154 ! Node: ITIME267902 ! Node: KILL268927 ! Node: KIND269800 ! Node: LBOUND270645 ! Node: LEADZ271957 ! Node: LEN272761 ! Node: LEN_TRIM273852 ! Node: LGE274840 ! Node: LGT276153 ! Node: LINK277430 ! Node: LLE278465 ! Node: LLT279769 ! Node: LNBLNK281039 ! Node: LOC281815 ! Node: LOG282546 ! Node: LOG10283837 ! Node: LOG_GAMMA284809 ! Node: LOGICAL285897 ! Node: LONG286701 ! Node: LSHIFT287457 ! Node: LSTAT288411 ! Node: LTIME289565 ! Node: MALLOC290980 ! Node: MATMUL292440 ! Node: MAX293530 ! Node: MAXEXPONENT295029 ! Node: MAXLOC295845 ! Node: MAXVAL297894 ! Node: MCLOCK299557 ! Node: MCLOCK8300560 ! Node: MERGE301774 ! Node: MIN302516 ! Node: MINEXPONENT304012 ! Node: MINLOC304642 ! Node: MINVAL306691 ! Node: MOD308373 ! Node: MODULO309865 ! Node: MOVE_ALLOC311079 ! Node: MVBITS312103 ! Node: NEAREST313162 ! Node: NEW_LINE314285 ! Node: NINT315056 ! Node: NOT316324 ! Node: NULL316907 ! Node: OR317805 ! Node: PACK319083 ! Node: PERROR321075 ! Node: PRECISION321697 ! Node: PRESENT322523 ! Node: PRODUCT323629 ! Node: RADIX325154 ! Node: RAN325931 ! Node: RAND326387 ! Node: RANDOM_NUMBER327722 ! Node: RANDOM_SEED329440 ! Node: RANGE331323 ! Node: REAL331947 ! Node: RENAME333389 ! Node: REPEAT334408 ! Node: RESHAPE335134 ! Node: RRSPACING336603 ! Node: RSHIFT337296 ! Node: SCALE338258 ! Node: SCAN339032 ! Node: SECNDS340582 ! Node: SECOND341670 ! Node: SELECTED_CHAR_KIND342546 ! Node: SELECTED_INT_KIND343543 ! Node: SELECTED_REAL_KIND344718 ! Node: SET_EXPONENT346657 ! Node: SHAPE347653 ! Node: SIGN348766 ! Node: SIGNAL349849 ! Node: SIN351346 ! Node: SINH352388 ! Node: SIZE353200 ! Node: SIZEOF354508 ! Node: SLEEP355802 ! Node: SNGL356359 ! Node: SPACING357030 ! Node: SPREAD358042 ! Node: SQRT359187 ! Node: SRAND360426 ! Node: STAT361594 ! Node: SUM364706 ! Node: SYMLNK366175 ! Node: SYSTEM367307 ! Node: SYSTEM_CLOCK368255 ! Node: TAN369599 ! Node: TANH370435 ! Node: TIME371302 ! Node: TIME8372406 ! Node: TINY373543 ! Node: TRAILZ374143 ! Node: TRANSFER374928 ! Node: TRANSPOSE376962 ! Node: TRIM377649 ! Node: TTYNAM378506 ! Node: UBOUND379421 ! Node: UMASK380790 ! Node: UNLINK381345 ! Node: UNPACK382322 ! Node: VERIFY383610 ! Node: XOR385326 ! Node: Intrinsic Modules386634 ! Node: Contributing392425 ! Node: Contributors393277 ! Node: Projects394900 ! Node: Proposed Extensions395703 ! Node: Copying397754 ! Node: GNU Free Documentation License435318 ! Node: Funding457730 ! Node: Option Index460255 ! Node: Keyword Index472137  End Tag Table diff -Nrcpad gcc-4.4.3/gcc/fortran/gfortran.texi gcc-4.4.4/gcc/fortran/gfortran.texi *** gcc-4.4.3/gcc/fortran/gfortran.texi Wed Feb 18 18:54:41 2009 --- gcc-4.4.4/gcc/fortran/gfortran.texi Wed Apr 7 18:07:48 2010 *************** Part I: Invoking GNU Fortran *** 181,187 **** Part II: Language Reference * Fortran 2003 and 2008 status:: Fortran 2003 and 2008 features supported by GNU Fortran. ! * Compiler Characteristics:: KIND type parameters supported. * Extensions:: Language extensions implemented by GNU Fortran. * Intrinsic Procedures:: Intrinsic procedures supported by GNU Fortran. * Intrinsic Modules:: Intrinsic modules supported by GNU Fortran. --- 181,187 ---- Part II: Language Reference * Fortran 2003 and 2008 status:: Fortran 2003 and 2008 features supported by GNU Fortran. ! * Compiler Characteristics:: User-visible implementation details. * Extensions:: Language extensions implemented by GNU Fortran. * Intrinsic Procedures:: Intrinsic procedures supported by GNU Fortran. * Intrinsic Modules:: Intrinsic modules supported by GNU Fortran. *************** made and you should only use it for expe *** 914,927 **** @node Compiler Characteristics @chapter Compiler Characteristics ! @c TODO: Formulate this introduction a little more generally once ! @c there is more here than KIND type parameters. ! ! This chapter describes certain characteristics of the GNU Fortran compiler, ! namely the KIND type parameter values supported. @menu * KIND Type Parameters:: @end menu --- 914,926 ---- @node Compiler Characteristics @chapter Compiler Characteristics ! This chapter describes certain characteristics of the GNU Fortran ! compiler, that are not specified by the Fortran standard, but which ! might in some way or another become visible to the programmer. @menu * KIND Type Parameters:: + * Internal representation of LOGICAL variables:: @end menu *************** imaginary part are a real value of the g *** 965,970 **** --- 964,996 ---- the @code{SELECT_*_KIND} intrinsics instead of the concrete values. + @node Internal representation of LOGICAL variables + @section Internal representation of LOGICAL variables + @cindex logical, variable representation + + The Fortran standard does not specify how variables of @code{LOGICAL} + type are represented, beyond requiring that @code{LOGICAL} variables + of default kind have the same storage size as default @code{INTEGER} + and @code{REAL} variables. The GNU Fortran internal representation is + as follows. + + A @code{LOGICAL(KIND=N)} variable is represented as an + @code{INTEGER(KIND=N)} variable, however, with only two permissible + values: @code{1} for @code{.TRUE.} and @code{0} for + @code{.FALSE.}. Any other integer value results in undefined behavior. + + Note that for mixed-language programming using the + @code{ISO_C_BINDING} feature, there is a @code{C_BOOL} kind that can + be used to create @code{LOGICAL(KIND=C_BOOL)} variables which are + interoperable with the C99 _Bool type. The C99 _Bool type has an + internal representation described in the C99 standard, which is + identical to the above description, i.e. with 1 for true and 0 for + false being the only permissible values. Thus the internal + representation of @code{LOGICAL} variables in GNU Fortran is identical + to C99 _Bool, except for a possible difference in storage size + depending on the kind. + + @c --------------------------------------------------------------------- @c Extensions @c --------------------------------------------------------------------- diff -Nrcpad gcc-4.4.3/gcc/fortran/intrinsic.c gcc-4.4.4/gcc/fortran/intrinsic.c *** gcc-4.4.3/gcc/fortran/intrinsic.c Fri Sep 11 22:11:06 2009 --- gcc-4.4.4/gcc/fortran/intrinsic.c Tue Apr 20 21:29:39 2010 *************** keywords: *** 3105,3111 **** if (f->actual != NULL) { ! gfc_error ("Argument '%s' is appears twice in call to '%s' at %L", f->name, name, where); return FAILURE; } --- 3105,3111 ---- if (f->actual != NULL) { ! gfc_error ("Argument '%s' appears twice in call to '%s' at %L", f->name, name, where); return FAILURE; } diff -Nrcpad gcc-4.4.3/gcc/fortran/ioparm.def gcc-4.4.4/gcc/fortran/ioparm.def *** gcc-4.4.3/gcc/fortran/ioparm.def Sat Nov 22 08:10:41 2008 --- gcc-4.4.4/gcc/fortran/ioparm.def Wed Mar 31 01:59:52 2010 *************** IOPARM (inquire, encoding, 1 << 2, char *** 66,72 **** IOPARM (inquire, round, 1 << 3, char2) IOPARM (inquire, sign, 1 << 4, char1) IOPARM (inquire, pending, 1 << 5, pint4) ! IOPARM (inquire, size, 1 << 6, pint4) IOPARM (inquire, id, 1 << 7, pint4) IOPARM (wait, common, 0, common) IOPARM (wait, id, 1 << 7, pint4) --- 66,72 ---- IOPARM (inquire, round, 1 << 3, char2) IOPARM (inquire, sign, 1 << 4, char1) IOPARM (inquire, pending, 1 << 5, pint4) ! IOPARM (inquire, size, 1 << 6, pintio) IOPARM (inquire, id, 1 << 7, pint4) IOPARM (wait, common, 0, common) IOPARM (wait, id, 1 << 7, pint4) diff -Nrcpad gcc-4.4.3/gcc/fortran/module.c gcc-4.4.4/gcc/fortran/module.c *** gcc-4.4.3/gcc/fortran/module.c Fri May 22 12:54:23 2009 --- gcc-4.4.4/gcc/fortran/module.c Tue Feb 16 10:50:56 2010 *************** fix_mio_expr (gfc_expr *e) *** 2846,2858 **** --- 2846,2874 ---- } else if (e->expr_type == EXPR_FUNCTION && e->value.function.name) { + gfc_symbol *sym; + /* In some circumstances, a function used in an initialization expression, in one use associated module, can fail to be coupled to its symtree when used in a specification expression in another module. */ + fname = e->value.function.esym ? e->value.function.esym->name : e->value.function.isym->name; e->symtree = gfc_find_symtree (gfc_current_ns->sym_root, fname); + + if (e->symtree) + return; + + /* This is probably a reference to a private procedure from another + module. To prevent a segfault, make a generic with no specific + instances. If this module is used, without the required + specific coming from somewhere, the appropriate error message + is issued. */ + gfc_get_symbol (fname, gfc_current_ns, &sym); + sym->attr.flavor = FL_PROCEDURE; + sym->attr.generic = 1; + e->symtree = gfc_find_symtree (gfc_current_ns->sym_root, fname); } } diff -Nrcpad gcc-4.4.3/gcc/fortran/openmp.c gcc-4.4.4/gcc/fortran/openmp.c *** gcc-4.4.3/gcc/fortran/openmp.c Tue Jul 28 16:33:08 2009 --- gcc-4.4.4/gcc/fortran/openmp.c Tue Apr 20 08:41:02 2010 *************** *** 1,5 **** /* OpenMP directive matching and resolving. ! Copyright (C) 2005, 2006, 2007, 2008 Free Software Foundation, Inc. Contributed by Jakub Jelinek --- 1,5 ---- /* OpenMP directive matching and resolving. ! Copyright (C) 2005, 2006, 2007, 2008, 2010 Free Software Foundation, Inc. Contributed by Jakub Jelinek *************** gfc_resolve_omp_parallel_blocks (gfc_cod *** 1367,1373 **** void gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym) { - struct omp_context *ctx; int i = omp_current_do_collapse; gfc_code *c = omp_current_do_code; --- 1367,1372 ---- *************** gfc_resolve_do_iterator (gfc_code *code, *** 1386,1406 **** c = c->block->next; } ! for (ctx = omp_current_ctx; ctx; ctx = ctx->previous) ! { ! if (pointer_set_contains (ctx->sharing_clauses, sym)) ! continue; ! if (! pointer_set_insert (ctx->private_iterators, sym)) ! { ! gfc_omp_clauses *omp_clauses = ctx->code->ext.omp_clauses; ! gfc_namelist *p; ! p = gfc_get_namelist (); ! p->sym = sym; ! p->next = omp_clauses->lists[OMP_LIST_PRIVATE]; ! omp_clauses->lists[OMP_LIST_PRIVATE] = p; ! } } } --- 1385,1405 ---- c = c->block->next; } ! if (omp_current_ctx == NULL) ! return; ! if (pointer_set_contains (omp_current_ctx->sharing_clauses, sym)) ! return; ! if (! pointer_set_insert (omp_current_ctx->private_iterators, sym)) ! { ! gfc_omp_clauses *omp_clauses = omp_current_ctx->code->ext.omp_clauses; ! gfc_namelist *p; ! ! p = gfc_get_namelist (); ! p->sym = sym; ! p->next = omp_clauses->lists[OMP_LIST_PRIVATE]; ! omp_clauses->lists[OMP_LIST_PRIVATE] = p; } } diff -Nrcpad gcc-4.4.3/gcc/fortran/parse.c gcc-4.4.4/gcc/fortran/parse.c *** gcc-4.4.3/gcc/fortran/parse.c Sat Apr 4 13:19:15 2009 --- gcc-4.4.4/gcc/fortran/parse.c Tue Feb 2 14:27:24 2010 *************** decode_specification_statement (void) *** 110,116 **** match ("import", gfc_match_import, ST_IMPORT); match ("use", gfc_match_use, ST_USE); ! if (gfc_current_block ()->ts.type != BT_DERIVED) goto end_of_block; match (NULL, gfc_match_st_function, ST_STATEMENT_FUNCTION); --- 110,116 ---- match ("import", gfc_match_import, ST_IMPORT); match ("use", gfc_match_use, ST_USE); ! if (gfc_current_block ()->result->ts.type != BT_DERIVED) goto end_of_block; match (NULL, gfc_match_st_function, ST_STATEMENT_FUNCTION); diff -Nrcpad gcc-4.4.3/gcc/fortran/resolve.c gcc-4.4.4/gcc/fortran/resolve.c *** gcc-4.4.3/gcc/fortran/resolve.c Thu Nov 26 21:57:32 2009 --- gcc-4.4.4/gcc/fortran/resolve.c Thu Feb 11 19:48:24 2010 *************** *** 1,5 **** /* Perform type resolution on the various structures. ! Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. Contributed by Andy Vaught --- 1,5 ---- /* Perform type resolution on the various structures. ! Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. Contributed by Andy Vaught *************** gfc_resolve_dim_arg (gfc_expr *dim) *** 3722,3727 **** --- 3722,3728 ---- { gfc_typespec ts; + gfc_clear_ts (&ts); ts.type = BT_INTEGER; ts.kind = gfc_index_integer_kind; diff -Nrcpad gcc-4.4.3/gcc/fortran/symbol.c gcc-4.4.4/gcc/fortran/symbol.c *** gcc-4.4.3/gcc/fortran/symbol.c Mon Oct 19 19:18:12 2009 --- gcc-4.4.4/gcc/fortran/symbol.c Thu Mar 11 11:10:37 2010 *************** get_iso_c_sym (gfc_symbol *old_sym, char *** 4237,4242 **** --- 4237,4244 ---- new_symtree->n.sym->module = gfc_get_string (old_sym->module); new_symtree->n.sym->from_intmod = old_sym->from_intmod; new_symtree->n.sym->intmod_sym_id = old_sym->intmod_sym_id; + if (old_sym->attr.function) + new_symtree->n.sym->result = new_symtree->n.sym; /* Build the formal arg list. */ build_formal_args (new_symtree->n.sym, old_sym, add_optional_arg); diff -Nrcpad gcc-4.4.3/gcc/fortran/trans-expr.c gcc-4.4.4/gcc/fortran/trans-expr.c *** gcc-4.4.3/gcc/fortran/trans-expr.c Sun Nov 1 14:35:40 2009 --- gcc-4.4.4/gcc/fortran/trans-expr.c Wed Feb 10 15:11:30 2010 *************** gfc_apply_interface_mapping (gfc_interfa *** 2118,2125 **** an actual argument derived type array is copied and then returned after the function call. */ void ! gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, ! int g77, sym_intent intent) { gfc_se lse; gfc_se rse; --- 2118,2125 ---- an actual argument derived type array is copied and then returned after the function call. */ void ! gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77, ! sym_intent intent, bool formal_ptr) { gfc_se lse; gfc_se rse; *************** gfc_conv_subref_array_arg (gfc_se * parm *** 2132,2139 **** --- 2132,2141 ---- tree tmp_index; tree tmp; tree base_type; + tree size; stmtblock_t body; int n; + int dimen; gcc_assert (expr->expr_type == EXPR_VARIABLE); *************** gfc_conv_subref_array_arg (gfc_se * parm *** 2262,2270 **** outside the innermost loop, so the overall transfer could be optimized further. */ info = &rse.ss->data.info; tmp_index = gfc_index_zero_node; ! for (n = info->dimen - 1; n > 0; n--) { tree tmp_str; tmp = rse.loop->loopvar[n]; --- 2264,2273 ---- outside the innermost loop, so the overall transfer could be optimized further. */ info = &rse.ss->data.info; + dimen = info->dimen; tmp_index = gfc_index_zero_node; ! for (n = dimen - 1; n > 0; n--) { tree tmp_str; tmp = rse.loop->loopvar[n]; *************** gfc_conv_subref_array_arg (gfc_se * parm *** 2324,2329 **** --- 2327,2364 ---- if (expr->ts.type == BT_CHARACTER) parmse->string_length = expr->ts.cl->backend_decl; + /* Determine the offset for pointer formal arguments and set the + lbounds to one. */ + if (formal_ptr) + { + size = gfc_index_one_node; + offset = gfc_index_zero_node; + for (n = 0; n < dimen; n++) + { + tmp = gfc_conv_descriptor_ubound (parmse->expr, + gfc_rank_cst[n]); + gfc_add_modify (&parmse->pre, tmp, + fold_build2 (PLUS_EXPR, gfc_array_index_type, + tmp, gfc_index_one_node)); + tmp = gfc_conv_descriptor_lbound (parmse->expr, + gfc_rank_cst[n]); + gfc_add_modify (&parmse->pre, tmp, gfc_index_one_node); + size = gfc_evaluate_now (size, &parmse->pre); + offset = fold_build2 (MINUS_EXPR, gfc_array_index_type, + offset, size); + offset = gfc_evaluate_now (offset, &parmse->pre); + tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, + rse.loop->to[n], rse.loop->from[n]); + tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, + tmp, gfc_index_one_node); + size = fold_build2 (MULT_EXPR, gfc_array_index_type, + size, tmp); + } + + tmp = gfc_conv_descriptor_offset (parmse->expr); + gfc_add_modify (&parmse->pre, tmp, offset); + } + /* We want either the address for the data or the address of the descriptor, depending on the mode of passing array arguments. */ if (g77) *************** gfc_conv_function_call (gfc_se * se, gfc *** 2666,2672 **** is converted to a temporary, which is passed and then written back after the procedure call. */ gfc_conv_subref_array_arg (&parmse, e, f, ! fsym ? fsym->attr.intent : INTENT_INOUT); else gfc_conv_array_parameter (&parmse, e, argss, f, fsym, sym->name); --- 2701,2708 ---- is converted to a temporary, which is passed and then written back after the procedure call. */ gfc_conv_subref_array_arg (&parmse, e, f, ! fsym ? fsym->attr.intent : INTENT_INOUT, ! fsym && fsym->attr.pointer); else gfc_conv_array_parameter (&parmse, e, argss, f, fsym, sym->name); *************** gfc_trans_subarray_assign (tree dest, gf *** 3518,3523 **** --- 3554,3703 ---- } + static tree + gfc_trans_alloc_subarray_assign (tree dest, gfc_component * cm, + gfc_expr * expr) + { + gfc_se se; + gfc_ss *rss; + stmtblock_t block; + tree offset; + int n; + tree tmp; + tree tmp2; + gfc_array_spec *as; + gfc_expr *arg = NULL; + + 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_add_block_to_block (&block, &se.pre); + gfc_add_modify (&block, dest, se.expr); + + /* Deal with arrays of derived types with allocatable components. */ + if (cm->ts.type == BT_DERIVED + && cm->ts.derived->attr.alloc_comp) + tmp = gfc_copy_alloc_comp (cm->ts.derived, + se.expr, dest, + cm->as->rank); + else + tmp = gfc_duplicate_allocatable (dest, se.expr, + TREE_TYPE(cm->backend_decl), + cm->as->rank); + + gfc_add_expr_to_block (&block, tmp); + gfc_add_block_to_block (&block, &se.post); + + if (expr->expr_type != EXPR_VARIABLE) + gfc_conv_descriptor_data_set (&block, se.expr, + null_pointer_node); + + /* We need to know if the argument of a conversion function is a + variable, so that the correct lower bound can be used. */ + if (expr->expr_type == EXPR_FUNCTION + && expr->value.function.isym + && expr->value.function.isym->conversion + && expr->value.function.actual->expr + && expr->value.function.actual->expr->expr_type == EXPR_VARIABLE) + arg = expr->value.function.actual->expr; + + /* Obtain the array spec of full array references. */ + if (arg) + as = gfc_get_full_arrayspec_from_expr (arg); + else + as = gfc_get_full_arrayspec_from_expr (expr); + + /* Shift the lbound and ubound of temporaries to being unity, + rather than zero, based. Always calculate the offset. */ + offset = gfc_conv_descriptor_offset (dest); + gfc_add_modify (&block, offset, gfc_index_zero_node); + tmp2 =gfc_create_var (gfc_array_index_type, NULL); + + for (n = 0; n < expr->rank; n++) + { + tree span; + tree lbound; + tree ubound; + + /* Obtain the correct lbound - ISO/IEC TR 15581:2001 page 9. + TODO It looks as if gfc_conv_expr_descriptor should return + the correct bounds and that the following should not be + necessary. This would simplify gfc_conv_intrinsic_bound + as well. */ + if (as && as->lower[n]) + { + gfc_se lbse; + gfc_init_se (&lbse, NULL); + gfc_conv_expr (&lbse, as->lower[n]); + gfc_add_block_to_block (&block, &lbse.pre); + lbound = gfc_evaluate_now (lbse.expr, &block); + } + else if (as && arg) + { + tmp = gfc_get_symbol_decl (arg->symtree->n.sym); + lbound = gfc_conv_descriptor_lbound (tmp, gfc_rank_cst[n]); + } + else if (as) + lbound = gfc_conv_descriptor_lbound (dest, gfc_rank_cst[n]); + else + lbound = gfc_index_one_node; + + lbound = fold_convert (gfc_array_index_type, lbound); + + /* Shift the bounds and set the offset accordingly. */ + tmp = gfc_conv_descriptor_ubound (dest, gfc_rank_cst[n]); + span = fold_build2 (MINUS_EXPR, gfc_array_index_type, tmp, + gfc_conv_descriptor_lbound (dest, gfc_rank_cst[n])); + + ubound = fold_build2 (PLUS_EXPR, gfc_array_index_type, + span, lbound); + gfc_add_modify (&block, tmp, ubound); + + tmp = gfc_conv_descriptor_lbound (dest, gfc_rank_cst[n]); + gfc_add_modify (&block, tmp, lbound); + + tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, + gfc_conv_descriptor_lbound (dest, gfc_rank_cst[n]), + gfc_conv_descriptor_stride (dest, gfc_rank_cst[n])); + + gfc_add_modify (&block, tmp2, tmp); + tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, + offset, tmp2); + gfc_add_modify (&block, offset, tmp); + } + + if (arg) + { + /* If a conversion expression has a null data pointer + argument, nullify the allocatable component. */ + tree non_null_expr; + tree null_expr; + + if (arg->symtree->n.sym->attr.allocatable + || arg->symtree->n.sym->attr.pointer) + { + non_null_expr = gfc_finish_block (&block); + gfc_start_block (&block); + gfc_conv_descriptor_data_set (&block, dest, + null_pointer_node); + null_expr = gfc_finish_block (&block); + tmp = gfc_conv_descriptor_data_get (arg->symtree->n.sym->backend_decl); + tmp = build2 (EQ_EXPR, boolean_type_node, tmp, + fold_convert (TREE_TYPE (tmp), + null_pointer_node)); + return build3_v (COND_EXPR, tmp, + null_expr, non_null_expr); + } + } + + return gfc_finish_block (&block); + } + + /* Assign a single component of a derived type constructor. */ static tree *************** gfc_trans_subcomponent_assign (tree dest *** 3528,3535 **** gfc_ss *rss; stmtblock_t block; tree tmp; - tree offset; - int n; gfc_start_block (&block); --- 3708,3713 ---- *************** gfc_trans_subcomponent_assign (tree dest *** 3569,3659 **** gfc_conv_descriptor_data_set (&block, dest, null_pointer_node); else if (cm->attr.allocatable) { ! tree tmp2; ! ! gfc_init_se (&se, NULL); ! ! rss = gfc_walk_expr (expr); ! se.want_pointer = 0; ! gfc_conv_expr_descriptor (&se, expr, rss); ! gfc_add_block_to_block (&block, &se.pre); ! ! tmp = fold_convert (TREE_TYPE (dest), se.expr); ! gfc_add_modify (&block, dest, tmp); ! ! if (cm->ts.type == BT_DERIVED && cm->ts.derived->attr.alloc_comp) ! tmp = gfc_copy_alloc_comp (cm->ts.derived, se.expr, dest, ! cm->as->rank); ! else ! tmp = gfc_duplicate_allocatable (dest, se.expr, ! TREE_TYPE(cm->backend_decl), ! cm->as->rank); ! gfc_add_expr_to_block (&block, tmp); - gfc_add_block_to_block (&block, &se.post); - - if (expr->expr_type != EXPR_VARIABLE) - gfc_conv_descriptor_data_set (&block, se.expr, null_pointer_node); - - /* Shift the lbound and ubound of temporaries to being unity, rather - than zero, based. Calculate the offset for all cases. */ - offset = gfc_conv_descriptor_offset (dest); - gfc_add_modify (&block, offset, gfc_index_zero_node); - tmp2 =gfc_create_var (gfc_array_index_type, NULL); - for (n = 0; n < expr->rank; n++) - { - if (expr->expr_type != EXPR_VARIABLE - && expr->expr_type != EXPR_CONSTANT) - { - tree span; - tmp = gfc_conv_descriptor_ubound (dest, gfc_rank_cst[n]); - span = fold_build2 (MINUS_EXPR, gfc_array_index_type, tmp, - gfc_conv_descriptor_lbound (dest, gfc_rank_cst[n])); - gfc_add_modify (&block, tmp, - fold_build2 (PLUS_EXPR, - gfc_array_index_type, - span, gfc_index_one_node)); - tmp = gfc_conv_descriptor_lbound (dest, gfc_rank_cst[n]); - gfc_add_modify (&block, tmp, gfc_index_one_node); - } - tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, - gfc_conv_descriptor_lbound (dest, - gfc_rank_cst[n]), - gfc_conv_descriptor_stride (dest, - gfc_rank_cst[n])); - gfc_add_modify (&block, tmp2, tmp); - tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, offset, tmp2); - gfc_add_modify (&block, offset, tmp); - } - - if (expr->expr_type == EXPR_FUNCTION - && expr->value.function.isym - && expr->value.function.isym->conversion - && expr->value.function.actual->expr - && expr->value.function.actual->expr->expr_type - == EXPR_VARIABLE) - { - /* If a conversion expression has a null data pointer - argument, nullify the allocatable component. */ - gfc_symbol *s; - tree non_null_expr; - tree null_expr; - s = expr->value.function.actual->expr->symtree->n.sym; - if (s->attr.allocatable || s->attr.pointer) - { - non_null_expr = gfc_finish_block (&block); - gfc_start_block (&block); - gfc_conv_descriptor_data_set (&block, dest, - null_pointer_node); - null_expr = gfc_finish_block (&block); - tmp = gfc_conv_descriptor_data_get (s->backend_decl); - tmp = build2 (EQ_EXPR, boolean_type_node, tmp, - fold_convert (TREE_TYPE (tmp), - null_pointer_node)); - return build3_v (COND_EXPR, tmp, null_expr, - non_null_expr); - } - } } else { --- 3747,3754 ---- gfc_conv_descriptor_data_set (&block, dest, null_pointer_node); else if (cm->attr.allocatable) { ! tmp = gfc_trans_alloc_subarray_assign (dest, cm, expr); gfc_add_expr_to_block (&block, tmp); } else { diff -Nrcpad gcc-4.4.3/gcc/fortran/trans-intrinsic.c gcc-4.4.4/gcc/fortran/trans-intrinsic.c *** gcc-4.4.3/gcc/fortran/trans-intrinsic.c Mon Nov 2 16:30:48 2009 --- gcc-4.4.4/gcc/fortran/trans-intrinsic.c Sun Jan 31 14:57:13 2010 *************** gfc_conv_intrinsic_bound (gfc_se * se, g *** 832,838 **** gfc_se argse; gfc_ss *ss; gfc_array_spec * as; - gfc_ref *ref; arg = expr->value.function.actual; arg2 = arg->next; --- 832,837 ---- *************** gfc_conv_intrinsic_bound (gfc_se * se, g *** 901,942 **** ubound = gfc_conv_descriptor_ubound (desc, bound); lbound = gfc_conv_descriptor_lbound (desc, bound); ! /* Follow any component references. */ ! if (arg->expr->expr_type == EXPR_VARIABLE ! || arg->expr->expr_type == EXPR_CONSTANT) ! { ! as = arg->expr->symtree->n.sym->as; ! for (ref = arg->expr->ref; ref; ref = ref->next) ! { ! switch (ref->type) ! { ! case REF_COMPONENT: ! as = ref->u.c.component->as; ! continue; ! ! case REF_SUBSTRING: ! continue; ! ! case REF_ARRAY: ! { ! switch (ref->u.ar.type) ! { ! case AR_ELEMENT: ! case AR_SECTION: ! case AR_UNKNOWN: ! as = NULL; ! continue; ! ! case AR_FULL: ! break; ! } ! break; ! } ! } ! } ! } ! else ! as = NULL; /* 13.14.53: Result value for LBOUND --- 900,906 ---- ubound = gfc_conv_descriptor_ubound (desc, bound); lbound = gfc_conv_descriptor_lbound (desc, bound); ! as = gfc_get_full_arrayspec_from_expr (arg->expr); /* 13.14.53: Result value for LBOUND diff -Nrcpad gcc-4.4.3/gcc/fortran/trans-io.c gcc-4.4.4/gcc/fortran/trans-io.c *** gcc-4.4.3/gcc/fortran/trans-io.c Sat Jul 4 03:07:12 2009 --- gcc-4.4.4/gcc/fortran/trans-io.c Sat Feb 6 19:44:41 2010 *************** set_internal_unit (stmtblock_t * block, *** 746,752 **** /* Use a temporary for components of arrays of derived types or substring array references. */ gfc_conv_subref_array_arg (&se, e, 0, ! last_dt == READ ? INTENT_IN : INTENT_OUT); tmp = build_fold_indirect_ref (se.expr); se.expr = gfc_build_addr_expr (pchar_type_node, tmp); tmp = gfc_conv_descriptor_data_get (tmp); --- 746,752 ---- /* Use a temporary for components of arrays of derived types or substring array references. */ gfc_conv_subref_array_arg (&se, e, 0, ! last_dt == READ ? INTENT_IN : INTENT_OUT, false); tmp = build_fold_indirect_ref (se.expr); se.expr = gfc_build_addr_expr (pchar_type_node, tmp); tmp = gfc_conv_descriptor_data_get (tmp); *************** gfc_trans_transfer (gfc_code * code) *** 2191,2197 **** if (seen_vector && last_dt == READ) { /* Create a temp, read to that and copy it back. */ ! gfc_conv_subref_array_arg (&se, expr, 0, INTENT_OUT); tmp = se.expr; } else --- 2191,2197 ---- if (seen_vector && last_dt == READ) { /* Create a temp, read to that and copy it back. */ ! gfc_conv_subref_array_arg (&se, expr, 0, INTENT_OUT, false); tmp = se.expr; } else diff -Nrcpad gcc-4.4.3/gcc/fortran/trans-stmt.c gcc-4.4.4/gcc/fortran/trans-stmt.c *** gcc-4.4.3/gcc/fortran/trans-stmt.c Sun May 10 15:34:55 2009 --- gcc-4.4.4/gcc/fortran/trans-stmt.c Sat Feb 6 19:44:41 2010 *************** gfc_conv_elemental_dependencies (gfc_se *** 212,217 **** --- 212,218 ---- gfc_ss *ss; gfc_ss_info *info; gfc_symbol *fsym; + gfc_ref *ref; int n; tree data; tree offset; *************** gfc_conv_elemental_dependencies (gfc_se *** 267,272 **** --- 268,301 ---- /* Obtain the argument descriptor for unpacking. */ gfc_init_se (&parmse, NULL); parmse.want_pointer = 1; + + /* The scalarizer introduces some specific peculiarities when + handling elemental subroutines; the stride can be needed up to + the dim_array - 1, rather than dim_loop - 1 to calculate + offsets outside the loop. For this reason, we make sure that + the descriptor has the dimensionality of the array by converting + trailing elements into ranges with end = start. */ + for (ref = e->ref; ref; ref = ref->next) + if (ref->type == REF_ARRAY && ref->u.ar.type == AR_SECTION) + break; + + if (ref) + { + bool seen_range = false; + for (n = 0; n < ref->u.ar.dimen; n++) + { + if (ref->u.ar.dimen_type[n] == DIMEN_RANGE) + seen_range = true; + + if (!seen_range + || ref->u.ar.dimen_type[n] != DIMEN_ELEMENT) + continue; + + ref->u.ar.end[n] = gfc_copy_expr (ref->u.ar.start[n]); + ref->u.ar.dimen_type[n] = DIMEN_RANGE; + } + } + gfc_conv_expr_descriptor (&parmse, e, gfc_walk_expr (e)); gfc_add_block_to_block (&se->pre, &parmse.pre); *************** forall_make_variable_temp (gfc_code *c, *** 1691,1697 **** if (old_sym->attr.dimension) { gfc_init_se (&tse, NULL); ! gfc_conv_subref_array_arg (&tse, e, 0, INTENT_IN); gfc_add_block_to_block (pre, &tse.pre); gfc_add_block_to_block (post, &tse.post); tse.expr = build_fold_indirect_ref (tse.expr); --- 1720,1726 ---- if (old_sym->attr.dimension) { gfc_init_se (&tse, NULL); ! gfc_conv_subref_array_arg (&tse, e, 0, INTENT_IN, false); gfc_add_block_to_block (pre, &tse.pre); gfc_add_block_to_block (post, &tse.post); tse.expr = build_fold_indirect_ref (tse.expr); diff -Nrcpad gcc-4.4.3/gcc/fortran/trans.h gcc-4.4.4/gcc/fortran/trans.h *** gcc-4.4.3/gcc/fortran/trans.h Wed Jun 3 19:39:09 2009 --- gcc-4.4.4/gcc/fortran/trans.h Sat Feb 6 19:44:41 2010 *************** int gfc_is_intrinsic_libcall (gfc_expr * *** 314,320 **** int gfc_conv_function_call (gfc_se *, gfc_symbol *, gfc_actual_arglist *, tree); ! void gfc_conv_subref_array_arg (gfc_se *, gfc_expr *, int, sym_intent); /* gfc_trans_* shouldn't call push/poplevel, use gfc_push/pop_scope */ --- 314,320 ---- int gfc_conv_function_call (gfc_se *, gfc_symbol *, gfc_actual_arglist *, tree); ! void gfc_conv_subref_array_arg (gfc_se *, gfc_expr *, int, sym_intent, bool); /* gfc_trans_* shouldn't call push/poplevel, use gfc_push/pop_scope */ diff -Nrcpad gcc-4.4.3/libgfortran/ChangeLog gcc-4.4.4/libgfortran/ChangeLog *** gcc-4.4.3/libgfortran/ChangeLog Thu Jan 21 09:38:12 2010 --- gcc-4.4.4/libgfortran/ChangeLog Thu Apr 29 07:52:00 2010 *************** *** 1,3 **** --- 1,88 ---- + 2010-04-29 Release Manager + + * GCC 4.4.4 released. + + 2010-04-01 Janne Blomqvist + + PR libfortran/43605 + * io/intrinsics.c (gf_ftell): New function, seek to correct offset. + (ftell): Call gf_ftell. + (FTELL_SUB): Likewise. + + 2010-04-01 Janne Blomqvist + + PR libfortran/43605 + * io/intrinsics.c (ftell): Reset fbuf, correct offset. + (FTELL_SUB): Likewise. + + 2010-03-30 Jerry DeLisle + + PR fortran/43409 + Back port from trunk. + * io/io.h: Fix type of size in st_parameter_inquire structure. + Add prototype for new function to return file size. + * io/unix.c (file_size): New function. + * io/inquire.c (inquire_via_unit): Use new function. + (inquire_via_filename): Use new function. + + 2010-03-29 Jerry DeLisle + + PR libfortran/43265 + * io/transfer.c (next_record_r): Only call hit_eof for specific + conditions when an EOF is encountered. + + 2010-03-29 Tobias Burnus + + PR fortran/43551 + * io/unix.c (buf_write): Set physical_offset after lseek. + + 2010-03-25 Jerry DeLisle + + PR libfortran/43517 + * io/read.c (read_x): Return if seen EOR condition. + + 2010-03-17 Jerry DeLisle + + PR libfortran/43265 + * io/io.h: Delete prototype for read_sf, making it static. + * io/read.c (read_x): Modify to call hit_eof if PAD="no". + * io/transfer.c (read_sf_internal): New static function extracted from + read_sf for use on internal units only. Handle empty string case. + (read_sf): New factoring of this function, make it static. Add special + conditions for EOF based on ADVANCE="no", PAD="no", and whether any + bytes have been previously read from the record. + (read_block_form): Modify to call read_sf or read_sf_internal. + (next_record_r): Add a done flag similar to next_record_w. Call hit_eof + if internal array unit next record returns finished, meaning an EOF was + found and not done, ie not the last record expected. For external + units call hit_eof if item_count is 1 or there are no pending spaces. + (next_record): Update call to next_record_r. + + 2010-03-12 Jerry DeLisle + + PR libfortran/43265 + Backport from trunk. + * io/read.c (read_x): Replace the use of read_sf with equivalent lower + level I/O, eliminating unneeded code and handling EOF and EOR + conditions. + * io/io.h: Revise prototype for read_sf. + * io/transfer.c (read_sf): Delete no_error parameter and all uses of it. + Set eof and eor condition flags. (read_block_form): Likewise. + (next_record_r): Add condition to call to hit_eof. + + 2010-03-11 Tobias Burnus + + PR fortran/43228 + * io/list_read.c (nml_parse_qualifier): Disable expanded_read + for array sections. + + 2010-02-04 Jerry DeLisle + + PR libfortran/42901 + * io/list_read.c (nml_get_obj_data): Add new qualifier flag, clean up + code, and adjust logic to set namelist info pointer correctly for array + qualifiers of derived type components. + 2010-01-21 Release Manager * GCC 4.4.3 released. diff -Nrcpad gcc-4.4.3/libgfortran/io/inquire.c gcc-4.4.4/libgfortran/io/inquire.c *** gcc-4.4.3/libgfortran/io/inquire.c Thu Apr 9 23:23:07 2009 --- gcc-4.4.4/libgfortran/io/inquire.c Wed Mar 31 02:00:51 2010 *************** inquire_via_unit (st_parameter_inquire * *** 370,375 **** --- 370,383 ---- cf_strcpy (iqp->round, iqp->round_len, p); } + + if ((cf2 & IOPARM_INQUIRE_HAS_SIZE) != 0) + { + if (u == NULL) + *iqp->size = -1; + else + *iqp->size = file_size (u->file, (gfc_charlen_type) u->file_len); + } } if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0) *************** inquire_via_filename (st_parameter_inqui *** 600,605 **** --- 608,616 ---- if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0) cf_strcpy (iqp->encoding, iqp->encoding_len, undefined); + + if ((cf2 & IOPARM_INQUIRE_HAS_SIZE) != 0) + *iqp->size = file_size (iqp->file, iqp->file_len); } if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0) diff -Nrcpad gcc-4.4.3/libgfortran/io/intrinsics.c gcc-4.4.4/libgfortran/io/intrinsics.c *** gcc-4.4.3/libgfortran/io/intrinsics.c Wed May 27 01:21:22 2009 --- gcc-4.4.4/libgfortran/io/intrinsics.c Thu Apr 1 20:59:15 2010 *************** *** 1,8 **** /* Implementation of the FGET, FGETC, FPUT, FPUTC, FLUSH FTELL, TTYNAM and ISATTY intrinsics. ! Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. ! This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public --- 1,8 ---- /* Implementation of the FGET, FGETC, FPUT, FPUTC, FLUSH FTELL, TTYNAM and ISATTY intrinsics. ! Copyright (C) 2005, 2007, 2009, 2010 Free Software Foundation, Inc. ! This file is part of the GNU Fortran runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public *************** fseek_sub (int * unit, GFC_IO_INT * offs *** 258,276 **** /* FTELL intrinsic */ extern size_t PREFIX(ftell) (int *); export_proto_np(PREFIX(ftell)); size_t PREFIX(ftell) (int * unit) { ! gfc_unit * u = find_unit (*unit); ! size_t ret; ! if (u == NULL) ! return ((size_t) -1); ! ret = (size_t) stell (u->s); ! unlock_unit (u); ! return ret; } #define FTELL_SUB(kind) \ --- 258,284 ---- /* FTELL intrinsic */ + static gfc_offset + gf_ftell (int unit) + { + gfc_unit * u = find_unit (unit); + if (u == NULL) + return -1; + int pos = fbuf_reset (u); + if (pos != 0) + sseek (u->s, pos, SEEK_CUR); + gfc_offset ret = stell (u->s); + unlock_unit (u); + return ret; + } + extern size_t PREFIX(ftell) (int *); export_proto_np(PREFIX(ftell)); size_t PREFIX(ftell) (int * unit) { ! return gf_ftell (*unit); } #define FTELL_SUB(kind) \ *************** PREFIX(ftell) (int * unit) *** 279,292 **** void \ ftell_i ## kind ## _sub (int * unit, GFC_INTEGER_ ## kind * offset) \ { \ ! gfc_unit * u = find_unit (*unit); \ ! if (u == NULL) \ ! *offset = -1; \ ! else \ ! { \ ! *offset = stell (u->s); \ ! unlock_unit (u); \ ! } \ } FTELL_SUB(1) --- 287,293 ---- void \ ftell_i ## kind ## _sub (int * unit, GFC_INTEGER_ ## kind * offset) \ { \ ! *offset = gf_ftell (*unit); \ } FTELL_SUB(1) diff -Nrcpad gcc-4.4.3/libgfortran/io/io.h gcc-4.4.4/libgfortran/io/io.h *** gcc-4.4.3/libgfortran/io/io.h Thu Jun 11 12:49:35 2009 --- gcc-4.4.4/libgfortran/io/io.h Wed Mar 31 02:00:51 2010 *************** typedef struct *** 368,374 **** CHARACTER2 (round); CHARACTER1 (sign); GFC_INTEGER_4 *pending; ! GFC_INTEGER_4 *size; GFC_INTEGER_4 *id; } st_parameter_inquire; --- 368,374 ---- CHARACTER2 (round); CHARACTER1 (sign); GFC_INTEGER_4 *pending; ! GFC_IO_INT *size; GFC_INTEGER_4 *id; } st_parameter_inquire; *************** internal_proto(delete_file); *** 728,733 **** --- 728,736 ---- extern int file_exists (const char *file, gfc_charlen_type file_len); internal_proto(file_exists); + extern GFC_IO_INT file_size (const char *file, gfc_charlen_type file_len); + internal_proto(file_size); + extern const char *inquire_sequential (const char *, int); internal_proto(inquire_sequential); *************** internal_proto(type_name); *** 848,856 **** extern void * read_block_form (st_parameter_dt *, int *); internal_proto(read_block_form); - extern char *read_sf (st_parameter_dt *, int *, int); - internal_proto(read_sf); - extern void *write_block (st_parameter_dt *, int); internal_proto(write_block); --- 851,856 ---- diff -Nrcpad gcc-4.4.3/libgfortran/io/list_read.c gcc-4.4.4/libgfortran/io/list_read.c *** gcc-4.4.3/libgfortran/io/list_read.c Wed Aug 5 03:15:18 2009 --- gcc-4.4.4/libgfortran/io/list_read.c Thu Mar 11 19:48:11 2010 *************** static void *** 287,296 **** eat_line (st_parameter_dt *dtp) { char c; ! if (!is_internal_unit (dtp)) ! do ! c = next_char (dtp); ! while (c != '\n'); } --- 287,296 ---- eat_line (st_parameter_dt *dtp) { char c; ! ! do ! c = next_char (dtp); ! while (c != '\n'); } *************** nml_parse_qualifier (st_parameter_dt *dt *** 2092,2097 **** --- 2092,2105 ---- } } + 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) || (ls[dim].start < (ssize_t)ad[dim].lbound) *************** nml_get_obj_data (st_parameter_dt *dtp, *** 2563,2569 **** namelist_info * first_nl = NULL; namelist_info * root_nl = NULL; int dim, parsed_rank; ! int component_flag; index_type clow, chigh; int non_zero_rank_count; --- 2571,2577 ---- namelist_info * first_nl = NULL; namelist_info * root_nl = NULL; int dim, parsed_rank; ! int component_flag, qualifier_flag; index_type clow, chigh; int non_zero_rank_count; *************** nml_get_obj_data (st_parameter_dt *dtp, *** 2612,2622 **** break; } ! /* Untouch all nodes of the namelist and reset the flag that is set for derived type components. */ nml_untouch_nodes (dtp); component_flag = 0; non_zero_rank_count = 0; /* Get the object name - should '!' and '\n' be permitted separators? */ --- 2620,2631 ---- break; } ! /* Untouch all nodes of the namelist and reset the flags that are set for derived type components. */ nml_untouch_nodes (dtp); component_flag = 0; + qualifier_flag = 0; non_zero_rank_count = 0; /* Get the object name - should '!' and '\n' be permitted separators? */ *************** get_name: *** 2698,2707 **** " for namelist variable %s", nl->var_name); goto nml_err_ret; } - if (parsed_rank > 0) non_zero_rank_count++; c = next_char (dtp); unget_char (dtp, c); } --- 2707,2717 ---- " for namelist variable %s", nl->var_name); goto nml_err_ret; } if (parsed_rank > 0) non_zero_rank_count++; + qualifier_flag = 1; + c = next_char (dtp); unget_char (dtp, c); } *************** get_name: *** 2726,2731 **** --- 2736,2742 ---- root_nl = nl; component_flag = 1; + c = next_char (dtp); goto get_name; } *************** get_name: *** 2766,2780 **** unget_char (dtp, c); } - /* If a derived type touch its components and restore the root - namelist_info if we have parsed a qualified derived type - component. */ - - if (nl->type == GFC_DTYPE_DERIVED) - nml_touch_nodes (nl); - if (component_flag && nl->var_rank > 0 && nl->next) - nl = first_nl; - /* Make sure no extraneous qualifiers are there. */ if (c == '(') --- 2777,2782 ---- *************** get_name: *** 2819,2828 **** nl->var_name); goto nml_err_ret; } - if (first_nl != NULL && first_nl->var_rank > 0) - nl = first_nl; - if (nml_read_obj (dtp, nl, 0, pprev_nl, nml_err_msg, nml_err_msg_size, clow, chigh) == FAILURE) goto nml_err_ret; --- 2821,2844 ---- nl->var_name); goto nml_err_ret; } + /* If a derived type, touch its components and restore the root + namelist_info if we have parsed a qualified derived type + component. */ + + if (nl->type == GFC_DTYPE_DERIVED) + nml_touch_nodes (nl); + + if (first_nl) + { + if (first_nl->var_rank == 0) + { + if (component_flag && qualifier_flag) + nl = first_nl; + } + else + nl = first_nl; + } if (nml_read_obj (dtp, nl, 0, pprev_nl, nml_err_msg, nml_err_msg_size, clow, chigh) == FAILURE) goto nml_err_ret; diff -Nrcpad gcc-4.4.3/libgfortran/io/read.c gcc-4.4.4/libgfortran/io/read.c *** gcc-4.4.3/libgfortran/io/read.c Wed May 27 01:21:22 2009 --- gcc-4.4.4/libgfortran/io/read.c Fri Mar 26 04:56:51 2010 *************** bad_float: *** 1019,1034 **** * and never look at it. */ void ! read_x (st_parameter_dt * dtp, int n) { if ((dtp->u.p.current_unit->pad_status == PAD_NO || is_internal_unit (dtp)) && dtp->u.p.current_unit->bytes_left < n) n = dtp->u.p.current_unit->bytes_left; ! dtp->u.p.sf_read_comma = 0; ! if (n > 0) ! read_sf (dtp, &n, 1); ! dtp->u.p.sf_read_comma = 1; dtp->u.p.current_unit->strm_pos += (gfc_offset) n; } --- 1019,1102 ---- * and never look at it. */ void ! read_x (st_parameter_dt *dtp, int n) { + int length; + char *p, q; + if ((dtp->u.p.current_unit->pad_status == PAD_NO || is_internal_unit (dtp)) && dtp->u.p.current_unit->bytes_left < n) n = dtp->u.p.current_unit->bytes_left; + + if (n == 0) + return; ! length = n; ! ! if (is_internal_unit (dtp)) ! { ! p = mem_alloc_r (dtp->u.p.current_unit->s, &length); ! if (unlikely (length < n)) ! n = length; ! goto done; ! } ! ! if (dtp->u.p.sf_seen_eor) ! return; ! ! p = fbuf_read (dtp->u.p.current_unit, &length); ! if (p == NULL) ! { ! hit_eof (dtp); ! return; ! } ! ! if (length == 0 && dtp->u.p.item_count == 1) ! { ! if (dtp->u.p.current_unit->pad_status == PAD_NO) ! { ! hit_eof (dtp); ! return; ! } ! else ! return; ! } ! ! n = 0; ! 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 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); ! } ! } ! goto done; ! } ! n++; ! p++; ! } ! ! fbuf_seek (dtp->u.p.current_unit, n, SEEK_CUR); ! ! done: ! if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) ! dtp->u.p.size_used += (GFC_IO_INT) n; ! dtp->u.p.current_unit->bytes_left -= n; dtp->u.p.current_unit->strm_pos += (gfc_offset) n; } diff -Nrcpad gcc-4.4.3/libgfortran/io/transfer.c gcc-4.4.4/libgfortran/io/transfer.c *** gcc-4.4.3/libgfortran/io/transfer.c Fri Nov 20 04:00:03 2009 --- gcc-4.4.4/libgfortran/io/transfer.c Tue Mar 30 03:54:36 2010 *************** current_mode (st_parameter_dt *dtp) *** 162,170 **** } ! /* Mid level data transfer statements. These subroutines do reading ! and writing in the style of salloc_r()/salloc_w() within the ! current record. */ /* When reading sequential formatted records we have a problem. We don't know how long the line is until we read the trailing newline, --- 162,168 ---- } ! /* Mid level data transfer statements. */ /* When reading sequential formatted records we have a problem. We don't know how long the line is until we read the trailing newline, *************** current_mode (st_parameter_dt *dtp) *** 177,200 **** we hit the newline. For small allocations, we use a static buffer. For larger allocations, we are forced to allocate memory on the heap. Hopefully this won't happen very often. */ ! char * ! read_sf (st_parameter_dt *dtp, int * length, int no_error) { static char *empty_string[0]; ! char *base, *p, q; ! int n, lorig, memread, seen_comma; ! /* If we hit EOF previously with the no_error flag set (i.e. X, T, ! TR edit descriptors), and we now try to read again, this time ! without setting no_error. */ ! if (!no_error && dtp->u.p.at_eof) { *length = 0; hit_eof (dtp); return NULL; } /* If we have seen an eor previously, return a length of 0. The caller is responsible for correctly padding the input field. */ if (dtp->u.p.sf_seen_eor) --- 175,230 ---- we hit the newline. For small allocations, we use a static buffer. For larger allocations, we are forced to allocate memory on the heap. Hopefully this won't happen very often. */ + + /* Read sequential file - internal unit */ ! static char * ! read_sf_internal (st_parameter_dt *dtp, int * length) { static char *empty_string[0]; ! char *base; ! int lorig; ! if (dtp->internal_unit_len == 0 ! && dtp->u.p.current_unit->pad_status == PAD_NO) ! hit_eof (dtp); ! ! /* If we have seen an eor previously, return a length of 0. The ! caller is responsible for correctly padding the input field. */ ! if (dtp->u.p.sf_seen_eor) { *length = 0; + /* Just return something that isn't a NULL pointer, otherwise the + caller thinks an error occured. */ + return (char*) empty_string; + } + + lorig = *length; + base = mem_alloc_r (dtp->u.p.current_unit->s, length); + if (unlikely (lorig > *length)) + { hit_eof (dtp); return NULL; } + dtp->u.p.current_unit->bytes_left -= *length; + + if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) + dtp->u.p.size_used += (GFC_IO_INT) *length; + + return base; + + } + + /* Read sequential file - external unit */ + + static char * + 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 caller is responsible for correctly padding the input field. */ if (dtp->u.p.sf_seen_eor) *************** read_sf (st_parameter_dt *dtp, int * len *** 205,223 **** return (char*) empty_string; } - if (is_internal_unit (dtp)) - { - memread = *length; - base = mem_alloc_r (dtp->u.p.current_unit->s, length); - if (unlikely (memread > *length)) - { - hit_eof (dtp); - return NULL; - } - n = *length; - goto done; - } - n = seen_comma = 0; /* Read data into format buffer and scan through it. */ --- 235,240 ---- *************** read_sf (st_parameter_dt *dtp, int * len *** 260,267 **** so we can just continue with a short read. */ if (dtp->u.p.current_unit->pad_status == PAD_NO) { - if (likely (no_error)) - break; generate_error (&dtp->common, LIBERROR_EOR, NULL); return NULL; } --- 277,282 ---- *************** read_sf (st_parameter_dt *dtp, int * len *** 291,303 **** some other stuff. Set the relevant flags. */ if (lorig > *length && !dtp->u.p.sf_seen_eor && !seen_comma) { ! if (n > 0 || no_error) ! dtp->u.p.at_eof = 1; ! else { ! hit_eof (dtp); ! return NULL; ! } } done: --- 306,334 ---- some other stuff. Set the relevant flags. */ if (lorig > *length && !dtp->u.p.sf_seen_eor && !seen_comma) { ! if (n > 0) { ! if (dtp->u.p.advance_status == ADVANCE_NO) ! { ! if (dtp->u.p.current_unit->pad_status == PAD_NO) ! { ! hit_eof (dtp); ! return NULL; ! } ! else ! dtp->u.p.eor_condition = 1; ! } ! else ! dtp->u.p.at_eof = 1; ! } ! else if (dtp->u.p.advance_status == ADVANCE_NO ! || dtp->u.p.current_unit->pad_status == PAD_NO ! || dtp->u.p.current_unit->bytes_left ! == dtp->u.p.current_unit->recl) ! { ! hit_eof (dtp); ! return NULL; ! } } done: *************** read_block_form (st_parameter_dt *dtp, i *** 338,344 **** dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; else { ! if (unlikely (dtp->u.p.current_unit->pad_status == PAD_NO)) { /* Not enough data left. */ generate_error (&dtp->common, LIBERROR_EOR, NULL); --- 369,376 ---- dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; else { ! if (unlikely (dtp->u.p.current_unit->pad_status == PAD_NO) ! && !is_internal_unit (dtp)) { /* Not enough data left. */ generate_error (&dtp->common, LIBERROR_EOR, NULL); *************** read_block_form (st_parameter_dt *dtp, i *** 346,354 **** } } ! if (unlikely (dtp->u.p.current_unit->bytes_left == 0)) { ! hit_eof (dtp); return NULL; } --- 378,387 ---- } } ! if (unlikely (dtp->u.p.current_unit->bytes_left == 0 ! && !is_internal_unit(dtp))) { ! hit_eof (dtp); return NULL; } *************** read_block_form (st_parameter_dt *dtp, i *** 360,366 **** (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL || dtp->u.p.current_unit->flags.access == ACCESS_STREAM)) { ! source = read_sf (dtp, nbytes, 0); dtp->u.p.current_unit->strm_pos += (gfc_offset) (*nbytes + dtp->u.p.sf_seen_eor); return source; --- 393,403 ---- (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL || dtp->u.p.current_unit->flags.access == ACCESS_STREAM)) { ! if (is_internal_unit (dtp)) ! source = read_sf_internal (dtp, nbytes); ! else ! source = read_sf (dtp, nbytes); ! dtp->u.p.current_unit->strm_pos += (gfc_offset) (*nbytes + dtp->u.p.sf_seen_eor); return source; *************** min_off (gfc_offset a, gfc_offset b) *** 2641,2647 **** /* Space to the next record for read mode. */ static void ! next_record_r (st_parameter_dt *dtp) { gfc_offset record; int bytes_left; --- 2678,2684 ---- /* Space to the next record for read mode. */ static void ! next_record_r (st_parameter_dt *dtp, int done) { gfc_offset record; int bytes_left; *************** next_record_r (st_parameter_dt *dtp) *** 2668,2677 **** case FORMATTED_SEQUENTIAL: /* read_sf has already terminated input because of an '\n', or we have hit EOF. */ ! if (dtp->u.p.sf_seen_eor || dtp->u.p.at_eof) { dtp->u.p.sf_seen_eor = 0; - dtp->u.p.at_eof = 0; break; } --- 2705,2713 ---- case FORMATTED_SEQUENTIAL: /* read_sf has already terminated input because of an '\n', or we have hit EOF. */ ! if (dtp->u.p.sf_seen_eor) { dtp->u.p.sf_seen_eor = 0; break; } *************** next_record_r (st_parameter_dt *dtp) *** 2683,2688 **** --- 2719,2726 ---- record = next_array_record (dtp, dtp->u.p.current_unit->ls, &finished); + if (!done && finished) + hit_eof (dtp); /* Now seek to this record. */ record = record * dtp->u.p.current_unit->recl; *************** next_record_r (st_parameter_dt *dtp) *** 2720,2727 **** { if (errno != 0) generate_error (&dtp->common, LIBERROR_OS, NULL); ! else ! hit_eof (dtp); break; } --- 2758,2771 ---- { if (errno != 0) generate_error (&dtp->common, LIBERROR_OS, NULL); ! else ! { ! if (is_stream_io (dtp) ! || dtp->u.p.current_unit->pad_status == PAD_NO ! || dtp->u.p.current_unit->bytes_left ! == dtp->u.p.current_unit->recl) ! hit_eof (dtp); ! } break; } *************** next_record (st_parameter_dt *dtp, int d *** 3061,3067 **** dtp->u.p.current_unit->read_bad = 0; if (dtp->u.p.mode == READING) ! next_record_r (dtp); else next_record_w (dtp, done); --- 3105,3111 ---- dtp->u.p.current_unit->read_bad = 0; if (dtp->u.p.mode == READING) ! next_record_r (dtp, done); else next_record_w (dtp, done); diff -Nrcpad gcc-4.4.3/libgfortran/io/unix.c gcc-4.4.4/libgfortran/io/unix.c *** gcc-4.4.3/libgfortran/io/unix.c Wed May 27 01:21:22 2009 --- gcc-4.4.4/libgfortran/io/unix.c Wed Mar 31 02:00:51 2010 *************** buf_write (unix_stream * s, const void * *** 454,466 **** s->ndirty += nbyte; } else ! { ! if (s->file_length != -1 && s->physical_offset != s->logical_offset ! && lseek (s->fd, s->logical_offset, SEEK_SET) < 0) ! return -1; ! nbyte = raw_write (s, buf, nbyte); ! s->physical_offset += nbyte; ! } } s->logical_offset += nbyte; /* Don't increment file_length if the file is non-seekable. */ --- 454,470 ---- s->ndirty += nbyte; } else ! { ! if (s->file_length != -1 && s->physical_offset != s->logical_offset) ! { ! if (lseek (s->fd, s->logical_offset, SEEK_SET) < 0) ! return -1; ! s->physical_offset = s->logical_offset; ! } ! ! nbyte = raw_write (s, buf, nbyte); ! s->physical_offset += nbyte; ! } } s->logical_offset += nbyte; /* Don't increment file_length if the file is non-seekable. */ *************** file_exists (const char *file, gfc_charl *** 1392,1397 **** --- 1396,1417 ---- } + /* file_size()-- Returns the size of the file. */ + + GFC_IO_INT + file_size (const char *file, gfc_charlen_type file_len) + { + char path[PATH_MAX + 1]; + struct stat statbuf; + + if (unpack_filename (path, file, file_len)) + return -1; + + if (stat (path, &statbuf) < 0) + return -1; + + return (GFC_IO_INT) statbuf.st_size; + } static const char yes[] = "YES", no[] = "NO", unknown[] = "UNKNOWN";