diff options
| author | bstarynk <bstarynk@138bc75d-0d04-0410-961f-82ee72b054a4> | 2013-01-03 09:01:56 +0000 |
|---|---|---|
| committer | bstarynk <bstarynk@138bc75d-0d04-0410-961f-82ee72b054a4> | 2013-01-03 09:01:56 +0000 |
| commit | 75bd5a1db9c6c967878fc8a466ce504a1f6ee96b (patch) | |
| tree | 7ebdbe10606d582163269a093592c719d2192347 /gcc | |
| parent | 19854ff430ae0ea2882baa0775221bfb58b8719a (diff) | |
| download | gcc-75bd5a1db9c6c967878fc8a466ce504a1f6ee96b.tar.gz | |
2013-01-03 Basile Starynkevitch <basile@starynkevitch.net>
MELT branch merged with trunk rev 194833 using svnmerge.py
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@194835 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc')
234 files changed, 5266 insertions, 2572 deletions
diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 90ecae0e034..b1dda601096 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,217 @@ +2013-01-02 Gerald Pfeifer <gerald@pfeifer.com> + + * doc/contrib.texi: Note years as release manager for Mark Mitchell. + +2013-01-02 Teresa Johnson <tejohnson@google.com> + + * dumpfile.c (dump_loc): Print filename with location. + * tree-ssa-loop-ivcanon.c (try_unroll_loop_completely): Use + new location_t parameter to emit complete unroll message with + new dump framework. + (canonicalize_loop_induction_variables): Compute loops location + and pass to try_unroll_loop_completely. + * loop-unroll.c (report_unroll_peel): New function. + (peel_loops_completely): Use new dump format with location + for main dumpfile message, and invoke report_unroll_peel on success. + (decide_unrolling_and_peeling): Ditto. + (decide_peel_once_rolling): Remove old dumpfile message subsumed + by report_unroll_peel. + (decide_peel_completely): Ditto. + (decide_unroll_constant_iterations): Ditto. + (decide_unroll_runtime_iterations): Ditto. + (decide_peel_simple): Ditto. + (decide_unroll_stupid): Ditto. + * cfgloop.c (get_loop_location): New function. + * cfgloop.h (get_loop_location): Declare. + + testsuite/ + * gcc.dg/tree-ssa/loop-1.c: Update expected dump message. + * gcc.dg/tree-ssa/loop-23.c: Ditto. + * gcc.dg/tree-ssa/cunroll-1.c: Ditto. + * gcc.dg/tree-ssa/cunroll-2.c: Ditto. + * gcc.dg/tree-ssa/cunroll-3.c: Ditto. + * gcc.dg/tree-ssa/cunroll-4.c: Ditto. + * gcc.dg/tree-ssa/cunroll-5.c: Ditto. + * gcc.dg/unroll_1.c: Ditto. + * gcc.dg/unroll_2.c: Ditto. + * gcc.dg/unroll_3.c: Ditto. + * gcc.dg/unroll_4.c: Ditto. + +2013-01-02 Sriraman Tallam <tmsriram@google.com> + + * config/i386/i386.c (fold_builtin_cpu): Remove unnecessary checks for + NULL. + +2013-01-02 John David Anglin <dave.anglin@nrc-cnrc.gc.ca> + + PR middle-end/55198 + * expr.c (expand_expr_real_1): Don't use bitfield extraction for non + BLKmode objects when EXPAND_MEMORY is specified. + +2013-01-02 Sriraman Tallam <tmsriram@google.com> + + * config/i386/i386.c (ix86_get_function_versions_dispatcher): Fix bug + in loop predicate. + (fold_builtin_cpu): Do not share cpu model decls across statements. + +2013-01-02 Jason Merrill <jason@redhat.com> + + PR c++/55804 + * tree.c (build_array_type_1): Revert earlier change. + +2013-01-02 Yufeng Zhang <yufeng.zhang@arm.com> + + * config/aarch64/aarch64-cores.def: Add entries for "cortex-a53" and + "cortex-a57". + * config/aarch64/aarch64-tune.md: Re-generate. + +2013-01-02 Richard Biener <rguenther@suse.de> + + * tree-vect-stmts.c (vectorizable_load): When vectorizing an + invariant load do not generate a vector load from the scalar + location. + +2013-01-02 Richard Biener <rguenther@suse.de> + + PR bootstrap/55784 + * configure.ac: Add $GMPINC to CFLAGS/CXXFLAGS. + * configure: Regenerate. + +2013-01-02 Richard Sandiford <rdsandiford@googlemail.com> + + * builtins.c (expand_builtin_mathfn, expand_builtin_mathfn_2) + (expand_builtin_mathfn_ternary, expand_builtin_mathfn_3) + (expand_builtin_int_roundingfn_2): Keep the original target around + for the fallback case. + +2013-01-02 Richard Sandiford <rdsandiford@googlemail.com> + + * tree-vrp.c (range_fits_type_p): Require the MSB of the double_int + to be clear for sign changes. + +2013-01-01 Jan Hubicka <jh@suse.cz> + + * ipa-inline-analysis.c: Fix formatting. + +2013-01-01 Jakub Jelinek <jakub@redhat.com> + + PR tree-optimization/55831 + * tree-vect-loop.c (get_initial_def_for_induction): Use + gsi_after_labels instead of gsi_start_bb. + +2012-12-27 David Edelsohn <dje.gcc@gmail.com> + + * config/rs6000/rs6000.c (rs6000_deligitimze_address): Do not + delegitimize TLS addresses on AIX. + (rs6000_legitimize_tls_address_aix): Append TLS symbol qualifier. + Set SYMBOL_FLAG_LOCAL on module symbol. + (output_toc): Do not append TLS symbol qualifier here. + * config/rs6000/rs6000.md (tls_get_addr_internal): Add GPR 4 to + clobbers. + +2012-12-27 Andreas Schwab <schwab@linux-m68k.org> + + * target.def (supports_function_versions): Fix typo. + +2012-12-26 Sriraman Tallam <tmsriram@google.com> + + * doc/tm.texi.in (TARGET_OPTION_SUPPORTS_FUNCTION_VERSIONS): Document + new target hook. + * doc/tm.texi: Regenerate. + * c-family/c-common.c (handle_target_attribute): Retain target attribute + for targets that support versioning. + * target.def (supports_function_versions): New hook. + * cp/class.c (add_method): Remove calls + to DECL_FUNCTION_SPECIFIC_TARGET. + * config/i386/i386.c (ix86_function_versions): Use target string + to check for function versions instead of target flags. + * (ix86_supports_function_versions): New function. + * (is_function_default_version): Check target string. + * TARGET_OPTION_SUPPORTS_FUNCTION_VERSIONS: New macro. + +2012-12-27 Steven Bosscher <steven@gcc.gnu.org> + + * cgraph.c (verify_cgraph_node): Don't allocate/free visited_nodes set. + +2012-12-25 John David Anglin <dave.anglin@nrc-cnrc.gc.ca> + + PR target/53789 + * config/pa/pa.md (movsi): Reject expansion of TLS symbol references + after reload starts. + +2012-12-22 Jan Hubicka <jh@suse.cz> + + PR lto/54728 + * cgraph.h (symtab_real_symbol_p): Drop code looking for external functions. + * lto-streamer-out.c (output_symbol_p): New function. + (produce_symtab) Use it. + +2012-12-21 Martin Jambor <mjambor@suse.cz> + + PR tree-optimization/55355 + * tree-sra.c (type_internals_preclude_sra_p): Also check that + bit_position is small enough to fit a single HOST_WIDE_INT. + +2012-12-21 Eric Botcazou <ebotcazou@adacore.com> + + * rtlanal.c (volatile_insn_p): Delete commented out code. + (side_effects_p): Likewise. + (may_trap_p_1) <UNSPEC_VOLATILE>: Return 1 again. + * target.def (unspec_may_trap_p): Adjust comment. + * targhooks.c (default_unspec_may_trap_p): Don't handle UNSPEC_VOLATILE. + * config/ia64/ia64.c (ia64_unspec_may_trap_p): Adjust to above change. + +2012-12-21 Vladimir Makarov <vmakarov@redhat.com> + + PR middle-end/55775 + * lra-assigns.c (improve_inheritance): Do nothing after + LRA_MAX_INHERITANCE_PASSES pass. + * lra-constraints.c (MAX_CONSTRAINT_ITERATION_NUMBER): Rename to + LRA_MAX_CONSTRAINT_ITERATION_NUMBER. Move to lra-int.h. + (MAX_INHERITANCE_PASSES): Rename to LRA_MAX_INHERITANCE_PASSES. + Move to lra-int.h. + * lra-int.h (LRA_MAX_CONSTRAINT_ITERATION_NUMBER): Move from + lra-constraints.c. + (LRA_MAX_INHERITANCE_PASSES): Ditto. + +2012-12-21 Steve Ellcey <sellcey@mips.com> + + PR bootstrap/54128 + * ira.c (build_insn_chain): Check only NONDEBUG instructions for + register usage. + +2012-12-21 David Edelsohn <dje.gcc@gmail.com> + + * varasm.c (bss_initializer_p): Remove static. + * output.h (bss_initializer_p): Declare. + * xcoffout.c (xcoff_tbss_section_name): Define. + * xcoffout.h (xcoff_tbss_section_name): Declare. + * config/rs6000/xcoff.h (TARGET_ENCODE_SECTION_INFO): Define. + (ASM_OUTPUT_TLS_COMMON): Merge strings. + * config/rs6000/rs6000.c (tls_private_data_section): New. + (output_toc): Only output CSECT decoration for TLS. + Output appropriate CSECT for data or bss. + (rs6000_xcoff_asm_init_sections) Define tls_private_data_section. + (rs6000_xcoff_select_section): Handle TLS bss and private data. + (rs6000_xcoff_file_start): Generate xcoff_tbss_section_name. + (rs6000_xcoff_encode_section_info): Strip SYMBOL_FLAG_HAS_BLOCK_INFO + from native TLS symbols. + +2012-12-21 Richard Biener <rguenther@suse.de> + + PR rtl-optimization/52996 + * cprop.c (bypass_block): When loops are to be preserved + do not bypass loop headers. Revert earlier kludge to remove + loops when doing that. + +2012-12-21 Richard Biener <rguenther@suse.de> + + PR bootstrap/54659 + * system.h: Include gmp.h. + * tree-ssa-loop-niter.c: Do not include gmp.h here. + * double-int.h: Likewise. + * realmpfr.h: Likewise. + 2012-12-21 Greta Yorsh <Greta.Yorsh@arm.com> * config/arm/cortex-a7.md: New file. @@ -12762,18 +12976,14 @@ 2012-08-22 H.J. Lu <hongjiu.lu@intel.com> * doc/invoke.texi: Document -mlong-double-64/-mlong-double-80. - * config/i386/i386.c (flag_opts): Add -mlong-double-64. (TARGET_HAS_BIONIC): Default long double to 64-bit for Bionic. - * config/i386/i386.h (LONG_DOUBLE_TYPE_SIZE): Use 64 if TARGET_LONG_DOUBLE_64 is true. (LIBGCC2_LONG_DOUBLE_TYPE_SIZE): New macro. (WIDEST_HARDWARE_FP_SIZE): Defined to 80. - * config/i386/i386.opt (mlong-double-80): New option. (mlong-double-64): Likewise. - * config/i386/i386-c.c (ix86_target_macros): Define __LONG_DOUBLE_64__ for TARGET_LONG_DOUBLE_64. @@ -13185,7 +13395,6 @@ PR target/20020 * config/i386/i386.c (ix86_member_type_forces_blk): New function. (TARGET_MEMBER_TYPE_FORCES_BLK): New macro. - * config/i386/i386.h (MAX_FIXED_MODE_SIZE): New macro. 2012-08-17 Marc Glisse <marc.glisse@inria.fr> @@ -13198,31 +13407,21 @@ * stor-layout.c (compute_record_mode): Replace MEMBER_TYPE_FORCES_BLK with targetm.member_type_forces_blk. (layout_type): Likewise. - * system.h: Poison MEMBER_TYPE_FORCES_BLK. - * target.def (member_type_forces_blk): New target hook. - * targhooks.c (default_member_type_forces_blk): New. * targhooks.h (default_member_type_forces_blk): Likewise. - * doc/tm.texi.in (MEMBER_TYPE_FORCES_BLK): Removed. (TARGET_MEMBER_TYPE_FORCES_BLK): New hook. * doc/tm.texi: Regenerated. - * config/ia64/hpux.h (MEMBER_TYPE_FORCES_BLK): Removed. - * config/ia64/ia64.c (ia64_member_type_forces_blk): New function. (TARGET_MEMBER_TYPE_FORCES_BLK): New macro. - * config/rs6000/rs6000.c (TARGET_MEMBER_TYPE_FORCES_BLK): New macro. (rs6000_member_type_forces_blk): New function. - * config/rs6000/rs6000.h (MEMBER_TYPE_FORCES_BLK): Removed. - * config/xtensa/xtensa.c (xtensa_member_type_forces_blk): New function. (TARGET_MEMBER_TYPE_FORCES_BLK): New macro. - * config/xtensa/xtensa.h (MEMBER_TYPE_FORCES_BLK): Removed. 2012-08-17 Diego Novillo <dnovillo@google.com> @@ -15899,20 +16098,15 @@ PR middle-end/53865 * ipa-inline-analysis.c (inline_free_summary): Return if inline_edge_summary_vec is NULL. - * ipa-split.c (execute_split_functions): Check if a function is inlinable only if inline_edge_summary_vec != NULL. - * ipa.c (symtab_remove_unreachable_nodes): Restore cgraph_propagate_frequency call when something was changed. (free_inline_summary): New function. (pass_ipa_free_inline_summary): New pass. - * passes.c (init_optimization_passes): Add pass_ipa_free_inline_summary before pass_ipa_tree_profile. - * timevar.def (TV_IPA_FREE_INLINE_SUMMARY): New. - * tree-pass.h (pass_ipa_free_inline_summary): New. 2012-08-02 Richard Earnshaw <rearnsha@arm.com> @@ -20788,10 +20982,8 @@ PR target/53383 * doc/invoke.texi: Add a warning for -mpreferred-stack-boundary=3. - * config/i386/i386.c (ix86_option_override_internal): Allow -mpreferred-stack-boundary=3 for 64-bit if SSE is disabled. - * config/i386/i386.h (MIN_STACK_BOUNDARY): Set to 64 for 64-bit if SSE is disabled. @@ -22384,7 +22576,7 @@ 2012-06-04 H.J. Lu <hongjiu.lu@intel.com> PR bootstrap/53555 - * config/i386/i386.c (ix86_sched_reorder) Skip debug insns. + * config/i386/i386.c (ix86_sched_reorder): Skip debug insns. 2012-06-04 Jason Merrill <jason@redhat.com> @@ -28675,7 +28867,6 @@ PR rtl-optimization/52876 * emit-rtl.c (set_reg_attrs_from_value): Handle arbitrary value. Don't call mark_reg_pointer for incompatible pointer sign extension. - * reginfo.c (reg_scan_mark_refs): Call set_reg_attrs_from_value directly. @@ -29524,21 +29715,17 @@ * config/i386/biarch64.h (TARGET_64BIT_DEFAULT): Add OPTION_MASK_ABI_64. - * config/i386/gnu-user64.h (SPEC_64): Support TARGET_BI_ARCH == 2. (SPEC_X32): Likewise. (MULTILIB_DEFAULTS): Likewise. - * config/i386/i386.c (isa_opts): Remove -m64. (ix86_target_string): Properly handle -m32/-m64/-mx32. (ix86_option_override_internal): Properly set OPTION_MASK_ISA_64BIT and OPTION_MASK_ISA_X32 as well as handle -m32, -m64 and -mx32. - * config/i386/i386.h (TARGET_X32): Replace OPTION_ISA_X32 with OPTION_ABI_X32. Moved after TARGET_LP64. (TARGET_LP64): Changed to OPTION_ABI_64. - * config/i386/i386.opt (m64): Replace ISA_64BIT with ABI_64. (mx32): Replace ISA_X32 with ABI_X32. @@ -30236,7 +30423,6 @@ if Pmode != word_mode. (legitimize_tls_address): Call gen_tls_initial_exec_x32 if Pmode == SImode for TARGET_X32. - * config/i386/i386.md (UNSPEC_TLS_IE_X32): New. (tls_initial_exec_x32): Likewise. @@ -30543,14 +30729,10 @@ PR target/50797 * config/i386/i386-opts.h (pmode): New. - * config/i386/i386.c (ix86_option_override_internal): Properly check and set ix86_pmode. - * config/i386/i386.h (Pmode): Check ix86_pmode instead of TARGET_64BIT. - * config/i386/i386.opt (maddress-mode=): New. - * doc/invoke.texi: Document -maddress-mode=short|long for x86. 2012-03-14 Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE> @@ -30925,7 +31107,6 @@ and ix86_gen_tls_local_dynamic_base_64. (legitimize_tls_address): Use ix86_gen_tls_global_dynamic_64 and ix86_gen_tls_local_dynamic_base_64. - * config/i386/i386.md (*tls_global_dynamic_64): Renamed to ... (*tls_global_dynamic_64_<mode>): This. (tls_global_dynamic_64): Renamed to ... @@ -30942,7 +31123,6 @@ instead of TARGET_64BIT, to set ix86_gen_add3, ix86_gen_sub3, ix86_gen_one_cmpl2, ix86_gen_andsp, ix86_gen_allocate_stack_worker, ix86_gen_adjust_stack_and_probe and ix86_gen_probe_stack_range. - * config/i386/sse.md (sse3_monitor64): Renamed to ... (sse3_monitor64_<mode>): This. @@ -31207,7 +31387,6 @@ if Pmode != word_mode. (legitimize_tls_address): Call gen_tls_initial_exec_x32 if Pmode == SImode for TARGET_X32. - * config/i386/i386.md (UNSPEC_TLS_IE_X32): New. (tls_initial_exec_x32): Likewise. @@ -31333,7 +31512,6 @@ word_mode. (ix86_split_to_parts): Use word_mode with PUT_MODE for push. (ix86_split_long_move): Likewise. - * config/i386/i386.md (W): New. (*push<mode>2_prologue): Replace :P with :W. (*pop<mode>1): Likewise. diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index 5b7b28b8e3e..5cf5bfb717e 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20121221 +20130103 diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0c902a825ff..d9e91b6826e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,451 @@ +2013-01-02 Richard Biener <rguenther@suse.de> + + PR bootstrap/55784 + * gcc-interface/Makefile.in: Add $(GMPINC) to includes. + +2013-01-02 Thomas Quinot <quinot@adacore.com> + + * exp_intr.adb (Expand_Dispatching_Constructor_Call): Remove + side effects from Tag_Arg early, doing it too late may cause a + crash due to inconsistent Parent link. + * sem_ch8.adb, einfo.ads: Minor reformatting. + +2013-01-02 Robert Dewar <dewar@adacore.com> + + * einfo.ads, einfo.adb (Has_Independent_Components): New flag. + * freeze.adb (Size_Known): We do not know the size of a packed + record if it has atomic components, by reference type components, + or independent components. + * sem_prag.adb (Analyze_Pragma, case Independent_Components): Set new + flag Has_Independent_Components. + +2013-01-02 Yannick Moy <moy@adacore.com> + + * opt.ads (Warn_On_Suspicious_Contract): Set to True by default. + * usage.adb (Usage): Update usage message. + +2013-01-02 Pascal Obry <obry@adacore.com> + + * adaint.c (__gnat_is_module_name_supported): New constant. + +2013-01-02 Ed Schonberg <schonberg@adacore.com> + + * sem_attr.adb (Check_Array_Type): Reject an attribute reference on an + array whose component type does not have a completion. + +2013-01-02 Geert Bosch <bosch@adacore.com> + + * a-nllcef.ads, a-nlcefu.ads, a-nscefu.ads: Make Pure. + +2013-01-02 Robert Dewar <dewar@adacore.com> + + * par_sco.adb: Minor reformatting. + +2013-01-02 Javier Miranda <miranda@adacore.com> + + * sem_aggr.adb (Resolve_Array_Aggregate): Remove dead code. + +2013-01-02 Olivier Hainque <hainque@adacore.com> + + * a-exctra.ads (Get_PC): New function. + +2013-01-02 Thomas Quinot <quinot@adacore.com> + + * sem_ch8.adb: Minor reformatting. + +2013-01-02 Thomas Quinot <quinot@adacore.com> + + * sem_ch7.adb: Minor reformatting. + +2013-01-02 Thomas Quinot <quinot@adacore.com> + + * freeze.adb (Check_Component_Storage_Order): Do not crash on + _Tag component. + +2013-01-02 Robert Dewar <dewar@adacore.com> + + * gnat1drv.adb, targparm.adb, targparm.ads: Minor name change: add + On_Target to Atomic_Sync_Default. + +2013-01-02 Robert Dewar <dewar@adacore.com> + + * sem_warn.adb (Warn_On_Known_Condition): Suppress warning for + comparison of attribute result with constant + * a-ststio.adb, s-direio.adb, s-rannum.adb: Remove unnecessary pragma + Warnings (Off, ".."); + +2013-01-02 Yannick Moy <moy@adacore.com> + + * sem_prag.ads: Minor correction of comment. + +2013-01-02 Thomas Quinot <quinot@adacore.com> + + * par_sco.adb (Traverse_Package_Declaration): The first + declaration in a nested package is dominated by the preceding + declaration in the enclosing scope. + +2013-01-02 Pascal Obry <obry@adacore.com> + + * adaint.c, adaint.h (__gnat_get_module_name): Return the actual + module containing a given address. + +2013-01-02 Thomas Quinot <quinot@adacore.com> + + * sem_ch3.adb: Minor reformatting. + +2013-01-02 Pascal Obry <obry@adacore.com> + + * cstreams.c (__gnat_ftell64): New routine. Use _ftelli64 on + Win64 and default to ftell on other platforms. + (__gnat_fsek64): Likewise. + * i-cstrea.ads: Add fssek64 and ftell64 specs. + * s-crtl.ads: Likewise. + * a-ststio.adb, s-direio.adb (Size): Use 64 bits version when required. + (Set_Position): Likewise. + +2013-01-02 Thomas Quinot <quinot@adacore.com> + + * par_sco.adb: Generate X SCOs for default expressions in + subprogram body stubs. Do not generate any SCO for package, + task, or protected body stubs. + +2013-01-02 Ed Schonberg <schonberg@adacore.com> + + * sem_ch3.adb: Further improvement to ASIS mode for anonymous + access to protected subprograms. + +2013-01-02 Robert Dewar <dewar@adacore.com> + + * par_sco.adb, vms_data.ads: Minor reformatting. + +2013-01-02 Thomas Quinot <quinot@adacore.com> + + * par_sco.adb (Traverse_Declarations_Or_Statement): Function + form, returning value of Current_Dominant upon exit, for chaining + purposes. + (Traverse_Declarations_Or_Statement.Traverse_One, case + N_Block_Statement): First statement is dominated by last declaration. + (Traverse_Subprogram_Or_Task_Body): Ditto. + (Traverse_Package_Declaration): First private + declaration is dominated by last visible declaration. + (Traverse_Sync_Definition): Ditto. + +2013-01-02 Thomas Quinot <quinot@adacore.com> + + * gnat_rm.texi: Restrict the requirement for Scalar_Storage_Order + matching Bit_Order to record types only, since array types do not + have a Bit_Order. + +2013-01-02 Vincent Celier <celier@adacore.com> + + * gnat_ugn.texi: Remove documentation of -gnateO, which is an + internal switch. + * usage.adb: Indicate that -gnateO is an internal switch. + +2013-01-02 Thomas Quinot <quinot@adacore.com> + + * par_sco.adb: Add SCO generation for task types and single + task declarations. + * get_scos.adb: When adding an instance table entry for a + non-nested instantiation, make sure the Enclosing_Instance is + correctly set to 0. + +2013-01-02 Hristian Kirtchev <kirtchev@adacore.com> + + * sem_attr.adb (Analyze_Attribute): Skip the special _Parent + scope generated for subprogram inlining purposes while trying + to locate the enclosing function. + * sem_prag.adb (Analyze_Pragma): Preanalyze the boolean + expression of pragma Postcondition when the pragma comes from + source and appears inside a subprogram body. + +2013-01-02 Thomas Quinot <quinot@adacore.com> + + * switch-c.adb, fe.h, back_end.adb: Enable generation of instantiation + information in debug info unconditionally when using -fdump-scos, + instead of relying on a separate command line switch -fdebug-instances. + * gcc-interface/Make-lang.in: Update dependencies. + +2013-01-02 Ed Schonberg <schonberg@adacore.com> + + * sem_ch12.adb: Additional refinement of predicate. + +2013-01-02 Vincent Celier <celier@adacore.com> + + * vms_data.ads: Remove incorrect spaces at end of descriptions + of qualifiers for single switch. + +2013-01-02 Ben Brosgol <brosgol@adacore.com> + + * gnat_rm.texi: Minor edits / wordsmithing in section on pragma + Check_Float_Overflow. + +2013-01-02 Thomas Quinot <quinot@adacore.com> + + * sprint.adb (Sprint_Node_Actual): Do not add extra parens for + a conditional expression (CASE or IF expression) that already + has parens. Also omit ELSE keyword for an IF expression without + an ELSE part. + +2013-01-02 Thomas Quinot <quinot@adacore.com> + + * gnat1drv.adb (Adjust_Global_Switches): Adjust back-end + flag_debug_instances here, after front-end switches have been + processed. + +2013-01-02 Vincent Celier <celier@adacore.com> + + * usage.adb: Minor reformatting. + +2013-01-02 Arnaud Charlet <charlet@adacore.com> + + * opt.ads: Fix typo. + +2013-01-02 Thomas Quinot <quinot@adacore.com> + + * par_sco.adb: Generate P decision SCOs for SPARK pragmas + Assume and Loop_Invariant. + +2013-01-02 Robert Dewar <dewar@adacore.com> + + * vms_data.ads: Add entry for Float_Check_Valid (-gnateF). + * ug_words: Add entry for Float_Check_Overflow. + * usage.adb: Minor reformatting. + * gnat_ugn.texi: Add documentation for -gnateF (Check_Float_Overflow). + +2013-01-02 Vincent Celier <celier@adacore.com> + + * gnat_ugn.texi: Add documentation for switches -gnateA, -gnated, + -gnateO=, -gnatet and -gnateV. + * ug_words: Add qualifiers equivalent to -gnateA, -gnated, + -gnatet and -gnateV. + * usage.adb: Add lines for -gnatea, -gnateO and -gnatez. + * vms_data.ads: Add new compiler qualifiers /ALIASING_CHECK + (-gnateA), /DISABLE_ATOMIC_SYNCHRONIZATION (-gnated), + /PARAMETER_VALIDITY_CHECK (-gnateV) and /TARGET_DEPENDENT_INFO + (-gnatet). + +2013-01-02 Robert Dewar <dewar@adacore.com> + + * checks.adb (Apply_Scalar_Range_Check): Implement Check_Float_Overflow. + * opt.ads, opt.adb: Handle flags Check_Float_Overflow[_Config]. + * par-prag.adb: Add dummy entry for pragma Check_Float_Overflow. + * sem_prag.adb: Implement pragma Check_Float_Overflow. + * snames.ads-tmpl: Add entries for pragma Check_Float_Overflow. + * switch-c.adb: Recognize -gnateF switch. + * tree_io.ads: Update ASIS version number. + * gnat_rm.texi: Add documentation of pragma Check_Float_Overflow. + +2013-01-02 Robert Dewar <dewar@adacore.com> + + * checks.adb, exp_ch4.adb, exp_ch6.adb, exp_ch7.adb, exp_ch9.adb, + exp_disp.adb, exp_dist.adb, exp_intr.adb, exp_prag.adb, exp_util.adb, + freeze.adb, gnat1drv.adb, inline.adb, layout.adb, lib-xref.adb, + par-ch10.adb, par-labl.adb, par-load.adb, par-util.adb, restrict.adb, + sem_ch13.adb, sem_ch4.adb, sem_ch6.adb, sem_dim.adb, sem_elab.adb, + sem_res.adb, sem_warn.adb, sinput-l.adb: Add tags to warning messages. + * sem_ch6.ads, warnsw.ads, opt.ads: Minor comment updates. + +2013-01-02 Robert Dewar <dewar@adacore.com> + + * err_vars.ads: Minor comment fix. + +2013-01-02 Ed Schonberg <schonberg@adacore.com> + + * sem_ch12.adb: Refine predicate. + +2013-01-02 Robert Dewar <dewar@adacore.com> + + * errout.ads: Minor comment fixes. + * opt.ads: Minor comment additions. + * exp_aggr.adb: Add tags to warning messages + * exp_ch11.adb, exp_ch3.adb, exp_ch4.adb, exp_util.adb, sem_aggr.adb, + sem_attr.adb, sem_case.adb, sem_cat.adb, sem_ch3.adb, sem_ch4.adb, + sem_ch5.adb, sem_disp.adb, sem_dist.adb, sem_elab.adb, sem_eval.adb, + sem_intr.adb, sem_mech.adb, sem_prag.adb, sem_res.adb, sem_util.adb, + sem_warn.adb: Add tags to warning messages + +2013-01-02 Doug Rupp <rupp@adacore.com> + + * init.c [VMS] Remove subtest on reason mask for ACCVIO that is a C_E. + +2013-01-02 Ed Schonberg <schonberg@adacore.com> + + * sem_ch12.adb: Recover source name for renamed packagea. + +2013-01-02 Robert Dewar <dewar@adacore.com> + + * errout.adb (Set_Msg_Insertion_Warning): Correct typo causing + tests to fail if insertion sequence is at end of message string. + * opt.ads: Minor comment fixes and additions. + * sem_ch7.adb, sem_ch8.adb, sem_ch9.adb, sem_ch10.adb, sem_ch11.adb, + sem_ch12.adb, sem_ch13.adb: Add tags to warning messages. + * sem_ch6.ads, sem_ch6.adb (Cannot_Inline): Deal with warning message + tags. Add tags to warning messages. + +2013-01-02 Robert Dewar <dewar@adacore.com> + + * err_vars.ads (Warning_Doc_Switch): New flag. + * errout.adb (Error_Msg_Internal): Implement new warning flag + doc tag stuff (Set_Msg_Insertion_Warning): New procedure. + * errout.ads: Document new insertion sequences ?? ?x? ?.x? + * erroutc.adb (Output_Msg_Text): Handle ?? and ?x? warning doc + tag stuff. + * erroutc.ads (Warning_Msg_Char): New variable. + (Warn_Chr): New field in error message object. + * errutil.adb (Error_Msg): Set Warn_Chr in error message object. + * sem_ch13.adb: Minor reformatting. + * warnsw.adb: Add handling for -gnatw.d and -gnatw.D + (Warning_Doc_Switch). + * warnsw.ads: Add handling of -gnatw.d/.D switches (warning + doc tag). + +2013-01-02 Robert Dewar <dewar@adacore.com> + + * opt.ads: Minor reformatting. + +2013-01-02 Doug Rupp <rupp@adacore.com> + + * init.c: Reorganize VMS section. + (scan_condtions): New function for scanning condition tables. + (__gnat_handle_vms_condtion): Use actual exception name for imported + exceptions vice IMPORTED_EXCEPTION. + Move condition table scanning into separate function. Move formerly + special handled conditions to system condition table. Use SYS$PUTMSG + output to fill exception message field for formally special handled + condtions, in particular HPARITH to provide more clues about cause and + location then raised from the translated image. + +2013-01-02 Thomas Quinot <quinot@adacore.com> + + * sem_ch13.adb (Analyze_Aspect_Specifications): For a Pre/Post + aspect that applies to a library subprogram, prepend corresponding + pragma to the Pragmas_After list, in order for split AND THEN + sections to be processed in the expected order. + +2013-01-02 Thomas Quinot <quinot@adacore.com> + + * exp_prag.adb (Expand_Pragma_Check): The statements generated + for the pragma must have the sloc of the pragma, not the + sloc of the condition, otherwise this creates anomalies in the + generated debug information that confuse coverage analysis tools. + +2013-01-02 Thomas Quinot <quinot@adacore.com> + + * sem_ch13.adb: Minor reformatting. + +2013-01-02 Arnaud Charlet <charlet@adacore.com> + + * g-excact.ads (Core_Dump): Clarify that this subprogram does + not dump cores under Windows. + +2013-01-02 Ed Schonberg <schonberg@adacore.com> + + * sem_ch8.adb (Analyze_Primitive_Renamed_Operation): The prefixed + view of a subprogram has convention Intrnnsic, and a renaming + of a prefixed view cannot be the prefix of an Access attribute. + +2013-01-02 Robert Dewar <dewar@adacore.com> + + * restrict.adb: Minor reformatting. + +2013-01-02 Thomas Quinot <quinot@adacore.com> + + * exp_prag.adb: Minor reformatting. + +2013-01-02 Ed Schonberg <schonberg@adacore.com> + + * sem_ch12.adb (Get_Associated_Node): If the node is an + identifier that denotes an unconstrained array in an object + declaration, it is rewritten as the name of an anonymous + subtype whose bounds are given by the initial expression in the + declaration. When checking whether that identifier is global + reference, use the original node, not the local generated subtype. + +2013-01-02 Olivier Hainque <hainque@adacore.com> + + * tracebak.c: Revert previous change, incomplete. + +2013-01-02 Ed Schonberg <schonberg@adacore.com> + + * sem_ch13.adb (Analyze_Aspect_Specifications): If the aspect + appears on a subprogram body that acts as a spec, place the + corresponding pragma in the declarations of the body, so that + e.g. pre/postcondition checks can be generated appropriately. + +2013-01-02 Robert Dewar <dewar@adacore.com> + + * sem_ch3.adb: Minor reformatting and code reorganization. + +2013-01-02 Vincent Celier <celier@adacore.com> + + * switch-m.adb (Normalize_Compiler_Switches): Record the + complete switch -fstack-check=specific instead of its shorter + alias -fstack-check. + +2013-01-02 Ed Schonberg <schonberg@adacore.com> + + * sem_ch3.adb (Derive_Subprogram): Enforce RM 6.3.1 (8): + if the derived type is a tagged generic formal type with + unknown discriminants, the inherited operation has convention + Intrinsic. As such, the 'Access attribute cannot be applied to it. + +2013-01-02 Thomas Quinot <quinot@adacore.com> + + * sem_attr.adb: Minor reformatting. + +2013-01-02 Thomas Quinot <quinot@adacore.com> + + * par_sco.adb: Add SCO generation for S of protected types and + single protected object declarations. + +2013-01-02 Robert Dewar <dewar@adacore.com> + + * sem_eval.adb, osint.ads: Minor reformatting. + +2013-01-02 Hristian Kirtchev <kirtchev@adacore.com> + + * sem_prag.adb (Analyze_Pragma): Check the legality of pragma Assume. + +2013-01-02 Thomas Quinot <quinot@adacore.com> + + * sem_eval.adb (Compile_Time_Compare): For static operands, we + can perform a compile time comparison even if in preanalysis mode. + +2013-01-02 Thomas Quinot <quinot@adacore.com> + + * par_sco.adb (SCO_Record): Always use + Traverse_Declarations_Or_Statements to process the library level + declaration, so that SCOs are properly generated for its aspects. + +2013-01-02 Thomas Quinot <quinot@adacore.com> + + * scos.ads (In_Decision): Add missing entry for 'a'. + * sem_prag.adb (Analyze_Pragma, case pragma Check): Omit + call to Set_SCO_Pragma_Enabled for Invariant and Predicate. + * sem_ch13.adb: Minor comment update. + +2012-12-21 Ed Schonberg <schonberg@adacore.com> + + PR ada/53737 + * sem_ch12.adb (Analyze_Associations): Do not check the legality of + actuals for RACW types if this is an internal instantiation for a formal + package with defaulted parameters. + +2012-12-21 Eric Botcazou <ebotcazou@adacore.com> + + * adaint.c: Move directive around. + * argv.c: Likewise. + * cio.c: Likewise. + * cstreams.c: Likewise. + * env.c: Likewise. + * exit.c: Likewise. + * init.c: Likewise. + * initialize.c: Likewise. + * raise.c: Likewise. + * seh_init.c: Likewise. + * targext.c: Likewise. + 2012-12-15 Eric Botcazou <ebotcazou@adacore.com> Martin Ettl <ettl.martin@gmx.de> diff --git a/gcc/ada/a-exctra.ads b/gcc/ada/a-exctra.ads index 8bb956248f8..6d22c1c746b 100644 --- a/gcc/ada/a-exctra.ads +++ b/gcc/ada/a-exctra.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1999-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1999-2012, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -39,12 +39,12 @@ with System.Traceback_Entries; package Ada.Exceptions.Traceback is - package TBE renames System.Traceback_Entries; + package STBE renames System.Traceback_Entries; subtype Code_Loc is System.Address; -- Code location in executing program - type Tracebacks_Array is array (Positive range <>) of TBE.Traceback_Entry; + type Tracebacks_Array is array (Positive range <>) of STBE.Traceback_Entry; -- A traceback array is an array of traceback entries function Tracebacks (E : Exception_Occurrence) return Tracebacks_Array; @@ -52,4 +52,9 @@ package Ada.Exceptions.Traceback is -- occurrence, and returns it formatted in the manner required for -- processing in GNAT.Traceback. See g-traceb.ads for further details. + function Get_PC (TBE : STBE.Traceback_Entry) return Code_Loc + renames STBE.PC_For; + -- Returns the code address held by a given traceback entry, typically the + -- address of a call instruction. + end Ada.Exceptions.Traceback; diff --git a/gcc/ada/a-nlcefu.ads b/gcc/ada/a-nlcefu.ads index 9e985dfca6a..083f6a990e3 100644 --- a/gcc/ada/a-nlcefu.ads +++ b/gcc/ada/a-nlcefu.ads @@ -19,3 +19,4 @@ with Ada.Numerics.Generic_Complex_Elementary_Functions; package Ada.Numerics.Long_Complex_Elementary_Functions is new Ada.Numerics.Generic_Complex_Elementary_Functions (Ada.Numerics.Long_Complex_Types); +pragma Pure (Ada.Numerics.Long_Complex_Elementary_Functions); diff --git a/gcc/ada/a-nllcef.ads b/gcc/ada/a-nllcef.ads index 2867e1dbb03..7a1f4b17ac3 100644 --- a/gcc/ada/a-nllcef.ads +++ b/gcc/ada/a-nllcef.ads @@ -19,3 +19,4 @@ with Ada.Numerics.Generic_Complex_Elementary_Functions; package Ada.Numerics.Long_Long_Complex_Elementary_Functions is new Ada.Numerics.Generic_Complex_Elementary_Functions (Ada.Numerics.Long_Long_Complex_Types); +pragma Pure (Ada.Numerics.Long_Long_Complex_Elementary_Functions); diff --git a/gcc/ada/a-nscefu.ads b/gcc/ada/a-nscefu.ads index ac89d051c87..0d0aa154878 100644 --- a/gcc/ada/a-nscefu.ads +++ b/gcc/ada/a-nscefu.ads @@ -19,3 +19,4 @@ with Ada.Numerics.Generic_Complex_Elementary_Functions; package Ada.Numerics.Short_Complex_Elementary_Functions is new Ada.Numerics.Generic_Complex_Elementary_Functions (Ada.Numerics.Short_Complex_Types); +pragma Pure (Ada.Numerics.Short_Complex_Elementary_Functions); diff --git a/gcc/ada/a-ststio.adb b/gcc/ada/a-ststio.adb index c5da571495f..ef8af62d206 100644 --- a/gcc/ada/a-ststio.adb +++ b/gcc/ada/a-ststio.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -367,7 +367,11 @@ package body Ada.Streams.Stream_IO is FIO.Append_Set (AP (File)); if File.Mode = FCB.Append_File then - File.Index := Count (ftell (File.Stream)) + 1; + if Standard'Address_Size = 64 then + File.Index := Count (ftell64 (File.Stream)) + 1; + else + File.Index := Count (ftell (File.Stream)) + 1; + end if; end if; File.Last_Op := Op_Other; @@ -379,10 +383,18 @@ package body Ada.Streams.Stream_IO is procedure Set_Position (File : File_Type) is use type System.CRTL.long; + use type System.CRTL.ssize_t; + R : int; begin - if fseek (File.Stream, - System.CRTL.long (File.Index) - 1, SEEK_SET) /= 0 - then + if Standard'Address_Size = 64 then + R := fseek64 (File.Stream, + System.CRTL.ssize_t (File.Index) - 1, SEEK_SET); + else + R := fseek (File.Stream, + System.CRTL.long (File.Index) - 1, SEEK_SET); + end if; + + if R /= 0 then raise Use_Error; end if; end Set_Position; @@ -402,7 +414,11 @@ package body Ada.Streams.Stream_IO is raise Device_Error; end if; - File.File_Size := Stream_Element_Offset (ftell (File.Stream)); + if Standard'Address_Size = 64 then + File.File_Size := Stream_Element_Offset (ftell64 (File.Stream)); + else + File.File_Size := Stream_Element_Offset (ftell (File.Stream)); + end if; end if; return Count (File.File_Size); diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index eab3ea5fbae..d95b6615b77 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -34,10 +34,6 @@ package Osint. Many of the subprograms in OS_Lib import standard library calls directly. This file contains all other routines. */ -#ifdef __cplusplus -extern "C" { -#endif - #ifdef __vxworks /* No need to redefine exit here. */ @@ -107,6 +103,10 @@ extern "C" { #include "version.h" #endif +#ifdef __cplusplus +extern "C" { +#endif + #if defined (__MINGW32__) #if defined (RTX) @@ -2960,6 +2960,54 @@ __gnat_locate_exec_on_path (char *exec_name) #endif } +/* __gnat_get_module_name returns the module name (executable or shared + library) in which the code at addr is. This is used to properly + report the symbolic tracebacks. If the module cannot be located + it returns the empty string. The returned value must not be freed. + + If this routine is fully implemented the value for + __gnat_is_module_name_supported should be set to 1. */ + +char *__gnat_get_module_name (void *addr ATTRIBUTE_UNUSED) +{ + extern char **gnat_argv; + +#ifdef _WIN32 + static char lpFilename[MAX_PATH]; + HMODULE hModule; + + lpFilename[0] = '\0'; + + /* Get the module handle in which the code running at the specified + address is contained. */ + + if (GetModuleHandleEx + (GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS, addr, &hModule) == FALSE) + return __gnat_locate_exec_on_path (gnat_argv[0]); + + /* Get the corresponding module full path name. We really want the + standard ASCII version of this routine as the name is passed to + the BFD library. */ + + if (GetModuleFileNameA (hModule, lpFilename, MAX_PATH) == 0) + return __gnat_locate_exec_on_path (gnat_argv[0]); + + return lpFilename; + +#else + /* On all other platforms we just return the full path name of the + main executable. */ + + return __gnat_locate_exec_on_path (gnat_argv[0]); +#endif +} + +#ifdef _WIN32 +int __gnat_is_module_name_supported = 1; +#else +int __gnat_is_module_name_supported = 0; +#endif + #ifdef VMS /* These functions are used to translate to and from VMS and Unix syntax diff --git a/gcc/ada/adaint.h b/gcc/ada/adaint.h index 7956e27a709..217ce6c48e1 100644 --- a/gcc/ada/adaint.h +++ b/gcc/ada/adaint.h @@ -186,6 +186,7 @@ extern int __gnat_portable_wait (int *); extern char *__gnat_locate_exec (char *, char *); extern char *__gnat_locate_exec_on_path (char *); extern char *__gnat_locate_regular_file (char *, char *); +extern char *__gnat_get_module_name (void *); extern void __gnat_maybe_glob_args (int *, char ***); extern void __gnat_os_exit (int); extern char *__gnat_get_libraries_from_registry (void); diff --git a/gcc/ada/argv.c b/gcc/ada/argv.c index 29f163972ea..430404e3aa4 100644 --- a/gcc/ada/argv.c +++ b/gcc/ada/argv.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 1992-2011, Free Software Foundation, Inc. * + * Copyright (C) 1992-2012, Free Software Foundation, Inc. * * * * GNAT is free software; you can redistribute it and/or modify it under * * terms of the GNU General Public License as published by the Free Soft- * @@ -42,10 +42,6 @@ main program, and these routines are accessed from the Ada.Command_Line.Environment package. */ -#ifdef __cplusplus -extern "C" { -#endif - #ifdef IN_RTS #include "tconfig.h" #include "tsystem.h" @@ -57,6 +53,10 @@ extern "C" { #include "adaint.h" +#ifdef __cplusplus +extern "C" { +#endif + /* argc and argv of the main program are saved under gnat_argc and gnat_argv, envp of the main program is saved under gnat_envp. */ diff --git a/gcc/ada/back_end.adb b/gcc/ada/back_end.adb index aa398ff31c3..f23230ecf9d 100644 --- a/gcc/ada/back_end.adb +++ b/gcc/ada/back_end.adb @@ -244,11 +244,6 @@ package body Back_End is elsif Switch_Chars (First .. Last) = "fdump-scos" then Opt.Generate_SCO := True; - - -- Back end switch -fdebug-instances also enables instance table - -- SCO generation. - - elsif Switch_Chars (First .. Last) = "fdebug-instances" then Opt.Generate_SCO_Instance_Table := True; end if; diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 8a73e25e6c9..38b6ea4d7e2 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -599,10 +599,10 @@ package body Checks is begin if Address_Clause_Overlay_Warnings then Error_Msg_FE - ("?specified address for& may be inconsistent with alignment ", + ("?o?specified address for& may be inconsistent with alignment", Aexp, E); Error_Msg_FE - ("\?program execution may be erroneous (RM 13.3(27))", + ("\?o?program execution may be erroneous (RM 13.3(27))", Aexp, E); Set_Address_Warning_Posted (AC); end if; @@ -1624,7 +1624,7 @@ package body Checks is exit; else Apply_Compile_Time_Constraint_Error - (N, "incorrect value for discriminant&?", + (N, "incorrect value for discriminant&??", CE_Discriminant_Check_Failed, Ent => Discr); return; end if; @@ -2467,9 +2467,9 @@ package body Checks is elsif S = Predicate_Function (Typ) then Error_Msg_N ("predicate check includes a function call that " - & "requires a predicate check?", Parent (N)); + & "requires a predicate check??", Parent (N)); Error_Msg_N - ("\this will result in infinite recursion?", Parent (N)); + ("\this will result in infinite recursion??", Parent (N)); Insert_Action (N, Make_Raise_Storage_Error (Sloc (N), Reason => SE_Infinite_Recursion)); @@ -2558,7 +2558,7 @@ package body Checks is procedure Bad_Value is begin Apply_Compile_Time_Constraint_Error - (Expr, "value not in range of}?", CE_Range_Check_Failed, + (Expr, "value not in range of}??", CE_Range_Check_Failed, Ent => Target_Typ, Typ => Target_Typ); end Bad_Value; @@ -2692,15 +2692,24 @@ package body Checks is Is_Unconstrained_Subscr_Ref := Is_Subscr_Ref and then not Is_Constrained (Arr_Typ); - -- Always do a range check if the source type includes infinities and - -- the target type does not include infinities. We do not do this if - -- range checks are killed. + -- Special checks for floating-point type - if Is_Floating_Point_Type (S_Typ) - and then Has_Infinities (S_Typ) - and then not Has_Infinities (Target_Typ) - then - Enable_Range_Check (Expr); + if Is_Floating_Point_Type (S_Typ) then + + -- Always do a range check if the source type includes infinities and + -- the target type does not include infinities. We do not do this if + -- range checks are killed. + + if Has_Infinities (S_Typ) + and then not Has_Infinities (Target_Typ) + then + Enable_Range_Check (Expr); + + -- Always do a range check for operators if option set + + elsif Check_Float_Overflow and then Nkind (Expr) in N_Op then + Enable_Range_Check (Expr); + end if; end if; -- Return if we know expression is definitely in the range of the target @@ -2780,15 +2789,14 @@ package body Checks is -- only if this is not a conversion between integer and real types. if not Is_Unconstrained_Subscr_Ref - and then - Is_Discrete_Type (S_Typ) = Is_Discrete_Type (Target_Typ) + and then Is_Discrete_Type (S_Typ) = Is_Discrete_Type (Target_Typ) and then (In_Subrange_Of (S_Typ, Target_Typ, Fixed_Int) or else Is_In_Range (Expr, Target_Typ, Assume_Valid => True, - Fixed_Int => Fixed_Int, - Int_Real => Int_Real)) + Fixed_Int => Fixed_Int, + Int_Real => Int_Real)) then return; @@ -2800,12 +2808,18 @@ package body Checks is Bad_Value; return; + -- Floating-point case -- In the floating-point case, we only do range checks if the type is -- constrained. We definitely do NOT want range checks for unconstrained -- types, since we want to have infinities elsif Is_Floating_Point_Type (S_Typ) then - if Is_Constrained (S_Typ) then + + -- Normally, we only do range checks if the type is constrained. We do + -- NOT want range checks for unconstrained types, since we want to have + -- infinities. Override this decision in Check_Float_Overflow mode. + + if Is_Constrained (S_Typ) or else Check_Float_Overflow then Enable_Range_Check (Expr); end if; @@ -2904,7 +2918,7 @@ package body Checks is and then Entity (Cond) = Standard_True then Apply_Compile_Time_Constraint_Error - (Ck_Node, "wrong length for array of}?", + (Ck_Node, "wrong length for array of}??", CE_Length_Check_Failed, Ent => Target_Typ, Typ => Target_Typ); @@ -2984,7 +2998,7 @@ package body Checks is if Nkind (Ck_Node) = N_Range then Apply_Compile_Time_Constraint_Error - (Low_Bound (Ck_Node), "static range out of bounds of}?", + (Low_Bound (Ck_Node), "static range out of bounds of}??", CE_Range_Check_Failed, Ent => Target_Typ, Typ => Target_Typ); @@ -3539,11 +3553,11 @@ package body Checks is case Check is when Access_Check => Error_Msg_N - ("Constraint_Error may be raised (access check)?", + ("Constraint_Error may be raised (access check)??", Parent (Nod)); when Division_Check => Error_Msg_N - ("Constraint_Error may be raised (zero divide)?", + ("Constraint_Error may be raised (zero divide)??", Parent (Nod)); when others => @@ -3552,10 +3566,10 @@ package body Checks is if K = N_Op_And then Error_Msg_N -- CODEFIX - ("use `AND THEN` instead of AND?", P); + ("use `AND THEN` instead of AND??", P); else Error_Msg_N -- CODEFIX - ("use `OR ELSE` instead of OR?", P); + ("use `OR ELSE` instead of OR??", P); end if; -- If not short-circuited, we need the check @@ -3694,7 +3708,8 @@ package body Checks is Apply_Compile_Time_Constraint_Error (N => Expression (N), - Msg => "(Ada 2005) null-excluding objects must be initialized?", + Msg => + "(Ada 2005) null-excluding objects must be initialized??", Reason => CE_Null_Not_Allowed); end if; @@ -3712,7 +3727,7 @@ package body Checks is Apply_Compile_Time_Constraint_Error (N => Expr, Msg => "(Ada 2005) null not allowed " & - "in null-excluding components?", + "in null-excluding components??", Reason => CE_Null_Not_Allowed); when N_Object_Declaration => @@ -3726,7 +3741,7 @@ package body Checks is Apply_Compile_Time_Constraint_Error (N => Expr, Msg => "(Ada 2005) null not allowed " & - "in null-excluding formals?", + "in null-excluding formals??", Reason => CE_Null_Not_Allowed); when others => @@ -5649,22 +5664,24 @@ package body Checks is -- First special case, if the source type is already within the range -- of the target type, then no check is needed (probably we should have -- stopped Do_Range_Check from being set in the first place, but better - -- late than later in preventing junk code! - - -- We do NOT apply this if the source node is a literal, since in this - -- case the literal has already been labeled as having the subtype of - -- the target. + -- late than never in preventing junk code! if In_Subrange_Of (Source_Type, Target_Type) + + -- We do NOT apply this if the source node is a literal, since in this + -- case the literal has already been labeled as having the subtype of + -- the target. + and then not - (Nkind (N) = N_Integer_Literal - or else - Nkind (N) = N_Real_Literal + (Nkind_In (N, N_Integer_Literal, N_Real_Literal, N_Character_Literal) or else - Nkind (N) = N_Character_Literal - or else - (Is_Entity_Name (N) - and then Ekind (Entity (N)) = E_Enumeration_Literal)) + (Is_Entity_Name (N) + and then Ekind (Entity (N)) = E_Enumeration_Literal)) + + -- Also do not apply this for floating-point if Check_Float_Overflow + + and then not + (Is_Floating_Point_Type (Source_Type) and Check_Float_Overflow) then return; end if; @@ -5674,9 +5691,7 @@ package body Checks is -- reference). Such a double evaluation is always a potential source -- of inefficiency, and is functionally incorrect in the volatile case. - if not Is_Entity_Name (N) - or else Treat_As_Volatile (Entity (N)) - then + if not Is_Entity_Name (N) or else Treat_As_Volatile (Entity (N)) then Force_Evaluation (N); end if; @@ -6466,7 +6481,7 @@ package body Checks is if not Inside_Init_Proc then Apply_Compile_Time_Constraint_Error (N, - "null value not allowed here?", + "null value not allowed here??", CE_Access_Check_Failed); else Insert_Action (N, @@ -8251,12 +8266,12 @@ package body Checks is if L_Length > R_Length then Add_Check (Compile_Time_Constraint_Error - (Wnode, "too few elements for}?", T_Typ)); + (Wnode, "too few elements for}??", T_Typ)); elsif L_Length < R_Length then Add_Check (Compile_Time_Constraint_Error - (Wnode, "too many elements for}?", T_Typ)); + (Wnode, "too many elements for}??", T_Typ)); end if; -- The comparison for an individual index subtype @@ -8802,13 +8817,13 @@ package body Checks is Add_Check (Compile_Time_Constraint_Error (Low_Bound (Ck_Node), - "static value out of range of}?", T_Typ)); + "static value out of range of}??", T_Typ)); else Add_Check (Compile_Time_Constraint_Error (Wnode, - "static range out of bounds of}?", T_Typ)); + "static range out of bounds of}??", T_Typ)); end if; end if; @@ -8817,13 +8832,13 @@ package body Checks is Add_Check (Compile_Time_Constraint_Error (High_Bound (Ck_Node), - "static value out of range of}?", T_Typ)); + "static value out of range of}??", T_Typ)); else Add_Check (Compile_Time_Constraint_Error (Wnode, - "static range out of bounds of}?", T_Typ)); + "static range out of bounds of}??", T_Typ)); end if; end if; end if; @@ -8944,13 +8959,13 @@ package body Checks is Add_Check (Compile_Time_Constraint_Error (Ck_Node, - "static value out of range of}?", T_Typ)); + "static value out of range of}??", T_Typ)); else Add_Check (Compile_Time_Constraint_Error (Wnode, - "static value out of range of}?", T_Typ)); + "static value out of range of}??", T_Typ)); end if; end if; @@ -9132,7 +9147,7 @@ package body Checks is then Add_Check (Compile_Time_Constraint_Error - (Wnode, "value out of range of}?", T_Typ)); + (Wnode, "value out of range of}??", T_Typ)); else Evolve_Or_Else diff --git a/gcc/ada/cio.c b/gcc/ada/cio.c index 2564e4d3c47..ac23519ae9b 100644 --- a/gcc/ada/cio.c +++ b/gcc/ada/cio.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 1992-2011, Free Software Foundation, Inc. * + * Copyright (C) 1992-2012, Free Software Foundation, Inc. * * * * GNAT is free software; you can redistribute it and/or modify it under * * terms of the GNU General Public License as published by the Free Soft- * @@ -29,10 +29,6 @@ * * ****************************************************************************/ -#ifdef __cplusplus -extern "C" { -#endif - #ifdef IN_RTS #include "tconfig.h" #include "tsystem.h" @@ -44,6 +40,10 @@ extern "C" { #include "adaint.h" +#ifdef __cplusplus +extern "C" { +#endif + /* Don't use macros on GNU/Linux since they cause incompatible changes between glibc 2.0 and 2.1 */ #ifdef linux diff --git a/gcc/ada/cstreams.c b/gcc/ada/cstreams.c index 894b056eaba..25a867a768f 100644 --- a/gcc/ada/cstreams.c +++ b/gcc/ada/cstreams.c @@ -31,10 +31,6 @@ /* Routines required for implementing routines in Interfaces.C.Streams. */ -#ifdef __cplusplus -extern "C" { -#endif - #ifdef __vxworks #include "vxWorks.h" #endif @@ -50,6 +46,10 @@ extern "C" { #include "adaint.h" +#ifdef __cplusplus +extern "C" { +#endif + #ifdef VMS #include <unixlib.h> #endif @@ -257,6 +257,35 @@ __gnat_full_name (char *nam, char *buffer) return buffer; } +#ifdef _WIN64 + /* On Windows 64 we want to use the fseek/fteel supporting large files. This + issue is due to the fact that a long on Win64 is still a 32 bits value */ +__int64 +__gnat_ftell64 (FILE *stream) +{ + return _ftelli64 (stream); +} + +int +__gnat_fseek64 (FILE *stream, __int64 offset, int origin) +{ + return _fseeki64 (stream, offset, origin); +} + +#else +long +__gnat_ftell64 (FILE *stream) +{ + return ftell (stream); +} + +int +__gnat_fseek64 (FILE *stream, long offset, int origin) +{ + return fseek (stream, offset, origin); +} +#endif + #ifdef __cplusplus } #endif diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 212849791fb..34f61b9f25e 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -285,6 +285,7 @@ package body Einfo is -- Checks_May_Be_Suppressed Flag31 -- Kill_Elaboration_Checks Flag32 -- Kill_Range_Checks Flag33 + -- Has_Independent_Components Flag34 -- Is_Class_Wide_Equivalent_Type Flag35 -- Referenced_As_LHS Flag36 -- Is_Known_Non_Null Flag37 @@ -527,7 +528,6 @@ package body Einfo is -- Has_Anonymous_Master Flag253 -- Is_Implementation_Defined Flag254 - -- (unused) Flag34 -- (unused) Flag201 ----------------------- @@ -1338,6 +1338,12 @@ package body Einfo is return Flag251 (Id); end Has_Implicit_Dereference; + function Has_Independent_Components (Id : E) return B is + begin + pragma Assert (Is_Object (Id) or else Is_Type (Id)); + return Flag34 (Id); + end Has_Independent_Components; + function Has_Inheritable_Invariants (Id : E) return B is begin pragma Assert (Is_Type (Id)); @@ -3853,6 +3859,12 @@ package body Einfo is Set_Flag251 (Id, V); end Set_Has_Implicit_Dereference; + procedure Set_Has_Independent_Components (Id : E; V : B := True) is + begin + pragma Assert (Is_Object (Id) or else Is_Type (Id)); + Set_Flag34 (Id, V); + end Set_Has_Independent_Components; + procedure Set_Has_Inheritable_Invariants (Id : E; V : B := True) is begin pragma Assert (Is_Type (Id)); diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index e4af8cf23fb..1b412e51d88 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -528,7 +528,7 @@ package Einfo is -- -- Setting this False in all cases corresponds to the traditional back -- end strategy, where all access-to-subprogram types are represented the --- same way, independent of the Convention. See also +-- same way, independent of the Convention. For further details, see also -- Always_Compatible_Rep in Targparm. -- -- Efficiency note: On targets that use dynamically generated @@ -536,11 +536,11 @@ package Einfo is -- subprograms, whereas True generally favors efficiency of nested -- ones. On other targets, this flag has little or no effect on -- efficiency. The front end should take this into account. In --- particular, pragma Favor_Top_Level gives a hint that the flag should --- be False. +-- particular, pragma Favor_Top_Level gives a hint that the flag +-- should be False. -- -- Note: We considered using Convention-C for this purpose, but we need --- this separate flag, because Convention-C implies that for +-- this separate flag, because Convention-C implies that in the case of -- P'[Unrestricted_]Access, P also have convention C. Sometimes we want -- to have Can_Use_Internal_Rep False for an access type, but allow P to -- have convention Ada. @@ -902,11 +902,11 @@ package Einfo is -- DTC_Entity (Node16) -- Defined in function and procedure entities. Set to Empty unless -- the subprogram is dispatching in which case it references the --- Dispatch Table pointer Component. That is to say the component _tag --- for regular Ada tagged types, for CPP_Class types and their --- descendants this field points to the component entity in the record --- that is the Vtable pointer for the Vtable containing the entry that --- references the subprogram. +-- Dispatch Table pointer Component. For regular Ada tagged this, this +-- is the _Tag component. For CPP_Class types and their descendants, +-- this points to the component entity in the record that holds the +-- Vtable pointer for the Vtable containing the entry referencing the +-- subprogram. -- DT_Entry_Count (Uint15) -- Defined in E_Component entities. Only used for component marked @@ -1547,6 +1547,19 @@ package Einfo is -- Implicit_Dereference. Set also on the discriminant named in the aspect -- clause, to simplify type resolution. +-- Has_Independent_Components (Flag34) +-- Defined in objects and types. Set if the aspect Independent_Components +-- applies (as set by coresponding pragma or aspect specification). + +-- Has_Inheritable_Invariants (Flag248) +-- Defined in all type entities. Set True in private types from which one +-- or more Invariant'Class aspects will be inherited if a another type is +-- derived from the type (i.e. those types which have an Invariant'Class +-- aspect, or which inherit one or more Invariant'Class aspects). Also +-- set in the corresponding full types. Note that it might be the full +-- type which has inheritable invariants, and in this case the flag will +-- also be set in the private type. + -- Has_Initial_Value (Flag219) -- Defined in entities for variables and out parameters. Set if there -- is an explicit initial value expression in the declaration of the @@ -1573,15 +1586,6 @@ package Einfo is -- the invariant procedure entity, to distinguish it among entries in the -- Subprograms_For_Type. --- Has_Inheritable_Invariants (Flag248) --- Defined in all type entities. Set True in private types from which one --- or more Invariant'Class aspects will be inherited if a another type is --- derived from the type (i.e. those types which have an Invariant'Class --- aspect, or which inherit one or more Invariant'Class aspects). Also --- set in the corresponding full types. Note that it might be the full --- type which has inheritable invariants, and in this case the flag will --- also be set in the private type. - -- Has_Machine_Radix_Clause (Flag83) -- Defined in decimal types and subtypes, set if a Machine_Radix -- representation clause is present. This flag is used to detect @@ -4902,6 +4906,7 @@ package Einfo is -- Has_Controlled_Component (Flag43) (base type only) -- Has_Default_Aspect (Flag39) (base type only) -- Has_Discriminants (Flag5) + -- Has_Independent_Components (Flag34) (base type only) -- Has_Inheritable_Invariants (Flag248) -- Has_Invariants (Flag232) -- Has_Non_Standard_Rep (Flag75) (base type only) @@ -5102,6 +5107,7 @@ package Einfo is -- Has_Atomic_Components (Flag86) -- Has_Biased_Representation (Flag139) -- Has_Completion (Flag26) (constants only) + -- Has_Independent_Components (Flag34) (base type only) -- Has_Thunks (Flag228) (constants only) -- Has_Size_Clause (Flag29) -- Has_Up_Level_Access (Flag215) @@ -5769,6 +5775,7 @@ package Einfo is -- Has_Alignment_Clause (Flag46) -- Has_Atomic_Components (Flag86) -- Has_Biased_Representation (Flag139) + -- Has_Independent_Components (Flag34) (base type only) -- Has_Initial_Value (Flag219) -- Has_Size_Clause (Flag29) -- Has_Up_Level_Access (Flag215) @@ -6154,6 +6161,7 @@ package Einfo is function Has_Gigi_Rep_Item (Id : E) return B; function Has_Homonym (Id : E) return B; function Has_Implicit_Dereference (Id : E) return B; + function Has_Independent_Components (Id : E) return B; function Has_Inheritable_Invariants (Id : E) return B; function Has_Initial_Value (Id : E) return B; function Has_Interrupt_Handler (Id : E) return B; @@ -6745,6 +6753,7 @@ package Einfo is procedure Set_Has_Gigi_Rep_Item (Id : E; V : B := True); procedure Set_Has_Homonym (Id : E; V : B := True); procedure Set_Has_Implicit_Dereference (Id : E; V : B := True); + procedure Set_Has_Independent_Components (Id : E; V : B := True); procedure Set_Has_Inheritable_Invariants (Id : E; V : B := True); procedure Set_Has_Initial_Value (Id : E; V : B := True); procedure Set_Has_Invariants (Id : E; V : B := True); @@ -7424,6 +7433,7 @@ package Einfo is pragma Inline (Has_Gigi_Rep_Item); pragma Inline (Has_Homonym); pragma Inline (Has_Implicit_Dereference); + pragma Inline (Has_Independent_Components); pragma Inline (Has_Inheritable_Invariants); pragma Inline (Has_Initial_Value); pragma Inline (Has_Invariants); @@ -7870,6 +7880,7 @@ package Einfo is pragma Inline (Set_Has_Gigi_Rep_Item); pragma Inline (Set_Has_Homonym); pragma Inline (Set_Has_Implicit_Dereference); + pragma Inline (Set_Has_Independent_Components); pragma Inline (Set_Has_Inheritable_Invariants); pragma Inline (Set_Has_Initial_Value); pragma Inline (Set_Has_Invariants); diff --git a/gcc/ada/env.c b/gcc/ada/env.c index 78328dc371b..800d20748ec 100644 --- a/gcc/ada/env.c +++ b/gcc/ada/env.c @@ -29,10 +29,6 @@ * * ****************************************************************************/ -#ifdef __cplusplus -extern "C" { -#endif - #ifdef IN_RTS #include "tconfig.h" #include "tsystem.h" @@ -76,6 +72,10 @@ extern "C" { #include "system.h" #endif /* IN_RTS */ +#ifdef __cplusplus +extern "C" { +#endif + #if defined (__APPLE__) #include <crt_externs.h> #endif diff --git a/gcc/ada/err_vars.ads b/gcc/ada/err_vars.ads index 64d68e0630c..ecfbc54ce81 100644 --- a/gcc/ada/err_vars.ads +++ b/gcc/ada/err_vars.ads @@ -88,6 +88,12 @@ package Err_Vars is -- Source_Reference line, then this is initialized to No_Source_File, -- to force an initial reference to the real source file name. + Warning_Doc_Switch : Boolean := False; + -- If this is set True, then the ??/?x?/?x? sequences in error messages + -- are active (see errout.ads for details). If this switch is False, then + -- these sequences are ignored (i.e. simply equivalent to a single ?). The + -- -gnatw.d switch sets this flag True, -gnatw.D sets this flag False. + ---------------------------------------- -- Error Message Insertion Parameters -- ---------------------------------------- @@ -133,7 +139,9 @@ package Err_Vars is -- before any call to Error_Msg_xxx with a < insertion character present. -- Setting is irrelevant if no < insertion character is present. Note -- that it is not necessary to reset this after using it, since the proper - -- procedure is always to set it before issuing such a message. + -- procedure is always to set it before issuing such a message. Note that + -- the warning documentation tag is always [enabled by default] in the + -- case where this flag is True. Error_Msg_String : String (1 .. 4096); Error_Msg_Strlen : Natural; diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 6f450200ef9..052b43f8dab 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -821,9 +821,7 @@ package body Errout is -- with a comma space separator (eliminating a possible (style) or -- info prefix). - if Error_Msg_Line_Length /= 0 - and then Continuation - then + if Error_Msg_Line_Length /= 0 and then Continuation then Cur_Msg := Errors.Last; declare @@ -894,12 +892,24 @@ package body Errout is Msg_Buffer (M .. Msglen); Newl := Newl + Msglen - M + 1; Errors.Table (Cur_Msg).Text := new String'(Newm (1 .. Newl)); + + -- Update warning msg flag and message doc char if needed + + if Is_Warning_Msg then + if not Errors.Table (Cur_Msg).Warn then + Errors.Table (Cur_Msg).Warn := True; + Errors.Table (Cur_Msg).Warn_Chr := Warning_Msg_Char; + + elsif Warning_Msg_Char /= ' ' then + Errors.Table (Cur_Msg).Warn_Chr := Warning_Msg_Char; + end if; + end if; end; return; end if; - -- Otherwise build error message object for new message + -- Here we build a new error object Errors.Append ((Text => new String'(Msg_Buffer (1 .. Msglen)), @@ -911,6 +921,7 @@ package body Errout is Line => Get_Physical_Line_Number (Sptr), Col => Get_Column_Number (Sptr), Warn => Is_Warning_Msg, + Warn_Chr => Warning_Msg_Char, Style => Is_Style_Msg, Serious => Is_Serious_Error, Uncond => Is_Unconditional_Msg, @@ -2655,6 +2666,40 @@ package body Errout is C : Character; -- Current character P : Natural; -- Current index; + procedure Set_Msg_Insertion_Warning; + -- Deal with ? ?? ?x? ?X? insertion sequences + + ------------------------------- + -- Set_Msg_Insertion_Warning -- + ------------------------------- + + procedure Set_Msg_Insertion_Warning is + begin + Warning_Msg_Char := ' '; + + if P <= Text'Last and then Text (P) = '?' then + if Warning_Doc_Switch then + Warning_Msg_Char := '?'; + end if; + + P := P + 1; + + elsif P + 1 <= Text'Last + and then (Text (P) in 'a' .. 'z' + or else + Text (P) in 'A' .. 'Z') + and then Text (P + 1) = '?' + then + if Warning_Doc_Switch then + Warning_Msg_Char := Text (P); + end if; + + P := P + 2; + end if; + end Set_Msg_Insertion_Warning; + + -- Start of processing for Set_Msg_Text + begin Manual_Quote_Mode := False; Is_Unconditional_Msg := False; @@ -2725,10 +2770,16 @@ package body Errout is Is_Unconditional_Msg := True; when '?' => - null; -- already dealt with + Set_Msg_Insertion_Warning; when '<' => - null; -- already dealt with + + -- If tagging of messages is enabled, and this is a warning, + -- then it is treated as being [enabled by default]. + + if Error_Msg_Warn and Warning_Doc_Switch then + Warning_Msg_Char := '?'; + end if; when '|' => null; -- already dealt with diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index 0f746d989cc..f8d1fdadb26 100644 --- a/gcc/ada/errout.ads +++ b/gcc/ada/errout.ads @@ -59,6 +59,12 @@ package Errout is Error_Msg_Exception : exception renames Err_Vars.Error_Msg_Exception; -- Exception raised if Raise_Exception_On_Error is true + Warning_Doc_Switch : Boolean renames Err_Vars.Warning_Doc_Switch; + -- If this is set True, then the ??/?x?/?X? sequences in error messages + -- are active (see errout.ads for details). If this switch is False, then + -- these sequences are ignored (i.e. simply equivalent to a single ?). The + -- -gnatw.d switch sets this flag True, -gnatw.D sets this flag False. + ----------------------------------- -- Suppression of Error Messages -- ----------------------------------- @@ -275,6 +281,24 @@ package Errout is -- messages, and the usual style is to include it, since it makes it -- clear that the continuation is part of a warning message. + -- Insertion character ?? (two question marks) + -- Like ?, but if the flag Warn_Doc_Switch is True, adds the string + -- "[enabled by default]" at the end of the warning message. In the + -- case of continuations, use this in each continuation message. + + -- Insertion character ?x? (warning with switch) + -- Like ?, but if the flag Warn_Doc_Switch is True, adds the string + -- "[-gnatwx]" at the end of the warning message. x is a lower case + -- letter. In the case of continuations, use this on each continuation + -- message. + + -- Insertion character ?X? (warning with dot switch) + -- Like ?, but if the flag Warn_Doc_Switch is True, adds the string + -- "[-gnatw.x]" at the end of the warning message. X is an upper case + -- letter corresponding to the lower case letter x in the message. In + -- the case of continuations, use this on each continuation + -- message. + -- Insertion character < (Less Than: conditional warning message) -- The character < appearing anywhere in a message is used for a -- conditional error message. If Error_Msg_Warn is True, then the diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb index 56a4e3547fb..35f71a4a7cf 100644 --- a/gcc/ada/erroutc.adb +++ b/gcc/ada/erroutc.adb @@ -442,13 +442,37 @@ package body Erroutc is Length : Nat; -- Maximum total length of lines - Txt : constant String_Ptr := Errors.Table (E).Text; - Len : constant Natural := Txt'Length; - Ptr : Natural; - Split : Natural; - Start : Natural; + Text : constant String_Ptr := Errors.Table (E).Text; + Warn : constant Boolean := Errors.Table (E).Warn; + Warn_Chr : constant Character := Errors.Table (E).Warn_Chr; + Warn_Tag : String_Ptr; + Ptr : Natural; + Split : Natural; + Start : Natural; begin + -- Add warning doc tag if needed + + if Warn and then Warn_Chr /= ' ' then + if Warn_Chr = '?' then + Warn_Tag := new String'(" [enabled by default]"); + + elsif Warn_Chr in 'a' .. 'z' then + Warn_Tag := new String'(" [-gnatw" & Warn_Chr & ']'); + + else pragma Assert (Warn_Chr in 'A' .. 'Z'); + Warn_Tag := + new String'(" [-gnatw." + & Character'Val (Character'Pos (Warn_Chr) + 32) + & ']'); + end if; + + else + Warn_Tag := new String'(""); + end if; + + -- Set error message line length + if Error_Msg_Line_Length = 0 then Length := Nat'Last; else @@ -457,87 +481,95 @@ package body Erroutc is Max := Integer (Length - Column + 1); - -- For warning message, add "warning: " unless msg starts with "info: " + declare + Txt : constant String := Text.all & Warn_Tag.all; + Len : constant Natural := Txt'Length; - if Errors.Table (E).Warn then - if Len < 6 or else Txt (Txt'First .. Txt'First + 5) /= "info: " then - Write_Str ("warning: "); - Max := Max - 9; - end if; + begin + -- For warning, add "warning: " unless msg starts with "info: " - -- No prefix needed for style message, since "(style)" is there already + if Errors.Table (E).Warn then + if Len < 6 + or else Txt (Txt'First .. Txt'First + 5) /= "info: " + then + Write_Str ("warning: "); + Max := Max - 9; + end if; - elsif Errors.Table (E).Style then - null; + -- No prefix needed for style message, "(style)" is there already - -- All other cases, add "error: " + elsif Errors.Table (E).Style then + null; - elsif Opt.Unique_Error_Tag then - Write_Str ("error: "); - Max := Max - 7; - end if; + -- All other cases, add "error: " - -- Here we have to split the message up into multiple lines + elsif Opt.Unique_Error_Tag then + Write_Str ("error: "); + Max := Max - 7; + end if; - Ptr := 1; - loop - -- Make sure we do not have ludicrously small line + -- Here we have to split the message up into multiple lines - Max := Integer'Max (Max, 20); + Ptr := 1; + loop + -- Make sure we do not have ludicrously small line - -- If remaining text fits, output it respecting LF and we are done + Max := Integer'Max (Max, 20); - if Len - Ptr < Max then - for J in Ptr .. Len loop - if Txt (J) = ASCII.LF then - Write_Eol; - Write_Spaces (Offs); - else - Write_Char (Txt (J)); - end if; - end loop; + -- If remaining text fits, output it respecting LF and we are done - return; + if Len - Ptr < Max then + for J in Ptr .. Len loop + if Txt (J) = ASCII.LF then + Write_Eol; + Write_Spaces (Offs); + else + Write_Char (Txt (J)); + end if; + end loop; + + return; -- Line does not fit - else - Start := Ptr; + else + Start := Ptr; - -- First scan forward looking for a hard end of line + -- First scan forward looking for a hard end of line - for Scan in Ptr .. Ptr + Max - 1 loop - if Txt (Scan) = ASCII.LF then - Split := Scan - 1; - Ptr := Scan + 1; - goto Continue; - end if; - end loop; + for Scan in Ptr .. Ptr + Max - 1 loop + if Txt (Scan) = ASCII.LF then + Split := Scan - 1; + Ptr := Scan + 1; + goto Continue; + end if; + end loop; - -- Otherwise scan backwards looking for a space + -- Otherwise scan backwards looking for a space - for Scan in reverse Ptr .. Ptr + Max - 1 loop - if Txt (Scan) = ' ' then - Split := Scan - 1; - Ptr := Scan + 1; - goto Continue; - end if; - end loop; + for Scan in reverse Ptr .. Ptr + Max - 1 loop + if Txt (Scan) = ' ' then + Split := Scan - 1; + Ptr := Scan + 1; + goto Continue; + end if; + end loop; - -- If we fall through, no space, so split line arbitrarily + -- If we fall through, no space, so split line arbitrarily - Split := Ptr + Max - 1; - Ptr := Split + 1; - end if; + Split := Ptr + Max - 1; + Ptr := Split + 1; + end if; - <<Continue>> - if Start <= Split then - Write_Line (Txt (Start .. Split)); - Write_Spaces (Offs); - end if; + <<Continue>> + if Start <= Split then + Write_Line (Txt (Start .. Split)); + Write_Spaces (Offs); + end if; - Max := Integer (Length - Column + 1); - end loop; + Max := Integer (Length - Column + 1); + end loop; + end; end Output_Msg_Text; -------------------- @@ -846,9 +878,7 @@ package body Erroutc is -- Remove upper case letter at end, again, we should not be getting -- such names, and what we hope is that the remainder makes sense. - if Name_Len > 1 - and then Name_Buffer (Name_Len) in 'A' .. 'Z' - then + if Name_Len > 1 and then Name_Buffer (Name_Len) in 'A' .. 'Z' then Name_Len := Name_Len - 1; end if; @@ -1217,11 +1247,13 @@ package body Erroutc is and then (J = Msg'First or else Msg (J - 1) /= ''') then Is_Warning_Msg := True; + Warning_Msg_Char := ' '; elsif Msg (J) = '<' and then (J = Msg'First or else Msg (J - 1) /= ''') then Is_Warning_Msg := Error_Msg_Warn; + Warning_Msg_Char := ' '; elsif Msg (J) = '|' and then (J = Msg'First or else Msg (J - 1) /= ''') diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads index fc5cfa9fc21..4e38fbd30fb 100644 --- a/gcc/ada/erroutc.ads +++ b/gcc/ada/erroutc.ads @@ -50,6 +50,13 @@ package Erroutc is Is_Warning_Msg : Boolean := False; -- Set True to indicate if current message is warning message + Warning_Msg_Char : Character; + -- Warning character, valid only if Is_Warning_Msg is True + -- ' ' -- ? appeared on its own in message + -- '?' -- ?? appeared in message + -- 'x' -- ?x? appeared in message + -- 'X' -- ?x? appeared in message (X is upper case of x) + Is_Style_Msg : Boolean := False; -- Set True to indicate if the current message is a style message -- (i.e. a message whose text starts with the characters "(style)"). @@ -182,6 +189,13 @@ package Erroutc is Warn : Boolean; -- True if warning message (i.e. insertion character ? appeared) + Warn_Chr : Character; + -- Warning character, valid only if Warn is True + -- ' ' -- ? appeared on its own in message + -- '?' -- ?? appeared in message + -- 'x' -- ?x? appeared in message + -- 'X' -- ?x? appeared in message (X is upper case of x) + Style : Boolean; -- True if style message (starts with "(style)") diff --git a/gcc/ada/errutil.adb b/gcc/ada/errutil.adb index d6fa960a7a4..3a087caac66 100644 --- a/gcc/ada/errutil.adb +++ b/gcc/ada/errutil.adb @@ -211,6 +211,7 @@ package body Errutil is Errors.Table (Cur_Msg).Col := Get_Column_Number (Sptr); Errors.Table (Cur_Msg).Style := Is_Style_Msg; Errors.Table (Cur_Msg).Warn := Is_Warning_Msg; + Errors.Table (Cur_Msg).Warn_Chr := Warning_Msg_Char; Errors.Table (Cur_Msg).Serious := Is_Serious_Error; Errors.Table (Cur_Msg).Uncond := Is_Unconditional_Msg; Errors.Table (Cur_Msg).Msg_Cont := Continuation; diff --git a/gcc/ada/exit.c b/gcc/ada/exit.c index 47983e87ef7..7dc9105fb4e 100644 --- a/gcc/ada/exit.c +++ b/gcc/ada/exit.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 1992-2011, Free Software Foundation, Inc. * + * Copyright (C) 1992-2012, Free Software Foundation, Inc. * * * * GNAT is free software; you can redistribute it and/or modify it under * * terms of the GNU General Public License as published by the Free Soft- * @@ -29,10 +29,6 @@ * * ****************************************************************************/ -#ifdef __cplusplus -extern "C" { -#endif - #ifdef __alpha_vxworks #include "vxWorks.h" #endif @@ -48,6 +44,10 @@ extern "C" { #include "adaint.h" +#ifdef __cplusplus +extern "C" { +#endif + /* Routine used by Ada.Command_Line.Set_Exit_Status. */ int gnat_exit_status = 0; diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 1d42bf89948..10a4a560984 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -431,13 +431,14 @@ package body Exp_Aggr is if Present (Component_Associations (N)) then Indx := First (Choices (First (Component_Associations (N)))); + if Is_Entity_Name (Indx) and then not Is_Type (Entity (Indx)) then Error_Msg_N - ("single component aggregate in non-static context?", - Indx); - Error_Msg_N ("\maybe subtype name was meant?", Indx); + ("single component aggregate in " + & "non-static context??", Indx); + Error_Msg_N ("\maybe subtype name was meant??", Indx); end if; end if; @@ -3057,7 +3058,7 @@ package body Exp_Aggr is elsif Expr_Value (Val1) /= Expr_Value (Val2) then Apply_Compile_Time_Constraint_Error (Aggr, - Msg => "incorrect value for discriminant&?", + Msg => "incorrect value for discriminant&??", Reason => CE_Discriminant_Check_Failed, Ent => D); return False; @@ -3767,7 +3768,7 @@ package body Exp_Aggr is else Error_Msg_N - ("non-static object requires elaboration code?", N); + ("non-static object requires elaboration code??", N); exit; end if; @@ -3775,7 +3776,7 @@ package body Exp_Aggr is end loop; if Present (Component_Associations (N)) then - Error_Msg_N ("object requires elaboration code?", N); + Error_Msg_N ("object requires elaboration code??", N); end if; end if; end; diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index 56cf190e2a8..07b631de6eb 100644 --- a/gcc/ada/exp_ch11.adb +++ b/gcc/ada/exp_ch11.adb @@ -1005,8 +1005,8 @@ package body Exp_Ch11 is then Warn_No_Exception_Propagation_Active (Handler); Error_Msg_N - ("\?this handler can never be entered, and has been removed", - Handler); + ("\?X?this handler can never be entered, " + & "and has been removed", Handler); end if; if No_Exception_Propagation_Active then @@ -1808,10 +1808,10 @@ package body Exp_Ch11 is if Configurable_Run_Time_Mode then Error_Msg_NE - ("\?& may call Last_Chance_Handler", N, E); + ("\?X?& may call Last_Chance_Handler", N, E); else Error_Msg_NE - ("\?& may result in unhandled exception", N, E); + ("\?X?& may result in unhandled exception", N, E); end if; end if; end; @@ -2147,10 +2147,10 @@ package body Exp_Ch11 is if Configurable_Run_Time_Mode then Error_Msg_N - ("\?Last_Chance_Handler will be called on exception", N); + ("\?X?Last_Chance_Handler will be called on exception", N); else Error_Msg_N - ("\?execution may raise unhandled exception", N); + ("\?X?execution may raise unhandled exception", N); end if; end if; end Warn_If_No_Propagation; @@ -2162,7 +2162,7 @@ package body Exp_Ch11 is procedure Warn_No_Exception_Propagation_Active (N : Node_Id) is begin Error_Msg_N - ("?pragma Restrictions (No_Exception_Propagation) in effect", N); + ("?X?pragma Restrictions (No_Exception_Propagation) in effect", N); end Warn_No_Exception_Propagation_Active; end Exp_Ch11; diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 2434d5b7d95..096d14e7503 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -7132,7 +7132,7 @@ package body Exp_Ch3 is if Is_Ancestor (RSPWS, Etype (Pool)) then Error_Msg_N - ("?subpool access type has deeper accessibility " & + ("??subpool access type has deeper accessibility " & "level than pool", Def_Id); Append_Freeze_Action (Def_Id, @@ -7744,14 +7744,13 @@ package body Exp_Ch3 is if Warning_Needed then Error_Msg_N - ("Objects of the type cannot be initialized " & - "statically by default?", - Parent (E)); + ("Objects of the type cannot be initialized " + & "statically by default??", Parent (E)); end if; end if; else - Error_Msg_N ("Object cannot be initialized statically?", E); + Error_Msg_N ("Object cannot be initialized statically??", E); end if; end if; end Initialization_Warning; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index b7ecd830048..446a310345b 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -3686,7 +3686,7 @@ package body Exp_Ch4 is Kill_Dead_Code (Declaration_Node (Entity (High_Bound))); Apply_Compile_Time_Constraint_Error (N => Cnode, - Msg => "concatenation result upper bound out of range?", + Msg => "concatenation result upper bound out of range??", Reason => CE_Range_Check_Failed); end Expand_Concatenate; @@ -5501,9 +5501,10 @@ package body Exp_Ch4 is -- actually eliminated the danger of optimization above. if Overflow_Check_Mode not in Minimized_Or_Eliminated then - Error_Msg_N ("?explicit membership test may be optimized away", N); + Error_Msg_N + ("??explicit membership test may be optimized away", N); Error_Msg_N -- CODEFIX - ("\?use ''Valid attribute instead", N); + ("\??use ''Valid attribute instead", N); end if; return; @@ -5684,8 +5685,8 @@ package body Exp_Ch4 is if Lcheck = LT or else Ucheck = GT then if Warn1 then - Error_Msg_N ("?range test optimized away", N); - Error_Msg_N ("\?value is known to be out of range", N); + Error_Msg_N ("?c?range test optimized away", N); + Error_Msg_N ("\?c?value is known to be out of range", N); end if; Rewrite (N, New_Reference_To (Standard_False, Loc)); @@ -5698,8 +5699,8 @@ package body Exp_Ch4 is elsif Lcheck in Compare_GE and then Ucheck in Compare_LE then if Warn1 then - Error_Msg_N ("?range test optimized away", N); - Error_Msg_N ("\?value is known to be in range", N); + Error_Msg_N ("?c?range test optimized away", N); + Error_Msg_N ("\?c?value is known to be in range", N); end if; Rewrite (N, New_Reference_To (Standard_True, Loc)); @@ -5713,8 +5714,8 @@ package body Exp_Ch4 is elsif Lcheck in Compare_GE then if Warn2 and then not In_Instance then - Error_Msg_N ("?lower bound test optimized away", Lo); - Error_Msg_N ("\?value is known to be in range", Lo); + Error_Msg_N ("??lower bound test optimized away", Lo); + Error_Msg_N ("\??value is known to be in range", Lo); end if; Rewrite (N, @@ -5730,8 +5731,8 @@ package body Exp_Ch4 is elsif Ucheck in Compare_LE then if Warn2 and then not In_Instance then - Error_Msg_N ("?upper bound test optimized away", Hi); - Error_Msg_N ("\?value is known to be in range", Hi); + Error_Msg_N ("??upper bound test optimized away", Hi); + Error_Msg_N ("\??value is known to be in range", Hi); end if; Rewrite (N, @@ -5755,25 +5756,25 @@ package body Exp_Ch4 is if Lcheck = LT or else Ucheck = GT then Error_Msg_N - ("?value can only be in range if it is invalid", N); + ("?c?value can only be in range if it is invalid", N); -- Result is in range for valid value elsif Lcheck in Compare_GE and then Ucheck in Compare_LE then Error_Msg_N - ("?value can only be out of range if it is invalid", N); + ("?c?value can only be out of range if it is invalid", N); -- Lower bound check succeeds if value is valid elsif Warn2 and then Lcheck in Compare_GE then Error_Msg_N - ("?lower bound check only fails if it is invalid", Lo); + ("?c?lower bound check only fails if it is invalid", Lo); -- Upper bound check succeeds if value is valid elsif Warn2 and then Ucheck in Compare_LE then Error_Msg_N - ("?upper bound check only fails for invalid values", Hi); + ("?c?upper bound check only fails for invalid values", Hi); end if; end if; end; @@ -9665,9 +9666,10 @@ package body Exp_Ch4 is Reason => PE_Accessibility_Check_Failed)); Set_Etype (N, Target_Type); - Error_Msg_N ("?accessibility check failure", N); + Error_Msg_N + ("??accessibility check failure", N); Error_Msg_NE - ("\?& will be raised at run time", N, Standard_Program_Error); + ("\??& will be raised at run time", N, Standard_Program_Error); end Raise_Accessibility_Error; ---------------------- @@ -10632,7 +10634,7 @@ package body Exp_Ch4 is end if; -- Otherwise force evaluation unless Assignment_OK flag is set (this - -- flag indicates ??? -- more comments needed here) + -- flag indicates ??? More comments needed here) if Assignment_OK (N) then null; @@ -12061,7 +12063,7 @@ package body Exp_Ch4 is if Constant_Condition_Warnings and then Comes_From_Source (Original_Node (N)) then - Error_Msg_N ("could replace by ""'=""?", N); + Error_Msg_N ("could replace by ""'=""?c?", N); end if; Op := N_Op_Eq; @@ -12254,7 +12256,8 @@ package body Exp_Ch4 is and then not Has_Warnings_Off (Etype (Left_Opnd (N))) then Error_Msg_N - ("can never be greater than, could replace by ""'=""?", N); + ("can never be greater than, could replace by ""'=""?c?", + N); Warning_Generated := True; end if; @@ -12279,7 +12282,7 @@ package body Exp_Ch4 is and then not Has_Warnings_Off (Etype (Left_Opnd (N))) then Error_Msg_N - ("can never be less than, could replace by ""'=""?", N); + ("can never be less than, could replace by ""'=""?c?", N); Warning_Generated := True; end if; @@ -12312,11 +12315,11 @@ package body Exp_Ch4 is then if True_Result then Error_Msg_N - ("condition can only be False if invalid values present?", + ("condition can only be False if invalid values present??", N); elsif False_Result then Error_Msg_N - ("condition can only be True if invalid values present?", + ("condition can only be True if invalid values present??", N); end if; end if; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index c3cf8c8e70b..cd83d45bddc 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -1450,7 +1450,7 @@ package body Exp_Ch6 is and then Is_Valued_Procedure (Scope (Formal)) then Error_Msg_N - ("by_reference actual may be misaligned?", Actual); + ("by_reference actual may be misaligned??", Actual); return False; else @@ -1527,8 +1527,9 @@ package body Exp_Ch6 is and then In_Open_Scopes (Entity (Actual)) then if Scope (Subp) /= Entity (Actual) then - Error_Msg_N ("operation outside protected type may not " - & "call back its protected operations?", Actual); + Error_Msg_N + ("operation outside protected type may not " + & "call back its protected operations??", Actual); end if; Rewrite (Actual, @@ -2002,8 +2003,7 @@ package body Exp_Ch6 is (Loc, Sloc (Body_To_Inline (Spec))) then Error_Msg_NE - ("cannot inline& (body not seen yet)?", - Call_Node, Subp); + ("cannot inline& (body not seen yet)??", Call_Node, Subp); else declare @@ -2122,7 +2122,7 @@ package body Exp_Ch6 is if not In_Same_Extended_Unit (Call_Node, Subp) then Cannot_Inline - ("cannot inline& (body not seen yet)", Call_Node, Subp, + ("cannot inline& (body not seen yet)?", Call_Node, Subp, Is_Serious => True); elsif In_Open_Scopes (Subp) then @@ -2136,7 +2136,7 @@ package body Exp_Ch6 is and then Optimization_Level = 0 then Error_Msg_N - ("call to recursive subprogram cannot be inlined?", + ("call to recursive subprogram cannot be inlined?p?", N); -- Do not emit error compiling runtime packages @@ -2145,7 +2145,7 @@ package body Exp_Ch6 is (Unit_File_Name (Get_Source_Unit (Subp))) then Error_Msg_N - ("call to recursive subprogram cannot be inlined?", + ("call to recursive subprogram cannot be inlined??", N); else @@ -3790,7 +3790,8 @@ package body Exp_Ch6 is and then In_Same_Extended_Unit (Sloc (Spec), Loc) then Cannot_Inline - ("cannot inline& (body not seen yet)?", Call_Node, Subp); + ("cannot inline& (body not seen yet)?", + Call_Node, Subp); end if; end if; end Inlined_Subprogram; @@ -4644,7 +4645,7 @@ package body Exp_Ch6 is -- subprograms this must be done explicitly. if In_Open_Scopes (Subp) then - Error_Msg_N ("call to recursive subprogram cannot be inlined?", N); + Error_Msg_N ("call to recursive subprogram cannot be inlined??", N); Set_Is_Inlined (Subp, False); return; diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 78ad5d27d67..72892828b61 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -148,6 +148,7 @@ package body Exp_Ch7 is -- Set the field Node_To_Be_Wrapped of the current scope -- ??? The entire comment needs to be rewritten + -- ??? which entire comment? ----------------------------- -- Finalization Management -- @@ -3379,7 +3380,7 @@ package body Exp_Ch7 is -- with the array case and non-discriminated record cases. Error_Msg_N - ("task/protected object in variant record will not be freed?", N); + ("task/protected object in variant record will not be freed??", N); return New_List (Make_Null_Statement (Loc)); end if; diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 781de8695dc..49e7efeba6e 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -8812,9 +8812,7 @@ package body Exp_Ch9 is if Present (Private_Declarations (Pdef)) then Priv := First (Private_Declarations (Pdef)); - while Present (Priv) loop - if Nkind (Priv) = N_Component_Declaration then if not Static_Component_Size (Defining_Identifier (Priv)) then @@ -8827,10 +8825,10 @@ package body Exp_Ch9 is Check_Restriction (No_Implicit_Heap_Allocations, Priv); elsif Restriction_Active (No_Implicit_Heap_Allocations) then - Error_Msg_N ("component has non-static size?", Priv); + Error_Msg_N ("component has non-static size??", Priv); Error_Msg_NE ("\creation of protected object of type& will violate" - & " restriction No_Implicit_Heap_Allocations?", + & " restriction No_Implicit_Heap_Allocations??", Priv, Prot_Typ); end if; end if; diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 23235d8db51..c0872ade55f 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -8431,11 +8431,11 @@ package body Exp_Disp is if Is_Controlled (Typ) then if not Finalized then Error_Msg_N - ("controlled type has no explicit Finalize method?", Typ); + ("controlled type has no explicit Finalize method??", Typ); elsif not Adjusted then Error_Msg_N - ("controlled type has no explicit Adjust method?", Typ); + ("controlled type has no explicit Adjust method??", Typ); end if; end if; @@ -8754,7 +8754,7 @@ package body Exp_Disp is if Has_CPP_Constructors (Typ) and then No (Init_Proc (Typ)) then - Error_Msg_N ("?default constructor must be imported from C++", Typ); + Error_Msg_N ("??default constructor must be imported from C++", Typ); end if; end Set_CPP_Constructors; diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index 7c7fbd06f5f..8649fafff54 100644 --- a/gcc/ada/exp_dist.adb +++ b/gcc/ada/exp_dist.adb @@ -7417,6 +7417,7 @@ package body Exp_Dist is -- If the current parameter has a dynamic constrained status, then -- this status is transmitted as well. + -- This should be done for accessibility as well ??? if Nkind (Parameter_Type (Current_Parameter)) /= diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb index bc43a4b4e06..b2c24c83101 100644 --- a/gcc/ada/exp_intr.adb +++ b/gcc/ada/exp_intr.adb @@ -210,6 +210,15 @@ package body Exp_Intr is Result_Typ : Entity_Id; begin + -- Remove side effects from tag argument early, before rewriting + -- the dispatching constructor call, as Remove_Side_Effects relies + -- on Tag_Arg's Parent link properly attached to the tree (once the + -- call is rewritten, the Parent is inconsistent as it points to the + -- rewritten node, which is not the syntactic parent of the Tag_Arg + -- anymore). + + Remove_Side_Effects (Tag_Arg); + -- The subprogram is the third actual in the instantiation, and is -- retrieved from the corresponding renaming declaration. However, -- freeze nodes may appear before, so we retrieve the declaration @@ -223,15 +232,10 @@ package body Exp_Intr is Act_Constr := Entity (Name (Act_Rename)); Result_Typ := Class_Wide_Type (Etype (Act_Constr)); - -- Ada 2005 (AI-251): If the result is an interface type, the function - -- returns a class-wide interface type (otherwise the resulting object - -- would be abstract!) - if Is_Interface (Etype (Act_Constr)) then - Set_Etype (Act_Constr, Result_Typ); - -- If the result type is not parent of Tag_Arg then we need to - -- locate the tag of the secondary dispatch table. + -- If the result type is not known to be a parent of Tag_Arg then we + -- need to locate the tag of the secondary dispatch table. if not Is_Ancestor (Etype (Result_Typ), Etype (Tag_Arg), Use_Full_View => True) @@ -255,7 +259,7 @@ package body Exp_Intr is New_Reference_To (RTE (RE_Tag), Loc), Expression => Make_Function_Call (Loc, - Name => Fname, + Name => Fname, Parameter_Associations => New_List ( Relocate_Node (Tag_Arg), New_Reference_To @@ -283,9 +287,7 @@ package body Exp_Intr is Set_Controlling_Argument (Cnstr_Call, New_Occurrence_Of (Defining_Identifier (Iface_Tag), Loc)); else - Remove_Side_Effects (Tag_Arg); - Set_Controlling_Argument (Cnstr_Call, - Relocate_Node (Tag_Arg)); + Set_Controlling_Argument (Cnstr_Call, Relocate_Node (Tag_Arg)); end if; -- Rewrite and analyze the call to the instance as a class-wide @@ -314,7 +316,7 @@ package body Exp_Intr is elsif not Is_Interface (Result_Typ) then declare - Obj_Tag_Node : Node_Id := Duplicate_Subexpr (Tag_Arg); + Obj_Tag_Node : Node_Id := New_Copy_Tree (Tag_Arg); CW_Test_Node : Node_Id; begin @@ -348,7 +350,7 @@ package body Exp_Intr is Name => New_Occurrence_Of (RTE (RE_IW_Membership), Loc), Parameter_Associations => New_List ( Make_Attribute_Reference (Loc, - Prefix => Duplicate_Subexpr (Tag_Arg), + Prefix => New_Copy_Tree (Tag_Arg), Attribute_Name => Name_Address), New_Reference_To ( @@ -1045,9 +1047,9 @@ package body Exp_Intr is and then Is_Entity_Name (Nam2) and then Entity (Prefix (Nam1)) = Entity (Nam2) then - Error_Msg_N ("abort may take time to complete?", N); - Error_Msg_N ("\deallocation might have no effect?", N); - Error_Msg_N ("\safer to wait for termination.?", N); + Error_Msg_N ("abort may take time to complete??", N); + Error_Msg_N ("\deallocation might have no effect??", N); + Error_Msg_N ("\safer to wait for termination??", N); end if; end if; end; diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index d34322dc626..537fa01eafd 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -274,18 +274,18 @@ package body Exp_Prag is -------------------------- procedure Expand_Pragma_Check (N : Node_Id) is - Cond : constant Node_Id := Arg2 (N); - Nam : constant Name_Id := Chars (Arg1 (N)); + Loc : constant Source_Ptr := Sloc (N); + -- Location of the pragma node. Note: it is important to use this + -- location (and not the location of the expression) for the generated + -- statements, otherwise the implicit return statement in the body + -- of a pre/postcondition subprogram may inherit the source location + -- of part of the expression, which causes confusing debug information + -- to be generated, which interferes with coverage analysis tools. + + Cond : constant Node_Id := Arg2 (N); + Nam : constant Name_Id := Chars (Arg1 (N)); Msg : Node_Id; - Loc : constant Source_Ptr := Sloc (First_Node (Cond)); - -- Source location used in the case of a failed assertion. Note that - -- the source location of the expression is not usually the best choice - -- here. For example, it gets located on the last AND keyword in a - -- chain of boolean expressiond AND'ed together. It is best to put the - -- message on the first character of the assertion, which is the effect - -- of the First_Node call here. - begin -- We already know that this check is enabled, because otherwise the -- semantic pass dealt with rewriting the assertion (see Sem_Prag) @@ -362,7 +362,15 @@ package body Exp_Prag is else declare - Msg_Loc : constant String := Build_Location_String (Loc); + Msg_Loc : constant String := + Build_Location_String (Sloc (First_Node (Cond))); + -- Source location used in the case of a failed assertion: + -- point to the failing condition, not Loc. Note that the + -- source location of the expression is not usually the best + -- choice here. For example, it gets located on the last AND + -- keyword in a chain of boolean expressiond AND'ed together. + -- It is best to put the message on the first character of the + -- condition, which is the effect of the First_Node call here. begin Name_Len := 0; @@ -440,10 +448,12 @@ package body Exp_Prag is and then Entity (Original_Node (Cond)) = Standard_False then return; + elsif Nam = Name_Assertion then - Error_Msg_N ("?assertion will fail at run time", N); + Error_Msg_N ("?A?assertion will fail at run time", N); else - Error_Msg_N ("?check will fail at run time", N); + + Error_Msg_N ("?A?check will fail at run time", N); end if; end if; end Expand_Pragma_Check; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 3a9f81db0fc..29d8182ff83 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -224,9 +224,11 @@ package body Exp_Util is end case; if Present (Msg_Node) then - Error_Msg_N ("?info: atomic synchronization set for &", Msg_Node); + Error_Msg_N + ("?N?info: atomic synchronization set for &", Msg_Node); else - Error_Msg_N ("?info: atomic synchronization set", N); + Error_Msg_N + ("?N?info: atomic synchronization set", N); end if; end if; end Activate_Atomic_Synchronization; @@ -5125,7 +5127,8 @@ package body Exp_Util is if W then Error_Msg_F - ("?this code can never be executed and has been deleted!", N); + ("?t?this code can never be executed and has been deleted!", + N); end if; end if; diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h index fe52233202b..552a8bf1ae9 100644 --- a/gcc/ada/fe.h +++ b/gcc/ada/fe.h @@ -178,19 +178,21 @@ extern Boolean In_Same_Source_Unit (Node_Id, Node_Id); /* opt: */ -#define Global_Discard_Names opt__global_discard_names +#define Back_Annotate_Rep_Info opt__back_annotate_rep_info #define Exception_Extra_Info opt__exception_extra_info #define Exception_Locations_Suppressed opt__exception_locations_suppressed #define Exception_Mechanism opt__exception_mechanism -#define Back_Annotate_Rep_Info opt__back_annotate_rep_info +#define Generate_SCO_Instance_Table opt__generate_sco_instance_table +#define Global_Discard_Names opt__global_discard_names typedef enum {Setjmp_Longjmp, Back_End_Exceptions} Exception_Mechanism_Type; -extern Boolean Global_Discard_Names; +extern Boolean Back_Annotate_Rep_Info; extern Boolean Exception_Extra_Info; extern Boolean Exception_Locations_Suppressed; extern Exception_Mechanism_Type Exception_Mechanism; -extern Boolean Back_Annotate_Rep_Info; +extern Boolean Generate_SCO_Instance_Table; +extern Boolean Global_Discard_Names; /* restrict: */ diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 6c647111627..5df4c727194 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -802,17 +802,22 @@ package body Freeze is -- size of packed records if we can tell the size of the packed -- record in the front end. Packed_Size_Known is True if so far -- we can figure out the size. It is initialized to True for a - -- packed record, unless the record has discriminants. The - -- reason we eliminate the discriminated case is that we don't - -- know the way the back end lays out discriminated packed - -- records. If Packed_Size_Known is True, then Packed_Size is - -- the size in bits so far. + -- packed record, unless the record has discriminants or atomic + -- components or independent components. + + -- The reason we eliminate the discriminated case is that + -- we don't know the way the back end lays out discriminated + -- packed records. If Packed_Size_Known is True, then + -- Packed_Size is the size in bits so far. Packed_Size_Known : Boolean := - Is_Packed (T) - and then not Has_Discriminants (T); + Is_Packed (T) + and then not Has_Discriminants (T) + and then not Has_Atomic_Components (T) + and then not Has_Independent_Components (T); Packed_Size : Uint := Uint_0; + -- SIze in bis so far begin -- Test for variant part present @@ -856,6 +861,16 @@ package body Freeze is Packed_Size_Known := False; end if; + -- We do not know the packed size if we have a by reference + -- type, or an atomic type or an atomic component. + + if Is_Atomic (Ctyp) + or else Is_Atomic (Comp) + or else Is_By_Reference_Type (Ctyp) + then + Packed_Size_Known := False; + end if; + -- We need to identify a component that is an array where -- the index type is an enumeration type with non-standard -- representation, and some bound of the type depends on a @@ -934,10 +949,19 @@ package body Freeze is and then Is_Modular_Integer_Type (Packed_Array_Type (Ctyp))) then + -- Packed size unknown if we have an atomic type + -- or a by reference type, since the back end + -- knows how these are layed out. + + if Is_Atomic (Ctyp) + or else Is_By_Reference_Type (Ctyp) + then + Packed_Size_Known := False; + -- If RM_Size is known and static, then we can keep - -- accumulating the packed size. + -- accumulating the packed size - if Known_Static_RM_Size (Ctyp) then + elsif Known_Static_RM_Size (Ctyp) then -- A little glitch, to be removed sometime ??? -- gigi does not understand zero sizes yet. @@ -1040,11 +1064,18 @@ package body Freeze is if Present (Comp) then Err_Node := Comp; Comp_Type := Etype (Comp); - Comp_Def := Component_Definition (Parent (Comp)); - Comp_Byte_Aligned := - Present (Component_Clause (Comp)) - and then Normalized_First_Bit (Comp) mod System_Storage_Unit = 0; + if Is_Tag (Comp) then + Comp_Def := Empty; + Comp_Byte_Aligned := True; + + else + Comp_Def := Component_Definition (Parent (Comp)); + Comp_Byte_Aligned := + Present (Component_Clause (Comp)) + and then + Normalized_First_Bit (Comp) mod System_Storage_Unit = 0; + end if; -- Array case @@ -1080,7 +1111,7 @@ package body Freeze is & "storage order as enclosing composite", Err_Node); end if; - elsif Aliased_Present (Comp_Def) then + elsif Present (Comp_Def) and then Aliased_Present (Comp_Def) then Error_Msg_N ("aliased component not permitted for type with " & "explicit Scalar_Storage_Order", Err_Node); @@ -1817,6 +1848,10 @@ package body Freeze is Decl : constant Node_Id := Declaration_Node (Underlying_Type (Utype)); begin + if not Warn_On_Suspicious_Modulus_Value then + return; + end if; + if Nkind (Decl) = N_Full_Type_Declaration then declare Tdef : constant Node_Id := Type_Definition (Decl); @@ -1826,6 +1861,7 @@ package body Freeze is declare Modulus : constant Node_Id := Original_Node (Expression (Tdef)); + begin if Nkind (Modulus) = N_Integer_Literal then declare @@ -1870,7 +1906,7 @@ package body Freeze is Error_Msg_Uint_1 := Modv; Error_Msg_N - ("?2 '*'*^' may have been intended here", + ("?M?2 '*'*^' may have been intended here", Modulus); end; end if; @@ -2285,7 +2321,7 @@ package body Freeze is if not (Placed_Component or else Is_Packed (Rec)) then Error_Msg_N - ("?scalar storage order specified but no component clause", + ("??scalar storage order specified but no component clause", ADC); end if; @@ -2304,9 +2340,9 @@ package body Freeze is if Present (ADC) and then Base_Type (Rec) = Rec then if not (Placed_Component or else Is_Packed (Rec)) then - Error_Msg_N ("?bit order specification has no effect", ADC); + Error_Msg_N ("??bit order specification has no effect", ADC); Error_Msg_N - ("\?since no component clauses were specified", ADC); + ("\??since no component clauses were specified", ADC); -- Here is where we do the processing for reversed bit order @@ -2371,7 +2407,7 @@ package body Freeze is if Warn_On_Redundant_Constructs then Error_Msg_N -- CODEFIX - ("?pragma Pack has no effect, no unplaced components", + ("??pragma Pack has no effect, no unplaced components", Get_Rep_Pragma (Rec, Name_Pack)); end if; end if; @@ -2478,14 +2514,16 @@ package body Freeze is if Convention (E) = Convention_C then Error_Msg_N - ("?variant record has no direct equivalent in C", A2); + ("?x?variant record has no direct equivalent in C", + A2); else Error_Msg_N - ("?variant record has no direct equivalent in C++", A2); + ("?x?variant record has no direct equivalent in C++", + A2); end if; Error_Msg_NE - ("\?use of convention for type& is dubious", A2, E); + ("\?x?use of convention for type& is dubious", A2, E); end if; end; end if; @@ -2689,6 +2727,7 @@ package body Freeze is -- Case of entity being frozen is other than a type if not Is_Type (E) then + -- If entity is exported or imported and does not have an external -- name, now is the time to provide the appropriate default name. -- Skip this if the entity is stubbed, since we don't need a name @@ -2805,7 +2844,7 @@ package body Freeze is and then Esize (F_Type) > Ttypes.System_Address_Size then Error_Msg_N - ("?type of & does not correspond to C pointer!", + ("?x?type of & does not correspond to C pointer!", Formal); -- Check suspicious return of boolean @@ -2816,10 +2855,11 @@ package body Freeze is and then not Has_Size_Clause (F_Type) and then VM_Target = No_VM then - Error_Msg_N ("& is an 8-bit Ada Boolean?", Formal); + Error_Msg_N + ("& is an 8-bit Ada Boolean?x?", Formal); Error_Msg_N ("\use appropriate corresponding type in C " - & "(e.g. char)?", Formal); + & "(e.g. char)?x?", Formal); -- Check suspicious tagged type @@ -2831,7 +2871,7 @@ package body Freeze is and then Convention (E) = Convention_C then Error_Msg_N - ("?& involves a tagged type which does not " + ("?x?& involves a tagged type which does not " & "correspond to any C type!", Formal); -- Check wrong convention subprogram pointer @@ -2840,11 +2880,11 @@ package body Freeze is and then not Has_Foreign_Convention (F_Type) then Error_Msg_N - ("?subprogram pointer & should " + ("?x?subprogram pointer & should " & "have foreign convention!", Formal); Error_Msg_Sloc := Sloc (F_Type); Error_Msg_NE - ("\?add Convention pragma to declaration of &#", + ("\?x?add Convention pragma to declaration of &#", Formal, F_Type); end if; @@ -2880,17 +2920,17 @@ package body Freeze is if Formal = First_Formal (E) then Error_Msg_NE - ("?in inherited operation&", Warn_Node, E); + ("??in inherited operation&", Warn_Node, E); end if; else Warn_Node := Formal; end if; Error_Msg_NE - ("?type of argument& is unconstrained array", + ("?x?type of argument& is unconstrained array", Warn_Node, Formal); Error_Msg_NE - ("?foreign caller must pass bounds explicitly", + ("?x?foreign caller must pass bounds explicitly", Warn_Node, Formal); Error_Msg_Qual_Level := 0; end if; @@ -2951,7 +2991,7 @@ package body Freeze is and then not Has_Warnings_Off (R_Type) then Error_Msg_N - ("?return type of& does not " + ("?x?return type of& does not " & "correspond to C pointer!", E); -- Check suspicious return of boolean @@ -2968,11 +3008,11 @@ package body Freeze is Result_Definition (Declaration_Node (E)); begin Error_Msg_NE - ("return type of & is an 8-bit Ada Boolean?", + ("return type of & is an 8-bit Ada Boolean?x?", N, E); Error_Msg_NE ("\use appropriate corresponding type in C " - & "(e.g. char)?", N, E); + & "(e.g. char)?x?", N, E); end; -- Check suspicious return tagged type @@ -2987,7 +3027,7 @@ package body Freeze is and then not Has_Warnings_Off (R_Type) then Error_Msg_N - ("?return type of & does not " + ("?x?return type of & does not " & "correspond to C type!", E); -- Check return of wrong convention subprogram pointer @@ -2998,11 +3038,11 @@ package body Freeze is and then not Has_Warnings_Off (R_Type) then Error_Msg_N - ("?& should return a foreign " + ("?x?& should return a foreign " & "convention subprogram pointer", E); Error_Msg_Sloc := Sloc (R_Type); Error_Msg_NE - ("\?add Convention pragma to declaration of& #", + ("\?x?add Convention pragma to declaration of& #", E, R_Type); end if; end if; @@ -3037,7 +3077,7 @@ package body Freeze is and then not Has_Warnings_Off (R_Type) then Error_Msg_N - ("?foreign convention function& should not " & + ("?x?foreign convention function& should not " & "return unconstrained array!", E); end if; end if; @@ -3054,9 +3094,9 @@ package body Freeze is and then Present (Contract (E)) and then Present (Spec_PPC_List (Contract (E))) then - Error_Msg_NE ("pre/post conditions on imported subprogram " - & "are not enforced?", - E, Spec_PPC_List (Contract (E))); + Error_Msg_NE + ("pre/post conditions on imported subprogram " + & "are not enforced??", E, Spec_PPC_List (Contract (E))); end if; end if; @@ -3218,7 +3258,7 @@ package body Freeze is then Error_Msg_Uint_1 := UI_From_Int (Standard_Integer_Size); Error_Msg_N - ("?convention C enumeration object has size less than ^", + ("??convention C enumeration object has size less than ^", E); Error_Msg_N ("\?use explicit size clause to set size", E); end if; @@ -3595,10 +3635,10 @@ package body Freeze is then Error_Msg_Sloc := Sloc (Comp_Size_C); Error_Msg_NE - ("?pragma Pack for& ignored!", + ("?r?pragma Pack for& ignored!", Pack_Pragma, Ent); Error_Msg_N - ("\?explicit component size given#!", + ("\?r?explicit component size given#!", Pack_Pragma); Set_Is_Packed (Base_Type (Ent), False); Set_Is_Bit_Packed_Array (Base_Type (Ent), False); @@ -3628,10 +3668,10 @@ package body Freeze is if Present (Pack_Pragma) then Error_Msg_N - ("?pragma Pack causes component size " + ("??pragma Pack causes component size " & "to be ^!", Pack_Pragma); Error_Msg_N - ("\?use Component_Size to set " + ("\??use Component_Size to set " & "desired value!", Pack_Pragma); end if; end if; @@ -3784,7 +3824,7 @@ package body Freeze is then Error_Msg_NE ("non-atomic components of type& may not be " - & "accessible by separate tasks?", Clause, E); + & "accessible by separate tasks??", Clause, E); if Has_Component_Size_Clause (E) then Error_Msg_Sloc := @@ -3792,14 +3832,14 @@ package body Freeze is (Get_Attribute_Definition_Clause (FS, Attribute_Component_Size)); Error_Msg_N - ("\because of component size clause#?", + ("\because of component size clause#??", Clause); elsif Has_Pragma_Pack (E) then Error_Msg_Sloc := Sloc (Get_Rep_Pragma (FS, Name_Pack)); Error_Msg_N - ("\because of pragma Pack#?", Clause); + ("\because of pragma Pack#??", Clause); end if; end if; @@ -4273,16 +4313,16 @@ package body Freeze is if Ada_Version >= Ada_2005 then Error_Msg_N - ("\would be legal if Storage_Size of 0 given?", E); + ("\would be legal if Storage_Size of 0 given??", E); elsif No_Pool_Assigned (E) then Error_Msg_N - ("\would be legal in Ada 2005?", E); + ("\would be legal in Ada 2005??", E); else Error_Msg_N ("\would be legal in Ada 2005 if " - & "Storage_Size of 0 given?", E); + & "Storage_Size of 0 given??", E); end if; end if; end if; @@ -4839,7 +4879,7 @@ package body Freeze is and then not Is_Character_Type (Typ) then Error_Msg_N - ("C enum types have the size of a C int?", Size_Clause (Typ)); + ("C enum types have the size of a C int??", Size_Clause (Typ)); end if; Adjust_Esize_For_Alignment (Typ); @@ -6081,7 +6121,7 @@ package body Freeze is and then Warn_On_Export_Import then Error_Msg_N - ("?Valued_Procedure has no effect for convention Ada", E); + ("??Valued_Procedure has no effect for convention Ada", E); Set_Is_Valued_Procedure (E, False); end if; @@ -6133,7 +6173,7 @@ package body Freeze is and then VM_Target = No_VM then Error_Msg_N - ("?foreign convention function& should not return " & + ("?x?foreign convention function& should not return " & "unconstrained array", E); return; end if; @@ -6150,7 +6190,7 @@ package body Freeze is and then Present (Default_Value (F)) then Error_Msg_N - ("?parameter cannot be defaulted in non-Ada call", + ("?x?parameter cannot be defaulted in non-Ada call", Default_Value (F)); end if; @@ -6575,11 +6615,11 @@ package body Freeze is if Present (Old) then Error_Msg_Node_2 := Old; Error_Msg_N - ("default initialization of & may modify &?", + ("default initialization of & may modify &??", Nam); else Error_Msg_N - ("default initialization of & may modify overlaid storage?", + ("default initialization of & may modify overlaid storage??", Nam); end if; @@ -6602,7 +6642,7 @@ package body Freeze is then Error_Msg_NE ("\packed array component& " & - "will be initialized to zero?", + "will be initialized to zero??", Nam, Comp); exit; else @@ -6614,7 +6654,7 @@ package body Freeze is Error_Msg_N ("\use pragma Import for & to " & - "suppress initialization (RM B.1(24))?", + "suppress initialization (RM B.1(24))??", Nam); end if; end Warn_Overlay; diff --git a/gcc/ada/g-excact.ads b/gcc/ada/g-excact.ads index 77abadac8fb..6111bc7fd02 100644 --- a/gcc/ada/g-excact.ads +++ b/gcc/ada/g-excact.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 2002-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -110,7 +110,9 @@ package GNAT.Exception_Actions is -- is compiled with pragma Restrictions (No_Exception_Registration); procedure Core_Dump (Occurrence : Exception_Occurrence); - -- Dump memory (called a core dump in some systems), and abort execution - -- of the application. + -- Dump memory (called a core dump in some systems) if supported by the + -- OS (most unix systems and VMS), and abort execution of the application. + -- Under Windows this procedure will not dump the memory, it will only + -- abort execution. end GNAT.Exception_Actions; diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index 0d83ab88208..0e0cd6d266f 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/gcc/ada/gcc-interface/Make-lang.in @@ -2194,14 +2194,13 @@ ada/exp_vfpt.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/expander.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \ ada/atree.adb ada/casing.ads ada/debug.ads ada/debug_a.ads \ - ada/debug_a.adb ada/einfo.ads ada/elists.ads ada/err_vars.ads \ - ada/errout.ads ada/erroutc.ads ada/exp_aggr.ads ada/exp_alfa.ads \ - ada/exp_attr.ads ada/exp_ch11.ads ada/exp_ch12.ads ada/exp_ch13.ads \ - ada/exp_ch2.ads ada/exp_ch3.ads ada/exp_ch4.ads ada/exp_ch5.ads \ - ada/exp_ch6.ads ada/exp_ch7.ads ada/exp_ch8.ads ada/exp_ch9.ads \ - ada/exp_prag.ads ada/exp_tss.ads ada/expander.ads ada/expander.adb \ - ada/fname.ads ada/hostparm.ads ada/inline.ads ada/lib.ads \ - ada/lib-load.ads ada/namet.ads ada/nlists.ads ada/opt.ads \ + ada/debug_a.adb ada/einfo.ads ada/elists.ads ada/exp_aggr.ads \ + ada/exp_alfa.ads ada/exp_attr.ads ada/exp_ch11.ads ada/exp_ch12.ads \ + ada/exp_ch13.ads ada/exp_ch2.ads ada/exp_ch3.ads ada/exp_ch4.ads \ + ada/exp_ch5.ads ada/exp_ch6.ads ada/exp_ch7.ads ada/exp_ch8.ads \ + ada/exp_ch9.ads ada/exp_prag.ads ada/exp_tss.ads ada/expander.ads \ + ada/expander.adb ada/fname.ads ada/hostparm.ads ada/inline.ads \ + ada/lib.ads ada/lib-load.ads ada/namet.ads ada/nlists.ads ada/opt.ads \ ada/output.ads ada/restrict.ads ada/rident.ads ada/rtsfind.ads \ ada/sem.ads ada/sem.adb ada/sem_attr.ads ada/sem_aux.ads \ ada/sem_ch10.ads ada/sem_ch11.ads ada/sem_ch12.ads ada/sem_ch13.ads \ @@ -2734,25 +2733,25 @@ ada/par.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads ada/a-uncdea.ads \ ada/warnsw.ads ada/widechar.ads ada/par_sco.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ - ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \ - ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \ - ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/exp_tss.ads \ - ada/fname.ads ada/gnat.ads ada/g-byorma.ads ada/g-hesorg.ads \ - ada/g-hesorg.adb ada/g-htable.ads ada/g-table.ads ada/g-table.adb \ - ada/hostparm.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \ - ada/lib-sort.adb ada/lib-util.ads ada/lib-util.adb ada/namet.ads \ - ada/nlists.ads ada/nlists.adb ada/opt.ads ada/osint.ads ada/osint-c.ads \ - ada/output.ads ada/par_sco.ads ada/par_sco.adb ada/put_scos.ads \ - ada/put_scos.adb ada/scans.ads ada/scos.ads ada/scos.adb ada/sem.ads \ - ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \ - ada/sinput.adb ada/snames.ads ada/stand.ads ada/stringt.ads \ - ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-htable.adb \ - ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \ - ada/s-secsta.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \ - ada/s-strhas.ads ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \ - ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \ - ada/types.ads ada/uintp.ads ada/uname.ads ada/unchconv.ads \ - ada/unchdeal.ads ada/urealp.ads ada/widechar.ads + ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/aspects.adb \ + ada/atree.ads ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads \ + ada/einfo.ads ada/err_vars.ads ada/errout.ads ada/erroutc.ads \ + ada/exp_tss.ads ada/fname.ads ada/gnat.ads ada/g-byorma.ads \ + ada/g-hesorg.ads ada/g-hesorg.adb ada/g-htable.ads ada/g-table.ads \ + ada/g-table.adb ada/hostparm.ads ada/lib.ads ada/lib.adb \ + ada/lib-list.adb ada/lib-sort.adb ada/lib-util.ads ada/lib-util.adb \ + ada/namet.ads ada/nlists.ads ada/nlists.adb ada/opt.ads ada/osint.ads \ + ada/osint-c.ads ada/output.ads ada/par_sco.ads ada/par_sco.adb \ + ada/put_scos.ads ada/put_scos.adb ada/scans.ads ada/scos.ads \ + ada/scos.adb ada/sem.ads ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb \ + ada/sinput.ads ada/sinput.adb ada/snames.ads ada/stand.ads \ + ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \ + ada/s-htable.adb ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \ + ada/s-parame.ads ada/s-secsta.ads ada/s-stalib.ads ada/s-stoele.ads \ + ada/s-stoele.adb ada/s-strhas.ads ada/s-string.ads ada/s-traent.ads \ + ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \ + ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uname.ads \ + ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads ada/prep.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/a-uncdea.ads ada/alloc.ads ada/casing.ads ada/csets.ads \ @@ -2795,12 +2794,12 @@ ada/put_alfa.o : ada/ada.ads ada/a-unccon.ads ada/alfa.ads ada/gnat.ads \ ada/put_scos.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/a-uncdea.ads ada/alloc.ads ada/debug.ads ada/gnat.ads \ ada/g-table.ads ada/g-table.adb ada/hostparm.ads ada/namet.ads \ - ada/opt.ads ada/output.ads ada/par_sco.ads ada/put_scos.ads \ - ada/put_scos.adb ada/scos.ads ada/snames.ads ada/system.ads \ - ada/s-exctab.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \ - ada/s-stalib.ads ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \ - ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \ - ada/types.ads ada/unchconv.ads ada/unchdeal.ads + ada/opt.ads ada/output.ads ada/put_scos.ads ada/put_scos.adb \ + ada/scos.ads ada/system.ads ada/s-exctab.ads ada/s-memory.ads \ + ada/s-os_lib.ads ada/s-parame.ads ada/s-stalib.ads ada/s-string.ads \ + ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \ + ada/table.adb ada/tree_io.ads ada/types.ads ada/unchconv.ads \ + ada/unchdeal.ads ada/repinfo.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \ @@ -3075,34 +3074,34 @@ ada/scng.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/scos.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/a-uncdea.ads ada/alloc.ads ada/debug.ads ada/gnat.ads \ ada/g-table.ads ada/g-table.adb ada/hostparm.ads ada/namet.ads \ - ada/opt.ads ada/output.ads ada/scos.ads ada/scos.adb ada/snames.ads \ - ada/system.ads ada/s-exctab.ads ada/s-memory.ads ada/s-os_lib.ads \ - ada/s-parame.ads ada/s-stalib.ads ada/s-string.ads ada/s-traent.ads \ - ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \ - ada/tree_io.ads ada/types.ads ada/unchconv.ads ada/unchdeal.ads + ada/opt.ads ada/output.ads ada/scos.ads ada/scos.adb ada/system.ads \ + ada/s-exctab.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \ + ada/s-stalib.ads ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \ + ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \ + ada/types.ads ada/unchconv.ads ada/unchdeal.ads ada/sem.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads ada/a-uncdea.ads \ ada/alloc.ads ada/aspects.ads ada/atree.ads ada/atree.adb \ ada/casing.ads ada/csets.ads ada/debug.ads ada/debug_a.ads \ ada/debug_a.adb ada/einfo.ads ada/einfo.adb ada/elists.ads \ - ada/elists.adb ada/err_vars.ads ada/errout.ads ada/erroutc.ads \ - ada/exp_tss.ads ada/expander.ads ada/fname.ads ada/gnat.ads \ - ada/g-hesorg.ads ada/hostparm.ads ada/inline.ads ada/lib.ads \ - ada/lib.adb ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb \ - ada/namet.ads ada/nlists.ads ada/nlists.adb ada/opt.ads ada/output.ads \ - ada/restrict.ads ada/rident.ads ada/sem.ads ada/sem.adb \ - ada/sem_attr.ads ada/sem_aux.ads ada/sem_ch10.ads ada/sem_ch11.ads \ - ada/sem_ch12.ads ada/sem_ch13.ads ada/sem_ch2.ads ada/sem_ch2.adb \ - ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch5.ads ada/sem_ch6.ads \ - ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_ch9.ads ada/sem_dim.ads \ - ada/sem_prag.ads ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb \ - ada/sinput.ads ada/snames.ads ada/stand.ads ada/stringt.ads \ - ada/system.ads ada/s-exctab.ads ada/s-imenne.ads ada/s-memory.ads \ - ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \ - ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads \ - ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \ - ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uname.ads \ - ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads + ada/elists.adb ada/exp_tss.ads ada/expander.ads ada/fname.ads \ + ada/gnat.ads ada/g-hesorg.ads ada/hostparm.ads ada/inline.ads \ + ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-load.ads \ + ada/lib-sort.adb ada/namet.ads ada/nlists.ads ada/nlists.adb \ + ada/opt.ads ada/output.ads ada/restrict.ads ada/rident.ads ada/sem.ads \ + ada/sem.adb ada/sem_attr.ads ada/sem_aux.ads ada/sem_ch10.ads \ + ada/sem_ch11.ads ada/sem_ch12.ads ada/sem_ch13.ads ada/sem_ch2.ads \ + ada/sem_ch2.adb ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch5.ads \ + ada/sem_ch6.ads ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_ch9.ads \ + ada/sem_dim.ads ada/sem_prag.ads ada/sem_util.ads ada/sinfo.ads \ + ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \ + ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-imenne.ads \ + ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \ + ada/s-secsta.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \ + ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \ + ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \ + ada/uname.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \ + ada/widechar.ads ada/sem_aggr.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \ @@ -4372,11 +4371,14 @@ ada/validsw.o : ada/ada.ads ada/a-unccon.ads ada/a-uncdea.ads \ ada/types.ads ada/unchconv.ads ada/unchdeal.ads ada/validsw.ads \ ada/validsw.adb -ada/warnsw.o : ada/ada.ads ada/a-unccon.ads ada/a-uncdea.ads \ - ada/hostparm.ads ada/opt.ads ada/system.ads ada/s-exctab.ads \ - ada/s-stalib.ads ada/s-string.ads ada/s-unstyp.ads ada/s-wchcon.ads \ - ada/types.ads ada/unchconv.ads ada/unchdeal.ads ada/warnsw.ads \ - ada/warnsw.adb +ada/warnsw.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ + ada/a-uncdea.ads ada/alloc.ads ada/debug.ads ada/err_vars.ads \ + ada/hostparm.ads ada/namet.ads ada/opt.ads ada/output.ads \ + ada/system.ads ada/s-exctab.ads ada/s-memory.ads ada/s-os_lib.ads \ + ada/s-parame.ads ada/s-stalib.ads ada/s-string.ads ada/s-traent.ads \ + ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \ + ada/tree_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \ + ada/unchdeal.ads ada/warnsw.ads ada/warnsw.adb ada/widechar.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/a-uncdea.ads ada/hostparm.ads ada/interfac.ads ada/opt.ads \ diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index d27a8136641..24c9966feb8 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -273,7 +273,7 @@ endif # Both . and srcdir are used, in that order, # so that tm.h and config.h will be found in the compilation # subdirectory rather than in the source directory. -INCLUDES = -I- -I. -I.. -I$(srcdir)/ada -I$(srcdir) -I$(srcdir)/../include +INCLUDES = -I- -I. -I.. -I$(srcdir)/ada -I$(srcdir) -I$(srcdir)/../include $(GMPINC) ADA_INCLUDES = -I- -I. -I$(srcdir)/ada @@ -283,11 +283,11 @@ ADA_INCLUDES = -I- -I. -I$(srcdir)/ada ifneq ($(findstring vxworks,$(osys)),) INCLUDES_FOR_SUBDIR = -iquote . -iquote .. -iquote ../.. \ -iquote $(fsrcdir)/ada \ - -I$(fsrcdir)/../include + -I$(fsrcdir)/../include $(GMPINC) else INCLUDES_FOR_SUBDIR = -iquote . -iquote .. -iquote ../.. \ -iquote $(fsrcdir)/ada -iquote $(fsrcdir) \ - -I$(fsrcdir)/../include + -I$(fsrcdir)/../include $(GMPINC) endif ADA_INCLUDES_FOR_SUBDIR = -I. -I$(fsrcdir)/ada diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c index 3d3f16110ce..2fd2743bbe1 100644 --- a/gcc/ada/gcc-interface/misc.c +++ b/gcc/ada/gcc-interface/misc.c @@ -228,7 +228,9 @@ int optimize_size; int flag_compare_debug; enum stack_check_type flag_stack_check = NO_STACK_CHECK; -/* Post-switch processing. */ +/* Settings adjustments after switches processing by the back-end. + Note that the front-end switches processing (Scan_Compiler_Arguments) + has not been done yet at this point! */ static bool gnat_post_options (const char **pfilename ATTRIBUTE_UNUSED) diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 74133a458b1..4d21d2c77ae 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -302,6 +302,16 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED, type_annotate_only = (gigi_operating_mode == 1); +#if 0 + if (Generate_SCO_Instance_Table) + flag_debug_instances = 1; +#else + /* Temporary compatibility shim: FSF head back-end does not support instance + based debug info discriminators, so disable the generation of the SCO + instance table. ??? */ + Generate_SCO_Instance_Table = False; +#endif + for (i = 0; i < number_file; i++) { /* Use the identifier table to make a permanent copy of the filename as diff --git a/gcc/ada/get_scos.adb b/gcc/ada/get_scos.adb index 170f5b5623b..ca90a85b4f7 100644 --- a/gcc/ada/get_scos.adb +++ b/gcc/ada/get_scos.adb @@ -205,7 +205,7 @@ procedure Get_SCOs is Nam : Name_Id; --- Start of processing for Get_Scos +-- Start of processing for Get_SCOs begin SCOs.Initialize; @@ -265,7 +265,9 @@ begin pragma Assert (C = '|'); Get_Source_Location (SIE.Inst_Loc); - if not At_EOL then + if At_EOL then + SIE.Enclosing_Instance := 0; + else Skip_Spaces; SIE.Enclosing_Instance := SCO_Instance_Index (Get_Int); @@ -342,6 +344,10 @@ begin Key := '>'; Typ := Getc; + -- Sanity check on dominance marker type indication + + pragma Assert (Typ in 'A' .. 'Z'); + when '1' .. '9' => Typ := ' '; diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 4948e1bb9bb..4cfc3392f24 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -518,7 +518,7 @@ procedure Gnat1drv is -- off. Note Atomic Synchronization is implemented as check. Suppress_Options.Suppress (Atomic_Synchronization) := - not Atomic_Sync_Default; + not Atomic_Sync_Default_On_Target; -- Set switch indicating if we can use N_Expression_With_Actions @@ -677,9 +677,9 @@ procedure Gnat1drv is and then not Compilation_Errors then Error_Msg_N - ("package $$ does not require a body?", Main_Unit_Node); + ("package $$ does not require a body??", Main_Unit_Node); Error_Msg_File_1 := Fname; - Error_Msg_N ("body in file{? will be ignored", Main_Unit_Node); + Error_Msg_N ("body in file{ will be ignored??", Main_Unit_Node); -- Ada 95 cases of a body file present when no body is -- permitted. This we consider to be an error. diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index b0e9f32abe4..0a89386af57 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -111,6 +111,7 @@ Implementation Defined Pragmas * Pragma Ast_Entry:: * Pragma C_Pass_By_Copy:: * Pragma Check:: +* Pragma Check_Float_Overflow:: * Pragma Check_Name:: * Pragma Check_Policy:: * Pragma Comment:: @@ -850,6 +851,7 @@ consideration, the use of these pragmas should be minimized. * Pragma Ast_Entry:: * Pragma C_Pass_By_Copy:: * Pragma Check:: +* Pragma Check_Float_Overflow:: * Pragma Check_Name:: * Pragma Check_Policy:: * Pragma Comment:: @@ -1402,6 +1404,60 @@ Checks introduced by this pragma are normally deactivated by default. They can be activated either by the command line option @option{-gnata}, which turns on all checks, or individually controlled using pragma @code{Check_Policy}. +@node Pragma Check_Float_Overflow +@unnumberedsec Pragma Check_Float_Overflow +@cindex Floating-point overflow +@findex Check_Float_Overflow +@noindent +Syntax: +@smallexample @c ada +pragma Check_Float_Overflow; +@end smallexample + +@noindent +In Ada, the predefined floating-point types (@code{Short_Float}, +@code{Float}, @code{Long_Float}, @code{Long_Long_Float}) are +defined to be @emph{unconstrained}. This means that even though each +has a well-defined base range, an operation that delivers a result +outside this base range is not required to raise an exception. +This implementation permission accommodates the notion +of infinities in IEEE floating-point, and corresponds to the +efficient execution mode on most machines. GNAT will not raise +overflow exceptions on these machines; instead it will generate +infinities and NaN's as defined in the IEEE standard. + +Generating infinities, although efficient, is not always desirable. +Often the preferable approach is to check for overflow, even at the +(perhaps considerable) expense of run-time performance. +This can be accomplished by defining your own constrained floating-point subtypes -- i.e., by supplying explicit +range constraints -- and indeed such a subtype +can have the same base range as its base type. For example: + +@smallexample @c ada +subtype My_Float is Float range Float'Range; +@end smallexample + +@noindent +Here @code{My_Float} has the same range as +@code{Float} but is constrained, so operations on +@code{My_Float} values will be checked for overflow +against this range. + +This style will achieve the desired goal, but +it is often more convenient to be able to simply use +the standard predefined floating-point types as long +as overflow checking could be guaranteed. +The @code{Check_Float_Overflow} +configuration pragma achieves this effect. If a unit is compiled +subject to this configuration pragma, then all operations +on predefined floating-point types will be treated as +though those types were constrained, and overflow checks +will be generated. The @code{Constraint_Error} +exception is raised if the result is out of range. + +This mode can also be set by use of the compiler +switch @option{-gnateF}. + @node Pragma Check_Name @unnumberedsec Pragma Check_Name @cindex Defining check names @@ -6790,13 +6846,13 @@ that make up scalar components are ordered within S. Other properties are as for standard representation attribute @code{Bit_Order}, as defined by Ada RM 13.5.3(4). The default is @code{System.Default_Bit_Order}. -If @code{@var{S}'Scalar_Storage_Order} is specified explicitly, it shall be -equal to @code{@var{S}'Bit_Order}. Note: This means that if a -@code{Scalar_Storage_Order} attribute definition clause is not confirming, -then the type's @code{Bit_Order} shall be specified explicitly and set to -the same value. +For a record type @var{S}, if @code{@var{S}'Scalar_Storage_Order} is +specified explicitly, it shall be equal to @code{@var{S}'Bit_Order}. Note: +This means that if a @code{Scalar_Storage_Order} attribute definition +clause is not confirming, then the type's @code{Bit_Order} shall be +specified explicitly and set to the same value. -If a component of S has itself a record or array type, then it shall also +If a component of @var{S} has itself a record or array type, then it shall also have a @code{Scalar_Storage_Order} attribute definition clause. In addition, if the component does not start on a byte boundary, then the scalar storage order specified for S and for the nested component type shall be identical. @@ -6808,10 +6864,11 @@ A confirming @code{Scalar_Storage_Order} attribute definition clause (i.e. with a value equal to @code{System.Default_Bit_Order}) has no effect. If the opposite storage order is specified, then whenever the value of -a scalar component of S is read, the storage elements of the enclosing -machine scalar are first reversed (before retrieving the component value, -possibly applying some shift and mask operatings on the enclosing machine -scalar), and the opposite operation is done for writes. +a scalar component of an object of type @var{S} is read, the storage +elements of the enclosing machine scalar are first reversed (before +retrieving the component value, possibly applying some shift and mask +operatings on the enclosing machine scalar), and the opposite operation +is done for writes. In that case, the restrictions set forth in 13.5.1(10.3/2) for scalar components are relaxed. Instead, the following rules apply: diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 176c01db3b7..d96a724df6d 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -4178,6 +4178,10 @@ Create expanded source files for source level debugging. This switch also suppress generation of cross-reference information (see @option{-gnatx}). +@item ^-gnateA^/ALIASING_CHECK^ +@cindex @option{-gnateA} (@command{gcc}) +Check that there is no aliasing between two parameters of the same subprogram. + @item -gnatec=@var{path} @cindex @option{-gnatec} (@command{gcc}) Specify a configuration pragma file @@ -4186,6 +4190,10 @@ Specify a configuration pragma file @end ifclear (@pxref{The Configuration Pragmas Files}). +@item ^-gnated^/DISABLE_ATOMIC_SYNCHRONIZATION^ +@cindex @option{-gnated} (@command{gcc}) +Disable atomic synchronization + @item ^-gnateD^/DATA_PREPROCESSING=^symbol@r{[}=@var{value}@r{]} @cindex @option{-gnateD} (@command{gcc}) Defines a symbol, associated with @var{value}, for preprocessing. @@ -4204,6 +4212,12 @@ produced at run time. @cindex @option{-gnatef} (@command{gcc}) Display full source path name in brief error messages. +@item -gnateF +@cindex @option{-gnateF} (@command{gcc}) +Check for overflow on all floating-point operations, including those +for unconstrained predefined types. See description of pragma +@code{Check_Float_Overflow} in GNAT RM. + @item -gnateG @cindex @option{-gnateG} (@command{gcc}) Save result of preprocessing in a text file. @@ -4249,6 +4263,14 @@ temporary use of special test software. @cindex @option{-gnateS} (@command{gcc}) Synonym of @option{-fdump-scos}, kept for backards compatibility. +@item ^-gnatet^/TARGET_DEPENDENT_INFO^ +@cindex @option{-gnatet} (@command{gcc}) +Generate target dependent information. + +@item ^-gnateV^/PARAMETER_VALIDITY_CHECK^ +@cindex @option{-gnateV} (@command{gcc}) +Check validity of subprogram parameters. + @item -gnatE @cindex @option{-gnatE} (@command{gcc}) Full dynamic elaboration checks. diff --git a/gcc/ada/i-cstrea.ads b/gcc/ada/i-cstrea.ads index 8882a7d3de6..1a7e76a713b 100644 --- a/gcc/ada/i-cstrea.ads +++ b/gcc/ada/i-cstrea.ads @@ -42,6 +42,7 @@ package Interfaces.C_Streams is subtype int is System.CRTL.int; subtype long is System.CRTL.long; subtype size_t is System.CRTL.size_t; + subtype ssize_t is System.CRTL.ssize_t; subtype voids is System.Address; NULL_Stream : constant FILEs; @@ -153,9 +154,18 @@ package Interfaces.C_Streams is origin : int) return int renames System.CRTL.fseek; + function fseek64 + (stream : FILEs; + offset : ssize_t; + origin : int) return int + renames System.CRTL.fseek64; + function ftell (stream : FILEs) return long renames System.CRTL.ftell; + function ftell64 (stream : FILEs) return ssize_t + renames System.CRTL.ftell64; + function fwrite (buffer : voids; size : size_t; diff --git a/gcc/ada/init.c b/gcc/ada/init.c index 8a28bf68ab5..37c403b803e 100644 --- a/gcc/ada/init.c +++ b/gcc/ada/init.c @@ -38,10 +38,6 @@ installed by this file are used to catch the resulting signals that come from these probes failing (i.e. touching protected pages). */ -#ifdef __cplusplus -extern "C" { -#endif - /* This file should be kept synchronized with 2sinit.ads, 2sinit.adb, s-init-ae653-cert.adb and s-init-xi-sparc.adb. All these files implement the required functionality for different targets. */ @@ -71,6 +67,10 @@ extern "C" { #include "adaint.h" #include "raise.h" +#ifdef __cplusplus +extern "C" { +#endif + extern void __gnat_raise_program_error (const char *, int); /* Addresses of exception data blocks for predefined exceptions. Tasking_Error @@ -821,34 +821,46 @@ int __gnat_features_set = 0; #endif /* Define macro symbols for the VMS conditions that become Ada exceptions. - Most of these are also defined in the header file ssdef.h which has not - yet been converted to be recognized by GNU C. */ + It would be better to just include <ssdef.h> */ -/* Defining these as macros, as opposed to external addresses, allows - them to be used in a case statement below. */ #define SS$_ACCVIO 12 #define SS$_HPARITH 1284 +#define SS$_INTDIV 1156 #define SS$_STKOVF 1364 #define SS$_RESIGNAL 2328 +#define MTH$_FLOOVEMAT 1475268 /* Some ACVC_21 CXA tests */ + +/* The following codes must be resignalled, and not handled here. */ + /* These codes are in standard message libraries. */ extern int C$_SIGKILL; extern int SS$_DEBUG; extern int LIB$_KEYNOTFOU; extern int LIB$_ACTIMAGE; -#define CMA$_EXIT_THREAD 4227492 -#define MTH$_FLOOVEMAT 1475268 /* Some ACVC_21 CXA tests */ -#define SS$_INTDIV 1156 /* These codes are non standard, which is to say the author is not sure if they are defined in the standard message libraries so keep them as macros for now. */ #define RDB$_STREAM_EOF 20480426 #define FDL$_UNPRIKW 11829410 +#define CMA$_EXIT_THREAD 4227492 + +struct cond_sigargs { + unsigned int sigarg; + unsigned int sigargval; +}; + +struct cond_subtests { + unsigned int num; + const struct cond_sigargs sigargs[]; +}; struct cond_except { unsigned int cond; const struct Exception_Data *except; + unsigned int needs_adjust; /* 1 = adjust PC, 0 = no adjust */ + const struct cond_subtests *subtests; }; struct descriptor_s { @@ -928,53 +940,72 @@ extern Exception_Code Base_Code_In (Exception_Code); /* DEC Ada specific conditions. */ static const struct cond_except dec_ada_cond_except_table [] = { - {ADA$_PROGRAM_ERROR, &program_error}, - {ADA$_USE_ERROR, &Use_Error}, - {ADA$_KEYSIZERR, &program_error}, - {ADA$_STAOVF, &storage_error}, - {ADA$_CONSTRAINT_ERRO, &constraint_error}, - {ADA$_IOSYSFAILED, &Device_Error}, - {ADA$_LAYOUT_ERROR, &Layout_Error}, - {ADA$_STORAGE_ERROR, &storage_error}, - {ADA$_DATA_ERROR, &Data_Error}, - {ADA$_DEVICE_ERROR, &Device_Error}, - {ADA$_END_ERROR, &End_Error}, - {ADA$_MODE_ERROR, &Mode_Error}, - {ADA$_NAME_ERROR, &Name_Error}, - {ADA$_STATUS_ERROR, &Status_Error}, - {ADA$_NOT_OPEN, &Use_Error}, - {ADA$_ALREADY_OPEN, &Use_Error}, - {ADA$_USE_ERROR, &Use_Error}, - {ADA$_UNSUPPORTED, &Use_Error}, - {ADA$_FAC_MODE_MISMAT, &Use_Error}, - {ADA$_ORG_MISMATCH, &Use_Error}, - {ADA$_RFM_MISMATCH, &Use_Error}, - {ADA$_RAT_MISMATCH, &Use_Error}, - {ADA$_MRS_MISMATCH, &Use_Error}, - {ADA$_MRN_MISMATCH, &Use_Error}, - {ADA$_KEY_MISMATCH, &Use_Error}, - {ADA$_MAXLINEXC, &constraint_error}, - {ADA$_LINEXCMRS, &constraint_error}, + {ADA$_PROGRAM_ERROR, &program_error, 0, 0}, + {ADA$_USE_ERROR, &Use_Error, 0, 0}, + {ADA$_KEYSIZERR, &program_error, 0, 0}, + {ADA$_STAOVF, &storage_error, 0, 0}, + {ADA$_CONSTRAINT_ERRO, &constraint_error, 0, 0}, + {ADA$_IOSYSFAILED, &Device_Error, 0, 0}, + {ADA$_LAYOUT_ERROR, &Layout_Error, 0, 0}, + {ADA$_STORAGE_ERROR, &storage_error, 0, 0}, + {ADA$_DATA_ERROR, &Data_Error, 0, 0}, + {ADA$_DEVICE_ERROR, &Device_Error, 0, 0}, + {ADA$_END_ERROR, &End_Error, 0, 0}, + {ADA$_MODE_ERROR, &Mode_Error, 0, 0}, + {ADA$_NAME_ERROR, &Name_Error, 0, 0}, + {ADA$_STATUS_ERROR, &Status_Error, 0, 0}, + {ADA$_NOT_OPEN, &Use_Error, 0, 0}, + {ADA$_ALREADY_OPEN, &Use_Error, 0, 0}, + {ADA$_USE_ERROR, &Use_Error, 0, 0}, + {ADA$_UNSUPPORTED, &Use_Error, 0, 0}, + {ADA$_FAC_MODE_MISMAT, &Use_Error, 0, 0}, + {ADA$_ORG_MISMATCH, &Use_Error, 0, 0}, + {ADA$_RFM_MISMATCH, &Use_Error, 0, 0}, + {ADA$_RAT_MISMATCH, &Use_Error, 0, 0}, + {ADA$_MRS_MISMATCH, &Use_Error, 0, 0}, + {ADA$_MRN_MISMATCH, &Use_Error, 0, 0}, + {ADA$_KEY_MISMATCH, &Use_Error, 0, 0}, + {ADA$_MAXLINEXC, &constraint_error, 0, 0}, + {ADA$_LINEXCMRS, &constraint_error, 0, 0}, #if 0 /* Already handled by a pragma Import_Exception in Aux_IO_Exceptions */ - {ADA$_LOCK_ERROR, &Lock_Error}, - {ADA$_EXISTENCE_ERROR, &Existence_Error}, - {ADA$_KEY_ERROR, &Key_Error}, + {ADA$_LOCK_ERROR, &Lock_Error, 0, 0}, + {ADA$_EXISTENCE_ERROR, &Existence_Error, 0, 0}, + {ADA$_KEY_ERROR, &Key_Error, 0, 0}, #endif - {0, 0} + {0, 0, 0, 0} }; #endif /* IN_RTS */ -/* Non-DEC Ada specific conditions. We could probably also put - SS$_HPARITH here and possibly SS$_ACCVIO, SS$_STKOVF. */ -static const struct cond_except cond_except_table [] = { - {MTH$_FLOOVEMAT, &constraint_error}, - {SS$_INTDIV, &constraint_error}, - {0, 0} +/* Non-DEC Ada specific conditions that map to Ada exceptions. */ + +/* Subtest for ACCVIO Constraint_Error, kept for compatibility, + in hindsight should have just made ACCVIO == Storage_Error. */ +#define ACCVIO_VIRTUAL_ADDR 3 +static const struct cond_subtests accvio_c_e = + {1, /* number of subtests below */ + { + {ACCVIO_VIRTUAL_ADDR, 0} + } + }; + +/* Macro flag to adjust PC which gets off by one for some conditions, + not sure if this is reliably true, PC could be off by more for + HPARITH for example, unless a trapb is inserted. */ +#define NEEDS_ADJUST 1 + +static const struct cond_except system_cond_except_table [] = { + {MTH$_FLOOVEMAT, &constraint_error, 0, 0}, + {SS$_INTDIV, &constraint_error, 0, 0}, + {SS$_HPARITH, &constraint_error, NEEDS_ADJUST, 0}, + {SS$_ACCVIO, &constraint_error, NEEDS_ADJUST, &accvio_c_e}, + {SS$_ACCVIO, &storage_error, NEEDS_ADJUST, 0}, + {SS$_STKOVF, &storage_error, NEEDS_ADJUST, 0}, + {0, 0, 0, 0} }; /* To deal with VMS conditions and their mapping to Ada exceptions, @@ -1039,7 +1070,7 @@ __gnat_default_resignal_p (int code) for (i = 0, iexcept = 0; cond_resignal_table [i] - && !(iexcept = LIB$MATCH_COND (&code, &cond_resignal_table [i])); + && !(iexcept = LIB$MATCH_COND (&code, &cond_resignal_table [i])); i++); return iexcept; @@ -1092,10 +1123,62 @@ copy_msg (struct descriptor_s *msgdesc, char *message) return 0; } +/* Scan TABLE for a match for the condition contained in SIGARGS, + and return the entry, or the empty entry if no match found. */ + +static const struct cond_except * + scan_conditions ( int *sigargs, const struct cond_except *table []) +{ + int i; + struct cond_except entry; + + /* Scan the exception condition table for a match and fetch + the associated GNAT exception pointer. */ + for (i = 0; (*table) [i].cond; i++) + { + unsigned int match = LIB$MATCH_COND (&sigargs [1], &(*table) [i].cond); + const struct cond_subtests *subtests = (*table) [i].subtests; + + if (match) + { + if (!subtests) + { + return &(*table) [i]; + } + else + { + unsigned int ii; + int num = (*subtests).num; + + /* Perform subtests to differentiate exception. */ + for (ii = 0; ii < num; ii++) + { + unsigned int arg = (*subtests).sigargs [ii].sigarg; + unsigned int argval = (*subtests).sigargs [ii].sigargval; + + if (sigargs [arg] != argval) + { + num = 0; + break; + } + } + + /* All subtests passed. */ + if (num == (*subtests).num) + return &(*table) [i]; + } + } + } + + /* No match, return the null terminating entry. */ + return &(*table) [i]; +} + long __gnat_handle_vms_condition (int *sigargs, void *mechargs) { struct Exception_Data *exception = 0; + unsigned int needs_adjust = 0; Exception_Code base_code; struct descriptor_s gnat_facility = {4, 0, "GNAT"}; char message [Default_Exception_Msg_Max_Length]; @@ -1106,112 +1189,60 @@ __gnat_handle_vms_condition (int *sigargs, void *mechargs) Import_Exception. */ if (__gnat_resignal_p (sigargs [1])) return SS$_RESIGNAL; +#ifndef IN_RTS + /* toplev.c handles this for compiler. */ + if (sigargs [1] == SS$_HPARITH) + return SS$_RESIGNAL; +#endif #ifdef IN_RTS /* See if it's an imported exception. Beware that registered exceptions are bound to their base code, with the severity bits masked off. */ base_code = Base_Code_In ((Exception_Code) sigargs[1]); exception = Coded_Exception (base_code); - - if (exception) - { - message[0] = 0; - - /* Subtract PC & PSL fields which messes with PUTMSG. */ - sigargs[0] -= 2; - SYS$PUTMSG (sigargs, copy_msg, &gnat_facility, message); - sigargs[0] += 2; - msg = message; - - exception->Name_Length = 19; - /* ??? The full name really should be get SYS$GETMSG returns. */ - exception->Full_Name = "IMPORTED_EXCEPTION"; - exception->Import_Code = base_code; - -#ifdef __IA64 - /* Do not adjust the program counter as already points to the next - instruction (just after the call to LIB$STOP). */ - Raise_From_Signal_Handler (exception, msg); -#endif - } #endif if (exception == 0) - switch (sigargs[1]) - { - case SS$_ACCVIO: - if (sigargs[3] == 0) - { - exception = &constraint_error; - msg = "access zero"; - } - else - { - exception = &storage_error; - msg = "stack overflow or erroneous memory access"; - } - __gnat_adjust_context_for_raise (SS$_ACCVIO, (void *)mechargs); - break; - - case SS$_STKOVF: - exception = &storage_error; - msg = "stack overflow"; - __gnat_adjust_context_for_raise (SS$_STKOVF, (void *)mechargs); - break; - - case SS$_HPARITH: -#ifndef IN_RTS - return SS$_RESIGNAL; /* toplev.c handles for compiler */ -#else - exception = &constraint_error; - msg = "arithmetic error"; - __gnat_adjust_context_for_raise (SS$_HPARITH, (void *)mechargs); -#endif - break; - - default: #ifdef IN_RTS + { + int i; + struct cond_except cond; + const struct cond_except *cond_table; + const struct cond_except *cond_tables [] = {dec_ada_cond_except_table, + system_cond_except_table, + 0}; + + i = 0; + while ((cond_table = cond_tables[i++]) && !exception) { - int i; - - /* Scan the DEC Ada exception condition table for a match and fetch - the associated GNAT exception pointer. */ - for (i = 0; - dec_ada_cond_except_table [i].cond && - !LIB$MATCH_COND (&sigargs [1], - &dec_ada_cond_except_table [i].cond); - i++); - exception = (struct Exception_Data *) - dec_ada_cond_except_table [i].except; - - if (!exception) - { - /* Scan the VMS standard condition table for a match and fetch - the associated GNAT exception pointer. */ - for (i = 0; - cond_except_table[i].cond && - !LIB$MATCH_COND (&sigargs[1], &cond_except_table[i].cond); - i++); - exception = (struct Exception_Data *) - cond_except_table [i].except; - - if (!exception) - /* User programs expect Non_Ada_Error to be raised, reference - DEC Ada test CXCONDHAN. */ - exception = &Non_Ada_Error; - } + cond = *scan_conditions (sigargs, &cond_table); + exception = (struct Exception_Data *) cond.except; } + + if (exception) + needs_adjust = cond.needs_adjust; + else + /* User programs expect Non_Ada_Error to be raised if no match, + reference DEC Ada test CXCONDHAN. */ + exception = &Non_Ada_Error; + } #else - exception = &program_error; + { + /* Pretty much everything is just a program error in the compiler */ + exception = &program_error; + } #endif - message[0] = 0; - /* Subtract PC & PSL fields which messes with PUTMSG. */ - sigargs[0] -= 2; - SYS$PUTMSG (sigargs, copy_msg, &gnat_facility, message); - sigargs[0] += 2; - msg = message; - break; - } + + message[0] = 0; + /* Subtract PC & PSL fields as per ABI for SYS$PUTMSG. */ + sigargs[0] -= 2; + SYS$PUTMSG (sigargs, copy_msg, &gnat_facility, message); + /* Add back PC & PSL fields as per ABI for SYS$PUTMSG. */ + sigargs[0] += 2; + msg = message; + + if (needs_adjust) + __gnat_adjust_context_for_raise (sigargs [1], (void *)mechargs); Raise_From_Signal_Handler (exception, msg); } @@ -1244,11 +1275,11 @@ __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext) if (signo == SS$_HPARITH) { /* Sub one to the address of the instruction signaling the condition, - located in the sigargs array. */ + located in the sigargs array. */ CHF$MECH_ARRAY * mechargs = (CHF$MECH_ARRAY *) ucontext; CHF$SIGNAL_ARRAY * sigargs - = (CHF$SIGNAL_ARRAY *) mechargs->chf$q_mch_sig_addr; + = (CHF$SIGNAL_ARRAY *) mechargs->chf$q_mch_sig_addr; int vcount = sigargs->chf$is_sig_args; int * pc_slot = & (&sigargs->chf$l_sig_name)[vcount-2]; diff --git a/gcc/ada/initialize.c b/gcc/ada/initialize.c index 7e1141a9be7..6b92d27cb13 100644 --- a/gcc/ada/initialize.c +++ b/gcc/ada/initialize.c @@ -34,10 +34,6 @@ in a separate file/object so that users can replace it easily. The default implementation should be null on most targets. */ -#ifdef __cplusplus -extern "C" { -#endif - /* The following include is here to meet the published VxWorks requirement that the __vxworks header appear before any other include. */ #ifdef __vxworks @@ -57,6 +53,10 @@ extern "C" { #include "raise.h" +#ifdef __cplusplus +extern "C" { +#endif + /******************************************/ /* __gnat_initialize (NT-mingw32 Version) */ /******************************************/ diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index c3947ed2efd..cba417507b6 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -699,11 +699,11 @@ package body Inline is Error_Msg_Unit_1 := Bname; Error_Msg_N - ("one or more inlined subprograms accessed in $!?", + ("one or more inlined subprograms accessed in $!??", Comp_Unit); Error_Msg_File_1 := Get_File_Name (Bname, Subunit => False); - Error_Msg_N ("\but file{ was not found!?", Comp_Unit); + Error_Msg_N ("\but file{ was not found!??", Comp_Unit); else -- If the package to be inlined is an ancestor unit of @@ -882,11 +882,11 @@ package body Inline is then Error_Msg_Node_2 := Child_Spec; Error_Msg_NE - ("body of & depends on child unit&?", - With_Clause, P); + ("body of & depends on child unit&??", + With_Clause, P); Error_Msg_N - ("\subprograms in body cannot be inlined?", - With_Clause); + ("\subprograms in body cannot be inlined??", + With_Clause); -- Disable further inlining from this unit, -- and keep Taft-amendment types incomplete. @@ -916,8 +916,8 @@ package body Inline is elsif Ineffective_Inline_Warnings then Error_Msg_Unit_1 := Bname; Error_Msg_N - ("unable to inline subprograms defined in $?", P); - Error_Msg_N ("\body not found?", P); + ("unable to inline subprograms defined in $??", P); + Error_Msg_N ("\body not found??", P); return; end if; end if; diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb index 651107f24c4..3ac620ca4ca 100644 --- a/gcc/ada/layout.adb +++ b/gcc/ada/layout.adb @@ -2435,7 +2435,7 @@ package body Layout is Convention (E) = Convention_CPP) then Error_Msg_N - ("?this access type does not correspond to C pointer", E); + ("?x?this access type does not correspond to C pointer", E); end if; -- If the designated type is a limited view it is unanalyzed. We can @@ -2804,7 +2804,7 @@ package body Layout is begin if Spec > Max then Error_Msg_Uint_1 := Spec - Max; - Error_Msg_NE ("?^ bits of & unused", SC, E); + Error_Msg_NE ("??^ bits of & unused", SC, E); end if; end Check_Unused_Bits; @@ -2883,8 +2883,8 @@ package body Layout is and then not Is_Atomic (E) then if not Size_Known_At_Compile_Time (E) then - Error_Msg_N ("Optimize_Alignment has no effect for &", E); - Error_Msg_N ("\pragma is ignored for variable length record?", E); + Error_Msg_N ("Optimize_Alignment has no effect for &??", E); + Error_Msg_N ("\pragma is ignored for variable length record??", E); else Align := 1; end if; diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index aa9031f835c..2f01dd4480f 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -597,7 +597,7 @@ package body Lib.Xref is and then Warn_On_Ada_2005_Compatibility and then (Typ = 'm' or else Typ = 'r' or else Typ = 's') then - Error_Msg_NE ("& is only defined in Ada 2005?", N, E); + Error_Msg_NE ("& is only defined in Ada 2005?y?", N, E); end if; -- Warn if reference to Ada 2012 entity not in Ada 2012 mode. We only @@ -609,7 +609,7 @@ package body Lib.Xref is and then Warn_On_Ada_2012_Compatibility and then (Typ = 'm' or else Typ = 'r') then - Error_Msg_NE ("& is only defined in Ada 2012?", N, E); + Error_Msg_NE ("& is only defined in Ada 2012?y?", N, E); end if; -- Never collect references if not in main source unit. However, we omit @@ -841,7 +841,7 @@ package body Lib.Xref is while Present (BE) loop if Chars (BE) = Chars (E) then Error_Msg_NE -- CODEFIX - ("?pragma Unreferenced given for&!", N, BE); + ("??pragma Unreferenced given for&!", N, BE); exit; end if; diff --git a/gcc/ada/opt.adb b/gcc/ada/opt.adb index a6c15538c28..98eab409877 100644 --- a/gcc/ada/opt.adb +++ b/gcc/ada/opt.adb @@ -57,6 +57,7 @@ package body Opt is Ada_Version_Explicit_Config := Ada_Version_Explicit; Assertions_Enabled_Config := Assertions_Enabled; Assume_No_Invalid_Values_Config := Assume_No_Invalid_Values; + Check_Float_Overflow_Config := Check_Float_Overflow; Check_Policy_List_Config := Check_Policy_List; Debug_Pragmas_Disabled_Config := Debug_Pragmas_Disabled; Debug_Pragmas_Enabled_Config := Debug_Pragmas_Enabled; @@ -91,6 +92,7 @@ package body Opt is Ada_Version_Explicit := Save.Ada_Version_Explicit; Assertions_Enabled := Save.Assertions_Enabled; Assume_No_Invalid_Values := Save.Assume_No_Invalid_Values; + Check_Float_Overflow := Save.Check_Float_Overflow; Check_Policy_List := Save.Check_Policy_List; Debug_Pragmas_Disabled := Save.Debug_Pragmas_Disabled; Debug_Pragmas_Enabled := Save.Debug_Pragmas_Enabled; @@ -127,6 +129,7 @@ package body Opt is Save.Ada_Version_Explicit := Ada_Version_Explicit; Save.Assertions_Enabled := Assertions_Enabled; Save.Assume_No_Invalid_Values := Assume_No_Invalid_Values; + Save.Check_Float_Overflow := Check_Float_Overflow; Save.Check_Policy_List := Check_Policy_List; Save.Debug_Pragmas_Disabled := Debug_Pragmas_Disabled; Save.Debug_Pragmas_Enabled := Debug_Pragmas_Enabled; @@ -198,6 +201,7 @@ package body Opt is Ada_Version_Explicit := Ada_Version_Explicit_Config; Assertions_Enabled := Assertions_Enabled_Config; Assume_No_Invalid_Values := Assume_No_Invalid_Values_Config; + Check_Float_Overflow := Check_Float_Overflow_Config; Check_Policy_List := Check_Policy_List_Config; Debug_Pragmas_Disabled := Debug_Pragmas_Disabled_Config; Debug_Pragmas_Enabled := Debug_Pragmas_Enabled_Config; @@ -255,6 +259,7 @@ package body Opt is Tree_Read_Int (Assertions_Enabled_Config_Val); Tree_Read_Bool (All_Errors_Mode); Tree_Read_Bool (Assertions_Enabled); + Tree_Read_Bool (Check_Float_Overflow); Tree_Read_Int (Int (Check_Policy_List)); Tree_Read_Bool (Debug_Pragmas_Disabled); Tree_Read_Bool (Debug_Pragmas_Enabled); @@ -321,6 +326,7 @@ package body Opt is Tree_Write_Int (Boolean'Pos (Assertions_Enabled_Config)); Tree_Write_Bool (All_Errors_Mode); Tree_Write_Bool (Assertions_Enabled); + Tree_Write_Bool (Check_Float_Overflow); Tree_Write_Int (Int (Check_Policy_List)); Tree_Write_Bool (Debug_Pragmas_Disabled); Tree_Write_Bool (Debug_Pragmas_Enabled); diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index b8d169700dc..2b68d796993 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -174,7 +174,8 @@ package Opt is Address_Clause_Overlay_Warnings : Boolean := True; -- GNAT - -- Set False to disable address clause warnings + -- Set False to disable address clause warnings. Modified by use of + -- -gnatwo/O. Address_Is_Private : Boolean := False; -- GNAT, GNATBIND @@ -211,10 +212,9 @@ package Opt is -- Enable assertions made using pragma Assert Assume_No_Invalid_Values : Boolean := False; - -- GNAT - -- Normally, in accordance with (RM 13.9.1 (9-11)) the front end assumes - -- that values could have invalid representations, unless it can clearly - -- prove that the values are valid. If this switch is set (by -gnatB or by + -- GNAT Normally, in accordance with (RM 13.9.1 (9-11)) the front end + -- assumes that values could have invalid representations, unless it can + -- clearly prove that the values are valid. If this switch is set (by -- pragma Assume_No_Invalid_Values (Off)), then the compiler assumes values -- are valid and in range of their representations. This feature is now -- fully enabled in the compiler. @@ -276,6 +276,13 @@ package Opt is -- Set to True to detect whether subprogram parameters and function results -- alias the same object(s). + Check_Float_Overflow : Boolean := False; + -- GNAT + -- Set to True to check that operations on predefined unconstrained float + -- types (e.g. Float, Long_Float) do not overflow and generate infinities + -- or invalid values. Set by the Check_Float_Overflow pragma, or by use + -- of the -gnateF switch. + Check_Object_Consistency : Boolean := False; -- GNATBIND, GNATMAKE -- Set to True to check whether every object file is consistent with @@ -318,6 +325,7 @@ package Opt is -- GNAT -- Set to True to enable checking for unreferenced entities other -- than formal parameters (for which see Check_Unreferenced_Formals) + -- Modified by use of -gnatwu/U. Check_Unreferenced_Formals : Boolean := False; -- GNAT @@ -333,6 +341,7 @@ package Opt is -- GNAT -- Set to True to enable checking for unused withs, and also the case -- of withing a package and using none of the entities in the package. + -- Modified by use of -gnatwu/U. CodePeer_Mode : Boolean := False; -- GNAT, GNATBIND @@ -374,7 +383,8 @@ package Opt is Constant_Condition_Warnings : Boolean := False; -- GNAT - -- Set to True to activate warnings on constant conditions + -- Set to True to activate warnings on constant conditions. Modified by + -- use of -gnatwc/C. Create_Mapping_File : Boolean := False; -- GNATMAKE, GPRMAKE @@ -553,8 +563,7 @@ package Opt is Extensions_Allowed : Boolean := False; -- GNAT -- Set to True by switch -gnatX if GNAT specific language extensions - -- are allowed. For example, the use of 'Constrained with objects of - -- generic types is a GNAT extension. + -- are allowed. Currently there are no such defined extensions. type External_Casing_Type is ( As_Is, -- External names cased as they appear in the Ada source @@ -714,7 +723,7 @@ package Opt is Implementation_Unit_Warnings : Boolean := True; -- GNAT -- Set True to active warnings for use of implementation internal units. - -- Can be controlled by use of -gnatwi/-gnatwI. + -- Modified by use of -gnatwi/-gnatwI. Implicit_Packing : Boolean := False; -- GNAT @@ -824,8 +833,7 @@ package Opt is -- GNAT -- List inherited invariants, preconditions, and postconditions from -- Invariant'Class, Pre'Class, and Post'Class aspects. Also list inherited - -- subtype predicates. Set True by use of -gnatw.l and False by use of - -- -gnatw.L. + -- subtype predicates. Modified by use of -gnatw.l/.L. List_Restrictions : Boolean := False; -- GNATBIND @@ -1019,7 +1027,7 @@ package Opt is Object_Path_File_Name : String_Ptr := null; -- GNAT2WHY -- Path of the temporary file that contains a list of object directories - -- passed by -gnateO=<obj_pat_file>. + -- passed by -gnateO=<obj_path_file>. One_Compilation_Per_Obj_Dir : Boolean := False; -- GNATMAKE, GPRBUILD @@ -1467,47 +1475,48 @@ package Opt is -- GNAT -- Set to True to generate all warnings on Ada 2005 compatibility issues, -- including warnings on Ada 2005 obsolescent features used in Ada 2005 - -- mode. Set False by -gnatwY. + -- mode. Set by default, modified by use of -gnatwy/Y. Warn_On_Ada_2012_Compatibility : Boolean := True; -- GNAT -- Set to True to generate all warnings on Ada 2012 compatibility issues, -- including warnings on Ada 2012 obsolescent features used in Ada 2012 - -- mode. Set False by -gnatwY. + -- mode. Modified by use of -gnatwy/Y. Warn_On_All_Unread_Out_Parameters : Boolean := False; -- GNAT -- Set to True to generate warnings in all cases where a variable is -- modified by being passed as to an OUT formal, but the resulting value is - -- never read. The default is that this warning is suppressed, except in - -- the case of + -- never read. The default is that this warning is suppressed. Modified + -- by use of gnatw.o/.O. Warn_On_Assertion_Failure : Boolean := True; -- GNAT -- Set to True to activate warnings on assertions that can be determined - -- at compile time will always fail. Set false by -gnatw.A. + -- at compile time will always fail. Modified by use of -gnatw.a/.A. Warn_On_Assumed_Low_Bound : Boolean := True; -- GNAT -- Set to True to activate warnings for string parameters that are indexed - -- with literals or S'Length, presumably assuming a lower bound of one. Set - -- False by -gnatwW. + -- with literals or S'Length, presumably assuming a lower bound of one. + -- Modified by use of -gnatww/W. Warn_On_Atomic_Synchronization : Boolean := False; -- GNAT -- Set to True to generate information messages for atomic synchronization. - -- Set True by use of -gnatw.n. + -- Modified by use of -gnatw.n/.N. Warn_On_Bad_Fixed_Value : Boolean := False; -- GNAT -- Set to True to generate warnings for static fixed-point expression -- values that are not an exact multiple of the small value of the type. + -- Odd by default, modified by use of -gnatwb/B. Warn_On_Biased_Representation : Boolean := True; -- GNAT -- Set to True to generate warnings for size clauses, component clauses - -- and component_size clauses that force biased representation. Set False - -- by -gnatw.B. + -- and component_size clauses that force biased representation. Modified + -- by use of -gnatw.b/.B. Warn_On_Constant : Boolean := False; -- GNAT @@ -1533,20 +1542,23 @@ package Opt is Warn_On_Hiding : Boolean := False; -- GNAT -- Set to True to generate warnings if a declared entity hides another - -- entity. The default is that this warning is suppressed. + -- entity. The default is that this warning is suppressed. Modified by + -- use of -gnatwh/H. Warn_On_Modified_Unread : Boolean := False; -- GNAT -- Set to True to generate warnings if a variable is assigned but is never -- read. Also controls warnings for similar cases involving out parameters, -- but only if there is only one out parameter for the procedure involved. - -- The default is that this warning is suppressed. + -- The default is that this warning is suppressed, modified by use of + -- -gnatwm/M. Warn_On_No_Value_Assigned : Boolean := True; -- GNAT -- Set to True to generate warnings if no value is ever assigned to a -- variable that is at least partially uninitialized. Set to false to -- suppress such warnings. The default is that such warnings are enabled. + -- Modified by use of -gnatwv/V. Warn_On_Non_Local_Exception : Boolean := False; -- GNAT @@ -1556,6 +1568,7 @@ package Opt is -- default is not to generate the warnings except that if the source has -- at least one exception handler, and this restriction is set, and the -- warning was not explicitly turned off, then it is turned on by default. + -- Modified by use of -gnatw.x/.X. No_Warn_On_Non_Local_Exception : Boolean := False; -- GNAT @@ -1566,22 +1579,26 @@ package Opt is Warn_On_Object_Renames_Function : Boolean := False; -- GNAT -- Set to True to generate warnings when a function result is renamed as - -- an object. The default is that this warning is disabled. + -- an object. The default is that this warning is disabled. Modified by + -- use of -gnatw.r/.R. Warn_On_Obsolescent_Feature : Boolean := False; -- GNAT -- Set to True to generate warnings on use of any feature in Annex or if a - -- subprogram is called for which a pragma Obsolescent applies. + -- subprogram is called for which a pragma Obsolescent applies. Modified + -- by use of -gnatwj/J. Warn_On_Overlap : Boolean := False; -- GNAT -- Set to True to generate warnings when a writable actual which is not -- a by-copy type overlaps with another actual in a subprogram call. + -- Modified by use of -gnatw.i/.I. Warn_On_Questionable_Missing_Parens : Boolean := True; -- GNAT -- Set to True to generate warnings for cases where parentheses are missing - -- and the usage is questionable, because the intent is unclear. + -- and the usage is questionable, because the intent is unclear. On by + -- default, modified by use of -gnatwq/Q. Warn_On_Parameter_Order : Boolean := False; -- GNAT @@ -1593,53 +1610,54 @@ package Opt is -- GNAT -- Set to True to generate warnings for redundant constructs (e.g. useless -- assignments/conversions). The default is that this warning is disabled. + -- Modified by use of -gnatwr/R. Warn_On_Reverse_Bit_Order : Boolean := True; -- GNAT -- Set to True to generate warning (informational) messages for component -- clauses that are affected by non-standard bit-order. The default is - -- that this warning is enabled. + -- that this warning is enabled. Modified by -gnatw.v/.V. - Warn_On_Suspicious_Contract : Boolean := False; + Warn_On_Suspicious_Contract : Boolean := True; -- GNAT -- Set to True to generate warnings for suspicious contracts expressed as -- pragmas or aspects precondition and postcondition. The default is that - -- this warning is disabled. + -- this warning is enabled. Modified by use of -gnatw.t/.T. Warn_On_Suspicious_Modulus_Value : Boolean := True; -- GNAT -- Set to True to generate warnings for suspicious modulus values. The - -- default is that this warning is enabled. + -- default is that this warning is enabled. Modified by -gnatw.m/.M. Warn_On_Unchecked_Conversion : Boolean := True; -- GNAT -- Set to True to generate warnings for unchecked conversions that may have - -- non-portable semantics (e.g. because sizes of types differ). The default - -- is that this warning is enabled. + -- non-portable semantics (e.g. because sizes of types differ). Modified + -- by use of -gnatwz/Z. Warn_On_Unordered_Enumeration_Type : Boolean := False; -- GNAT -- Set to True to generate warnings for inappropriate uses (comparisons -- and explicit ranges) on unordered enumeration types (which includes -- all enumeration types for which pragma Ordered is not given). The - -- default is that this warning is disabled. + -- default is that this warning is disabled. Modified by -gnat.u/.U. Warn_On_Unrecognized_Pragma : Boolean := True; -- GNAT -- Set to True to generate warnings for unrecognized pragmas. The default - -- is that this warning is enabled. + -- is that this warning is enabled. Modified by use of -gnatwg/G. Warn_On_Unrepped_Components : Boolean := False; -- GNAT -- Set to True to generate warnings for the case of components of record -- which have a record representation clause but this component does not - -- have a component clause. The default is that this warning is disabled. + -- have a component clause. Modified by use of -gnatw.c/.C. Warn_On_Warnings_Off : Boolean := False; -- GNAT -- Set to True to generate warnings for use of Pragma Warnings (Off, ent), -- where either the pragma is never used, or it could be replaced by a - -- pragma Unmodified or Unreferenced. + -- pragma Unmodified or Unreferenced. Modified by use of -gnatw.w/.W. type Warning_Mode_Type is (Suppress, Normal, Treat_As_Error); Warning_Mode : Warning_Mode_Type := Normal; @@ -1714,6 +1732,13 @@ package Opt is -- -gnatB, and possibly modified by the use of the configuration pragma -- Assume_No_Invalid_Values. + Check_Float_Overflow_Config : Boolean; + -- GNAT + -- Set to True to check that operations on predefined unconstrained float + -- types (e.g. Float, Long_Float) do not overflow and generate infinities + -- or invalid values. Set by the Check_Float_Overflow pragma, or by use + -- of the -gnateF switch. + Check_Policy_List_Config : Node_Id; -- GNAT -- This points to the list of N_Pragma nodes for Check_Policy pragmas @@ -1969,6 +1994,7 @@ private Ada_Version_Explicit : Ada_Version_Type; Assertions_Enabled : Boolean; Assume_No_Invalid_Values : Boolean; + Check_Float_Overflow : Boolean; Check_Policy_List : Node_Id; Debug_Pragmas_Disabled : Boolean; Debug_Pragmas_Enabled : Boolean; diff --git a/gcc/ada/osint.ads b/gcc/ada/osint.ads index 094fee3f52f..48a7d8e44c1 100644 --- a/gcc/ada/osint.ads +++ b/gcc/ada/osint.ads @@ -73,7 +73,7 @@ package Osint is -- found. Note that for the special case of gnat.adc, only the compilation -- environment directory is searched, i.e. the directory where the ali and -- object files are written. Another special case is Debug_Generated_Code - -- set and the file name ends on ".dg", in which case we look for the + -- set and the file name ends in ".dg", in which case we look for the -- generated file only in the current directory, since that is where it is -- always built. diff --git a/gcc/ada/par-ch10.adb b/gcc/ada/par-ch10.adb index 08553dd0376..ddd88b3eea3 100644 --- a/gcc/ada/par-ch10.adb +++ b/gcc/ada/par-ch10.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -314,8 +314,9 @@ package body Ch10 is -- Do not complain if there is a pragma No_Body if not No_Body then - Error_Msg_SC ("?file contains no compilation units"); + Error_Msg_SC ("??file contains no compilation units"); end if; + else Error_Msg_SC ("compilation unit expected"); Cunit_Error_Flag := True; diff --git a/gcc/ada/par-labl.adb b/gcc/ada/par-labl.adb index 9bafb07b7d1..f709dd088ee 100644 --- a/gcc/ada/par-labl.adb +++ b/gcc/ada/par-labl.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -81,6 +81,7 @@ procedure Labl is -- Note that in the worst case, this is quadratic in the number -- of labels. However, labels are not all that common, and this -- is only called for explicit labels. + -- ???Nonetheless, the efficiency could be improved. For example, -- call Labl for each body, rather than once per compilation. @@ -356,7 +357,7 @@ procedure Labl is Remove (Loop_Header); Rewrite (Loop_End, Loop_Stmt); Error_Msg_N - ("info: code between label and backwards goto rewritten as loop?", + ("info: code between label and backwards goto rewritten as loop??", Loop_End); end Rewrite_As_Loop; diff --git a/gcc/ada/par-load.adb b/gcc/ada/par-load.adb index e30ffc02a02..f5bf99d9d9e 100644 --- a/gcc/ada/par-load.adb +++ b/gcc/ada/par-load.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -172,7 +172,7 @@ begin then Error_Msg_File_1 := File_Name; Error_Msg - ("?file name does not match unit name, should be{", Sloc (Curunit)); + ("??file name does not match unit name, should be{", Sloc (Curunit)); end if; -- For units other than the main unit, the expected unit name is set and diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index e1f394b2853..579dd374a13 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -1106,6 +1106,7 @@ begin Pragma_Attach_Handler | Pragma_Attribute_Definition | Pragma_Check | + Pragma_Check_Float_Overflow | Pragma_Check_Name | Pragma_Check_Policy | Pragma_CIL_Constructor | diff --git a/gcc/ada/par-util.adb b/gcc/ada/par-util.adb index 3baf9f51f57..fa592a7ea50 100644 --- a/gcc/ada/par-util.adb +++ b/gcc/ada/par-util.adb @@ -186,7 +186,7 @@ package body Util is or else (Token_Name = Name_Interface and then Prev_Token /= Tok_Pragma) then - Error_Msg_N ("& is a reserved word in Ada 2005?", Token_Node); + Error_Msg_N ("& is a reserved word in Ada 2005?y?", Token_Node); end if; end if; @@ -196,7 +196,7 @@ package body Util is and then Warn_On_Ada_2012_Compatibility then if Token_Name = Name_Some then - Error_Msg_N ("& is a reserved word in Ada 2012?", Token_Node); + Error_Msg_N ("& is a reserved word in Ada 2012?y?", Token_Node); end if; end if; @@ -761,7 +761,7 @@ package body Util is C : constant Entity_Id := Current_Entity (N); begin if Present (C) and then Sloc (C) = Standard_Location then - Error_Msg_N ("redefinition of entity& in Standard?", N); + Error_Msg_N ("redefinition of entity& in Standard?K?", N); end if; end; end if; diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb index c2c522cb520..54fe0ddb8d7 100644 --- a/gcc/ada/par_sco.adb +++ b/gcc/ada/par_sco.adb @@ -154,19 +154,35 @@ package body Par_SCO is -- Process L, a list of statements or declarations dominated by D. -- If P is present, it is processed as though it had been prepended to L. - procedure Traverse_Generic_Instantiation (N : Node_Id); + function Traverse_Declarations_Or_Statements + (L : List_Id; + D : Dominant_Info := No_Dominant; + P : Node_Id := Empty) return Dominant_Info; + -- Same as above, and returns dominant information corresponding to the + -- last node with SCO in L. + + -- The following Traverse_* routines perform appropriate calls to + -- Traverse_Declarations_Or_Statements to traverse specific node kinds. + -- Parameter D, when present, indicates the dominant of the first + -- declaration or statement within N. + + -- Why is Traverse_Sync_Definition commented specificaly and + -- the others are not??? + procedure Traverse_Generic_Package_Declaration (N : Node_Id); procedure Traverse_Handled_Statement_Sequence (N : Node_Id; D : Dominant_Info := No_Dominant); - procedure Traverse_Package_Body (N : Node_Id); - procedure Traverse_Package_Declaration (N : Node_Id); - procedure Traverse_Protected_Body (N : Node_Id); + procedure Traverse_Package_Body (N : Node_Id); + procedure Traverse_Package_Declaration + (N : Node_Id; + D : Dominant_Info := No_Dominant); procedure Traverse_Subprogram_Or_Task_Body (N : Node_Id; D : Dominant_Info := No_Dominant); - procedure Traverse_Subprogram_Declaration (N : Node_Id); - -- Traverse the corresponding construct, generating SCO table entries + + procedure Traverse_Sync_Definition (N : Node_Id); + -- Traverse a protected definition or task definition procedure Write_SCOs_To_ALI_File is new Put_SCOs; -- Write SCO information to the ALI file using routines in Lib.Util @@ -900,6 +916,23 @@ package body Par_SCO is Lu : Node_Id; From : Nat; + procedure Traverse_Aux_Decls (N : Node_Id); + -- Traverse the Aux_Decl_Nodes of compilation unit N + + ------------------------ + -- Traverse_Aux_Decls -- + ------------------------ + + procedure Traverse_Aux_Decls (N : Node_Id) is + ADN : constant Node_Id := Aux_Decls_Node (N); + begin + Traverse_Declarations_Or_Statements (Config_Pragmas (ADN)); + Traverse_Declarations_Or_Statements (Declarations (ADN)); + Traverse_Declarations_Or_Statements (Pragmas_After (ADN)); + end Traverse_Aux_Decls; + + -- Start of processing for SCO_Record + begin -- Ignore call if not generating code and generating SCO's @@ -929,27 +962,20 @@ package body Par_SCO is -- Traverse the unit - case Nkind (Lu) is - when N_Protected_Body => - Traverse_Protected_Body (Lu); - - when N_Subprogram_Body | N_Task_Body => - Traverse_Subprogram_Or_Task_Body (Lu); - - when N_Subprogram_Declaration => - Traverse_Subprogram_Declaration (Lu); + Traverse_Aux_Decls (Cunit (U)); - when N_Package_Declaration => - Traverse_Package_Declaration (Lu); - - when N_Package_Body => - Traverse_Package_Body (Lu); - - when N_Generic_Package_Declaration => - Traverse_Generic_Package_Declaration (Lu); - - when N_Generic_Instantiation => - Traverse_Generic_Instantiation (Lu); + case Nkind (Lu) is + when + N_Package_Declaration | + N_Package_Body | + N_Subprogram_Declaration | + N_Subprogram_Body | + N_Generic_Package_Declaration | + N_Protected_Body | + N_Task_Body | + N_Generic_Instantiation => + + Traverse_Declarations_Or_Statements (L => No_List, P => Lu); when others => @@ -1012,8 +1038,7 @@ package body Par_SCO is -- original source occurrence of the pragma. if not (Generate_SCO - and then - In_Extended_Main_Source_Unit (Cunit_Entity (Current_Sem_Unit)) + and then In_Extended_Main_Source_Unit (Loc) and then not (In_Instance or In_Inlined_Body)) then return; @@ -1025,10 +1050,15 @@ package body Par_SCO is Index := Condition_Pragma_Hash_Table.Get (Loc); - -- The test here for zero is to deal with possible previous errors + -- A zero index here indicates that semantic analysis found an + -- activated pragma at Loc which does not have a corresponding pragma + -- or aspect at the syntax level. This may occur in legitimate cases + -- because of expanded code (such are Pre/Post conditions generated for + -- formal parameter validity checks), or as a consequence of a previous + -- error. if Index = 0 then - Check_Error_Detected; + return; else declare @@ -1172,6 +1202,17 @@ package body Par_SCO is D : Dominant_Info := No_Dominant; P : Node_Id := Empty) is + Discard_Dom : Dominant_Info; + pragma Warnings (Off, Discard_Dom); + begin + Discard_Dom := Traverse_Declarations_Or_Statements (L, D, P); + end Traverse_Declarations_Or_Statements; + + function Traverse_Declarations_Or_Statements + (L : List_Id; + D : Dominant_Info := No_Dominant; + P : Node_Id := Empty) return Dominant_Info + is Current_Dominant : Dominant_Info := D; -- Dominance information for the current basic block @@ -1191,12 +1232,13 @@ package body Par_SCO is procedure Set_Statement_Entry; -- Output CS entries for all statements saved in table SC, and end the - -- current CS sequence. + -- current CS sequence. Then output entries for all decisions nested in + -- these statements, which have been deferred so far. procedure Process_Decisions_Defer (N : Node_Id; T : Character); pragma Inline (Process_Decisions_Defer); -- This routine is logically the same as Process_Decisions, except that - -- the arguments are saved in the SD table, for later processing when + -- the arguments are saved in the SD table for later processing when -- Set_Statement_Entry is called, which goes through the saved entries -- making the corresponding calls to Process_Decision. @@ -1340,12 +1382,25 @@ package body Par_SCO is when N_Loop_Statement => To_Node := Iteration_Scheme (N); - when N_Selective_Accept | - N_Timed_Entry_Call | - N_Conditional_Entry_Call | - N_Asynchronous_Select => + when N_Selective_Accept | + N_Timed_Entry_Call | + N_Conditional_Entry_Call | + N_Asynchronous_Select | + N_Single_Protected_Declaration | + N_Single_Task_Declaration => T := F; + when N_Protected_Type_Declaration | N_Task_Type_Declaration => + if Has_Aspects (N) then + To_Node := Last (Aspect_Specifications (N)); + + elsif Present (Discriminant_Specifications (N)) then + To_Node := Last (Discriminant_Specifications (N)); + + else + To_Node := Defining_Identifier (N); + end if; + when others => null; @@ -1415,6 +1470,9 @@ package body Par_SCO is -- entry since Set_SCO_Pragma_Enabled will be called when -- analyzing actual checks, possibly in other units). + -- Pre/post can have checks in client units too because of + -- inheritance, so should they be moved here??? + when Aspect_Predicate | Aspect_Static_Predicate | Aspect_Dynamic_Predicate | @@ -1466,7 +1524,7 @@ package body Par_SCO is when N_Package_Declaration => Set_Statement_Entry; - Traverse_Package_Declaration (N); + Traverse_Package_Declaration (N, Current_Dominant); -- Generic package declaration @@ -1482,7 +1540,7 @@ package body Par_SCO is -- Subprogram declaration - when N_Subprogram_Declaration => + when N_Subprogram_Declaration | N_Subprogram_Body_Stub => Process_Decisions_Defer (Parameter_Specifications (Specification (N)), 'X'); @@ -1528,7 +1586,7 @@ package body Par_SCO is when N_Protected_Body => Set_Statement_Entry; - Traverse_Protected_Body (N); + Traverse_Declarations_Or_Statements (Declarations (N)); -- Exit statement, which is an exit statement in the SCO sense, -- so it is included in the current statement sequence, but @@ -1561,9 +1619,14 @@ package body Par_SCO is when N_Block_Statement => Set_Statement_Entry; - Traverse_Declarations_Or_Statements - (L => Declarations (N), - D => Current_Dominant); + + -- The first statement in the handled sequence of statements + -- is dominated by the elaboration of the last declaration. + + Current_Dominant := Traverse_Declarations_Or_Statements + (L => Declarations (N), + D => Current_Dominant); + Traverse_Handled_Statement_Sequence (N => Handled_Statement_Sequence (N), D => Current_Dominant); @@ -1868,10 +1931,13 @@ package body Par_SCO is begin case Nam is - when Name_Assert | - Name_Check | - Name_Precondition | - Name_Postcondition => + when Name_Assert | + Name_Assert_And_Cut | + Name_Assume | + Name_Check | + Name_Loop_Invariant | + Name_Precondition | + Name_Postcondition => -- For Assert/Check/Precondition/Postcondition, we -- must generate a P entry for the decision. Note @@ -1887,6 +1953,9 @@ package body Par_SCO is Process_Decisions_Defer (Expression (Arg), 'P'); Typ := 'p'; + -- Pre/postconditions can be inherited so SCO should + -- never be deactivated??? + when Name_Debug => if Present (Arg) and then Present (Next (Arg)) then @@ -1905,6 +1974,10 @@ package body Par_SCO is -- for any embedded expressions, and the pragma is -- never disabled. + -- Should generate P decisions (not X) for assertion + -- related pragmas: [Type_]Invariant, + -- [{Static,Dynamic}_]Predicate??? + when others => Process_Decisions_Defer (N, 'X'); Typ := 'P'; @@ -1920,7 +1993,7 @@ package body Par_SCO is -- Object declaration. Ignored if Prev_Ids is set, since the -- parser generates multiple instances of the whole declaration -- if there is more than one identifier declared, and we only - -- want one entry in the SCO's, so we take the first, for which + -- want one entry in the SCOs, so we take the first, for which -- Prev_Ids is False. when N_Object_Declaration => @@ -1935,6 +2008,19 @@ package body Par_SCO is -- All other cases, which extend the current statement sequence -- but do not terminate it, even if they have nested decisions. + when N_Protected_Type_Declaration | N_Task_Type_Declaration => + Extend_Statement_Sequence (N, 't'); + Process_Decisions_Defer (Discriminant_Specifications (N), 'X'); + Set_Statement_Entry; + + Traverse_Sync_Definition (N); + + when N_Single_Protected_Declaration | N_Single_Task_Declaration => + Extend_Statement_Sequence (N, 'o'); + Set_Statement_Entry; + + Traverse_Sync_Definition (N); + when others => -- Determine required type character code, or ASCII.NUL if @@ -1962,7 +2048,10 @@ package body Par_SCO is when N_Representation_Clause | N_Use_Package_Clause | - N_Use_Type_Clause => + N_Use_Type_Clause | + N_Package_Body_Stub | + N_Task_Body_Stub | + N_Protected_Body_Stub => Typ := ASCII.NUL; when others => @@ -1989,47 +2078,31 @@ package body Par_SCO is -- Start of processing for Traverse_Declarations_Or_Statements begin + -- Process single prefixed node + if Present (P) then Traverse_One (P); end if; - if Is_Non_Empty_List (L) then - - -- Loop through statements or declarations + -- Loop through statements or declarations + if Is_Non_Empty_List (L) then N := First (L); while Present (N) loop Traverse_One (N); Next (N); end loop; - Set_Statement_Entry; end if; - end Traverse_Declarations_Or_Statements; - - ------------------------------------ - -- Traverse_Generic_Instantiation -- - ------------------------------------ - - procedure Traverse_Generic_Instantiation (N : Node_Id) is - First : Source_Ptr; - Last : Source_Ptr; - - begin - -- First we need a statement entry to cover the instantiation - Sloc_Range (N, First, Last); - Set_Table_Entry - (C1 => 'S', - C2 => ' ', - From => First, - To => Last, - Last => True); + -- End sequence of statements and flush deferred decisions - -- Now output any embedded decisions + if Present (P) or else Is_Non_Empty_List (L) then + Set_Statement_Entry; + end if; - Process_Decisions (N, 'X', No_Location); - end Traverse_Generic_Instantiation; + return Current_Dominant; + end Traverse_Declarations_Or_Statements; ------------------------------------------ -- Traverse_Generic_Package_Declaration -- @@ -2076,30 +2149,77 @@ package body Par_SCO is --------------------------- procedure Traverse_Package_Body (N : Node_Id) is + Dom : Dominant_Info; begin - Traverse_Declarations_Or_Statements (Declarations (N)); - Traverse_Handled_Statement_Sequence (Handled_Statement_Sequence (N)); + -- The first statement in the handled sequence of statements is + -- dominated by the elaboration of the last declaration. + + Dom := Traverse_Declarations_Or_Statements (Declarations (N)); + + Traverse_Handled_Statement_Sequence + (Handled_Statement_Sequence (N), Dom); end Traverse_Package_Body; ---------------------------------- -- Traverse_Package_Declaration -- ---------------------------------- - procedure Traverse_Package_Declaration (N : Node_Id) is + procedure Traverse_Package_Declaration + (N : Node_Id; + D : Dominant_Info := No_Dominant) + is Spec : constant Node_Id := Specification (N); + Dom : Dominant_Info; + begin - Traverse_Declarations_Or_Statements (Visible_Declarations (Spec)); - Traverse_Declarations_Or_Statements (Private_Declarations (Spec)); + Dom := + Traverse_Declarations_Or_Statements (Visible_Declarations (Spec), D); + + -- First private declaration is dominated by last visible declaration + + Traverse_Declarations_Or_Statements (Private_Declarations (Spec), Dom); end Traverse_Package_Declaration; - ----------------------------- - -- Traverse_Protected_Body -- - ----------------------------- + ------------------------------ + -- Traverse_Sync_Definition -- + ------------------------------ + + procedure Traverse_Sync_Definition (N : Node_Id) is + Dom_Info : Dominant_Info := ('S', N); + -- The first declaration is dominated by the protected or task [type] + -- declaration. + + Sync_Def : Node_Id; + -- N's protected or task definition + + Vis_Decl : List_Id; + -- Sync_Def's Visible_Declarations - procedure Traverse_Protected_Body (N : Node_Id) is begin - Traverse_Declarations_Or_Statements (Declarations (N)); - end Traverse_Protected_Body; + case Nkind (N) is + when N_Single_Protected_Declaration | N_Protected_Type_Declaration => + Sync_Def := Protected_Definition (N); + + when N_Single_Task_Declaration | N_Task_Type_Declaration => + Sync_Def := Task_Definition (N); + + when others => + raise Program_Error; + end case; + + Vis_Decl := Visible_Declarations (Sync_Def); + + Dom_Info := Traverse_Declarations_Or_Statements + (L => Vis_Decl, + D => Dom_Info); + + -- If visible declarations are present, the first private declaration + -- is dominated by the last visible declaration. + + Traverse_Declarations_Or_Statements + (L => Private_Declarations (Sync_Def), + D => Dom_Info); + end Traverse_Sync_Definition; -------------------------------------- -- Traverse_Subprogram_Or_Task_Body -- @@ -2109,21 +2229,18 @@ package body Par_SCO is (N : Node_Id; D : Dominant_Info := No_Dominant) is + Decls : constant List_Id := Declarations (N); + Dom_Info : Dominant_Info := D; begin - Traverse_Declarations_Or_Statements (Declarations (N), D); - Traverse_Handled_Statement_Sequence (Handled_Statement_Sequence (N), D); - end Traverse_Subprogram_Or_Task_Body; + -- If declarations are present, the first statement is dominated by the + -- last declaration. - ------------------------------------- - -- Traverse_Subprogram_Declaration -- - ------------------------------------- + Dom_Info := Traverse_Declarations_Or_Statements + (L => Decls, D => Dom_Info); - procedure Traverse_Subprogram_Declaration (N : Node_Id) is - ADN : constant Node_Id := Aux_Decls_Node (Parent (N)); - begin - Traverse_Declarations_Or_Statements (Config_Pragmas (ADN)); - Traverse_Declarations_Or_Statements (Declarations (ADN)); - Traverse_Declarations_Or_Statements (Pragmas_After (ADN)); - end Traverse_Subprogram_Declaration; + Traverse_Handled_Statement_Sequence + (N => Handled_Statement_Sequence (N), + D => Dom_Info); + end Traverse_Subprogram_Or_Task_Body; end Par_SCO; diff --git a/gcc/ada/raise.c b/gcc/ada/raise.c index 35b0e988ee1..a0c01216777 100644 --- a/gcc/ada/raise.c +++ b/gcc/ada/raise.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 1992-2011, Free Software Foundation, Inc. * + * Copyright (C) 1992-2012, Free Software Foundation, Inc. * * * * GNAT is free software; you can redistribute it and/or modify it under * * terms of the GNU General Public License as published by the Free Soft- * @@ -32,10 +32,6 @@ /* Shared routines to support exception handling. __gnat_unhandled_terminate is shared between all exception handling mechanisms. */ -#ifdef __cplusplus -extern "C" { -#endif - #ifdef IN_RTS #include "tconfig.h" #include "tsystem.h" @@ -47,6 +43,10 @@ extern "C" { #include "adaint.h" #include "raise.h" +#ifdef __cplusplus +extern "C" { +#endif + /* Wrapper to builtin_longjmp. This is for the compiler eh only, as the sjlj runtime library interfaces directly to the intrinsic. We can't yet do this for the compiler itself, because this capability relies on changes diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb index 14ab452b477..d4acf1dd912 100644 --- a/gcc/ada/restrict.adb +++ b/gcc/ada/restrict.adb @@ -582,7 +582,7 @@ package body Restrict is if No_Dependences.Table (J).Warn then Error_Msg - ("?violation of restriction `No_Dependence '='> &`#", + ("??violation of restriction `No_Dependence '='> &`#", Sloc (Err)); else Error_Msg @@ -611,8 +611,8 @@ package body Restrict is end if; -- Ignore call if node N is not in the main source unit, since we only - -- give messages for . This avoids giving messages for aspects that are - -- specified in withed units. + -- give messages for the main unit. This avoids giving messages for + -- aspects that are specified in withed units. if not In_Extended_Main_Source_Unit (N) then return; @@ -798,9 +798,9 @@ package body Restrict is if Warn_On_Obsolescent_Feature then Error_Msg_Name_1 := Old_Name; - Error_Msg_N ("restriction identifier % is obsolescent?", N); + Error_Msg_N ("restriction identifier % is obsolescent?j?", N); Error_Msg_Name_1 := New_Name; - Error_Msg_N ("|use restriction identifier % instead", N); + Error_Msg_N ("|use restriction identifier % instead?j?", N); end if; return New_Name; @@ -951,7 +951,7 @@ package body Restrict is -- Set warning message if warning if Restriction_Warnings (R) then - Add_Char ('?'); + Add_Str ("??"); -- If real violation (not warning), then mark it as non-serious unless -- it is a violation of No_Finalization in which case we leave it as a @@ -1012,7 +1012,7 @@ package body Restrict is -- Set as warning if warning case if Restriction_Warnings (R) then - Add_Char ('?'); + Add_Str ("??"); end if; -- Set main message diff --git a/gcc/ada/s-crtl.ads b/gcc/ada/s-crtl.ads index a763d606b70..18c43c42a64 100644 --- a/gcc/ada/s-crtl.ads +++ b/gcc/ada/s-crtl.ads @@ -122,9 +122,18 @@ package System.CRTL is origin : int) return int; pragma Import (C, fseek, "fseek"); + function fseek64 + (stream : FILEs; + offset : ssize_t; + origin : int) return int; + pragma Import (C, fseek64, "__gnat_fseek64"); + function ftell (stream : FILEs) return long; pragma Import (C, ftell, "ftell"); + function ftell64 (stream : FILEs) return ssize_t; + pragma Import (C, ftell64, "__gnat_ftell64"); + function getenv (S : String) return System.Address; pragma Import (C, getenv, "getenv"); diff --git a/gcc/ada/s-direio.adb b/gcc/ada/s-direio.adb index ef4c3ea9cf1..99f8ddf7722 100644 --- a/gcc/ada/s-direio.adb +++ b/gcc/ada/s-direio.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -29,13 +29,13 @@ -- -- ------------------------------------------------------------------------------ -with Ada.IO_Exceptions; use Ada.IO_Exceptions; -with Interfaces.C_Streams; use Interfaces.C_Streams; -with System; use System; +with Ada.IO_Exceptions; use Ada.IO_Exceptions; +with Ada.Unchecked_Deallocation; +with Interfaces.C_Streams; use Interfaces.C_Streams; +with System; use System; with System.CRTL; with System.File_IO; with System.Soft_Links; -with Ada.Unchecked_Deallocation; package body System.Direct_IO is @@ -280,11 +280,20 @@ package body System.Direct_IO is ------------------ procedure Set_Position (File : File_Type) is + use type System.CRTL.ssize_t; + R : int; begin - if fseek + if Standard'Address_Size = 64 then + R := fseek64 + (File.Stream, ssize_t (File.Bytes) * + ssize_t (File.Index - 1), SEEK_SET); + else + R := fseek (File.Stream, long (File.Bytes) * - long (File.Index - 1), SEEK_SET) /= 0 - then + long (File.Index - 1), SEEK_SET); + end if; + + if R /= 0 then raise Use_Error; end if; end Set_Position; @@ -294,6 +303,7 @@ package body System.Direct_IO is ---------- function Size (File : File_Type) return Count is + use type System.CRTL.ssize_t; begin FIO.Check_File_Open (AP (File)); File.Last_Op := Op_Other; @@ -302,7 +312,11 @@ package body System.Direct_IO is raise Device_Error; end if; - return Count (ftell (File.Stream) / long (File.Bytes)); + if Standard'Address_Size = 64 then + return Count (ftell64 (File.Stream) / ssize_t (File.Bytes)); + else + return Count (ftell (File.Stream) / long (File.Bytes)); + end if; end Size; ----------- diff --git a/gcc/ada/s-except.ads b/gcc/ada/s-except.ads index f0da1e520d3..255ca859783 100644 --- a/gcc/ada/s-except.ads +++ b/gcc/ada/s-except.ads @@ -40,6 +40,7 @@ package System.Exceptions is -- Visible copy to allow Ada.Exceptions to know the exception model. private + type Require_Body; -- Dummy Taft-amendment type to make it legal (and required) to provide -- a body for this package. diff --git a/gcc/ada/s-rannum.adb b/gcc/ada/s-rannum.adb index 21d879923a3..bfcea556944 100644 --- a/gcc/ada/s-rannum.adb +++ b/gcc/ada/s-rannum.adb @@ -406,7 +406,7 @@ package body System.Random_Numbers is -- Ignore different-size warnings here since GNAT's handling -- is correct. - pragma Warnings ("Z"); -- better to use msg string! ??? + pragma Warnings ("Z"); function Conv_To_Unsigned is new Unchecked_Conversion (Result_Subtype'Base, Unsigned_64); function Conv_To_Result is @@ -496,7 +496,6 @@ package body System.Random_Numbers is procedure Reset (Gen : Generator; Initiator : Integer) is begin - pragma Warnings (Off, "condition is always *"); -- This is probably an unnecessary precaution against future change, but -- since the test is a static expression, no extra code is involved. @@ -515,8 +514,6 @@ package body System.Random_Numbers is Reset (Gen, Initialization_Vector'(Init0, Init1)); end; end if; - - pragma Warnings (On, "condition is always *"); end Reset; procedure Reset (Gen : Generator; Initiator : Initialization_Vector) is diff --git a/gcc/ada/scn.adb b/gcc/ada/scn.adb index 52431b3940b..9f8ce2078d4 100644 --- a/gcc/ada/scn.adb +++ b/gcc/ada/scn.adb @@ -339,9 +339,9 @@ package body Scn is if Warn_On_Obsolescent_Feature then Error_Msg - ("use of "":"" is an obsolescent feature (RM J.2(3))?", S); + ("?j?use of "":"" is an obsolescent feature (RM J.2(3))", S); Error_Msg - ("\use ""'#"" instead?", S); + ("\?j?use ""'#"" instead", S); end if; end if; end Check_Obsolete_Base_Char; @@ -382,8 +382,8 @@ package body Scn is if Warn_On_Obsolescent_Feature then Error_Msg_SC - ("use of ""'%"" is an obsolescent feature (RM J.2(4))?"); - Error_Msg_SC ("\use """""" instead?"); + ("?j?use of ""'%"" is an obsolescent feature (RM J.2(4))"); + Error_Msg_SC ("\?j?use """""" instead"); end if; end if; @@ -398,8 +398,8 @@ package body Scn is if Warn_On_Obsolescent_Feature then Error_Msg_SC - ("use of ""'!"" is an obsolescent feature (RM J.2(2))?"); - Error_Msg_SC ("\use ""'|"" instead?"); + ("?j?use of ""'!"" is an obsolescent feature (RM J.2(2))"); + Error_Msg_SC ("\?j?use ""'|"" instead"); end if; end if; diff --git a/gcc/ada/scos.ads b/gcc/ada/scos.ads index 0082099afb4..dc4248e12d9 100644 --- a/gcc/ada/scos.ads +++ b/gcc/ada/scos.ads @@ -385,8 +385,8 @@ package SCOs is Table_Increment => 300); Is_Decision : constant array (Character) of Boolean := - ('E' | 'G' | 'I' | 'P' | 'A' | 'W' | 'X' => True, - others => False); + ('E' | 'G' | 'I' | 'P' | 'a' | 'A' | 'W' | 'X' => True, + others => False); -- Indicates which C1 values correspond to decisions -- The SCO_Table_Entry values appear as follows: diff --git a/gcc/ada/seh_init.c b/gcc/ada/seh_init.c index 772dab0aa84..9b3c081081d 100644 --- a/gcc/ada/seh_init.c +++ b/gcc/ada/seh_init.c @@ -32,10 +32,6 @@ /* This unit contains support for SEH (Structured Exception Handling). Right now the only implementation is for Win32. */ -#ifdef __cplusplus -extern "C" { -#endif - #ifdef IN_RTS #include "tconfig.h" #include "tsystem.h" @@ -50,6 +46,10 @@ extern "C" { #include "raise.h" +#ifdef __cplusplus +extern "C" { +#endif + /* Addresses of exception data blocks for predefined exceptions. */ extern struct Exception_Data constraint_error; extern struct Exception_Data numeric_error; diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index e73b8758386..7458324a9d6 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -468,13 +468,13 @@ package body Sem_Aggr is then if Is_Out_Of_Range (Exp, Base_Type (Check_Typ)) then Apply_Compile_Time_Constraint_Error - (Exp, "value not in range of}?", CE_Range_Check_Failed, + (Exp, "value not in range of}??", CE_Range_Check_Failed, Ent => Base_Type (Check_Typ), Typ => Base_Type (Check_Typ)); elsif Is_Out_Of_Range (Exp, Check_Typ) then Apply_Compile_Time_Constraint_Error - (Exp, "value not in range of}?", CE_Range_Check_Failed, + (Exp, "value not in range of}??", CE_Range_Check_Failed, Ent => Check_Typ, Typ => Check_Typ); @@ -583,9 +583,9 @@ package body Sem_Aggr is elsif Expr_Value (This_Low) /= Expr_Value (Aggr_Low (Dim)) then Set_Raises_Constraint_Error (N); - Error_Msg_N ("sub-aggregate low bound mismatch?", N); + Error_Msg_N ("sub-aggregate low bound mismatch??", N); Error_Msg_N - ("\Constraint_Error will be raised at run time?", N); + ("\Constraint_Error will be raised at run time??", N); end if; end if; @@ -597,9 +597,9 @@ package body Sem_Aggr is Expr_Value (This_High) /= Expr_Value (Aggr_High (Dim)) then Set_Raises_Constraint_Error (N); - Error_Msg_N ("sub-aggregate high bound mismatch?", N); + Error_Msg_N ("sub-aggregate high bound mismatch??", N); Error_Msg_N - ("\Constraint_Error will be raised at run time?", N); + ("\Constraint_Error will be raised at run time??", N); end if; end if; end if; @@ -1440,8 +1440,8 @@ package body Sem_Aggr is if OK_BH and then OK_AH and then Val_BH < Val_AH then Set_Raises_Constraint_Error (N); - Error_Msg_N ("upper bound out of range?", AH); - Error_Msg_N ("\Constraint_Error will be raised at run time?", AH); + Error_Msg_N ("upper bound out of range??", AH); + Error_Msg_N ("\Constraint_Error will be raised at run time??", AH); -- You need to set AH to BH or else in the case of enumerations -- indexes we will not be able to resolve the aggregate bounds. @@ -1483,14 +1483,14 @@ package body Sem_Aggr is if OK_L and then Val_L > Val_AL then Set_Raises_Constraint_Error (N); - Error_Msg_N ("lower bound of aggregate out of range?", N); - Error_Msg_N ("\Constraint_Error will be raised at run time?", N); + Error_Msg_N ("lower bound of aggregate out of range??", N); + Error_Msg_N ("\Constraint_Error will be raised at run time??", N); end if; if OK_H and then Val_H < Val_AH then Set_Raises_Constraint_Error (N); - Error_Msg_N ("upper bound of aggregate out of range?", N); - Error_Msg_N ("\Constraint_Error will be raised at run time?", N); + Error_Msg_N ("upper bound of aggregate out of range??", N); + Error_Msg_N ("\Constraint_Error will be raised at run time??", N); end if; end Check_Bounds; @@ -1529,8 +1529,8 @@ package body Sem_Aggr is if Range_Len < Len then Set_Raises_Constraint_Error (N); - Error_Msg_N ("too many elements?", N); - Error_Msg_N ("\Constraint_Error will be raised at run time?", N); + Error_Msg_N ("too many elements??", N); + Error_Msg_N ("\Constraint_Error will be raised at run time??", N); end if; end Check_Length; @@ -1877,31 +1877,6 @@ package body Sem_Aggr is return Failure; end if; - if Others_Present - and then Nkind (Parent (N)) /= N_Component_Association - and then No (Expressions (N)) - and then - Nkind (First (Choices (First (Component_Associations (N))))) - = N_Others_Choice - and then Is_Elementary_Type (Component_Typ) - and then False - then - declare - Assoc : constant Node_Id := First (Component_Associations (N)); - begin - Rewrite (Assoc, - Make_Component_Association (Loc, - Choices => - New_List ( - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Index_Typ, Loc), - Attribute_Name => Name_Range)), - Expression => Relocate_Node (Expression (Assoc)))); - return Resolve_Array_Aggregate - (N, Index, Index_Constr, Component_Typ, Others_Allowed); - end; - end if; - -- Protect against cascaded errors if Etype (Index_Typ) = Any_Type then @@ -1980,7 +1955,7 @@ package body Sem_Aggr is elsif Nkind (Choice) = N_Subtype_Indication then Resolve_Discrete_Subtype_Indication (Choice, Index_Base); - -- Does the subtype indication evaluation raise CE ? + -- Does the subtype indication evaluation raise CE? Get_Index_Bounds (Subtype_Mark (Choice), S_Low, S_High); Get_Index_Bounds (Choice, Low, High); @@ -2310,7 +2285,8 @@ package body Sem_Aggr is (Enumeration_Pos (AHi) - Enumeration_Pos (ALo)) then Error_Msg_N - ("missing index value(s) in array aggregate?", N); + ("missing index value(s) in array aggregate??", + N); -- Output missing value(s) at start @@ -2319,11 +2295,11 @@ package body Sem_Aggr is if Chars (ALo) = Chars (Ent) then Error_Msg_Name_1 := Chars (ALo); - Error_Msg_N ("\ %?", N); + Error_Msg_N ("\ %??", N); else Error_Msg_Name_1 := Chars (ALo); Error_Msg_Name_2 := Chars (Ent); - Error_Msg_N ("\ % .. %?", N); + Error_Msg_N ("\ % .. %??", N); end if; end if; @@ -2334,11 +2310,11 @@ package body Sem_Aggr is if Chars (AHi) = Chars (Ent) then Error_Msg_Name_1 := Chars (Ent); - Error_Msg_N ("\ %?", N); + Error_Msg_N ("\ %??", N); else Error_Msg_Name_1 := Chars (Ent); Error_Msg_Name_2 := Chars (AHi); - Error_Msg_N ("\ % .. %?", N); + Error_Msg_N ("\ % .. %??", N); end if; end if; @@ -2356,7 +2332,7 @@ package body Sem_Aggr is not Is_Constrained (First_Subtype (Etype (N))) then Error_Msg_N - ("bounds of aggregate do not match target?", N); + ("bounds of aggregate do not match target??", N); end if; end; end if; @@ -2810,7 +2786,7 @@ package body Sem_Aggr is and then Enclosing_CPP_Parent (Typ) /= A_Type then Error_Msg_NE - ("?must use 'C'P'P constructor for type &", A, + ("??must use 'C'P'P constructor for type &", A, Enclosing_CPP_Parent (Typ)); -- The following call is not needed if the previous warning @@ -4576,9 +4552,9 @@ package body Sem_Aggr is Insert_Action (Compile_Time_Constraint_Error (Expr, - "(Ada 2005) null not allowed in null-excluding component?"), - Make_Raise_Constraint_Error (Sloc (Expr), - Reason => CE_Access_Check_Failed)); + "(Ada 2005) null not allowed in null-excluding component??"), + Make_Raise_Constraint_Error + (Sloc (Expr), Reason => CE_Access_Check_Failed)); -- Set proper type for bogus component (why is this needed???) diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 94cbd9e730a..6247952843e 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -739,7 +739,7 @@ package body Sem_Attr is if Is_CPP_Class (Root_Type (Typ)) then Error_Msg_N - ("?current instance unsupported for derivations of " + ("??current instance unsupported for derivations of " & "'C'P'P types", N); end if; @@ -1015,6 +1015,16 @@ package body Sem_Attr is ("prefix for % attribute must be constrained array", P); end if; + -- The attribute reference freezes the type, and thus the + -- component type, even if the attribute may not depend on the + -- component. Diagnose arrays with incomplete components now. + -- If the prefix is an access to array, this does not freeze + -- the designated type. + + if Nkind (P) /= N_Explicit_Dereference then + Check_Fully_Declared (Component_Type (P_Type), P); + end if; + D := Number_Dimensions (P_Type); else @@ -2019,7 +2029,7 @@ package body Sem_Attr is if not Attribute_83 (Attr_Id) then if Ada_Version = Ada_83 and then Comes_From_Source (N) then Error_Msg_Name_1 := Aname; - Error_Msg_N ("(Ada 83) attribute% is not standard?", N); + Error_Msg_N ("(Ada 83) attribute% is not standard??", N); end if; if Attribute_Impl_Def (Attr_Id) then @@ -2640,7 +2650,7 @@ package body Sem_Attr is and then Warn_On_Redundant_Constructs then Error_Msg_NE -- CODEFIX - ("?redundant attribute, & is its own base type", N, Typ); + ("?r?redundant attribute, & is its own base type", N, Typ); end if; if Nkind (Parent (N)) /= N_Attribute_Reference then @@ -2896,7 +2906,7 @@ package body Sem_Attr is if Warn_On_Obsolescent_Feature then Error_Msg_N ("constrained for private type is an " & - "obsolescent feature (RM J.4)?", N); + "obsolescent feature (RM J.4)?j?", N); end if; -- If we are within an instance, the attribute must be legal @@ -4251,9 +4261,9 @@ package body Sem_Attr is Prag := N; while not Nkind_In (Prag, N_Pragma, - N_Function_Specification, - N_Procedure_Specification, - N_Subprogram_Body) + N_Function_Specification, + N_Procedure_Specification, + N_Subprogram_Body) loop Prag := Parent (Prag); end loop; @@ -4346,7 +4356,7 @@ package body Sem_Attr is and then Is_Constant_Object (Entity (P)) then Error_Msg_N - ("?attribute Old applied to constant has no effect", P); + ("??attribute Old applied to constant has no effect", P); end if; -- The attribute appears within a pre/postcondition, but refers to @@ -4586,11 +4596,26 @@ package body Sem_Attr is -- During pre-analysis, Prag is the enclosing pragma node if any begin - -- Find enclosing scopes, excluding loops + -- Find the proper enclosing scope CS := Current_Scope; - while Ekind (CS) = E_Loop loop - CS := Scope (CS); + while Present (CS) loop + + -- Skip generated loops + + if Ekind (CS) = E_Loop then + CS := Scope (CS); + + -- Skip the special _Parent scope generated to capture references + -- to formals during the process of subprogram inlining. + + elsif Ekind (CS) = E_Function + and then Chars (CS) = Name_uParent + then + CS := Scope (CS); + else + exit; + end if; end loop; PS := Scope (CS); @@ -4603,7 +4628,7 @@ package body Sem_Attr is and then Warn_On_Redundant_Constructs then Error_Msg_N - ("postconditions on inlined functions not enforced?", N); + ("postconditions on inlined functions not enforced?r?", N); end if; -- If we are in the scope of a function and in Spec_Expression mode, @@ -5032,10 +5057,10 @@ package body Sem_Attr is Name_Simple_Storage_Pool_Type)) then Error_Msg_Name_1 := Aname; - Error_Msg_N ("cannot use % attribute for type with simple " & - "storage pool?", N); + Error_Msg_N ("cannot use % attribute for type with simple " + & "storage pool??", N); Error_Msg_N - ("\Program_Error will be raised at run time?", N); + ("\Program_Error will be raised at run time??", N); Rewrite (N, Make_Raise_Program_Error @@ -5228,8 +5253,8 @@ package body Sem_Attr is if not Is_Tagged_Type (P_Type) then Error_Attr_P ("prefix of % attribute must be tagged"); - -- Next test does not apply to generated code - -- why not, and what does the illegal reference mean??? + -- Next test does not apply to generated code why not, and what does + -- the illegal reference mean??? elsif Is_Object_Reference (P) and then not Is_Class_Wide_Type (P_Type) @@ -5240,9 +5265,9 @@ package body Sem_Attr is "of class - wide type"); end if; - -- The prefix cannot be an incomplete type. However, references - -- to 'Tag can be generated when expanding interface conversions, - -- and this is legal. + -- The prefix cannot be an incomplete type. However, references to + -- 'Tag can be generated when expanding interface conversions, and + -- this is legal. if Comes_From_Source (N) then Check_Not_Incomplete_Type; @@ -5728,8 +5753,8 @@ package body Sem_Attr is begin if Present (Pred_Func) and then Current_Scope = Pred_Func then Error_Msg_N - ("attribute Valid requires a predicate check?", N); - Error_Msg_N ("\and will result in infinite recursion?", N); + ("attribute Valid requires a predicate check??", N); + Error_Msg_N ("\and will result in infinite recursion??", N); end if; end; @@ -5744,7 +5769,7 @@ package body Sem_Attr is Check_Object_Reference (P); if No_Scalar_Parts (P_Type) then - Error_Attr_P ("?attribute % always True, no scalars to check"); + Error_Attr_P ("??attribute % always True, no scalars to check"); end if; Set_Etype (N, Standard_Boolean); @@ -6095,7 +6120,7 @@ package body Sem_Attr is elsif Is_Out_Of_Range (N, T) then Apply_Compile_Time_Constraint_Error - (N, "value not in range of}?", CE_Range_Check_Failed); + (N, "value not in range of}??", CE_Range_Check_Failed); elsif not Range_Checks_Suppressed (T) then Enable_Range_Check (N); @@ -8894,9 +8919,10 @@ package body Sem_Attr is -- know will fail, so generate an appropriate warning. if In_Instance_Body then - Error_Msg_F ("?non-local pointer cannot point to local object", P); Error_Msg_F - ("\?Program_Error will be raised at run time", P); + ("??non-local pointer cannot point to local object", P); + Error_Msg_F + ("\??Program_Error will be raised at run time", P); Rewrite (N, Make_Raise_Program_Error (Loc, Reason => PE_Accessibility_Check_Failed)); @@ -9368,9 +9394,9 @@ package body Sem_Attr is if In_Instance_Body then Error_Msg_F - ("?non-local pointer cannot point to local object", P); + ("??non-local pointer cannot point to local object", P); Error_Msg_F - ("\?Program_Error will be raised at run time", P); + ("\??Program_Error will be raised at run time", P); Rewrite (N, Make_Raise_Program_Error (Loc, Reason => PE_Accessibility_Check_Failed)); @@ -9484,11 +9510,13 @@ package body Sem_Attr is declare D : constant Node_Id := Declaration_Node (Entity (P)); begin - Error_Msg_N ("aliased object has explicit bounds?", - D); - Error_Msg_N ("\declare without bounds" - & " (and with explicit initialization)?", D); - Error_Msg_N ("\for use with unconstrained access?", D); + Error_Msg_N + ("aliased object has explicit bounds??", D); + Error_Msg_N + ("\declare without bounds (and with explicit " + & "initialization)??", D); + Error_Msg_N + ("\for use with unconstrained access??", D); end; end if; end if; diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb index 3dd3b617820..432de5dc367 100644 --- a/gcc/ada/sem_case.adb +++ b/gcc/ada/sem_case.adb @@ -601,8 +601,8 @@ package body Sem_Case is and then Comes_From_Source (Others_Choice) and then Is_Empty_List (Choice_List) then - Error_Msg_N ("?OTHERS choice is redundant", Others_Choice); - Error_Msg_N ("\previous choices cover all values", Others_Choice); + Error_Msg_N ("?r?OTHERS choice is redundant", Others_Choice); + Error_Msg_N ("\?r?previous choices cover all values", Others_Choice); end if; end Expand_Others_Choice; diff --git a/gcc/ada/sem_cat.adb b/gcc/ada/sem_cat.adb index 4d8b8ffc5d0..e4615393dd2 100644 --- a/gcc/ada/sem_cat.adb +++ b/gcc/ada/sem_cat.adb @@ -923,6 +923,7 @@ package body Sem_Cat is then -- If the type is private, it must have the Ada 2005 pragma -- Has_Preelaborable_Initialization. + -- The check is omitted within predefined units. This is probably -- obsolete code to fix the Ada 95 weakness in this area ??? @@ -1728,8 +1729,7 @@ package body Sem_Cat is Direct_Designated_Type := Designated_Type (T); Desig_Type := Etype (Direct_Designated_Type); - -- Why is the check below not in - -- Validate_Remote_Access_To_Class_Wide_Type??? + -- Why is this check not in Validate_Remote_Access_To_Class_Wide_Type??? if not Is_Valid_Remote_Object_Type (Desig_Type) then Error_Msg_N @@ -2047,6 +2047,7 @@ package body Sem_Cat is function Is_Primary (N : Node_Id) return Boolean; -- Determine whether node is syntactically a primary in an expression -- This function should probably be somewhere else ??? + -- -- Also it does not do what it says, e.g if N is a binary operator -- whose parent is a binary operator, Is_Primary returns True ??? @@ -2170,7 +2171,7 @@ package body Sem_Cat is if GNAT_Mode then Error_Msg_N - ("?non-static constant in preelaborated unit", N); + ("??non-static constant in preelaborated unit", N); else Flag_Non_Static_Expr ("non-static constant in preelaborated unit", N); diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 19d749931b4..b55d064f7bb 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -556,7 +556,7 @@ package body Sem_Ch10 is Used_In_Spec) then Error_Msg_N -- CODEFIX - ("?redundant with clause in body", Clause); + ("redundant with clause in body??", Clause); end if; Used_In_Body := False; @@ -585,7 +585,7 @@ package body Sem_Ch10 is if Withed then Error_Msg_N -- CODEFIX - ("?redundant with clause", Clause); + ("redundant with clause??", Clause); end if; end; end if; @@ -1793,7 +1793,7 @@ package body Sem_Ch10 is Error_Msg_File_1 := Get_File_Name (Subunit_Name, Subunit => True); Error_Msg_N - ("subunit$$ in file{ not found?!!", N); + ("subunit$$ in file{ not found??!!", N); Subunits_Missing := True; end if; @@ -2513,30 +2513,30 @@ package body Sem_Ch10 is begin if U_Kind = Implementation_Unit then - Error_Msg_F ("& is an internal 'G'N'A'T unit?", Name (N)); + Error_Msg_F ("& is an internal 'G'N'A'T unit?i?", Name (N)); -- Add alternative name if available, otherwise issue a -- general warning message. if Error_Msg_Strlen /= 0 then - Error_Msg_F ("\use ""~"" instead", Name (N)); + Error_Msg_F ("\use ""~"" instead?i?", Name (N)); else Error_Msg_F ("\use of this unit is non-portable " & - "and version-dependent?", Name (N)); + "and version-dependent?i?", Name (N)); end if; elsif U_Kind = Ada_2005_Unit and then Ada_Version < Ada_2005 and then Warn_On_Ada_2005_Compatibility then - Error_Msg_N ("& is an Ada 2005 unit?", Name (N)); + Error_Msg_N ("& is an Ada 2005 unit?i?", Name (N)); elsif U_Kind = Ada_2012_Unit and then Ada_Version < Ada_2012 and then Warn_On_Ada_2012_Compatibility then - Error_Msg_N ("& is an Ada 2012 unit?", Name (N)); + Error_Msg_N ("& is an Ada 2012 unit?i?", Name (N)); end if; end; end if; @@ -3342,7 +3342,7 @@ package body Sem_Ch10 is procedure License_Error is begin Error_Msg_N - ("?license of withed unit & may be inconsistent", + ("license of withed unit & may be inconsistent??", Name (Item)); end License_Error; @@ -4129,7 +4129,7 @@ package body Sem_Ch10 is then Error_Msg_NE ("child unit& hides compilation unit " & - "with the same name?", + "with the same name??", Name (Item), Id); exit; end if; diff --git a/gcc/ada/sem_ch11.adb b/gcc/ada/sem_ch11.adb index d3d8528c872..e3635c66e17 100644 --- a/gcc/ada/sem_ch11.adb +++ b/gcc/ada/sem_ch11.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -266,7 +266,7 @@ package body Sem_Ch11 is and then Scope (Entity (Id)) = Current_Scope then Error_Msg_NE - ("?exception & is never raised", Entity (Id), Id); + ("exception & is never raised?r?", Entity (Id), Id); end if; if Present (Renamed_Entity (Entity (Id))) then @@ -276,9 +276,9 @@ package body Sem_Ch11 is if Warn_On_Obsolescent_Feature then Error_Msg_N ("Numeric_Error is an " & - "obsolescent feature (RM J.6(1))?", Id); + "obsolescent feature (RM J.6(1))?j?", Id); Error_Msg_N - ("\use Constraint_Error instead?", Id); + ("\use Constraint_Error instead?j?", Id); end if; end if; end if; @@ -345,7 +345,7 @@ package body Sem_Ch11 is N_Others_Choice) then Error_Msg_N - ("useless handler contains only a reraise statement?", + ("useless handler contains only a reraise statement?r?", Handler); end if; @@ -445,8 +445,7 @@ package body Sem_Ch11 is end if; -- Check for useless assignment to OUT or IN OUT scalar preceding the - -- raise. Right now we only look at assignment statements, we could do - -- more. + -- raise. Right now only look at assignment statements, could do more??? if Is_List_Member (N) then declare @@ -496,11 +495,11 @@ package body Sem_Ch11 is if No (Exception_Handlers (Par)) then Error_Msg_N - ("?assignment to pass-by-copy formal " & - "may have no effect", P); + ("assignment to pass-by-copy formal " & + "may have no effect??", P); Error_Msg_N - ("\?RAISE statement may result in abnormal return" & - " (RM 6.4.1(17))", P); + ("\RAISE statement may result in abnormal return" & + " (RM 6.4.1(17))??", P); end if; end if; end if; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 60edce32f2d..ee883327054 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -1448,10 +1448,15 @@ package body Sem_Ch12 is -- defined aspect/pragma Remote_Access_Type. In that case -- the actual must be remote as well. + -- If the current instantiation is the construction of a + -- local copy for a formal package the actuals may be + -- defaulted, and there is no matching actual to check. + if Nkind (Analyzed_Formal) = N_Formal_Type_Declaration and then Nkind (Formal_Type_Definition (Analyzed_Formal)) = N_Access_To_Object_Definition + and then Present (Match) then declare Formal_Ent : constant Entity_Id := @@ -4924,6 +4929,17 @@ package body Sem_Ch12 is Assoc := Associated_Node (Assoc); end if; + -- An additional special case: an unconstrained type in an object + -- declaration may have been rewritten as a local subtype constrained + -- by the expression in the declaration. We need to recover the + -- original entity which may be global. + + if Present (Original_Node (Assoc)) + and then Nkind (Parent (N)) = N_Object_Declaration + then + Assoc := Original_Node (Assoc); + end if; + return Assoc; end if; end Get_Associated_Node; @@ -10475,8 +10491,7 @@ package body Sem_Ch12 is -- This is a binding interpretation that applies to previous versions -- of the language, but for now we retain the milder check in order - -- to preserve ACATS tests. - -- These will be protested eventually ??? + -- to preserve ACATS tests. These will be protested eventually ??? if Ada_Version < Ada_2012 then Check_Mode_Conformant @@ -12139,8 +12154,8 @@ package body Sem_Ch12 is E1 := First_Entity (Form); E2 := First_Entity (Act); while Present (E1) and then E1 /= First_Private_Entity (Form) loop - -- Could this test be a single condition??? - -- Seems like it could, and isn't FPE (Form) a constant anyway??? + -- Could this test be a single condition??? Seems like it could, and + -- isn't FPE (Form) a constant anyway??? if not Is_Internal (E1) and then Present (Parent (E1)) @@ -12406,7 +12421,7 @@ package body Sem_Ch12 is -- provide additional warning which might explain the error. Set_Is_Immediately_Visible (Cur, Vis); - Error_Msg_NE ("& hides outer unit with the same name?", + Error_Msg_NE ("& hides outer unit with the same name??", N, Defining_Unit_Name (N)); end if; @@ -12981,7 +12996,36 @@ package body Sem_Ch12 is end if; if Is_Global (E) then - Set_Global_Type (N, N2); + + -- If the entity is a package renaming that is the prefix of + -- an expanded name, it has been rewritten as the renamed + -- package, which is necessary semantically but complicates + -- ASIS tree traversal, so we recover the original entity to + -- expose the renaming. Take into account that the context may + -- be a nested generic and that the original node may itself + -- have an associated node. + + if Ekind (E) = E_Package + and then Nkind (Parent (N)) = N_Expanded_Name + and then Present (Original_Node (N2)) + and then Present (Entity (Original_Node (N2))) + and then Is_Entity_Name (Entity (Original_Node (N2))) + then + if Is_Global (Entity (Original_Node (N2))) then + N2 := Original_Node (N2); + Set_Associated_Node (N, N2); + Set_Global_Type (N, N2); + + else + -- Renaming is local, and will be resolved in instance + + Set_Associated_Node (N, Empty); + Set_Etype (N, Empty); + end if; + + else + Set_Global_Type (N, N2); + end if; elsif Nkind (N) = N_Op_Concat and then Is_Generic_Type (Etype (N2)) diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index eee75d52a1e..37e521cb099 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -279,16 +279,16 @@ package body Sem_Ch13 is then Error_Msg_N ("multi-byte field specified with non-standard" - & " Bit_Order?", CLC); + & " Bit_Order??", CLC); if Bytes_Big_Endian then Error_Msg_N ("bytes are not reversed " - & "(component is big-endian)?", CLC); + & "(component is big-endian)??", CLC); else Error_Msg_N ("bytes are not reversed " - & "(component is little-endian)?", CLC); + & "(component is little-endian)??", CLC); end if; -- Do not allow non-contiguous field @@ -314,14 +314,14 @@ package body Sem_Ch13 is and then Warn_On_Reverse_Bit_Order then Error_Msg_N - ("?Bit_Order clause does not affect " & - "byte ordering", Pos); + ("Bit_Order clause does not affect " & + "byte ordering?V?", Pos); Error_Msg_Uint_1 := Intval (Pos) + Intval (FB) / System_Storage_Unit; Error_Msg_N - ("?position normalized to ^ before bit " & - "order interpreted", Pos); + ("position normalized to ^ before bit " & + "order interpreted?V?", Pos); end if; -- Here is where we fix up the Component_Bit_Offset value @@ -390,10 +390,8 @@ package body Sem_Ch13 is if Present (CC) then declare - Fbit : constant Uint := - Static_Integer (First_Bit (CC)); - Lbit : constant Uint := - Static_Integer (Last_Bit (CC)); + Fbit : constant Uint := Static_Integer (First_Bit (CC)); + Lbit : constant Uint := Static_Integer (Last_Bit (CC)); begin -- Case of component with last bit >= max machine scalar @@ -410,16 +408,16 @@ package body Sem_Ch13 is if Warn_On_Reverse_Bit_Order then Error_Msg_N ("multi-byte field specified with " - & " non-standard Bit_Order?", CC); + & " non-standard Bit_Order?V?", CC); if Bytes_Big_Endian then Error_Msg_N ("\bytes are not reversed " - & "(component is big-endian)?", CC); + & "(component is big-endian)?V?", CC); else Error_Msg_N ("\bytes are not reversed " - & "(component is little-endian)?", CC); + & "(component is little-endian)?V?", CC); end if; end if; @@ -633,19 +631,19 @@ package body Sem_Ch13 is Error_Msg_Uint_1 := MSS; Error_Msg_N ("info: reverse bit order in machine " & - "scalar of length^?", First_Bit (CC)); + "scalar of length^?V?", First_Bit (CC)); Error_Msg_Uint_1 := NFB; Error_Msg_Uint_2 := NLB; if Bytes_Big_Endian then Error_Msg_NE - ("?\info: big-endian range for " - & "component & is ^ .. ^", + ("\info: big-endian range for " + & "component & is ^ .. ^?V?", First_Bit (CC), Comp); else Error_Msg_NE - ("?\info: little-endian range " - & "for component & is ^ .. ^", + ("\info: little-endian range " + & "for component & is ^ .. ^?V?", First_Bit (CC), Comp); end if; end if; @@ -1602,10 +1600,33 @@ package body Sem_Ch13 is -- with delay of visibility for the expression analysis. -- If the entity is a library-level subprogram, the pre/ - -- postconditions must be treated as late pragmas. + -- postconditions must be treated as late pragmas. Note + -- that they must be prepended, not appended, to the list, + -- so that split AND THEN sections are processed in the + -- correct order. if Nkind (Parent (N)) = N_Compilation_Unit then - Add_Global_Declaration (Aitem); + declare + Aux : constant Node_Id := Aux_Decls_Node (Parent (N)); + + begin + if No (Pragmas_After (Aux)) then + Set_Pragmas_After (Aux, New_List); + end if; + + Prepend (Aitem, Pragmas_After (Aux)); + end; + + -- If it is a subprogram body, add pragmas to list of + -- declarations in body. + + elsif Nkind (N) = N_Subprogram_Body then + if No (Declarations (N)) then + Set_Declarations (N, New_List); + end if; + + Append (Aitem, Declarations (N)); + else Insert_After (N, Aitem); end if; @@ -1875,7 +1896,7 @@ package body Sem_Ch13 is -- In the context of a compilation unit, we directly put the -- pragma in the Pragmas_After list of the - -- N_Compilation_Unit_Aux node (No delay is required here) + -- N_Compilation_Unit_Aux node (no delay is required here) -- except for aspects on a subprogram body (see below). if Nkind (Parent (N)) = N_Compilation_Unit @@ -1919,7 +1940,7 @@ package body Sem_Ch13 is else if No (Pragmas_After (Aux)) then - Set_Pragmas_After (Aux, Empty_List); + Set_Pragmas_After (Aux, New_List); end if; Append (Aitem, Pragmas_After (Aux)); @@ -1992,17 +2013,17 @@ package body Sem_Ch13 is if Warn_On_Obsolescent_Feature then Error_Msg_N - ("at clause is an obsolescent feature (RM J.7(2))?", N); + ("?j?at clause is an obsolescent feature (RM J.7(2))", N); Error_Msg_N - ("\use address attribute definition clause instead?", N); + ("\?j?use address attribute definition clause instead", N); end if; -- Rewrite as address clause Rewrite (N, Make_Attribute_Definition_Clause (Sloc (N), - Name => Identifier (N), - Chars => Name_Address, + Name => Identifier (N), + Chars => Name_Address, Expression => Expression (N))); -- We preserve Comes_From_Source, since logically the clause still comes @@ -2736,9 +2757,9 @@ package body Sem_Ch13 is and then Comes_From_Source (Scope (U_Ent)) then Error_Msg_N - ("?entry address declared for entry in task type", N); + ("??entry address declared for entry in task type", N); Error_Msg_N - ("\?only one task can be declared of this type", N); + ("\??only one task can be declared of this type", N); end if; -- Entry address clauses are obsolescent @@ -2747,10 +2768,10 @@ package body Sem_Ch13 is if Warn_On_Obsolescent_Feature then Error_Msg_N - ("attaching interrupt to task entry is an " & - "obsolescent feature (RM J.7.1)?", N); + ("?j?attaching interrupt to task entry is an " & + "obsolescent feature (RM J.7.1)", N); Error_Msg_N - ("\use interrupt procedure instead?", N); + ("\?j?use interrupt procedure instead", N); end if; -- Case of an address clause for a controlled object which we @@ -2760,9 +2781,9 @@ package body Sem_Ch13 is or else Has_Controlled_Component (Etype (U_Ent)) then Error_Msg_NE - ("?controlled object& must not be overlaid", Nam, U_Ent); + ("??controlled object& must not be overlaid", Nam, U_Ent); Error_Msg_N - ("\?Program_Error will be raised at run time", Nam); + ("\??Program_Error will be raised at run time", Nam); Insert_Action (Declaration_Node (U_Ent), Make_Raise_Program_Error (Loc, Reason => PE_Overlaid_Controlled_Object)); @@ -2799,9 +2820,9 @@ package body Sem_Ch13 is or else Is_Controlled (Etype (O_Ent))) then Error_Msg_N - ("?cannot overlay with controlled object", Expr); + ("??cannot overlay with controlled object", Expr); Error_Msg_N - ("\?Program_Error will be raised at run time", Expr); + ("\??Program_Error will be raised at run time", Expr); Insert_Action (Declaration_Node (U_Ent), Make_Raise_Program_Error (Loc, Reason => PE_Overlaid_Controlled_Object)); @@ -2811,7 +2832,7 @@ package body Sem_Ch13 is and then Ekind (U_Ent) = E_Constant and then not Is_Constant_Object (O_Ent) then - Error_Msg_N ("constant overlays a variable?", Expr); + Error_Msg_N ("??constant overlays a variable", Expr); -- Imported variables can have an address clause, but then -- the import is pretty meaningless except to suppress @@ -2982,7 +3003,7 @@ package body Sem_Ch13 is if Is_Tagged_Type (U_Ent) and then Align > Max_Align then Error_Msg_N - ("?alignment for & set to Maximum_Aligment", Nam); + ("alignment for & set to Maximum_Aligment??", Nam); Set_Alignment (U_Ent, Max_Align); -- All other cases @@ -3110,7 +3131,7 @@ package body Sem_Ch13 is if not GNAT_Mode then Error_Msg_N - ("?component size ignored in this configuration", N); + ("component size ignored in this configuration??", N); end if; end if; @@ -3121,8 +3142,7 @@ package body Sem_Ch13 is and then RM_Size (Ctyp) /= Csize then Error_Msg_NE - ("?component size overrides size clause for&", - N, Ctyp); + ("component size overrides size clause for&?S?", N, Ctyp); end if; Set_Has_Component_Size_Clause (Btype, True); @@ -3278,11 +3298,12 @@ package body Sem_Ch13 is if not Is_Library_Level_Entity (U_Ent) then Error_Msg_NE - ("?non-unique external tag supplied for &", N, U_Ent); + ("??non-unique external tag supplied for &", N, U_Ent); Error_Msg_N - ("?\same external tag applies to all subprogram calls", N); + ("\??same external tag applies to all " + & "subprogram calls", N); Error_Msg_N - ("?\corresponding internal tag cannot be obtained", N); + ("\??corresponding internal tag cannot be obtained", N); end if; end if; end External_Tag; @@ -3563,7 +3584,7 @@ package body Sem_Ch13 is -- case this is useless. Error_Msg_N - ("?size clauses are ignored in this configuration", N); + ("size clauses are ignored in this configuration??", N); end if; if Is_Type (U_Ent) then @@ -3852,9 +3873,9 @@ package body Sem_Ch13 is if Warn_On_Obsolescent_Feature then Error_Msg_N - ("storage size clause for task is an " & - "obsolescent feature (RM J.9)?", N); - Error_Msg_N ("\use Storage_Size pragma instead?", N); + ("?j?storage size clause for task is an " & + "obsolescent feature (RM J.9)", N); + Error_Msg_N ("\?j?use Storage_Size pragma instead", N); end if; FOnly := True; @@ -4487,7 +4508,7 @@ package body Sem_Ch13 is if First_Entity (E) /= Last_Entity (E) then Error_Msg_N - ("?'C'P'P type must import at least one primitive from C++", + ("'C'P'P type must import at least one primitive from C++??", E); end if; end if; @@ -4514,15 +4535,15 @@ package body Sem_Ch13 is or else Convention (Prim) /= Convention_CPP then Error_Msg_N - ("?primitives of 'C'P'P types must be imported from C++" - & " or abstract", Prim); + ("primitives of 'C'P'P types must be imported from C++ " + & "or abstract??", Prim); elsif not Has_Constructors and then not Error_Reported then Error_Msg_Name_1 := Chars (E); Error_Msg_N - ("?'C'P'P constructor required for type %", Prim); + ("??'C'P'P constructor required for type %", Prim); Error_Reported := True; end if; end if; @@ -4698,9 +4719,9 @@ package body Sem_Ch13 is if Warn_On_Obsolescent_Feature then Error_Msg_N - ("mod clause is an obsolescent feature (RM J.8)?", N); + ("?j?mod clause is an obsolescent feature (RM J.8)", N); Error_Msg_N - ("\use alignment attribute definition clause instead?", N); + ("\?j?use alignment attribute definition clause instead", N); end if; if Present (P) then @@ -4887,7 +4908,7 @@ package body Sem_Ch13 is & "with representation of ancestor", CC); elsif Warn_On_Redundant_Constructs then Error_Msg_N - ("?redundant component clause " + ("?r?redundant component clause " & "for inherited component!", CC); end if; end; @@ -4927,7 +4948,7 @@ package body Sem_Ch13 is and then RM_Size (Etype (Comp)) /= Esize (Comp) then Error_Msg_NE - ("?component size overrides size clause for&", + ("?S?component size overrides size clause for&", Component_Name (CC), Etype (Comp)); end if; @@ -4993,7 +5014,7 @@ package body Sem_Ch13 is Next_Component_Or_Discriminant (Comp); end loop; - -- If no Complete_Representation pragma, warn if missing components + -- Give missing components warning if required elsif Warn_On_Unrepped_Components then declare @@ -5037,7 +5058,7 @@ package body Sem_Ch13 is then Error_Msg_Sloc := Sloc (Comp); Error_Msg_NE - ("?no component clause given for & declared #", + ("?C?no component clause given for & declared #", N, Comp); end if; @@ -5066,9 +5087,7 @@ package body Sem_Ch13 is -- Check for duplicate definiations. - if Has_Invariants (Typ) - and then Present (Invariant_Procedure (Typ)) - then + if Has_Invariants (Typ) and then Present (Invariant_Procedure (Typ)) then return Empty; end if; @@ -5229,8 +5248,7 @@ package body Sem_Ch13 is Exp := New_Copy_Tree (Arg2); - -- Preserve sloc of original pragma Invariant (this is required - -- by Par_SCO). + -- Preserve sloc of original pragma Invariant Loc := Sloc (Ritem); @@ -5321,7 +5339,7 @@ package body Sem_Ch13 is if Inherit and Opt.List_Inherited_Aspects then Error_Msg_Sloc := Sloc (Ritem); Error_Msg_N - ("?info: & inherits `Invariant''Class` aspect from #", + ("?L?info: & inherits `Invariant''Class` aspect from #", Typ); end if; end if; @@ -5545,7 +5563,7 @@ package body Sem_Ch13 is then Error_Msg_Sloc := Sloc (Predicate_Function (T)); Error_Msg_Node_2 := T; - Error_Msg_N ("?info: & inherits predicate from & #", Typ); + Error_Msg_N ("info: & inherits predicate from & #?L?", Typ); end if; end if; end Add_Call; @@ -6755,7 +6773,7 @@ package body Sem_Ch13 is ("visibility of aspect for& changes after freeze point", ASN, Ent); Error_Msg_NE - ("?info: & is frozen here, aspects evaluated at this point", + ("info: & is frozen here, aspects evaluated at this point??", Freeze_Node (Ent), Ent); end if; end Check_Aspect_At_End_Of_Declarations; @@ -7932,7 +7950,7 @@ package body Sem_Ch13 is if Error_Msg_Uint_1 > 0 then Error_Msg_NE - ("?^-bit gap before component&", + ("?H?^-bit gap before component&", Component_Name (Component_Clause (CEnt)), CEnt); end if; @@ -8887,7 +8905,7 @@ package body Sem_Ch13 is if Present (Freeze_Node (S)) then Error_Msg_NE - ("?no more representation items for }", Freeze_Node (S), S); + ("??no more representation items for }", Freeze_Node (S), S); end if; return True; @@ -9269,7 +9287,7 @@ package body Sem_Ch13 is if Warn_On_Biased_Representation then Error_Msg_NE - ("?" & Msg & " forces biased representation for&", N, E); + ("?B?" & Msg & " forces biased representation for&", N, E); end if; end if; end Set_Biased; @@ -9378,13 +9396,13 @@ package body Sem_Ch13 is Error_Msg_NE ("?& overlays smaller object", ACCR.N, ACCR.X); Error_Msg_N - ("\?program execution may be erroneous", ACCR.N); + ("\??program execution may be erroneous", ACCR.N); Error_Msg_Uint_1 := X_Size; Error_Msg_NE - ("\?size of & is ^", ACCR.N, ACCR.X); + ("\??size of & is ^", ACCR.N, ACCR.X); Error_Msg_Uint_1 := Y_Size; Error_Msg_NE - ("\?size of & is ^", ACCR.N, ACCR.Y); + ("\??size of & is ^", ACCR.N, ACCR.Y); -- Check for inadequate alignment, both of the base object -- and of the offset, if any. @@ -9405,24 +9423,20 @@ package body Sem_Ch13 is /= Known_Compatible)) then Error_Msg_NE - ("?specified address for& may be inconsistent " - & "with alignment", - ACCR.N, ACCR.X); + ("??specified address for& may be inconsistent " + & "with alignment", ACCR.N, ACCR.X); Error_Msg_N - ("\?program execution may be erroneous (RM 13.3(27))", + ("\??program execution may be erroneous (RM 13.3(27))", ACCR.N); Error_Msg_Uint_1 := X_Alignment; Error_Msg_NE - ("\?alignment of & is ^", - ACCR.N, ACCR.X); + ("\??alignment of & is ^", ACCR.N, ACCR.X); Error_Msg_Uint_1 := Y_Alignment; Error_Msg_NE - ("\?alignment of & is ^", - ACCR.N, ACCR.Y); + ("\??alignment of & is ^", ACCR.N, ACCR.Y); if Y_Alignment >= X_Alignment then Error_Msg_N - ("\?but offset is not multiple of alignment", - ACCR.N); + ("\??but offset is not multiple of alignment", ACCR.N); end if; end if; end if; @@ -9783,7 +9797,8 @@ package body Sem_Ch13 is or else OpenVMS_On_Target then Error_Msg_N - ("?conversion between pointers with different conventions!", N); + ("?z?conversion between pointers with different conventions!", + N); end if; end if; @@ -9809,7 +9824,7 @@ package body Sem_Ch13 is if Source = Calendar_Time or else Target = Calendar_Time then Error_Msg_N - ("?representation of 'Time values may change between " & + ("?z?representation of 'Time values may change between " & "'G'N'A'T versions", N); end if; end; @@ -9831,7 +9846,8 @@ package body Sem_Ch13 is -- known statically, then we need the annotation. if Known_Static_RM_Size (Source) - and then Known_Static_RM_Size (Target) + and then + Known_Static_RM_Size (Target) then null; else @@ -9909,7 +9925,7 @@ package body Sem_Ch13 is if Source_Siz /= Target_Siz then Error_Msg - ("?types for unchecked conversion have different sizes!", + ("?z?types for unchecked conversion have different sizes!", Eloc); if All_Errors_Mode then @@ -9917,7 +9933,7 @@ package body Sem_Ch13 is Error_Msg_Uint_1 := Source_Siz; Error_Msg_Name_2 := Chars (Target); Error_Msg_Uint_2 := Target_Siz; - Error_Msg ("\size of % is ^, size of % is ^?", Eloc); + Error_Msg ("\size of % is ^, size of % is ^?z?", Eloc); Error_Msg_Uint_1 := UI_Abs (Source_Siz - Target_Siz); @@ -9927,44 +9943,41 @@ package body Sem_Ch13 is then if Source_Siz > Target_Siz then Error_Msg - ("\?^ high order bits of source will be ignored!", - Eloc); + ("\?z?^ high order bits of source will " + & "be ignored!", Eloc); elsif Is_Unsigned_Type (Source) then Error_Msg - ("\?source will be extended with ^ high order " & - "zero bits?!", Eloc); + ("\?z?source will be extended with ^ high order " + & "zero bits?!", Eloc); else Error_Msg - ("\?source will be extended with ^ high order " & - "sign bits!", - Eloc); + ("\?z?source will be extended with ^ high order " + & "sign bits!", Eloc); end if; elsif Source_Siz < Target_Siz then if Is_Discrete_Type (Target) then if Bytes_Big_Endian then Error_Msg - ("\?target value will include ^ undefined " & - "low order bits!", - Eloc); + ("\?z?target value will include ^ undefined " + & "low order bits!", Eloc); else Error_Msg - ("\?target value will include ^ undefined " & - "high order bits!", - Eloc); + ("\?z?target value will include ^ undefined " + & "high order bits!", Eloc); end if; else Error_Msg - ("\?^ trailing bits of target value will be " & - "undefined!", Eloc); + ("\?z?^ trailing bits of target value will be " + & "undefined!", Eloc); end if; else pragma Assert (Source_Siz > Target_Siz); Error_Msg - ("\?^ trailing bits of source will be ignored!", + ("\?z?^ trailing bits of source will be ignored!", Eloc); end if; end if; @@ -10017,11 +10030,11 @@ package body Sem_Ch13 is Error_Msg_Node_1 := D_Target; Error_Msg_Node_2 := D_Source; Error_Msg - ("?alignment of & (^) is stricter than " & - "alignment of & (^)!", Eloc); + ("?z?alignment of & (^) is stricter than " + & "alignment of & (^)!", Eloc); Error_Msg - ("\?resulting access value may have invalid " & - "alignment!", Eloc); + ("\?z?resulting access value may have invalid " + & "alignment!", Eloc); end if; end; end if; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 5745746ce00..5764223cd06 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -3643,9 +3643,9 @@ package body Sem_Ch3 is (E, Attribute_Address)) then Error_Msg_N - ("?more than one task with same entry address", N); + ("??more than one task with same entry address", N); Error_Msg_N - ("\?Program_Error will be raised at run time", N); + ("\??Program_Error will be raised at run time", N); Insert_Action (N, Make_Raise_Program_Error (Loc, Reason => PE_Duplicated_Entry_Address)); @@ -5049,10 +5049,45 @@ package body Sem_Ch3 is Decl := Make_Full_Type_Declaration (Loc, Defining_Identifier => Anon, - Type_Definition => Relocate_Node (Spec)); + Type_Definition => Copy_Separate_Tree (Spec)); Mark_Rewrite_Insertion (Decl); + -- In ASIS mode, analyze the profile on the original node, because + -- the separate copy does not provide enough links to recover the + -- original tree. Analysis is limited to type annotations, within + -- a temporary scope that serves as an anonymous subprogram to collect + -- otherwise useless temporaries and itypes. + + if ASIS_Mode then + declare + Typ : constant Entity_Id := Make_Temporary (Loc, 'S'); + + begin + if Nkind (Spec) = N_Access_Function_Definition then + Set_Ekind (Typ, E_Function); + else + Set_Ekind (Typ, E_Procedure); + end if; + + Set_Parent (Typ, N); + Set_Scope (Typ, Current_Scope); + Push_Scope (Typ); + + Process_Formals (Parameter_Specifications (Spec), Spec); + + if Nkind (Spec) = N_Access_Function_Definition then + if Nkind (Result_Definition (Spec)) = N_Access_Definition then + Find_Type (Subtype_Mark (Result_Definition (Spec))); + else + Find_Type (Result_Definition (Spec)); + end if; + end if; + + End_Scope; + end; + end if; + -- Insert the new declaration in the nearest enclosing scope. If the -- node is a body and N is its return type, the declaration belongs in -- the enclosing scope. @@ -10866,7 +10901,7 @@ package body Sem_Ch3 is if Ada_Version < Ada_2005 then Error_Msg_N ("access subtype of general access type would not " & - "be allowed in Ada 2005?", S); + "be allowed in Ada 2005?y?", S); else Error_Msg_N ("access subtype of general access type not allowed", S); @@ -10882,7 +10917,7 @@ package body Sem_Ch3 is if Ada_Version < Ada_2005 then Error_Msg_N ("access subtype would not be allowed in generic body " & - "in Ada 2005?", S); + "in Ada 2005?y?", S); else Error_Msg_N ("access subtype not allowed in generic body", S); @@ -11320,6 +11355,7 @@ package body Sem_Ch3 is -- to one: one new discriminant can constrain several old ones. In -- that case, scan sequentially the stored_constraint, the list of -- discriminants of the parents, and the constraints. + -- Previous code checked for the present of the Stored_Constraint -- list for the derived type, but did not use it at all. Should it -- be present when the component is a discriminated task type? @@ -11780,7 +11816,7 @@ package body Sem_Ch3 is if Warn_On_Obsolescent_Feature then Error_Msg_N ("subtype digits constraint is an " & - "obsolescent feature (RM J.3(8))?", C); + "obsolescent feature (RM J.3(8))?j?", C); end if; D := Digits_Expression (C); @@ -11794,7 +11830,7 @@ package body Sem_Ch3 is if Digits_Value (Def_Id) > Digits_Value (T) then Error_Msg_Uint_1 := Digits_Value (T); - Error_Msg_N ("?digits value is too large, maximum is ^", D); + Error_Msg_N ("??digits value is too large, maximum is ^", D); Rais := Make_Raise_Constraint_Error (Sloc (D), Reason => CE_Range_Check_Failed); @@ -12007,7 +12043,7 @@ package body Sem_Ch3 is if Warn_On_Obsolescent_Feature then Error_Msg_S ("subtype delta constraint is an " & - "obsolescent feature (RM J.3(7))?"); + "obsolescent feature (RM J.3(7))?j?"); end if; D := Delta_Expression (C); @@ -12020,7 +12056,7 @@ package body Sem_Ch3 is -- course there is an ACVC test that checks this! if Delta_Value (Def_Id) < Delta_Value (T) then - Error_Msg_N ("?delta value is too small", D); + Error_Msg_N ("??delta value is too small", D); Rais := Make_Raise_Constraint_Error (Sloc (D), Reason => CE_Range_Check_Failed); @@ -13320,8 +13356,29 @@ package body Sem_Ch3 is -- of the parent subprogram (a requirement of AI-117). Derived -- subprograms of untagged types simply get convention Ada by default. + -- If the derived type is a tagged generic formal type with unknown + -- discriminants, its convention is intrinsic (RM 6.3.1 (8)). + + -- However, if the type is derived from a generic formal, the further + -- inherited subprogram has the convention of the non-generic ancestor. + -- Otherwise there would be no way to override the operation. + -- (This is subject to forthcoming ARG discussions). + if Is_Tagged_Type (Derived_Type) then - Set_Convention (New_Subp, Convention (Parent_Subp)); + if Is_Generic_Type (Derived_Type) + and then Has_Unknown_Discriminants (Derived_Type) + then + Set_Convention (New_Subp, Convention_Intrinsic); + + else + if Is_Generic_Type (Parent_Type) + and then Has_Unknown_Discriminants (Parent_Type) + then + Set_Convention (New_Subp, Convention (Alias (Parent_Subp))); + else + Set_Convention (New_Subp, Convention (Parent_Subp)); + end if; + end if; end if; -- Predefined controlled operations retain their name even if the parent @@ -13333,9 +13390,9 @@ package body Sem_Ch3 is if Is_Controlled (Parent_Type) and then - (Chars (Parent_Subp) = Name_Initialize - or else Chars (Parent_Subp) = Name_Adjust - or else Chars (Parent_Subp) = Name_Finalize) + (Chars (Parent_Subp) = Name_Initialize or else + Chars (Parent_Subp) = Name_Adjust or else + Chars (Parent_Subp) = Name_Finalize) and then Is_Hidden (Parent_Subp) and then not Is_Visibly_Controlled (Parent_Type) then @@ -13377,14 +13434,14 @@ package body Sem_Ch3 is elsif Ada_Version >= Ada_2005 and then (Is_Abstract_Subprogram (Alias (New_Subp)) or else (Is_Tagged_Type (Derived_Type) - and then Etype (New_Subp) = Derived_Type - and then not Is_Null_Extension (Derived_Type)) + and then Etype (New_Subp) = Derived_Type + and then not Is_Null_Extension (Derived_Type)) or else (Is_Tagged_Type (Derived_Type) - and then Ekind (Etype (New_Subp)) = + and then Ekind (Etype (New_Subp)) = E_Anonymous_Access_Type - and then Designated_Type (Etype (New_Subp)) = - Derived_Type - and then not Is_Null_Extension (Derived_Type))) + and then Designated_Type (Etype (New_Subp)) = + Derived_Type + and then not Is_Null_Extension (Derived_Type))) and then No (Actual_Subp) then if not Is_Tagged_Type (Derived_Type) @@ -13509,9 +13566,7 @@ package body Sem_Ch3 is -- an incomplete type whose full-view is derived type E := First_Entity (Scope (Derived_Type)); - while Present (E) - and then E /= Derived_Type - loop + while Present (E) and then E /= Derived_Type loop if Ekind (E) = E_Incomplete_Type and then Present (Full_View (E)) and then Full_View (E) = Derived_Type @@ -13614,7 +13669,7 @@ package body Sem_Ch3 is Alias_Subp : Entity_Id; Act_List : Elist_Id; - Act_Elmt : Elmt_Id := No_Elmt; + Act_Elmt : Elmt_Id; Act_Subp : Entity_Id := Empty; Elmt : Elmt_Id; Need_Search : Boolean := False; @@ -13637,6 +13692,9 @@ package body Sem_Ch3 is if Present (Generic_Actual) then Act_List := Collect_Primitive_Operations (Generic_Actual); Act_Elmt := First_Elmt (Act_List); + else + Act_List := No_Elist; + Act_Elmt := No_Elmt; end if; -- Derive primitives inherited from the parent. Note that if the generic @@ -13648,8 +13706,7 @@ package body Sem_Ch3 is if not Is_Tagged_Type (Derived_Type) or else (not Has_Interfaces (Derived_Type) and then not (Present (Generic_Actual) - and then - Has_Interfaces (Generic_Actual))) + and then Has_Interfaces (Generic_Actual))) then Elmt := First_Elmt (Op_List); while Present (Elmt) loop @@ -13673,9 +13730,10 @@ package body Sem_Ch3 is else pragma Assert (No (Node (Act_Elmt)) or else (Primitive_Names_Match (Subp, Node (Act_Elmt)) - and then - Type_Conformant (Subp, Node (Act_Elmt), - Skip_Controlling_Formals => True))); + and then + Type_Conformant + (Subp, Node (Act_Elmt), + Skip_Controlling_Formals => True))); Derive_Subprogram (New_Subp, Subp, Derived_Type, Parent_Base, Node (Act_Elmt)); @@ -13831,15 +13889,17 @@ package body Sem_Ch3 is pragma Assert (Is_Generic_Unit (Scope (Find_Dispatching_Type (Alias_Subp))) - or else - Instantiation_Depth - (Sloc (Find_Dispatching_Type (Alias_Subp))) > 0); + or else + Instantiation_Depth + (Sloc (Find_Dispatching_Type (Alias_Subp))) > 0); declare Iface_Prim_Loc : constant Source_Ptr := Original_Location (Sloc (Alias_Subp)); - Elmt : Elmt_Id; - Prim : Entity_Id; + + Elmt : Elmt_Id; + Prim : Entity_Id; + begin Elmt := First_Elmt (Primitive_Operations (Generic_Actual)); @@ -13849,8 +13909,8 @@ package body Sem_Ch3 is if Present (Interface_Alias (Prim)) and then Original_Location - (Sloc (Interface_Alias (Prim))) - = Iface_Prim_Loc + (Sloc (Interface_Alias (Prim))) = + Iface_Prim_Loc then Act_Subp := Alias (Prim); exit Search; @@ -14722,9 +14782,7 @@ package body Sem_Ch3 is -- Set Discard_Names if configuration pragma set, or if there is -- a parameterless pragma in the current declarative region - if Global_Discard_Names - or else Discard_Names (Scope (T)) - then + if Global_Discard_Names or else Discard_Names (Scope (T)) then Set_Discard_Names (T); end if; @@ -16775,10 +16833,6 @@ package body Sem_Ch3 is Set_Must_Not_Freeze (I); Set_Must_Not_Freeze (Prefix (I)); - - -- Is order critical??? if so, document why, if not - -- use Analyze_And_Resolve - Analyze_And_Resolve (I); T := Etype (I); R := I; @@ -16906,7 +16960,8 @@ package body Sem_Ch3 is and then Nkind (Right_Opnd (Mod_Expr)) = N_Integer_Literal and then Intval (Right_Opnd (Mod_Expr)) <= Uint_64 then - Error_Msg_N ("suspicious MOD value, was '*'* intended'??", Mod_Expr); + Error_Msg_N + ("suspicious MOD value, was '*'* intended'??M?", Mod_Expr); end if; -- Proceed with analysis of mod expression @@ -17251,7 +17306,7 @@ package body Sem_Ch3 is High_Val := Expr_Value_R (High); if Low_Val > High_Val then - Error_Msg_NE ("?fixed point type& has null range", Def, T); + Error_Msg_NE ("??fixed point type& has null range", Def, T); end if; end; end if; @@ -19119,7 +19174,7 @@ package body Sem_Ch3 is then Make_Class_Wide_Type (Typ); Error_Msg_N - ("incomplete view of tagged type should be declared tagged?", + ("incomplete view of tagged type should be declared tagged??", Parent (Current_Entity (Typ))); end if; return; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 718af47f17c..14e7f93da7c 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -635,8 +635,9 @@ package body Sem_Ch4 is Insert_Action (N, Not_Null_Check); Analyze (Not_Null_Check); - else - Error_Msg_N ("null value not allowed here?", E); + elsif Warn_On_Ada_2012_Compatibility then + Error_Msg_N + ("null value not allowed here in Ada 2012?y?", E); end if; end; end if; @@ -2082,7 +2083,8 @@ package body Sem_Ch4 is -- account a possible implicit dereference. if Is_Access_Type (Array_Type) then - Error_Msg_NW (Warn_On_Dereference, "?implicit dereference", N); + Error_Msg_NW + (Warn_On_Dereference, "?d?implicit dereference", N); Array_Type := Process_Implicit_Dereference_Prefix (Pent, P); end if; @@ -2241,7 +2243,8 @@ package body Sem_Ch4 is if Is_Access_Type (Typ) then Typ := Designated_Type (Typ); - Error_Msg_NW (Warn_On_Dereference, "?implicit dereference", N); + Error_Msg_NW + (Warn_On_Dereference, "?d?implicit dereference", N); end if; if Is_Array_Type (Typ) then @@ -2670,7 +2673,7 @@ package body Sem_Ch4 is and then Intval (Right_Opnd (Parent (N))) <= Uint_64 then Error_Msg_N - ("suspicious MOD value, was '*'* intended'??", Parent (N)); + ("suspicious MOD value, was '*'* intended'??M?", Parent (N)); end if; -- Remaining processing is same as for other arithmetic operators @@ -3235,7 +3238,7 @@ package body Sem_Ch4 is while Present (It.Typ) loop if Is_Access_Type (It.Typ) then T := Designated_Type (It.Typ); - Error_Msg_NW (Warn_On_Dereference, "?implicit dereference", N); + Error_Msg_NW (Warn_On_Dereference, "?d?implicit dereference", N); else T := It.Typ; end if; @@ -3318,7 +3321,7 @@ package body Sem_Ch4 is then Insert_Explicit_Dereference (Nam); Error_Msg_NW - (Warn_On_Dereference, "?implicit dereference", N); + (Warn_On_Dereference, "?d?implicit dereference", N); end if; end if; @@ -3427,13 +3430,13 @@ package body Sem_Ch4 is if All_Present (N) then Error_Msg_N - ("?quantified expression with ALL " + ("??quantified expression with ALL " & "over a null range has value True", N); Rewrite (N, New_Occurrence_Of (Standard_True, Loc)); else Error_Msg_N - ("?quantified expression with SOME " + ("??quantified expression with SOME " & "over a null range has value False", N); Rewrite (N, New_Occurrence_Of (Standard_False, Loc)); end if; @@ -3810,7 +3813,7 @@ package body Sem_Ch4 is -- Normal case of selected component applied to access type else - Error_Msg_NW (Warn_On_Dereference, "?implicit dereference", N); + Error_Msg_NW (Warn_On_Dereference, "?d?implicit dereference", N); if Is_Entity_Name (Name) then Pent := Entity (Name); @@ -3922,7 +3925,7 @@ package body Sem_Ch4 is if Is_Access_Type (Etype (Name)) then Insert_Explicit_Dereference (Name); - Error_Msg_NW (Warn_On_Dereference, "?implicit dereference", N); + Error_Msg_NW (Warn_On_Dereference, "?d?implicit dereference", N); end if; elsif Is_Record_Type (Prefix_Type) then @@ -4220,7 +4223,7 @@ package body Sem_Ch4 is if Is_Access_Type (Etype (Name)) then Insert_Explicit_Dereference (Name); Error_Msg_NW - (Warn_On_Dereference, "?implicit dereference", N); + (Warn_On_Dereference, "?d?implicit dereference", N); end if; end if; @@ -4403,7 +4406,7 @@ package body Sem_Ch4 is Ent => Prefix_Type, Rep => False); else Apply_Compile_Time_Constraint_Error - (N, "component not present in }?", + (N, "component not present in }??", CE_Discriminant_Check_Failed, Ent => Prefix_Type, Rep => False); end if; @@ -4537,7 +4540,8 @@ package body Sem_Ch4 is if Is_Access_Type (Typ) then Typ := Designated_Type (Typ); - Error_Msg_NW (Warn_On_Dereference, "?implicit dereference", N); + Error_Msg_NW + (Warn_On_Dereference, "?d?implicit dereference", N); end if; if Is_Array_Type (Typ) @@ -4574,7 +4578,7 @@ package body Sem_Ch4 is if Is_Access_Type (Array_Type) then Array_Type := Designated_Type (Array_Type); - Error_Msg_NW (Warn_On_Dereference, "?implicit dereference", N); + Error_Msg_NW (Warn_On_Dereference, "?d?implicit dereference", N); end if; if not Is_Array_Type (Array_Type) then diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index a16e01e2be8..04c07bec6d9 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -430,9 +430,9 @@ package body Sem_Ch5 is if Locking_Policy /= 'C' then Error_Msg_N ("assignment to the attribute PRIORITY has " & - "no effect?", Lhs); + "no effect??", Lhs); Error_Msg_N ("\since no Locking_Policy has been " & - "specified", Lhs); + "specified??", Lhs); end if; return; @@ -636,8 +636,9 @@ package body Sem_Ch5 is if Known_Null (Rhs) then Apply_Compile_Time_Constraint_Error - (N => Rhs, - Msg => "(Ada 2005) null not allowed in null-excluding objects?", + (N => Rhs, + Msg => + "(Ada 2005) null not allowed in null-excluding objects??", Reason => CE_Null_Not_Allowed); -- We still mark this as a possible modification, that's necessary @@ -717,10 +718,10 @@ package body Sem_Ch5 is then if Nkind (Lhs) in N_Has_Entity then Error_Msg_NE -- CODEFIX - ("?useless assignment of & to itself!", N, Entity (Lhs)); + ("?r?useless assignment of & to itself!", N, Entity (Lhs)); else Error_Msg_N -- CODEFIX - ("?useless assignment of object to itself!", N); + ("?r?useless assignment of object to itself!", N); end if; end if; @@ -2405,7 +2406,7 @@ package body Sem_Ch5 is (L, H, Assume_Valid => False) = GT then Error_Msg_N - ("?loop range is null, loop will not execute", DS); + ("??loop range is null, loop will not execute", DS); -- Since we know the range of the loop is null, set the -- appropriate flag to remove the loop entirely during @@ -2420,9 +2421,11 @@ package body Sem_Ch5 is else Error_Msg_N - ("?loop range may be null, loop may not execute", DS); + ("??loop range may be null, loop may not execute", + DS); Error_Msg_N - ("?can only execute if invalid values are present", DS); + ("??can only execute if invalid values are present", + DS); end if; end if; @@ -2449,8 +2452,8 @@ package body Sem_Ch5 is (Intval (Original_Node (H)) = Uint_0 or else Intval (Original_Node (H)) = Uint_1) then - Error_Msg_N ("?loop range may be null", DS); - Error_Msg_N ("\?bounds may be wrong way round", DS); + Error_Msg_N ("??loop range may be null", DS); + Error_Msg_N ("\??bounds may be wrong way round", DS); end if; end; end if; @@ -2666,7 +2669,7 @@ package body Sem_Ch5 is then Error_Msg_Sloc := Sloc (ODSD); Error_Msg_N - ("inner range same as outer range#?", DSD); + ("inner range same as outer range#??", DSD); end if; end; end if; @@ -2918,7 +2921,7 @@ package body Sem_Ch5 is Check_SPARK_Restriction ("unreachable code is not allowed", Error_Node); else - Error_Msg ("?unreachable code!", Sloc (Error_Node)); + Error_Msg ("??unreachable code!", Sloc (Error_Node)); end if; end if; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 2903e896e5e..eae2df3c000 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -261,7 +261,7 @@ package body Sem_Ch6 is or else Scop /= Scope (Etype (First_Formal (Designator)))) then Error_Msg_N - ("?abstract subprogram is not dispatching or overriding", N); + ("abstract subprogram is not dispatching or overriding?r?", N); end if; Generate_Reference_To_Formals (Designator); @@ -579,16 +579,16 @@ package body Sem_Ch6 is if Inside_A_Generic then Error_Msg_N ("return of limited object not permitted in Ada 2005 " - & "(RM-2005 6.5(5.5/2))?", Expr); + & "(RM-2005 6.5(5.5/2))?y?", Expr); elsif Is_Immutably_Limited_Type (R_Type) then Error_Msg_N ("return by reference not permitted in Ada 2005 " - & "(RM-2005 6.5(5.5/2))?", Expr); + & "(RM-2005 6.5(5.5/2))?y?", Expr); else Error_Msg_N ("cannot copy object of a limited type in Ada 2005 " - & "(RM-2005 6.5(5.5/2))?", Expr); + & "(RM-2005 6.5(5.5/2))?y?", Expr); end if; -- Ada 95 mode, compatibility warnings disabled @@ -847,7 +847,12 @@ package body Sem_Ch6 is if Has_Aliased then if Ada_Version < Ada_2012 then - Error_Msg_N ("aliased only allowed for limited" + + -- Shouldn't this test Warn_On_Ada_2012_Compatibility ??? + -- Can it really happen (extended return???) + + Error_Msg_N + ("aliased only allowed for limited" & " return objects in Ada 2012?", N); elsif not Is_Immutably_Limited_Type (R_Type) then @@ -937,7 +942,6 @@ package body Sem_Ch6 is and then Object_Access_Level (Expr) > Subprogram_Access_Level (Scope_Id) then - -- Suppress the message in a generic, where the rewriting -- is irrelevant. @@ -951,9 +955,9 @@ package body Sem_Ch6 is Analyze (N); Error_Msg_N - ("cannot return a local value by reference?", N); + ("cannot return a local value by reference??", N); Error_Msg_NE - ("\& will be raised at run time?", + ("\& will be raised at run time??", N, Standard_Program_Error); end if; end if; @@ -965,7 +969,7 @@ package body Sem_Ch6 is Apply_Compile_Time_Constraint_Error (N => Expr, Msg => "(Ada 2005) null not allowed for " - & "null-excluding return?", + & "null-excluding return??", Reason => CE_Null_Not_Allowed); end if; @@ -3784,6 +3788,7 @@ package body Sem_Ch6 is if Has_Excluded_Statement (Then_Statements (E)) then return True; end if; + Next (E); end loop; end if; @@ -3971,7 +3976,7 @@ package body Sem_Ch6 is then Cannot_Inline ("cannot inline & (call returns unconstrained type)?", - N, Subp); + N, Subp); return Abandon; else return OK; @@ -4168,7 +4173,7 @@ package body Sem_Ch6 is Error_Msg_NE (Msg (Msg'First .. Msg'Last - 1), N, Subp); elsif Ineffective_Inline_Warnings then - Error_Msg_NE (Msg, N, Subp); + Error_Msg_NE (Msg & "p?", N, Subp); end if; return; @@ -4207,7 +4212,7 @@ package body Sem_Ch6 is (Unit_File_Name (Get_Source_Unit (Gen_P))) then Set_Is_Inlined (Subp, False); - Error_Msg_NE (Msg, N, Subp); + Error_Msg_NE (Msg & "p?", N, Subp); return; end if; end; @@ -4225,7 +4230,7 @@ package body Sem_Ch6 is -- For backward compatibility we still report a warning. if Ineffective_Inline_Warnings then - Error_Msg_NE (Msg, N, Subp); + Error_Msg_NE (Msg & "p?", N, Subp); end if; end if; @@ -6912,10 +6917,10 @@ package body Sem_Ch6 is if Mode = 'F' then if not Raise_Exception_Call then Error_Msg_N - ("?RETURN statement missing following this statement!", + ("RETURN statement missing following this statement??!", Last_Stm); Error_Msg_N - ("\?Program_Error may be raised at run time!", + ("\Program_Error may be raised at run time??!", Last_Stm); end if; @@ -6931,11 +6936,11 @@ package body Sem_Ch6 is else if not Raise_Exception_Call then Error_Msg_N - ("?implied return after this statement " & - "will raise Program_Error", + ("implied return after this statement " & + "will raise Program_Error??", Last_Stm); Error_Msg_NE - ("\?procedure & is marked as No_Return!", + ("\procedure & is marked as No_Return??!", Last_Stm, Proc); end if; @@ -7172,7 +7177,7 @@ package body Sem_Ch6 is No_Warning_On_Some_Postcondition := True; else Error_Msg_N - ("?`Ensures` component refers only to pre-state", Prag); + ("`Ensures` component refers only to pre-state??", Prag); end if; end if; @@ -7229,7 +7234,7 @@ package body Sem_Ch6 is No_Warning_On_Some_Postcondition := True; else Error_Msg_N - ("?postcondition refers only to pre-state", Prag); + ("postcondition refers only to pre-state??", Prag); end if; end if; end if; @@ -7283,17 +7288,18 @@ package body Sem_Ch6 is then if Present (Last_Postcondition) then if Present (Last_Contract_Case) then - Error_Msg_N ("?neither function postcondition nor " & - "contract cases do mention result", - Last_Postcondition); + Error_Msg_N + ("neither function postcondition nor " + & "contract cases mention result?T?", Last_Postcondition); else - Error_Msg_N ("?function postcondition does not mention result", - Last_Postcondition); + Error_Msg_N + ("function postcondition does not mention result?T?", + Last_Postcondition); end if; else - Error_Msg_N ("?contract cases do not mention result", - Last_Contract_Case); + Error_Msg_N + ("contract cases do not mention result?T?", Last_Contract_Case); end if; end if; end Check_Subprogram_Contract; @@ -8143,14 +8149,14 @@ package body Sem_Ch6 is then if Scope (E) /= Standard_Standard then Error_Msg_Sloc := Sloc (E); - Error_Msg_N ("declaration of & hides one#?", S); + Error_Msg_N ("declaration of & hides one#?h?", S); elsif Nkind (S) = N_Defining_Operator_Symbol and then Scope (Base_Type (Etype (First_Formal (S)))) /= Scope (S) then Error_Msg_N - ("declaration of & hides predefined operator?", S); + ("declaration of & hides predefined operator?h?", S); end if; end if; end loop; @@ -8199,17 +8205,15 @@ package body Sem_Ch6 is & "before type& is frozen", Eq_Op, Typ); Obj_Decl := Next (Parent (Typ)); - while Present (Obj_Decl) - and then Obj_Decl /= Decl - loop + while Present (Obj_Decl) and then Obj_Decl /= Decl loop if Nkind (Obj_Decl) = N_Object_Declaration and then Etype (Defining_Identifier (Obj_Decl)) = Typ then - Error_Msg_NE ("type& is frozen by declaration?", - Obj_Decl, Typ); + Error_Msg_NE + ("type& is frozen by declaration??", Obj_Decl, Typ); Error_Msg_N ("\an equality operator cannot be declared after this " - & "point (RM 4.5.2 (9.8)) (Ada 2012))?", Obj_Decl); + & "point (RM 4.5.2 (9.8)) (Ada 2012))??", Obj_Decl); exit; end if; @@ -9328,7 +9332,7 @@ package body Sem_Ch6 is Error_Msg_Node_2 := F_Typ; Error_Msg_NE ("private operation& in generic unit does not override " & - "any primitive operation of& (RM 12.3 (18))?", + "any primitive operation of& (RM 12.3 (18))??", New_E, New_E); end if; @@ -9350,24 +9354,24 @@ package body Sem_Ch6 is and then (Is_Subprogram (E) or else Is_Generic_Subprogram (E)) then declare - Inherited : constant Subprogram_List := - Inherited_Subprograms (E); + Inherited : constant Subprogram_List := Inherited_Subprograms (E); P : Node_Id; begin for J in Inherited'Range loop P := Spec_PPC_List (Contract (Inherited (J))); - while Present (P) loop Error_Msg_Sloc := Sloc (P); if Class_Present (P) and then not Split_PPC (P) then if Pragma_Name (P) = Name_Precondition then Error_Msg_N - ("?info: & inherits `Pre''Class` aspect from #", E); + ("info: & inherits `Pre''Class` aspect from #?L?", + E); else Error_Msg_N - ("?info: & inherits `Post''Class` aspect from #", E); + ("info: & inherits `Post''Class` aspect from #?L?", + E); end if; end if; @@ -10659,7 +10663,7 @@ package body Sem_Ch6 is and then No (F1) and then No (F2) then - Error_Msg_NE ("calls to& may be ambiguous?", S, S); + Error_Msg_NE ("calls to& may be ambiguous??", S, S); end if; end; end if; @@ -11094,7 +11098,7 @@ package body Sem_Ch6 is if Convention (Formal_Type) = Convention_Ada_Pass_By_Copy then Error_Msg_N - ("?cannot pass aliased parameter & by copy", Formal); + ("cannot pass aliased parameter & by copy?", Formal); end if; -- Force mechanism if type has Convention Ada_Pass_By_Ref/Copy diff --git a/gcc/ada/sem_ch6.ads b/gcc/ada/sem_ch6.ads index 5d30df76c95..a0df51ef21e 100644 --- a/gcc/ada/sem_ch6.ads +++ b/gcc/ada/sem_ch6.ads @@ -58,26 +58,31 @@ package Sem_Ch6 is Is_Serious : Boolean := False); -- This procedure is called if the node N, an instance of a call to -- subprogram Subp, cannot be inlined. Msg is the message to be issued, - -- and has a ? as the last character. Temporarily the behavior of this - -- routine depends on the value of -gnatd.k: + -- which ends with ? (it does not end with ?p?, this routine takes care of + -- the need to change ? to ?p?). Temporarily the behavior of this routine + -- depends on the value of -gnatd.k: + -- -- * If -gnatd.k is not set (ie. old inlining model) then if Subp has -- a pragma Always_Inlined, then an error message is issued (by -- removing the last character of Msg). If Subp is not Always_Inlined, -- then a warning is issued if the flag Ineffective_Inline_Warnings - -- is set, and if not, the call has no effect. + -- is set, adding ?p to the msg, and if not, the call has no effect. + -- -- * If -gnatd.k is set (ie. new inlining model) then: -- - If Is_Serious is true, then an error is reported (by removing the -- last character of Msg); + -- -- - otherwise: + -- -- * Compiling without optimizations if Subp has a pragma -- Always_Inlined, then an error message is issued; if Subp is -- not Always_Inlined, then a warning is issued if the flag - -- Ineffective_Inline_Warnings is set, and if not, the call - -- has no effect. - -- * Compiling with optimizations then a warning is issued if - -- the flag Ineffective_Inline_Warnings is set; otherwise the - -- call has no effect since inlining may be performed by the - -- backend. + -- Ineffective_Inline_Warnings is set (adding p?), and if not, + -- the call has no effect. + -- + -- * Compiling with optimizations then a warning is issued if the + -- flag Ineffective_Inline_Warnings is set (adding p?); otherwise + -- no effect since inlining may be performed by the backend. procedure Check_Conventions (Typ : Entity_Id); -- Ada 2005 (AI-430): Check that the conventions of all inherited and diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index a25e3283338..b81f57554aa 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -261,7 +261,7 @@ package body Sem_Ch7 is then if Ada_Version = Ada_83 then Error_Msg_N - ("optional package body (not allowed in Ada 95)?", N); + ("optional package body (not allowed in Ada 95)??", N); else Error_Msg_N ("spec of this package does not allow a body", N); end if; @@ -2218,7 +2218,7 @@ package body Sem_Ch7 is Write_Eol; end if; - -- On exit from the package scope, we must preserve the visibility + -- On exit from the package scope, we must preserve the visibility -- established by use clauses in the current scope. Two cases: -- a) If the entity is an operator, it may be a primitive operator of @@ -2252,8 +2252,8 @@ package body Sem_Ch7 is -- of its parent unit. if Is_Child_Unit (Id) then - Set_Is_Potentially_Use_Visible (Id, - Is_Visible_Child_Unit (Id)); + Set_Is_Potentially_Use_Visible + (Id, Is_Visible_Child_Unit (Id)); else Set_Is_Potentially_Use_Visible (Id); end if; @@ -2272,9 +2272,7 @@ package body Sem_Ch7 is -- full view is also removed from visibility: it may be exposed when -- swapping views in an instantiation. - if Is_Type (Id) - and then Present (Full_View (Id)) - then + if Is_Type (Id) and then Present (Full_View (Id)) then Set_Is_Immediately_Visible (Full_View (Id), False); end if; @@ -2328,7 +2326,7 @@ package body Sem_Ch7 is -- OK if object declaration with the No_Initialization flag set and then not (Nkind (Parent (Id)) = N_Object_Declaration - and then No_Initialization (Parent (Id))) + and then No_Initialization (Parent (Id))) then -- If no private declaration is present, we assume the user did -- not intend a deferred constant declaration and the problem @@ -2354,13 +2352,13 @@ package body Sem_Ch7 is else Error_Msg_N - ("missing full declaration for deferred constant (RM 7.4)", - Id); + ("missing full declaration for deferred constant (RM 7.4)", + Id); if Is_Limited_Type (Etype (Id)) then Error_Msg_N ("\if variable intended, remove CONSTANT from declaration", - Parent (Id)); + Parent (Id)); end if; end if; end if; @@ -2396,9 +2394,7 @@ package body Sem_Ch7 is Set_Is_Immediately_Visible (Id, False); - if Is_Private_Base_Type (Id) - and then Present (Full_View (Id)) - then + if Is_Private_Base_Type (Id) and then Present (Full_View (Id)) then Full := Full_View (Id); -- If the partial view is not declared in the visible part of the @@ -2407,8 +2403,8 @@ package body Sem_Ch7 is -- no exchange takes place. if No (Parent (Id)) - or else List_Containing (Parent (Id)) - /= Visible_Declarations (Specification (Decl)) + or else List_Containing (Parent (Id)) /= + Visible_Declarations (Specification (Decl)) then goto Next_Id; end if; @@ -2433,9 +2429,9 @@ package body Sem_Ch7 is Priv_Elmt := First_Elmt (Private_Dependents (Id)); - -- Swap out the subtypes and derived types of Id that were - -- compiled in this scope, or installed previously by - -- Install_Private_Declarations. + -- Swap out the subtypes and derived types of Id that + -- were compiled in this scope, or installed previously + -- by Install_Private_Declarations. -- Before we do the swap, we verify the presence of the Full_View -- field which may be empty due to a swap by a previous call to @@ -2445,7 +2441,6 @@ package body Sem_Ch7 is Priv_Sub := Node (Priv_Elmt); if Present (Full_View (Priv_Sub)) then - if Scope (Priv_Sub) = P or else not In_Open_Scopes (Scope (Priv_Sub)) then @@ -2615,11 +2610,11 @@ package body Sem_Ch7 is -- expander will provide an implicit completion at some point. elsif (Is_Overloadable (E) - and then Ekind (E) /= E_Enumeration_Literal - and then Ekind (E) /= E_Operator - and then not Is_Abstract_Subprogram (E) - and then not Has_Completion (E) - and then Comes_From_Source (Parent (E))) + and then Ekind (E) /= E_Enumeration_Literal + and then Ekind (E) /= E_Operator + and then not Is_Abstract_Subprogram (E) + and then not Has_Completion (E) + and then Comes_From_Source (Parent (E))) or else (Ekind (E) = E_Package @@ -2633,12 +2628,12 @@ package body Sem_Ch7 is and then not Is_Generic_Type (E)) or else - ((Ekind (E) = E_Task_Type or else - Ekind (E) = E_Protected_Type) + (Ekind_In (E, E_Task_Type, E_Protected_Type) and then not Has_Completion (E)) or else - (Ekind (E) = E_Generic_Package and then E /= P + (Ekind (E) = E_Generic_Package + and then E /= P and then not Has_Completion (E) and then Unit_Requires_Body (E)) diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index ae12e466811..4437a16aa6e 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -397,8 +397,10 @@ package body Sem_Ch8 is New_S : Entity_Id; Is_Body : Boolean); -- If the renamed entity in a subprogram renaming is a primitive operation - -- or a class-wide operation in prefix form, save the target object, which - -- must be added to the list of actuals in any subsequent call. + -- or a class-wide operation in prefix form, save the target object, + -- which must be added to the list of actuals in any subsequent call. + -- The renaming operation is intrinsic because the compiler must in + -- fact generate a wrapper for it (6.3.1 (10 1/2)). function Applicable_Use (Pack_Name : Node_Id) return Boolean; -- Common code to Use_One_Package and Set_Use, to determine whether use @@ -1015,13 +1017,13 @@ package body Sem_Ch8 is and then Comes_From_Source (Nam) then Error_Msg_N - ("?renaming function result object is suspicious", Nam); + ("renaming function result object is suspicious?R?", Nam); Error_Msg_NE - ("\?function & will be called only once", Nam, + ("\function & will be called only once?R?", Nam, Entity (Name (Nam))); Error_Msg_N -- CODEFIX - ("\?suggest using an initialized constant object instead", - Nam); + ("\suggest using an initialized constant " + & "object instead?R?", Nam); end if; end case; @@ -1602,6 +1604,10 @@ package body Sem_Ch8 is -- match. The first formal of the renamed entity is skipped because it -- is the target object in any subsequent call. + -------------- + -- Conforms -- + -------------- + function Conforms (Subp : Entity_Id; Ctyp : Conformance_Type) return Boolean @@ -1634,6 +1640,8 @@ package body Sem_Ch8 is return True; end Conforms; + -- Start of processing for Analyze_Renamed_Primitive_Operation + begin if not Is_Overloaded (Selector_Name (Name (N))) then Old_S := Entity (Selector_Name (Name (N))); @@ -1681,6 +1689,14 @@ package body Sem_Ch8 is if not Conforms (Old_S, Mode_Conformant) then Error_Msg_N ("mode conformance error in renaming", N); end if; + + -- Enforce the rule given in (RM 6.3.1 (10.1/2)): a prefixed + -- view of a subprogram is intrinsic, because the compiler has + -- to generate a wrapper for any call to it. If the name in a + -- subprogram renaming is a prefixed view, the entity is thus + -- intrinsic, and 'Access cannot be applied to it. + + Set_Convention (New_S, Convention_Intrinsic); end if; -- Inherit_Renamed_Profile (New_S, Old_S); @@ -1890,7 +1906,7 @@ package body Sem_Ch8 is end loop; New_S := Analyze_Subprogram_Specification (Spec); - Result := Find_Renamed_Entity (N, Name (N), New_S, Is_Actual); + Result := Find_Renamed_Entity (N, Name (N), New_S, Is_Actual); end if; if Result /= Any_Id then @@ -2273,10 +2289,10 @@ package body Sem_Ch8 is and then Hidden /= Old_S then Error_Msg_Sloc := Sloc (Hidden); - Error_Msg_N ("?default subprogram is resolved " & + Error_Msg_N ("default subprogram is resolved " & "in the generic declaration " & - "(RM 12.6(17))", N); - Error_Msg_NE ("\?and will not use & #", N, Hidden); + "(RM 12.6(17))??", N); + Error_Msg_NE ("\and will not use & #??", N, Hidden); end if; end; end if; @@ -2926,7 +2942,7 @@ package body Sem_Ch8 is and then Chars (Old_S) /= Chars (New_S) then Error_Msg_NE - ("?& is being renamed as a different operator", N, Old_S); + ("& is being renamed as a different operator??", N, Old_S); end if; -- Check for renaming of obsolescent subprogram @@ -2949,7 +2965,7 @@ package body Sem_Ch8 is and then Chars (Current_Scope) /= Chars (Old_S) then Error_Msg_N - ("?redundant renaming, entity is directly visible", Name (N)); + ("redundant renaming, entity is directly visible?r?", Name (N)); end if; -- Implementation-defined aspect specifications can appear in a renaming @@ -3203,7 +3219,7 @@ package body Sem_Ch8 is and then Pack = Current_Scope then Error_Msg_NE -- CODEFIX - ("& is already use-visible within itself?", Pack_Name, Pack); + ("& is already use-visible within itself?r?", Pack_Name, Pack); end if; return False; @@ -4728,7 +4744,7 @@ package body Sem_Ch8 is goto Found; -- If there is more than one potentially use-visible entity and at - -- least one of them non-overloadable, we have an error (RM 8.4(11). + -- least one of them non-overloadable, we have an error (RM 8.4(11)). -- Note that E points to the first such entity on the homonym list. -- Special case: if one of the entities is declared in an actual -- package, it was visible in the generic, and takes precedence over @@ -5999,7 +6015,8 @@ package body Sem_Ch8 is then -- Selected component of record. Type checking will validate -- name of selector. - -- ??? could we rewrite an implicit dereference into an explicit + + -- ??? Could we rewrite an implicit dereference into an explicit -- one here? Analyze_Selected_Component (N); @@ -6259,18 +6276,18 @@ package body Sem_Ch8 is Set_Entity (N, Any_Type); return; - -- ??? This test is temporarily disabled (always False) - -- because it causes an unwanted warning on GNAT sources - -- (built with -gnatg, which includes Warn_On_Obsolescent_ - -- Feature). Once this issue is cleared in the sources, it - -- can be enabled. + -- ??? This test is temporarily disabled (always + -- False) because it causes an unwanted warning on + -- GNAT sources (built with -gnatg, which includes + -- Warn_On_Obsolescent_ Feature). Once this issue + -- is cleared in the sources, it can be enabled. elsif Warn_On_Obsolescent_Feature and then False then Error_Msg_N ("applying 'Class to an untagged incomplete type" - & " is an obsolescent feature (RM J.11)", N); + & " is an obsolescent feature (RM J.11)?r?", N); end if; end if; @@ -6363,7 +6380,7 @@ package body Sem_Ch8 is and then Base_Type (Typ) = Typ then Error_Msg_NE -- CODEFIX - ("?redundant attribute, & is its own base type", N, Typ); + ("redundant attribute, & is its own base type?r?", N, Typ); end if; T := Base_Type (Typ); @@ -7232,7 +7249,7 @@ package body Sem_Ch8 is if Present (Redundant) then Error_Msg_Sloc := Sloc (Prev_Use); Error_Msg_NE -- CODEFIX - ("& is already use-visible through previous use clause #?", + ("& is already use-visible through previous use clause #??", Redundant, Pack_Name); end if; end Note_Redundant_Use; @@ -8346,14 +8363,14 @@ package body Sem_Ch8 is Error_Msg_Sloc := Sloc (Current_Use_Clause (T)); Error_Msg_NE -- CODEFIX ("& is already use-visible through previous " - & "use_type_clause #?", Clause1, T); + & "use_type_clause #??", Clause1, T); return; elsif Nkind (Unit1) = N_Subunit then Error_Msg_Sloc := Sloc (Current_Use_Clause (T)); Error_Msg_NE -- CODEFIX ("& is already use-visible through previous " - & "use_type_clause #?", Clause1, T); + & "use_type_clause #??", Clause1, T); return; elsif Nkind_In (Unit2, N_Package_Body, N_Subprogram_Body) @@ -8363,7 +8380,7 @@ package body Sem_Ch8 is Error_Msg_Sloc := Sloc (Clause1); Error_Msg_NE -- CODEFIX ("& is already use-visible through previous " - & "use_type_clause #?", Current_Use_Clause (T), T); + & "use_type_clause #??", Current_Use_Clause (T), T); return; end if; @@ -8415,7 +8432,7 @@ package body Sem_Ch8 is Error_Msg_NE -- CODEFIX ("& is already use-visible through previous " - & "use_type_clause #?", Err_No, Id); + & "use_type_clause #??", Err_No, Id); -- Case where current use type clause and the use type -- clause for the type are not both at the compilation unit @@ -8424,7 +8441,7 @@ package body Sem_Ch8 is else Error_Msg_NE -- CODEFIX ("& is already use-visible through previous " - & "use type clause?", Id, T); + & "use type clause??", Id, T); end if; end Use_Clause_Known; @@ -8434,7 +8451,7 @@ package body Sem_Ch8 is else Error_Msg_NE -- CODEFIX ("& is already use-visible through previous " - & "use type clause?", Id, T); + & "use type clause??", Id, T); end if; -- The package where T is declared is already used @@ -8442,7 +8459,7 @@ package body Sem_Ch8 is elsif In_Use (Scope (T)) then Error_Msg_Sloc := Sloc (Current_Use_Clause (Scope (T))); Error_Msg_NE -- CODEFIX - ("& is already use-visible through package use clause #?", + ("& is already use-visible through package use clause #??", Id, T); -- The current scope is the package where T is declared @@ -8450,7 +8467,7 @@ package body Sem_Ch8 is else Error_Msg_Node_2 := Scope (T); Error_Msg_NE -- CODEFIX - ("& is already use-visible inside package &?", Id, T); + ("& is already use-visible inside package &??", Id, T); end if; end if; end Use_One_Type; diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index 9b38f0072fb..16c011c5ad8 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -1062,9 +1062,9 @@ package body Sem_Ch9 is and then Nkind (First (Else_Statements (N))) in N_Delay_Statement then Error_Msg_N - ("suspicious form of conditional entry call?!", N); + ("suspicious form of conditional entry call??!", N); Error_Msg_N - ("\`SELECT OR` may be intended rather than `SELECT ELSE`!", N); + ("\`SELECT OR` may be intended rather than `SELECT ELSE`??!", N); end if; -- Postpone the analysis of the statements till expansion. Analyze only @@ -1987,11 +1987,11 @@ package body Sem_Ch9 is if Error_Msg_Sloc = No_Location then Error_Msg_N ("objects of this type will violate " & - "`No_Local_Protected_Objects`?", N); + "`No_Local_Protected_Objects`??", N); else Error_Msg_N ("objects of this type will violate " & - "`No_Local_Protected_Objects`?#", N); + "`No_Local_Protected_Objects`#??", N); end if; end if; @@ -2052,15 +2052,15 @@ package body Sem_Ch9 is or else From_Aspect_Specification (Prio_Item) then Error_Msg_Name_1 := Chars (Identifier (Prio_Item)); - Error_Msg_NE ("?aspect% for & has no effect when Lock_Free" & - " given", Prio_Item, Id); + Error_Msg_NE ("aspect% for & has no effect when Lock_Free" & + " given??", Prio_Item, Id); -- Pragma case else Error_Msg_Name_1 := Pragma_Name (Prio_Item); - Error_Msg_NE ("?pragma% for & has no effect when Lock_Free" & - " given", Prio_Item, Id); + Error_Msg_NE ("pragma% for & has no effect when Lock_Free" & + " given??", Prio_Item, Id); end if; end if; end; @@ -2089,16 +2089,16 @@ package body Sem_Ch9 is or else From_Aspect_Specification (Prio_Item)) and then Chars (Identifier (Prio_Item)) = Name_Priority then - Error_Msg_N ("?aspect Interrupt_Priority is preferred " - & "in presence of handlers", Prio_Item); + Error_Msg_N ("aspect Interrupt_Priority is preferred " + & "in presence of handlers??", Prio_Item); -- Pragma case elsif Nkind (Prio_Item) = N_Pragma and then Pragma_Name (Prio_Item) = Name_Priority then - Error_Msg_N ("?pragma Interrupt_Priority is preferred " - & "in presence of handlers", Prio_Item); + Error_Msg_N ("pragma Interrupt_Priority is preferred " + & "in presence of handlers??", Prio_Item); end if; end if; end; @@ -2516,7 +2516,7 @@ package body Sem_Ch9 is if Entity (EDN1) = Ent then Error_Msg_Sloc := Sloc (Stm1); Error_Msg_N - ("?accept duplicates one on line#", Stm); + ("accept duplicates one on line#??", Stm); exit; end if; end if; @@ -2799,7 +2799,7 @@ package body Sem_Ch9 is and then not Entry_Accepted (Ent) and then Comes_From_Source (Ent) then - Error_Msg_NE ("no accept for entry &?", N, Ent); + Error_Msg_NE ("no accept for entry &??", N, Ent); end if; Next_Entity (Ent); @@ -2923,10 +2923,10 @@ package body Sem_Ch9 is if Error_Msg_Sloc = No_Location then Error_Msg_N - ("objects of this type will violate `No_Task_Hierarchy`?", N); + ("objects of this type will violate `No_Task_Hierarchy`??", N); else Error_Msg_N - ("objects of this type will violate `No_Task_Hierarchy`?#", N); + ("objects of this type will violate `No_Task_Hierarchy`#??", N); end if; end if; diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb index 0e46efae949..be14d47ef5c 100644 --- a/gcc/ada/sem_dim.adb +++ b/gcc/ada/sem_dim.adb @@ -2451,7 +2451,7 @@ package body Sem_Dim is Add_String_To_Name_Buffer (Symbol_Of (Typ)); Error_Msg_Name_1 := Name_Find; - Error_Msg_N ("?assumed to be%%", N); + Error_Msg_N ("??assumed to be%%", N); end Dim_Warning_For_Numeric_Literal; ---------------------------------------- diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index 50929365596..2e4186f2652 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -904,10 +904,10 @@ package body Sem_Disp is and then not Is_Generic_Type (Typ) and then not In_Instance then - Error_Msg_N ("?declaration of& is too late!", Subp); + Error_Msg_N ("??declaration of& is too late!", Subp); Error_Msg_NE -- CODEFIX?? - ("\spec should appear immediately after declaration of &!", - Subp, Typ); + ("\??spec should appear immediately after declaration " + & "of & !", Subp, Typ); exit; end if; @@ -933,10 +933,10 @@ package body Sem_Disp is and then not Is_Generic_Type (Typ) and then not In_Instance then - Error_Msg_N ("?declaration of& is too late!", Subp); + Error_Msg_N ("??declaration of& is too late!", Subp); Error_Msg_NE - ("\spec should appear immediately after declaration of &!", - Subp, Typ); + ("\??spec should appear immediately after declaration " + & "of & !", Subp, Typ); end if; end if; end; @@ -1153,7 +1153,7 @@ package body Sem_Disp is and then In_Same_List (Parent (Tagged_Type), Parent (Parent (Subp))) then Error_Msg_N - ("?not dispatching (must be defined in a package spec)", Subp); + ("??not dispatching (must be defined in a package spec)", Subp); return; -- When the type is frozen, it is legitimate to define a new @@ -1169,7 +1169,7 @@ package body Sem_Disp is elsif Is_Frozen (Tagged_Type) and then not Has_Dispatching_Parent then Error_Msg_N ("this primitive operation is declared too late", Subp); Error_Msg_NE - ("?no primitive operations for& after this line", + ("??no primitive operations for& after this line", Freeze_Node (Tagged_Type), Tagged_Type); return; @@ -1220,7 +1220,7 @@ package body Sem_Disp is else Error_Msg_NE - ("operation does not override inherited&?", Subp, Subp); + ("operation does not override inherited&??", Subp, Subp); end if; else diff --git a/gcc/ada/sem_dist.adb b/gcc/ada/sem_dist.adb index 678a6001b1a..f3d3e33ff77 100644 --- a/gcc/ada/sem_dist.adb +++ b/gcc/ada/sem_dist.adb @@ -522,8 +522,9 @@ package body Sem_Dist is Parameter := First (Parameter_Specifications (Type_Def)); while Present (Parameter) loop if Nkind (Parameter_Type (Parameter)) = N_Access_Definition then - Error_Msg_N ("formal parameter& has anonymous access type?", - Defining_Identifier (Parameter)); + Error_Msg_N + ("formal parameter& has anonymous access type??", + Defining_Identifier (Parameter)); Is_Degenerate := True; exit; end if; @@ -533,7 +534,7 @@ package body Sem_Dist is if Is_Degenerate then Error_Msg_NE - ("remote access-to-subprogram type& can only be null?", + ("remote access-to-subprogram type& can only be null??", Defining_Identifier (Parameter), User_Type); -- The only legal value for a RAS with a formal parameter of an diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 6d88c966e1f..125caefbc96 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -908,8 +908,8 @@ package body Sem_Elab is if Inst_Case then Elab_Warning - ("instantiation of& may raise Program_Error?", - "info: instantiation of& during elaboration?", Ent); + ("instantiation of& may raise Program_Error?l?", + "info: instantiation of& during elaboration?l?", Ent); -- Indirect call case, warning only in static elaboration -- case, because the attribute reference itself cannot raise @@ -917,7 +917,7 @@ package body Sem_Elab is elsif Access_Case then Elab_Warning - ("", "info: access to& during elaboration?", Ent); + ("", "info: access to& during elaboration?l?", Ent); -- Subprogram call case @@ -927,14 +927,14 @@ package body Sem_Elab is and then Comes_From_Source (Ent) then Elab_Warning - ("implicit call to & may raise Program_Error?", - "info: implicit call to & during elaboration?", + ("implicit call to & may raise Program_Error?l?", + "info: implicit call to & during elaboration?l?", Ent); else Elab_Warning - ("call to & may raise Program_Error?", - "info: call to & during elaboration?", + ("call to & may raise Program_Error?l?", + "info: call to & during elaboration?l?", Ent); end if; end if; @@ -943,14 +943,14 @@ package body Sem_Elab is if Nkind (N) in N_Subprogram_Instantiation then Elab_Warning - ("\missing pragma Elaborate for&?", - "\info: implicit pragma Elaborate for& generated?", + ("\missing pragma Elaborate for&?l?", + "\info: implicit pragma Elaborate for& generated?l?", W_Scope); else Elab_Warning - ("\missing pragma Elaborate_All for&?", - "\info: implicit pragma Elaborate_All for & generated?", + ("\missing pragma Elaborate_All for&?l?", + "\info: implicit pragma Elaborate_All for & generated?l?", W_Scope); end if; end Generate_Elab_Warnings; @@ -1030,7 +1030,7 @@ package body Sem_Elab is Error_Msg_Node_2 := W_Scope; Error_Msg_NE ("call to& in elaboration code " & - "requires pragma Elaborate_All on&?", N, E); + "requires pragma Elaborate_All on&?l?", N, E); end if; -- Set indication for binder to generate Elaborate_All @@ -1138,13 +1138,13 @@ package body Sem_Elab is -- Here we definitely have a bad instantiation - Error_Msg_NE ("?cannot instantiate& before body seen", N, Ent); + Error_Msg_NE ("??cannot instantiate& before body seen", N, Ent); if Present (Instance_Spec (N)) then Supply_Bodies (Instance_Spec (N)); end if; - Error_Msg_N ("\?Program_Error will be raised at run time", N); + Error_Msg_N ("\??Program_Error will be raised at run time", N); Insert_Elab_Check (N); Set_ABE_Is_Certain (N); end Check_Bad_Instantiation; @@ -1720,13 +1720,13 @@ package body Sem_Elab is Error_Msg_Sloc := Sloc (Ent); Error_Msg_NE - ("?elaboration code may access& before it is initialized", + ("??elaboration code may access& before it is initialized", N, Ent); Error_Msg_NE - ("\?suggest adding pragma Elaborate_Body to spec of &", + ("\??suggest adding pragma Elaborate_Body to spec of &", N, Scop); Error_Msg_N - ("\?or an explicit initialization could be added #", N); + ("\??or an explicit initialization could be added #", N); end if; if not All_Errors_Mode then @@ -2181,12 +2181,12 @@ package body Sem_Elab is if Elab_Call.Last = 0 then if Inst_Case then Error_Msg_NE - ("?cannot instantiate& before body seen", N, Orig_Ent); + ("??cannot instantiate& before body seen", N, Orig_Ent); else - Error_Msg_NE ("?cannot call& before body seen", N, Orig_Ent); + Error_Msg_NE ("??cannot call& before body seen", N, Orig_Ent); end if; - Error_Msg_N ("\?Program_Error will be raised at run time", N); + Error_Msg_N ("\??Program_Error will be raised at run time", N); Insert_Elab_Check (N); -- Call is not at outer level @@ -2255,15 +2255,15 @@ package body Sem_Elab is then if Inst_Case then Error_Msg_NE - ("instantiation of& may occur before body is seen?", + ("instantiation of& may occur before body is seen??", N, Orig_Ent); else Error_Msg_NE - ("call to& may occur before body is seen?", N, Orig_Ent); + ("call to& may occur before body is seen??", N, Orig_Ent); end if; Error_Msg_N - ("\Program_Error may be raised at run time?", N); + ("\Program_Error may be raised at run time??", N); Output_Calls (N); end if; @@ -2359,10 +2359,10 @@ package body Sem_Elab is Scope (Proc) = Scope (Defining_Identifier (Decl))) then Error_Msg_N - ("task will be activated before elaboration of its body?", + ("task will be activated before elaboration of its body??", Decl); Error_Msg_N - ("\Program_Error will be raised at run time?", Decl); + ("\Program_Error will be raised at run time??", Decl); elsif Present (Corresponding_Body (Unit_Declaration_Node (Proc))) @@ -2506,7 +2506,7 @@ package body Sem_Elab is Error_Msg_Node_2 := Task_Scope; Error_Msg_NE ("activation of an instance of task type&" & - " requires pragma Elaborate_All on &?", N, Ent); + " requires pragma Elaborate_All on &?l?", N, Ent); end if; Activate_Elaborate_All_Desirable (N, Task_Scope); @@ -3082,16 +3082,16 @@ package body Sem_Elab is Ent := Elab_Call.Table (J).Ent; if Is_Generic_Unit (Ent) then - Error_Msg_NE ("\?& instantiated #", N, Ent); + Error_Msg_NE ("\??& instantiated #", N, Ent); elsif Is_Init_Proc (Ent) then - Error_Msg_N ("\?initialization procedure called #", N); + Error_Msg_N ("\??initialization procedure called #", N); elsif Is_Printable_Error_Name (Chars (Ent)) then - Error_Msg_NE ("\?& called #", N, Ent); + Error_Msg_NE ("\??& called #", N, Ent); else - Error_Msg_N ("\? called #", N); + Error_Msg_N ("\?? called #", N); end if; end loop; end Output_Calls; diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index a4bb76e309b..ab7f3c934ae 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -293,7 +293,7 @@ package body Sem_Eval is and then Is_Out_Of_Range (N, Base_Type (T), Assume_Valid => True) then Error_Msg_N - ("?float value out of range, infinity will be generated", N); + ("??float value out of range, infinity will be generated", N); end if; return; @@ -369,7 +369,7 @@ package body Sem_Eval is Intval (N) > Expr_Value (Type_High_Bound (Universal_Integer))) then Apply_Compile_Time_Constraint_Error - (N, "non-static universal integer value out of range?", + (N, "non-static universal integer value out of range??", CE_Range_Check_Failed); -- Check out of range of base type @@ -390,7 +390,7 @@ package body Sem_Eval is elsif Is_Out_Of_Range (N, T, Assume_Valid => True) then Apply_Compile_Time_Constraint_Error - (N, "value not in range of}?", CE_Range_Check_Failed); + (N, "value not in range of}??", CE_Range_Check_Failed); elsif Checks_On then Enable_Range_Check (N); @@ -407,14 +407,12 @@ package body Sem_Eval is procedure Check_String_Literal_Length (N : Node_Id; Ttype : Entity_Id) is begin - if not Raises_Constraint_Error (N) - and then Is_Constrained (Ttype) - then + if not Raises_Constraint_Error (N) and then Is_Constrained (Ttype) then if UI_From_Int (String_Length (Strval (N))) /= String_Type_Len (Ttype) then Apply_Compile_Time_Constraint_Error - (N, "string length wrong for}?", + (N, "string length wrong for}??", CE_Length_Check_Failed, Ent => Ttype, Typ => Ttype); @@ -744,13 +742,18 @@ package body Sem_Eval is begin Diff.all := No_Uint; - -- In preanalysis mode, always return Unknown, it is too early to be - -- thinking we know the result of a comparison, save that judgment for - -- the full analysis. This is particularly important in the case of - -- pre and postconditions, which otherwise can be prematurely collapsed - -- into having True or False conditions when this is inappropriate. + -- In preanalysis mode, always return Unknown unless the expression + -- is static. It is too early to be thinking we know the result of a + -- comparison, save that judgment for the full analysis. This is + -- particularly important in the case of pre and postconditions, which + -- otherwise can be prematurely collapsed into having True or False + -- conditions when this is inappropriate. - if not Full_Analysis then + if not (Full_Analysis + or else (Is_Static_Expression (L) + and then + Is_Static_Expression (R))) + then return Unknown; end if; @@ -1650,7 +1653,7 @@ package body Sem_Eval is begin if Result < Lo or else Result > Hi then Apply_Compile_Time_Constraint_Error - (N, "value not in range of }?", + (N, "value not in range of }??", CE_Overflow_Check_Failed, Ent => BT); return; @@ -3253,7 +3256,7 @@ package body Sem_Eval is Left_Int := Expr_Value (Left); if (Kind = N_And_Then and then Is_False (Left_Int)) - or else + or else (Kind = N_Or_Else and then Is_True (Left_Int)) then Fold_Uint (N, Left_Int, Rstat); @@ -3311,10 +3314,10 @@ package body Sem_Eval is = Entity (Drange) then if Warn_On_Redundant_Constructs then - Error_Msg_N ("redundant slice denotes whole array?", N); + Error_Msg_N ("redundant slice denotes whole array?r?", N); end if; - -- The following might be a useful optimization???? + -- The following might be a useful optimization??? -- Rewrite (N, New_Occurrence_Of (E, Sloc (N))); end if; @@ -4651,7 +4654,7 @@ package body Sem_Eval is else Apply_Compile_Time_Constraint_Error - (N, "value not in range of}?", CE_Range_Check_Failed); + (N, "value not in range of}??", CE_Range_Check_Failed); end if; end Out_Of_Range; diff --git a/gcc/ada/sem_intr.adb b/gcc/ada/sem_intr.adb index 93eb4924735..fe3855d33d6 100644 --- a/gcc/ada/sem_intr.adb +++ b/gcc/ada/sem_intr.adb @@ -163,7 +163,7 @@ package body Sem_Intr is and then Can_Never_Be_Null (Etype (Arg1)) then Error_Msg_N - ("freeing `NOT NULL` object will raise Constraint_Error?", N); + ("freeing `NOT NULL` object will raise Constraint_Error??", N); -- For unchecked deallocation, error to deallocate from empty pool. -- Note: this test used to be in Exp_Intr as a warning, but AI 157 diff --git a/gcc/ada/sem_mech.adb b/gcc/ada/sem_mech.adb index 6bd498ef9fc..e2fce979a22 100644 --- a/gcc/ada/sem_mech.adb +++ b/gcc/ada/sem_mech.adb @@ -245,7 +245,7 @@ package body Sem_Mech is if Mech in Descriptor_Codes and then not Is_Formal (Ent) then if Is_Record_Type (Etype (Ent)) then - Error_Msg_N ("?records cannot be returned by Descriptor", Enod); + Error_Msg_N ("??records cannot be returned by Descriptor", Enod); return; end if; end if; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index b44df5ad150..0610128fd7b 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -980,7 +980,7 @@ package body Sem_Prag is procedure Check_Ada_83_Warning is begin if Ada_Version = Ada_83 and then Comes_From_Source (N) then - Error_Msg_N ("(Ada 83) pragma& is non-standard?", N); + Error_Msg_N ("(Ada 83) pragma& is non-standard??", N); end if; end Check_Ada_83_Warning; @@ -1853,7 +1853,7 @@ package body Sem_Prag is then Error_Msg_Name_1 := Pname; Error_Msg_N - ("?pragma% is only effective in main program", N); + ("??pragma% is only effective in main program", N); end if; end Check_In_Main_Program; @@ -2233,7 +2233,7 @@ package body Sem_Prag is (Get_Pragma_Arg (Arg2), Standard_String); end if; - -- For a pragma in the extended main source unit, record enabled + -- For a pragma PPC in the extended main source unit, record enabled -- status in SCO. -- This may seem redundant with the call to Check_Enabled occurring @@ -3551,7 +3551,7 @@ package body Sem_Prag is else if Warn_On_Export_Import and not OpenVMS_On_Target then Error_Msg_N - ("?unrecognized convention name, C assumed", + ("??unrecognized convention name, C assumed", Get_Pragma_Arg (Arg1)); end if; @@ -3860,7 +3860,7 @@ package body Sem_Prag is begin if not OpenVMS_On_Target then Error_Pragma - ("?pragma% ignored (applies only to Open'V'M'S)"); + ("??pragma% ignored (applies only to Open'V'M'S)"); end if; Process_Extended_Import_Export_Internal_Arg (Arg_Internal); @@ -3996,7 +3996,7 @@ package body Sem_Prag is end if; if Warn_On_Export_Import and then Is_Exported (Def_Id) then - Error_Msg_N ("?duplicate Export_Object pragma", N); + Error_Msg_N ("??duplicate Export_Object pragma", N); else Set_Exported (Def_Id, Arg_Internal); end if; @@ -4019,21 +4019,20 @@ package body Sem_Prag is and then Has_Discriminants (Etype (Def_Id)) then Error_Msg_N - ("imported value must be initialized?", Arg_Internal); + ("imported value must be initialized??", Arg_Internal); end if; if Warn_On_Export_Import and then Is_Access_Type (Etype (Def_Id)) then Error_Pragma_Arg - ("cannot import object of an access type?", Arg_Internal); + ("cannot import object of an access type??", Arg_Internal); end if; if Warn_On_Export_Import and then Is_Imported (Def_Id) then - Error_Msg_N - ("?duplicate Import_Object pragma", N); + Error_Msg_N ("??duplicate Import_Object pragma", N); -- Check for explicit initialization present. Note that an -- initialization generated by the code generator, e.g. for an @@ -4957,7 +4956,7 @@ package body Sem_Prag is if Front_End_Inlining and then Analyzed (Corresponding_Body (Decl)) then - Error_Msg_N ("pragma appears too late, ignored?", N); + Error_Msg_N ("pragma appears too late, ignored??", N); return True; -- If the subprogram is a renaming as body, the body is just a @@ -5209,10 +5208,12 @@ package body Sem_Prag is then if Inlining_Not_Possible (Subp) then Error_Msg_NE - ("pragma Inline for& is ignored?", N, Entity (Subp_Id)); + ("pragma Inline for& is ignored?r?", + N, Entity (Subp_Id)); else Error_Msg_NE - ("pragma Inline for& is redundant?", N, Entity (Subp_Id)); + ("pragma Inline for& is redundant?r?", + N, Entity (Subp_Id)); end if; end if; @@ -5284,7 +5285,7 @@ package body Sem_Prag is Get_Character (C) = '/')) then Error_Msg - ("?interface name contains illegal character", + ("??interface name contains illegal character", Sloc (SN) + Source_Ptr (J)); end if; end loop; @@ -5704,7 +5705,7 @@ package body Sem_Prag is if not UI_Is_In_Int_Range (Val) then Error_Pragma_Arg - ("pragma ignored, value too large?", Arg); + ("pragma ignored, value too large??", Arg); end if; -- Warning case. If the real restriction is active, then we @@ -5981,20 +5982,23 @@ package body Sem_Prag is and then Comes_From_Source (Arg) then Error_Msg_NE - ("?& has been made static as a result of Export", Arg, E); + ("?x?& has been made static as a result of Export", + Arg, E); Error_Msg_N - ("\this usage is non-standard and non-portable", Arg); + ("\?x?this usage is non-standard and non-portable", + Arg); end if; end if; end if; if Warn_On_Export_Import and then Is_Type (E) then - Error_Msg_NE ("exporting a type has no effect?", Arg, E); + Error_Msg_NE ("exporting a type has no effect?x?", Arg, E); end if; if Warn_On_Export_Import and Inside_A_Generic then Error_Msg_NE - ("all instances of& will have the same external name?", Arg, E); + ("all instances of& will have the same external name?x?", + Arg, E); end if; end Set_Exported; @@ -6562,13 +6566,13 @@ package body Sem_Prag is if not Is_Pragma_Name (Pname) then if Warn_On_Unrecognized_Pragma then Error_Msg_Name_1 := Pname; - Error_Msg_N ("?unrecognized pragma%!", Pragma_Identifier (N)); + Error_Msg_N ("?g?unrecognized pragma%!", Pragma_Identifier (N)); for PN in First_Pragma_Name .. Last_Pragma_Name loop if Is_Bad_Spelling_Of (Pname, PN) then Error_Msg_Name_1 := PN; Error_Msg_N -- CODEFIX - ("\?possible misspelling of %!", Pragma_Identifier (N)); + ("\?g?possible misspelling of %!", Pragma_Identifier (N)); exit; end if; end loop; @@ -7013,16 +7017,27 @@ package body Sem_Prag is -- pragma Assume (boolean_EXPRESSION); - -- This should share pragma Assert code ??? - -- Run-time check is missing completely ??? - when Pragma_Assume => Assume : declare begin GNAT_Pragma; S14_Pragma; Check_Arg_Count (1); - Analyze_And_Resolve (Expression (Arg1), Any_Boolean); + -- Pragma Assume is transformed into pragma Check in the following + -- manner: + + -- pragma Check (Assume, Expr); + + Rewrite (N, + Make_Pragma (Loc, + Chars => Name_Check, + Pragma_Argument_Associations => New_List ( + Make_Pragma_Argument_Association (Loc, + Expression => Make_Identifier (Loc, Name_Assume)), + + Make_Pragma_Argument_Association (Loc, + Expression => Relocate_Node (Expression (Arg1)))))); + Analyze (N); end Assume; ------------------------------ @@ -7449,8 +7464,9 @@ package body Sem_Prag is -- [,[Message =>] String_EXPRESSION]); when Pragma_Check => Check : declare - Expr : Node_Id; - Eloc : Source_Ptr; + Expr : Node_Id; + Eloc : Source_Ptr; + Cname : Name_Id; Check_On : Boolean; -- Set True if category of assertions referenced by Name enabled @@ -7477,14 +7493,28 @@ package body Sem_Prag is return; end if; - -- Indicate if pragma is enabled. The Original_Node reference here - -- is to deal with pragma Assert rewritten as a Check pragma. + Cname := Chars (Get_Pragma_Arg (Arg1)); + Check_On := Check_Enabled (Cname); - Check_On := Check_Enabled (Chars (Get_Pragma_Arg (Arg1))); + case Cname is + when Name_Predicate | + Name_Invariant => - if Check_On and then not Split_PPC (N) then - Set_SCO_Pragma_Enabled (Loc); - end if; + -- Nothing to do: since checks occur in client units, + -- the SCO for the aspect in the declaration unit is + -- conservatively always enabled. + + null; + + when others => + + if Check_On and then not Split_PPC (N) then + + -- Mark pragma/aspect SCO as enabled + + Set_SCO_Pragma_Enabled (Loc); + end if; + end case; -- If expansion is active and the check is not enabled then we -- rewrite the Check as: @@ -7530,6 +7560,18 @@ package body Sem_Prag is end if; end Check; + -------------------------- + -- Check_Float_Overflow -- + -------------------------- + + -- pragma Check_Float_Overflow; + + when Pragma_Check_Float_Overflow => + GNAT_Pragma; + Check_Valid_Configuration_Pragma; + Check_Arg_Count (0); + Check_Float_Overflow := True; + ---------------- -- Check_Name -- ---------------- @@ -8093,7 +8135,7 @@ package body Sem_Prag is -- Following message is obsolete ??? Error_Msg_N ("'G'N'A'T pragma cpp'_class is now obsolete and has no " & - "effect; replace it by pragma import?", N); + "effect; replace it by pragma import?j?", N); end if; Check_Arg_Count (1); @@ -8145,7 +8187,7 @@ package body Sem_Prag is if Is_Constructor (Def_Id) then Error_Msg_N - ("?duplicate argument for pragma 'C'P'P_Constructor", Arg1); + ("??duplicate argument for pragma 'C'P'P_Constructor", Arg1); return; end if; @@ -8219,7 +8261,7 @@ package body Sem_Prag is if Warn_On_Obsolescent_Feature then Error_Msg_N ("'G'N'A'T pragma cpp'_virtual is now obsolete and has " & - "no effect?", N); + "no effect?j?", N); end if; end CPP_Virtual; @@ -8234,7 +8276,7 @@ package body Sem_Prag is if Warn_On_Obsolescent_Feature then Error_Msg_N ("'G'N'A'T pragma cpp'_vtable is now obsolete and has " & - "no effect?", N); + "no effect?j?", N); end if; end CPP_Vtable; @@ -8719,9 +8761,9 @@ package body Sem_Prag is if Elab_Warnings and not Dynamic_Elaboration_Checks then Error_Msg_N - ("?use of pragma Elaborate may not be safe", N); + ("?l?use of pragma Elaborate may not be safe", N); Error_Msg_N - ("?use pragma Elaborate_All instead if possible", N); + ("?l?use pragma Elaborate_All instead if possible", N); end if; end Elaborate; @@ -9560,7 +9602,7 @@ package body Sem_Prag is if not OpenVMS_On_Target then if Chars (Get_Pragma_Arg (Arg1)) = Name_VAX_Float then Error_Pragma - ("?pragma% ignored (applies only to Open'V'M'S)"); + ("??pragma% ignored (applies only to Open'V'M'S)"); end if; return; @@ -10288,15 +10330,19 @@ package body Sem_Prag is D := Declaration_Node (E); K := Nkind (D); - if (K = N_Full_Type_Declaration - and then (Is_Array_Type (E) or else Is_Record_Type (E))) - or else - ((Ekind (E) = E_Constant or else Ekind (E) = E_Variable) - and then Nkind (D) = N_Object_Declaration - and then Nkind (Object_Definition (D)) = - N_Constrained_Array_Definition) + if K = N_Full_Type_Declaration + and then (Is_Array_Type (E) or else Is_Record_Type (E)) + then + Independence_Checks.Append ((N, E)); + Set_Has_Independent_Components (Base_Type (E)); + + elsif (Ekind (E) = E_Constant or else Ekind (E) = E_Variable) + and then Nkind (D) = N_Object_Declaration + and then Nkind (Object_Definition (D)) = + N_Constrained_Array_Definition then Independence_Checks.Append ((N, E)); + Set_Has_Independent_Components (E); else Error_Pragma_Arg ("inappropriate entity for pragma%", Arg1); @@ -11538,7 +11584,7 @@ package body Sem_Prag is Check_Arg_Is_One_Of (Arg1, Name_D_Float, Name_G_Float); if not OpenVMS_On_Target then - Error_Pragma ("?pragma% ignored (applies only to Open'V'M'S)"); + Error_Pragma ("??pragma% ignored (applies only to Open'V'M'S)"); end if; -- D_Float case @@ -12442,7 +12488,7 @@ package body Sem_Prag is elsif VM_Target /= No_VM then if not GNAT_Mode then Error_Pragma - ("?pragma% ignored in this configuration"); + ("??pragma% ignored in this configuration"); end if; -- Normal case where we do the pack action @@ -12468,7 +12514,7 @@ package body Sem_Prag is if VM_Target /= No_VM then if not GNAT_Mode then Error_Pragma - ("?pragma% ignored in this configuration"); + ("??pragma% ignored in this configuration"); end if; -- Normal case of pack request active @@ -12613,7 +12659,7 @@ package body Sem_Prag is if Has_Pragma_Preelab_Init (Ent) and then Warn_On_Redundant_Constructs then - Error_Pragma ("?duplicate pragma%!"); + Error_Pragma ("?r?duplicate pragma%!"); else Set_Has_Pragma_Preelab_Init (Ent); end if; @@ -12706,7 +12752,6 @@ package body Sem_Prag is when Pragma_Postcondition => Postcondition : declare In_Body : Boolean; - pragma Warnings (Off, In_Body); begin GNAT_Pragma; @@ -12714,10 +12759,22 @@ package body Sem_Prag is Check_At_Most_N_Arguments (2); Check_Optional_Identifier (Arg1, Name_Check); - -- All we need to do here is call the common check procedure, - -- the remainder of the processing is found in Sem_Ch6/Sem_Ch7. + -- Verify the proper placement of the pragma. The remainder of the + -- processing is found in Sem_Ch6/Sem_Ch7. Check_Precondition_Postcondition (In_Body); + + -- When the pragma is a source contruct and appears inside a body, + -- preanalyze the boolean_expression to detect illegal forward + -- references: + + -- procedure P is + -- pragma Postcondition (X'Old ...); + -- X : ... + + if Comes_From_Source (N) and then In_Body then + Preanalyze_Spec_Expression (Expression (Arg1), Any_Boolean); + end if; end Postcondition; ------------------ @@ -13288,7 +13345,7 @@ package body Sem_Prag is or else Has_Rep_Pragma (Def_Id, Name_Psect_Object) then - Error_Msg_N ("?duplicate Common/Psect_Object pragma", N); + Error_Msg_N ("??duplicate Common/Psect_Object pragma", N); end if; if Ekind (Def_Id) = E_Constant then @@ -13312,7 +13369,7 @@ package body Sem_Prag is and then Warn_On_Export_Import then Error_Msg_N - ("?object for pragma % has defaults", Internal); + ("?x?object for pragma % has defaults", Internal); exit; else @@ -13496,7 +13553,7 @@ package body Sem_Prag is and then Warn_On_Redundant_Constructs then Error_Msg_NE - ("pragma Pure_Function on& is redundant?", + ("pragma Pure_Function on& is redundant?r?", N, Entity (E_Id)); end if; end if; @@ -13702,8 +13759,10 @@ package body Sem_Prag is Set_Ravenscar_Profile (N); if Warn_On_Obsolescent_Feature then - Error_Msg_N ("pragma Ravenscar is an obsolescent feature?", N); - Error_Msg_N ("|use pragma Profile (Ravenscar) instead", N); + Error_Msg_N + ("pragma Ravenscar is an obsolescent feature?j?", N); + Error_Msg_N + ("|use pragma Profile (Ravenscar) instead?j?", N); end if; ------------------------- @@ -13721,8 +13780,10 @@ package body Sem_Prag is if Warn_On_Obsolescent_Feature then Error_Msg_N - ("pragma Restricted_Run_Time is an obsolescent feature?", N); - Error_Msg_N ("|use pragma Profile (Restricted) instead", N); + ("pragma Restricted_Run_Time is an obsolescent feature?j?", + N); + Error_Msg_N + ("|use pragma Profile (Restricted) instead?j?", N); end if; ------------------ @@ -14913,7 +14974,7 @@ package body Sem_Prag is end if; if not AAMP_On_Target then - Error_Pragma ("?pragma% ignored (applies only to AAMP)"); + Error_Pragma ("??pragma% ignored (applies only to AAMP)"); end if; ---------------- @@ -15406,7 +15467,7 @@ package body Sem_Prag is if Err then Error_Msg - ("?pragma Warnings On with no " & + ("??pragma Warnings On with no " & "matching Warnings Off", Loc); end if; @@ -15706,6 +15767,7 @@ package body Sem_Prag is Pragma_Atomic_Components => 0, Pragma_Attach_Handler => -1, Pragma_Check => 99, + Pragma_Check_Float_Overflow => 0, Pragma_Check_Name => 0, Pragma_Check_Policy => 0, Pragma_CIL_Constructor => -1, diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads index 99711546cb5..9df7d5ab711 100644 --- a/gcc/ada/sem_prag.ads +++ b/gcc/ada/sem_prag.ads @@ -58,7 +58,8 @@ package Sem_Prag is -- This function is used in connection with pragmas Assertion, Check, -- Precondition, and Postcondition, to determine if Check pragmas (or -- corresponding Assert, Precondition, or Postcondition pragmas) are - -- currently disabled (as set by a Policy pragma with the Disabled + -- currently disabled (as set by a Check_Policy or Assertion_Policy pragma + -- with the Disable argument). function Check_Enabled (Nam : Name_Id) return Boolean; -- This function is used in connection with pragmas Assertion, Check, diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 445458ca687..5559f178419 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -577,7 +577,7 @@ package body Sem_Res is -- Warn about the danger Error_Msg_N - ("?creation of & object may raise Storage_Error!", + ("??creation of & object may raise Storage_Error!", Scope (Disc)); <<No_Danger>> @@ -769,8 +769,8 @@ package body Sem_Res is and then Nkind (Parent (P)) = N_Subprogram_Body and then Is_Empty_List (Declarations (Parent (P))) then - Error_Msg_N ("!?infinite recursion", N); - Error_Msg_N ("\!?Storage_Error will be raised at run time", N); + Error_Msg_N ("!??infinite recursion", N); + Error_Msg_N ("\!??Storage_Error will be raised at run time", N); Insert_Action (N, Make_Raise_Storage_Error (Sloc (N), Reason => SE_Infinite_Recursion)); @@ -867,8 +867,8 @@ package body Sem_Res is end if; end loop; - Error_Msg_N ("!?possible infinite recursion", N); - Error_Msg_N ("\!?Storage_Error may be raised at run time", N); + Error_Msg_N ("!??possible infinite recursion", N); + Error_Msg_N ("\!??Storage_Error may be raised at run time", N); return True; end Check_Infinite_Recursion; @@ -3095,7 +3095,7 @@ package body Sem_Res is if Wrong_Order then Error_Msg_N - ("actuals for this call may be in wrong order?", N); + ("?P?actuals for this call may be in wrong order", N); end if; end; end; @@ -3963,14 +3963,14 @@ package body Sem_Res is if Is_Controlling_Formal (F) then Apply_Compile_Time_Constraint_Error (N => A, - Msg => "null value not allowed here?", + Msg => "null value not allowed here??", Reason => CE_Access_Check_Failed); elsif Ada_Version >= Ada_2005 then Apply_Compile_Time_Constraint_Error (N => A, Msg => "(Ada 2005) null not allowed in " - & "null-excluding formal?", + & "null-excluding formal??", Reason => CE_Null_Not_Allowed); end if; end if; @@ -4448,9 +4448,9 @@ package body Sem_Res is Deepest_Type_Access_Level (Typ) then if In_Instance_Body then - Error_Msg_N ("?type in allocator has deeper level than" & + Error_Msg_N ("??type in allocator has deeper level than" & " designated class-wide type", E); - Error_Msg_N ("\?Program_Error will be raised at run time", + Error_Msg_N ("\??Program_Error will be raised at run time", E); Rewrite (N, Make_Raise_Program_Error (Sloc (N), @@ -4556,8 +4556,8 @@ package body Sem_Res is and then Ekind (Current_Scope) = E_Package and then not In_Package_Body (Current_Scope) then - Error_Msg_N ("?cannot activate task before body seen", N); - Error_Msg_N ("\?Program_Error will be raised at run time", N); + Error_Msg_N ("??cannot activate task before body seen", N); + Error_Msg_N ("\??Program_Error will be raised at run time", N); end if; -- Ada 2012 (AI05-0111-3): Detect an attempt to allocate a task or a @@ -4569,8 +4569,8 @@ package body Sem_Res is and then Present (Subpool_Handle_Name (N)) and then Has_Task (Desig_T) then - Error_Msg_N ("?cannot allocate task on subpool", N); - Error_Msg_N ("\?Program_Error will be raised at run time", N); + Error_Msg_N ("??cannot allocate task on subpool", N); + Error_Msg_N ("\??Program_Error will be raised at run time", N); Rewrite (N, Make_Raise_Program_Error (Sloc (N), @@ -5026,24 +5026,24 @@ package body Sem_Res is then Error_Msg_N ("float division by zero, " & - "may generate '+'/'- infinity?", Right_Opnd (N)); + "may generate '+'/'- infinity??", Right_Opnd (N)); -- For all other cases, we get a Constraint_Error else Apply_Compile_Time_Constraint_Error - (N, "division by zero?", CE_Divide_By_Zero, + (N, "division by zero??", CE_Divide_By_Zero, Loc => Sloc (Right_Opnd (N))); end if; when N_Op_Rem => Apply_Compile_Time_Constraint_Error - (N, "rem with zero divisor?", CE_Divide_By_Zero, + (N, "rem with zero divisor??", CE_Divide_By_Zero, Loc => Sloc (Right_Opnd (N))); when N_Op_Mod => Apply_Compile_Time_Constraint_Error - (N, "mod with zero divisor?", CE_Divide_By_Zero, + (N, "mod with zero divisor??", CE_Divide_By_Zero, Loc => Sloc (Right_Opnd (N))); -- Division by zero can only happen with division, rem, @@ -5285,10 +5285,10 @@ package body Sem_Res is then Rtype := Etype (N); Error_Msg_NE - ("?& should not be used in entry body (RM C.7(17))", + ("??& should not be used in entry body (RM C.7(17))", N, Nam); Error_Msg_NE - ("\Program_Error will be raised at run time?", N, Nam); + ("\Program_Error will be raised at run time??", N, Nam); Rewrite (N, Make_Raise_Program_Error (Loc, Reason => PE_Current_Task_In_Entry_Body)); @@ -5578,9 +5578,9 @@ package body Sem_Res is Set_Has_Recursive_Call (Nam); Error_Msg_N - ("?possible infinite recursion!", N); + ("??possible infinite recursion!", N); Error_Msg_N - ("\?Storage_Error may be raised at run time!", N); + ("\??Storage_Error may be raised at run time!", N); end if; exit Scope_Loop; @@ -5898,8 +5898,8 @@ package body Sem_Res is end loop; if not Call_OK then - Error_Msg_N ("!? cannot determine tag of result", N); - Error_Msg_N ("!? Program_Error will be raised", N); + Error_Msg_N ("!?? cannot determine tag of result", N); + Error_Msg_N ("!?? Program_Error will be raised", N); Insert_Action (N, Make_Raise_Program_Error (Sloc (N), Reason => PE_Explicit_Raise)); @@ -6100,7 +6100,7 @@ package body Sem_Res is -- Check comparison on unordered enumeration if Bad_Unordered_Enumeration_Reference (N, Etype (L)) then - Error_Msg_N ("comparison on unordered enumeration type?", N); + Error_Msg_N ("comparison on unordered enumeration type?U?", N); end if; -- Evaluate the relation (note we do this after the above check since @@ -6939,7 +6939,7 @@ package body Sem_Res is and then Comes_From_Source (R) then Error_Msg_N -- CODEFIX - ("?comparison with True is redundant!", R); + ("?r?comparison with True is redundant!", R); end if; Check_Unset_Reference (L); @@ -7322,9 +7322,9 @@ package body Sem_Res is and then Is_Bit_Packed_Array (Array_Type) and then Is_LHS (N) then - Error_Msg_N ("?assignment to component of packed atomic array", + Error_Msg_N ("??assignment to component of packed atomic array", Prefix (N)); - Error_Msg_N ("?\may cause unexpected accesses to atomic object", + Error_Msg_N ("??\may cause unexpected accesses to atomic object", Prefix (N)); end if; end Resolve_Indexed_Component; @@ -7700,7 +7700,7 @@ package body Sem_Res is while Present (Alt) loop if Is_Static_Expression (Alt) and then (Nkind_In (Alt, N_Integer_Literal, - N_Character_Literal) + N_Character_Literal) or else Nkind (Alt) in N_Has_Entity) then Nalts := Nalts + 1; @@ -7709,7 +7709,7 @@ package body Sem_Res is for J in 1 .. Nalts - 1 loop if Alts (J).Val = Alts (Nalts).Val then Error_Msg_Sloc := Sloc (Alts (J).Alt); - Error_Msg_N ("duplicate of value given#?", Alt); + Error_Msg_N ("duplicate of value given#??", Alt); end if; end loop; end if; @@ -7838,7 +7838,7 @@ package body Sem_Res is if not Inside_Init_Proc then Insert_Action (Compile_Time_Constraint_Error (N, - "(Ada 2005) null not allowed in null-excluding objects?"), + "(Ada 2005) null not allowed in null-excluding objects??"), Make_Raise_Constraint_Error (Loc, Reason => CE_Access_Check_Failed)); else @@ -8308,7 +8308,7 @@ package body Sem_Res is and then not Is_Boolean_Type (Typ) and then Parent_Is_Boolean then - Error_Msg_N ("?not expression should be parenthesized here!", N); + Error_Msg_N ("?q?not expression should be parenthesized here!", N); end if; -- Warn on double negation if checking redundant constructs @@ -8319,7 +8319,7 @@ package body Sem_Res is and then Root_Type (Typ) = Standard_Boolean and then Nkind (Right_Opnd (N)) = N_Op_Not then - Error_Msg_N ("redundant double negation?", N); + Error_Msg_N ("redundant double negation?r?", N); end if; -- Complete resolution and evaluation of NOT @@ -8459,7 +8459,7 @@ package body Sem_Res is and then not First_Last_Ref then - Error_Msg ("subrange of unordered enumeration type?", Sloc (N)); + Error_Msg ("subrange of unordered enumeration type?U?", Sloc (N)); end if; Check_Unset_Reference (L); @@ -8546,7 +8546,7 @@ package body Sem_Res is and then Warn_On_Bad_Fixed_Value then Error_Msg_N - ("?static fixed-point value is not a multiple of Small!", + ("?b?static fixed-point value is not a multiple of Small!", N); end if; @@ -8796,9 +8796,9 @@ package body Sem_Res is and then Is_LHS (N) then Error_Msg_N - ("?assignment to component of packed atomic record", Prefix (N)); + ("??assignment to component of packed atomic record", Prefix (N)); Error_Msg_N - ("?\may cause unexpected accesses to atomic object", Prefix (N)); + ("\??may cause unexpected accesses to atomic object", Prefix (N)); end if; Analyze_Dimension (N); @@ -8891,7 +8891,7 @@ package body Sem_Res is -- of the First_Node call here. Error_Msg_F - ("?assertion would fail at run time!", + ("?A?assertion would fail at run time!", Expression (First (Pragma_Argument_Associations (Orig)))); end if; @@ -8906,10 +8906,9 @@ package body Sem_Res is declare Expr : constant Node_Id := - Original_Node - (Expression - (Next (First - (Pragma_Argument_Associations (Orig))))); + Original_Node + (Expression + (Next (First (Pragma_Argument_Associations (Orig))))); begin if Is_Entity_Name (Expr) and then Entity (Expr) = Standard_False @@ -8923,7 +8922,7 @@ package body Sem_Res is -- comment above for an explanation of why we do this. Error_Msg_F - ("?check would fail at run time!", + ("?A?check would fail at run time!", Expression (Last (Pragma_Argument_Associations (Orig)))); end if; @@ -9329,7 +9328,8 @@ package body Sem_Res is or else Char_Val > Expr_Value (Comp_Typ_Hi) then Apply_Compile_Time_Constraint_Error - (N, "character out of range?", CE_Range_Check_Failed, + (N, "character out of range??", + CE_Range_Check_Failed, Loc => Source_Ptr (Int (Loc) + J)); end if; end loop; @@ -9474,11 +9474,10 @@ package body Sem_Res is and then abs (Realval (Rop)) < Delta_Value (Standard_Duration) then Error_Msg_N - ("?universal real operand can only " & - "be interpreted as Duration!", - Rop); + ("??universal real operand can only " & + "be interpreted as Duration!", Rop); Error_Msg_N - ("\?precision will be lost in the conversion!", Rop); + ("\??precision will be lost in the conversion!", Rop); end if; elsif Is_Numeric_Type (Typ) @@ -9654,15 +9653,17 @@ package body Sem_Res is -- entity, give the name of the entity in the message. If not, -- just mention the expression. + -- Shoudn't we test Warn_On_Redundant_Constructs here ??? + else if Is_Entity_Name (Orig_N) then Error_Msg_Node_2 := Orig_T; Error_Msg_NE -- CODEFIX - ("?redundant conversion, & is of type &!", + ("??redundant conversion, & is of type &!", N, Entity (Orig_N)); else Error_Msg_NE - ("?redundant conversion, expression is of type&!", + ("??redundant conversion, expression is of type&!", N, Orig_T); end if; end if; @@ -9830,7 +9831,7 @@ package body Sem_Res is if OK and then Hi >= Lo and then Lo >= 0 then Error_Msg_N -- CODEFIX - ("?abs applied to known non-negative value has no effect", N); + ("?r?abs applied to known non-negative value has no effect", N); end if; end if; @@ -9968,8 +9969,10 @@ package body Sem_Res is -- If we fall through warning should be issued + -- Shouldn't we test Warn_On_Questionable_Missing_Parens ??? + Error_Msg_N - ("?unary minus expression should be parenthesized here!", N); + ("??unary minus expression should be parenthesized here!", N); end if; end if; end; @@ -10443,9 +10446,11 @@ package body Sem_Res is end loop; if Nkind (N) = N_Real_Literal then - Error_Msg_NE ("?real literal interpreted as }!", N, T1); + Error_Msg_NE + ("??real literal interpreted as }!", N, T1); else - Error_Msg_NE ("?universal_fixed expression interpreted as }!", N, T1); + Error_Msg_NE + ("??universal_fixed expression interpreted as }!", N, T1); end if; return T1; @@ -10628,10 +10633,10 @@ package body Sem_Res is then if In_Instance_Body then Error_Msg_N - ("?source array type has " & + ("??source array type has " & "deeper accessibility level than target", Operand); Error_Msg_N - ("\?Program_Error will be raised at run time", + ("\??Program_Error will be raised at run time", Operand); Rewrite (N, Make_Raise_Program_Error (Sloc (N), @@ -10915,10 +10920,10 @@ package body Sem_Res is if In_Instance_Body then Error_Msg_N - ("?cannot convert local pointer to non-local access type", + ("??cannot convert local pointer to non-local access type", Operand); Error_Msg_N - ("\?Program_Error will be raised at run time", Operand); + ("\??Program_Error will be raised at run time", Operand); else Error_Msg_N @@ -10948,10 +10953,11 @@ package body Sem_Res is if In_Instance_Body then Error_Msg_N - ("?cannot convert access discriminant to non-local" & + ("??cannot convert access discriminant to non-local" & " access type", Operand); Error_Msg_N - ("\?Program_Error will be raised at run time", Operand); + ("\??Program_Error will be raised at run time", + Operand); else Error_Msg_N ("cannot convert access discriminant to non-local" & @@ -11092,10 +11098,10 @@ package body Sem_Res is if In_Instance_Body then Error_Msg_N - ("?cannot convert local pointer to non-local access type", + ("??cannot convert local pointer to non-local access type", Operand); Error_Msg_N - ("\?Program_Error will be raised at run time", Operand); + ("\??Program_Error will be raised at run time", Operand); else -- Avoid generation of spurious error message @@ -11130,10 +11136,10 @@ package body Sem_Res is if In_Instance_Body then Error_Msg_N - ("?cannot convert access discriminant to non-local" & - " access type", Operand); + ("??cannot convert access discriminant to non-local" + & " access type", Operand); Error_Msg_N - ("\?Program_Error will be raised at run time", + ("\??Program_Error will be raised at run time", Operand); else diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 7d3215e59c3..648362c658f 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -444,8 +444,8 @@ package body Sem_Util is begin if Has_Predicates (Typ) then if Is_Generic_Actual_Type (Typ) then - Error_Msg_FE (Msg & '?', N, Typ); - Error_Msg_F ("\Program_Error will be raised at run time?", N); + Error_Msg_FE (Msg & "??", N, Typ); + Error_Msg_F ("\Program_Error will be raised at run time??", N); Insert_Action (N, Make_Raise_Program_Error (Sloc (N), Reason => PE_Bad_Predicated_Generic_Type)); @@ -1576,7 +1576,7 @@ package body Sem_Util is then Error_Msg_N ("result may differ if evaluated " - & "after other actual in expression?", Act1); + & "after other actual in expression??", Act1); end if; end if; end loop; @@ -1610,7 +1610,7 @@ package body Sem_Util is while Present (S) and then S /= Standard_Standard loop if Is_Protected_Type (S) then Error_Msg_N - ("potentially blocking operation in protected operation?", N); + ("potentially blocking operation in protected operation??", N); return; end if; @@ -1724,7 +1724,7 @@ package body Sem_Util is Object_Access_Level (Context) then Error_Msg_N - ("?possible unprotected access to protected data", Expr); + ("??possible unprotected access to protected data", Expr); end if; end if; end Check_Unprotected_Access; @@ -2249,8 +2249,8 @@ package body Sem_Util is Loc : Source_Ptr := No_Location; Warn : Boolean := False) return Node_Id is - Msgc : String (1 .. Msg'Length + 2); - -- Copy of message, with room for possible ? and ! at end + Msgc : String (1 .. Msg'Length + 3); + -- Copy of message, with room for possible ?? and ! at end Msgl : Natural; Wmsg : Boolean; @@ -2291,11 +2291,15 @@ package body Sem_Util is then Msgl := Msgl + 1; Msgc (Msgl) := '?'; + Msgl := Msgl + 1; + Msgc (Msgl) := '?'; Wmsg := True; elsif In_Instance_Not_Visible then Msgl := Msgl + 1; Msgc (Msgl) := '?'; + Msgl := Msgl + 1; + Msgc (Msgl) := '?'; Wmsg := True; -- Otherwise we have a real error message (Ada 95 static case) @@ -2413,19 +2417,19 @@ package body Sem_Util is and then not Comes_From_Source (Conc_Typ) then Error_Msg_NEL - ("\?& will be raised at run time", + ("\??& will be raised at run time", N, Standard_Constraint_Error, Eloc); else Error_Msg_NEL - ("\?& will be raised for objects of this type", + ("\??& will be raised for objects of this type", N, Standard_Constraint_Error, Eloc); end if; end; else Error_Msg_NEL - ("\?& will be raised at run time", + ("\??& will be raised at run time", N, Standard_Constraint_Error, Eloc); end if; @@ -3863,7 +3867,7 @@ package body Sem_Util is Is_Potentially_Use_Visible (C)) then Error_Msg_Sloc := Sloc (C); - Error_Msg_N ("declaration hides &#?", Def_Id); + Error_Msg_N ("declaration hides &#?h?", Def_Id); end if; end Enter_Name; @@ -11258,7 +11262,8 @@ package body Sem_Util is -- sure this is a modification. if Has_Pragma_Unmodified (Ent) and then Sure then - Error_Msg_NE ("?pragma Unmodified given for &!", N, Ent); + Error_Msg_NE + ("??pragma Unmodified given for &!", N, Ent); end if; Set_Never_Set_In_Source (Ent, False); @@ -11348,8 +11353,8 @@ package body Sem_Util is then Error_Msg_Sloc := Sloc (A); Error_Msg_NE - ("constant& may be modified via address clause#?", - N, Entity (Prefix (Exp))); + ("constant& may be modified via address " + & "clause#??", N, Entity (Prefix (Exp))); end if; end; end if; @@ -11600,16 +11605,15 @@ package body Sem_Util is end Return_Master_Scope_Depth_Of_Call; end if; - -- For convenience we handle qualified expressions, even though - -- they aren't technically object names. + -- For convenience we handle qualified expressions, even though they + -- aren't technically object names. elsif Nkind (Obj) = N_Qualified_Expression then return Object_Access_Level (Expression (Obj)); - -- Otherwise return the scope level of Standard. - -- (If there are cases that fall through - -- to this point they will be treated as - -- having global accessibility for now. ???) + -- Otherwise return the scope level of Standard. (If there are cases + -- that fall through to this point they will be treated as having + -- global accessibility for now. ???) else return Scope_Depth (Standard_Standard); diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 53ad6312daa..e24e72901dd 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -200,7 +200,7 @@ package body Sem_Warn is if No (Asm_Input_Value) then Error_Msg_F - ("?code statement with no inputs should usually be Volatile!", N); + ("??code statement with no inputs should usually be Volatile!", N); return; end if; @@ -208,7 +208,7 @@ package body Sem_Warn is if No (Asm_Output_Variable) then Error_Msg_F - ("?code statement with no outputs should usually be Volatile!", N); + ("??code statement with no outputs should usually be Volatile!", N); return; end if; end Check_Code_Statement; @@ -707,9 +707,9 @@ package body Sem_Warn is if No_Ref_Found (Loop_Statement) = OK then Error_Msg_NE - ("?variable& is not modified in loop body!", Ref, Var); + ("??variable& is not modified in loop body!", Ref, Var); Error_Msg_N - ("\?possible infinite loop!", Ref); + ("\??possible infinite loop!", Ref); end if; end Check_Infinite_Loop_Warning; @@ -1057,7 +1057,7 @@ package body Sem_Warn is -- the designated object). if not Warnings_Off_E1 then - Error_Msg_NE ("?& may be null!", UR, E1); + Error_Msg_NE ("??& may be null!", UR, E1); end if; goto Continue; @@ -1083,7 +1083,7 @@ package body Sem_Warn is and then not Is_Imported (E1) then Error_Msg_N - ("?& is not modified, volatile has no effect!", E1); + ("?k?& is not modified, volatile has no effect!", E1); -- Another special case, Exception_Occurrence, this catches -- the case of exception choice (and a bit more too, but not @@ -1105,7 +1105,7 @@ package body Sem_Warn is then if not Warnings_Off_E1 then Error_Msg_N -- CODEFIX - ("?& is not modified, " + ("?k?& is not modified, " & "could be declared constant!", E1); end if; @@ -1237,7 +1237,7 @@ package body Sem_Warn is and then not Warnings_Off_E1 then Output_Reference_Error - ("?formal parameter& is read but " + ("?f?formal parameter& is read but " & "never assigned!"); end if; @@ -1245,7 +1245,7 @@ package body Sem_Warn is and then not Warnings_Off_E1 then Output_Reference_Error - ("?formal parameter& is not referenced!"); + ("?f?formal parameter& is not referenced!"); end if; end if; @@ -1257,14 +1257,14 @@ package body Sem_Warn is and then not Warnings_Off_E1 then Output_Reference_Error - ("?variable& is read but never assigned!"); + ("?v?variable& is read but never assigned!"); end if; elsif not Has_Unreferenced (E1) and then not Warnings_Off_E1 then Output_Reference_Error -- CODEFIX - ("?variable& is never read and never assigned!"); + ("?v?variable& is never read and never assigned!"); end if; -- Deal with special case where this variable is hidden @@ -1275,12 +1275,12 @@ package body Sem_Warn is and then not Warnings_Off_E1 then Error_Msg_N - ("?for loop implicitly declares loop variable!", + ("?v?for loop implicitly declares loop variable!", Hiding_Loop_Variable (E1)); Error_Msg_Sloc := Sloc (E1); Error_Msg_N - ("\?declaration hides & declared#!", + ("\?v?declaration hides & declared#!", Hiding_Loop_Variable (E1)); end if; end if; @@ -1321,7 +1321,8 @@ package body Sem_Warn is then if not Warnings_Off_E1 then Error_Msg_NE - ("?OUT parameter& not set before return", UR, E1); + ("?v?OUT parameter& not set before return", + UR, E1); end if; -- If the unset reference is a selected component @@ -2111,7 +2112,7 @@ package body Sem_Warn is if Entity (Nam) = Pack then Error_Msg_Qual_Level := 1; Error_Msg_NE -- CODEFIX - ("?no entities of package& are referenced!", + ("?u?no entities of package& are referenced!", Nam, Pack); Error_Msg_Qual_Level := 0; end if; @@ -2308,7 +2309,7 @@ package body Sem_Warn is elsif Has_Visible_Entities (Entity (Name (Item))) then Error_Msg_N -- CODEFIX - ("?unit& is not referenced!", Name (Item)); + ("?u?unit& is not referenced!", Name (Item)); end if; end if; @@ -2385,7 +2386,7 @@ package body Sem_Warn is Has_Unreferenced (Entity (Name (Item))) then Error_Msg_N -- CODEFIX - ("?no entities of & are referenced!", + ("?u?no entities of & are referenced!", Name (Item)); end if; @@ -2401,7 +2402,7 @@ package body Sem_Warn is and then not Has_Unreferenced (Pack) then Error_Msg_NE -- CODEFIX - ("?no entities of & are referenced!", + ("?u?no entities of & are referenced!", Unit_Declaration_Node (Pack), Pack); end if; @@ -2451,12 +2452,12 @@ package body Sem_Warn is elsif Unreferenced_In_Spec (Item) then Error_Msg_N -- CODEFIX - ("?unit& is not referenced in spec!", + ("?u?unit& is not referenced in spec!", Name (Item)); elsif No_Entities_Ref_In_Spec (Item) then Error_Msg_N -- CODEFIX - ("?no entities of & are referenced in spec!", + ("?u?no entities of & are referenced in spec!", Name (Item)); else @@ -2469,7 +2470,7 @@ package body Sem_Warn is if not Is_Visible_Renaming then Error_Msg_N -- CODEFIX - ("\?with clause might be moved to body!", + ("\?u?with clause might be moved to body!", Name (Item)); end if; @@ -2497,7 +2498,7 @@ package body Sem_Warn is Set_Unreferenced_In_Spec (Item); else Error_Msg_N -- CODEFIX - ("?unit& is never instantiated!", Name (Item)); + ("?u?unit& is never instantiated!", Name (Item)); end if; -- If unit was indeed instantiated, make sure that flag is @@ -2506,9 +2507,9 @@ package body Sem_Warn is elsif Unreferenced_In_Spec (Item) then Error_Msg_N - ("?unit& is not instantiated in spec!", Name (Item)); + ("?u?unit& is not instantiated in spec!", Name (Item)); Error_Msg_N -- CODEFIX - ("\?with clause can be moved to body!", Name (Item)); + ("\?u?with clause can be moved to body!", Name (Item)); end if; end if; end if; @@ -2520,9 +2521,7 @@ package body Sem_Warn is -- Start of processing for Check_Unused_Withs begin - if not Opt.Check_Withs - or else Operating_Mode = Check_Syntax - then + if not Opt.Check_Withs or else Operating_Mode = Check_Syntax then return; end if; @@ -2793,9 +2792,9 @@ package body Sem_Warn is if not Is_Trivial_Subprogram (Scope (E1)) then if Warn_On_Constant then Error_Msg_N - ("?formal parameter & is not modified!", E1); + ("?u?formal parameter & is not modified!", E1); Error_Msg_N - ("\?mode could be IN instead of `IN OUT`!", E1); + ("\?u?mode could be IN instead of `IN OUT`!", E1); -- We do not generate warnings for IN OUT parameters -- unless we have at least -gnatwu. This is deliberately @@ -2805,7 +2804,7 @@ package body Sem_Warn is elsif Check_Unreferenced then Error_Msg_N - ("?formal parameter& is read but " + ("?u?formal parameter& is read but " & "never assigned!", E1); end if; end if; @@ -2864,13 +2863,13 @@ package body Sem_Warn is if Nkind (P) = N_With_Clause then if Ekind (E) = E_Package then Error_Msg_NE - ("?with of obsolescent package& declared#", N, E); + ("??with of obsolescent package& declared#", N, E); elsif Ekind (E) = E_Procedure then Error_Msg_NE - ("?with of obsolescent procedure& declared#", N, E); + ("??with of obsolescent procedure& declared#", N, E); else Error_Msg_NE - ("?with of obsolescent function& declared#", N, E); + ("??with of obsolescent function& declared#", N, E); end if; -- If we do not have a with clause, then ignore any reference to an @@ -2884,51 +2883,49 @@ package body Sem_Warn is elsif Nkind (P) = N_Procedure_Call_Statement then Error_Msg_NE - ("?call to obsolescent procedure& declared#", N, E); + ("??call to obsolescent procedure& declared#", N, E); -- Function call elsif Nkind (P) = N_Function_Call then Error_Msg_NE - ("?call to obsolescent function& declared#", N, E); + ("??call to obsolescent function& declared#", N, E); -- Reference to obsolescent type elsif Is_Type (E) then Error_Msg_NE - ("?reference to obsolescent type& declared#", N, E); + ("??reference to obsolescent type& declared#", N, E); -- Reference to obsolescent component elsif Ekind_In (E, E_Component, E_Discriminant) then Error_Msg_NE - ("?reference to obsolescent component& declared#", N, E); + ("??reference to obsolescent component& declared#", N, E); -- Reference to obsolescent variable elsif Ekind (E) = E_Variable then Error_Msg_NE - ("?reference to obsolescent variable& declared#", N, E); + ("??reference to obsolescent variable& declared#", N, E); -- Reference to obsolescent constant - elsif Ekind (E) = E_Constant - or else Ekind (E) in Named_Kind - then + elsif Ekind (E) = E_Constant or else Ekind (E) in Named_Kind then Error_Msg_NE - ("?reference to obsolescent constant& declared#", N, E); + ("??reference to obsolescent constant& declared#", N, E); -- Reference to obsolescent enumeration literal elsif Ekind (E) = E_Enumeration_Literal then Error_Msg_NE - ("?reference to obsolescent enumeration literal& declared#", N, E); + ("??reference to obsolescent enumeration literal& declared#", N, E); -- Generic message for any other case we missed else Error_Msg_NE - ("?reference to obsolescent entity& declared#", N, E); + ("??reference to obsolescent entity& declared#", N, E); end if; -- Output additional warning if present @@ -2938,7 +2935,7 @@ package body Sem_Warn is String_To_Name_Buffer (Obsolescent_Warnings.Table (J).Msg); Error_Msg_Strlen := Name_Len; Error_Msg_String (1 .. Name_Len) := Name_Buffer (1 .. Name_Len); - Error_Msg_N ("\\?~", N); + Error_Msg_N ("\\??~", N); exit; end if; end loop; @@ -2992,21 +2989,21 @@ package body Sem_Warn is elsif Warnings_Off_Used_Unmodified (E) then Error_Msg_NE - ("?could use Unmodified instead of " + ("?W?could use Unmodified instead of " & "Warnings Off for &", Pragma_Identifier (N), E); -- Used only in context where Unreferenced would have worked elsif Warnings_Off_Used_Unreferenced (E) then Error_Msg_NE - ("?could use Unreferenced instead of " + ("?W?could use Unreferenced instead of " & "Warnings Off for &", Pragma_Identifier (N), E); -- Not used at all else Error_Msg_NE - ("?pragma Warnings Off for & unused, " + ("?W?pragma Warnings Off for & unused, " & "could be omitted", N, E); end if; end; @@ -3178,9 +3175,20 @@ package body Sem_Warn is if Constant_Condition_Warnings and then Is_Known_Branch - and then Comes_From_Source (Original_Node (C)) + and then Comes_From_Source (Orig) and then not In_Instance then + -- Don't warn if comparison of result of attribute against a constant + -- value, since this is likely legitimate conditional compilation. + + if Nkind (Orig) in N_Op_Compare + and then Compile_Time_Known_Value (Right_Opnd (Orig)) + and then Nkind (Original_Node (Left_Opnd (Orig))) = + N_Attribute_Reference + then + return; + end if; + -- See if this is in a statement or a declaration P := Parent (C); @@ -3248,16 +3256,16 @@ package body Sem_Warn is and then Nkind (Cond) /= N_Op_Not then Error_Msg_NE - ("object & is always True?", Cond, Original_Node (C)); + ("object & is always True?c?", Cond, Original_Node (C)); Track (Original_Node (C), Cond); else - Error_Msg_N ("condition is always True?", Cond); + Error_Msg_N ("condition is always True?c?", Cond); Track (Cond, Cond); end if; else - Error_Msg_N ("condition is always False?", Cond); + Error_Msg_N ("condition is always False?c?", Cond); Track (Cond, Cond); end if; end; @@ -3387,23 +3395,23 @@ package body Sem_Warn is then if Act1 = First_Actual (N) then Error_Msg_FE - ("`IN OUT` prefix overlaps with actual for&?", - Act1, Form); + ("`IN OUT` prefix overlaps with " + & "actual for&?I?", Act1, Form); else -- For greater clarity, give name of formal. Error_Msg_Node_2 := Form; Error_Msg_FE - ("writable actual for & overlaps with" - & " actual for&?", Act1, Form); + ("writable actual for & overlaps with " + & "actual for&?I?", Act1, Form); end if; else Error_Msg_Node_2 := Form; Error_Msg_FE ("writable actual for & overlaps with" - & " actual for&?", Act1, Form1); + & " actual for&?I?", Act1, Form1); end if; end; end if; @@ -3513,7 +3521,7 @@ package body Sem_Warn is begin Error_Msg_Uint_1 := Low_Bound; Error_Msg_FE -- CODEFIX - ("?index for& may assume lower bound of^", X, Ent); + ("?w?index for& may assume lower bound of^", X, Ent); end Warn1; -- Start of processing for Test_Suspicious_Index @@ -3538,11 +3546,11 @@ package body Sem_Warn is if Nkind (Original_Node (X)) = N_Integer_Literal then if Intval (X) = Low_Bound then Error_Msg_FE -- CODEFIX - ("\suggested replacement: `&''First`", X, Ent); + ("\?w?suggested replacement: `&''First`", X, Ent); else Error_Msg_Uint_1 := Intval (X) - Low_Bound; Error_Msg_FE -- CODEFIX - ("\suggested replacement: `&''First + ^`", X, Ent); + ("\?w?suggested replacement: `&''First + ^`", X, Ent); end if; @@ -3648,7 +3656,7 @@ package body Sem_Warn is -- Replacement subscript is now in string buffer Error_Msg_FE -- CODEFIX - ("\suggested replacement: `&~`", Original_Node (X), Ent); + ("\?w?suggested replacement: `&~`", Original_Node (X), Ent); end if; -- Case where subscript is of the form X'Length @@ -3657,7 +3665,7 @@ package body Sem_Warn is Warn1; Error_Msg_Node_2 := Ent; Error_Msg_FE - ("\suggest replacement of `&''Length` by `&''Last`", + ("\?w?suggest replacement of `&''Length` by `&''Last`", X, Ent); -- Case where subscript is of the form X'Length - expression @@ -3668,7 +3676,7 @@ package body Sem_Warn is Warn1; Error_Msg_Node_2 := Ent; Error_Msg_FE - ("\suggest replacement of `&''Length` by `&''Last`", + ("\?w?suggest replacement of `&''Length` by `&''Last`", Left_Opnd (X), Ent); end if; end Test_Suspicious_Index; @@ -3796,7 +3804,7 @@ package body Sem_Warn is then if not Has_Pragma_Unmodified_Check_Spec (E) then Error_Msg_N -- CODEFIX - ("?variable & is assigned but never read!", E); + ("?u?variable & is assigned but never read!", E); end if; Set_Last_Assignment (E, Empty); @@ -3820,10 +3828,10 @@ package body Sem_Warn is and then Comes_From_Source (Renamed_Object (E)) then Error_Msg_N -- CODEFIX - ("?renamed variable & is not referenced!", E); + ("?u?renamed variable & is not referenced!", E); else Error_Msg_N -- CODEFIX - ("?variable & is not referenced!", E); + ("?u?variable & is not referenced!", E); end if; end if; end if; @@ -3833,10 +3841,10 @@ package body Sem_Warn is and then Comes_From_Source (Renamed_Object (E)) then Error_Msg_N -- CODEFIX - ("?renamed constant & is not referenced!", E); + ("?u?renamed constant & is not referenced!", E); else Error_Msg_N -- CODEFIX - ("?constant & is not referenced!", E); + ("?u?constant & is not referenced!", E); end if; when E_In_Parameter | @@ -3845,8 +3853,8 @@ package body Sem_Warn is -- Do not emit message for formals of a renaming, because -- they are never referenced explicitly. - if Nkind (Original_Node (Unit_Declaration_Node (Scope (E)))) - /= N_Subprogram_Renaming_Declaration + if Nkind (Original_Node (Unit_Declaration_Node (Scope (E)))) /= + N_Subprogram_Renaming_Declaration then -- Suppress this message for an IN OUT parameter of a -- non-scalar type, since it is normal to have only an @@ -3862,7 +3870,7 @@ package body Sem_Warn is if not Is_Trivial_Subprogram (Scope (E)) then Error_Msg_NE -- CODEFIX - ("?formal parameter & is not referenced!", + ("?u?formal parameter & is not referenced!", E, Spec_E); end if; end if; @@ -3872,56 +3880,56 @@ package body Sem_Warn is null; when E_Discriminant => - Error_Msg_N ("?discriminant & is not referenced!", E); + Error_Msg_N ("?u?discriminant & is not referenced!", E); when E_Named_Integer | E_Named_Real => Error_Msg_N -- CODEFIX - ("?named number & is not referenced!", E); + ("?u?named number & is not referenced!", E); when Formal_Object_Kind => Error_Msg_N -- CODEFIX - ("?formal object & is not referenced!", E); + ("?u?formal object & is not referenced!", E); when E_Enumeration_Literal => Error_Msg_N -- CODEFIX - ("?literal & is not referenced!", E); + ("?u?literal & is not referenced!", E); when E_Function => Error_Msg_N -- CODEFIX - ("?function & is not referenced!", E); + ("?u?function & is not referenced!", E); when E_Procedure => Error_Msg_N -- CODEFIX - ("?procedure & is not referenced!", E); + ("?u?procedure & is not referenced!", E); when E_Package => Error_Msg_N -- CODEFIX - ("?package & is not referenced!", E); + ("?u?package & is not referenced!", E); when E_Exception => Error_Msg_N -- CODEFIX - ("?exception & is not referenced!", E); + ("?u?exception & is not referenced!", E); when E_Label => Error_Msg_N -- CODEFIX - ("?label & is not referenced!", E); + ("?u?label & is not referenced!", E); when E_Generic_Procedure => Error_Msg_N -- CODEFIX - ("?generic procedure & is never instantiated!", E); + ("?u?generic procedure & is never instantiated!", E); when E_Generic_Function => Error_Msg_N -- CODEFIX - ("?generic function & is never instantiated!", E); + ("?u?generic function & is never instantiated!", E); when Type_Kind => Error_Msg_N -- CODEFIX - ("?type & is not referenced!", E); + ("?u?type & is not referenced!", E); when others => Error_Msg_N -- CODEFIX - ("?& is not referenced!", E); + ("?u?& is not referenced!", E); end case; -- Kill warnings on the entity on which the message has been posted @@ -4023,12 +4031,12 @@ package body Sem_Warn is N_Parameter_Association) then Error_Msg_NE - ("?& modified by call, but value never " + ("?m?& modified by call, but value never " & "referenced", LA, Ent); else Error_Msg_NE -- CODEFIX - ("?useless assignment to&, value never " + ("?m?useless assignment to&, value never " & "referenced!", LA, Ent); end if; end if; @@ -4050,11 +4058,11 @@ package body Sem_Warn is N_Parameter_Association) then Error_Msg_NE - ("?& modified by call, but value overwritten #!", + ("?m?& modified by call, but value overwritten #!", LA, Ent); else Error_Msg_NE -- CODEFIX - ("?useless assignment to&, value overwritten #!", + ("?m?useless assignment to&, value overwritten #!", LA, Ent); end if; end; diff --git a/gcc/ada/sinput-l.adb b/gcc/ada/sinput-l.adb index 59d2aed4f99..64a7cdb68b4 100644 --- a/gcc/ada/sinput-l.adb +++ b/gcc/ada/sinput-l.adb @@ -668,7 +668,7 @@ package body Sinput.L is if not Status then Errout.Error_Msg - ("?could not write processed file """ & + ("??could not write processed file """ & Name_Buffer (1 .. Name_Len) & '"', Lo); end if; diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index bffa6004ba7..2cb296dd1be 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -366,6 +366,7 @@ package Snames is Name_Assume_No_Invalid_Values : constant Name_Id := N + $; -- GNAT Name_Attribute_Definition : constant Name_Id := N + $; -- GNAT Name_C_Pass_By_Copy : constant Name_Id := N + $; -- GNAT + Name_Check_Float_Overflow : constant Name_Id := N + $; -- GNAT Name_Check_Name : constant Name_Id := N + $; -- GNAT Name_Check_Policy : constant Name_Id := N + $; -- GNAT Name_Compile_Time_Error : constant Name_Id := N + $; -- GNAT @@ -1665,6 +1666,7 @@ package Snames is Pragma_Assume_No_Invalid_Values, Pragma_Attribute_Definition, Pragma_C_Pass_By_Copy, + Pragma_Check_Float_Overflow, Pragma_Check_Name, Pragma_Check_Policy, Pragma_Compile_Time_Error, diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb index e80708e67b0..bfa245fd9dc 100644 --- a/gcc/ada/sprint.adb +++ b/gcc/ada/sprint.adb @@ -1159,14 +1159,19 @@ package body Sprint is when N_Case_Expression => declare - Alt : Node_Id; + Has_Parens : constant Boolean := Paren_Count (Node) > 0; + Alt : Node_Id; begin -- The syntax for case_expression does not include parentheses, -- but sometimes parentheses are required, so unconditionally - -- generate them here. + -- generate them here unless already present. - Write_Str_With_Col_Check_Sloc ("(case "); + if not Has_Parens then + Write_Char ('('); + end if; + + Write_Str_With_Col_Check_Sloc ("case "); Sprint_Node (Expression (Node)); Write_Str_With_Col_Check (" is"); @@ -1178,7 +1183,9 @@ package body Sprint is Write_Char (','); end loop; - Write_Char (')'); + if not Has_Parens then + Write_Char (')'); + end if; end; when N_Case_Expression_Alternative => @@ -1963,15 +1970,19 @@ package body Sprint is when N_If_Expression => declare - Condition : constant Node_Id := First (Expressions (Node)); - Then_Expr : constant Node_Id := Next (Condition); + Has_Parens : constant Boolean := Paren_Count (Node) > 0; + Condition : constant Node_Id := First (Expressions (Node)); + Then_Expr : constant Node_Id := Next (Condition); begin -- The syntax for if_expression does not include parentheses, -- but sometimes parentheses are required, so unconditionally - -- generate them here. + -- generate them here unless already present. - Write_Str_With_Col_Check_Sloc ("(if "); + if not Has_Parens then + Write_Char ('('); + end if; + Write_Str_With_Col_Check_Sloc ("if "); Sprint_Node (Condition); Write_Str_With_Col_Check (" then "); @@ -1979,11 +1990,16 @@ package body Sprint is if Present (Then_Expr) then Sprint_Node (Then_Expr); - Write_Str_With_Col_Check (" else "); - Sprint_Node (Next (Then_Expr)); + + if Present (Next (Then_Expr)) then + Write_Str_With_Col_Check (" else "); + Sprint_Node (Next (Then_Expr)); + end if; end if; - Write_Char (')'); + if not Has_Parens then + Write_Char (')'); + end if; end; when N_If_Statement => diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index 920b2a5773a..ebb18b0c401 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -514,6 +514,12 @@ package body Switch.C is Ptr := Ptr + 1; Full_Path_Name_For_Brief_Errors := True; + -- -gnateF (Check_Float_Overflow) + + when 'F' => + Ptr := Ptr + 1; + Check_Float_Overflow := True; + -- -gnateG (save preprocessor output) when 'G' => @@ -612,6 +618,7 @@ package body Switch.C is when 'S' => Generate_SCO := True; + Generate_SCO_Instance_Table := True; Ptr := Ptr + 1; -- -gnatet (generate target dependent information) diff --git a/gcc/ada/switch-m.adb b/gcc/ada/switch-m.adb index 0d769dc09f1..4f18ec11c54 100644 --- a/gcc/ada/switch-m.adb +++ b/gcc/ada/switch-m.adb @@ -214,6 +214,12 @@ package body Switch.M is then Add_Switch_Component (Switch_Chars); + -- Special case for -fstack-check (alias for + -- -fstack-check=specific) + + elsif Switch_Chars = "-fstack-check" then + Add_Switch_Component ("-fstack-check=specific"); + -- Take only into account switches that are transmitted to -- gnat1 by the gcc driver and stored by gnat1 in the ALI file. diff --git a/gcc/ada/targext.c b/gcc/ada/targext.c index 6a9f970c286..f51301bda1d 100644 --- a/gcc/ada/targext.c +++ b/gcc/ada/targext.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 2005-2011, Free Software Foundation, Inc. * + * Copyright (C) 2005-2012, Free Software Foundation, Inc. * * * * GNAT is free software; you can redistribute it and/or modify it under * * terms of the GNU General Public License as published by the Free Soft- * @@ -35,10 +35,6 @@ Note that, in order to have access to the TARGET_* macros used below, the file must be compiled with IN_GCC defined, even for the library. */ -#ifdef __cplusplus -extern "C" { -#endif - #ifdef IN_RTS #include "tconfig.h" #include "tsystem.h" @@ -57,6 +53,10 @@ extern "C" { #define TARGET_EXECUTABLE_SUFFIX "" #endif +#ifdef __cplusplus +extern "C" { +#endif + const char *__gnat_target_object_extension = TARGET_OBJECT_SUFFIX; const char *__gnat_target_executable_extension = TARGET_EXECUTABLE_SUFFIX; const char *__gnat_target_debuggable_extension = TARGET_EXECUTABLE_SUFFIX; diff --git a/gcc/ada/targparm.adb b/gcc/ada/targparm.adb index ae801555d0b..5ed84083a8a 100644 --- a/gcc/ada/targparm.adb +++ b/gcc/ada/targparm.adb @@ -554,7 +554,7 @@ package body Targparm is case K is when AAM => AAMP_On_Target := Result; when ACR => Always_Compatible_Rep_On_Target := Result; - when ASD => Atomic_Sync_Default := Result; + when ASD => Atomic_Sync_Default_On_Target := Result; when BDC => Backend_Divide_Checks_On_Target := Result; when BOC => Backend_Overflow_Checks_On_Target := Result; when CLA => Command_Line_Args_On_Target := Result; diff --git a/gcc/ada/targparm.ads b/gcc/ada/targparm.ads index e3210c93664..5869f0c1013 100644 --- a/gcc/ada/targparm.ads +++ b/gcc/ada/targparm.ads @@ -388,7 +388,7 @@ package Targparm is -- used at the source level, and the corresponding flag is false, then an -- error message will be issued saying the feature is not supported. - Atomic_Sync_Default : Boolean := True; + Atomic_Sync_Default_On_Target : Boolean := True; -- Access to atomic variables requires memory barrier synchronization in -- the general case to ensure proper behavior when such accesses are used -- on a multi-processor to synchronize tasks (e.g. by using spin locks). diff --git a/gcc/ada/tracebak.c b/gcc/ada/tracebak.c index 01b96548baf..2c8335de68b 100644 --- a/gcc/ada/tracebak.c +++ b/gcc/ada/tracebak.c @@ -287,10 +287,9 @@ __gnat_backtrace (void **array, #error Unhandled darwin architecture. #endif -/*---------------------- PPC AIX/PPC Lynx 178/Older Darwin ------------------*/ +/*------------------------ PPC AIX/Older Darwin -------------------------*/ #elif ((defined (_POWER) && defined (_AIX)) || \ - (defined (__powerpc__) && defined (__Lynx__) && !defined(__ELF__)) || \ - (defined (__ppc__) && defined (__APPLE__))) +(defined (__ppc__) && defined (__APPLE__))) #define USE_GENERIC_UNWINDER @@ -308,23 +307,9 @@ struct layout should to feature a null backchain, AIX might expose a null return address instead. */ -/* Then LynxOS-178 features yet another variation, with return_address - == &__start, which we only add conditionally as this symbol is not - necessarily present elsewhere. Beware that &bla returns the - address of a descriptor when "bla" is a function. Getting the code - address requires an extra dereference. */ - -#if defined (__Lynx__) -extern void __start(); -#define EXTRA_STOP_CONDITION(CURRENT) ((CURRENT)->return_address == *(void**)&__start) -#else -#define EXTRA_STOP_CONDITION(CURRENT) (0) -#endif - #define STOP_FRAME(CURRENT, TOP_STACK) \ (((void *) (CURRENT) < (TOP_STACK)) \ - || (CURRENT)->return_address == NULL \ - || EXTRA_STOP_CONDITION(CURRENT)) + || (CURRENT)->return_address == NULL) /* The PPC ABI has an interesting specificity: the return address saved by a function is located in it's caller's frame, and the save operation only diff --git a/gcc/ada/tree_io.ads b/gcc/ada/tree_io.ads index 9fa2121f4cd..1f5b90059eb 100644 --- a/gcc/ada/tree_io.ads +++ b/gcc/ada/tree_io.ads @@ -47,7 +47,7 @@ package Tree_IO is Tree_Format_Error : exception; -- Raised if a format error is detected in the input file - ASIS_Version_Number : constant := 29; + ASIS_Version_Number : constant := 30; -- ASIS Version. This is used to check for consistency between the compiler -- used to generate trees and an ASIS application that is reading the -- trees. It must be incremented whenever a change is made to the tree @@ -58,6 +58,7 @@ package Tree_IO is -- 28 Changes in Snames -- 29 Changes in Sem_Ch3 (tree copying in case of discriminant constraint -- for concurrent types). + -- 30 Add Check_Float_Overflow boolean to tree file procedure Tree_Read_Initialize (Desc : File_Descriptor); -- Called to initialize reading of a tree file. This call must be made diff --git a/gcc/ada/ug_words b/gcc/ada/ug_words index b1b45c407cb..10f03f5c6f3 100644 --- a/gcc/ada/ug_words +++ b/gcc/ada/ug_words @@ -58,10 +58,13 @@ gcc -c ^ GNAT COMPILE -gnatC ^ /COMPRESS_NAMES -gnatDG ^ /XDEBUG /EXPAND_SOURCEA -gnatD ^ /XDEBUG +-gnateA ^ /ALIASING_CHECK -gnatec ^ /CONFIGURATION_PRAGMAS_FILE --gnateE ^ /EXTRA_EXCEPTION_INFORMATION +-gnated ^ /DISABLE_ATOMIC_SYNCHRONIZATION -gnateD ^ /SYMBOL_PREPROCESSING +-gnateE ^ /EXTRA_EXCEPTION_INFORMATION -gnatef ^ /FULL_PATH_IN_BRIEF_MESSAGES +-gnateF ^ /FLOAT_OVERFLOW_CHECK -gnateG ^ /GENERATE_PROCESSED_SOURCE -gnatei ^ /MAX_INSTANTIATIONS= -gnateI ^ /MULTI_UNIT_INDEX= @@ -69,6 +72,8 @@ gcc -c ^ GNAT COMPILE -gnatep ^ /DATA_PREPROCESSING -gnateP ^ /CATEGORIZATION_WARNINGS -gnateS ^ /SCO_OUTPUT +-gnatet ^ /TARGET_DEPENDENT_INFO +-gnateV ^ /PARAMETER_VALIDITY_CHECK -gnatE ^ /CHECKS=ELABORATION -gnatf ^ /REPORT_ERRORS=FULL -gnatF ^ /UPPERCASE_EXTERNALS diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index 6b6605d8eb6..769afdeba1a 100644 --- a/gcc/ada/usage.adb +++ b/gcc/ada/usage.adb @@ -167,6 +167,11 @@ begin Write_Switch_Char ("Dnn"); Write_Line ("Debug expanded generated code (max line length = nn)"); + -- Line for -gnatea switch + + Write_Switch_Char ("ea"); + Write_Line ("Delimiter for automatically added switches (internal switch)"); + -- Line for -gnateA switch Write_Switch_Char ("eA"); @@ -217,6 +222,11 @@ begin Write_Switch_Char ("em=?"); Write_Line ("Specify mapping file, e.g. -gnatem=mapping"); + -- Line for -gnateO=? + + Write_Switch_Char ("eO=?"); + Write_Line ("Specify an object path file (internal switch)"); + -- Line for -gnatep switch Write_Switch_Char ("ep=?"); @@ -242,6 +252,11 @@ begin Write_Switch_Char ("eV"); Write_Line ("Validity checks on subprogram parameters"); + -- Line for -gnatez switch + + Write_Switch_Char ("ez"); + Write_Line ("Delimiter for automatically added switches (internal switch)"); + -- Line for -gnatE switch Write_Switch_Char ("E"); @@ -526,8 +541,8 @@ begin Write_Line (" .S* turn off warnings for overridden size clause"); Write_Line (" t turn on warnings for tracking deleted code"); Write_Line (" T* turn off warnings for tracking deleted code"); - Write_Line (" .t+ turn on warnings for suspicious contract"); - Write_Line (" .T* turn off warnings for suspicious contract"); + Write_Line (" .t*+ turn on warnings for suspicious contract"); + Write_Line (" .T turn off warnings for suspicious contract"); Write_Line (" u+ turn on warnings for unused entity"); Write_Line (" U* turn off warnings for unused entity"); Write_Line (" .u turn on warnings for unordered enumeration"); diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads index 69fe509b3e2..ed6f1b5c4fc 100644 --- a/gcc/ada/vms_data.ads +++ b/gcc/ada/vms_data.ads @@ -1275,11 +1275,18 @@ package VMS_Data is -- Equivalent to /12 (/2012 is the preferred usage). S_GCC_Add : aliased constant S := "/ADD_PROJECT_SEARCH_DIR=*" & - "-aP*"; + "-aP*"; -- /ADD_PROJECT_SEARCH_PATH=(directory[,...]) -- -- Add directories to the project search path. + S_GCC_AlCheck : aliased constant S := "/ALIASING_CHECK " & + "-gnateA"; + -- /NOALIASING_CHECK (D) + -- /ALIASING_CHECK + -- + -- Check that there are no aliased parameters in subprogram calls. + S_GCC_Asm : aliased constant S := "/ASM " & "-S,!-c"; -- /NOASM (D) @@ -1398,6 +1405,14 @@ package VMS_Data is "-gnatp,!-gnato,!-gnatE"; -- NODOC (see /CHECKS) + S_GCC_Chflov : aliased constant S := "/FLOAT_OVERFLOW_CHECK " & + "-gnateF"; + -- /NOFLOAT_OVERFLOW_CHECK (D) + -- /FLOAT_OVERFLOW_CHECK + -- + -- Set mode to check overflow for all floating-point operations including + -- those using an unconstrained predefined type (i.e. no infinities). + S_GCC_Compres : aliased constant S := "/COMPRESS_NAMES " & "-gnatC"; -- /NOCOMPRESS_NAMES (D) @@ -1414,7 +1429,8 @@ package VMS_Data is "-gnatec>"; -- /CONFIGURATION_PRAGMAS_FILE=file -- - -- Specify a configuration pragmas file that need to be taken into account + -- Specify a configuration pragmas file that needs to be taken into + -- account. S_GCC_Current : aliased constant S := "/CURRENT_DIRECTORY " & "!-I-"; @@ -1534,6 +1550,12 @@ package VMS_Data is "!-g"; -- NODOC (see /Debug) + S_GCC_DisAtom : aliased constant S := "/DISABLE_ATOMIC_SYNCHRONIZATION " & + "-gnated"; + -- /NODISABLE_ATOMIC_SYNCHRONIZATION (D) + -- /DISABLE_ATOMIC_SYNCHRONIZATION + -- Disable synchronization of atomic variables. + S_GCC_Dist : aliased constant S := "/DISTRIBUTION_STUBS=" & "RECEIVER " & "-gnatzr " & @@ -2126,6 +2148,13 @@ package VMS_Data is -- assertion, and the second digit sets the mode for expressions within -- an assertion. + S_GCC_PValid : aliased constant S := "/PARAMETER_VALIDITY_CHECK " & + "-gnateV"; + -- /NOPARAMETER_VALIDITY_CHECK (D) + -- /PARAMETER_VALIDITY_CHECK + -- + -- Check validity of subprogram parameters. + S_GCC_Pointer : aliased constant S := "/POINTER_SIZE=" & "64 " & "-mmalloc64 " & @@ -2837,6 +2866,13 @@ package VMS_Data is -- -- All compiler tables start at nnn times usual starting size. + S_GCC_Target : aliased constant S := "/TARGET_DEPENDENT_INFO " & + "-gnatet"; + -- /NOTARGET_DEPENDENT_INFO (D) + -- /TARGET_DEPENDENT_INFO + -- + -- Generate target dependent information. + S_GCC_Trace : aliased constant S := "/TRACE_UNITS " & "-gnatdc"; -- /TRACE_UNITS @@ -3592,10 +3628,12 @@ package VMS_Data is S_GCC_Ada_12 'Access, S_GCC_Ada_2012'Access, S_GCC_Add 'Access, + S_GCC_AlCheck 'Access, S_GCC_Asm 'Access, S_GCC_AValid 'Access, S_GCC_CategW 'Access, S_GCC_Checks 'Access, + S_GCC_Chflov 'Access, S_GCC_ChecksX 'Access, S_GCC_Compres 'Access, S_GCC_Config 'Access, @@ -3603,6 +3641,7 @@ package VMS_Data is S_GCC_Debug 'Access, S_GCC_DebugX 'Access, S_GCC_Data 'Access, + S_GCC_DisAtom 'Access, S_GCC_Dist 'Access, S_GCC_DistX 'Access, S_GCC_Error 'Access, @@ -3645,6 +3684,7 @@ package VMS_Data is S_GCC_Opt 'Access, S_GCC_OptX 'Access, S_GCC_Overflo 'Access, + S_GCC_PValid 'Access, S_GCC_Pointer 'Access, S_GCC_Polling 'Access, S_GCC_Project 'Access, @@ -3663,6 +3703,7 @@ package VMS_Data is S_GCC_Symbol 'Access, S_GCC_Syntax 'Access, S_GCC_Table 'Access, + S_GCC_Target 'Access, S_GCC_Trace 'Access, S_GCC_Tree 'Access, S_GCC_Trys 'Access, @@ -6097,6 +6138,7 @@ package VMS_Data is -- By default, the form of the line terminator depends on the platforms. -- On Unix and VMS, it is a Line Feed (LF) character. On Windows (DOS), -- It is a Carriage Return (CR) followed by a Line Feed. + -- The Options DOS and CRLF are equivalent. The options UNIX and LF are -- also equivalent. diff --git a/gcc/ada/warnsw.adb b/gcc/ada/warnsw.adb index 7920ac90269..a8d31e45231 100644 --- a/gcc/ada/warnsw.adb +++ b/gcc/ada/warnsw.adb @@ -22,8 +22,8 @@ -- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ - -with Opt; use Opt; +with Err_Vars; use Err_Vars; +with Opt; use Opt; package body Warnsw is @@ -52,6 +52,12 @@ package body Warnsw is when 'C' => Warn_On_Unrepped_Components := False; + when 'd' => + Warning_Doc_Switch := True; + + when 'D' => + Warning_Doc_Switch := False; + when 'e' => Address_Clause_Overlay_Warnings := True; Check_Unreferenced := True; diff --git a/gcc/ada/warnsw.ads b/gcc/ada/warnsw.ads index f802bb7790a..45983e95114 100644 --- a/gcc/ada/warnsw.ads +++ b/gcc/ada/warnsw.ads @@ -44,12 +44,13 @@ package Warnsw is Warn_On_Overridden_Size : Boolean := False; -- Warn when explicit record component clause or array component_size -- clause specifies a size that overrides a size for the typen which was - -- set with an explicit size clause. Off by default, set by -gnatw.s (but - -- not -gnatwa). + -- set with an explicit size clause. Off by default, modified by use of + -- -gnatw.s/.S, but not set by -gnatwa. Warn_On_Standard_Redefinition : Boolean := False; -- Warn when a program defines an identifier that matches a name in - -- Standard. Off by default, set by -gnatw.k (and also by -gnatwa). + -- Standard. Off by default, modified by use of -gnatw.k/.K, but not + -- affected by -gnatwa. ----------------- -- Subprograms -- diff --git a/gcc/builtins.c b/gcc/builtins.c index fb7b537ca2c..67c96df2689 100644 --- a/gcc/builtins.c +++ b/gcc/builtins.c @@ -2031,7 +2031,7 @@ expand_builtin_mathfn (tree exp, rtx target, rtx subtarget) if (optab_handler (builtin_optab, mode) != CODE_FOR_nothing && (!errno_set || !optimize_insn_for_size_p ())) { - target = gen_reg_rtx (mode); + rtx result = gen_reg_rtx (mode); /* Wrap the computation of the argument in a SAVE_EXPR, as we may need to expand the argument again. This way, we will not perform @@ -2042,20 +2042,20 @@ expand_builtin_mathfn (tree exp, rtx target, rtx subtarget) start_sequence (); - /* Compute into TARGET. - Set TARGET to wherever the result comes back. */ - target = expand_unop (mode, builtin_optab, op0, target, 0); + /* Compute into RESULT. + Set RESULT to wherever the result comes back. */ + result = expand_unop (mode, builtin_optab, op0, result, 0); - if (target != 0) + if (result != 0) { if (errno_set) - expand_errno_check (exp, target); + expand_errno_check (exp, result); /* Output the entire sequence. */ insns = get_insns (); end_sequence (); emit_insn (insns); - return target; + return result; } /* If we were unable to expand via the builtin, stop the sequence @@ -2078,7 +2078,7 @@ static rtx expand_builtin_mathfn_2 (tree exp, rtx target, rtx subtarget) { optab builtin_optab; - rtx op0, op1, insns; + rtx op0, op1, insns, result; int op1_type = REAL_TYPE; tree fndecl = get_callee_fndecl (exp); tree arg0, arg1; @@ -2134,7 +2134,7 @@ expand_builtin_mathfn_2 (tree exp, rtx target, rtx subtarget) if (optab_handler (builtin_optab, mode) == CODE_FOR_nothing) return NULL_RTX; - target = gen_reg_rtx (mode); + result = gen_reg_rtx (mode); if (! flag_errno_math || ! HONOR_NANS (mode)) errno_set = false; @@ -2151,29 +2151,29 @@ expand_builtin_mathfn_2 (tree exp, rtx target, rtx subtarget) start_sequence (); - /* Compute into TARGET. - Set TARGET to wherever the result comes back. */ - target = expand_binop (mode, builtin_optab, op0, op1, - target, 0, OPTAB_DIRECT); + /* Compute into RESULT. + Set RESULT to wherever the result comes back. */ + result = expand_binop (mode, builtin_optab, op0, op1, + result, 0, OPTAB_DIRECT); /* If we were unable to expand via the builtin, stop the sequence (without outputting the insns) and call to the library function with the stabilized argument list. */ - if (target == 0) + if (result == 0) { end_sequence (); return expand_call (exp, target, target == const0_rtx); } if (errno_set) - expand_errno_check (exp, target); + expand_errno_check (exp, result); /* Output the entire sequence. */ insns = get_insns (); end_sequence (); emit_insn (insns); - return target; + return result; } /* Expand a call to the builtin trinary math functions (fma). @@ -2187,7 +2187,7 @@ static rtx expand_builtin_mathfn_ternary (tree exp, rtx target, rtx subtarget) { optab builtin_optab; - rtx op0, op1, op2, insns; + rtx op0, op1, op2, insns, result; tree fndecl = get_callee_fndecl (exp); tree arg0, arg1, arg2; enum machine_mode mode; @@ -2214,7 +2214,7 @@ expand_builtin_mathfn_ternary (tree exp, rtx target, rtx subtarget) if (optab_handler (builtin_optab, mode) == CODE_FOR_nothing) return NULL_RTX; - target = gen_reg_rtx (mode); + result = gen_reg_rtx (mode); /* Always stabilize the argument list. */ CALL_EXPR_ARG (exp, 0) = arg0 = builtin_save_expr (arg0); @@ -2227,15 +2227,15 @@ expand_builtin_mathfn_ternary (tree exp, rtx target, rtx subtarget) start_sequence (); - /* Compute into TARGET. - Set TARGET to wherever the result comes back. */ - target = expand_ternary_op (mode, builtin_optab, op0, op1, op2, - target, 0); + /* Compute into RESULT. + Set RESULT to wherever the result comes back. */ + result = expand_ternary_op (mode, builtin_optab, op0, op1, op2, + result, 0); /* If we were unable to expand via the builtin, stop the sequence (without outputting the insns) and call to the library function with the stabilized argument list. */ - if (target == 0) + if (result == 0) { end_sequence (); return expand_call (exp, target, target == const0_rtx); @@ -2246,7 +2246,7 @@ expand_builtin_mathfn_ternary (tree exp, rtx target, rtx subtarget) end_sequence (); emit_insn (insns); - return target; + return result; } /* Expand a call to the builtin sin and cos math functions. @@ -2298,7 +2298,7 @@ expand_builtin_mathfn_3 (tree exp, rtx target, rtx subtarget) /* Before working hard, check whether the instruction is available. */ if (optab_handler (builtin_optab, mode) != CODE_FOR_nothing) { - target = gen_reg_rtx (mode); + rtx result = gen_reg_rtx (mode); /* Wrap the computation of the argument in a SAVE_EXPR, as we may need to expand the argument again. This way, we will not perform @@ -2309,37 +2309,35 @@ expand_builtin_mathfn_3 (tree exp, rtx target, rtx subtarget) start_sequence (); - /* Compute into TARGET. - Set TARGET to wherever the result comes back. */ + /* Compute into RESULT. + Set RESULT to wherever the result comes back. */ if (builtin_optab == sincos_optab) { - int result; + int ok; switch (DECL_FUNCTION_CODE (fndecl)) { CASE_FLT_FN (BUILT_IN_SIN): - result = expand_twoval_unop (builtin_optab, op0, 0, target, 0); + ok = expand_twoval_unop (builtin_optab, op0, 0, result, 0); break; CASE_FLT_FN (BUILT_IN_COS): - result = expand_twoval_unop (builtin_optab, op0, target, 0, 0); + ok = expand_twoval_unop (builtin_optab, op0, result, 0, 0); break; default: gcc_unreachable (); } - gcc_assert (result); + gcc_assert (ok); } else - { - target = expand_unop (mode, builtin_optab, op0, target, 0); - } + result = expand_unop (mode, builtin_optab, op0, result, 0); - if (target != 0) + if (result != 0) { /* Output the entire sequence. */ insns = get_insns (); end_sequence (); emit_insn (insns); - return target; + return result; } /* If we were unable to expand via the builtin, stop the sequence @@ -2348,9 +2346,7 @@ expand_builtin_mathfn_3 (tree exp, rtx target, rtx subtarget) end_sequence (); } - target = expand_call (exp, target, target == const0_rtx); - - return target; + return expand_call (exp, target, target == const0_rtx); } /* Given an interclass math builtin decl FNDECL and it's argument ARG @@ -2819,7 +2815,7 @@ expand_builtin_int_roundingfn_2 (tree exp, rtx target) /* There's no easy way to detect the case we need to set EDOM. */ if (!flag_errno_math) { - target = gen_reg_rtx (mode); + rtx result = gen_reg_rtx (mode); /* Wrap the computation of the argument in a SAVE_EXPR, as we may need to expand the argument again. This way, we will not perform @@ -2830,13 +2826,13 @@ expand_builtin_int_roundingfn_2 (tree exp, rtx target) start_sequence (); - if (expand_sfix_optab (target, op0, builtin_optab)) + if (expand_sfix_optab (result, op0, builtin_optab)) { /* Output the entire sequence. */ insns = get_insns (); end_sequence (); emit_insn (insns); - return target; + return result; } /* If we were unable to expand via the builtin, stop the sequence @@ -2863,9 +2859,7 @@ expand_builtin_int_roundingfn_2 (tree exp, rtx target) return convert_to_mode (mode, target, 0); } - target = expand_call (exp, target, target == const0_rtx); - - return target; + return expand_call (exp, target, target == const0_rtx); } /* Expand a call to the powi built-in mathematical function. Return NULL_RTX if diff --git a/gcc/c-family/c-common.c b/gcc/c-family/c-common.c index 872a6a0feed..012751330f3 100644 --- a/gcc/c-family/c-common.c +++ b/gcc/c-family/c-common.c @@ -8742,8 +8742,12 @@ handle_target_attribute (tree *node, tree name, tree args, int flags, warning (OPT_Wattributes, "%qE attribute ignored", name); *no_add_attrs = true; } + /* Do not strip invalid target attributes for targets which support function + multiversioning as the target string is used to determine versioned + functions. */ else if (! targetm.target_option.valid_attribute_p (*node, name, args, - flags)) + flags) + && ! targetm.target_option.supports_function_versions ()) *no_add_attrs = true; return NULL_TREE; diff --git a/gcc/cfgloop.c b/gcc/cfgloop.c index b45493a16bb..c15e64945f4 100644 --- a/gcc/cfgloop.c +++ b/gcc/cfgloop.c @@ -1666,3 +1666,55 @@ loop_exits_from_bb_p (struct loop *loop, basic_block bb) return false; } + +/* Return location corresponding to the loop control condition if possible. */ + +location_t +get_loop_location (struct loop *loop) +{ + rtx insn = NULL; + struct niter_desc *desc = NULL; + edge exit; + + /* For a for or while loop, we would like to return the location + of the for or while statement, if possible. To do this, look + for the branch guarding the loop back-edge. */ + + /* If this is a simple loop with an in_edge, then the loop control + branch is typically at the end of its source. */ + desc = get_simple_loop_desc (loop); + if (desc->in_edge) + { + FOR_BB_INSNS_REVERSE (desc->in_edge->src, insn) + { + if (INSN_P (insn) && INSN_HAS_LOCATION (insn)) + return INSN_LOCATION (insn); + } + } + /* If loop has a single exit, then the loop control branch + must be at the end of its source. */ + if ((exit = single_exit (loop))) + { + FOR_BB_INSNS_REVERSE (exit->src, insn) + { + if (INSN_P (insn) && INSN_HAS_LOCATION (insn)) + return INSN_LOCATION (insn); + } + } + /* Next check the latch, to see if it is non-empty. */ + FOR_BB_INSNS_REVERSE (loop->latch, insn) + { + if (INSN_P (insn) && INSN_HAS_LOCATION (insn)) + return INSN_LOCATION (insn); + } + /* Finally, if none of the above identifies the loop control branch, + return the first location in the loop header. */ + FOR_BB_INSNS (loop->header, insn) + { + if (INSN_P (insn) && INSN_HAS_LOCATION (insn)) + return INSN_LOCATION (insn); + } + /* If all else fails, simply return the current function location. */ + return DECL_SOURCE_LOCATION (current_function_decl); +} + diff --git a/gcc/cfgloop.h b/gcc/cfgloop.h index 9e2e02de93d..81e70d859c4 100644 --- a/gcc/cfgloop.h +++ b/gcc/cfgloop.h @@ -239,6 +239,7 @@ extern bool loop_exit_edge_p (const struct loop *, const_edge); extern bool loop_exits_to_bb_p (struct loop *, basic_block); extern bool loop_exits_from_bb_p (struct loop *, basic_block); extern void mark_loop_exit_edges (void); +extern location_t get_loop_location (struct loop *loop); /* Loops & cfg manipulation. */ extern basic_block *get_loop_body (const struct loop *); diff --git a/gcc/cgraph.c b/gcc/cgraph.c index 3af545671e1..444b4f0e957 100644 --- a/gcc/cgraph.c +++ b/gcc/cgraph.c @@ -2498,9 +2498,6 @@ verify_cgraph_node (struct cgraph_node *node) { if (this_cfun->cfg) { - /* The nodes we're interested in are never shared, so walk - the tree ignoring duplicates. */ - struct pointer_set_t *visited_nodes = pointer_set_create (); /* Reach the trees by walking over the CFG, and note the enclosing basic-blocks in the call edges. */ FOR_EACH_BB_FN (this_block, this_cfun) @@ -2550,7 +2547,6 @@ verify_cgraph_node (struct cgraph_node *node) } } } - pointer_set_destroy (visited_nodes); } else /* No CFG available?! */ diff --git a/gcc/cgraph.h b/gcc/cgraph.h index 28c3497c566..d783862c667 100644 --- a/gcc/cgraph.h +++ b/gcc/cgraph.h @@ -1357,7 +1357,6 @@ static inline bool symtab_real_symbol_p (symtab_node node) { struct cgraph_node *cnode; - struct ipa_ref *ref; if (!is_a <cgraph_node> (node)) return true; @@ -1366,11 +1365,6 @@ symtab_real_symbol_p (symtab_node node) return false; if (cnode->abstract_and_needed) return false; - /* We keep virtual clones in symtab. */ - if (!cnode->analyzed - || DECL_EXTERNAL (cnode->symbol.decl)) - return (cnode->callers - || ipa_ref_list_referring_iterate (&cnode->symbol.ref_list, 0, ref)); return true; } #endif /* GCC_CGRAPH_H */ diff --git a/gcc/config/aarch64/aarch64-cores.def b/gcc/config/aarch64/aarch64-cores.def index 06cc9825d39..4b77009ab7d 100644 --- a/gcc/config/aarch64/aarch64-cores.def +++ b/gcc/config/aarch64/aarch64-cores.def @@ -34,5 +34,7 @@ This list currently contains example CPUs that implement AArch64, and therefore serves as a template for adding more CPUs in the future. */ +AARCH64_CORE("cortex-a53", cortexa53, 8, AARCH64_FL_FPSIMD, generic) +AARCH64_CORE("cortex-a57", cortexa57, 8, AARCH64_FL_FPSIMD, generic) AARCH64_CORE("example-1", large, 8, AARCH64_FL_FPSIMD, generic) AARCH64_CORE("example-2", small, 8, AARCH64_FL_FPSIMD, generic) diff --git a/gcc/config/aarch64/aarch64-tune.md b/gcc/config/aarch64/aarch64-tune.md index a654a91b43b..02699e35c3f 100644 --- a/gcc/config/aarch64/aarch64-tune.md +++ b/gcc/config/aarch64/aarch64-tune.md @@ -1,5 +1,5 @@ ;; -*- buffer-read-only: t -*- ;; Generated automatically by gentune.sh from aarch64-cores.def (define_attr "tune" - "large,small" + "cortexa53,cortexa57,large,small" (const (symbol_ref "((enum attr_tune) aarch64_tune)"))) diff --git a/gcc/config/i386/i386.c b/gcc/config/i386/i386.c index b466a4fbbdf..60f68d45369 100644 --- a/gcc/config/i386/i386.c +++ b/gcc/config/i386/i386.c @@ -28945,47 +28945,6 @@ dispatch_function_versions (tree dispatch_decl, return 0; } -/* This function returns true if FN1 and FN2 are versions of the same function, - that is, the targets of the function decls are different. This assumes - that FN1 and FN2 have the same signature. */ - -static bool -ix86_function_versions (tree fn1, tree fn2) -{ - tree attr1, attr2; - struct cl_target_option *target1, *target2; - - if (TREE_CODE (fn1) != FUNCTION_DECL - || TREE_CODE (fn2) != FUNCTION_DECL) - return false; - - attr1 = DECL_FUNCTION_SPECIFIC_TARGET (fn1); - attr2 = DECL_FUNCTION_SPECIFIC_TARGET (fn2); - - /* Atleast one function decl should have target attribute specified. */ - if (attr1 == NULL_TREE && attr2 == NULL_TREE) - return false; - - if (attr1 == NULL_TREE) - attr1 = target_option_default_node; - else if (attr2 == NULL_TREE) - attr2 = target_option_default_node; - - target1 = TREE_TARGET_OPTION (attr1); - target2 = TREE_TARGET_OPTION (attr2); - - /* target1 and target2 must be different in some way. */ - if (target1->x_ix86_isa_flags == target2->x_ix86_isa_flags - && target1->x_target_flags == target2->x_target_flags - && target1->arch == target2->arch - && target1->tune == target2->tune - && target1->x_ix86_fpmath == target2->x_ix86_fpmath - && target1->branch_cost == target2->branch_cost) - return false; - - return true; -} - /* Comparator function to be used in qsort routine to sort attribute specification strings to "target". */ @@ -29098,6 +29057,60 @@ ix86_mangle_function_version_assembler_name (tree decl, tree id) return get_identifier (assembler_name); } +/* This function returns true if FN1 and FN2 are versions of the same function, + that is, the target strings of the function decls are different. This assumes + that FN1 and FN2 have the same signature. */ + +static bool +ix86_function_versions (tree fn1, tree fn2) +{ + tree attr1, attr2; + const char *attr_str1, *attr_str2; + char *target1, *target2; + bool result; + + if (TREE_CODE (fn1) != FUNCTION_DECL + || TREE_CODE (fn2) != FUNCTION_DECL) + return false; + + attr1 = lookup_attribute ("target", DECL_ATTRIBUTES (fn1)); + attr2 = lookup_attribute ("target", DECL_ATTRIBUTES (fn2)); + + /* At least one function decl should have the target attribute specified. */ + if (attr1 == NULL_TREE && attr2 == NULL_TREE) + return false; + + /* If one function does not have a target attribute, these are versions. */ + if (attr1 == NULL_TREE || attr2 == NULL_TREE) + return true; + + attr_str1 = TREE_STRING_POINTER (TREE_VALUE (TREE_VALUE (attr1))); + attr_str2 = TREE_STRING_POINTER (TREE_VALUE (TREE_VALUE (attr2))); + + target1 = sorted_attr_string (attr_str1); + target2 = sorted_attr_string (attr_str2); + + /* The sorted target strings must be different for fn1 and fn2 + to be versions. */ + if (strcmp (target1, target2) == 0) + result = false; + else + result = true; + + free (target1); + free (target2); + + return result; +} + +/* This target supports function multiversioning. */ + +static bool +ix86_supports_function_versions (void) +{ + return true; +} + static tree ix86_mangle_decl_assembler_name (tree decl, tree id) { @@ -29195,7 +29208,7 @@ is_function_default_version (const tree decl) { return (TREE_CODE (decl) == FUNCTION_DECL && DECL_FUNCTION_VERSIONED (decl) - && DECL_FUNCTION_SPECIFIC_TARGET (decl) == NULL_TREE); + && lookup_attribute ("target", DECL_ATTRIBUTES (decl)) == NULL_TREE); } /* Make a dispatcher declaration for the multi-versioned function DECL. @@ -29277,7 +29290,7 @@ ix86_get_function_versions_dispatcher (void *decl) /* Set the dispatcher for all the versions. */ it_v = default_version_info; - while (it_v->next != NULL) + while (it_v != NULL) { it_v->dispatcher_resolver = dispatch_decl; it_v = it_v->next; @@ -29613,15 +29626,9 @@ fold_builtin_cpu (tree fndecl, tree *args) {"avx2", F_AVX2} }; - static tree __processor_model_type = NULL_TREE; - static tree __cpu_model_var = NULL_TREE; - - if (__processor_model_type == NULL_TREE) - __processor_model_type = build_processor_model_struct (); - - if (__cpu_model_var == NULL_TREE) - __cpu_model_var = make_var_decl (__processor_model_type, - "__cpu_model"); + tree __processor_model_type = build_processor_model_struct (); + tree __cpu_model_var = make_var_decl (__processor_model_type, + "__cpu_model"); gcc_assert ((args != NULL) && (*args != NULL)); @@ -42463,6 +42470,10 @@ ix86_memmodel_check (unsigned HOST_WIDE_INT val) #undef TARGET_OPTION_FUNCTION_VERSIONS #define TARGET_OPTION_FUNCTION_VERSIONS ix86_function_versions +#undef TARGET_OPTION_SUPPORTS_FUNCTION_VERSIONS +#define TARGET_OPTION_SUPPORTS_FUNCTION_VERSIONS \ + ix86_supports_function_versions + #undef TARGET_CAN_INLINE_P #define TARGET_CAN_INLINE_P ix86_can_inline_p diff --git a/gcc/config/ia64/ia64.c b/gcc/config/ia64/ia64.c index 3b19b98b5ce..9be9b42146d 100644 --- a/gcc/config/ia64/ia64.c +++ b/gcc/config/ia64/ia64.c @@ -5845,19 +5845,16 @@ ia64_secondary_reload_class (enum reg_class rclass, static int ia64_unspec_may_trap_p (const_rtx x, unsigned flags) { - if (GET_CODE (x) == UNSPEC) + switch (XINT (x, 1)) { - switch (XINT (x, 1)) - { - case UNSPEC_LDA: - case UNSPEC_LDS: - case UNSPEC_LDSA: - case UNSPEC_LDCCLR: - case UNSPEC_CHKACLR: - case UNSPEC_CHKS: - /* These unspecs are just wrappers. */ - return may_trap_p_1 (XVECEXP (x, 0, 0), flags); - } + case UNSPEC_LDA: + case UNSPEC_LDS: + case UNSPEC_LDSA: + case UNSPEC_LDCCLR: + case UNSPEC_CHKACLR: + case UNSPEC_CHKS: + /* These unspecs are just wrappers. */ + return may_trap_p_1 (XVECEXP (x, 0, 0), flags); } return default_unspec_may_trap_p (x, flags); diff --git a/gcc/config/pa/pa.md b/gcc/config/pa/pa.md index 9c6a361c6b5..5cef94bc00e 100644 --- a/gcc/config/pa/pa.md +++ b/gcc/config/pa/pa.md @@ -2094,6 +2094,12 @@ "" " { + /* A TLS symbol reference is not a valid move source operand. + pa_emit_move_sequence can only handle them prior to reload. + There is also no way to reload a TLS symbol reference, so + we must reject them after reload starts. */ + if (PA_SYMBOL_REF_TLS_P (operands[1]) && !can_create_pseudo_p ()) + FAIL; if (pa_emit_move_sequence (operands, SImode, 0)) DONE; }") diff --git a/gcc/config/rs6000/rs6000.c b/gcc/config/rs6000/rs6000.c index d25c63c4310..bc663eabcc0 100644 --- a/gcc/config/rs6000/rs6000.c +++ b/gcc/config/rs6000/rs6000.c @@ -209,6 +209,7 @@ static short cached_can_issue_more; static GTY(()) section *read_only_data_section; static GTY(()) section *private_data_section; static GTY(()) section *tls_data_section; +static GTY(()) section *tls_private_data_section; static GTY(()) section *read_only_private_data_section; static GTY(()) section *sdata2_section; static GTY(()) section *toc_section; @@ -5825,6 +5826,15 @@ rs6000_delegitimize_address (rtx orig_x) } #endif y = XVECEXP (y, 0, 0); + +#ifdef HAVE_AS_TLS + /* Do not associate thread-local symbols with the original + constant pool symbol. */ + if (TARGET_XCOFF + && SYMBOL_REF_TLS_MODEL (get_pool_constant (y)) >= TLS_MODEL_REAL) + return orig_x; +#endif + if (offset != NULL_RTX) y = gen_rtx_PLUS (Pmode, y, offset); if (!MEM_P (orig_x)) @@ -5898,10 +5908,29 @@ rs6000_got_sym (void) static rtx rs6000_legitimize_tls_address_aix (rtx addr, enum tls_model model) { - rtx sym, mem, tocref, tlsreg, tmpreg, dest; + rtx sym, mem, tocref, tlsreg, tmpreg, dest, tlsaddr; + const char *name; + char *tlsname; + + name = XSTR (addr, 0); + /* Append TLS CSECT qualifier, unless the symbol already is qualified + or the symbol will be in TLS private data section. */ + if (name[strlen (name) - 1] != ']' + && (TREE_PUBLIC (SYMBOL_REF_DECL (addr)) + || bss_initializer_p (SYMBOL_REF_DECL (addr)))) + { + tlsname = XALLOCAVEC (char, strlen (name) + 4); + strcpy (tlsname, name); + strcat (tlsname, + bss_initializer_p (SYMBOL_REF_DECL (addr)) ? "[UL]" : "[TL]"); + tlsaddr = copy_rtx (addr); + XSTR (tlsaddr, 0) = ggc_strdup (tlsname); + } + else + tlsaddr = addr; /* Place addr into TOC constant pool. */ - sym = force_const_mem (GET_MODE (addr), addr); + sym = force_const_mem (GET_MODE (tlsaddr), tlsaddr); /* Output the TOC entry and create the MEM referencing the value. */ if (constant_pool_expr_p (XEXP (sym, 0)) @@ -5918,27 +5947,28 @@ rs6000_legitimize_tls_address_aix (rtx addr, enum tls_model model) if (model == TLS_MODEL_GLOBAL_DYNAMIC || model == TLS_MODEL_LOCAL_DYNAMIC) { - rtx module = gen_reg_rtx (Pmode); /* Create new TOC reference for @m symbol. */ - const char *name = XSTR (XVECEXP (XEXP (mem, 0), 0, 0), 0); - char *name2 = XALLOCAVEC (char, strlen (name) + 1); - strcpy (name2, "*LCM"); - strcat (name2, name + 3); - tocref = create_TOC_reference (gen_rtx_SYMBOL_REF (Pmode, - ggc_alloc_string (name2, - strlen (name2))), - NULL_RTX); - rtx mem2 = gen_const_mem (Pmode, tocref); - set_mem_alias_set (mem2, get_TOC_alias_set ()); + name = XSTR (XVECEXP (XEXP (mem, 0), 0, 0), 0); + tlsname = XALLOCAVEC (char, strlen (name) + 1); + strcpy (tlsname, "*LCM"); + strcat (tlsname, name + 3); + rtx modaddr = gen_rtx_SYMBOL_REF (Pmode, ggc_strdup (tlsname)); + SYMBOL_REF_FLAGS (modaddr) |= SYMBOL_FLAG_LOCAL; + tocref = create_TOC_reference (modaddr, NULL_RTX); + rtx modmem = gen_const_mem (Pmode, tocref); + set_mem_alias_set (modmem, get_TOC_alias_set ()); - dest = gen_reg_rtx (Pmode); + rtx modreg = gen_reg_rtx (Pmode); + emit_insn (gen_rtx_SET (VOIDmode, modreg, modmem)); + tmpreg = gen_reg_rtx (Pmode); emit_insn (gen_rtx_SET (VOIDmode, tmpreg, mem)); - emit_insn (gen_rtx_SET (VOIDmode, module, mem2)); + + dest = gen_reg_rtx (Pmode); if (TARGET_32BIT) - emit_insn (gen_tls_get_addrsi (dest, module, tmpreg)); + emit_insn (gen_tls_get_addrsi (dest, modreg, tmpreg)); else - emit_insn (gen_tls_get_addrdi (dest, module, tmpreg)); + emit_insn (gen_tls_get_addrdi (dest, modreg, tmpreg)); return dest; } /* Obtain TLS pointer: 32 bit call or 64 bit GPR 13. */ @@ -22316,23 +22346,24 @@ output_toc (FILE *file, rtx x, int labelno, enum machine_mode mode) output_addr_const (file, x); #if HAVE_AS_TLS - if (TARGET_XCOFF && GET_CODE (base) == SYMBOL_REF) + if (TARGET_XCOFF && GET_CODE (base) == SYMBOL_REF + && SYMBOL_REF_TLS_MODEL (base) != 0) { if (SYMBOL_REF_TLS_MODEL (base) == TLS_MODEL_LOCAL_EXEC) - fputs ("[TL]@le", file); + fputs ("@le", file); else if (SYMBOL_REF_TLS_MODEL (base) == TLS_MODEL_INITIAL_EXEC) - fputs ("[TL]@ie", file); + fputs ("@ie", file); /* Use global-dynamic for local-dynamic. */ else if (SYMBOL_REF_TLS_MODEL (base) == TLS_MODEL_GLOBAL_DYNAMIC || SYMBOL_REF_TLS_MODEL (base) == TLS_MODEL_LOCAL_DYNAMIC) { - fputs ("[TL]\n", file); + putc ('\n', file); (*targetm.asm_out.internal_label) (file, "LCM", labelno); fputs ("\t.tc .", file); RS6000_OUTPUT_BASENAME (file, name); fputs ("[TC],", file); output_addr_const (file, x); - fputs ("[TL]@m", file); + fputs ("@m", file); } } #endif @@ -25705,6 +25736,11 @@ rs6000_xcoff_asm_init_sections (void) rs6000_xcoff_output_tls_section_asm_op, &xcoff_tls_data_section_name); + tls_private_data_section + = get_unnamed_section (SECTION_TLS, + rs6000_xcoff_output_tls_section_asm_op, + &xcoff_private_data_section_name); + read_only_private_data_section = get_unnamed_section (0, rs6000_xcoff_output_readonly_section_asm_op, &xcoff_private_data_section_name); @@ -25758,7 +25794,18 @@ rs6000_xcoff_select_section (tree decl, int reloc, { #if HAVE_AS_TLS if (TREE_CODE (decl) == VAR_DECL && DECL_THREAD_LOCAL_P (decl)) - return tls_data_section; + { + if (TREE_PUBLIC (decl)) + return tls_data_section; + else if (bss_initializer_p (decl)) + { + /* Convert to COMMON to emit in BSS. */ + DECL_COMMON (decl) = 1; + return tls_comm_section; + } + else + return tls_private_data_section; + } else #endif if (TREE_PUBLIC (decl)) @@ -25857,10 +25904,12 @@ rs6000_xcoff_file_start (void) main_input_filename, ".bss_"); rs6000_gen_section_name (&xcoff_private_data_section_name, main_input_filename, ".rw_"); - rs6000_gen_section_name (&xcoff_tls_data_section_name, - main_input_filename, ".tls_"); rs6000_gen_section_name (&xcoff_read_only_section_name, main_input_filename, ".ro_"); + rs6000_gen_section_name (&xcoff_tls_data_section_name, + main_input_filename, ".tls_"); + rs6000_gen_section_name (&xcoff_tbss_section_name, + main_input_filename, ".tbss_[UL]"); fputs ("\t.file\t", asm_out_file); output_quoted_string (asm_out_file, main_input_filename); @@ -25886,6 +25935,31 @@ rs6000_xcoff_file_end (void) ? "\t.long _section_.text\n" : "\t.llong _section_.text\n", asm_out_file); } + +#ifdef HAVE_AS_TLS +static void +rs6000_xcoff_encode_section_info (tree decl, rtx rtl, int first) +{ + rtx symbol; + int flags; + + default_encode_section_info (decl, rtl, first); + + /* Careful not to prod global register variables. */ + if (!MEM_P (rtl)) + return; + symbol = XEXP (rtl, 0); + if (GET_CODE (symbol) != SYMBOL_REF) + return; + + flags = SYMBOL_REF_FLAGS (symbol); + + if (TREE_CODE (decl) == VAR_DECL && DECL_THREAD_LOCAL_P (decl)) + flags &= ~SYMBOL_FLAG_HAS_BLOCK_INFO; + + SYMBOL_REF_FLAGS (symbol) = flags; +} +#endif /* HAVE_AS_TLS */ #endif /* TARGET_XCOFF */ /* Compute a (partial) cost for rtx X. Return true if the complete diff --git a/gcc/config/rs6000/rs6000.md b/gcc/config/rs6000/rs6000.md index 03ad9280386..0fa3d88c15b 100644 --- a/gcc/config/rs6000/rs6000.md +++ b/gcc/config/rs6000/rs6000.md @@ -10022,6 +10022,7 @@ [(set (reg:P 3) (unspec:P [(reg:P 3) (reg:P 4)] UNSPEC_TLSTLS)) (clobber (reg:P 0)) + (clobber (reg:P 4)) (clobber (reg:P 5)) (clobber (reg:P 11)) (clobber (reg:CC CR0_REGNO)) diff --git a/gcc/config/rs6000/xcoff.h b/gcc/config/rs6000/xcoff.h index 15f8bbf5e3e..4c12e1f4671 100644 --- a/gcc/config/rs6000/xcoff.h +++ b/gcc/config/rs6000/xcoff.h @@ -98,6 +98,9 @@ #define TARGET_ASM_FUNCTION_RODATA_SECTION default_no_function_rodata_section #define TARGET_STRIP_NAME_ENCODING rs6000_xcoff_strip_name_encoding #define TARGET_SECTION_TYPE_FLAGS rs6000_xcoff_section_type_flags +#ifdef HAVE_AS_TLS +#define TARGET_ENCODE_SECTION_INFO rs6000_xcoff_encode_section_info +#endif /* FP save and restore routines. */ #define SAVE_FP_PREFIX "._savef" @@ -308,8 +311,8 @@ #define ASM_OUTPUT_TLS_COMMON(FILE, DECL, NAME, SIZE) \ do { fputs(COMMON_ASM_OP, (FILE)); \ RS6000_OUTPUT_BASENAME ((FILE), (NAME)); \ - fputs("[UL]", (FILE)); \ - fprintf ((FILE), ","HOST_WIDE_INT_PRINT_UNSIGNED"\n", (SIZE)); \ + fprintf ((FILE), "[UL],"HOST_WIDE_INT_PRINT_UNSIGNED"\n", \ + (SIZE)); \ } while (0) #endif diff --git a/gcc/configure b/gcc/configure index f4f6593114d..ecdbea403d6 100755 --- a/gcc/configure +++ b/gcc/configure @@ -10321,9 +10321,9 @@ $as_echo "#define HAVE_LANGINFO_CODESET 1" >>confdefs.h # We will need to find libiberty.h and ansidecl.h saved_CFLAGS="$CFLAGS" -CFLAGS="$CFLAGS -I${srcdir} -I${srcdir}/../include" +CFLAGS="$CFLAGS -I${srcdir} -I${srcdir}/../include $GMPINC" saved_CXXFLAGS="$CXXFLAGS" -CXXFLAGS="$CXXFLAGS -I${srcdir} -I${srcdir}/../include" +CXXFLAGS="$CXXFLAGS -I${srcdir} -I${srcdir}/../include $GMPINC" for ac_func in getenv atol asprintf sbrk abort atof getcwd getwd \ strsignal strstr stpcpy strverscmp \ errno snprintf vsnprintf vasprintf malloc realloc calloc \ diff --git a/gcc/configure.ac b/gcc/configure.ac index 7abe7cf5b98..447a0ca3056 100644 --- a/gcc/configure.ac +++ b/gcc/configure.ac @@ -1098,9 +1098,9 @@ AM_LANGINFO_CODESET # We will need to find libiberty.h and ansidecl.h saved_CFLAGS="$CFLAGS" -CFLAGS="$CFLAGS -I${srcdir} -I${srcdir}/../include" +CFLAGS="$CFLAGS -I${srcdir} -I${srcdir}/../include $GMPINC" saved_CXXFLAGS="$CXXFLAGS" -CXXFLAGS="$CXXFLAGS -I${srcdir} -I${srcdir}/../include" +CXXFLAGS="$CXXFLAGS -I${srcdir} -I${srcdir}/../include $GMPINC" gcc_AC_CHECK_DECLS(getenv atol asprintf sbrk abort atof getcwd getwd \ strsignal strstr stpcpy strverscmp \ errno snprintf vsnprintf vasprintf malloc realloc calloc \ diff --git a/gcc/cp/ChangeLog b/gcc/cp/ChangeLog index f6abef63682..f2148f72667 100644 --- a/gcc/cp/ChangeLog +++ b/gcc/cp/ChangeLog @@ -1,3 +1,24 @@ +2013-01-02 Jason Merrill <jason@redhat.com> + + PR c++/54325 + * call.c (build_new_method_call_1): Don't use build_value_init for + user-provided default constructors. + + * decl.c (check_default_argument): Use LOOKUP_IMPLICIT. + + PR c++/55032 + PR c++/55245 + * tree.c (build_cplus_array_type): Copy layout information + to main variant if necessary. + +2012-12-28 Kai Tietz <ktietz@redhat.com> + + * rtti.c (LONGPTR_T): New helper-macro. + (get_pseudo_ti_init): Initialize offset_type by LONGPTR_T + type instead of 'long' type. + (create_tinfo_types): Use for offset/flags field LONGPTR_T + type instead of 'long' type. + 2012-12-19 Jason Merrill <jason@redhat.com> PR c++/55724 diff --git a/gcc/cp/call.c b/gcc/cp/call.c index bba5d9fdba5..ad39637c8b7 100644 --- a/gcc/cp/call.c +++ b/gcc/cp/call.c @@ -7534,6 +7534,9 @@ build_new_method_call_1 (tree instance, tree fns, vec<tree, va_gc> **args, build_special_member_call. */ if (CONSTRUCTOR_NELTS (init_list) == 0 && TYPE_HAS_DEFAULT_CONSTRUCTOR (basetype) + /* For a user-provided default constructor, use the normal + mechanisms so that protected access works. */ + && !type_has_user_provided_default_constructor (basetype) && !processing_template_decl) init = build_value_init (basetype, complain); diff --git a/gcc/cp/class.c b/gcc/cp/class.c index 82b2c0a3810..0aecabb380e 100644 --- a/gcc/cp/class.c +++ b/gcc/cp/class.c @@ -1096,8 +1096,6 @@ add_method (tree type, tree method, tree using_decl) && TREE_CODE (method) == FUNCTION_DECL && !DECL_EXTERN_C_P (fn) && !DECL_EXTERN_C_P (method) - && (DECL_FUNCTION_SPECIFIC_TARGET (fn) - || DECL_FUNCTION_SPECIFIC_TARGET (method)) && targetm.target_option.function_versions (fn, method)) { /* Mark functions as versions if necessary. Modify the mangled diff --git a/gcc/cp/decl.c b/gcc/cp/decl.c index 64bd4b5d2c0..52ceefce03b 100644 --- a/gcc/cp/decl.c +++ b/gcc/cp/decl.c @@ -10829,7 +10829,7 @@ check_default_argument (tree decl, tree arg) parameter type. */ ++cp_unevaluated_operand; perform_implicit_conversion_flags (decl_type, arg, tf_warning_or_error, - LOOKUP_NORMAL); + LOOKUP_IMPLICIT); --cp_unevaluated_operand; if (warn_zero_as_null_pointer_constant diff --git a/gcc/cp/rtti.c b/gcc/cp/rtti.c index b13ec171bbb..de28371c679 100644 --- a/gcc/cp/rtti.c +++ b/gcc/cp/rtti.c @@ -89,6 +89,12 @@ typedef enum tinfo_kind /* ... abi::__vmi_type_info<I> */ } tinfo_kind; +/* Helper macro to get maximum scalar-width of pointer or of the 'long'-type. + This of interest for llp64 targets. */ +#define LONGPTR_T \ + integer_types[(POINTER_SIZE <= TYPE_PRECISION (integer_types[itk_long]) \ + ? itk_long : itk_long_long)] + /* A vector of all tinfo decls that haven't yet been emitted. */ vec<tree, va_gc> *unemitted_tinfo_decls; @@ -1116,7 +1122,7 @@ get_pseudo_ti_init (tree type, unsigned tk_index) tree binfo = TYPE_BINFO (type); int nbases = BINFO_N_BASE_BINFOS (binfo); vec<tree, va_gc> *base_accesses = BINFO_BASE_ACCESSES (binfo); - tree offset_type = integer_types[itk_long]; + tree offset_type = LONGPTR_T; tree base_inits = NULL_TREE; int ix; vec<constructor_elt, va_gc> *init_vec = NULL; @@ -1420,7 +1426,7 @@ create_tinfo_types (void) fields = field; field = build_decl (BUILTINS_LOCATION, - FIELD_DECL, NULL_TREE, integer_types[itk_long]); + FIELD_DECL, NULL_TREE, LONGPTR_T); DECL_CHAIN (field) = fields; fields = field; diff --git a/gcc/cp/tree.c b/gcc/cp/tree.c index c4302371b73..c658582052b 100644 --- a/gcc/cp/tree.c +++ b/gcc/cp/tree.c @@ -809,6 +809,15 @@ build_cplus_array_type (tree elt_type, tree index_type) t = build_array_type (elt_type, index_type); } + /* Push these needs up so that initialization takes place + more easily. */ + bool needs_ctor + = TYPE_NEEDS_CONSTRUCTING (TYPE_MAIN_VARIANT (elt_type)); + TYPE_NEEDS_CONSTRUCTING (t) = needs_ctor; + bool needs_dtor + = TYPE_HAS_NONTRIVIAL_DESTRUCTOR (TYPE_MAIN_VARIANT (elt_type)); + TYPE_HAS_NONTRIVIAL_DESTRUCTOR (t) = needs_dtor; + /* We want TYPE_MAIN_VARIANT of an array to strip cv-quals from the element type as well, so fix it up if needed. */ if (elt_type != TYPE_MAIN_VARIANT (elt_type)) @@ -818,6 +827,27 @@ build_cplus_array_type (tree elt_type, tree index_type) if (TYPE_MAIN_VARIANT (t) != m) { + if (COMPLETE_TYPE_P (t) && !COMPLETE_TYPE_P (m)) + { + /* m was built before the element type was complete, so we + also need to copy the layout info from t. */ + tree size = TYPE_SIZE (t); + tree size_unit = TYPE_SIZE_UNIT (t); + unsigned int align = TYPE_ALIGN (t); + unsigned int user_align = TYPE_USER_ALIGN (t); + enum machine_mode mode = TYPE_MODE (t); + for (tree var = m; var; var = TYPE_NEXT_VARIANT (var)) + { + TYPE_SIZE (var) = size; + TYPE_SIZE_UNIT (var) = size_unit; + TYPE_ALIGN (var) = align; + TYPE_USER_ALIGN (var) = user_align; + SET_TYPE_MODE (var, mode); + TYPE_NEEDS_CONSTRUCTING (var) = needs_ctor; + TYPE_HAS_NONTRIVIAL_DESTRUCTOR (var) = needs_dtor; + } + } + TYPE_MAIN_VARIANT (t) = m; TYPE_NEXT_VARIANT (t) = TYPE_NEXT_VARIANT (m); TYPE_NEXT_VARIANT (m) = t; @@ -828,12 +858,6 @@ build_cplus_array_type (tree elt_type, tree index_type) if (TYPE_SIZE (t) && EXPR_P (TYPE_SIZE (t))) TREE_NO_WARNING (TYPE_SIZE (t)) = 1; - /* Push these needs up so that initialization takes place - more easily. */ - TYPE_NEEDS_CONSTRUCTING (t) - = TYPE_NEEDS_CONSTRUCTING (TYPE_MAIN_VARIANT (elt_type)); - TYPE_HAS_NONTRIVIAL_DESTRUCTOR (t) - = TYPE_HAS_NONTRIVIAL_DESTRUCTOR (TYPE_MAIN_VARIANT (elt_type)); return t; } diff --git a/gcc/cprop.c b/gcc/cprop.c index ec896a46062..463f81ff73b 100644 --- a/gcc/cprop.c +++ b/gcc/cprop.c @@ -1496,7 +1496,7 @@ bypass_block (basic_block bb, rtx setcc, rtx jump) rtx insn, note; edge e, edest; int change; - int may_be_loop_header; + int may_be_loop_header = false; unsigned removed_p; unsigned i; edge_iterator ei; @@ -1510,27 +1510,22 @@ bypass_block (basic_block bb, rtx setcc, rtx jump) if (note) find_used_regs (&XEXP (note, 0), NULL); - /* Determine whether there are more latch edges. Threading through - a loop header with more than one latch is delicate, see e.g. - tree-ssa-threadupdate.c:thread_through_loop_header. */ if (current_loops) { - may_be_loop_header = bb == bb->loop_father->header; - if (may_be_loop_header - && bb->loop_father->latch == NULL) + /* If we are to preserve loop structure then do not bypass + a loop header. This will either rotate the loop, create + multiple entry loops or even irreducible regions. */ + if (bb == bb->loop_father->header) return 0; } else { - unsigned n_back_edges = 0; FOR_EACH_EDGE (e, ei, bb->preds) if (e->flags & EDGE_DFS_BACK) - n_back_edges++; - - may_be_loop_header = n_back_edges > 0; - - if (n_back_edges > 1) - return 0; + { + may_be_loop_header = true; + break; + } } change = 0; @@ -1619,17 +1614,6 @@ bypass_block (basic_block bb, rtx setcc, rtx jump) && dest != old_dest && dest != EXIT_BLOCK_PTR) { - if (current_loops != NULL - && e->src->loop_father->latch == e->src) - { - /* ??? Now we are creating (or may create) a loop - with multiple entries. Simply mark it for - removal. Alternatively we could not do this - threading. */ - e->src->loop_father->header = NULL; - e->src->loop_father->latch = NULL; - } - redirect_edge_and_branch_force (e, dest); /* Copy the register setter to the redirected edge. diff --git a/gcc/doc/contrib.texi b/gcc/doc/contrib.texi index e4d656d4948..94971ec7ccd 100644 --- a/gcc/doc/contrib.texi +++ b/gcc/doc/contrib.texi @@ -623,7 +623,8 @@ entire libstdc++ testsuite namespace-compatible. @item Mark Mitchell for his direction via the steering committee, mountains of C++ work, load/store hoisting out of loops, alias analysis improvements, -ISO C @code{restrict} support, and serving as release manager for GCC 3.x. +ISO C @code{restrict} support, and serving as release manager from 2000 +to 2011. @item Alan Modra for various GNU/Linux bits and testing. diff --git a/gcc/doc/tm.texi b/gcc/doc/tm.texi index 75aa8672758..55a103700f6 100644 --- a/gcc/doc/tm.texi +++ b/gcc/doc/tm.texi @@ -9909,6 +9909,11 @@ different target specific attributes, that is, they are compiled for different target machines. @end deftypefn +@deftypefn {Target Hook} bool TARGET_OPTION_SUPPORTS_FUNCTION_VERSIONS (void) +This target hook returns @code{true} if the target supports function +multiversioning. +@end deftypefn + @deftypefn {Target Hook} bool TARGET_CAN_INLINE_P (tree @var{caller}, tree @var{callee}) This target hook returns @code{false} if the @var{caller} function cannot inline @var{callee}, based on target specific information. By diff --git a/gcc/doc/tm.texi.in b/gcc/doc/tm.texi.in index 95fab189c70..e820f77be45 100644 --- a/gcc/doc/tm.texi.in +++ b/gcc/doc/tm.texi.in @@ -9770,6 +9770,11 @@ different target specific attributes, that is, they are compiled for different target machines. @end deftypefn +@hook TARGET_OPTION_SUPPORTS_FUNCTION_VERSIONS +This target hook returns @code{true} if the target supports function +multiversioning. +@end deftypefn + @hook TARGET_CAN_INLINE_P This target hook returns @code{false} if the @var{caller} function cannot inline @var{callee}, based on target specific information. By diff --git a/gcc/double-int.h b/gcc/double-int.h index f4eb6ab0a77..b3f33863287 100644 --- a/gcc/double-int.h +++ b/gcc/double-int.h @@ -20,10 +20,6 @@ along with GCC; see the file COPYING3. If not see #ifndef DOUBLE_INT_H #define DOUBLE_INT_H -#ifndef GENERATOR_FILE -#include <gmp.h> -#endif - /* A large integer is currently represented as a pair of HOST_WIDE_INTs. It therefore represents a number with precision of 2 * HOST_BITS_PER_WIDE_INT bits (it is however possible that the diff --git a/gcc/dumpfile.c b/gcc/dumpfile.c index 2887a57b512..7e1d6d7c599 100644 --- a/gcc/dumpfile.c +++ b/gcc/dumpfile.c @@ -265,7 +265,9 @@ dump_loc (int dump_kind, FILE *dfile, source_location loc) DECL_SOURCE_FILE (current_function_decl), DECL_SOURCE_LINE (current_function_decl)); else - fprintf (dfile, "\n%d: ", LOCATION_LINE (loc)); + fprintf (dfile, "\n%s:%d: note: ", + LOCATION_FILE (loc), + LOCATION_LINE (loc)); } } diff --git a/gcc/expr.c b/gcc/expr.c index 9d9e5b9abf5..e7b77707de8 100644 --- a/gcc/expr.c +++ b/gcc/expr.c @@ -9960,7 +9960,8 @@ expand_expr_real_1 (tree exp, rtx target, enum machine_mode tmode, && GET_MODE_CLASS (mode) != MODE_COMPLEX_INT && GET_MODE_CLASS (mode) != MODE_COMPLEX_FLOAT && modifier != EXPAND_CONST_ADDRESS - && modifier != EXPAND_INITIALIZER) + && modifier != EXPAND_INITIALIZER + && modifier != EXPAND_MEMORY) /* If the field is volatile, we always want an aligned access. Do this in following two situations: 1. the access is not already naturally diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index db7383c57f2..5045220f038 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,56 @@ +2012-12-28 Janus Weil <janus@gcc.gnu.org> + + PR fortran/55692 + * check.c (gfc_check_associated): Remove a "gcc_assert (0)". + +2012-12-28 Tobias Burnus <burnus@net-b.de> + + PR fortran/55763 + * check.c (gfc_check_move_alloc): Handle unlimited polymorphic. + * trans-intrinsic.c (conv_intrinsic_move_alloc): Ditto. + +2012-12-27 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/48976 + * gfortran.h (gfc_inquire struct): Add pointer for inquire stream. + * io.c (io_tag): Add tag for inquire stream. (match_inquire_element): + Add matcher for new tag. (gfc_resolve_inquire): Resolve new tag. + * ioparm.def: Add new parameter for inquire stream. + * trans-io.c (gfc_trans_inquire): Add tranlste code for inquire + stream. + +2012-12-23 Tobias Burnus <burnus@net-b.de> + + PR fortran/54884 + * module.c (write_symbol1_recursion): Set attr.public_use. + * interface.c (check_sym_interfaces, check_uop_interfaces, + gfc_check_interfaces): Remove attr.public_use code. + * resolve.c (resolve_function, resolve_variable, + resolve_typebound_procedure): Ditto. + +2012-12-22 Tobias Burnus <burnus@net-b.de> + + PR fortran/55763 + * module.c (mio_component): Don't skip _hash's initializer. + * resolve.c (resolve_select_type): Add an assert. + * trans-expr.c (gfc_conv_procedure_call): Handle + INTENT(OUT) for UNLIMIT_POLY. + +2012-12-21 Richard Biener <rguenther@suse.de> + + PR bootstrap/54659 + * gfortran.h: Do not include gmp.h here. + +2012-12-21 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/55763 + * match.c (select_type_set_tmp): Return is a derived type or + class typespec has no derived type. + * resolve.c (resolve_fl_var_and_proc): Exclude select type + temporaries from 'pointer'. + (resolve_symbol): Exclude select type temporaries from tests + for assumed size and assumed rank. + 2012-12-20 Janus Weil <janus@gcc.gnu.org> PR fortran/36044 diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 793ad75d701..4e8b046439d 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -895,12 +895,10 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target) where = &pointer->where; - if (pointer->expr_type == EXPR_VARIABLE || pointer->expr_type == EXPR_FUNCTION) - attr1 = gfc_expr_attr (pointer); - else if (pointer->expr_type == EXPR_NULL) + if (pointer->expr_type == EXPR_NULL) goto null_arg; - else - gcc_assert (0); /* Pointer must be a variable or a function. */ + + attr1 = gfc_expr_attr (pointer); if (!attr1.pointer && !attr1.proc_pointer) { @@ -2791,18 +2789,15 @@ gfc_check_move_alloc (gfc_expr *from, gfc_expr *to) return FAILURE; } - if (to->ts.kind != from->ts.kind) + /* CLASS arguments: Make sure the vtab of from is present. */ + if (to->ts.type == BT_CLASS && !UNLIMITED_POLY (from)) { - gfc_error ("The FROM and TO arguments of the MOVE_ALLOC intrinsic at %L" - " must be of the same kind %d/%d", &to->where, from->ts.kind, - to->ts.kind); - return FAILURE; + if (from->ts.type == BT_CLASS || from->ts.type == BT_DERIVED) + gfc_find_derived_vtab (from->ts.u.derived); + else + gfc_find_intrinsic_vtab (&from->ts); } - /* CLASS arguments: Make sure the vtab of from is present. */ - if (to->ts.type == BT_CLASS) - gfc_find_derived_vtab (from->ts.u.derived); - return SUCCESS; } diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index ec0c61f09c9..a419af3ad40 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1699,7 +1699,6 @@ gfc_intrinsic_sym; EXPR_COMPCALL Function (or subroutine) call of a procedure pointer component or type-bound procedure. */ -#include <gmp.h> #include <mpfr.h> #include <mpc.h> #define GFC_RND_MODE GMP_RNDN @@ -2009,7 +2008,8 @@ typedef struct *name, *access, *sequential, *direct, *form, *formatted, *unformatted, *recl, *nextrec, *blank, *position, *action, *read, *write, *readwrite, *delim, *pad, *iolength, *iomsg, *convert, *strm_pos, - *asynchronous, *decimal, *encoding, *pending, *round, *sign, *size, *id; + *asynchronous, *decimal, *encoding, *pending, *round, *sign, *size, *id, + *iqstream; gfc_st_label *err; diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 908db747c04..b587d4ad069 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -1582,9 +1582,6 @@ check_sym_interfaces (gfc_symbol *sym) for (p = sym->generic; p; p = p->next) { - if (sym->attr.access != ACCESS_PRIVATE) - p->sym->attr.public_used = 1; - if (p->sym->attr.mod_proc && (p->sym->attr.if_source != IFSRC_DECL || p->sym->attr.procedure)) @@ -1610,16 +1607,11 @@ check_uop_interfaces (gfc_user_op *uop) char interface_name[100]; gfc_user_op *uop2; gfc_namespace *ns; - gfc_interface *p; sprintf (interface_name, "operator interface '%s'", uop->name); if (check_interface0 (uop->op, interface_name)) return; - if (uop->access != ACCESS_PRIVATE) - for (p = uop->op; p; p = p->next) - p->sym->attr.public_used = 1; - for (ns = gfc_current_ns; ns; ns = ns->parent) { uop2 = gfc_find_uop (uop->name, ns); @@ -1689,7 +1681,6 @@ void gfc_check_interfaces (gfc_namespace *ns) { gfc_namespace *old_ns, *ns2; - gfc_interface *p; char interface_name[100]; int i; @@ -1714,10 +1705,6 @@ gfc_check_interfaces (gfc_namespace *ns) if (check_interface0 (ns->op[i], interface_name)) continue; - for (p = ns->op[i]; p; p = p->next) - p->sym->attr.public_used = 1; - - if (ns->op[i]) gfc_check_operator_interface (ns->op[i]->sym, (gfc_intrinsic_op) i, ns->op[i]->where); diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index bd84f1fc48a..7eb52a974d7 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -97,7 +97,8 @@ static const io_tag tag_eor = {"EOR", " eor =", " %l", BT_UNKNOWN}, tag_id = {"ID", " id =", " %v", BT_INTEGER}, tag_pending = {"PENDING", " pending =", " %v", BT_LOGICAL}, - tag_newunit = {"NEWUNIT", " newunit =", " %v", BT_INTEGER}; + tag_newunit = {"NEWUNIT", " newunit =", " %v", BT_INTEGER}, + tag_s_iqstream = {"STREAM", " stream =", " %v", BT_CHARACTER}; static gfc_dt *current_dt; @@ -3912,6 +3913,7 @@ match_inquire_element (gfc_inquire *inquire) RETM m = match_out_tag (&tag_strm_out, &inquire->strm_pos); RETM m = match_vtag (&tag_pending, &inquire->pending); RETM m = match_vtag (&tag_id, &inquire->id); + RETM m = match_vtag (&tag_s_iqstream, &inquire->iqstream); RETM return MATCH_NO; } @@ -4101,6 +4103,7 @@ gfc_resolve_inquire (gfc_inquire *inquire) INQUIRE_RESOLVE_TAG (&tag_pending, inquire->pending); INQUIRE_RESOLVE_TAG (&tag_size, inquire->size); INQUIRE_RESOLVE_TAG (&tag_s_decimal, inquire->decimal); + INQUIRE_RESOLVE_TAG (&tag_s_iqstream, inquire->iqstream); #undef INQUIRE_RESOLVE_TAG if (gfc_reference_st_label (inquire->err, ST_LABEL_TARGET) == FAILURE) diff --git a/gcc/fortran/ioparm.def b/gcc/fortran/ioparm.def index 5ccd869732f..c9c271d886d 100644 --- a/gcc/fortran/ioparm.def +++ b/gcc/fortran/ioparm.def @@ -88,6 +88,7 @@ IOPARM (inquire, sign, 1 << 4, char1) IOPARM (inquire, pending, 1 << 5, pint4) IOPARM (inquire, size, 1 << 6, pintio) IOPARM (inquire, id, 1 << 7, pint4) +IOPARM (inquire, iqstream, 1 << 8, char1) IOPARM (wait, common, 0, common) IOPARM (wait, id, 1 << 7, pint4) #ifndef IOPARM_dt_list_format diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 6322fae6fda..ca8f08c6822 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -5293,6 +5293,9 @@ select_type_set_tmp (gfc_typespec *ts) if (tmp == NULL) { + if (!ts->u.derived) + return; + if (ts->type == BT_CLASS) sprintf (name, "__tmp_class_%s", ts->u.derived->name); else diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 168f933936a..e19c6d9d71f 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -2603,7 +2603,8 @@ mio_component (gfc_component *c, int vtype) c->attr.class_ok = 1; c->attr.access = MIO_NAME (gfc_access) (c->attr.access, access_types); - if (!vtype || strcmp (c->name, "_final") == 0) + if (!vtype || strcmp (c->name, "_final") == 0 + || strcmp (c->name, "_hash") == 0) mio_expr (&c->initializer); if (c->attr.proc_pointer) @@ -5237,6 +5238,7 @@ write_symbol1_recursion (sorted_pointer_info *sp) p1->u.wsym.state = WRITTEN; write_symbol (p1->integer, p1->u.wsym.sym); + p1->u.wsym.sym->attr.public_used = 1; write_symbol1_recursion (sp->right); } diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 6208a819c13..873400abb39 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -3129,12 +3129,6 @@ resolve_function (gfc_expr *expr) return FAILURE; } - if (sym && specification_expr && sym->attr.function - && gfc_current_ns->proc_name - && gfc_current_ns->proc_name->attr.flavor == FL_MODULE) - sym->attr.public_used = 1; - - /* Switch off assumed size checking and do this again for certain kinds of procedure, once the procedure itself is resolved. */ need_full_assumed_size++; @@ -5360,19 +5354,6 @@ resolve_variable (gfc_expr *e) if (check_assumed_size_reference (sym, e)) return FAILURE; - /* If a PRIVATE variable is used in the specification expression of the - result variable, it might be accessed from outside the module and can - thus not be TREE_PUBLIC() = 0. - TODO: sym->attr.public_used only has to be set for the result variable's - type-parameter expression and not for dummies or automatic variables. - Additionally, it only has to be set if the function is either PUBLIC or - used in a generic interface or TBP; unfortunately, - proc_name->attr.public_used can get set at a later stage. */ - if (specification_expr && sym->attr.access == ACCESS_PRIVATE - && !sym->attr.function && !sym->attr.use_assoc - && gfc_current_ns->proc_name && gfc_current_ns->proc_name->attr.function) - sym->attr.public_used = 1; - /* Deal with forward references to entries during resolve_code, to satisfy, at least partially, 12.5.2.5. */ if (gfc_current_ns->entries @@ -8484,7 +8465,7 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) gfc_expr *e; ivtab = gfc_find_intrinsic_vtab (&c->ts); - gcc_assert (ivtab); + gcc_assert (ivtab && CLASS_DATA (ivtab)->initializer); e = CLASS_DATA (ivtab)->initializer; c->low = c->high = gfc_copy_expr (e); } @@ -11056,7 +11037,7 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag) } else { - pointer = sym->attr.pointer; + pointer = sym->attr.pointer && !sym->attr.select_type_temporary; allocatable = sym->attr.allocatable; dimension = sym->attr.dimension; } @@ -12146,7 +12127,6 @@ resolve_typebound_procedure (gfc_symtree* stree) gcc_assert (stree->n.tb->u.specific); proc = stree->n.tb->u.specific->n.sym; where = stree->n.tb->where; - proc->attr.public_used = 1; /* Default access should already be resolved from the parser. */ gcc_assert (stree->n.tb->access != ACCESS_UNKNOWN); @@ -13315,7 +13295,7 @@ resolve_symbol (gfc_symbol *sym) gcc_assert (as->type != AS_IMPLIED_SHAPE); if (((as->type == AS_ASSUMED_SIZE && !as->cp_was_assumed) || as->type == AS_ASSUMED_SHAPE) - && sym->attr.dummy == 0) + && !sym->attr.dummy && !sym->attr.select_type_temporary) { if (as->type == AS_ASSUMED_SIZE) gfc_error ("Assumed size array at %L must be a dummy argument", @@ -13326,7 +13306,8 @@ resolve_symbol (gfc_symbol *sym) return; } /* TS 29113, C535a. */ - if (as->type == AS_ASSUMED_RANK && !sym->attr.dummy) + if (as->type == AS_ASSUMED_RANK && !sym->attr.dummy + && !sym->attr.select_type_temporary) { gfc_error ("Assumed-rank array at %L must be a dummy argument", &sym->declared_at); diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index ad266845ae7..452f2bcf974 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -4302,7 +4302,14 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, null_pointer_node); gfc_add_expr_to_block (&block, tmp); - if (fsym->ts.type == BT_CLASS) + if (fsym->ts.type == BT_CLASS && UNLIMITED_POLY (fsym)) + { + gfc_add_modify (&block, ptr, + fold_convert (TREE_TYPE (ptr), + null_pointer_node)); + gfc_add_expr_to_block (&block, tmp); + } + else if (fsym->ts.type == BT_CLASS) { gfc_symbol *vtab; vtab = gfc_find_derived_vtab (fsym->ts.u.derived); diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index b9d13ccaecd..5a89be1a98d 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -7373,8 +7373,13 @@ conv_intrinsic_move_alloc (gfc_code *code) if (from_expr->ts.type == BT_CLASS) { - vtab = gfc_find_derived_vtab (from_expr->ts.u.derived); - gcc_assert (vtab); + if (UNLIMITED_POLY (from_expr)) + vtab = NULL; + else + { + vtab = gfc_find_derived_vtab (from_expr->ts.u.derived); + gcc_assert (vtab); + } gfc_free_expr (from_expr2); gfc_init_se (&from_se, NULL); @@ -7386,13 +7391,23 @@ conv_intrinsic_move_alloc (gfc_code *code) from_se.expr)); /* Reset _vptr component to declared type. */ - tmp = gfc_build_addr_expr (NULL_TREE, gfc_get_symbol_decl (vtab)); - gfc_add_modify_loc (input_location, &block, from_se.expr, - fold_convert (TREE_TYPE (from_se.expr), tmp)); + if (UNLIMITED_POLY (from_expr)) + gfc_add_modify_loc (input_location, &block, from_se.expr, + fold_convert (TREE_TYPE (from_se.expr), + null_pointer_node)); + else + { + tmp = gfc_build_addr_expr (NULL_TREE, gfc_get_symbol_decl (vtab)); + gfc_add_modify_loc (input_location, &block, from_se.expr, + fold_convert (TREE_TYPE (from_se.expr), tmp)); + } } else { - vtab = gfc_find_derived_vtab (from_expr->ts.u.derived); + if (from_expr->ts.type != BT_DERIVED) + vtab = gfc_find_intrinsic_vtab (&from_expr->ts); + else + vtab = gfc_find_derived_vtab (from_expr->ts.u.derived); gcc_assert (vtab); tmp = gfc_build_addr_expr (NULL_TREE, gfc_get_symbol_decl (vtab)); gfc_add_modify_loc (input_location, &block, to_se.expr, @@ -7415,8 +7430,13 @@ conv_intrinsic_move_alloc (gfc_code *code) if (from_expr->ts.type == BT_CLASS) { - vtab = gfc_find_derived_vtab (from_expr->ts.u.derived); - gcc_assert (vtab); + if (UNLIMITED_POLY (from_expr)) + vtab = NULL; + else + { + vtab = gfc_find_derived_vtab (from_expr->ts.u.derived); + gcc_assert (vtab); + } from_se.want_pointer = 1; from_expr2 = gfc_copy_expr (from_expr); @@ -7427,13 +7447,23 @@ conv_intrinsic_move_alloc (gfc_code *code) from_se.expr)); /* Reset _vptr component to declared type. */ - tmp = gfc_build_addr_expr (NULL_TREE, gfc_get_symbol_decl (vtab)); - gfc_add_modify_loc (input_location, &block, from_se.expr, - fold_convert (TREE_TYPE (from_se.expr), tmp)); + if (UNLIMITED_POLY (from_expr)) + gfc_add_modify_loc (input_location, &block, from_se.expr, + fold_convert (TREE_TYPE (from_se.expr), + null_pointer_node)); + else + { + tmp = gfc_build_addr_expr (NULL_TREE, gfc_get_symbol_decl (vtab)); + gfc_add_modify_loc (input_location, &block, from_se.expr, + fold_convert (TREE_TYPE (from_se.expr), tmp)); + } } else { - vtab = gfc_find_derived_vtab (from_expr->ts.u.derived); + if (from_expr->ts.type != BT_DERIVED) + vtab = gfc_find_intrinsic_vtab (&from_expr->ts); + else + vtab = gfc_find_derived_vtab (from_expr->ts.u.derived); gcc_assert (vtab); tmp = gfc_build_addr_expr (NULL_TREE, gfc_get_symbol_decl (vtab)); gfc_add_modify_loc (input_location, &block, to_se.expr, diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index 940129eb05f..921edd042ea 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -1364,6 +1364,9 @@ gfc_trans_inquire (gfc_code * code) if (p->id) mask2 |= set_parameter_ref (&block, &post_block,var, IOPARM_inquire_id, p->id); + if (p->iqstream) + mask2 |= set_string (&block, &post_block, var, IOPARM_inquire_iqstream, + p->iqstream); if (mask2) mask |= set_parameter_const (&block, var, IOPARM_inquire_flags2, mask2); diff --git a/gcc/go/ChangeLog b/gcc/go/ChangeLog index 477e6ed32f7..6d6b14b1109 100644 --- a/gcc/go/ChangeLog +++ b/gcc/go/ChangeLog @@ -1,3 +1,8 @@ +2012-12-21 Ian Lance Taylor <iant@google.com> + + PR bootstrap/54659 + * go-system.h: Don't include <cstdio>. + 2012-12-18 Ian Lance Taylor <iant@google.com> PR go/55201 diff --git a/gcc/go/go-system.h b/gcc/go/go-system.h index 2decc555df5..85160cd4910 100644 --- a/gcc/go/go-system.h +++ b/gcc/go/go-system.h @@ -125,15 +125,6 @@ struct hash<T*> // system.h. #include <iostream> -// Some versions of gmp.h assume that #include <iostream> will define -// std::FILE. This is not true with libstdc++ 4.3 and later. This is -// fixed in GMP 4.3, but at this point we don't know which version of -// GMP is in use. Since the top level configure script accepts GMP -// 4.2, at least for now we #include <cstdio> to ensure that GMP 4.2 -// will work. FIXME: This can be removed when we require GMP 4.3 or -// later. -#include <cstdio> - #include "system.h" #include "ansidecl.h" #include "coretypes.h" diff --git a/gcc/go/gofrontend/expressions.cc b/gcc/go/gofrontend/expressions.cc index f10627295b8..9abd2247f37 100644 --- a/gcc/go/gofrontend/expressions.cc +++ b/gcc/go/gofrontend/expressions.cc @@ -8,8 +8,6 @@ #include <algorithm> -#include <gmp.h> - #include "toplev.h" #include "intl.h" #include "tree.h" diff --git a/gcc/go/gofrontend/expressions.h b/gcc/go/gofrontend/expressions.h index 66e05a7bcfd..152c2232454 100644 --- a/gcc/go/gofrontend/expressions.h +++ b/gcc/go/gofrontend/expressions.h @@ -7,7 +7,6 @@ #ifndef GO_EXPRESSIONS_H #define GO_EXPRESSIONS_H -#include <gmp.h> #include <mpfr.h> #include "operator.h" diff --git a/gcc/go/gofrontend/gogo-tree.cc b/gcc/go/gofrontend/gogo-tree.cc index 7159dfb6244..2ffc5085be8 100644 --- a/gcc/go/gofrontend/gogo-tree.cc +++ b/gcc/go/gofrontend/gogo-tree.cc @@ -6,8 +6,6 @@ #include "go-system.h" -#include <gmp.h> - #include "toplev.h" #include "tree.h" #include "gimple.h" diff --git a/gcc/go/gofrontend/gogo.cc b/gcc/go/gofrontend/gogo.cc index 41f9665e724..735b4c81204 100644 --- a/gcc/go/gofrontend/gogo.cc +++ b/gcc/go/gofrontend/gogo.cc @@ -29,6 +29,7 @@ Gogo::Gogo(Backend* backend, Linemap* linemap, int, int pointer_size) package_(NULL), functions_(), globals_(new Bindings(NULL)), + file_block_names_(), imports_(), imported_unsafe_(false), packages_(), @@ -1243,6 +1244,33 @@ Gogo::define_global_names() else if (no->is_unknown()) no->unknown_value()->set_real_named_object(global_no); } + + // Give an error if any name is defined in both the package block + // and the file block. For example, this can happen if one file + // imports "fmt" and another file defines a global variable fmt. + for (Bindings::const_declarations_iterator p = + this->package_->bindings()->begin_declarations(); + p != this->package_->bindings()->end_declarations(); + ++p) + { + if (p->second->is_unknown() + && p->second->unknown_value()->real_named_object() == NULL) + { + // No point in warning about an undefined name, as we will + // get other errors later anyhow. + continue; + } + File_block_names::const_iterator pf = + this->file_block_names_.find(p->second->name()); + if (pf != this->file_block_names_.end()) + { + std::string n = p->second->message_name(); + error_at(p->second->location(), + "%qs defined as both imported name and global name", + n.c_str()); + inform(pf->second, "%qs imported here", n.c_str()); + } + } } // Clear out names in file scope. @@ -1250,7 +1278,7 @@ Gogo::define_global_names() void Gogo::clear_file_scope() { - this->package_->bindings()->clear_file_scope(); + this->package_->bindings()->clear_file_scope(this); // Warn about packages which were imported but not used. bool quiet = saw_errors(); @@ -4855,7 +4883,7 @@ Bindings::Bindings(Bindings* enclosing) // Clear imports. void -Bindings::clear_file_scope() +Bindings::clear_file_scope(Gogo* gogo) { Contour::iterator p = this->bindings_.begin(); while (p != this->bindings_.end()) @@ -4875,7 +4903,10 @@ Bindings::clear_file_scope() if (keep) ++p; else - p = this->bindings_.erase(p); + { + gogo->add_file_block_name(p->second->name(), p->second->location()); + p = this->bindings_.erase(p); + } } } diff --git a/gcc/go/gofrontend/gogo.h b/gcc/go/gofrontend/gogo.h index cffdd219118..f96ffcdfdb9 100644 --- a/gcc/go/gofrontend/gogo.h +++ b/gcc/go/gofrontend/gogo.h @@ -377,6 +377,11 @@ class Gogo void add_named_object(Named_object*); + // Add an identifier to the list of names seen in the file block. + void + add_file_block_name(const std::string& name, Location location) + { this->file_block_names_[name] = location; } + // Mark all local variables in current bindings as used. This is // used when there is a parse error to avoid useless errors. void @@ -678,6 +683,10 @@ class Gogo // This is used for initialization dependency analysis. typedef std::map<Variable*, Named_object*> Var_deps; + // Type used to map identifiers in the file block to the location + // where they were defined. + typedef Unordered_map(std::string, Location) File_block_names; + // Type used to queue writing a type specific function. struct Specific_type_function { @@ -710,6 +719,8 @@ class Gogo // The global binding contour. This includes the builtin functions // and the package we are compiling. Bindings* globals_; + // The list of names we have seen in the file block. + File_block_names file_block_names_; // Mapping from import file names to packages. Imports imports_; // Whether the magic unsafe package was imported. @@ -2265,7 +2276,7 @@ class Bindings // Clear all names in file scope from the bindings. void - clear_file_scope(); + clear_file_scope(Gogo*); // Look up a name in this binding contour and in any enclosing // binding contours. This returns NULL if the name is not found. diff --git a/gcc/go/gofrontend/lex.h b/gcc/go/gofrontend/lex.h index fc9258b880a..383a9178780 100644 --- a/gcc/go/gofrontend/lex.h +++ b/gcc/go/gofrontend/lex.h @@ -7,7 +7,6 @@ #ifndef GO_LEX_H #define GO_LEX_H -#include <gmp.h> #include <mpfr.h> #include "operator.h" diff --git a/gcc/go/gofrontend/runtime.cc b/gcc/go/gofrontend/runtime.cc index 059263db44e..ecc508d0dcc 100644 --- a/gcc/go/gofrontend/runtime.cc +++ b/gcc/go/gofrontend/runtime.cc @@ -6,8 +6,6 @@ #include "go-system.h" -#include <gmp.h> - #include "gogo.h" #include "types.h" #include "expressions.h" diff --git a/gcc/go/gofrontend/statements.cc b/gcc/go/gofrontend/statements.cc index fb1322f42f3..7870dad729e 100644 --- a/gcc/go/gofrontend/statements.cc +++ b/gcc/go/gofrontend/statements.cc @@ -6,8 +6,6 @@ #include "go-system.h" -#include <gmp.h> - #include "go-c.h" #include "types.h" #include "expressions.h" diff --git a/gcc/go/gofrontend/types.cc b/gcc/go/gofrontend/types.cc index 44d6a61f8e6..c0aeb91acff 100644 --- a/gcc/go/gofrontend/types.cc +++ b/gcc/go/gofrontend/types.cc @@ -6,8 +6,6 @@ #include "go-system.h" -#include <gmp.h> - #include "toplev.h" #include "intl.h" #include "tree.h" diff --git a/gcc/ipa-inline-analysis.c b/gcc/ipa-inline-analysis.c index 8f5b1f2641c..3e03b31d17d 100644 --- a/gcc/ipa-inline-analysis.c +++ b/gcc/ipa-inline-analysis.c @@ -1,5 +1,5 @@ /* Inlining decision heuristics. - Copyright (C) 2003, 2004, 2007, 2008, 2009, 2010, 2011 + Copyright (C) 2003, 2004, 2007, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. Contributed by Jan Hubicka @@ -127,8 +127,7 @@ static void inline_node_duplication_hook (struct cgraph_node *, struct cgraph_node *, void *); static void inline_edge_removal_hook (struct cgraph_edge *, void *); static void inline_edge_duplication_hook (struct cgraph_edge *, - struct cgraph_edge *, - void *); + struct cgraph_edge *, void *); /* VECtor holding inline summaries. In GGC memory because conditions might point to constant trees. */ @@ -200,6 +199,7 @@ false_predicate_p (struct predicate *p) /* Return predicate that is set true when function is not inlined. */ + static inline struct predicate not_inlined_predicate (void) { @@ -254,7 +254,7 @@ add_condition (struct inline_summary *summary, int operand_num, && c->val == val && c->agg_contents == agg_contents && (!agg_contents || (c->offset == offset && c->by_ref == by_ref))) - return single_cond_predicate (i + predicate_first_dynamic_condition); + return single_cond_predicate (i + predicate_first_dynamic_condition); } /* Too many conditions. Give up and return constant true. */ if (i == NUM_CONDITIONS - predicate_first_dynamic_condition) @@ -321,7 +321,7 @@ add_clause (conditions conditions, struct predicate *p, clause_t clause) insert_here = i2; /* If clause implies p->clause[i], then p->clause[i] becomes redundant. - Otherwise the p->clause[i] has to stay. */ + Otherwise the p->clause[i] has to stay. */ if ((p->clause[i] & clause) != clause) i2++; } @@ -335,26 +335,27 @@ add_clause (conditions conditions, struct predicate *p, clause_t clause) continue; cc1 = &(*conditions)[c1 - predicate_first_dynamic_condition]; /* We have no way to represent !CHANGED and !IS_NOT_CONSTANT - and thus there is no point for looking for them. */ - if (cc1->code == CHANGED - || cc1->code == IS_NOT_CONSTANT) + and thus there is no point for looking for them. */ + if (cc1->code == CHANGED || cc1->code == IS_NOT_CONSTANT) continue; for (c2 = c1 + 1; c2 <= NUM_CONDITIONS; c2++) if (clause & (1 << c2)) { - condition *cc1 = &(*conditions)[c1 - predicate_first_dynamic_condition]; - condition *cc2 = &(*conditions)[c2 - predicate_first_dynamic_condition]; + condition *cc1 = + &(*conditions)[c1 - predicate_first_dynamic_condition]; + condition *cc2 = + &(*conditions)[c2 - predicate_first_dynamic_condition]; if (cc1->operand_num == cc2->operand_num && cc1->val == cc2->val && cc2->code != IS_NOT_CONSTANT && cc2->code != CHANGED - && cc1->code == invert_tree_comparison - (cc2->code, - HONOR_NANS (TYPE_MODE (TREE_TYPE (cc1->val))))) + && cc1->code == invert_tree_comparison + (cc2->code, + HONOR_NANS (TYPE_MODE (TREE_TYPE (cc1->val))))) return; } } - + /* We run out of variants. Be conservative in positive direction. */ if (i2 == MAX_CLAUSES) @@ -362,7 +363,7 @@ add_clause (conditions conditions, struct predicate *p, clause_t clause) /* Keep clauses in decreasing order. This makes equivalence testing easy. */ p->clause[i2 + 1] = 0; if (insert_here >= 0) - for (;i2 > insert_here; i2--) + for (; i2 > insert_here; i2--) p->clause[i2] = p->clause[i2 - 1]; else insert_here = i2; @@ -390,7 +391,7 @@ and_predicates (conditions conditions, { gcc_checking_assert (i < MAX_CLAUSES); } - + /* Combine the predicates rest. */ for (; p2->clause[i]; i++) { @@ -410,11 +411,11 @@ predicates_equal_p (struct predicate *p, struct predicate *p2) for (i = 0; p->clause[i]; i++) { gcc_checking_assert (i < MAX_CLAUSES); - gcc_checking_assert (p->clause [i] > p->clause[i + 1]); + gcc_checking_assert (p->clause[i] > p->clause[i + 1]); gcc_checking_assert (!p2->clause[i] - || p2->clause [i] > p2->clause[i + 1]); + || p2->clause[i] > p2->clause[i + 1]); if (p->clause[i] != p2->clause[i]) - return false; + return false; } return !p2->clause[i]; } @@ -423,10 +424,11 @@ predicates_equal_p (struct predicate *p, struct predicate *p2) /* Return P | P2. */ static struct predicate -or_predicates (conditions conditions, struct predicate *p, struct predicate *p2) +or_predicates (conditions conditions, + struct predicate *p, struct predicate *p2) { struct predicate out = true_predicate (); - int i,j; + int i, j; /* Avoid busy work. */ if (false_predicate_p (p2) || true_predicate_p (p)) @@ -440,8 +442,8 @@ or_predicates (conditions conditions, struct predicate *p, struct predicate *p2) for (i = 0; p->clause[i]; i++) for (j = 0; p2->clause[j]; j++) { - gcc_checking_assert (i < MAX_CLAUSES && j < MAX_CLAUSES); - add_clause (conditions, &out, p->clause[i] | p2->clause[j]); + gcc_checking_assert (i < MAX_CLAUSES && j < MAX_CLAUSES); + add_clause (conditions, &out, p->clause[i] | p2->clause[j]); } return out; } @@ -466,7 +468,7 @@ evaluate_predicate (struct predicate *p, clause_t possible_truths) { gcc_checking_assert (i < MAX_CLAUSES); if (!(p->clause[i] & possible_truths)) - return false; + return false; } return true; } @@ -508,23 +510,25 @@ predicate_probability (conditions conds, { if (i2 >= predicate_first_dynamic_condition) { - condition *c = &(*conds)[i2 - predicate_first_dynamic_condition]; + condition *c = + &(*conds)[i2 - predicate_first_dynamic_condition]; if (c->code == CHANGED - && (c->operand_num - < (int) inline_param_summary.length ())) + && (c->operand_num < + (int) inline_param_summary.length ())) { - int iprob = inline_param_summary[c->operand_num].change_prob; + int iprob = + inline_param_summary[c->operand_num].change_prob; this_prob = MAX (this_prob, iprob); } else this_prob = REG_BR_PROB_BASE; - } - else - this_prob = REG_BR_PROB_BASE; + } + else + this_prob = REG_BR_PROB_BASE; } combined_prob = MIN (this_prob, combined_prob); if (!combined_prob) - return 0; + return 0; } } return combined_prob; @@ -580,7 +584,7 @@ dump_clause (FILE *f, conditions conds, clause_t clause) if (found) fprintf (f, " || "); found = true; - dump_condition (f, conds, i); + dump_condition (f, conds, i); } fprintf (f, ")"); } @@ -599,7 +603,7 @@ dump_predicate (FILE *f, conditions conds, struct predicate *pred) { if (i) fprintf (f, " && "); - dump_clause (f, conds, pred->clause[i]); + dump_clause (f, conds, pred->clause[i]); } fprintf (f, "\n"); } @@ -683,7 +687,7 @@ account_size_time (struct inline_summary *summary, int size, int time, if (predicates_equal_p (&e->predicate, pred)) { found = true; - break; + break; } if (i == 256) { @@ -692,14 +696,16 @@ account_size_time (struct inline_summary *summary, int size, int time, e = &(*summary->entry)[0]; gcc_assert (!e->predicate.clause[0]); if (dump_file && (dump_flags & TDF_DETAILS)) - fprintf (dump_file, "\t\tReached limit on number of entries, ignoring the predicate."); + fprintf (dump_file, + "\t\tReached limit on number of entries, " + "ignoring the predicate."); } if (dump_file && (dump_flags & TDF_DETAILS) && (time || size)) { - fprintf (dump_file, "\t\tAccounting size:%3.2f, time:%3.2f on %spredicate:", - ((double)size) / INLINE_SIZE_SCALE, - ((double)time) / INLINE_TIME_SCALE, - found ? "" : "new "); + fprintf (dump_file, + "\t\tAccounting size:%3.2f, time:%3.2f on %spredicate:", + ((double) size) / INLINE_SIZE_SCALE, + ((double) time) / INLINE_TIME_SCALE, found ? "" : "new "); dump_predicate (dump_file, summary->conds, pred); } if (!found) @@ -728,13 +734,13 @@ edge_set_predicate (struct cgraph_edge *e, struct predicate *predicate) if (predicate && !true_predicate_p (predicate)) { if (!es->predicate) - es->predicate = (struct predicate *)pool_alloc (edge_predicate_pool); + es->predicate = (struct predicate *) pool_alloc (edge_predicate_pool); *es->predicate = *predicate; } else { if (es->predicate) - pool_free (edge_predicate_pool, es->predicate); + pool_free (edge_predicate_pool, es->predicate); es->predicate = NULL; } } @@ -744,8 +750,7 @@ edge_set_predicate (struct cgraph_edge *e, struct predicate *predicate) static void set_hint_predicate (struct predicate **p, struct predicate new_predicate) { - if (false_predicate_p (&new_predicate) - || true_predicate_p (&new_predicate)) + if (false_predicate_p (&new_predicate) || true_predicate_p (&new_predicate)) { if (*p) pool_free (edge_predicate_pool, *p); @@ -754,7 +759,7 @@ set_hint_predicate (struct predicate **p, struct predicate new_predicate) else { if (!*p) - *p = (struct predicate *)pool_alloc (edge_predicate_pool); + *p = (struct predicate *) pool_alloc (edge_predicate_pool); **p = new_predicate; } } @@ -769,9 +774,10 @@ set_hint_predicate (struct predicate **p, struct predicate new_predicate) static clause_t evaluate_conditions_for_known_args (struct cgraph_node *node, - bool inline_p, - vec<tree> known_vals, - vec<ipa_agg_jump_function_p> known_aggs) + bool inline_p, + vec<tree> known_vals, + vec<ipa_agg_jump_function_p> + known_aggs) { clause_t clause = inline_p ? 0 : 1 << predicate_not_inlined_condition; struct inline_summary *info = inline_summary (node); @@ -784,9 +790,9 @@ evaluate_conditions_for_known_args (struct cgraph_node *node, tree res; /* We allow call stmt to have fewer arguments than the callee function - (especially for K&R style programs). So bound check here (we assume - known_aggs vector, if non-NULL, has the same length as - known_vals). */ + (especially for K&R style programs). So bound check here (we assume + known_aggs vector, if non-NULL, has the same length as + known_vals). */ gcc_checking_assert (!known_aggs.exists () || (known_vals.length () == known_aggs.length ())); if (c->operand_num >= (int) known_vals.length ()) @@ -801,8 +807,7 @@ evaluate_conditions_for_known_args (struct cgraph_node *node, if (c->code == CHANGED && !c->by_ref - && (known_vals[c->operand_num] - == error_mark_node)) + && (known_vals[c->operand_num] == error_mark_node)) continue; if (known_aggs.exists ()) @@ -828,8 +833,7 @@ evaluate_conditions_for_known_args (struct cgraph_node *node, if (c->code == IS_NOT_CONSTANT || c->code == CHANGED) continue; res = fold_binary_to_constant (c->code, boolean_type_node, val, c->val); - if (res - && integer_zerop (res)) + if (res && integer_zerop (res)) continue; clause |= 1 << (i + predicate_first_dynamic_condition); } @@ -841,12 +845,13 @@ evaluate_conditions_for_known_args (struct cgraph_node *node, static void evaluate_properties_for_edge (struct cgraph_edge *e, bool inline_p, - clause_t *clause_ptr, - vec<tree> *known_vals_ptr, - vec<tree> *known_binfos_ptr, - vec<ipa_agg_jump_function_p> *known_aggs_ptr) + clause_t *clause_ptr, + vec<tree> *known_vals_ptr, + vec<tree> *known_binfos_ptr, + vec<ipa_agg_jump_function_p> *known_aggs_ptr) { - struct cgraph_node *callee = cgraph_function_or_thunk_node (e->callee, NULL); + struct cgraph_node *callee = + cgraph_function_or_thunk_node (e->callee, NULL); struct inline_summary *info = inline_summary (callee); vec<tree> known_vals = vNULL; vec<ipa_agg_jump_function_p> known_aggs = vNULL; @@ -860,8 +865,7 @@ evaluate_properties_for_edge (struct cgraph_edge *e, bool inline_p, if (ipa_node_params_vector.exists () && !e->call_stmt_cannot_inline_p - && ((clause_ptr && info->conds) - || known_vals_ptr || known_binfos_ptr)) + && ((clause_ptr && info->conds) || known_vals_ptr || known_binfos_ptr)) { struct ipa_node_params *parms_info; struct ipa_edge_args *args = IPA_EDGE_REF (e); @@ -869,9 +873,9 @@ evaluate_properties_for_edge (struct cgraph_edge *e, bool inline_p, int i, count = ipa_get_cs_argument_count (args); if (e->caller->global.inlined_to) - parms_info = IPA_NODE_REF (e->caller->global.inlined_to); + parms_info = IPA_NODE_REF (e->caller->global.inlined_to); else - parms_info = IPA_NODE_REF (e->caller); + parms_info = IPA_NODE_REF (e->caller); if (count && (info->conds || known_vals_ptr)) known_vals.safe_grow_cleared (count); @@ -888,7 +892,8 @@ evaluate_properties_for_edge (struct cgraph_edge *e, bool inline_p, { if (known_vals.exists () && TREE_CODE (cst) != TREE_BINFO) known_vals[i] = cst; - else if (known_binfos_ptr != NULL && TREE_CODE (cst) == TREE_BINFO) + else if (known_binfos_ptr != NULL + && TREE_CODE (cst) == TREE_BINFO) (*known_binfos_ptr)[i] = cst; } else if (inline_p && !es->param[i].change_prob) @@ -940,8 +945,7 @@ inline_summary_alloc (void) inline_edge_summary_vec.safe_grow_cleared (cgraph_edge_max_uid + 1); if (!edge_predicate_pool) edge_predicate_pool = create_alloc_pool ("edge predicates", - sizeof (struct predicate), - 10); + sizeof (struct predicate), 10); } /* We are called multiple time for given function; clear @@ -950,7 +954,7 @@ inline_summary_alloc (void) static void reset_inline_edge_summary (struct cgraph_edge *e) { - if (e->uid < (int)inline_edge_summary_vec.length ()) + if (e->uid < (int) inline_edge_summary_vec.length ()) { struct inline_edge_summary *es = inline_edge_summary (e); @@ -1005,10 +1009,11 @@ reset_inline_summary (struct cgraph_node *node) /* Hook that is called by cgraph.c when a node is removed. */ static void -inline_node_removal_hook (struct cgraph_node *node, void *data ATTRIBUTE_UNUSED) +inline_node_removal_hook (struct cgraph_node *node, + void *data ATTRIBUTE_UNUSED) { struct inline_summary *info; - if (vec_safe_length (inline_summary_vec) <= (unsigned)node->uid) + if (vec_safe_length (inline_summary_vec) <= (unsigned) node->uid) return; info = inline_summary (node); reset_inline_summary (node); @@ -1054,8 +1059,7 @@ remap_hint_predicate_after_duplication (struct predicate **p, return; new_predicate = remap_predicate_after_duplication (*p, - possible_truths, - info); + possible_truths, info); /* We do not want to free previous predicate; it is used by node origin. */ *p = NULL; set_hint_predicate (p, new_predicate); @@ -1065,29 +1069,28 @@ remap_hint_predicate_after_duplication (struct predicate **p, /* Hook that is called by cgraph.c when a node is duplicated. */ static void -inline_node_duplication_hook (struct cgraph_node *src, struct cgraph_node *dst, +inline_node_duplication_hook (struct cgraph_node *src, + struct cgraph_node *dst, ATTRIBUTE_UNUSED void *data) { struct inline_summary *info; inline_summary_alloc (); info = inline_summary (dst); - memcpy (info, inline_summary (src), - sizeof (struct inline_summary)); + memcpy (info, inline_summary (src), sizeof (struct inline_summary)); /* TODO: as an optimization, we may avoid copying conditions that are known to be false or true. */ info->conds = vec_safe_copy (info->conds); /* When there are any replacements in the function body, see if we can figure out that something was optimized out. */ - if (ipa_node_params_vector.exists () - && dst->clone.tree_map) + if (ipa_node_params_vector.exists () && dst->clone.tree_map) { vec<size_time_entry, va_gc> *entry = info->entry; /* Use SRC parm info since it may not be copied yet. */ struct ipa_node_params *parms_info = IPA_NODE_REF (src); vec<tree> known_vals = vNULL; int count = ipa_get_param_count (parms_info); - int i,j; + int i, j; clause_t possible_truths; struct predicate true_pred = true_predicate (); size_time_entry *e; @@ -1098,15 +1101,13 @@ inline_node_duplication_hook (struct cgraph_node *src, struct cgraph_node *dst, info->entry = 0; known_vals.safe_grow_cleared (count); for (i = 0; i < count; i++) - { + { tree t = ipa_get_param (parms_info, i); struct ipa_replace_map *r; for (j = 0; vec_safe_iterate (dst->clone.tree_map, j, &r); j++) { - if (r->old_tree == t - && r->replace_p - && !r->ref_p) + if (r->old_tree == t && r->replace_p && !r->ref_p) { known_vals[i] = r->new_tree; break; @@ -1114,16 +1115,17 @@ inline_node_duplication_hook (struct cgraph_node *src, struct cgraph_node *dst, } } possible_truths = evaluate_conditions_for_known_args (dst, false, - known_vals, vNULL); + known_vals, + vNULL); known_vals.release (); account_size_time (info, 0, 0, &true_pred); /* Remap size_time vectors. - Simplify the predicate by prunning out alternatives that are known - to be false. - TODO: as on optimization, we can also eliminate conditions known - to be true. */ + Simplify the predicate by prunning out alternatives that are known + to be false. + TODO: as on optimization, we can also eliminate conditions known + to be true. */ for (i = 0; vec_safe_iterate (entry, i, &e); i++) { struct predicate new_predicate; @@ -1137,7 +1139,7 @@ inline_node_duplication_hook (struct cgraph_node *src, struct cgraph_node *dst, } /* Remap edge predicates with the same simplification as above. - Also copy constantness arrays. */ + Also copy constantness arrays. */ for (edge = dst->callees; edge; edge = edge->next_callee) { struct predicate new_predicate; @@ -1160,7 +1162,7 @@ inline_node_duplication_hook (struct cgraph_node *src, struct cgraph_node *dst, } /* Remap indirect edge predicates with the same simplificaiton as above. - Also copy constantness arrays. */ + Also copy constantness arrays. */ for (edge = dst->indirect_calls; edge; edge = edge->next_callee) { struct predicate new_predicate; @@ -1181,21 +1183,17 @@ inline_node_duplication_hook (struct cgraph_node *src, struct cgraph_node *dst, edge_set_predicate (edge, &new_predicate); } remap_hint_predicate_after_duplication (&info->loop_iterations, - possible_truths, - info); + possible_truths, info); remap_hint_predicate_after_duplication (&info->loop_stride, - possible_truths, - info); + possible_truths, info); remap_hint_predicate_after_duplication (&info->array_index, - possible_truths, - info); + possible_truths, info); /* If inliner or someone after inliner will ever start producing - non-trivial clones, we will get trouble with lack of information - about updating self sizes, because size vectors already contains - sizes of the calees. */ - gcc_assert (!inlined_to_p - || !optimized_out_size); + non-trivial clones, we will get trouble with lack of information + about updating self sizes, because size vectors already contains + sizes of the calees. */ + gcc_assert (!inlined_to_p || !optimized_out_size); } else { @@ -1226,7 +1224,8 @@ inline_node_duplication_hook (struct cgraph_node *src, struct cgraph_node *dst, /* Hook that is called by cgraph.c when a node is duplicated. */ static void -inline_edge_duplication_hook (struct cgraph_edge *src, struct cgraph_edge *dst, +inline_edge_duplication_hook (struct cgraph_edge *src, + struct cgraph_edge *dst, ATTRIBUTE_UNUSED void *data) { struct inline_edge_summary *info; @@ -1234,8 +1233,7 @@ inline_edge_duplication_hook (struct cgraph_edge *src, struct cgraph_edge *dst, inline_summary_alloc (); info = inline_edge_summary (dst); srcinfo = inline_edge_summary (src); - memcpy (info, srcinfo, - sizeof (struct inline_edge_summary)); + memcpy (info, srcinfo, sizeof (struct inline_edge_summary)); info->predicate = NULL; edge_set_predicate (dst, srcinfo->predicate); info->param = srcinfo->param.copy (); @@ -1245,7 +1243,8 @@ inline_edge_duplication_hook (struct cgraph_edge *src, struct cgraph_edge *dst, /* Keep edge cache consistent across edge removal. */ static void -inline_edge_removal_hook (struct cgraph_edge *edge, void *data ATTRIBUTE_UNUSED) +inline_edge_removal_hook (struct cgraph_edge *edge, + void *data ATTRIBUTE_UNUSED) { if (edge_growth_cache.exists ()) reset_edge_growth_cache (edge); @@ -1279,28 +1278,27 @@ free_growth_caches (void) Indent by INDENT. */ static void -dump_inline_edge_summary (FILE * f, int indent, struct cgraph_node *node, +dump_inline_edge_summary (FILE *f, int indent, struct cgraph_node *node, struct inline_summary *info) { struct cgraph_edge *edge; for (edge = node->callees; edge; edge = edge->next_callee) { struct inline_edge_summary *es = inline_edge_summary (edge); - struct cgraph_node *callee = cgraph_function_or_thunk_node (edge->callee, NULL); + struct cgraph_node *callee = + cgraph_function_or_thunk_node (edge->callee, NULL); int i; - fprintf (f, "%*s%s/%i %s\n%*s loop depth:%2i freq:%4i size:%2i time: %2i callee size:%2i stack:%2i", - indent, "", cgraph_node_name (callee), - callee->uid, - !edge->inline_failed ? "inlined" - : cgraph_inline_failed_string (edge->inline_failed), - indent, "", - es->loop_depth, - edge->frequency, - es->call_stmt_size, - es->call_stmt_time, - (int)inline_summary (callee)->size / INLINE_SIZE_SCALE, - (int)inline_summary (callee)->estimated_stack_size); + fprintf (f, + "%*s%s/%i %s\n%*s loop depth:%2i freq:%4i size:%2i" + " time: %2i callee size:%2i stack:%2i", + indent, "", cgraph_node_name (callee), callee->uid, + !edge->inline_failed + ? "inlined" : cgraph_inline_failed_string (edge-> inline_failed), + indent, "", es->loop_depth, edge->frequency, + es->call_stmt_size, es->call_stmt_time, + (int) inline_summary (callee)->size / INLINE_SIZE_SCALE, + (int) inline_summary (callee)->estimated_stack_size); if (es->predicate) { @@ -1308,9 +1306,9 @@ dump_inline_edge_summary (FILE * f, int indent, struct cgraph_node *node, dump_predicate (f, info->conds, es->predicate); } else - fprintf (f, "\n"); + fprintf (f, "\n"); if (es->param.exists ()) - for (i = 0; i < (int)es->param.length (); i++) + for (i = 0; i < (int) es->param.length (); i++) { int prob = es->param[i].change_prob; @@ -1323,13 +1321,13 @@ dump_inline_edge_summary (FILE * f, int indent, struct cgraph_node *node, } if (!edge->inline_failed) { - fprintf (f, "%*sStack frame offset %i, callee self size %i," + fprintf (f, "%*sStack frame offset %i, callee self size %i," " callee size %i\n", - indent+2, "", - (int)inline_summary (callee)->stack_frame_offset, - (int)inline_summary (callee)->estimated_self_stack_size, - (int)inline_summary (callee)->estimated_stack_size); - dump_inline_edge_summary (f, indent+2, callee, info); + indent + 2, "", + (int) inline_summary (callee)->stack_frame_offset, + (int) inline_summary (callee)->estimated_self_stack_size, + (int) inline_summary (callee)->estimated_stack_size); + dump_inline_edge_summary (f, indent + 2, callee, info); } } for (edge = node->indirect_calls; edge; edge = edge->next_callee) @@ -1338,10 +1336,8 @@ dump_inline_edge_summary (FILE * f, int indent, struct cgraph_node *node, fprintf (f, "%*sindirect call loop depth:%2i freq:%4i size:%2i" " time: %2i", indent, "", - es->loop_depth, - edge->frequency, - es->call_stmt_size, - es->call_stmt_time); + es->loop_depth, + edge->frequency, es->call_stmt_size, es->call_stmt_time); if (es->predicate) { fprintf (f, "predicate: "); @@ -1354,7 +1350,7 @@ dump_inline_edge_summary (FILE * f, int indent, struct cgraph_node *node, void -dump_inline_summary (FILE * f, struct cgraph_node *node) +dump_inline_summary (FILE *f, struct cgraph_node *node) { if (node->analyzed) { @@ -1367,22 +1363,17 @@ dump_inline_summary (FILE * f, struct cgraph_node *node) fprintf (f, " always_inline"); if (s->inlinable) fprintf (f, " inlinable"); - fprintf (f, "\n self time: %i\n", - s->self_time); + fprintf (f, "\n self time: %i\n", s->self_time); fprintf (f, " global time: %i\n", s->time); - fprintf (f, " self size: %i\n", - s->self_size); + fprintf (f, " self size: %i\n", s->self_size); fprintf (f, " global size: %i\n", s->size); fprintf (f, " self stack: %i\n", (int) s->estimated_self_stack_size); - fprintf (f, " global stack: %i\n", - (int) s->estimated_stack_size); + fprintf (f, " global stack: %i\n", (int) s->estimated_stack_size); if (s->growth) - fprintf (f, " estimated growth:%i\n", - (int) s->growth); + fprintf (f, " estimated growth:%i\n", (int) s->growth); if (s->scc_no) - fprintf (f, " In SCC: %i\n", - (int) s->scc_no); + fprintf (f, " In SCC: %i\n", (int) s->scc_no); for (i = 0; vec_safe_iterate (s->entry, i, &e); i++) { fprintf (f, " size:%f, time:%f, predicate:", @@ -1452,7 +1443,7 @@ initialize_inline_failed (struct cgraph_edge *e) static bool mark_modified (ao_ref *ao ATTRIBUTE_UNUSED, tree vdef ATTRIBUTE_UNUSED, - void *data) + void *data) { bool *b = (bool *) data; *b = true; @@ -1563,116 +1554,117 @@ eliminated_by_inlining_prob (gimple stmt) switch (code) { - case GIMPLE_RETURN: - return 2; - case GIMPLE_ASSIGN: - if (gimple_num_ops (stmt) != 2) - return 0; - - rhs_code = gimple_assign_rhs_code (stmt); - - /* Casts of parameters, loads from parameters passed by reference - and stores to return value or parameters are often free after - inlining dua to SRA and further combining. - Assume that half of statements goes away. */ - if (rhs_code == CONVERT_EXPR - || rhs_code == NOP_EXPR - || rhs_code == VIEW_CONVERT_EXPR - || rhs_code == ADDR_EXPR - || gimple_assign_rhs_class (stmt) == GIMPLE_SINGLE_RHS) - { - tree rhs = gimple_assign_rhs1 (stmt); - tree lhs = gimple_assign_lhs (stmt); - tree inner_rhs = get_base_address (rhs); - tree inner_lhs = get_base_address (lhs); - bool rhs_free = false; - bool lhs_free = false; - - if (!inner_rhs) - inner_rhs = rhs; - if (!inner_lhs) - inner_lhs = lhs; - - /* Reads of parameter are expected to be free. */ - if (unmodified_parm (stmt, inner_rhs)) - rhs_free = true; - /* Match expressions of form &this->field. Those will most likely - combine with something upstream after inlining. */ - else if (TREE_CODE (inner_rhs) == ADDR_EXPR) - { - tree op = get_base_address (TREE_OPERAND (inner_rhs, 0)); - if (TREE_CODE (op) == PARM_DECL) - rhs_free = true; - else if (TREE_CODE (op) == MEM_REF - && unmodified_parm (stmt, TREE_OPERAND (op, 0))) - rhs_free = true; - } - - /* When parameter is not SSA register because its address is taken - and it is just copied into one, the statement will be completely - free after inlining (we will copy propagate backward). */ - if (rhs_free && is_gimple_reg (lhs)) - return 2; - - /* Reads of parameters passed by reference - expected to be free (i.e. optimized out after inlining). */ - if (TREE_CODE(inner_rhs) == MEM_REF - && unmodified_parm (stmt, TREE_OPERAND (inner_rhs, 0))) - rhs_free = true; - - /* Copying parameter passed by reference into gimple register is - probably also going to copy propagate, but we can't be quite - sure. */ - if (rhs_free && is_gimple_reg (lhs)) - lhs_free = true; - - /* Writes to parameters, parameters passed by value and return value - (either dirrectly or passed via invisible reference) are free. - - TODO: We ought to handle testcase like - struct a {int a,b;}; - struct a - retrurnsturct (void) - { - struct a a ={1,2}; - return a; - } - - This translate into: - - retrurnsturct () - { - int a$b; - int a$a; - struct a a; - struct a D.2739; - - <bb 2>: - D.2739.a = 1; - D.2739.b = 2; - return D.2739; - - } - For that we either need to copy ipa-split logic detecting writes - to return value. */ - if (TREE_CODE (inner_lhs) == PARM_DECL - || TREE_CODE (inner_lhs) == RESULT_DECL - || (TREE_CODE(inner_lhs) == MEM_REF - && (unmodified_parm (stmt, TREE_OPERAND (inner_lhs, 0)) - || (TREE_CODE (TREE_OPERAND (inner_lhs, 0)) == SSA_NAME - && SSA_NAME_VAR (TREE_OPERAND (inner_lhs, 0)) - && TREE_CODE (SSA_NAME_VAR (TREE_OPERAND - (inner_lhs, 0))) == RESULT_DECL)))) - lhs_free = true; - if (lhs_free - && (is_gimple_reg (rhs) || is_gimple_min_invariant (rhs))) - rhs_free = true; - if (lhs_free && rhs_free) - return 1; - } - return 0; - default: + case GIMPLE_RETURN: + return 2; + case GIMPLE_ASSIGN: + if (gimple_num_ops (stmt) != 2) return 0; + + rhs_code = gimple_assign_rhs_code (stmt); + + /* Casts of parameters, loads from parameters passed by reference + and stores to return value or parameters are often free after + inlining dua to SRA and further combining. + Assume that half of statements goes away. */ + if (rhs_code == CONVERT_EXPR + || rhs_code == NOP_EXPR + || rhs_code == VIEW_CONVERT_EXPR + || rhs_code == ADDR_EXPR + || gimple_assign_rhs_class (stmt) == GIMPLE_SINGLE_RHS) + { + tree rhs = gimple_assign_rhs1 (stmt); + tree lhs = gimple_assign_lhs (stmt); + tree inner_rhs = get_base_address (rhs); + tree inner_lhs = get_base_address (lhs); + bool rhs_free = false; + bool lhs_free = false; + + if (!inner_rhs) + inner_rhs = rhs; + if (!inner_lhs) + inner_lhs = lhs; + + /* Reads of parameter are expected to be free. */ + if (unmodified_parm (stmt, inner_rhs)) + rhs_free = true; + /* Match expressions of form &this->field. Those will most likely + combine with something upstream after inlining. */ + else if (TREE_CODE (inner_rhs) == ADDR_EXPR) + { + tree op = get_base_address (TREE_OPERAND (inner_rhs, 0)); + if (TREE_CODE (op) == PARM_DECL) + rhs_free = true; + else if (TREE_CODE (op) == MEM_REF + && unmodified_parm (stmt, TREE_OPERAND (op, 0))) + rhs_free = true; + } + + /* When parameter is not SSA register because its address is taken + and it is just copied into one, the statement will be completely + free after inlining (we will copy propagate backward). */ + if (rhs_free && is_gimple_reg (lhs)) + return 2; + + /* Reads of parameters passed by reference + expected to be free (i.e. optimized out after inlining). */ + if (TREE_CODE (inner_rhs) == MEM_REF + && unmodified_parm (stmt, TREE_OPERAND (inner_rhs, 0))) + rhs_free = true; + + /* Copying parameter passed by reference into gimple register is + probably also going to copy propagate, but we can't be quite + sure. */ + if (rhs_free && is_gimple_reg (lhs)) + lhs_free = true; + + /* Writes to parameters, parameters passed by value and return value + (either dirrectly or passed via invisible reference) are free. + + TODO: We ought to handle testcase like + struct a {int a,b;}; + struct a + retrurnsturct (void) + { + struct a a ={1,2}; + return a; + } + + This translate into: + + retrurnsturct () + { + int a$b; + int a$a; + struct a a; + struct a D.2739; + + <bb 2>: + D.2739.a = 1; + D.2739.b = 2; + return D.2739; + + } + For that we either need to copy ipa-split logic detecting writes + to return value. */ + if (TREE_CODE (inner_lhs) == PARM_DECL + || TREE_CODE (inner_lhs) == RESULT_DECL + || (TREE_CODE (inner_lhs) == MEM_REF + && (unmodified_parm (stmt, TREE_OPERAND (inner_lhs, 0)) + || (TREE_CODE (TREE_OPERAND (inner_lhs, 0)) == SSA_NAME + && SSA_NAME_VAR (TREE_OPERAND (inner_lhs, 0)) + && TREE_CODE (SSA_NAME_VAR (TREE_OPERAND + (inner_lhs, + 0))) == RESULT_DECL)))) + lhs_free = true; + if (lhs_free + && (is_gimple_reg (rhs) || is_gimple_min_invariant (rhs))) + rhs_free = true; + if (lhs_free && rhs_free) + return 1; + } + return 0; + default: + return 0; } } @@ -1682,8 +1674,8 @@ eliminated_by_inlining_prob (gimple stmt) static void set_cond_stmt_execution_predicate (struct ipa_node_params *info, - struct inline_summary *summary, - basic_block bb) + struct inline_summary *summary, + basic_block bb) { gimple last; tree op; @@ -1696,8 +1688,7 @@ set_cond_stmt_execution_predicate (struct ipa_node_params *info, tree op2; last = last_stmt (bb); - if (!last - || gimple_code (last) != GIMPLE_COND) + if (!last || gimple_code (last) != GIMPLE_COND) return; if (!is_gimple_ip_invariant (gimple_cond_rhs (last))) return; @@ -1709,8 +1700,8 @@ set_cond_stmt_execution_predicate (struct ipa_node_params *info, { code = gimple_cond_code (last); inverted_code - = invert_tree_comparison (code, - HONOR_NANS (TYPE_MODE (TREE_TYPE (op)))); + = invert_tree_comparison (code, + HONOR_NANS (TYPE_MODE (TREE_TYPE (op)))); FOR_EACH_EDGE (e, ei, bb->succs) { @@ -1719,7 +1710,7 @@ set_cond_stmt_execution_predicate (struct ipa_node_params *info, ? code : inverted_code, gimple_cond_rhs (last)); e->aux = pool_alloc (edge_predicate_pool); - *(struct predicate *)e->aux = p; + *(struct predicate *) e->aux = p; } } @@ -1727,9 +1718,9 @@ set_cond_stmt_execution_predicate (struct ipa_node_params *info, return; /* Special case if (builtin_constant_p (op)) - constant_code + constant_code else - nonconstant_code. + nonconstant_code. Here we can predicate nonconstant_code. We can't really handle constant_code since we have no predicate for this and also the constant code is not known to be @@ -1743,16 +1734,16 @@ set_cond_stmt_execution_predicate (struct ipa_node_params *info, || gimple_call_num_args (set_stmt) != 1) return; op2 = gimple_call_arg (set_stmt, 0); - if (!unmodified_parm_or_parm_agg_item (info, set_stmt, op2, &index, &aggpos)) + if (!unmodified_parm_or_parm_agg_item + (info, set_stmt, op2, &index, &aggpos)) return; - FOR_EACH_EDGE (e, ei, bb->succs) - if (e->flags & EDGE_FALSE_VALUE) - { - struct predicate p = add_condition (summary, index, &aggpos, - IS_NOT_CONSTANT, NULL_TREE); - e->aux = pool_alloc (edge_predicate_pool); - *(struct predicate *)e->aux = p; - } + FOR_EACH_EDGE (e, ei, bb->succs) if (e->flags & EDGE_FALSE_VALUE) + { + struct predicate p = add_condition (summary, index, &aggpos, + IS_NOT_CONSTANT, NULL_TREE); + e->aux = pool_alloc (edge_predicate_pool); + *(struct predicate *) e->aux = p; + } } @@ -1761,8 +1752,8 @@ set_cond_stmt_execution_predicate (struct ipa_node_params *info, static void set_switch_stmt_execution_predicate (struct ipa_node_params *info, - struct inline_summary *summary, - basic_block bb) + struct inline_summary *summary, + basic_block bb) { gimple last; tree op; @@ -1774,8 +1765,7 @@ set_switch_stmt_execution_predicate (struct ipa_node_params *info, size_t case_idx; last = last_stmt (bb); - if (!last - || gimple_code (last) != GIMPLE_SWITCH) + if (!last || gimple_code (last) != GIMPLE_SWITCH) return; op = gimple_switch_index (last); if (!unmodified_parm_or_parm_agg_item (info, last, op, &index, &aggpos)) @@ -1784,9 +1774,9 @@ set_switch_stmt_execution_predicate (struct ipa_node_params *info, FOR_EACH_EDGE (e, ei, bb->succs) { e->aux = pool_alloc (edge_predicate_pool); - *(struct predicate *)e->aux = false_predicate (); + *(struct predicate *) e->aux = false_predicate (); } - n = gimple_switch_num_labels(last); + n = gimple_switch_num_labels (last); for (case_idx = 0; case_idx < n; ++case_idx) { tree cl = gimple_switch_label (last, case_idx); @@ -1798,8 +1788,8 @@ set_switch_stmt_execution_predicate (struct ipa_node_params *info, max = CASE_HIGH (cl); /* For default we might want to construct predicate that none - of cases is met, but it is bit hard to do not having negations - of conditionals handy. */ + of cases is met, but it is bit hard to do not having negations + of conditionals handy. */ if (!min && !max) p = true_predicate (); else if (!max) @@ -1811,8 +1801,8 @@ set_switch_stmt_execution_predicate (struct ipa_node_params *info, p2 = add_condition (summary, index, &aggpos, LE_EXPR, max); p = and_predicates (summary->conds, &p1, &p2); } - *(struct predicate *)e->aux - = or_predicates (summary->conds, &p, (struct predicate *)e->aux); + *(struct predicate *) e->aux + = or_predicates (summary->conds, &p, (struct predicate *) e->aux); } } @@ -1838,7 +1828,7 @@ compute_bb_predicates (struct cgraph_node *node, /* Entry block is always executable. */ ENTRY_BLOCK_PTR_FOR_FUNCTION (my_function)->aux = pool_alloc (edge_predicate_pool); - *(struct predicate *)ENTRY_BLOCK_PTR_FOR_FUNCTION (my_function)->aux + *(struct predicate *) ENTRY_BLOCK_PTR_FOR_FUNCTION (my_function)->aux = true_predicate (); /* A simple dataflow propagation of predicates forward in the CFG. @@ -1848,19 +1838,19 @@ compute_bb_predicates (struct cgraph_node *node, done = true; FOR_EACH_BB_FN (bb, my_function) { - struct predicate p = false_predicate (); - edge e; - edge_iterator ei; + struct predicate p = false_predicate (); + edge e; + edge_iterator ei; FOR_EACH_EDGE (e, ei, bb->preds) { if (e->src->aux) { struct predicate this_bb_predicate - = *(struct predicate *)e->src->aux; + = *(struct predicate *) e->src->aux; if (e->aux) this_bb_predicate - = and_predicates (summary->conds, &this_bb_predicate, - (struct predicate *)e->aux); + = and_predicates (summary->conds, &this_bb_predicate, + (struct predicate *) e->aux); p = or_predicates (summary->conds, &p, &this_bb_predicate); if (true_predicate_p (&p)) break; @@ -1874,12 +1864,12 @@ compute_bb_predicates (struct cgraph_node *node, { done = false; bb->aux = pool_alloc (edge_predicate_pool); - *((struct predicate *)bb->aux) = p; + *((struct predicate *) bb->aux) = p; } - else if (!predicates_equal_p (&p, (struct predicate *)bb->aux)) + else if (!predicates_equal_p (&p, (struct predicate *) bb->aux)) { done = false; - *((struct predicate *)bb->aux) = p; + *((struct predicate *) bb->aux) = p; } } } @@ -1895,9 +1885,9 @@ typedef struct predicate predicate_t; static struct predicate will_be_nonconstant_expr_predicate (struct ipa_node_params *info, - struct inline_summary *summary, - tree expr, - vec<predicate_t> nonconstant_names) + struct inline_summary *summary, + tree expr, + vec<predicate_t> nonconstant_names) { tree parm; int index; @@ -1906,19 +1896,17 @@ will_be_nonconstant_expr_predicate (struct ipa_node_params *info, expr = TREE_OPERAND (expr, 0); parm = unmodified_parm (NULL, expr); - if (parm - && (index = ipa_get_param_decl_index (info, parm)) >= 0) + if (parm && (index = ipa_get_param_decl_index (info, parm)) >= 0) return add_condition (summary, index, NULL, CHANGED, NULL_TREE); if (is_gimple_min_invariant (expr)) return false_predicate (); if (TREE_CODE (expr) == SSA_NAME) return nonconstant_names[SSA_NAME_VERSION (expr)]; - if (BINARY_CLASS_P (expr) - || COMPARISON_CLASS_P (expr)) + if (BINARY_CLASS_P (expr) || COMPARISON_CLASS_P (expr)) { struct predicate p1 = will_be_nonconstant_expr_predicate - (info, summary, TREE_OPERAND (expr, 0), - nonconstant_names); + (info, summary, TREE_OPERAND (expr, 0), + nonconstant_names); struct predicate p2; if (true_predicate_p (&p1)) return p1; @@ -1930,8 +1918,8 @@ will_be_nonconstant_expr_predicate (struct ipa_node_params *info, else if (TREE_CODE (expr) == COND_EXPR) { struct predicate p1 = will_be_nonconstant_expr_predicate - (info, summary, TREE_OPERAND (expr, 0), - nonconstant_names); + (info, summary, TREE_OPERAND (expr, 0), + nonconstant_names); struct predicate p2; if (true_predicate_p (&p1)) return p1; @@ -2018,7 +2006,8 @@ will_be_nonconstant_predicate (struct ipa_node_params *info, } if (is_load) - op_non_const = add_condition (summary, base_index, &aggpos, CHANGED, NULL); + op_non_const = + add_condition (summary, base_index, &aggpos, CHANGED, NULL); else op_non_const = false_predicate (); FOR_EACH_SSA_TREE_OPERAND (use, stmt, iter, SSA_OP_USE) @@ -2026,8 +2015,7 @@ will_be_nonconstant_predicate (struct ipa_node_params *info, tree parm = unmodified_parm (stmt, use); int index; - if (parm - && (index = ipa_get_param_decl_index (info, parm)) >= 0) + if (parm && (index = ipa_get_param_decl_index (info, parm)) >= 0) { if (index != base_index) p = add_condition (summary, index, NULL, CHANGED, NULL_TREE); @@ -2041,7 +2029,7 @@ will_be_nonconstant_predicate (struct ipa_node_params *info, if (gimple_code (stmt) == GIMPLE_ASSIGN && TREE_CODE (gimple_assign_lhs (stmt)) == SSA_NAME) nonconstant_names[SSA_NAME_VERSION (gimple_assign_lhs (stmt))] - = op_non_const; + = op_non_const; return op_non_const; } @@ -2055,15 +2043,16 @@ struct record_modified_bb_info set except for info->stmt. */ static bool -record_modified (ao_ref *ao ATTRIBUTE_UNUSED, tree vdef, - void *data) +record_modified (ao_ref *ao ATTRIBUTE_UNUSED, tree vdef, void *data) { - struct record_modified_bb_info *info = (struct record_modified_bb_info *) data; + struct record_modified_bb_info *info = + (struct record_modified_bb_info *) data; if (SSA_NAME_DEF_STMT (vdef) == info->stmt) return false; bitmap_set_bit (info->bb_set, SSA_NAME_IS_DEFAULT_DEF (vdef) - ? ENTRY_BLOCK_PTR->index : gimple_bb (SSA_NAME_DEF_STMT (vdef))->index); + ? ENTRY_BLOCK_PTR->index + : gimple_bb (SSA_NAME_DEF_STMT (vdef))->index); return false; } @@ -2081,6 +2070,7 @@ param_change_prob (gimple stmt, int i) basic_block bb = gimple_bb (stmt); tree base; + /* Global invariants neve change. */ if (is_gimple_min_invariant (op)) return 0; /* We would have to do non-trivial analysis to really work out what @@ -2104,10 +2094,10 @@ param_change_prob (gimple stmt, int i) if (!init_freq) init_freq = 1; if (init_freq < bb->frequency) - return MAX ((init_freq * REG_BR_PROB_BASE + - bb->frequency / 2) / bb->frequency, 1); + return MAX ((init_freq * REG_BR_PROB_BASE + + bb->frequency / 2) / bb->frequency, 1); else - return REG_BR_PROB_BASE; + return REG_BR_PROB_BASE; } base = get_base_address (op); @@ -2130,13 +2120,13 @@ param_change_prob (gimple stmt, int i) NULL); if (bitmap_bit_p (info.bb_set, bb->index)) { - BITMAP_FREE (info.bb_set); + BITMAP_FREE (info.bb_set); return REG_BR_PROB_BASE; } /* Assume that every memory is initialized at entry. - TODO: Can we easilly determine if value is always defined - and thus we may skip entry block? */ + TODO: Can we easilly determine if value is always defined + and thus we may skip entry block? */ if (ENTRY_BLOCK_PTR->frequency) max = ENTRY_BLOCK_PTR->frequency; else @@ -2144,13 +2134,13 @@ param_change_prob (gimple stmt, int i) EXECUTE_IF_SET_IN_BITMAP (info.bb_set, 0, index, bi) max = MIN (max, BASIC_BLOCK (index)->frequency); - + BITMAP_FREE (info.bb_set); if (max < bb->frequency) - return MAX ((max * REG_BR_PROB_BASE + + return MAX ((max * REG_BR_PROB_BASE + bb->frequency / 2) / bb->frequency, 1); else - return REG_BR_PROB_BASE; + return REG_BR_PROB_BASE; } return REG_BR_PROB_BASE; } @@ -2251,19 +2241,18 @@ predicate_for_phi_result (struct inline_summary *summary, gimple phi, static struct predicate array_index_predicate (struct inline_summary *info, - vec<predicate_t> nonconstant_names, tree op) + vec< predicate_t> nonconstant_names, tree op) { struct predicate p = false_predicate (); while (handled_component_p (op)) { - if (TREE_CODE (op) == ARRAY_REF - || TREE_CODE (op) == ARRAY_RANGE_REF) - { + if (TREE_CODE (op) == ARRAY_REF || TREE_CODE (op) == ARRAY_RANGE_REF) + { if (TREE_CODE (TREE_OPERAND (op, 1)) == SSA_NAME) - p = or_predicates (info->conds, &p, - &nonconstant_names[ - SSA_NAME_VERSION (TREE_OPERAND (op, 1))]); - } + p = or_predicates (info->conds, &p, + &nonconstant_names[SSA_NAME_VERSION + (TREE_OPERAND (op, 1))]); + } op = TREE_OPERAND (op, 0); } return p; @@ -2304,7 +2293,8 @@ estimate_function_body_sizes (struct cgraph_node *node, bool early) if (ipa_node_params_vector.exists ()) { parms_info = IPA_NODE_REF (node); - nonconstant_names.safe_grow_cleared(SSANAMES (my_function)->length()); + nonconstant_names.safe_grow_cleared + (SSANAMES (my_function)->length ()); } } @@ -2335,7 +2325,7 @@ estimate_function_body_sizes (struct cgraph_node *node, bool early) if (parms_info) { if (bb->aux) - bb_predicate = *(struct predicate *)bb->aux; + bb_predicate = *(struct predicate *) bb->aux; else bb_predicate = false_predicate (); } @@ -2384,26 +2374,33 @@ estimate_function_body_sizes (struct cgraph_node *node, bool early) fprintf (dump_file, " "); print_gimple_stmt (dump_file, stmt, 0, 0); fprintf (dump_file, "\t\tfreq:%3.2f size:%3i time:%3i\n", - ((double)freq)/CGRAPH_FREQ_BASE, this_size, this_time); + ((double) freq) / CGRAPH_FREQ_BASE, this_size, + this_time); } if (gimple_assign_load_p (stmt) && nonconstant_names.exists ()) { struct predicate this_array_index; - this_array_index = array_index_predicate (info, nonconstant_names, - gimple_assign_rhs1 (stmt)); + this_array_index = + array_index_predicate (info, nonconstant_names, + gimple_assign_rhs1 (stmt)); if (!false_predicate_p (&this_array_index)) - array_index = and_predicates (info->conds, &array_index, &this_array_index); + array_index = + and_predicates (info->conds, &array_index, + &this_array_index); } if (gimple_store_p (stmt) && nonconstant_names.exists ()) { struct predicate this_array_index; - this_array_index = array_index_predicate (info, nonconstant_names, - gimple_get_lhs (stmt)); + this_array_index = + array_index_predicate (info, nonconstant_names, + gimple_get_lhs (stmt)); if (!false_predicate_p (&this_array_index)) - array_index = and_predicates (info->conds, &array_index, &this_array_index); + array_index = + and_predicates (info->conds, &array_index, + &this_array_index); } - + if (is_gimple_call (stmt)) { @@ -2411,8 +2408,8 @@ estimate_function_body_sizes (struct cgraph_node *node, bool early) struct inline_edge_summary *es = inline_edge_summary (edge); /* Special case: results of BUILT_IN_CONSTANT_P will be always - resolved as constant. We however don't want to optimize - out the cgraph edges. */ + resolved as constant. We however don't want to optimize + out the cgraph edges. */ if (nonconstant_names.exists () && gimple_call_builtin_p (stmt, BUILT_IN_CONSTANT_P) && gimple_call_lhs (stmt) @@ -2420,11 +2417,11 @@ estimate_function_body_sizes (struct cgraph_node *node, bool early) { struct predicate false_p = false_predicate (); nonconstant_names[SSA_NAME_VERSION (gimple_call_lhs (stmt))] - = false_p; + = false_p; } if (ipa_node_params_vector.exists ()) { - int count = gimple_call_num_args (stmt); + int count = gimple_call_num_args (stmt); int i; if (count) @@ -2444,12 +2441,12 @@ estimate_function_body_sizes (struct cgraph_node *node, bool early) } /* TODO: When conditional jump or swithc is known to be constant, but - we did not translate it into the predicates, we really can account + we did not translate it into the predicates, we really can account just maximum of the possible paths. */ if (parms_info) will_be_nonconstant - = will_be_nonconstant_predicate (parms_info, info, - stmt, nonconstant_names); + = will_be_nonconstant_predicate (parms_info, info, + stmt, nonconstant_names); if (this_time || this_size) { struct predicate p; @@ -2458,7 +2455,8 @@ estimate_function_body_sizes (struct cgraph_node *node, bool early) prob = eliminated_by_inlining_prob (stmt); if (prob == 1 && dump_file && (dump_flags & TDF_DETAILS)) - fprintf (dump_file, "\t\t50%% will be eliminated by inlining\n"); + fprintf (dump_file, + "\t\t50%% will be eliminated by inlining\n"); if (prob == 2 && dump_file && (dump_flags & TDF_DETAILS)) fprintf (dump_file, "\t\tWill be eliminated by inlining\n"); @@ -2477,8 +2475,8 @@ estimate_function_body_sizes (struct cgraph_node *node, bool early) } /* We account everything but the calls. Calls have their own - size/time info attached to cgraph edges. This is necessary - in order to make the cost disappear after inlining. */ + size/time info attached to cgraph edges. This is necessary + in order to make the cost disappear after inlining. */ if (!is_gimple_call (stmt)) { if (prob) @@ -2516,38 +2514,42 @@ estimate_function_body_sizes (struct cgraph_node *node, bool early) scev_initialize (); FOR_EACH_LOOP (li, loop, 0) { - vec<edge> exits; - edge ex; + vec<edge> exits; + edge ex; unsigned int j, i; struct tree_niter_desc niter_desc; basic_block *body = get_loop_body (loop); - bb_predicate = *(struct predicate *)loop->header->aux; + bb_predicate = *(struct predicate *) loop->header->aux; exits = get_loop_exit_edges (loop); - FOR_EACH_VEC_ELT (exits, j, ex) + FOR_EACH_VEC_ELT (exits, j, ex) if (number_of_iterations_exit (loop, ex, &niter_desc, false) && !is_gimple_min_invariant (niter_desc.niter)) - { - predicate will_be_nonconstant - = will_be_nonconstant_expr_predicate (parms_info, info, - niter_desc.niter, nonconstant_names); - if (!true_predicate_p (&will_be_nonconstant)) - will_be_nonconstant = and_predicates (info->conds, - &bb_predicate, - &will_be_nonconstant); - if (!true_predicate_p (&will_be_nonconstant) - && !false_predicate_p (&will_be_nonconstant)) - /* This is slightly inprecise. We may want to represent each loop with - independent predicate. */ - loop_iterations = and_predicates (info->conds, &loop_iterations, &will_be_nonconstant); - } - exits.release (); + { + predicate will_be_nonconstant + = will_be_nonconstant_expr_predicate (parms_info, info, + niter_desc.niter, + nonconstant_names); + if (!true_predicate_p (&will_be_nonconstant)) + will_be_nonconstant = and_predicates (info->conds, + &bb_predicate, + &will_be_nonconstant); + if (!true_predicate_p (&will_be_nonconstant) + && !false_predicate_p (&will_be_nonconstant)) + /* This is slightly inprecise. We may want to represent each + loop with independent predicate. */ + loop_iterations = + and_predicates (info->conds, &loop_iterations, + &will_be_nonconstant); + } + exits.release (); - for (i = 0; i < loop->num_nodes; i++) + for (i = 0; i < loop->num_nodes; i++) { gimple_stmt_iterator gsi; - bb_predicate = *(struct predicate *)body[i]->aux; - for (gsi = gsi_start_bb (body[i]); !gsi_end_p (gsi); gsi_next (&gsi)) + bb_predicate = *(struct predicate *) body[i]->aux; + for (gsi = gsi_start_bb (body[i]); !gsi_end_p (gsi); + gsi_next (&gsi)) { gimple stmt = gsi_stmt (gsi); affine_iv iv; @@ -2555,30 +2557,36 @@ estimate_function_body_sizes (struct cgraph_node *node, bool early) tree use; FOR_EACH_SSA_TREE_OPERAND (use, stmt, iter, SSA_OP_USE) - { - predicate will_be_nonconstant; - - if (!simple_iv (loop, loop_containing_stmt (stmt), use, &iv, true) - || is_gimple_min_invariant (iv.step)) - continue; + { + predicate will_be_nonconstant; + + if (!simple_iv + (loop, loop_containing_stmt (stmt), use, &iv, true) + || is_gimple_min_invariant (iv.step)) + continue; + will_be_nonconstant + = will_be_nonconstant_expr_predicate (parms_info, info, + iv.step, + nonconstant_names); + if (!true_predicate_p (&will_be_nonconstant)) will_be_nonconstant - = will_be_nonconstant_expr_predicate (parms_info, info, - iv.step, nonconstant_names); - if (!true_predicate_p (&will_be_nonconstant)) - will_be_nonconstant = and_predicates (info->conds, - &bb_predicate, - &will_be_nonconstant); - if (!true_predicate_p (&will_be_nonconstant) - && !false_predicate_p (&will_be_nonconstant)) - /* This is slightly inprecise. We may want to represent each loop with - independent predicate. */ - loop_stride = and_predicates (info->conds, &loop_stride, &will_be_nonconstant); - } + = and_predicates (info->conds, + &bb_predicate, + &will_be_nonconstant); + if (!true_predicate_p (&will_be_nonconstant) + && !false_predicate_p (&will_be_nonconstant)) + /* This is slightly inprecise. We may want to represent + each loop with independent predicate. */ + loop_stride = + and_predicates (info->conds, &loop_stride, + &will_be_nonconstant); + } } } free (body); } - set_hint_predicate (&inline_summary (node)->loop_iterations, loop_iterations); + set_hint_predicate (&inline_summary (node)->loop_iterations, + loop_iterations); set_hint_predicate (&inline_summary (node)->loop_stride, loop_stride); scev_finalize (); } @@ -2691,8 +2699,7 @@ compute_inline_parameters (struct cgraph_node *node, bool early) info->estimated_stack_size = info->estimated_self_stack_size; #ifdef ENABLE_CHECKING inline_update_overall_summary (node); - gcc_assert (info->time == info->self_time - && info->size == info->self_size); + gcc_assert (info->time == info->self_time && info->size == info->self_size); #endif pop_cfun (); @@ -2709,24 +2716,24 @@ compute_inline_parameters_for_current (void) return 0; } -struct gimple_opt_pass pass_inline_parameters = +struct gimple_opt_pass pass_inline_parameters = { { GIMPLE_PASS, - "inline_param", /* name */ - OPTGROUP_INLINE, /* optinfo_flags */ - NULL, /* gate */ - compute_inline_parameters_for_current,/* execute */ - NULL, /* sub */ - NULL, /* next */ - 0, /* static_pass_number */ - TV_INLINE_PARAMETERS, /* tv_id */ - 0, /* properties_required */ - 0, /* properties_provided */ - 0, /* properties_destroyed */ - 0, /* todo_flags_start */ - 0 /* todo_flags_finish */ - } + "inline_param", /* name */ + OPTGROUP_INLINE, /* optinfo_flags */ + NULL, /* gate */ + compute_inline_parameters_for_current, /* execute */ + NULL, /* sub */ + NULL, /* next */ + 0, /* static_pass_number */ + TV_INLINE_PARAMETERS, /* tv_id */ + 0, /* properties_required */ + 0, /* properties_provided */ + 0, /* properties_destroyed */ + 0, /* todo_flags_start */ + 0 /* todo_flags_finish */ + } }; @@ -2776,7 +2783,6 @@ estimate_edge_size_and_time (struct cgraph_edge *e, int *size, int *time, vec<tree> known_binfos, vec<ipa_agg_jump_function_p> known_aggs, inline_hints *hints) - { struct inline_edge_summary *es = inline_edge_summary (e); int call_size = es->call_stmt_size; @@ -2784,12 +2790,11 @@ estimate_edge_size_and_time (struct cgraph_edge *e, int *size, int *time, if (!e->callee && estimate_edge_devirt_benefit (e, &call_size, &call_time, known_vals, known_binfos, known_aggs) - && hints - && cgraph_maybe_hot_edge_p (e)) + && hints && cgraph_maybe_hot_edge_p (e)) *hints |= INLINE_HINT_indirect_call; *size += call_size * INLINE_SIZE_SCALE; *time += call_time * prob / REG_BR_PROB_BASE - * e->frequency * (INLINE_TIME_SCALE / CGRAPH_FREQ_BASE); + * e->frequency * (INLINE_TIME_SCALE / CGRAPH_FREQ_BASE); if (*time > MAX_TIME * INLINE_TIME_SCALE) *time = MAX_TIME * INLINE_TIME_SCALE; } @@ -2812,26 +2817,29 @@ estimate_calls_size_and_time (struct cgraph_node *node, int *size, int *time, for (e = node->callees; e; e = e->next_callee) { struct inline_edge_summary *es = inline_edge_summary (e); - if (!es->predicate || evaluate_predicate (es->predicate, possible_truths)) + if (!es->predicate + || evaluate_predicate (es->predicate, possible_truths)) { if (e->inline_failed) { /* Predicates of calls shall not use NOT_CHANGED codes, - sowe do not need to compute probabilities. */ + sowe do not need to compute probabilities. */ estimate_edge_size_and_time (e, size, time, REG_BR_PROB_BASE, - known_vals, known_binfos, known_aggs, - hints); + known_vals, known_binfos, + known_aggs, hints); } else estimate_calls_size_and_time (e->callee, size, time, hints, possible_truths, - known_vals, known_binfos, known_aggs); + known_vals, known_binfos, + known_aggs); } } for (e = node->indirect_calls; e; e = e->next_callee) { struct inline_edge_summary *es = inline_edge_summary (e); - if (!es->predicate || evaluate_predicate (es->predicate, possible_truths)) + if (!es->predicate + || evaluate_predicate (es->predicate, possible_truths)) estimate_edge_size_and_time (e, size, time, REG_BR_PROB_BASE, known_vals, known_binfos, known_aggs, hints); @@ -2849,10 +2857,10 @@ estimate_node_size_and_time (struct cgraph_node *node, vec<tree> known_vals, vec<tree> known_binfos, vec<ipa_agg_jump_function_p> known_aggs, - int *ret_size, int *ret_time, + int *ret_size, int *ret_time, inline_hints *ret_hints, vec<inline_param_summary_t> - inline_param_summary) + inline_param_summary) { struct inline_summary *info = inline_summary (node); size_time_entry *e; @@ -2861,24 +2869,21 @@ estimate_node_size_and_time (struct cgraph_node *node, inline_hints hints = 0; int i; - if (dump_file - && (dump_flags & TDF_DETAILS)) + if (dump_file && (dump_flags & TDF_DETAILS)) { bool found = false; fprintf (dump_file, " Estimating body: %s/%i\n" - " Known to be false: ", - cgraph_node_name (node), - node->uid); + " Known to be false: ", cgraph_node_name (node), node->uid); for (i = predicate_not_inlined_condition; i < (predicate_first_dynamic_condition - + (int)vec_safe_length (info->conds)); i++) + + (int) vec_safe_length (info->conds)); i++) if (!(possible_truths & (1 << i))) { if (found) fprintf (dump_file, ", "); found = true; - dump_condition (dump_file, info->conds, i); + dump_condition (dump_file, info->conds, i); } } @@ -2887,7 +2892,7 @@ estimate_node_size_and_time (struct cgraph_node *node, { size += e->size; gcc_checking_assert (e->time >= 0); - gcc_checking_assert (time >= 0); + gcc_checking_assert (time >= 0); if (!inline_param_summary.exists ()) time += e->time; else @@ -2898,25 +2903,25 @@ estimate_node_size_and_time (struct cgraph_node *node, inline_param_summary); gcc_checking_assert (prob >= 0); gcc_checking_assert (prob <= REG_BR_PROB_BASE); - time += ((gcov_type)e->time * prob) / REG_BR_PROB_BASE; + time += ((gcov_type) e->time * prob) / REG_BR_PROB_BASE; } - if (time > MAX_TIME * INLINE_TIME_SCALE) - time = MAX_TIME * INLINE_TIME_SCALE; - gcc_checking_assert (time >= 0); - + if (time > MAX_TIME * INLINE_TIME_SCALE) + time = MAX_TIME * INLINE_TIME_SCALE; + gcc_checking_assert (time >= 0); + } gcc_checking_assert (size >= 0); gcc_checking_assert (time >= 0); if (info->loop_iterations && !evaluate_predicate (info->loop_iterations, possible_truths)) - hints |=INLINE_HINT_loop_iterations; + hints |= INLINE_HINT_loop_iterations; if (info->loop_stride && !evaluate_predicate (info->loop_stride, possible_truths)) - hints |=INLINE_HINT_loop_stride; + hints |= INLINE_HINT_loop_stride; if (info->array_index && !evaluate_predicate (info->array_index, possible_truths)) - hints |=INLINE_HINT_array_index; + hints |= INLINE_HINT_array_index; if (info->scc_no) hints |= INLINE_HINT_in_scc; if (DECL_DECLARED_INLINE_P (node->symbol.decl)) @@ -2929,9 +2934,8 @@ estimate_node_size_and_time (struct cgraph_node *node, time = RDIV (time, INLINE_TIME_SCALE); size = RDIV (size, INLINE_SIZE_SCALE); - if (dump_file - && (dump_flags & TDF_DETAILS)) - fprintf (dump_file, "\n size:%i time:%i\n", (int)size, (int)time); + if (dump_file && (dump_flags & TDF_DETAILS)) + fprintf (dump_file, "\n size:%i time:%i\n", (int) size, (int) time); if (ret_time) *ret_time = time; if (ret_size) @@ -2949,11 +2953,11 @@ estimate_node_size_and_time (struct cgraph_node *node, void estimate_ipcp_clone_size_and_time (struct cgraph_node *node, - vec<tree> known_vals, - vec<tree> known_binfos, - vec<ipa_agg_jump_function_p> known_aggs, - int *ret_size, int *ret_time, - inline_hints *hints) + vec<tree> known_vals, + vec<tree> known_binfos, + vec<ipa_agg_jump_function_p> known_aggs, + int *ret_size, int *ret_time, + inline_hints *hints) { clause_t clause; @@ -2982,8 +2986,7 @@ remap_predicate (struct inline_summary *info, struct predicate *p, vec<int> operand_map, vec<int> offset_map, - clause_t possible_truths, - struct predicate *toplev_predicate) + clause_t possible_truths, struct predicate *toplev_predicate) { int i; struct predicate out = true_predicate (); @@ -2999,7 +3002,7 @@ remap_predicate (struct inline_summary *info, gcc_assert (i < MAX_CLAUSES); - for (cond = 0; cond < NUM_CONDITIONS; cond ++) + for (cond = 0; cond < NUM_CONDITIONS; cond++) /* Do we have condition we can't disprove? */ if (clause & possible_truths & (1 << cond)) { @@ -3008,42 +3011,42 @@ remap_predicate (struct inline_summary *info, inlined function. */ if (cond >= predicate_first_dynamic_condition) { - struct condition *c; - - c = &(*callee_info->conds)[cond - - predicate_first_dynamic_condition]; - /* See if we can remap condition operand to caller's operand. - Otherwise give up. */ - if (!operand_map.exists () - || (int)operand_map.length () <= c->operand_num - || operand_map[c->operand_num] == -1 - /* TODO: For non-aggregate conditions, adding an offset is - basically an arithmetic jump function processing which - we should support in future. */ - || ((!c->agg_contents || !c->by_ref) - && offset_map[c->operand_num] > 0) - || (c->agg_contents && c->by_ref - && offset_map[c->operand_num] < 0)) - cond_predicate = true_predicate (); - else - { - struct agg_position_info ap; - HOST_WIDE_INT offset_delta = offset_map[c->operand_num]; - if (offset_delta < 0) - { - gcc_checking_assert (!c->agg_contents || !c->by_ref); - offset_delta = 0; - } - gcc_assert (!c->agg_contents - || c->by_ref - || offset_delta == 0); - ap.offset = c->offset + offset_delta; - ap.agg_contents = c->agg_contents; - ap.by_ref = c->by_ref; - cond_predicate = add_condition (info, - operand_map[c->operand_num], - &ap, c->code, c->val); - } + struct condition *c; + + c = &(*callee_info->conds)[cond + - + predicate_first_dynamic_condition]; + /* See if we can remap condition operand to caller's operand. + Otherwise give up. */ + if (!operand_map.exists () + || (int) operand_map.length () <= c->operand_num + || operand_map[c->operand_num] == -1 + /* TODO: For non-aggregate conditions, adding an offset is + basically an arithmetic jump function processing which + we should support in future. */ + || ((!c->agg_contents || !c->by_ref) + && offset_map[c->operand_num] > 0) + || (c->agg_contents && c->by_ref + && offset_map[c->operand_num] < 0)) + cond_predicate = true_predicate (); + else + { + struct agg_position_info ap; + HOST_WIDE_INT offset_delta = offset_map[c->operand_num]; + if (offset_delta < 0) + { + gcc_checking_assert (!c->agg_contents || !c->by_ref); + offset_delta = 0; + } + gcc_assert (!c->agg_contents + || c->by_ref || offset_delta == 0); + ap.offset = c->offset + offset_delta; + ap.agg_contents = c->agg_contents; + ap.by_ref = c->by_ref; + cond_predicate = add_condition (info, + operand_map[c->operand_num], + &ap, c->code, c->val); + } } /* Fixed conditions remains same, construct single condition predicate. */ @@ -3065,8 +3068,7 @@ remap_predicate (struct inline_summary *info, Compute peak stack usage. */ static void -inline_update_callee_summaries (struct cgraph_node *node, - int depth) +inline_update_callee_summaries (struct cgraph_node *node, int depth) { struct cgraph_edge *e; struct inline_summary *callee_info = inline_summary (node); @@ -3075,12 +3077,11 @@ inline_update_callee_summaries (struct cgraph_node *node, callee_info->stack_frame_offset = caller_info->stack_frame_offset - + caller_info->estimated_self_stack_size; + + caller_info->estimated_self_stack_size; peak = callee_info->stack_frame_offset - + callee_info->estimated_self_stack_size; - if (inline_summary (node->global.inlined_to)->estimated_stack_size - < peak) - inline_summary (node->global.inlined_to)->estimated_stack_size = peak; + + callee_info->estimated_self_stack_size; + if (inline_summary (node->global.inlined_to)->estimated_stack_size < peak) + inline_summary (node->global.inlined_to)->estimated_stack_size = peak; cgraph_propagate_frequency (node); for (e = node->callees; e; e = e->next_callee) { @@ -3108,7 +3109,7 @@ remap_edge_change_prob (struct cgraph_edge *inlined_edge, struct ipa_edge_args *args = IPA_EDGE_REF (edge); struct inline_edge_summary *es = inline_edge_summary (edge); struct inline_edge_summary *inlined_es - = inline_edge_summary (inlined_edge); + = inline_edge_summary (inlined_edge); for (i = 0; i < ipa_get_cs_argument_count (args); i++) { @@ -3129,7 +3130,7 @@ remap_edge_change_prob (struct cgraph_edge *inlined_edge, es->param[i].change_prob = prob; } } - } + } } /* Update edge summaries of NODE after INLINED_EDGE has been inlined. @@ -3140,14 +3141,14 @@ remap_edge_change_prob (struct cgraph_edge *inlined_edge, Also update change probabilities. */ static void -remap_edge_summaries (struct cgraph_edge *inlined_edge, - struct cgraph_node *node, - struct inline_summary *info, - struct inline_summary *callee_info, - vec<int> operand_map, - vec<int> offset_map, - clause_t possible_truths, - struct predicate *toplev_predicate) +remap_edge_summaries (struct cgraph_edge *inlined_edge, + struct cgraph_node *node, + struct inline_summary *info, + struct inline_summary *callee_info, + vec<int> operand_map, + vec<int> offset_map, + clause_t possible_truths, + struct predicate *toplev_predicate) { struct cgraph_edge *e; for (e = node->callees; e; e = e->next_callee) @@ -3163,12 +3164,11 @@ remap_edge_summaries (struct cgraph_edge *inlined_edge, { p = remap_predicate (info, callee_info, es->predicate, operand_map, offset_map, - possible_truths, - toplev_predicate); + possible_truths, toplev_predicate); edge_set_predicate (e, &p); /* TODO: We should remove the edge for code that will be - optimized out, but we need to keep verifiers and tree-inline - happy. Make it cold for now. */ + optimized out, but we need to keep verifiers and tree-inline + happy. Make it cold for now. */ if (false_predicate_p (&p)) { e->count = 0; @@ -3227,17 +3227,13 @@ remap_hint_predicate (struct inline_summary *info, p = remap_predicate (info, callee_info, *hint, operand_map, offset_map, - possible_truths, - toplev_predicate); - if (!false_predicate_p (&p) - && !true_predicate_p (&p)) + possible_truths, toplev_predicate); + if (!false_predicate_p (&p) && !true_predicate_p (&p)) { if (!*hint) set_hint_predicate (hint, p); else - **hint = and_predicates (info->conds, - *hint, - &p); + **hint = and_predicates (info->conds, *hint, &p); } } @@ -3312,19 +3308,19 @@ inline_merge_summary (struct cgraph_edge *edge) &toplev_predicate); if (!false_predicate_p (&p)) { - gcov_type add_time = ((gcov_type)e->time * edge->frequency + gcov_type add_time = ((gcov_type) e->time * edge->frequency + CGRAPH_FREQ_BASE / 2) / CGRAPH_FREQ_BASE; int prob = predicate_probability (callee_info->conds, &e->predicate, clause, es->param); - add_time = ((gcov_type)add_time * prob) / REG_BR_PROB_BASE; + add_time = ((gcov_type) add_time * prob) / REG_BR_PROB_BASE; if (add_time > MAX_TIME * INLINE_TIME_SCALE) add_time = MAX_TIME * INLINE_TIME_SCALE; if (prob != REG_BR_PROB_BASE && dump_file && (dump_flags & TDF_DETAILS)) { fprintf (dump_file, "\t\tScaling time by probability:%f\n", - (double)prob / REG_BR_PROB_BASE); + (double) prob / REG_BR_PROB_BASE); } account_size_time (info, e->size, add_time, &p); } @@ -3333,16 +3329,13 @@ inline_merge_summary (struct cgraph_edge *edge) offset_map, clause, &toplev_predicate); remap_hint_predicate (info, callee_info, &callee_info->loop_iterations, - operand_map, offset_map, - clause, &toplev_predicate); + operand_map, offset_map, clause, &toplev_predicate); remap_hint_predicate (info, callee_info, &callee_info->loop_stride, - operand_map, offset_map, - clause, &toplev_predicate); + operand_map, offset_map, clause, &toplev_predicate); remap_hint_predicate (info, callee_info, &callee_info->array_index, - operand_map, offset_map, - clause, &toplev_predicate); + operand_map, offset_map, clause, &toplev_predicate); inline_update_callee_summaries (edge->callee, inline_edge_summary (edge)->loop_depth); @@ -3371,10 +3364,10 @@ inline_update_overall_summary (struct cgraph_node *node) { info->size += e->size, info->time += e->time; if (info->time > MAX_TIME * INLINE_TIME_SCALE) - info->time = MAX_TIME * INLINE_TIME_SCALE; + info->time = MAX_TIME * INLINE_TIME_SCALE; } estimate_calls_size_and_time (node, &info->size, &info->time, NULL, - ~(clause_t)(1 << predicate_false_condition), + ~(clause_t) (1 << predicate_false_condition), vNULL, vNULL, vNULL); info->time = (info->time + INLINE_TIME_SCALE / 2) / INLINE_TIME_SCALE; info->size = (info->size + INLINE_SIZE_SCALE / 2) / INLINE_SIZE_SCALE; @@ -3386,8 +3379,7 @@ simple_edge_hints (struct cgraph_edge *edge) { int hints = 0; struct cgraph_node *to = (edge->caller->global.inlined_to - ? edge->caller->global.inlined_to - : edge->caller); + ? edge->caller->global.inlined_to : edge->caller); if (inline_summary (to)->scc_no && inline_summary (to)->scc_no == inline_summary (edge->callee)->scc_no && !cgraph_edge_recursive_p (edge)) @@ -3437,7 +3429,7 @@ do_estimate_edge_time (struct cgraph_edge *edge) /* When caching, update the cache entry. */ if (edge_growth_cache.exists ()) { - if ((int)edge_growth_cache.length () <= edge->uid) + if ((int) edge_growth_cache.length () <= edge->uid) edge_growth_cache.safe_grow_cleared (cgraph_edge_max_uid); edge_growth_cache[edge->uid].time = time + (time >= 0); @@ -3537,7 +3529,8 @@ estimate_time_after_inlining (struct cgraph_node *node, struct inline_edge_summary *es = inline_edge_summary (edge); if (!es->predicate || !false_predicate_p (es->predicate)) { - gcov_type time = inline_summary (node)->time + estimate_edge_time (edge); + gcov_type time = + inline_summary (node)->time + estimate_edge_time (edge); if (time < 0) time = 0; if (time > MAX_TIME) @@ -3588,7 +3581,7 @@ do_estimate_growth_1 (struct cgraph_node *node, void *data) if (e->caller == node || (e->caller->global.inlined_to && e->caller->global.inlined_to == node)) - d->self_recursive = true; + d->self_recursive = true; d->growth += estimate_edge_growth (e); } return false; @@ -3600,7 +3593,7 @@ do_estimate_growth_1 (struct cgraph_node *node, void *data) int do_estimate_growth (struct cgraph_node *node) { - struct growth_data d = {0, false}; + struct growth_data d = { 0, false }; struct inline_summary *info = inline_summary (node); cgraph_for_node_and_aliases (node, do_estimate_growth_1, &d, true); @@ -3618,10 +3611,10 @@ do_estimate_growth (struct cgraph_node *node) if (cgraph_will_be_removed_from_program_if_no_direct_calls (node)) d.growth -= info->size; /* COMDAT functions are very often not shared across multiple units - since they come from various template instantiations. - Take this into account. */ - else if (DECL_COMDAT (node->symbol.decl) - && cgraph_can_remove_if_no_direct_calls_p (node)) + since they come from various template instantiations. + Take this into account. */ + else if (DECL_COMDAT (node->symbol.decl) + && cgraph_can_remove_if_no_direct_calls_p (node)) d.growth -= (info->size * (100 - PARAM_VALUE (PARAM_COMDAT_SHARING_PROBABILITY)) + 50) / 100; @@ -3629,7 +3622,7 @@ do_estimate_growth (struct cgraph_node *node) if (node_growth_cache.exists ()) { - if ((int)node_growth_cache.length () <= node->uid) + if ((int) node_growth_cache.length () <= node->uid) node_growth_cache.safe_grow_cleared (cgraph_max_uid); node_growth_cache[node->uid] = d.growth + (d.growth >= 0); } @@ -3687,7 +3680,7 @@ inline_generate_summary (void) struct cgraph_node *node; function_insertion_hook_holder = - cgraph_add_function_insertion_hook (&add_new_function, NULL); + cgraph_add_function_insertion_hook (&add_new_function, NULL); ipa_register_cgraph_hooks (); inline_free_summary (); @@ -3707,7 +3700,7 @@ read_predicate (struct lto_input_block *ib) clause_t clause; int k = 0; - do + do { gcc_assert (k <= MAX_CLAUSES); clause = out.clause[k++] = streamer_read_uhwi (ib); @@ -3741,8 +3734,7 @@ read_inline_edge_summary (struct lto_input_block *ib, struct cgraph_edge *e) { es->param.safe_grow_cleared (length); for (i = 0; i < length; i++) - es->param[i].change_prob - = streamer_read_uhwi (ib); + es->param[i].change_prob = streamer_read_uhwi (ib); } } @@ -3820,7 +3812,7 @@ inline_read_section (struct lto_file_decl_data *file_data, const char *data, vec_safe_push (info->entry, e); } - + p = read_predicate (&ib); set_hint_predicate (&info->loop_iterations, p); p = read_predicate (&ib); @@ -3859,7 +3851,7 @@ inline_read_summary (void) LTO_section_inline_summary, NULL, &len); if (data) - inline_read_section (file_data, data, len); + inline_read_section (file_data, data, len); else /* Fatal error here. We do not want to support compiling ltrans units with different version of compiler or different flags than the WPA @@ -3870,10 +3862,10 @@ inline_read_summary (void) { ipa_register_cgraph_hooks (); if (!flag_ipa_cp) - ipa_prop_read_jump_functions (); + ipa_prop_read_jump_functions (); } function_insertion_hook_holder = - cgraph_add_function_insertion_hook (&add_new_function, NULL); + cgraph_add_function_insertion_hook (&add_new_function, NULL); } @@ -3886,8 +3878,8 @@ write_predicate (struct output_block *ob, struct predicate *p) if (p) for (j = 0; p->clause[j]; j++) { - gcc_assert (j < MAX_CLAUSES); - streamer_write_uhwi (ob, p->clause[j]); + gcc_assert (j < MAX_CLAUSES); + streamer_write_uhwi (ob, p->clause[j]); } streamer_write_uhwi (ob, 0); } @@ -3906,7 +3898,7 @@ write_inline_edge_summary (struct output_block *ob, struct cgraph_edge *e) streamer_write_uhwi (ob, es->loop_depth); write_predicate (ob, es->predicate); streamer_write_uhwi (ob, es->param.length ()); - for (i = 0; i < (int)es->param.length (); i++) + for (i = 0; i < (int) es->param.length (); i++) streamer_write_uhwi (ob, es->param[i].change_prob); } @@ -3945,8 +3937,11 @@ inline_write_summary (void) int i; size_time_entry *e; struct condition *c; - - streamer_write_uhwi (ob, lto_symtab_encoder_encode (encoder, (symtab_node)node)); + + streamer_write_uhwi (ob, + lto_symtab_encoder_encode (encoder, + (symtab_node) + node)); streamer_write_hwi (ob, info->estimated_self_stack_size); streamer_write_hwi (ob, info->self_size); streamer_write_hwi (ob, info->self_time); @@ -3964,7 +3959,7 @@ inline_write_summary (void) bp_pack_value (&bp, c->by_ref, 1); streamer_write_bitpack (&bp); if (c->agg_contents) - streamer_write_uhwi (ob, c->offset); + streamer_write_uhwi (ob, c->offset); } streamer_write_uhwi (ob, vec_safe_length (info->entry)); for (i = 0; vec_safe_iterate (info->entry, i, &e); i++) diff --git a/gcc/ira.c b/gcc/ira.c index f0cbd6dc72e..0fa5b389591 100644 --- a/gcc/ira.c +++ b/gcc/ira.c @@ -3563,7 +3563,7 @@ build_insn_chain (void) c->insn = insn; c->block = bb->index; - if (INSN_P (insn)) + if (NONDEBUG_INSN_P (insn)) for (def_rec = DF_INSN_UID_DEFS (uid); *def_rec; def_rec++) { df_ref def = *def_rec; @@ -3654,7 +3654,7 @@ build_insn_chain (void) bitmap_and_compl_into (live_relevant_regs, elim_regset); bitmap_copy (&c->live_throughout, live_relevant_regs); - if (INSN_P (insn)) + if (NONDEBUG_INSN_P (insn)) for (use_rec = DF_INSN_UID_USES (uid); *use_rec; use_rec++) { df_ref use = *use_rec; diff --git a/gcc/loop-unroll.c b/gcc/loop-unroll.c index de319c4f1d7..39a7b80bdb3 100644 --- a/gcc/loop-unroll.c +++ b/gcc/loop-unroll.c @@ -148,6 +148,61 @@ static void combine_var_copies_in_loop_exit (struct var_to_expand *, basic_block); static rtx get_expansion (struct var_to_expand *); +/* Emit a message summarizing the unroll or peel that will be + performed for LOOP, along with the loop's location LOCUS, if + appropriate given the dump or -fopt-info settings. */ + +static void +report_unroll_peel (struct loop *loop, location_t locus) +{ + struct niter_desc *desc; + int niters = 0; + int report_flags = MSG_OPTIMIZED_LOCATIONS | TDF_RTL | TDF_DETAILS; + + if (!dump_enabled_p ()) + return; + + /* In the special case where the loop never iterated, emit + a different message so that we don't report an unroll by 0. + This matches the equivalent message emitted during tree unrolling. */ + if (loop->lpt_decision.decision == LPT_PEEL_COMPLETELY + && !loop->lpt_decision.times) + { + dump_printf_loc (report_flags, locus, + "Turned loop into non-loop; it never loops.\n"); + return; + } + + desc = get_simple_loop_desc (loop); + + if (desc->const_iter) + niters = desc->niter; + else if (loop->header->count) + niters = expected_loop_iterations (loop); + + dump_printf_loc (report_flags, locus, + "%s loop %d times", + (loop->lpt_decision.decision == LPT_PEEL_COMPLETELY + ? "Completely unroll" + : (loop->lpt_decision.decision == LPT_PEEL_SIMPLE + ? "Peel" : "Unroll")), + loop->lpt_decision.times); + if (profile_info) + dump_printf (report_flags, + " (header execution count %d", + (int)loop->header->count); + if (loop->lpt_decision.decision == LPT_PEEL_COMPLETELY) + dump_printf (report_flags, + "%s%s iterations %d)", + profile_info ? ", " : " (", + desc->const_iter ? "const" : "average", + niters); + else if (profile_info) + dump_printf (report_flags, ")"); + + dump_printf (report_flags, "\n"); +} + /* Unroll and/or peel (depending on FLAGS) LOOPS. */ void unroll_and_peel_loops (int flags) @@ -234,11 +289,13 @@ peel_loops_completely (int flags) FOR_EACH_LOOP (li, loop, LI_FROM_INNERMOST) { loop->lpt_decision.decision = LPT_NONE; + location_t locus = get_loop_location (loop); - if (dump_file) - fprintf (dump_file, - "\n;; *** Considering loop %d for complete peeling ***\n", - loop->num); + if (dump_enabled_p ()) + dump_printf_loc (TDF_RTL, locus, + ";; *** Considering loop %d at BB %d for " + "complete peeling ***\n", + loop->num, loop->header->index); loop->ninsns = num_loop_insns (loop); @@ -248,6 +305,7 @@ peel_loops_completely (int flags) if (loop->lpt_decision.decision == LPT_PEEL_COMPLETELY) { + report_unroll_peel (loop, locus); peel_loop_completely (loop); #ifdef ENABLE_CHECKING verify_loop_structure (); @@ -267,9 +325,13 @@ decide_unrolling_and_peeling (int flags) FOR_EACH_LOOP (li, loop, LI_FROM_INNERMOST) { loop->lpt_decision.decision = LPT_NONE; + location_t locus = get_loop_location (loop); - if (dump_file) - fprintf (dump_file, "\n;; *** Considering loop %d ***\n", loop->num); + if (dump_enabled_p ()) + dump_printf_loc (TDF_RTL, locus, + ";; *** Considering loop %d at BB %d for " + "unrolling and peeling ***\n", + loop->num, loop->header->index); /* Do not peel cold areas. */ if (optimize_loop_for_size_p (loop)) @@ -309,6 +371,8 @@ decide_unrolling_and_peeling (int flags) decide_unroll_stupid (loop, flags); if (loop->lpt_decision.decision == LPT_NONE) decide_peel_simple (loop, flags); + + report_unroll_peel (loop, locus); } } @@ -348,8 +412,6 @@ decide_peel_once_rolling (struct loop *loop, int flags ATTRIBUTE_UNUSED) } /* Success. */ - if (dump_file) - fprintf (dump_file, ";; Decided to peel exactly once rolling loop\n"); loop->lpt_decision.decision = LPT_PEEL_COMPLETELY; } @@ -429,8 +491,6 @@ decide_peel_completely (struct loop *loop, int flags ATTRIBUTE_UNUSED) } /* Success. */ - if (dump_file) - fprintf (dump_file, ";; Decided to peel loop completely\n"); loop->lpt_decision.decision = LPT_PEEL_COMPLETELY; } @@ -608,10 +668,6 @@ decide_unroll_constant_iterations (struct loop *loop, int flags) loop->lpt_decision.decision = LPT_UNROLL_CONSTANT; loop->lpt_decision.times = best_unroll; - - if (dump_file) - fprintf (dump_file, ";; Decided to unroll the loop %d times (%d copies).\n", - loop->lpt_decision.times, best_copies); } /* Unroll LOOP with constant number of iterations LOOP->LPT_DECISION.TIMES times. @@ -893,10 +949,6 @@ decide_unroll_runtime_iterations (struct loop *loop, int flags) loop->lpt_decision.decision = LPT_UNROLL_RUNTIME; loop->lpt_decision.times = i - 1; - - if (dump_file) - fprintf (dump_file, ";; Decided to unroll the loop %d times.\n", - loop->lpt_decision.times); } /* Splits edge E and inserts the sequence of instructions INSNS on it, and @@ -1305,10 +1357,6 @@ decide_peel_simple (struct loop *loop, int flags) /* Success. */ loop->lpt_decision.decision = LPT_PEEL_SIMPLE; loop->lpt_decision.times = npeel; - - if (dump_file) - fprintf (dump_file, ";; Decided to simply peel the loop %d times.\n", - loop->lpt_decision.times); } /* Peel a LOOP LOOP->LPT_DECISION.TIMES times. The transformation does this: @@ -1460,10 +1508,6 @@ decide_unroll_stupid (struct loop *loop, int flags) loop->lpt_decision.decision = LPT_UNROLL_STUPID; loop->lpt_decision.times = i - 1; - - if (dump_file) - fprintf (dump_file, ";; Decided to unroll the loop stupidly %d times.\n", - loop->lpt_decision.times); } /* Unroll a LOOP LOOP->LPT_DECISION.TIMES times. The transformation does this: diff --git a/gcc/lra-assigns.c b/gcc/lra-assigns.c index b1d18102dc2..12d58cca609 100644 --- a/gcc/lra-assigns.c +++ b/gcc/lra-assigns.c @@ -1084,6 +1084,8 @@ improve_inheritance (bitmap changed_pseudos) lra_copy_t cp, next_cp; bitmap_iterator bi; + if (lra_inheritance_iter > LRA_MAX_INHERITANCE_PASSES) + return; n = 0; EXECUTE_IF_SET_IN_BITMAP (&lra_inheritance_pseudos, 0, k, bi) if (reg_renumber[k] >= 0 && lra_reg_info[k].nrefs != 0) diff --git a/gcc/lra-constraints.c b/gcc/lra-constraints.c index e4c9ca2a5e8..f6c6c89b858 100644 --- a/gcc/lra-constraints.c +++ b/gcc/lra-constraints.c @@ -3201,10 +3201,6 @@ loc_equivalence_callback (rtx loc, const_rtx, void *) return NULL_RTX; } -/* Maximum allowed number of constraint pass iterations after the last - spill pass. It is for preventing LRA cycling in a bug case. */ -#define MAX_CONSTRAINT_ITERATION_NUMBER 30 - /* Maximum number of generated reload insns per an insn. It is for preventing this pass cycling in a bug case. */ #define MAX_RELOAD_INSNS_NUMBER LRA_MAX_INSN_RELOADS @@ -3328,10 +3324,10 @@ lra_constraints (bool first_p) fprintf (lra_dump_file, "\n********** Local #%d: **********\n\n", lra_constraint_iter); lra_constraint_iter_after_spill++; - if (lra_constraint_iter_after_spill > MAX_CONSTRAINT_ITERATION_NUMBER) + if (lra_constraint_iter_after_spill > LRA_MAX_CONSTRAINT_ITERATION_NUMBER) internal_error ("Maximum number of LRA constraint passes is achieved (%d)\n", - MAX_CONSTRAINT_ITERATION_NUMBER); + LRA_MAX_CONSTRAINT_ITERATION_NUMBER); changed_p = false; lra_risky_transformations_p = false; new_insn_uid_start = get_max_uid (); @@ -4698,21 +4694,6 @@ inherit_in_ebb (rtx head, rtx tail) return change_p; } -/* The maximal number of inheritance/split passes in LRA. It should - be more 1 in order to perform caller saves transformations and much - less MAX_CONSTRAINT_ITERATION_NUMBER to prevent LRA to do as many - as permitted constraint passes in some complicated cases. The - first inheritance/split pass has a biggest impact on generated code - quality. Each subsequent affects generated code in less degree. - For example, the 3rd pass does not change generated SPEC2000 code - at all on x86-64. */ -#define MAX_INHERITANCE_PASSES 2 - -#if MAX_INHERITANCE_PASSES <= 0 \ - || MAX_INHERITANCE_PASSES >= MAX_CONSTRAINT_ITERATION_NUMBER - 8 -#error wrong MAX_INHERITANCE_PASSES value -#endif - /* This value affects EBB forming. If probability of edge from EBB to a BB is not greater than the following value, we don't add the BB to EBB. */ @@ -4730,7 +4711,7 @@ lra_inheritance (void) edge e; lra_inheritance_iter++; - if (lra_inheritance_iter > MAX_INHERITANCE_PASSES) + if (lra_inheritance_iter > LRA_MAX_INHERITANCE_PASSES) return; timevar_push (TV_LRA_INHERITANCE); if (lra_dump_file != NULL) @@ -5000,7 +4981,7 @@ lra_undo_inheritance (void) bool change_p; lra_undo_inheritance_iter++; - if (lra_undo_inheritance_iter > MAX_INHERITANCE_PASSES) + if (lra_undo_inheritance_iter > LRA_MAX_INHERITANCE_PASSES) return false; if (lra_dump_file != NULL) fprintf (lra_dump_file, diff --git a/gcc/lra-int.h b/gcc/lra-int.h index 8e89518bae0..064722936ba 100644 --- a/gcc/lra-int.h +++ b/gcc/lra-int.h @@ -249,6 +249,25 @@ typedef struct lra_insn_recog_data *lra_insn_recog_data_t; #define LRA_LOSER_COST_FACTOR 6 #define LRA_MAX_REJECT 600 +/* Maximum allowed number of constraint pass iterations after the last + spill pass. It is for preventing LRA cycling in a bug case. */ +#define LRA_MAX_CONSTRAINT_ITERATION_NUMBER 30 + +/* The maximal number of inheritance/split passes in LRA. It should + be more 1 in order to perform caller saves transformations and much + less MAX_CONSTRAINT_ITERATION_NUMBER to prevent LRA to do as many + as permitted constraint passes in some complicated cases. The + first inheritance/split pass has a biggest impact on generated code + quality. Each subsequent affects generated code in less degree. + For example, the 3rd pass does not change generated SPEC2000 code + at all on x86-64. */ +#define LRA_MAX_INHERITANCE_PASSES 2 + +#if LRA_MAX_INHERITANCE_PASSES <= 0 \ + || LRA_MAX_INHERITANCE_PASSES >= LRA_MAX_CONSTRAINT_ITERATION_NUMBER - 8 +#error wrong LRA_MAX_INHERITANCE_PASSES value +#endif + /* lra.c: */ extern FILE *lra_dump_file; diff --git a/gcc/lto-streamer-out.c b/gcc/lto-streamer-out.c index 853b155a3af..85c36c65ab4 100644 --- a/gcc/lto-streamer-out.c +++ b/gcc/lto-streamer-out.c @@ -1257,6 +1257,26 @@ write_symbol (struct streamer_tree_cache_d *cache, lto_output_data_stream (stream, &slot_num, 4); } +/* Return true if NODE should appear in the plugin symbol table. */ + +bool +output_symbol_p (symtab_node node) +{ + struct cgraph_node *cnode; + struct ipa_ref *ref; + + if (!symtab_real_symbol_p (node)) + return false; + /* We keep external functions in symtab for sake of inlining + and devirtualization. We do not want to see them in symbol table as + references. */ + cnode = dyn_cast <cgraph_node> (node); + if (cnode && DECL_EXTERNAL (cnode->symbol.decl)) + return (cnode->callers + || ipa_ref_list_referring_iterate (&cnode->symbol.ref_list, 0, ref)); + return true; +} + /* Write an IL symbol table to OB. SET and VSET are cgraph/varpool node sets we are outputting. */ @@ -1285,7 +1305,7 @@ produce_symtab (struct output_block *ob) { symtab_node node = lsei_node (lsei); - if (!symtab_real_symbol_p (node) || DECL_EXTERNAL (node->symbol.decl)) + if (!output_symbol_p (node) || DECL_EXTERNAL (node->symbol.decl)) continue; write_symbol (cache, &stream, node->symbol.decl, seen, false); } @@ -1294,7 +1314,7 @@ produce_symtab (struct output_block *ob) { symtab_node node = lsei_node (lsei); - if (!symtab_real_symbol_p (node) || !DECL_EXTERNAL (node->symbol.decl)) + if (!output_symbol_p (node) || !DECL_EXTERNAL (node->symbol.decl)) continue; write_symbol (cache, &stream, node->symbol.decl, seen, false); } diff --git a/gcc/output.h b/gcc/output.h index 3fb743a17e9..bd5c3ebd0aa 100644 --- a/gcc/output.h +++ b/gcc/output.h @@ -556,6 +556,8 @@ extern void output_file_directive (FILE *, const char *); extern unsigned int default_section_type_flags (tree, const char *, int); extern bool have_global_bss_p (void); +extern bool bss_initializer_p (const_tree); + extern void default_no_named_section (const char *, unsigned int, tree); extern void default_elf_asm_named_section (const char *, unsigned int, tree); extern enum section_category categorize_decl_for_section (const_tree, int); diff --git a/gcc/realmpfr.h b/gcc/realmpfr.h index ab234e9195d..4cfa4fb5803 100644 --- a/gcc/realmpfr.h +++ b/gcc/realmpfr.h @@ -22,7 +22,6 @@ #ifndef GCC_REALGMP_H #define GCC_REALGMP_H -#include <gmp.h> #include <mpfr.h> #include <mpc.h> #include "real.h" diff --git a/gcc/rtlanal.c b/gcc/rtlanal.c index 382648188ed..b14a2a87853 100644 --- a/gcc/rtlanal.c +++ b/gcc/rtlanal.c @@ -2107,7 +2107,6 @@ volatile_insn_p (const_rtx x) return 0; case UNSPEC_VOLATILE: - /* case TRAP_IF: This isn't clear yet. */ return 1; case ASM_INPUT: @@ -2240,7 +2239,6 @@ side_effects_p (const_rtx x) case POST_MODIFY: case CALL: case UNSPEC_VOLATILE: - /* case TRAP_IF: This isn't clear yet. */ return 1; case MEM: @@ -2312,9 +2310,9 @@ may_trap_p_1 (const_rtx x, unsigned flags) return 0; case UNSPEC: - case UNSPEC_VOLATILE: return targetm.unspec_may_trap_p (x, flags); + case UNSPEC_VOLATILE: case ASM_INPUT: case TRAP_IF: return 1; @@ -2406,8 +2404,7 @@ may_trap_p_1 (const_rtx x, unsigned flags) default: /* Any floating arithmetic may trap. */ - if (SCALAR_FLOAT_MODE_P (GET_MODE (x)) - && flag_trapping_math) + if (SCALAR_FLOAT_MODE_P (GET_MODE (x)) && flag_trapping_math) return 1; } diff --git a/gcc/system.h b/gcc/system.h index 54d86acc360..ab1b887b847 100644 --- a/gcc/system.h +++ b/gcc/system.h @@ -638,6 +638,8 @@ extern int vsnprintf(char *, size_t, const char *, va_list); #include <dlfcn.h> #endif +#include <gmp.h> + /* Get libiberty declarations. */ #include "libiberty.h" diff --git a/gcc/target.def b/gcc/target.def index bbda6c25d26..d0547be63c4 100644 --- a/gcc/target.def +++ b/gcc/target.def @@ -1816,7 +1816,7 @@ DEFHOOK "", rtx, (rtx hard_reg), NULL) -/* Return nonzero if evaluating UNSPEC[_VOLATILE] X might cause a trap. +/* Return nonzero if evaluating UNSPEC X might cause a trap. FLAGS has the same meaning as in rtlanal.c: may_trap_p_1. */ DEFHOOK (unspec_may_trap_p, @@ -2833,6 +2833,14 @@ DEFHOOK bool, (tree decl1, tree decl2), hook_bool_tree_tree_false) +/* This function returns true if the target supports function + multiversioning. */ +DEFHOOK +(supports_function_versions, + "", + bool, (void), + hook_bool_void_false) + /* Function to determine if one function can inline another function. */ #undef HOOK_PREFIX #define HOOK_PREFIX "TARGET_" diff --git a/gcc/targhooks.c b/gcc/targhooks.c index 241c1cce577..954cdb9d1be 100644 --- a/gcc/targhooks.c +++ b/gcc/targhooks.c @@ -102,10 +102,8 @@ default_unspec_may_trap_p (const_rtx x, unsigned flags) { int i; - if (GET_CODE (x) == UNSPEC_VOLATILE - /* Any floating arithmetic may trap. */ - || (SCALAR_FLOAT_MODE_P (GET_MODE (x)) - && flag_trapping_math)) + /* Any floating arithmetic may trap. */ + if ((SCALAR_FLOAT_MODE_P (GET_MODE (x)) && flag_trapping_math)) return 1; for (i = 0; i < XVECLEN (x, 0); ++i) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index a51f09e2aad..b3418f11882 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,129 @@ +2013-01-02 John David Anglin <dave.anglin@nrc-cnrc.gc.ca> + + * gcc.dg/pr55430.c: Define MAP_FAILED if not defined. + +2013-01-02 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/55818 + * gfortran.dg/eof_4.f90: New test. + +2013-01-02 Jakub Jelinek <jakub@redhat.com> + + * lib/c-compat.exp (compat-use-alt-compiler): Remove + -fno-diagnostics-show-caret from TEST_ALWAYS_FLAGS if needed. + (compat-use-tst-compiler): Restore TEST_ALWAYS_FLAGS. + (compat_setup_dfp): Initialize compat_alt_caret and + compat_save_TEST_ALWAYS_FLAGS. + +2013-01-02 Richard Sandiford <rdsandiford@googlemail.com> + + * gcc.dg/torture/tls/tls-reload-1.c: New test. + +2013-01-02 Richard Sandiford <rdsandiford@googlemail.com> + + * gcc.dg/torture/fp-int-convert-2.c: New test. + +2013-01-01 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + * gfortran.dg/newunit_3.f90: Add dg-do run. + * gfortran.dg/inquire_15.f90: Add dg-do run. + +2013-01-01 Jakub Jelinek <jakub@redhat.com> + + PR tree-optimization/55831 + * gcc.dg/pr55831.c: New test. + +2012-12-31 Uros Bizjak <ubizjak@gmail.com> + + * g++.dg/ipa/devirt-9.C: Cleanup inline ipa dump. + +2012-12-31 Uros Bizjak <ubizjak@gmail.com> + + * gcc.target/i386/builtin_target.c (vendor_signatures): Remove. + (check_detailed): Use signature_INTEL_ebx and signature_AMD_ebx + to check vendor signature. + +2012-12-28 Janus Weil <janus@gcc.gnu.org> + + PR fortran/55692 + * gfortran.dg/associated_7.f90: New. + +2012-12-28 Tobias Burnus <burnus@net-b.de> + + PR fortran/55763 + * gfortran.dg/unlimited_polymorphic_5.f90 + +2012-12-27 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/48960 + * gfortran.dg/newunit_3.f90: New. + +2012-12-27 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/48976 + * gfortran.dg/inquire_15.f90: New. + +2012-12-27 Sriraman Tallam <tmsriram@google.com> + + * testsuite/g++.dg/mv1.C: Remove target options. + * testsuite/g++.dg/mv2.C: Ditto. + * testsuite/g++.dg/mv3.C: Ditto. + * testsuite/g++.dg/mv4.C: Ditto. + * testsuite/g++.dg/mv5.C: Ditto. + +2012-12-26 Janne Blomqvist <jb@gcc.gnu.org> + + PR fortran/55539 + * gfortran.dg/nosigned_zero_3.f90: New testcase. + +2012-12-23 Tobias Burnus <burnus@net-b.de> + + PR fortran/54884 + * gfortran.dg/public_private_module_8.f90: New. + +2012-12-23 Richard Sandiford <rdsandiford@googlemail.com> + + * gcc.target/mips/r10k-cache-barrier-10.c: Make a branch-likely + instruction more likely. + +2012-12-23 Richard Sandiford <rdsandiford@googlemail.com> + + * gcc.target/mips/pr55315.c: Cast to long rather than int. + +2012-12-22 Tobias Burnus <burnus@net-b.de> + + PR fortran/55763 + * gfortran.dg/unlimited_polymorphic_6.f90: New. + +2012-12-21 Martin Jambor <mjambor@suse.cz> + + PR tree-optimization/55355 + * g++.dg/torture/pr55355.C: New test. + +2012-12-21 Vladimir Makarov <vmakarov@redhat.com> + + PR middle-end/55775 + * gcc.target/i386/pr55775.c: New test. + +2012-12-21 David Edelsohn <dje.gcc@gmail.com> + + * gcc.dg/pthread-init-2.c (dg-options): Define _XOPEN_SOURCE=500 + on AIX. + + * lib/target-supports.exp (add_options_for_tls): Add -pthread for + AIX as well. + (check_effective_target_powerpc_vsx_ok): Only test VSX on AIX 7.1 + and above. + + * gcc.c-torture/compile/pr44707.c: Do not try to assemble on AIX. + + * c-c++-common/pr43942.c: Remove XFAIL for AIX. + +2012-12-21 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/55763 + * gfortran.dg/unlimited_polymorphic_4.f03: New test. + 2012-12-21 Richard Biener <rguenther@suse.de> PR tree-optimization/52996 @@ -842,7 +968,7 @@ PR middle-end/55030 * gcc.dg/guality/pr36728-1.c, gcc.dg/guality/pr36728-2.c (foo): Don't - use volatile asms, use plain asms. Where the output value for the + use volatile asms, use plain asms. Where the output value for the asm is unused, write a global variable. 2012-11-25 Uros Bizjak <ubizjak@gmail.com> @@ -1305,12 +1431,12 @@ * gcc.target/powerpc/ppc-pow.c: Allow dot symbols in branch. * gcc.target/powerpc/tfmode_off.c: Skip on AIX. -2012-11-07 Manuel López-Ibáñez <manu@gcc.gnu.org> +2012-11-07 Manuel López-Ibáñez <manu@gcc.gnu.org> PR c/53063 * gcc.dg/warn-nsstring.c: Use -Wformat explicitly. -2012-11-07 Manuel López-Ibáñez <manu@gcc.gnu.org> +2012-11-07 Manuel López-Ibáñez <manu@gcc.gnu.org> PR c/51294 * c-c++-common/pr51294.c: New. @@ -1691,7 +1817,7 @@ PR middle-end/55116 * gcc.target/i386/pr55116.c: New file. -2012-10-29 Manuel López-Ibáñez <manu@gcc.gnu.org> +2012-10-29 Manuel López-Ibáñez <manu@gcc.gnu.org> PR c/53066 * gcc.dg/Wshadow-4.c: New. @@ -2120,7 +2246,7 @@ * gcc.dg/webizer.c (main): Add missing exit call. -2012-10-21 Thomas König <tkoenig@gcc.gnu.org> +2012-10-21 Thomas König <tkoenig@gcc.gnu.org> PR fortran/54465 * gfortran.dg/wextra_1.f: New test. @@ -2203,7 +2329,7 @@ * gcc.dg/tree-ssa/ldist-17.c: Block cunroll to make testcase still valid. -2012-10-16 Manuel López-Ibáñez <manu@gcc.gnu.org> +2012-10-16 Manuel López-Ibáñez <manu@gcc.gnu.org> PR c/53063 PR c/40989 @@ -3009,7 +3135,7 @@ * go.test/go-test.exp: Update for latest version of Go testsuite. -2012-09-29 Thomas König <tkoenig@gcc.gnu.org> +2012-09-29 Thomas König <tkoenig@gcc.gnu.org> PR fortran/52724 * gfortran.dg/internal_readwrite_3.f90: New test. @@ -3514,7 +3640,7 @@ * g++.dg/torture/builtin-location.C: New testcase. 2012-09-13 Paolo Carlini <paolo.carlini@oracle.com> - Manuel López-Ibáñez <manu@gcc.gnu.org> + Manuel López-Ibáñez <manu@gcc.gnu.org> PR c++/53210 * g++.dg/warn/Wuninitialized-self.C: New. @@ -4375,7 +4501,7 @@ PR fortran/54301 * gfortran.dg/warn_target_lifetime_1.f90: New. -2012-08-19 Thomas König <tkoenig@gcc.gnu.org> +2012-08-19 Thomas König <tkoenig@gcc.gnu.org> PR fortran/54298 * gfortran.dg/real_compare_1.f90: New test case. @@ -4830,7 +4956,7 @@ * gcc.dg/tree-ssa/pta-ptrarith-1.c: Likewise. * gcc.dg/tree-ssa/pta-ptrarith-2.c: Likewise. -2012-08-01 Thomas König <tkoenig@gcc.gnu.org> +2012-08-01 Thomas König <tkoenig@gcc.gnu.org> PR fortran/54033 * gfortran.dg/include_6.f90: New test case. @@ -5303,7 +5429,7 @@ * g++.dg/parse/access8.C: Adjust. * g++.dg/template/sfinae6_neg.C: Adjust. -2012-07-16 Thomas König <tkoenig@gcc.gnu.org> +2012-07-16 Thomas König <tkoenig@gcc.gnu.org> PR fortran/53824 * gfortran.dg/coarray_allocate_1.f90: New test. @@ -6334,12 +6460,12 @@ PR middle-end/53535 * gcc.dg/pr46647.c: xfail for cris-* and crisv32-*. -2012-06-07 Thomas König <tkoenig@gcc.gnu.org> +2012-06-07 Thomas König <tkoenig@gcc.gnu.org> PR fortran/52861 * gfortran.dg/string_assign_2.f90: New test case. -2012-06-07 Thomas König <tkoenig@gcc.gnu.org> +2012-06-07 Thomas König <tkoenig@gcc.gnu.org> PR fortran/52861 * gfortran.dg/string_assign_1.f90: New test case. @@ -6355,7 +6481,7 @@ * gfortran.dg/gomp/appendix-a/a.35.6.f90: Likewise. * c-c++-common/gomp/pr53580.c: New test. -2012-06-07 Fabien Chêne <fabien@gcc.gnu.org> +2012-06-07 Fabien Chêne <fabien@gcc.gnu.org> PR c++/51214 * g++.dg/cpp0x/forw_enum11.C: New. @@ -6383,7 +6509,7 @@ * gfortran.dg/vect/pr32380.f: Adjust number of expected vectorized loops. -2012-06-06 Fabien Chêne <fabien@gcc.gnu.org> +2012-06-06 Fabien Chêne <fabien@gcc.gnu.org> PR c++/52841 * g++.dg/cpp0x/pr52841.C: New testcase. @@ -7171,7 +7297,7 @@ * gnat.dg/discr36.ad[sb]: New test. * gnat.dg/discr36_pkg.ad[sb]: New helper. -2012-05-05 Manuel López-Ibáñez <manu@gcc.gnu.org> +2012-05-05 Manuel López-Ibáñez <manu@gcc.gnu.org> PR c/43772 * c-c++-common/pr43772.c: New. @@ -7233,7 +7359,7 @@ * gcc.target/ia64/pr48496.c: New test. * gcc.target/ia64/pr52657.c: Likewise. -2012-05-04 Manuel López-Ibáñez <manu@gcc.gnu.org> +2012-05-04 Manuel López-Ibáñez <manu@gcc.gnu.org> PR c/51712 * c-c++-common/pr51712.c: New. @@ -7476,7 +7602,7 @@ * gnat.dg/warn6.ad[sb]: New test. -2012-04-29 Manuel López-Ibáñez <manu@gcc.gnu.org> +2012-04-29 Manuel López-Ibáñez <manu@gcc.gnu.org> PR 53149 * gcc.dg/20011021-1.c: Adjust testcase. @@ -7584,7 +7710,7 @@ PR c/52880 * gcc.dg/pr52880.c: New test. -2012-04-25 Manuel López-Ibáñez <manu@gcc.gnu.org> +2012-04-25 Manuel López-Ibáñez <manu@gcc.gnu.org> * gcc.dg/m-un-2.c: Update. * gcc.dg/20011021-1.c: Update. @@ -7667,7 +7793,7 @@ PR fortran/53051 * gfortran.dg/read_float_4.f90: New. -2012-04-21 Manuel López-Ibáñez <manu@gcc.gnu.org> +2012-04-21 Manuel López-Ibáñez <manu@gcc.gnu.org> PR 35441 * c-c++-common/pr35441.C: New. @@ -7702,7 +7828,7 @@ * gcc.dg/pr52283.c: New test. -2012-04-19 Manuel López-Ibáñez <manu@gcc.gnu.org> +2012-04-19 Manuel López-Ibáñez <manu@gcc.gnu.org> * gcc.dg/pr37985.c: New test. @@ -7950,12 +8076,12 @@ * gcc/target/sh/pr50751-6.c: New. * gcc/target/sh/pr50751-7.c: New. -2012-04-11 Fabien Chêne <fabien@gcc.gnu.org> +2012-04-11 Fabien Chêne <fabien@gcc.gnu.org> PR c++/52465 * g++.dg/lookup/using52.C: New. -2012-04-11 Manuel López-Ibáñez <manu@gcc.gnu.org> +2012-04-11 Manuel López-Ibáñez <manu@gcc.gnu.org> * lib/prune.exp (TEST_ALWAYS_FLAGS): If undefined, set to empty. @@ -8051,7 +8177,7 @@ * gcc.dg/builtin-bswap-5.c: Likewise. * gcc.target/i386/builtin-bswap-4.c: New test. -2012-04-11 Manuel López-Ibáñez <manu@gcc.gnu.org> +2012-04-11 Manuel López-Ibáñez <manu@gcc.gnu.org> PR 24985 * lib/prune.exp: Add -fno-diagnostics-show-caret. @@ -8160,7 +8286,7 @@ PR fortran/52751 * gfortran.dg/public_private_module_2.f90: New. -2012-04-08 Manuel López-Ibáñez <manu@gcc.gnu.org> +2012-04-08 Manuel López-Ibáñez <manu@gcc.gnu.org> * g++.dg/warn/Wstrict-aliasing-float-ref-int-obj.C: Add labels to directives. @@ -9395,7 +9521,7 @@ PR c++/52248 * g++.dg/ext/timevar1.C: New. -2012-02-16 Fabien Chêne <fabien@gcc.gnu.org> +2012-02-16 Fabien Chêne <fabien@gcc.gnu.org> PR c++/52126 * g++.dg/template/using21.C: New. @@ -9730,7 +9856,7 @@ PR fortran/51514 * gfortran.dg/class_to_type_2.f90: New. -2012-02-06 Thomas König <tkoenig@gcc.gnu.org> +2012-02-06 Thomas König <tkoenig@gcc.gnu.org> PR fortran/32373 * gfortran.dg/vect/vect-8.f90: Use vect_double effective target. @@ -9756,12 +9882,12 @@ * gcc.dg/pr48374.c: Actually add the test I forgot in the 2012-01-25 commit. -2012-02-05 Thomas König <tkoenig@gcc.gnu.org> +2012-02-05 Thomas König <tkoenig@gcc.gnu.org> PR fortran/32373 * gfortran.dg/vect/vect-8.f90: New test case. -2012-02-05 Thomas König <tkoenig@gcc.gnu.org> +2012-02-05 Thomas König <tkoenig@gcc.gnu.org> PR fortran/48847 * gfortran.dg/warn_unused_dummy_argument_3.f90: New test. @@ -9853,7 +9979,7 @@ PR tree-optimization/52073 * gcc.c-torture/compile/pr52073.c: New test. -2012-02-01 Thomas König <tkoenig@gcc.gnu.org> +2012-02-01 Thomas König <tkoenig@gcc.gnu.org> PR fortran/51958 * gfortran.dg/function_optimize_10.f90: New test. @@ -11036,7 +11162,7 @@ * g++.dg/cpp0x/constexpr-delegating2.C: Add missing piece. -2012-01-01 Fabien Chêne <fabien@gcc.gnu.org> +2012-01-01 Fabien Chêne <fabien@gcc.gnu.org> * g++.old-deja/g++.brendan/crash25.C: Adjust. * g++.old-deja/g++.brendan/crash56.C: Likewise. diff --git a/gcc/testsuite/c-c++-common/pr43942.c b/gcc/testsuite/c-c++-common/pr43942.c index 9e7787f508c..3d97db6624e 100644 --- a/gcc/testsuite/c-c++-common/pr43942.c +++ b/gcc/testsuite/c-c++-common/pr43942.c @@ -1,7 +1,6 @@ /* PR debug/43942 */ /* { dg-do compile } */ /* { dg-options "-O2 -fcompare-debug" } */ -/* { dg-xfail-if "" { powerpc-ibm-aix* } { "*" } { "" } } */ extern int f1 (int); diff --git a/gcc/testsuite/g++.dg/cpp0x/initlist-protected.C b/gcc/testsuite/g++.dg/cpp0x/initlist-protected.C new file mode 100644 index 00000000000..fb5cc6aa892 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/initlist-protected.C @@ -0,0 +1,23 @@ +// PR c++/54325 +// { dg-options -std=c++11 } + +class base +{ + protected: + base() + {} +}; + +class derived : public base +{ + public: + derived() + : base{} // <-- Note the c++11 curly brace syntax + {} +}; + +int main() +{ + derived d1; + return 0; +} diff --git a/gcc/testsuite/g++.dg/init/array33.C b/gcc/testsuite/g++.dg/init/array33.C new file mode 100644 index 00000000000..4440d3d5432 --- /dev/null +++ b/gcc/testsuite/g++.dg/init/array33.C @@ -0,0 +1,22 @@ +// PR c++/55804 +// { dg-do run } + +int t = 0; +template <typename> struct vector { + vector() { t++; } +}; + +typedef vector<int> Arrays[1]; +class C +{ + vector<int> v_; + void Foo(const Arrays &); +}; +Arrays a; + +int main(void) +{ + if (t!=1) + __builtin_abort (); + return 0; +} diff --git a/gcc/testsuite/g++.dg/ipa/devirt-9.C b/gcc/testsuite/g++.dg/ipa/devirt-9.C index 62ea96e5eed..5be458cbb41 100644 --- a/gcc/testsuite/g++.dg/ipa/devirt-9.C +++ b/gcc/testsuite/g++.dg/ipa/devirt-9.C @@ -28,3 +28,4 @@ bar () c.c1 (60, (int) foo ()); } /* { dg-final { scan-ipa-dump "Discovered a virtual call to a known target" "inline" } } */ +/* { dg-final { cleanup-ipa-dump "inline" } } */ diff --git a/gcc/testsuite/g++.dg/mv1.C b/gcc/testsuite/g++.dg/mv1.C index 150b4511267..bad0c4496d3 100644 --- a/gcc/testsuite/g++.dg/mv1.C +++ b/gcc/testsuite/g++.dg/mv1.C @@ -1,7 +1,7 @@ /* Test case to check if Multiversioning works. */ /* { dg-do run { target i?86-*-* x86_64-*-* } } */ /* { dg-require-ifunc "" } */ -/* { dg-options "-O2 -fPIC -march=x86-64 -mno-avx -mno-popcnt" } */ +/* { dg-options "-O2 -fPIC" } */ #include <assert.h> diff --git a/gcc/testsuite/g++.dg/mv2.C b/gcc/testsuite/g++.dg/mv2.C index f94877a674f..baaa5da350a 100644 --- a/gcc/testsuite/g++.dg/mv2.C +++ b/gcc/testsuite/g++.dg/mv2.C @@ -2,7 +2,7 @@ dispatching order when versions are for various ISAs. */ /* { dg-do run { target i?86-*-* x86_64-*-* } } */ /* { dg-require-ifunc "" } */ -/* { dg-options "-O2 -mno-sse -mno-mmx -mno-popcnt -mno-avx" } */ +/* { dg-options "-O2" } */ #include <assert.h> diff --git a/gcc/testsuite/g++.dg/mv3.C b/gcc/testsuite/g++.dg/mv3.C index c7088f2b013..ec2aa1ffec2 100644 --- a/gcc/testsuite/g++.dg/mv3.C +++ b/gcc/testsuite/g++.dg/mv3.C @@ -10,7 +10,7 @@ test should pass. */ /* { dg-do run { target i?86-*-* x86_64-*-* } } */ -/* { dg-options "-O2 -mno-sse -mno-popcnt" } */ +/* { dg-options "-O2" } */ int __attribute__ ((target ("sse"))) diff --git a/gcc/testsuite/g++.dg/mv4.C b/gcc/testsuite/g++.dg/mv4.C index ac5c5481c66..ff1cc2f63f4 100644 --- a/gcc/testsuite/g++.dg/mv4.C +++ b/gcc/testsuite/g++.dg/mv4.C @@ -4,7 +4,7 @@ /* { dg-do compile { target i?86-*-* x86_64-*-* } } */ /* { dg-require-ifunc "" } */ -/* { dg-options "-O2 -mno-sse -mno-popcnt" } */ +/* { dg-options "-O2" } */ int __attribute__ ((target ("sse"))) foo () diff --git a/gcc/testsuite/g++.dg/mv5.C b/gcc/testsuite/g++.dg/mv5.C index cac6d04e2e3..93daab650e0 100644 --- a/gcc/testsuite/g++.dg/mv5.C +++ b/gcc/testsuite/g++.dg/mv5.C @@ -3,7 +3,7 @@ /* { dg-do run { target i?86-*-* x86_64-*-* } } */ /* { dg-require-ifunc "" } */ -/* { dg-options "-O2 -mno-popcnt" } */ +/* { dg-options "-O2" } */ /* Default version. */ diff --git a/gcc/testsuite/g++.dg/overload/defarg7.C b/gcc/testsuite/g++.dg/overload/defarg7.C new file mode 100644 index 00000000000..8cc08f53869 --- /dev/null +++ b/gcc/testsuite/g++.dg/overload/defarg7.C @@ -0,0 +1,12 @@ +struct A +{ + A(const char *); + explicit A(const int *); +}; + +void f (A a = 0); + +int main() +{ + f(); +} diff --git a/gcc/testsuite/g++.dg/torture/pr55355.C b/gcc/testsuite/g++.dg/torture/pr55355.C new file mode 100644 index 00000000000..6d8f8b6be1e --- /dev/null +++ b/gcc/testsuite/g++.dg/torture/pr55355.C @@ -0,0 +1,23 @@ +/* { dg-do compile } */ + +struct A +{ + void funcA(void); +}; + +struct B {}; + +struct C +{ + void funcC(void) { a_mp->funcA(); } + + char buf_ma[268435456]; + A *a_mp; + B b_m; +}; + +void +func(C *c_p) +{ + c_p->funcC(); +} diff --git a/gcc/testsuite/gcc.c-torture/compile/pr44707.c b/gcc/testsuite/gcc.c-torture/compile/pr44707.c index d5d39fc83c8..bad8177557e 100644 --- a/gcc/testsuite/gcc.c-torture/compile/pr44707.c +++ b/gcc/testsuite/gcc.c-torture/compile/pr44707.c @@ -1,3 +1,5 @@ +/* { dg-do compile { target powerpc-ibm-aix* } } */ + extern struct { int a, b, c, d; } v; extern int w; diff --git a/gcc/testsuite/gcc.dg/pr55430.c b/gcc/testsuite/gcc.dg/pr55430.c index dda02f3fac1..ac56cacea5a 100644 --- a/gcc/testsuite/gcc.dg/pr55430.c +++ b/gcc/testsuite/gcc.dg/pr55430.c @@ -11,6 +11,9 @@ #ifndef MAP_ANON #define MAP_ANON 0 #endif +#ifndef MAP_FAILED +#define MAP_FAILED ((void *)-1) +#endif #include <stdlib.h> struct S diff --git a/gcc/testsuite/gcc.dg/pr55831.c b/gcc/testsuite/gcc.dg/pr55831.c new file mode 100644 index 00000000000..ce7be63e1da --- /dev/null +++ b/gcc/testsuite/gcc.dg/pr55831.c @@ -0,0 +1,39 @@ +/* PR tree-optimization/55831 */ +/* { dg-do compile } */ +/* { dg-options "-O -fstrict-overflow -ftree-vectorize -Wno-unused-label" } */ + +int g; +short p, q; + +void +foo (void) +{ + short a = p, b = q, i; + + if (a) + { + label: + for (i = 0; i < 8; i++) + b ^= a++; + + if (!b) + g = 0; + } +} + +void +bar (void) +{ + short a = p, b = q, i; + + if (a) + { + label: + for (i = 0; i < 8; i++) + b ^= (a = a + 1); + + if (!b) + g = 0; + } +} + diff --git a/gcc/testsuite/gcc.dg/pthread-init-2.c b/gcc/testsuite/gcc.dg/pthread-init-2.c index 3e8a17e23d7..8ec0515ba26 100644 --- a/gcc/testsuite/gcc.dg/pthread-init-2.c +++ b/gcc/testsuite/gcc.dg/pthread-init-2.c @@ -8,6 +8,7 @@ /* { dg-require-effective-target pthread_h } */ /* { dg-options "-Wextra -Wall -ansi" } */ /* { dg-options "-Wextra -Wall -ansi -D_POSIX_C_SOURCE=199506L" { target { *-*-hpux* } } } */ +/* { dg-options "-Wextra -Wall -ansi -D_XOPEN_SOURCE=500" { target { powerpc-ibm-aix* } } } */ #include "pthread-init-common.h" diff --git a/gcc/testsuite/gcc.dg/torture/fp-int-convert-2.c b/gcc/testsuite/gcc.dg/torture/fp-int-convert-2.c new file mode 100644 index 00000000000..4c00e8fa71f --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/fp-int-convert-2.c @@ -0,0 +1,18 @@ +/* { dg-do run } */ +/* { dg-require-effective-target int128 } */ + +extern void abort (void); + +float __attribute__((noinline)) +f (__uint128_t x) +{ + return x + 1; +} + +int +main (void) +{ + if (f (0xffffffffu) == 0) + abort (); + return 0; +} diff --git a/gcc/testsuite/gcc.dg/torture/tls/tls-reload-1.c b/gcc/testsuite/gcc.dg/torture/tls/tls-reload-1.c new file mode 100644 index 00000000000..464a65122b2 --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/tls/tls-reload-1.c @@ -0,0 +1,48 @@ +/* { dg-do run } */ +/* { dg-require-effective-target tls_runtime } */ + +#define ARRAY(X) X##_array +#define DECLARE(X) \ + __thread int X; \ + __thread int ARRAY(X)[4]; \ + int *volatile *__attribute__((noinline)) \ + check##X (int *volatile *y) \ + { \ + if (!y || *y++ != &X || *y++ != &ARRAY(X)[3]) \ + return 0; \ + return y; \ + } +#define COPY(X) *y++ = &X; *y++ = &ARRAY(X)[3]; +#define CHECK(X) y = check##X (y); +#define A(M, X) M(X##0) M(X##1) M(X##2) M(X##3) M(X##4) M(X##5) M(X##6) M(X##7) +#define B(M, X) A(M, X##0) A(M, X##1) A(M, X##2) +#define C(M, X) B(M, X) B(M, X) B(M, X) + +#define NM 2 +#define NA (NM * 8) +#define NB (NA * 3) +#define NC (NB * 3) + +extern void abort (void); + +B(DECLARE, tls) + +void __attribute__ ((noinline)) +setup (int *volatile *y) +{ + C(COPY, tls) +} + +int +main (void) +{ + int *volatile array[NC]; + int *volatile *y = array; + int i; + + setup (array); + B(CHECK, tls); + if (!y) + abort (); + return 0; +} diff --git a/gcc/testsuite/gcc.dg/tree-ssa/cunroll-1.c b/gcc/testsuite/gcc.dg/tree-ssa/cunroll-1.c index 523250dfd05..6220640459d 100644 --- a/gcc/testsuite/gcc.dg/tree-ssa/cunroll-1.c +++ b/gcc/testsuite/gcc.dg/tree-ssa/cunroll-1.c @@ -8,6 +8,6 @@ test(int c) a[i]=5; } /* Array bounds says the loop will not roll much. */ -/* { dg-final { scan-tree-dump "Unrolled loop 1 completely .duplicated 2 times.." "cunrolli"} } */ +/* { dg-final { scan-tree-dump "Completely unroll loop 2 times" "cunrolli"} } */ /* { dg-final { scan-tree-dump "Last iteration exit edge was proved true." "cunrolli"} } */ /* { dg-final { cleanup-tree-dump "cunrolli" } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/cunroll-2.c b/gcc/testsuite/gcc.dg/tree-ssa/cunroll-2.c index 8a54a801c6e..10f6645cf25 100644 --- a/gcc/testsuite/gcc.dg/tree-ssa/cunroll-2.c +++ b/gcc/testsuite/gcc.dg/tree-ssa/cunroll-2.c @@ -12,5 +12,5 @@ test(int c) } } /* We are not able to get rid of the final conditional because the loop has two exits. */ -/* { dg-final { scan-tree-dump "Unrolled loop 1 completely .duplicated 1 times.." "cunroll"} } */ +/* { dg-final { scan-tree-dump "Completely unroll loop 1 times" "cunroll"} } */ /* { dg-final { cleanup-tree-dump "cunroll" } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/cunroll-3.c b/gcc/testsuite/gcc.dg/tree-ssa/cunroll-3.c index b621432c045..44de9606e9c 100644 --- a/gcc/testsuite/gcc.dg/tree-ssa/cunroll-3.c +++ b/gcc/testsuite/gcc.dg/tree-ssa/cunroll-3.c @@ -11,5 +11,5 @@ test(int c) } /* If we start duplicating headers prior curoll, this loop will have 0 iterations. */ -/* { dg-final { scan-tree-dump "Unrolled loop 1 completely .duplicated 1 times.." "cunrolli"} } */ +/* { dg-final { scan-tree-dump "Completely unroll loop 1 times" "cunrolli"} } */ /* { dg-final { cleanup-tree-dump "cunrolli" } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/cunroll-4.c b/gcc/testsuite/gcc.dg/tree-ssa/cunroll-4.c index e42919c342f..9b70e95949f 100644 --- a/gcc/testsuite/gcc.dg/tree-ssa/cunroll-4.c +++ b/gcc/testsuite/gcc.dg/tree-ssa/cunroll-4.c @@ -16,6 +16,6 @@ test(int c) /* We should do this as part of cunrolli, but our cost model do not take into account early exit from the last iteration. */ -/* { dg-final { scan-tree-dump "Turned loop 1 to non-loop; it never loops." "ivcanon"} } */ +/* { dg-final { scan-tree-dump "Turned loop into non-loop; it never loops." "ivcanon"} } */ /* { dg-final { scan-tree-dump "Last iteration exit edge was proved true." "ivcanon"} } */ /* { dg-final { cleanup-tree-dump "ivcanon" } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/cunroll-5.c b/gcc/testsuite/gcc.dg/tree-ssa/cunroll-5.c index 8d1a14a7837..f74e6b5093b 100644 --- a/gcc/testsuite/gcc.dg/tree-ssa/cunroll-5.c +++ b/gcc/testsuite/gcc.dg/tree-ssa/cunroll-5.c @@ -8,7 +8,7 @@ test(int c) a[i]=5; } /* Basic testcase for complette unrolling. */ -/* { dg-final { scan-tree-dump "Unrolled loop 1 completely .duplicated 5 times.." "cunroll"} } */ +/* { dg-final { scan-tree-dump "Completely unroll loop 5 times" "cunroll"} } */ /* { dg-final { scan-tree-dump "Exit condition of peeled iterations was eliminated." "cunroll"} } */ /* { dg-final { scan-tree-dump "Last iteration exit edge was proved true." "cunroll"} } */ /* { dg-final { cleanup-tree-dump "cunroll" } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/loop-1.c b/gcc/testsuite/gcc.dg/tree-ssa/loop-1.c index 35ff0be60fa..81178ae4c6e 100644 --- a/gcc/testsuite/gcc.dg/tree-ssa/loop-1.c +++ b/gcc/testsuite/gcc.dg/tree-ssa/loop-1.c @@ -33,7 +33,7 @@ int xxx(void) /* { dg-final { scan-tree-dump-times "Added canonical iv to loop 1, 4 iterations" 1 "ivcanon"} } */ /* { dg-final { cleanup-tree-dump "ivcanon" } } */ -/* { dg-final { scan-tree-dump-times "Unrolled loop 1 completely" 1 "cunroll"} } */ +/* { dg-final { scan-tree-dump-times "Completely unroll loop 4 times" 1 "cunroll"} } */ /* { dg-final { cleanup-tree-dump "cunroll" } } */ /* { dg-final { scan-tree-dump-times "foo" 5 "optimized"} } */ /* { dg-final { cleanup-tree-dump "optimized" } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/loop-23.c b/gcc/testsuite/gcc.dg/tree-ssa/loop-23.c index 466d1758d1f..4f42491dad2 100644 --- a/gcc/testsuite/gcc.dg/tree-ssa/loop-23.c +++ b/gcc/testsuite/gcc.dg/tree-ssa/loop-23.c @@ -24,6 +24,6 @@ int foo(void) return sum; } -/* { dg-final { scan-tree-dump-times "Unrolled loop 1 completely" 1 "cunroll" } } */ +/* { dg-final { scan-tree-dump-times "Completely unroll loop 3 times" 1 "cunroll" } } */ /* { dg-final { cleanup-tree-dump "cunroll" } } */ diff --git a/gcc/testsuite/gcc.dg/unroll_1.c b/gcc/testsuite/gcc.dg/unroll_1.c index 23e241bfce2..5818635cea9 100644 --- a/gcc/testsuite/gcc.dg/unroll_1.c +++ b/gcc/testsuite/gcc.dg/unroll_1.c @@ -28,5 +28,5 @@ int foo2(void) return 1; } -/* { dg-final { scan-rtl-dump-times "Decided to peel loop completely" 2 "loop2_unroll" } } */ +/* { dg-final { scan-rtl-dump-times "Turned loop into non-loop; it never loops" 2 "loop2_unroll" } } */ /* { dg-final { cleanup-rtl-dump "loop2_unroll" } } */ diff --git a/gcc/testsuite/gcc.dg/unroll_2.c b/gcc/testsuite/gcc.dg/unroll_2.c index 12912cf77db..9333bf97b1b 100644 --- a/gcc/testsuite/gcc.dg/unroll_2.c +++ b/gcc/testsuite/gcc.dg/unroll_2.c @@ -28,6 +28,6 @@ int foo2(void) return 1; } -/* { dg-final { scan-rtl-dump-times "Decided to peel loop completely" 1 "loop2_unroll" } } */ +/* { dg-final { scan-rtl-dump-times "Turned loop into non-loop; it never loops" 1 "loop2_unroll" } } */ /* { dg-final { cleanup-rtl-dump "loop2_unroll" } } */ /* { dg-excess-errors "extra notes" } */ diff --git a/gcc/testsuite/gcc.dg/unroll_3.c b/gcc/testsuite/gcc.dg/unroll_3.c index d86ed552aec..673069f3f33 100644 --- a/gcc/testsuite/gcc.dg/unroll_3.c +++ b/gcc/testsuite/gcc.dg/unroll_3.c @@ -28,6 +28,6 @@ int foo2(void) return 1; } -/* { dg-final { scan-rtl-dump-times "Decided to peel loop completely" 1 "loop2_unroll" } } */ +/* { dg-final { scan-rtl-dump-times "Turned loop into non-loop; it never loops" 1 "loop2_unroll" } } */ /* { dg-final { cleanup-rtl-dump "loop2_unroll" } } */ /* { dg-excess-errors "extra notes" } */ diff --git a/gcc/testsuite/gcc.dg/unroll_4.c b/gcc/testsuite/gcc.dg/unroll_4.c index 7c70157f583..d3fedd0de5c 100644 --- a/gcc/testsuite/gcc.dg/unroll_4.c +++ b/gcc/testsuite/gcc.dg/unroll_4.c @@ -28,6 +28,6 @@ int foo2(void) return 1; } -/* { dg-final { scan-rtl-dump-times "Decided to peel loop completely" 1 "loop2_unroll" } } */ +/* { dg-final { scan-rtl-dump-times "Turned loop into non-loop; it never loops" 1 "loop2_unroll" } } */ /* { dg-final { cleanup-rtl-dump "loop2_unroll" } } */ /* { dg-excess-errors "extra notes" } */ diff --git a/gcc/testsuite/gcc.target/i386/builtin_target.c b/gcc/testsuite/gcc.target/i386/builtin_target.c index ab6b82e6853..c40983e6b3c 100644 --- a/gcc/testsuite/gcc.target/i386/builtin_target.c +++ b/gcc/testsuite/gcc.target/i386/builtin_target.c @@ -9,12 +9,6 @@ #include <assert.h> #include "cpuid.h" -enum vendor_signatures -{ - SIG_INTEL = 0x756e6547 /* Genu */, - SIG_AMD = 0x68747541 /* Auth */ -}; - /* Check if the Intel CPU model and sub-model are identified. */ static void check_intel_cpu_model (unsigned int family, unsigned int model, @@ -191,7 +185,7 @@ check_detailed () extended_model = (eax >> 12) & 0xf0; extended_family = (eax >> 20) & 0xff; - if (vendor == SIG_INTEL) + if (vendor == signature_INTEL_ebx) { assert (__builtin_cpu_is ("intel")); /* Adjust family and model for Intel CPUs. */ @@ -205,7 +199,7 @@ check_detailed () check_intel_cpu_model (family, model, brand_id); check_features (ecx, edx, max_level); } - else if (vendor == SIG_AMD) + else if (vendor == signature_AMD_ebx) { assert (__builtin_cpu_is ("amd")); /* Adjust model and family for AMD CPUS. */ diff --git a/gcc/testsuite/gcc.target/i386/pr55775.c b/gcc/testsuite/gcc.target/i386/pr55775.c new file mode 100644 index 00000000000..1902f688324 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr55775.c @@ -0,0 +1,56 @@ +/* { dg-do compile } */ +/* { dg-options "-O1" } */ + +int *ptr; +int *fn1 (int *); +int fn2 (int, int); +int fn3 (void); +int fn4 (int); + +static int +foo (int x, int y, int z) +{ + int b; + asm ("" : "=a" (b), "=&d" (x) : "0" (y), "1" (x), "mr" (z)); + return x; +} + +static int +bar (int x, int y) +{ + int a; + if (!y) + { + for (a = 0; a <= (x >> 1); ) + ; + a = foo (y, fn2 (2, x), x); + if (x) + a = x; + return a; + } +} + +static int +baz (int x, int y) +{ + int *a = ptr; + int t, xk1 = fn3 (), xk = x * xk1; + for (t = 0; t < xk; t += xk1) + { + if (fn4 (a[2])) + return -y; + a = fn1 (a); + } + return 0; +} + +void +test (int x, long y, int z) +{ + int a = fn3 (); + int b; + int c = bar (x, z); + for (b = 0; b <= y; b++) + c = baz (x, c); + fn2 (c, a); +} diff --git a/gcc/testsuite/gcc.target/mips/pr55315.c b/gcc/testsuite/gcc.target/mips/pr55315.c index c3f83329306..9dcf2893a77 100644 --- a/gcc/testsuite/gcc.target/mips/pr55315.c +++ b/gcc/testsuite/gcc.target/mips/pr55315.c @@ -5,7 +5,7 @@ int data[4096]; int f (void) { - return (((unsigned int) &data[0]) == 0xdeadbea0U); + return (((unsigned long) &data[0]) == 0xdeadbea0U); } /* { dg-final { scan-assembler-not "\tmove\t\\\$2,\\\$0" } } */ diff --git a/gcc/testsuite/gcc.target/mips/r10k-cache-barrier-10.c b/gcc/testsuite/gcc.target/mips/r10k-cache-barrier-10.c index 1b8c6f4ab49..ad0d2b0491b 100644 --- a/gcc/testsuite/gcc.target/mips/r10k-cache-barrier-10.c +++ b/gcc/testsuite/gcc.target/mips/r10k-cache-barrier-10.c @@ -9,6 +9,12 @@ unsigned char *bar (int); NOMIPS16 void foo (unsigned char *n) { + /* n starts in $4, but will be in $2 after the call to bar. + Encourage it to be in $2 on entry to the loop as well, + by doing some computation on it beforehand (D?ADDIU $2,$4,4). + dbr_schedule should then pull the *n load (L[WD] ...,0($2)) + into the delay slot. */ + n += 4; do n = bar (*n + 1); while (n); diff --git a/gcc/testsuite/gfortran.dg/associated_7.f90 b/gcc/testsuite/gfortran.dg/associated_7.f90 new file mode 100644 index 00000000000..bc56f84c858 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/associated_7.f90 @@ -0,0 +1,9 @@ +! { dg-do compile } +! +! PR 55692: ICE on incorrect use of ASSOCIATED function +! +! Contributed by Gilbert Scott <gilbert.scott@easynet.co.uk> + +INTEGER, POINTER :: P1, P2 +PRINT *, ASSOCIATED([P1,P2]) ! { dg-error "must be a POINTER" } +END diff --git a/gcc/testsuite/gfortran.dg/eof_4.f90 b/gcc/testsuite/gfortran.dg/eof_4.f90 new file mode 100644 index 00000000000..293c0fa39f6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/eof_4.f90 @@ -0,0 +1,130 @@ +! { dg-do run } +! PR55818 Reading a REAL from a file which doesn't end in a new line fails +! Test case from PR reporter. +implicit none +integer :: stat +!integer :: var ! << works +real :: var ! << fails +character(len=10) :: cvar ! << fails +complex :: cval +logical :: lvar + +open(99, file="test.dat", access="stream", form="unformatted", status="new") +write(99) "1", new_line("") +write(99) "2", new_line("") +write(99) "3" +close(99) + +! Test character kind +open(99, file="test.dat") +read (99,*, iostat=stat) cvar +if (stat /= 0 .or. cvar /= "1") call abort() +read (99,*, iostat=stat) cvar +if (stat /= 0 .or. cvar /= "2") call abort() +read (99,*, iostat=stat) cvar ! << FAILS: stat /= 0 +if (stat /= 0 .or. cvar /= "3") call abort() ! << aborts here + +! Test real kind +rewind(99) +read (99,*, iostat=stat) var +if (stat /= 0 .or. var /= 1.0) call abort() +read (99,*, iostat=stat) var +if (stat /= 0 .or. var /= 2.0) call abort() +read (99,*, iostat=stat) var ! << FAILS: stat /= 0 +if (stat /= 0 .or. var /= 3.0) call abort() +close(99, status="delete") + +! Test real kind with exponents +open(99, file="test.dat", access="stream", form="unformatted", status="new") +write(99) "1.0e3", new_line("") +write(99) "2.0e-03", new_line("") +write(99) "3.0e2" +close(99) + +open(99, file="test.dat") +read (99,*, iostat=stat) var +if (stat /= 0) call abort() +read (99,*, iostat=stat) var +if (stat /= 0) call abort() +read (99,*) var ! << FAILS: stat /= 0 +if (stat /= 0) call abort() +close(99, status="delete") + +! Test logical kind +open(99, file="test.dat", access="stream", form="unformatted", status="new") +write(99) "Tru", new_line("") +write(99) "fal", new_line("") +write(99) "t" +close(99) + +open(99, file="test.dat") +read (99,*, iostat=stat) lvar +if (stat /= 0 .or. (.not.lvar)) call abort() +read (99,*, iostat=stat) lvar +if (stat /= 0 .or. lvar) call abort() +read (99,*) lvar ! << FAILS: stat /= 0 +if (stat /= 0 .or. (.not.lvar)) call abort() +close(99, status="delete") + +! Test combinations of Inf and Nan +open(99, file="test.dat", access="stream", form="unformatted", status="new") +write(99) "infinity", new_line("") +write(99) "nan", new_line("") +write(99) "infinity" +close(99) + +open(99, file="test.dat") +read (99,*, iostat=stat) var +if (stat /= 0) call abort() +read (99,*, iostat=stat) var +if (stat /= 0) call abort() +read (99,*) var ! << FAILS: stat /= 0 +if (stat /= 0) call abort ! << aborts here +close(99, status="delete") + +open(99, file="test.dat", access="stream", form="unformatted", status="new") +write(99) "infinity", new_line("") +write(99) "inf", new_line("") +write(99) "nan" +close(99) + +open(99, file="test.dat") +read (99,*, iostat=stat) var +if (stat /= 0) call abort() +read (99,*, iostat=stat) var +if (stat /= 0) call abort() +read (99,*) var ! << FAILS: stat /= 0 +if (stat /= 0) call abort ! << aborts here +close(99, status="delete") + +open(99, file="test.dat", access="stream", form="unformatted", status="new") +write(99) "infinity", new_line("") +write(99) "nan", new_line("") +write(99) "inf" +close(99) + +open(99, file="test.dat") +read (99,*, iostat=stat) var +if (stat /= 0) call abort() +read (99,*, iostat=stat) var +if (stat /= 0) call abort() +read (99,*) var ! << FAILS: stat /= 0 +if (stat /= 0) call abort ! << aborts here +close(99, status="delete") + +! Test complex kind +open(99, file="test.dat", access="stream", form="unformatted", status="new") +write(99) "(1,2)", new_line("") +write(99) "(2,3)", new_line("") +write(99) "(4,5)" +close(99) + +open(99, file="test.dat") +read (99,*, iostat=stat) cval +if (stat /= 0 .or. cval /= cmplx(1,2)) call abort() +read (99,*, iostat=stat) cval +if (stat /= 0 .or. cval /= cmplx(2,3)) call abort() +read (99,*, iostat=stat) cval ! << FAILS: stat /= 0, value is okay +if (stat /= 0 .or. cval /= cmplx(4,5)) call abort() +close(99, status="delete") +end diff --git a/gcc/testsuite/gfortran.dg/inquire_15.f90 b/gcc/testsuite/gfortran.dg/inquire_15.f90 new file mode 100644 index 00000000000..e2aaf9ee17d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/inquire_15.f90 @@ -0,0 +1,28 @@ +! { dg-do run } +! PR48976 test case by jvdelisle@gcc.gnu.org +character(len=20) :: str +str = "abcdefg" +inquire(file="abcddummy", stream=str) +!print *, "str=",str +if (str /= "UNKNOWN") call abort +inquire(99, stream=str) +!print *, "str=",str +if (str /= "UNKNOWN") call abort +open(99,access="stream") +inquire(99, stream=str) +!print *, "str=",str +if (str /= "YES") goto 10 +close(99) +open(99,access="direct", recl=16) +inquire(99, stream=str) +!print *, "str=",str +if (str /= "NO") goto 10 +close(99) +open(99,access="sequential") +inquire(99, stream=str) +!print *, "str=",str +if (str /= "NO") goto 10 +stop +10 close(99, status="delete") +call abort +end diff --git a/gcc/testsuite/gfortran.dg/newunit_3.f90 b/gcc/testsuite/gfortran.dg/newunit_3.f90 new file mode 100644 index 00000000000..a0e5a8a75a7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/newunit_3.f90 @@ -0,0 +1,7 @@ +! { dg-do run } +! PR48960 On ERROR newunit should not modify user variable. +program test_newunit + integer :: st, un = 0 + open (newunit=un, file='nonexisting.dat', status='old', iostat=st) + if (un /= 0) call abort +end program test_newunit diff --git a/gcc/testsuite/gfortran.dg/nosigned_zero_3.f90 b/gcc/testsuite/gfortran.dg/nosigned_zero_3.f90 new file mode 100644 index 00000000000..3f0f7101f26 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/nosigned_zero_3.f90 @@ -0,0 +1,15 @@ +! { dg-do run } +! { dg-options "-fno-sign-zero" } +! +! PR fortran/55539 +! +program nosigned_zero_3 + implicit none + character(len=20) :: s + real(4) :: x = -1.2e-3 + real(8) :: y = -1.2e-3 + write(s,'(7f10.3)') x + if (trim(adjustl(s)) /= "-0.001") call abort + write(s, '(7f10.3)') y + if (trim(adjustl(s)) /= "-0.001") call abort +end program nosigned_zero_3 diff --git a/gcc/testsuite/gfortran.dg/public_private_module_8.f90 b/gcc/testsuite/gfortran.dg/public_private_module_8.f90 new file mode 100644 index 00000000000..bfc1b368f46 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/public_private_module_8.f90 @@ -0,0 +1,49 @@ +! { dg-do compile } +! { dg-options "-O2" } +! +! PR fortran/54884 +! +! Check that get_key_len is not optimized away as it +! is used in a publicly visible specification expression. +! + +module m + private + public :: foo + interface foo + module procedure bar + end interface foo +contains + pure function mylen() + integer :: mylen + mylen = 42 + end function mylen + pure function myotherlen() + integer :: myotherlen + myotherlen = 99 + end function myotherlen + subroutine bar(x) + character(len=mylen()) :: x + character :: z2(myotherlen()) + call internal(x) + block + character(len=myotherlen()) :: z + z = "abc" + x(1:5) = z + end block + x(6:10) = intern_func() + contains + function intern_func() + character(len=myotherlen()) :: intern_func + intern_func = "zuzu" + end function intern_func + subroutine internal(y) + character(len=myotherlen()) :: y + y = "abc" + end subroutine internal + end subroutine bar +end module m + +! { dg-final { scan-assembler-not "__m_MOD_myotherlen" } } +! { dg-final { scan-assembler "__m_MOD_bar" } } +! { dg-final { scan-assembler "__m_MOD_mylen" } } diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_4.f03 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_4.f03 new file mode 100644 index 00000000000..d289b69199f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_4.f03 @@ -0,0 +1,41 @@ +! { dg-do compile }
+!
+! Fix PR55763
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+module mpi_f08_f
+ implicit none
+ abstract interface
+ subroutine user_function( inoutvec )
+ class(*), dimension(:), intent(inout) :: inoutvec
+ end subroutine user_function
+ end interface
+end module
+
+module mod_test1
+ use mpi_f08_f
+ implicit none
+contains
+ subroutine my_function( invec ) ! { dg-error "no IMPLICIT type" }
+ class(*), dimension(:), intent(inout) :: inoutvec ! { dg-error "not a DUMMY" }
+
+ select type (inoutvec)
+ type is (integer)
+ inoutvec = 2*inoutvec
+ end select
+ end subroutine my_function
+end module
+
+module mod_test2
+ use mpi_f08_f
+ implicit none
+contains
+ subroutine my_function( inoutvec ) ! Used to produce a BOGUS ERROR
+ class(*), dimension(:), intent(inout) :: inoutvec
+
+ select type (inoutvec)
+ type is (integer)
+ inoutvec = 2*inoutvec
+ end select
+ end subroutine my_function
+end module
diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_5.f90 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_5.f90 new file mode 100644 index 00000000000..12a3c4a5624 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_5.f90 @@ -0,0 +1,41 @@ +! { dg-do run } +! +! PR fortran/55763 +! +! Based on Reinhold Bader's test case +! + +program mvall_03 + implicit none + integer, parameter :: n1 = 100, n2 = 200 + class(*), allocatable :: i1(:), i3(:) + integer, allocatable :: i2(:) + + allocate(real :: i1(n1)) + allocate(i2(n2)) + i2 = 2 + call move_alloc(i2, i1) + if (size(i1) /= n2 .or. allocated(i2)) then + call abort +! write(*,*) 'FAIL' + else +! write(*,*) 'OK' + end if + + select type (i1) + type is (integer) + if (any (i1 /= 2)) call abort + class default + call abort() + end select + call move_alloc (i1, i3) + if (size(i3) /= n2 .or. allocated(i1)) then + call abort() + end if + select type (i3) + type is (integer) + if (any (i3 /= 2)) call abort + class default + call abort() + end select +end program diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_6.f90 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_6.f90 new file mode 100644 index 00000000000..a64f4e393e2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_6.f90 @@ -0,0 +1,37 @@ +! { dg-do run } +! +! PR fortran/55763 +! +! Contributed by Reinhold Bader +! +module mod_alloc_scalar_01 +contains + subroutine construct(this) + class(*), allocatable, intent(out) :: this + integer :: this_i + this_i = 4 + allocate(this, source=this_i) + end subroutine +end module + +program alloc_scalar_01 + use mod_alloc_scalar_01 + implicit none + class(*), allocatable :: mystuff + + call construct(mystuff) + call construct(mystuff) + + select type(mystuff) + type is (integer) + if (mystuff == 4) then +! write(*,*) 'OK' + else + call abort() +! write(*,*) 'FAIL 1' + end if + class default + call abort() +! write(*,*) 'FAIL 2' + end select +end program diff --git a/gcc/testsuite/lib/c-compat.exp b/gcc/testsuite/lib/c-compat.exp index ddbdd2d455e..bb928c2969d 100644 --- a/gcc/testsuite/lib/c-compat.exp +++ b/gcc/testsuite/lib/c-compat.exp @@ -1,4 +1,4 @@ -# Copyright (C) 2002, 2003, 2005, 2006, 2007, 2008 +# Copyright (C) 2002, 2003, 2005, 2006, 2007, 2008, 2013 # Free Software Foundation, Inc. # This program is free software; you can redistribute it and/or modify @@ -35,12 +35,16 @@ load_lib target-supports.exp # proc compat-use-alt-compiler { } { global GCC_UNDER_TEST ALT_CC_UNDER_TEST - global compat_same_alt + global compat_same_alt compat_alt_caret + global TEST_ALWAYS_FLAGS # We don't need to do this if the alternate compiler is actually # the same as the compiler under test. if { $compat_same_alt == 0 } then { set GCC_UNDER_TEST $ALT_CC_UNDER_TEST + if { $compat_alt_caret == 0 } then { + regsub -- "-fno-diagnostics-show-caret" $TEST_ALWAYS_FLAGS "" TEST_ALWAYS_FLAGS + } } } @@ -50,12 +54,14 @@ proc compat-use-alt-compiler { } { proc compat-use-tst-compiler { } { global GCC_UNDER_TEST compat_save_gcc_under_test global compat_same_alt + global TEST_ALWAYS_FLAGS compat_save_TEST_ALWAYS_FLAGS # We don't need to do this if the alternate compiler is actually # the same as the compiler under test. if { $compat_same_alt == 0 } then { set GCC_UNDER_TEST $compat_save_gcc_under_test + set TEST_ALWAYS_FLAGS $compat_save_TEST_ALWAYS_FLAGS } } @@ -64,6 +70,11 @@ proc compat_setup_dfp { } { global compat_use_alt global compat_same_alt global compat_have_dfp + global compat_alt_caret + global TEST_ALWAYS_FLAGS compat_save_TEST_ALWAYS_FLAGS + + set compat_alt_caret 0 + set compat_save_TEST_ALWAYS_FLAGS $TEST_ALWAYS_FLAGS verbose "compat_setup_dfp: $compat_use_alt $compat_same_alt" 2 @@ -72,6 +83,15 @@ proc compat_setup_dfp { } { set compat_have_dfp [check_effective_target_dfprt_nocache] verbose "compat_have_dfp for tst compiler: $compat_have_dfp" 2 + if { $compat_use_alt == 1 && $compat_same_alt == 0 } { + compat-use-alt-compiler + if { [check_no_compiler_messages_nocache compat_alt_has_caret object { + int dummy; } "-fno-diagnostics-show-caret"] != 0 } { + set compat_alt_caret 1 + } + compat-use-tst-compiler + } + # If there is an alternate compiler, does it support decimal float types? if { $compat_have_dfp == 1 && $compat_use_alt == 1 && $compat_same_alt == 0 } { compat-use-alt-compiler diff --git a/gcc/testsuite/lib/target-supports.exp b/gcc/testsuite/lib/target-supports.exp index 7124eba235d..a3828cbbec6 100644 --- a/gcc/testsuite/lib/target-supports.exp +++ b/gcc/testsuite/lib/target-supports.exp @@ -578,10 +578,10 @@ proc check_effective_target_pcc_bitfield_type_matters { } { proc add_options_for_tls { flags } { # On Solaris 9, __tls_get_addr/___tls_get_addr only lives in - # libthread, so always pass -pthread for native TLS. + # libthread, so always pass -pthread for native TLS. Same for AIX. # Need to duplicate native TLS check from # check_effective_target_tls_native to avoid recursion. - if { [istarget *-*-solaris2.9*] && + if { ([istarget *-*-solaris2.9*] || [istarget powerpc-ibm-aix*]) && [check_no_messages_and_pattern tls_native "!emutls" assembly { __thread int i; int f (void) { return i; } @@ -2646,10 +2646,10 @@ proc check_effective_target_powerpc_vsx_ok { } { if { ([istarget powerpc*-*-*] && ![istarget powerpc-*-linux*paired*]) || [istarget rs6000-*-*] } { - # AltiVec is not supported on AIX before 5.3. + # VSX is not supported on AIX before 7.1. if { [istarget powerpc*-*-aix4*] - || [istarget powerpc*-*-aix5.1*] - || [istarget powerpc*-*-aix5.2*] } { + || [istarget powerpc*-*-aix5*] + || [istarget powerpc*-*-aix6*] } { return 0 } return [check_no_compiler_messages powerpc_vsx_ok object { diff --git a/gcc/tree-sra.c b/gcc/tree-sra.c index 21d8a514117..286ef266920 100644 --- a/gcc/tree-sra.c +++ b/gcc/tree-sra.c @@ -714,7 +714,12 @@ type_internals_preclude_sra_p (tree type, const char **msg) { *msg = "structure field size not fixed"; return true; - } + } + if (!host_integerp (bit_position (fld), 0)) + { + *msg = "structure field size too big"; + return true; + } if (AGGREGATE_TYPE_P (ft) && int_bit_position (fld) % BITS_PER_UNIT != 0) { diff --git a/gcc/tree-ssa-loop-ivcanon.c b/gcc/tree-ssa-loop-ivcanon.c index eef613c4a77..1a872a32cc4 100644 --- a/gcc/tree-ssa-loop-ivcanon.c +++ b/gcc/tree-ssa-loop-ivcanon.c @@ -639,22 +639,24 @@ unloop_loops (bitmap loop_closed_ssa_invalidated, /* Tries to unroll LOOP completely, i.e. NITER times. UL determines which loops we are allowed to unroll. - EXIT is the exit of the loop that should be eliminated. + EXIT is the exit of the loop that should be eliminated. MAXITER specfy bound on number of iterations, -1 if it is - not known or too large for HOST_WIDE_INT. */ + not known or too large for HOST_WIDE_INT. The location + LOCUS corresponding to the loop is used when emitting + a summary of the unroll to the dump file. */ static bool try_unroll_loop_completely (struct loop *loop, edge exit, tree niter, enum unroll_level ul, - HOST_WIDE_INT maxiter) + HOST_WIDE_INT maxiter, + location_t locus) { unsigned HOST_WIDE_INT n_unroll, ninsns, max_unroll, unr_insns; gimple cond; struct loop_size size; bool n_unroll_found = false; edge edge_to_cancel = NULL; - int num = loop->num; /* See if we proved number of iterations to be low constant. @@ -862,14 +864,25 @@ try_unroll_loop_completely (struct loop *loop, loops_to_unloop.safe_push (loop); loops_to_unloop_nunroll.safe_push (n_unroll); - if (dump_file && (dump_flags & TDF_DETAILS)) + if (dump_enabled_p ()) { if (!n_unroll) - fprintf (dump_file, "Turned loop %d to non-loop; it never loops.\n", - num); + dump_printf_loc (MSG_OPTIMIZED_LOCATIONS | TDF_DETAILS, locus, + "Turned loop into non-loop; it never loops.\n"); else - fprintf (dump_file, "Unrolled loop %d completely " - "(duplicated %i times).\n", num, (int)n_unroll); + { + dump_printf_loc (MSG_OPTIMIZED_LOCATIONS | TDF_DETAILS, locus, + "Completely unroll loop %d times", (int)n_unroll); + if (profile_info) + dump_printf (MSG_OPTIMIZED_LOCATIONS | TDF_DETAILS, + " (header execution count %d)", + (int)loop->header->count); + dump_printf (MSG_OPTIMIZED_LOCATIONS | TDF_DETAILS, "\n"); + } + } + + if (dump_file && (dump_flags & TDF_DETAILS)) + { if (exit) fprintf (dump_file, "Exit condition of peeled iterations was " "eliminated.\n"); @@ -898,15 +911,17 @@ canonicalize_loop_induction_variables (struct loop *loop, tree niter; HOST_WIDE_INT maxiter; bool modified = false; + location_t locus = UNKNOWN_LOCATION; niter = number_of_latch_executions (loop); + exit = single_exit (loop); if (TREE_CODE (niter) == INTEGER_CST) - exit = single_exit (loop); + locus = gimple_location (last_stmt (exit->src)); else { /* If the loop has more than one exit, try checking all of them for # of iterations determinable through scev. */ - if (!single_exit (loop)) + if (!exit) niter = find_loop_niter (loop, &exit); /* Finally if everything else fails, try brute force evaluation. */ @@ -915,6 +930,9 @@ canonicalize_loop_induction_variables (struct loop *loop, || TREE_CODE (niter) != INTEGER_CST)) niter = find_loop_niter_by_eval (loop, &exit); + if (exit) + locus = gimple_location (last_stmt (exit->src)); + if (TREE_CODE (niter) != INTEGER_CST) exit = NULL; } @@ -949,7 +967,7 @@ canonicalize_loop_induction_variables (struct loop *loop, populates the loop bounds. */ modified |= remove_redundant_iv_tests (loop); - if (try_unroll_loop_completely (loop, exit, niter, ul, maxiter)) + if (try_unroll_loop_completely (loop, exit, niter, ul, maxiter, locus)) return true; if (create_iv diff --git a/gcc/tree-ssa-loop-niter.c b/gcc/tree-ssa-loop-niter.c index 4a09999f434..7a15ff82d5b 100644 --- a/gcc/tree-ssa-loop-niter.c +++ b/gcc/tree-ssa-loop-niter.c @@ -38,7 +38,6 @@ along with GCC; see the file COPYING3. If not see #include "flags.h" #include "diagnostic-core.h" #include "tree-inline.h" -#include "gmp.h" #define SWAP(X, Y) do { affine_iv *tmp = (X); (X) = (Y); (Y) = tmp; } while (0) diff --git a/gcc/tree-vect-loop.c b/gcc/tree-vect-loop.c index 633d3d1d972..f091604e492 100644 --- a/gcc/tree-vect-loop.c +++ b/gcc/tree-vect-loop.c @@ -1,6 +1,6 @@ /* Loop Vectorization - Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012 - Free Software Foundation, Inc. + Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, + 2013 Free Software Foundation, Inc. Contributed by Dorit Naishlos <dorit@il.ibm.com> and Ira Rosen <irar@il.ibm.com> @@ -3406,7 +3406,7 @@ get_initial_def_for_induction (gimple iv_phi) build1 (VIEW_CONVERT_EXPR, resvectype, induc_def), NULL_TREE); induc_def = make_ssa_name (gimple_assign_lhs (new_stmt), new_stmt); gimple_assign_set_lhs (new_stmt, induc_def); - si = gsi_start_bb (bb); + si = gsi_after_labels (bb); gsi_insert_before (&si, new_stmt, GSI_SAME_STMT); set_vinfo_for_stmt (new_stmt, new_stmt_vec_info (new_stmt, loop_vinfo, NULL)); diff --git a/gcc/tree-vect-stmts.c b/gcc/tree-vect-stmts.c index 1e8d7ee4401..da9f12b5c8c 100644 --- a/gcc/tree-vect-stmts.c +++ b/gcc/tree-vect-stmts.c @@ -4988,6 +4988,19 @@ vectorizable_load (gimple stmt, gimple_stmt_iterator *gsi, gimple *vec_stmt, /* Record the mapping between SSA_NAMEs and statements. */ vect_record_grouped_load_vectors (stmt, dr_chain); } + /* Handle invariant-load. */ + else if (inv_p && !bb_vinfo) + { + gimple_stmt_iterator gsi2 = *gsi; + gcc_assert (!grouped_load && !slp_perm); + gsi_next (&gsi2); + new_temp = vect_init_vector (stmt, scalar_dest, + vectype, &gsi2); + new_stmt = SSA_NAME_DEF_STMT (new_temp); + /* Store vector loads in the corresponding SLP_NODE. */ + if (slp) + SLP_TREE_VEC_STMTS (slp_node).quick_push (new_stmt); + } else { for (i = 0; i < vec_num; i++) @@ -5135,17 +5148,6 @@ vectorizable_load (gimple stmt, gimple_stmt_iterator *gsi, gimple *vec_stmt, } } - /* 4. Handle invariant-load. */ - if (inv_p && !bb_vinfo) - { - gimple_stmt_iterator gsi2 = *gsi; - gcc_assert (!grouped_load); - gsi_next (&gsi2); - new_temp = vect_init_vector (stmt, scalar_dest, - vectype, &gsi2); - new_stmt = SSA_NAME_DEF_STMT (new_temp); - } - if (negative) { tree perm_mask = perm_mask_for_reverse (vectype); diff --git a/gcc/tree-vrp.c b/gcc/tree-vrp.c index 4319c60802e..6b8cbf38d84 100644 --- a/gcc/tree-vrp.c +++ b/gcc/tree-vrp.c @@ -8766,9 +8766,11 @@ range_fits_type_p (value_range_t *vr, unsigned precision, bool unsigned_p) || TREE_CODE (vr->max) != INTEGER_CST) return false; - /* For precision-preserving sign-changes the MSB of the double-int - has to be clear. */ - if (src_precision == precision + /* For sign changes, the MSB of the double_int has to be clear. + An unsigned value with its MSB set cannot be represented by + a signed double_int, while a negative value cannot be represented + by an unsigned double_int. */ + if (TYPE_UNSIGNED (src_type) != unsigned_p && (TREE_INT_CST_HIGH (vr->min) | TREE_INT_CST_HIGH (vr->max)) < 0) return false; diff --git a/gcc/tree.c b/gcc/tree.c index 429db49e1a8..7cacb2a0d64 100644 --- a/gcc/tree.c +++ b/gcc/tree.c @@ -7505,12 +7505,7 @@ build_array_type_1 (tree elt_type, tree index_type, bool shared) hashval_t hashcode = iterative_hash_object (TYPE_HASH (elt_type), 0); if (index_type) hashcode = iterative_hash_object (TYPE_HASH (index_type), hashcode); - tree old_t = t; t = type_hash_canon (hashcode, t); - if (t != old_t) - /* Lay it out again in case the element type has been completed since - the array was added to the hash table. */ - layout_type (t); } if (TYPE_CANONICAL (t) == t) diff --git a/gcc/varasm.c b/gcc/varasm.c index 53ebfbf2629..7d083fdacce 100644 --- a/gcc/varasm.c +++ b/gcc/varasm.c @@ -927,7 +927,7 @@ decode_reg_name (const char *name) /* Return true if DECL's initializer is suitable for a BSS section. */ -static bool +bool bss_initializer_p (const_tree decl) { return (DECL_INITIAL (decl) == NULL diff --git a/gcc/xcoffout.c b/gcc/xcoffout.c index 457d34f4b5b..d0733764bfc 100644 --- a/gcc/xcoffout.c +++ b/gcc/xcoffout.c @@ -67,6 +67,7 @@ static const char *xcoff_current_function_file; char *xcoff_bss_section_name; char *xcoff_private_data_section_name; char *xcoff_tls_data_section_name; +char *xcoff_tbss_section_name; char *xcoff_read_only_section_name; /* Last source file name mentioned in a NOTE insn. */ diff --git a/gcc/xcoffout.h b/gcc/xcoffout.h index 9a35e2d7156..1692279d12b 100644 --- a/gcc/xcoffout.h +++ b/gcc/xcoffout.h @@ -127,6 +127,7 @@ extern const char *xcoff_current_include_file; extern char *xcoff_bss_section_name; extern char *xcoff_private_data_section_name; extern char *xcoff_tls_data_section_name; +extern char *xcoff_tbss_section_name; extern char *xcoff_read_only_section_name; /* Last source file name mentioned in a NOTE insn. */ |