diff options
79 files changed, 1152 insertions, 322 deletions
diff --git a/ChangeLog b/ChangeLog index 42054b91f91..06e81784f54 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2007-06-25 Martin Michlmayr <tbm@cyrius.com> + + * MAINTAINERS (Write After Approval): Add myself. + 2007-06-19 Chris Matthews <chrismatthews@google.com> * MAINTAINERS (Write After Approval): Add myself. diff --git a/MAINTAINERS b/MAINTAINERS index d37df9a6291..90b95e404c7 100644 --- a/MAINTAINERS +++ b/MAINTAINERS @@ -360,6 +360,7 @@ Chris Matthews chrismatthews@google.com Michael Matz matz@suse.de Greg McGary gkm@gnu.org Adam Megacz adam@xwt.org +Martin Michlmayr tbm@cyrius.com Robert Millan rmh@gcc.gnu.org Lee Millward lee.millward@gmail.com Alan Modra amodra@bigpond.net.au diff --git a/boehm-gc/ChangeLog b/boehm-gc/ChangeLog index 89e48b942ed..f140791a56f 100644 --- a/boehm-gc/ChangeLog +++ b/boehm-gc/ChangeLog @@ -1,3 +1,8 @@ +2007-06-22 Jakub Jelinek <jakub@redhat.com> + + * pthread_support.c (GC_get_thread_stack_base): Handle + pthread_getattr_np failures. + 2007-06-02 Paolo Bonzini <bonzini@gnu.org> * configure: Regenerate. diff --git a/boehm-gc/pthread_support.c b/boehm-gc/pthread_support.c index bbda8522c03..f0a58c886a3 100644 --- a/boehm-gc/pthread_support.c +++ b/boehm-gc/pthread_support.c @@ -1135,7 +1135,13 @@ GC_PTR GC_get_thread_stack_base() size_t stack_size; my_pthread = pthread_self(); - pthread_getattr_np (my_pthread, &attr); + if (pthread_getattr_np (my_pthread, &attr) != 0) + { +# ifdef DEBUG_THREADS + GC_printf1("Can not determine stack base for attached thread"); +# endif + return 0; + } pthread_attr_getstack (&attr, (void **) &stack_addr, &stack_size); pthread_attr_destroy (&attr); diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 67247fe9efb..81df5d7d0c2 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,124 @@ +2007-06-25 Nathan Froyd <froydnj@codesourcery.com> + + * config/rs6000/spe.md (*frob_ti_tf_2): Specify an input_operand + as the source of the set. + +2007-06-25 Roman Zippel <zippel@linux-m68k.org> + + * config/m68k/m68k.h (DATA_REGNO_P, ADDRESS_REGNO_P, INT_REGNO_P, + FP_REGNO_P): Use IN_RANGE. + (REGNO_OK_FOR_DATA_P, REGNO_OK_FOR_FP_P): Remove. + (REGNO_OK_FOR_INDEX_NONSTRICT_P, REGNO_OK_FOR_BASE_NONSTRICT_P): New. + (DATA_REG_P): Use DATA_REGNO_P. + (FP_REG_P): Use FP_REGNO_P. + (ADDRESS_REG_P): Use ADDRESS_REGNO_P. + * config/m68k/m68k.c (m68k_legitimate_base_reg_p): Use + REGNO_OK_FOR_INDEX_NONSTRICT_P, REGNO_OK_FOR_BASE_NONSTRICT_P. + +2007-06-24 Jan Hubicka <jh@suse.cz> + + PR middle-end/30563 + * cgraphunit.c (cgraph_analyze_function): Fix ordering problem. + +2007-06-24 Sebastian Pop <sebpop@gmail.com> + + PR middle-end/32461 + * fold-const.c (fold_binary): Strip nops of operand 0 + of BIT_NOT_EXPR before calling operand_equal_p. + * testsuite/gcc.dg/tree-ssa/pr32461-1.c: New. + * testsuite/gcc.dg/tree-ssa/pr32461-2.c: New. + +2007-06-23 Mark Mitchell <mark@codesourcery.com> + + * doc/extend.texi: Document that dllimport and dllexport imply + default visibility. + * tree.c (handle_dll_attribute): Set DECL_VISIBILITY on the + imported or exported declaration, including type declarations. + * c-common.c (handle_visibility_attribute): Check for conflicts + with dllimport/dllexport. + (c_determine_visibility): Handle dllimport/dllexport as an + explicit visibility atttribute. + +2007-06-23 Richard Guenther <rguenther@suse.de> + + PR tree-optimization/16876 + PR middle-end/29478 + * tree.h (CALL_CANNOT_INLINE_P): New macro to access static_flag + for CALL_EXPRs. + * tree-inline.c (initialize_inlined_parameters): Do not call + lang_hooks.tree_inlining.convert_parm_for_inlining. + * cgraphbuild.c (initialize_inline_failed): Set inline failed + reason for mismatched types. + * gimplify.c (gimplify_call_expr): Verify the call expression + arguments match the called function type signature. Otherwise + mark the call expression to be not considered for inlining + using CALL_CANNOT_INLINE_P flag. + * ipa-inline.c (cgraph_mark_inline): Honor CALL_CANNOT_INLINE_P on the + edges call expression. + (cgraph_decide_inlining_of_small_function): Likewise. + (cgraph_decide_inlining): Likewise. + * c-objc-common.h (LANG_HOOKS_TREE_INLINING_CONVERT_PARM_FOR_INLINING): + Remove define. + * c-tree.h (c_convert_parm_for_inlining): Remove declaration. + * c-typeck.c (c_convert_parm_for_inlining): Remove. + * langhooks-def.h (lhd_tree_inlining_convert_parm_for_inlining): + Remove declaration. + (LANG_HOOKS_TREE_INLINING_CONVERT_PARM_FOR_INLINING): Remove define. + * langhooks.c (lhd_tree_inlining_convert_parm_for_inlining): + Remove. + * langhooks.h (struct lang_hooks_for_tree_inlining): Remove + convert_parm_for_inlining member. + +2007-06-23 Richard Earnshaw <rearnsha@arm.com> + + PR target/31152 + * arm.md (negscc): Match the correct operand for optimized LT0 test. + Remove optimization for GT. + +2007-06-23 Kenneth Zadeck <zadeck@naturalbridge.com> + + PR middle-end/32437 + *dce.c (deletable_insn_p): Add extra parameter and recurse if insn + is a PARALLEL. + (prescan_insns_for_dce): Add extra parameter. + +2007-06-23 Jan Hubicka <jh@suse.cz> + + PR middle-end/31541 + * gimplify.c (mark_addressable): New function. + (gimplify_modify_expr_rhs, gimplify_addr_expr, gimplify_expr): Use it. + +2007-06-19 Uros Bizjak <ubizjak@gmail.com> + + PR middle-end/32374 + * expr.c (store_constructor): Do not clobber non-zeroed memory. + +2007-06-22 Uros Bizjak <ubizjak@gmail.com> + + PR target/32413 + * config/i386/i386.c (ix86_register_move_cost): Rise the cost of + moves between MMX/SSE registers to at least 8 units to prevent + ICE caused by non-tieable SI/HI/QImodes in SSE registers. + +2007-06-22 Uros Bizjak <ubizjak@gmail.com> + + * config/i386/i386.c (override_options): Correct x86_sahf + setting condition. + +2007-06-21 David Daney <ddaney@avtrex.com> + + PR target/32406 + * config/mips/mips.md (define_constants): Rename UNSPEC_EH_RECEIVER + to UNSPEC_NONLOCAL_GOTO_RECEIVER globally. + (exception_receiver): Renamed to ... + (nonlocal_goto_receiver): ... this. + +2007-06-22 Roman Zippel <zippel@linux-m68k.org> + + * df-scan.c (df_read_modify_subreg_p): Use REGMODE_NATURAL_SIZE. + (df_def_record_1): Set (DF_REF_READ_WRITE | DF_REF_PARTIAL) for + partial register accesses. + 2007-06-22 Chao-ying Fu <fu@mips.com> * doc/c-tree.texi (FIXED_CST): Remove spaces. diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index b07d4f6f7c7..2e298d9d5f2 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20070621 +20070625 diff --git a/gcc/c-common.c b/gcc/c-common.c index be7891022f9..f4368458120 100644 --- a/gcc/c-common.c +++ b/gcc/c-common.c @@ -5640,11 +5640,22 @@ handle_visibility_attribute (tree *node, tree name, tree args, } if (DECL_VISIBILITY_SPECIFIED (decl) - && vis != DECL_VISIBILITY (decl) - && lookup_attribute ("visibility", (TYPE_P (*node) - ? TYPE_ATTRIBUTES (*node) - : DECL_ATTRIBUTES (decl)))) - error ("%qD redeclared with different visibility", decl); + && vis != DECL_VISIBILITY (decl)) + { + tree attributes = (TYPE_P (*node) + ? TYPE_ATTRIBUTES (*node) + : DECL_ATTRIBUTES (decl)); + if (lookup_attribute ("visibility", attributes)) + error ("%qD redeclared with different visibility", decl); + else if (TARGET_DLLIMPORT_DECL_ATTRIBUTES + && lookup_attribute ("dllimport", attributes)) + error ("%qD was declared %qs which implies default visibility", + decl, "dllimport"); + else if (TARGET_DLLIMPORT_DECL_ATTRIBUTES + && lookup_attribute ("dllexport", attributes)) + error ("%qD was declared %qs which implies default visibility", + decl, "dllexport"); + } DECL_VISIBILITY (decl) = vis; DECL_VISIBILITY_SPECIFIED (decl) = 1; @@ -5677,18 +5688,12 @@ c_determine_visibility (tree decl) to distinguish the use of an attribute from the use of a "#pragma GCC visibility push(...)"; in the latter case we still want other considerations to be able to overrule the #pragma. */ - if (lookup_attribute ("visibility", DECL_ATTRIBUTES (decl))) + if (lookup_attribute ("visibility", DECL_ATTRIBUTES (decl)) + || (TARGET_DLLIMPORT_DECL_ATTRIBUTES + && (lookup_attribute ("dllimport", DECL_ATTRIBUTES (decl)) + || lookup_attribute ("dllexport", DECL_ATTRIBUTES (decl))))) return true; - /* Anything that is exported must have default visibility. */ - if (TARGET_DLLIMPORT_DECL_ATTRIBUTES - && lookup_attribute ("dllexport", DECL_ATTRIBUTES (decl))) - { - DECL_VISIBILITY (decl) = VISIBILITY_DEFAULT; - DECL_VISIBILITY_SPECIFIED (decl) = 1; - return true; - } - /* Set default visibility to whatever the user supplied with visibility_specified depending on #pragma GCC visibility. */ if (!DECL_VISIBILITY_SPECIFIED (decl)) diff --git a/gcc/c-objc-common.h b/gcc/c-objc-common.h index e6a82efd4ae..171e702e59d 100644 --- a/gcc/c-objc-common.h +++ b/gcc/c-objc-common.h @@ -89,9 +89,6 @@ extern void c_initialize_diagnostics (diagnostic_context *); #undef LANG_HOOKS_TREE_INLINING_DISREGARD_INLINE_LIMITS #define LANG_HOOKS_TREE_INLINING_DISREGARD_INLINE_LIMITS \ c_disregard_inline_limits -#undef LANG_HOOKS_TREE_INLINING_CONVERT_PARM_FOR_INLINING -#define LANG_HOOKS_TREE_INLINING_CONVERT_PARM_FOR_INLINING \ - c_convert_parm_for_inlining #undef LANG_HOOKS_TREE_DUMP_DUMP_TREE_FN #define LANG_HOOKS_TREE_DUMP_DUMP_TREE_FN c_dump_tree diff --git a/gcc/c-tree.h b/gcc/c-tree.h index dd0702d9e9d..48e798fb158 100644 --- a/gcc/c-tree.h +++ b/gcc/c-tree.h @@ -581,7 +581,6 @@ extern tree c_start_case (tree); extern void c_finish_case (tree); extern tree build_asm_expr (tree, tree, tree, tree, bool); extern tree build_asm_stmt (tree, tree); -extern tree c_convert_parm_for_inlining (tree, tree, tree, int); extern int c_types_compatible_p (tree, tree); extern tree c_begin_compound_stmt (bool); extern tree c_end_compound_stmt (tree, bool); diff --git a/gcc/c-typeck.c b/gcc/c-typeck.c index 774050c9c3c..67a4f3ebf67 100644 --- a/gcc/c-typeck.c +++ b/gcc/c-typeck.c @@ -4355,37 +4355,6 @@ convert_for_assignment (tree type, tree rhs, enum impl_conv errtype, return error_mark_node; } - -/* Convert VALUE for assignment into inlined parameter PARM. ARGNUM - is used for error and warning reporting and indicates which argument - is being processed. */ - -tree -c_convert_parm_for_inlining (tree parm, tree value, tree fn, int argnum) -{ - tree ret, type; - - /* If FN was prototyped at the call site, the value has been converted - already in convert_arguments. - However, we might see a prototype now that was not in place when - the function call was seen, so check that the VALUE actually matches - PARM before taking an early exit. */ - if (!value - || (TYPE_ARG_TYPES (TREE_TYPE (fn)) - && (TYPE_MAIN_VARIANT (TREE_TYPE (parm)) - == TYPE_MAIN_VARIANT (TREE_TYPE (value))))) - return value; - - type = TREE_TYPE (parm); - ret = convert_for_assignment (type, value, - ic_argpass_nonproto, fn, - fn, argnum); - if (targetm.calls.promote_prototypes (TREE_TYPE (fn)) - && INTEGRAL_TYPE_P (type) - && (TYPE_PRECISION (type) < TYPE_PRECISION (integer_type_node))) - ret = default_conversion (ret); - return ret; -} /* If VALUE is a compound expr all of whose expressions are constant, then return its value. Otherwise, return error_mark_node. diff --git a/gcc/cgraphbuild.c b/gcc/cgraphbuild.c index ec4e356c8c2..dbd8b48978b 100644 --- a/gcc/cgraphbuild.c +++ b/gcc/cgraphbuild.c @@ -99,6 +99,8 @@ initialize_inline_failed (struct cgraph_node *node) "considered for inlining"); else if (!node->local.inlinable) e->inline_failed = N_("function not inlinable"); + else if (CALL_CANNOT_INLINE_P (e->call_stmt)) + e->inline_failed = N_("mismatched arguments"); else e->inline_failed = N_("function not considered for inlining"); } diff --git a/gcc/cgraphunit.c b/gcc/cgraphunit.c index 1dba95bb06a..ac8472f23a4 100644 --- a/gcc/cgraphunit.c +++ b/gcc/cgraphunit.c @@ -760,6 +760,7 @@ cgraph_analyze_function (struct cgraph_node *node) current_function_decl = decl; push_cfun (DECL_STRUCT_FUNCTION (decl)); cgraph_lower_function (node); + node->analyzed = true; if (!flag_unit_at_a_time) { @@ -771,7 +772,6 @@ cgraph_analyze_function (struct cgraph_node *node) bitmap_obstack_release (NULL); } - node->analyzed = true; pop_cfun (); current_function_decl = NULL; } diff --git a/gcc/config/arm/arm.md b/gcc/config/arm/arm.md index 664f23d8fe8..5a8774e79ad 100644 --- a/gcc/config/arm/arm.md +++ b/gcc/config/arm/arm.md @@ -9423,15 +9423,12 @@ (clobber (reg:CC CC_REGNUM))] "TARGET_ARM" "* - if (GET_CODE (operands[3]) == LT && operands[3] == const0_rtx) + if (GET_CODE (operands[3]) == LT && operands[2] == const0_rtx) return \"mov\\t%0, %1, asr #31\"; if (GET_CODE (operands[3]) == NE) return \"subs\\t%0, %1, %2\;mvnne\\t%0, #0\"; - if (GET_CODE (operands[3]) == GT) - return \"subs\\t%0, %1, %2\;mvnne\\t%0, %0, asr #31\"; - output_asm_insn (\"cmp\\t%1, %2\", operands); output_asm_insn (\"mov%D3\\t%0, #0\", operands); return \"mvn%d3\\t%0, #0\"; diff --git a/gcc/config/i386/i386.c b/gcc/config/i386/i386.c index ad51cb616fe..5c5cb528858 100644 --- a/gcc/config/i386/i386.c +++ b/gcc/config/i386/i386.c @@ -2059,7 +2059,7 @@ override_options (void) x86_popcnt = true; if (processor_alias_table[i].flags & (PTA_PREFETCH_SSE | PTA_SSE)) x86_prefetch_sse = true; - if ((processor_alias_table[i].flags & PTA_NO_SAHF) && !TARGET_64BIT) + if (!(TARGET_64BIT && (processor_alias_table[i].flags & PTA_NO_SAHF))) x86_sahf = true; break; @@ -20279,7 +20279,15 @@ ix86_register_move_cost (enum machine_mode mode, enum reg_class class1, /* Moves between SSE/MMX and integer unit are expensive. */ if (MMX_CLASS_P (class1) != MMX_CLASS_P (class2) || SSE_CLASS_P (class1) != SSE_CLASS_P (class2)) - return ix86_cost->mmxsse_to_integer; + + /* ??? By keeping returned value relatively high, we limit the number + of moves between integer and MMX/SSE registers for all targets. + Additionally, high value prevents problem with x86_modes_tieable_p(), + where integer modes in MMX/SSE registers are not tieable + because of missing QImode and HImode moves to, from or between + MMX/SSE registers. */ + return MAX (ix86_cost->mmxsse_to_integer, 8); + if (MAYBE_FLOAT_CLASS_P (class1)) return ix86_cost->fp_move; if (MAYBE_SSE_CLASS_P (class1)) diff --git a/gcc/config/m68k/m68k.c b/gcc/config/m68k/m68k.c index 039649c2e48..ec65a889233 100644 --- a/gcc/config/m68k/m68k.c +++ b/gcc/config/m68k/m68k.c @@ -1609,7 +1609,7 @@ m68k_legitimate_base_reg_p (rtx x, bool strict_p) return (REG_P (x) && (strict_p ? REGNO_OK_FOR_BASE_P (REGNO (x)) - : !DATA_REGNO_P (REGNO (x)) && !FP_REGNO_P (REGNO (x)))); + : REGNO_OK_FOR_BASE_NONSTRICT_P (REGNO (x)))); } /* Return true if X is a legitimate index register. STRICT_P says @@ -1624,7 +1624,7 @@ m68k_legitimate_index_reg_p (rtx x, bool strict_p) return (REG_P (x) && (strict_p ? REGNO_OK_FOR_INDEX_P (REGNO (x)) - : !FP_REGNO_P (REGNO (x)))); + : REGNO_OK_FOR_INDEX_NONSTRICT_P (REGNO (x)))); } /* Return true if X is a legitimate index expression for a (d8,An,Xn) or diff --git a/gcc/config/m68k/m68k.h b/gcc/config/m68k/m68k.h index e84994b7f10..3ff24842343 100644 --- a/gcc/config/m68k/m68k.h +++ b/gcc/config/m68k/m68k.h @@ -662,16 +662,16 @@ __transfer_from_trampoline () \ /* Macros to check register numbers against specific register classes. */ /* True for data registers, D0 through D7. */ -#define DATA_REGNO_P(REGNO) ((unsigned int) (REGNO) < 8) +#define DATA_REGNO_P(REGNO) IN_RANGE (REGNO, 0, 7) /* True for address registers, A0 through A7. */ -#define ADDRESS_REGNO_P(REGNO) (((unsigned int) (REGNO) - 8) < 8) +#define ADDRESS_REGNO_P(REGNO) IN_RANGE (REGNO, 8, 15) /* True for integer registers, D0 through D7 and A0 through A7. */ -#define INT_REGNO_P(REGNO) ((unsigned int) (REGNO) < 16) +#define INT_REGNO_P(REGNO) IN_RANGE (REGNO, 0, 15) /* True for floating point registers, FP0 through FP7. */ -#define FP_REGNO_P(REGNO) (((unsigned int) (REGNO) - 16) < 8) +#define FP_REGNO_P(REGNO) IN_RANGE (REGNO, 16, 23) #define REGNO_OK_FOR_INDEX_P(REGNO) \ (INT_REGNO_P (REGNO) \ @@ -681,13 +681,15 @@ __transfer_from_trampoline () \ (ADDRESS_REGNO_P (REGNO) \ || ADDRESS_REGNO_P (reg_renumber[REGNO])) -#define REGNO_OK_FOR_DATA_P(REGNO) \ - (DATA_REGNO_P (REGNO) \ - || DATA_REGNO_P (reg_renumber[REGNO])) +#define REGNO_OK_FOR_INDEX_NONSTRICT_P(REGNO) \ + (INT_REGNO_P (REGNO) \ + || REGNO == ARG_POINTER_REGNUM \ + || REGNO >= FIRST_PSEUDO_REGISTER) -#define REGNO_OK_FOR_FP_P(REGNO) \ - (FP_REGNO_P (REGNO) \ - || FP_REGNO_P (reg_renumber[REGNO])) +#define REGNO_OK_FOR_BASE_NONSTRICT_P(REGNO) \ + (ADDRESS_REGNO_P (REGNO) \ + || REGNO == ARG_POINTER_REGNUM \ + || REGNO >= FIRST_PSEUDO_REGISTER) /* Now macros that check whether X is a register and also, strictly, whether it is in a specified class. @@ -697,13 +699,13 @@ __transfer_from_trampoline () \ define_optimization. */ /* 1 if X is a data register. */ -#define DATA_REG_P(X) (REG_P (X) && REGNO_OK_FOR_DATA_P (REGNO (X))) +#define DATA_REG_P(X) (REG_P (X) && DATA_REGNO_P (REGNO (X))) /* 1 if X is an fp register. */ -#define FP_REG_P(X) (REG_P (X) && REGNO_OK_FOR_FP_P (REGNO (X))) +#define FP_REG_P(X) (REG_P (X) && FP_REGNO_P (REGNO (X))) /* 1 if X is an address register */ -#define ADDRESS_REG_P(X) (REG_P (X) && REGNO_OK_FOR_BASE_P (REGNO (X))) +#define ADDRESS_REG_P(X) (REG_P (X) && ADDRESS_REGNO_P (REGNO (X))) /* True if SYMBOL + OFFSET constants must refer to something within SYMBOL's section. */ diff --git a/gcc/config/mips/mips.md b/gcc/config/mips/mips.md index 3dc3c00bc10..8eb5576e059 100644 --- a/gcc/config/mips/mips.md +++ b/gcc/config/mips/mips.md @@ -31,7 +31,7 @@ (UNSPEC_GET_FNADDR 3) (UNSPEC_BLOCKAGE 4) (UNSPEC_CPRESTORE 5) - (UNSPEC_EH_RECEIVER 6) + (UNSPEC_NONLOCAL_GOTO_RECEIVER 6) (UNSPEC_EH_RETURN 7) (UNSPEC_CONSTTABLE_INT 8) (UNSPEC_CONSTTABLE_FLOAT 9) @@ -5143,9 +5143,9 @@ DONE; }) -(define_insn_and_split "exception_receiver" +(define_insn_and_split "nonlocal_goto_receiver" [(set (reg:SI 28) - (unspec_volatile:SI [(const_int 0)] UNSPEC_EH_RECEIVER))] + (unspec_volatile:SI [(const_int 0)] UNSPEC_NONLOCAL_GOTO_RECEIVER))] "TARGET_CALL_CLOBBERED_GP" "#" "&& reload_completed" diff --git a/gcc/config/rs6000/spe.md b/gcc/config/rs6000/spe.md index 94e8528ab08..58d401fb3c1 100644 --- a/gcc/config/rs6000/spe.md +++ b/gcc/config/rs6000/spe.md @@ -2319,7 +2319,7 @@ (define_insn "*frob_ti_tf_2" [(set (subreg:TF (match_operand:TI 0 "gpc_reg_operand" "=&r") 0) - (match_operand:TF 1 "gpc_reg_operand" "r"))] + (match_operand:TF 1 "input_operand" "r"))] "TARGET_E500_DOUBLE" "evmergehi %0,%1,%1\;mr %L0,%1\;evmergehi %Y0,%L1,%L1\;mr %Z0,%L1" [(set_attr "length" "16")]) diff --git a/gcc/cp/ChangeLog b/gcc/cp/ChangeLog index 609b80cb31d..951faf4af49 100644 --- a/gcc/cp/ChangeLog +++ b/gcc/cp/ChangeLog @@ -1,3 +1,8 @@ +2007-06-23 Mark Mitchell <mark@codesourcery.com> + + * decl2.c (determine_visibility): Don't look for dllexport here. + (determine_visibility_from_class): Tidy. + 2007-06-18 Simon Baldwin <simonb@google.com> PR c++/31923 diff --git a/gcc/cp/decl2.c b/gcc/cp/decl2.c index 52953b2fa0c..b745183f1af 100644 --- a/gcc/cp/decl2.c +++ b/gcc/cp/decl2.c @@ -1684,17 +1684,6 @@ determine_visibility (tree decl) else use_template = 0; - /* Anything that is exported must have default visibility. */ - if (TARGET_DLLIMPORT_DECL_ATTRIBUTES - && lookup_attribute ("dllexport", - TREE_CODE (decl) == TYPE_DECL - ? TYPE_ATTRIBUTES (TREE_TYPE (decl)) - : DECL_ATTRIBUTES (decl))) - { - DECL_VISIBILITY (decl) = VISIBILITY_DEFAULT; - DECL_VISIBILITY_SPECIFIED (decl) = 1; - } - /* If DECL is a member of a class, visibility specifiers on the class can influence the visibility of the DECL. */ if (DECL_CLASS_SCOPE_P (decl)) @@ -1796,18 +1785,20 @@ determine_visibility (tree decl) static void determine_visibility_from_class (tree decl, tree class_type) { + if (DECL_VISIBILITY_SPECIFIED (decl)) + return; + if (visibility_options.inlines_hidden /* Don't do this for inline templates; specializations might not be inline, and we don't want them to inherit the hidden visibility. We'll set it here for all inline instantiations. */ && !processing_template_decl - && ! DECL_VISIBILITY_SPECIFIED (decl) && TREE_CODE (decl) == FUNCTION_DECL && DECL_DECLARED_INLINE_P (decl) && (! DECL_LANG_SPECIFIC (decl) || ! DECL_EXPLICIT_INSTANTIATION (decl))) DECL_VISIBILITY (decl) = VISIBILITY_HIDDEN; - else if (!DECL_VISIBILITY_SPECIFIED (decl)) + else { /* Default to the class visibility. */ DECL_VISIBILITY (decl) = CLASSTYPE_VISIBILITY (class_type); @@ -1826,7 +1817,6 @@ determine_visibility_from_class (tree decl, tree class_type) && !DECL_CONSTRUCTION_VTABLE_P (decl))) && TREE_PUBLIC (decl) && !DECL_REALLY_EXTERN (decl) - && !DECL_VISIBILITY_SPECIFIED (decl) && !CLASSTYPE_VISIBILITY_SPECIFIED (class_type)) targetm.cxx.determine_class_data_visibility (decl); } diff --git a/gcc/dce.c b/gcc/dce.c index 902dbd923a8..0252d4d5b24 100644 --- a/gcc/dce.c +++ b/gcc/dce.c @@ -58,15 +58,14 @@ static bitmap_obstack dce_tmp_bitmap_obstack; static sbitmap marked = NULL; -/* Return true if INSN a normal instruction that can be deleted by the - DCE pass. */ +/* Return true if INSN with BODY is a normal instruction that can be + deleted by the DCE pass. */ static bool -deletable_insn_p (rtx insn, bool fast) +deletable_insn_p (rtx insn, rtx body, bool fast) { rtx x; - - switch (GET_CODE (PATTERN (insn))) + switch (GET_CODE (body)) { case USE: case PREFETCH: @@ -86,7 +85,7 @@ deletable_insn_p (rtx insn, bool fast) /* A CLOBBER of a dead pseudo register serves no purpose. That is not necessarily true for hard registers until after reload. */ - x = XEXP (PATTERN (insn), 0); + x = XEXP (body, 0); return REG_P (x) && (!HARD_REGISTER_P (x) || reload_completed); } else @@ -95,14 +94,23 @@ deletable_insn_p (rtx insn, bool fast) never be the target of a use-def chain. */ return false; + case PARALLEL: + { + int i; + for (i = XVECLEN (body, 0) - 1; i >= 0; i--) + if (!deletable_insn_p (insn, XVECEXP (body, 0, i), fast)) + return false; + return true; + } + default: if (!NONJUMP_INSN_P (insn)) return false; - if (volatile_insn_p (PATTERN (insn))) + if (volatile_insn_p (body)) return false; - if (flag_non_call_exceptions && may_trap_p (PATTERN (insn))) + if (flag_non_call_exceptions && may_trap_p (body)) return false; return true; @@ -361,7 +369,7 @@ prescan_insns_for_dce (bool fast) rtx note = find_reg_note (insn, REG_LIBCALL_ID, NULL_RTX); if (note) mark_libcall (insn, fast); - else if (deletable_insn_p (insn, fast)) + else if (deletable_insn_p (insn, PATTERN (insn), fast)) mark_nonreg_stores (PATTERN (insn), insn, fast); else mark_insn (insn, fast); diff --git a/gcc/df-scan.c b/gcc/df-scan.c index 17c22721ead..fdad6a931b6 100644 --- a/gcc/df-scan.c +++ b/gcc/df-scan.c @@ -2703,7 +2703,8 @@ df_read_modify_subreg_p (rtx x) return false; isize = GET_MODE_SIZE (GET_MODE (SUBREG_REG (x))); osize = GET_MODE_SIZE (GET_MODE (x)); - return (isize > osize && isize > UNITS_PER_WORD); + return isize > osize + && isize > REGMODE_NATURAL_SIZE (GET_MODE (SUBREG_REG (x))); } @@ -2718,7 +2719,6 @@ df_def_record_1 (struct df_collection_rec *collection_rec, { rtx *loc; rtx dst; - bool dst_in_strict_lowpart = false; /* We may recursively call ourselves on EXPR_LIST when dealing with PARALLEL construct. */ @@ -2749,33 +2749,16 @@ df_def_record_1 (struct df_collection_rec *collection_rec, /* Maybe, we should flag the use of STRICT_LOW_PART somehow. It might be handy for the reg allocator. */ while (GET_CODE (dst) == STRICT_LOW_PART - || GET_CODE (dst) == ZERO_EXTRACT - || df_read_modify_subreg_p (dst)) + || GET_CODE (dst) == ZERO_EXTRACT) { -#if 0 - /* Strict low part always contains SUBREG, but we do not want to make - it appear outside, as whole register is always considered. */ - if (GET_CODE (dst) == STRICT_LOW_PART) - { - loc = &XEXP (dst, 0); - dst = *loc; - } -#endif + flags |= DF_REF_READ_WRITE | DF_REF_PARTIAL; loc = &XEXP (dst, 0); - if (GET_CODE (dst) == STRICT_LOW_PART) - dst_in_strict_lowpart = true; dst = *loc; - flags |= DF_REF_READ_WRITE; - } - /* Sets to a subreg of a single word register are partial sets if - they are wrapped in a strict lowpart, and not partial otherwise. - */ - if (GET_CODE (dst) == SUBREG && REG_P (SUBREG_REG (dst)) - && dst_in_strict_lowpart) - flags |= DF_REF_PARTIAL; - + if (df_read_modify_subreg_p (dst)) + flags |= DF_REF_READ_WRITE | DF_REF_PARTIAL; + if (REG_P (dst) || (GET_CODE (dst) == SUBREG && REG_P (SUBREG_REG (dst)))) df_ref_record (collection_rec, diff --git a/gcc/doc/extend.texi b/gcc/doc/extend.texi index 8a6ea17b990..9f5a373604c 100644 --- a/gcc/doc/extend.texi +++ b/gcc/doc/extend.texi @@ -1911,10 +1911,8 @@ You can use @code{__declspec(dllexport)} as a synonym for compilers. On systems that support the @code{visibility} attribute, this -attribute also implies ``default'' visibility, unless a -@code{visibility} attribute is explicitly specified. You should avoid -the use of @code{dllexport} with ``hidden'' or ``internal'' -visibility; in the future GCC may issue an error for those cases. +attribute also implies ``default'' visibility. It is an error to +explicitly specify any other visibility. Currently, the @code{dllexport} attribute is ignored for inlined functions, unless the @option{-fkeep-inline-functions} flag has been @@ -1935,14 +1933,18 @@ the @option{--export-all} linker flag. On Microsoft Windows and Symbian OS targets, the @code{dllimport} attribute causes the compiler to reference a function or variable via a global pointer to a pointer that is set up by the DLL exporting the -symbol. The attribute implies @code{extern} storage. On Microsoft -Windows targets, the pointer name is formed by combining @code{_imp__} -and the function or variable name. +symbol. The attribute implies @code{extern}. On Microsoft Windows +targets, the pointer name is formed by combining @code{_imp__} and the +function or variable name. You can use @code{__declspec(dllimport)} as a synonym for @code{__attribute__ ((dllimport))} for compatibility with other compilers. +On systems that support the @code{visibility} attribute, this +attribute also implies ``default'' visibility. It is an error to +explicitly specify any other visibility. + Currently, the attribute is ignored for inlined functions. If the attribute is applied to a symbol @emph{definition}, an error is reported. If a symbol previously declared @code{dllimport} is later defined, the diff --git a/gcc/expr.c b/gcc/expr.c index d3d746bd189..26701d0f99a 100644 --- a/gcc/expr.c +++ b/gcc/expr.c @@ -5082,7 +5082,7 @@ store_constructor (tree exp, rtx target, int cleared, HOST_WIDE_INT size) cleared = 1; } - if (! cleared) + if (REG_P (target) && !cleared) emit_insn (gen_rtx_CLOBBER (VOIDmode, target)); /* Store each element of the constructor into the diff --git a/gcc/fold-const.c b/gcc/fold-const.c index d22e9c447b3..e23b4e3f711 100644 --- a/gcc/fold-const.c +++ b/gcc/fold-const.c @@ -9550,21 +9550,31 @@ fold_binary (enum tree_code code, tree type, tree op0, tree op1) /* ~X + X is -1. */ if (TREE_CODE (arg0) == BIT_NOT_EXPR - && operand_equal_p (TREE_OPERAND (arg0, 0), arg1, 0) && !TYPE_OVERFLOW_TRAPS (type)) { - t1 = build_int_cst_type (type, -1); - return omit_one_operand (type, t1, arg1); + tree tem = TREE_OPERAND (arg0, 0); + + STRIP_NOPS (tem); + if (operand_equal_p (tem, arg1, 0)) + { + t1 = build_int_cst_type (type, -1); + return omit_one_operand (type, t1, arg1); + } } /* X + ~X is -1. */ if (TREE_CODE (arg1) == BIT_NOT_EXPR - && operand_equal_p (arg0, TREE_OPERAND (arg1, 0), 0) && !TYPE_OVERFLOW_TRAPS (type)) { - t1 = build_int_cst_type (type, -1); - return omit_one_operand (type, t1, arg0); - } + tree tem = TREE_OPERAND (arg1, 0); + + STRIP_NOPS (tem); + if (operand_equal_p (arg0, tem, 0)) + { + t1 = build_int_cst_type (type, -1); + return omit_one_operand (type, t1, arg0); + } + } /* If we are adding two BIT_AND_EXPR's, both of which are and'ing with a constant, and the two constants have no bits in common, @@ -14558,9 +14568,9 @@ fold_relational_const (enum tree_code code, tree type, tree op0, tree op1) return constant_boolean_node (result, type); } -/* Build an expression for the a clean point containing EXPR with type TYPE. - Don't build a cleanup point expression for EXPR which don't have side - effects. */ +/* If necessary, return a CLEANUP_POINT_EXPR for EXPR with the + indicated TYPE. If no CLEANUP_POINT_EXPR is necessary, return EXPR + itself. */ tree fold_build_cleanup_point_expr (tree type, tree expr) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a3f52ef1b57..5b697d14c0c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,57 @@ +2007-06-25 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/32464 + * resolve.c (check_host_association): Return if the old symbol + is use associated. Introduce retval to reduce the number of + evaluations of the first-order return value. + + PR fortran/31494 + * match.c (gfc_match_call): If a host associated symbol is not + a subroutine, build a new symtree/symbol in the current name + space. + +2007-06-24 Tobias Burnus <burnus@net-de> + + PR fortran/32460 + * interface.c (gfc_compare_derived_types): Add access check. + * symbol.c (gfc_find_component): Ditto. + (gfc_set_component_attr,gfc_get_component_attr) Copy access state. + * dump-parse-tree.c (gfc_show_components): Dump access state. + * gfortran.h (struct gfc_component): Add gfc_access. + * module.c (mio_component): Add access state. + * (gfc_match_structure_constructor): Check for private access state. + +2007-06-24 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/32298 + PR fortran/31726 + * trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): Calculate + the offset between the loop counter and the position as + defined. Add the offset within the loop so that the mask acts + correctly. Do not advance the location on the basis that it + is zero. + +2007-06-22 Daniel Franke <franke.daniel@gmail.com> + + PR fortran/31473 + * symbol.c (gfc_copy_attr): Emit errors for duplicate + EXTERNAL/INTRINSIC statements. + +2007-06-22 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/32360 + * expr.c (gfc_check_assign): If the rvalue expression type is NULL_EXPR, + check to see if the lvalue has attribute pointer and data. + +2007-06-21 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/31162 + * resolve.c (gfc_resolve_iterator_expr): Add check for REAL using + gfc_notify_standard. (gfc_resolve_iterator): Remove check. + (resolve_branch): Change "Obsolete" to "Deleted feature". + * io.c (resolve_tag): Ditto. + * match.c (gfc_match_pause, gfc_match_assign, gfc_match_goto): Ditto. + 2007-06-20 Jerry DeLisle <jvdelisle@gcc.gnu.org> PR fortran/32361 diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 51af1c401f2..5d26a78af1b 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -624,6 +624,8 @@ gfc_show_components (gfc_symbol *sym) gfc_status (" DIMENSION"); gfc_status_char (' '); gfc_show_array_spec (c->as); + if (c->access) + gfc_status (" %s", gfc_code2string (access_types, c->access)); gfc_status (")"); if (c->next != NULL) gfc_status_char (' '); diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 00ed9a04d77..d3f0ddf5cce 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -2407,12 +2407,18 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform) return FAILURE; } - if (rvalue->expr_type == EXPR_NULL) - { - gfc_error ("NULL appears on right-hand side in assignment at %L", - &rvalue->where); - return FAILURE; - } + if (rvalue->expr_type == EXPR_NULL) + { + if (lvalue->symtree->n.sym->attr.pointer + && lvalue->symtree->n.sym->attr.data) + return SUCCESS; + else + { + gfc_error ("NULL appears on right-hand side in assignment at %L", + &rvalue->where); + return FAILURE; + } + } if (sym->attr.cray_pointee && lvalue->ref != NULL diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index aa4c03508d4..9a653ce29ac 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -743,6 +743,7 @@ typedef struct gfc_component gfc_typespec ts; int pointer, allocatable, dimension; + gfc_access access; gfc_array_spec *as; tree backend_decl; diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 591e46e0af2..da8696b81da 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -364,6 +364,9 @@ gfc_compare_derived_types (gfc_symbol *derived1, gfc_symbol *derived2) if (strcmp (dt1->name, dt2->name) != 0) return 0; + if (dt1->access != dt2->access) + return 0; + if (dt1->pointer != dt2->pointer) return 0; diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index 4d12b2416fb..aa299a3885a 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -1072,7 +1072,7 @@ resolve_tag (const io_tag *tag, gfc_expr *e) } else if (e->ts.type == BT_INTEGER && e->expr_type == EXPR_VARIABLE) { - if (gfc_notify_std (GFC_STD_F95_DEL, "Obsolete: ASSIGNED " + if (gfc_notify_std (GFC_STD_F95_DEL, "Deleted feature: ASSIGNED " "variable in FORMAT tag at %L", &e->where) == FAILURE) return FAILURE; diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index d1f5f41636b..ee376f5640e 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -1578,7 +1578,8 @@ gfc_match_pause (void) m = gfc_match_stopcode (ST_PAUSE); if (m == MATCH_YES) { - if (gfc_notify_std (GFC_STD_F95_DEL, "Obsolete: PAUSE statement at %C") + if (gfc_notify_std (GFC_STD_F95_DEL, "Deleted feature: PAUSE statement" + " at %C") == FAILURE) m = MATCH_ERROR; } @@ -1625,7 +1626,7 @@ gfc_match_assign (void) return MATCH_ERROR; if (gfc_match (" to %v%t", &expr) == MATCH_YES) { - if (gfc_notify_std (GFC_STD_F95_DEL, "Obsolete: ASSIGN " + if (gfc_notify_std (GFC_STD_F95_DEL, "Deleted feature: ASSIGN " "statement at %C") == FAILURE) return MATCH_ERROR; @@ -1671,7 +1672,7 @@ gfc_match_goto (void) if (gfc_match_variable (&expr, 0) == MATCH_YES) { - if (gfc_notify_std (GFC_STD_F95_DEL, "Obsolete: Assigned GOTO " + if (gfc_notify_std (GFC_STD_F95_DEL, "Deleted feature: Assigned GOTO " "statement at %C") == FAILURE) return MATCH_ERROR; @@ -2169,13 +2170,20 @@ gfc_match_call (void) return MATCH_ERROR; sym = st->n.sym; - gfc_set_sym_referenced (sym); - if (!sym->attr.generic - && !sym->attr.subroutine - && gfc_add_subroutine (&sym->attr, sym->name, NULL) == FAILURE) + if (sym->ns != gfc_current_ns + && !sym->attr.generic + && !sym->attr.subroutine + && gfc_get_sym_tree (name, NULL, &st) == 1) return MATCH_ERROR; + sym = st->n.sym; + + if (gfc_add_subroutine (&sym->attr, sym->name, NULL) == FAILURE) + return MATCH_ERROR; + + gfc_set_sym_referenced (sym); + if (gfc_match_eos () != MATCH_YES) { m = gfc_match_actual_arglist (1, &arglist); diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 876255f5849..14d26d9e432 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -2065,6 +2065,7 @@ mio_component (gfc_component *c) mio_integer (&c->dimension); mio_integer (&c->pointer); mio_integer (&c->allocatable); + c->access = MIO_NAME (gfc_access) (c->access, access_types); mio_expr (&c->initializer); mio_rparen (); diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 90b1d6840e4..14253f6f1bd 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -1888,6 +1888,7 @@ gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result) gfc_expr *e; locus where; match m; + bool private_comp = false; head = tail = NULL; @@ -1900,6 +1901,11 @@ gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result) for (comp = sym->components; comp; comp = comp->next) { + if (comp->access == ACCESS_PRIVATE) + { + private_comp = true; + break; + } if (head == NULL) tail = head = gfc_get_constructor (); else @@ -1928,6 +1934,14 @@ gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result) break; } + if (sym->attr.use_assoc + && (sym->component_access == ACCESS_PRIVATE || private_comp)) + { + gfc_error ("Structure constructor for '%s' at %C has PRIVATE " + "components", sym->name); + goto cleanup; + } + if (gfc_match_char (')') != MATCH_YES) goto syntax; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index cbf4f7cea29..bc6ba02d44a 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -3224,11 +3224,16 @@ check_host_association (gfc_expr *e) locus temp_locus; gfc_expr *expr; int n; + bool retval = e->expr_type == EXPR_FUNCTION; if (e->symtree == NULL || e->symtree->n.sym == NULL) - return e->expr_type == EXPR_FUNCTION; + return retval; old_sym = e->symtree->n.sym; + + if (old_sym->attr.use_assoc) + return retval; + if (gfc_current_ns->parent && gfc_current_ns->parent->parent && old_sym->ns != gfc_current_ns) @@ -3244,7 +3249,7 @@ check_host_association (gfc_expr *e) gfc_free_ref_list (e->ref); e->ref = NULL; - if (e->expr_type == EXPR_FUNCTION) + if (retval) { gfc_free_actual_arglist (e->value.function.actual); e->value.function.actual = NULL; @@ -3271,7 +3276,7 @@ check_host_association (gfc_expr *e) gfc_current_locus = temp_locus; } } - + /* This might have changed! */ return e->expr_type == EXPR_FUNCTION; } @@ -3373,15 +3378,26 @@ gfc_resolve_iterator_expr (gfc_expr *expr, bool real_ok, return FAILURE; } - if (!(expr->ts.type == BT_INTEGER - || (expr->ts.type == BT_REAL && real_ok))) + if (expr->ts.type != BT_INTEGER) { - if (real_ok) - gfc_error ("%s at %L must be INTEGER or REAL", _(name_msgid), - &expr->where); + if (expr->ts.type == BT_REAL) + { + if (real_ok) + return gfc_notify_std (GFC_STD_F95_DEL, + "Deleted feature: %s at %L must be integer", + _(name_msgid), &expr->where); + else + { + gfc_error ("%s at %L must be INTEGER", _(name_msgid), + &expr->where); + return FAILURE; + } + } else - gfc_error ("%s at %L must be INTEGER", _(name_msgid), &expr->where); - return FAILURE; + { + gfc_error ("%s at %L must be INTEGER", _(name_msgid), &expr->where); + return FAILURE; + } } return SUCCESS; } @@ -3393,11 +3409,6 @@ gfc_resolve_iterator_expr (gfc_expr *expr, bool real_ok, try gfc_resolve_iterator (gfc_iterator *iter, bool real_ok) { - - if (iter->var->ts.type == BT_REAL) - gfc_notify_std (GFC_STD_F95_DEL, "Obsolete: REAL DO loop iterator at %L", - &iter->var->where); - if (gfc_resolve_iterator_expr (iter->var, real_ok, "Loop variable") == FAILURE) return FAILURE; @@ -4572,7 +4583,7 @@ resolve_branch (gfc_st_label *label, gfc_code *code) if (stack && stack->current->next->op == EXEC_NOP) { - gfc_notify_std (GFC_STD_F95_DEL, "Obsolete: GOTO at %L jumps to " + gfc_notify_std (GFC_STD_F95_DEL, "Deleted feature: GOTO at %L jumps to " "END of construct at %L", &code->loc, &stack->current->next->loc); return; /* We know this is not an END DO. */ @@ -4586,7 +4597,7 @@ resolve_branch (gfc_st_label *label, gfc_code *code) || stack->current->op == EXEC_DO_WHILE) && stack->tail->here == label && stack->tail->op == EXEC_NOP) { - gfc_notify_std (GFC_STD_F95_DEL, "Obsolete: GOTO at %L jumps " + gfc_notify_std (GFC_STD_F95_DEL, "Deleted feature: GOTO at %L jumps " "to END of construct at %L", &code->loc, &stack->tail->loc); return; diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 5215c3ec2a7..e1b27dc0fb7 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -1436,14 +1436,11 @@ gfc_copy_attr (symbol_attribute * dest, symbol_attribute * src, locus * where) goto fail; if (src->cray_pointee && gfc_add_cray_pointee (dest, where) == FAILURE) goto fail; - - /* The subroutines that set these bits also cause flavors to be set, - and that has already happened in the original, so don't let it - happen again. */ - if (src->external) - dest->external = 1; - if (src->intrinsic) - dest->intrinsic = 1; + + if (src->external && gfc_add_external (dest, where) == FAILURE) + goto fail; + if (src->intrinsic && gfc_add_intrinsic (dest, where) == FAILURE) + goto fail; return SUCCESS; @@ -1618,7 +1615,8 @@ gfc_find_component (gfc_symbol *sym, const char *name) name, sym->name); else { - if (sym->attr.use_assoc && sym->component_access == ACCESS_PRIVATE) + if (sym->attr.use_assoc && (sym->component_access == ACCESS_PRIVATE + || p->access == ACCESS_PRIVATE)) { gfc_error ("Component '%s' at %C is a PRIVATE component of '%s'", name, sym->name); @@ -1659,6 +1657,7 @@ gfc_set_component_attr (gfc_component *c, symbol_attribute *attr) c->dimension = attr->dimension; c->pointer = attr->pointer; c->allocatable = attr->allocatable; + c->access = attr->access; } @@ -1673,6 +1672,7 @@ gfc_get_component_attr (symbol_attribute *attr, gfc_component *c) attr->dimension = c->dimension; attr->pointer = c->pointer; attr->allocatable = c->allocatable; + attr->access = c->access; } diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index d1c371092fb..874b1081de6 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -1928,6 +1928,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op) tree tmp; tree elsetmp; tree ifbody; + tree offset; gfc_loopinfo loop; gfc_actual_arglist *actual; gfc_ss *arrayss; @@ -1947,6 +1948,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op) /* Initialize the result. */ pos = gfc_create_var (gfc_array_index_type, "pos"); + offset = gfc_create_var (gfc_array_index_type, "offset"); type = gfc_typenode_for_spec (&expr->ts); /* Walk the arguments. */ @@ -2045,15 +2047,28 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op) /* Assign the value to the limit... */ gfc_add_modify_expr (&ifblock, limit, arrayse.expr); - /* Remember where we are. */ - gfc_add_modify_expr (&ifblock, pos, loop.loopvar[0]); + /* Remember where we are. An offset must be added to the loop + counter to obtain the required position. */ + if (loop.temp_dim) + tmp = build_int_cst (gfc_array_index_type, 1); + else + tmp =fold_build2 (MINUS_EXPR, gfc_array_index_type, + gfc_index_one_node, loop.from[0]); + gfc_add_modify_expr (&block, offset, tmp); + + tmp = build2 (PLUS_EXPR, TREE_TYPE (pos), + loop.loopvar[0], offset); + gfc_add_modify_expr (&ifblock, pos, tmp); ifbody = gfc_finish_block (&ifblock); - /* If it is a more extreme value or pos is still zero. */ + /* If it is a more extreme value or pos is still zero and the value + equal to the limit. */ + tmp = build2 (TRUTH_AND_EXPR, boolean_type_node, + build2 (EQ_EXPR, boolean_type_node, pos, gfc_index_zero_node), + build2 (EQ_EXPR, boolean_type_node, arrayse.expr, limit)); tmp = build2 (TRUTH_OR_EXPR, boolean_type_node, - build2 (op, boolean_type_node, arrayse.expr, limit), - build2 (EQ_EXPR, boolean_type_node, pos, gfc_index_zero_node)); + build2 (op, boolean_type_node, arrayse.expr, limit), tmp); tmp = build3_v (COND_EXPR, tmp, ifbody, build_empty_stmt ()); gfc_add_expr_to_block (&block, tmp); @@ -2098,12 +2113,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op) } gfc_cleanup_loop (&loop); - /* Return a value in the range 1..SIZE(array). */ - tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, loop.from[0], - gfc_index_one_node); - tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, pos, tmp); - /* And convert to the required type. */ - se->expr = convert (type, tmp); + se->expr = convert (type, pos); } static void diff --git a/gcc/gimplify.c b/gcc/gimplify.c index 9e259613e81..ac94ba52608 100644 --- a/gcc/gimplify.c +++ b/gcc/gimplify.c @@ -117,6 +117,17 @@ static enum gimplify_status gimplify_compound_expr (tree *, tree *, bool); static bool cpt_same_type (tree a, tree b); #endif +/* Mark X addressable. Unlike the langhook we expect X to be in gimple + form and we don't do any syntax checking. */ +static void +mark_addressable (tree x) +{ + while (handled_component_p (x)) + x = TREE_OPERAND (x, 0); + if (TREE_CODE (x) != VAR_DECL && TREE_CODE (x) != PARM_DECL) + return ; + TREE_ADDRESSABLE (x) = 1; +} /* Return a hash value for a formal temporary table entry. */ @@ -2047,7 +2058,7 @@ gimplify_arg (tree *expr_p, tree *pre_p) static enum gimplify_status gimplify_call_expr (tree *expr_p, tree *pre_p, bool want_value) { - tree decl; + tree decl, parms, p; enum gimplify_status ret; int i, nargs; @@ -2113,6 +2124,48 @@ gimplify_call_expr (tree *expr_p, tree *pre_p, bool want_value) nargs = call_expr_nargs (*expr_p); + /* Get argument types for verification. */ + decl = get_callee_fndecl (*expr_p); + parms = NULL_TREE; + if (decl) + parms = TYPE_ARG_TYPES (TREE_TYPE (decl)); + else if (POINTER_TYPE_P (TREE_TYPE (CALL_EXPR_FN (*expr_p)))) + parms = TYPE_ARG_TYPES (TREE_TYPE (TREE_TYPE (CALL_EXPR_FN (*expr_p)))); + + /* Verify if the type of the argument matches that of the function + declaration. If we cannot verify this or there is a mismatch, + mark the call expression so it doesn't get inlined later. */ + if (parms) + { + for (i = 0, p = parms; i < nargs; i++, p = TREE_CHAIN (p)) + if (!p + || TREE_VALUE (p) == error_mark_node + || CALL_EXPR_ARG (*expr_p, i) == error_mark_node + || !lang_hooks.types_compatible_p + (TREE_TYPE (CALL_EXPR_ARG (*expr_p, i)), TREE_VALUE (p))) + { + CALL_CANNOT_INLINE_P (*expr_p) = 1; + break; + } + } + else if (decl && DECL_ARGUMENTS (decl)) + { + for (i = 0, p = DECL_ARGUMENTS (decl); i < nargs; + i++, p = TREE_CHAIN (p)) + if (!p + || p == error_mark_node + || CALL_EXPR_ARG (*expr_p, i) == error_mark_node + || !lang_hooks.types_compatible_p + (TREE_TYPE (CALL_EXPR_ARG (*expr_p, i)), TREE_TYPE (p))) + { + CALL_CANNOT_INLINE_P (*expr_p) = 1; + break; + } + } + else if (nargs != 0) + CALL_CANNOT_INLINE_P (*expr_p) = 1; + + /* Finally, gimplify the function arguments. */ for (i = (PUSH_ARGS_REVERSED ? nargs - 1 : 0); PUSH_ARGS_REVERSED ? i >= 0 : i < nargs; PUSH_ARGS_REVERSED ? i-- : i++) @@ -3434,7 +3487,7 @@ gimplify_modify_expr_rhs (tree *expr_p, tree *from_p, tree *to_p, tree *pre_p, if (use_target) { CALL_EXPR_RETURN_SLOT_OPT (*from_p) = 1; - lang_hooks.mark_addressable (*to_p); + mark_addressable (*to_p); } } @@ -3957,6 +4010,8 @@ gimplify_addr_expr (tree *expr_p, tree *pre_p, tree *post_p) the address of a call that returns a struct; see gcc.dg/c99-array-lval-1.c. The gimplifier will correctly make the implied temporary explicit. */ + + /* Mark the RHS addressable. */ ret = gimplify_expr (&TREE_OPERAND (expr, 0), pre_p, post_p, is_gimple_addressable, fb_either); if (ret != GS_ERROR) @@ -3972,8 +4027,7 @@ gimplify_addr_expr (tree *expr_p, tree *pre_p, tree *post_p) is set properly. */ recompute_tree_invariant_for_addr_expr (expr); - /* Mark the RHS addressable. */ - lang_hooks.mark_addressable (TREE_OPERAND (expr, 0)); + mark_addressable (TREE_OPERAND (expr, 0)); } break; } @@ -4011,7 +4065,7 @@ gimplify_asm_expr (tree *expr_p, tree *pre_p, tree *post_p) &allows_mem, &allows_reg, &is_inout); if (!allows_reg && allows_mem) - lang_hooks.mark_addressable (TREE_VALUE (link)); + mark_addressable (TREE_VALUE (link)); tret = gimplify_expr (&TREE_VALUE (link), pre_p, post_p, is_inout ? is_gimple_min_lval : is_gimple_lvalue, @@ -4140,7 +4194,7 @@ gimplify_asm_expr (tree *expr_p, tree *pre_p, tree *post_p) { tret = gimplify_expr (&TREE_VALUE (link), pre_p, post_p, is_gimple_lvalue, fb_lvalue | fb_mayfail); - lang_hooks.mark_addressable (TREE_VALUE (link)); + mark_addressable (TREE_VALUE (link)); if (tret == GS_ERROR) { error ("memory input %d is not directly addressable", i); @@ -5563,7 +5617,7 @@ gimplify_expr (tree *expr_p, tree *pre_p, tree *post_p, if (fallback == fb_lvalue) { *expr_p = get_initialized_tmp_var (*expr_p, pre_p, post_p); - lang_hooks.mark_addressable (*expr_p); + mark_addressable (*expr_p); } break; @@ -5576,7 +5630,7 @@ gimplify_expr (tree *expr_p, tree *pre_p, tree *post_p, if (fallback == fb_lvalue) { *expr_p = get_initialized_tmp_var (*expr_p, pre_p, post_p); - lang_hooks.mark_addressable (*expr_p); + mark_addressable (*expr_p); } break; @@ -5765,7 +5819,7 @@ gimplify_expr (tree *expr_p, tree *pre_p, tree *post_p, else if (fallback == fb_lvalue) { *expr_p = get_initialized_tmp_var (*expr_p, pre_p, post_p); - lang_hooks.mark_addressable (*expr_p); + mark_addressable (*expr_p); } else ret = GS_ALL_DONE; diff --git a/gcc/ipa-inline.c b/gcc/ipa-inline.c index ee9d7e6ca00..c682f86866f 100644 --- a/gcc/ipa-inline.c +++ b/gcc/ipa-inline.c @@ -288,22 +288,21 @@ cgraph_mark_inline (struct cgraph_edge *edge) struct cgraph_node *to = edge->caller; struct cgraph_node *what = edge->callee; struct cgraph_edge *e, *next; - int times = 0; /* Look for all calls, mark them inline and clone recursively all inlined functions. */ for (e = what->callers; e; e = next) { next = e->next_caller; - if (e->caller == to && e->inline_failed) + if (e->caller == to && e->inline_failed + && !CALL_CANNOT_INLINE_P (e->call_stmt)) { cgraph_mark_inline_edge (e, true); if (e == edge) edge = next; - times++; } } - gcc_assert (times); + return edge; } @@ -885,7 +884,7 @@ cgraph_decide_inlining_of_small_functions (void) } gcc_assert (edge->aux); edge->aux = NULL; - if (!edge->inline_failed) + if (!edge->inline_failed || CALL_CANNOT_INLINE_P (edge->call_stmt)) continue; /* When not having profile info ready we don't weight by any way the @@ -1076,7 +1075,7 @@ cgraph_decide_inlining (void) for (e = node->callers; e; e = next) { next = e->next_caller; - if (!e->inline_failed) + if (!e->inline_failed || CALL_CANNOT_INLINE_P (e->call_stmt)) continue; if (cgraph_recursive_inlining_p (e->caller, e->callee, &e->inline_failed)) diff --git a/gcc/langhooks-def.h b/gcc/langhooks-def.h index 28b35bb89b1..6ca6e2f40de 100644 --- a/gcc/langhooks-def.h +++ b/gcc/langhooks-def.h @@ -73,7 +73,6 @@ extern tree lhd_tree_inlining_walk_subtrees (tree *, int *, walk_tree_fn, extern int lhd_tree_inlining_cannot_inline_tree_fn (tree *); extern int lhd_tree_inlining_disregard_inline_limits (tree); extern int lhd_tree_inlining_auto_var_in_fn_p (tree, tree); -extern tree lhd_tree_inlining_convert_parm_for_inlining (tree, tree, tree, int); extern void lhd_initialize_diagnostics (struct diagnostic_context *); extern tree lhd_callgraph_analyze_expr (tree *, int *, tree); @@ -145,8 +144,6 @@ extern void lhd_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *, lhd_tree_inlining_auto_var_in_fn_p #define LANG_HOOKS_TREE_INLINING_VAR_MOD_TYPE_P \ hook_bool_tree_tree_false -#define LANG_HOOKS_TREE_INLINING_CONVERT_PARM_FOR_INLINING \ - lhd_tree_inlining_convert_parm_for_inlining #define LANG_HOOKS_TREE_INLINING_INITIALIZER { \ LANG_HOOKS_TREE_INLINING_WALK_SUBTREES, \ @@ -154,7 +151,6 @@ extern void lhd_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *, LANG_HOOKS_TREE_INLINING_DISREGARD_INLINE_LIMITS, \ LANG_HOOKS_TREE_INLINING_AUTO_VAR_IN_FN_P, \ LANG_HOOKS_TREE_INLINING_VAR_MOD_TYPE_P, \ - LANG_HOOKS_TREE_INLINING_CONVERT_PARM_FOR_INLINING \ } #define LANG_HOOKS_CALLGRAPH_ANALYZE_EXPR lhd_callgraph_analyze_expr diff --git a/gcc/langhooks.c b/gcc/langhooks.c index 5d4d63c7066..85ce93524bf 100644 --- a/gcc/langhooks.c +++ b/gcc/langhooks.c @@ -330,18 +330,6 @@ lhd_tree_inlining_auto_var_in_fn_p (tree var, tree fn) || TREE_CODE (var) == RESULT_DECL)); } -/* lang_hooks.tree_inlining.convert_parm_for_inlining performs any - language-specific conversion before assigning VALUE to PARM. */ - -tree -lhd_tree_inlining_convert_parm_for_inlining (tree parm ATTRIBUTE_UNUSED, - tree value, - tree fndecl ATTRIBUTE_UNUSED, - int argnum ATTRIBUTE_UNUSED) -{ - return value; -} - /* lang_hooks.tree_dump.dump_tree: Dump language-specific parts of tree nodes. Returns nonzero if it does not want the usual dumping of the second argument. */ diff --git a/gcc/langhooks.h b/gcc/langhooks.h index e48c0bca81c..1af85b348ea 100644 --- a/gcc/langhooks.h +++ b/gcc/langhooks.h @@ -42,7 +42,6 @@ struct lang_hooks_for_tree_inlining int (*disregard_inline_limits) (tree); int (*auto_var_in_fn_p) (tree, tree); bool (*var_mod_type_p) (tree, tree); - tree (*convert_parm_for_inlining) (tree, tree, tree, int); }; struct lang_hooks_for_callgraph diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 298ce3fa77f..c5c45270eb1 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,83 @@ +2007-06-25 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/32464 + * gfortran.dg/host_assoc_function_2.f90: New test. + + PR fortran/31494 + * gfortran.dg/host_assoc_call_1.f90: New test. + +2007-06-24 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + * gfortran.dg/secnds-1.f: Revise test to reduce random errors. + +2007-06-24 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/32456 + * gfortran.dg/error_format.f90: New test. + +2007-06-24 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/32136 + * gfortran.dg/pr32136.f90: New test. + +2007-06-24 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/31726 + * gfortran.dg/minmaxloc_1.f90: New test. + + PR fortran/32298 + * gfortran.dg/minmaxloc_2.f90: New test. + +2007-06-23 Mark Mitchell <mark@codesourcery.com> + + * gcc.dg/visibility-12.c: New test. + * gcc.dg/visibility-13.c: Likewise. + * g++.dg/ext/visibility-9.C: Likewise. + * g++.dg/ext/visibility-10.C: Likewise. + +2007-06-23 Richard Guenther <rguenther@suse.de> + + PR tree-optimization/16876 + PR middle-end/29478 + * gcc.dg/pr29254.c: The warning is bogus. + * gcc.dg/warn-1.c: Likewise. + * gcc.dg/assign-warn-3.c: Likewise. + * gcc.dg/noncompile/pr16876.c: The testcase is bogus, remove. + +2007-06-23 Richard Earnshaw <rearnsha@arm.com> + + * gcc.c-torture/execute/20070623-1.c: New. + +2007-06-22 Jan Hubicka <jh@suse.cz> + + * gcc.c-torture/compile/pr31541.c: New. + +2007-06-22 Uros Bizjak <ubizjak@gmail.com> + + * gcc.target/i386/large-size-array-3.c: Fix dg-do compile directive. + Remove -m64 from dg-options. + +2007-06-22 Uros Bizjak <ubizjak@gmail.com> + + PR middle-end/32374 + * gcc.dg/pr32374.c: New test. + +2007-06-22 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/32360 + * gfortran.dg/pointer_assign_3.f90: New test. + +2007-06-21 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/31162 + * gfortran.dg/assign.f90: Update test. + * gfortran.dg/real_do_1.f90: Update test. + * gfortran.dg/gomp/omp_do1.f90: Update test. + * gfortran.dg/warnings_are_errors_1.f: Update test. + * gfortran.dg/g77/20010519-1.f: Update test. + * gfortran.dg/g77/pr9258.f: Update test. + * gfortran.dg/g77/960317-1.f: Update test. + 2007-06-22 Chao-ying Fu <fu@mips.com> * gcc.dg/fixed-point/struct-union.c: Remove spaces. diff --git a/gcc/testsuite/gcc.c-torture/compile/pr31541.c b/gcc/testsuite/gcc.c-torture/compile/pr31541.c new file mode 100644 index 00000000000..0cac26ed092 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/pr31541.c @@ -0,0 +1,9 @@ +typedef unsigned char Uchar; +struct scsi_mode_header { + unsigned char sense_data_len : 8; +}; +int f(void) +{ + struct scsi_mode_header md; +return *(Uchar*)&md; +} diff --git a/gcc/testsuite/gcc.c-torture/execute/20070623-1.c b/gcc/testsuite/gcc.c-torture/execute/20070623-1.c new file mode 100644 index 00000000000..e9c7d2a952d --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/20070623-1.c @@ -0,0 +1,41 @@ +#include <limits.h> + +int __attribute__((noinline)) nge(int a, int b) {return -(a >= b);} +int __attribute__((noinline)) ngt(int a, int b) {return -(a > b);} +int __attribute__((noinline)) nle(int a, int b) {return -(a <= b);} +int __attribute__((noinline)) nlt(int a, int b) {return -(a < b);} +int __attribute__((noinline)) neq(int a, int b) {return -(a == b);} +int __attribute__((noinline)) nne(int a, int b) {return -(a != b);} +int __attribute__((noinline)) ngeu(unsigned a, unsigned b) {return -(a >= b);} +int __attribute__((noinline)) ngtu(unsigned a, unsigned b) {return -(a > b);} +int __attribute__((noinline)) nleu(unsigned a, unsigned b) {return -(a <= b);} +int __attribute__((noinline)) nltu(unsigned a, unsigned b) {return -(a < b);} + + +int main() +{ + if (nge(INT_MIN, INT_MAX) != 0) abort(); + if (nge(INT_MAX, INT_MIN) != -1) abort(); + if (ngt(INT_MIN, INT_MAX) != 0) abort(); + if (ngt(INT_MAX, INT_MIN) != -1) abort(); + if (nle(INT_MIN, INT_MAX) != -1) abort(); + if (nle(INT_MAX, INT_MIN) != 0) abort(); + if (nlt(INT_MIN, INT_MAX) != -1) abort(); + if (nlt(INT_MAX, INT_MIN) != 0) abort(); + + if (neq(INT_MIN, INT_MAX) != 0) abort(); + if (neq(INT_MAX, INT_MIN) != 0) abort(); + if (nne(INT_MIN, INT_MAX) != -1) abort(); + if (nne(INT_MAX, INT_MIN) != -1) abort(); + + if (ngeu(0, ~0U) != 0) abort(); + if (ngeu(~0U, 0) != -1) abort(); + if (ngtu(0, ~0U) != 0) abort(); + if (ngtu(~0U, 0) != -1) abort(); + if (nleu(0, ~0U) != -1) abort(); + if (nleu(~0U, 0) != 0) abort(); + if (nltu(0, ~0U) != -1) abort(); + if (nltu(~0U, 0) != 0) abort(); + + exit(0); +} diff --git a/gcc/testsuite/gcc.dg/assign-warn-3.c b/gcc/testsuite/gcc.dg/assign-warn-3.c index 1463fce0f68..86d1b3028f2 100644 --- a/gcc/testsuite/gcc.dg/assign-warn-3.c +++ b/gcc/testsuite/gcc.dg/assign-warn-3.c @@ -6,8 +6,8 @@ /* This is valid to execute, so maybe shouldn't warn at all. */ void f0(x) signed char *x; { } -void g0(unsigned char *x) { f0(x); } /* { dg-warning "warning: pointer targets in passing argument 1 of 'f0' differ in signedness" } */ +void g0(unsigned char *x) { f0(x); } /* { dg-bogus "warning: pointer targets in passing argument 1 of 'f0' differ in signedness" } */ /* This is undefined on execution but still must compile. */ void f1(x) int *x; { } -void g1(unsigned int *x) { f1(x); } /* { dg-warning "warning: pointer targets in passing argument 1 of 'f1' differ in signedness" } */ +void g1(unsigned int *x) { f1(x); } /* { dg-bogus "warning: pointer targets in passing argument 1 of 'f1' differ in signedness" } */ diff --git a/gcc/testsuite/gcc.dg/noncompile/pr16876.c b/gcc/testsuite/gcc.dg/noncompile/pr16876.c deleted file mode 100644 index 9587849b2fc..00000000000 --- a/gcc/testsuite/gcc.dg/noncompile/pr16876.c +++ /dev/null @@ -1,15 +0,0 @@ -/* { dg-options "-O -finline-functions" } */ - -static void g(); -struct bigstack { - char space[4096]; -}; - - -void f() { - g(0); /* { dg-error "incompatible type for argument 1 of 'g'" } */ -} - -static void g(struct bigstack bstack) { - g(bstack); -} diff --git a/gcc/testsuite/gcc.dg/pr29254.c b/gcc/testsuite/gcc.dg/pr29254.c index 98846a92090..598b6bf7b11 100644 --- a/gcc/testsuite/gcc.dg/pr29254.c +++ b/gcc/testsuite/gcc.dg/pr29254.c @@ -1,6 +1,5 @@ /* { dg-do compile } */ /* { dg-options "-O3 -Werror" } */ -/* { dg-message "warnings being treated as errors" "" {target "*-*-*"} 0 } */ list_compare (int * list1) { @@ -18,5 +17,5 @@ value_compare (int * a) func2 (const int * fb) { - func1 ((int *) fb); /* { dg-error "discards qualifiers" } */ + func1 ((int *) fb); /* { dg-bogus "discards qualifiers" } */ } diff --git a/gcc/testsuite/gcc.dg/pr32374.c b/gcc/testsuite/gcc.dg/pr32374.c new file mode 100644 index 00000000000..de15d559f5b --- /dev/null +++ b/gcc/testsuite/gcc.dg/pr32374.c @@ -0,0 +1,20 @@ +/* { dg-do compile } */ +/* { dg-options "-O2" } */ + +extern int *stderr; + +void f (int *, const char *, ...); + +void g (const char *conf_name) +{ + typedef struct + { + const char *label; + const int value; + } Section; + + const Section sections[2] = { {"", 0}, {"", 1} }; + + f (stderr, "", "", conf_name, 0, sections[0]); + f (stderr, "", "", conf_name, 0, sections[0]); +} diff --git a/gcc/testsuite/gcc.dg/tree-ssa/pr32461-1.c b/gcc/testsuite/gcc.dg/tree-ssa/pr32461-1.c new file mode 100644 index 00000000000..6e069886d1a --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/pr32461-1.c @@ -0,0 +1,24 @@ +/* { dg-do compile } */ +/* { dg-options "-O3" } */ + +typedef struct +{ + unsigned exp[256]; +} +expbap_t; + +void +a52_bit_allocate (expbap_t * expbap) +{ + int i; + unsigned *exp = expbap->exp; + char *bap; + + while (i < 3 || exp[i] > exp[i - 1]); + + do { + if (exp[i + 1] == exp[i]) + bap[i] = 0; + i++; + } while (i < 20); +} diff --git a/gcc/testsuite/gcc.dg/tree-ssa/pr32461-2.c b/gcc/testsuite/gcc.dg/tree-ssa/pr32461-2.c new file mode 100644 index 00000000000..81ee6ae953e --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/pr32461-2.c @@ -0,0 +1,26 @@ +/* { dg-do compile } */ +/* { dg-options "-O3" } */ + +typedef struct +{ + unsigned char exp[256]; +} +expbap_t; + +void +a52_bit_allocate (expbap_t * expbap) +{ + int i; + unsigned char *exp = expbap->exp; + int lowcomp; + + do + { + if (exp[i + 1] == exp[i] - 2) + lowcomp = 384; + else if (lowcomp && (exp[i + 1] > exp[i])) + lowcomp -= 64; + i++; + } + while ((i < 3) || ((i < 7) && (exp[i] > exp[i - 1]))); +} diff --git a/gcc/testsuite/gcc.dg/warn-1.c b/gcc/testsuite/gcc.dg/warn-1.c index dc2cd0e7c71..6db4ae5cd6c 100644 --- a/gcc/testsuite/gcc.dg/warn-1.c +++ b/gcc/testsuite/gcc.dg/warn-1.c @@ -12,5 +12,5 @@ void bar (void) { void *vp; - foo (vp); /* { dg-warning "passing argument 1 of" } */ + foo (vp); /* { dg-bogus "passing argument 1 of" } */ } diff --git a/gcc/testsuite/gcc.target/i386/large-size-array-3.c b/gcc/testsuite/gcc.target/i386/large-size-array-3.c index 2eac19cf1a7..3d321afa2c7 100644 --- a/gcc/testsuite/gcc.target/i386/large-size-array-3.c +++ b/gcc/testsuite/gcc.target/i386/large-size-array-3.c @@ -1,4 +1,4 @@ -/* { dg-do compile { target { { i?86-*-linux* x86_64-*-linux* } || { i?86-*-* x86_64-*-darwin* } } } } */ -/* { dg-options "-m64 -mcmodel=medium" } */ +/* { dg-do compile { target { { i?86-*-* x86_64-*-* } && lp64 } } } */ +/* { dg-options "-mcmodel=medium" } */ /* { dg-final { scan-assembler "8589934592|8589934588" } } */ int bigarray[2147483647]; diff --git a/gcc/testsuite/gfortran.dg/assign.f90 b/gcc/testsuite/gfortran.dg/assign.f90 index 516a3d7632a..2d9e497fbe9 100644 --- a/gcc/testsuite/gfortran.dg/assign.f90 +++ b/gcc/testsuite/gfortran.dg/assign.f90 @@ -3,6 +3,6 @@ program test integer i common i - assign 2000 to i ! { dg-warning "Obsolete: ASSIGN statement" } + assign 2000 to i ! { dg-warning "Deleted feature: ASSIGN statement" } 2000 continue end diff --git a/gcc/testsuite/gfortran.dg/error_format.f90 b/gcc/testsuite/gfortran.dg/error_format.f90 new file mode 100644 index 00000000000..227a3e0c8fa --- /dev/null +++ b/gcc/testsuite/gfortran.dg/error_format.f90 @@ -0,0 +1,11 @@ +! { dg-do run } +! { dg-shouldfail "Runtime error format check" } +! PR32456 IO error message should show Unit/Filename +program test + implicit none + integer :: i + open(99, status="scratch") + read(99,*) i +end program +! { dg-output ".*(unit = 99, file = .*)" } +! { dg-output "Fortran runtime error: End of file" } diff --git a/gcc/testsuite/gfortran.dg/fmt_huge.f90 b/gcc/testsuite/gfortran.dg/fmt_huge.f90 new file mode 100644 index 00000000000..43c4e2ac273 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/fmt_huge.f90 @@ -0,0 +1,6 @@ +! { dg-do run } +! PR32446 printing big numbers in F0.1 format. +! This segfaulted before the patch. + open (10, status="scratch") + write (10,'(F0.1)') huge(1.0) + END diff --git a/gcc/testsuite/gfortran.dg/g77/20010519-1.f b/gcc/testsuite/gfortran.dg/g77/20010519-1.f index e9336f1b6ab..beead98c7b9 100644 --- a/gcc/testsuite/gfortran.dg/g77/20010519-1.f +++ b/gcc/testsuite/gfortran.dg/g77/20010519-1.f @@ -711,19 +711,19 @@ C Begin 1 'NFREG IS LARGER THAN PARDIM*3') C C ALLOCATE-SPACE-FOR-TRANSROT-VECTORS - ASSIGN 801 TO I800 ! { dg-warning "Obsolete: ASSIGN" "Obsolete: ASSIGN" } + ASSIGN 801 TO I800 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" } GOTO 800 801 CONTINUE C ALLOCATE-SPACE-FOR-DIAGONALIZATION - ASSIGN 721 TO I720 ! { dg-warning "Obsolete: ASSIGN" "Obsolete: ASSIGN" } + ASSIGN 721 TO I720 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" } GOTO 720 721 CONTINUE C ALLOCATE-SPACE-FOR-REDUCED-BASIS - ASSIGN 761 TO I760 ! { dg-warning "Obsolete: ASSIGN" "Obsolete: ASSIGN" } + ASSIGN 761 TO I760 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" } GOTO 760 761 CONTINUE C ALLOCATE-SPACE-FOR-OTHER-ARRAYS - ASSIGN 921 TO I920 ! { dg-warning "Obsolete: ASSIGN" "Obsolete: ASSIGN" } + ASSIGN 921 TO I920 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" } GOTO 920 921 CONTINUE C @@ -731,12 +731,12 @@ C Space allocation for working arrays of EISPACK C diagonalization subroutines IF(LSCI) THEN C ALLOCATE-SPACE-FOR-LSCI - ASSIGN 841 TO I840 ! { dg-warning "Obsolete: ASSIGN" "Obsolete: ASSIGN" } + ASSIGN 841 TO I840 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" } GOTO 840 841 CONTINUE ELSE C ALLOCATE-DUMMY-SPACE-FOR-LSCI - ASSIGN 881 TO I880 ! { dg-warning "Obsolete: ASSIGN" "Obsolete: ASSIGN" } + ASSIGN 881 TO I880 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" } GOTO 880 881 CONTINUE ENDIF @@ -878,11 +878,11 @@ C C C DO-THE-DIAGONALISATIONS-WITH-RESIDUALS C - ASSIGN 621 TO I620 ! { dg-warning "Obsolete: ASSIGN" "Obsolete: ASSIGN" } + ASSIGN 621 TO I620 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" } GOTO 620 621 CONTINUE C SAVE-MODES - ASSIGN 701 TO I700 ! { dg-warning "Obsolete: ASSIGN" "Obsolete: ASSIGN" } + ASSIGN 701 TO I700 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" } GOTO 700 701 CONTINUE IF(ITER.EQ.ITMX) THEN @@ -1025,17 +1025,17 @@ C CALL PARTDS(NAT3,NPARC,ATMPAR,NPARS,ATMPAS,INIDS,NPARMX, 1 DDF,NFREG,CUTF1,PARDIM,NFCUT1) C DO-THE-DIAGONALISATIONS - ASSIGN 641 to I640 ! { dg-warning "Obsolete: ASSIGN" "Obsolete: ASSIGN" } + ASSIGN 641 to I640 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" } GOTO 640 641 CONTINUE QDIAG=.FALSE. C DO-THE-DIAGONALISATIONS-WITH-RESIDUALS - ASSIGN 622 TO I620 ! { dg-warning "Obsolete: ASSIGN" "Obsolete: ASSIGN" } + ASSIGN 622 TO I620 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" } GOTO 620 622 CONTINUE QDIAG=.TRUE. C SAVE-MODES - ASSIGN 702 TO I700 ! { dg-warning "Obsolete: ASSIGN" "Obsolete: ASSIGN" } + ASSIGN 702 TO I700 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" } GOTO 700 702 CONTINUE C @@ -1048,7 +1048,7 @@ C ITER=ITER+1 IF(PRNLEV.GE.2) WRITE(OUTU,553) ITER C DO-THE-DWIN-DIAGONALISATIONS - ASSIGN 661 TO I660 ! { dg-warning "Obsolete: ASSIGN" "Obsolete: ASSIGN" } + ASSIGN 661 TO I660 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" } GOTO 660 661 CONTINUE ENDIF @@ -1056,13 +1056,13 @@ C DO-THE-DWIN-DIAGONALISATIONS IRESF=0 QDIAG=.FALSE. C DO-THE-DIAGONALISATIONS-WITH-RESIDUALS - ASSIGN 623 TO I620 ! { dg-warning "Obsolete: ASSIGN" "Obsolete: ASSIGN" } + ASSIGN 623 TO I620 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" } GOTO 620 623 CONTINUE QDIAG=.TRUE. IF((CVGMX.LE.TOLDIM).OR.(ITER.EQ.ITMX)) GOTO 600 C SAVE-MODES - ASSIGN 703 TO I700 ! { dg-warning "Obsolete: ASSIGN" "Obsolete: ASSIGN" } + ASSIGN 703 TO I700 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" } GOTO 700 703 CONTINUE ENDIF @@ -1072,7 +1072,7 @@ C SAVE-MODES 600 CONTINUE C C SAVE-MODES - ASSIGN 704 TO I700 ! { dg-warning "Obsolete: ASSIGN" "Obsolete: ASSIGN" } + ASSIGN 704 TO I700 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" } GOTO 700 704 CONTINUE CALL CLEANHP(NAT3,NFREG,NPARD,NSUBP,PARDIM,DDV2,DDSS,DDVBAS, @@ -1150,7 +1150,7 @@ C 6 HEAP(BDRATQ),HEAP(INRATQ),LSCI,LBIG,IUNMOD) CALL SELNMD(DDF,NFRET,CUTF1,NFCUT1) ENDIF - GOTO I620 ! { dg-warning "Obsolete: Assigned" "Assigned GO TO" } + GOTO I620 ! { dg-warning "Deleted feature: Assigned" "Assigned GO TO" } C C----------------------------------------------------------------------- C TO DO-THE-DIAGONALISATIONS @@ -1190,7 +1190,7 @@ C TO DO-THE-DIAGONALISATIONS NFCUT1=NFCUT NFRET=NFCUT ENDDO - GOTO I640 ! { dg-warning "Obsolete: Assigned" "Assigned GO TO" } + GOTO I640 ! { dg-warning "Deleted feature: Assigned" "Assigned GO TO" } C C----------------------------------------------------------------------- C TO DO-THE-DWIN-DIAGONALISATIONS @@ -1241,7 +1241,7 @@ C IF(NFCUT.GT.NFRRES) NFCUT=NFRRES NFCUT1=NFCUT NFRET=NFCUT - GOTO I660 ! { dg-warning "Obsolete: Assigned" "Assigned GO TO" } + GOTO I660 ! { dg-warning "Deleted feature: Assigned" "Assigned GO TO" } C C----------------------------------------------------------------------- C TO SAVE-MODES @@ -1258,7 +1258,7 @@ C TO SAVE-MODES CALL WRTNMD(LCARD,ISTRT,ISTOP,NAT3,DDV,DDSCR,DDEV,IUNMOD, 1 AMASS) CALL SAVEIT(IUNMOD) - GOTO I700 ! { dg-warning "Obsolete: Assigned" "Assigned GO TO" } + GOTO I700 ! { dg-warning "Deleted feature: Assigned" "Assigned GO TO" } C C----------------------------------------------------------------------- C TO ALLOCATE-SPACE-FOR-DIAGONALIZATION @@ -1269,7 +1269,7 @@ C TO ALLOCATE-SPACE-FOR-DIAGONALIZATION JSPACE=JSPACE+JSP DDSS=ALLHP(JSPACE) DD5=DDSS+JSPACE-JSP - GOTO I720 ! { dg-warning "Obsolete: Assigned" "Assigned GO TO" } + GOTO I720 ! { dg-warning "Deleted feature: Assigned" "Assigned GO TO" } C C----------------------------------------------------------------------- C TO ALLOCATE-SPACE-FOR-REDUCED-BASIS @@ -1279,13 +1279,13 @@ C TO ALLOCATE-SPACE-FOR-REDUCED-BASIS ELSE DDVBAS=ALLHP(IREAL8(NFREG*NAT3)) ENDIF - GOTO I760 ! { dg-warning "Obsolete: Assigned" "Assigned GO TO" } + GOTO I760 ! { dg-warning "Deleted feature: Assigned" "Assigned GO TO" } C C----------------------------------------------------------------------- C TO ALLOCATE-SPACE-FOR-TRANSROT-VECTORS 800 CONTINUE TRAROT=ALLHP(IREAL8(6*NAT3)) - GOTO I800 ! { dg-warning "Obsolete: Assigned" "Assigned GO TO" } + GOTO I800 ! { dg-warning "Deleted feature: Assigned" "Assigned GO TO" } C C----------------------------------------------------------------------- C TO ALLOCATE-SPACE-FOR-LSCI @@ -1300,7 +1300,7 @@ C TO ALLOCATE-SPACE-FOR-LSCI E2RATQ=ALLHP(IREAL8(PARDIM+3)) BDRATQ=ALLHP(IREAL8(PARDIM+3)) INRATQ=ALLHP(INTEG4(PARDIM+3)) - GOTO I840 ! { dg-warning "Obsolete: Assigned" "Assigned GO TO" } + GOTO I840 ! { dg-warning "Deleted feature: Assigned" "Assigned GO TO" } C C----------------------------------------------------------------------- C TO ALLOCATE-DUMMY-SPACE-FOR-LSCI @@ -1315,13 +1315,13 @@ C TO ALLOCATE-DUMMY-SPACE-FOR-LSCI E2RATQ=ALLHP(IREAL8(2)) BDRATQ=ALLHP(IREAL8(2)) INRATQ=ALLHP(INTEG4(2)) - GOTO I880 ! { dg-warning "Obsolete: Assigned" "Assigned GO TO" } + GOTO I880 ! { dg-warning "Deleted feature: Assigned" "Assigned GO TO" } C C----------------------------------------------------------------------- C TO ALLOCATE-SPACE-FOR-OTHER-ARRAYS 920 CONTINUE IUPD=ALLHP(INTEG4(PARDIM+3)) - GOTO I920 ! { dg-warning "Obsolete: Assigned" "Assigned GO TO" } + GOTO I920 ! { dg-warning "Deleted feature: Assigned" "Assigned GO TO" } C.##ELSE C.##ENDIF END diff --git a/gcc/testsuite/gfortran.dg/g77/960317-1.f b/gcc/testsuite/gfortran.dg/g77/960317-1.f index f9a3ef2ce7a..c8b3b69baeb 100644 --- a/gcc/testsuite/gfortran.dg/g77/960317-1.f +++ b/gcc/testsuite/gfortran.dg/g77/960317-1.f @@ -14,7 +14,7 @@ C SUBROUTINE QUICK SAVE C - ASSIGN 101 TO JUMP ! { dg-warning "Obsolete: ASSIGN" "" } + ASSIGN 101 TO JUMP ! { dg-warning "Deleted feature: ASSIGN" "" } 101 Continue C RETURN diff --git a/gcc/testsuite/gfortran.dg/g77/pr9258.f b/gcc/testsuite/gfortran.dg/g77/pr9258.f index 6de78454ede..6213245566b 100644 --- a/gcc/testsuite/gfortran.dg/g77/pr9258.f +++ b/gcc/testsuite/gfortran.dg/g77/pr9258.f @@ -5,14 +5,14 @@ C { dg-do compile } SUBROUTINE FOO (B) 10 CALL BAR (A) - ASSIGN 20 TO M !{ dg-warning "Obsolete: ASSIGN" "" } + ASSIGN 20 TO M !{ dg-warning "Deleted feature: ASSIGN" "" } IF (100.LT.A) GOTO 10 GOTO 40 C 20 IF (B.LT.ABS(A)) GOTO 10 - ASSIGN 30 TO M !{ dg-warning "Obsolete: ASSIGN" "" } + ASSIGN 30 TO M !{ dg-warning "Deleted feature: ASSIGN" "" } GOTO 40 C - 30 ASSIGN 10 TO M !{ dg-warning "Obsolete: ASSIGN" "" } - 40 GOTO M,(10,20,30) !{ dg-warning "Obsolete: Assigned GOTO" "" } + 30 ASSIGN 10 TO M !{ dg-warning "Deleted feature: ASSIGN" "" } + 40 GOTO M,(10,20,30) !{ dg-warning "Deleted feature: Assigned GOTO" "" } END diff --git a/gcc/testsuite/gfortran.dg/gomp/omp_do1.f90 b/gcc/testsuite/gfortran.dg/gomp/omp_do1.f90 index 3dfd43d43e3..c97af1ddb8a 100644 --- a/gcc/testsuite/gfortran.dg/gomp/omp_do1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/omp_do1.f90 @@ -24,11 +24,11 @@ subroutine foo i = i + 1 end do !$omp do - do 300 d = 1, 30, 6 ! { dg-warning "Obsolete: REAL DO loop iterator" } + do 300 d = 1, 30, 6 ! { dg-warning "Deleted feature: Loop variable" } i = d 300 a(i) = 1 !$omp do - do d = 1, 30, 5 ! { dg-warning "Obsolete: REAL DO loop iterator" } + do d = 1, 30, 5 ! { dg-warning "Deleted feature: Loop variable" } i = d a(i) = 2 end do diff --git a/gcc/testsuite/gfortran.dg/host_assoc_call_1.f90 b/gcc/testsuite/gfortran.dg/host_assoc_call_1.f90 new file mode 100644 index 00000000000..804929080a1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/host_assoc_call_1.f90 @@ -0,0 +1,17 @@ +! { dg-do compile } +! Tests the fix for PR31494, where the call of sub2 would reference +! the variable, rather than the contained subroutine. +! +! Contributed by Michael Richmond <michael.a.richmond@nasa.gov> +! +MODULE ksbin2_aux_mod +REAL, DIMENSION(1) :: sub2 +CONTAINS + SUBROUTINE sub1 + CALL sub2 + CONTAINS + SUBROUTINE sub2 + END SUBROUTINE sub2 + END SUBROUTINE sub1 +END MODULE ksbin2_aux_mod +! { dg-final { cleanup-modules "ksbin2_aux_mod" } } diff --git a/gcc/testsuite/gfortran.dg/host_assoc_function_2.f90 b/gcc/testsuite/gfortran.dg/host_assoc_function_2.f90 new file mode 100644 index 00000000000..5d63d7aa378 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/host_assoc_function_2.f90 @@ -0,0 +1,48 @@ +! { dg-do compile } +! Tests the fix for PR32464, where the use associated procedure would +! mess up the check for "grandparent" host association. +! +! Contributed by Harald Anlauf <anlauf@gmx.de> +! + +module gfcbug64_mod1 + implicit none + + public :: inverse + + interface inverse + module procedure copy + end interface + +contains + + function copy (d) result (y) + real, intent(in) :: d(:) + real :: y(size (d)) ! <- this version kills gfortran +! real, intent(in) :: d +! real :: y + y = d + end function copy + +end module gfcbug64_mod1 + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +module gfcbug64_mod2 + implicit none +contains + + subroutine foo (x_o) + real, intent(in) :: x_o(:) + + integer :: s(size (x_o)) ! <- this line kills gfortran + + contains + + subroutine bar () + use gfcbug64_mod1, only: inverse ! <- this line kills gfortran + end subroutine bar + + end subroutine foo +end module gfcbug64_mod2 +! { dg-final { cleanup-modules "gfcbug64_mod1 gfcbug64_mod2" } } diff --git a/gcc/testsuite/gfortran.dg/minmaxloc_1.f90 b/gcc/testsuite/gfortran.dg/minmaxloc_1.f90 new file mode 100644 index 00000000000..fcdf7952e66 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/minmaxloc_1.f90 @@ -0,0 +1,118 @@ +! { dg-do run } +! Check max/minloc. +! PR fortran/31726 +! +program test + implicit none + integer :: i(1), j(-1:1), res(1) + logical, volatile :: m(3), m2(3) + m = (/ .false., .false., .false. /) + m2 = (/ .false., .true., .false. /) + call check(1, 0, MAXLOC((/ 42, 23, 11 /), DIM=1, MASK=.FALSE.)) + call check(2, 0, MAXLOC((/ 42, 23, 11 /), DIM=1, MASK=m)) + call check(3, 2, MAXLOC((/ 42, 23, 11 /), DIM=1, MASK=m2)) + call check(4, 0, MAXLOC(i(1:0), DIM=1, MASK=.TRUE.)) + call check(5, 0, MAXLOC(i(1:0), DIM=1, MASK=.FALSE.)) + call check(6, 0, MAXLOC(i(1:0), DIM=1, MASK=m(1:0))) + call check(7, 0, MAXLOC(i(1:0), DIM=1)) + call check(8, 0, MINLOC((/ 42, 23, 11 /), DIM=1, MASK=.FALSE.)) + call check(9, 0, MINLOC((/ 42, 23, 11 /), DIM=1, MASK=m)) + call check(10, 0, MINLOC(i(1:0), DIM=1, MASK=.FALSE.)) + call check(11,0, MINLOC(i(1:0), DIM=1, MASK=m(1:0))) + call check(12,0, MINLOC(i(1:0), DIM=1, MASK=.TRUE.)) + call check(13,0, MINLOC(i(1:0), DIM=1)) + + j = (/ 1, 2, 1 /); call check(14, 2, MAXLOC(j, DIM=1)) + j = (/ 1, 2, 3 /); call check(15, 3, MAXLOC(j, DIM=1)) + j = (/ 3, 2, 1 /); call check(16, 1, MAXLOC(j, DIM=1)) + j = (/ 1, 2, 1 /); call check(17, 1, MINLOC(j, DIM=1)) + j = (/ 1, 2, 3 /); call check(18, 1, MINLOC(j, DIM=1)) + j = (/ 3, 2, 1 /); call check(19, 3, MINLOC(j, DIM=1)) + + j = (/ 1, 2, 1 /); call check(20, 2, MAXLOC(j, DIM=1,mask=.true.)) + j = (/ 1, 2, 3 /); call check(21, 3, MAXLOC(j, DIM=1,mask=.true.)) + j = (/ 3, 2, 1 /); call check(22, 1, MAXLOC(j, DIM=1,mask=.true.)) + j = (/ 1, 2, 1 /); call check(23, 1, MINLOC(j, DIM=1,mask=.true.)) + j = (/ 1, 2, 3 /); call check(24, 1, MINLOC(j, DIM=1,mask=.true.)) + j = (/ 3, 2, 1 /); call check(25, 3, MINLOC(j, DIM=1,mask=.true.)) + + j = (/ 1, 2, 1 /); call check(26, 0, MAXLOC(j, DIM=1,mask=.false.)) + j = (/ 1, 2, 3 /); call check(27, 0, MAXLOC(j, DIM=1,mask=.false.)) + j = (/ 3, 2, 1 /); call check(28, 0, MAXLOC(j, DIM=1,mask=.false.)) + j = (/ 1, 2, 1 /); call check(29, 0, MINLOC(j, DIM=1,mask=.false.)) + j = (/ 1, 2, 3 /); call check(30, 0, MINLOC(j, DIM=1,mask=.false.)) + j = (/ 3, 2, 1 /); call check(31, 0, MINLOC(j, DIM=1,mask=.false.)) + + j = (/ 1, 2, 1 /); call check(32, 0, MAXLOC(j, DIM=1,mask=m)) + j = (/ 1, 2, 3 /); call check(33, 0, MAXLOC(j, DIM=1,mask=m)) + j = (/ 3, 2, 1 /); call check(34, 0, MAXLOC(j, DIM=1,mask=m)) + j = (/ 1, 2, 1 /); call check(35, 0, MINLOC(j, DIM=1,mask=m)) + j = (/ 1, 2, 3 /); call check(36, 0, MINLOC(j, DIM=1,mask=m)) + j = (/ 3, 2, 1 /); call check(37, 0, MINLOC(j, DIM=1,mask=m)) + + j = (/ 1, 2, 1 /); call check(38, 2, MAXLOC(j, DIM=1,mask=m2)) + j = (/ 1, 2, 3 /); call check(39, 2, MAXLOC(j, DIM=1,mask=m2)) + j = (/ 3, 2, 1 /); call check(40, 2, MAXLOC(j, DIM=1,mask=m2)) + j = (/ 1, 2, 1 /); call check(41, 2, MINLOC(j, DIM=1,mask=m2)) + j = (/ 1, 2, 3 /); call check(42, 2, MINLOC(j, DIM=1,mask=m2)) + j = (/ 3, 2, 1 /); call check(43, 2, MINLOC(j, DIM=1,mask=m2)) + +! Check the library minloc and maxloc + res = MAXLOC((/ 42, 23, 11 /), MASK=.FALSE.); call check(44, 0, res(1)) + res = MAXLOC((/ 42, 23, 11 /), MASK=m); call check(45, 0, res(1)) + res = MAXLOC((/ 42, 23, 11 /), MASK=m2); call check(46, 2, res(1)) + res = MAXLOC(i(1:0), MASK=.TRUE.); call check(47, 0, res(1)) + res = MAXLOC(i(1:0), MASK=.FALSE.); call check(48, 0, res(1)) + res = MAXLOC(i(1:0), MASK=m(1:0)); call check(49, 0, res(1)) + res = MAXLOC(i(1:0)); call check(50, 0, res(1)) + res = MINLOC((/ 42, 23, 11 /), MASK=.FALSE.); call check(51, 0, res(1)) + res = MINLOC((/ 42, 23, 11 /), MASK=m); call check(52, 0, res(1)) + res = MINLOC(i(1:0), MASK=.FALSE.); call check(53, 0, res(1)) + res = MINLOC(i(1:0), MASK=m(1:0)); call check(54,0, res(1)) + res = MINLOC(i(1:0), MASK=.TRUE.); call check(55,0, res(1)) + res = MINLOC(i(1:0)); call check(56,0, res(1)) + + j = (/ 1, 2, 1 /); res = MAXLOC(j); call check(57, 2, res(1)) + j = (/ 1, 2, 3 /); res = MAXLOC(j); call check(58, 3, res(1)) + j = (/ 3, 2, 1 /); res = MAXLOC(j); call check(59, 1, res(1)) + j = (/ 1, 2, 1 /); res = MINLOC(j); call check(60, 1, res(1)) + j = (/ 1, 2, 3 /); res = MINLOC(j); call check(61, 1, res(1)) + j = (/ 3, 2, 1 /); res = MINLOC(j); call check(62, 3, res(1)) + + j = (/ 1, 2, 1 /); res = MAXLOC(j,mask=.true.); call check(63, 2, res(1)) + j = (/ 1, 2, 3 /); res = MAXLOC(j,mask=.true.); call check(65, 3, res(1)) + j = (/ 3, 2, 1 /); res = MAXLOC(j,mask=.true.); call check(66, 1, res(1)) + j = (/ 1, 2, 1 /); res = MINLOC(j,mask=.true.); call check(67, 1, res(1)) + j = (/ 1, 2, 3 /); res = MINLOC(j,mask=.true.); call check(68, 1, res(1)) + j = (/ 3, 2, 1 /); res = MINLOC(j,mask=.true.); call check(69, 3, res(1)) + + j = (/ 1, 2, 1 /); res = MAXLOC(j,mask=.false.); call check(70, 0, res(1)) + j = (/ 1, 2, 3 /); res = MAXLOC(j,mask=.false.); call check(71, 0, res(1)) + j = (/ 3, 2, 1 /); res = MAXLOC(j,mask=.false.); call check(72, 0, res(1)) + j = (/ 1, 2, 1 /); res = MINLOC(j,mask=.false.); call check(73, 0, res(1)) + j = (/ 1, 2, 3 /); res = MINLOC(j,mask=.false.); call check(74, 0, res(1)) + j = (/ 3, 2, 1 /); res = MINLOC(j,mask=.false.); call check(75, 0, res(1)) + + j = (/ 1, 2, 1 /); res = MAXLOC(j,mask=m); call check(76, 0, res(1)) + j = (/ 1, 2, 3 /); res = MAXLOC(j,mask=m); call check(77, 0, res(1)) + j = (/ 3, 2, 1 /); res = MAXLOC(j,mask=m); call check(78, 0, res(1)) + j = (/ 1, 2, 1 /); res = MINLOC(j,mask=m); call check(79, 0, res(1)) + j = (/ 1, 2, 3 /); res = MINLOC(j,mask=m); call check(80, 0, res(1)) + j = (/ 3, 2, 1 /); res = MINLOC(j,mask=m);call check(81, 0, res(1)) + + j = (/ 1, 2, 1 /); res = MAXLOC(j,mask=m2); call check(82, 2, res(1)) + j = (/ 1, 2, 3 /); res = MAXLOC(j,mask=m2); call check(83, 2, res(1)) + j = (/ 3, 2, 1 /); res = MAXLOC(j,mask=m2); call check(84, 2, res(1)) + j = (/ 1, 2, 1 /); res = MINLOC(j,mask=m2); call check(85, 2, res(1)) + j = (/ 1, 2, 3 /); res = MINLOC(j,mask=m2); call check(86, 2, res(1)) + j = (/ 3, 2, 1 /); res = MINLOC(j,mask=m2); call check(87, 2, res(1)) + +contains +subroutine check(n, i,j) + integer, value, intent(in) :: i,j,n + if(i /= j) then + call abort() +! print *, 'ERROR: Test',n,' expected ',i,' received ', j + end if +end subroutine check +end program diff --git a/gcc/testsuite/gfortran.dg/minmaxloc_2.f90 b/gcc/testsuite/gfortran.dg/minmaxloc_2.f90 new file mode 100644 index 00000000000..a4fd7ae5e77 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/minmaxloc_2.f90 @@ -0,0 +1,29 @@ +! { dg-do run } +! Tests the fix for PR32298, in which the scalarizer would generate +! a temporary in the course of evaluating MINLOC or MAXLOC, thereby +! setting the start of the scalarizer loop to zero. +! +! Contributed by Jens Bischoff <jens.bischoff@freenet.de> +! +PROGRAM ERR_MINLOC + + INTEGER, PARAMETER :: N = 7 + + DOUBLE PRECISION, DIMENSION (N), PARAMETER :: A & + = (/ 0.3D0, 0.455D0, 0.6D0, 0.7D0, 0.72D0, 0.76D0, 0.79D0 /) + + DOUBLE PRECISION :: B + INTEGER :: I, J(N), K(N) + + DO I = 1, N + B = A(I) + J(I) = MINLOC (ABS (A - B), 1) + K(I) = MAXLOC (ABS (A - B), 1) + END DO + + if (any (J .NE. (/1,2,3,4,5,6,7/))) call abort () + if (any (K .NE. (/7,7,1,1,1,1,1/))) call abort () + + STOP + +END PROGRAM ERR_MINLOC diff --git a/gcc/testsuite/gfortran.dg/pointer_assign_3.f90 b/gcc/testsuite/gfortran.dg/pointer_assign_3.f90 new file mode 100644 index 00000000000..432d59fffe9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pointer_assign_3.f90 @@ -0,0 +1,6 @@ +! { dg-do compile } +! PR32360 Won't compile 'data ptr1 /null ()/' when ptr1 has pointer attribute. + integer, pointer :: ptr1 + data ptr1 /NULL()/ + end + diff --git a/gcc/testsuite/gfortran.dg/pr32136.f90 b/gcc/testsuite/gfortran.dg/pr32136.f90 new file mode 100644 index 00000000000..304b7b4a212 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr32136.f90 @@ -0,0 +1,11 @@ +! { dg-do run } +! { dg-options "-std=gnu" } +! Tests PR32136, which went away! +! +! Contributed by Tobias Burnus <burnus@gcc.gnu.org> +! +real(kind(0d0)), parameter :: r(1) = & + transfer(transfer(sqrt(2d0), (/ .true. /) ), (/ 0d0 /), 1) + if (r(1) .ne. sqrt(2d0)) call abort () +end + diff --git a/gcc/testsuite/gfortran.dg/private_type_6.f90 b/gcc/testsuite/gfortran.dg/private_type_6.f90 new file mode 100644 index 00000000000..0d7ec534be0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/private_type_6.f90 @@ -0,0 +1,25 @@ +! { dg-do compile } +! PR fortran/32460 +! +module foomod + implicit none + type :: footype + private + integer :: dummy + end type footype + TYPE :: bartype + integer :: dummy + integer, private :: dummy2 + end type bartype +end module foomod + +program foo_test + USE foomod + implicit none + TYPE(footype) :: foo + TYPE(bartype) :: foo2 + foo = footype(1) ! { dg-error "has PRIVATE components" } + foo2 = bartype(1,2) ! { dg-error "has PRIVATE components" } + foo2%dummy2 = 5 ! { dg-error "is a PRIVATE component" } +end program foo_test +! { dg-final { cleanup-tree-dump "foomod" } } diff --git a/gcc/testsuite/gfortran.dg/real_do_1.f90 b/gcc/testsuite/gfortran.dg/real_do_1.f90 index 89a9d1b9b59..95fb47378a5 100644 --- a/gcc/testsuite/gfortran.dg/real_do_1.f90 +++ b/gcc/testsuite/gfortran.dg/real_do_1.f90 @@ -1,4 +1,8 @@ ! { dg-do run } +! { dg-warning "Loop variable" "Loop" { target *-*-* } 13 } +! { dg-warning "Start expression" "Start" { target *-*-* } 13 } +! { dg-warning "End expression" "End" { target *-*-* } 13 } +! { dg-warning "Step expression" "Step" { target *-*-* } 13 } ! Test REAL type iterators in DO loops program real_do_1 real x, y @@ -6,7 +10,7 @@ program real_do_1 n = 0 y = 1.0 - do x = 1.0, 2.05, 0.1 ! { dg-warning "REAL DO loop" "" } + do x = 1.0, 2.05, 0.1 call check (x, y) y = y + 0.1 n = n + 1 diff --git a/gcc/testsuite/gfortran.dg/secnds-1.f b/gcc/testsuite/gfortran.dg/secnds-1.f index 5ac2bce154f..c5f528357ad 100644 --- a/gcc/testsuite/gfortran.dg/secnds-1.f +++ b/gcc/testsuite/gfortran.dg/secnds-1.f @@ -6,18 +6,25 @@ C Contributed by Paul Thomas <pault@gcc.gnu.org> C character*20 dum1, dum2, dum3 real t1, t1a, t2, t2a - real*8 dat1, dat2 - integer i, j, values(8) + real*4 dat1, dat2 + integer i, j, values(8), k t1 = secnds (0.0) call date_and_time (dum1, dum2, dum3, values) t1a = secnds (0.0) - dat1 = 0.001*real (values(8)) + real (values(7)) + - & 60.0*real (values(6)) + 3600.0* real (values(5)) - if (((dat1 - t1) < 0.) .or. ((dat1 - t1) > (t1a - t1))) call abort () + dat1 = 0.001 * real(values(8)) + real(values(7)) + + & 60.0 * real(values(6)) + 3600.0 * real(values(5)) + ! handle midnight shift + if ((t1a - t1) < -12.0*3600.0 ) t1 = t1 - 24.0*3600.0 + if ((t1a - dat1) < -12.0*3600.0 ) dat1 = dat1 - 24.0*3600.0 + if ((dat1 < nearest(t1, -1.)) .or. (dat1 > nearest(t1a, 1.))) + & call abort () t2a = secnds (t1a) call date_and_time (dum1, dum2, dum3, values) t2 = secnds (t1) - dat2 = 0.001*real (values(8)) + real (values(7)) + - & 60.0*real (values(6)) + 3600.0* real (values(5)) - if (((dat2 - dat1) < t2a) .or. ((dat2 - dat1) > t2)) call abort () + dat2 = 0.001 * real(values(8)) + real(values(7)) + + & 60.0 * real(values(6)) + 3600.0 * real(values(5)) + ! handle midnight shift + if ((dat2 - dat1) < -12.0*3600.0 ) dat1 = dat1 - 24.0*3600.0 + if (((dat2 - dat1) < t2a - 0.008) .or. + & ((dat2 - dat1) > t2 + 0.008)) call abort () end diff --git a/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f b/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f index 26c4e26b4db..2452b497151 100644 --- a/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f +++ b/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f @@ -12,7 +12,7 @@ ! 34 5 i=0 ! gfc_notify_std(GFC_STD_F95_DEL): - do r1 = 1.0, 2 ! { dg-warning "Obsolete: REAL DO loop iterator" } + do r1 = 1, 2 ! { dg-error "Deleted feature: Loop variable" } i = i+1 end do call foo j bar diff --git a/gcc/tree-inline.c b/gcc/tree-inline.c index a0c514a0f5c..3f4093b6063 100644 --- a/gcc/tree-inline.c +++ b/gcc/tree-inline.c @@ -1452,7 +1452,6 @@ initialize_inlined_parameters (copy_body_data *id, tree exp, tree a; tree p; tree vars = NULL_TREE; - int argnum = 0; call_expr_arg_iterator iter; tree static_chain = CALL_EXPR_STATIC_CHAIN (exp); @@ -1463,17 +1462,7 @@ initialize_inlined_parameters (copy_body_data *id, tree exp, equivalent VAR_DECL, appropriately initialized. */ for (p = parms, a = first_call_expr_arg (exp, &iter); p; a = next_call_expr_arg (&iter), p = TREE_CHAIN (p)) - { - tree value; - - ++argnum; - - /* Find the initializer. */ - value = lang_hooks.tree_inlining.convert_parm_for_inlining - (p, a, fn, argnum); - - setup_one_parameter (id, p, value, fn, bb, &vars); - } + setup_one_parameter (id, p, a, fn, bb, &vars); /* Initialize the static chain. */ p = DECL_STRUCT_FUNCTION (fn)->static_chain_decl; diff --git a/gcc/tree.c b/gcc/tree.c index 41cc07accf9..60ee18faa63 100644 --- a/gcc/tree.c +++ b/gcc/tree.c @@ -4035,18 +4035,25 @@ handle_dll_attribute (tree * pnode, tree name, tree args, int flags, *no_add_attrs = true; return tree_cons (name, args, NULL_TREE); } - if (TREE_CODE (node) != RECORD_TYPE && TREE_CODE (node) != UNION_TYPE) + if (TREE_CODE (node) == RECORD_TYPE + || TREE_CODE (node) == UNION_TYPE) + { + node = TYPE_NAME (node); + if (!node) + return NULL_TREE; + } + else { warning (OPT_Wattributes, "%qs attribute ignored", IDENTIFIER_POINTER (name)); *no_add_attrs = true; + return NULL_TREE; } - - return NULL_TREE; } if (TREE_CODE (node) != FUNCTION_DECL - && TREE_CODE (node) != VAR_DECL) + && TREE_CODE (node) != VAR_DECL + && TREE_CODE (node) != TYPE_DECL) { *no_add_attrs = true; warning (OPT_Wattributes, "%qs attribute ignored", @@ -4109,6 +4116,22 @@ handle_dll_attribute (tree * pnode, tree name, tree args, int flags, *no_add_attrs = true; } + /* A dllexport'd entity must have default visibility so that other + program units (shared libraries or the main executable) can see + it. A dllimport'd entity must have default visibility so that + the linker knows that undefined references within this program + unit can be resolved by the dynamic linker. */ + if (!*no_add_attrs) + { + if (DECL_VISIBILITY_SPECIFIED (node) + && DECL_VISIBILITY (node) != VISIBILITY_DEFAULT) + error ("%qs implies default visibility, but %qD has already " + "been declared with a different visibility", + IDENTIFIER_POINTER (name), node); + DECL_VISIBILITY (node) = VISIBILITY_DEFAULT; + DECL_VISIBILITY_SPECIFIED (node) = 1; + } + return NULL_TREE; } diff --git a/gcc/tree.h b/gcc/tree.h index ebd6fda4f86..c700cdae116 100644 --- a/gcc/tree.h +++ b/gcc/tree.h @@ -450,7 +450,10 @@ struct gimple_stmt GTY(()) POINTER_TYPE, REFERENCE_TYPE MOVE_NONTEMPORAL in GIMPLE_MODIFY_STMT - CASE_HIGH_SEEN in CASE_LABEL_EXPR + CASE_HIGH_SEEN in + CASE_LABEL_EXPR + CALL_CANNOT_INLINE_P in + CALL_EXPR public_flag: @@ -1165,6 +1168,9 @@ extern void omp_clause_range_check_failed (const tree, const char *, int, #define CASE_HIGH_SEEN(NODE) \ (CASE_LABEL_EXPR_CHECK (NODE)->base.static_flag) +/* Used to mark a CALL_EXPR as not suitable for inlining. */ +#define CALL_CANNOT_INLINE_P(NODE) ((NODE)->base.static_flag) + /* In an expr node (usually a conversion) this means the node was made implicitly and should not lead to any sort of warning. In a decl node, warnings concerning the decl should be suppressed. This is used at diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 8df6b35529b..fc8e1edf2b5 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,26 @@ +2007-06-24 Adam Nemet <anemet@caviumnetworks.com> + + PR libfortran/32495 + * runtime/backtrace.c (local_strcasestr): Rename from strcasestr. + (show_backtrace): Rename strcasestr to local_strcasestr. + +2007-06-24 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR libgfortran/32456 + * runtime/error.c (show_locus): Update to emit the unit number + and file name involved with the error. Use new function + filename_from_unit. + * libgfortran.h (filename_from_unit): Declare new function. + * io/unit.c (init_units): Set the unit file name for stdin, stdout, + and stderr for use later in error reporting. + (filename_from_unit): Add this new function. + +2007-06-24 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR libgfortran/32446 + * io/write.c (output_float): Calculate ndigits correctly for large + numbered formats that must pad zeros before the decimal point. + 2007-06-15 Rainer Orth <ro@TechFak.Uni-Bielefeld.DE> PR libfortran/32345 diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c index c468510b875..9297af08521 100644 --- a/libgfortran/io/unit.c +++ b/libgfortran/io/unit.c @@ -84,6 +84,12 @@ __gthread_mutex_t unit_lock = __GTHREAD_MUTEX_INIT; __gthread_mutex_t unit_lock; #endif +/* We use these filenames for error reporting. */ + +static char stdin_name[] = "stdin"; +static char stdout_name[] = "stdout"; +static char stderr_name[] = "stderr"; + /* This implementation is based on Stefan Nilsson's article in the * July 1997 Doctor Dobb's Journal, "Treaps in Java". */ @@ -506,6 +512,10 @@ init_units (void) u->recl = options.default_recl; u->endfile = NO_ENDFILE; + u->file_len = strlen (stdin_name); + u->file = get_mem (u->file_len); + memmove (u->file, stdin_name, u->file_len); + __gthread_mutex_unlock (&u->lock); } @@ -524,6 +534,10 @@ init_units (void) u->recl = options.default_recl; u->endfile = AT_ENDFILE; + + u->file_len = strlen (stdout_name); + u->file = get_mem (u->file_len); + memmove (u->file, stdout_name, u->file_len); __gthread_mutex_unlock (&u->lock); } @@ -544,6 +558,10 @@ init_units (void) u->recl = options.default_recl; u->endfile = AT_ENDFILE; + u->file_len = strlen (stderr_name); + u->file = get_mem (u->file_len); + memmove (u->file, stderr_name, u->file_len); + __gthread_mutex_unlock (&u->lock); } @@ -665,3 +683,24 @@ update_position (gfc_unit *u) else u->flags.position = POSITION_ASIS; } + + +/* filename_from_unit()-- If the unit_number exists, return a pointer to the + name of the associated file, otherwise return the empty string. The caller + must free memory allocated for the filename string. */ + +char * +filename_from_unit (int unit_number) +{ + char *filename; + gfc_unit *u = NULL; + u = find_unit (unit_number); + if (u != NULL) + { + filename = (char *) get_mem (u->file_len + 1); + unpack_filename (filename, u->file, u->file_len); + return filename; + } + else + return (char *) NULL; +}
\ No newline at end of file diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c index e0c507f4750..f156d19862b 100644 --- a/libgfortran/io/write.c +++ b/libgfortran/io/write.c @@ -810,16 +810,21 @@ output_float (st_parameter_dt *dtp, const fnode *f, GFC_REAL_LARGEST value) if (nbefore > 0) { if (nbefore > ndigits) - i = ndigits; + { + i = ndigits; + memcpy (out, digits, i); + ndigits = 0; + while (i < nbefore) + out[i++] = '0'; + } else - i = nbefore; - - memcpy (out, digits, i); - while (i < nbefore) - out[i++] = '0'; + { + i = nbefore; + memcpy (out, digits, i); + ndigits -= i; + } digits += i; - ndigits -= i; out += nbefore; } /* Output the decimal point. */ diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h index d42302a3002..e0801a14d16 100644 --- a/libgfortran/libgfortran.h +++ b/libgfortran/libgfortran.h @@ -683,6 +683,9 @@ extern int st_printf (const char *, ...) __attribute__ ((format (printf, 1, 2))); internal_proto(st_printf); +extern char * filename_from_unit (int); +internal_proto(filename_from_unit); + /* stop.c */ extern void stop_numeric (GFC_INTEGER_4) __attribute__ ((noreturn)); diff --git a/libgfortran/runtime/backtrace.c b/libgfortran/runtime/backtrace.c index 3577c6476a6..684ac00c9a0 100644 --- a/libgfortran/runtime/backtrace.c +++ b/libgfortran/runtime/backtrace.c @@ -68,11 +68,13 @@ Boston, MA 02110-1301, USA. */ -#ifndef HAVE_STRCASESTR -#define HAVE_STRCASESTR 1 static char * -strcasestr (const char *s1, const char *s2) +local_strcasestr (const char *s1, const char *s2) { +#ifdef HAVE_STRCASESTR + return strcasestr (s1, s2); +#else + const char *p = s1; const size_t len = strlen (s2); const char u = *s2, v = isupper((int) *s2) ? tolower((int) *s2) @@ -88,8 +90,8 @@ strcasestr (const char *s1, const char *s2) if (strncasecmp (p, s2, len) == 0) return (char *)p; } -} #endif +} #define CAN_FORK (defined(HAVE_FORK) && defined(HAVE_EXECVP) \ && defined(HAVE_WAIT)) @@ -224,9 +226,9 @@ show_backtrace (void) || strcmp (func, "main") == 0 || strcmp (func, "_start") == 0) continue; - if (strcasestr (str[i], "libgfortran.so") != NULL - || strcasestr (str[i], "libgfortran.dylib") != NULL - || strcasestr (str[i], "libgfortran.a") != NULL) + if (local_strcasestr (str[i], "libgfortran.so") != NULL + || local_strcasestr (str[i], "libgfortran.dylib") != NULL + || local_strcasestr (str[i], "libgfortran.a") != NULL) continue; /* If we only have the address, use the glibc backtrace. */ diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c index bd3c306bc2f..959a44b97d1 100644 --- a/libgfortran/runtime/error.c +++ b/libgfortran/runtime/error.c @@ -248,8 +248,22 @@ st_sprintf (char *buffer, const char *format, ...) void show_locus (st_parameter_common *cmp) { + static char *filename; + if (!options.locus || cmp == NULL || cmp->filename == NULL) return; + + if (cmp->unit > 0) + { + filename = filename_from_unit (cmp->unit); + if (filename != NULL) + { + st_printf ("At line %d of file %s (unit = %d, file = '%s')\n", + (int) cmp->line, cmp->filename, cmp->unit, filename); + free_mem (filename); + } + return; + } st_printf ("At line %d of file %s\n", (int) cmp->line, cmp->filename); } |