diff options
| author | Ian Lance Taylor <ian@gcc.gnu.org> | 2019-12-19 06:03:51 +0000 |
|---|---|---|
| committer | Ian Lance Taylor <ian@gcc.gnu.org> | 2019-12-19 06:03:51 +0000 |
| commit | d5338d09e5352b939227c27997a0120b50d649be (patch) | |
| tree | b65a6e0da38ccfd243a0ba0325bae4961c4a4f5b | |
| parent | 51426017f8fe0f18295ca467feba3fbb5aad3fa8 (diff) | |
| parent | 951e27f58ca5c7f33124407079c383706e99c68d (diff) | |
| download | gcc-d5338d09e5352b939227c27997a0120b50d649be.zip gcc-d5338d09e5352b939227c27997a0120b50d649be.tar.gz gcc-d5338d09e5352b939227c27997a0120b50d649be.tar.bz2 | |
Merge from trunk revision 279561.
From-SVN: r279562
388 files changed, 13485 insertions, 3664 deletions
@@ -1,3 +1,7 @@ +2019-12-17 Mihail Ionescu <mihail.ionescu@arm.com> + + * MAINTAINERS (write_after_approval): Add myself. + 2019-12-11 Matthias Klose <doko@ubuntu.com> * configure.ac: Factor out common cases for compare_exclusions. diff --git a/MAINTAINERS b/MAINTAINERS index 8ebd221..e31fb19 100644 --- a/MAINTAINERS +++ b/MAINTAINERS @@ -434,6 +434,7 @@ Naveen H.S <naveenh@marvell.com> Roland Illig <roland.illig@gmx.de> Meador Inge <meadori@codesourcery.com> Bernardo Innocenti <bernie@develer.com> +Mihail Ionescu <mihail.ionescu@arm.com> Vladislav Ivanishin <vlad@ispras.ru> Alexander Ivchenko <aivchenk@gmail.com> Balaji V. Iyer <bviyer@gmail.com> diff --git a/contrib/ChangeLog b/contrib/ChangeLog index e3fef32..cfac553 100644 --- a/contrib/ChangeLog +++ b/contrib/ChangeLog @@ -1,3 +1,7 @@ +2019-12-16 Jozef Lawrynowicz <jozef.l@mittosystems.com> + + * config-list.mk: Add msp430-elfbare. + 2019-12-09 Lewis Hyatt <lhyatt@gmail.com> PR preprocessor/49973 diff --git a/contrib/config-list.mk b/contrib/config-list.mk index a5f5d7b..d154286 100644 --- a/contrib/config-list.mk +++ b/contrib/config-list.mk @@ -68,7 +68,7 @@ LIST = aarch64-elf aarch64-linux-gnu aarch64-rtems \ mipsel-elf mips64-elf mips64vr-elf mips64orion-elf mips-rtems \ mips-wrs-vxworks mipstx39-elf mmix-knuth-mmixware mn10300-elf moxie-elf \ moxie-uclinux moxie-rtems \ - msp430-elf \ + msp430-elf msp430-elfbare \ nds32le-elf nds32be-elf \ nios2-elf nios2-linux-gnu nios2-rtems \ nvptx-none \ diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 06b9444..e52d056 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,319 @@ +2019-12-19 Feng Xue <fxue@os.amperecomputing.com> + + PR ipa/92794 + * ipa-cp.c (self_recursive_agg_pass_through_p): New function. + (intersect_with_plats): Use error_mark_node as place holder + when aggregate jump function is simple pass-through for + self-recursive call. + (intersect_with_agg_replacements): Likewise. + (intersect_aggregates_with_edge): Likewise. + (find_aggregate_values_for_callers_subset): Likewise. + +2019-12-18 David Malcolm <dmalcolm@redhat.com> + + * common.opt (fdiagnostics-show-cwe): Add. + * diagnostic-core.h (class diagnostic_metadata): New forward decl. + (warning_at): Add overload taking a const diagnostic_metadata &. + (emit_diagnostic_valist): Add overload taking a + const diagnostic_metadata *. + * diagnostic-format-json.cc: Include "diagnostic-metadata.h". + (json_from_metadata): New function. + (json_end_diagnostic): Call it to add "metadata" child for + diagnostics with metadata. + (diagnostic_output_format_init): Clear context->show_cwe. + * diagnostic-metadata.h: New file. + * diagnostic.c: Include "diagnostic-metadata.h". + (diagnostic_impl): Add const diagnostic_metadata * param. + (diagnostic_n_impl): Likewise. + (diagnostic_initialize): Initialize context->show_cwe. + (diagnostic_set_info_translated): Initialize diagnostic->metadata. + (get_cwe_url): New function. + (print_any_cwe): New function. + (diagnostic_report_diagnostic): Call print_any_cwe if the + diagnostic has non-NULL metadata. + (emit_diagnostic): Pass NULL as the metadata in the call to + diagnostic_impl. + (emit_diagnostic_valist): Likewise. + (emit_diagnostic_valist): New overload taking a + const diagnostic_metadata *. + (inform): Pass NULL as the metadata in the call to + diagnostic_impl. + (inform_n): Likewise for diagnostic_n_impl. + (warning): Likewise. + (warning_at): Likewise. Add overload that takes a + const diagnostic_metadata &. + (warning_n): Pass NULL as the metadata in the call to + diagnostic_n_impl. + (pedwarn): Likewise for diagnostic_impl. + (permerror): Likewise. + (error): Likewise. + (error_n): Likewise. + (error_at): Likewise. + (sorry): Likewise. + (sorry_at): Likewise. + (fatal_error): Likewise. + (internal_error): Likewise. + (internal_error_no_backtrace): Likewise. + * diagnostic.h (diagnostic_info::metadata): New field. + (diagnostic_context::show_cwe): New field. + * doc/invoke.texi (-fno-diagnostics-show-cwe): New option. + * opts.c (common_handle_option): Handle OPT_fdiagnostics_show_cwe. + * toplev.c (general_init): Initialize global_dc->show_cwe. + +2019-12-19 Julian Brown <julian@codesourcery.com> + Maciej W. Rozycki <macro@codesourcery.com> + Tobias Burnus <tobias@codesourcery.com> + Thomas Schwinge <thomas@codesourcery.com> + + * omp-low.c (lower_omp_target): Support GOMP_MAP_NO_ALLOC. + * tree-pretty-print.c (dump_omp_clause): Likewise. + +2019-12-18 Eric Botcazou <ebotcazou@adacore.com> + + * ira.c (ira): Use simple LRA algorithm when not optimizing. + +2019-12-18 Thomas Schwinge <thomas@codesourcery.com> + + * gimplify.c (gimplify_omp_target_update): Elaborate 'exit data' + 'finalize' handling. + +2019-12-18 Tobias Burnus <tobias@codesourcery.com> + + PR middle-end/86416 + * Makefile.in (CFLAGS-lto-streamer-in.o): Pass target_noncanonical on. + * lto-streamer-in.c (lto_input_mode_table): Improve unsupported-mode + diagnostic. + +2019-12-18 Wilco Dijkstra <wdijkstr@arm.com> + + * config/aarch64/aarch64-cores.def: + ("cortex-a76ae"): Use neoversen1 tuning. + ("cortex-a77"): Likewise. + ("cortex-a65"): Use cortexa53 scheduler. + ("cortex-a65ae"): Likewise. + ("neoverse-e1"): Use cortexa73 tuning. + +2019-12-18 Martin Jambor <mjambor@suse.cz> + + PR ipa/92971 + * ipa-cp.c (cgraph_edge_brings_all_agg_vals_for_node): Fix + definition of values, release memory on exit. + +2019-12-17 Jan Hubicka <hubicka@ucw.cz> + Martin Jambor <mjambor@suse.cz> + + * ipa-param-manipulation.h (get_original_index): Declare. + * ipa-param-manipulation.c (ipa_param_adjustments::get_original_index): + New member function. + * ipa-prop.c (ipcp_get_parm_bits): New function. + * ipa-prop.h (ipcp_get_parm_bits): Declare. + * tree-ssa-ccp.c: Include cgraph.h, alloc-pool.h, symbol-summary.h, + ipa-utils.h and ipa-prop.h + (get_default_value): Use ipcp_get_parm_bits. + +2019-12-18 Jakub Jelinek <jakub@redhat.com> + + PR lto/92972 + * lto-wrapper.c (merge_and_complain): Use just "-fno-pie" instead of + big ? "-fno-pie" : "-fno-pie". Formatting fixes. Fix comment typo. + +2019-12-17 Martin Sebor <msebor@redhat.com> + + PR c++/61339 + * doc/invoke.texi (-Wmismatched-tags, -Wredundant-tags): Document + new C++ options. + +2019-12-17 Michael Meissner <meissner@linux.ibm.com> + + * config/rs6000/rs6000.c (num_insns_constant_gpr): Return 1 if the + constant can be loaded with PLI if -mcpu=future. + * config/rs6000/rs6000.md (add<mode>3): Add alternative to + generate PADDI for 34-bit constants if -mcpu=future. + (movdi_internal64): Add alternative to use PLI to load up 34-bit + constants if -mcpu=future. + (movsi_internal1): Add alternative to use PLI to load up 32-bit + constants if -mcpu=future. + * config/rs6000/predicates.md (add_operand): Allow eI constants. + +2019-12-17 Jakub Jelinek <jakub@redhat.com> + + PR target/92841 + * config/i386/i386.md (@stack_protect_set_1_<mode>, + @stack_protect_test_1_<mode>): Use output_asm_insn. + (*stack_protect_set_2_<mode>, *stack_protect_set_3): New define_insns + and corresponding define_peephole2s. + +2019-12-17 Jan Hubicka <hubicka@ucw.cz> + + * symtab.c (symtab_node::get_partitioning_class): Aliases of external + symbols are external. + +2019-12-17 Christophe Lyon <christophe.lyon@linaro.org> + + * config/arm/arm-protos.h (thumb1_gen_const_int): Add new prototype. + * config/arm/arm.c (arm_option_check_internal): Remove restriction + on MOVT for -mpure-code. + (thumb1_gen_const_int): New function. + (thumb1_legitimate_address_p): Support -mpure-code. + (thumb1_rtx_costs): Likewise. + (thumb1_size_rtx_costs): Likewise. + (arm_thumb1_mi_thunk): Likewise. + * config/arm/arm.h (CASE_VECTOR_PC_RELATIVE): Likewise. + * config/arm/thumb1.md (thumb1_movsi_symbol_ref): New. + (*thumb1_movhf): Support -mpure-code. + * doc/invoke.texi (-mpure-code): Remove restriction on MOVT. + +2019-12-17 Andrew Stubbs <ams@codesourcery.com> + + * tree-vect-loop.c (vect_create_epilog_for_reduction): Mention pr92772 + in the comments. + +2019-12-17 Andrew Stubbs <ams@codesourcery.com> + + * config/gcn/gcn-valu.md (extract_last_<mode>): New expander. + (fold_extract_last_<mode>): New expander. + +2019-12-17 Andrew Stubbs <ams@codesourcery.com> + + * config/gcn/gcn.h (CLZ_DEFINED_VALUE_AT_ZERO): Define. + (CTZ_DEFINED_VALUE_AT_ZERO): Define. + * config/gcn/gcn.md (s_mnemonic): Add clz and ctz. + (expander): Likewise. + (countzeros): New code iterator. + (<expander>si2): New insn pattern. + (<expander>di2): New insn pattern. + +2019-12-17 Jakub Jelinek <jakub@redhat.com> + + PR target/92962 + * common/config/i386/i386-common.c (processor_alias_table): Formatting + fixes. + * doc/invoke.texi (bdver3, bdver4, znver1): Add missing closing paren. + (znver2): Likewise. Add RDPID and WBNOINVD, remove spurious comma + before CLWB. + +2019-12-17 Hongyu Wang <hongyu.wang@intel.com> + + PR target/92651 + * config/i386/i386.h (TARGET_EXPAND_ABS): New macro. + * config/i386/x86-tune.def (X86_TUNE_EXPAND_ABS): New. + * config/i386/i386.md (abs<SWI48x>2): New define_expand. + +2019-12-17 H.J. Lu <hjl.tools@gmail.com> + + PR target/92807 + * config/i386/i386.c (ix86_lea_outperforms): Check !TARGET_BONNELL. + (ix86_avoid_lea_for_addr): When not optimizing for Bonnell, use add + for a = a + b and a = b + a. + +2019-12-16 Martin Sebor <msebor@redhat.com> + + PR middle-end/92952 + * builtins.c (compute_objsize): Adjust offset by the array low bound. + +2019-12-16 David Malcolm <dmalcolm@redhat.com> + + * pretty-print.c (pp_write_text_as_html_like_dot_to_stream): New + function. + * pretty-print.h (pp_write_text_as_html_like_dot_to_stream): New decl. + +2019-12-16 Segher Boessenkool <segher@kernel.crashing.org> + + * config/rs6000/rs6000.md (movsi_to_cr_one): Use CR0_REGNO instead of + hardcoding the (old, expired) register number. + (*mtcrfsi): Ditto. + +2019-12-16 Jozef Lawrynowicz <jozef.l@mittosystems.com> + + * config.gcc: s/msp430*-*-*/msp430-*-*. + Handle msp430-*-elfbare. + * config/msp430/msp430-devices.c (TARGET_SUBDIR): Define. + (_MSPMKSTR): Define. + (__MSPMKSTR): Define. + (rest_of_devices_path): Use TARGET_SUBDIR value in string. + * config/msp430/msp430.c (msp430_option_override): Error if + -fuse-cxa-atexit is used when it has been disabled at configure time. + * config/msp430/t-msp430: Define TARGET_SUBDIR when building + msp430-devices.o. + * doc/install.texi: Document msp430-*-elf and msp430-*-elfbare. + * doc/invoke.texi: Update documentation about which path devices.csv is + searched for. + +2019-12-16 Andreas Krebbel <krebbel@linux.ibm.com> + + PR target/92950 + * config/s390/vector.md ("mov<mode>" for V_8): Replace lh, lhy, + and lhrl with llc. + +2019-12-14 Martin Sebor <msebor@redhat.com> + + * doc/extend.texi (attribute access): Correct typos. + +2019-12-14 Jakub Jelinek <jakub@redhat.com> + + PR ipa/92357 + * ipa-fnsummary.c (ipa_fn_summary_write): Use + lto_symtab_encoder_iterator with lsei_start_function_in_partition and + lsei_next_function_in_partition instead of walking all cgraph nodes + in encoder. + + PR tree-optimization/92930 + * ipa-pure-const.c (special_builtin_state): Don't handle + BUILT_IN_APPLY. Formatting fixes. + (check_call): Formatting fixes. + +2019-12-14 Iain Sandoe <iain@sandoe.co.uk> + + * config/darwin.h (DARWIN_EXTRA_SPECS): Add new + bundle spec. (DARWIN_BUNDLE1_SPEC): New. + (STARTFILE_SPEC): Use darwin bundle spec. + * config/rs6000/darwin.h (DARWIN_BUNDLE1_SPEC): New. + (DARWIN_DYLIB1_SPEC): Delete duplicate. + +2019-12-13 Martin Sebor <msebor@redhat.com> + + PR middle-end/91582 + PR middle-end/92868 + * builtins.c (addr_decl_size): New function. + (gimple_call_alloc_size): Add arguments. + (compute_objsize): Add an argument. Set *PDECL even for allocated + objects. + Correct checking for negative wide_int. + Correct handling of negative outer offsets into unknown regions + or with unknown inner offsets. + Extend offsets to at most sizetype precision. + Only handle constant subobject sizes. + * builtins.h (gimple_call_alloc_size): Add arguments. + * tree.c (component_ref_size): Always return sizetype. + * tree-ssa-strlen.c (strinfo::alloc): New member. + (get_addr_stridx): Add argument. + (get_stridx): Use ptrdiff_t. Add argument. + (new_strinfo): Set new member. + (get_string_length): Handle alloca and VLA. + (dump_strlen_info): Dump more state. + (maybe_invalidate): Print more info. Decrease indentation. + (unshare_strinfo): Set new member. + (valid_builtin_call): Handle alloca and VLA. + (maybe_warn_overflow): Check and set no-warning bit. Improve + handling of offsets. Print allocated objects. + (handle_builtin_strlen): Handle strinfo records with null lengths. + (handle_builtin_strcpy): Add argument. Call maybe_warn_overflow. + (is_strlen_related_p): Handle dynamically allocated objects. + (get_range): Add argument. + (handle_builtin_malloc): Rename... + (handle_alloc): ...to this and handle all allocation functions. + (handle_builtin_memset): Call maybe_warn_overflow. + (count_nonzero_bytes): Handle more MEM_REF forms. + (strlen_check_and_optimize_call): Call handle_alloc_call. Pass + arguments to more callees. + (handle_integral_assign): Add argument. Create strinfo entries + for MEM_REF assignments. + (check_and_optimize_stmt): Handle more MEM_REF forms. + +2019-12-13 Iain Sandoe <iain@sandoe.co.uk> + + * config/rs6000/darwin.h (DARWIN_DYLIB1_SPEC): New. + 2019-12-13 Jan Hubicka <hubicka@ucw.cz> * lto-streamer-in.c (input_function): Add node parameter. diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index 3795991..cecccc3 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20191213 +20191219 diff --git a/gcc/Makefile.in b/gcc/Makefile.in index 6b857bd..657488d 100644 --- a/gcc/Makefile.in +++ b/gcc/Makefile.in @@ -2244,6 +2244,8 @@ version.o: $(REVISION) $(DATESTAMP) $(BASEVER) $(DEVPHASE) # lto-compress.o needs $(ZLIBINC) added to the include flags. CFLAGS-lto-compress.o += $(ZLIBINC) +CFLAGS-lto-streamer-in.o += -DTARGET_MACHINE=\"$(target_noncanonical)\" + bversion.h: s-bversion; @true s-bversion: BASE-VER echo "#define BUILDING_GCC_MAJOR `echo $(BASEVER_c) | sed -e 's/^\([0-9]*\).*$$/\1/'`" > bversion.h diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1fea353..bfc838f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,474 @@ +2019-12-18 Eric Botcazou <ebotcazou@adacore.com> + + * gcc-interface/trans.c (Pragma_to_gnu) <Pragma_Warnings>: Push a + diagnostics state for pragma Warnings (Off) before turning off all + the warnings and only pop it for pragma Warnings (On). + +2019-12-18 Justin Squirek <squirek@adacore.com> + + * sem_ch6.adb (Analyze_Function_Return): Modify handling of + extended return statements to check accessibility of access + discriminants. + (Check_Aggregate_Accessibility): Removed. + (Check_Return_Obj_Accessibility): Added to centralize checking + of return aggregates and subtype indications in the case of an + extended return statement. + +2019-12-18 Arnaud Charlet <charlet@adacore.com> + + * libgnat/s-regpat.adb (Parse_Literal, Parse_Piece): Ensure + Expr_Flags is always fully initialized. + +2019-12-18 Arnaud Charlet <charlet@adacore.com> + + * libgnat/s-atopar.ads, libgnat/s-atopex.ads (Atomic_Type): Can + now be marked Atomic. This requires marking the unit Ada 202x. + +2019-12-18 Arnaud Charlet <charlet@adacore.com> + + * libgnat/a-nbnbin.ads, libgnat/a-nbnbin.adb, + libgnat/a-nbnbre.ads, libgnat/a-nbnbre.adb: Replace + Optional_Big_* types by a simple check and exception raise in + Get_Bignum. + (Set_Bignum): Arg should be 'out' and not 'in out'. + (Invalid_Big_Integer, No_Big_Real): Removed. + (Is_Valid): Now convention Intrinsic. + +2019-12-18 Piotr Trojanek <trojanek@adacore.com> + + * doc/gnat_rm/implementation_defined_pragmas.rst, + doc/gnat_rm/obsolescent_features.rst, + doc/gnat_ugn/gnat_and_program_execution.rst, exp_attr.adb, + exp_ch9.adb, init.c, libgnat/s-valrea.adb, par-ch6.adb, + sem_attr.adb, sem_ch4.adb, sem_util.ads: Fix trivial typos. + * gnat_rm.texi, gnat_ugn.texi: Regenerate. + +2019-12-18 Gary Dismukes <dismukes@adacore.com> + + * sem_res.adb (Resolve_Type_Conversion): Add handling for access + types with designated operand and target types that are + referenced in places that have a limited view of an interface + type by retrieving the nonlimited view when it exists. Add ??? + comments related to missing limited_with_clause handling for + Target (in the non-access case). + +2019-12-18 Ed Schonberg <schonberg@adacore.com> + + * par-ch12.adb (P_Formal_Derived_Type_Definition): In Ada_2020 + the keyword WITH can indicate the start of aspect specifications + and not a private type extension. + * sem_ch12.adb (Analyze_Formal_Type): Indicate that it is a + first subtype. + (Instantiate_Type): New procedure + Check_Shared_Variable_Control_Aspects to verify matching rules + between formal and actual types. Note that an array type with + aspect Atomic_Components is considered compatible with an array + type whose component type is Atomic, even though the array types + do not carry the same aspect. + * sem_ch13.adb (Analyze_One_Aspect): Allow shared variable + control aspects to appear on formal types. + (Rep_Item_Too_Early): Exclude aspects on formal types. + * sem_prag.adb (Mark_Type): Handle properly pragmas that come + from aspects on formal types. + (Analyze_Pragma, case Atomic_Components): Handle formal types. + +2019-12-18 Eric Botcazou <ebotcazou@adacore.com> + + * cstand.adb (Create_Standard): Remove duplicate line and + adjust. + +2019-12-18 Javier Miranda <miranda@adacore.com> + + * debug.adb: Document -gnatd_K as a reserved switch for the + detection of known problem issues of previous releases. + +2019-12-18 Ghjuvan Lacambre <lacambre@adacore.com> + + * par-ch13.adb: Check if declarations allow aspect + specifications. + +2019-12-18 Piotr Trojanek <trojanek@adacore.com> + + * einfo.ads (Is_Ghost_Entity): Fix typo in comment. + +2019-12-18 Eric Botcazou <ebotcazou@adacore.com> + + * layout.adb (Layout_Type): In the case of composite types, do + not copy the Esize onto the RM_Size if the latter is not set. + * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Record_Type>: + Also cap the alignment if an Object_Size clause has been + specified. Pass VAR_DECL in the call to validate_size for the + Esize of a type. + (validate_size): Be prepared to give an error on an Object_Size + clause. + +2019-12-18 Eric Botcazou <ebotcazou@adacore.com> + + * einfo.ads (Handling of Type'Size Value): Add references to the + introduction of Object_Size in Ada 2020. + * sem_eval.adb (Subtypes_Statically_Match): Likewise. + +2019-12-18 Bob Duff <duff@adacore.com> + + * sem_ch3.adb (Derive_Subprogram): Do not set the + Requires_Overriding flag in the above-mentioned case. + +2019-12-18 Bob Duff <duff@adacore.com> + + * sem_ch8.adb (Note_Redundant_Use): It was already checking for + a use clause in the visible part of the child. Add an additional + check for a use clause in the context clause of the child. + +2019-12-16 Bob Duff <duff@adacore.com> + + * errout.adb (Handle_Serious_Error): Disable the above-mentioned + warnings. + +2019-12-16 Bob Duff <duff@adacore.com> + + * errout.adb, errout.ads: Improve comments. + +2019-12-16 Bob Duff <duff@adacore.com> + + * sem_util.ads: Minor comment fix. + +2019-12-16 Bob Duff <duff@adacore.com> + + * errout.ads, errout.adb (Is_Size_Too_Small_Message): Check for + "size for" instead of "size for& too small, minimum allowed is + ^". + +2019-12-16 Eric Botcazou <ebotcazou@adacore.com> + + * sem_ch13.adb (Analyze_Attribute_Definition_Clause): Set only + the RM_Size on the subtype built for a Component_Size clause + when the component type is a biased integer type. + +2019-12-16 Arnaud Charlet <charlet@adacore.com> + + * socket.c: Shutdown warning. + +2019-12-16 Arnaud Charlet <charlet@adacore.com> + + * libgnarl/s-tataat.ads (Deallocator): Mark as Favor_Top_Level. + +2019-12-16 Arnaud Charlet <charlet@adacore.com> + + * libgnat/s-aotase.adb, libgnat/s-aotase.ads, + libgnat/s-atoope.ads, libgnat/s-atopar.adb, + libgnat/s-atopar.ads, libgnat/s-atopex.adb, + libgnat/s-atopex.ads: New files. + * libgnat/s-atopri.ads: Add new intrinsics. + * Makefile.rtl: Add new runtime files. + * impunit.adb: Add new units to Ada 2020 list. + +2019-12-16 Eric Botcazou <ebotcazou@adacore.com> + + * freeze.adb (Check_Strict_Alignment): Remove new check on + Has_Aliased_Components for array types. + +2019-12-16 Ed Schonberg <schonberg@adacore.com> + + * sem_ch4.adb (Try_Container_Indexing): In the case of a derived + container type, use the base type to look for candidate indexing + operations, because the object may be a constrained subtype or + itype with no explicit declaration. Candidate indexing + operations are found in the same scope and list of declarations + as the declaration of the base type. + +2019-12-16 Ed Schonberg <schonberg@adacore.com> + + * scng.adb (Scan): In Ada2020, a left-bracket indicates the + start of an homogenous aggregate. + * par-ch4.adb (P_Reduction_Attribute_Reference): New procedure. + (P_Aggregate): Recognize Ada2020 bracket-delimited aggregates. + (P_Primary): Ditto. + * par-util.adb (Comma_Present): Return false on a right bracket + in Ada2020, indicating the end of an aggregate. + * snames.ads-tmpl: Introduce Name_Reduce and Attribute Reduce. + * sinfo.ads, sinfo.adb (Is_Homogeneous_Aggregate): New flag on + aggregates, to designate an Ada2020 array or container aggregate + that is bracket-delimited in the source. + * sem_attr.adb (Analyze_Attribute): For attribute Reduce, verify + that two arguments are present, and verify that the prefix is a + stream or an object that is iterable (array or contrainer). + (Resolve_Attribute): For attribute Reduce, resolve initial value + with the type of the context. Type-checking of element type of + prefix is performed after expansion. + * exp_attr.adb (Expand_N_Attribute_Reference): For attribute + Reduce, expand into a loop: a) If prefix is an aggregate with a + single iterated component association, use its iterator + specification to construct a loop, b) If prefix is a name, build + a loop using an element iterator loop. + * scans.ads: Add brackets tokens. + +2019-12-16 Eric Botcazou <ebotcazou@adacore.com> + + * gcc-interface/decl.c (gnat_to_gnu_entity): Adjust calls to + validate_size. + (gnat_to_gnu_component_type): Likewise. + (gnat_to_gnu_field): Likewise and pass string for error messages. + (components_need_strict_alignment): Remove test on Is_Aliased and + add test for the independence of the component. + (validate_size): Add S1 and S2 string parameters and use them to + give better error messages for fields. Tweak a couple of messages. + * einfo.ads (Has_Independent_Components): Document more cases. + (Is_Independent): Likewise. + (Strict_Alignment): Document new semantics. + * exp_ch9.adb (Install_Private_Data_Declarations): Also set the + Is_Independent flag along with Is_Aliased on the renaming + entity. + * freeze.adb (Size_Known): Remove always-false test and add test + for the strict-alignment on the record type. Remove redundant + tests and add test for the strict-alignment on the component + type. + (Check_Strict_Alignment): Set the flag if the type is by-ref and + remove now redundant conditions. Set the flag on an array type + if it has aliased components. In the record type case, do not + set type for C_Pass_By_Copy convention. + (Freeze_Array_Type): Move code checking for conflicts between + representation aspects and clauses to before specific handling + of packed array types. Give a warnind instead of an error for a + conflict with pragma Pack. Do not test Has_Pragma_Pack for the + specific handling of packed array types. + (Freeze_Record_Type): Move error checking of representation + clause to... + (Freeze_Entity): ...here after Check_Strict_Alignment is called. + * sem_aggr.adb (Array_Aggr_Subtype): Also set the Is_Independent + flag along with Is_Aliased on the Itype. + * sem_ch13.adb (Check_Record_Representation_Clause): Do not set + the RM size for a strict-alignment type. + * sem_ch3.adb (Add_Interface_Tag_Components): Also set the + Is_Independent flag along with Is_Aliased on the tag. + (Add_Interface_Tag_Components): Likewise on the offset. + (Analyze_Component_Declaration): Likewise on the component. + (Analyze_Object_Declaration): Likewise on the object. + (Constrain_Array): Likewise on the array. + (Record_Type_Declaration: Likewise on the tag. + (Array_Type_Declaration): Also set the + Has_Independent_Components flag along with + Has_Aliased_Components on the array. + (Copy_Array_Base_Type_Attributes): Copy + Has_Independent_Components. + (Copy_Array_Subtype_Attributes): Copy Is_Atomic, Is_Independent + and Is_Volatile_Full_Access. + (Analyze_Iterator_Specification): Set Is_Independent on the loop + variable according to Independent_Components on the array. + * sem_ch5.adb: Likewise. + * sem_ch6.adb (Process_Formals): Also set the Is_Independent + flag along with Is_Aliased on the formal. + +2019-12-16 Eric Botcazou <ebotcazou@adacore.com> + + * sem_ch8.adb (Analyze_Object_Renaming): Set Atomic, Independent + and Volatile_Full_Access aspects on the entity of the renaming + the same way as the Volatile aspect is set. + * sem_util.ads (Is_Atomic_Object_Entity): Move declaration to... + (Is_Independent_Object): New function. + (Is_Volatile_Full_Access_Object): Likewise. + * sem_util.adb (Is_Atomic_Object_Entity): ...here. + (Prefix_Has_Atomic_Components): Minor tweak. + (Is_Atomic_Object): Test Is_Atomic on the Etype uniformly. + (Is_Atomic_Or_VFA_Object): Call Is_Volatile_Full_Access_Object. + (Is_Independent_Object): New predicate. + (Is_Subcomponent_Of_Atomic_Object): Remove redundant test. + (Is_Volatile_Full_Access_Object): New predicate. + (Is_Volatile_Prefix): Rename into... + (Prefix_Has_Volatile_Components): ... and call + Is_Volatile_Object. + (Object_Has_Volatile_Components): Delete. + (Is_Volatile_Object): Simplify. + * gcc-interface/trans.c (node_is_volatile_full_access): Adjust + comment. + +2019-12-16 Bob Duff <duff@adacore.com> + + * par.adb: Add Scopes function to do range checking on the scope + stack. Call Scopes all over the parser. Add + SIS_Aspect_Import_Seen flag. + * par-ch6.adb (P_Subprogram): Initialize SIS_Aspect_Import_Seen + to False at the start, and check it at the end. + * par-ch13.adb (Get_Aspect_Specifications): Set + SIS_Aspect_Import_Seen to True when appropriate. + * par-ch10.adb, par-ch12.adb, par-ch2.adb, par-ch3.adb, + par-ch5.adb, par-ch7.adb, par-ch9.adb, par-endh.adb, + par-util.adb: Call Scopes. + +2019-12-16 Eric Botcazou <ebotcazou@adacore.com> + + * sem_prag.adb (Atomic_Components): Remove local variable and + fix consistency issues. Call Component_Type on the Etype of E. + (Independent_Components): Remove local variable. + * sem_util.adb (Is_Subcomponent_Of_Atomic_Object): Properly deal + with prefixes that are access values. + * gcc-interface/trans.c (atomic_acces_t): New enumeral type. + (node_is_atomic) <N_Indexed_Component>: Test the prefix. + (node_has_volatile_full_access): Rename into... + (node_is_volatile_full_access): ...this. + (node_is_component): New predicare. + (gnat_strip_type_conversion): Delete. + (outer_atomic_access_required_p): Likewise. + (atomic_access_required_p): Rename into... + (get_atomic_access): ...this. Implement the 3 different semantics + of Atomic and Volatile_Full_Access. + (simple_atomic_access_required_p): New predicate. + (Call_to_gnu): Remove outer_atomic_access parameter and change the + type of atomic_access parameter to atomic_acces_t. Replace call to + atomic_access_required_p with simple_atomic_access_required_p for + the in direction and call get_atomic_access for the out direction + instead of [outer_]atomic_access_required_p. + (lhs_or_actual_p): Constify local variables. + (present_in_lhs_or_actual_p): Likewise. + (gnat_to_gnu) <N_Identifier>: Replace call to atomic_access_required_p + with simple_atomic_access_required_p. + <N_Explicit_Dereference>: Likewise. + <N_Indexed_Component>: Likewise. + <N_Selected_Component>: Likewise. + <N_Assignment_Statement>: Call get_atomic_access for the name instead + of [outer_]atomic_access_required_p. Adjust call to Call_to_gnu. + <N_Function_Call>: Adjust call to Call_to_gnu. + (get_controlling_type): Fix typo in comment. + +2019-12-16 Eric Botcazou <ebotcazou@adacore.com> + + * fe.h (Ada_Version_Type): New typedef. + (Ada_Version): Declare. + * opt.ads (Ada_Version_Type): Add Convention C and WARNING line. + (Ada_Version): Add WARNING line. + (Exception_Mechanism_Type): Likewise. + +2019-12-16 Gary Dismukes <dismukes@adacore.com> + + * checks.adb, sem_util.adb: Minor reformatting and U.S. spelling + adjustment. + +2019-12-16 Bob Duff <duff@adacore.com> + + * sem_ch10.adb (Analyze_Subunit): Give an error if the subunit + is not a proper body. This hides the confusing "duplicate body" + message that was previously given. + +2019-12-16 Eric Botcazou <ebotcazou@adacore.com> + + * exp_ch8.adb (Expand_N_Object_Renaming_Declaration): Document + third special case of renamings requiring special handling. + (Evaluation_Required): Return true for an atomic or VFA prefix. + +2019-12-16 Ed Schonberg <schonberg@adacore.com> + + * checks.adb (Apply_Float_Conversion_Check): Use node of type + conversion and not its parent, when inserting the declaration + for the temporary that hold the result of the conversion. + Previously the declaration was inserted above the parent of the + conversion, apparently as a small optimization for the + subsequent traversal in Insert_Actions. Unfortunately a similar + optimization takes place in Insert_Actions, assuming that the + insertion point must be above the expression that creates the + actions to insert. This is not correct in the presence of + conditional expressions (i.e. since Ada2012), where the + insertion must be in the list of actions attached to the current + alternative. + +2019-12-16 Bob Duff <duff@adacore.com> + + * sem_attr.adb (Analyze_Attribute): Use Known_RM_Size. But we + still need Size_Known_At_Compile_Time, because when the size + really is known, sometimes only one or the other of these is + True. + +2019-12-16 Eric Botcazou <ebotcazou@adacore.com> + + * sem_util.adb (Is_Atomic_Or_VFA_Object): Also return true for + components whose type is Volatile_Full_Access or which are + subject to the aspect/pragma individually. + * sem_util.ads (Is_Atomic_Object_Entity): Small comment fix. + +2019-12-16 Yannick Moy <moy@adacore.com> + + * exp_ch6.adb: Fix comment. + * sem_res.adb (Resolve_Call): Do not check No_Recursion + restriction or indirectly No_Secondary_Stack restriction, when + inside an ignored ghost subprogram. + +2019-12-16 Arnaud Charlet <charlet@adacore.com> + + * impunit.adb: Add a-nbnbin, a-nbnbre, a-nubinu to Ada 2020 + units. + * Makefile.rtl: Enable new file. + * libgnat/a-nbnbin.adb, libgnat/a-nbnbin.ads, + libgnat/a-nbnbre.adb, libgnat/a-nbnbre.ads, + libgnat/a-nubinu.ads: New files. Provide default standalone + implementation of Ada.Numerics.Big_Numbers.Big_* based on + System.Generic_Bignum. + * libgnat/a-nbnbin__gmp.adb: Alternate implementation of + Ada.Numerics.Big_Numbers.Big_Integers based on GMP. Not enabled + for now. + * libgnat/s-bignum.ads, libgnat/s-bignum.adb: Now a simple + wrapper on top of s-genbig.ads. + * libgnat/s-genbig.ads, libgnat/s-genbig.adb: New files, making + s-bignum generic for reuse in Ada.Numerics.Big_Numbers. + +2019-12-16 Bob Duff <duff@adacore.com> + + * doc/gnat_ugn/building_executable_programs_with_gnat.rst: + Correct documentation of -gnatw_C switch + * gnat_ugn.texi: Regenerate. + +2019-12-16 Joel Brobecker <brobecker@adacore.com> + + * doc/gnat_ugn/building_executable_programs_with_gnat.rst + (_Switches_for_gnatbind): Reword the section explaining the + impact of -minimal on debugging. + * gnat_ugn.texi: Regenerate. + +2019-12-16 Gary Dismukes <dismukes@adacore.com> + + * libgnat/g-exptty.adb, libgnat/g-exptty.ads: Typo fixes and + minor reformatting. + +2019-12-16 Eric Botcazou <ebotcazou@adacore.com> + + * exp_ch6.adb (Requires_Atomic_Or_Volatile_Copy): New predicate. + (Expand_Actuals): Use it to decide whether to add call by copy + code as per the RM C.6(19) clause. + * fe.h (Is_Atomic_Object): Remove. + (Is_Volatile_Object): Likewise. + * sem_util.ads (Is_Atomic_Object): Remove WARNING note. + (Is_Volatile_Object): Likewise. + * gcc-interface/trans.c (atomic_or_volatile_copy_required_p): Delete. + (Call_to_gnu): Do not implement the RM C.6(19) clause. + +2019-12-16 Ghjuvan Lacambre <lacambre@adacore.com> + + * sem_ch12.adb (Validate_Access_Subprogram_Instance): Add + Can_Never_Be_Null checks. + +2019-12-16 Eric Botcazou <ebotcazou@adacore.com> + + * doc/gnat_rm/implementation_defined_pragmas.rst (VFA): Document + extension of the no-aliasing rule to any subcomponent. + * freeze.adb (Freeze_Object_Declaration): Small comment tweak. + (Freeze_Record_Type): Do not deal with delayed aspect + specifications for components here but... + (Freeze_Entity): ...here instead. + * sem_ch12.adb (Instantiate_Object): Improve wording of errors + given for legality rules in C.6(12) and implement the new rule + in C.6(13). + * sem_res.adb (Resolve_Actuals): Likewise. + * sem_prag.adb (Check_Atomic_VFA): New procedure implementing + the new legality rules in C.6(13). + (Process_Atomic_Independent_Shared_Volatile): Call + Check_Atomic_VFA to check the legality rules. Factor out code + marking types into... + (Mark_Type): ...this new procedure. + (Check_VFA_Conflicts): Do not check the legality rules here. + (Pragma_Atomic_Components): Call Check_Atomic_VFA on component + type. + * sem_util.ads (Is_Subcomponent_Of_Atomic_Object): Declare. + * sem_util.adb (Is_Subcomponent_Of_Atomic_Object): New + predicate. + * gnat_rm.texi: Regenerate. + 2019-12-13 Gary Dismukes <dismukes@adacore.com> * doc/gnat_rm/implementation_defined_pragmas.rst: Minor diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index c286701..55ff9b0 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -205,6 +205,8 @@ GNATRTL_NONTASKING_OBJS= \ a-lliwti$(objext) \ a-llizti$(objext) \ a-locale$(objext) \ + a-nbnbin$(objext) \ + a-nbnbre$(objext) \ a-ncelfu$(objext) \ a-ngcefu$(objext) \ a-ngcoar$(objext) \ @@ -224,6 +226,7 @@ GNATRTL_NONTASKING_OBJS= \ a-nscefu$(objext) \ a-nscoty$(objext) \ a-nselfu$(objext) \ + a-nubinu$(objext) \ a-nucoar$(objext) \ a-nucoty$(objext) \ a-nudira$(objext) \ @@ -495,10 +498,14 @@ GNATRTL_NONTASKING_OBJS= \ machcode$(objext) \ s-addima$(objext) \ s-addope$(objext) \ + s-aotase$(objext) \ s-arit64$(objext) \ s-assert$(objext) \ s-atacco$(objext) \ s-atocou$(objext) \ + s-atoope$(objext) \ + s-atopar$(objext) \ + s-atopex$(objext) \ s-atopri$(objext) \ s-auxdec$(objext) \ s-bignum$(objext) \ @@ -570,6 +577,7 @@ GNATRTL_NONTASKING_OBJS= \ s-flocon$(objext) \ s-fore$(objext) \ s-gearop$(objext) \ + s-genbig$(objext) \ s-geveop$(objext) \ s-gloloc$(objext) \ s-htable$(objext) \ diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 9ca1cf0..51ef6c0 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -2067,7 +2067,16 @@ package body Checks is Apply_Float_Conversion_Check (Ck_Node, Target_Base); Set_Etype (Temp, Target_Base); - Insert_Action (Parent (Par), + -- Note: Previously the declaration was inserted above the parent + -- of the conversion, apparently as a small optimization for the + -- subequent traversal in Insert_Actions. Unfortunately a similar + -- optimization takes place in Insert_Actions, assuming that the + -- insertion point must be above the expression that creates + -- actions. This is not correct in the presence of conditional + -- expressions, where the insertion must be in the list of actions + -- attached to the current alternative. + + Insert_Action (Par, Make_Object_Declaration (Loc, Defining_Identifier => Temp, Object_Definition => New_Occurrence_Of (Target_Typ, Loc), diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb index 86ec8f9..5f3d69f 100644 --- a/gcc/ada/cstand.adb +++ b/gcc/ada/cstand.adb @@ -717,6 +717,7 @@ package body CStand is Build_Signed_Integer_Type (Standard_Short_Short_Integer, Standard_Short_Short_Integer_Size); + Set_Is_Implementation_Defined (Standard_Short_Short_Integer); Build_Signed_Integer_Type (Standard_Short_Integer, Standard_Short_Integer_Size); @@ -734,7 +735,6 @@ package body CStand is Create_Unconstrained_Base_Type (Standard_Short_Short_Integer, E_Signed_Integer_Subtype); - Set_Is_Implementation_Defined (Standard_Short_Short_Integer); Create_Unconstrained_Base_Type (Standard_Short_Integer, E_Signed_Integer_Subtype); @@ -747,7 +747,6 @@ package body CStand is Create_Unconstrained_Base_Type (Standard_Long_Long_Integer, E_Signed_Integer_Subtype); - Set_Is_Implementation_Defined (Standard_Short_Short_Integer); Create_Float_Types; diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 6a5d0ea..032d88a 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -182,7 +182,7 @@ package body Debug is -- d_H -- d_I -- d_J - -- d_K + -- d_K (Reserved) Enable reporting a warning on known-problem issues -- d_L Output trace information on elaboration checking -- d_M -- d_N @@ -1007,6 +1007,9 @@ package body Debug is -- an external target, offering additional information to GNATBIND for -- purposes of error diagnostics. + -- d_K (Reserved) Enable reporting a warning on known-problem issues of + -- previous releases. No action performed in the wavefront. + -- d_L Output trace information on elaboration checking. This debug switch -- causes output to be generated showing each call or instantiation as -- it is checked, and the progress of the recursive trace through diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst index 6d0bdd8..c3d6f90 100644 --- a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst +++ b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst @@ -1344,7 +1344,7 @@ are equivalent to The precondition ensures that one and only one of the case guards is satisfied on entry to the subprogram. The postcondition ensures that for the case guard that was True on entry, -the corrresponding consequence is True on exit. Other consequence expressions +the corresponding consequence is True on exit. Other consequence expressions are not evaluated. A precondition ``P`` and postcondition ``Q`` can also be @@ -7443,7 +7443,7 @@ It is not permissible to specify ``Atomic`` and ``Volatile_Full_Access`` for the same type or object. It is not permissible to specify ``Volatile_Full_Access`` for a composite -(record or array) type or object that has at least one ``Aliased`` component. +(record or array) type or object that has an ``Aliased`` subcomponent. .. _Pragma-Volatile_Function: diff --git a/gcc/ada/doc/gnat_rm/obsolescent_features.rst b/gcc/ada/doc/gnat_rm/obsolescent_features.rst index 2082a2a..3ba5021 100644 --- a/gcc/ada/doc/gnat_rm/obsolescent_features.rst +++ b/gcc/ada/doc/gnat_rm/obsolescent_features.rst @@ -49,7 +49,7 @@ pragma Task_Info The functionality provided by pragma ``Task_Info`` is now part of the Ada language. The ``CPU`` aspect and the package ``System.Multiprocessors`` offer a less system-dependent way to specify -task affinity or to query the number of processsors. +task affinity or to query the number of processors. Syntax diff --git a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst index 457646a..7f5dabe 100644 --- a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst +++ b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst @@ -3000,7 +3000,7 @@ of the pragma in the :title:`GNAT_Reference_manual`). .. index:: -gnatw_C (gcc) :switch:`-gnatw_C` - *Suppress warnings on missing component clauses.* + *Suppress warnings on unknown condition in Compile_Time_Warning.* This switch supresses warnings on a pragma Compile_Time_Warning or Compile_Time_Error whose condition has a value that is not @@ -6540,7 +6540,10 @@ be presented in subsequent sections. longer generated. **Warning:** this option comes with the following limitations: - * Debugging will not work; + * Starting the program's execution in the debugger will cause it to + stop at the start of the ``main`` function instead of the main subprogram. + This can be worked around by manually inserting a breakpoint on that + subprogram and resuming the program's execution until reaching that breakpoint. * Programs using GNAT.Compiler_Version will not link. .. index:: -n (gnatbind) diff --git a/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst b/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst index 0fb9bdd..ba2c9b6 100644 --- a/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst +++ b/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst @@ -2964,7 +2964,7 @@ integer arithmetic package. The compiler will make calls to this package, though only in cases where it cannot be sure that ``Long_Long_Integer`` is sufficient to guard against intermediate overflows. This package does not use dynamic -alllocation, but it does use the secondary stack, so an +allocation, but it does use the secondary stack, so an appropriate secondary stack package must be present (this is always true for standard full Ada, but may require specific steps for restricted run times such as ZFP). diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 0aa7e00..a55d5a7 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -132,19 +132,23 @@ package Einfo is -- default size of objects, creates chaos, and major incompatibilities in -- existing code. +-- The Ada 2020 RM acknowledges it and adopts GNAT's Object_Size attribute +-- for determining the default size of objects, but stops short of applying +-- it universally like GNAT. Indeed the notable exceptions are nonaliased +-- stand-alone objects, which are not covered by Object_Size in Ada 2020. + -- We proceed as follows, for discrete and fixed-point subtypes, we have -- two separate sizes for each subtype: -- The Object_Size, which is used for determining the default size of -- objects and components. This size value can be referred to using the -- Object_Size attribute. The phrase "is used" here means that it is --- the basis of the determination of the size. The backend is free to +-- the basis of the determination of the size. The back end is free to -- pad this up if necessary for efficiency, e.g. an 8-bit stand-alone -- character might be stored in 32 bits on a machine with no efficient -- byte access instructions such as the Alpha. --- The default rules for the value of Object_Size for fixed-point and --- discrete types are as follows: +-- The default rules for the value of Object_Size are as follows: -- The Object_Size for base subtypes reflect the natural hardware -- size in bits (see Ttypes and Cstand for integer types). For @@ -158,9 +162,11 @@ package Einfo is -- base type, and the Object_Size of a derived first subtype is copied -- from the parent first subtype. --- The Value_Size which is the number of bits required to store a value +-- The Ada 2020 RM defined attribute Object_Size uses this implementation. + +-- The Value_Size, which is the number of bits required to store a value -- of the type. This size can be referred to using the Value_Size --- attribute. This value is used to determine how tightly to pack +-- attribute. This value is used for determining how tightly to pack -- records or arrays with components of this type, and also affects -- the semantics of unchecked conversion (unchecked conversions where -- the Value_Size values differ generate a warning, and are potentially @@ -182,7 +188,7 @@ package Einfo is -- dynamic bounds, it is assumed that the value can range down or up -- to the corresponding bound of the ancestor. --- The RM defined attribute Size corresponds to the Value_Size attribute. +-- The Ada 95 RM defined attribute Size is identified with Value_Size. -- The Size attribute may be defined for a first-named subtype. This sets -- the Value_Size of the first-named subtype to the given value, and the @@ -194,14 +200,15 @@ package Einfo is -- subtypes. The Value_Size of any other static subtypes is not affected. -- Value_Size and Object_Size may be explicitly set for any subtype using --- an attribute definition clause. Note that the use of these attributes --- can cause the RM 13.1(14) rule to be violated. If two access types --- reference aliased objects whose subtypes have differing Object_Size --- values as a result of explicit attribute definition clauses, then it --- is erroneous to convert from one access subtype to the other. - --- At the implementation level, Esize stores the Object_Size and the --- RM_Size field stores the Value_Size (and hence the value of the +-- an attribute definition clause. Note that the use of such a clause can +-- cause the RM 13.1(14) rule to be violated, in Ada 95 and 2020 for the +-- Value_Size attribute, but only in Ada 95 for the Object_Size attribute. +-- If access types reference aliased objects whose subtypes have differing +-- Object_Size values as a result of explicit attribute definition clauses, +-- then it is erroneous to convert from one access subtype to the other. + +-- At the implementation level, the Esize field stores the Object_Size +-- and the RM_Size field stores the Value_Size (hence the value of the -- Size attribute, which, as noted above, is equivalent to Value_Size). -- To get a feel for the difference, consider the following examples (note @@ -1725,7 +1732,8 @@ package Einfo is -- has independent components is to see if either the object or its base -- type has this flag set. Note that in the case of a type, the pragma -- will be chained to the rep item chain of the first subtype in the --- usual manner. +-- usual manner. Also set if a pragma Has_Atomic_Components or pragma +-- Has_Aliased_Components applies to the type or object. -- Has_Inheritable_Invariants (Flag248) [base type only] -- Defined in all type entities. Set on private types and interface types @@ -2659,7 +2667,7 @@ package Einfo is -- Applies to all entities. Yields True for abstract states, [generic] -- packages, [generic] subprograms, components, discriminants, formal -- parameters, objects, package bodies, subprogram bodies, and [sub]types --- subject to pragma Ghost or those that inherit the Ghost propery from +-- subject to pragma Ghost or those that inherit the Ghost property from -- an enclosing construct. -- Is_Hidden (Flag57) @@ -2720,13 +2728,14 @@ package Einfo is -- Applies to all entities, true for incomplete types and subtypes -- Is_Independent (Flag268) --- Defined in all type entities, and also in constants, components and --- variables. Set if a valid pragma or aspect Independent applies to the --- entity, or if a valid pragma or aspect Independent_Components applies --- to the enclosing record type for a component. Also set if a pragma --- Shared or pragma Atomic applies to the entity. In the case of private --- and incomplete types, this flag is set in both the partial view and --- the full view. +-- Defined in all types and objects. Set if a valid pragma or aspect +-- Independent applies to the entity, or for a component if a valid +-- pragma or aspect Independent_Components applies to the enclosing +-- record type. Also set if a pragma Shared or pragma Atomic applies to +-- the entity, or if the declaration of the entity carries the Aliased +-- keyword. For Ada 2012, also applies to formal parameters. In the +-- case of private and incomplete types, this flag is set in both the +-- partial view and the full view. -- Is_Initial_Condition_Procedure (Flag302) -- Defined in functions and procedures. Set for a generated procedure @@ -4448,9 +4457,10 @@ package Einfo is -- the value of attribute 'Old's prefix. -- Strict_Alignment (Flag145) [implementation base type only] --- Defined in all type entities. Indicates that some containing part --- is either aliased or tagged. This prohibits packing the object --- tighter than its natural size and alignment. +-- Defined in all type entities. Indicates that the type is by-reference +-- or contains an aliased part. This forbids packing a component of this +-- type tighter than the alignment and size of the type, as specified by +-- RM 13.2(7) modified by AI12-001 as a Binding Interpretation. -- String_Literal_Length (Uint16) -- Defined in string literal subtypes (which are created to correspond diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 42c7cb9..a08c6df 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -861,6 +861,14 @@ package body Errout is end if; end; end if; + + -- Disable warnings on unused use clauses and the like. Otherwise, an + -- error might hide a reference to an entity in a used package, so + -- after fixing the error, the use clause no longer looks like it was + -- unused. + + Check_Unreferenced := False; + Check_Unreferenced_Formals := False; end Handle_Serious_Error; -- Start of processing for Error_Msg_Internal @@ -1710,6 +1718,20 @@ package body Errout is Specific_Warnings.Init; end Initialize; + ------------------------------- + -- Is_Size_Too_Small_Message -- + ------------------------------- + + function Is_Size_Too_Small_Message (S : String) return Boolean is + Size_For : constant String := "size for"; + pragma Assert (Size_Too_Small_Message (1 .. Size_For'Last) = Size_For); + -- Assert that Size_Too_Small_Message starts with Size_For + begin + return S'Length >= Size_For'Length + and then S (S'First .. S'First + Size_For'Length - 1) = Size_For; + -- True if S starts with Size_For + end Is_Size_Too_Small_Message; + ----------------- -- No_Warnings -- ----------------- @@ -3259,7 +3281,7 @@ package body Errout is -- Processing for "Size too small" messages - elsif Msg = Size_Too_Small_Message then + elsif Is_Size_Too_Small_Message (Msg) then -- Suppress "size too small" errors in CodePeer mode, since code may -- be analyzed in a different configuration than the one used for diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index dfa6b86..4cfb806 100644 --- a/gcc/ada/errout.ads +++ b/gcc/ada/errout.ads @@ -954,10 +954,12 @@ package Errout is -- WARNING: There is a matching C declaration of this subprogram in fe.h + function Is_Size_Too_Small_Message (S : String) return Boolean; Size_Too_Small_Message : constant String := "size for& too small, minimum allowed is ^"; - -- This message is explicitly tested in Special_Msg_Delete in the package - -- body, which is somewhat questionable, but at least by using a constant - -- we are obeying the DRY principle. + -- This message is printed in Freeze and Sem_Ch13. We also test for it in + -- the body of this package (see Special_Msg_Delete) ???which is somewhat + -- questionable. The Is_Size_Too_Small_Message function tests for it by + -- testing a prefix. The function and constant should be kept in synch. end Errout; diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 8c5981a..4057a36 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -5246,7 +5246,7 @@ package body Exp_Attr is Rep_To_Pos_Flag (Ptyp, Loc)))))); else - -- Add Boolean parameter True, to request program errror if + -- Add Boolean parameter True, to request program error if -- we have a bad representation on our hands. If checks are -- suppressed, then add False instead @@ -5463,6 +5463,97 @@ package body Exp_Attr is Apply_Universal_Integer_Attribute_Checks (N); end if; + ------------ + -- Reduce -- + ------------ + + when Attribute_Reduce => + declare + Loc : constant Source_Ptr := Sloc (N); + E1 : constant Node_Id := First (Expressions (N)); + E2 : constant Node_Id := Next (E1); + Bnn : constant Entity_Id := Make_Temporary (Loc, 'B', N); + Typ : constant Entity_Id := Etype (N); + New_Loop : Node_Id; + + -- If the prefix is an aggregwte, its unique component is sn + -- Iterated_Element, and we create a loop out of its itertor. + + begin + if Nkind (Prefix (N)) = N_Aggregate then + declare + Stream : constant Node_Id := + First (Component_Associations (Prefix (N))); + Id : constant Node_Id := Defining_Identifier (Stream); + Expr : constant Node_Id := Expression (Stream); + Ch : constant Node_Id := + First (Discrete_Choices (Stream)); + begin + New_Loop := Make_Loop_Statement (Loc, + Iteration_Scheme => + Make_Iteration_Scheme (Loc, + Iterator_Specification => Empty, + Loop_Parameter_Specification => + Make_Loop_Parameter_Specification (Loc, + Defining_Identifier => New_Copy (Id), + Discrete_Subtype_Definition => + Relocate_Node (Ch))), + End_Label => Empty, + Statements => New_List ( + Make_Assignment_Statement (Loc, + Name => New_Occurrence_Of (Bnn, Loc), + Expression => Make_Function_Call (Loc, + Name => New_Occurrence_Of (Entity (E1), Loc), + Parameter_Associations => New_List ( + New_Occurrence_Of (Bnn, Loc), + Relocate_Node (Expr)))))); + end; + else + -- If the prefix is a name we construct an element iterwtor + -- over it. Its expansion will verify that it is an array + -- or a container with the proper aspects. + + declare + Iter : Node_Id; + Elem : constant Entity_Id := Make_Temporary (Loc, 'E', N); + + begin + Iter := + Make_Iterator_Specification (Loc, + Defining_Identifier => Elem, + Name => Relocate_Node (Prefix (N)), + Subtype_Indication => Empty); + Set_Of_Present (Iter); + + New_Loop := Make_Loop_Statement (Loc, + Iteration_Scheme => + Make_Iteration_Scheme (Loc, + Iterator_Specification => Iter, + Loop_Parameter_Specification => Empty), + End_Label => Empty, + Statements => New_List ( + Make_Assignment_Statement (Loc, + Name => New_Occurrence_Of (Bnn, Loc), + Expression => Make_Function_Call (Loc, + Name => New_Occurrence_Of (Entity (E1), Loc), + Parameter_Associations => New_List ( + New_Occurrence_Of (Bnn, Loc), + New_Occurrence_Of (Elem, Loc)))))); + end; + end if; + + Rewrite (N, + Make_Expression_With_Actions (Loc, + Actions => New_List ( + Make_Object_Declaration (Loc, + Defining_Identifier => Bnn, + Object_Definition => + New_Occurrence_Of (Typ, Loc), + Expression => Relocate_Node (E2)), New_Loop), + Expression => New_Occurrence_Of (Bnn, Loc))); + Analyze_And_Resolve (N, Typ); + end; + ---------- -- Read -- ---------- @@ -6125,7 +6216,7 @@ package body Exp_Attr is Make_Integer_Literal (Loc, 1))), Rep_To_Pos_Flag (Ptyp, Loc)))))); else - -- Add Boolean parameter True, to request program errror if + -- Add Boolean parameter True, to request program error if -- we have a bad representation on our hands. Add False if -- checks are suppressed. diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index c03cd7c..b50e5d0 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -1287,6 +1287,10 @@ package body Exp_Ch6 is -- the context of a call. Now we need to complete the expansion, so we -- unmark the analyzed bits in all prefixes. + function Requires_Atomic_Or_Volatile_Copy return Boolean; + -- Returns whether a copy is required as per RM C.6(19) and gives a + -- warning in this case. + --------------------------- -- Add_Call_By_Copy_Code -- --------------------------- @@ -1938,6 +1942,43 @@ package body Exp_Ch6 is end loop; end Reset_Packed_Prefix; + ---------------------------------------- + -- Requires_Atomic_Or_Volatile_Copy -- + ---------------------------------------- + + function Requires_Atomic_Or_Volatile_Copy return Boolean is + begin + -- If the formal is already passed by copy, no need to do anything + + if Is_By_Copy_Type (E_Formal) then + return False; + end if; + + -- Check for atomicity mismatch + + if Is_Atomic_Object (Actual) and then not Is_Atomic (E_Formal) + then + if Comes_From_Source (N) then + Error_Msg_N + ("?atomic actual passed by copy (RM C.6(19))", Actual); + end if; + return True; + end if; + + -- Check for volatility mismatch + + if Is_Volatile_Object (Actual) and then not Is_Volatile (E_Formal) + then + if Comes_From_Source (N) then + Error_Msg_N + ("?volatile actual passed by copy (RM C.6(19))", Actual); + end if; + return True; + end if; + + return False; + end Requires_Atomic_Or_Volatile_Copy; + -- Start of processing for Expand_Actuals begin @@ -2125,27 +2166,10 @@ package body Exp_Ch6 is then Add_Call_By_Copy_Code; - -- If the actual is not a scalar and is marked for volatile - -- treatment, whereas the formal is not volatile, then pass - -- by copy unless it is a by-reference type. + -- We may need to force a copy because of atomicity or volatility + -- considerations. - -- Note: we use Is_Volatile here rather than Treat_As_Volatile, - -- because this is the enforcement of a language rule that applies - -- only to "real" volatile variables, not e.g. to the address - -- clause overlay case. - - elsif Is_Entity_Name (Actual) - and then Is_Volatile (Entity (Actual)) - and then not Is_By_Reference_Type (E_Actual) - and then not Is_Scalar_Type (Etype (Entity (Actual))) - and then not Is_Volatile (E_Formal) - then - Add_Call_By_Copy_Code; - - elsif Nkind (Actual) = N_Indexed_Component - and then Is_Entity_Name (Prefix (Actual)) - and then Has_Volatile_Components (Entity (Prefix (Actual))) - then + elsif Requires_Atomic_Or_Volatile_Copy then Add_Call_By_Copy_Code; -- Add call-by-copy code for the case of scalar out parameters @@ -2323,6 +2347,12 @@ package body Exp_Ch6 is elsif Is_Possibly_Unaligned_Slice (Actual) then Add_Call_By_Copy_Code; + -- We may need to force a copy because of atomicity or volatility + -- considerations. + + elsif Requires_Atomic_Or_Volatile_Copy then + Add_Call_By_Copy_Code; + -- An unusual case: a current instance of an enclosing task can be -- an actual, and must be replaced by a reference to self. @@ -6904,8 +6934,8 @@ package body Exp_Ch6 is elsif Is_Thunk (Current_Scope) and then Is_Incomplete_Type (Exptyp) then return; - -- A return statement from a Ghost function does not use the secondary - -- stack (or any other one). + -- A return statement from an ignored Ghost function does not use the + -- secondary stack (or any other one). elsif not Requires_Transient_Scope (R_Type) or else Is_Ignored_Ghost_Entity (Scope_Id) diff --git a/gcc/ada/exp_ch8.adb b/gcc/ada/exp_ch8.adb index c3a77ed..dcb51ef6 100644 --- a/gcc/ada/exp_ch8.adb +++ b/gcc/ada/exp_ch8.adb @@ -72,7 +72,14 @@ package body Exp_Ch8 is -- clause applies (that can specify an arbitrary bit boundary), or where -- the enclosing record itself has a non-standard representation. - -- In these two cases, we pre-evaluate the renaming expression, by + -- In Ada 2020, a third case arises when the renamed object is a nonatomic + -- subcomponent of an atomic object, because reads of or writes to it must + -- access the enclosing atomic object. That's also the case for an object + -- subject to the Volatile_Full_Access GNAT aspect/pragma in any language + -- version. For the sake of simplicity, we treat any subcomponent of an + -- atomic or Volatile_Full_Access object in any language version this way. + + -- In these three cases, we pre-evaluate the renaming expression, by -- extracting and freezing the values of any subscripts, and then we -- set the flag Is_Renaming_Of_Object which means that any reference -- to the object will be handled by macro substitution in the front @@ -102,10 +109,10 @@ package body Exp_Ch8 is -- Determines whether it is necessary to do static name evaluation for -- renaming of Nam. It is considered necessary if evaluating the name -- involves indexing a packed array, or extracting a component of a - -- record to which a component clause applies. Note that we are only - -- interested in these operations if they occur as part of the name - -- itself, subscripts are just values that are computed as part of the - -- evaluation, so their form is unimportant. + -- record to which a component clause applies, or a subcomponent of an + -- atomic object. Note that we are only interested in these operations + -- if they occur as part of the name itself, subscripts are just values + -- that are computed as part of the evaluation, so they are unimportant. -- In addition, always return True for Modify_Tree_For_C since the -- code generator doesn't know how to handle renamings. @@ -121,6 +128,10 @@ package body Exp_Ch8 is elsif Nkind_In (Nam, N_Indexed_Component, N_Slice) then if Is_Packed (Etype (Prefix (Nam))) then return True; + + elsif Is_Atomic_Or_VFA_Object (Prefix (Nam)) then + return True; + else return Evaluation_Required (Prefix (Nam)); end if; @@ -141,6 +152,9 @@ package body Exp_Ch8 is then return True; + elsif Is_Atomic_Or_VFA_Object (Prefix (Nam)) then + return True; + else return Evaluation_Required (Prefix (Nam)); end if; diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 60080e6..64ac353 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -363,7 +363,7 @@ package body Exp_Ch9 is -- a null trailing statement with the given Loc (which is the sloc of -- the accept, delay, or entry call statement). There might not be any -- generated code for the accept, delay, or entry call itself (the effect - -- of these statements is part of the general processsing done for the + -- of these statements is part of the general processing done for the -- enclosing selective accept, timed entry call, or asynchronous select), -- and the null statement is there to carry the sloc of that statement to -- the back-end for trace-based coverage analysis purposes. @@ -13721,9 +13721,10 @@ package body Exp_Ch9 is Set_Ekind (Decl_Id, E_Variable); end if; - Set_Prival (Comp_Id, Decl_Id); - Set_Prival_Link (Decl_Id, Comp_Id); - Set_Is_Aliased (Decl_Id, Is_Aliased (Comp_Id)); + Set_Prival (Comp_Id, Decl_Id); + Set_Prival_Link (Decl_Id, Comp_Id); + Set_Is_Aliased (Decl_Id, Is_Aliased (Comp_Id)); + Set_Is_Independent (Decl_Id, Is_Independent (Comp_Id)); -- Generate: -- comp_name : comp_typ renames _object.comp_name; diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h index 0ccd1a0..6b3f300 100644 --- a/gcc/ada/fe.h +++ b/gcc/ada/fe.h @@ -36,7 +36,7 @@ "WARNING: There is a matching C declaration of this <entity_kind> in fe.h" - where <entity_kind> is either "subprogram" or "variable". + where <entity_kind> is either "subprogram" or "variable" or "type". WARNING: functions taking String_Pointer parameters must abide by the rule documented alongside the definition of String_Pointer in types.h. */ @@ -187,6 +187,7 @@ extern Boolean In_Extended_Main_Code_Unit (Entity_Id); /* opt: */ +#define Ada_Version opt__ada_version #define Back_End_Inlining opt__back_end_inlining #define Debug_Generated_Code opt__debug_generated_code #define Exception_Extra_Info opt__exception_extra_info @@ -199,9 +200,14 @@ extern Boolean In_Extended_Main_Code_Unit (Entity_Id); #define Suppress_Checks opt__suppress_checks typedef enum { + Ada_83, Ada_95, Ada_2005, Ada_2012, Ada_2020 +} Ada_Version_Type; + +typedef enum { Front_End_SJLJ, Back_End_ZCX, Back_End_SJLJ } Exception_Mechanism_Type; +extern Ada_Version_Type Ada_Version; extern Boolean Back_End_Inlining; extern Boolean Debug_Generated_Code; extern Boolean Exception_Extra_Info; @@ -281,17 +287,13 @@ extern Boolean Is_OK_Static_Expression (Node_Id); #define Defining_Entity sem_util__defining_entity #define First_Actual sem_util__first_actual -#define Is_Atomic_Object sem_util__is_atomic_object #define Is_Variable_Size_Record sem_util__is_variable_size_record -#define Is_Volatile_Object sem_util__is_volatile_object #define Next_Actual sem_util__next_actual #define Requires_Transient_Scope sem_util__requires_transient_scope extern Entity_Id Defining_Entity (Node_Id); extern Node_Id First_Actual (Node_Id); -extern Boolean Is_Atomic_Object (Node_Id); extern Boolean Is_Variable_Size_Record (Entity_Id Id); -extern Boolean Is_Volatile_Object (Node_Id); extern Node_Id Next_Actual (Node_Id); extern Boolean Requires_Transient_Scope (Entity_Id); diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index add4153..0312ca7 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -937,8 +937,9 @@ 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 or atomic - -- components or independent components. + -- packed record, unless the record has either discriminants or + -- independent components, or is a strict-alignment type, since + -- it cannot be fully packed in this case. -- The reason we eliminate the discriminated case is that -- we don't know the way the back end lays out discriminated @@ -948,8 +949,8 @@ package body Freeze is Packed_Size_Known : Boolean := Is_Packed (T) and then not Has_Discriminants (T) - and then not Has_Atomic_Components (T) - and then not Has_Independent_Components (T); + and then not Has_Independent_Components (T) + and then not Strict_Alignment (T); Packed_Size : Uint := Uint_0; -- Size in bits so far @@ -997,17 +998,13 @@ package body Freeze is Packed_Size_Known := False; end if; - -- We do not know the packed size for an atomic/VFA type - -- or component, or an independent type or component, or a - -- by-reference type or aliased component (because packing - -- does not touch these). + -- We do not know the packed size for an independent + -- component or if it is of a strict-alignment type, + -- since packing does not touch these (RM 13.2(7)). - if Is_Atomic_Or_VFA (Ctyp) - or else Is_Atomic_Or_VFA (Comp) + if Is_Independent (Comp) or else Is_Independent (Ctyp) - or else Is_Independent (Comp) - or else Is_By_Reference_Type (Ctyp) - or else Is_Aliased (Comp) + or else Strict_Alignment (Ctyp) then Packed_Size_Known := False; end if; @@ -1613,23 +1610,31 @@ package body Freeze is Comp : Entity_Id; begin - if Is_Tagged_Type (E) or else Is_Concurrent_Type (E) then + if Is_By_Reference_Type (E) then Set_Strict_Alignment (E); elsif Is_Array_Type (E) then Set_Strict_Alignment (E, Strict_Alignment (Component_Type (E))); - elsif Is_Record_Type (E) then - if Is_Limited_Record (E) then - Set_Strict_Alignment (E); - return; - end if; + -- ??? AI12-001: Any component of a packed type that contains an + -- aliased part must be aligned according to the alignment of its + -- subtype (RM 13.2(7)). This means that the following test: + -- if Has_Aliased_Components (E) then + -- Set_Strict_Alignment (E); + -- end if; + + -- should be implemented here. Unfortunately it would break Florist, + -- which has the bad habit of overaligning all the types it declares + -- on 32-bit platforms. Other legacy codebases could also be affected + -- because this check has historically been missing in GNAT. + + elsif Is_Record_Type (E) then Comp := First_Component (E); while Present (Comp) loop if not Is_Type (Comp) - and then (Strict_Alignment (Etype (Comp)) - or else Is_Aliased (Comp)) + and then (Is_Aliased (Comp) + or else Strict_Alignment (Etype (Comp))) then Set_Strict_Alignment (E); return; @@ -2622,6 +2627,152 @@ package body Freeze is end; end if; + -- Check for Aliased or Atomic_Components/Atomic/VFA with + -- unsuitable packing or explicit component size clause given. + + if (Has_Aliased_Components (Arr) + or else Has_Atomic_Components (Arr) + or else Is_Atomic_Or_VFA (Ctyp)) + and then + (Has_Component_Size_Clause (Arr) or else Is_Packed (Arr)) + then + Alias_Atomic_Check : declare + + procedure Complain_CS (T : String); + -- Outputs error messages for incorrect CS clause or pragma + -- Pack for aliased or atomic/VFA components (T is "aliased" + -- or "atomic/vfa"); + + ----------------- + -- Complain_CS -- + ----------------- + + procedure Complain_CS (T : String) is + begin + if Has_Component_Size_Clause (Arr) then + Clause := + Get_Attribute_Definition_Clause + (FS, Attribute_Component_Size); + + Error_Msg_N + ("incorrect component size for " + & T & " components", Clause); + Error_Msg_Uint_1 := Esize (Ctyp); + Error_Msg_N + ("\only allowed value is^", Clause); + + else + Error_Msg_N + ("?cannot pack " & T & " components (RM 13.2(7))", + Get_Rep_Pragma (FS, Name_Pack)); + Set_Is_Packed (Arr, False); + end if; + end Complain_CS; + + -- Start of processing for Alias_Atomic_Check + + begin + -- If object size of component type isn't known, we cannot + -- be sure so we defer to the back end. + + if not Known_Static_Esize (Ctyp) then + null; + + -- Case where component size has no effect. First check for + -- object size of component type multiple of the storage + -- unit size. + + elsif Esize (Ctyp) mod System_Storage_Unit = 0 + + -- OK in both packing case and component size case if RM + -- size is known and static and same as the object size. + + and then + ((Known_Static_RM_Size (Ctyp) + and then Esize (Ctyp) = RM_Size (Ctyp)) + + -- Or if we have an explicit component size clause and + -- the component size and object size are equal. + + or else + (Has_Component_Size_Clause (Arr) + and then Component_Size (Arr) = Esize (Ctyp))) + then + null; + + elsif Has_Aliased_Components (Arr) then + Complain_CS ("aliased"); + + elsif Has_Atomic_Components (Arr) + or else Is_Atomic (Ctyp) + then + Complain_CS ("atomic"); + + elsif Is_Volatile_Full_Access (Ctyp) then + Complain_CS ("volatile full access"); + end if; + end Alias_Atomic_Check; + end if; + + -- Check for Independent_Components/Independent with unsuitable + -- packing or explicit component size clause given. + + if (Has_Independent_Components (Arr) or else Is_Independent (Ctyp)) + and then + (Has_Component_Size_Clause (Arr) or else Is_Packed (Arr)) + then + begin + -- If object size of component type isn't known, we cannot + -- be sure so we defer to the back end. + + if not Known_Static_Esize (Ctyp) then + null; + + -- Case where component size has no effect. First check for + -- object size of component type multiple of the storage + -- unit size. + + elsif Esize (Ctyp) mod System_Storage_Unit = 0 + + -- OK in both packing case and component size case if RM + -- size is known and multiple of the storage unit size. + + and then + ((Known_Static_RM_Size (Ctyp) + and then RM_Size (Ctyp) mod System_Storage_Unit = 0) + + -- Or if we have an explicit component size clause and + -- the component size is larger than the object size. + + or else + (Has_Component_Size_Clause (Arr) + and then Component_Size (Arr) >= Esize (Ctyp))) + then + null; + + else + if Has_Component_Size_Clause (Arr) then + Clause := + Get_Attribute_Definition_Clause + (FS, Attribute_Component_Size); + + Error_Msg_N + ("incorrect component size for " + & "independent components", Clause); + Error_Msg_Uint_1 := Esize (Ctyp); + Error_Msg_N + ("\minimum allowed is^", Clause); + + else + Error_Msg_N + ("?cannot pack independent components (RM 13.2(7))", + Get_Rep_Pragma (FS, Name_Pack)); + Set_Is_Packed (Arr, False); + end if; + end if; + end; + end if; + -- If packing was requested or if the component size was -- set explicitly, then see if bit packing is required. This -- processing is only done for base types, since all of the @@ -2637,7 +2788,7 @@ package body Freeze is Esiz : Uint; begin - if (Is_Packed (Arr) or else Has_Pragma_Pack (Arr)) + if Is_Packed (Arr) and then Known_Static_RM_Size (Ctyp) and then not Has_Component_Size_Clause (Arr) then @@ -2797,150 +2948,6 @@ package body Freeze is end if; end; - -- Check for Aliased or Atomic_Components/Atomic/VFA with - -- unsuitable packing or explicit component size clause given. - - if (Has_Aliased_Components (Arr) - or else Has_Atomic_Components (Arr) - or else Is_Atomic_Or_VFA (Ctyp)) - and then - (Has_Component_Size_Clause (Arr) or else Is_Packed (Arr)) - then - Alias_Atomic_Check : declare - - procedure Complain_CS (T : String); - -- Outputs error messages for incorrect CS clause or pragma - -- Pack for aliased or atomic/VFA components (T is "aliased" - -- or "atomic/vfa"); - - ----------------- - -- Complain_CS -- - ----------------- - - procedure Complain_CS (T : String) is - begin - if Has_Component_Size_Clause (Arr) then - Clause := - Get_Attribute_Definition_Clause - (FS, Attribute_Component_Size); - - Error_Msg_N - ("incorrect component size for " - & T & " components", Clause); - Error_Msg_Uint_1 := Esize (Ctyp); - Error_Msg_N - ("\only allowed value is^", Clause); - - else - Error_Msg_N - ("cannot pack " & T & " components", - Get_Rep_Pragma (FS, Name_Pack)); - end if; - end Complain_CS; - - -- Start of processing for Alias_Atomic_Check - - begin - -- If object size of component type isn't known, we cannot - -- be sure so we defer to the back end. - - if not Known_Static_Esize (Ctyp) then - null; - - -- Case where component size has no effect. First check for - -- object size of component type multiple of the storage - -- unit size. - - elsif Esize (Ctyp) mod System_Storage_Unit = 0 - - -- OK in both packing case and component size case if RM - -- size is known and static and same as the object size. - - and then - ((Known_Static_RM_Size (Ctyp) - and then Esize (Ctyp) = RM_Size (Ctyp)) - - -- Or if we have an explicit component size clause and - -- the component size and object size are equal. - - or else - (Has_Component_Size_Clause (Arr) - and then Component_Size (Arr) = Esize (Ctyp))) - then - null; - - elsif Has_Aliased_Components (Arr) then - Complain_CS ("aliased"); - - elsif Has_Atomic_Components (Arr) - or else Is_Atomic (Ctyp) - then - Complain_CS ("atomic"); - - elsif Is_Volatile_Full_Access (Ctyp) then - Complain_CS ("volatile full access"); - end if; - end Alias_Atomic_Check; - end if; - - -- Check for Independent_Components/Independent with unsuitable - -- packing or explicit component size clause given. - - if (Has_Independent_Components (Arr) or else Is_Independent (Ctyp)) - and then - (Has_Component_Size_Clause (Arr) or else Is_Packed (Arr)) - then - begin - -- If object size of component type isn't known, we cannot - -- be sure so we defer to the back end. - - if not Known_Static_Esize (Ctyp) then - null; - - -- Case where component size has no effect. First check for - -- object size of component type multiple of the storage - -- unit size. - - elsif Esize (Ctyp) mod System_Storage_Unit = 0 - - -- OK in both packing case and component size case if RM - -- size is known and multiple of the storage unit size. - - and then - ((Known_Static_RM_Size (Ctyp) - and then RM_Size (Ctyp) mod System_Storage_Unit = 0) - - -- Or if we have an explicit component size clause and - -- the component size is larger than the object size. - - or else - (Has_Component_Size_Clause (Arr) - and then Component_Size (Arr) >= Esize (Ctyp))) - then - null; - - else - if Has_Component_Size_Clause (Arr) then - Clause := - Get_Attribute_Definition_Clause - (FS, Attribute_Component_Size); - - Error_Msg_N - ("incorrect component size for " - & "independent components", Clause); - Error_Msg_Uint_1 := Esize (Ctyp); - Error_Msg_N - ("\minimum allowed is^", Clause); - - else - Error_Msg_N - ("cannot pack independent components", - Get_Rep_Pragma (FS, Name_Pack)); - end if; - end if; - end; - end if; - -- Warn for case of atomic type Clause := Get_Rep_Pragma (FS, Name_Atomic); @@ -3569,7 +3576,8 @@ package body Freeze is Error_Msg_N ("\??use explicit size clause to set size", E); end if; - -- Declaring a too-big array in disabled ghost code is OK + -- Declaring too big an array in disabled ghost code is OK + if Is_Array_Type (Typ) and then not Is_Ignored_Ghost_Entity (E) then Check_Large_Modular_Array (Typ); end if; @@ -3998,11 +4006,6 @@ package body Freeze is -- clause (used to warn about useless Bit_Order pragmas, and also -- to detect cases where Implicit_Packing may have an effect). - Rec_Pushed : Boolean := False; - -- Set True if the record type scope Rec has been pushed on the scope - -- stack. Needed for the analysis of delayed aspects specified to the - -- components of Rec. - Sized_Component_Total_RM_Size : Uint := Uint_0; -- Accumulates total RM_Size values of all sized components. Used -- for processing of Implicit_Packing. @@ -4141,47 +4144,6 @@ package body Freeze is -- Start of processing for Freeze_Record_Type begin - -- Deal with delayed aspect specifications for components. The - -- analysis of the aspect is required to be delayed to the freeze - -- point, thus we analyze the pragma or attribute definition - -- clause in the tree at this point. We also analyze the aspect - -- specification node at the freeze point when the aspect doesn't - -- correspond to pragma/attribute definition clause. - - Comp := First_Entity (Rec); - while Present (Comp) loop - if Ekind (Comp) = E_Component - and then Has_Delayed_Aspects (Comp) - then - if not Rec_Pushed then - Push_Scope (Rec); - Rec_Pushed := True; - - -- The visibility to the discriminants must be restored in - -- order to properly analyze the aspects. - - if Has_Discriminants (Rec) then - Install_Discriminants (Rec); - end if; - end if; - - Analyze_Aspects_At_Freeze_Point (Comp); - end if; - - Next_Entity (Comp); - end loop; - - -- Pop the scope if Rec scope has been pushed on the scope stack - -- during the delayed aspect analysis process. - - if Rec_Pushed then - if Has_Discriminants (Rec) then - Uninstall_Discriminants (Rec); - end if; - - Pop_Scope; - end if; - -- Freeze components and embedded subtypes Comp := First_Entity (Rec); @@ -4634,18 +4596,6 @@ package body Freeze is end if; end if; - -- Complete error checking on record representation clause (e.g. - -- overlap of components). This is called after adjusting the - -- record for reverse bit order. - - declare - RRC : constant Node_Id := Get_Record_Representation_Clause (Rec); - begin - if Present (RRC) then - Check_Record_Representation_Clause (RRC); - end if; - end; - -- Check for useless pragma Pack when all components placed. We only -- do this check for record types, not subtypes, since a subtype may -- have all its components placed, and it still makes perfectly good @@ -5492,6 +5442,56 @@ package body Freeze is -- In addition, a derived type may have inherited aspects that were -- delayed in the parent, so these must also be captured now. + -- For a record type, we deal with the delayed aspect specifications on + -- components first, which is consistent with the non-delayed case and + -- makes it possible to have a single processing to detect conflicts. + + if Is_Record_Type (E) then + declare + Comp : Entity_Id; + + Rec_Pushed : Boolean := False; + -- Set True if the record type E has been pushed on the scope + -- stack. Needed for the analysis of delayed aspects specified + -- to the components of Rec. + + begin + Comp := First_Entity (E); + while Present (Comp) loop + if Ekind (Comp) = E_Component + and then Has_Delayed_Aspects (Comp) + then + if not Rec_Pushed then + Push_Scope (E); + Rec_Pushed := True; + + -- The visibility to the discriminants must be restored + -- in order to properly analyze the aspects. + + if Has_Discriminants (E) then + Install_Discriminants (E); + end if; + end if; + + Analyze_Aspects_At_Freeze_Point (Comp); + end if; + + Next_Entity (Comp); + end loop; + + -- Pop the scope if Rec scope has been pushed on the scope stack + -- during the delayed aspect analysis process. + + if Rec_Pushed then + if Has_Discriminants (E) then + Uninstall_Discriminants (E); + end if; + + Pop_Scope; + end if; + end; + end if; + if Has_Delayed_Aspects (E) or else May_Inherit_Delayed_Rep_Aspects (E) then @@ -6787,17 +6787,29 @@ package body Freeze is end if; end if; - -- Now that all types from which E may depend are frozen, see if the - -- size is known at compile time, if it must be unsigned, or if - -- strict alignment is required - - Check_Compile_Time_Size (E); - Check_Unsigned_Type (E); + -- Now that all types from which E may depend are frozen, see if + -- strict alignment is required, a component clause on a record + -- is correct, the size is known at compile time and if it must + -- be unsigned, in that order. if Base_Type (E) = E then Check_Strict_Alignment (E); end if; + if Ekind_In (E, E_Record_Type, E_Record_Subtype) then + declare + RC : constant Node_Id := Get_Record_Representation_Clause (E); + begin + if Present (RC) then + Check_Record_Representation_Clause (RC); + end if; + end; + end if; + + Check_Compile_Time_Size (E); + + Check_Unsigned_Type (E); + -- Do not allow a size clause for a type which does not have a size -- that is known at compile time diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index b83f38c..871a309 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -233,7 +233,8 @@ static vec<subst_pair> build_subst_list (Entity_Id, Entity_Id, bool); static vec<variant_desc> build_variant_list (tree, vec<subst_pair>, vec<variant_desc>); static tree maybe_saturate_size (tree); -static tree validate_size (Uint, tree, Entity_Id, enum tree_code, bool, bool); +static tree validate_size (Uint, tree, Entity_Id, enum tree_code, bool, bool, + const char *, const char *); static void set_rm_size (Uint, tree, Entity_Id); static unsigned int validate_alignment (Uint, Entity_Id, unsigned int); static unsigned int promote_object_alignment (tree, Entity_Id); @@ -780,7 +781,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) if (Known_Esize (gnat_entity)) gnu_size = validate_size (Esize (gnat_entity), gnu_type, gnat_entity, - VAR_DECL, false, Has_Size_Clause (gnat_entity)); + VAR_DECL, false, Has_Size_Clause (gnat_entity), + NULL, NULL); if (gnu_size) { gnu_type @@ -3052,6 +3054,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) if (max_align < BIGGEST_ALIGNMENT) TYPE_MAX_ALIGN (gnu_type) = max_align; } + + /* Similarly if an Object_Size clause has been specified. */ + else if (Known_Esize (gnat_entity)) + { + unsigned int max_size = UI_To_Int (Esize (gnat_entity)); + unsigned int max_align = max_size & -max_size; + if (max_align < BIGGEST_ALIGNMENT) + TYPE_MAX_ALIGN (gnu_type) = max_align; + } } /* If we have a Parent_Subtype, make a field for the parent. If @@ -4239,11 +4250,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) non-constant). */ if (!gnu_size && kind != E_String_Literal_Subtype) { - Uint gnat_size = Known_Esize (gnat_entity) - ? Esize (gnat_entity) : RM_Size (gnat_entity); - gnu_size - = validate_size (gnat_size, gnu_type, gnat_entity, TYPE_DECL, - false, Has_Size_Clause (gnat_entity)); + if (Known_Esize (gnat_entity)) + gnu_size + = validate_size (Esize (gnat_entity), gnu_type, gnat_entity, + VAR_DECL, false, false, NULL, NULL); + else + gnu_size + = validate_size (RM_Size (gnat_entity), gnu_type, gnat_entity, + TYPE_DECL, false, Has_Size_Clause (gnat_entity), + NULL, NULL); } /* If a size was specified, see if we can make a new type of that size @@ -5090,8 +5105,8 @@ gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition, /* Get and validate any specified Component_Size. */ gnu_comp_size = validate_size (Component_Size (gnat_array), gnu_type, gnat_array, - has_packed_components ? TYPE_DECL : VAR_DECL, - true, Has_Component_Size_Clause (gnat_array)); + has_packed_components ? TYPE_DECL : VAR_DECL, true, + Has_Component_Size_Clause (gnat_array), NULL, NULL); /* If the component type is a RECORD_TYPE that has a self-referential size, then use the maximum size for the component size. */ @@ -6999,6 +7014,8 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, const Node_Id gnat_clause = Component_Clause (gnat_field); const Entity_Id gnat_record_type = Underlying_Type (Scope (gnat_field)); const Entity_Id gnat_field_type = Etype (gnat_field); + tree gnu_field_type = gnat_to_gnu_type (gnat_field_type); + tree gnu_field_id = get_entity_name (gnat_field); const bool is_atomic = (Is_Atomic_Or_VFA (gnat_field) || Is_Atomic_Or_VFA (gnat_field_type)); const bool is_aliased = Is_Aliased (gnat_field); @@ -7006,6 +7023,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, = (Is_Independent (gnat_field) || Is_Independent (gnat_field_type)); const bool is_volatile = (Treat_As_Volatile (gnat_field) || Treat_As_Volatile (gnat_field_type)); + const bool is_by_ref = TYPE_IS_BY_REFERENCE_P (gnu_field_type); const bool is_strict_alignment = Strict_Alignment (gnat_field_type); /* We used to consider that volatile fields also require strict alignment, but that was an interpolation and would cause us to reject a pragma @@ -7014,16 +7032,36 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, involve load-modify-store sequences, but that's OK for volatile. The only constraint is the implementation advice whereby only the bits of the components should be accessed if they both start and end on byte - boundaries, but that should be guaranteed by the GCC memory model. */ - const bool needs_strict_alignment - = (is_atomic || is_aliased || is_independent || is_strict_alignment); - bool is_bitfield; - tree gnu_field_type = gnat_to_gnu_type (gnat_field_type); - tree gnu_field_id = get_entity_name (gnat_field); + boundaries, but that should be guaranteed by the GCC memory model. + Note that we have some redundancies (is_atomic => is_independent, + is_aliased => is_independent and is_by_ref => is_strict_alignment) + so the following formula is sufficient. */ + const bool needs_strict_alignment = (is_independent || is_strict_alignment); + const char *field_s, *size_s; tree gnu_field, gnu_size, gnu_pos; + bool is_bitfield; - /* If this field requires strict alignment, we cannot pack it because - it would very likely be under-aligned in the record. */ + /* The qualifier to be used in messages. */ + if (is_atomic) + field_s = "atomic&"; + else if (is_aliased) + field_s = "aliased&"; + else if (is_independent) + field_s = "independent&"; + else if (is_by_ref) + field_s = "& with by-reference type"; + else if (is_strict_alignment) + field_s = "& with aliased part"; + else + field_s = "&"; + + /* The message to be used for incompatible size. */ + if (is_atomic || is_aliased) + size_s = "size for %s must be ^"; + else if (field_s) + size_s = "size for %s too small{, minimum allowed is ^}"; + + /* If a field requires strict alignment, we cannot pack it (RM 13.2(7)). */ if (needs_strict_alignment) packed = 0; else @@ -7034,7 +7072,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, for further details. */ if (Present (gnat_clause) || Known_Esize (gnat_field)) gnu_size = validate_size (Esize (gnat_field), gnu_field_type, gnat_field, - FIELD_DECL, false, true); + FIELD_DECL, false, true, size_s, field_s); else if (packed == 1) { gnu_size = rm_size (gnu_field_type); @@ -7152,23 +7190,11 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, && !(type_annotate_only && Is_Tagged_Type (gnat_field_type))) { const unsigned int type_align = TYPE_ALIGN (gnu_field_type); - const char *field_s; if (TYPE_ALIGN (gnu_record_type) && TYPE_ALIGN (gnu_record_type) < type_align) SET_TYPE_ALIGN (gnu_record_type, type_align); - if (is_atomic) - field_s = "atomic &"; - else if (is_aliased) - field_s = "aliased &"; - else if (is_independent) - field_s = "independent &"; - else if (is_strict_alignment) - field_s = "& with aliased or tagged part"; - else - gcc_unreachable (); - /* If the position is not a multiple of the storage unit, then error out and reset the position. */ if (!integer_zerop (size_binop (TRUNC_MOD_EXPR, gnu_pos, @@ -7221,11 +7247,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, || (cmp > 0 && (is_atomic || is_aliased))) { char s[128]; - if (is_atomic || is_aliased) - snprintf (s, sizeof (s), "size for %s must be ^", field_s); - else - snprintf (s, sizeof (s), "size for %s must be at least ^", - field_s); + snprintf (s, sizeof (s), size_s, field_s); post_error_ne_tree (s, Last_Bit (gnat_clause), gnat_field, type_size); gnu_size = NULL_TREE; @@ -7362,7 +7384,7 @@ components_need_strict_alignment (Node_Id component_list) { Entity_Id gnat_field = Defining_Entity (component_decl); - if (Is_Aliased (gnat_field)) + if (Is_Independent (gnat_field) || Is_Independent (Etype (gnat_field))) return true; if (Strict_Alignment (Etype (gnat_field))) @@ -8838,11 +8860,12 @@ maybe_saturate_size (tree size) true if we are being called to process the Component_Size of GNAT_OBJECT; this is used only for error messages. ZERO_OK is true if a size of zero is permitted; if ZERO_OK is false, it means that a size of zero should be - treated as an unspecified size. */ + treated as an unspecified size. S1 and S2 are used for error messages. */ static tree validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object, - enum tree_code kind, bool component_p, bool zero_ok) + enum tree_code kind, bool component_p, bool zero_ok, + const char *s1, const char *s2) { Node_Id gnat_error_node; tree old_size, size; @@ -8862,6 +8885,8 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object, gnat_error_node = Last_Bit (Component_Clause (gnat_object)); else if (Present (Size_Clause (gnat_object))) gnat_error_node = Expression (Size_Clause (gnat_object)); + else if (Has_Object_Size_Clause (gnat_object)) + gnat_error_node = Expression (Object_Size_Clause (gnat_object)); else gnat_error_node = gnat_object; @@ -8888,10 +8913,10 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object, && !integer_zerop (size_binop (TRUNC_MOD_EXPR, size, bitsize_unit_node))) { if (component_p) - post_error_ne ("component size for& is not a multiple of Storage_Unit", + post_error_ne ("component size for& must be multiple of Storage_Unit", gnat_error_node, gnat_object); else - post_error_ne ("size for& is not a multiple of Storage_Unit", + post_error_ne ("size for& must be multiple of Storage_Unit", gnat_error_node, gnat_object); return NULL_TREE; } @@ -8932,14 +8957,20 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object, || TREE_OVERFLOW (old_size) || tree_int_cst_lt (size, old_size)) { - if (component_p) - post_error_ne_tree - ("component size for& too small{, minimum allowed is ^}", - gnat_error_node, gnat_object, old_size); + char buf[128]; + const char *s; + + if (kind == FIELD_DECL) + { + snprintf (buf, sizeof (buf), s1, s2); + s = buf; + } + else if (component_p) + s = "component size for& too small{, minimum allowed is ^}"; else - post_error_ne_tree - ("size for& too small{, minimum allowed is ^}", - gnat_error_node, gnat_object, old_size); + s = "size for& too small{, minimum allowed is ^}"; + post_error_ne_tree (s, gnat_error_node, gnat_object, old_size); + return NULL_TREE; } diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index ef16a08..5f87bc3 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -1975,7 +1975,21 @@ Pragma_to_gnu (Node_Id gnat_node) gnat_expr = Expression (Next (gnat_temp)); } else - gnat_expr = Empty; + { + gnat_expr = Empty; + + /* For pragma Warnings (Off), we save the current state... */ + if (kind == DK_IGNORED) + diagnostic_push_diagnostics (global_dc, location); + + /* ...so that, for pragma Warnings (On), we do not enable all + the warnings but just restore the previous state. */ + else + { + diagnostic_pop_diagnostics (global_dc, location); + break; + } + } imply = false; } @@ -3976,7 +3990,7 @@ Loop_Statement_to_gnu (Node_Id gnat_node) return gnu_result; } -/* This page implements a form of Named Return Value optimization modelled +/* This page implements a form of Named Return Value optimization modeled on the C++ optimization of the same name. The main difference is that we disregard any semantical considerations when applying it here, the counterpart being that we don't try to apply it to semantically loaded @@ -4792,7 +4806,13 @@ Subprogram_Body_to_gnu (Node_Id gnat_node) rest_of_subprog_body_compilation (gnu_subprog_decl); } -/* Return true if GNAT_NODE references an Atomic entity. */ +/* The type of an atomic access. */ + +typedef enum { NOT_ATOMIC, SIMPLE_ATOMIC, OUTER_ATOMIC } atomic_acces_t; + +/* Return true if GNAT_NODE references an Atomic entity. This is modeled on + the Is_Atomic_Object predicate of the front-end, but additionally handles + explicit dereferences. */ static bool node_is_atomic (Node_Id gnat_node) @@ -4809,17 +4829,14 @@ node_is_atomic (Node_Id gnat_node) return Is_Atomic (gnat_entity) || Is_Atomic (Etype (gnat_entity)); case N_Selected_Component: - gnat_entity = Entity (Selector_Name (gnat_node)); - return Is_Atomic (gnat_entity) || Is_Atomic (Etype (gnat_entity)); + return Is_Atomic (Etype (gnat_node)) + || Is_Atomic (Entity (Selector_Name (gnat_node))); case N_Indexed_Component: - if (Has_Atomic_Components (Etype (Prefix (gnat_node)))) - return true; - if (Is_Entity_Name (Prefix (gnat_node)) - && Has_Atomic_Components (Entity (Prefix (gnat_node)))) - return true; - - /* ... fall through ... */ + return Is_Atomic (Etype (gnat_node)) + || Has_Atomic_Components (Etype (Prefix (gnat_node))) + || (Is_Entity_Name (Prefix (gnat_node)) + && Has_Atomic_Components (Entity (Prefix (gnat_node)))); case N_Explicit_Dereference: return Is_Atomic (Etype (gnat_node)); @@ -4831,10 +4848,12 @@ node_is_atomic (Node_Id gnat_node) return false; } -/* Return true if GNAT_NODE references a Volatile_Full_Access entity. */ +/* Return true if GNAT_NODE references a Volatile_Full_Access entity. This is + modeled on the Is_Volatile_Full_Access_Object predicate of the front-end, + but additionally handles explicit dereferences. */ static bool -node_has_volatile_full_access (Node_Id gnat_node) +node_is_volatile_full_access (Node_Id gnat_node) { Entity_Id gnat_entity; @@ -4849,9 +4868,8 @@ node_has_volatile_full_access (Node_Id gnat_node) || Is_Volatile_Full_Access (Etype (gnat_entity)); case N_Selected_Component: - gnat_entity = Entity (Selector_Name (gnat_node)); - return Is_Volatile_Full_Access (gnat_entity) - || Is_Volatile_Full_Access (Etype (gnat_entity)); + return Is_Volatile_Full_Access (Etype (gnat_node)) + || Is_Volatile_Full_Access (Entity (Selector_Name (gnat_node))); case N_Indexed_Component: case N_Explicit_Dereference: @@ -4864,73 +4882,42 @@ node_has_volatile_full_access (Node_Id gnat_node) return false; } -/* Strip any type conversion on GNAT_NODE and return the result. */ +/* Return true if GNAT_NODE references a component of a larger object. */ -static Node_Id -gnat_strip_type_conversion (Node_Id gnat_node) +static inline bool +node_is_component (Node_Id gnat_node) { - Node_Kind kind = Nkind (gnat_node); - - if (kind == N_Type_Conversion || kind == N_Unchecked_Type_Conversion) - gnat_node = Expression (gnat_node); - - return gnat_node; + const Node_Kind k = Nkind (gnat_node); + return + (k == N_Indexed_Component || k == N_Selected_Component || k == N_Slice); } -/* Return true if GNAT_NODE requires outer atomic access, i.e. atomic access - of an object of which GNAT_NODE is a component. */ +/* Compute whether GNAT_NODE requires atomic access and set TYPE to the type + of access and SYNC according to the associated synchronization setting. -static bool -outer_atomic_access_required_p (Node_Id gnat_node) -{ - gnat_node = gnat_strip_type_conversion (gnat_node); - - while (true) - { - switch (Nkind (gnat_node)) - { - case N_Identifier: - case N_Expanded_Name: - if (No (Renamed_Object (Entity (gnat_node)))) - return false; - gnat_node - = gnat_strip_type_conversion (Renamed_Object (Entity (gnat_node))); - break; + We implement 3 different semantics of atomicity in this function: - case N_Indexed_Component: - case N_Selected_Component: - case N_Slice: - gnat_node = gnat_strip_type_conversion (Prefix (gnat_node)); - if (node_has_volatile_full_access (gnat_node)) - return true; - break; + 1. the Ada 95/2005/2012 semantics of the Atomic aspect/pragma, + 2. the Ada 2020 semantics of the Atomic aspect/pragma, + 3. the semantics of the Volatile_Full_Access GNAT aspect/pragma. - default: - return false; - } - } + They are mutually exclusive and the FE should have rejected conflicts. */ - gcc_unreachable (); -} - -/* Return true if GNAT_NODE requires atomic access and set SYNC according to - the associated synchronization setting. */ - -static bool -atomic_access_required_p (Node_Id gnat_node, bool *sync) +static void +get_atomic_access (Node_Id gnat_node, atomic_acces_t *type, bool *sync) { - const Node_Id gnat_parent = Parent (gnat_node); + Node_Id gnat_parent, gnat_temp; unsigned char attr_id; - bool as_a_whole = true; - /* First, scan the parent to find out cases where the flag is irrelevant. */ + /* First, scan the parent to filter out irrelevant cases. */ + gnat_parent = Parent (gnat_node); switch (Nkind (gnat_parent)) { case N_Attribute_Reference: attr_id = Get_Attribute_Id (Attribute_Name (gnat_parent)); /* Do not mess up machine code insertions. */ if (attr_id == Attr_Asm_Input || attr_id == Attr_Asm_Output) - return false; + goto not_atomic; /* Nothing to do if we are the prefix of an attribute, since we do not want an atomic access for things like 'Size. */ @@ -4940,45 +4927,86 @@ atomic_access_required_p (Node_Id gnat_node, bool *sync) case N_Reference: /* The N_Reference node is like an attribute. */ if (Prefix (gnat_parent) == gnat_node) - return false; - break; - - case N_Indexed_Component: - case N_Selected_Component: - case N_Slice: - /* If we are the prefix, then the access is only partial. */ - if (Prefix (gnat_parent) == gnat_node) - as_a_whole = false; + goto not_atomic; break; case N_Object_Renaming_Declaration: /* Nothing to do for the identifier in an object renaming declaration, the renaming itself does not need atomic access. */ - return false; + goto not_atomic; default: break; } - /* Then, scan the node to find the atomic object. */ - gnat_node = gnat_strip_type_conversion (gnat_node); + /* Now strip any type conversion from GNAT_NODE. */ + if (Nkind (gnat_node) == N_Type_Conversion + || Nkind (gnat_node) == N_Unchecked_Type_Conversion) + gnat_node = Expression (gnat_node); - /* For Atomic itself, only reads and updates of the object as a whole require - atomic access (RM C.6 (15)). But for Volatile_Full_Access, all reads and - updates require atomic access. */ - if (!(as_a_whole && node_is_atomic (gnat_node)) - && !node_has_volatile_full_access (gnat_node)) - return false; + /* Up to Ada 2012, for Atomic itself, only reads and updates of the object as + a whole require atomic access (RM C.6(15)). But, starting with Ada 2020, + reads of or writes to a nonatomic subcomponent of the object also require + atomic access (RM C.6(19)). */ + if (node_is_atomic (gnat_node)) + { + bool as_a_whole = true; - /* If an outer atomic access will also be required, it cancels this one. */ - if (outer_atomic_access_required_p (gnat_node)) - return false; + /* If we are the prefix of the parent, then the access is partial. */ + for (gnat_temp = gnat_node, gnat_parent = Parent (gnat_temp); + node_is_component (gnat_parent) && Prefix (gnat_parent) == gnat_temp; + gnat_temp = gnat_parent, gnat_parent = Parent (gnat_temp)) + if (Ada_Version < Ada_2020 || node_is_atomic (gnat_parent)) + goto not_atomic; + else + as_a_whole = false; - *sync = Atomic_Sync_Required (gnat_node); + /* We consider that partial accesses are not sequential actions and, + therefore, do not require synchronization. */ + *type = SIMPLE_ATOMIC; + *sync = as_a_whole ? Atomic_Sync_Required (gnat_node) : false; + return; + } - return true; + /* Look for an outer atomic access of a nonatomic subcomponent. Note that, + for VFA, we do this before looking at the node itself because we need to + access the outermost VFA object atomically, unlike for Atomic where it is + the innermost atomic object (RM C.6(19)). */ + for (gnat_temp = gnat_node; + node_is_component (gnat_temp); + gnat_temp = Prefix (gnat_temp)) + if ((Ada_Version >= Ada_2020 && node_is_atomic (Prefix (gnat_temp))) + || node_is_volatile_full_access (Prefix (gnat_temp))) + { + *type = OUTER_ATOMIC; + *sync = false; + return; + } + + /* Unlike Atomic, accessing a VFA object always requires atomic access. */ + if (node_is_volatile_full_access (gnat_node)) + { + *type = SIMPLE_ATOMIC; + *sync = false; + return; + } + +not_atomic: + *type = NOT_ATOMIC; + *sync = false; } + /* Return true if GNAT_NODE requires simple atomic access and, if so, set SYNC + according to the associated synchronization setting. */ + +static inline bool +simple_atomic_access_required_p (Node_Id gnat_node, bool *sync) +{ + atomic_acces_t type; + get_atomic_access (gnat_node, &type, sync); + return type == SIMPLE_ATOMIC; +} + /* Create a temporary variable with PREFIX and TYPE, and return it. */ static tree @@ -5008,48 +5036,18 @@ create_init_temporary (const char *prefix, tree gnu_init, tree *gnu_init_stmt, return gnu_temp; } -/* Return whether ACTUAL parameter corresponding to FORMAL_TYPE must be passed - by copy in a call as per RM C.6(19). Note that we use the same predicates - as in the front-end for RM C.6(12) because it's purely a legality issue. */ - -static bool -atomic_or_volatile_copy_required_p (Node_Id actual, Entity_Id formal_type) -{ - /* We should not have a scalar type here because such a type is passed - by copy. But the Interlocked routines in System.Aux_DEC force some - of the their scalar parameters to be passed by reference so we need - to preserve that if we do not want to break the interface. */ - if (Is_Scalar_Type (formal_type)) - return false; - - if (Is_Atomic_Object (actual) && !Is_Atomic (formal_type)) - { - post_error ("?atomic actual passed by copy (RM C.6(19))", actual); - return true; - } - - if (Is_Volatile_Object (actual) && !Is_Volatile (formal_type)) - { - post_error ("?volatile actual passed by copy (RM C.6(19))", actual); - return true; - } - - return false; -} - /* Subroutine of gnat_to_gnu to translate gnat_node, either an N_Function_Call or an N_Procedure_Call_Statement, to a GCC tree, which is returned. GNU_RESULT_TYPE_P is a pointer to where we should place the result type. If GNU_TARGET is non-null, this must be a function call on the RHS of a N_Assignment_Statement and the result is to be placed into that object. - If OUTER_ATOMIC_ACCESS is true, then the assignment to GNU_TARGET must be a - load-modify-store sequence. Otherwise, if ATOMIC_ACCESS is true, then the - assignment to GNU_TARGET must be atomic. If, in addition, ATOMIC_SYNC is - true, then the assignment to GNU_TARGET requires atomic synchronization. */ + ATOMIC_ACCESS is the type of atomic access to be used for the assignment + to GNU_TARGET. If, in addition, ATOMIC_SYNC is true, then the assignment + to GNU_TARGET requires atomic synchronization. */ static tree Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, - bool outer_atomic_access, bool atomic_access, bool atomic_sync) + atomic_acces_t atomic_access, bool atomic_sync) { const bool function_call = (Nkind (gnat_node) == N_Function_Call); const bool returning_value = (function_call && !gnu_target); @@ -5076,7 +5074,8 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, bool pushed_binding_level = false; Entity_Id gnat_formal; Node_Id gnat_actual; - bool sync; + atomic_acces_t aa_type; + bool aa_sync; gcc_assert (FUNC_OR_METHOD_TYPE_P (gnu_subprog_type)); @@ -5254,18 +5253,13 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, = build_compound_expr (TREE_TYPE (gnu_name), init, gnu_name); } - /* If we are passing a non-addressable actual parameter by reference, - pass the address of a copy and, in the In Out or Out case, set up - to copy back after the call. We also need to do that if the actual - parameter is atomic or volatile but the formal parameter is not. */ + /* If we are passing a non-addressable parameter by reference, pass the + address of a copy. In the In Out or Out case, set up to copy back + out after the call. */ if (is_by_ref_formal_parm && (gnu_name_type = gnat_to_gnu_type (Etype (gnat_name))) - && (!addressable_p (gnu_name, gnu_name_type) - || (Comes_From_Source (gnat_node) - && atomic_or_volatile_copy_required_p (gnat_actual, - gnat_formal_type)))) + && !addressable_p (gnu_name, gnu_name_type)) { - const bool atomic_p = atomic_access_required_p (gnat_actual, &sync); tree gnu_orig = gnu_name, gnu_temp, gnu_stmt; /* Do not issue warnings for CONSTRUCTORs since this is not a copy @@ -5335,9 +5329,6 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, } /* Create an explicit temporary holding the copy. */ - if (atomic_p) - gnu_name = build_atomic_load (gnu_name, sync); - /* Do not initialize it for the _Init parameter of an initialization procedure since no data is meant to be passed in. */ if (Ekind (gnat_formal) == E_Out_Parameter @@ -5367,13 +5358,8 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, (TREE_OPERAND (TREE_OPERAND (gnu_orig, 1), 1))) gnu_orig = TREE_OPERAND (gnu_orig, 2); - if (atomic_p) - gnu_stmt - = build_atomic_store (gnu_orig, gnu_temp, sync); - else - gnu_stmt - = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_orig, - gnu_temp); + gnu_stmt + = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_orig, gnu_temp); set_expr_location_from_node (gnu_stmt, gnat_node); append_to_statement_list (gnu_stmt, &gnu_after_list); @@ -5388,8 +5374,8 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, if (is_true_formal_parm && !is_by_ref_formal_parm && Ekind (gnat_formal) != E_Out_Parameter - && atomic_access_required_p (gnat_actual, &sync)) - gnu_actual = build_atomic_load (gnu_actual, sync); + && simple_atomic_access_required_p (gnat_actual, &aa_sync)) + gnu_actual = build_atomic_load (gnu_actual, aa_sync); /* If this was a procedure call, we may not have removed any padding. So do it here for the part we will use as an input, if any. */ @@ -5689,16 +5675,19 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, gnu_result = convert (TREE_TYPE (gnu_actual), gnu_result); } + get_atomic_access (gnat_actual, &aa_type, &aa_sync); + /* If an outer atomic access is required for an actual parameter, build the load-modify-store sequence. */ - if (outer_atomic_access_required_p (gnat_actual)) + if (aa_type == OUTER_ATOMIC) gnu_result = build_load_modify_store (gnu_actual, gnu_result, gnat_node); - /* Or else, if simple atomic access is required, build the atomic + /* Or else, if a simple atomic access is required, build the atomic store. */ - else if (atomic_access_required_p (gnat_actual, &sync)) - gnu_result = build_atomic_store (gnu_actual, gnu_result, sync); + else if (aa_type == SIMPLE_ATOMIC) + gnu_result + = build_atomic_store (gnu_actual, gnu_result, aa_sync); /* Otherwise build a regular assignment. */ else @@ -5750,10 +5739,10 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, op_code = MODIFY_EXPR; /* Use the required method to move the result to the target. */ - if (outer_atomic_access) + if (atomic_access == OUTER_ATOMIC) gnu_call = build_load_modify_store (gnu_target, gnu_call, gnat_node); - else if (atomic_access) + else if (atomic_access == SIMPLE_ATOMIC) gnu_call = build_atomic_store (gnu_target, gnu_call, atomic_sync); else gnu_call @@ -6673,8 +6662,8 @@ common: static bool lhs_or_actual_p (Node_Id gnat_node) { - Node_Id gnat_parent = Parent (gnat_node); - Node_Kind kind = Nkind (gnat_parent); + const Node_Id gnat_parent = Parent (gnat_node); + const Node_Kind kind = Nkind (gnat_parent); if (kind == N_Assignment_Statement && Name (gnat_parent) == gnat_node) return true; @@ -6695,12 +6684,10 @@ lhs_or_actual_p (Node_Id gnat_node) static bool present_in_lhs_or_actual_p (Node_Id gnat_node) { - Node_Kind kind; - if (lhs_or_actual_p (gnat_node)) return true; - kind = Nkind (Parent (gnat_node)); + const Node_Kind kind = Nkind (Parent (gnat_node)); if ((kind == N_Type_Conversion || kind == N_Unchecked_Type_Conversion) && lhs_or_actual_p (Parent (gnat_node))) @@ -6789,7 +6776,8 @@ gnat_to_gnu (Node_Id gnat_node) tree gnu_result_type = void_type_node; tree gnu_expr, gnu_lhs, gnu_rhs; Node_Id gnat_temp; - bool sync = false; + atomic_acces_t aa_type; + bool aa_sync; /* Save node number for error message and set location information. */ Current_Error_Node = gnat_node; @@ -6861,9 +6849,9 @@ gnat_to_gnu (Node_Id gnat_node) gnu_result = Identifier_to_gnu (gnat_node, &gnu_result_type); /* If atomic access is required on the RHS, build the atomic load. */ - if (atomic_access_required_p (gnat_node, &sync) + if (simple_atomic_access_required_p (gnat_node, &aa_sync) && !present_in_lhs_or_actual_p (gnat_node)) - gnu_result = build_atomic_load (gnu_result, sync); + gnu_result = build_atomic_load (gnu_result, aa_sync); break; case N_Integer_Literal: @@ -7195,9 +7183,9 @@ gnat_to_gnu (Node_Id gnat_node) gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_result); /* If atomic access is required on the RHS, build the atomic load. */ - if (atomic_access_required_p (gnat_node, &sync) + if (simple_atomic_access_required_p (gnat_node, &aa_sync) && !present_in_lhs_or_actual_p (gnat_node)) - gnu_result = build_atomic_load (gnu_result, sync); + gnu_result = build_atomic_load (gnu_result, aa_sync); break; case N_Indexed_Component: @@ -7272,9 +7260,9 @@ gnat_to_gnu (Node_Id gnat_node) gnu_result_type = get_unpadded_type (Etype (gnat_node)); /* If atomic access is required on the RHS, build the atomic load. */ - if (atomic_access_required_p (gnat_node, &sync) + if (simple_atomic_access_required_p (gnat_node, &aa_sync) && !present_in_lhs_or_actual_p (gnat_node)) - gnu_result = build_atomic_load (gnu_result, sync); + gnu_result = build_atomic_load (gnu_result, aa_sync); } break; @@ -7350,9 +7338,9 @@ gnat_to_gnu (Node_Id gnat_node) gnu_result_type = get_unpadded_type (Etype (gnat_node)); /* If atomic access is required on the RHS, build the atomic load. */ - if (atomic_access_required_p (gnat_node, &sync) + if (simple_atomic_access_required_p (gnat_node, &aa_sync) && !present_in_lhs_or_actual_p (gnat_node)) - gnu_result = build_atomic_load (gnu_result, sync); + gnu_result = build_atomic_load (gnu_result, aa_sync); } break; @@ -7853,14 +7841,10 @@ gnat_to_gnu (Node_Id gnat_node) N_Raise_Storage_Error); else if (Nkind (Expression (gnat_node)) == N_Function_Call) { - bool outer_atomic_access - = outer_atomic_access_required_p (Name (gnat_node)); - bool atomic_access - = !outer_atomic_access - && atomic_access_required_p (Name (gnat_node), &sync); + get_atomic_access (Name (gnat_node), &aa_type, &aa_sync); gnu_result = Call_to_gnu (Expression (gnat_node), &gnu_result_type, gnu_lhs, - outer_atomic_access, atomic_access, sync); + aa_type, aa_sync); } else { @@ -7890,14 +7874,17 @@ gnat_to_gnu (Node_Id gnat_node) gigi_checking_assert (!Do_Range_Check (gnat_expr)); + get_atomic_access (Name (gnat_node), &aa_type, &aa_sync); + /* If an outer atomic access is required on the LHS, build the load- modify-store sequence. */ - if (outer_atomic_access_required_p (Name (gnat_node))) + if (aa_type == OUTER_ATOMIC) gnu_result = build_load_modify_store (gnu_lhs, gnu_rhs, gnat_node); - /* Or else, if atomic access is required, build the atomic store. */ - else if (atomic_access_required_p (Name (gnat_node), &sync)) - gnu_result = build_atomic_store (gnu_lhs, gnu_rhs, sync); + /* Or else, if a simple atomic access is required, build the atomic + store. */ + else if (aa_type == SIMPLE_ATOMIC) + gnu_result = build_atomic_store (gnu_lhs, gnu_rhs, aa_sync); /* Or else, use memset when the conditions are met. This has already been validated by Aggr_Assignment_OK_For_Backend in the front-end @@ -8218,7 +8205,7 @@ gnat_to_gnu (Node_Id gnat_node) case N_Function_Call: case N_Procedure_Call_Statement: gnu_result = Call_to_gnu (gnat_node, &gnu_result_type, NULL_TREE, - false, false, false); + NOT_ATOMIC, false); break; /************************/ @@ -8518,7 +8505,7 @@ gnat_to_gnu (Node_Id gnat_node) /* If the operand is going to end up in memory, mark it addressable. Note that we don't test allows_mem like in the input case below; this - is modelled on the C front-end. */ + is modeled on the C front-end. */ if (!allows_reg) { output = remove_conversions (output, false); @@ -11165,7 +11152,7 @@ get_elaboration_procedure (void) static Entity_Id get_controlling_type (Entity_Id subprog) { - /* This is modelled on Expand_Interface_Thunk. */ + /* This is modeled on Expand_Interface_Thunk. */ Entity_Id controlling_type = Etype (First_Formal (subprog)); if (Is_Access_Type (controlling_type)) controlling_type = Directly_Designated_Type (controlling_type); diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index f7c2923..5261d38 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -2751,7 +2751,7 @@ pragma Postcondition (if C2 then Pred2); The precondition ensures that one and only one of the case guards is satisfied on entry to the subprogram. The postcondition ensures that for the case guard that was True on entry, -the corrresponding consequence is True on exit. Other consequence expressions +the corresponding consequence is True on exit. Other consequence expressions are not evaluated. A precondition @code{P} and postcondition @code{Q} can also be @@ -8949,7 +8949,7 @@ It is not permissible to specify @code{Atomic} and @code{Volatile_Full_Access} f the same type or object. It is not permissible to specify @code{Volatile_Full_Access} for a composite -(record or array) type or object that has at least one @code{Aliased} component. +(record or array) type or object that has an @code{Aliased} subcomponent. @node Pragma Volatile_Function,Pragma Warning_As_Error,Pragma Volatile_Full_Access,Implementation Defined Pragmas @anchor{gnat_rm/implementation_defined_pragmas id56}@anchor{11e}@anchor{gnat_rm/implementation_defined_pragmas pragma-volatile-function}@anchor{11f} @@ -28804,7 +28804,7 @@ this kind of implementation dependent addition. The functionality provided by pragma @code{Task_Info} is now part of the Ada language. The @code{CPU} aspect and the package @code{System.Multiprocessors} offer a less system-dependent way to specify -task affinity or to query the number of processsors. +task affinity or to query the number of processors. Syntax diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 07db41f..66bea96 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -11250,7 +11250,7 @@ The default is that such warnings are generated. @item @code{-gnatw_C} -@emph{Suppress warnings on missing component clauses.} +@emph{Suppress warnings on unknown condition in Compile_Time_Warning.} This switch supresses warnings on a pragma Compile_Time_Warning or Compile_Time_Error whose condition has a value that is not @@ -15968,7 +15968,10 @@ limitations: @itemize * @item -Debugging will not work; +Starting the program's execution in the debugger will cause it to +stop at the start of the @code{main} function instead of the main subprogram. +This can be worked around by manually inserting a breakpoint on that +subprogram and resuming the program's execution until reaching that breakpoint. @item Programs using GNAT.Compiler_Version will not link. @@ -22792,7 +22795,7 @@ integer arithmetic package. The compiler will make calls to this package, though only in cases where it cannot be sure that @code{Long_Long_Integer} is sufficient to guard against intermediate overflows. This package does not use dynamic -alllocation, but it does use the secondary stack, so an +allocation, but it does use the secondary stack, so an appropriate secondary stack package must be present (this is always true for standard full Ada, but may require specific steps for restricted run times such as ZFP). diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb index 6bff383..c53cdf9 100644 --- a/gcc/ada/impunit.adb +++ b/gcc/ada/impunit.adb @@ -620,11 +620,14 @@ package body Impunit is -- The following units should be used only in Ada 202X mode Non_Imp_File_Names_2X : constant File_List := ( - 0 => ("a-stteou", T) -- Ada.Strings.Text_Output - -- ???We use named notation, because there is only one of these so far. - -- When we add more, we should switch to positional notation, and erase - -- the "0 =>". - ); + ("a-stteou", T), -- Ada.Strings.Text_Output + ("a-nubinu", T), -- Ada.Numerics.Big_Numbers + ("a-nbnbin", T), -- Ada.Numerics.Big_Numbers.Big_Integers + ("a-nbnbre", T), -- Ada.Numerics.Big_Numbers.Big_Reals + ("s-aotase", T), -- System.Atomic_Operations.Test_And_Set + ("s-atoope", T), -- System.Atomic_Operations + ("s-atopar", T), -- System.Atomic_Operations.Arithmetic + ("s-atopex", T)); -- System.Atomic_Operations.Exchange ----------------------- -- Alternative Units -- diff --git a/gcc/ada/init.c b/gcc/ada/init.c index f7e830e..67ea4dc 100644 --- a/gcc/ada/init.c +++ b/gcc/ada/init.c @@ -1564,7 +1564,7 @@ int __gl_heap_size = 64; operation, drivide by zero, and overflow. This will prevent the VMS runtime (specifically OTS$CHECK_FP_MODE) from complaining about inconsistent floating point settings in a mixed language program. Ideally the setting - would be determined at link time based on setttings in the object files, + would be determined at link time based on settings in the object files, however the VMS linker seems to take the setting from the first object in the link, e.g. pcrt0.o which is float representation neutral. */ char __gl_float_format = 'I'; diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb index 4fc502b..ce2fe30 100644 --- a/gcc/ada/layout.adb +++ b/gcc/ada/layout.adb @@ -435,14 +435,6 @@ package body Layout is end; end if; - -- If Esize is set, and RM_Size is not, RM_Size is copied from Esize. - -- At least for now this seems reasonable, and is in any case needed - -- for compatibility with old versions of gigi. - - if Known_Esize (E) and then Unknown_RM_Size (E) then - Set_RM_Size (E, Esize (E)); - end if; - -- For array base types, set the component size if object size of the -- component type is known and is a small power of 2 (8, 16, 32, 64), -- since this is what will always be used, except if a very large diff --git a/gcc/ada/libgnarl/s-tataat.ads b/gcc/ada/libgnarl/s-tataat.ads index b7d5edb..5ae9a75 100644 --- a/gcc/ada/libgnarl/s-tataat.ads +++ b/gcc/ada/libgnarl/s-tataat.ads @@ -36,6 +36,7 @@ with Ada.Unchecked_Conversion; package System.Tasking.Task_Attributes is type Deallocator is access procedure (Ptr : Atomic_Address); + pragma Favor_Top_Level (Deallocator); type Attribute_Record is record Free : Deallocator; diff --git a/gcc/ada/libgnat/a-nbnbin.adb b/gcc/ada/libgnat/a-nbnbin.adb new file mode 100644 index 0000000..7d8311d --- /dev/null +++ b/gcc/ada/libgnat/a-nbnbin.adb @@ -0,0 +1,484 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- ADA.NUMERICS.BIG_NUMBERS.BIG_INTEGERS -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2019, 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +with Ada.Unchecked_Deallocation; +with Ada.Characters.Conversions; use Ada.Characters.Conversions; + +with Interfaces; use Interfaces; + +with System.Generic_Bignums; + +package body Ada.Numerics.Big_Numbers.Big_Integers is + + package Bignums is new + System.Generic_Bignums (Use_Secondary_Stack => False); + use Bignums, System; + + procedure Free is new Ada.Unchecked_Deallocation (Bignum_Data, Bignum); + + function Get_Bignum (Arg : Big_Integer) return Bignum is + (if Arg.Value.C = System.Null_Address + then raise Constraint_Error with "invalid big integer" + else To_Bignum (Arg.Value.C)); + -- Check for validity of Arg and return the Bignum value stored in Arg. + -- Raise Constraint_Error if Arg is uninitialized. + + procedure Set_Bignum (Arg : out Big_Integer; Value : Bignum) + with Inline; + -- Set the Bignum value stored in Arg to Value + + ---------------- + -- Set_Bignum -- + ---------------- + + procedure Set_Bignum (Arg : out Big_Integer; Value : Bignum) is + begin + Arg.Value.C := To_Address (Value); + end Set_Bignum; + + -------------- + -- Is_Valid -- + -------------- + + function Is_Valid (Arg : Big_Integer) return Boolean is + (Arg.Value.C /= System.Null_Address); + + --------- + -- "=" -- + --------- + + function "=" (L, R : Big_Integer) return Boolean is + begin + return Big_EQ (Get_Bignum (L), Get_Bignum (R)); + end "="; + + --------- + -- "<" -- + --------- + + function "<" (L, R : Big_Integer) return Boolean is + begin + return Big_LT (Get_Bignum (L), Get_Bignum (R)); + end "<"; + + ---------- + -- "<=" -- + ---------- + + function "<=" (L, R : Big_Integer) return Boolean is + begin + return Big_LE (Get_Bignum (L), Get_Bignum (R)); + end "<="; + + --------- + -- ">" -- + --------- + + function ">" (L, R : Big_Integer) return Boolean is + begin + return Big_GT (Get_Bignum (L), Get_Bignum (R)); + end ">"; + + ---------- + -- ">=" -- + ---------- + + function ">=" (L, R : Big_Integer) return Boolean is + begin + return Big_GE (Get_Bignum (L), Get_Bignum (R)); + end ">="; + + -------------------- + -- To_Big_Integer -- + -------------------- + + function To_Big_Integer (Arg : Integer) return Big_Integer is + Result : Big_Integer; + begin + Set_Bignum (Result, To_Bignum (Long_Long_Integer (Arg))); + return Result; + end To_Big_Integer; + + ---------------- + -- To_Integer -- + ---------------- + + function To_Integer (Arg : Big_Integer) return Integer is + begin + return Integer (From_Bignum (Get_Bignum (Arg))); + end To_Integer; + + ------------------------ + -- Signed_Conversions -- + ------------------------ + + package body Signed_Conversions is + + -------------------- + -- To_Big_Integer -- + -------------------- + + function To_Big_Integer (Arg : Int) return Big_Integer is + Result : Big_Integer; + begin + Set_Bignum (Result, To_Bignum (Long_Long_Integer (Arg))); + return Result; + end To_Big_Integer; + + ---------------------- + -- From_Big_Integer -- + ---------------------- + + function From_Big_Integer (Arg : Big_Integer) return Int is + begin + return Int (From_Bignum (Get_Bignum (Arg))); + end From_Big_Integer; + + end Signed_Conversions; + + -------------------------- + -- Unsigned_Conversions -- + -------------------------- + + package body Unsigned_Conversions is + + -------------------- + -- To_Big_Integer -- + -------------------- + + function To_Big_Integer (Arg : Int) return Big_Integer is + Result : Big_Integer; + begin + Set_Bignum (Result, To_Bignum (Unsigned_64 (Arg))); + return Result; + end To_Big_Integer; + + ---------------------- + -- From_Big_Integer -- + ---------------------- + + function From_Big_Integer (Arg : Big_Integer) return Int is + begin + return Int (From_Bignum (Get_Bignum (Arg))); + end From_Big_Integer; + + end Unsigned_Conversions; + + --------------- + -- To_String -- + --------------- + + Hex_Chars : constant array (0 .. 15) of Character := "0123456789ABCDEF"; + + function To_String + (Arg : Big_Integer; Width : Field := 0; Base : Number_Base := 10) + return String + is + Big_Base : constant Big_Integer := To_Big_Integer (Integer (Base)); + + function Add_Base (S : String) return String; + -- Add base information if Base /= 10 + + function Leading_Padding + (Str : String; + Min_Length : Field; + Char : Character := ' ') return String; + -- Return padding of Char concatenated with Str so that the resulting + -- string is at least Min_Length long. + + function Image (Arg : Big_Integer) return String; + -- Return image of Arg, assuming Arg is positive. + + function Image (N : Natural) return String; + -- Return image of N, with no leading space. + + -------------- + -- Add_Base -- + -------------- + + function Add_Base (S : String) return String is + begin + if Base = 10 then + return S; + else + return Image (Base) & "#" & S & "#"; + end if; + end Add_Base; + + ----------- + -- Image -- + ----------- + + function Image (N : Natural) return String is + S : constant String := Natural'Image (N); + begin + return S (2 .. S'Last); + end Image; + + function Image (Arg : Big_Integer) return String is + begin + if Arg < Big_Base then + return (1 => Hex_Chars (To_Integer (Arg))); + else + return Image (Arg / Big_Base) + & Hex_Chars (To_Integer (Arg rem Big_Base)); + end if; + end Image; + + --------------------- + -- Leading_Padding -- + --------------------- + + function Leading_Padding + (Str : String; + Min_Length : Field; + Char : Character := ' ') return String is + begin + return (1 .. Integer'Max (Integer (Min_Length) - Str'Length, 0) + => Char) & Str; + end Leading_Padding; + + begin + if Arg < To_Big_Integer (0) then + return Leading_Padding ("-" & Add_Base (Image (-Arg)), Width); + else + return Leading_Padding (" " & Add_Base (Image (Arg)), Width); + end if; + end To_String; + + ----------------- + -- From_String -- + ----------------- + + function From_String (Arg : String) return Big_Integer is + Result : Big_Integer; + begin + -- ??? only support Long_Long_Integer, good enough for now + Set_Bignum (Result, To_Bignum (Long_Long_Integer'Value (Arg))); + return Result; + end From_String; + + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (Stream : not null access Ada.Streams.Root_Stream_Type'Class; + Arg : Big_Integer) is + begin + Wide_Wide_String'Write (Stream, To_Wide_Wide_String (To_String (Arg))); + end Put_Image; + + --------- + -- "+" -- + --------- + + function "+" (L : Big_Integer) return Big_Integer is + Result : Big_Integer; + begin + Set_Bignum (Result, new Bignum_Data'(Get_Bignum (L).all)); + return Result; + end "+"; + + --------- + -- "-" -- + --------- + + function "-" (L : Big_Integer) return Big_Integer is + Result : Big_Integer; + begin + Set_Bignum (Result, Big_Neg (Get_Bignum (L))); + return Result; + end "-"; + + ----------- + -- "abs" -- + ----------- + + function "abs" (L : Big_Integer) return Big_Integer is + Result : Big_Integer; + begin + Set_Bignum (Result, Big_Abs (Get_Bignum (L))); + return Result; + end "abs"; + + --------- + -- "+" -- + --------- + + function "+" (L, R : Big_Integer) return Big_Integer is + Result : Big_Integer; + begin + Set_Bignum (Result, Big_Add (Get_Bignum (L), Get_Bignum (R))); + return Result; + end "+"; + + --------- + -- "-" -- + --------- + + function "-" (L, R : Big_Integer) return Big_Integer is + Result : Big_Integer; + begin + Set_Bignum (Result, Big_Sub (Get_Bignum (L), Get_Bignum (R))); + return Result; + end "-"; + + --------- + -- "*" -- + --------- + + function "*" (L, R : Big_Integer) return Big_Integer is + Result : Big_Integer; + begin + Set_Bignum (Result, Big_Mul (Get_Bignum (L), Get_Bignum (R))); + return Result; + end "*"; + + --------- + -- "/" -- + --------- + + function "/" (L, R : Big_Integer) return Big_Integer is + Result : Big_Integer; + begin + Set_Bignum (Result, Big_Div (Get_Bignum (L), Get_Bignum (R))); + return Result; + end "/"; + + ----------- + -- "mod" -- + ----------- + + function "mod" (L, R : Big_Integer) return Big_Integer is + Result : Big_Integer; + begin + Set_Bignum (Result, Big_Mod (Get_Bignum (L), Get_Bignum (R))); + return Result; + end "mod"; + + ----------- + -- "rem" -- + ----------- + + function "rem" (L, R : Big_Integer) return Big_Integer is + Result : Big_Integer; + begin + Set_Bignum (Result, Big_Rem (Get_Bignum (L), Get_Bignum (R))); + return Result; + end "rem"; + + ---------- + -- "**" -- + ---------- + + function "**" (L : Big_Integer; R : Natural) return Big_Integer is + begin + -- Explicitly check for validity before allocating Exp so that + -- the call to Get_Bignum below cannot raise an exception before + -- we get a chance to free Exp. + + if not Is_Valid (L) then + raise Constraint_Error with "invalid big integer"; + end if; + + declare + Exp : Bignum := To_Bignum (Long_Long_Integer (R)); + Result : Big_Integer; + begin + Set_Bignum (Result, Big_Exp (Get_Bignum (L), Exp)); + Free (Exp); + return Result; + end; + end "**"; + + --------- + -- Min -- + --------- + + function Min (L, R : Big_Integer) return Big_Integer is + (if L < R then L else R); + + --------- + -- Max -- + --------- + + function Max (L, R : Big_Integer) return Big_Integer is + (if L > R then L else R); + + ----------------------------- + -- Greatest_Common_Divisor -- + ----------------------------- + + function Greatest_Common_Divisor (L, R : Big_Integer) return Big_Positive is + function GCD (A, B : Big_Integer) return Big_Integer; + -- Recursive internal version + + --------- + -- GCD -- + --------- + + function GCD (A, B : Big_Integer) return Big_Integer is + begin + if Is_Zero (Get_Bignum (B)) then + return A; + else + return GCD (B, A rem B); + end if; + end GCD; + + begin + return GCD (abs L, abs R); + end Greatest_Common_Divisor; + + ------------ + -- Adjust -- + ------------ + + procedure Adjust (This : in out Controlled_Bignum) is + begin + if This.C /= System.Null_Address then + This.C := To_Address (new Bignum_Data'(To_Bignum (This.C).all)); + end if; + end Adjust; + + -------------- + -- Finalize -- + -------------- + + procedure Finalize (This : in out Controlled_Bignum) is + Tmp : Bignum := To_Bignum (This.C); + begin + Free (Tmp); + This.C := System.Null_Address; + end Finalize; + +end Ada.Numerics.Big_Numbers.Big_Integers; diff --git a/gcc/ada/libgnat/a-nbnbin.ads b/gcc/ada/libgnat/a-nbnbin.ads new file mode 100644 index 0000000..a54b09f --- /dev/null +++ b/gcc/ada/libgnat/a-nbnbin.ads @@ -0,0 +1,145 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- ADA.NUMERICS.BIG_NUMBERS.BIG_INTEGERS -- +-- -- +-- S p e c -- +-- -- +-- This specification is derived from the Ada Reference Manual for use with -- +-- GNAT. In accordance with the copyright of that document, you can freely -- +-- copy and modify this specification, provided that if you redistribute a -- +-- modified version, any changes that you have made are clearly indicated. -- +-- -- +------------------------------------------------------------------------------ + +with Ada.Finalization; +with Ada.Streams; + +private with System; + +-- Note that some Ada 2020 aspects are commented out since they are not +-- supported yet. + +package Ada.Numerics.Big_Numbers.Big_Integers + with Preelaborate +-- Nonblocking +is + type Big_Integer is private; + -- with Integer_Literal => From_String, + -- Put_Image => Put_Image; + + function Is_Valid (Arg : Big_Integer) return Boolean + with Convention => Intrinsic; + + function "=" (L, R : Big_Integer) return Boolean; + + function "<" (L, R : Big_Integer) return Boolean; + + function "<=" (L, R : Big_Integer) return Boolean; + + function ">" (L, R : Big_Integer) return Boolean; + + function ">=" (L, R : Big_Integer) return Boolean; + + function To_Big_Integer (Arg : Integer) return Big_Integer; + + subtype Big_Positive is Big_Integer + with Dynamic_Predicate => Big_Positive > To_Big_Integer (0), + Predicate_Failure => (raise Constraint_Error); + + subtype Big_Natural is Big_Integer + with Dynamic_Predicate => Big_Natural >= To_Big_Integer (0), + Predicate_Failure => (raise Constraint_Error); + + function In_Range (Arg, Low, High : Big_Integer) return Boolean is + ((Low <= Arg) and (Arg <= High)); + + function To_Integer (Arg : Big_Integer) return Integer + with Pre => In_Range (Arg, + Low => To_Big_Integer (Integer'First), + High => To_Big_Integer (Integer'Last)) + or else (raise Constraint_Error); + + generic + type Int is range <>; + package Signed_Conversions is + + function To_Big_Integer (Arg : Int) return Big_Integer; + + function From_Big_Integer (Arg : Big_Integer) return Int + with Pre => In_Range (Arg, + Low => To_Big_Integer (Int'First), + High => To_Big_Integer (Int'Last)) + or else (raise Constraint_Error); + + end Signed_Conversions; + + generic + type Int is mod <>; + package Unsigned_Conversions is + + function To_Big_Integer (Arg : Int) return Big_Integer; + + function From_Big_Integer (Arg : Big_Integer) return Int + with Pre => In_Range (Arg, + Low => To_Big_Integer (Int'First), + High => To_Big_Integer (Int'Last)) + or else (raise Constraint_Error); + + end Unsigned_Conversions; + + function To_String (Arg : Big_Integer; + Width : Field := 0; + Base : Number_Base := 10) return String + with Post => To_String'Result'First = 1; + + function From_String (Arg : String) return Big_Integer; + + procedure Put_Image + (Stream : not null access Ada.Streams.Root_Stream_Type'Class; + Arg : Big_Integer); + + function "+" (L : Big_Integer) return Big_Integer; + + function "-" (L : Big_Integer) return Big_Integer; + + function "abs" (L : Big_Integer) return Big_Integer; + + function "+" (L, R : Big_Integer) return Big_Integer; + + function "-" (L, R : Big_Integer) return Big_Integer; + + function "*" (L, R : Big_Integer) return Big_Integer; + + function "/" (L, R : Big_Integer) return Big_Integer; + + function "mod" (L, R : Big_Integer) return Big_Integer; + + function "rem" (L, R : Big_Integer) return Big_Integer; + + function "**" (L : Big_Integer; R : Natural) return Big_Integer; + + function Min (L, R : Big_Integer) return Big_Integer; + + function Max (L, R : Big_Integer) return Big_Integer; + + function Greatest_Common_Divisor + (L, R : Big_Integer) return Big_Positive + with Pre => (L /= To_Big_Integer (0) and R /= To_Big_Integer (0)) + or else (raise Constraint_Error); + +private + + type Controlled_Bignum is new Ada.Finalization.Controlled with record + C : System.Address := System.Null_Address; + end record; + + procedure Adjust (This : in out Controlled_Bignum); + procedure Finalize (This : in out Controlled_Bignum); + + type Big_Integer is record + Value : Controlled_Bignum; + end record; + +end Ada.Numerics.Big_Numbers.Big_Integers; diff --git a/gcc/ada/libgnat/a-nbnbin__gmp.adb b/gcc/ada/libgnat/a-nbnbin__gmp.adb new file mode 100644 index 0000000..041dfe2 --- /dev/null +++ b/gcc/ada/libgnat/a-nbnbin__gmp.adb @@ -0,0 +1,730 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- ADA.NUMERICS.BIG_NUMBERS.BIG_INTEGERS -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2019, 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This is the GMP version of this package + +with Ada.Unchecked_Conversion; +with Ada.Unchecked_Deallocation; +with Interfaces.C; use Interfaces.C; +with Interfaces.C.Strings; use Interfaces.C.Strings; +with Ada.Characters.Conversions; use Ada.Characters.Conversions; +with Ada.Characters.Handling; use Ada.Characters.Handling; + +package body Ada.Numerics.Big_Numbers.Big_Integers is + + use System; + + pragma Linker_Options ("-lgmp"); + + type mpz_t is record + mp_alloc : Integer; + mp_size : Integer; + mp_d : System.Address; + end record; + pragma Convention (C, mpz_t); + type mpz_t_ptr is access all mpz_t; + + function To_Mpz is new Ada.Unchecked_Conversion (System.Address, mpz_t_ptr); + function To_Address is new + Ada.Unchecked_Conversion (mpz_t_ptr, System.Address); + + function Get_Mpz (Arg : Optional_Big_Integer) return mpz_t_ptr is + (To_Mpz (Arg.Value.C)); + -- Return the mpz_t value stored in Arg + + procedure Set_Mpz (Arg : in out Optional_Big_Integer; Value : mpz_t_ptr) + with Inline; + -- Set the mpz_t value stored in Arg to Value + + procedure Allocate (This : in out Optional_Big_Integer) with Inline; + -- Allocate an Optional_Big_Integer, including the underlying mpz + + procedure mpz_init_set (ROP : access mpz_t; OP : access constant mpz_t); + pragma Import (C, mpz_init_set, "__gmpz_init_set"); + + procedure mpz_set (ROP : access mpz_t; OP : access constant mpz_t); + pragma Import (C, mpz_set, "__gmpz_set"); + + function mpz_cmp (OP1, OP2 : access constant mpz_t) return Integer; + pragma Import (C, mpz_cmp, "__gmpz_cmp"); + + function mpz_cmp_ui + (OP1 : access constant mpz_t; OP2 : unsigned_long) return Integer; + pragma Import (C, mpz_cmp_ui, "__gmpz_cmp_ui"); + + procedure mpz_set_si (ROP : access mpz_t; OP : long); + pragma Import (C, mpz_set_si, "__gmpz_set_si"); + + procedure mpz_set_ui (ROP : access mpz_t; OP : unsigned_long); + pragma Import (C, mpz_set_ui, "__gmpz_set_ui"); + + function mpz_get_si (OP : access constant mpz_t) return long; + pragma Import (C, mpz_get_si, "__gmpz_get_si"); + + function mpz_get_ui (OP : access constant mpz_t) return unsigned_long; + pragma Import (C, mpz_get_ui, "__gmpz_get_ui"); + + procedure mpz_neg (ROP : access mpz_t; OP : access constant mpz_t); + pragma Import (C, mpz_neg, "__gmpz_neg"); + + procedure mpz_sub (ROP : access mpz_t; OP1, OP2 : access constant mpz_t); + pragma Import (C, mpz_sub, "__gmpz_sub"); + + ------------- + -- Set_Mpz -- + ------------- + + procedure Set_Mpz (Arg : in out Optional_Big_Integer; Value : mpz_t_ptr) is + begin + Arg.Value.C := To_Address (Value); + end Set_Mpz; + + -------------- + -- Is_Valid -- + -------------- + + function Is_Valid (Arg : Optional_Big_Integer) return Boolean is + (Arg.Value.C /= System.Null_Address); + + -------------------------- + -- Invalid_Big_Integer -- + -------------------------- + + function Invalid_Big_Integer return Optional_Big_Integer is + (Value => (Ada.Finalization.Controlled with C => System.Null_Address)); + + --------- + -- "=" -- + --------- + + function "=" (L, R : Big_Integer) return Boolean is + begin + return mpz_cmp (Get_Mpz (L), Get_Mpz (R)) = 0; + end "="; + + --------- + -- "<" -- + --------- + + function "<" (L, R : Big_Integer) return Boolean is + begin + return mpz_cmp (Get_Mpz (L), Get_Mpz (R)) < 0; + end "<"; + + ---------- + -- "<=" -- + ---------- + + function "<=" (L, R : Big_Integer) return Boolean is + begin + return mpz_cmp (Get_Mpz (L), Get_Mpz (R)) <= 0; + end "<="; + + --------- + -- ">" -- + --------- + + function ">" (L, R : Big_Integer) return Boolean is + begin + return mpz_cmp (Get_Mpz (L), Get_Mpz (R)) > 0; + end ">"; + + ---------- + -- ">=" -- + ---------- + + function ">=" (L, R : Big_Integer) return Boolean is + begin + return mpz_cmp (Get_Mpz (L), Get_Mpz (R)) >= 0; + end ">="; + + -------------------- + -- To_Big_Integer -- + -------------------- + + function To_Big_Integer (Arg : Integer) return Big_Integer is + Result : Optional_Big_Integer; + begin + Allocate (Result); + mpz_set_si (Get_Mpz (Result), long (Arg)); + return Result; + end To_Big_Integer; + + ---------------- + -- To_Integer -- + ---------------- + + function To_Integer (Arg : Big_Integer) return Integer is + begin + return Integer (mpz_get_si (Get_Mpz (Arg))); + end To_Integer; + + ------------------------ + -- Signed_Conversions -- + ------------------------ + + package body Signed_Conversions is + + -------------------- + -- To_Big_Integer -- + -------------------- + + function To_Big_Integer (Arg : Int) return Big_Integer is + Result : Optional_Big_Integer; + begin + Allocate (Result); + mpz_set_si (Get_Mpz (Result), long (Arg)); + return Result; + end To_Big_Integer; + + ---------------------- + -- From_Big_Integer -- + ---------------------- + + function From_Big_Integer (Arg : Big_Integer) return Int is + begin + return Int (mpz_get_si (Get_Mpz (Arg))); + end From_Big_Integer; + + end Signed_Conversions; + + -------------------------- + -- Unsigned_Conversions -- + -------------------------- + + package body Unsigned_Conversions is + + -------------------- + -- To_Big_Integer -- + -------------------- + + function To_Big_Integer (Arg : Int) return Big_Integer is + Result : Optional_Big_Integer; + begin + Allocate (Result); + mpz_set_ui (Get_Mpz (Result), unsigned_long (Arg)); + return Result; + end To_Big_Integer; + + ---------------------- + -- From_Big_Integer -- + ---------------------- + + function From_Big_Integer (Arg : Big_Integer) return Int is + begin + return Int (mpz_get_ui (Get_Mpz (Arg))); + end From_Big_Integer; + + end Unsigned_Conversions; + + --------------- + -- To_String -- + --------------- + + function To_String + (Arg : Big_Integer; Width : Field := 0; Base : Number_Base := 10) + return String + is + function mpz_get_str + (STR : System.Address; + BASE : Integer; + OP : access constant mpz_t) return chars_ptr; + pragma Import (C, mpz_get_str, "__gmpz_get_str"); + + function mpz_sizeinbase + (this : access constant mpz_t; base : Integer) return size_t; + pragma Import (C, mpz_sizeinbase, "__gmpz_sizeinbase"); + + function Add_Base (S : String) return String; + -- Add base information if Base /= 10 + + function Leading_Padding + (Str : String; + Min_Length : Field; + Char : Character := ' ') return String; + -- Return padding of Char concatenated with Str so that the resulting + -- string is at least Min_Length long. + + function Image (N : Natural) return String; + -- Return image of N, with no leading space. + + -------------- + -- Add_Base -- + -------------- + + function Add_Base (S : String) return String is + begin + if Base = 10 then + return S; + else + return Image (Base) & "#" & To_Upper (S) & "#"; + end if; + end Add_Base; + + ----------- + -- Image -- + ----------- + + function Image (N : Natural) return String is + S : constant String := Natural'Image (N); + begin + return S (2 .. S'Last); + end Image; + + --------------------- + -- Leading_Padding -- + --------------------- + + function Leading_Padding + (Str : String; + Min_Length : Field; + Char : Character := ' ') return String is + begin + return (1 .. Integer'Max (Integer (Min_Length) - Str'Length, 0) + => Char) & Str; + end Leading_Padding; + + Number_Digits : constant Integer := + Integer (mpz_sizeinbase (Get_Mpz (Arg), Integer (abs Base))); + + Buffer : aliased String (1 .. Number_Digits + 2); + -- The correct number to allocate is 2 more than Number_Digits in order + -- to handle a possible minus sign and the null-terminator. + + Result : constant chars_ptr := + mpz_get_str (Buffer'Address, Integer (Base), Get_Mpz (Arg)); + S : constant String := Value (Result); + + begin + if S (1) = '-' then + return Leading_Padding ("-" & Add_Base (S (2 .. S'Last)), Width); + else + return Leading_Padding (" " & Add_Base (S), Width); + end if; + end To_String; + + ----------------- + -- From_String -- + ----------------- + + function From_String (Arg : String) return Big_Integer is + function mpz_set_str + (this : access mpz_t; + str : System.Address; + base : Integer := 10) return Integer; + pragma Import (C, mpz_set_str, "__gmpz_set_str"); + + Result : Optional_Big_Integer; + First : Natural; + Last : Natural; + Base : Natural; + + begin + Allocate (Result); + + if Arg (Arg'Last) /= '#' then + + -- Base 10 number + + First := Arg'First; + Last := Arg'Last; + Base := 10; + else + -- Compute the xx base in a xx#yyyyy# number + + if Arg'Length < 4 then + raise Constraint_Error; + end if; + + First := 0; + Last := Arg'Last - 1; + + for J in Arg'First + 1 .. Last loop + if Arg (J) = '#' then + First := J; + exit; + end if; + end loop; + + if First = 0 then + raise Constraint_Error; + end if; + + Base := Natural'Value (Arg (Arg'First .. First - 1)); + First := First + 1; + end if; + + declare + Str : aliased String (1 .. Last - First + 2); + Index : Natural := 0; + begin + -- Strip underscores + + for J in First .. Last loop + if Arg (J) /= '_' then + Index := Index + 1; + Str (Index) := Arg (J); + end if; + end loop; + + Index := Index + 1; + Str (Index) := ASCII.NUL; + + if mpz_set_str (Get_Mpz (Result), Str'Address, Base) /= 0 then + raise Constraint_Error; + end if; + end; + + return Result; + end From_String; + + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (Stream : not null access Ada.Streams.Root_Stream_Type'Class; + Arg : Big_Integer) is + begin + Wide_Wide_String'Write (Stream, To_Wide_Wide_String (To_String (Arg))); + end Put_Image; + + --------- + -- "+" -- + --------- + + function "+" (L : Big_Integer) return Big_Integer is + Result : Optional_Big_Integer; + begin + Set_Mpz (Result, new mpz_t); + mpz_init_set (Get_Mpz (Result), Get_Mpz (L)); + return Result; + end "+"; + + --------- + -- "-" -- + --------- + + function "-" (L : Big_Integer) return Big_Integer is + Result : Optional_Big_Integer; + begin + Allocate (Result); + mpz_neg (Get_Mpz (Result), Get_Mpz (L)); + return Result; + end "-"; + + ----------- + -- "abs" -- + ----------- + + function "abs" (L : Big_Integer) return Big_Integer is + procedure mpz_abs (ROP : access mpz_t; OP : access constant mpz_t); + pragma Import (C, mpz_abs, "__gmpz_abs"); + + Result : Optional_Big_Integer; + begin + Allocate (Result); + mpz_abs (Get_Mpz (Result), Get_Mpz (L)); + return Result; + end "abs"; + + --------- + -- "+" -- + --------- + + function "+" (L, R : Big_Integer) return Big_Integer is + procedure mpz_add + (ROP : access mpz_t; OP1, OP2 : access constant mpz_t); + pragma Import (C, mpz_add, "__gmpz_add"); + + Result : Optional_Big_Integer; + + begin + Allocate (Result); + mpz_add (Get_Mpz (Result), Get_Mpz (L), Get_Mpz (R)); + return Result; + end "+"; + + --------- + -- "-" -- + --------- + + function "-" (L, R : Big_Integer) return Big_Integer is + Result : Optional_Big_Integer; + begin + Allocate (Result); + mpz_sub (Get_Mpz (Result), Get_Mpz (L), Get_Mpz (R)); + return Result; + end "-"; + + --------- + -- "*" -- + --------- + + function "*" (L, R : Big_Integer) return Big_Integer is + procedure mpz_mul + (ROP : access mpz_t; OP1, OP2 : access constant mpz_t); + pragma Import (C, mpz_mul, "__gmpz_mul"); + + Result : Optional_Big_Integer; + + begin + Allocate (Result); + mpz_mul (Get_Mpz (Result), Get_Mpz (L), Get_Mpz (R)); + return Result; + end "*"; + + --------- + -- "/" -- + --------- + + function "/" (L, R : Big_Integer) return Big_Integer is + procedure mpz_tdiv_q (Q : access mpz_t; N, D : access constant mpz_t); + pragma Import (C, mpz_tdiv_q, "__gmpz_tdiv_q"); + begin + if mpz_cmp_ui (Get_Mpz (R), 0) = 0 then + raise Constraint_Error; + end if; + + declare + Result : Optional_Big_Integer; + begin + Allocate (Result); + mpz_tdiv_q (Get_Mpz (Result), Get_Mpz (L), Get_Mpz (R)); + return Result; + end; + end "/"; + + ----------- + -- "mod" -- + ----------- + + function "mod" (L, R : Big_Integer) return Big_Integer is + procedure mpz_mod (R : access mpz_t; N, D : access constant mpz_t); + pragma Import (C, mpz_mod, "__gmpz_mod"); + -- result is always non-negative + + L_Negative, R_Negative : Boolean; + + begin + if mpz_cmp_ui (Get_Mpz (R), 0) = 0 then + raise Constraint_Error; + end if; + + declare + Result : Optional_Big_Integer; + begin + Allocate (Result); + L_Negative := mpz_cmp_ui (Get_Mpz (L), 0) < 0; + R_Negative := mpz_cmp_ui (Get_Mpz (R), 0) < 0; + + if not (L_Negative or R_Negative) then + mpz_mod (Get_Mpz (Result), Get_Mpz (L), Get_Mpz (R)); + else + -- The GMP library provides operators defined by C semantics, but + -- the semantics of Ada's mod operator are not the same as C's + -- when negative values are involved. We do the following to + -- implement the required Ada semantics. + + declare + Temp_Left : Big_Integer; + Temp_Right : Big_Integer; + Temp_Result : Big_Integer; + + begin + Allocate (Temp_Result); + Set_Mpz (Temp_Left, new mpz_t); + Set_Mpz (Temp_Right, new mpz_t); + mpz_init_set (Get_Mpz (Temp_Left), Get_Mpz (L)); + mpz_init_set (Get_Mpz (Temp_Right), Get_Mpz (R)); + + if L_Negative then + mpz_neg (Get_Mpz (Temp_Left), Get_Mpz (Temp_Left)); + end if; + + if R_Negative then + mpz_neg (Get_Mpz (Temp_Right), Get_Mpz (Temp_Right)); + end if; + + -- now both Temp_Left and Temp_Right are nonnegative + + mpz_mod (Get_Mpz (Temp_Result), + Get_Mpz (Temp_Left), + Get_Mpz (Temp_Right)); + + if mpz_cmp_ui (Get_Mpz (Temp_Result), 0) = 0 then + -- if Temp_Result is zero we are done + mpz_set (Get_Mpz (Result), Get_Mpz (Temp_Result)); + + elsif L_Negative then + if R_Negative then + mpz_neg (Get_Mpz (Result), Get_Mpz (Temp_Result)); + else -- L is negative but R is not + mpz_sub (Get_Mpz (Result), + Get_Mpz (Temp_Right), + Get_Mpz (Temp_Result)); + end if; + else + pragma Assert (R_Negative); + mpz_sub (Get_Mpz (Result), + Get_Mpz (Temp_Result), + Get_Mpz (Temp_Right)); + end if; + end; + end if; + + return Result; + end; + end "mod"; + + ----------- + -- "rem" -- + ----------- + + function "rem" (L, R : Big_Integer) return Big_Integer is + procedure mpz_tdiv_r (R : access mpz_t; N, D : access constant mpz_t); + pragma Import (C, mpz_tdiv_r, "__gmpz_tdiv_r"); + -- R will have the same sign as N. + + begin + if mpz_cmp_ui (Get_Mpz (R), 0) = 0 then + raise Constraint_Error; + end if; + + declare + Result : Optional_Big_Integer; + begin + Allocate (Result); + mpz_tdiv_r (R => Get_Mpz (Result), + N => Get_Mpz (L), + D => Get_Mpz (R)); + -- the result takes the sign of N, as required by the RM + + return Result; + end; + end "rem"; + + ---------- + -- "**" -- + ---------- + + function "**" (L : Big_Integer; R : Natural) return Big_Integer is + procedure mpz_pow_ui (ROP : access mpz_t; + BASE : access constant mpz_t; + EXP : unsigned_long); + pragma Import (C, mpz_pow_ui, "__gmpz_pow_ui"); + + Result : Optional_Big_Integer; + + begin + Allocate (Result); + mpz_pow_ui (Get_Mpz (Result), Get_Mpz (L), unsigned_long (R)); + return Result; + end "**"; + + --------- + -- Min -- + --------- + + function Min (L, R : Big_Integer) return Big_Integer is + (if L < R then L else R); + + --------- + -- Max -- + --------- + + function Max (L, R : Big_Integer) return Big_Integer is + (if L > R then L else R); + + ----------------------------- + -- Greatest_Common_Divisor -- + ----------------------------- + + function Greatest_Common_Divisor (L, R : Big_Integer) return Big_Integer is + procedure mpz_gcd + (ROP : access mpz_t; Op1, Op2 : access constant mpz_t); + pragma Import (C, mpz_gcd, "__gmpz_gcd"); + + Result : Optional_Big_Integer; + + begin + Allocate (Result); + mpz_gcd (Get_Mpz (Result), Get_Mpz (L), Get_Mpz (R)); + return Result; + end Greatest_Common_Divisor; + + -------------- + -- Allocate -- + -------------- + + procedure Allocate (This : in out Optional_Big_Integer) is + procedure mpz_init (this : access mpz_t); + pragma Import (C, mpz_init, "__gmpz_init"); + begin + Set_Mpz (This, new mpz_t); + mpz_init (Get_Mpz (This)); + end Allocate; + + ------------ + -- Adjust -- + ------------ + + procedure Adjust (This : in out Controlled_Bignum) is + Value : constant mpz_t_ptr := To_Mpz (This.C); + begin + if Value /= null then + This.C := To_Address (new mpz_t); + mpz_init_set (To_Mpz (This.C), Value); + end if; + end Adjust; + + -------------- + -- Finalize -- + -------------- + + procedure Finalize (This : in out Controlled_Bignum) is + procedure Free is new Ada.Unchecked_Deallocation (mpz_t, mpz_t_ptr); + + procedure mpz_clear (this : access mpz_t); + pragma Import (C, mpz_clear, "__gmpz_clear"); + + Mpz : mpz_t_ptr; + + begin + if This.C /= System.Null_Address then + Mpz := To_Mpz (This.C); + mpz_clear (Mpz); + Free (Mpz); + This.C := System.Null_Address; + end if; + end Finalize; + +end Ada.Numerics.Big_Numbers.Big_Integers; diff --git a/gcc/ada/libgnat/a-nbnbre.adb b/gcc/ada/libgnat/a-nbnbre.adb new file mode 100644 index 0000000..c087f49 --- /dev/null +++ b/gcc/ada/libgnat/a-nbnbre.adb @@ -0,0 +1,540 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- ADA.NUMERICS.BIG_NUMBERS.BIG_REALS -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2019, 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This is the default version of this package, based on Big_Integers only. + +with Ada.Characters.Conversions; use Ada.Characters.Conversions; + +package body Ada.Numerics.Big_Numbers.Big_Reals is + + use Big_Integers; + + procedure Normalize (Arg : in out Big_Real); + -- Normalize Arg by ensuring that Arg.Den is always positive and that + -- Arg.Num and Arg.Den always have a GCD of 1. + + -------------- + -- Is_Valid -- + -------------- + + function Is_Valid (Arg : Big_Real) return Boolean is + (Is_Valid (Arg.Num) and then Is_Valid (Arg.Den)); + + --------- + -- "/" -- + --------- + + function "/" (Num, Den : Big_Integer) return Big_Real is + Result : Big_Real; + begin + if Den = To_Big_Integer (0) then + raise Constraint_Error with "divide by zero"; + end if; + + Result.Num := Num; + Result.Den := Den; + Normalize (Result); + return Result; + end "/"; + + --------------- + -- Numerator -- + --------------- + + function Numerator (Arg : Big_Real) return Big_Integer is (Arg.Num); + + ----------------- + -- Denominator -- + ----------------- + + function Denominator (Arg : Big_Real) return Big_Positive is (Arg.Den); + + --------- + -- "=" -- + --------- + + function "=" (L, R : Big_Real) return Boolean is + (abs L.Num = abs R.Num and then L.Den = R.Den); + + --------- + -- "<" -- + --------- + + function "<" (L, R : Big_Real) return Boolean is + (abs L.Num * R.Den < abs R.Num * L.Den); + + ---------- + -- "<=" -- + ---------- + + function "<=" (L, R : Big_Real) return Boolean is (not (R < L)); + + --------- + -- ">" -- + --------- + + function ">" (L, R : Big_Real) return Boolean is (R < L); + + ---------- + -- ">=" -- + ---------- + + function ">=" (L, R : Big_Real) return Boolean is (not (L < R)); + + ----------------------- + -- Float_Conversions -- + ----------------------- + + package body Float_Conversions is + + ----------------- + -- To_Big_Real -- + ----------------- + + function To_Big_Real (Arg : Num) return Big_Real is + begin + return From_String (Arg'Image); + end To_Big_Real; + + ------------------- + -- From_Big_Real -- + ------------------- + + function From_Big_Real (Arg : Big_Real) return Num is + begin + return Num'Value (To_String (Arg)); + end From_Big_Real; + + end Float_Conversions; + + ----------------------- + -- Fixed_Conversions -- + ----------------------- + + package body Fixed_Conversions is + + ----------------- + -- To_Big_Real -- + ----------------- + + function To_Big_Real (Arg : Num) return Big_Real is + begin + return From_String (Arg'Image); + end To_Big_Real; + + ------------------- + -- From_Big_Real -- + ------------------- + + function From_Big_Real (Arg : Big_Real) return Num is + begin + return Num'Value (To_String (Arg)); + end From_Big_Real; + + end Fixed_Conversions; + + --------------- + -- To_String -- + --------------- + + function To_String + (Arg : Big_Real; Fore : Field := 2; Aft : Field := 3; Exp : Field := 0) + return String + is + Zero : constant Big_Integer := To_Big_Integer (0); + Ten : constant Big_Integer := To_Big_Integer (10); + + function Leading_Padding + (Str : String; + Min_Length : Field; + Char : Character := ' ') return String; + -- Return padding of Char concatenated with Str so that the resulting + -- string is at least Min_Length long. + + function Trailing_Padding + (Str : String; + Length : Field; + Char : Character := '0') return String; + -- Return Str with trailing Char removed, and if needed either + -- truncated or concatenated with padding of Char so that the resulting + -- string is Length long. + + function Image (N : Natural) return String; + -- Return image of N, with no leading space. + + function Numerator_Image + (Num : Big_Integer; + After : Natural) return String; + -- Return image of Num as a float value with After digits after the "." + -- and taking Fore, Aft, Exp into account. + + ----------- + -- Image -- + ----------- + + function Image (N : Natural) return String is + S : constant String := Natural'Image (N); + begin + return S (2 .. S'Last); + end Image; + + --------------------- + -- Leading_Padding -- + --------------------- + + function Leading_Padding + (Str : String; + Min_Length : Field; + Char : Character := ' ') return String is + begin + if Str = "" then + return Leading_Padding ("0", Min_Length, Char); + else + return (1 .. Integer'Max (Integer (Min_Length) - Str'Length, 0) + => Char) & Str; + end if; + end Leading_Padding; + + ---------------------- + -- Trailing_Padding -- + ---------------------- + + function Trailing_Padding + (Str : String; + Length : Field; + Char : Character := '0') return String is + begin + if Str'Length > 0 and then Str (Str'Last) = Char then + for J in reverse Str'Range loop + if Str (J) /= '0' then + return Trailing_Padding + (Str (Str'First .. J), Length, Char); + end if; + end loop; + end if; + + if Str'Length >= Length then + return Str (Str'First .. Str'First + Length - 1); + else + return Str & + (1 .. Integer'Max (Integer (Length) - Str'Length, 0) + => Char); + end if; + end Trailing_Padding; + + --------------------- + -- Numerator_Image -- + --------------------- + + function Numerator_Image + (Num : Big_Integer; + After : Natural) return String + is + Tmp : constant String := To_String (Num); + Str : constant String (1 .. Tmp'Last - 1) := Tmp (2 .. Tmp'Last); + Index : Integer; + + begin + if After = 0 then + return Leading_Padding (Str, Fore) & "." + & Trailing_Padding ("0", Aft); + else + Index := Str'Last - After; + + if Index < 0 then + return Leading_Padding ("0", Fore) + & "." + & Trailing_Padding ((1 .. -Index => '0') & Str, Aft) + & (if Exp = 0 then "" else "E+" & Image (Natural (Exp))); + else + return Leading_Padding (Str (Str'First .. Index), Fore) + & "." + & Trailing_Padding (Str (Index + 1 .. Str'Last), Aft) + & (if Exp = 0 then "" else "E+" & Image (Natural (Exp))); + end if; + end if; + end Numerator_Image; + + begin + if Arg.Num < Zero then + declare + Str : String := To_String (-Arg, Fore, Aft, Exp); + begin + if Str (1) = ' ' then + for J in 1 .. Str'Last - 1 loop + if Str (J + 1) /= ' ' then + Str (J) := '-'; + exit; + end if; + end loop; + + return Str; + else + return '-' & Str; + end if; + end; + else + -- Compute Num * 10^Aft so that we get Aft significant digits + -- in the integer part (rounded) to display. + + return Numerator_Image + ((Arg.Num * Ten ** Aft) / Arg.Den, After => Exp + Aft); + end if; + end To_String; + + ----------------- + -- From_String -- + ----------------- + + function From_String (Arg : String) return Big_Real is + Ten : constant Big_Integer := To_Big_Integer (10); + Frac : Big_Integer; + Exp : Integer := 0; + Pow : Natural := 0; + Index : Natural := 0; + Last : Natural := Arg'Last; + + begin + for J in reverse Arg'Range loop + if Arg (J) in 'e' | 'E' then + if Last /= Arg'Last then + raise Constraint_Error with "multiple exponents specified"; + end if; + + Last := J - 1; + Exp := Integer'Value (Arg (J + 1 .. Arg'Last)); + Pow := 0; + + elsif Arg (J) = '.' then + Index := J - 1; + exit; + else + Pow := Pow + 1; + end if; + end loop; + + if Index = 0 then + raise Constraint_Error with "invalid real value"; + end if; + + declare + Result : Big_Real; + begin + Result.Den := Ten ** Pow; + Result.Num := From_String (Arg (Arg'First .. Index)) * Result.Den; + Frac := From_String (Arg (Index + 2 .. Last)); + + if Result.Num < To_Big_Integer (0) then + Result.Num := Result.Num - Frac; + else + Result.Num := Result.Num + Frac; + end if; + + if Exp > 0 then + Result.Num := Result.Num * Ten ** Exp; + elsif Exp < 0 then + Result.Den := Result.Den * Ten ** (-Exp); + end if; + + Normalize (Result); + return Result; + end; + end From_String; + + -------------------------- + -- From_Quotient_String -- + -------------------------- + + function From_Quotient_String (Arg : String) return Big_Real is + Index : Natural := 0; + begin + for J in Arg'First + 1 .. Arg'Last - 1 loop + if Arg (J) = '/' then + Index := J; + exit; + end if; + end loop; + + if Index = 0 then + raise Constraint_Error with "no quotient found"; + end if; + + return Big_Integers.From_String (Arg (Arg'First .. Index - 1)) / + Big_Integers.From_String (Arg (Index + 1 .. Arg'Last)); + end From_Quotient_String; + + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (Stream : not null access Ada.Streams.Root_Stream_Type'Class; + Arg : Big_Real) is + begin + Wide_Wide_String'Write (Stream, To_Wide_Wide_String (To_String (Arg))); + end Put_Image; + + --------- + -- "+" -- + --------- + + function "+" (L : Big_Real) return Big_Real is + Result : Big_Real; + begin + Result.Num := L.Num; + Result.Den := L.Den; + return Result; + end "+"; + + --------- + -- "-" -- + --------- + + function "-" (L : Big_Real) return Big_Real is + (Num => -L.Num, Den => L.Den); + + ----------- + -- "abs" -- + ----------- + + function "abs" (L : Big_Real) return Big_Real is + (Num => abs L.Num, Den => L.Den); + + --------- + -- "+" -- + --------- + + function "+" (L, R : Big_Real) return Big_Real is + Result : Big_Real; + begin + Result.Num := L.Num * R.Den + R.Num * L.Den; + Result.Den := L.Den * R.Den; + Normalize (Result); + return Result; + end "+"; + + --------- + -- "-" -- + --------- + + function "-" (L, R : Big_Real) return Big_Real is + Result : Big_Real; + begin + Result.Num := L.Num * R.Den - R.Num * L.Den; + Result.Den := L.Den * R.Den; + Normalize (Result); + return Result; + end "-"; + + --------- + -- "*" -- + --------- + + function "*" (L, R : Big_Real) return Big_Real is + Result : Big_Real; + begin + Result.Num := L.Num * R.Num; + Result.Den := L.Den * R.Den; + Normalize (Result); + return Result; + end "*"; + + --------- + -- "/" -- + --------- + + function "/" (L, R : Big_Real) return Big_Real is + Result : Big_Real; + begin + Result.Num := L.Num * R.Den; + Result.Den := L.Den * R.Num; + Normalize (Result); + return Result; + end "/"; + + ---------- + -- "**" -- + ---------- + + function "**" (L : Big_Real; R : Integer) return Big_Real is + Result : Big_Real; + begin + if R = 0 then + Result.Num := To_Big_Integer (1); + Result.Den := To_Big_Integer (1); + else + if R < 0 then + Result.Num := L.Den ** (-R); + Result.Den := L.Num ** (-R); + else + Result.Num := L.Num ** R; + Result.Den := L.Den ** R; + end if; + + Normalize (Result); + end if; + + return Result; + end "**"; + + --------- + -- Min -- + --------- + + function Min (L, R : Big_Real) return Big_Real is (if L < R then L else R); + + --------- + -- Max -- + --------- + + function Max (L, R : Big_Real) return Big_Real is (if L > R then L else R); + + --------------- + -- Normalize -- + --------------- + + procedure Normalize (Arg : in out Big_Real) is + begin + if Arg.Den < To_Big_Integer (0) then + Arg.Num := -Arg.Num; + Arg.Den := -Arg.Den; + end if; + + declare + GCD : constant Big_Integer := + Greatest_Common_Divisor (Arg.Num, Arg.Den); + begin + Arg.Num := Arg.Num / GCD; + Arg.Den := Arg.Den / GCD; + end; + end Normalize; + +end Ada.Numerics.Big_Numbers.Big_Reals; diff --git a/gcc/ada/libgnat/a-nbnbre.ads b/gcc/ada/libgnat/a-nbnbre.ads new file mode 100644 index 0000000..4827caa --- /dev/null +++ b/gcc/ada/libgnat/a-nbnbre.ads @@ -0,0 +1,138 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- ADA.NUMERICS.BIG_NUMBERS.BIG_REALS -- +-- -- +-- S p e c -- +-- -- +-- This specification is derived from the Ada Reference Manual for use with -- +-- GNAT. In accordance with the copyright of that document, you can freely -- +-- copy and modify this specification, provided that if you redistribute a -- +-- modified version, any changes that you have made are clearly indicated. -- +-- -- +------------------------------------------------------------------------------ + +with Ada.Numerics.Big_Numbers.Big_Integers; +with Ada.Streams; + +-- Note that some Ada 2020 aspects are commented out since they are not +-- supported yet. + +package Ada.Numerics.Big_Numbers.Big_Reals + with Preelaborate +-- Nonblocking, Global => in out synchronized Big_Reals +is + type Big_Real is private; +-- with Real_Literal => From_String, +-- Put_Image => Put_Image; + + function Is_Valid (Arg : Big_Real) return Boolean; + + function "/" (Num, Den : Big_Integers.Big_Integer) return Big_Real; +-- with Pre => (if Big_Integers."=" (Den, Big_Integers.To_Big_Integer (0)) +-- then raise Constraint_Error); + + function Numerator (Arg : Big_Real) return Big_Integers.Big_Integer; + + function Denominator (Arg : Big_Real) return Big_Integers.Big_Positive + with Post => + (Arg = To_Real (0)) or else + (Big_Integers."=" + (Big_Integers.Greatest_Common_Divisor + (Numerator (Arg), Denominator'Result), + Big_Integers.To_Big_Integer (1))); + + function To_Big_Real + (Arg : Big_Integers.Big_Integer) + return Big_Real is (Arg / Big_Integers.To_Big_Integer (1)); + + function To_Real (Arg : Integer) return Big_Real is + (Big_Integers.To_Big_Integer (Arg) / Big_Integers.To_Big_Integer (1)); + + function "=" (L, R : Big_Real) return Boolean; + + function "<" (L, R : Big_Real) return Boolean; + + function "<=" (L, R : Big_Real) return Boolean; + + function ">" (L, R : Big_Real) return Boolean; + + function ">=" (L, R : Big_Real) return Boolean; + + function In_Range (Arg, Low, High : Big_Real) return Boolean is + (Low <= Arg and then Arg <= High); + + generic + type Num is digits <>; + package Float_Conversions is + + function To_Big_Real (Arg : Num) return Big_Real; + + function From_Big_Real (Arg : Big_Real) return Num + with Pre => In_Range (Arg, + Low => To_Big_Real (Num'First), + High => To_Big_Real (Num'Last)) + or else (raise Constraint_Error); + + end Float_Conversions; + + generic + type Num is delta <>; + package Fixed_Conversions is + + function To_Big_Real (Arg : Num) return Big_Real; + + function From_Big_Real (Arg : Big_Real) return Num + with Pre => In_Range (Arg, + Low => To_Big_Real (Num'First), + High => To_Big_Real (Num'Last)) + or else (raise Constraint_Error); + + end Fixed_Conversions; + + function To_String (Arg : Big_Real; + Fore : Field := 2; + Aft : Field := 3; + Exp : Field := 0) return String + with Post => To_String'Result'First = 1; + + function From_String (Arg : String) return Big_Real; + + function To_Quotient_String (Arg : Big_Real) return String is + (Big_Integers.To_String (Numerator (Arg)) & " / " + & Big_Integers.To_String (Denominator (Arg))); + + function From_Quotient_String (Arg : String) return Big_Real; + + procedure Put_Image + (Stream : not null access Ada.Streams.Root_Stream_Type'Class; + Arg : Big_Real); + + function "+" (L : Big_Real) return Big_Real; + + function "-" (L : Big_Real) return Big_Real; + + function "abs" (L : Big_Real) return Big_Real; + + function "+" (L, R : Big_Real) return Big_Real; + + function "-" (L, R : Big_Real) return Big_Real; + + function "*" (L, R : Big_Real) return Big_Real; + + function "/" (L, R : Big_Real) return Big_Real; + + function "**" (L : Big_Real; R : Integer) return Big_Real; + + function Min (L, R : Big_Real) return Big_Real; + + function Max (L, R : Big_Real) return Big_Real; + +private + + type Big_Real is record + Num, Den : Big_Integers.Big_Integer; + end record; + +end Ada.Numerics.Big_Numbers.Big_Reals; diff --git a/gcc/ada/libgnat/a-nubinu.ads b/gcc/ada/libgnat/a-nubinu.ads new file mode 100644 index 0000000..a25e39c --- /dev/null +++ b/gcc/ada/libgnat/a-nubinu.ads @@ -0,0 +1,25 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- A D A . N U M E R I C S -- +-- -- +-- S p e c -- +-- -- +-- This specification is derived from the Ada Reference Manual for use with -- +-- GNAT. In accordance with the copyright of that document, you can freely -- +-- copy and modify this specification, provided that if you redistribute a -- +-- modified version, any changes that you have made are clearly indicated. -- +-- -- +------------------------------------------------------------------------------ + +-- Note that some Ada 2020 aspects are commented out since they are not +-- supported yet. + +package Ada.Numerics.Big_Numbers + -- with Pure, Nonblocking, Global => null + with Pure +is + subtype Field is Integer range 0 .. 255; + subtype Number_Base is Integer range 2 .. 16; +end Ada.Numerics.Big_Numbers; diff --git a/gcc/ada/libgnat/g-exptty.adb b/gcc/ada/libgnat/g-exptty.adb index b193448..758be7a 100644 --- a/gcc/ada/libgnat/g-exptty.adb +++ b/gcc/ada/libgnat/g-exptty.adb @@ -38,8 +38,9 @@ package body GNAT.Expect.TTY is On_Windows : constant Boolean := Directory_Separator = '\'; -- True when on Windows - function Waitpid (Process : System.Address; Blocking : Integer) - return Integer; + function Waitpid + (Process : System.Address; + Blocking : Integer) return Integer; pragma Import (C, Waitpid, "__gnat_tty_waitpid"); -- Wait for a specific process id, and return its exit code @@ -48,8 +49,7 @@ package body GNAT.Expect.TTY is ------------------------ function Is_Process_Running - (Descriptor : in out TTY_Process_Descriptor) - return Boolean + (Descriptor : in out TTY_Process_Descriptor) return Boolean is begin if Descriptor.Process = System.Null_Address then @@ -57,6 +57,7 @@ package body GNAT.Expect.TTY is end if; Descriptor.Exit_Status := Waitpid (Descriptor.Process, Blocking => 0); + return Descriptor.Exit_Status = Still_Active; end Is_Process_Running; @@ -106,17 +107,20 @@ package body GNAT.Expect.TTY is Status := Waitpid (Descriptor.Process, Blocking => 0); if Status = Still_Active then - -- In theory the process might hav died since the check. In + -- In theory the process might have died since the check. In -- practice the following calls should not cause any issue. + Interrupt (Descriptor); delay (0.05); Terminate_Process (Descriptor.Process); Status := Waitpid (Descriptor.Process, Blocking => 1); Descriptor.Exit_Status := Status; end if; + else -- If Exit_Status is not STILL_ACTIVE just retrieve the saved - -- exit status + -- exit status. + Status := Descriptor.Exit_Status; end if; diff --git a/gcc/ada/libgnat/g-exptty.ads b/gcc/ada/libgnat/g-exptty.ads index f61ea62..683a453 100644 --- a/gcc/ada/libgnat/g-exptty.ads +++ b/gcc/ada/libgnat/g-exptty.ads @@ -95,7 +95,7 @@ package GNAT.Expect.TTY is function Is_Process_Running (Descriptor : in out TTY_Process_Descriptor) return Boolean; - -- Return True is the process is still alive + -- Returns True if the process is still alive private @@ -142,7 +142,7 @@ private Process : System.Address := System.Null_Address; -- Underlying structure used in C Exit_Status : Integer := Still_Active; - -- Hold the exit status of the process. + -- Holds the exit status of the process Use_Pipes : Boolean := True; end record; diff --git a/gcc/ada/libgnat/s-aotase.adb b/gcc/ada/libgnat/s-aotase.adb new file mode 100644 index 0000000..7ed6ab8 --- /dev/null +++ b/gcc/ada/libgnat/s-aotase.adb @@ -0,0 +1,66 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- System.Atomic_Operations.Test_And_Set -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2019, 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +with System.Atomic_Primitives; use System.Atomic_Primitives; + +package body System.Atomic_Operations.Test_And_Set is + + ------------------------- + -- Atomic_Test_And_Set -- + ------------------------- + + function Atomic_Test_And_Set + (Item : aliased in out Test_And_Set_Flag) return Boolean is + begin + return Boolean (Atomic_Test_And_Set (Item'Address)); + end Atomic_Test_And_Set; + + ------------------ + -- Atomic_Clear -- + ------------------ + + procedure Atomic_Clear + (Item : aliased in out Test_And_Set_Flag) is + begin + Atomic_Clear (Item'Address); + end Atomic_Clear; + + ------------------ + -- Is_Lock_Free -- + ------------------ + + function Is_Lock_Free (Item : aliased Test_And_Set_Flag) return Boolean is + pragma Unreferenced (Item); + begin + return True; + end Is_Lock_Free; + +end System.Atomic_Operations.Test_And_Set; diff --git a/gcc/ada/libgnat/s-aotase.ads b/gcc/ada/libgnat/s-aotase.ads new file mode 100644 index 0000000..0406630 --- /dev/null +++ b/gcc/ada/libgnat/s-aotase.ads @@ -0,0 +1,55 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- System.Atomic_Operations.Test_And_Set -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2019, 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +package System.Atomic_Operations.Test_And_Set + with Pure +-- Nonblocking +is + type Test_And_Set_Flag is mod 2 ** 8 + with Atomic, Default_Value => 0, Size => 8; + + function Atomic_Test_And_Set + (Item : aliased in out Test_And_Set_Flag) return Boolean + with Convention => Intrinsic; + + procedure Atomic_Clear + (Item : aliased in out Test_And_Set_Flag) + with Convention => Intrinsic; + + function Is_Lock_Free + (Item : aliased Test_And_Set_Flag) return Boolean + with Convention => Intrinsic; + +private + pragma Inline_Always (Atomic_Test_And_Set); + pragma Inline_Always (Atomic_Clear); + pragma Inline_Always (Is_Lock_Free); +end System.Atomic_Operations.Test_And_Set; diff --git a/gcc/ada/libgnat/s-atoope.ads b/gcc/ada/libgnat/s-atoope.ads new file mode 100644 index 0000000..cbe089b --- /dev/null +++ b/gcc/ada/libgnat/s-atoope.ads @@ -0,0 +1,35 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- S Y S T E M . A T O M I C _ O P E R A T I O N S -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2019, 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +package System.Atomic_Operations + with Pure +is +end System.Atomic_Operations; diff --git a/gcc/ada/libgnat/s-atopar.adb b/gcc/ada/libgnat/s-atopar.adb new file mode 100644 index 0000000..82cfbd3 --- /dev/null +++ b/gcc/ada/libgnat/s-atopar.adb @@ -0,0 +1,147 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- System.Atomic_Operations.Arithmetic -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2019, 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +with System.Atomic_Primitives; use System.Atomic_Primitives; +with Interfaces.C; + +package body System.Atomic_Operations.Arithmetic is + + ---------------- + -- Atomic_Add -- + ---------------- + + procedure Atomic_Add + (Item : aliased in out Atomic_Type; + Value : Atomic_Type) + is + Ignore : constant Atomic_Type := Atomic_Fetch_And_Add (Item, Value); + begin + null; + end Atomic_Add; + + --------------------- + -- Atomic_Subtract -- + --------------------- + + procedure Atomic_Subtract + (Item : aliased in out Atomic_Type; + Value : Atomic_Type) + is + Ignore : constant Atomic_Type := Atomic_Fetch_And_Subtract (Item, Value); + begin + null; + end Atomic_Subtract; + + -------------------------- + -- Atomic_Fetch_And_Add -- + -------------------------- + + function Atomic_Fetch_And_Add + (Item : aliased in out Atomic_Type; + Value : Atomic_Type) return Atomic_Type + is + pragma Warnings (Off); + function Atomic_Fetch_Add_1 + (Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst) + return Atomic_Type; + pragma Import (Intrinsic, Atomic_Fetch_Add_1, "__atomic_fetch_add_1"); + function Atomic_Fetch_Add_2 + (Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst) + return Atomic_Type; + pragma Import (Intrinsic, Atomic_Fetch_Add_2, "__atomic_fetch_add_2"); + function Atomic_Fetch_Add_4 + (Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst) + return Atomic_Type; + pragma Import (Intrinsic, Atomic_Fetch_Add_4, "__atomic_fetch_add_4"); + function Atomic_Fetch_Add_8 + (Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst) + return Atomic_Type; + pragma Import (Intrinsic, Atomic_Fetch_Add_8, "__atomic_fetch_add_8"); + pragma Warnings (On); + + begin + case Item'Size is + when 8 => return Atomic_Fetch_Add_1 (Item'Address, Value); + when 16 => return Atomic_Fetch_Add_2 (Item'Address, Value); + when 32 => return Atomic_Fetch_Add_4 (Item'Address, Value); + when 64 => return Atomic_Fetch_Add_8 (Item'Address, Value); + when others => raise Program_Error; + end case; + end Atomic_Fetch_And_Add; + + ------------------------------- + -- Atomic_Fetch_And_Subtract -- + ------------------------------- + + function Atomic_Fetch_And_Subtract + (Item : aliased in out Atomic_Type; + Value : Atomic_Type) return Atomic_Type + is + pragma Warnings (Off); + function Atomic_Fetch_Sub_1 + (Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst) + return Atomic_Type; + pragma Import (Intrinsic, Atomic_Fetch_Sub_1, "__atomic_fetch_sub_1"); + function Atomic_Fetch_Sub_2 + (Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst) + return Atomic_Type; + pragma Import (Intrinsic, Atomic_Fetch_Sub_2, "__atomic_fetch_sub_2"); + function Atomic_Fetch_Sub_4 + (Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst) + return Atomic_Type; + pragma Import (Intrinsic, Atomic_Fetch_Sub_4, "__atomic_fetch_sub_4"); + function Atomic_Fetch_Sub_8 + (Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst) + return Atomic_Type; + pragma Import (Intrinsic, Atomic_Fetch_Sub_8, "__atomic_fetch_sub_8"); + pragma Warnings (On); + + begin + case Item'Size is + when 8 => return Atomic_Fetch_Sub_1 (Item'Address, Value); + when 16 => return Atomic_Fetch_Sub_2 (Item'Address, Value); + when 32 => return Atomic_Fetch_Sub_4 (Item'Address, Value); + when 64 => return Atomic_Fetch_Sub_8 (Item'Address, Value); + when others => raise Program_Error; + end case; + end Atomic_Fetch_And_Subtract; + + ------------------ + -- Is_Lock_Free -- + ------------------ + + function Is_Lock_Free (Item : aliased Atomic_Type) return Boolean is + use type Interfaces.C.size_t; + begin + return Boolean (Atomic_Always_Lock_Free (Item'Size / 8)); + end Is_Lock_Free; + +end System.Atomic_Operations.Arithmetic; diff --git a/gcc/ada/libgnat/s-atopar.ads b/gcc/ada/libgnat/s-atopar.ads new file mode 100644 index 0000000..73c2447 --- /dev/null +++ b/gcc/ada/libgnat/s-atopar.ads @@ -0,0 +1,65 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- System.Atomic_Operations.Arithmetic -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2019, 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +pragma Ada_2020; + +generic + type Atomic_Type is range <> with Atomic; +package System.Atomic_Operations.Arithmetic + with Pure +-- Nonblocking +is + procedure Atomic_Add + (Item : aliased in out Atomic_Type; + Value : Atomic_Type) with Convention => Intrinsic; + + procedure Atomic_Subtract + (Item : aliased in out Atomic_Type; + Value : Atomic_Type) with Convention => Intrinsic; + + function Atomic_Fetch_And_Add + (Item : aliased in out Atomic_Type; + Value : Atomic_Type) return Atomic_Type with Convention => Intrinsic; + + function Atomic_Fetch_And_Subtract + (Item : aliased in out Atomic_Type; + Value : Atomic_Type) return Atomic_Type with Convention => Intrinsic; + + function Is_Lock_Free + (Item : aliased Atomic_Type) return Boolean with Convention => Intrinsic; + +private + pragma Inline_Always (Atomic_Add); + pragma Inline_Always (Atomic_Subtract); + pragma Inline_Always (Atomic_Fetch_And_Add); + pragma Inline_Always (Atomic_Fetch_And_Subtract); + pragma Inline_Always (Is_Lock_Free); +end System.Atomic_Operations.Arithmetic; diff --git a/gcc/ada/libgnat/s-atopex.adb b/gcc/ada/libgnat/s-atopex.adb new file mode 100644 index 0000000..624d3d5 --- /dev/null +++ b/gcc/ada/libgnat/s-atopex.adb @@ -0,0 +1,159 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- System.Atomic_Operations.Exchange -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2019, 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +with System.Atomic_Primitives; use System.Atomic_Primitives; +with Interfaces.C; + +package body System.Atomic_Operations.Exchange is + + --------------------- + -- Atomic_Exchange -- + --------------------- + + function Atomic_Exchange + (Item : aliased in out Atomic_Type; + Value : Atomic_Type) return Atomic_Type + is + pragma Warnings (Off); + function Atomic_Exchange_1 + (Ptr : System.Address; + Val : Atomic_Type; + Model : Mem_Model := Seq_Cst) return Atomic_Type; + pragma Import (Intrinsic, Atomic_Exchange_1, "__atomic_exchange_1"); + function Atomic_Exchange_2 + (Ptr : System.Address; + Val : Atomic_Type; + Model : Mem_Model := Seq_Cst) return Atomic_Type; + pragma Import (Intrinsic, Atomic_Exchange_2, "__atomic_exchange_2"); + function Atomic_Exchange_4 + (Ptr : System.Address; + Val : Atomic_Type; + Model : Mem_Model := Seq_Cst) return Atomic_Type; + pragma Import (Intrinsic, Atomic_Exchange_4, "__atomic_exchange_4"); + function Atomic_Exchange_8 + (Ptr : System.Address; + Val : Atomic_Type; + Model : Mem_Model := Seq_Cst) return Atomic_Type; + pragma Import (Intrinsic, Atomic_Exchange_8, "__atomic_exchange_8"); + pragma Warnings (On); + + begin + case Item'Size is + when 8 => return Atomic_Exchange_1 (Item'Address, Value); + when 16 => return Atomic_Exchange_2 (Item'Address, Value); + when 32 => return Atomic_Exchange_4 (Item'Address, Value); + when 64 => return Atomic_Exchange_8 (Item'Address, Value); + when others => raise Program_Error; + end case; + end Atomic_Exchange; + + --------------------------------- + -- Atomic_Compare_And_Exchange -- + --------------------------------- + + function Atomic_Compare_And_Exchange + (Item : aliased in out Atomic_Type; + Prior : aliased in out Atomic_Type; + Desired : Atomic_Type) return Boolean + is + pragma Warnings (Off); + function Atomic_Compare_Exchange_1 + (Ptr : System.Address; + Expected : System.Address; + Desired : Atomic_Type; + Weak : bool := False; + Success_Model : Mem_Model := Seq_Cst; + Failure_Model : Mem_Model := Seq_Cst) return bool; + pragma Import + (Intrinsic, Atomic_Compare_Exchange_1, "__atomic_compare_exchange_1"); + function Atomic_Compare_Exchange_2 + (Ptr : System.Address; + Expected : System.Address; + Desired : Atomic_Type; + Weak : bool := False; + Success_Model : Mem_Model := Seq_Cst; + Failure_Model : Mem_Model := Seq_Cst) return bool; + pragma Import + (Intrinsic, Atomic_Compare_Exchange_2, "__atomic_compare_exchange_2"); + function Atomic_Compare_Exchange_4 + (Ptr : System.Address; + Expected : System.Address; + Desired : Atomic_Type; + Weak : bool := False; + Success_Model : Mem_Model := Seq_Cst; + Failure_Model : Mem_Model := Seq_Cst) return bool; + pragma Import + (Intrinsic, Atomic_Compare_Exchange_4, "__atomic_compare_exchange_4"); + function Atomic_Compare_Exchange_8 + (Ptr : System.Address; + Expected : System.Address; + Desired : Atomic_Type; + Weak : bool := False; + Success_Model : Mem_Model := Seq_Cst; + Failure_Model : Mem_Model := Seq_Cst) return bool; + pragma Import + (Intrinsic, Atomic_Compare_Exchange_8, "__atomic_compare_exchange_8"); + pragma Warnings (On); + + begin + case Item'Size is + when 8 => + return Boolean + (Atomic_Compare_Exchange_1 + (Item'Address, Prior'Address, Desired)); + when 16 => + return Boolean + (Atomic_Compare_Exchange_2 + (Item'Address, Prior'Address, Desired)); + when 32 => + return Boolean + (Atomic_Compare_Exchange_4 + (Item'Address, Prior'Address, Desired)); + when 64 => + return Boolean + (Atomic_Compare_Exchange_8 + (Item'Address, Prior'Address, Desired)); + when others => + raise Program_Error; + end case; + end Atomic_Compare_And_Exchange; + + ------------------ + -- Is_Lock_Free -- + ------------------ + + function Is_Lock_Free (Item : aliased Atomic_Type) return Boolean is + use type Interfaces.C.size_t; + begin + return Boolean (Atomic_Always_Lock_Free (Item'Size / 8)); + end Is_Lock_Free; + +end System.Atomic_Operations.Exchange; diff --git a/gcc/ada/libgnat/s-atopex.ads b/gcc/ada/libgnat/s-atopex.ads new file mode 100644 index 0000000..51db0b9 --- /dev/null +++ b/gcc/ada/libgnat/s-atopex.ads @@ -0,0 +1,56 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- System.Atomic_Operations.Exchange -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2019, 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +pragma Ada_2020; + +generic + type Atomic_Type is private with Atomic; +package System.Atomic_Operations.Exchange + with Pure +-- Blocking +is + function Atomic_Exchange + (Item : aliased in out Atomic_Type; + Value : Atomic_Type) return Atomic_Type with Convention => Intrinsic; + + function Atomic_Compare_And_Exchange + (Item : aliased in out Atomic_Type; + Prior : aliased in out Atomic_Type; + Desired : Atomic_Type) return Boolean with Convention => Intrinsic; + + function Is_Lock_Free + (Item : aliased Atomic_Type) return Boolean with Convention => Intrinsic; + +private + pragma Inline_Always (Atomic_Exchange); + pragma Inline_Always (Atomic_Compare_And_Exchange); + pragma Inline_Always (Is_Lock_Free); +end System.Atomic_Operations.Exchange; diff --git a/gcc/ada/libgnat/s-atopri.ads b/gcc/ada/libgnat/s-atopri.ads index c4ac47f..b65156a 100644 --- a/gcc/ada/libgnat/s-atopri.ads +++ b/gcc/ada/libgnat/s-atopri.ads @@ -33,8 +33,10 @@ -- functions and operations used by the compiler to generate the lock-free -- implementation of protected objects. +with Interfaces.C; + package System.Atomic_Primitives is - pragma Preelaborate; + pragma Pure; type uint is mod 2 ** Long_Integer'Size; @@ -60,6 +62,9 @@ package System.Atomic_Primitives is subtype Mem_Model is Integer range Relaxed .. Last; + type bool is new Boolean; + pragma Convention (C, bool); + ------------------------------------ -- GCC built-in atomic primitives -- ------------------------------------ @@ -130,6 +135,22 @@ package System.Atomic_Primitives is -- Atomic_Compare_Exchange_8, -- "__atomic_compare_exchange_1"); + function Atomic_Test_And_Set + (Ptr : System.Address; + Model : Mem_Model := Seq_Cst) return bool; + pragma Import (Intrinsic, Atomic_Test_And_Set, "__atomic_test_and_set"); + + procedure Atomic_Clear + (Ptr : System.Address; + Model : Mem_Model := Seq_Cst); + pragma Import (Intrinsic, Atomic_Clear, "__atomic_clear"); + + function Atomic_Always_Lock_Free + (Size : Interfaces.C.size_t; + Ptr : System.Address := System.Null_Address) return bool; + pragma Import + (Intrinsic, Atomic_Always_Lock_Free, "__atomic_always_lock_free"); + -------------------------- -- Lock-free operations -- -------------------------- diff --git a/gcc/ada/libgnat/s-bignum.adb b/gcc/ada/libgnat/s-bignum.adb index e0f31c1..bde6c1f 100644 --- a/gcc/ada/libgnat/s-bignum.adb +++ b/gcc/ada/libgnat/s-bignum.adb @@ -29,1077 +29,68 @@ -- -- ------------------------------------------------------------------------------ --- This package provides arbitrary precision signed integer arithmetic for --- use in computing intermediate values in expressions for the case where --- pragma Overflow_Check (Eliminate) is in effect. - -with System; use System; -with System.Secondary_Stack; use System.Secondary_Stack; -with System.Storage_Elements; use System.Storage_Elements; +with System.Generic_Bignums; +with Ada.Unchecked_Conversion; package body System.Bignums is - use Interfaces; - -- So that operations on Unsigned_32 are available - - type DD is mod Base ** 2; - -- Double length digit used for intermediate computations - - function MSD (X : DD) return SD is (SD (X / Base)); - function LSD (X : DD) return SD is (SD (X mod Base)); - -- Most significant and least significant digit of double digit value - - function "&" (X, Y : SD) return DD is (DD (X) * Base + DD (Y)); - -- Compose double digit value from two single digit values - - subtype LLI is Long_Long_Integer; - - One_Data : constant Digit_Vector (1 .. 1) := (1 => 1); - -- Constant one - - Zero_Data : constant Digit_Vector (1 .. 0) := (1 .. 0 => 0); - -- Constant zero - - ----------------------- - -- Local Subprograms -- - ----------------------- - - function Add - (X, Y : Digit_Vector; - X_Neg : Boolean; - Y_Neg : Boolean) return Bignum - with - Pre => X'First = 1 and then Y'First = 1; - -- This procedure adds two signed numbers returning the Sum, it is used - -- for both addition and subtraction. The value computed is X + Y, with - -- X_Neg and Y_Neg giving the signs of the operands. - - function Allocate_Bignum (Len : Length) return Bignum with - Post => Allocate_Bignum'Result.Len = Len; - -- Allocate Bignum value of indicated length on secondary stack. On return - -- the Neg and D fields are left uninitialized. - - type Compare_Result is (LT, EQ, GT); - -- Indicates result of comparison in following call - - function Compare - (X, Y : Digit_Vector; - X_Neg, Y_Neg : Boolean) return Compare_Result - with - Pre => X'First = 1 and then Y'First = 1; - -- Compare (X with sign X_Neg) with (Y with sign Y_Neg), and return the - -- result of the signed comparison. - - procedure Div_Rem - (X, Y : Bignum; - Quotient : out Bignum; - Remainder : out Bignum; - Discard_Quotient : Boolean := False; - Discard_Remainder : Boolean := False); - -- Returns the Quotient and Remainder from dividing abs (X) by abs (Y). The - -- values of X and Y are not modified. If Discard_Quotient is True, then - -- Quotient is undefined on return, and if Discard_Remainder is True, then - -- Remainder is undefined on return. Service routine for Big_Div/Rem/Mod. - - procedure Free_Bignum (X : Bignum) is null; - -- Called to free a Bignum value used in intermediate computations. In - -- this implementation using the secondary stack, it does nothing at all, - -- because we rely on Mark/Release, but it may be of use for some - -- alternative implementation. - - function Normalize - (X : Digit_Vector; - Neg : Boolean := False) return Bignum; - -- Given a digit vector and sign, allocate and construct a Bignum value. - -- Note that X may have leading zeroes which must be removed, and if the - -- result is zero, the sign is forced positive. - - --------- - -- Add -- - --------- - - function Add - (X, Y : Digit_Vector; - X_Neg : Boolean; - Y_Neg : Boolean) return Bignum - is - begin - -- If signs are the same, we are doing an addition, it is convenient to - -- ensure that the first operand is the longer of the two. - - if X_Neg = Y_Neg then - if X'Last < Y'Last then - return Add (X => Y, Y => X, X_Neg => Y_Neg, Y_Neg => X_Neg); - - -- Here signs are the same, and the first operand is the longer - - else - pragma Assert (X_Neg = Y_Neg and then X'Last >= Y'Last); - - -- Do addition, putting result in Sum (allowing for carry) - - declare - Sum : Digit_Vector (0 .. X'Last); - RD : DD; - - begin - RD := 0; - for J in reverse 1 .. X'Last loop - RD := RD + DD (X (J)); - - if J >= 1 + (X'Last - Y'Last) then - RD := RD + DD (Y (J - (X'Last - Y'Last))); - end if; - - Sum (J) := LSD (RD); - RD := RD / Base; - end loop; - - Sum (0) := SD (RD); - return Normalize (Sum, X_Neg); - end; - end if; - - -- Signs are different so really this is a subtraction, we want to make - -- sure that the largest magnitude operand is the first one, and then - -- the result will have the sign of the first operand. - - else - declare - CR : constant Compare_Result := Compare (X, Y, False, False); - - begin - if CR = EQ then - return Normalize (Zero_Data); - - elsif CR = LT then - return Add (X => Y, Y => X, X_Neg => Y_Neg, Y_Neg => X_Neg); - - else - pragma Assert (X_Neg /= Y_Neg and then CR = GT); - - -- Do subtraction, putting result in Diff - - declare - Diff : Digit_Vector (1 .. X'Length); - RD : DD; - - begin - RD := 0; - for J in reverse 1 .. X'Last loop - RD := RD + DD (X (J)); - - if J >= 1 + (X'Last - Y'Last) then - RD := RD - DD (Y (J - (X'Last - Y'Last))); - end if; - - Diff (J) := LSD (RD); - RD := (if RD < Base then 0 else -1); - end loop; - - return Normalize (Diff, X_Neg); - end; - end if; - end; - end if; - end Add; - - --------------------- - -- Allocate_Bignum -- - --------------------- - - function Allocate_Bignum (Len : Length) return Bignum is - Addr : Address; - - begin - -- Change the if False here to if True to get allocation on the heap - -- instead of the secondary stack, which is convenient for debugging - -- System.Bignum itself. - - if False then - declare - B : Bignum; - begin - B := new Bignum_Data'(Len, False, (others => 0)); - return B; - end; - - -- Normal case of allocation on the secondary stack - - else - -- Note: The approach used here is designed to avoid strict aliasing - -- warnings that appeared previously using unchecked conversion. - - SS_Allocate (Addr, Storage_Offset (4 + 4 * Len)); - - declare - B : Bignum; - for B'Address use Addr'Address; - pragma Import (Ada, B); - - BD : Bignum_Data (Len); - for BD'Address use Addr; - pragma Import (Ada, BD); - - -- Expose a writable view of discriminant BD.Len so that we can - -- initialize it. We need to use the exact layout of the record - -- to ensure that the Length field has 24 bits as expected. - - type Bignum_Data_Header is record - Len : Length; - Neg : Boolean; - end record; - - for Bignum_Data_Header use record - Len at 0 range 0 .. 23; - Neg at 3 range 0 .. 7; - end record; - - BDH : Bignum_Data_Header; - for BDH'Address use BD'Address; - pragma Import (Ada, BDH); - - pragma Assert (BDH.Len'Size = BD.Len'Size); - - begin - BDH.Len := Len; - return B; - end; - end if; - end Allocate_Bignum; - - ------------- - -- Big_Abs -- - ------------- - - function Big_Abs (X : Bignum) return Bignum is - begin - return Normalize (X.D); - end Big_Abs; - - ------------- - -- Big_Add -- - ------------- - - function Big_Add (X, Y : Bignum) return Bignum is - begin - return Add (X.D, Y.D, X.Neg, Y.Neg); - end Big_Add; - - ------------- - -- Big_Div -- - ------------- - - -- This table is excerpted from RM 4.5.5(28-30) and shows how the result - -- varies with the signs of the operands. - - -- A B A/B A B A/B - -- - -- 10 5 2 -10 5 -2 - -- 11 5 2 -11 5 -2 - -- 12 5 2 -12 5 -2 - -- 13 5 2 -13 5 -2 - -- 14 5 2 -14 5 -2 - -- - -- A B A/B A B A/B - -- - -- 10 -5 -2 -10 -5 2 - -- 11 -5 -2 -11 -5 2 - -- 12 -5 -2 -12 -5 2 - -- 13 -5 -2 -13 -5 2 - -- 14 -5 -2 -14 -5 2 - - function Big_Div (X, Y : Bignum) return Bignum is - Q, R : Bignum; - begin - Div_Rem (X, Y, Q, R, Discard_Remainder => True); - Q.Neg := Q.Len > 0 and then (X.Neg xor Y.Neg); - return Q; - end Big_Div; - - ------------- - -- Big_Exp -- - ------------- - - function Big_Exp (X, Y : Bignum) return Bignum is + package Sec_Stack_Bignums is new + System.Generic_Bignums (Use_Secondary_Stack => True); + use Sec_Stack_Bignums; - function "**" (X : Bignum; Y : SD) return Bignum; - -- Internal routine where we know right operand is one word + function "+" is new Ada.Unchecked_Conversion + (Bignum, Sec_Stack_Bignums.Bignum); - ---------- - -- "**" -- - ---------- + function "-" is new Ada.Unchecked_Conversion + (Sec_Stack_Bignums.Bignum, Bignum); - function "**" (X : Bignum; Y : SD) return Bignum is - begin - case Y is + function Big_Add (X, Y : Bignum) return Bignum is + (-Sec_Stack_Bignums.Big_Add (+X, +Y)); - -- X ** 0 is 1 - - when 0 => - return Normalize (One_Data); - - -- X ** 1 is X - - when 1 => - return Normalize (X.D); - - -- X ** 2 is X * X - - when 2 => - return Big_Mul (X, X); - - -- For X greater than 2, use the recursion - - -- X even, X ** Y = (X ** (Y/2)) ** 2; - -- X odd, X ** Y = (X ** (Y/2)) ** 2 * X; - - when others => - declare - XY2 : constant Bignum := X ** (Y / 2); - XY2S : constant Bignum := Big_Mul (XY2, XY2); - Res : Bignum; - - begin - Free_Bignum (XY2); - - -- Raise storage error if intermediate value is getting too - -- large, which we arbitrarily define as 200 words for now. - - if XY2S.Len > 200 then - Free_Bignum (XY2S); - raise Storage_Error with - "exponentiation result is too large"; - end if; - - -- Otherwise take care of even/odd cases - - if (Y and 1) = 0 then - return XY2S; - - else - Res := Big_Mul (XY2S, X); - Free_Bignum (XY2S); - return Res; - end if; - end; - end case; - end "**"; - - -- Start of processing for Big_Exp - - begin - -- Error if right operand negative - - if Y.Neg then - raise Constraint_Error with "exponentiation to negative power"; - - -- X ** 0 is always 1 (including 0 ** 0, so do this test first) - - elsif Y.Len = 0 then - return Normalize (One_Data); - - -- 0 ** X is always 0 (for X non-zero) - - elsif X.Len = 0 then - return Normalize (Zero_Data); - - -- (+1) ** Y = 1 - -- (-1) ** Y = +/-1 depending on whether Y is even or odd - - elsif X.Len = 1 and then X.D (1) = 1 then - return Normalize - (X.D, Neg => X.Neg and then ((Y.D (Y.Len) and 1) = 1)); - - -- If the absolute value of the base is greater than 1, then the - -- exponent must not be bigger than one word, otherwise the result - -- is ludicrously large, and we just signal Storage_Error right away. - - elsif Y.Len > 1 then - raise Storage_Error with "exponentiation result is too large"; - - -- Special case (+/-)2 ** K, where K is 1 .. 31 using a shift - - elsif X.Len = 1 and then X.D (1) = 2 and then Y.D (1) < 32 then - declare - D : constant Digit_Vector (1 .. 1) := - (1 => Shift_Left (SD'(1), Natural (Y.D (1)))); - begin - return Normalize (D, X.Neg); - end; - - -- Remaining cases have right operand of one word - - else - return X ** Y.D (1); - end if; - end Big_Exp; - - ------------ - -- Big_EQ -- - ------------ - - function Big_EQ (X, Y : Bignum) return Boolean is - begin - return Compare (X.D, Y.D, X.Neg, Y.Neg) = EQ; - end Big_EQ; - - ------------ - -- Big_GE -- - ------------ - - function Big_GE (X, Y : Bignum) return Boolean is - begin - return Compare (X.D, Y.D, X.Neg, Y.Neg) /= LT; - end Big_GE; - - ------------ - -- Big_GT -- - ------------ - - function Big_GT (X, Y : Bignum) return Boolean is - begin - return Compare (X.D, Y.D, X.Neg, Y.Neg) = GT; - end Big_GT; - - ------------ - -- Big_LE -- - ------------ - - function Big_LE (X, Y : Bignum) return Boolean is - begin - return Compare (X.D, Y.D, X.Neg, Y.Neg) /= GT; - end Big_LE; - - ------------ - -- Big_LT -- - ------------ - - function Big_LT (X, Y : Bignum) return Boolean is - begin - return Compare (X.D, Y.D, X.Neg, Y.Neg) = LT; - end Big_LT; - - ------------- - -- Big_Mod -- - ------------- - - -- This table is excerpted from RM 4.5.5(28-30) and shows how the result - -- of Rem and Mod vary with the signs of the operands. - - -- A B A mod B A rem B A B A mod B A rem B - - -- 10 5 0 0 -10 5 0 0 - -- 11 5 1 1 -11 5 4 -1 - -- 12 5 2 2 -12 5 3 -2 - -- 13 5 3 3 -13 5 2 -3 - -- 14 5 4 4 -14 5 1 -4 - - -- A B A mod B A rem B A B A mod B A rem B - - -- 10 -5 0 0 -10 -5 0 0 - -- 11 -5 -4 1 -11 -5 -1 -1 - -- 12 -5 -3 2 -12 -5 -2 -2 - -- 13 -5 -2 3 -13 -5 -3 -3 - -- 14 -5 -1 4 -14 -5 -4 -4 - - function Big_Mod (X, Y : Bignum) return Bignum is - Q, R : Bignum; - - begin - -- If signs are same, result is same as Rem - - if X.Neg = Y.Neg then - return Big_Rem (X, Y); - - -- Case where Mod is different - - else - -- Do division - - Div_Rem (X, Y, Q, R, Discard_Quotient => True); - - -- Zero result is unchanged - - if R.Len = 0 then - return R; - - -- Otherwise adjust result - - else - declare - T1 : constant Bignum := Big_Sub (Y, R); - begin - T1.Neg := Y.Neg; - Free_Bignum (R); - return T1; - end; - end if; - end if; - end Big_Mod; - - ------------- - -- Big_Mul -- - ------------- + function Big_Sub (X, Y : Bignum) return Bignum is + (-Sec_Stack_Bignums.Big_Sub (+X, +Y)); function Big_Mul (X, Y : Bignum) return Bignum is - Result : Digit_Vector (1 .. X.Len + Y.Len) := (others => 0); - -- Accumulate result (max length of result is sum of operand lengths) - - L : Length; - -- Current result digit - - D : DD; - -- Result digit - - begin - for J in 1 .. X.Len loop - for K in 1 .. Y.Len loop - L := Result'Last - (X.Len - J) - (Y.Len - K); - D := DD (X.D (J)) * DD (Y.D (K)) + DD (Result (L)); - Result (L) := LSD (D); - D := D / Base; - - -- D is carry which must be propagated + (-Sec_Stack_Bignums.Big_Mul (+X, +Y)); - while D /= 0 and then L >= 1 loop - L := L - 1; - D := D + DD (Result (L)); - Result (L) := LSD (D); - D := D / Base; - end loop; + function Big_Div (X, Y : Bignum) return Bignum is + (-Sec_Stack_Bignums.Big_Div (+X, +Y)); - -- Must not have a carry trying to extend max length + function Big_Exp (X, Y : Bignum) return Bignum is + (-Sec_Stack_Bignums.Big_Exp (+X, +Y)); - pragma Assert (D = 0); - end loop; - end loop; - - -- Return result - - return Normalize (Result, X.Neg xor Y.Neg); - end Big_Mul; - - ------------ - -- Big_NE -- - ------------ - - function Big_NE (X, Y : Bignum) return Boolean is - begin - return Compare (X.D, Y.D, X.Neg, Y.Neg) /= EQ; - end Big_NE; - - ------------- - -- Big_Neg -- - ------------- - - function Big_Neg (X : Bignum) return Bignum is - begin - return Normalize (X.D, not X.Neg); - end Big_Neg; - - ------------- - -- Big_Rem -- - ------------- - - -- This table is excerpted from RM 4.5.5(28-30) and shows how the result - -- varies with the signs of the operands. - - -- A B A rem B A B A rem B - - -- 10 5 0 -10 5 0 - -- 11 5 1 -11 5 -1 - -- 12 5 2 -12 5 -2 - -- 13 5 3 -13 5 -3 - -- 14 5 4 -14 5 -4 - - -- A B A rem B A B A rem B - - -- 10 -5 0 -10 -5 0 - -- 11 -5 1 -11 -5 -1 - -- 12 -5 2 -12 -5 -2 - -- 13 -5 3 -13 -5 -3 - -- 14 -5 4 -14 -5 -4 + function Big_Mod (X, Y : Bignum) return Bignum is + (-Sec_Stack_Bignums.Big_Mod (+X, +Y)); function Big_Rem (X, Y : Bignum) return Bignum is - Q, R : Bignum; - begin - Div_Rem (X, Y, Q, R, Discard_Quotient => True); - R.Neg := R.Len > 0 and then X.Neg; - return R; - end Big_Rem; - - ------------- - -- Big_Sub -- - ------------- - - function Big_Sub (X, Y : Bignum) return Bignum is - begin - -- If right operand zero, return left operand (avoiding sharing) - - if Y.Len = 0 then - return Normalize (X.D, X.Neg); - - -- Otherwise add negative of right operand - - else - return Add (X.D, Y.D, X.Neg, not Y.Neg); - end if; - end Big_Sub; - - ------------- - -- Compare -- - ------------- - - function Compare - (X, Y : Digit_Vector; - X_Neg, Y_Neg : Boolean) return Compare_Result - is - begin - -- Signs are different, that's decisive, since 0 is always plus - - if X_Neg /= Y_Neg then - return (if X_Neg then LT else GT); - - -- Lengths are different, that's decisive since no leading zeroes - - elsif X'Last /= Y'Last then - return (if (X'Last > Y'Last) xor X_Neg then GT else LT); - - -- Need to compare data - - else - for J in X'Range loop - if X (J) /= Y (J) then - return (if (X (J) > Y (J)) xor X_Neg then GT else LT); - end if; - end loop; - - return EQ; - end if; - end Compare; - - ------------- - -- Div_Rem -- - ------------- - - procedure Div_Rem - (X, Y : Bignum; - Quotient : out Bignum; - Remainder : out Bignum; - Discard_Quotient : Boolean := False; - Discard_Remainder : Boolean := False) - is - begin - -- Error if division by zero - - if Y.Len = 0 then - raise Constraint_Error with "division by zero"; - end if; - - -- Handle simple cases with special tests - - -- If X < Y then quotient is zero and remainder is X - - if Compare (X.D, Y.D, False, False) = LT then - Remainder := Normalize (X.D); - Quotient := Normalize (Zero_Data); - return; - - -- If both X and Y are less than 2**63-1, we can use Long_Long_Integer - -- arithmetic. Note it is good not to do an accurate range check against - -- Long_Long_Integer since -2**63 / -1 overflows. - - elsif (X.Len <= 1 or else (X.Len = 2 and then X.D (1) < 2**31)) - and then - (Y.Len <= 1 or else (Y.Len = 2 and then Y.D (1) < 2**31)) - then - declare - A : constant LLI := abs (From_Bignum (X)); - B : constant LLI := abs (From_Bignum (Y)); - begin - Quotient := To_Bignum (A / B); - Remainder := To_Bignum (A rem B); - return; - end; - - -- Easy case if divisor is one digit - - elsif Y.Len = 1 then - declare - ND : DD; - Div : constant DD := DD (Y.D (1)); - - Result : Digit_Vector (1 .. X.Len); - Remdr : Digit_Vector (1 .. 1); - - begin - ND := 0; - for J in 1 .. X.Len loop - ND := Base * ND + DD (X.D (J)); - Result (J) := SD (ND / Div); - ND := ND rem Div; - end loop; - - Quotient := Normalize (Result); - Remdr (1) := SD (ND); - Remainder := Normalize (Remdr); - return; - end; - end if; - - -- The complex full multi-precision case. We will employ algorithm - -- D defined in the section "The Classical Algorithms" (sec. 4.3.1) - -- of Donald Knuth's "The Art of Computer Programming", Vol. 2, 2nd - -- edition. The terminology is adjusted for this section to match that - -- reference. - - -- We are dividing X.Len digits of X (called u here) by Y.Len digits - -- of Y (called v here), developing the quotient and remainder. The - -- numbers are represented using Base, which was chosen so that we have - -- the operations of multiplying to single digits (SD) to form a double - -- digit (DD), and dividing a double digit (DD) by a single digit (SD) - -- to give a single digit quotient and a single digit remainder. - - -- Algorithm D from Knuth - - -- Comments here with square brackets are directly from Knuth - - Algorithm_D : declare - - -- The following lower case variables correspond exactly to the - -- terminology used in algorithm D. - - m : constant Length := X.Len - Y.Len; - n : constant Length := Y.Len; - b : constant DD := Base; - - u : Digit_Vector (0 .. m + n); - v : Digit_Vector (1 .. n); - q : Digit_Vector (0 .. m); - r : Digit_Vector (1 .. n); - - u0 : SD renames u (0); - v1 : SD renames v (1); - v2 : SD renames v (2); - - d : DD; - j : Length; - qhat : DD; - rhat : DD; - temp : DD; - - begin - -- Initialize data of left and right operands - - for J in 1 .. m + n loop - u (J) := X.D (J); - end loop; - - for J in 1 .. n loop - v (J) := Y.D (J); - end loop; - - -- [Division of nonnegative integers.] Given nonnegative integers u - -- = (ul,u2..um+n) and v = (v1,v2..vn), where v1 /= 0 and n > 1, we - -- form the quotient u / v = (q0,ql..qm) and the remainder u mod v = - -- (r1,r2..rn). - - pragma Assert (v1 /= 0); - pragma Assert (n > 1); - - -- Dl. [Normalize.] Set d = b/(vl + 1). Then set (u0,u1,u2..um+n) - -- equal to (u1,u2..um+n) times d, and set (v1,v2..vn) equal to - -- (v1,v2..vn) times d. Note the introduction of a new digit position - -- u0 at the left of u1; if d = 1 all we need to do in this step is - -- to set u0 = 0. - - d := b / (DD (v1) + 1); - - if d = 1 then - u0 := 0; - - else - declare - Carry : DD; - Tmp : DD; - - begin - -- Multiply Dividend (u) by d - - Carry := 0; - for J in reverse 1 .. m + n loop - Tmp := DD (u (J)) * d + Carry; - u (J) := LSD (Tmp); - Carry := Tmp / Base; - end loop; - - u0 := SD (Carry); - - -- Multiply Divisor (v) by d - - Carry := 0; - for J in reverse 1 .. n loop - Tmp := DD (v (J)) * d + Carry; - v (J) := LSD (Tmp); - Carry := Tmp / Base; - end loop; - - pragma Assert (Carry = 0); - end; - end if; - - -- D2. [Initialize j.] Set j = 0. The loop on j, steps D2 through D7, - -- will be essentially a division of (uj, uj+1..uj+n) by (v1,v2..vn) - -- to get a single quotient digit qj. - - j := 0; - - -- Loop through digits - - loop - -- Note: In the original printing, step D3 was as follows: - - -- D3. [Calculate qhat.] If uj = v1, set qhat to b-l; otherwise - -- set qhat to (uj,uj+1)/v1. Now test if v2 * qhat is greater than - -- (uj*b + uj+1 - qhat*v1)*b + uj+2. If so, decrease qhat by 1 and - -- repeat this test - - -- This had a bug not discovered till 1995, see Vol 2 errata: - -- http://www-cs-faculty.stanford.edu/~uno/err2-2e.ps.gz. Under - -- rare circumstances the expression in the test could overflow. - -- This version was further corrected in 2005, see Vol 2 errata: - -- http://www-cs-faculty.stanford.edu/~uno/all2-pre.ps.gz. - -- The code below is the fixed version of this step. - - -- D3. [Calculate qhat.] Set qhat to (uj,uj+1)/v1 and rhat to - -- to (uj,uj+1) mod v1. - - temp := u (j) & u (j + 1); - qhat := temp / DD (v1); - rhat := temp mod DD (v1); - - -- D3 (continued). Now test if qhat >= b or v2*qhat > (rhat,uj+2): - -- if so, decrease qhat by 1, increase rhat by v1, and repeat this - -- test if rhat < b. [The test on v2 determines at high speed - -- most of the cases in which the trial value qhat is one too - -- large, and eliminates all cases where qhat is two too large.] - - while qhat >= b - or else DD (v2) * qhat > LSD (rhat) & u (j + 2) - loop - qhat := qhat - 1; - rhat := rhat + DD (v1); - exit when rhat >= b; - end loop; - - -- D4. [Multiply and subtract.] Replace (uj,uj+1..uj+n) by - -- (uj,uj+1..uj+n) minus qhat times (v1,v2..vn). This step - -- consists of a simple multiplication by a one-place number, - -- combined with a subtraction. - - -- The digits (uj,uj+1..uj+n) are always kept positive; if the - -- result of this step is actually negative then (uj,uj+1..uj+n) - -- is left as the true value plus b**(n+1), i.e. as the b's - -- complement of the true value, and a "borrow" to the left is - -- remembered. - - declare - Borrow : SD; - Carry : DD; - Temp : DD; - - Negative : Boolean; - -- Records if subtraction causes a negative result, requiring - -- an add back (case where qhat turned out to be 1 too large). - - begin - Borrow := 0; - for K in reverse 1 .. n loop - Temp := qhat * DD (v (K)) + DD (Borrow); - Borrow := MSD (Temp); - - if LSD (Temp) > u (j + K) then - Borrow := Borrow + 1; - end if; - - u (j + K) := u (j + K) - LSD (Temp); - end loop; - - Negative := u (j) < Borrow; - u (j) := u (j) - Borrow; - - -- D5. [Test remainder.] Set qj = qhat. If the result of step - -- D4 was negative, we will do the add back step (step D6). - - q (j) := LSD (qhat); - - if Negative then - - -- D6. [Add back.] Decrease qj by 1, and add (0,v1,v2..vn) - -- to (uj,uj+1,uj+2..uj+n). (A carry will occur to the left - -- of uj, and it is be ignored since it cancels with the - -- borrow that occurred in D4.) - - q (j) := q (j) - 1; - - Carry := 0; - for K in reverse 1 .. n loop - Temp := DD (v (K)) + DD (u (j + K)) + Carry; - u (j + K) := LSD (Temp); - Carry := Temp / Base; - end loop; - - u (j) := u (j) + SD (Carry); - end if; - end; - - -- D7. [Loop on j.] Increase j by one. Now if j <= m, go back to - -- D3 (the start of the loop on j). - - j := j + 1; - exit when not (j <= m); - end loop; - - -- D8. [Unnormalize.] Now (qo,ql..qm) is the desired quotient, and - -- the desired remainder may be obtained by dividing (um+1..um+n) - -- by d. - - if not Discard_Quotient then - Quotient := Normalize (q); - end if; - - if not Discard_Remainder then - declare - Remdr : DD; - - begin - Remdr := 0; - for K in 1 .. n loop - Remdr := Base * Remdr + DD (u (m + K)); - r (K) := SD (Remdr / d); - Remdr := Remdr rem d; - end loop; - - pragma Assert (Remdr = 0); - end; - - Remainder := Normalize (r); - end if; - end Algorithm_D; - end Div_Rem; - - ----------------- - -- From_Bignum -- - ----------------- - - function From_Bignum (X : Bignum) return Long_Long_Integer is - begin - if X.Len = 0 then - return 0; - - elsif X.Len = 1 then - return (if X.Neg then -LLI (X.D (1)) else LLI (X.D (1))); - - elsif X.Len = 2 then - declare - Mag : constant DD := X.D (1) & X.D (2); - begin - if X.Neg and then Mag <= 2 ** 63 then - return -LLI (Mag); - elsif Mag < 2 ** 63 then - return LLI (Mag); - end if; - end; - end if; - - raise Constraint_Error with "expression value out of range"; - end From_Bignum; - - ------------------------- - -- Bignum_In_LLI_Range -- - ------------------------- + (-Sec_Stack_Bignums.Big_Rem (+X, +Y)); + + function Big_Neg (X : Bignum) return Bignum is + (-Sec_Stack_Bignums.Big_Neg (+X)); + + function Big_Abs (X : Bignum) return Bignum is + (-Sec_Stack_Bignums.Big_Abs (+X)); + + function Big_EQ (X, Y : Bignum) return Boolean is + (Sec_Stack_Bignums.Big_EQ (+X, +Y)); + function Big_NE (X, Y : Bignum) return Boolean is + (Sec_Stack_Bignums.Big_NE (+X, +Y)); + function Big_GE (X, Y : Bignum) return Boolean is + (Sec_Stack_Bignums.Big_GE (+X, +Y)); + function Big_LE (X, Y : Bignum) return Boolean is + (Sec_Stack_Bignums.Big_LE (+X, +Y)); + function Big_GT (X, Y : Bignum) return Boolean is + (Sec_Stack_Bignums.Big_GT (+X, +Y)); + function Big_LT (X, Y : Bignum) return Boolean is + (Sec_Stack_Bignums.Big_LT (+X, +Y)); function Bignum_In_LLI_Range (X : Bignum) return Boolean is - begin - -- If length is 0 or 1, definitely fits - - if X.Len <= 1 then - return True; - - -- If length is greater than 2, definitely does not fit - - elsif X.Len > 2 then - return False; - - -- Length is 2, more tests needed - - else - declare - Mag : constant DD := X.D (1) & X.D (2); - begin - return Mag < 2 ** 63 or else (X.Neg and then Mag = 2 ** 63); - end; - end if; - end Bignum_In_LLI_Range; - - --------------- - -- Normalize -- - --------------- - - function Normalize - (X : Digit_Vector; - Neg : Boolean := False) return Bignum - is - B : Bignum; - J : Length; - - begin - J := X'First; - while J <= X'Last and then X (J) = 0 loop - J := J + 1; - end loop; - - B := Allocate_Bignum (X'Last - J + 1); - B.Neg := B.Len > 0 and then Neg; - B.D := X (J .. X'Last); - return B; - end Normalize; - - --------------- - -- To_Bignum -- - --------------- + (Sec_Stack_Bignums.Bignum_In_LLI_Range (+X)); function To_Bignum (X : Long_Long_Integer) return Bignum is - R : Bignum; - - begin - if X = 0 then - R := Allocate_Bignum (0); + (-Sec_Stack_Bignums.To_Bignum (X)); - -- One word result - - elsif X in -(2 ** 32 - 1) .. +(2 ** 32 - 1) then - R := Allocate_Bignum (1); - R.D (1) := SD (abs (X)); - - -- Largest negative number annoyance - - elsif X = Long_Long_Integer'First then - R := Allocate_Bignum (2); - R.D (1) := 2 ** 31; - R.D (2) := 0; - - -- Normal two word case - - else - R := Allocate_Bignum (2); - R.D (2) := SD (abs (X) mod Base); - R.D (1) := SD (abs (X) / Base); - end if; - - R.Neg := X < 0; - return R; - end To_Bignum; + function From_Bignum (X : Bignum) return Long_Long_Integer is + (Sec_Stack_Bignums.From_Bignum (+X)); end System.Bignums; diff --git a/gcc/ada/libgnat/s-bignum.ads b/gcc/ada/libgnat/s-bignum.ads index cc64844..5edb62c 100644 --- a/gcc/ada/libgnat/s-bignum.ads +++ b/gcc/ada/libgnat/s-bignum.ads @@ -33,51 +33,13 @@ -- use in computing intermediate values in expressions for the case where -- pragma Overflow_Check (Eliminated) is in effect. -with Interfaces; +-- Note that we cannot use a straight instantiation of System.Generic_Bignums +-- because the rtsfind mechanism is not ready to handle instantiations. package System.Bignums is + pragma Preelaborate; - pragma Assert (Long_Long_Integer'Size = 64); - -- This package assumes that Long_Long_Integer size is 64 bit (i.e. that it - -- has a range of -2**63 to 2**63-1). The front end ensures that the mode - -- ELIMINATED is not allowed for overflow checking if this is not the case. - - subtype Length is Natural range 0 .. 2 ** 23 - 1; - -- Represent number of words in Digit_Vector - - Base : constant := 2 ** 32; - -- Digit vectors use this base - - subtype SD is Interfaces.Unsigned_32; - -- Single length digit - - type Digit_Vector is array (Length range <>) of SD; - -- Represent digits of a number (most significant digit first) - - type Bignum_Data (Len : Length) is record - Neg : Boolean; - -- Set if value is negative, never set for zero - - D : Digit_Vector (1 .. Len); - -- Digits of number, most significant first, represented in base - -- 2**Base. No leading zeroes are stored, and the value of zero is - -- represented using an empty vector for D. - end record; - - for Bignum_Data use record - Len at 0 range 0 .. 23; - Neg at 3 range 0 .. 7; - end record; - - type Bignum is access all Bignum_Data; - -- This is the type that is used externally. Possibly this could be a - -- private type, but we leave the structure exposed for now. For one - -- thing it helps with debugging. Note that this package never shares - -- an allocated Bignum value, so for example for X + 0, a copy of X is - -- returned, not X itself. - - -- Note: none of the subprograms in this package modify the Bignum_Data - -- records referenced by Bignum arguments of mode IN. + type Bignum is private; function Big_Add (X, Y : Bignum) return Bignum; -- "+" function Big_Sub (X, Y : Bignum) return Bignum; -- "-" @@ -113,4 +75,27 @@ package System.Bignums is -- Convert Bignum to Long_Long_Integer. Constraint_Error raised with -- appropriate message if value is out of range of Long_Long_Integer. +private + + type Bignum is new System.Address; + + pragma Inline (Big_Add); + pragma Inline (Big_Sub); + pragma Inline (Big_Mul); + pragma Inline (Big_Div); + pragma Inline (Big_Exp); + pragma Inline (Big_Mod); + pragma Inline (Big_Rem); + pragma Inline (Big_Neg); + pragma Inline (Big_Abs); + pragma Inline (Big_EQ); + pragma Inline (Big_NE); + pragma Inline (Big_GE); + pragma Inline (Big_LE); + pragma Inline (Big_GT); + pragma Inline (Big_LT); + pragma Inline (Bignum_In_LLI_Range); + pragma Inline (To_Bignum); + pragma Inline (From_Bignum); + end System.Bignums; diff --git a/gcc/ada/libgnat/s-genbig.adb b/gcc/ada/libgnat/s-genbig.adb new file mode 100644 index 0000000..0a92dfb --- /dev/null +++ b/gcc/ada/libgnat/s-genbig.adb @@ -0,0 +1,1133 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S Y S T E M . G E N E R I C _ B I G N U M S -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2012-2019, 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This package provides arbitrary precision signed integer arithmetic. + +with System; use System; +with System.Secondary_Stack; use System.Secondary_Stack; +with System.Storage_Elements; use System.Storage_Elements; + +package body System.Generic_Bignums is + + use Interfaces; + -- So that operations on Unsigned_32/Unsigned_64 are available + + type DD is mod Base ** 2; + -- Double length digit used for intermediate computations + + function MSD (X : DD) return SD is (SD (X / Base)); + function LSD (X : DD) return SD is (SD (X mod Base)); + -- Most significant and least significant digit of double digit value + + function "&" (X, Y : SD) return DD is (DD (X) * Base + DD (Y)); + -- Compose double digit value from two single digit values + + subtype LLI is Long_Long_Integer; + + One_Data : constant Digit_Vector (1 .. 1) := (1 => 1); + -- Constant one + + Zero_Data : constant Digit_Vector (1 .. 0) := (1 .. 0 => 0); + -- Constant zero + + ----------------------- + -- Local Subprograms -- + ----------------------- + + function Add + (X, Y : Digit_Vector; + X_Neg : Boolean; + Y_Neg : Boolean) return Bignum + with + Pre => X'First = 1 and then Y'First = 1; + -- This procedure adds two signed numbers returning the Sum, it is used + -- for both addition and subtraction. The value computed is X + Y, with + -- X_Neg and Y_Neg giving the signs of the operands. + + function Allocate_Bignum (Len : Length) return Bignum with + Post => Allocate_Bignum'Result.Len = Len; + -- Allocate Bignum value of indicated length on secondary stack. On return + -- the Neg and D fields are left uninitialized. + + type Compare_Result is (LT, EQ, GT); + -- Indicates result of comparison in following call + + function Compare + (X, Y : Digit_Vector; + X_Neg, Y_Neg : Boolean) return Compare_Result + with + Pre => X'First = 1 and then Y'First = 1; + -- Compare (X with sign X_Neg) with (Y with sign Y_Neg), and return the + -- result of the signed comparison. + + procedure Div_Rem + (X, Y : Bignum; + Quotient : out Bignum; + Remainder : out Bignum; + Discard_Quotient : Boolean := False; + Discard_Remainder : Boolean := False); + -- Returns the Quotient and Remainder from dividing abs (X) by abs (Y). The + -- values of X and Y are not modified. If Discard_Quotient is True, then + -- Quotient is undefined on return, and if Discard_Remainder is True, then + -- Remainder is undefined on return. Service routine for Big_Div/Rem/Mod. + + procedure Free_Bignum (X : Bignum) is null; + -- Called to free a Bignum value used in intermediate computations. In + -- this implementation using the secondary stack, it does nothing at all, + -- because we rely on Mark/Release, but it may be of use for some + -- alternative implementation. + + function Normalize + (X : Digit_Vector; + Neg : Boolean := False) return Bignum; + -- Given a digit vector and sign, allocate and construct a Bignum value. + -- Note that X may have leading zeroes which must be removed, and if the + -- result is zero, the sign is forced positive. + + --------- + -- Add -- + --------- + + function Add + (X, Y : Digit_Vector; + X_Neg : Boolean; + Y_Neg : Boolean) return Bignum + is + begin + -- If signs are the same, we are doing an addition, it is convenient to + -- ensure that the first operand is the longer of the two. + + if X_Neg = Y_Neg then + if X'Last < Y'Last then + return Add (X => Y, Y => X, X_Neg => Y_Neg, Y_Neg => X_Neg); + + -- Here signs are the same, and the first operand is the longer + + else + pragma Assert (X_Neg = Y_Neg and then X'Last >= Y'Last); + + -- Do addition, putting result in Sum (allowing for carry) + + declare + Sum : Digit_Vector (0 .. X'Last); + RD : DD; + + begin + RD := 0; + for J in reverse 1 .. X'Last loop + RD := RD + DD (X (J)); + + if J >= 1 + (X'Last - Y'Last) then + RD := RD + DD (Y (J - (X'Last - Y'Last))); + end if; + + Sum (J) := LSD (RD); + RD := RD / Base; + end loop; + + Sum (0) := SD (RD); + return Normalize (Sum, X_Neg); + end; + end if; + + -- Signs are different so really this is a subtraction, we want to make + -- sure that the largest magnitude operand is the first one, and then + -- the result will have the sign of the first operand. + + else + declare + CR : constant Compare_Result := Compare (X, Y, False, False); + + begin + if CR = EQ then + return Normalize (Zero_Data); + + elsif CR = LT then + return Add (X => Y, Y => X, X_Neg => Y_Neg, Y_Neg => X_Neg); + + else + pragma Assert (X_Neg /= Y_Neg and then CR = GT); + + -- Do subtraction, putting result in Diff + + declare + Diff : Digit_Vector (1 .. X'Length); + RD : DD; + + begin + RD := 0; + for J in reverse 1 .. X'Last loop + RD := RD + DD (X (J)); + + if J >= 1 + (X'Last - Y'Last) then + RD := RD - DD (Y (J - (X'Last - Y'Last))); + end if; + + Diff (J) := LSD (RD); + RD := (if RD < Base then 0 else -1); + end loop; + + return Normalize (Diff, X_Neg); + end; + end if; + end; + end if; + end Add; + + --------------------- + -- Allocate_Bignum -- + --------------------- + + function Allocate_Bignum (Len : Length) return Bignum is + Addr : Address; + + begin + -- Allocation on the heap + + if not Use_Secondary_Stack then + declare + B : Bignum; + begin + B := new Bignum_Data'(Len, False, (others => 0)); + return B; + end; + + -- Allocation on the secondary stack + + else + -- Note: The approach used here is designed to avoid strict aliasing + -- warnings that appeared previously using unchecked conversion. + + SS_Allocate (Addr, Storage_Offset (4 + 4 * Len)); + + declare + B : Bignum; + for B'Address use Addr'Address; + pragma Import (Ada, B); + + BD : Bignum_Data (Len); + for BD'Address use Addr; + pragma Import (Ada, BD); + + -- Expose a writable view of discriminant BD.Len so that we can + -- initialize it. We need to use the exact layout of the record + -- to ensure that the Length field has 24 bits as expected. + + type Bignum_Data_Header is record + Len : Length; + Neg : Boolean; + end record; + + for Bignum_Data_Header use record + Len at 0 range 0 .. 23; + Neg at 3 range 0 .. 7; + end record; + + BDH : Bignum_Data_Header; + for BDH'Address use BD'Address; + pragma Import (Ada, BDH); + + pragma Assert (BDH.Len'Size = BD.Len'Size); + + begin + BDH.Len := Len; + return B; + end; + end if; + end Allocate_Bignum; + + ------------- + -- Big_Abs -- + ------------- + + function Big_Abs (X : Bignum) return Bignum is + begin + return Normalize (X.D); + end Big_Abs; + + ------------- + -- Big_Add -- + ------------- + + function Big_Add (X, Y : Bignum) return Bignum is + begin + return Add (X.D, Y.D, X.Neg, Y.Neg); + end Big_Add; + + ------------- + -- Big_Div -- + ------------- + + -- This table is excerpted from RM 4.5.5(28-30) and shows how the result + -- varies with the signs of the operands. + + -- A B A/B A B A/B + -- + -- 10 5 2 -10 5 -2 + -- 11 5 2 -11 5 -2 + -- 12 5 2 -12 5 -2 + -- 13 5 2 -13 5 -2 + -- 14 5 2 -14 5 -2 + -- + -- A B A/B A B A/B + -- + -- 10 -5 -2 -10 -5 2 + -- 11 -5 -2 -11 -5 2 + -- 12 -5 -2 -12 -5 2 + -- 13 -5 -2 -13 -5 2 + -- 14 -5 -2 -14 -5 2 + + function Big_Div (X, Y : Bignum) return Bignum is + Q, R : Bignum; + begin + Div_Rem (X, Y, Q, R, Discard_Remainder => True); + Q.Neg := Q.Len > 0 and then (X.Neg xor Y.Neg); + return Q; + end Big_Div; + + ------------- + -- Big_Exp -- + ------------- + + function Big_Exp (X, Y : Bignum) return Bignum is + + function "**" (X : Bignum; Y : SD) return Bignum; + -- Internal routine where we know right operand is one word + + ---------- + -- "**" -- + ---------- + + function "**" (X : Bignum; Y : SD) return Bignum is + begin + case Y is + + -- X ** 0 is 1 + + when 0 => + return Normalize (One_Data); + + -- X ** 1 is X + + when 1 => + return Normalize (X.D); + + -- X ** 2 is X * X + + when 2 => + return Big_Mul (X, X); + + -- For X greater than 2, use the recursion + + -- X even, X ** Y = (X ** (Y/2)) ** 2; + -- X odd, X ** Y = (X ** (Y/2)) ** 2 * X; + + when others => + declare + XY2 : constant Bignum := X ** (Y / 2); + XY2S : constant Bignum := Big_Mul (XY2, XY2); + Res : Bignum; + + begin + Free_Bignum (XY2); + + -- Raise storage error if intermediate value is getting too + -- large, which we arbitrarily define as 200 words for now. + + if XY2S.Len > 200 then + Free_Bignum (XY2S); + raise Storage_Error with + "exponentiation result is too large"; + end if; + + -- Otherwise take care of even/odd cases + + if (Y and 1) = 0 then + return XY2S; + + else + Res := Big_Mul (XY2S, X); + Free_Bignum (XY2S); + return Res; + end if; + end; + end case; + end "**"; + + -- Start of processing for Big_Exp + + begin + -- Error if right operand negative + + if Y.Neg then + raise Constraint_Error with "exponentiation to negative power"; + + -- X ** 0 is always 1 (including 0 ** 0, so do this test first) + + elsif Y.Len = 0 then + return Normalize (One_Data); + + -- 0 ** X is always 0 (for X non-zero) + + elsif X.Len = 0 then + return Normalize (Zero_Data); + + -- (+1) ** Y = 1 + -- (-1) ** Y = +/-1 depending on whether Y is even or odd + + elsif X.Len = 1 and then X.D (1) = 1 then + return Normalize + (X.D, Neg => X.Neg and then ((Y.D (Y.Len) and 1) = 1)); + + -- If the absolute value of the base is greater than 1, then the + -- exponent must not be bigger than one word, otherwise the result + -- is ludicrously large, and we just signal Storage_Error right away. + + elsif Y.Len > 1 then + raise Storage_Error with "exponentiation result is too large"; + + -- Special case (+/-)2 ** K, where K is 1 .. 31 using a shift + + elsif X.Len = 1 and then X.D (1) = 2 and then Y.D (1) < 32 then + declare + D : constant Digit_Vector (1 .. 1) := + (1 => Shift_Left (SD'(1), Natural (Y.D (1)))); + begin + return Normalize (D, X.Neg); + end; + + -- Remaining cases have right operand of one word + + else + return X ** Y.D (1); + end if; + end Big_Exp; + + ------------ + -- Big_EQ -- + ------------ + + function Big_EQ (X, Y : Bignum) return Boolean is + begin + return Compare (X.D, Y.D, X.Neg, Y.Neg) = EQ; + end Big_EQ; + + ------------ + -- Big_GE -- + ------------ + + function Big_GE (X, Y : Bignum) return Boolean is + begin + return Compare (X.D, Y.D, X.Neg, Y.Neg) /= LT; + end Big_GE; + + ------------ + -- Big_GT -- + ------------ + + function Big_GT (X, Y : Bignum) return Boolean is + begin + return Compare (X.D, Y.D, X.Neg, Y.Neg) = GT; + end Big_GT; + + ------------ + -- Big_LE -- + ------------ + + function Big_LE (X, Y : Bignum) return Boolean is + begin + return Compare (X.D, Y.D, X.Neg, Y.Neg) /= GT; + end Big_LE; + + ------------ + -- Big_LT -- + ------------ + + function Big_LT (X, Y : Bignum) return Boolean is + begin + return Compare (X.D, Y.D, X.Neg, Y.Neg) = LT; + end Big_LT; + + ------------- + -- Big_Mod -- + ------------- + + -- This table is excerpted from RM 4.5.5(28-30) and shows how the result + -- of Rem and Mod vary with the signs of the operands. + + -- A B A mod B A rem B A B A mod B A rem B + + -- 10 5 0 0 -10 5 0 0 + -- 11 5 1 1 -11 5 4 -1 + -- 12 5 2 2 -12 5 3 -2 + -- 13 5 3 3 -13 5 2 -3 + -- 14 5 4 4 -14 5 1 -4 + + -- A B A mod B A rem B A B A mod B A rem B + + -- 10 -5 0 0 -10 -5 0 0 + -- 11 -5 -4 1 -11 -5 -1 -1 + -- 12 -5 -3 2 -12 -5 -2 -2 + -- 13 -5 -2 3 -13 -5 -3 -3 + -- 14 -5 -1 4 -14 -5 -4 -4 + + function Big_Mod (X, Y : Bignum) return Bignum is + Q, R : Bignum; + + begin + -- If signs are same, result is same as Rem + + if X.Neg = Y.Neg then + return Big_Rem (X, Y); + + -- Case where Mod is different + + else + -- Do division + + Div_Rem (X, Y, Q, R, Discard_Quotient => True); + + -- Zero result is unchanged + + if R.Len = 0 then + return R; + + -- Otherwise adjust result + + else + declare + T1 : constant Bignum := Big_Sub (Y, R); + begin + T1.Neg := Y.Neg; + Free_Bignum (R); + return T1; + end; + end if; + end if; + end Big_Mod; + + ------------- + -- Big_Mul -- + ------------- + + function Big_Mul (X, Y : Bignum) return Bignum is + Result : Digit_Vector (1 .. X.Len + Y.Len) := (others => 0); + -- Accumulate result (max length of result is sum of operand lengths) + + L : Length; + -- Current result digit + + D : DD; + -- Result digit + + begin + for J in 1 .. X.Len loop + for K in 1 .. Y.Len loop + L := Result'Last - (X.Len - J) - (Y.Len - K); + D := DD (X.D (J)) * DD (Y.D (K)) + DD (Result (L)); + Result (L) := LSD (D); + D := D / Base; + + -- D is carry which must be propagated + + while D /= 0 and then L >= 1 loop + L := L - 1; + D := D + DD (Result (L)); + Result (L) := LSD (D); + D := D / Base; + end loop; + + -- Must not have a carry trying to extend max length + + pragma Assert (D = 0); + end loop; + end loop; + + -- Return result + + return Normalize (Result, X.Neg xor Y.Neg); + end Big_Mul; + + ------------ + -- Big_NE -- + ------------ + + function Big_NE (X, Y : Bignum) return Boolean is + begin + return Compare (X.D, Y.D, X.Neg, Y.Neg) /= EQ; + end Big_NE; + + ------------- + -- Big_Neg -- + ------------- + + function Big_Neg (X : Bignum) return Bignum is + begin + return Normalize (X.D, not X.Neg); + end Big_Neg; + + ------------- + -- Big_Rem -- + ------------- + + -- This table is excerpted from RM 4.5.5(28-30) and shows how the result + -- varies with the signs of the operands. + + -- A B A rem B A B A rem B + + -- 10 5 0 -10 5 0 + -- 11 5 1 -11 5 -1 + -- 12 5 2 -12 5 -2 + -- 13 5 3 -13 5 -3 + -- 14 5 4 -14 5 -4 + + -- A B A rem B A B A rem B + + -- 10 -5 0 -10 -5 0 + -- 11 -5 1 -11 -5 -1 + -- 12 -5 2 -12 -5 -2 + -- 13 -5 3 -13 -5 -3 + -- 14 -5 4 -14 -5 -4 + + function Big_Rem (X, Y : Bignum) return Bignum is + Q, R : Bignum; + begin + Div_Rem (X, Y, Q, R, Discard_Quotient => True); + R.Neg := R.Len > 0 and then X.Neg; + return R; + end Big_Rem; + + ------------- + -- Big_Sub -- + ------------- + + function Big_Sub (X, Y : Bignum) return Bignum is + begin + -- If right operand zero, return left operand (avoiding sharing) + + if Y.Len = 0 then + return Normalize (X.D, X.Neg); + + -- Otherwise add negative of right operand + + else + return Add (X.D, Y.D, X.Neg, not Y.Neg); + end if; + end Big_Sub; + + ------------- + -- Compare -- + ------------- + + function Compare + (X, Y : Digit_Vector; + X_Neg, Y_Neg : Boolean) return Compare_Result + is + begin + -- Signs are different, that's decisive, since 0 is always plus + + if X_Neg /= Y_Neg then + return (if X_Neg then LT else GT); + + -- Lengths are different, that's decisive since no leading zeroes + + elsif X'Last /= Y'Last then + return (if (X'Last > Y'Last) xor X_Neg then GT else LT); + + -- Need to compare data + + else + for J in X'Range loop + if X (J) /= Y (J) then + return (if (X (J) > Y (J)) xor X_Neg then GT else LT); + end if; + end loop; + + return EQ; + end if; + end Compare; + + ------------- + -- Div_Rem -- + ------------- + + procedure Div_Rem + (X, Y : Bignum; + Quotient : out Bignum; + Remainder : out Bignum; + Discard_Quotient : Boolean := False; + Discard_Remainder : Boolean := False) + is + begin + -- Error if division by zero + + if Y.Len = 0 then + raise Constraint_Error with "division by zero"; + end if; + + -- Handle simple cases with special tests + + -- If X < Y then quotient is zero and remainder is X + + if Compare (X.D, Y.D, False, False) = LT then + Remainder := Normalize (X.D); + Quotient := Normalize (Zero_Data); + return; + + -- If both X and Y are less than 2**63-1, we can use Long_Long_Integer + -- arithmetic. Note it is good not to do an accurate range check against + -- Long_Long_Integer since -2**63 / -1 overflows. + + elsif (X.Len <= 1 or else (X.Len = 2 and then X.D (1) < 2**31)) + and then + (Y.Len <= 1 or else (Y.Len = 2 and then Y.D (1) < 2**31)) + then + declare + A : constant LLI := abs (From_Bignum (X)); + B : constant LLI := abs (From_Bignum (Y)); + begin + Quotient := To_Bignum (A / B); + Remainder := To_Bignum (A rem B); + return; + end; + + -- Easy case if divisor is one digit + + elsif Y.Len = 1 then + declare + ND : DD; + Div : constant DD := DD (Y.D (1)); + + Result : Digit_Vector (1 .. X.Len); + Remdr : Digit_Vector (1 .. 1); + + begin + ND := 0; + for J in 1 .. X.Len loop + ND := Base * ND + DD (X.D (J)); + Result (J) := SD (ND / Div); + ND := ND rem Div; + end loop; + + Quotient := Normalize (Result); + Remdr (1) := SD (ND); + Remainder := Normalize (Remdr); + return; + end; + end if; + + -- The complex full multi-precision case. We will employ algorithm + -- D defined in the section "The Classical Algorithms" (sec. 4.3.1) + -- of Donald Knuth's "The Art of Computer Programming", Vol. 2, 2nd + -- edition. The terminology is adjusted for this section to match that + -- reference. + + -- We are dividing X.Len digits of X (called u here) by Y.Len digits + -- of Y (called v here), developing the quotient and remainder. The + -- numbers are represented using Base, which was chosen so that we have + -- the operations of multiplying to single digits (SD) to form a double + -- digit (DD), and dividing a double digit (DD) by a single digit (SD) + -- to give a single digit quotient and a single digit remainder. + + -- Algorithm D from Knuth + + -- Comments here with square brackets are directly from Knuth + + Algorithm_D : declare + + -- The following lower case variables correspond exactly to the + -- terminology used in algorithm D. + + m : constant Length := X.Len - Y.Len; + n : constant Length := Y.Len; + b : constant DD := Base; + + u : Digit_Vector (0 .. m + n); + v : Digit_Vector (1 .. n); + q : Digit_Vector (0 .. m); + r : Digit_Vector (1 .. n); + + u0 : SD renames u (0); + v1 : SD renames v (1); + v2 : SD renames v (2); + + d : DD; + j : Length; + qhat : DD; + rhat : DD; + temp : DD; + + begin + -- Initialize data of left and right operands + + for J in 1 .. m + n loop + u (J) := X.D (J); + end loop; + + for J in 1 .. n loop + v (J) := Y.D (J); + end loop; + + -- [Division of nonnegative integers.] Given nonnegative integers u + -- = (ul,u2..um+n) and v = (v1,v2..vn), where v1 /= 0 and n > 1, we + -- form the quotient u / v = (q0,ql..qm) and the remainder u mod v = + -- (r1,r2..rn). + + pragma Assert (v1 /= 0); + pragma Assert (n > 1); + + -- Dl. [Normalize.] Set d = b/(vl + 1). Then set (u0,u1,u2..um+n) + -- equal to (u1,u2..um+n) times d, and set (v1,v2..vn) equal to + -- (v1,v2..vn) times d. Note the introduction of a new digit position + -- u0 at the left of u1; if d = 1 all we need to do in this step is + -- to set u0 = 0. + + d := b / (DD (v1) + 1); + + if d = 1 then + u0 := 0; + + else + declare + Carry : DD; + Tmp : DD; + + begin + -- Multiply Dividend (u) by d + + Carry := 0; + for J in reverse 1 .. m + n loop + Tmp := DD (u (J)) * d + Carry; + u (J) := LSD (Tmp); + Carry := Tmp / Base; + end loop; + + u0 := SD (Carry); + + -- Multiply Divisor (v) by d + + Carry := 0; + for J in reverse 1 .. n loop + Tmp := DD (v (J)) * d + Carry; + v (J) := LSD (Tmp); + Carry := Tmp / Base; + end loop; + + pragma Assert (Carry = 0); + end; + end if; + + -- D2. [Initialize j.] Set j = 0. The loop on j, steps D2 through D7, + -- will be essentially a division of (uj, uj+1..uj+n) by (v1,v2..vn) + -- to get a single quotient digit qj. + + j := 0; + + -- Loop through digits + + loop + -- Note: In the original printing, step D3 was as follows: + + -- D3. [Calculate qhat.] If uj = v1, set qhat to b-l; otherwise + -- set qhat to (uj,uj+1)/v1. Now test if v2 * qhat is greater than + -- (uj*b + uj+1 - qhat*v1)*b + uj+2. If so, decrease qhat by 1 and + -- repeat this test + + -- This had a bug not discovered till 1995, see Vol 2 errata: + -- http://www-cs-faculty.stanford.edu/~uno/err2-2e.ps.gz. Under + -- rare circumstances the expression in the test could overflow. + -- This version was further corrected in 2005, see Vol 2 errata: + -- http://www-cs-faculty.stanford.edu/~uno/all2-pre.ps.gz. + -- The code below is the fixed version of this step. + + -- D3. [Calculate qhat.] Set qhat to (uj,uj+1)/v1 and rhat to + -- to (uj,uj+1) mod v1. + + temp := u (j) & u (j + 1); + qhat := temp / DD (v1); + rhat := temp mod DD (v1); + + -- D3 (continued). Now test if qhat >= b or v2*qhat > (rhat,uj+2): + -- if so, decrease qhat by 1, increase rhat by v1, and repeat this + -- test if rhat < b. [The test on v2 determines at high speed + -- most of the cases in which the trial value qhat is one too + -- large, and eliminates all cases where qhat is two too large.] + + while qhat >= b + or else DD (v2) * qhat > LSD (rhat) & u (j + 2) + loop + qhat := qhat - 1; + rhat := rhat + DD (v1); + exit when rhat >= b; + end loop; + + -- D4. [Multiply and subtract.] Replace (uj,uj+1..uj+n) by + -- (uj,uj+1..uj+n) minus qhat times (v1,v2..vn). This step + -- consists of a simple multiplication by a one-place number, + -- combined with a subtraction. + + -- The digits (uj,uj+1..uj+n) are always kept positive; if the + -- result of this step is actually negative then (uj,uj+1..uj+n) + -- is left as the true value plus b**(n+1), i.e. as the b's + -- complement of the true value, and a "borrow" to the left is + -- remembered. + + declare + Borrow : SD; + Carry : DD; + Temp : DD; + + Negative : Boolean; + -- Records if subtraction causes a negative result, requiring + -- an add back (case where qhat turned out to be 1 too large). + + begin + Borrow := 0; + for K in reverse 1 .. n loop + Temp := qhat * DD (v (K)) + DD (Borrow); + Borrow := MSD (Temp); + + if LSD (Temp) > u (j + K) then + Borrow := Borrow + 1; + end if; + + u (j + K) := u (j + K) - LSD (Temp); + end loop; + + Negative := u (j) < Borrow; + u (j) := u (j) - Borrow; + + -- D5. [Test remainder.] Set qj = qhat. If the result of step + -- D4 was negative, we will do the add back step (step D6). + + q (j) := LSD (qhat); + + if Negative then + + -- D6. [Add back.] Decrease qj by 1, and add (0,v1,v2..vn) + -- to (uj,uj+1,uj+2..uj+n). (A carry will occur to the left + -- of uj, and it is be ignored since it cancels with the + -- borrow that occurred in D4.) + + q (j) := q (j) - 1; + + Carry := 0; + for K in reverse 1 .. n loop + Temp := DD (v (K)) + DD (u (j + K)) + Carry; + u (j + K) := LSD (Temp); + Carry := Temp / Base; + end loop; + + u (j) := u (j) + SD (Carry); + end if; + end; + + -- D7. [Loop on j.] Increase j by one. Now if j <= m, go back to + -- D3 (the start of the loop on j). + + j := j + 1; + exit when not (j <= m); + end loop; + + -- D8. [Unnormalize.] Now (qo,ql..qm) is the desired quotient, and + -- the desired remainder may be obtained by dividing (um+1..um+n) + -- by d. + + if not Discard_Quotient then + Quotient := Normalize (q); + end if; + + if not Discard_Remainder then + declare + Remdr : DD; + + begin + Remdr := 0; + for K in 1 .. n loop + Remdr := Base * Remdr + DD (u (m + K)); + r (K) := SD (Remdr / d); + Remdr := Remdr rem d; + end loop; + + pragma Assert (Remdr = 0); + end; + + Remainder := Normalize (r); + end if; + end Algorithm_D; + end Div_Rem; + + ----------------- + -- From_Bignum -- + ----------------- + + function From_Bignum (X : Bignum) return Long_Long_Integer is + begin + if X.Len = 0 then + return 0; + + elsif X.Len = 1 then + return (if X.Neg then -LLI (X.D (1)) else LLI (X.D (1))); + + elsif X.Len = 2 then + declare + Mag : constant DD := X.D (1) & X.D (2); + begin + if X.Neg and then Mag <= 2 ** 63 then + return -LLI (Mag); + elsif Mag < 2 ** 63 then + return LLI (Mag); + end if; + end; + end if; + + raise Constraint_Error with "expression value out of range"; + end From_Bignum; + + ------------------------- + -- Bignum_In_LLI_Range -- + ------------------------- + + function Bignum_In_LLI_Range (X : Bignum) return Boolean is + begin + -- If length is 0 or 1, definitely fits + + if X.Len <= 1 then + return True; + + -- If length is greater than 2, definitely does not fit + + elsif X.Len > 2 then + return False; + + -- Length is 2, more tests needed + + else + declare + Mag : constant DD := X.D (1) & X.D (2); + begin + return Mag < 2 ** 63 or else (X.Neg and then Mag = 2 ** 63); + end; + end if; + end Bignum_In_LLI_Range; + + --------------- + -- Normalize -- + --------------- + + function Normalize + (X : Digit_Vector; + Neg : Boolean := False) return Bignum + is + B : Bignum; + J : Length; + + begin + J := X'First; + while J <= X'Last and then X (J) = 0 loop + J := J + 1; + end loop; + + B := Allocate_Bignum (X'Last - J + 1); + B.Neg := B.Len > 0 and then Neg; + B.D := X (J .. X'Last); + return B; + end Normalize; + + --------------- + -- To_Bignum -- + --------------- + + function To_Bignum (X : Long_Long_Integer) return Bignum is + R : Bignum; + + begin + if X = 0 then + R := Allocate_Bignum (0); + + -- One word result + + elsif X in -(2 ** 32 - 1) .. +(2 ** 32 - 1) then + R := Allocate_Bignum (1); + R.D (1) := SD (abs (X)); + + -- Largest negative number annoyance + + elsif X = Long_Long_Integer'First then + R := Allocate_Bignum (2); + R.D (1) := 2 ** 31; + R.D (2) := 0; + + -- Normal two word case + + else + R := Allocate_Bignum (2); + R.D (2) := SD (abs (X) mod Base); + R.D (1) := SD (abs (X) / Base); + end if; + + R.Neg := X < 0; + return R; + end To_Bignum; + + function To_Bignum (X : Unsigned_64) return Bignum is + R : Bignum; + + begin + if X = 0 then + R := Allocate_Bignum (0); + + -- One word result + + elsif X < 2 ** 32 then + R := Allocate_Bignum (1); + R.D (1) := SD (X); + + -- Two word result + + else + R := Allocate_Bignum (2); + R.D (2) := SD (X mod Base); + R.D (1) := SD (X / Base); + end if; + + R.Neg := False; + return R; + end To_Bignum; + + ------------- + -- Is_Zero -- + ------------- + + function Is_Zero (X : Bignum) return Boolean is + (X /= null and then X.D = Zero_Data); + +end System.Generic_Bignums; diff --git a/gcc/ada/libgnat/s-genbig.ads b/gcc/ada/libgnat/s-genbig.ads new file mode 100644 index 0000000..d9408af --- /dev/null +++ b/gcc/ada/libgnat/s-genbig.ads @@ -0,0 +1,135 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S Y S T E M . G E N E R I C _ B I G N U M S -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2012-2019, 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This package provides arbitrary precision signed integer arithmetic +-- and can be used either built into the compiler via System.Bignums or to +-- implement a default version of Ada.Numerics.Big_Numbers.Big_Integers. + +-- If Use_Secondary_Stack is True then all Bignum values are allocated on the +-- secondary stack. If False, the heap is used and the caller is responsible +-- for memory management. + +with Ada.Unchecked_Conversion; +with Interfaces; + +generic + Use_Secondary_Stack : Boolean; +package System.Generic_Bignums is + pragma Preelaborate; + + pragma Assert (Long_Long_Integer'Size = 64); + -- This package assumes that Long_Long_Integer size is 64 bit (i.e. that it + -- has a range of -2**63 to 2**63-1). The front end ensures that the mode + -- ELIMINATED is not allowed for overflow checking if this is not the case. + + subtype Length is Natural range 0 .. 2 ** 23 - 1; + -- Represent number of words in Digit_Vector + + Base : constant := 2 ** 32; + -- Digit vectors use this base + + subtype SD is Interfaces.Unsigned_32; + -- Single length digit + + type Digit_Vector is array (Length range <>) of SD; + -- Represent digits of a number (most significant digit first) + + type Bignum_Data (Len : Length) is record + Neg : Boolean; + -- Set if value is negative, never set for zero + + D : Digit_Vector (1 .. Len); + -- Digits of number, most significant first, represented in base + -- 2**Base. No leading zeroes are stored, and the value of zero is + -- represented using an empty vector for D. + end record; + + for Bignum_Data use record + Len at 0 range 0 .. 23; + Neg at 3 range 0 .. 7; + end record; + + type Bignum is access all Bignum_Data; + -- This is the type that is used externally. Possibly this could be a + -- private type, but we leave the structure exposed for now. For one + -- thing it helps with debugging. Note that this package never shares + -- an allocated Bignum value, so for example for X + 0, a copy of X is + -- returned, not X itself. + + function To_Bignum is new Ada.Unchecked_Conversion (System.Address, Bignum); + function To_Address is new + Ada.Unchecked_Conversion (Bignum, System.Address); + + -- Note: none of the subprograms in this package modify the Bignum_Data + -- records referenced by Bignum arguments of mode IN. + + function Big_Add (X, Y : Bignum) return Bignum; -- "+" + function Big_Sub (X, Y : Bignum) return Bignum; -- "-" + function Big_Mul (X, Y : Bignum) return Bignum; -- "*" + function Big_Div (X, Y : Bignum) return Bignum; -- "/" + function Big_Exp (X, Y : Bignum) return Bignum; -- "**" + function Big_Mod (X, Y : Bignum) return Bignum; -- "mod" + function Big_Rem (X, Y : Bignum) return Bignum; -- "rem" + function Big_Neg (X : Bignum) return Bignum; -- "-" + function Big_Abs (X : Bignum) return Bignum; -- "abs" + -- Perform indicated arithmetic operation on bignum values. No exception + -- raised except for Div/Mod/Rem by 0 which raises Constraint_Error with + -- an appropriate message. + + function Big_EQ (X, Y : Bignum) return Boolean; -- "=" + function Big_NE (X, Y : Bignum) return Boolean; -- "/=" + function Big_GE (X, Y : Bignum) return Boolean; -- ">=" + function Big_LE (X, Y : Bignum) return Boolean; -- "<=" + function Big_GT (X, Y : Bignum) return Boolean; -- ">" + function Big_LT (X, Y : Bignum) return Boolean; -- "<" + -- Perform indicated comparison on bignums, returning result as Boolean. + -- No exception raised for any input arguments. + + function Bignum_In_LLI_Range (X : Bignum) return Boolean; + -- Returns True if the Bignum value is in the range of Long_Long_Integer, + -- so that a call to From_Bignum is guaranteed not to raise an exception. + + function To_Bignum (X : Long_Long_Integer) return Bignum; + -- Convert Long_Long_Integer to Bignum. No exception can be raised for any + -- input argument. + + function To_Bignum (X : Interfaces.Unsigned_64) return Bignum; + -- Convert Unsigned_64 to Bignum. No exception can be raised for any + -- input argument. + + function From_Bignum (X : Bignum) return Long_Long_Integer; + -- Convert Bignum to Long_Long_Integer. Constraint_Error raised with + -- appropriate message if value is out of range of Long_Long_Integer. + + function Is_Zero (X : Bignum) return Boolean; + -- Return True if X = 0 + +end System.Generic_Bignums; diff --git a/gcc/ada/libgnat/s-regpat.adb b/gcc/ada/libgnat/s-regpat.adb index d7f59c7..ae69f47 100644 --- a/gcc/ada/libgnat/s-regpat.adb +++ b/gcc/ada/libgnat/s-regpat.adb @@ -1558,7 +1558,8 @@ package body System.Regpat is Has_Special_Operator : Boolean := False; begin - Parse_Pos := Parse_Pos - 1; -- Look at current character + Expr_Flags := Worst_Expression; -- Ensure Expr_Flags is initialized + Parse_Pos := Parse_Pos - 1; -- Look at current character IP := Emit_Node @@ -1684,11 +1685,8 @@ package body System.Regpat is begin Parse_Atom (New_Flags, IP); - if IP = 0 then - return; - end if; - - if Parse_Pos > Parse_End + if IP = 0 + or else Parse_Pos > Parse_End or else not Is_Mult (Parse_Pos) then Expr_Flags := New_Flags; diff --git a/gcc/ada/libgnat/s-valrea.adb b/gcc/ada/libgnat/s-valrea.adb index 519e369..424ccd0 100644 --- a/gcc/ada/libgnat/s-valrea.adb +++ b/gcc/ada/libgnat/s-valrea.adb @@ -204,7 +204,7 @@ package body System.Val_Real is if Digit < 0 then if Digit = Underscore and Index + 1 <= Max then - -- Underscore is only alllowed if followed by a digit + -- Underscore is only allowed if followed by a digit Digit := As_Digit (Str (Index + 1)); if Digit in Valid_Digit then Index := Index + 1; diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index fcfafc4..291fae8 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -124,11 +124,14 @@ package Opt is type Ada_Version_Type is (Ada_83, Ada_95, Ada_2005, Ada_2012, Ada_2020); pragma Ordered (Ada_Version_Type); + pragma Convention (C, Ada_Version_Type); -- Versions of Ada for Ada_Version below. Note that these are ordered, -- so that tests like Ada_Version >= Ada_95 are legitimate and useful. -- Think twice before using "="; Ada_Version >= Ada_2012 is more likely -- what you want, because it will apply to future versions of the language. + -- WARNING: There is a matching C declaration of this type in fe.h + Ada_Version_Default : constant Ada_Version_Type := Ada_2012; pragma Warnings (Off, Ada_Version_Default); -- GNAT @@ -141,6 +144,8 @@ package Opt is -- compiler switches, or implicitly (to Ada_Version_Runtime) when a -- predefined or internal file is compiled. + -- WARNING: There is a matching C declaration of this variable in fe.h + Ada_Version_Pragma : Node_Id := Empty; -- Reflects the Ada_xxx pragma that resulted in setting Ada_Version. Used -- to specialize error messages complaining about the Ada version in use. @@ -629,9 +634,10 @@ package Opt is -- Similar to Back_End_ZCX with respect to the front-end processing -- of regular and AT-END handlers. A setjmp/longjmp scheme is used to -- propagate and setup handler contexts on regular execution paths. - pragma Convention (C, Exception_Mechanism_Type); + -- WARNING: There is a matching C declaration of this type in fe.h + Exception_Mechanism : Exception_Mechanism_Type := Front_End_SJLJ; -- GNAT -- Set to the appropriate value depending on the flags in system.ads diff --git a/gcc/ada/par-ch10.adb b/gcc/ada/par-ch10.adb index ba16cc7..34323b8 100644 --- a/gcc/ada/par-ch10.adb +++ b/gcc/ada/par-ch10.adb @@ -397,10 +397,10 @@ package body Ch10 is or else Token in Token_Class_Deckn then Push_Scope_Stack; - Scope.Table (Scope.Last).Etyp := E_Name; - Scope.Table (Scope.Last).Sloc := SIS_Sloc; - Scope.Table (Scope.Last).Ecol := SIS_Ecol; - Scope.Table (Scope.Last).Lreq := False; + Scopes (Scope.Last).Etyp := E_Name; + Scopes (Scope.Last).Sloc := SIS_Sloc; + Scopes (Scope.Last).Ecol := SIS_Ecol; + Scopes (Scope.Last).Lreq := False; SIS_Entry_Active := False; -- If we had a missing semicolon in the declaration, then diff --git a/gcc/ada/par-ch12.adb b/gcc/ada/par-ch12.adb index 0861c7f..0ecac2e 100644 --- a/gcc/ada/par-ch12.adb +++ b/gcc/ada/par-ch12.adb @@ -302,7 +302,7 @@ package body Ch12 is elsif Token /= Tok_Left_Paren and then Token_Is_At_Start_Of_Line - and then Start_Column <= Scope.Table (Scope.Last).Ecol + and then Start_Column <= Scopes (Scope.Last).Ecol then return No_List; @@ -971,9 +971,16 @@ package body Ch12 is end if; if Token = Tok_With then - Scan; -- past WITH - Set_Private_Present (Def_Node, True); - T_Private; + + if Ada_Version >= Ada_2020 and Token /= Tok_Private then + -- Formal type has aspect specifications, parsed later. + return Def_Node; + + else + Scan; -- past WITH + Set_Private_Present (Def_Node, True); + T_Private; + end if; elsif Token = Tok_Tagged then Scan; diff --git a/gcc/ada/par-ch13.adb b/gcc/ada/par-ch13.adb index d7f5434..e26e83f 100644 --- a/gcc/ada/par-ch13.adb +++ b/gcc/ada/par-ch13.adb @@ -528,7 +528,15 @@ package body Ch13 is Inside_Depends := True; end if; - -- Parse the aspect definition depening on the expected + -- Note that we have seen an Import aspect specification. + -- This matters only while parsing a subprogram. + + if A_Id = Aspect_Import then + SIS_Aspect_Import_Seen := True; + -- Should do it only for subprograms + end if; + + -- Parse the aspect definition depending on the expected -- argument kind. if Aspect_Argument (A_Id) = Name @@ -826,9 +834,9 @@ package body Ch13 is Set_Identifier (Rep_Clause_Node, Identifier_Node); Push_Scope_Stack; - Scope.Table (Scope.Last).Etyp := E_Record; - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Etyp := E_Record; + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Sloc := Token_Ptr; Scan; -- past RECORD Record_Items := P_Pragmas_Opt; @@ -948,7 +956,9 @@ package body Ch13 is -- If Decl is Error, we ignore the aspects, and issue a message - elsif Decl = Error then + elsif Decl = Error + or else not Permits_Aspect_Specifications (Decl) + then Error_Msg ("aspect specifications not allowed here", Ptr); -- Here aspects are allowed, and we store them diff --git a/gcc/ada/par-ch2.adb b/gcc/ada/par-ch2.adb index 2924834..ae055af 100644 --- a/gcc/ada/par-ch2.adb +++ b/gcc/ada/par-ch2.adb @@ -247,11 +247,8 @@ package body Ch2 is -- Local variables - Interface_Check_Required : Boolean := False; - -- Set True if check of pragma INTERFACE is required - Import_Check_Required : Boolean := False; - -- Set True if check of pragma IMPORT is required + -- Set True if check of pragma IMPORT or INTERFACE is required Arg_Count : Nat := 0; -- Number of argument associations processed @@ -295,11 +292,10 @@ package body Ch2 is -- See if special INTERFACE/IMPORT check is required if SIS_Entry_Active then - Interface_Check_Required := (Prag_Name = Name_Interface); - Import_Check_Required := (Prag_Name = Name_Import); + Import_Check_Required := + (Prag_Name = Name_Import) or else (Prag_Name = Name_Interface); else - Interface_Check_Required := False; - Import_Check_Required := False; + Import_Check_Required := False; end if; -- Set global to indicate if we are within a Depends pragma @@ -331,9 +327,7 @@ package body Ch2 is Nam_In (Prag_Name, Name_Restriction_Warnings, Name_Restrictions)); - if Arg_Count = 2 - and then (Interface_Check_Required or else Import_Check_Required) - then + if Arg_Count = 2 and then Import_Check_Required then -- Here is where we cancel the SIS active status if this pragma -- supplies a body for the currently active subprogram spec. diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index aff14ed..2b054b2 100644 --- a/gcc/ada/par-ch3.adb +++ b/gcc/ada/par-ch3.adb @@ -3338,11 +3338,11 @@ package body Ch3 is else Push_Scope_Stack; - Scope.Table (Scope.Last).Etyp := E_Record; - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Sloc := Token_Ptr; - Scope.Table (Scope.Last).Labl := Error; - Scope.Table (Scope.Last).Junk := (Token /= Tok_Record); + Scopes (Scope.Last).Etyp := E_Record; + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Labl := Error; + Scopes (Scope.Last).Junk := (Token /= Tok_Record); T_Record; @@ -3419,7 +3419,7 @@ package body Ch3 is -- additional clue that confirms the incorrect spelling. if Token /= Tok_Identifier then - if Start_Column > Scope.Table (Scope.Last).Ecol + if Start_Column > Scopes (Scope.Last).Ecol and then Is_Reserved_Identifier then Save_Scan_State (Scan_State); -- at reserved id @@ -3661,9 +3661,9 @@ package body Ch3 is begin Variant_Part_Node := New_Node (N_Variant_Part, Token_Ptr); Push_Scope_Stack; - Scope.Table (Scope.Last).Etyp := E_Case; - Scope.Table (Scope.Last).Sloc := Token_Ptr; - Scope.Table (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Etyp := E_Case; + Scopes (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Ecol := Start_Column; Scan; -- past CASE Case_Node := P_Expression; @@ -4514,11 +4514,11 @@ package body Ch3 is -- scan it out Push_Scope_Stack; - Scope.Table (Scope.Last).Sloc := SIS_Sloc; - Scope.Table (Scope.Last).Etyp := E_Name; - Scope.Table (Scope.Last).Ecol := SIS_Ecol; - Scope.Table (Scope.Last).Labl := SIS_Labl; - Scope.Table (Scope.Last).Lreq := False; + Scopes (Scope.Last).Sloc := SIS_Sloc; + Scopes (Scope.Last).Etyp := E_Name; + Scopes (Scope.Last).Ecol := SIS_Ecol; + Scopes (Scope.Last).Labl := SIS_Labl; + Scopes (Scope.Last).Lreq := False; SIS_Entry_Active := False; Scan; -- past BEGIN Set_Handled_Statement_Sequence (Body_Node, diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb index 986d128..355aeb8 100644 --- a/gcc/ada/par-ch4.adb +++ b/gcc/ada/par-ch4.adb @@ -81,6 +81,8 @@ package body Ch4 is function P_Primary return Node_Id; function P_Relation return Node_Id; function P_Term return Node_Id; + function P_Reduction_Attribute_Reference (S : Node_Id) + return Node_Id; function P_Binary_Adding_Operator return Node_Kind; function P_Logical_Operator return Node_Kind; @@ -1202,12 +1204,48 @@ package body Ch4 is return Attr_Node; end P_Range_Attribute_Reference; + ------------------------------------- + -- P_Reduction_Attribute_Reference -- + ------------------------------------- + + function P_Reduction_Attribute_Reference (S : Node_Id) + return Node_Id + is + Attr_Node : Node_Id; + Attr_Name : Name_Id; + + begin + Attr_Name := Token_Name; + Scan; -- past Reduce + Attr_Node := New_Node (N_Attribute_Reference, Token_Ptr); + Set_Attribute_Name (Attr_Node, Attr_Name); + if Attr_Name /= Name_Reduce then + Error_Msg ("reduce attribute expected", Prev_Token_Ptr); + end if; + + Set_Prefix (Attr_Node, S); + Set_Expressions (Attr_Node, New_List); + T_Left_Paren; + Append (P_Name, Expressions (Attr_Node)); + T_Comma; + Append (P_Expression, Expressions (Attr_Node)); + T_Right_Paren; + + return Attr_Node; + end P_Reduction_Attribute_Reference; + --------------------------------------- -- 4.1.4 Range Attribute Designator -- --------------------------------------- -- Parsed by P_Range_Attribute_Reference (4.4) + --------------------------------------------- + -- 4.1.4 (2) Reduction_Attribute_Reference -- + --------------------------------------------- + + -- parsed by P_Reduction_Attribute_Reference + -------------------- -- 4.3 Aggregate -- -------------------- @@ -1229,6 +1267,7 @@ package body Ch4 is if Nkind (Aggr_Node) /= N_Aggregate and then Nkind (Aggr_Node) /= N_Extension_Aggregate + and then Ada_Version < Ada_2020 then Error_Msg ("aggregate may not have single positional component", Aggr_Sloc); @@ -1343,7 +1382,21 @@ package body Ch4 is begin Lparen_Sloc := Token_Ptr; - T_Left_Paren; + if Token = Tok_Left_Bracket and then Ada_Version >= Ada_2020 then + Scan; + + -- Special case for null aggregate in Ada2020. + + if Token = Tok_Right_Bracket then + Scan; -- past ] + Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc); + Set_Expressions (Aggregate_Node, New_List); + Set_Is_Homogeneous_Aggregate (Aggregate_Node); + return Aggregate_Node; + end if; + else + T_Left_Paren; + end if; -- Note on parentheses count. For cases like an if expression, the -- parens here really count as real parentheses for the paren count, @@ -1577,6 +1630,14 @@ package body Ch4 is Append (Expr_Node, Expr_List); + elsif Token = Tok_Right_Bracket then + if No (Expr_List) then + Expr_List := New_List; + end if; + + Append (Expr_Node, Expr_List); + exit; + -- Anything else is assumed to be a named association else @@ -1625,7 +1686,19 @@ package body Ch4 is -- All component associations (positional and named) have been scanned - T_Right_Paren; + if Token = Tok_Right_Bracket and then Ada_Version >= Ada_2020 then + Set_Component_Associations (Aggregate_Node, Assoc_List); + Set_Is_Homogeneous_Aggregate (Aggregate_Node); + Scan; -- past right bracket + if Token = Tok_Apostrophe then + Scan; + if Token = Tok_Identifier then + return P_Reduction_Attribute_Reference (Aggregate_Node); + end if; + end if; + else + T_Right_Paren; + end if; if Nkind (Aggregate_Node) /= N_Delta_Aggregate then Set_Expressions (Aggregate_Node, Expr_List); @@ -2623,6 +2696,7 @@ package body Ch4 is -- | STRING_LITERAL | AGGREGATE -- | NAME | QUALIFIED_EXPRESSION -- | ALLOCATOR | (EXPRESSION) | QUANTIFIED_EXPRESSION + -- | REDUCTION_ATTRIBUTE_REFERENCE -- Error recovery: can raise Error_Resync @@ -2715,6 +2789,9 @@ package body Ch4 is return Expr; end; + when Tok_Left_Bracket => + return P_Aggregate; + -- Allocator when Tok_New => diff --git a/gcc/ada/par-ch5.adb b/gcc/ada/par-ch5.adb index 4a2c369..426bbd5 100644 --- a/gcc/ada/par-ch5.adb +++ b/gcc/ada/par-ch5.adb @@ -358,7 +358,7 @@ package body Ch5 is -- of the expected column of the end for this sequence if SS_Flags.Eftm - or else Start_Column < Scope.Table (Scope.Last).Ecol + or else Start_Column < Scopes (Scope.Last).Ecol then Test_Statement_Required; exit; @@ -381,7 +381,7 @@ package body Ch5 is -- of the expected column of the end for this sequence if SS_Flags.Eltm - or else Start_Column < Scope.Table (Scope.Last).Ecol + or else Start_Column < Scopes (Scope.Last).Ecol then Test_Statement_Required; exit; @@ -405,7 +405,7 @@ package body Ch5 is -- is not permitted. if not SS_Flags.Extm and then - Start_Column >= Scope.Table (Scope.Last).Ecol + Start_Column >= Scopes (Scope.Last).Ecol then Error_Msg_SC ("exception handler not permitted here"); @@ -427,7 +427,7 @@ package body Ch5 is -- expected column of the end for this sequence. if SS_Flags.Ortm - or else Start_Column < Scope.Table (Scope.Last).Ecol + or else Start_Column < Scopes (Scope.Last).Ecol then Test_Statement_Required; exit; @@ -467,7 +467,7 @@ package body Ch5 is -- the expected column of the end for this sequence. if SS_Flags.Whtm - or else Start_Column < Scope.Table (Scope.Last).Ecol + or else Start_Column < Scopes (Scope.Last).Ecol then Test_Statement_Required; exit; @@ -1142,9 +1142,9 @@ package body Ch5 is procedure Check_If_Column is begin if RM_Column_Check and then Token_Is_At_Start_Of_Line - and then Start_Column /= Scope.Table (Scope.Last).Ecol + and then Start_Column /= Scopes (Scope.Last).Ecol then - Error_Msg_Col := Scope.Table (Scope.Last).Ecol; + Error_Msg_Col := Scopes (Scope.Last).Ecol; Error_Msg_SC ("(style) this token should be@"); end if; end Check_If_Column; @@ -1192,11 +1192,11 @@ package body Ch5 is If_Node := New_Node (N_If_Statement, Token_Ptr); Push_Scope_Stack; - Scope.Table (Scope.Last).Etyp := E_If; - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Sloc := Token_Ptr; - Scope.Table (Scope.Last).Labl := Error; - Scope.Table (Scope.Last).Node := If_Node; + Scopes (Scope.Last).Etyp := E_If; + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Labl := Error; + Scopes (Scope.Last).Node := If_Node; if Token = Tok_If then Loc := Token_Ptr; @@ -1350,11 +1350,11 @@ package body Ch5 is Case_Node := New_Node (N_Case_Statement, Token_Ptr); Push_Scope_Stack; - Scope.Table (Scope.Last).Etyp := E_Case; - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Sloc := Token_Ptr; - Scope.Table (Scope.Last).Labl := Error; - Scope.Table (Scope.Last).Node := Case_Node; + Scopes (Scope.Last).Etyp := E_Case; + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Labl := Error; + Scopes (Scope.Last).Node := Case_Node; Scan; -- past CASE Set_Expression (Case_Node, P_Expression_No_Right_Paren); @@ -1392,7 +1392,7 @@ package body Ch5 is -- complain about the missing WHEN, and discard the junk statements. elsif not Token_Is_At_Start_Of_Line - or else Start_Column > Scope.Table (Scope.Last).Ecol + or else Start_Column > Scopes (Scope.Last).Ecol then Error_Msg_BC ("WHEN (case statement alternative) expected"); @@ -1490,10 +1490,10 @@ package body Ch5 is begin Push_Scope_Stack; - Scope.Table (Scope.Last).Labl := Loop_Name; - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Sloc := Token_Ptr; - Scope.Table (Scope.Last).Etyp := E_Loop; + Scopes (Scope.Last).Labl := Loop_Name; + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Etyp := E_Loop; Loop_Node := New_Node (N_Loop_Statement, Token_Ptr); TF_Loop; @@ -1504,7 +1504,7 @@ package body Ch5 is Set_Comes_From_Source (Created_Name, False); Set_Has_Created_Identifier (Loop_Node, True); Set_Identifier (Loop_Node, Created_Name); - Scope.Table (Scope.Last).Labl := Created_Name; + Scopes (Scope.Last).Labl := Created_Name; else Set_Identifier (Loop_Node, Loop_Name); end if; @@ -1536,10 +1536,10 @@ package body Ch5 is begin Push_Scope_Stack; - Scope.Table (Scope.Last).Labl := Loop_Name; - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Sloc := Token_Ptr; - Scope.Table (Scope.Last).Etyp := E_Loop; + Scopes (Scope.Last).Labl := Loop_Name; + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Etyp := E_Loop; Loop_For_Flag := (Prev_Token = Tok_Loop); Scan; -- past FOR @@ -1575,7 +1575,7 @@ package body Ch5 is Set_Comes_From_Source (Created_Name, False); Set_Has_Created_Identifier (Loop_Node, True); Set_Identifier (Loop_Node, Created_Name); - Scope.Table (Scope.Last).Labl := Created_Name; + Scopes (Scope.Last).Labl := Created_Name; else Set_Identifier (Loop_Node, Loop_Name); end if; @@ -1607,10 +1607,10 @@ package body Ch5 is begin Push_Scope_Stack; - Scope.Table (Scope.Last).Labl := Loop_Name; - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Sloc := Token_Ptr; - Scope.Table (Scope.Last).Etyp := E_Loop; + Scopes (Scope.Last).Labl := Loop_Name; + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Etyp := E_Loop; Loop_While_Flag := (Prev_Token = Tok_Loop); Iter_Scheme_Node := New_Node (N_Iteration_Scheme, Token_Ptr); @@ -1641,7 +1641,7 @@ package body Ch5 is Set_Comes_From_Source (Created_Name, False); Set_Has_Created_Identifier (Loop_Node, True); Set_Identifier (Loop_Node, Created_Name); - Scope.Table (Scope.Last).Labl := Created_Name; + Scopes (Scope.Last).Labl := Created_Name; else Set_Identifier (Loop_Node, Loop_Name); end if; @@ -1805,11 +1805,11 @@ package body Ch5 is Block_Node := New_Node (N_Block_Statement, Token_Ptr); Push_Scope_Stack; - Scope.Table (Scope.Last).Etyp := E_Name; - Scope.Table (Scope.Last).Lreq := Present (Block_Name); - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Labl := Block_Name; - Scope.Table (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Etyp := E_Name; + Scopes (Scope.Last).Lreq := Present (Block_Name); + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Labl := Block_Name; + Scopes (Scope.Last).Sloc := Token_Ptr; Scan; -- past DECLARE @@ -1819,7 +1819,7 @@ package body Ch5 is Set_Comes_From_Source (Created_Name, False); Set_Has_Created_Identifier (Block_Node, True); Set_Identifier (Block_Node, Created_Name); - Scope.Table (Scope.Last).Labl := Created_Name; + Scopes (Scope.Last).Labl := Created_Name; else Set_Identifier (Block_Node, Block_Name); end if; @@ -1848,11 +1848,11 @@ package body Ch5 is Block_Node := New_Node (N_Block_Statement, Token_Ptr); Push_Scope_Stack; - Scope.Table (Scope.Last).Etyp := E_Name; - Scope.Table (Scope.Last).Lreq := Present (Block_Name); - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Labl := Block_Name; - Scope.Table (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Etyp := E_Name; + Scopes (Scope.Last).Lreq := Present (Block_Name); + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Labl := Block_Name; + Scopes (Scope.Last).Sloc := Token_Ptr; if No (Block_Name) then Created_Name := @@ -1860,15 +1860,15 @@ package body Ch5 is Set_Comes_From_Source (Created_Name, False); Set_Has_Created_Identifier (Block_Node, True); Set_Identifier (Block_Node, Created_Name); - Scope.Table (Scope.Last).Labl := Created_Name; + Scopes (Scope.Last).Labl := Created_Name; else Set_Identifier (Block_Node, Block_Name); end if; Append_Elmt (Block_Node, Label_List); - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Sloc := Token_Ptr; Scan; -- past BEGIN Set_Handled_Statement_Sequence (Block_Node, P_Handled_Sequence_Of_Statements); @@ -1913,7 +1913,7 @@ package body Ch5 is if not Token_Is_At_Start_Of_Line then return False; - elsif Scope.Table (Scope.Last).Etyp /= E_Case then + elsif Scopes (Scope.Last).Etyp /= E_Case then return False; else @@ -1946,13 +1946,13 @@ package body Ch5 is Check_No_Exit_Name : for J in reverse 1 .. Scope.Last loop - if Scope.Table (J).Etyp = E_Loop then - if Present (Scope.Table (J).Labl) - and then Comes_From_Source (Scope.Table (J).Labl) + if Scopes (J).Etyp = E_Loop then + if Present (Scopes (J).Labl) + and then Comes_From_Source (Scopes (J).Labl) then -- Innermost loop in fact had a name, style check fails - Style.No_Exit_Name (Scope.Table (J).Labl); + Style.No_Exit_Name (Scopes (J).Labl); end if; exit Check_No_Exit_Name; @@ -2154,7 +2154,7 @@ package body Ch5 is Style.Check_Indentation; end if; - Error_Msg_Col := Scope.Table (Scope.Last).Ecol; + Error_Msg_Col := Scopes (Scope.Last).Ecol; if RM_Column_Check and then Token_Is_At_Start_Of_Line @@ -2163,10 +2163,10 @@ package body Ch5 is Error_Msg_SC ("(style) BEGIN in wrong column, should be@"); else - Scope.Table (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Ecol := Start_Column; end if; - Scope.Table (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Sloc := Token_Ptr; Scan; -- past BEGIN Set_Handled_Statement_Sequence (Parent, P_Handled_Sequence_Of_Statements); @@ -2183,9 +2183,9 @@ package body Ch5 is if Parent_Nkind = N_Subprogram_Body and then Token = Tok_End - and then Scope.Table (Scope.Last).Etyp = E_Suspicious_Is + and then Scopes (Scope.Last).Etyp = E_Suspicious_Is then - Scope.Table (Scope.Last).Etyp := E_Bad_Is; + Scopes (Scope.Last).Etyp := E_Bad_Is; -- Otherwise BEGIN is not required for a package body, so we -- don't mind if it is missing, but we do construct a dummy @@ -2211,8 +2211,8 @@ package body Ch5 is -- Prepare to issue error message - Error_Msg_Sloc := Scope.Table (Scope.Last).Sloc; - Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl; + Error_Msg_Sloc := Scopes (Scope.Last).Sloc; + Error_Msg_Node_1 := Scopes (Scope.Last).Labl; -- Now issue appropriate message @@ -2272,6 +2272,7 @@ package body Ch5 is -- (because it is required to do so under all circumstances). We can -- therefore reference the entry it removed one past the stack top. -- What we are interested in is whether it was a case of a bad IS. + -- We can't call Scopes here. if Scope.Table (Scope.Last + 1).Etyp = E_Bad_Is then Error_Msg -- CODEFIX diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb index 0fc7109..8445a4e 100644 --- a/gcc/ada/par-ch6.adb +++ b/gcc/ada/par-ch6.adb @@ -229,12 +229,13 @@ package body Ch6 is -- Set up scope stack entry. Note that the Labl field will be set later SIS_Entry_Active := False; + SIS_Aspect_Import_Seen := False; SIS_Missing_Semicolon_Message := No_Error_Msg; Push_Scope_Stack; - Scope.Table (Scope.Last).Sloc := Token_Ptr; - Scope.Table (Scope.Last).Etyp := E_Name; - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Lreq := False; + Scopes (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Etyp := E_Name; + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Lreq := False; Aspects := Empty_List; @@ -335,7 +336,7 @@ package body Ch6 is Name_Node := P_Defining_Program_Unit_Name; end if; - Scope.Table (Scope.Last).Labl := Name_Node; + Scopes (Scope.Last).Labl := Name_Node; Current_Node := Name_Node; Ignore (Tok_Colon); @@ -533,7 +534,7 @@ package body Ch6 is -- i.e. that the terminating semicolon should have been IS. elsif Token = Tok_Begin - and then Start_Column >= Scope.Table (Scope.Last).Ecol + and then Start_Column >= Scopes (Scope.Last).Ecol then Error_Msg_SP -- CODEFIX ("|"";"" should be IS!"); @@ -764,7 +765,7 @@ package body Ch6 is Spec_Node : constant Node_Id := Parent - (Scope.Table (Scope.Last).Labl); + (Scopes (Scope.Last).Labl); Lib_Node : Node_Id := Spec_Node; begin @@ -773,7 +774,7 @@ package body Ch6 is if Scope.Last > 1 then Lib_Node := - Parent (Scope.Table (Scope.Last - 1).Labl); + Parent (Scopes (Scope.Last - 1).Labl); end if; if Ada_Version >= Ada_2012 @@ -917,11 +918,11 @@ package body Ch6 is if (Token in Token_Class_Declk or else Token = Tok_Identifier) - and then Start_Column <= Scope.Table (Scope.Last).Ecol + and then Start_Column <= Scopes (Scope.Last).Ecol and then Scope.Last /= 1 then - Scope.Table (Scope.Last).Etyp := E_Suspicious_Is; - Scope.Table (Scope.Last).S_Is := Prev_Token_Ptr; + Scopes (Scope.Last).Etyp := E_Suspicious_Is; + Scopes (Scope.Last).S_Is := Prev_Token_Ptr; end if; -- Build and return subprogram body, parsing declarations @@ -998,18 +999,23 @@ package body Ch6 is if Pf_Flags.Pbod - -- Disconnnect this processing if we have scanned a null procedure + -- Disconnect this processing if we have scanned a null procedure -- because in this case the spec is complete anyway with no body. and then (Nkind (Specification_Node) /= N_Procedure_Specification or else not Null_Present (Specification_Node)) then - SIS_Labl := Scope.Table (Scope.Last).Labl; - SIS_Sloc := Scope.Table (Scope.Last).Sloc; - SIS_Ecol := Scope.Table (Scope.Last).Ecol; + SIS_Labl := Scopes (Scope.Last).Labl; + SIS_Sloc := Scopes (Scope.Last).Sloc; + SIS_Ecol := Scopes (Scope.Last).Ecol; SIS_Declaration_Node := Decl_Node; SIS_Semicolon_Sloc := Prev_Token_Ptr; - SIS_Entry_Active := True; + + -- Do not activate the entry if we have "with Import" + + if not SIS_Aspect_Import_Seen then + SIS_Entry_Active := True; + end if; end if; Pop_Scope_Stack; @@ -1946,10 +1952,10 @@ package body Ch6 is if Token = Tok_Do then Push_Scope_Stack; - Scope.Table (Scope.Last).Ecol := Ret_Strt; - Scope.Table (Scope.Last).Etyp := E_Return; - Scope.Table (Scope.Last).Labl := Error; - Scope.Table (Scope.Last).Sloc := Ret_Sloc; + Scopes (Scope.Last).Ecol := Ret_Strt; + Scopes (Scope.Last).Etyp := E_Return; + Scopes (Scope.Last).Labl := Error; + Scopes (Scope.Last).Sloc := Ret_Sloc; Scan; -- past DO Set_Handled_Statement_Sequence diff --git a/gcc/ada/par-ch7.adb b/gcc/ada/par-ch7.adb index d3cfa25..c8150a4 100644 --- a/gcc/ada/par-ch7.adb +++ b/gcc/ada/par-ch7.adb @@ -121,9 +121,9 @@ package body Ch7 is begin Push_Scope_Stack; - Scope.Table (Scope.Last).Etyp := E_Name; - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Lreq := False; + Scopes (Scope.Last).Etyp := E_Name; + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Lreq := False; Package_Sloc := Token_Ptr; Scan; -- past PACKAGE @@ -143,9 +143,9 @@ package body Ch7 is end if; T_Body; - Scope.Table (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Sloc := Token_Ptr; Name_Node := P_Defining_Program_Unit_Name; - Scope.Table (Scope.Last).Labl := Name_Node; + Scopes (Scope.Last).Labl := Name_Node; Current_Node := Name_Node; if Aspect_Specifications_Present then @@ -209,9 +209,9 @@ package body Ch7 is -- Cases other than Package_Body else - Scope.Table (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Sloc := Token_Ptr; Name_Node := P_Defining_Program_Unit_Name; - Scope.Table (Scope.Last).Labl := Name_Node; + Scopes (Scope.Last).Labl := Name_Node; Current_Node := Name_Node; -- Case of renaming declaration @@ -290,7 +290,7 @@ package body Ch7 is (Specification_Node, P_Basic_Declarative_Items); if Token = Tok_Private then - Error_Msg_Col := Scope.Table (Scope.Last).Ecol; + Error_Msg_Col := Scopes (Scope.Last).Ecol; if RM_Column_Check then if Token_Is_At_Start_Of_Line diff --git a/gcc/ada/par-ch9.adb b/gcc/ada/par-ch9.adb index 825dac1..d6c6dfc 100644 --- a/gcc/ada/par-ch9.adb +++ b/gcc/ada/par-ch9.adb @@ -91,16 +91,16 @@ package body Ch9 is begin Push_Scope_Stack; - Scope.Table (Scope.Last).Etyp := E_Name; - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Sloc := Token_Ptr; - Scope.Table (Scope.Last).Lreq := False; + Scopes (Scope.Last).Etyp := E_Name; + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Lreq := False; Task_Sloc := Prev_Token_Ptr; if Token = Tok_Body then Scan; -- past BODY Name_Node := P_Defining_Identifier (C_Is); - Scope.Table (Scope.Last).Labl := Name_Node; + Scopes (Scope.Last).Labl := Name_Node; Current_Node := Name_Node; if Token = Tok_Left_Paren then @@ -168,7 +168,7 @@ package body Ch9 is Task_Node := New_Node (N_Task_Type_Declaration, Task_Sloc); Name_Node := P_Defining_Identifier; Set_Defining_Identifier (Task_Node, Name_Node); - Scope.Table (Scope.Last).Labl := Name_Node; + Scopes (Scope.Last).Labl := Name_Node; Current_Node := Name_Node; Set_Discriminant_Specifications (Task_Node, P_Known_Discriminant_Part_Opt); @@ -177,7 +177,7 @@ package body Ch9 is Task_Node := New_Node (N_Single_Task_Declaration, Task_Sloc); Name_Node := P_Defining_Identifier (C_Is); Set_Defining_Identifier (Task_Node, Name_Node); - Scope.Table (Scope.Last).Labl := Name_Node; + Scopes (Scope.Last).Labl := Name_Node; Current_Node := Name_Node; if Token = Tok_Left_Paren then @@ -441,15 +441,15 @@ package body Ch9 is begin Push_Scope_Stack; - Scope.Table (Scope.Last).Etyp := E_Name; - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Lreq := False; + Scopes (Scope.Last).Etyp := E_Name; + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Lreq := False; Protected_Sloc := Prev_Token_Ptr; if Token = Tok_Body then Scan; -- past BODY Name_Node := P_Defining_Identifier (C_Is); - Scope.Table (Scope.Last).Labl := Name_Node; + Scopes (Scope.Last).Labl := Name_Node; Current_Node := Name_Node; if Token = Tok_Left_Paren then @@ -504,7 +504,7 @@ package body Ch9 is New_Node (N_Protected_Type_Declaration, Protected_Sloc); Name_Node := P_Defining_Identifier (C_Is); Set_Defining_Identifier (Protected_Node, Name_Node); - Scope.Table (Scope.Last).Labl := Name_Node; + Scopes (Scope.Last).Labl := Name_Node; Current_Node := Name_Node; Set_Discriminant_Specifications (Protected_Node, P_Known_Discriminant_Part_Opt); @@ -521,7 +521,7 @@ package body Ch9 is Discard_Junk_List (P_Known_Discriminant_Part_Opt); end if; - Scope.Table (Scope.Last).Labl := Name_Node; + Scopes (Scope.Last).Labl := Name_Node; Current_Node := Name_Node; end if; @@ -1074,12 +1074,12 @@ package body Ch9 is begin Push_Scope_Stack; - Scope.Table (Scope.Last).Sloc := Token_Ptr; - Scope.Table (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Ecol := Start_Column; Accept_Node := New_Node (N_Accept_Statement, Token_Ptr); Scan; -- past ACCEPT - Scope.Table (Scope.Last).Labl := Token_Node; + Scopes (Scope.Last).Labl := Token_Node; Current_Node := Token_Node; Set_Entry_Direct_Name (Accept_Node, P_Identifier (C_Do)); @@ -1123,8 +1123,8 @@ package body Ch9 is -- Scan out DO if present if Token = Tok_Do then - Scope.Table (Scope.Last).Etyp := E_Name; - Scope.Table (Scope.Last).Lreq := False; + Scopes (Scope.Last).Etyp := E_Name; + Scopes (Scope.Last).Lreq := False; Scan; -- past DO Hand_Seq := P_Handled_Sequence_Of_Statements; Set_Handled_Statement_Sequence (Accept_Node, Hand_Seq); @@ -1221,14 +1221,14 @@ package body Ch9 is Entry_Node := New_Node (N_Entry_Body, Token_Ptr); Scan; -- past ENTRY - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Lreq := False; - Scope.Table (Scope.Last).Etyp := E_Name; - Scope.Table (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Lreq := False; + Scopes (Scope.Last).Etyp := E_Name; + Scopes (Scope.Last).Sloc := Token_Ptr; Name_Node := P_Defining_Identifier; Set_Defining_Identifier (Entry_Node, Name_Node); - Scope.Table (Scope.Last).Labl := Name_Node; + Scopes (Scope.Last).Labl := Name_Node; Current_Node := Name_Node; Formal_Part_Node := P_Entry_Body_Formal_Part; @@ -1521,10 +1521,10 @@ package body Ch9 is begin Push_Scope_Stack; - Scope.Table (Scope.Last).Etyp := E_Select; - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Sloc := Token_Ptr; - Scope.Table (Scope.Last).Labl := Error; + Scopes (Scope.Last).Etyp := E_Select; + Scopes (Scope.Last).Ecol := Start_Column; + Scopes (Scope.Last).Sloc := Token_Ptr; + Scopes (Scope.Last).Labl := Error; Select_Sloc := Token_Ptr; Scan; -- past SELECT diff --git a/gcc/ada/par-endh.adb b/gcc/ada/par-endh.adb index ba1f800..705b7fb 100644 --- a/gcc/ada/par-endh.adb +++ b/gcc/ada/par-endh.adb @@ -180,7 +180,7 @@ package body Endh is Name_Scan_State : Saved_Scan_State; -- Save state at start of name if Name_On_Separate_Line is TRUE - Span_Node : constant Node_Id := Scope.Table (Scope.Last).Node; + Span_Node : constant Node_Id := Scopes (Scope.Last).Node; begin End_Labl_Present := False; @@ -284,7 +284,7 @@ package body Endh is if Name_On_Separate_Line then if Token /= Tok_Semicolon or else - not Same_Label (End_Labl, Scope.Table (Scope.Last).Labl) + not Same_Label (End_Labl, Scopes (Scope.Last).Labl) then Restore_Scan_State (Name_Scan_State); End_Labl := Empty; @@ -297,7 +297,7 @@ package body Endh is -- to the scan location past the END token. else - End_Labl := Scope.Table (Scope.Last).Labl; + End_Labl := Scopes (Scope.Last).Labl; if End_Labl > Empty_Or_Error then @@ -382,10 +382,10 @@ package body Endh is if Style_Check and then End_Type = E_Name and then Explicit_Start_Label (Scope.Last) - and then Nkind (Parent (Scope.Table (Scope.Last).Labl)) + and then Nkind (Parent (Scopes (Scope.Last).Labl)) /= N_Block_Statement then - Style.No_End_Name (Scope.Table (Scope.Last).Labl); + Style.No_End_Name (Scopes (Scope.Last).Labl); end if; end if; end if; @@ -710,7 +710,7 @@ package body Endh is ------------------------ procedure Evaluate_End_Entry (SS_Index : Nat) is - STE : Scope_Table_Entry renames Scope.Table (SS_Index); + STE : Scope_Table_Entry renames Scopes (SS_Index).all; begin Column_OK := (End_Column = STE.Ecol); @@ -741,7 +741,7 @@ package body Endh is if not Label_OK and then End_Labl_Present - and then not Comes_From_Source (Scope.Table (SS_Index).Labl) + and then not Comes_From_Source (Scopes (SS_Index).Labl) then -- Here is where we will search the suspicious labels table @@ -792,7 +792,7 @@ package body Endh is -- If probably misspelling, then complain, and pretend it is OK declare - Nam : constant Node_Or_Entity_Id := Scope.Table (SS_Index).Labl; + Nam : constant Node_Or_Entity_Id := Scopes (SS_Index).Labl; begin if Nkind (End_Labl) in N_Has_Chars @@ -828,7 +828,7 @@ package body Endh is elsif End_Type = E_Name then Syntax_OK := (not Explicit_Start_Label (SS_Index)) or else - (not Scope.Table (SS_Index).Lreq); + (not Scopes (SS_Index).Lreq); -- Otherwise we have cases which don't allow labels anyway, so we -- certainly accept an END which does not have a label. @@ -843,8 +843,8 @@ package body Endh is -------------------------- function Explicit_Start_Label (SS_Index : Nat) return Boolean is - L : constant Node_Id := Scope.Table (SS_Index).Labl; - Etyp : constant SS_End_Type := Scope.Table (SS_Index).Etyp; + L : constant Node_Id := Scopes (SS_Index).Labl; + Etyp : constant SS_End_Type := Scopes (SS_Index).Etyp; begin if No (L) then @@ -906,16 +906,16 @@ package body Endh is -- Suppress message if this was a potentially junk entry (e.g. a record -- entry where no record keyword was present). - if Scope.Table (Scope.Last).Junk then + if Scopes (Scope.Last).Junk then return; end if; - End_Type := Scope.Table (Scope.Last).Etyp; - Error_Msg_Col := Scope.Table (Scope.Last).Ecol; - Error_Msg_Sloc := Scope.Table (Scope.Last).Sloc; + End_Type := Scopes (Scope.Last).Etyp; + Error_Msg_Col := Scopes (Scope.Last).Ecol; + Error_Msg_Sloc := Scopes (Scope.Last).Sloc; if Explicit_Start_Label (Scope.Last) then - Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl; + Error_Msg_Node_1 := Scopes (Scope.Last).Labl; else Error_Msg_Node_1 := Empty; end if; @@ -975,7 +975,7 @@ package body Endh is -- missing IS confirms the suspicion. else -- End_Type = E_Suspicious_Is or E_Bad_Is - Scope.Table (Scope.Last).Etyp := E_Bad_Is; + Scopes (Scope.Last).Etyp := E_Bad_Is; end if; end Output_End_Expected; @@ -990,15 +990,15 @@ package body Endh is -- Suppress message if this was a potentially junk entry (e.g. a record -- entry where no record keyword was present). - if Scope.Table (Scope.Last).Junk then + if Scopes (Scope.Last).Junk then return; end if; - End_Type := Scope.Table (Scope.Last).Etyp; - Error_Msg_Sloc := Scope.Table (Scope.Last).Sloc; + End_Type := Scopes (Scope.Last).Etyp; + Error_Msg_Sloc := Scopes (Scope.Last).Sloc; if Explicit_Start_Label (Scope.Last) then - Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl; + Error_Msg_Node_1 := Scopes (Scope.Last).Labl; else Error_Msg_Node_1 := Empty; end if; @@ -1036,7 +1036,7 @@ package body Endh is end if; else -- End_Type = E_Suspicious_Is or E_Bad_Is - Scope.Table (Scope.Last).Etyp := E_Bad_Is; + Scopes (Scope.Last).Etyp := E_Bad_Is; end if; end Output_End_Missing; @@ -1100,7 +1100,7 @@ package body Endh is Token = Tok_Separate) and then End_Type >= E_Name and then (not End_Labl_Present - or else Same_Label (End_Labl, Scope.Table (1).Labl)) + or else Same_Label (End_Labl, Scopes (1).Labl)) and then Scope.Last > 1 then Restore_Scan_State (Scan_State); -- to END @@ -1125,17 +1125,17 @@ package body Endh is -- line as the opener. if RM_Column_Check then - if End_Column /= Scope.Table (Scope.Last).Ecol - and then Current_Line_Start > Scope.Table (Scope.Last).Sloc + if End_Column /= Scopes (Scope.Last).Ecol + and then Current_Line_Start > Scopes (Scope.Last).Sloc -- A special case, for END RECORD, we are also allowed to -- line up with the TYPE keyword opening the declaration. - and then (Scope.Table (Scope.Last).Etyp /= E_Record + and then (Scopes (Scope.Last).Etyp /= E_Record or else Get_Column_Number (End_Sloc) /= Get_Column_Number (Type_Token_Location)) then - Error_Msg_Col := Scope.Table (Scope.Last).Ecol; + Error_Msg_Col := Scopes (Scope.Last).Ecol; Error_Msg ("(style) END in wrong column, should be@", End_Sloc); end if; @@ -1176,7 +1176,7 @@ package body Endh is or else (not Same_Label (End_Labl, - Scope.Table (Scope.Last - 1).Labl))) + Scopes (Scope.Last - 1).Labl))) then T_Semicolon; Error_Msg ("duplicate end line ignored", End_Loc); @@ -1229,7 +1229,7 @@ package body Endh is -- also it is unlikely that such nesting could occur by accident. Pretty_Good := (Token_OK and (Column_OK or Label_OK)) - or else Scope.Table (Scope.Last).Etyp = E_Record; + or else Scopes (Scope.Last).Etyp = E_Record; -- Next check, if there is a deeper entry in the stack which -- has a very high probability of being acceptable, then insert @@ -1289,8 +1289,8 @@ package body Endh is -- practices vary substantially in practice. if Pretty_Good - or else End_Column <= Scope.Table (Scope.Last).Ecol - or else (End_Type = Scope.Table (Scope.Last).Etyp + or else End_Column <= Scopes (Scope.Last).Ecol + or else (End_Type = Scopes (Scope.Last).Etyp and then End_Type = E_Loop) then Output_End_Expected (Ins => False); diff --git a/gcc/ada/par-util.adb b/gcc/ada/par-util.adb index 7b93ffa..6379c4a 100644 --- a/gcc/ada/par-util.adb +++ b/gcc/ada/par-util.adb @@ -162,7 +162,7 @@ package body Util is procedure Check_Bad_Layout is begin if RM_Column_Check and then Token_Is_At_Start_Of_Line - and then Start_Column <= Scope.Table (Scope.Last).Ecol + and then Start_Column <= Scopes (Scope.Last).Ecol then Error_Msg_BC -- CODEFIX ("(style) incorrect layout"); @@ -276,8 +276,11 @@ package body Util is -- If we have a right paren, then that is taken as ending the list -- i.e. no comma is present. + -- Ditto for a right bracket in Ada2020. - elsif Token = Tok_Right_Paren then + elsif Token = Tok_Right_Paren + or else (Token = Tok_Right_Bracket and then Ada_Version >= Ada_2020) + then return False; -- If pragmas, then get rid of them and make a recursive call @@ -668,9 +671,9 @@ package body Util is Scope.Decrement_Last; if Include_Subprogram_In_Messages - and then Scope.Table (Scope.Last).Labl /= Error + and then Scopes (Scope.Last).Labl /= Error then - Current_Node := Scope.Table (Scope.Last).Labl; + Current_Node := Scopes (Scope.Last).Labl; end if; if Debug_Flag_P then @@ -695,8 +698,8 @@ package body Util is First_Non_Blank_Location); end if; - Scope.Table (Scope.Last).Junk := False; - Scope.Table (Scope.Last).Node := Empty; + Scopes (Scope.Last).Junk := False; + Scopes (Scope.Last).Node := Empty; if Debug_Flag_P then Error_Msg_Uint_1 := UI_From_Int (Scope.Last); diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb index 43a7dae..0e3fa40 100644 --- a/gcc/ada/par.adb +++ b/gcc/ada/par.adb @@ -151,8 +151,17 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is SIS_Entry_Active : Boolean := False; -- Set True to indicate that an entry is active (i.e. that a subprogram - -- declaration has been encountered, and no body for this subprogram has - -- been encountered). The remaining fields are valid only if this is True. + -- declaration has been encountered, and no body for this subprogram + -- has been encountered). The remaining variables other than + -- SIS_Aspect_Import_Seen are valid only if this is True. + + SIS_Aspect_Import_Seen : Boolean := False; + -- If this is True when a subprogram declaration has been encountered, we + -- do not set SIS_Entry_Active, because the Import means there is no body. + -- Set False at the start of P_Subprogram, set True when an Import aspect + -- specification is seen, and used when P_Subprogram finds a subprogram + -- declaration. This is necessary because the aspects are parsed before + -- we know we have a subprogram declaration. SIS_Labl : Node_Id; -- Subprogram designator @@ -535,6 +544,20 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is Table_Increment => 100, Table_Name => "Scope"); + type Scope_Table_Entry_Ptr is access all Scope_Table_Entry; + + function Scopes (Index : Int) return Scope_Table_Entry_Ptr; + -- Return the indicated Scope_Table_Entry. We use a pointer for + -- efficiency. Callers should not save the pointer, but should do things + -- like Scopes (Scope.Last).Something. Note that there is one place in + -- Par.Ch5 that indexes the stack out of bounds, and can't call this. + + function Scopes (Index : Int) return Scope_Table_Entry_Ptr is + begin + pragma Assert (Index in Scope.First .. Scope.Last); + return Scope.Table (Index)'Unrestricted_Access; + end Scopes; + ------------------------------------------ -- Table for Handling Suspicious Labels -- ------------------------------------------ @@ -1332,7 +1355,7 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is -- Push a new entry onto the scope stack. Scope.Last (the stack pointer) -- is incremented. The Junk field is preinitialized to False. The caller -- is expected to fill in all remaining entries of the new top stack - -- entry at Scope.Table (Scope.Last). + -- entry at Scopes (Scope.Last). procedure Pop_Scope_Stack; -- Pop an entry off the top of the scope stack. Scope_Last (the scope @@ -1534,7 +1557,7 @@ begin Compiler_State := Parsing; Scope.Init; Scope.Increment_Last; - Scope.Table (0).Etyp := E_Dummy; + Scopes (0).Etyp := E_Dummy; SIS_Entry_Active := False; Last_Resync_Point := No_Location; diff --git a/gcc/ada/scans.ads b/gcc/ada/scans.ads index abee591..530da54 100644 --- a/gcc/ada/scans.ads +++ b/gcc/ada/scans.ads @@ -87,11 +87,15 @@ package Scans is -- exception-name". This degrades error recovery slightly, and perhaps -- we could do better, but not worth the effort. + -- Ada2020 introduces square brackets as delimiters for array and + -- container aggregates. + Tok_Raise, -- RAISE Tok_Dot, -- . Namext Tok_Apostrophe, -- ' Namext + Tok_Left_Bracket, -- [ Namest Tok_Left_Paren, -- ( Namext, Consk Tok_Delta, -- DELTA Atkwd, Sterm, Consk @@ -99,6 +103,7 @@ package Scans is Tok_Range, -- RANGE Atkwd, Sterm, Consk Tok_Right_Paren, -- ) Sterm + Tok_Right_Bracket, -- ] Sterm Tok_Comma, -- , Sterm Tok_And, -- AND Logop, Sterm diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb index 2d290b8..d4c1916 100644 --- a/gcc/ada/scng.adb +++ b/gcc/ada/scng.adb @@ -182,6 +182,7 @@ package body Scng is | Tok_Integer_Literal | Tok_Interface | Tok_Is + | Tok_Left_Bracket | Tok_Left_Paren | Tok_Less | Tok_Less_Equal @@ -204,6 +205,7 @@ package body Scng is | Tok_Rem | Tok_Renames | Tok_Reverse + | Tok_Right_Bracket | Tok_Right_Paren | Tok_Slash | Tok_String_Literal @@ -324,6 +326,7 @@ package body Scng is | Tok_In | Tok_Integer_Literal | Tok_Is + | Tok_Left_Bracket | Tok_Left_Paren | Tok_Less | Tok_Less_Equal @@ -340,6 +343,7 @@ package body Scng is | Tok_Range | Tok_Real_Literal | Tok_Rem + | Tok_Right_Bracket | Tok_Right_Paren | Tok_Slash | Tok_String_Literal @@ -1697,6 +1701,11 @@ package body Scng is if Source (Scan_Ptr + 1) = '"' then goto Scan_Wide_Character; + elsif Ada_Version = Ada_2020 then + Scan_Ptr := Scan_Ptr + 1; + Token := Tok_Left_Bracket; + return; + else Error_Msg_S ("illegal character, replaced by ""("""); Scan_Ptr := Scan_Ptr + 1; @@ -2063,6 +2072,7 @@ package body Scng is or else Prev_Token = Tok_Identifier or else Prev_Token = Tok_Project or else Prev_Token = Tok_Right_Paren + or else Prev_Token = Tok_Right_Bracket or else Prev_Token in Token_Class_Literal then Token := Tok_Apostrophe; @@ -2172,11 +2182,18 @@ package body Scng is return; -- Right bracket or right brace, treated as right paren + -- but proper aggregate delimiter in Ada_2020 when ']' | '}' => - Error_Msg_S ("illegal character, replaced by "")"""); + if Ada_Version >= Ada_2020 then + Token := Tok_Right_Bracket; + + else + Error_Msg_S ("illegal character, replaced by "")"""); + Token := Tok_Right_Paren; + end if; + Scan_Ptr := Scan_Ptr + 1; - Token := Tok_Right_Paren; return; -- Slash (can be division operator or first character of not equal) diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index d6d7c59..e41fcdb 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -602,6 +602,7 @@ package body Sem_Aggr is Set_Etype (Itype, Base_Type (Typ)); Set_Has_Alignment_Clause (Itype, Has_Alignment_Clause (Typ)); Set_Is_Aliased (Itype, Is_Aliased (Typ)); + Set_Is_Independent (Itype, Is_Independent (Typ)); Set_Depends_On_Private (Itype, Depends_On_Private (Typ)); Copy_Suppress_Status (Index_Check, Typ, Itype); diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index e842293..190d281 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -25,6 +25,7 @@ with Ada.Characters.Latin_1; use Ada.Characters.Latin_1; +with Aspects; use Aspects; with Atree; use Atree; with Casing; use Casing; with Checks; use Checks; @@ -5497,6 +5498,55 @@ package body Sem_Attr is Check_Discrete_Type; Set_Etype (N, Universal_Integer); + ------------ + -- Reduce -- + ------------ + + when Attribute_Reduce => + Check_E2; + + declare + Stream : constant Node_Id := Prefix (N); + Typ : Entity_Id; + begin + if Nkind (Stream) /= N_Aggregate then + -- Prefix is a name, as for other attributes. + + -- If the object is a function we asume that it is not + -- overloaded. AI12-242 does not suggest an name resulution + -- rule for that case, but can suppose that the expected + -- type of the reduction is the expected type of the + -- component of the prefix. + + Analyze_And_Resolve (Stream); + Typ := Etype (Stream); + + -- Verify that prefix can be iterated upon. + + if Is_Array_Type (Typ) + or else Present (Find_Aspect (Typ, Aspect_Default_Iterator)) + or else Present (Find_Aspect (Typ, Aspect_Iterable)) + then + null; + else + Error_Msg_NE + ("cannot apply reduce to object of type$", N, Typ); + end if; + + elsif Present (Expressions (Stream)) + or else No (Component_Associations (Stream)) + or else Nkind (First (Component_Associations (Stream))) /= + N_Iterated_Component_Association + then + Error_Msg_N + ("Prefix of reduce must be an iterated component", N); + end if; + + Analyze (E1); + Analyze (E2); + Set_Etype (N, Etype (E2)); + end; + ---------- -- Read -- ---------- @@ -5841,13 +5891,16 @@ package body Sem_Attr is -- Time_Errors after the back end has been called and this occurrence -- of 'Size is known at compile time then it is safe to perform this -- evaluation. Needed to perform the static evaluation of the full - -- boolean expression of these pragmas. + -- boolean expression of these pragmas. Note that Known_RM_Size is + -- sometimes True when Size_Known_At_Compile_Time is False, when the + -- back end has computed it. if In_Compile_Time_Warning_Or_Error and then Is_Entity_Name (P) and then (Is_Type (Entity (P)) or else Ekind (Entity (P)) = E_Enumeration_Literal) - and then Size_Known_At_Compile_Time (Entity (P)) + and then (Known_RM_Size (Entity (P)) + or else Size_Known_At_Compile_Time (Entity (P))) then declare Siz : Uint; @@ -8238,6 +8291,7 @@ package body Sem_Attr is | Attribute_Implicit_Dereference | Attribute_Iterator_Element | Attribute_Iterable + | Attribute_Reduce | Attribute_Variable_Indexing => null; @@ -10449,7 +10503,7 @@ package body Sem_Attr is -- to a missed warning (the Valid check does not really -- modify!) If this case, Note will be reset to False. - -- Skip it as well if the type is an Acccess_To_Constant, + -- Skip it as well if the type is an Access_To_Constant, -- given that no use of the value can modify the prefix. begin @@ -11648,6 +11702,70 @@ package body Sem_Attr is return; end Range_Attribute; + ------------- + -- Reduce -- + ------------- + + when Attribute_Reduce => + declare + E1 : constant Node_Id := First (Expressions (N)); + E2 : constant Node_Id := Next (E1); + Op : Entity_Id := Empty; + + Index : Interp_Index; + It : Interp; + function Proper_Op (Op : Entity_Id) return Boolean; + + --------------- + -- Proper_Op -- + --------------- + + function Proper_Op (Op : Entity_Id) return Boolean is + F1, F2 : Entity_Id; + + begin + F1 := First_Formal (Op); + if No (F1) then + return False; + else + F2 := Next_Formal (F1); + if No (F2) + or else Present (Next_Formal (F2)) + then + return False; + else + return + (Ekind (Op) = E_Operator + and then Scope (Op) = Standard_Standard) + or else Covers (Typ, Etype (Op)); + end if; + end if; + end Proper_Op; + + begin + Resolve (E2, Typ); + if Is_Overloaded (E1) then + Get_First_Interp (E1, Index, It); + while Present (It.Nam) loop + if Proper_Op (It.Nam) then + Op := It.Nam; + Set_Entity (E1, Op); + exit; + end if; + + Get_Next_Interp (Index, It); + end loop; + + elsif Proper_Op (Entity (E1)) then + Op := Entity (E1); + Set_Etype (N, Typ); + end if; + + if No (Op) then + Error_Msg_N ("No visible function for reduction", E1); + end if; + end; + ------------ -- Result -- ------------ diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index ae8bca7..ee18b37 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -2433,6 +2433,20 @@ package body Sem_Ch10 is Install_Elaboration_Model (Par_Unit); + -- The syntax rules require a proper body for a subprogram subunit + + if Nkind (Proper_Body (Sinfo.Unit (N))) = N_Subprogram_Declaration then + if Null_Present (Specification (Proper_Body (Sinfo.Unit (N)))) then + Error_Msg_N + ("null procedure not allowed as subunit", + Proper_Body (Unit (N))); + else + Error_Msg_N + ("subprogram declaration not allowed as subunit", + Defining_Unit_Name (Specification (Proper_Body (Unit (N))))); + end if; + end if; + Analyze (Proper_Body (Unit (N))); Remove_Context (N); diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 6932368..dc3a3c2 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -3410,7 +3410,11 @@ package body Sem_Ch12 is raise Program_Error; end case; + -- A formal type declaration declares a type and its first + -- subtype. + Set_Is_Generic_Type (T); + Set_Is_First_Subtype (T); if Has_Aspects (N) then Analyze_Aspect_Specifications (N, T); @@ -11111,19 +11115,36 @@ package body Sem_Ch12 is Note_Possible_Modification (Actual, Sure => True); - -- Check for instantiation of atomic/volatile actual for - -- non-atomic/volatile formal (RM C.6 (12)). + -- Check for instantiation with atomic/volatile object actual for + -- nonatomic/nonvolatile formal (RM C.6 (12)). if Is_Atomic_Object (Actual) and then not Is_Atomic (Orig_Ftyp) then - Error_Msg_N - ("cannot instantiate non-atomic formal object " - & "with atomic actual", Actual); + Error_Msg_NE + ("cannot instantiate nonatomic formal & of mode in out", + Actual, Gen_Obj); + Error_Msg_N ("\with atomic object actual (RM C.6(12))", Actual); elsif Is_Volatile_Object (Actual) and then not Is_Volatile (Orig_Ftyp) then + Error_Msg_NE + ("cannot instantiate nonvolatile formal & of mode in out", + Actual, Gen_Obj); + Error_Msg_N ("\with volatile object actual (RM C.6(12))", Actual); + end if; + + -- Check for instantiation on nonatomic subcomponent of an atomic + -- object in Ada 2020 (RM C.6 (13)). + + if Ada_Version >= Ada_2020 + and then Is_Subcomponent_Of_Atomic_Object (Actual) + and then not Is_Atomic_Object (Actual) + then + Error_Msg_NE + ("cannot instantiate formal & of mode in out with actual", + Actual, Gen_Obj); Error_Msg_N - ("cannot instantiate non-volatile formal object " - & "with volatile actual", Actual); + ("\nonatomic subcomponent of atomic object (RM C.6(13))", + Actual); end if; -- Formal in-parameter @@ -12161,6 +12182,10 @@ package body Sem_Ch12 is Loc : Source_Ptr; Subt : Entity_Id; + procedure Check_Shared_Variable_Control_Aspects; + -- Ada_2020: Verify that shared variable control aspects (RM C.6) + -- that may be specified for a formal type are obeyed by the actual. + procedure Diagnose_Predicated_Actual; -- There are a number of constructs in which a discrete type with -- predicates is illegal, e.g. as an index in an array type declaration. @@ -12185,6 +12210,79 @@ package body Sem_Ch12 is -- Check that base types are the same and that the subtypes match -- statically. Used in several of the above. + -------------------------------------------- + -- Check_Shared_Variable_Control_Aspects -- + -------------------------------------------- + + -- Ada_2020: Verify that shared variable control aspects (RM C.6) + -- that may be specified for the formal are obeyed by the actual. + + procedure Check_Shared_Variable_Control_Aspects is + begin + if Ada_Version >= Ada_2020 then + if Is_Atomic (A_Gen_T) and then not Is_Atomic (Act_T) then + Error_Msg_NE + ("actual for& must be an atomic type", Actual, A_Gen_T); + end if; + + if Is_Volatile (A_Gen_T) and then not Is_Volatile (Act_T) then + Error_Msg_NE + ("actual for& must be a Volatile type", Actual, A_Gen_T); + end if; + + if + Is_Independent (A_Gen_T) and then not Is_Independent (Act_T) + then + Error_Msg_NE + ("actual for& must be an Independent type", Actual, A_Gen_T); + end if; + + -- We assume that an array type whose atomic component type + -- is Atomic is equivalent to an array type with the explicit + -- aspect Has_Atomic_Components. This is a reasonable inference + -- from the intent of AI12-0282, and makes it legal to use an + -- actual that does not have the identical aspect as the formal. + + if Has_Atomic_Components (A_Gen_T) + and then not Has_Atomic_Components (Act_T) + then + if Is_Array_Type (Act_T) + and then Is_Atomic (Component_Type (Act_T)) + then + null; + + else + Error_Msg_NE + ("actual for& must have atomic components", + Actual, A_Gen_T); + end if; + end if; + + if Has_Independent_Components (A_Gen_T) + and then not Has_Independent_Components (Act_T) + then + Error_Msg_NE + ("actual for& must have independent components", + Actual, A_Gen_T); + end if; + + if Has_Volatile_Components (A_Gen_T) + and then not Has_Volatile_Components (Act_T) + then + if Is_Array_Type (Act_T) + and then Is_Volatile (Component_Type (Act_T)) + then + null; + + else + Error_Msg_NE + ("actual for& must have volatile components", + Actual, A_Gen_T); + end if; + end if; + end if; + end Check_Shared_Variable_Control_Aspects; + --------------------------------- -- Diagnose_Predicated_Actual -- --------------------------------- @@ -12286,6 +12384,12 @@ package body Sem_Ch12 is Error_Msg_NE ("actual for formal & must have convention %", Actual, Gen_T); end if; + + if Can_Never_Be_Null (A_Gen_T) /= Can_Never_Be_Null (Act_T) then + Error_Msg_NE + ("non null exclusion of actual and formal & do not match", + Actual, Gen_T); + end if; end Validate_Access_Subprogram_Instance; ----------------------------------- @@ -12797,12 +12901,21 @@ package body Sem_Ch12 is -- Perform atomic/volatile checks (RM C.6(12)). Note that AI05-0218-1 -- removes the second instance of the phrase "or allow pass by copy". - if Is_Atomic (Act_T) and then not Is_Atomic (Ancestor) then + -- In Ada_2020 the aspect may be specified explicitly for the formal + -- regardless of whether an ancestor obeys it. + + if Is_Atomic (Act_T) + and then not Is_Atomic (Ancestor) + and then not Is_Atomic (A_Gen_T) + then Error_Msg_N ("cannot have atomic actual type for non-atomic formal type", Actual); - elsif Is_Volatile (Act_T) and then not Is_Volatile (Ancestor) then + elsif Is_Volatile (Act_T) + and then not Is_Volatile (Ancestor) + and then not Is_Volatile (A_Gen_T) + then Error_Msg_N ("cannot have volatile actual type for non-volatile formal type", Actual); @@ -13481,6 +13594,8 @@ package body Sem_Ch12 is end if; end if; + Check_Shared_Variable_Control_Aspects; + if Error_Posted (Act_T) then null; else diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index e266af9..5944ba5 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -2131,12 +2131,27 @@ package body Sem_Ch13 is Aspect); end if; - -- Not allowed for formal type declarations + -- Not allowed for formal type declarations in previous + -- versions of the language. Allowed for them only for + -- shared variable control aspects. if Nkind (N) = N_Formal_Type_Declaration then - Error_Msg_N - ("aspect % not allowed for formal type declaration", - Aspect); + if Ada_Version < Ada_2020 then + Error_Msg_N + ("aspect % not allowed for formal type declaration", + Aspect); + + elsif A_Id /= Aspect_Atomic + and then A_Id /= Aspect_Volatile + and then A_Id /= Aspect_Independent + and then A_Id /= Aspect_Atomic_Components + and then A_Id /= Aspect_Independent_Components + and then A_Id /= Aspect_Volatile_Components + then + Error_Msg_N + ("aspect % not allowed for formal type declaration", + Aspect); + end if; end if; end if; @@ -5476,7 +5491,7 @@ package body Sem_Ch13 is Analyze (Decl, Suppress => All_Checks); Set_Has_Delayed_Freeze (New_Ctyp, False); - Set_Esize (New_Ctyp, Csize); + Init_Esize (New_Ctyp); Set_RM_Size (New_Ctyp, Csize); Init_Alignment (New_Ctyp); Set_Is_Itype (New_Ctyp, True); @@ -10937,9 +10952,9 @@ package body Sem_Ch13 is end if; -- For records that have component clauses for all components, and whose - -- size is less than or equal to 32, we need to know the size in the - -- front end to activate possible packed array processing where the - -- component type is a record. + -- size is less than or equal to 32, and which can be fully packed, we + -- need to know the size in the front end to activate possible packed + -- array processing where the component type is a record. -- At this stage Hbit + 1 represents the first unused bit from all the -- component clauses processed, so if the component clauses are @@ -10950,7 +10965,10 @@ package body Sem_Ch13 is -- length (it may for example be appropriate to round up the size -- to some convenient boundary, based on alignment considerations, etc). - if Unknown_RM_Size (Rectype) and then Hbit + 1 <= 32 then + if Unknown_RM_Size (Rectype) + and then Hbit + 1 <= 32 + and then not Strict_Alignment (Rectype) + then -- Nothing to do if at least one component has no component clause @@ -12834,8 +12852,13 @@ package body Sem_Ch13 is and then (Nkind (N) /= N_Pragma or else Get_Pragma_Id (N) /= Pragma_Convention) then - Error_Msg_N ("representation item not allowed for generic type", N); - return True; + if Ada_Version < Ada_2020 then + Error_Msg_N + ("representation item not allowed for generic type", N); + return True; + else + return False; + end if; end if; -- Otherwise check for incomplete type diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 9554c33..956c92d 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -1505,6 +1505,7 @@ package body Sem_Ch3 is Set_Ekind (Tag, E_Component); Set_Is_Tag (Tag); Set_Is_Aliased (Tag); + Set_Is_Independent (Tag); Set_Related_Type (Tag, Iface); Init_Component_Location (Tag); @@ -1544,6 +1545,7 @@ package body Sem_Ch3 is Set_Analyzed (Decl); Set_Ekind (Offset, E_Component); Set_Is_Aliased (Offset); + Set_Is_Independent (Offset); Set_Related_Type (Offset, Iface); Init_Component_Location (Offset); Insert_After (Last_Tag, Decl); @@ -2083,7 +2085,15 @@ package body Sem_Ch3 is end if; Set_Etype (Id, T); - Set_Is_Aliased (Id, Aliased_Present (Component_Definition (N))); + + if Aliased_Present (Component_Definition (N)) then + Set_Is_Aliased (Id); + + -- AI12-001: All aliased objects are considered to be specified as + -- independently addressable (RM C.6(8.1/4)). + + Set_Is_Independent (Id); + end if; -- The component declaration may have a per-object constraint, set -- the appropriate flag in the defining identifier of the subtype. @@ -4846,6 +4856,11 @@ package body Sem_Ch3 is if Aliased_Present (N) then Set_Is_Aliased (Id); + -- AI12-001: All aliased objects are considered to be specified as + -- independently addressable (RM C.6(8.1/4)). + + Set_Is_Independent (Id); + -- If the object is aliased and the type is unconstrained with -- defaulted discriminants and there is no expression, then the -- object is constrained by the defaults, so it is worthwhile @@ -6346,6 +6361,11 @@ package body Sem_Ch3 is Check_SPARK_05_Restriction ("aliased is not allowed", Component_Definition (Def)); Set_Has_Aliased_Components (Etype (T)); + + -- AI12-001: All aliased objects are considered to be specified as + -- independently addressable (RM C.6(8.1/4)). + + Set_Has_Independent_Components (Etype (T)); end if; -- Ada 2005 (AI-231): Propagate the null-excluding attribute to the @@ -13237,6 +13257,7 @@ package body Sem_Ch3 is Set_Is_Constrained (Def_Id, True); Set_Is_Aliased (Def_Id, Is_Aliased (T)); + Set_Is_Independent (Def_Id, Is_Independent (T)); Set_Depends_On_Private (Def_Id, Has_Private_Component (Def_Id)); Set_Is_Private_Composite (Def_Id, Is_Private_Composite (T)); @@ -14579,16 +14600,17 @@ package body Sem_Ch3 is procedure Copy_Array_Base_Type_Attributes (T1, T2 : Entity_Id) is begin - Set_Component_Alignment (T1, Component_Alignment (T2)); - Set_Component_Type (T1, Component_Type (T2)); - Set_Component_Size (T1, Component_Size (T2)); - Set_Has_Controlled_Component (T1, Has_Controlled_Component (T2)); - Set_Has_Non_Standard_Rep (T1, Has_Non_Standard_Rep (T2)); - Propagate_Concurrent_Flags (T1, T2); - Set_Is_Packed (T1, Is_Packed (T2)); - Set_Has_Aliased_Components (T1, Has_Aliased_Components (T2)); - Set_Has_Atomic_Components (T1, Has_Atomic_Components (T2)); - Set_Has_Volatile_Components (T1, Has_Volatile_Components (T2)); + Set_Component_Alignment (T1, Component_Alignment (T2)); + Set_Component_Type (T1, Component_Type (T2)); + Set_Component_Size (T1, Component_Size (T2)); + Set_Has_Controlled_Component (T1, Has_Controlled_Component (T2)); + Set_Has_Non_Standard_Rep (T1, Has_Non_Standard_Rep (T2)); + Propagate_Concurrent_Flags (T1, T2); + Set_Is_Packed (T1, Is_Packed (T2)); + Set_Has_Aliased_Components (T1, Has_Aliased_Components (T2)); + Set_Has_Atomic_Components (T1, Has_Atomic_Components (T2)); + Set_Has_Independent_Components (T1, Has_Independent_Components (T2)); + Set_Has_Volatile_Components (T1, Has_Volatile_Components (T2)); end Copy_Array_Base_Type_Attributes; ----------------------------------- @@ -14599,17 +14621,20 @@ package body Sem_Ch3 is begin Set_Size_Info (T1, T2); - Set_First_Index (T1, First_Index (T2)); - Set_Is_Aliased (T1, Is_Aliased (T2)); - Set_Is_Volatile (T1, Is_Volatile (T2)); - Set_Treat_As_Volatile (T1, Treat_As_Volatile (T2)); - Set_Is_Constrained (T1, Is_Constrained (T2)); - Set_Depends_On_Private (T1, Has_Private_Component (T2)); - Inherit_Rep_Item_Chain (T1, T2); - Set_Convention (T1, Convention (T2)); - Set_Is_Limited_Composite (T1, Is_Limited_Composite (T2)); - Set_Is_Private_Composite (T1, Is_Private_Composite (T2)); - Set_Packed_Array_Impl_Type (T1, Packed_Array_Impl_Type (T2)); + Set_First_Index (T1, First_Index (T2)); + Set_Is_Aliased (T1, Is_Aliased (T2)); + Set_Is_Atomic (T1, Is_Atomic (T2)); + Set_Is_Independent (T1, Is_Independent (T2)); + Set_Is_Volatile (T1, Is_Volatile (T2)); + Set_Is_Volatile_Full_Access (T1, Is_Volatile_Full_Access (T2)); + Set_Treat_As_Volatile (T1, Treat_As_Volatile (T2)); + Set_Is_Constrained (T1, Is_Constrained (T2)); + Set_Depends_On_Private (T1, Has_Private_Component (T2)); + Inherit_Rep_Item_Chain (T1, T2); + Set_Convention (T1, Convention (T2)); + Set_Is_Limited_Composite (T1, Is_Limited_Composite (T2)); + Set_Is_Private_Composite (T1, Is_Private_Composite (T2)); + Set_Packed_Array_Impl_Type (T1, Packed_Array_Impl_Type (T2)); end Copy_Array_Subtype_Attributes; ----------------------------------- @@ -15581,7 +15606,8 @@ package body Sem_Ch3 is Set_Derived_Name; -- Otherwise, the type is inheriting a private operation, so enter it - -- with a special name so it can't be overridden. + -- with a special name so it can't be overridden. See also below, where + -- we check for this case, and if so avoid setting Requires_Overriding. else Set_Chars (New_Subp, New_External_Name (Chars (Parent_Subp), 'P')); @@ -15761,7 +15787,15 @@ package body Sem_Ch3 is or else Is_Abstract_Subprogram (Alias (New_Subp)) then Set_Is_Abstract_Subprogram (New_Subp); - else + + -- If the Chars of the new subprogram is different from that of the + -- parent's one, it means that we entered it with a special name so + -- it can't be overridden (see above). In that case we had better not + -- *require* it to be overridden. This is the case where the parent + -- type inherited the operation privately, so there's no danger of + -- dangling dispatching. + + elsif Chars (New_Subp) = Chars (Alias (New_Subp)) then Set_Requires_Overriding (New_Subp); end if; @@ -22069,6 +22103,7 @@ package body Sem_Ch3 is Set_Ekind (Tag_Comp, E_Component); Set_Is_Tag (Tag_Comp); Set_Is_Aliased (Tag_Comp); + Set_Is_Independent (Tag_Comp); Set_Etype (Tag_Comp, RTE (RE_Tag)); Set_DT_Entry_Count (Tag_Comp, No_Uint); Set_Original_Record_Component (Tag_Comp, Tag_Comp); diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 80be4d6..5910112 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -676,7 +676,7 @@ package body Sem_Ch4 is -- In GNATprove mode we need to preserve the link between -- the original subtype indication and the anonymous subtype, - -- to extend proofs to constrained acccess types. We only do + -- to extend proofs to constrained access types. We only do -- that outside of spec expressions, otherwise the declaration -- cannot be inserted and analyzed. In such a case, GNATprove -- later rejects the allocator as it is not used here in @@ -8289,13 +8289,16 @@ package body Sem_Ch4 is -- Note that predefined containers are typically all derived from one of -- the Controlled types. The code below is motivated by containers that -- are derived from other types with a Reference aspect. + -- Note as well that we need to examine the base type, given that + -- the container object may be a constrained subtype or itype which + -- does not have an explicit declaration, elsif Is_Derived_Type (C_Type) and then Etype (First_Formal (Entity (Func_Name))) /= Pref_Typ then Func_Name := Find_Indexing_Operations - (T => C_Type, + (T => Base_Type (C_Type), Nam => Chars (Func_Name), Is_Constant => Is_Constant_Indexing); end if; diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index a65e92c..2342c54 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -2441,9 +2441,10 @@ package body Sem_Ch5 is Set_Etype (Def_Id, Component_Type (Typ)); -- The loop variable is aliased if the array components are - -- aliased. + -- aliased. Likewise for the independent aspect. - Set_Is_Aliased (Def_Id, Has_Aliased_Components (Typ)); + Set_Is_Aliased (Def_Id, Has_Aliased_Components (Typ)); + Set_Is_Independent (Def_Id, Has_Independent_Components (Typ)); -- AI12-0047 stipulates that the domain (array or container) -- cannot be a component that depends on a discriminant if the diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 386332c..eca0557 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -694,69 +694,199 @@ package body Sem_Ch6 is R_Type : constant Entity_Id := Etype (Scope_Id); -- Function result subtype - procedure Check_Aggregate_Accessibility (Aggr : Node_Id); - -- Apply legality rule of 6.5 (5.8) to the access discriminants of an + procedure Check_Return_Obj_Accessibility (Return_Stmt : Node_Id); + -- Apply legality rule of 6.5 (5.9) to the access discriminants of an -- aggregate in a return statement. procedure Check_Return_Subtype_Indication (Obj_Decl : Node_Id); -- Check that the return_subtype_indication properly matches the result -- subtype of the function, as required by RM-6.5(5.1/2-5.3/2). - ----------------------------------- - -- Check_Aggregate_Accessibility -- - ----------------------------------- + ------------------------------------ + -- Check_Return_Obj_Accessibility -- + ------------------------------------ - procedure Check_Aggregate_Accessibility (Aggr : Node_Id) is - Typ : constant Entity_Id := Etype (Aggr); - Assoc : Node_Id; - Discr : Entity_Id; - Expr : Node_Id; - Obj : Node_Id; + procedure Check_Return_Obj_Accessibility (Return_Stmt : Node_Id) is + Assoc : Node_Id; + Agg : Node_Id := Empty; + Discr : Entity_Id; + Expr : Node_Id; + Obj : Node_Id; + Process_Exprs : Boolean := False; + Return_Obj : Node_Id; begin - if Is_Record_Type (Typ) and then Has_Discriminants (Typ) then - Discr := First_Discriminant (Typ); - Assoc := First (Component_Associations (Aggr)); - while Present (Discr) loop - if Ekind (Etype (Discr)) = E_Anonymous_Access_Type then + -- Only perform checks on record types with access discriminants + + if not Is_Record_Type (R_Type) + or else not Has_Discriminants (R_Type) + then + return; + end if; + + -- We are only interested in return statements + + if not Nkind_In (Return_Stmt, N_Extended_Return_Statement, + N_Simple_Return_Statement) + then + return; + end if; + + -- Fetch the object from the return statement, in the case of a + -- simple return statement the expression is part of the node. + + if Nkind (Return_Stmt) = N_Extended_Return_Statement then + Return_Obj := Last (Return_Object_Declarations (Return_Stmt)); + + -- We could be looking at something that's been expanded with + -- an initialzation procedure which we can safely ignore. + + if Nkind (Return_Obj) /= N_Object_Declaration then + return; + end if; + else + Return_Obj := Return_Stmt; + end if; + + -- We may need to check an aggregate or a subtype indication + -- depending on how the discriminants were specified and whether + -- we are looking at an extended return statement. + + if Nkind (Return_Obj) = N_Object_Declaration + and then Nkind (Object_Definition (Return_Obj)) + = N_Subtype_Indication + then + Assoc := First (Constraints + (Constraint (Object_Definition (Return_Obj)))); + else + -- Qualified expressions may be nested + + Agg := Original_Node (Expression (Return_Obj)); + while Nkind (Agg) = N_Qualified_Expression loop + Agg := Original_Node (Expression (Agg)); + end loop; + + -- If we are looking at an aggregate instead of a function call we + -- can continue checking accessibility for the supplied + -- discriminant associations. + + if Nkind (Agg) = N_Aggregate then + if Present (Expressions (Agg)) then + Assoc := First (Expressions (Agg)); + Process_Exprs := True; + else + Assoc := First (Component_Associations (Agg)); + end if; + + -- Otherwise the expression is not of interest ??? + + else + return; + end if; + end if; + + -- Move through the discriminants checking the accessibility level + -- of each co-extension's associated expression. + + Discr := First_Discriminant (R_Type); + while Present (Discr) loop + if Ekind (Etype (Discr)) = E_Anonymous_Access_Type then + + if Nkind (Assoc) = N_Attribute_Reference then + Expr := Assoc; + elsif Nkind_In (Assoc, N_Component_Association, + N_Discriminant_Association) + then Expr := Expression (Assoc); + end if; - if Nkind (Expr) = N_Attribute_Reference - and then Attribute_Name (Expr) /= Name_Unrestricted_Access - then - Obj := Prefix (Expr); - while Nkind_In (Obj, N_Indexed_Component, - N_Selected_Component) - loop + -- This anonymous access discriminant has an associated + -- expression which needs checking. + + if Nkind (Expr) = N_Attribute_Reference + and then Attribute_Name (Expr) /= Name_Unrestricted_Access + then + -- Obtain the object to perform static checks on by moving + -- up the prefixes in the expression taking into account + -- named access types. + + Obj := Prefix (Expr); + while Nkind_In (Obj, N_Indexed_Component, + N_Selected_Component) + loop + -- When we encounter a named access type then we can + -- ignore accessibility checks on the dereference. + + if Ekind (Etype (Prefix (Obj))) + in E_Access_Type .. + E_Access_Protected_Subprogram_Type + then + if Nkind (Obj) = N_Selected_Component then + Obj := Selector_Name (Obj); + end if; + exit; + end if; + + -- Skip over the explicit dereference + + if Nkind (Prefix (Obj)) = N_Explicit_Dereference then + Obj := Prefix (Prefix (Obj)); + + -- Otherwise move up to the next prefix + + else Obj := Prefix (Obj); - end loop; + end if; + end loop; - -- Do not check aliased formals or function calls. A - -- run-time check may still be needed ??? + -- Do not check aliased formals or function calls. A + -- run-time check may still be needed ??? - if Is_Entity_Name (Obj) - and then Comes_From_Source (Obj) + if Is_Entity_Name (Obj) + and then Comes_From_Source (Obj) + then + -- Explicitly aliased formals are allowed + + if Is_Formal (Entity (Obj)) + and then Is_Aliased (Entity (Obj)) then - if Is_Formal (Entity (Obj)) - and then Is_Aliased (Entity (Obj)) - then - null; + null; - elsif Object_Access_Level (Obj) > - Scope_Depth (Scope (Scope_Id)) - then - Error_Msg_N - ("access discriminant in return aggregate would " - & "be a dangling reference", Obj); - end if; + elsif Object_Access_Level (Obj) > + Scope_Depth (Scope (Scope_Id)) + then + Error_Msg_N + ("access discriminant in return aggregate would " + & "be a dangling reference", Obj); end if; end if; end if; + end if; - Next_Discriminant (Discr); - end loop; - end if; - end Check_Aggregate_Accessibility; + Next_Discriminant (Discr); + + if not Is_List_Member (Assoc) then + Assoc := Empty; + else + Nlists.Next (Assoc); + end if; + + -- After aggregate expressions, examine component associations if + -- present. + + if No (Assoc) then + if Present (Agg) + and then Process_Exprs + and then Present (Component_Associations (Agg)) + then + Assoc := First (Component_Associations (Agg)); + Process_Exprs := False; + else + exit; + end if; + end if; + end loop; + end Check_Return_Obj_Accessibility; ------------------------------------- -- Check_Return_Subtype_Indication -- @@ -963,9 +1093,7 @@ package body Sem_Ch6 is Resolve (Expr, R_Type); Check_Limited_Return (N, Expr, R_Type); - if Present (Expr) and then Nkind (Expr) = N_Aggregate then - Check_Aggregate_Accessibility (Expr); - end if; + Check_Return_Obj_Accessibility (N); end if; -- RETURN only allowed in SPARK as the last statement in function @@ -1021,6 +1149,8 @@ package body Sem_Ch6 is Check_References (Stm_Entity); + Check_Return_Obj_Accessibility (N); + -- Check RM 6.5 (5.9/3) if Has_Aliased then @@ -11654,6 +11784,11 @@ package body Sem_Ch6 is and then Aliased_Present (Param_Spec) then Set_Is_Aliased (Formal); + + -- AI12-001: All aliased objects are considered to be specified + -- as independently addressable (RM C.6(8.1/4)). + + Set_Is_Independent (Formal); end if; -- Ada 2005 (AI-231): Create and decorate an internal subtype diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 8897b25..f083f7c 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -1358,19 +1358,13 @@ package body Sem_Ch8 is end if; -- The entity of the renaming declaration needs to reflect whether the - -- renamed object is volatile. Is_Volatile is set if the renamed object - -- is volatile in the RM legality sense. + -- renamed object is atomic, independent, volatile or VFA. These flags + -- are set on the renamed object in the RM legality sense. - Set_Is_Volatile (Id, Is_Volatile_Object (Nam)); - - -- Also copy settings of Atomic/Independent/Volatile_Full_Access - - if Is_Entity_Name (Nam) then - Set_Is_Atomic (Id, Is_Atomic (Entity (Nam))); - Set_Is_Independent (Id, Is_Independent (Entity (Nam))); - Set_Is_Volatile_Full_Access (Id, - Is_Volatile_Full_Access (Entity (Nam))); - end if; + Set_Is_Atomic (Id, Is_Atomic_Object (Nam)); + Set_Is_Independent (Id, Is_Independent_Object (Nam)); + Set_Is_Volatile (Id, Is_Volatile_Object (Nam)); + Set_Is_Volatile_Full_Access (Id, Is_Volatile_Full_Access_Object (Nam)); -- Treat as volatile if we just set the Volatile flag @@ -9613,15 +9607,16 @@ package body Sem_Ch8 is Par : constant Entity_Id := Defining_Entity (Parent (Decl)); Spec : constant Node_Id := Specification (Unit (Cunit (Current_Sem_Unit))); - + Cur_List : constant List_Id := List_Containing (Cur_Use); begin if Is_Compilation_Unit (Par) and then Par /= Cunit_Entity (Current_Sem_Unit) - and then Parent (Cur_Use) = Spec - and then List_Containing (Cur_Use) = - Visible_Declarations (Spec) then - return; + if Cur_List = Context_Items (Cunit (Current_Sem_Unit)) + or else Cur_List = Visible_Declarations (Spec) + then + return; + end if; end if; end; end if; @@ -9635,7 +9630,6 @@ package body Sem_Ch8 is then Redundant := Clause; Prev_Use := Cur_Use; - end if; if Present (Redundant) and then Parent (Redundant) /= Prev_Use then diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 5f26ecd..a082847 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -5905,7 +5905,8 @@ package body Sem_Eval is -- In addition, in GNAT, the object size (Esize) values of the types must -- match if they are set (unless checking an actual for a formal derived -- type). The use of 'Object_Size can cause this to be false even if the - -- types would otherwise match in the RM sense. + -- types would otherwise match in the Ada 95 RM sense, but this deviation + -- is adopted by AI12-059 which introduces Object_Size in Ada 2020. function Subtypes_Statically_Match (T1 : Entity_Id; @@ -5921,8 +5922,6 @@ package body Sem_Eval is -- No match if sizes different (from use of 'Object_Size). This test -- is excluded if Formal_Derived_Matching is True, as the base types -- can be different in that case and typically have different sizes. - -- ??? Frontend_Layout_On_Target used to set Esizes but this is no - -- longer the case, consider removing the last test below. elsif not Formal_Derived_Matching and then Known_Static_Esize (T1) diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index db4b1b4..2369d64 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -3927,6 +3927,10 @@ package body Sem_Prag is procedure Check_At_Most_N_Arguments (N : Nat); -- Check there are no more than N arguments present + procedure Check_Atomic_VFA (E : Entity_Id; VFA : Boolean); + -- Apply legality checks to type or object E subject to an Atomic aspect + -- in Ada 2020 (RM C.6(13)) or to a Volatile_Full_Access aspect. + procedure Check_Component (Comp : Node_Id; UU_Typ : Entity_Id; @@ -5680,6 +5684,165 @@ package body Sem_Prag is end if; end Check_At_Most_N_Arguments; + ------------------------ + -- Check_Atomic_VFA -- + ------------------------ + + procedure Check_Atomic_VFA (E : Entity_Id; VFA : Boolean) is + + Aliased_Subcomponent : exception; + -- Exception raised if an aliased subcomponent is found in E + + Independent_Subcomponent : exception; + -- Exception raised if an independent subcomponent is found in E + + procedure Check_Subcomponents (Typ : Entity_Id); + -- Apply checks to subcomponents for Atomic and Volatile_Full_Access + + ------------------------- + -- Check_Subcomponents -- + ------------------------- + + procedure Check_Subcomponents (Typ : Entity_Id) is + Comp : Entity_Id; + + begin + if Is_Array_Type (Typ) then + Comp := Component_Type (Typ); + + -- For Atomic we accept any atomic subcomponents + + if not VFA + and then (Has_Atomic_Components (Typ) + or else Is_Atomic (Comp)) + then + null; + + -- Give an error if the components are aliased + + elsif Has_Aliased_Components (Typ) + or else Is_Aliased (Comp) + then + raise Aliased_Subcomponent; + + -- For VFA we accept non-aliased VFA subcomponents + + elsif VFA + and then Is_Volatile_Full_Access (Comp) + then + null; + + -- Give an error if the components are independent + + elsif Has_Independent_Components (Typ) + or else Is_Independent (Comp) + then + raise Independent_Subcomponent; + end if; + + -- Recurse on the component type + + Check_Subcomponents (Comp); + + -- Note: Has_Aliased_Components, like Has_Atomic_Components, + -- and Has_Independent_Components, applies only to arrays. + -- However, this flag does not have a corresponding pragma, so + -- perhaps it should be possible to apply it to record types as + -- well. Should this be done ??? + + elsif Is_Record_Type (Typ) then + -- It is possible to have an aliased discriminant, so they + -- must be checked along with normal components. + + Comp := First_Component_Or_Discriminant (Typ); + while Present (Comp) loop + + -- For Atomic we accept any atomic subcomponents + + if not VFA + and then (Is_Atomic (Comp) + or else Is_Atomic (Etype (Comp))) + then + null; + + -- Give an error if the component is aliased + + elsif Is_Aliased (Comp) + or else Is_Aliased (Etype (Comp)) + then + raise Aliased_Subcomponent; + + -- For VFA we accept non-aliased VFA subcomponents + + elsif VFA + and then (Is_Volatile_Full_Access (Comp) + or else Is_Volatile_Full_Access (Etype (Comp))) + then + null; + + -- Give an error if the component is independent + + elsif Is_Independent (Comp) + or else Is_Independent (Etype (Comp)) + then + raise Independent_Subcomponent; + end if; + + -- Recurse on the component type + + Check_Subcomponents (Etype (Comp)); + + Next_Component_Or_Discriminant (Comp); + end loop; + end if; + end Check_Subcomponents; + + Typ : Entity_Id; + + begin + -- Fetch the type in case we are dealing with an object or component + + if Is_Type (E) then + Typ := E; + else + pragma Assert (Is_Object (E) + or else + Nkind (Declaration_Node (E)) = N_Component_Declaration); + + Typ := Etype (E); + end if; + + -- Check all the subcomponents of the type recursively, if any + + Check_Subcomponents (Typ); + + exception + when Aliased_Subcomponent => + if VFA then + Error_Pragma + ("cannot apply Volatile_Full_Access with aliased " + & "subcomponent "); + else + Error_Pragma + ("cannot apply Atomic with aliased subcomponent " + & "(RM C.6(13))"); + end if; + + when Independent_Subcomponent => + if VFA then + Error_Pragma + ("cannot apply Volatile_Full_Access with independent " + & "subcomponent "); + else + Error_Pragma + ("cannot apply Atomic with independent subcomponent " + & "(RM C.6(13))"); + end if; + + when others => + raise Program_Error; + end Check_Atomic_VFA; + --------------------- -- Check_Component -- --------------------- @@ -7260,13 +7423,16 @@ package body Sem_Prag is procedure Process_Atomic_Independent_Shared_Volatile is procedure Check_VFA_Conflicts (Ent : Entity_Id); - -- Apply additional checks for the GNAT pragma Volatile_Full_Access + -- Check that Volatile_Full_Access and VFA do not conflict procedure Mark_Component_Or_Object (Ent : Entity_Id); - -- Appropriately set flags on the given entity (either an array or + -- Appropriately set flags on the given entity, either an array or -- record component, or an object declaration) according to the -- current pragma. + procedure Mark_Type (Ent : Entity_Id); + -- Appropriately set flags on the given entity, a type + procedure Set_Atomic_VFA (Ent : Entity_Id); -- Set given type as Is_Atomic or Is_Volatile_Full_Access. Also, if -- no explicit alignment was given, set alignment to unknown, since @@ -7282,10 +7448,7 @@ package body Sem_Prag is Typ : Entity_Id; VFA_And_Atomic : Boolean := False; - -- Set True if atomic component present - - VFA_And_Aliased : Boolean := False; - -- Set True if aliased component present + -- Set True if both VFA and Atomic present begin -- Fetch the type in case we are dealing with an object or @@ -7343,48 +7506,6 @@ package body Sem_Prag is & "entity"); end if; end if; - - -- Check for the application of VFA to an entity that has aliased - -- components. - - if Prag_Id = Pragma_Volatile_Full_Access then - if Is_Array_Type (Typ) - and then Has_Aliased_Components (Typ) - then - VFA_And_Aliased := True; - - -- Note: Has_Aliased_Components, like Has_Atomic_Components, - -- and Has_Independent_Components, applies only to arrays. - -- However, this flag does not have a corresponding pragma, so - -- perhaps it should be possible to apply it to record types as - -- well. Should this be done ??? - - elsif Is_Record_Type (Typ) then - -- It is possible to have an aliased discriminant, so they - -- must be checked along with normal components. - - Comp := First_Component_Or_Discriminant (Typ); - while Present (Comp) loop - if Is_Aliased (Comp) - or else Is_Aliased (Etype (Comp)) - then - VFA_And_Aliased := True; - Check_SPARK_05_Restriction - ("aliased is not allowed", Comp); - - exit; - end if; - - Next_Component_Or_Discriminant (Comp); - end loop; - end if; - - if VFA_And_Aliased then - Error_Pragma - ("cannot apply Volatile_Full_Access (aliased component " - & "present)"); - end if; - end if; end Check_VFA_Conflicts; ------------------------------ @@ -7432,6 +7553,78 @@ package body Sem_Prag is end if; end Mark_Component_Or_Object; + --------------- + -- Mark_Type -- + --------------- + + procedure Mark_Type (Ent : Entity_Id) is + begin + -- Attribute belongs on the base type. If the view of the type is + -- currently private, it also belongs on the underlying type. + + -- In Ada_2020, the pragma can apply to a formal type, for which + -- there may be no underlying type. + + if Prag_Id = Pragma_Atomic + or else Prag_Id = Pragma_Shared + or else Prag_Id = Pragma_Volatile_Full_Access + then + Set_Atomic_VFA (Ent); + Set_Atomic_VFA (Base_Type (Ent)); + + if not Is_Generic_Type (Ent) then + Set_Atomic_VFA (Underlying_Type (Ent)); + end if; + end if; + + -- Atomic/Shared/Volatile_Full_Access imply Independent + + if Prag_Id /= Pragma_Volatile then + Set_Is_Independent (Ent); + Set_Is_Independent (Base_Type (Ent)); + + if not Is_Generic_Type (Ent) then + Set_Is_Independent (Underlying_Type (Ent)); + + if Prag_Id = Pragma_Independent then + Record_Independence_Check (N, Base_Type (Ent)); + end if; + end if; + end if; + + -- Atomic/Shared/Volatile_Full_Access imply Volatile + + if Prag_Id /= Pragma_Independent then + Set_Is_Volatile (Ent); + Set_Is_Volatile (Base_Type (Ent)); + + if not Is_Generic_Type (Ent) then + Set_Is_Volatile (Underlying_Type (Ent)); + Set_Treat_As_Volatile (Underlying_Type (Ent)); + end if; + + Set_Treat_As_Volatile (Ent); + end if; + + -- Apply Volatile to the composite type's individual components, + -- (RM C.6(8/3)). + + if Prag_Id = Pragma_Volatile + and then Is_Record_Type (Etype (Ent)) + then + declare + Comp : Entity_Id; + begin + Comp := First_Component (Ent); + while Present (Comp) loop + Mark_Component_Or_Object (Comp); + + Next_Component (Comp); + end loop; + end; + end if; + end Mark_Type; + -------------------- -- Set_Atomic_VFA -- -------------------- @@ -7494,58 +7687,7 @@ package body Sem_Prag is Check_First_Subtype (Arg1); end if; - -- Attribute belongs on the base type. If the view of the type is - -- currently private, it also belongs on the underlying type. - - if Prag_Id = Pragma_Atomic - or else Prag_Id = Pragma_Shared - or else Prag_Id = Pragma_Volatile_Full_Access - then - Set_Atomic_VFA (E); - Set_Atomic_VFA (Base_Type (E)); - Set_Atomic_VFA (Underlying_Type (E)); - end if; - - -- Atomic/Shared/Volatile_Full_Access imply Independent - - if Prag_Id /= Pragma_Volatile then - Set_Is_Independent (E); - Set_Is_Independent (Base_Type (E)); - Set_Is_Independent (Underlying_Type (E)); - - if Prag_Id = Pragma_Independent then - Record_Independence_Check (N, Base_Type (E)); - end if; - end if; - - -- Atomic/Shared/Volatile_Full_Access imply Volatile - - if Prag_Id /= Pragma_Independent then - Set_Is_Volatile (E); - Set_Is_Volatile (Base_Type (E)); - Set_Is_Volatile (Underlying_Type (E)); - - Set_Treat_As_Volatile (E); - Set_Treat_As_Volatile (Underlying_Type (E)); - end if; - - -- Apply Volatile to the composite type's individual components, - -- (RM C.6(8/3)). - - if Prag_Id = Pragma_Volatile - and then Is_Record_Type (Etype (E)) - then - declare - Comp : Entity_Id; - begin - Comp := First_Component (E); - while Present (Comp) loop - Mark_Component_Or_Object (Comp); - - Next_Component (Comp); - end loop; - end; - end if; + Mark_Type (E); -- Deal with the case where the pragma/attribute applies to a -- component or object declaration. @@ -7559,15 +7701,27 @@ package body Sem_Prag is end if; Mark_Component_Or_Object (E); + + -- In other cases give an error + else Error_Pragma_Arg ("inappropriate entity for pragma%", Arg1); end if; - -- Perform the checks needed to assure the proper use of the GNAT - -- pragma Volatile_Full_Access. + -- Check that Volatile_Full_Access and Atomic do not conflict Check_VFA_Conflicts (E); + -- Check for the application of Atomic or Volatile_Full_Access to + -- an entity that has [nonatomic] aliased, or else specified to be + -- independently addressable, subcomponents. + + if (Prag_Id = Pragma_Atomic and then Ada_Version >= Ada_2020) + or else Prag_Id = Pragma_Volatile_Full_Access + then + Check_Atomic_VFA (E, VFA => Prag_Id = Pragma_Volatile_Full_Access); + end if; + -- The following check is only relevant when SPARK_Mode is on as -- this is not a standard Ada legality rule. Pragma Volatile can -- only apply to a full type declaration or an object declaration @@ -13897,7 +14051,6 @@ package body Sem_Prag is D : Node_Id; E : Entity_Id; E_Id : Node_Id; - K : Node_Kind; begin Check_Ada_83_Warning; @@ -13926,24 +14079,33 @@ package body Sem_Prag is end if; D := Declaration_Node (E); - K := Nkind (D); - if (K = N_Full_Type_Declaration and then Is_Array_Type (E)) + if (Nkind (D) = N_Full_Type_Declaration and then Is_Array_Type (E)) or else - ((Ekind (E) = E_Constant or else Ekind (E) = E_Variable) - and then Nkind (D) = N_Object_Declaration + (Nkind (D) = N_Object_Declaration + and then (Ekind (E) = E_Constant + or else + Ekind (E) = E_Variable) and then Nkind (Object_Definition (D)) = N_Constrained_Array_Definition) + or else + (Ada_Version >= Ada_2020 + and then Nkind (D) = N_Formal_Type_Declaration) then - -- The flag is set on the object, or on the base type + -- The flag is set on the base type, or on the object - if Nkind (D) /= N_Object_Declaration then + if Nkind (D) = N_Full_Type_Declaration then E := Base_Type (E); end if; -- Atomic implies both Independent and Volatile if Prag_Id = Pragma_Atomic_Components then + if Ada_Version >= Ada_2020 then + Check_Atomic_VFA + (Component_Type (Etype (E)), VFA => False); + end if; + Set_Has_Atomic_Components (E); Set_Has_Independent_Components (E); end if; @@ -17818,7 +17980,6 @@ package body Sem_Prag is D : Node_Id; E_Id : Node_Id; E : Entity_Id; - K : Node_Kind; begin Check_Ada_83_Warning; @@ -17885,11 +18046,10 @@ package body Sem_Prag is end if; D := Declaration_Node (E); - K := Nkind (D); -- The flag is set on the base type, or on the object - if K = N_Full_Type_Declaration + if Nkind (D) = N_Full_Type_Declaration and then (Is_Array_Type (E) or else Is_Record_Type (E)) then Set_Has_Independent_Components (Base_Type (E)); diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 1c5ae36..21cbe0a 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -4715,7 +4715,7 @@ package body Sem_Res is end if; end if; - -- Check bad case of atomic/volatile argument (RM C.6(12)) + -- Check illegal cases of atomic/volatile actual (RM C.6(12,13)) if (Is_By_Reference_Type (Etype (F)) or else Is_Aliased (F)) and then Comes_From_Source (N) @@ -4724,14 +4724,30 @@ package body Sem_Res is and then not Is_Atomic (Etype (F)) then Error_Msg_NE - ("cannot pass atomic argument to non-atomic formal&", + ("cannot pass atomic object to nonatomic formal&", A, F); + Error_Msg_N + ("\which is passed by reference (RM C.6(12))", A); elsif Is_Volatile_Object (A) and then not Is_Volatile (Etype (F)) then Error_Msg_NE - ("cannot pass volatile argument to non-volatile formal&", + ("cannot pass volatile object to nonvolatile formal&", + A, F); + Error_Msg_N + ("\which is passed by reference (RM C.6(12))", A); + end if; + + if Ada_Version >= Ada_2020 + and then Is_Subcomponent_Of_Atomic_Object (A) + and then not Is_Atomic_Object (A) + then + Error_Msg_N + ("cannot pass nonatomic subcomponent of atomic object", + A); + Error_Msg_NE + ("\to formal & which is passed by reference (RM C.6(13))", A, F); end if; end if; @@ -6659,7 +6675,9 @@ package body Sem_Res is -- checkable, the case of calling an immediately containing -- subprogram is easy to catch. - Check_Restriction (No_Recursion, N); + if not Is_Ignored_Ghost_Entity (Nam) then + Check_Restriction (No_Recursion, N); + end if; -- If the recursive call is to a parameterless subprogram, -- then even if we can't statically detect infinite @@ -6804,9 +6822,13 @@ package body Sem_Res is then null; + -- A return statement from an ignored Ghost function does not use the + -- secondary stack (or any other one). + elsif Expander_Active and then Ekind_In (Nam, E_Function, E_Subprogram_Type) and then Requires_Transient_Scope (Etype (Nam)) + and then not Is_Ignored_Ghost_Entity (Nam) then Establish_Transient_Scope (N, Manage_Sec_Stack => True); @@ -11805,12 +11827,35 @@ package body Sem_Res is Set_Etype (Expression (N), Opnd); end if; + -- It seems that Non_Limited_View should also be applied for + -- Target when it has a limited view, but that leads to missing + -- error checks on interface conversions further below. ??? + if Is_Access_Type (Opnd) then Opnd := Designated_Type (Opnd); + + -- If the type of the operand is a limited view, use nonlimited + -- view when available. If it is a class-wide type, recover the + -- class-wide type of the nonlimited view. + + if From_Limited_With (Opnd) + and then Has_Non_Limited_View (Opnd) + then + Opnd := Non_Limited_View (Opnd); + end if; end if; if Is_Access_Type (Target_Typ) then Target := Designated_Type (Target); + + -- If the target type is a limited view, use nonlimited view + -- when available. + + if From_Limited_With (Target) + and then Has_Non_Limited_View (Target) + then + Target := Non_Limited_View (Target); + end if; end if; if Opnd = Target then @@ -11818,6 +11863,10 @@ package body Sem_Res is -- Conversion from interface type + -- It seems that it would be better for the error checks below + -- to be performed as part of Validate_Conversion (and maybe some + -- of the error checks above could be moved as well?). ??? + elsif Is_Interface (Opnd) then -- Ada 2005 (AI-217): Handle entities from limited views diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 30a2273..e1703e9 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -122,6 +122,10 @@ package body Sem_Util is -- T is a derived tagged type. Check whether the type extension is null. -- If the parent type is fully initialized, T can be treated as such. + function Is_Atomic_Object_Entity (Id : Entity_Id) return Boolean; + -- Determine whether arbitrary entity Id denotes an atomic object as per + -- RM C.6(7). + function Is_Fully_Initialized_Variant (Typ : Entity_Id) return Boolean; -- Subsidiary to Is_Fully_Initialized_Type. For an unconstrained type -- with discriminants whose default values are static, examine only the @@ -13724,16 +13728,16 @@ package body Sem_Util is ---------------------- function Is_Atomic_Object (N : Node_Id) return Boolean is - function Prefix_Has_Atomic_Components (Pref : Node_Id) return Boolean; - -- Determine whether prefix Pref of an indexed component has atomic - -- components. + function Prefix_Has_Atomic_Components (P : Node_Id) return Boolean; + -- Determine whether prefix P has atomic components. This requires the + -- presence of an Atomic_Components aspect/pragma. --------------------------------- -- Prefix_Has_Atomic_Components -- --------------------------------- - function Prefix_Has_Atomic_Components (Pref : Node_Id) return Boolean is - Typ : constant Entity_Id := Etype (Pref); + function Prefix_Has_Atomic_Components (P : Node_Id) return Boolean is + Typ : constant Entity_Id := Etype (P); begin if Is_Access_Type (Typ) then @@ -13742,8 +13746,8 @@ package body Sem_Util is elsif Has_Atomic_Components (Typ) then return True; - elsif Is_Entity_Name (Pref) - and then Has_Atomic_Components (Entity (Pref)) + elsif Is_Entity_Name (P) + and then Has_Atomic_Components (Entity (P)) then return True; @@ -13758,18 +13762,18 @@ package body Sem_Util is if Is_Entity_Name (N) then return Is_Atomic_Object_Entity (Entity (N)); + elsif Is_Atomic (Etype (N)) then + return True; + elsif Nkind (N) = N_Indexed_Component then - return - Is_Atomic (Etype (N)) - or else Prefix_Has_Atomic_Components (Prefix (N)); + return Prefix_Has_Atomic_Components (Prefix (N)); elsif Nkind (N) = N_Selected_Component then - return - Is_Atomic (Etype (N)) - or else Is_Atomic (Entity (Selector_Name (N))); - end if; + return Is_Atomic (Entity (Selector_Name (N))); - return False; + else + return False; + end if; end Is_Atomic_Object; ----------------------------- @@ -13789,12 +13793,7 @@ package body Sem_Util is function Is_Atomic_Or_VFA_Object (N : Node_Id) return Boolean is begin - return Is_Atomic_Object (N) - or else (Is_Entity_Name (N) - and then Is_Object (Entity (N)) - and then (Is_Volatile_Full_Access (Entity (N)) - or else - Is_Volatile_Full_Access (Etype (Entity (N))))); + return Is_Atomic_Object (N) or else Is_Volatile_Full_Access_Object (N); end Is_Atomic_Or_VFA_Object; ---------------------- @@ -15442,6 +15441,78 @@ package body Sem_Util is N_Generic_Subprogram_Declaration); end Is_Generic_Declaration_Or_Body; + --------------------------- + -- Is_Independent_Object -- + --------------------------- + + function Is_Independent_Object (N : Node_Id) return Boolean is + function Is_Independent_Object_Entity (Id : Entity_Id) return Boolean; + -- Determine whether arbitrary entity Id denotes an object that is + -- Independent. + + function Prefix_Has_Independent_Components (P : Node_Id) return Boolean; + -- Determine whether prefix P has independent components. This requires + -- the presence of an Independent_Components aspect/pragma. + + ------------------------------------ + -- Is_Independent_Object_Entity -- + ------------------------------------ + + function Is_Independent_Object_Entity (Id : Entity_Id) return Boolean is + begin + return + Is_Object (Id) + and then (Is_Independent (Id) + or else + Is_Independent (Etype (Id))); + end Is_Independent_Object_Entity; + + ------------------------------------- + -- Prefix_Has_Independent_Components -- + ------------------------------------- + + function Prefix_Has_Independent_Components (P : Node_Id) return Boolean + is + Typ : constant Entity_Id := Etype (P); + + begin + if Is_Access_Type (Typ) then + return Has_Independent_Components (Designated_Type (Typ)); + + elsif Has_Independent_Components (Typ) then + return True; + + elsif Is_Entity_Name (P) + and then Has_Independent_Components (Entity (P)) + then + return True; + + else + return False; + end if; + end Prefix_Has_Independent_Components; + + -- Start of processing for Is_Independent_Object + + begin + if Is_Entity_Name (N) then + return Is_Independent_Object_Entity (Entity (N)); + + elsif Is_Independent (Etype (N)) then + return True; + + elsif Nkind (N) = N_Indexed_Component then + return Prefix_Has_Independent_Components (Prefix (N)); + + elsif Nkind (N) = N_Selected_Component then + return Prefix_Has_Independent_Components (Prefix (N)) + or else Is_Independent (Entity (Selector_Name (N))); + + else + return False; + end if; + end Is_Independent_Object; + ---------------------------- -- Is_Inherited_Operation -- ---------------------------- @@ -17844,6 +17915,37 @@ package body Sem_Util is or else Nkind (N) = N_Procedure_Call_Statement; end Is_Statement; + ---------------------------------------- + -- Is_Subcomponent_Of_Atomic_Object -- + ---------------------------------------- + + function Is_Subcomponent_Of_Atomic_Object (N : Node_Id) return Boolean is + R : Node_Id; + + begin + R := Get_Referenced_Object (N); + + while Nkind_In (R, N_Indexed_Component, N_Selected_Component, N_Slice) + loop + R := Get_Referenced_Object (Prefix (R)); + + -- If the prefix is an access value, only the designated type matters + + if Is_Access_Type (Etype (R)) then + if Is_Atomic (Designated_Type (Etype (R))) then + return True; + end if; + + else + if Is_Atomic_Object (R) then + return True; + end if; + end if; + end loop; + + return False; + end Is_Subcomponent_Of_Atomic_Object; + --------------------------------------- -- Is_Subprogram_Contract_Annotation -- --------------------------------------- @@ -18477,6 +18579,45 @@ package body Sem_Util is and then Scope (Scope (Scope (Root))) = Standard_Standard; end Is_Visibly_Controlled; + -------------------------------------- + -- Is_Volatile_Full_Access_Object -- + -------------------------------------- + + function Is_Volatile_Full_Access_Object (N : Node_Id) return Boolean is + function Is_VFA_Object_Entity (Id : Entity_Id) return Boolean; + -- Determine whether arbitrary entity Id denotes an object that is + -- Volatile_Full_Access. + + ---------------------------- + -- Is_VFA_Object_Entity -- + ---------------------------- + + function Is_VFA_Object_Entity (Id : Entity_Id) return Boolean is + begin + return + Is_Object (Id) + and then (Is_Volatile_Full_Access (Id) + or else + Is_Volatile_Full_Access (Etype (Id))); + end Is_VFA_Object_Entity; + + -- Start of processing for Is_Volatile_Full_Access_Object + + begin + if Is_Entity_Name (N) then + return Is_VFA_Object_Entity (Entity (N)); + + elsif Is_Volatile_Full_Access (Etype (N)) then + return True; + + elsif Nkind (N) = N_Selected_Component then + return Is_Volatile_Full_Access (Entity (Selector_Name (N))); + + else + return False; + end if; + end Is_Volatile_Full_Access_Object; + -------------------------- -- Is_Volatile_Function -- -------------------------- @@ -18512,18 +18653,32 @@ package body Sem_Util is ------------------------ function Is_Volatile_Object (N : Node_Id) return Boolean is - function Is_Volatile_Prefix (N : Node_Id) return Boolean; - -- If prefix is an implicit dereference, examine designated type + function Is_Volatile_Object_Entity (Id : Entity_Id) return Boolean; + -- Determine whether arbitrary entity Id denotes an object that is + -- Volatile. - function Object_Has_Volatile_Components (N : Node_Id) return Boolean; - -- Determines if given object has volatile components + function Prefix_Has_Volatile_Components (P : Node_Id) return Boolean; + -- Determine whether prefix P has volatile components. This requires + -- the presence of a Volatile_Components aspect/pragma or that P be + -- itself a volatile object as per RM C.6(8). - ------------------------ - -- Is_Volatile_Prefix -- - ------------------------ + --------------------------------- + -- Is_Volatile_Object_Entity -- + --------------------------------- + + function Is_Volatile_Object_Entity (Id : Entity_Id) return Boolean is + begin + return + Is_Object (Id) + and then (Is_Volatile (Id) or else Is_Volatile (Etype (Id))); + end Is_Volatile_Object_Entity; - function Is_Volatile_Prefix (N : Node_Id) return Boolean is - Typ : constant Entity_Id := Etype (N); + ------------------------------------ + -- Prefix_Has_Volatile_Components -- + ------------------------------------ + + function Prefix_Has_Volatile_Components (P : Node_Id) return Boolean is + Typ : constant Entity_Id := Etype (P); begin if Is_Access_Type (Typ) then @@ -18531,67 +18686,41 @@ package body Sem_Util is Dtyp : constant Entity_Id := Designated_Type (Typ); begin - return Is_Volatile (Dtyp) - or else Has_Volatile_Components (Dtyp); + return Has_Volatile_Components (Dtyp) + or else Is_Volatile (Dtyp); end; - else - return Object_Has_Volatile_Components (N); - end if; - end Is_Volatile_Prefix; - - ------------------------------------ - -- Object_Has_Volatile_Components -- - ------------------------------------ - - function Object_Has_Volatile_Components (N : Node_Id) return Boolean is - Typ : constant Entity_Id := Etype (N); - - begin - if Is_Volatile (Typ) - or else Has_Volatile_Components (Typ) - then + elsif Has_Volatile_Components (Typ) then return True; - elsif Is_Entity_Name (N) - and then (Has_Volatile_Components (Entity (N)) - or else Is_Volatile (Entity (N))) + elsif Is_Entity_Name (P) + and then Has_Volatile_Component (Entity (P)) then return True; - elsif Nkind (N) = N_Indexed_Component - or else Nkind (N) = N_Selected_Component - then - return Is_Volatile_Prefix (Prefix (N)); + elsif Is_Volatile_Object (P) then + return True; else return False; end if; - end Object_Has_Volatile_Components; + end Prefix_Has_Volatile_Components; -- Start of processing for Is_Volatile_Object begin - if Nkind (N) = N_Defining_Identifier then - return Is_Volatile (N) or else Is_Volatile (Etype (N)); - - elsif Nkind (N) = N_Expanded_Name then - return Is_Volatile_Object (Entity (N)); + if Is_Entity_Name (N) then + return Is_Volatile_Object_Entity (Entity (N)); - elsif Is_Volatile (Etype (N)) - or else (Is_Entity_Name (N) and then Is_Volatile (Entity (N))) - then + elsif Is_Volatile (Etype (N)) then return True; - elsif Nkind_In (N, N_Indexed_Component, N_Selected_Component) - and then Is_Volatile_Prefix (Prefix (N)) - then - return True; + elsif Nkind (N) = N_Indexed_Component then + return Prefix_Has_Volatile_Components (Prefix (N)); - elsif Nkind (N) = N_Selected_Component - and then Is_Volatile (Entity (Selector_Name (N))) - then - return True; + elsif Nkind (N) = N_Selected_Component then + return Prefix_Has_Volatile_Components (Prefix (N)) + or else Is_Volatile (Entity (Selector_Name (N))); else return False; diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index c354d7e..c148a50 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -547,7 +547,7 @@ package Sem_Util is function Deepest_Type_Access_Level (Typ : Entity_Id) return Uint; -- Same as Type_Access_Level, except that if the type is the type of an Ada -- 2012 stand-alone object of an anonymous access type, then return the - -- static accesssibility level of the object. In that case, the dynamic + -- static accessibility level of the object. In that case, the dynamic -- accessibility level of the object may take on values in a range. The low -- bound of that range is returned by Type_Access_Level; this function -- yields the high bound of that range. Also differs from Type_Access_Level @@ -1531,13 +1531,7 @@ package Sem_Util is function Is_Atomic_Object (N : Node_Id) return Boolean; -- Determine whether arbitrary node N denotes a reference to an atomic - -- object as per Ada RM C.6(7) and the crucial remark in C.6(8). - - -- WARNING: There is a matching C declaration of this subprogram in fe.h - - function Is_Atomic_Object_Entity (Id : Entity_Id) return Boolean; - -- Determine whether arbitrary entity Id denotes an atomic object as per - -- Ada RM C.6(12). + -- object as per RM C.6(7) and the crucial remark in RM C.6(8). function Is_Atomic_Or_VFA_Object (N : Node_Id) return Boolean; -- Determine whether arbitrary node N denotes a reference to an object @@ -1751,6 +1745,10 @@ package Sem_Util is -- Determine whether arbitrary declaration Decl denotes a generic package, -- a generic subprogram or a generic body. + function Is_Independent_Object (N : Node_Id) return Boolean; + -- Determine whether arbitrary node N denotes a reference to an independent + -- object as per RM C.6(8). + function Is_Inherited_Operation (E : Entity_Id) return Boolean; -- E is a subprogram. Return True is E is an implicit operation inherited -- by a derived type declaration. @@ -1996,6 +1994,10 @@ package Sem_Util is -- the N_Statement_Other_Than_Procedure_Call subtype from Sinfo). -- Note that a label is *not* a statement, and will return False. + function Is_Subcomponent_Of_Atomic_Object (N : Node_Id) return Boolean; + -- Determine whether arbitrary node N denotes a reference to a subcomponent + -- of an atomic object as per RM C.6(7). + function Is_Subprogram_Contract_Annotation (Item : Node_Id) return Boolean; -- Determine whether aspect specification or pragma Item is one of the -- following subprogram contract annotations: @@ -2093,18 +2095,20 @@ package Sem_Util is -- Initialize/Adjust/Finalize subprogram does not override the inherited -- one. + function Is_Volatile_Full_Access_Object (N : Node_Id) return Boolean; + -- Determine whether arbitrary node N denotes a reference to an object + -- which is Volatile_Full_Access. + function Is_Volatile_Function (Func_Id : Entity_Id) return Boolean; -- Determine whether [generic] function Func_Id is subject to enabled -- pragma Volatile_Function. Protected functions are treated as volatile -- (SPARK RM 7.1.2). function Is_Volatile_Object (N : Node_Id) return Boolean; - -- Determines if the given node denotes an volatile object in the sense of - -- the legality checks described in RM C.6(12). Note that the test here is - -- for something actually declared as volatile, not for an object that gets - -- treated as volatile (see Einfo.Treat_As_Volatile). - - -- WARNING: There is a matching C declaration of this subprogram in fe.h + -- Determine whether arbitrary node N denotes a reference to a volatile + -- object as per RM C.6(8). Note that the test here is for something that + -- is actually declared as volatile, not for an object that gets treated + -- as volatile (see Einfo.Treat_As_Volatile). generic with procedure Handle_Parameter (Formal : Entity_Id; Actual : Node_Id); @@ -2682,7 +2686,7 @@ package Sem_Util is function Scope_Within_Or_Same (Inner : Entity_Id; Outer : Entity_Id) return Boolean; - -- Determine whether scope Inner appears within scope Outer or both renote + -- Determine whether scope Inner appears within scope Outer or both denote -- the same scope. Note that scopes are partially ordered, so Scope_Within -- (A, B) and Scope_Within (B, A) may both return False. diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index b99a32d..41cb8c8 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -2010,6 +2010,14 @@ package body Sinfo is return Flag2 (N); end Is_Generic_Contract_Pragma; + function Is_Homogeneous_Aggregate + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Aggregate); + return Flag14 (N); + end Is_Homogeneous_Aggregate; + function Is_Ignored (N : Node_Id) return Boolean is begin @@ -5505,6 +5513,14 @@ package body Sinfo is Set_Flag2 (N, Val); end Set_Is_Generic_Contract_Pragma; + procedure Set_Is_Homogeneous_Aggregate + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Aggregate); + Set_Flag14 (N, Val); + end Set_Is_Homogeneous_Aggregate; + procedure Set_Is_Ignored (N : Node_Id; Val : Boolean := True) is begin diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 5e04772..706007b 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -1837,6 +1837,11 @@ package Sinfo is -- Refined_State -- Test_Case + -- Is_Homogeneous_Aggregate (Flag14) + -- A flag set on an Ada2020 aggregate that uses square brackets as + -- delimiters, and thus denotes an array or container aggregate, or + -- the prefix of a reduction attribute. + -- Is_Ignored (Flag9-Sem) -- A flag set in an N_Aspect_Specification or N_Pragma node if there was -- a Check_Policy or Assertion_Policy (or in the case of a Debug_Pragma) @@ -4163,6 +4168,7 @@ package Sinfo is -- Compile_Time_Known_Aggregate (Flag18-Sem) -- Expansion_Delayed (Flag11-Sem) -- Has_Self_Reference (Flag13-Sem) + -- Is_Homogeneous_Aggregate (Flag14) -- plus fields for expression -- Note: this structure is used for both record and array aggregates @@ -9855,6 +9861,9 @@ package Sinfo is function Is_Generic_Contract_Pragma (N : Node_Id) return Boolean; -- Flag2 + function Is_Homogeneous_Aggregate + (N : Node_Id) return Boolean; -- Flag14 + function Is_Ignored (N : Node_Id) return Boolean; -- Flag9 @@ -10967,6 +10976,9 @@ package Sinfo is procedure Set_Is_Generic_Contract_Pragma (N : Node_Id; Val : Boolean := True); -- Flag2 + procedure Set_Is_Homogeneous_Aggregate + (N : Node_Id; Val : Boolean := True); -- Flag14 + procedure Set_Is_Ignored (N : Node_Id; Val : Boolean := True); -- Flag9 @@ -13521,6 +13533,7 @@ package Sinfo is pragma Inline (Is_Finalization_Wrapper); pragma Inline (Is_Folded_In_Parser); pragma Inline (Is_Generic_Contract_Pragma); + pragma Inline (Is_Homogeneous_Aggregate); pragma Inline (Is_Ignored); pragma Inline (Is_Ignored_Ghost_Pragma); pragma Inline (Is_In_Discriminant_Check); @@ -13887,6 +13900,7 @@ package Sinfo is pragma Inline (Set_Is_Finalization_Wrapper); pragma Inline (Set_Is_Folded_In_Parser); pragma Inline (Set_Is_Generic_Contract_Pragma); + pragma Inline (Set_Is_Homogeneous_Aggregate); pragma Inline (Set_Is_Ignored); pragma Inline (Set_Is_Ignored_Ghost_Pragma); pragma Inline (Set_Is_In_Discriminant_Check); diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 985a19f..9d8f13b 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -1002,6 +1002,7 @@ package Snames is Name_Priority : constant Name_Id := N + $; -- Ada 05 Name_Range : constant Name_Id := N + $; Name_Range_Length : constant Name_Id := N + $; -- GNAT + Name_Reduce : constant Name_Id := N + $; Name_Ref : constant Name_Id := N + $; -- GNAT Name_Restriction_Set : constant Name_Id := N + $; -- GNAT Name_Result : constant Name_Id := N + $; -- GNAT @@ -1674,6 +1675,7 @@ package Snames is Attribute_Priority, Attribute_Range, Attribute_Range_Length, + Attribute_Reduce, Attribute_Ref, Attribute_Restriction_Set, Attribute_Result, diff --git a/gcc/ada/socket.c b/gcc/ada/socket.c index 94538d4..6ca9d50 100644 --- a/gcc/ada/socket.c +++ b/gcc/ada/socket.c @@ -34,7 +34,9 @@ #define ATTRIBUTE_UNUSED __attribute__((unused)) /* Ensure access to errno is thread safe. */ +#ifndef _REENTRANT #define _REENTRANT +#endif #define _THREAD_SAFE #include "gsocket.h" diff --git a/gcc/builtins.c b/gcc/builtins.c index 4c08214..1297494 100644 --- a/gcc/builtins.c +++ b/gcc/builtins.c @@ -48,6 +48,7 @@ along with GCC; see the file COPYING3. If not see #include "calls.h" #include "varasm.h" #include "tree-object-size.h" +#include "tree-ssa-strlen.h" #include "realmpfr.h" #include "cfgrtl.h" #include "except.h" @@ -3696,11 +3697,13 @@ check_access (tree exp, tree, tree, tree dstwrite, return true; } -/* If STMT is a call to an allocation function, returns the size - of the object allocated by the call. */ +/* If STMT is a call to an allocation function, returns the constant + size of the object allocated by the call represented as sizetype. + If nonnull, sets RNG1[] to the range of the size. */ tree -gimple_call_alloc_size (gimple *stmt) +gimple_call_alloc_size (gimple *stmt, wide_int rng1[2] /* = NULL */, + const vr_values *rvals /* = NULL */) { if (!stmt) return NULL_TREE; @@ -3747,11 +3750,12 @@ gimple_call_alloc_size (gimple *stmt) tree size = gimple_call_arg (stmt, argidx1); - wide_int rng1[2]; - if (TREE_CODE (size) == INTEGER_CST) - rng1[0] = rng1[1] = wi::to_wide (size); - else if (TREE_CODE (size) != SSA_NAME - || get_range_info (size, rng1, rng1 + 1) != VR_RANGE) + wide_int rng1_buf[2]; + /* If RNG1 is not set, use the buffer. */ + if (!rng1) + rng1 = rng1_buf; + + if (!get_range (size, rng1, rvals)) return NULL_TREE; if (argidx2 > nargs && TREE_CODE (size) == INTEGER_CST) @@ -3761,20 +3765,18 @@ gimple_call_alloc_size (gimple *stmt) of the upper bounds as a constant. Ignore anti-ranges. */ tree n = argidx2 < nargs ? gimple_call_arg (stmt, argidx2) : integer_one_node; wide_int rng2[2]; - if (TREE_CODE (n) == INTEGER_CST) - rng2[0] = rng2[1] = wi::to_wide (n); - else if (TREE_CODE (n) != SSA_NAME - || get_range_info (n, rng2, rng2 + 1) != VR_RANGE) + if (!get_range (n, rng2, rvals)) return NULL_TREE; - /* Extend to the maximum precsion to avoid overflow. */ + /* Extend to the maximum precision to avoid overflow. */ const int prec = ADDR_MAX_PRECISION; rng1[0] = wide_int::from (rng1[0], prec, UNSIGNED); rng1[1] = wide_int::from (rng1[1], prec, UNSIGNED); rng2[0] = wide_int::from (rng2[0], prec, UNSIGNED); rng2[1] = wide_int::from (rng2[1], prec, UNSIGNED); - /* Return the lesser of SIZE_MAX and the product of the upper bounds. */ + /* Compute products of both bounds for the caller but return the lesser + of SIZE_MAX and the product of the upper bounds as a constant. */ rng1[0] = rng1[0] * rng2[0]; rng1[1] = rng1[1] * rng2[1]; tree size_max = TYPE_MAX_VALUE (sizetype); @@ -3787,36 +3789,76 @@ gimple_call_alloc_size (gimple *stmt) return wide_int_to_tree (sizetype, rng1[1]); } +/* Helper for compute_objsize. Returns the constant size of the DEST + if it refers to a variable or field and sets *PDECL to the DECL and + *POFF to zero. Otherwise returns null for other nodes. */ + +static tree +addr_decl_size (tree dest, tree *pdecl, tree *poff) +{ + if (TREE_CODE (dest) == ADDR_EXPR) + dest = TREE_OPERAND (dest, 0); + + if (DECL_P (dest)) + { + *pdecl = dest; + *poff = integer_zero_node; + if (tree size = DECL_SIZE_UNIT (dest)) + return TREE_CODE (size) == INTEGER_CST ? size : NULL_TREE; + } + + if (TREE_CODE (dest) == COMPONENT_REF) + { + *pdecl = TREE_OPERAND (dest, 1); + *poff = integer_zero_node; + /* Only return constant sizes for now while callers depend on it. */ + if (tree size = component_ref_size (dest)) + return TREE_CODE (size) == INTEGER_CST ? size : NULL_TREE; + } + + return NULL_TREE; +} + /* Helper to compute the size of the object referenced by the DEST expression which must have pointer type, using Object Size type - OSTYPE (only the least significant 2 bits are used). Return - an estimate of the size of the object if successful or NULL when - the size cannot be determined. When the referenced object involves - a non-constant offset in some range the returned value represents - the largest size given the smallest non-negative offset in the - range. If nonnull, set *PDECL to the decl of the referenced - subobject if it can be determined, or to null otherwise. Likewise, - when POFF is nonnull *POFF is set to the offset into *PDECL. + OSTYPE (only the least significant 2 bits are used). + Returns an estimate of the size of the object represented as + a sizetype constant if successful or NULL when the size cannot + be determined. + When the referenced object involves a non-constant offset in some + range the returned value represents the largest size given the + smallest non-negative offset in the range. + If nonnull, sets *PDECL to the decl of the referenced subobject + if it can be determined, or to null otherwise. Likewise, when + POFF is nonnull *POFF is set to the offset into *PDECL. + The function is intended for diagnostics and should not be used to influence code generation or optimization. */ tree compute_objsize (tree dest, int ostype, tree *pdecl /* = NULL */, - tree *poff /* = NULL */) + tree *poff /* = NULL */, const vr_values *rvals /* = NULL */) { tree dummy_decl = NULL_TREE; if (!pdecl) pdecl = &dummy_decl; - tree dummy_off = size_zero_node; + tree dummy_off = NULL_TREE; if (!poff) poff = &dummy_off; - unsigned HOST_WIDE_INT size; - /* Only the two least significant bits are meaningful. */ ostype &= 3; + if (ostype) + /* Except for overly permissive calls to memcpy and other raw + memory functions with zero OSTYPE, detect the size from simple + DECLs first to more reliably than compute_builtin_object_size + set *PDECL and *POFF. */ + if (tree size = addr_decl_size (dest, pdecl, poff)) + return size; + + unsigned HOST_WIDE_INT size; if (compute_builtin_object_size (dest, ostype, &size, pdecl, poff)) return build_int_cst (sizetype, size); @@ -3826,8 +3868,15 @@ compute_objsize (tree dest, int ostype, tree *pdecl /* = NULL */, if (is_gimple_call (stmt)) { /* If STMT is a call to an allocation function get the size - from its argument(s). */ - return gimple_call_alloc_size (stmt); + from its argument(s). If successful, also set *PDECL to + DEST for the caller to include in diagnostics. */ + if (tree size = gimple_call_alloc_size (stmt)) + { + *pdecl = dest; + *poff = integer_zero_node; + return size; + } + return NULL_TREE; } if (!is_gimple_assign (stmt)) @@ -3853,17 +3902,21 @@ compute_objsize (tree dest, int ostype, tree *pdecl /* = NULL */, /* Ignore negative offsets for now. For others, use the lower bound as the most optimistic estimate of the (remaining) size. */ - if (wi::sign_mask (wioff)) + if (wi::neg_p (wioff)) ; - else if (wi::ltu_p (wioff, wisiz)) - { - *poff = size_binop (PLUS_EXPR, *poff, off); - return wide_int_to_tree (TREE_TYPE (size), - wi::sub (wisiz, wioff)); - } else { - *poff = size_binop (PLUS_EXPR, *poff, off); + if (*poff) + { + *poff = fold_convert (ptrdiff_type_node, *poff); + off = fold_convert (ptrdiff_type_node, *poff); + *poff = size_binop (PLUS_EXPR, *poff, off); + } + else + *poff = off; + if (wi::ltu_p (wioff, wisiz)) + return wide_int_to_tree (TREE_TYPE (size), + wi::sub (wisiz, wioff)); return size_zero_node; } } @@ -3875,32 +3928,29 @@ compute_objsize (tree dest, int ostype, tree *pdecl /* = NULL */, enum value_range_kind rng = get_range_info (off, &min, &max); if (rng == VR_RANGE) - { - if (tree size = compute_objsize (dest, ostype, pdecl)) - { - wide_int wisiz = wi::to_wide (size); - - /* Ignore negative offsets for now. For others, - use the lower bound as the most optimistic - estimate of the (remaining)size. */ - if (wi::sign_mask (min) - || wi::sign_mask (max)) - ; - else if (wi::ltu_p (min, wisiz)) - { - *poff = size_binop (PLUS_EXPR, *poff, - wide_int_to_tree (sizetype, min)); + if (tree size = compute_objsize (dest, ostype, pdecl, poff)) + { + wide_int wisiz = wi::to_wide (size); + + /* Ignore negative offsets for now. For others, + use the lower bound as the most optimistic + estimate of the (remaining)size. */ + if (wi::neg_p (min) || wi::neg_p (max)) + ; + else + { + /* FIXME: For now, since the offset is non-constant, + clear *POFF to keep it from being "misused." + Eventually *POFF will need to become a range that + can be properly added to the outer offset if it + too is one. */ + *poff = NULL_TREE; + if (wi::ltu_p (min, wisiz)) return wide_int_to_tree (TREE_TYPE (size), wi::sub (wisiz, min)); - } - else - { - *poff = size_binop (PLUS_EXPR, *poff, - wide_int_to_tree (sizetype, min)); - return size_zero_node; - } - } - } + return size_zero_node; + } + } } } else if (code != ADDR_EXPR) @@ -3926,41 +3976,72 @@ compute_objsize (tree dest, int ostype, tree *pdecl /* = NULL */, && *poff && integer_zerop (*poff)) return size_zero_node; - /* A valid offset into a declared object cannot be negative. */ - if (tree_int_cst_sgn (*poff) < 0) + /* A valid offset into a declared object cannot be negative. + A zero size with a zero "inner" offset is still zero size + regardless of the "other" offset OFF. */ + if (*poff + && ((integer_zerop (*poff) && integer_zerop (size)) + || (TREE_CODE (*poff) == INTEGER_CST + && tree_int_cst_sgn (*poff) < 0))) return size_zero_node; + wide_int offrng[2]; + if (!get_range (off, offrng, rvals)) + return NULL_TREE; + + /* Convert to the same precision to keep wide_int from "helpfully" + crashing whenever it sees other arguments. */ + const unsigned sizprec = TYPE_PRECISION (sizetype); + offrng[0] = wide_int::from (offrng[0], sizprec, SIGNED); + offrng[1] = wide_int::from (offrng[1], sizprec, SIGNED); + /* Adjust SIZE either up or down by the sum of *POFF and OFF above. */ if (TREE_CODE (dest) == ARRAY_REF) { + tree lowbnd = array_ref_low_bound (dest); + if (!integer_zerop (lowbnd) && tree_fits_uhwi_p (lowbnd)) + { + /* Adjust the offset by the low bound of the array + domain (normally zero but 1 in Fortran). */ + unsigned HOST_WIDE_INT lb = tree_to_uhwi (lowbnd); + offrng[0] -= lb; + offrng[1] -= lb; + } + /* Convert the array index into a byte offset. */ tree eltype = TREE_TYPE (dest); tree tpsize = TYPE_SIZE_UNIT (eltype); if (tpsize && TREE_CODE (tpsize) == INTEGER_CST) - off = fold_build2 (MULT_EXPR, size_type_node, off, tpsize); + { + wide_int wsz = wi::to_wide (tpsize, offrng->get_precision ()); + offrng[0] *= wsz; + offrng[1] *= wsz; + } else return NULL_TREE; } - wide_int offrng[2]; - if (TREE_CODE (off) == INTEGER_CST) - offrng[0] = offrng[1] = wi::to_wide (off); - else if (TREE_CODE (off) == SSA_NAME) + wide_int wisize = wi::to_wide (size); + + if (!*poff) { - wide_int min, max; - enum value_range_kind rng - = get_range_info (off, offrng, offrng + 1); - if (rng != VR_RANGE) - return NULL_TREE; + /* If the "inner" offset is unknown and the "outer" offset + is either negative or less than SIZE, return the size + minus the offset. This may be overly optimistic in + the first case if the inner offset happens to be less + than the absolute value of the outer offset. */ + if (wi::neg_p (offrng[0])) + return size; + if (wi::ltu_p (offrng[0], wisize)) + return build_int_cst (sizetype, (wisize - offrng[0]).to_uhwi ()); + return size_zero_node; } - else - return NULL_TREE; /* Convert to the same precision to keep wide_int from "helpfuly" crashing whenever it sees other argumments. */ - offrng[0] = wide_int::from (offrng[0], ADDR_MAX_BITSIZE, SIGNED); - offrng[1] = wide_int::from (offrng[1], ADDR_MAX_BITSIZE, SIGNED); + offrng[0] = wide_int::from (offrng[0], sizprec, SIGNED); + offrng[1] = wide_int::from (offrng[1], sizprec, SIGNED); tree dstoff = *poff; if (integer_zerop (*poff)) @@ -3972,14 +4053,14 @@ compute_objsize (tree dest, int ostype, tree *pdecl /* = NULL */, *poff = size_binop (PLUS_EXPR, *poff, off); } - if (wi::sign_mask (offrng[0]) >= 0) + if (!wi::neg_p (offrng[0])) { if (TREE_CODE (size) != INTEGER_CST) return NULL_TREE; /* Return the difference between the size and the offset or zero if the offset is greater. */ - wide_int wisize = wi::to_wide (size, ADDR_MAX_BITSIZE); + wide_int wisize = wi::to_wide (size, sizprec); if (wi::ltu_p (wisize, offrng[0])) return size_zero_node; @@ -3999,39 +4080,25 @@ compute_objsize (tree dest, int ostype, tree *pdecl /* = NULL */, else return NULL_TREE; - dstoffrng[0] = wide_int::from (dstoffrng[0], ADDR_MAX_BITSIZE, SIGNED); - dstoffrng[1] = wide_int::from (dstoffrng[1], ADDR_MAX_BITSIZE, SIGNED); + dstoffrng[0] = wide_int::from (dstoffrng[0], sizprec, SIGNED); + dstoffrng[1] = wide_int::from (dstoffrng[1], sizprec, SIGNED); - wide_int declsize = wi::to_wide (size); - if (wi::sign_mask (dstoffrng[0]) > 0) - declsize += dstoffrng[0]; + if (!wi::neg_p (dstoffrng[0])) + wisize += dstoffrng[0]; offrng[1] += dstoffrng[1]; - if (wi::sign_mask (offrng[1]) < 0) + if (wi::neg_p (offrng[1])) return size_zero_node; - return wide_int_to_tree (sizetype, declsize); + return wide_int_to_tree (sizetype, wisize); } return NULL_TREE; } - if (TREE_CODE (dest) == COMPONENT_REF) - { - *pdecl = TREE_OPERAND (dest, 1); - return component_ref_size (dest); - } - - if (TREE_CODE (dest) != ADDR_EXPR) - return NULL_TREE; - - tree ref = TREE_OPERAND (dest, 0); - if (DECL_P (ref)) - { - *pdecl = ref; - if (tree size = DECL_SIZE_UNIT (ref)) - return TREE_CODE (size) == INTEGER_CST ? size : NULL_TREE; - } + /* Try simple DECLs not handled above. */ + if (tree size = addr_decl_size (dest, pdecl, poff)) + return size; tree type = TREE_TYPE (dest); if (TREE_CODE (type) == POINTER_TYPE) diff --git a/gcc/builtins.h b/gcc/builtins.h index 0fcccc1..2736f16 100644 --- a/gcc/builtins.h +++ b/gcc/builtins.h @@ -133,8 +133,12 @@ extern tree fold_call_stmt (gcall *, bool); extern void set_builtin_user_assembler_name (tree decl, const char *asmspec); extern bool is_simple_builtin (tree); extern bool is_inexpensive_builtin (tree); -extern tree gimple_call_alloc_size (gimple *); -extern tree compute_objsize (tree, int, tree * = NULL, tree * = NULL); + +class vr_values; +tree gimple_call_alloc_size (gimple *, wide_int[2] = NULL, + const vr_values * = NULL); +extern tree compute_objsize (tree, int, tree * = NULL, tree * = NULL, + const vr_values * = NULL); extern bool readonly_data_expr (tree exp); extern bool init_target_chars (void); diff --git a/gcc/c-family/ChangeLog b/gcc/c-family/ChangeLog index b264c38..77d928a 100644 --- a/gcc/c-family/ChangeLog +++ b/gcc/c-family/ChangeLog @@ -1,3 +1,16 @@ +2019-12-19 Julian Brown <julian@codesourcery.com> + Maciej W. Rozycki <macro@codesourcery.com> + Tobias Burnus <tobias@codesourcery.com> + Thomas Schwinge <thomas@codesourcery.com> + + * c-pragma.h (pragma_omp_clause): Add + PRAGMA_OACC_CLAUSE_NO_CREATE. + +2019-12-17 Martin Sebor <msebor@redhat.com> + + PR c++/61339 + * c.opt (-Wmismatched-tags, -Wredundant-tags): New options. + 2019-12-11 David Malcolm <dmalcolm@redhat.com> * c-pretty-print.c (c_pretty_printer::clone): New vfunc diff --git a/gcc/c-family/c-pragma.h b/gcc/c-family/c-pragma.h index bfe681b..3754c5f 100644 --- a/gcc/c-family/c-pragma.h +++ b/gcc/c-family/c-pragma.h @@ -154,6 +154,7 @@ enum pragma_omp_clause { PRAGMA_OACC_CLAUSE_GANG, PRAGMA_OACC_CLAUSE_HOST, PRAGMA_OACC_CLAUSE_INDEPENDENT, + PRAGMA_OACC_CLAUSE_NO_CREATE, PRAGMA_OACC_CLAUSE_NUM_GANGS, PRAGMA_OACC_CLAUSE_NUM_WORKERS, PRAGMA_OACC_CLAUSE_PRESENT, diff --git a/gcc/c-family/c.opt b/gcc/c-family/c.opt index 914a2f0..1fcb2e3 100644 --- a/gcc/c-family/c.opt +++ b/gcc/c-family/c.opt @@ -755,6 +755,10 @@ Wmisleading-indentation C C++ Common Var(warn_misleading_indentation) Warning LangEnabledBy(C C++,Wall) Warn when the indentation of the code does not reflect the block structure. +Wmismatched-tags +C++ ObjC++ Var(warn_mismatched_tags) Warning +Warn when a class is redeclared or referenced using a mismatched class-key. + Wmissing-braces C ObjC C++ ObjC++ Var(warn_missing_braces) Warning LangEnabledBy(C ObjC,Wall) Warn about possibly missing braces around initializers. @@ -783,6 +787,10 @@ Wpacked-not-aligned C ObjC C++ ObjC++ Var(warn_packed_not_aligned) Warning LangEnabledBy(C ObjC C++ ObjC++,Wall) Warn when fields in a struct with the packed attribute are misaligned. +Wredundant-tags +C++ ObjC++ Var(warn_redundant_tags) Warning +Warn when a class or enumerated type is referenced using a redundant class-key. + Wsized-deallocation C++ ObjC++ Var(warn_sized_deallocation) Warning EnabledBy(Wextra) Warn about missing sized deallocation functions. diff --git a/gcc/c/ChangeLog b/gcc/c/ChangeLog index 5371e9c..f4a088a 100644 --- a/gcc/c/ChangeLog +++ b/gcc/c/ChangeLog @@ -1,3 +1,17 @@ +2019-12-19 Julian Brown <julian@codesourcery.com> + Maciej W. Rozycki <macro@codesourcery.com> + Tobias Burnus <tobias@codesourcery.com> + Thomas Schwinge <thomas@codesourcery.com> + + * c-parser.c (c_parser_omp_clause_name): Support no_create. + (c_parser_oacc_data_clause): Likewise. + (c_parser_oacc_all_clauses): Likewise. + (OACC_DATA_CLAUSE_MASK, OACC_KERNELS_CLAUSE_MASK) + (OACC_PARALLEL_CLAUSE_MASK, OACC_SERIAL_CLAUSE_MASK): Add + PRAGMA_OACC_CLAUSE_NO_CREATE. + * c-typeck.c (handle_omp_array_sections): Support + GOMP_MAP_NO_ALLOC. + 2019-12-09 David Malcolm <dmalcolm@redhat.com> * c-objc-common.c (range_label_for_type_mismatch::get_text): diff --git a/gcc/c/c-parser.c b/gcc/c/c-parser.c index bfe5699..9b80088 100644 --- a/gcc/c/c-parser.c +++ b/gcc/c/c-parser.c @@ -12650,7 +12650,9 @@ c_parser_omp_clause_name (c_parser *parser) result = PRAGMA_OMP_CLAUSE_MERGEABLE; break; case 'n': - if (!strcmp ("nogroup", p)) + if (!strcmp ("no_create", p)) + result = PRAGMA_OACC_CLAUSE_NO_CREATE; + else if (!strcmp ("nogroup", p)) result = PRAGMA_OMP_CLAUSE_NOGROUP; else if (!strcmp ("nontemporal", p)) result = PRAGMA_OMP_CLAUSE_NONTEMPORAL; @@ -13113,7 +13115,10 @@ c_parser_omp_var_list_parens (c_parser *parser, enum omp_clause_code kind, copyout ( variable-list ) create ( variable-list ) delete ( variable-list ) - present ( variable-list ) */ + present ( variable-list ) + + OpenACC 2.6: + no_create ( variable-list ) */ static tree c_parser_oacc_data_clause (c_parser *parser, pragma_omp_clause c_kind, @@ -13149,6 +13154,9 @@ c_parser_oacc_data_clause (c_parser *parser, pragma_omp_clause c_kind, case PRAGMA_OACC_CLAUSE_LINK: kind = GOMP_MAP_LINK; break; + case PRAGMA_OACC_CLAUSE_NO_CREATE: + kind = GOMP_MAP_IF_PRESENT; + break; case PRAGMA_OACC_CLAUSE_PRESENT: kind = GOMP_MAP_FORCE_PRESENT; break; @@ -15947,6 +15955,10 @@ c_parser_oacc_all_clauses (c_parser *parser, omp_clause_mask mask, clauses = c_parser_oacc_data_clause (parser, c_kind, clauses); c_name = "link"; break; + case PRAGMA_OACC_CLAUSE_NO_CREATE: + clauses = c_parser_oacc_data_clause (parser, c_kind, clauses); + c_name = "no_create"; + break; case PRAGMA_OACC_CLAUSE_NUM_GANGS: clauses = c_parser_oacc_single_int_clause (parser, OMP_CLAUSE_NUM_GANGS, @@ -16415,6 +16427,7 @@ c_parser_oacc_cache (location_t loc, c_parser *parser) | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_CREATE) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_DEVICEPTR) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_IF) \ + | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_NO_CREATE) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_PRESENT)) static tree @@ -16747,6 +16760,7 @@ c_parser_oacc_loop (location_t loc, c_parser *parser, char *p_name, | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_DEFAULT) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_DEVICEPTR) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_IF) \ + | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_NO_CREATE) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_NUM_GANGS) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_NUM_WORKERS) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_PRESENT) \ @@ -16762,6 +16776,7 @@ c_parser_oacc_loop (location_t loc, c_parser *parser, char *p_name, | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_DEFAULT) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_DEVICEPTR) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_IF) \ + | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_NO_CREATE) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_PRIVATE) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_FIRSTPRIVATE) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_NUM_GANGS) \ @@ -16780,6 +16795,7 @@ c_parser_oacc_loop (location_t loc, c_parser *parser, char *p_name, | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_DEFAULT) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_DEVICEPTR) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_IF) \ + | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_NO_CREATE) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_PRIVATE) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_FIRSTPRIVATE) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_PRESENT) \ diff --git a/gcc/c/c-typeck.c b/gcc/c/c-typeck.c index 36aedc0..ce5e649 100644 --- a/gcc/c/c-typeck.c +++ b/gcc/c/c-typeck.c @@ -13422,6 +13422,7 @@ handle_omp_array_sections (tree c, enum c_omp_region_type ort) switch (OMP_CLAUSE_MAP_KIND (c)) { case GOMP_MAP_ALLOC: + case GOMP_MAP_IF_PRESENT: case GOMP_MAP_TO: case GOMP_MAP_FROM: case GOMP_MAP_TOFROM: diff --git a/gcc/common.opt b/gcc/common.opt index b4dc31c..058da8a 100644 --- a/gcc/common.opt +++ b/gcc/common.opt @@ -1334,6 +1334,10 @@ fdiagnostics-show-option Common Var(flag_diagnostics_show_option) Init(1) Amend appropriate diagnostic messages with the command line option that controls them. +fdiagnostics-show-cwe +Common Var(flag_diagnostics_show_cwe) Init(1) +Print CWE identifiers for diagnostic messages, where available. + fdiagnostics-minimum-margin-width= Common Joined UInteger Var(diagnostics_minimum_margin_width) Init(6) Set minimum width of left margin of source code when showing source. diff --git a/gcc/common/config/i386/i386-common.c b/gcc/common/config/i386/i386-common.c index d3e861b..0de0138 100644 --- a/gcc/common/config/i386/i386-common.c +++ b/gcc/common/config/i386/i386-common.c @@ -1617,7 +1617,7 @@ const pta processor_alias_table[] = {"pentium-m", PROCESSOR_PENTIUMPRO, CPU_PENTIUMPRO, PTA_MMX | PTA_SSE | PTA_SSE2 | PTA_FXSR}, {"pentium4", PROCESSOR_PENTIUM4, CPU_NONE, - PTA_MMX |PTA_SSE | PTA_SSE2 | PTA_FXSR}, + PTA_MMX | PTA_SSE | PTA_SSE2 | PTA_FXSR}, {"pentium4m", PROCESSOR_PENTIUM4, CPU_NONE, PTA_MMX | PTA_SSE | PTA_SSE2 | PTA_FXSR}, {"prescott", PROCESSOR_NOCONA, CPU_NONE, @@ -1775,12 +1775,12 @@ const pta processor_alias_table[] = | PTA_SHA | PTA_LZCNT | PTA_POPCNT | PTA_CLWB | PTA_RDPID | PTA_WBNOINVD}, {"btver1", PROCESSOR_BTVER1, CPU_GENERIC, - PTA_64BIT | PTA_MMX | PTA_SSE | PTA_SSE2 | PTA_SSE3 - | PTA_SSSE3 | PTA_SSE4A |PTA_ABM | PTA_CX16 | PTA_PRFCHW + PTA_64BIT | PTA_MMX | PTA_SSE | PTA_SSE2 | PTA_SSE3 + | PTA_SSSE3 | PTA_SSE4A | PTA_ABM | PTA_CX16 | PTA_PRFCHW | PTA_FXSR | PTA_XSAVE}, {"btver2", PROCESSOR_BTVER2, CPU_BTVER2, - PTA_64BIT | PTA_MMX | PTA_SSE | PTA_SSE2 | PTA_SSE3 - | PTA_SSSE3 | PTA_SSE4A |PTA_ABM | PTA_CX16 | PTA_SSE4_1 + PTA_64BIT | PTA_MMX | PTA_SSE | PTA_SSE2 | PTA_SSE3 + | PTA_SSSE3 | PTA_SSE4A | PTA_ABM | PTA_CX16 | PTA_SSE4_1 | PTA_SSE4_2 | PTA_AES | PTA_PCLMUL | PTA_AVX | PTA_BMI | PTA_F16C | PTA_MOVBE | PTA_PRFCHW | PTA_FXSR | PTA_XSAVE | PTA_XSAVEOPT}, diff --git a/gcc/config.gcc b/gcc/config.gcc index 5aa0130..9802f43 100644 --- a/gcc/config.gcc +++ b/gcc/config.gcc @@ -2624,7 +2624,7 @@ mn10300-*-*) use_collect2=no use_gcc_stdint=wrap ;; -msp430*-*-*) +msp430-*-*) tm_file="dbxelf.h elfos.h newlib-stdint.h ${tm_file}" c_target_objs="msp430-c.o" cxx_target_objs="msp430-c.o" @@ -2637,6 +2637,18 @@ msp430*-*-*) if test x${disable_initfini_array} != xyes; then gcc_cv_initfini_array=yes fi + case ${target} in + msp430-*-elfbare) + # __cxa_atexit increases code size, and we don't need to support + # dynamic shared objects on MSP430, so regular Newlib atexit is a + # fine replacement as it also supports registration of more than 32 + # functions. + default_use_cxa_atexit=no + # This target does not match the generic *-*-elf case above which + # sets use_gcc_stdint=wrap, so explicitly set it here. + use_gcc_stdint=wrap + ;; + esac ;; nds32*-*-*) target_cpu_default="0" diff --git a/gcc/config/aarch64/aarch64-cores.def b/gcc/config/aarch64/aarch64-cores.def index 053c639..d170253 100644 --- a/gcc/config/aarch64/aarch64-cores.def +++ b/gcc/config/aarch64/aarch64-cores.def @@ -101,13 +101,13 @@ AARCH64_CORE("thunderx2t99", thunderx2t99, thunderx2t99, 8_1A, AARCH64_FL_FOR AARCH64_CORE("cortex-a55", cortexa55, cortexa53, 8_2A, AARCH64_FL_FOR_ARCH8_2 | AARCH64_FL_F16 | AARCH64_FL_RCPC | AARCH64_FL_DOTPROD, cortexa53, 0x41, 0xd05, -1) AARCH64_CORE("cortex-a75", cortexa75, cortexa57, 8_2A, AARCH64_FL_FOR_ARCH8_2 | AARCH64_FL_F16 | AARCH64_FL_RCPC | AARCH64_FL_DOTPROD, cortexa73, 0x41, 0xd0a, -1) AARCH64_CORE("cortex-a76", cortexa76, cortexa57, 8_2A, AARCH64_FL_FOR_ARCH8_2 | AARCH64_FL_F16 | AARCH64_FL_RCPC | AARCH64_FL_DOTPROD, neoversen1, 0x41, 0xd0b, -1) -AARCH64_CORE("cortex-a76ae", cortexa76ae, cortexa57, 8_2A, AARCH64_FL_FOR_ARCH8_2 | AARCH64_FL_F16 | AARCH64_FL_RCPC | AARCH64_FL_DOTPROD | AARCH64_FL_SSBS, cortexa72, 0x41, 0xd0e, -1) -AARCH64_CORE("cortex-a77", cortexa77, cortexa57, 8_2A, AARCH64_FL_FOR_ARCH8_2 | AARCH64_FL_F16 | AARCH64_FL_RCPC | AARCH64_FL_DOTPROD | AARCH64_FL_SSBS, cortexa72, 0x41, 0xd0d, -1) -AARCH64_CORE("cortex-a65", cortexa65, cortexa57, 8_2A, AARCH64_FL_FOR_ARCH8_2 | AARCH64_FL_F16 | AARCH64_FL_RCPC | AARCH64_FL_DOTPROD | AARCH64_FL_SSBS, cortexa73, 0x41, 0xd06, -1) -AARCH64_CORE("cortex-a65ae", cortexa65ae, cortexa57, 8_2A, AARCH64_FL_FOR_ARCH8_2 | AARCH64_FL_F16 | AARCH64_FL_RCPC | AARCH64_FL_DOTPROD | AARCH64_FL_SSBS, cortexa73, 0x41, 0xd43, -1) +AARCH64_CORE("cortex-a76ae", cortexa76ae, cortexa57, 8_2A, AARCH64_FL_FOR_ARCH8_2 | AARCH64_FL_F16 | AARCH64_FL_RCPC | AARCH64_FL_DOTPROD | AARCH64_FL_SSBS, neoversen1, 0x41, 0xd0e, -1) +AARCH64_CORE("cortex-a77", cortexa77, cortexa57, 8_2A, AARCH64_FL_FOR_ARCH8_2 | AARCH64_FL_F16 | AARCH64_FL_RCPC | AARCH64_FL_DOTPROD | AARCH64_FL_SSBS, neoversen1, 0x41, 0xd0d, -1) +AARCH64_CORE("cortex-a65", cortexa65, cortexa53, 8_2A, AARCH64_FL_FOR_ARCH8_2 | AARCH64_FL_F16 | AARCH64_FL_RCPC | AARCH64_FL_DOTPROD | AARCH64_FL_SSBS, cortexa73, 0x41, 0xd06, -1) +AARCH64_CORE("cortex-a65ae", cortexa65ae, cortexa53, 8_2A, AARCH64_FL_FOR_ARCH8_2 | AARCH64_FL_F16 | AARCH64_FL_RCPC | AARCH64_FL_DOTPROD | AARCH64_FL_SSBS, cortexa73, 0x41, 0xd43, -1) AARCH64_CORE("ares", ares, cortexa57, 8_2A, AARCH64_FL_FOR_ARCH8_2 | AARCH64_FL_F16 | AARCH64_FL_RCPC | AARCH64_FL_DOTPROD | AARCH64_FL_PROFILE, neoversen1, 0x41, 0xd0c, -1) AARCH64_CORE("neoverse-n1", neoversen1, cortexa57, 8_2A, AARCH64_FL_FOR_ARCH8_2 | AARCH64_FL_F16 | AARCH64_FL_RCPC | AARCH64_FL_DOTPROD | AARCH64_FL_PROFILE, neoversen1, 0x41, 0xd0c, -1) -AARCH64_CORE("neoverse-e1", neoversee1, cortexa53, 8_2A, AARCH64_FL_FOR_ARCH8_2 | AARCH64_FL_F16 | AARCH64_FL_RCPC | AARCH64_FL_DOTPROD | AARCH64_FL_SSBS, cortexa53, 0x41, 0xd4a, -1) +AARCH64_CORE("neoverse-e1", neoversee1, cortexa53, 8_2A, AARCH64_FL_FOR_ARCH8_2 | AARCH64_FL_F16 | AARCH64_FL_RCPC | AARCH64_FL_DOTPROD | AARCH64_FL_SSBS, cortexa73, 0x41, 0xd4a, -1) /* HiSilicon ('H') cores. */ AARCH64_CORE("tsv110", tsv110, tsv110, 8_2A, AARCH64_FL_FOR_ARCH8_2 | AARCH64_FL_CRYPTO | AARCH64_FL_F16 | AARCH64_FL_AES | AARCH64_FL_SHA2, tsv110, 0x48, 0xd01, -1) @@ -127,6 +127,6 @@ AARCH64_CORE("cortex-a73.cortex-a53", cortexa73cortexa53, cortexa53, 8A, AARCH /* ARM DynamIQ big.LITTLE configurations. */ AARCH64_CORE("cortex-a75.cortex-a55", cortexa75cortexa55, cortexa53, 8_2A, AARCH64_FL_FOR_ARCH8_2 | AARCH64_FL_F16 | AARCH64_FL_RCPC | AARCH64_FL_DOTPROD, cortexa73, 0x41, AARCH64_BIG_LITTLE (0xd0a, 0xd05), -1) -AARCH64_CORE("cortex-a76.cortex-a55", cortexa76cortexa55, cortexa53, 8_2A, AARCH64_FL_FOR_ARCH8_2 | AARCH64_FL_F16 | AARCH64_FL_RCPC | AARCH64_FL_DOTPROD, cortexa72, 0x41, AARCH64_BIG_LITTLE (0xd0b, 0xd05), -1) +AARCH64_CORE("cortex-a76.cortex-a55", cortexa76cortexa55, cortexa53, 8_2A, AARCH64_FL_FOR_ARCH8_2 | AARCH64_FL_F16 | AARCH64_FL_RCPC | AARCH64_FL_DOTPROD, neoversen1, 0x41, AARCH64_BIG_LITTLE (0xd0b, 0xd05), -1) #undef AARCH64_CORE diff --git a/gcc/config/arm/arm-protos.h b/gcc/config/arm/arm-protos.h index a3f246b..2b61dac 100644 --- a/gcc/config/arm/arm-protos.h +++ b/gcc/config/arm/arm-protos.h @@ -71,6 +71,7 @@ extern bool arm_small_register_classes_for_mode_p (machine_mode); extern int const_ok_for_arm (HOST_WIDE_INT); extern int const_ok_for_op (HOST_WIDE_INT, enum rtx_code); extern int const_ok_for_dimode_op (HOST_WIDE_INT, enum rtx_code); +extern void thumb1_gen_const_int (rtx, HOST_WIDE_INT); extern int arm_split_constant (RTX_CODE, machine_mode, rtx, HOST_WIDE_INT, rtx, rtx, int); extern int legitimate_pic_operand_p (rtx); diff --git a/gcc/config/arm/arm.c b/gcc/config/arm/arm.c index 983852c..44d6d52 100644 --- a/gcc/config/arm/arm.c +++ b/gcc/config/arm/arm.c @@ -2893,13 +2893,18 @@ arm_option_check_internal (struct gcc_options *opts) { const char *flag = (target_pure_code ? "-mpure-code" : "-mslow-flash-data"); + bool common_unsupported_modes = arm_arch_notm || flag_pic || TARGET_NEON; - /* We only support -mpure-code and -mslow-flash-data on M-profile targets - with MOVT. */ - if (!TARGET_HAVE_MOVT || arm_arch_notm || flag_pic || TARGET_NEON) + /* We only support -mslow-flash-data on M-profile targets with + MOVT. */ + if (target_slow_flash_data && (!TARGET_HAVE_MOVT || common_unsupported_modes)) error ("%s only supports non-pic code on M-profile targets with the " "MOVT instruction", flag); + /* We only support -mpure-code on M-profile targets. */ + if (target_pure_code && common_unsupported_modes) + error ("%s only supports non-pic code on M-profile targets", flag); + /* Cannot load addresses: -mslow-flash-data forbids literal pool and -mword-relocations forbids relocation of MOVT/MOVW. */ if (target_word_relocations) @@ -4421,6 +4426,38 @@ const_ok_for_dimode_op (HOST_WIDE_INT i, enum rtx_code code) } } +/* Emit a sequence of movs/adds/shift to produce a 32-bit constant. + Avoid generating useless code when one of the bytes is zero. */ +void +thumb1_gen_const_int (rtx op0, HOST_WIDE_INT op1) +{ + bool mov_done_p = false; + int i; + + /* Emit upper 3 bytes if needed. */ + for (i = 0; i < 3; i++) + { + int byte = (op1 >> (8 * (3 - i))) & 0xff; + + if (byte) + { + emit_set_insn (op0, mov_done_p + ? gen_rtx_PLUS (SImode,op0, GEN_INT (byte)) + : GEN_INT (byte)); + mov_done_p = true; + } + + if (mov_done_p) + emit_set_insn (op0, gen_rtx_ASHIFT (SImode, op0, GEN_INT (8))); + } + + /* Emit lower byte if needed. */ + if (!mov_done_p) + emit_set_insn (op0, GEN_INT (op1 & 0xff)); + else if (op1 & 0xff) + emit_set_insn (op0, gen_rtx_PLUS (SImode, op0, GEN_INT (op1 & 0xff))); +} + /* Emit a sequence of insns to handle a large constant. CODE is the code of the operation required, it can be any of SET, PLUS, IOR, AND, XOR, MINUS; @@ -8576,7 +8613,8 @@ thumb1_legitimate_address_p (machine_mode mode, rtx x, int strict_p) /* This is PC relative data before arm_reorg runs. */ else if (GET_MODE_SIZE (mode) >= 4 && CONSTANT_P (x) && GET_CODE (x) == SYMBOL_REF - && CONSTANT_POOL_ADDRESS_P (x) && !flag_pic) + && CONSTANT_POOL_ADDRESS_P (x) && !flag_pic + && !arm_disable_literal_pool) return 1; /* This is PC relative data after arm_reorg runs. */ @@ -8644,6 +8682,7 @@ thumb1_legitimate_address_p (machine_mode mode, rtx x, int strict_p) && GET_MODE_SIZE (mode) == 4 && GET_CODE (x) == SYMBOL_REF && CONSTANT_POOL_ADDRESS_P (x) + && !arm_disable_literal_pool && ! (flag_pic && symbol_mentioned_p (get_pool_constant (x)) && ! pcrel_constant_p (get_pool_constant (x)))) @@ -9322,7 +9361,9 @@ thumb1_rtx_costs (rtx x, enum rtx_code code, enum rtx_code outer) return 0; if (thumb_shiftable_const (INTVAL (x))) return COSTS_N_INSNS (2); - return COSTS_N_INSNS (3); + return arm_disable_literal_pool + ? COSTS_N_INSNS (8) + : COSTS_N_INSNS (3); } else if ((outer == PLUS || outer == COMPARE) && INTVAL (x) < 256 && INTVAL (x) > -256) @@ -9479,7 +9520,9 @@ thumb1_size_rtx_costs (rtx x, enum rtx_code code, enum rtx_code outer) /* See split "TARGET_THUMB1 && satisfies_constraint_K". */ if (thumb_shiftable_const (INTVAL (x))) return COSTS_N_INSNS (2); - return COSTS_N_INSNS (3); + return arm_disable_literal_pool + ? COSTS_N_INSNS (8) + : COSTS_N_INSNS (3); } else if ((outer == PLUS || outer == COMPARE) && INTVAL (x) < 256 && INTVAL (x) > -256) @@ -27465,14 +27508,41 @@ arm_thumb1_mi_thunk (FILE *file, tree, HOST_WIDE_INT delta, /* push r3 so we can use it as a temporary. */ /* TODO: Omit this save if r3 is not used. */ fputs ("\tpush {r3}\n", file); - fputs ("\tldr\tr3, ", file); + + /* With -mpure-code, we cannot load the address from the + constant pool: we build it explicitly. */ + if (target_pure_code) + { + fputs ("\tmovs\tr3, #:upper8_15:#", file); + assemble_name (file, XSTR (XEXP (DECL_RTL (function), 0), 0)); + fputc ('\n', file); + fputs ("\tlsls r3, #8\n", file); + fputs ("\tadds\tr3, #:upper0_7:#", file); + assemble_name (file, XSTR (XEXP (DECL_RTL (function), 0), 0)); + fputc ('\n', file); + fputs ("\tlsls r3, #8\n", file); + fputs ("\tadds\tr3, #:lower8_15:#", file); + assemble_name (file, XSTR (XEXP (DECL_RTL (function), 0), 0)); + fputc ('\n', file); + fputs ("\tlsls r3, #8\n", file); + fputs ("\tadds\tr3, #:lower0_7:#", file); + assemble_name (file, XSTR (XEXP (DECL_RTL (function), 0), 0)); + fputc ('\n', file); + } + else + fputs ("\tldr\tr3, ", file); } else { fputs ("\tldr\tr12, ", file); } - assemble_name (file, label); - fputc ('\n', file); + + if (!target_pure_code) + { + assemble_name (file, label); + fputc ('\n', file); + } + if (flag_pic) { /* If we are generating PIC, the ldr instruction below loads diff --git a/gcc/config/arm/arm.h b/gcc/config/arm/arm.h index 3a1ba8b..29a66bc 100644 --- a/gcc/config/arm/arm.h +++ b/gcc/config/arm/arm.h @@ -1857,9 +1857,11 @@ enum arm_auto_incmodes for the index in the tablejump instruction. */ #define CASE_VECTOR_MODE Pmode -#define CASE_VECTOR_PC_RELATIVE (TARGET_THUMB2 \ - || (TARGET_THUMB1 \ - && (optimize_size || flag_pic))) +#define CASE_VECTOR_PC_RELATIVE ((TARGET_THUMB2 \ + || (TARGET_THUMB1 \ + && (optimize_size || flag_pic))) \ + && (!target_pure_code)) + #define CASE_VECTOR_SHORTEN_MODE(min, max, body) \ (TARGET_THUMB1 \ diff --git a/gcc/config/arm/thumb1.md b/gcc/config/arm/thumb1.md index 9df793c..3319b38 100644 --- a/gcc/config/arm/thumb1.md +++ b/gcc/config/arm/thumb1.md @@ -43,6 +43,41 @@ +(define_insn "thumb1_movsi_symbol_ref" + [(set (match_operand:SI 0 "register_operand" "=l") + (match_operand:SI 1 "general_operand" "")) + ] + "TARGET_THUMB1 + && arm_disable_literal_pool + && GET_CODE (operands[1]) == SYMBOL_REF" + "* + output_asm_insn (\"movs\\t%0, #:upper8_15:%1\", operands); + output_asm_insn (\"lsls\\t%0, #8\", operands); + output_asm_insn (\"adds\\t%0, #:upper0_7:%1\", operands); + output_asm_insn (\"lsls\\t%0, #8\", operands); + output_asm_insn (\"adds\\t%0, #:lower8_15:%1\", operands); + output_asm_insn (\"lsls\\t%0, #8\", operands); + output_asm_insn (\"adds\\t%0, #:lower0_7:%1\", operands); + return \"\"; + " + [(set_attr "length" "14") + (set_attr "conds" "clob")] +) + +(define_split + [(set (match_operand:SI 0 "register_operand" "") + (match_operand:SI 1 "immediate_operand" ""))] + "TARGET_THUMB1 + && arm_disable_literal_pool + && GET_CODE (operands[1]) == CONST_INT + && !satisfies_constraint_I (operands[1])" + [(clobber (const_int 0))] + " + thumb1_gen_const_int (operands[0], INTVAL (operands[1])); + DONE; + " +) + (define_insn "*thumb1_adddi3" [(set (match_operand:DI 0 "register_operand" "=l") (plus:DI (match_operand:DI 1 "register_operand" "%0") @@ -829,8 +864,8 @@ (set_attr "conds" "clob,nocond,nocond,nocond,nocond,clob")]) (define_insn "*thumb1_movhf" - [(set (match_operand:HF 0 "nonimmediate_operand" "=l,l,m,*r,*h") - (match_operand:HF 1 "general_operand" "l,mF,l,*h,*r"))] + [(set (match_operand:HF 0 "nonimmediate_operand" "=l,l,l,m,*r,*h") + (match_operand:HF 1 "general_operand" "l, m,F,l,*h,*r"))] "TARGET_THUMB1 && ( s_register_operand (operands[0], HFmode) || s_register_operand (operands[1], HFmode))" @@ -855,14 +890,34 @@ } return \"ldrh\\t%0, %1\"; } - case 2: return \"strh\\t%1, %0\"; + case 2: + { + int bits; + int high; + rtx ops[3]; + + bits = real_to_target (NULL, CONST_DOUBLE_REAL_VALUE (operands[1]), + HFmode); + ops[0] = operands[0]; + high = (bits >> 8) & 0xff; + ops[1] = GEN_INT (high); + ops[2] = GEN_INT (bits & 0xff); + if (high != 0) + output_asm_insn (\"movs\\t%0, %1\;lsls\\t%0, #8\;adds\\t%0, %2\", ops); + else + output_asm_insn (\"movs\\t%0, %2\", ops); + + return \"\"; + } + case 3: return \"strh\\t%1, %0\"; default: return \"mov\\t%0, %1\"; } " - [(set_attr "length" "2") - (set_attr "type" "mov_reg,load_4,store_4,mov_reg,mov_reg") - (set_attr "pool_range" "*,1018,*,*,*") - (set_attr "conds" "clob,nocond,nocond,nocond,nocond")]) + [(set_attr "length" "2,2,6,2,2,2") + (set_attr "type" "mov_reg,load_4,mov_reg,store_4,mov_reg,mov_reg") + (set_attr "pool_range" "*,1018,*,*,*,*") + (set_attr "conds" "clob,nocond,nocond,nocond,nocond,nocond")]) + ;;; ??? This should have alternatives for constants. (define_insn "*thumb1_movsf_insn" [(set (match_operand:SF 0 "nonimmediate_operand" "=l,l,>,l, m,*r,*h") diff --git a/gcc/config/avr/avr-mcus.def b/gcc/config/avr/avr-mcus.def index 95ac21d..97ce499 100644 --- a/gcc/config/avr/avr-mcus.def +++ b/gcc/config/avr/avr-mcus.def @@ -23,7 +23,6 @@ This will regenerate / update the following source files: - - $(srcdir)/config/avr/t-multilib - $(srcdir)/doc/avr-mmcu.texi After that, rebuild everything and check-in the new sources to the repo. @@ -36,36 +35,37 @@ Before including this file, define a macro: - AVR_MCU (NAME, ARCH, DEV_ATTRIBUTE, MACRO, DATA_SEC, N_FLASH) + AVR_MCU (NAME, ARCH, ATTR, MACRO, TDATA, TTEXT, FLASH_SIZE, PM_OFFSET) where the arguments are the fields of avr_mcu_t: - NAME Name of the device as specified by -mmcu=<NAME>. Also - used by DRIVER_SELF_SPECS and gen-avr-mmcu-specs.c for - - the name of the device specific specs file - in -specs=device-specs/spec-<NAME> - - the name of the startup file crt<NAME>.o - - to link the device library by means of -l<NAME> + NAME Name of the device as specified by -mmcu=<NAME>. Also + used by DRIVER_SELF_SPECS and gen-avr-mmcu-specs.c for + - the name of the device specific specs file + in -specs=device-specs/spec-<NAME> + - the name of the startup file crt<NAME>.o + - the name of the device library to be linked with -l<NAME> - ARCH Specifies the multilib variant together with AVR_SHORT_SP + ARCH Specifies the multilib variant together with AVR_SHORT_SP - DEV_ATTRIBUTE Specifies the device specific features - - additional ISA, short SP, errata skip etc., + ATTR Specifies the device specific features + - additional ISA, short SP, errata skip etc., - MACRO If NULL, this is a core and not a device. If non-NULL, - supply respective built-in macro. + MACRO If NULL, this is a core and not a device. If non-NULL, + supply respective built-in macro. - DATA_START First address of SRAM, used in -Tdata=<DATA_START>. + TDATA First address of SRAM, used in -Tdata=<DATA_START>. - TEXT_START First address of Flash, used in -Ttext=<TEXT_START>. + TTEXT First address of Flash, used in -Ttext=<TEXT_START>. - FLASH_SIZE Flash size in bytes. + FLASH_SIZE + Flash size in bytes. - RODATA_PM_OFFSET - Either 0x0 or the offset where flash memory is mirrored - into the RAM address space accessible by LD and LDS. - This is only needed if that value deviates from the - value for the respective family. + PM_OFFSET + Either 0x0 or the offset where flash memory is mirrored + into the RAM address space accessible by LD, LDD and LDS. + This is only needed if that value deviates from the + value for the respective device family. "avr2" must be first for the "0" default to work as intended. */ diff --git a/gcc/config/darwin.h b/gcc/config/darwin.h index 8eb8edf..546336e 100644 --- a/gcc/config/darwin.h +++ b/gcc/config/darwin.h @@ -401,9 +401,7 @@ extern GTY(()) int darwin_ms_struct; #undef STARTFILE_SPEC #define STARTFILE_SPEC \ "%{Zdynamiclib: %(darwin_dylib1) %{fgnu-tm: -lcrttms.o}} \ - %{!Zdynamiclib:%{Zbundle:%{!static: \ - %:version-compare(< 10.6 mmacosx-version-min= -lbundle1.o) \ - %{fgnu-tm: -lcrttms.o}}} \ + %{!Zdynamiclib:%{Zbundle:%(darwin_bundle1)} \ %{!Zbundle:%{pg:%{static:-lgcrt0.o} \ %{!static:%{object:-lgcrt0.o} \ %{!object:%{preload:-lgcrt0.o} \ @@ -425,7 +423,8 @@ extern GTY(()) int darwin_ms_struct; { "darwin_crt1", DARWIN_CRT1_SPEC }, \ { "darwin_crt2", DARWIN_CRT2_SPEC }, \ { "darwin_crt3", DARWIN_CRT3_SPEC }, \ - { "darwin_dylib1", DARWIN_DYLIB1_SPEC }, + { "darwin_dylib1", DARWIN_DYLIB1_SPEC }, \ + { "darwin_bundle1", DARWIN_BUNDLE1_SPEC }, #define DARWIN_CRT1_SPEC \ "%:version-compare(!> 10.5 mmacosx-version-min= -lcrt1.o) \ @@ -447,6 +446,10 @@ extern GTY(()) int darwin_ms_struct; "%:version-compare(!> 10.5 mmacosx-version-min= -ldylib1.o) \ %:version-compare(>< 10.5 10.6 mmacosx-version-min= -ldylib1.10.5.o)" +#define DARWIN_BUNDLE1_SPEC \ +"%{!static:%:version-compare(< 10.6 mmacosx-version-min= -lbundle1.o) \ + %{fgnu-tm: -lcrttms.o}}" + #ifdef HAVE_AS_MMACOSX_VERSION_MIN_OPTION /* Emit macosx version (but only major). */ #define ASM_MMACOSX_VERSION_MIN_SPEC \ diff --git a/gcc/config/gcn/gcn-valu.md b/gcc/config/gcn/gcn-valu.md index 4260446..3b3be8a 100644 --- a/gcc/config/gcn/gcn-valu.md +++ b/gcc/config/gcn/gcn-valu.md @@ -591,6 +591,48 @@ (set_attr "exec" "none") (set_attr "laneselect" "yes")]) +(define_expand "extract_last_<mode>" + [(match_operand:<SCALAR_MODE> 0 "register_operand") + (match_operand:DI 1 "gcn_alu_operand") + (match_operand:VEC_ALLREG_MODE 2 "register_operand")] + "can_create_pseudo_p ()" + { + rtx dst = operands[0]; + rtx mask = operands[1]; + rtx vect = operands[2]; + rtx tmpreg = gen_reg_rtx (SImode); + + emit_insn (gen_clzdi2 (tmpreg, mask)); + emit_insn (gen_subsi3 (tmpreg, GEN_INT (63), tmpreg)); + emit_insn (gen_vec_extract<mode><scalar_mode> (dst, vect, tmpreg)); + DONE; + }) + +(define_expand "fold_extract_last_<mode>" + [(match_operand:<SCALAR_MODE> 0 "register_operand") + (match_operand:<SCALAR_MODE> 1 "gcn_alu_operand") + (match_operand:DI 2 "gcn_alu_operand") + (match_operand:VEC_ALLREG_MODE 3 "register_operand")] + "can_create_pseudo_p ()" + { + rtx dst = operands[0]; + rtx default_value = operands[1]; + rtx mask = operands[2]; + rtx vect = operands[3]; + rtx else_label = gen_label_rtx (); + rtx end_label = gen_label_rtx (); + + rtx cond = gen_rtx_EQ (VOIDmode, mask, const0_rtx); + emit_jump_insn (gen_cbranchdi4 (cond, mask, const0_rtx, else_label)); + emit_insn (gen_extract_last_<mode> (dst, mask, vect)); + emit_jump_insn (gen_jump (end_label)); + emit_barrier (); + emit_label (else_label); + emit_move_insn (dst, default_value); + emit_label (end_label); + DONE; + }) + (define_expand "vec_init<mode><scalar_mode>" [(match_operand:VEC_ALLREG_MODE 0 "register_operand") (match_operand 1)] diff --git a/gcc/config/gcn/gcn.h b/gcc/config/gcn/gcn.h index bdf7188..76b449b 100644 --- a/gcc/config/gcn/gcn.h +++ b/gcc/config/gcn/gcn.h @@ -644,6 +644,10 @@ enum gcn_builtin_codes /* This needs to match gcn_function_value. */ #define LIBCALL_VALUE(MODE) gen_rtx_REG (MODE, SGPR_REGNO (RETURN_VALUE_REG)) +/* The s_ff0 and s_flbit instructions return -1 if no input bits are set. */ +#define CLZ_DEFINED_VALUE_AT_ZERO(MODE, VALUE) ((VALUE) = -1, 2) +#define CTZ_DEFINED_VALUE_AT_ZERO(MODE, VALUE) ((VALUE) = -1, 2) + /* Costs. */ diff --git a/gcc/config/gcn/gcn.md b/gcc/config/gcn/gcn.md index 36908ba..b48af0d 100644 --- a/gcc/config/gcn/gcn.md +++ b/gcc/config/gcn/gcn.md @@ -331,7 +331,9 @@ (define_code_attr s_mnemonic [(not "not%b") - (popcount "bcnt1_i32%b")]) + (popcount "bcnt1_i32%b") + (clz "flbit_i32%b") + (ctz "ff1_i32%b")]) (define_code_attr revmnemonic [(minus "subrev%i") @@ -356,7 +358,9 @@ (umin "umin") (umax "umax") (not "one_cmpl") - (popcount "popcount")]) + (popcount "popcount") + (clz "clz") + (ctz "ctz")]) ;; }}} ;; {{{ Miscellaneous instructions @@ -1389,6 +1393,28 @@ [(set_attr "type" "sop1,vop1") (set_attr "length" "8")]) +(define_code_iterator countzeros [clz ctz]) + +(define_insn "<expander>si2" + [(set (match_operand:SI 0 "register_operand" "=Sg,Sg") + (countzeros:SI + (match_operand:SI 1 "gcn_alu_operand" "SgA, B")))] + "" + "s_<s_mnemonic>1\t%0, %1" + [(set_attr "type" "sop1") + (set_attr "length" "4,8")]) + +; The truncate ensures that a constant passed to operand 1 is treated as DImode +(define_insn "<expander>di2" + [(set (match_operand:SI 0 "register_operand" "=Sg,Sg") + (truncate:SI + (countzeros:DI + (match_operand:DI 1 "gcn_alu_operand" "SgA, B"))))] + "" + "s_<s_mnemonic>1\t%0, %1" + [(set_attr "type" "sop1") + (set_attr "length" "4,8")]) + ;; }}} ;; {{{ ALU: generic 32-bit binop diff --git a/gcc/config/i386/i386.c b/gcc/config/i386/i386.c index 551e77a..02f4d00 100644 --- a/gcc/config/i386/i386.c +++ b/gcc/config/i386/i386.c @@ -14433,11 +14433,10 @@ ix86_lea_outperforms (rtx_insn *insn, unsigned int regno0, unsigned int regno1, { int dist_define, dist_use; - /* For Silvermont if using a 2-source or 3-source LEA for - non-destructive destination purposes, or due to wanting - ability to use SCALE, the use of LEA is justified. */ - if (TARGET_SILVERMONT || TARGET_GOLDMONT || TARGET_GOLDMONT_PLUS - || TARGET_TREMONT || TARGET_INTEL) + /* For Atom processors newer than Bonnell, if using a 2-source or + 3-source LEA for non-destructive destination purposes, or due to + wanting ability to use SCALE, the use of LEA is justified. */ + if (!TARGET_BONNELL) { if (has_scale) return true; @@ -14572,10 +14571,6 @@ ix86_avoid_lea_for_addr (rtx_insn *insn, rtx operands[]) struct ix86_address parts; int ok; - /* Check we need to optimize. */ - if (!TARGET_AVOID_LEA_FOR_ADDR || optimize_function_for_size_p (cfun)) - return false; - /* The "at least two components" test below might not catch simple move or zero extension insns if parts.base is non-NULL and parts.disp is const0_rtx as the only components in the address, e.g. if the @@ -14612,6 +14607,20 @@ ix86_avoid_lea_for_addr (rtx_insn *insn, rtx operands[]) if (parts.index) regno2 = true_regnum (parts.index); + /* Use add for a = a + b and a = b + a since it is faster and shorter + than lea for most processors. For the processors like BONNELL, if + the destination register of LEA holds an actual address which will + be used soon, LEA is better and otherwise ADD is better. */ + if (!TARGET_BONNELL + && parts.scale == 1 + && (!parts.disp || parts.disp == const0_rtx) + && (regno0 == regno1 || regno0 == regno2)) + return true; + + /* Check we need to optimize. */ + if (!TARGET_AVOID_LEA_FOR_ADDR || optimize_function_for_size_p (cfun)) + return false; + split_cost = 0; /* Compute how many cycles we will add to execution time diff --git a/gcc/config/i386/i386.h b/gcc/config/i386/i386.h index 2542cb3..65f6c76 100644 --- a/gcc/config/i386/i386.h +++ b/gcc/config/i386/i386.h @@ -596,6 +596,8 @@ extern unsigned char ix86_tune_features[X86_TUNE_LAST]; ix86_tune_features[X86_TUNE_USE_XCHG_FOR_ATOMIC_STORE] #define TARGET_EMIT_VZEROUPPER \ ix86_tune_features[X86_TUNE_EMIT_VZEROUPPER] +#define TARGET_EXPAND_ABS \ + ix86_tune_features[X86_TUNE_EXPAND_ABS] /* Feature tests against the various architecture variations. */ enum ix86_arch_indices { diff --git a/gcc/config/i386/i386.md b/gcc/config/i386/i386.md index 66a6f20..672fd1c 100644 --- a/gcc/config/i386/i386.md +++ b/gcc/config/i386/i386.md @@ -9669,6 +9669,45 @@ "#" [(set_attr "isa" "noavx,noavx,avx,avx")]) +;; Special expand pattern to handle integer mode abs + +(define_expand "abs<mode>2" + [(set (match_operand:SWI48x 0 "register_operand") + (abs:SWI48x + (match_operand:SWI48x 1 "register_operand")))] + "TARGET_EXPAND_ABS" + { + machine_mode mode = <MODE>mode; + + /* Generate rtx abs using abs (x) = (((signed) x >> (W-1)) ^ x) - + ((signed) x >> (W-1)) */ + rtx shift_amount = gen_int_shift_amount (mode, + GET_MODE_PRECISION (mode) + - 1); + shift_amount = convert_modes (E_QImode, GET_MODE (shift_amount), + shift_amount, 1); + rtx shift_dst = gen_reg_rtx (mode); + rtx shift_op = gen_rtx_SET (shift_dst, + gen_rtx_fmt_ee (ASHIFTRT, mode, + operands[1], shift_amount)); + rtx clobber = gen_rtx_CLOBBER (VOIDmode, gen_rtx_REG (CCmode, + FLAGS_REG)); + emit_insn (gen_rtx_PARALLEL (VOIDmode, gen_rtvec (2, shift_op, + clobber))); + + rtx xor_op = gen_rtx_SET (operands[0], + gen_rtx_fmt_ee (XOR, mode, shift_dst, + operands[1])); + emit_insn (gen_rtx_PARALLEL (VOIDmode, gen_rtvec (2, xor_op, clobber))); + + rtx minus_op = gen_rtx_SET (operands[0], + gen_rtx_fmt_ee (MINUS, mode, + operands[0], shift_dst)); + emit_insn (gen_rtx_PARALLEL (VOIDmode, gen_rtvec (2, minus_op, + clobber))); + DONE; + }) + (define_expand "<code><mode>2" [(set (match_operand:X87MODEF 0 "register_operand") (absneg:X87MODEF (match_operand:X87MODEF 1 "register_operand")))] @@ -19729,9 +19768,104 @@ (set (match_scratch:PTR 2 "=&r") (const_int 0)) (clobber (reg:CC FLAGS_REG))] "" - "mov{<imodesuffix>}\t{%1, %2|%2, %1}\;mov{<imodesuffix>}\t{%2, %0|%0, %2}\;xor{l}\t%k2, %k2" +{ + output_asm_insn ("mov{<imodesuffix>}\t{%1, %2|%2, %1}", operands); + output_asm_insn ("mov{<imodesuffix>}\t{%2, %0|%0, %2}", operands); + return "xor{l}\t%k2, %k2"; +} [(set_attr "type" "multi")]) +;; Patterns and peephole2s to optimize stack_protect_set_1_<mode> +;; immediately followed by *mov{s,d}i_internal to the same register, +;; where we can avoid the xor{l} above. We don't split this, so that +;; scheduling or anything else doesn't separate the *stack_protect_set* +;; pattern from the set of the register that overwrites the register +;; with a new value. +(define_insn "*stack_protect_set_2_<mode>" + [(set (match_operand:PTR 0 "memory_operand" "=m") + (unspec:PTR [(match_operand:PTR 3 "memory_operand" "m")] + UNSPEC_SP_SET)) + (set (match_operand:SI 1 "register_operand" "=&r") + (match_operand:SI 2 "general_operand" "g")) + (clobber (reg:CC FLAGS_REG))] + "reload_completed + && !reg_overlap_mentioned_p (operands[1], operands[2])" +{ + output_asm_insn ("mov{<imodesuffix>}\t{%3, %<k>1|%<k>1, %3}", operands); + output_asm_insn ("mov{<imodesuffix>}\t{%<k>1, %0|%0, %<k>1}", operands); + if (pic_32bit_operand (operands[2], SImode) + || ix86_use_lea_for_mov (insn, operands + 1)) + return "lea{l}\t{%E2, %1|%1, %E2}"; + else + return "mov{l}\t{%2, %1|%1, %2}"; +} + [(set_attr "type" "multi") + (set_attr "length" "24")]) + +(define_peephole2 + [(parallel [(set (match_operand:PTR 0 "memory_operand") + (unspec:PTR [(match_operand:PTR 1 "memory_operand")] + UNSPEC_SP_SET)) + (set (match_operand:PTR 2 "general_reg_operand") (const_int 0)) + (clobber (reg:CC FLAGS_REG))]) + (set (match_operand:SI 3 "general_reg_operand") + (match_operand:SI 4))] + "REGNO (operands[2]) == REGNO (operands[3]) + && (general_reg_operand (operands[4], SImode) + || memory_operand (operands[4], SImode) + || immediate_operand (operands[4], SImode)) + && !reg_overlap_mentioned_p (operands[3], operands[4])" + [(parallel [(set (match_dup 0) + (unspec:PTR [(match_dup 1)] UNSPEC_SP_SET)) + (set (match_dup 3) (match_dup 4)) + (clobber (reg:CC FLAGS_REG))])]) + +(define_insn "*stack_protect_set_3" + [(set (match_operand:DI 0 "memory_operand" "=m,m,m") + (unspec:DI [(match_operand:DI 3 "memory_operand" "m,m,m")] + UNSPEC_SP_SET)) + (set (match_operand:DI 1 "register_operand" "=&r,r,r") + (match_operand:DI 2 "general_operand" "Z,rem,i")) + (clobber (reg:CC FLAGS_REG))] + "TARGET_64BIT + && reload_completed + && !reg_overlap_mentioned_p (operands[1], operands[2])" +{ + output_asm_insn ("mov{q}\t{%3, %1|%1, %3}", operands); + output_asm_insn ("mov{q}\t{%1, %0|%0, %1}", operands); + if (which_alternative == 0) + return "mov{l}\t{%k2, %k1|%k1, %k2}"; + else if (which_alternative == 2) + return "movabs{q}\t{%2, %1|%1, %2}"; + else if (pic_32bit_operand (operands[2], DImode) + || ix86_use_lea_for_mov (insn, operands + 1)) + return "lea{q}\t{%E2, %1|%1, %E2}"; + else + return "mov{q}\t{%2, %1|%1, %2}"; +} + [(set_attr "type" "multi") + (set_attr "length" "24")]) + +(define_peephole2 + [(parallel [(set (match_operand:DI 0 "memory_operand") + (unspec:DI [(match_operand:DI 1 "memory_operand")] + UNSPEC_SP_SET)) + (set (match_operand:DI 2 "general_reg_operand") (const_int 0)) + (clobber (reg:CC FLAGS_REG))]) + (set (match_dup 2) (match_operand:DI 3))] + "TARGET_64BIT + && (general_reg_operand (operands[3], DImode) + || memory_operand (operands[3], DImode) + || x86_64_zext_immediate_operand (operands[3], DImode) + || x86_64_immediate_operand (operands[3], DImode) + || (CONSTANT_P (operands[3]) + && (!flag_pic || LEGITIMATE_PIC_OPERAND_P (operands[3])))) + && !reg_overlap_mentioned_p (operands[2], operands[3])" + [(parallel [(set (match_dup 0) + (unspec:PTR [(match_dup 1)] UNSPEC_SP_SET)) + (set (match_dup 2) (match_dup 3)) + (clobber (reg:CC FLAGS_REG))])]) + (define_expand "stack_protect_test" [(match_operand 0 "memory_operand") (match_operand 1 "memory_operand") @@ -19755,7 +19889,10 @@ UNSPEC_SP_TEST)) (clobber (match_scratch:PTR 3 "=&r"))] "" - "mov{<imodesuffix>}\t{%1, %3|%3, %1}\;sub{<imodesuffix>}\t{%2, %3|%3, %2}" +{ + output_asm_insn ("mov{<imodesuffix>}\t{%1, %3|%3, %1}", operands); + return "sub{<imodesuffix>}\t{%2, %3|%3, %2}"; +} [(set_attr "type" "multi")]) (define_insn "sse4_2_crc32<mode>" diff --git a/gcc/config/i386/x86-tune.def b/gcc/config/i386/x86-tune.def index 328535d..58a81e5 100644 --- a/gcc/config/i386/x86-tune.def +++ b/gcc/config/i386/x86-tune.def @@ -317,6 +317,13 @@ DEF_TUNE (X86_TUNE_ONE_IF_CONV_INSN, "one_if_conv_insn", DEF_TUNE (X86_TUNE_USE_XCHG_FOR_ATOMIC_STORE, "use_xchg_for_atomic_store", m_CORE_ALL | m_BDVER | m_ZNVER | m_GENERIC) +/* X86_TUNE_EXPAND_ABS: This enables a new abs pattern by + generating instructions for abs (x) = (((signed) x >> (W-1) ^ x) - + (signed) x >> (W-1)) instead of cmove or SSE max/abs instructions. */ +DEF_TUNE (X86_TUNE_EXPAND_ABS, "expand_abs", + m_CORE_ALL | m_SILVERMONT | m_KNL | m_KNM | m_GOLDMONT + | m_GOLDMONT_PLUS | m_TREMONT ) + /*****************************************************************************/ /* 387 instruction selection tuning */ /*****************************************************************************/ diff --git a/gcc/config/msp430/msp430-devices.c b/gcc/config/msp430/msp430-devices.c index 600a111..b379bb2 100644 --- a/gcc/config/msp430/msp430-devices.c +++ b/gcc/config/msp430/msp430-devices.c @@ -71,8 +71,23 @@ msp430_dirname (char *path) return path; } +/* We need to support both the msp430-elf and msp430-elfbare target aliases. + gcc/config/msp430/t-msp430 will define TARGET_SUBDIR to the target_subdir + Makefile variable, which will evaluate to the correct subdirectory that + needs to be searched for devices.csv. */ +#ifndef TARGET_SUBDIR +#define TARGET_SUBDIR msp430-elf +#endif + +#define _MSPMKSTR(x) __MSPMKSTR(x) +#define __MSPMKSTR(x) #x + /* devices.csv path from the toolchain root. */ -static const char rest_of_devices_path[] = "/msp430-elf/include/devices/"; +static const char rest_of_devices_path[] = + "/" _MSPMKSTR (TARGET_SUBDIR) "/include/devices/"; + +#undef _MSPMKSTR +#undef __MSPMKSTR /* "The default value of GCC_EXEC_PREFIX is prefix/lib/gcc". Strip lib/gcc from GCC_EXEC_PREFIX to get the path to the installed toolchain. */ diff --git a/gcc/config/msp430/msp430.c b/gcc/config/msp430/msp430.c index 4ebdcf5..cce4101 100644 --- a/gcc/config/msp430/msp430.c +++ b/gcc/config/msp430/msp430.c @@ -288,6 +288,16 @@ msp430_option_override (void) if (TARGET_OPT_SPACE && optimize < 3) optimize_size = 1; +#if !DEFAULT_USE_CXA_ATEXIT + /* For some configurations, we use atexit () instead of __cxa_atexit () by + default to save on code size and remove the declaration of __dso_handle + from the CRT library. + Configuring GCC with --enable-__cxa-atexit re-enables it by defining + DEFAULT_USE_CXA_ATEXIT to 1. */ + if (flag_use_cxa_atexit) + error ("%<-fuse-cxa-atexit%> is not supported for msp430-elf"); +#endif + #ifndef HAVE_NEWLIB_NANO_FORMATTED_IO if (TARGET_TINY_PRINTF) error ("GCC must be configured with %<--enable-newlib-nano-formatted-io%> " diff --git a/gcc/config/msp430/t-msp430 b/gcc/config/msp430/t-msp430 index e180ce3..d481696 100644 --- a/gcc/config/msp430/t-msp430 +++ b/gcc/config/msp430/t-msp430 @@ -24,7 +24,7 @@ driver-msp430.o: $(srcdir)/config/msp430/driver-msp430.c \ msp430-devices.o: $(srcdir)/config/msp430/msp430-devices.c \ $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) - $(COMPILER) -c $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) $< + $(COMPILER) -c $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) -DTARGET_SUBDIR=$(target_subdir) $(INCLUDES) $< # Enable multilibs: diff --git a/gcc/config/rs6000/darwin.h b/gcc/config/rs6000/darwin.h index d1a096f..5f5a6ca 100644 --- a/gcc/config/rs6000/darwin.h +++ b/gcc/config/rs6000/darwin.h @@ -173,6 +173,18 @@ %:version-compare(!> 10.4 mmacosx-version-min= crt3_2.o%s) \ }}" +/* As for crt1, we need to force the dylib crt for 10.6. */ +#undef DARWIN_DYLIB1_SPEC +#define DARWIN_DYLIB1_SPEC \ + "%:version-compare(!> 10.5 mmacosx-version-min= -ldylib1.o) \ + %:version-compare(>< 10.5 10.7 mmacosx-version-min= -ldylib1.10.5.o)" + +/* Likewise, the bundle crt. */ +#undef DARWIN_BUNDLE1_SPEC +#define DARWIN_BUNDLE1_SPEC \ +"%{!static:%:version-compare(< 10.7 mmacosx-version-min= -lbundle1.o) \ + %{fgnu-tm: -lcrttms.o}}" + /* The PPC regs save/restore functions are leaves and could, conceivably be used by the tm destructor. */ #undef ENDFILE_SPEC @@ -185,12 +197,6 @@ { "darwin_crt2", DARWIN_CRT2_SPEC }, \ { "darwin_subarch", DARWIN_SUBARCH_SPEC }, -/* We need to jam the dylib crt to 10.5 for 10.6 (Rosetta) use. */ -#undef DARWIN_DYLIB1_SPEC -#define DARWIN_DYLIB1_SPEC \ - "%:version-compare(!> 10.5 mmacosx-version-min= -ldylib1.o) \ - %:version-compare(>< 10.5 10.7 mmacosx-version-min= -ldylib1.10.5.o)" - /* Output a .machine directive. */ #undef TARGET_ASM_FILE_START #define TARGET_ASM_FILE_START rs6000_darwin_file_start diff --git a/gcc/config/rs6000/predicates.md b/gcc/config/rs6000/predicates.md index 42c41b3..718ddc4 100644 --- a/gcc/config/rs6000/predicates.md +++ b/gcc/config/rs6000/predicates.md @@ -839,7 +839,8 @@ (define_predicate "add_operand" (if_then_else (match_code "const_int") (match_test "satisfies_constraint_I (op) - || satisfies_constraint_L (op)") + || satisfies_constraint_L (op) + || satisfies_constraint_eI (op)") (match_operand 0 "gpc_reg_operand"))) ;; Return 1 if the operand is either a non-special register, or 0, or -1. diff --git a/gcc/config/rs6000/rs6000.c b/gcc/config/rs6000/rs6000.c index 6f0c7fa..002a8d8 100644 --- a/gcc/config/rs6000/rs6000.c +++ b/gcc/config/rs6000/rs6000.c @@ -5565,6 +5565,10 @@ num_insns_constant_gpr (HOST_WIDE_INT value) && (value >> 31 == -1 || value >> 31 == 0)) return 1; + /* PADDI can support up to 34 bit signed integers. */ + else if (TARGET_PREFIXED_ADDR && SIGNED_34BIT_OFFSET_P (value)) + return 1; + else if (TARGET_POWERPC64) { HOST_WIDE_INT low = ((value & 0xffffffff) ^ 0x80000000) - 0x80000000; diff --git a/gcc/config/rs6000/rs6000.md b/gcc/config/rs6000/rs6000.md index 4c44c1f..ed85a05 100644 --- a/gcc/config/rs6000/rs6000.md +++ b/gcc/config/rs6000/rs6000.md @@ -1761,15 +1761,17 @@ }) (define_insn "*add<mode>3" - [(set (match_operand:GPR 0 "gpc_reg_operand" "=r,r,r") - (plus:GPR (match_operand:GPR 1 "gpc_reg_operand" "%r,b,b") - (match_operand:GPR 2 "add_operand" "r,I,L")))] + [(set (match_operand:GPR 0 "gpc_reg_operand" "=r,r,r,r") + (plus:GPR (match_operand:GPR 1 "gpc_reg_operand" "%r,b,b,b") + (match_operand:GPR 2 "add_operand" "r,I,L,eI")))] "" "@ add %0,%1,%2 addi %0,%1,%2 - addis %0,%1,%v2" - [(set_attr "type" "add")]) + addis %0,%1,%v2 + addi %0,%1,%2" + [(set_attr "type" "add") + (set_attr "isa" "*,*,*,fut")]) (define_insn "*addsi3_high" [(set (match_operand:SI 0 "gpc_reg_operand" "=b") @@ -6892,7 +6894,7 @@ ;; MR LA ;; LWZ LFIWZX LXSIWZX ;; STW STFIWX STXSIWX -;; LI LIS # +;; LI LIS PLI # ;; XXLOR XXSPLTIB 0 XXSPLTIB -1 VSPLTISW ;; XXLXOR 0 XXLORC -1 P9 const ;; MTVSRWZ MFVSRWZ @@ -6903,7 +6905,7 @@ "=r, r, r, d, v, m, Z, Z, - r, r, r, + r, r, r, r, wa, wa, wa, v, wa, v, v, wa, r, @@ -6912,7 +6914,7 @@ "r, U, m, Z, Z, r, d, v, - I, L, n, + I, L, eI, n, wa, O, wM, wB, O, wM, wS, r, wa, @@ -6930,6 +6932,7 @@ stxsiwx %x1,%y0 li %0,%1 lis %0,%v1 + li %0,%1 # xxlor %x0,%x1,%x1 xxspltib %x0,0 @@ -6947,7 +6950,7 @@ "*, *, load, fpload, fpload, store, fpstore, fpstore, - *, *, *, + *, *, *, *, veclogical, vecsimple, vecsimple, vecsimple, veclogical, veclogical, vecsimple, mffgpr, mftgpr, @@ -6956,7 +6959,7 @@ "*, *, *, *, *, *, *, *, - *, *, 8, + *, *, *, 8, *, *, *, *, *, *, 8, *, *, @@ -6965,7 +6968,7 @@ "*, *, *, p8v, p8v, *, p8v, p8v, - *, *, *, + *, *, fut, *, p8v, p9v, p9v, p8v, p9v, p8v, p9v, p8v, p8v, @@ -7120,8 +7123,7 @@ (define_split [(set (match_operand:SI 0 "gpc_reg_operand") (match_operand:SI 1 "const_int_operand"))] - "(unsigned HOST_WIDE_INT) (INTVAL (operands[1]) + 0x8000) >= 0x10000 - && (INTVAL (operands[1]) & 0xffff) != 0" + "num_insns_constant (operands[1], SImode) > 1" [(set (match_dup 0) (match_dup 2)) (set (match_dup 0) @@ -8828,7 +8830,7 @@ }) ;; GPR store GPR load GPR move -;; GPR li GPR lis GPR # +;; GPR li GPR lis GPR pli GPR # ;; FPR store FPR load FPR move ;; AVX store AVX store AVX load AVX load VSX move ;; P9 0 P9 -1 AVX 0/-1 VSX 0 VSX -1 @@ -8838,7 +8840,7 @@ (define_insn "*movdi_internal64" [(set (match_operand:DI 0 "nonimmediate_operand" "=YZ, r, r, - r, r, r, + r, r, r, r, m, ^d, ^d, wY, Z, $v, $v, ^wa, wa, wa, v, wa, wa, @@ -8847,7 +8849,7 @@ ?r, ?wa") (match_operand:DI 1 "input_operand" "r, YZ, r, - I, L, nF, + I, L, eI, nF, ^d, m, ^d, ^v, $v, wY, Z, ^wa, Oj, wM, OjwM, Oj, wM, @@ -8863,6 +8865,7 @@ mr %0,%1 li %0,%1 lis %0,%v1 + li %0,%1 # stfd%U0%X0 %1,%0 lfd%U1%X1 %0,%1 @@ -8886,7 +8889,7 @@ mtvsrd %x0,%1" [(set_attr "type" "store, load, *, - *, *, *, + *, *, *, *, fpstore, fpload, fpsimple, fpstore, fpstore, fpload, fpload, veclogical, vecsimple, vecsimple, vecsimple, veclogical, veclogical, @@ -8896,7 +8899,7 @@ (set_attr "size" "64") (set_attr "length" "*, *, *, - *, *, 20, + *, *, *, 20, *, *, *, *, *, *, *, *, *, *, *, *, *, @@ -8905,7 +8908,7 @@ *, *") (set_attr "isa" "*, *, *, - *, *, *, + *, *, fut, *, *, *, *, p9v, p7v, p9v, p7v, *, p9v, p9v, p7v, *, *, @@ -13132,7 +13135,7 @@ (unspec:CC [(match_operand:SI 1 "gpc_reg_operand") (match_dup 2)] UNSPEC_MOVESI_TO_CR))] "" - "operands[2] = GEN_INT (1 << (75 - REGNO (operands[0])));") + "operands[2] = GEN_INT (1 << (7 - (REGNO (operands[0]) - CR0_REGNO)));") (define_insn "*movsi_to_cr" [(match_parallel 0 "mtcrf_operation" @@ -13159,7 +13162,7 @@ "REG_P (operands[0]) && CR_REGNO_P (REGNO (operands[0])) && CONST_INT_P (operands[2]) - && INTVAL (operands[2]) == 1 << (75 - REGNO (operands[0]))" + && INTVAL (operands[2]) == 1 << (7 - (REGNO (operands[0]) - CR0_REGNO))" "mtcrf %R0,%1" [(set_attr "type" "mtcr")]) diff --git a/gcc/config/s390/vector.md b/gcc/config/s390/vector.md index d40e310..1e591ba 100644 --- a/gcc/config/s390/vector.md +++ b/gcc/config/s390/vector.md @@ -291,9 +291,9 @@ ; However, this would probably be slower. (define_insn "mov<mode>" - [(set (match_operand:V_8 0 "nonimmediate_operand" "=v,v,d,v,R, v, v, v, v,d, Q, S, Q, S, d, d,d,d,d,R,T") - (match_operand:V_8 1 "general_operand" " v,d,v,R,v,j00,jm1,jyy,jxx,d,j00,j00,jm1,jm1,j00,jm1,R,T,b,d,d"))] - "" + [(set (match_operand:V_8 0 "nonimmediate_operand" "=v,v,d,v,R, v, v, v, v,d, Q, S, Q, S, d, d,d,R,T") + (match_operand:V_8 1 "general_operand" " v,d,v,R,v,j00,jm1,jyy,jxx,d,j00,j00,jm1,jm1,j00,jm1,T,d,d"))] + "TARGET_VX" "@ vlr\t%v0,%v1 vlvgb\t%v0,%1,0 @@ -311,12 +311,10 @@ mviy\t%0,-1 lhi\t%0,0 lhi\t%0,-1 - lh\t%0,%1 - lhy\t%0,%1 - lhrl\t%0,%1 + llc\t%0,%1 stc\t%1,%0 stcy\t%1,%0" - [(set_attr "op_type" "VRR,VRS,VRS,VRX,VRX,VRI,VRI,VRI,VRI,RR,SI,SIY,SI,SIY,RI,RI,RX,RXY,RIL,RX,RXY")]) + [(set_attr "op_type" "VRR,VRS,VRS,VRX,VRX,VRI,VRI,VRI,VRI,RR,SI,SIY,SI,SIY,RI,RI,RXY,RX,RXY")]) (define_insn "mov<mode>" [(set (match_operand:V_16 0 "nonimmediate_operand" "=v,v,d,v,R, v, v, v, v,d, Q, Q, d, d,d,d,d,R,T,b") diff --git a/gcc/cp/ChangeLog b/gcc/cp/ChangeLog index dd7da14..19e1b88 100644 --- a/gcc/cp/ChangeLog +++ b/gcc/cp/ChangeLog @@ -1,3 +1,98 @@ +2019-12-18 Jason Merrill <jason@redhat.com> + + PR c++/91165 follow-on tweak + * constexpr.c (cxx_eval_call_expression): Use + unshare_expr_without_location. + +2019-12-19 Julian Brown <julian@codesourcery.com> + Maciej W. Rozycki <macro@codesourcery.com> + Tobias Burnus <tobias@codesourcery.com> + Thomas Schwinge <thomas@codesourcery.com> + + * parser.c (cp_parser_omp_clause_name): Support no_create. + (cp_parser_oacc_data_clause): Likewise. + (cp_parser_oacc_all_clauses): Likewise. + (OACC_DATA_CLAUSE_MASK, OACC_KERNELS_CLAUSE_MASK) + (OACC_PARALLEL_CLAUSE_MASK): Add PRAGMA_OACC_CLAUSE_NO_CREATE. + * semantics.c (handle_omp_array_sections): Support no_create. + +2019-12-18 Paolo Carlini <paolo.carlini@oracle.com> + + * typeck.c (cxx_sizeof_or_alignof_type): Add location_t parameter + and use it throughout. + (cxx_sizeof_expr): Likewise. + (cxx_alignof_expr): Likewise. + (cxx_sizeof_or_alignof_expr): Likewise. + (cxx_alignas_expr): Update call. + * decl.c (fold_sizeof_expr): Likewise. + * pt.c (tsubst_copy): Likewise. + (tsubst_copy_and_build): Likewise. + * except.c (build_throw): Add location_t parameter and use it. + (expand_end_catch_block): Update call. + * parser.c (cp_parser_unary_expression): Update + cxx_sizeof_or_alignof_type and cxx_sizeof_or_alignof_expr calls, + pass the compound location. + (cp_parser_throw_expression): Likewise pass the combined location + to build_throw. + * cp-tree.h: Update declarations. + + * semantics.c (finish_handler_parms): Use DECL_SOURCE_LOCATION. + * decl2.c (check_classfn): Likewise. + + * except.c (is_admissible_throw_operand_or_catch_parameter): + Exploit cp_expr_loc_or_input_loc in one place. + + * except.c (create_try_catch_expr): Remove, unused. + +2019-12-17 Jason Merrill <jason@redhat.com> + + PR c++/12333 - X::~X() with implicit this->. + * parser.c (cp_parser_lookup_name): Use lookup_destructor. + * typeck.c (lookup_destructor): No longer static. + +2019-12-17 Martin Sebor <msebor@redhat.com> + + PR c++/61339 + * parser.c (cp_parser_maybe_warn_enum_key): New function. + (class_decl_loc_t): New class. + (cp_parser_elaborated_type_specifier): Call + cp_parser_maybe_warn_enum_key. + (cp_parser_class_head): Call cp_parser_check_class_key. + (cp_parser_check_class_key): Add arguments. Call class_decl_loc_t::add. + (c_parse_file): Call class_decl_loc_t::diag_mismatched_tags. + +2019-12-17 Jason Merrill <jason@redhat.com> + + PR c++/79592 - missing explanation of invalid constexpr. + * constexpr.c (register_constexpr_fundef): Do store the body of a + template instantiation that is not potentially constant. + (explain_invalid_constexpr_fn): Look it up. + (cxx_eval_call_expression): Check fundef->result. + +2019-12-17 Jason Merrill <jason@redhat.com> + + PR c++/92576 - redeclaration of variable template. + * decl.c (redeclaration_error_message): Recurse for variable + templates. + +2019-12-17 Jason Merrill <jason@redhat.com> + + * name-lookup.c (get_std_name_hint): Add std::byte. + +2019-12-17 Jakub Jelinek <jakub@redhat.com> + + PR c++/59655 + * pt.c (push_tinst_level_loc): If limit_bad_template_recursion, + set TREE_NO_WARNING on tldcl. + * decl2.c (no_linkage_error): Treat templates with TREE_NO_WARNING + as defined during error recovery. + +2019-12-13 Jason Merrill <jason@redhat.com> + + PR c++/91165 - verify_gimple ICE with cached constexpr. + * constexpr.c (cxx_bind_parameters_in_call): Don't unshare. + (cxx_eval_call_expression): Unshare all args if we're caching. + 2019-12-12 Jason Merrill <jason@redhat.com> PR c++/92496 - ICE with <=> and no #include <compare>. diff --git a/gcc/cp/constexpr.c b/gcc/cp/constexpr.c index 19e09c7..b95da0f 100644 --- a/gcc/cp/constexpr.c +++ b/gcc/cp/constexpr.c @@ -885,16 +885,16 @@ register_constexpr_fundef (tree fun, tree body) return NULL; } - if (!potential_rvalue_constant_expression (massaged)) - { - if (!DECL_GENERATED_P (fun)) - require_potential_rvalue_constant_expression (massaged); - return NULL; - } + bool potential = potential_rvalue_constant_expression (massaged); + if (!potential && !DECL_GENERATED_P (fun)) + require_potential_rvalue_constant_expression (massaged); if (DECL_CONSTRUCTOR_P (fun) && cx_check_missing_mem_inits (DECL_CONTEXT (fun), massaged, !DECL_GENERATED_P (fun))) + potential = false; + + if (!potential && !DECL_GENERATED_P (fun)) return NULL; /* Create the constexpr function table if necessary. */ @@ -917,6 +917,12 @@ register_constexpr_fundef (tree fun, tree body) if (clear_ctx) DECL_CONTEXT (DECL_RESULT (fun)) = NULL_TREE; + if (!potential) + /* For a template instantiation, we want to remember the pre-generic body + for explain_invalid_constexpr_fn, but do tell cxx_eval_call_expression + that it doesn't need to bother trying to expand the function. */ + entry.result = error_mark_node; + gcc_assert (*slot == NULL); *slot = ggc_alloc<constexpr_fundef> (); **slot = entry; @@ -962,11 +968,15 @@ explain_invalid_constexpr_fn (tree fun) { /* Then if it's OK, the body. */ if (!DECL_DECLARED_CONSTEXPR_P (fun) - && !LAMBDA_TYPE_P (CP_DECL_CONTEXT (fun))) + && DECL_DEFAULTED_FN (fun)) explain_implicit_non_constexpr (fun); else { - body = massage_constexpr_body (fun, DECL_SAVED_TREE (fun)); + if (constexpr_fundef *fd = retrieve_constexpr_fundef (fun)) + body = fd->body; + else + body = DECL_SAVED_TREE (fun); + body = massage_constexpr_body (fun, body); require_potential_rvalue_constant_expression (body); if (DECL_CONSTRUCTOR_P (fun)) cx_check_missing_mem_inits (DECL_CONTEXT (fun), body, true); @@ -1441,9 +1451,6 @@ cxx_bind_parameters_in_call (const constexpr_ctx *ctx, tree t, if (!*non_constant_p) { - /* Unsharing here isn't necessary for correctness, but it - significantly improves memory performance for some reason. */ - arg = unshare_constructor (arg); /* Make sure the binding has the same type as the parm. But only for constant args. */ if (!TYPE_REF_P (type)) @@ -1922,6 +1929,7 @@ cxx_eval_call_expression (const constexpr_ctx *ctx, tree t, { new_call.fundef = retrieve_constexpr_fundef (fun); if (new_call.fundef == NULL || new_call.fundef->body == NULL + || new_call.fundef->result == error_mark_node || fun == current_function_decl) { if (!ctx->quiet) @@ -1959,19 +1967,11 @@ cxx_eval_call_expression (const constexpr_ctx *ctx, tree t, this function exits. */ class free_bindings { + tree *bindings; public: - tree &bindings; - bool do_free; - free_bindings (tree &b): bindings (b), do_free(true) { } - void preserve () { do_free = false; } - ~free_bindings () { - if (do_free) - { - for (int i = 0; i < TREE_VEC_LENGTH (bindings); ++i) - free_constructor (TREE_VEC_ELT (bindings, i)); - ggc_free (bindings); - } - } + free_bindings (tree &b): bindings (&b) { } + ~free_bindings () { if (bindings) ggc_free (*bindings); } + void preserve () { bindings = NULL; } } fb (new_call.bindings); if (*non_constant_p) @@ -2074,7 +2074,18 @@ cxx_eval_call_expression (const constexpr_ctx *ctx, tree t, for (int i = 0; i < TREE_VEC_LENGTH (bound); ++i) { tree arg = TREE_VEC_ELT (bound, i); - /* Don't share a CONSTRUCTOR that might be changed. */ + if (entry) + { + /* Unshare args going into the hash table to separate them + from the caller's context, for better GC and to avoid + problems with verify_gimple. */ + arg = unshare_expr_without_location (arg); + TREE_VEC_ELT (bound, i) = arg; + } + /* Don't share a CONSTRUCTOR that might be changed. This is not + redundant with the unshare just above; we also don't want to + change the argument values in the hash table. XXX Could we + unshare lazily in cxx_eval_store_expression? */ arg = unshare_constructor (arg); if (TREE_CODE (arg) == CONSTRUCTOR) vec_safe_push (ctors, arg); diff --git a/gcc/cp/cp-tree.h b/gcc/cp/cp-tree.h index b47698e..3d1d62c 100644 --- a/gcc/cp/cp-tree.h +++ b/gcc/cp/cp-tree.h @@ -6657,7 +6657,7 @@ extern void init_exception_processing (void); extern tree expand_start_catch_block (tree); extern void expand_end_catch_block (void); extern tree build_exc_ptr (void); -extern tree build_throw (tree); +extern tree build_throw (location_t, tree); extern int nothrow_libfn_p (const_tree); extern void check_handlers (tree); extern tree finish_noexcept_expr (tree, tsubst_flags_t); @@ -6674,7 +6674,6 @@ extern tree begin_eh_spec_block (void); extern void finish_eh_spec_block (tree, tree); extern tree build_eh_type_type (tree); extern tree cp_protect_cleanup_actions (void); -extern tree create_try_catch_expr (tree, tree); extern tree template_parms_to_args (tree); extern tree template_parms_level_to_args (tree); extern tree generic_targs_for (tree); @@ -7487,8 +7486,10 @@ extern bool compparms (const_tree, const_tree); extern int comp_cv_qualification (const_tree, const_tree); extern int comp_cv_qualification (int, int); extern int comp_cv_qual_signature (tree, tree); -extern tree cxx_sizeof_or_alignof_expr (tree, enum tree_code, bool); -extern tree cxx_sizeof_or_alignof_type (tree, enum tree_code, bool, bool); +extern tree cxx_sizeof_or_alignof_expr (location_t, tree, + enum tree_code, bool); +extern tree cxx_sizeof_or_alignof_type (location_t, tree, + enum tree_code, bool, bool); extern tree cxx_alignas_expr (tree); extern tree cxx_sizeof_nowarn (tree); extern tree is_bitfield_expr_with_lowered_type (const_tree); @@ -7500,6 +7501,7 @@ extern tree build_class_member_access_expr (cp_expr, tree, tree, bool, tsubst_flags_t); extern tree finish_class_member_access_expr (cp_expr, tree, bool, tsubst_flags_t); +extern tree lookup_destructor (tree, tree, tree, tsubst_flags_t); extern tree build_x_indirect_ref (location_t, tree, ref_operator, tsubst_flags_t); @@ -7603,7 +7605,7 @@ extern tree cp_build_binary_op (const op_location_t &, extern tree build_x_vec_perm_expr (location_t, tree, tree, tree, tsubst_flags_t); -#define cxx_sizeof(T) cxx_sizeof_or_alignof_type (T, SIZEOF_EXPR, false, true) +#define cxx_sizeof(T) cxx_sizeof_or_alignof_type (input_location, T, SIZEOF_EXPR, false, true) extern tree build_simple_component_ref (tree, tree); extern tree build_ptrmemfunc_access_expr (tree, tree); extern tree build_address (tree); diff --git a/gcc/cp/decl.c b/gcc/cp/decl.c index 6dec583..7d4c947 100644 --- a/gcc/cp/decl.c +++ b/gcc/cp/decl.c @@ -2977,20 +2977,14 @@ redeclaration_error_message (tree newdecl, tree olddecl) { tree nt, ot; - if (TREE_CODE (DECL_TEMPLATE_RESULT (newdecl)) == TYPE_DECL) - { - if (COMPLETE_TYPE_P (TREE_TYPE (newdecl)) - && COMPLETE_TYPE_P (TREE_TYPE (olddecl))) - return G_("redefinition of %q#D"); - return NULL; - } - if (TREE_CODE (DECL_TEMPLATE_RESULT (newdecl)) == CONCEPT_DECL) return G_("redefinition of %q#D"); - if (TREE_CODE (DECL_TEMPLATE_RESULT (newdecl)) != FUNCTION_DECL - || (DECL_TEMPLATE_RESULT (newdecl) - == DECL_TEMPLATE_RESULT (olddecl))) + if (TREE_CODE (DECL_TEMPLATE_RESULT (newdecl)) != FUNCTION_DECL) + return redeclaration_error_message (DECL_TEMPLATE_RESULT (newdecl), + DECL_TEMPLATE_RESULT (olddecl)); + + if (DECL_TEMPLATE_RESULT (newdecl) == DECL_TEMPLATE_RESULT (olddecl)) return NULL; nt = DECL_TEMPLATE_RESULT (newdecl); @@ -10225,13 +10219,16 @@ fold_sizeof_expr (tree t) { tree r; if (SIZEOF_EXPR_TYPE_P (t)) - r = cxx_sizeof_or_alignof_type (TREE_TYPE (TREE_OPERAND (t, 0)), + r = cxx_sizeof_or_alignof_type (EXPR_LOCATION (t), + TREE_TYPE (TREE_OPERAND (t, 0)), SIZEOF_EXPR, false, false); else if (TYPE_P (TREE_OPERAND (t, 0))) - r = cxx_sizeof_or_alignof_type (TREE_OPERAND (t, 0), SIZEOF_EXPR, + r = cxx_sizeof_or_alignof_type (EXPR_LOCATION (t), + TREE_OPERAND (t, 0), SIZEOF_EXPR, false, false); else - r = cxx_sizeof_or_alignof_expr (TREE_OPERAND (t, 0), SIZEOF_EXPR, + r = cxx_sizeof_or_alignof_expr (EXPR_LOCATION (t), + TREE_OPERAND (t, 0), SIZEOF_EXPR, false); if (r == error_mark_node) r = size_one_node; diff --git a/gcc/cp/decl2.c b/gcc/cp/decl2.c index 46cc582..0352954 100644 --- a/gcc/cp/decl2.c +++ b/gcc/cp/decl2.c @@ -698,7 +698,8 @@ check_classfn (tree ctype, tree function, tree template_parms) if (!matched) { if (!COMPLETE_TYPE_P (ctype)) - cxx_incomplete_type_error (function, ctype); + cxx_incomplete_type_error (DECL_SOURCE_LOCATION (function), + function, ctype); else { if (DECL_CONV_FN_P (function)) @@ -4414,7 +4415,14 @@ decl_maybe_constant_var_p (tree decl) void no_linkage_error (tree decl) { - if (cxx_dialect >= cxx11 && decl_defined_p (decl)) + if (cxx_dialect >= cxx11 + && (decl_defined_p (decl) + /* Treat templates which limit_bad_template_recursion decided + not to instantiate as if they were defined. */ + || (errorcount + sorrycount > 0 + && DECL_LANG_SPECIFIC (decl) + && DECL_TEMPLATE_INFO (decl) + && TREE_NO_WARNING (decl)))) /* In C++11 it's ok if the decl is defined. */ return; tree t = no_linkage_check (TREE_TYPE (decl), /*relaxed_p=*/false); diff --git a/gcc/cp/except.c b/gcc/cp/except.c index 8bc831d..e385c67 100644 --- a/gcc/cp/except.c +++ b/gcc/cp/except.c @@ -507,7 +507,7 @@ expand_end_catch_block (void) && (DECL_CONSTRUCTOR_P (current_function_decl) || DECL_DESTRUCTOR_P (current_function_decl))) { - tree rethrow = build_throw (NULL_TREE); + tree rethrow = build_throw (input_location, NULL_TREE); TREE_NO_WARNING (rethrow) = true; finish_expr_stmt (rethrow); } @@ -627,7 +627,7 @@ wrap_cleanups_r (tree *tp, int *walk_subtrees, void * /*data*/) /* Build a throw expression. */ tree -build_throw (tree exp) +build_throw (location_t loc, tree exp) { if (exp == error_mark_node) return exp; @@ -637,12 +637,13 @@ build_throw (tree exp) if (cfun) current_function_returns_abnormally = 1; exp = build_min (THROW_EXPR, void_type_node, exp); - SET_EXPR_LOCATION (exp, input_location); + SET_EXPR_LOCATION (exp, loc); return exp; } if (exp && null_node_p (exp)) - warning (0, "throwing NULL, which has integral, not pointer type"); + warning_at (loc, 0, + "throwing NULL, which has integral, not pointer type"); if (exp != NULL_TREE) { @@ -758,6 +759,7 @@ build_throw (tree exp) { int flags = LOOKUP_NORMAL | LOOKUP_ONLYCONVERTING; bool converted = false; + location_t exp_loc = cp_expr_loc_or_loc (exp, loc); /* Under C++0x [12.8/16 class.copy], a thrown lvalue is sometimes treated as an rvalue for the purposes of overload resolution @@ -790,7 +792,7 @@ build_throw (tree exp) if (exp == error_mark_node) { - error (" in thrown expression"); + inform (exp_loc, " in thrown expression"); return error_mark_node; } } @@ -867,8 +869,7 @@ build_throw (tree exp) exp = cp_build_function_call_vec (rethrow_fn, NULL, tf_warning_or_error); } - exp = build1 (THROW_EXPR, void_type_node, exp); - SET_EXPR_LOCATION (exp, input_location); + exp = build1_loc (loc, THROW_EXPR, void_type_node, exp); return exp; } @@ -948,8 +949,9 @@ is_admissible_throw_operand_or_catch_parameter (tree t, bool is_throw) else if (variably_modified_type_p (type, NULL_TREE)) { if (is_throw) - error ("cannot throw expression of type %qT because it involves " - "types of variable size", type); + error_at (cp_expr_loc_or_input_loc (expr), + "cannot throw expression of type %qT because it involves " + "types of variable size", type); else error ("cannot catch type %qT because it involves types of " "variable size", type); @@ -1321,22 +1323,4 @@ build_noexcept_spec (tree expr, tsubst_flags_t complain) } } -/* Returns a TRY_CATCH_EXPR that will put TRY_LIST and CATCH_LIST in the - TRY and CATCH locations. CATCH_LIST must be a STATEMENT_LIST */ - -tree -create_try_catch_expr (tree try_expr, tree catch_list) -{ - location_t loc = EXPR_LOCATION (try_expr); - - append_to_statement_list (do_begin_catch (), &catch_list); - append_to_statement_list (build_throw (NULL_TREE), &catch_list); - tree catch_tf_expr = build_stmt (loc, TRY_FINALLY_EXPR, catch_list, - do_end_catch (NULL_TREE)); - catch_list = build2 (CATCH_EXPR, void_type_node, NULL_TREE, - catch_tf_expr); - tree try_catch_expr = build_stmt (loc, TRY_CATCH_EXPR, try_expr, catch_list); - return try_catch_expr; -} - #include "gt-cp-except.h" diff --git a/gcc/cp/name-lookup.c b/gcc/cp/name-lookup.c index e64cd9a..181dad0 100644 --- a/gcc/cp/name-lookup.c +++ b/gcc/cp/name-lookup.c @@ -5641,6 +5641,8 @@ get_std_name_hint (const char *name) /* <condition_variable>. */ {"condition_variable", "<condition_variable>", cxx11}, {"condition_variable_any", "<condition_variable>", cxx11}, + /* <cstddef>. */ + {"byte", "<cstddef>", cxx17}, /* <deque>. */ {"deque", "<deque>", cxx98}, /* <forward_list>. */ diff --git a/gcc/cp/parser.c b/gcc/cp/parser.c index 16d1359..ce2e4b5 100644 --- a/gcc/cp/parser.c +++ b/gcc/cp/parser.c @@ -2599,8 +2599,9 @@ static enum tag_types cp_parser_token_is_class_key (cp_token *); static enum tag_types cp_parser_token_is_type_parameter_key (cp_token *); +static void cp_parser_maybe_warn_enum_key (cp_parser *, location_t, tree, rid); static void cp_parser_check_class_key - (enum tag_types, tree type); +(cp_parser *, location_t, enum tag_types, tree type, bool, bool); static void cp_parser_check_access_in_redeclaration (tree type, location_t location); static bool cp_parser_optional_template_keyword @@ -8169,9 +8170,17 @@ cp_parser_unary_expression (cp_parser *parser, cp_id_kind * pidk, /* Parse the operand. */ operand = cp_parser_sizeof_operand (parser, keyword); + /* Construct a location e.g. : + alignof (expr) + ^~~~~~~~~~~~~~ + with start == caret at the start of the "alignof"/"sizeof" + token, with the endpoint at the final closing paren. */ + location_t compound_loc + = make_location (start_loc, start_loc, parser->lexer); + if (TYPE_P (operand)) - ret = cxx_sizeof_or_alignof_type (operand, op, std_alignof, - true); + ret = cxx_sizeof_or_alignof_type (compound_loc, operand, op, + std_alignof, true); else { /* ISO C++ defines alignof only with types, not with @@ -8182,7 +8191,8 @@ cp_parser_unary_expression (cp_parser *parser, cp_id_kind * pidk, "ISO C++ does not allow %<alignof%> " "with a non-type"); - ret = cxx_sizeof_or_alignof_expr (operand, op, true); + ret = cxx_sizeof_or_alignof_expr (compound_loc, + operand, op, true); } /* For SIZEOF_EXPR, just issue diagnostics, but keep SIZEOF_EXPR with the original operand. */ @@ -8201,19 +8211,11 @@ cp_parser_unary_expression (cp_parser *parser, cp_id_kind * pidk, ret = build_min (SIZEOF_EXPR, size_type_node, operand); TREE_SIDE_EFFECTS (ret) = 0; TREE_READONLY (ret) = 1; + SET_EXPR_LOCATION (ret, compound_loc); } } - /* Construct a location e.g. : - alignof (expr) - ^~~~~~~~~~~~~~ - with start == caret at the start of the "alignof"/"sizeof" - token, with the endpoint at the final closing paren. */ - location_t compound_loc - = make_location (start_loc, start_loc, parser->lexer); - - cp_expr ret_expr (ret); - ret_expr.set_location (compound_loc); + cp_expr ret_expr (ret, compound_loc); ret_expr = ret_expr.maybe_add_location_wrapper (); return ret_expr; } @@ -18498,6 +18500,11 @@ cp_parser_elaborated_type_specifier (cp_parser* parser, tree globalscope; cp_token *token = NULL; + /* For class and enum types the location of the class-key or enum-key. */ + location_t key_loc = cp_lexer_peek_token (parser->lexer)->location; + /* For a scoped enum, the 'class' or 'struct' keyword id. */ + rid scoped_key = RID_MAX; + /* See if we're looking at the `enum' keyword. */ if (cp_lexer_next_token_is_keyword (parser->lexer, RID_ENUM)) { @@ -18508,10 +18515,11 @@ cp_parser_elaborated_type_specifier (cp_parser* parser, /* Issue a warning if the `struct' or `class' key (for C++0x scoped enums) is used here. */ cp_token *token = cp_lexer_peek_token (parser->lexer); - if (cp_parser_is_keyword (token, RID_CLASS) - || cp_parser_is_keyword (token, RID_STRUCT)) + if (cp_parser_is_keyword (token, scoped_key = RID_CLASS) + || cp_parser_is_keyword (token, scoped_key = RID_STRUCT)) { - gcc_rich_location richloc (token->location); + location_t loc = token->location; + gcc_rich_location richloc (loc); richloc.add_range (input_location); richloc.add_fixit_remove (); pedwarn (&richloc, 0, "elaborated-type-specifier for " @@ -18519,7 +18527,12 @@ cp_parser_elaborated_type_specifier (cp_parser* parser, token->u.value); /* Consume the `struct' or `class' and parse it anyway. */ cp_lexer_consume_token (parser->lexer); + /* Create a combined location for the whole scoped-enum-key. */ + key_loc = make_location (key_loc, key_loc, loc); } + else + scoped_key = RID_MAX; + /* Parse the attributes. */ attributes = cp_parser_attributes_opt (parser); } @@ -18535,6 +18548,7 @@ cp_parser_elaborated_type_specifier (cp_parser* parser, /* Otherwise it must be a class-key. */ else { + key_loc = cp_lexer_peek_token (parser->lexer)->location; tag_type = cp_parser_class_key (parser); if (tag_type == none_type) return error_mark_node; @@ -18845,13 +18859,18 @@ cp_parser_elaborated_type_specifier (cp_parser* parser, "attributes ignored on elaborated-type-specifier that is not a forward declaration"); } - if (tag_type != enum_type) + if (tag_type == enum_type) + cp_parser_maybe_warn_enum_key (parser, key_loc, type, scoped_key); + else { + /* Diagnose class/struct/union mismatches. */ + cp_parser_check_class_key (parser, key_loc, tag_type, type, false, + cp_parser_declares_only_class_p (parser)); + /* Indicate whether this class was declared as a `class' or as a `struct'. */ - if (CLASS_TYPE_P (type)) + if (CLASS_TYPE_P (type) && !currently_open_class (type)) CLASSTYPE_DECLARED_CLASS (type) = (tag_type == class_type); - cp_parser_check_class_key (tag_type, type); } /* A "<" cannot follow an elaborated type specifier. If that @@ -24389,11 +24408,14 @@ cp_parser_class_head (cp_parser* parser, parser->num_template_parameter_lists); } + /* Diagnose class/struct/union mismatches. */ + cp_parser_check_class_key (parser, UNKNOWN_LOCATION, class_key, type, + true, true); + /* Indicate whether this class was declared as a `class' or as a `struct'. */ if (TREE_CODE (type) == RECORD_TYPE) - CLASSTYPE_DECLARED_CLASS (type) = (class_key == class_type); - cp_parser_check_class_key (class_key, type); + CLASSTYPE_DECLARED_CLASS (type) = class_key == class_type; /* If this type was already complete, and we see another definition, that's an error. Likewise if the type is already being defined: @@ -26045,8 +26067,7 @@ cp_parser_throw_expression (cp_parser* parser) the end at the end of the final token we consumed. */ location_t combined_loc = make_location (start_loc, start_loc, parser->lexer); - expression = build_throw (expression); - protected_set_expr_location (expression, combined_loc); + expression = build_throw (combined_loc, expression); return expression; } @@ -27918,6 +27939,11 @@ cp_parser_lookup_name (cp_parser *parser, tree name, if (!type || !CLASS_TYPE_P (type)) return error_mark_node; + /* In a non-static member function, check implicit this->. */ + if (current_class_ref) + return lookup_destructor (current_class_ref, parser->scope, name, + tf_warning_or_error); + if (CLASSTYPE_LAZY_DESTRUCTOR (type)) lazily_declare_fn (sfk_destructor, type); @@ -30617,14 +30643,169 @@ cp_parser_token_is_type_parameter_key (cp_token* token) } } -/* Issue an error message if the CLASS_KEY does not match the TYPE. */ +/* Diagnose redundant enum-keys. */ + +static void +cp_parser_maybe_warn_enum_key (cp_parser *parser, location_t key_loc, + tree type, rid scoped_key) +{ + tree type_decl = TYPE_MAIN_DECL (type); + tree name = DECL_NAME (type_decl); + /* Look up the NAME to see if it unambiguously refers to the TYPE + and set KEY_REDUNDANT if so. */ + tree decl = cp_parser_lookup_name_simple (parser, name, input_location); + + /* The enum-key is redundant for uses of the TYPE that are not + declarations and for which name lookup returns just the type + itself. */ + if (decl == type_decl) + { + gcc_rich_location richloc (key_loc); + richloc.add_fixit_remove (key_loc); + warning_at (&richloc, OPT_Wredundant_tags, + "redundant enum-key %<enum%s%> in reference to %q#T", + (scoped_key == RID_CLASS ? " class" + : scoped_key == RID_STRUCT ? " struct" : ""), type); + } +} + +/* Describes the set of declarations of a struct, class, or class template + or its specializations. Used for -Wmismatched-tags. */ + +class class_decl_loc_t +{ + public: + + class_decl_loc_t () + : locvec (), idxdef (), def_class_key () + { + locvec.create (4); + } + + /* Constructs an object for a single declaration of a class with + CLASS_KEY at the current location in the current function (or + at another scope). KEY_REDUNDANT is true if the class-key may + be omitted in the current context without an ambiguity with + another symbol with the same name. + DEF_P is true for a class declaration that is a definition. + CURLOC is the associated location. */ + class_decl_loc_t (tag_types class_key, bool key_redundant, bool def_p, + location_t curloc = input_location) + : locvec (), idxdef (def_p ? 0 : UINT_MAX), def_class_key (class_key) + { + locvec.create (4); + class_key_loc_t ckl (current_function_decl, curloc, class_key, + key_redundant); + locvec.quick_push (ckl); + } + + /* Copy, assign, and destroy the object. Necessary because LOCVEC + isn't safely copyable and assignable and doesn't release storage + on its own. */ + class_decl_loc_t (const class_decl_loc_t &rhs) + : locvec (rhs.locvec.copy ()), idxdef (rhs.idxdef), + def_class_key (rhs.def_class_key) + { } + + class_decl_loc_t& operator= (const class_decl_loc_t &rhs) + { + if (this == &rhs) + return *this; + locvec.release (); + locvec = rhs.locvec.copy (); + idxdef = rhs.idxdef; + def_class_key = rhs.def_class_key; + return *this; + } + + ~class_decl_loc_t () + { + locvec.release (); + } + + /* Issues -Wmismatched-tags for a single class. */ + void diag_mismatched_tags (tree); + + /* Issues -Wmismatched-tags for all classes. */ + static void diag_mismatched_tags (); + + /* Adds TYPE_DECL to the collection of class decls. */ + static void add (tree, tag_types, bool, bool); + + /* Either adds this decl to the collection of class decls + or diagnoses it, whichever is appropriate. */ + void add_or_diag_mismatched_tag (tree, tag_types, bool, bool); + +private: + + tree function (unsigned i) const + { + return locvec[i].func; + } + + location_t location (unsigned i) const + { + return locvec[i].loc; + } + + bool key_redundant (unsigned i) const + { + return locvec[i].key_redundant; + } + + tag_types class_key (unsigned i) const + { + return locvec[i].class_key; + } + + /* The location of a single mention of a class type with the given + class-key. */ + struct class_key_loc_t + { + class_key_loc_t (tree func, location_t loc, tag_types key, bool redundant) + : func (func), loc (loc), class_key (key), key_redundant (redundant) { } + + /* The function the type is mentioned in. */ + tree func; + /* The exact location. */ + location_t loc; + /* The class-key used in the mention of the type. */ + tag_types class_key; + /* True when the class-key could be omitted at this location + without an ambiguity with another symbol of the same name. */ + bool key_redundant; + }; + /* Avoid using auto_vec here since it's not safe to copy due to pr90904. */ + vec <class_key_loc_t> locvec; + /* LOCVEC index of the definition or UINT_MAX if none exists. */ + unsigned idxdef; + /* The class-key the class was last declared with or none_type when + it has been declared with a mismatched key. */ + tag_types def_class_key; + + /* A mapping between a TYPE_DECL for a class and the class_decl_loc_t + description above. */ + typedef hash_map<tree_decl_hash, class_decl_loc_t> class_to_loc_map_t; + static class_to_loc_map_t class2loc; +}; + +class_decl_loc_t::class_to_loc_map_t class_decl_loc_t::class2loc; + +/* Issue an error message if the CLASS_KEY does not match the TYPE. + DEF_P is expected to be set for a definition of class TYPE. DECL_P + is set for a declaration of class TYPE and clear for a reference to + it that is not a declaration of it. */ static void -cp_parser_check_class_key (enum tag_types class_key, tree type) +cp_parser_check_class_key (cp_parser *parser, location_t key_loc, + tag_types class_key, tree type, bool def_p, + bool decl_p) { if (type == error_mark_node) return; - if ((TREE_CODE (type) == UNION_TYPE) != (class_key == union_type)) + + bool seen_as_union = TREE_CODE (type) == UNION_TYPE; + if (seen_as_union != (class_key == union_type)) { if (permerror (input_location, "%qs tag used in naming %q#T", class_key == union_type ? "union" @@ -30632,7 +30813,240 @@ cp_parser_check_class_key (enum tag_types class_key, tree type) type)) inform (DECL_SOURCE_LOCATION (TYPE_NAME (type)), "%q#T was previously declared here", type); + return; } + + if (!warn_mismatched_tags && !warn_redundant_tags) + return; + + tree type_decl = TYPE_MAIN_DECL (type); + tree name = DECL_NAME (type_decl); + /* Look up the NAME to see if it unambiguously refers to the TYPE + and set KEY_REDUNDANT if so. */ + tree decl = cp_parser_lookup_name_simple (parser, name, input_location); + + /* The class-key is redundant for uses of the CLASS_TYPE that are + neither definitions of it nor declarations, and for which name + lookup returns just the type itself. */ + bool key_redundant = !def_p && !decl_p && decl == type_decl; + if (key_redundant) + { + gcc_rich_location richloc (key_loc); + richloc.add_fixit_remove (key_loc); + warning_at (&richloc, OPT_Wredundant_tags, + "redundant class-key %qs in reference to %q#T", + class_key == union_type ? "union" + : class_key == record_type ? "struct" : "class", + type); + } + + if (seen_as_union || !warn_mismatched_tags) + return; + + class_decl_loc_t::add (type_decl, class_key, key_redundant, def_p); +} + +/* Adds TYPE_DECL to the collection of class decls. */ + +void +class_decl_loc_t::add (tree type_decl, tag_types class_key, bool redundant, + bool def_p) +{ + bool exist; + class_decl_loc_t *rdl = &class2loc.get_or_insert (type_decl, &exist); + if (!exist) + { + tree type = TREE_TYPE (type_decl); + if (def_p || !COMPLETE_TYPE_P (type)) + { + /* TYPE_DECL is the first declaration or definition of the type + (outside precompiled headers -- see below). Just create + a new entry for it. */ + *rdl = class_decl_loc_t (class_key, false, def_p); + return; + } + + /* TYPE was previously defined in some unknown precompiled hdeader. + Simply add a record of its definition at an unknown location and + proceed below to add a reference to it at the current location. + (Declarations in precompiled headers that are not definitions + are ignored.) */ + tag_types def_key + = CLASSTYPE_DECLARED_CLASS (type) ? class_type : record_type; + location_t def_loc = DECL_SOURCE_LOCATION (type_decl); + *rdl = class_decl_loc_t (def_key, false, true, def_loc); + } + + /* A prior declaration of TYPE_DECL has been seen. */ + + if (rdl->idxdef != UINT_MAX && rdl->def_class_key == class_key) + /* Do nothing if the class-key in this declaration matches + the definition. */ + return; + + rdl->add_or_diag_mismatched_tag (type_decl, class_key, redundant, def_p); +} + +/* Either adds this DECL corresponding to the TYPE_DECL to the collection + of class decls or diagnoses it, whichever is appropriate. */ + +void +class_decl_loc_t::add_or_diag_mismatched_tag (tree type_decl, + tag_types class_key, + bool redundant, + bool def_p) +{ + /* Reset the CLASS_KEY associated with this type on mismatch. + This is an optimization that lets the diagnostic code skip + over classes that use the same class-key in all declarations. */ + if (def_class_key != class_key) + def_class_key = none_type; + + /* Set IDXDEF to the index of the vector corresponding to + the definition. */ + if (def_p) + idxdef = locvec.length (); + + /* Append a record of this declaration to the vector. */ + class_key_loc_t ckl (current_function_decl, input_location, class_key, + redundant); + locvec.safe_push (ckl); + + if (idxdef == UINT_MAX) + return; + + /* As a space optimization diagnose declarations of a class + whose definition has been seen and purge the LOCVEC of + all entries except the definition. */ + diag_mismatched_tags (type_decl); + if (idxdef) + { + class_decl_loc_t::class_key_loc_t ent = locvec[idxdef]; + locvec.release (); + locvec.reserve (2); + locvec.safe_push (ent); + idxdef = 0; + } + else + /* Pop the entry pushed above for this declaration. */ + locvec.pop (); +} + +/* Issues -Wmismatched-tags for a single class. */ + +void +class_decl_loc_t::diag_mismatched_tags (tree type_decl) +{ + unsigned ndecls = locvec.length (); + + /* Skip a declaration that consistently uses the same class-key + or one with just a solitary declaration (i.e., TYPE_DECL). */ + if (def_class_key != none_type || ndecls < 2) + return; + + /* Save the current function before changing it below. */ + tree save_func = current_function_decl; + /* Set if a class definition for RECLOC has been seen. */ + bool def_p = idxdef < ndecls; + unsigned idxguide = def_p ? idxdef : 0; + unsigned idx = 0; + /* Advance IDX to the first declaration that either is not + a definition or that doesn't match the first declaration + if no definition is provided. */ + while (class_key (idx) == class_key (idxguide)) + if (++idx == ndecls) + return; + + /* The class-key the class is expected to be declared with: it's + either the key used in its definition or the first declaration + if no definition has been provided. */ + tag_types xpect_key = class_key (def_p ? idxguide : 0); + const char *xmatchkstr = xpect_key == record_type ? "class" : "struct"; + const char *xpectkstr = xpect_key == record_type ? "struct" : "class"; + /* Set the function declaration to print in diagnostic context. */ + current_function_decl = function (idx); + + location_t loc = location (idx); + bool key_redundant_p = key_redundant (idx); + auto_diagnostic_group d; + /* Issue a warning for the first mismatched declaration. + Avoid using "%#qT" since the class-key for the same type will + be the same regardless of which one was used in the declaraion. */ + warning_at (loc, OPT_Wmismatched_tags, + "%qT declared with a mismatched class-key %qs", + type_decl, xmatchkstr); + + /* Suggest how to avoid the warning for each instance since + the guidance may be different depending on context. */ + inform (loc, + (key_redundant_p + ? G_("remove the class-key or replace it with %qs") + : G_("replace the class-key with %qs")), + xpectkstr); + + /* Also point to the first declaration or definition that guided + the decision to issue the warning above. */ + inform (location (idxguide), + (def_p + ? G_("%qT defined as %qs here") + : G_("%qT first declared as %qs here")), + type_decl, xpectkstr); + + /* Issue warnings for the remaining inconsistent declarations. */ + for (unsigned i = idx + 1; i != ndecls; ++i) + { + tag_types clskey = class_key (i); + /* Skip over the declarations that match either the definition + if one was provided or the first declaration. */ + if (clskey == xpect_key) + continue; + + loc = location (i); + key_redundant_p = key_redundant (i); + /* Set the function declaration to print in diagnostic context. */ + current_function_decl = function (i); + warning_at (loc, OPT_Wmismatched_tags, + "%qT declared with a mismatched class-key %qs", + type_decl, xmatchkstr); + /* Suggest how to avoid the warning for each instance since + the guidance may be different depending on context. */ + inform (loc, + (key_redundant_p + ? G_("remove the class-key or replace it with %qs") + : G_("replace the class-key with %qs")), + xpectkstr); + } + + /* Restore the current function in case it was replaced above. */ + current_function_decl = save_func; +} + +/* Issues -Wmismatched-tags for all classes. Called at the end + of processing a translation unit, after declarations of all class + types and their uses have been recorded. */ + +void +class_decl_loc_t::diag_mismatched_tags () +{ + /* CLASS2LOC should be empty if -Wmismatched-tags is disabled. */ + gcc_assert (warn_mismatched_tags || class2loc.is_empty ()); + + /* Save the current function before changing it below. It should + be null at this point. */ + tree save_func = current_function_decl; + + /* Iterate over the collected class/struct declarations. */ + typedef class_to_loc_map_t::iterator iter_t; + for (iter_t it = class2loc.begin (); it != class2loc.end (); ++it) + { + tree type_decl = (*it).first; + class_decl_loc_t &recloc = (*it).second; + recloc.diag_mismatched_tags (type_decl); + } + + class2loc.empty (); + /* Restore the current function. */ + current_function_decl = save_func; } /* Issue an error message if DECL is redeclared with different @@ -33208,7 +33622,9 @@ cp_parser_omp_clause_name (cp_parser *parser) result = PRAGMA_OMP_CLAUSE_MERGEABLE; break; case 'n': - if (!strcmp ("nogroup", p)) + if (!strcmp ("no_create", p)) + result = PRAGMA_OACC_CLAUSE_NO_CREATE; + else if (!strcmp ("nogroup", p)) result = PRAGMA_OMP_CLAUSE_NOGROUP; else if (!strcmp ("nontemporal", p)) result = PRAGMA_OMP_CLAUSE_NONTEMPORAL; @@ -33574,7 +33990,10 @@ cp_parser_omp_var_list (cp_parser *parser, enum omp_clause_code kind, tree list) copyout ( variable-list ) create ( variable-list ) delete ( variable-list ) - present ( variable-list ) */ + present ( variable-list ) + + OpenACC 2.6: + no_create ( variable-list ) */ static tree cp_parser_oacc_data_clause (cp_parser *parser, pragma_omp_clause c_kind, @@ -33610,6 +34029,9 @@ cp_parser_oacc_data_clause (cp_parser *parser, pragma_omp_clause c_kind, case PRAGMA_OACC_CLAUSE_LINK: kind = GOMP_MAP_LINK; break; + case PRAGMA_OACC_CLAUSE_NO_CREATE: + kind = GOMP_MAP_IF_PRESENT; + break; case PRAGMA_OACC_CLAUSE_PRESENT: kind = GOMP_MAP_FORCE_PRESENT; break; @@ -36172,6 +36594,10 @@ cp_parser_oacc_all_clauses (cp_parser *parser, omp_clause_mask mask, clauses = cp_parser_oacc_data_clause (parser, c_kind, clauses); c_name = "link"; break; + case PRAGMA_OACC_CLAUSE_NO_CREATE: + clauses = cp_parser_oacc_data_clause (parser, c_kind, clauses); + c_name = "no_create"; + break; case PRAGMA_OACC_CLAUSE_NUM_GANGS: code = OMP_CLAUSE_NUM_GANGS; c_name = "num_gangs"; @@ -39977,6 +40403,7 @@ cp_parser_oacc_cache (cp_parser *parser, cp_token *pragma_tok) | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_CREATE) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_DEVICEPTR) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_IF) \ + | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_NO_CREATE) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_PRESENT) ) static tree @@ -40298,6 +40725,7 @@ cp_parser_oacc_loop (cp_parser *parser, cp_token *pragma_tok, char *p_name, | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_DEFAULT) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_DEVICEPTR) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_IF) \ + | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_NO_CREATE) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_NUM_GANGS) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_NUM_WORKERS) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_PRESENT) \ @@ -40312,8 +40740,9 @@ cp_parser_oacc_loop (cp_parser *parser, cp_token *pragma_tok, char *p_name, | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_CREATE) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_DEFAULT) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_DEVICEPTR) \ - | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_FIRSTPRIVATE) \ + | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_FIRSTPRIVATE) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_IF) \ + | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_NO_CREATE) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_NUM_GANGS) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_NUM_WORKERS) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_PRESENT) \ @@ -40331,6 +40760,7 @@ cp_parser_oacc_loop (cp_parser *parser, cp_token *pragma_tok, char *p_name, | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_DEFAULT) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_DEVICEPTR) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_IF) \ + | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_NO_CREATE) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_PRIVATE) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_FIRSTPRIVATE) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OACC_CLAUSE_PRESENT) \ @@ -43065,6 +43495,8 @@ c_parse_file (void) push_deferring_access_checks (flag_access_control ? dk_no_deferred : dk_no_check); cp_parser_translation_unit (the_parser); + class_decl_loc_t::diag_mismatched_tags (); + the_parser = NULL; finish_translation_unit (); diff --git a/gcc/cp/pt.c b/gcc/cp/pt.c index 6f658de..e9cf46c 100644 --- a/gcc/cp/pt.c +++ b/gcc/cp/pt.c @@ -10640,7 +10640,12 @@ push_tinst_level_loc (tree tldcl, tree targs, location_t loc) anything else. Do allow deduction substitution and decls usable in constant expressions. */ if (!targs && limit_bad_template_recursion (tldcl)) - return false; + { + /* Avoid no_linkage_errors and unused function warnings for this + decl. */ + TREE_NO_WARNING (tldcl) = 1; + return false; + } /* When not -quiet, dump template instantiations other than functions, since announce_function will take care of those. */ @@ -16395,11 +16400,13 @@ tsubst_copy (tree t, tree args, tsubst_flags_t complain, tree in_decl) expanded = make_argument_pack (expanded); if (TYPE_P (expanded)) - return cxx_sizeof_or_alignof_type (expanded, SIZEOF_EXPR, + return cxx_sizeof_or_alignof_type (input_location, + expanded, SIZEOF_EXPR, false, complain & tf_error); else - return cxx_sizeof_or_alignof_expr (expanded, SIZEOF_EXPR, + return cxx_sizeof_or_alignof_expr (input_location, + expanded, SIZEOF_EXPR, complain & tf_error); } else @@ -19189,10 +19196,12 @@ tsubst_copy_and_build (tree t, --c_inhibit_evaluation_warnings; } if (TYPE_P (op1)) - r = cxx_sizeof_or_alignof_type (op1, TREE_CODE (t), std_alignof, + r = cxx_sizeof_or_alignof_type (input_location, + op1, TREE_CODE (t), std_alignof, complain & tf_error); else - r = cxx_sizeof_or_alignof_expr (op1, TREE_CODE (t), + r = cxx_sizeof_or_alignof_expr (input_location, + op1, TREE_CODE (t), complain & tf_error); if (TREE_CODE (t) == SIZEOF_EXPR && r != error_mark_node) { @@ -19954,7 +19963,7 @@ tsubst_copy_and_build (tree t, case THROW_EXPR: RETURN (build_throw - (RECUR (TREE_OPERAND (t, 0)))); + (input_location, RECUR (TREE_OPERAND (t, 0)))); case CONSTRUCTOR: { diff --git a/gcc/cp/semantics.c b/gcc/cp/semantics.c index 4261168..69010dc 100644 --- a/gcc/cp/semantics.c +++ b/gcc/cp/semantics.c @@ -1429,15 +1429,19 @@ finish_handler_parms (tree decl, tree handler) if (CLASS_TYPE_P (orig_type)) { if (TYPE_POLYMORPHIC_P (orig_type)) - warning (OPT_Wcatch_value_, - "catching polymorphic type %q#T by value", orig_type); + warning_at (DECL_SOURCE_LOCATION (decl), + OPT_Wcatch_value_, + "catching polymorphic type %q#T by value", + orig_type); else if (warn_catch_value > 1) - warning (OPT_Wcatch_value_, - "catching type %q#T by value", orig_type); + warning_at (DECL_SOURCE_LOCATION (decl), + OPT_Wcatch_value_, + "catching type %q#T by value", orig_type); } else if (warn_catch_value > 2) - warning (OPT_Wcatch_value_, - "catching non-reference type %q#T", orig_type); + warning_at (DECL_SOURCE_LOCATION (decl), + OPT_Wcatch_value_, + "catching non-reference type %q#T", orig_type); } } HANDLER_TYPE (handler) = type; @@ -5288,6 +5292,7 @@ handle_omp_array_sections (tree c, enum c_omp_region_type ort) switch (OMP_CLAUSE_MAP_KIND (c)) { case GOMP_MAP_ALLOC: + case GOMP_MAP_IF_PRESENT: case GOMP_MAP_TO: case GOMP_MAP_FROM: case GOMP_MAP_TOFROM: diff --git a/gcc/cp/typeck.c b/gcc/cp/typeck.c index d381458..41ef896 100644 --- a/gcc/cp/typeck.c +++ b/gcc/cp/typeck.c @@ -59,7 +59,6 @@ static tree get_delta_difference (tree, tree, bool, bool, tsubst_flags_t); static void casts_away_constness_r (tree *, tree *, tsubst_flags_t); static bool casts_away_constness (tree, tree, tsubst_flags_t); static bool maybe_warn_about_returning_address_of_local (tree); -static tree lookup_destructor (tree, tree, tree, tsubst_flags_t); static void error_args_num (location_t, tree, bool); static int convert_arguments (tree, vec<tree, va_gc> **, tree, int, tsubst_flags_t); @@ -1663,8 +1662,8 @@ compparms (const_tree parms1, const_tree parms2) SIZEOF_EXPR. */ tree -cxx_sizeof_or_alignof_type (tree type, enum tree_code op, bool std_alignof, - bool complain) +cxx_sizeof_or_alignof_type (location_t loc, tree type, enum tree_code op, + bool std_alignof, bool complain) { gcc_assert (op == SIZEOF_EXPR || op == ALIGNOF_EXPR); if (type == error_mark_node) @@ -1675,7 +1674,7 @@ cxx_sizeof_or_alignof_type (tree type, enum tree_code op, bool std_alignof, { if (complain) { - pedwarn (input_location, OPT_Wpointer_arith, + pedwarn (loc, OPT_Wpointer_arith, "invalid application of %qs to a member function", OVL_OP_INFO (false, op)->name); return size_one_node; @@ -1702,10 +1701,11 @@ cxx_sizeof_or_alignof_type (tree type, enum tree_code op, bool std_alignof, TREE_READONLY (value) = 1; if (op == ALIGNOF_EXPR && std_alignof) ALIGNOF_EXPR_STD_P (value) = true; + SET_EXPR_LOCATION (value, loc); return value; } - return c_sizeof_or_alignof_type (input_location, complete_type (type), + return c_sizeof_or_alignof_type (loc, complete_type (type), op == SIZEOF_EXPR, std_alignof, complain); } @@ -1724,13 +1724,14 @@ cxx_sizeof_nowarn (tree type) else if (!COMPLETE_TYPE_P (type)) return size_zero_node; else - return cxx_sizeof_or_alignof_type (type, SIZEOF_EXPR, false, false); + return cxx_sizeof_or_alignof_type (input_location, type, + SIZEOF_EXPR, false, false); } /* Process a sizeof expression where the operand is an expression. */ static tree -cxx_sizeof_expr (tree e, tsubst_flags_t complain) +cxx_sizeof_expr (location_t loc, tree e, tsubst_flags_t complain) { if (e == error_mark_node) return error_mark_node; @@ -1740,10 +1741,12 @@ cxx_sizeof_expr (tree e, tsubst_flags_t complain) e = build_min (SIZEOF_EXPR, size_type_node, e); TREE_SIDE_EFFECTS (e) = 0; TREE_READONLY (e) = 1; + SET_EXPR_LOCATION (e, loc); return e; } + location_t e_loc = cp_expr_loc_or_loc (e, loc); STRIP_ANY_LOCATION_WRAPPER (e); /* To get the size of a static data member declared as an array of @@ -1758,8 +1761,9 @@ cxx_sizeof_expr (tree e, tsubst_flags_t complain) && (complain & tf_warning)) { auto_diagnostic_group d; - if (warning (OPT_Wsizeof_array_argument, "%<sizeof%> on array function " - "parameter %qE will return size of %qT", e, TREE_TYPE (e))) + if (warning_at (e_loc, OPT_Wsizeof_array_argument, + "%<sizeof%> on array function parameter %qE " + "will return size of %qT", e, TREE_TYPE (e))) inform (DECL_SOURCE_LOCATION (e), "declared here"); } @@ -1768,7 +1772,7 @@ cxx_sizeof_expr (tree e, tsubst_flags_t complain) if (bitfield_p (e)) { if (complain & tf_error) - error_at (cp_expr_loc_or_input_loc (e), + error_at (e_loc, "invalid application of %<sizeof%> to a bit-field"); else return error_mark_node; @@ -1777,9 +1781,8 @@ cxx_sizeof_expr (tree e, tsubst_flags_t complain) else if (is_overloaded_fn (e)) { if (complain & tf_error) - permerror (cp_expr_loc_or_input_loc (e), - "ISO C++ forbids applying %<sizeof%> to an expression " - "of function type"); + permerror (e_loc, "ISO C++ forbids applying %<sizeof%> to " + "an expression of function type"); else return error_mark_node; e = char_type_node; @@ -1787,7 +1790,7 @@ cxx_sizeof_expr (tree e, tsubst_flags_t complain) else if (type_unknown_p (e)) { if (complain & tf_error) - cxx_incomplete_type_error (e, TREE_TYPE (e)); + cxx_incomplete_type_error (e_loc, e, TREE_TYPE (e)); else return error_mark_node; e = char_type_node; @@ -1795,7 +1798,8 @@ cxx_sizeof_expr (tree e, tsubst_flags_t complain) else e = TREE_TYPE (e); - return cxx_sizeof_or_alignof_type (e, SIZEOF_EXPR, false, complain & tf_error); + return cxx_sizeof_or_alignof_type (loc, e, SIZEOF_EXPR, false, + complain & tf_error); } /* Implement the __alignof keyword: Return the minimum required @@ -1804,7 +1808,7 @@ cxx_sizeof_expr (tree e, tsubst_flags_t complain) "aligned" __attribute__ specification). */ static tree -cxx_alignof_expr (tree e, tsubst_flags_t complain) +cxx_alignof_expr (location_t loc, tree e, tsubst_flags_t complain) { tree t; @@ -1816,15 +1820,17 @@ cxx_alignof_expr (tree e, tsubst_flags_t complain) e = build_min (ALIGNOF_EXPR, size_type_node, e); TREE_SIDE_EFFECTS (e) = 0; TREE_READONLY (e) = 1; + SET_EXPR_LOCATION (e, loc); return e; } + location_t e_loc = cp_expr_loc_or_loc (e, loc); STRIP_ANY_LOCATION_WRAPPER (e); e = mark_type_use (e); - if (!verify_type_context (input_location, TCTX_ALIGNOF, TREE_TYPE (e), + if (!verify_type_context (loc, TCTX_ALIGNOF, TREE_TYPE (e), !(complain & tf_error))) { if (!(complain & tf_error)) @@ -1836,7 +1842,7 @@ cxx_alignof_expr (tree e, tsubst_flags_t complain) else if (bitfield_p (e)) { if (complain & tf_error) - error_at (cp_expr_loc_or_input_loc (e), + error_at (e_loc, "invalid application of %<__alignof%> to a bit-field"); else return error_mark_node; @@ -1848,9 +1854,8 @@ cxx_alignof_expr (tree e, tsubst_flags_t complain) else if (is_overloaded_fn (e)) { if (complain & tf_error) - permerror (cp_expr_loc_or_input_loc (e), - "ISO C++ forbids applying %<__alignof%> to an expression " - "of function type"); + permerror (e_loc, "ISO C++ forbids applying %<__alignof%> to " + "an expression of function type"); else return error_mark_node; if (TREE_CODE (e) == FUNCTION_DECL) @@ -1861,28 +1866,30 @@ cxx_alignof_expr (tree e, tsubst_flags_t complain) else if (type_unknown_p (e)) { if (complain & tf_error) - cxx_incomplete_type_error (e, TREE_TYPE (e)); + cxx_incomplete_type_error (e_loc, e, TREE_TYPE (e)); else return error_mark_node; t = size_one_node; } else - return cxx_sizeof_or_alignof_type (TREE_TYPE (e), ALIGNOF_EXPR, false, + return cxx_sizeof_or_alignof_type (loc, TREE_TYPE (e), + ALIGNOF_EXPR, false, complain & tf_error); - return fold_convert (size_type_node, t); + return fold_convert_loc (loc, size_type_node, t); } /* Process a sizeof or alignof expression E with code OP where the operand is an expression. */ tree -cxx_sizeof_or_alignof_expr (tree e, enum tree_code op, bool complain) +cxx_sizeof_or_alignof_expr (location_t loc, tree e, enum tree_code op, + bool complain) { if (op == SIZEOF_EXPR) - return cxx_sizeof_expr (e, complain? tf_warning_or_error : tf_none); + return cxx_sizeof_expr (loc, e, complain? tf_warning_or_error : tf_none); else - return cxx_alignof_expr (e, complain? tf_warning_or_error : tf_none); + return cxx_alignof_expr (loc, e, complain? tf_warning_or_error : tf_none); } /* Build a representation of an expression 'alignas(E).' Return the @@ -1906,7 +1913,8 @@ cxx_alignas_expr (tree e) alignas(type-id ), it shall have the same effect as alignas(alignof(type-id )). */ - return cxx_sizeof_or_alignof_type (e, ALIGNOF_EXPR, true, false); + return cxx_sizeof_or_alignof_type (input_location, + e, ALIGNOF_EXPR, true, false); /* If we reach this point, it means the alignas expression if of the form "alignas(assignment-expression)", so we should follow @@ -2696,7 +2704,7 @@ build_class_member_access_expr (cp_expr object, tree member, /* Return the destructor denoted by OBJECT.SCOPE::DTOR_NAME, or, if SCOPE is NULL, by OBJECT.DTOR_NAME, where DTOR_NAME is ~type. */ -static tree +tree lookup_destructor (tree object, tree scope, tree dtor_name, tsubst_flags_t complain) { diff --git a/gcc/diagnostic-core.h b/gcc/diagnostic-core.h index efafde4..2e7f120 100644 --- a/gcc/diagnostic-core.h +++ b/gcc/diagnostic-core.h @@ -45,6 +45,9 @@ class auto_diagnostic_group ~auto_diagnostic_group (); }; +/* Forward decl. */ +class diagnostic_metadata; /* See diagnostic-metadata.h. */ + extern const char *progname; extern const char *trim_filename (const char *); @@ -78,6 +81,9 @@ extern bool warning_at (location_t, int, const char *, ...) ATTRIBUTE_GCC_DIAG(3,4); extern bool warning_at (rich_location *, int, const char *, ...) ATTRIBUTE_GCC_DIAG(3,4); +extern bool warning_at (rich_location *, const diagnostic_metadata &, int, + const char *, ...) + ATTRIBUTE_GCC_DIAG(4,5); extern void error (const char *, ...) ATTRIBUTE_GCC_DIAG(1,2); extern void error_n (location_t, unsigned HOST_WIDE_INT, const char *, const char *, ...) @@ -109,6 +115,10 @@ extern bool emit_diagnostic (diagnostic_t, rich_location *, int, const char *, ...) ATTRIBUTE_GCC_DIAG(4,5); extern bool emit_diagnostic_valist (diagnostic_t, location_t, int, const char *, va_list *) ATTRIBUTE_GCC_DIAG (4,0); +extern bool emit_diagnostic_valist (diagnostic_t, rich_location *, + const diagnostic_metadata *metadata, + int, const char *, va_list *) + ATTRIBUTE_GCC_DIAG (5,0); extern bool seen_error (void); #ifdef BUFSIZ diff --git a/gcc/diagnostic-format-json.cc b/gcc/diagnostic-format-json.cc index 6782ec9..18f7a56 100644 --- a/gcc/diagnostic-format-json.cc +++ b/gcc/diagnostic-format-json.cc @@ -23,6 +23,7 @@ along with GCC; see the file COPYING3. If not see #include "system.h" #include "coretypes.h" #include "diagnostic.h" +#include "diagnostic-metadata.h" #include "json.h" #include "selftest.h" @@ -103,6 +104,20 @@ json_from_fixit_hint (const fixit_hint *hint) return fixit_obj; } +/* Generate a JSON object for METADATA. */ + +static json::object * +json_from_metadata (const diagnostic_metadata *metadata) +{ + json::object *metadata_obj = new json::object (); + + if (metadata->get_cwe ()) + metadata_obj->set ("cwe", + new json::integer_number (metadata->get_cwe ())); + + return metadata_obj; +} + /* No-op implementation of "begin_diagnostic" for JSON output. */ static void @@ -211,6 +226,12 @@ json_end_diagnostic (diagnostic_context *context, diagnostic_info *diagnostic, TODO: functions TODO: inlining information TODO: macro expansion information. */ + + if (diagnostic->metadata) + { + json::object *metadata_obj = json_from_metadata (diagnostic->metadata); + diag_obj->set ("metadata", metadata_obj); + } } /* No-op implementation of "begin_group_cb" for JSON output. */ @@ -268,6 +289,9 @@ diagnostic_output_format_init (diagnostic_context *context, context->end_group_cb = json_end_group; context->final_cb = json_final_cb; + /* The metadata is handled in JSON format, rather than as text. */ + context->show_cwe = false; + /* The option is handled in JSON format, rather than as text. */ context->show_option_requested = false; diff --git a/gcc/diagnostic-metadata.h b/gcc/diagnostic-metadata.h new file mode 100644 index 0000000..a759d44 --- /dev/null +++ b/gcc/diagnostic-metadata.h @@ -0,0 +1,42 @@ +/* Additional metadata for a diagnostic. + Copyright (C) 2019 Free Software Foundation, Inc. + Contributed by David Malcolm <dmalcolm@redhat.com> + +This file is part of GCC. + +GCC is free software; you can redistribute it and/or modify it under +the terms of the GNU General Public License as published by the Free +Software Foundation; either version 3, or (at your option) any later +version. + +GCC is distributed in the hope that it will be useful, but WITHOUT ANY +WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with GCC; see the file COPYING3. If not see +<http://www.gnu.org/licenses/>. */ + +#ifndef GCC_DIAGNOSTIC_METADATA_H +#define GCC_DIAGNOSTIC_METADATA_H + +/* A bundle of additional metadata that can be associated with a + diagnostic. + + Currently this only supports associating a CWE identifier with a + diagnostic. */ + +class diagnostic_metadata +{ + public: + diagnostic_metadata () : m_cwe (0) {} + + void add_cwe (int cwe) { m_cwe = cwe; } + int get_cwe () const { return m_cwe; } + + private: + int m_cwe; +}; + +#endif /* ! GCC_DIAGNOSTIC_METADATA_H */ diff --git a/gcc/diagnostic.c b/gcc/diagnostic.c index d6604e6..95cfb6e 100644 --- a/gcc/diagnostic.c +++ b/gcc/diagnostic.c @@ -32,6 +32,7 @@ along with GCC; see the file COPYING3. If not see #include "diagnostic.h" #include "diagnostic-color.h" #include "diagnostic-url.h" +#include "diagnostic-metadata.h" #include "edit-context.h" #include "selftest.h" #include "selftest-diagnostic.h" @@ -58,11 +59,13 @@ along with GCC; see the file COPYING3. If not see #define permissive_error_option(DC) ((DC)->opt_permissive) /* Prototypes. */ -static bool diagnostic_impl (rich_location *, int, const char *, - va_list *, diagnostic_t) ATTRIBUTE_GCC_DIAG(3,0); -static bool diagnostic_n_impl (rich_location *, int, unsigned HOST_WIDE_INT, +static bool diagnostic_impl (rich_location *, const diagnostic_metadata *, + int, const char *, + va_list *, diagnostic_t) ATTRIBUTE_GCC_DIAG(4,0); +static bool diagnostic_n_impl (rich_location *, const diagnostic_metadata *, + int, unsigned HOST_WIDE_INT, const char *, const char *, va_list *, - diagnostic_t) ATTRIBUTE_GCC_DIAG(5,0); + diagnostic_t) ATTRIBUTE_GCC_DIAG(6,0); static void error_recursion (diagnostic_context *) ATTRIBUTE_NORETURN; static void real_abort (void) ATTRIBUTE_NORETURN; @@ -183,6 +186,7 @@ diagnostic_initialize (diagnostic_context *context, int n_opts) diagnostic_set_caret_max_width (context, pp_line_cutoff (context->printer)); for (i = 0; i < rich_location::STATICALLY_ALLOCATED_RANGES; i++) context->caret_chars[i] = '^'; + context->show_cwe = false; context->show_option_requested = false; context->abort_on_error = false; context->show_column = false; @@ -299,6 +303,7 @@ diagnostic_set_info_translated (diagnostic_info *diagnostic, const char *msg, diagnostic->message.format_spec = msg; diagnostic->message.m_richloc = richloc; diagnostic->richloc = richloc; + diagnostic->metadata = NULL; diagnostic->kind = kind; diagnostic->option_index = 0; } @@ -898,6 +903,47 @@ update_effective_level_from_pragmas (diagnostic_context *context, return diag_class; } +/* Generate a URL string describing CWE. The caller is responsible for + freeing the string. */ + +static char * +get_cwe_url (int cwe) +{ + return xasprintf ("https://cwe.mitre.org/data/definitions/%i.html", cwe); +} + +/* If DIAGNOSTIC has a CWE identifier, print it. + + For example, if the diagnostic metadata associates it with CWE-119, + " [CWE-119]" will be printed, suitably colorized, and with a URL of a + description of the security issue. */ + +static void +print_any_cwe (diagnostic_context *context, + const diagnostic_info *diagnostic) +{ + if (diagnostic->metadata == NULL) + return; + + int cwe = diagnostic->metadata->get_cwe (); + if (cwe) + { + pretty_printer *pp = context->printer; + char *saved_prefix = pp_take_prefix (context->printer); + pp_string (pp, " ["); + pp_string (pp, colorize_start (pp_show_color (pp), + diagnostic_kind_color[diagnostic->kind])); + char *cwe_url = get_cwe_url (cwe); + pp_begin_url (pp, cwe_url); + free (cwe_url); + pp_printf (pp, "CWE-%i", cwe); + pp_set_prefix (context->printer, saved_prefix); + pp_end_url (pp); + pp_string (pp, colorize_stop (pp_show_color (pp))); + pp_character (pp, ']'); + } +} + /* Print any metadata about the option used to control DIAGNOSTIC to CONTEXT's printer, e.g. " [-Werror=uninitialized]". Subroutine of diagnostic_report_diagnostic. */ @@ -1058,6 +1104,8 @@ diagnostic_report_diagnostic (diagnostic_context *context, pp_format (context->printer, &diagnostic->message); (*diagnostic_starter (context)) (context, diagnostic); pp_output_formatted_text (context->printer); + if (context->show_cwe) + print_any_cwe (context, diagnostic); if (context->show_option_requested) print_option_information (context, diagnostic, orig_diag_kind); (*diagnostic_finalizer (context)) (context, diagnostic, orig_diag_kind); @@ -1183,8 +1231,8 @@ diagnostic_append_note (diagnostic_context *context, permerror, error, error_at, error_at, sorry, fatal_error, internal_error, and internal_error_no_backtrace, as documented and defined below. */ static bool -diagnostic_impl (rich_location *richloc, int opt, - const char *gmsgid, +diagnostic_impl (rich_location *richloc, const diagnostic_metadata *metadata, + int opt, const char *gmsgid, va_list *ap, diagnostic_t kind) { diagnostic_info diagnostic; @@ -1200,13 +1248,15 @@ diagnostic_impl (rich_location *richloc, int opt, if (kind == DK_WARNING || kind == DK_PEDWARN) diagnostic.option_index = opt; } + diagnostic.metadata = metadata; return diagnostic_report_diagnostic (global_dc, &diagnostic); } /* Implement inform_n, warning_n, and error_n, as documented and defined below. */ static bool -diagnostic_n_impl (rich_location *richloc, int opt, unsigned HOST_WIDE_INT n, +diagnostic_n_impl (rich_location *richloc, const diagnostic_metadata *metadata, + int opt, unsigned HOST_WIDE_INT n, const char *singular_gmsgid, const char *plural_gmsgid, va_list *ap, diagnostic_t kind) @@ -1226,6 +1276,7 @@ diagnostic_n_impl (rich_location *richloc, int opt, unsigned HOST_WIDE_INT n, diagnostic_set_info_translated (&diagnostic, text, ap, richloc, kind); if (kind == DK_WARNING) diagnostic.option_index = opt; + diagnostic.metadata = metadata; return diagnostic_report_diagnostic (global_dc, &diagnostic); } @@ -1239,7 +1290,7 @@ emit_diagnostic (diagnostic_t kind, location_t location, int opt, va_list ap; va_start (ap, gmsgid); rich_location richloc (line_table, location); - bool ret = diagnostic_impl (&richloc, opt, gmsgid, &ap, kind); + bool ret = diagnostic_impl (&richloc, NULL, opt, gmsgid, &ap, kind); va_end (ap); return ret; } @@ -1253,7 +1304,7 @@ emit_diagnostic (diagnostic_t kind, rich_location *richloc, int opt, auto_diagnostic_group d; va_list ap; va_start (ap, gmsgid); - bool ret = diagnostic_impl (richloc, opt, gmsgid, &ap, kind); + bool ret = diagnostic_impl (richloc, NULL, opt, gmsgid, &ap, kind); va_end (ap); return ret; } @@ -1265,7 +1316,18 @@ emit_diagnostic_valist (diagnostic_t kind, location_t location, int opt, const char *gmsgid, va_list *ap) { rich_location richloc (line_table, location); - return diagnostic_impl (&richloc, opt, gmsgid, ap, kind); + return diagnostic_impl (&richloc, NULL, opt, gmsgid, ap, kind); +} + +/* Wrapper around diagnostic_impl taking a va_list parameter. */ + +bool +emit_diagnostic_valist (diagnostic_t kind, rich_location *richloc, + const diagnostic_metadata *metadata, + int opt, + const char *gmsgid, va_list *ap) +{ + return diagnostic_impl (richloc, metadata, opt, gmsgid, ap, kind); } /* An informative note at LOCATION. Use this for additional details on an error @@ -1277,7 +1339,7 @@ inform (location_t location, const char *gmsgid, ...) va_list ap; va_start (ap, gmsgid); rich_location richloc (line_table, location); - diagnostic_impl (&richloc, -1, gmsgid, &ap, DK_NOTE); + diagnostic_impl (&richloc, NULL, -1, gmsgid, &ap, DK_NOTE); va_end (ap); } @@ -1290,7 +1352,7 @@ inform (rich_location *richloc, const char *gmsgid, ...) auto_diagnostic_group d; va_list ap; va_start (ap, gmsgid); - diagnostic_impl (richloc, -1, gmsgid, &ap, DK_NOTE); + diagnostic_impl (richloc, NULL, -1, gmsgid, &ap, DK_NOTE); va_end (ap); } @@ -1304,7 +1366,7 @@ inform_n (location_t location, unsigned HOST_WIDE_INT n, va_start (ap, plural_gmsgid); auto_diagnostic_group d; rich_location richloc (line_table, location); - diagnostic_n_impl (&richloc, -1, n, singular_gmsgid, plural_gmsgid, + diagnostic_n_impl (&richloc, NULL, -1, n, singular_gmsgid, plural_gmsgid, &ap, DK_NOTE); va_end (ap); } @@ -1319,7 +1381,7 @@ warning (int opt, const char *gmsgid, ...) va_list ap; va_start (ap, gmsgid); rich_location richloc (line_table, input_location); - bool ret = diagnostic_impl (&richloc, opt, gmsgid, &ap, DK_WARNING); + bool ret = diagnostic_impl (&richloc, NULL, opt, gmsgid, &ap, DK_WARNING); va_end (ap); return ret; } @@ -1335,7 +1397,7 @@ warning_at (location_t location, int opt, const char *gmsgid, ...) va_list ap; va_start (ap, gmsgid); rich_location richloc (line_table, location); - bool ret = diagnostic_impl (&richloc, opt, gmsgid, &ap, DK_WARNING); + bool ret = diagnostic_impl (&richloc, NULL, opt, gmsgid, &ap, DK_WARNING); va_end (ap); return ret; } @@ -1350,7 +1412,25 @@ warning_at (rich_location *richloc, int opt, const char *gmsgid, ...) auto_diagnostic_group d; va_list ap; va_start (ap, gmsgid); - bool ret = diagnostic_impl (richloc, opt, gmsgid, &ap, DK_WARNING); + bool ret = diagnostic_impl (richloc, NULL, opt, gmsgid, &ap, DK_WARNING); + va_end (ap); + return ret; +} + +/* Same as "warning at" above, but using METADATA. */ + +bool +warning_at (rich_location *richloc, const diagnostic_metadata &metadata, + int opt, const char *gmsgid, ...) +{ + gcc_assert (richloc); + + auto_diagnostic_group d; + va_list ap; + va_start (ap, gmsgid); + bool ret + = diagnostic_impl (richloc, &metadata, opt, gmsgid, &ap, + DK_WARNING); va_end (ap); return ret; } @@ -1366,7 +1446,7 @@ warning_n (rich_location *richloc, int opt, unsigned HOST_WIDE_INT n, auto_diagnostic_group d; va_list ap; va_start (ap, plural_gmsgid); - bool ret = diagnostic_n_impl (richloc, opt, n, + bool ret = diagnostic_n_impl (richloc, NULL, opt, n, singular_gmsgid, plural_gmsgid, &ap, DK_WARNING); va_end (ap); @@ -1385,7 +1465,7 @@ warning_n (location_t location, int opt, unsigned HOST_WIDE_INT n, va_list ap; va_start (ap, plural_gmsgid); rich_location richloc (line_table, location); - bool ret = diagnostic_n_impl (&richloc, opt, n, + bool ret = diagnostic_n_impl (&richloc, NULL, opt, n, singular_gmsgid, plural_gmsgid, &ap, DK_WARNING); va_end (ap); @@ -1412,7 +1492,7 @@ pedwarn (location_t location, int opt, const char *gmsgid, ...) va_list ap; va_start (ap, gmsgid); rich_location richloc (line_table, location); - bool ret = diagnostic_impl (&richloc, opt, gmsgid, &ap, DK_PEDWARN); + bool ret = diagnostic_impl (&richloc, NULL, opt, gmsgid, &ap, DK_PEDWARN); va_end (ap); return ret; } @@ -1427,7 +1507,7 @@ pedwarn (rich_location *richloc, int opt, const char *gmsgid, ...) auto_diagnostic_group d; va_list ap; va_start (ap, gmsgid); - bool ret = diagnostic_impl (richloc, opt, gmsgid, &ap, DK_PEDWARN); + bool ret = diagnostic_impl (richloc, NULL, opt, gmsgid, &ap, DK_PEDWARN); va_end (ap); return ret; } @@ -1446,7 +1526,7 @@ permerror (location_t location, const char *gmsgid, ...) va_list ap; va_start (ap, gmsgid); rich_location richloc (line_table, location); - bool ret = diagnostic_impl (&richloc, -1, gmsgid, &ap, DK_PERMERROR); + bool ret = diagnostic_impl (&richloc, NULL, -1, gmsgid, &ap, DK_PERMERROR); va_end (ap); return ret; } @@ -1461,7 +1541,7 @@ permerror (rich_location *richloc, const char *gmsgid, ...) auto_diagnostic_group d; va_list ap; va_start (ap, gmsgid); - bool ret = diagnostic_impl (richloc, -1, gmsgid, &ap, DK_PERMERROR); + bool ret = diagnostic_impl (richloc, NULL, -1, gmsgid, &ap, DK_PERMERROR); va_end (ap); return ret; } @@ -1475,7 +1555,7 @@ error (const char *gmsgid, ...) va_list ap; va_start (ap, gmsgid); rich_location richloc (line_table, input_location); - diagnostic_impl (&richloc, -1, gmsgid, &ap, DK_ERROR); + diagnostic_impl (&richloc, NULL, -1, gmsgid, &ap, DK_ERROR); va_end (ap); } @@ -1489,7 +1569,7 @@ error_n (location_t location, unsigned HOST_WIDE_INT n, va_list ap; va_start (ap, plural_gmsgid); rich_location richloc (line_table, location); - diagnostic_n_impl (&richloc, -1, n, singular_gmsgid, plural_gmsgid, + diagnostic_n_impl (&richloc, NULL, -1, n, singular_gmsgid, plural_gmsgid, &ap, DK_ERROR); va_end (ap); } @@ -1502,7 +1582,7 @@ error_at (location_t loc, const char *gmsgid, ...) va_list ap; va_start (ap, gmsgid); rich_location richloc (line_table, loc); - diagnostic_impl (&richloc, -1, gmsgid, &ap, DK_ERROR); + diagnostic_impl (&richloc, NULL, -1, gmsgid, &ap, DK_ERROR); va_end (ap); } @@ -1516,7 +1596,7 @@ error_at (rich_location *richloc, const char *gmsgid, ...) auto_diagnostic_group d; va_list ap; va_start (ap, gmsgid); - diagnostic_impl (richloc, -1, gmsgid, &ap, DK_ERROR); + diagnostic_impl (richloc, NULL, -1, gmsgid, &ap, DK_ERROR); va_end (ap); } @@ -1530,7 +1610,7 @@ sorry (const char *gmsgid, ...) va_list ap; va_start (ap, gmsgid); rich_location richloc (line_table, input_location); - diagnostic_impl (&richloc, -1, gmsgid, &ap, DK_SORRY); + diagnostic_impl (&richloc, NULL, -1, gmsgid, &ap, DK_SORRY); va_end (ap); } @@ -1542,7 +1622,7 @@ sorry_at (location_t loc, const char *gmsgid, ...) va_list ap; va_start (ap, gmsgid); rich_location richloc (line_table, loc); - diagnostic_impl (&richloc, -1, gmsgid, &ap, DK_SORRY); + diagnostic_impl (&richloc, NULL, -1, gmsgid, &ap, DK_SORRY); va_end (ap); } @@ -1564,7 +1644,7 @@ fatal_error (location_t loc, const char *gmsgid, ...) va_list ap; va_start (ap, gmsgid); rich_location richloc (line_table, loc); - diagnostic_impl (&richloc, -1, gmsgid, &ap, DK_FATAL); + diagnostic_impl (&richloc, NULL, -1, gmsgid, &ap, DK_FATAL); va_end (ap); gcc_unreachable (); @@ -1581,7 +1661,7 @@ internal_error (const char *gmsgid, ...) va_list ap; va_start (ap, gmsgid); rich_location richloc (line_table, input_location); - diagnostic_impl (&richloc, -1, gmsgid, &ap, DK_ICE); + diagnostic_impl (&richloc, NULL, -1, gmsgid, &ap, DK_ICE); va_end (ap); gcc_unreachable (); @@ -1597,7 +1677,7 @@ internal_error_no_backtrace (const char *gmsgid, ...) va_list ap; va_start (ap, gmsgid); rich_location richloc (line_table, input_location); - diagnostic_impl (&richloc, -1, gmsgid, &ap, DK_ICE_NOBT); + diagnostic_impl (&richloc, NULL, -1, gmsgid, &ap, DK_ICE_NOBT); va_end (ap); gcc_unreachable (); diff --git a/gcc/diagnostic.h b/gcc/diagnostic.h index 91e4c50..3a49c99 100644 --- a/gcc/diagnostic.h +++ b/gcc/diagnostic.h @@ -46,6 +46,10 @@ struct diagnostic_info /* The location at which the diagnostic is to be reported. */ rich_location *richloc; + /* An optional bundle of metadata associated with the diagnostic + (or NULL). */ + const diagnostic_metadata *metadata; + /* Auxiliary data for client. */ void *x_data; /* The kind of diagnostic it is about. */ @@ -126,6 +130,10 @@ struct diagnostic_context /* Character used for caret diagnostics. */ char caret_chars[rich_location::STATICALLY_ALLOCATED_RANGES]; + /* True if we should print any CWE identifiers associated with + diagnostics. */ + bool show_cwe; + /* True if we should print the command line option which controls each diagnostic, if known. */ bool show_option_requested; diff --git a/gcc/doc/extend.texi b/gcc/doc/extend.texi index b487e03..e6aefd1 100644 --- a/gcc/doc/extend.texi +++ b/gcc/doc/extend.texi @@ -2489,10 +2489,10 @@ The following attributes are supported on most targets. @itemx access (@var{access-mode}, @var{ref-index}, @var{size-index}) The @code{access} attribute enables the detection of invalid or unsafe -accesses by functions to which they apply to or their callers, as well -as write-only accesses to objects that are never read from. Such accesses +accesses by functions to which they apply or their callers, as well as +write-only accesses to objects that are never read from. Such accesses may be diagnosed by warnings such as @option{-Wstringop-overflow}, -@option{-Wunnitialized}, @option{-Wunused}, and others. +@option{-Wuninitialized}, @option{-Wunused}, and others. The @code{access} attribute specifies that a function to whose by-reference arguments the attribute applies accesses the referenced object according to @@ -2501,13 +2501,13 @@ one of three names: @code{read_only}, @code{read_write}, or @code{write_only}. The remaining two are positional arguments. The required @var{ref-index} positional argument denotes a function -argument of pointer (or in C++, refeference) type that is subject to +argument of pointer (or in C++, reference) type that is subject to the access. The same pointer argument can be referenced by at most one distinct @code{access} attribute. The optional @var{size-index} positional argument denotes a function argument of integer type that specifies the maximum size of the access. -The size is the number of elements of the type refefenced by @var{ref-index}, +The size is the number of elements of the type referenced by @var{ref-index}, or the number of bytes when the pointer type is @code{void*}. When no @var{size-index} argument is specified, the pointer argument must be either null or point to a space that is suitably aligned and large for at least one @@ -2520,10 +2520,10 @@ applies is used to read the referenced object but not write to it. Unless the argument specifying the size of the access denoted by @var{size-index} is zero, the referenced object must be initialized. The mode implies a stronger guarantee than the @code{const} qualifier which, when cast away -from a pointer, does not prevent a function from modifying the pointed-to -object. Examples of the use of the @code{read_only} access mode is -the argument to the @code{puts} function, or the second and third arguments -to the @code{memcpy} function. +from a pointer, does not prevent the pointed-to object from being modified. +Examples of the use of the @code{read_only} access mode is the argument to +the @code{puts} function, or the second and third arguments to +the @code{memcpy} function. @smallexample __attribute__ ((access (read_only))) int puts (const char*); @@ -2534,7 +2534,7 @@ The @code{read_write} access mode applies to arguments of pointer types without the @code{const} qualifier. It specifies that the pointer to which it applies is used to both read and write the referenced object. Unless the argument specifying the size of the access denoted by @var{size-index} -is zero, the object refrenced by the pointer must be initialized. An example +is zero, the object referenced by the pointer must be initialized. An example of the use of the @code{read_write} access mode is the first argument to the @code{strcat} function. diff --git a/gcc/doc/install.texi b/gcc/doc/install.texi index 19d649c..656410a 100644 --- a/gcc/doc/install.texi +++ b/gcc/doc/install.texi @@ -4330,10 +4330,24 @@ The moxie processor. <hr /> @end html @anchor{msp430-x-elf} -@heading msp430-*-elf +@heading msp430-*-elf* TI MSP430 processor. This configuration is intended for embedded systems. +@samp{msp430-*-elf} is the standard configuration with most GCC +features enabled by default. + +@samp{msp430-*-elfbare} is tuned for a bare-metal environment, and disables +features related to shared libraries and other functionality not used for +this device. This reduces code and data usage of the GCC libraries, resulting +in a minimal run-time environment by default. + +Features disabled by default include: +@itemize +@item transactional memory +@item __cxa_atexit +@end itemize + @html <hr /> @end html diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index 519bd7a..8c3446e 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -233,10 +233,10 @@ in the following sections. -Wabi=@var{n} -Wabi-tag -Wcomma-subscript -Wconversion-null @gol -Wctor-dtor-privacy @gol -Wdelete-non-virtual-dtor -Wdeprecated-copy -Wdeprecated-copy-dtor @gol --Wliteral-suffix @gol +-Wliteral-suffix -Wmismatched-tags @gol -Wmultiple-inheritance -Wno-init-list-lifetime @gol -Wnamespaces -Wnarrowing @gol --Wpessimizing-move -Wredundant-move @gol +-Wpessimizing-move -Wredundant-move -Wredundant-tags @gol -Wnoexcept -Wnoexcept-type -Wclass-memaccess @gol -Wnon-virtual-dtor -Wreorder -Wregister @gol -Weffc++ -Wstrict-null-sentinel -Wtemplates @gol @@ -277,6 +277,7 @@ Objective-C and Objective-C++ Dialects}. -fdiagnostics-format=@r{[}text@r{|}json@r{]} @gol -fno-diagnostics-show-option -fno-diagnostics-show-caret @gol -fno-diagnostics-show-labels -fno-diagnostics-show-line-numbers @gol +-fno-diagnostics-show-cwe @gol -fdiagnostics-minimum-margin-width=@var{width} @gol -fdiagnostics-parseable-fixits -fdiagnostics-generate-patch @gol -fdiagnostics-show-template-tree -fno-elide-type @gol @@ -3323,6 +3324,21 @@ treats the return value as if it were designated by an rvalue. This warning is enabled by @option{-Wextra}. +@item -Wredundant-tags @r{(C++ and Objective-C++ only)} +@opindex Wredundant-tags +@opindex Wno-redundant-tags +Warn about redundant class-key and enum-key in references to class types +and enumerated types in contexts where the key can be eliminated without +causing an ambiguity. For example + +@smallexample +struct foo; +struct foo *p; // -Wredundant-tags, keyword struct can be eliminated + +void foo (); // "hides" struct foo +void bar (struct foo&); // no warning, keyword struct cannot be eliminated +@end smallexample + @item -fext-numeric-literals @r{(C++ and Objective-C++ only)} @opindex fext-numeric-literals @opindex fno-ext-numeric-literals @@ -3458,6 +3474,32 @@ The warning is inactive inside a system header file, such as the STL, so one can still use the STL. One may also instantiate or specialize templates. +@item -Wmismatched-tags @r{(C++ and Objective-C++ only)} +@opindex Wmismatched-tags +@opindex Wno-mismatched-tags +Warn for declarations of structs, classes, and class templates and their +specializations with a class-key that does not match either the definition +or the first declaration if no definition is provided. + +For example, the declaration of @code{struct Object} in the argument list +of @code{draw} triggers the warning. To avoid it, either remove the redundant +class-key @code{struct} or replace it with @code{class} to match its definition. +@smallexample +class Object @{ +public: + virtual ~Object () = 0; +@}; +void draw (struct Object*); +@end smallexample + +It is not wrong to declare a class with the class-key @code{struct} as +the example above shows. The @option{-Wmismatched-tags} option is intended +to help achieve a consistent style of class declarations. In code that is +intended to be portable to Windows-based compilers the warning helps prevent +unresolved references due to the difference in the mangling of symbols +declared with different class-keys. The option can be used either on its +own or in conjunction with @option{-Wredundant-tags}. + @item -Wmultiple-inheritance @r{(C++ and Objective-C++ only)} @opindex Wmultiple-inheritance @opindex Wno-multiple-inheritance @@ -3964,6 +4006,15 @@ as the types of expressions: This option suppresses the printing of these labels (in the example above, the vertical bars and the ``char *'' and ``long int'' text). +@item -fno-diagnostics-show-cwe +@opindex fno-diagnostics-show-cwe +@opindex fdiagnostics-show-cwe +Diagnostic messages can optionally have an associated +@url{https://cwe.mitre.org/index.html, CWE} identifier. +GCC itself does not do this for any of its diagnostics, but plugins may do so. +By default, if this information is present, it will be printed with +the diagnostic. This option suppresses the printing of this metadata. + @item -fno-diagnostics-show-line-numbers @opindex fno-diagnostics-show-line-numbers @opindex fdiagnostics-show-line-numbers @@ -18227,8 +18278,7 @@ provided for use in debugging the compiler. Do not allow constant data to be placed in code sections. Additionally, when compiling for ELF object format give all text sections the ELF processor-specific section attribute @code{SHF_ARM_PURECODE}. This option -is only available when generating non-pic code for M-profile targets with the -MOVT instruction. +is only available when generating non-pic code for M-profile targets. @item -mcmse @opindex mcmse @@ -23311,8 +23361,8 @@ this directory for devices.csv. If devices.csv is found, this directory will also be registered as an include path, and linker library path. Header files and linker scripts in this directory can therefore be used without manually specifying @code{-I} and @code{-L} on the command line. -@item The @samp{msp430-elf/include/devices} directory -Finally, GCC will examine @samp{msp430-elf/include/devices} from the +@item The @samp{msp430-elf@{,bare@}/include/devices} directory +Finally, GCC will examine @samp{msp430-elf@{,bare@}/include/devices} from the toolchain root directory. This directory does not exist in a default installation, but if the user has created it and copied @samp{devices.csv} there, then the MCU data will be read. As above, this directory will @@ -27767,35 +27817,38 @@ instruction set extensions.) CPUs based on AMD Family 15h cores with x86-64 instruction set support. (This supersets FMA4, AVX, XOP, LWP, AES, PCLMUL, CX16, MMX, SSE, SSE2, SSE3, SSE4A, SSSE3, SSE4.1, SSE4.2, ABM and 64-bit instruction set extensions.) + @item bdver2 AMD Family 15h core based CPUs with x86-64 instruction set support. (This supersets BMI, TBM, F16C, FMA, FMA4, AVX, XOP, LWP, AES, PCLMUL, CX16, MMX, SSE, SSE2, SSE3, SSE4A, SSSE3, SSE4.1, SSE4.2, ABM and 64-bit instruction set extensions.) + @item bdver3 AMD Family 15h core based CPUs with x86-64 instruction set support. (This supersets BMI, TBM, F16C, FMA, FMA4, FSGSBASE, AVX, XOP, LWP, AES, PCLMUL, CX16, MMX, SSE, SSE2, SSE3, SSE4A, SSSE3, SSE4.1, SSE4.2, ABM and -64-bit instruction set extensions. +64-bit instruction set extensions.) + @item bdver4 AMD Family 15h core based CPUs with x86-64 instruction set support. (This supersets BMI, BMI2, TBM, F16C, FMA, FMA4, FSGSBASE, AVX, AVX2, XOP, LWP, AES, PCLMUL, CX16, MOVBE, MMX, SSE, SSE2, SSE3, SSE4A, SSSE3, SSE4.1, -SSE4.2, ABM and 64-bit instruction set extensions. +SSE4.2, ABM and 64-bit instruction set extensions.) @item znver1 AMD Family 17h core based CPUs with x86-64 instruction set support. (This supersets BMI, BMI2, F16C, FMA, FSGSBASE, AVX, AVX2, ADCX, RDSEED, MWAITX, SHA, CLZERO, AES, PCLMUL, CX16, MOVBE, MMX, SSE, SSE2, SSE3, SSE4A, SSSE3, SSE4.1, SSE4.2, ABM, XSAVEC, XSAVES, CLFLUSHOPT, POPCNT, and 64-bit -instruction set extensions. +instruction set extensions.) + @item znver2 AMD Family 17h core based CPUs with x86-64 instruction set support. (This -supersets BMI, BMI2, ,CLWB, F16C, FMA, FSGSBASE, AVX, AVX2, ADCX, RDSEED, +supersets BMI, BMI2, CLWB, F16C, FMA, FSGSBASE, AVX, AVX2, ADCX, RDSEED, MWAITX, SHA, CLZERO, AES, PCLMUL, CX16, MOVBE, MMX, SSE, SSE2, SSE3, SSE4A, -SSSE3, SSE4.1, SSE4.2, ABM, XSAVEC, XSAVES, CLFLUSHOPT, POPCNT, and 64-bit -instruction set extensions.) - +SSSE3, SSE4.1, SSE4.2, ABM, XSAVEC, XSAVES, CLFLUSHOPT, POPCNT, RDPID, +WBNOINVD, and 64-bit instruction set extensions.) @item btver1 CPUs based on AMD Family 14h cores with x86-64 instruction set support. (This diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index f8103bb..12465bf 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,33 @@ +2019-12-19 Jakub Jelinek <jakub@redhat.com> + + PR fortran/92977 + * frontend-passes.c (in_omp_atomic): New variable. + (cfe_expr_0, matmul_to_var_expr, matmul_temp_args, + inline_matmul_assign, call_external_blas): Don't optimize in + EXEC_OMP_ATOMIC. + (optimize_namespace): Clear in_omp_atomic. + (gfc_code_walker): Set in_omp_atomic for EXEC_OMP_ATOMIC, save/restore + it around. + +2019-12-19 Julian Brown <julian@codesourcery.com> + Maciej W. Rozycki <macro@codesourcery.com> + Tobias Burnus <tobias@codesourcery.com> + Thomas Schwinge <thomas@codesourcery.com> + + * gfortran.h (gfc_omp_map_op): Add OMP_MAP_NO_ALLOC. + * openmp.c (omp_mask2): Add OMP_CLAUSE_NO_CREATE. + (gfc_match_omp_clauses): Support no_create. + (OACC_PARALLEL_CLAUSES, OACC_KERNELS_CLAUSES) + (OACC_DATA_CLAUSES): Add OMP_CLAUSE_NO_CREATE. + * trans-openmp.c (gfc_trans_omp_clauses_1): Support + OMP_MAP_NO_ALLOC. + +2019-12-18 Harald Anlauf <anlauf@gmx.de> + + PR fortran/70853 + * trans-expr.c (gfc_trans_pointer_assignment): Reject bounds + remapping if pointer target is NULL(). + 2019-12-12 Harald Anlauf <anlauf@gmx.de> PR fortran/92898 diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index a20d9ef..5f83ad2 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -92,6 +92,10 @@ static int forall_level; static bool in_omp_workshare; +/* Keep track of whether we are within an OMP atomic. */ + +static bool in_omp_atomic; + /* Keep track of whether we are within a WHERE statement. */ static bool in_where; @@ -913,9 +917,9 @@ cfe_expr_0 (gfc_expr **e, int *walk_subtrees, gfc_expr *newvar; gfc_expr **ei, **ej; - /* Don't do this optimization within OMP workshare or ASSOC lists. */ + /* Don't do this optimization within OMP workshare/atomic or ASSOC lists. */ - if (in_omp_workshare || in_assoc_list) + if (in_omp_workshare || in_omp_atomic || in_assoc_list) { *walk_subtrees = 0; return 0; @@ -1464,6 +1468,7 @@ optimize_namespace (gfc_namespace *ns) iterator_level = 0; in_assoc_list = false; in_omp_workshare = false; + in_omp_atomic = false; if (flag_frontend_optimize) { @@ -2818,7 +2823,7 @@ matmul_to_var_expr (gfc_expr **ep, int *walk_subtrees ATTRIBUTE_UNUSED, return 0; if (forall_level > 0 || iterator_level > 0 || in_omp_workshare - || in_where || in_assoc_list) + || in_omp_atomic || in_where || in_assoc_list) return 0; /* Check if this is already in the form c = matmul(a,b). */ @@ -2880,7 +2885,7 @@ matmul_temp_args (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED, return 0; if (forall_level > 0 || iterator_level > 0 || in_omp_workshare - || in_where) + || in_omp_atomic || in_where) return 0; /* This has some duplication with inline_matmul_assign. This @@ -3848,7 +3853,7 @@ inline_matmul_assign (gfc_code **c, int *walk_subtrees, /* For now don't do anything in OpenMP workshare, it confuses its translation, which expects only the allowed statements in there. We should figure out how to parallelize this eventually. */ - if (in_omp_workshare) + if (in_omp_workshare || in_omp_atomic) return 0; expr1 = co->expr1; @@ -4385,7 +4390,7 @@ call_external_blas (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED, /* For now don't do anything in OpenMP workshare, it confuses its translation, which expects only the allowed statements in there. */ - if (in_omp_workshare) + if (in_omp_workshare | in_omp_atomic) return 0; expr1 = co->expr1; @@ -5047,6 +5052,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, gfc_code *co; gfc_association_list *alist; bool saved_in_omp_workshare; + bool saved_in_omp_atomic; bool saved_in_where; /* There might be statement insertions before the current code, @@ -5054,6 +5060,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, co = *c; saved_in_omp_workshare = in_omp_workshare; + saved_in_omp_atomic = in_omp_atomic; saved_in_where = in_where; switch (co->op) @@ -5251,6 +5258,10 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, WALK_SUBEXPR (co->ext.dt->extra_comma); break; + case EXEC_OMP_ATOMIC: + in_omp_atomic = true; + break; + case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: @@ -5368,6 +5379,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, select_level --; in_omp_workshare = saved_in_omp_workshare; + in_omp_atomic = saved_in_omp_atomic; in_where = saved_in_where; } } diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index f4a2b99..3907d14 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1192,6 +1192,7 @@ enum gfc_omp_depend_op enum gfc_omp_map_op { OMP_MAP_ALLOC, + OMP_MAP_IF_PRESENT, OMP_MAP_TO, OMP_MAP_FROM, OMP_MAP_TOFROM, diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index dc0521b..576003d 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -807,6 +807,7 @@ enum omp_mask2 OMP_CLAUSE_COPY, OMP_CLAUSE_COPYOUT, OMP_CLAUSE_CREATE, + OMP_CLAUSE_NO_CREATE, OMP_CLAUSE_PRESENT, OMP_CLAUSE_DEVICEPTR, OMP_CLAUSE_GANG, @@ -1445,6 +1446,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, } break; case 'n': + if ((mask & OMP_CLAUSE_NO_CREATE) + && gfc_match ("no_create ( ") == MATCH_YES + && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], + OMP_MAP_IF_PRESENT, true)) + continue; if ((mask & OMP_CLAUSE_NOGROUP) && !c->nogroup && gfc_match ("nogroup") == MATCH_YES) @@ -1955,25 +1961,25 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_ASYNC | OMP_CLAUSE_NUM_GANGS \ | OMP_CLAUSE_NUM_WORKERS | OMP_CLAUSE_VECTOR_LENGTH | OMP_CLAUSE_REDUCTION \ | OMP_CLAUSE_COPY | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT \ - | OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT | OMP_CLAUSE_DEVICEPTR \ - | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULT \ - | OMP_CLAUSE_WAIT) + | OMP_CLAUSE_CREATE | OMP_CLAUSE_NO_CREATE | OMP_CLAUSE_PRESENT \ + | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \ + | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_WAIT) #define OACC_KERNELS_CLAUSES \ (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_ASYNC | OMP_CLAUSE_NUM_GANGS \ | OMP_CLAUSE_NUM_WORKERS | OMP_CLAUSE_VECTOR_LENGTH | OMP_CLAUSE_DEVICEPTR \ | OMP_CLAUSE_COPY | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT \ - | OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT | OMP_CLAUSE_DEFAULT \ - | OMP_CLAUSE_WAIT) + | OMP_CLAUSE_CREATE | OMP_CLAUSE_NO_CREATE | OMP_CLAUSE_PRESENT \ + | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_WAIT) #define OACC_SERIAL_CLAUSES \ (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_ASYNC | OMP_CLAUSE_REDUCTION \ | OMP_CLAUSE_COPY | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT \ - | OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT | OMP_CLAUSE_DEVICEPTR \ - | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULT \ - | OMP_CLAUSE_WAIT) + | OMP_CLAUSE_CREATE | OMP_CLAUSE_NO_CREATE | OMP_CLAUSE_PRESENT \ + | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \ + | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_WAIT) #define OACC_DATA_CLAUSES \ (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_COPY \ | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT | OMP_CLAUSE_CREATE \ - | OMP_CLAUSE_PRESENT) + | OMP_CLAUSE_NO_CREATE | OMP_CLAUSE_PRESENT) #define OACC_LOOP_CLAUSES \ (omp_mask (OMP_CLAUSE_COLLAPSE) | OMP_CLAUSE_GANG | OMP_CLAUSE_WORKER \ | OMP_CLAUSE_VECTOR | OMP_CLAUSE_SEQ | OMP_CLAUSE_INDEPENDENT \ @@ -2509,7 +2515,7 @@ cleanup: #define OMP_TASKLOOP_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF \ - | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL \ + | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL \ | OMP_CLAUSE_MERGEABLE | OMP_CLAUSE_PRIORITY | OMP_CLAUSE_GRAINSIZE \ | OMP_CLAUSE_NUM_TASKS | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_NOGROUP) #define OMP_TARGET_CLAUSES \ @@ -2531,7 +2537,7 @@ cleanup: | OMP_CLAUSE_FROM | OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOWAIT) #define OMP_TEAMS_CLAUSES \ (omp_mask (OMP_CLAUSE_NUM_TEAMS) | OMP_CLAUSE_THREAD_LIMIT \ - | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \ + | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_SHARED | OMP_CLAUSE_REDUCTION) #define OMP_DISTRIBUTE_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index fe89c7b..eb3250a 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -9218,6 +9218,13 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) break; rank_remap = (remap && remap->u.ar.end[0]); + if (remap && expr2->expr_type == EXPR_NULL) + { + gfc_error ("If bounds remapping is specified at %L, " + "the pointer target shall not be NULL", &expr1->where); + return NULL_TREE; + } + gfc_init_se (&lse, NULL); if (remap) lse.descriptor_only = 1; diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index b6da7b9..7153491 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -2624,6 +2624,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, case OMP_MAP_ALLOC: OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALLOC); break; + case OMP_MAP_IF_PRESENT: + OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_IF_PRESENT); + break; case OMP_MAP_TO: OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_TO); break; diff --git a/gcc/gimplify.c b/gcc/gimplify.c index 9073680..60a80cb 100644 --- a/gcc/gimplify.c +++ b/gcc/gimplify.c @@ -12738,27 +12738,30 @@ gimplify_omp_target_update (tree *expr_p, gimple_seq *pre_p) && omp_find_clause (OMP_STANDALONE_CLAUSES (expr), OMP_CLAUSE_FINALIZE)) { - /* Use GOMP_MAP_DELETE/GOMP_MAP_FORCE_FROM to denote that "finalize" - semantics apply to all mappings of this OpenACC directive. */ - bool finalize_marked = false; + /* Use GOMP_MAP_DELETE/GOMP_MAP_FORCE_FROM to denote "finalize" + semantics. */ + bool have_clause = false; for (tree c = OMP_STANDALONE_CLAUSES (expr); c; c = OMP_CLAUSE_CHAIN (c)) if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP) switch (OMP_CLAUSE_MAP_KIND (c)) { case GOMP_MAP_FROM: OMP_CLAUSE_SET_MAP_KIND (c, GOMP_MAP_FORCE_FROM); - finalize_marked = true; + have_clause = true; break; case GOMP_MAP_RELEASE: OMP_CLAUSE_SET_MAP_KIND (c, GOMP_MAP_DELETE); - finalize_marked = true; + have_clause = true; break; - default: - /* Check consistency: libgomp relies on the very first data - mapping clause being marked, so make sure we did that before - any other mapping clauses. */ - gcc_assert (finalize_marked); + case GOMP_MAP_POINTER: + case GOMP_MAP_TO_PSET: + /* TODO PR92929: we may see these here, but they'll always follow + one of the clauses above, and will be handled by libgomp as + one group, so no handling required here. */ + gcc_assert (have_clause); break; + default: + gcc_unreachable (); } } stmt = gimple_build_omp_target (NULL, kind, OMP_STANDALONE_CLAUSES (expr)); diff --git a/gcc/ipa-cp.c b/gcc/ipa-cp.c index 1a80ccb..126d154 100644 --- a/gcc/ipa-cp.c +++ b/gcc/ipa-cp.c @@ -4564,6 +4564,25 @@ self_recursive_pass_through_p (cgraph_edge *cs, ipa_jump_func *jfunc, int i) return false; } +/* Return true, if JFUNC, which describes a part of an aggregate represented + or pointed to by the i-th parameter of call CS, is a simple no-operation + pass-through function to itself. */ + +static bool +self_recursive_agg_pass_through_p (cgraph_edge *cs, ipa_agg_jf_item *jfunc, + int i) +{ + enum availability availability; + if (cs->caller == cs->callee->function_symbol (&availability) + && availability > AVAIL_INTERPOSABLE + && jfunc->jftype == IPA_JF_LOAD_AGG + && jfunc->offset == jfunc->value.load_agg.offset + && jfunc->value.pass_through.operation == NOP_EXPR + && jfunc->value.pass_through.formal_id == i) + return true; + return false; +} + /* Given a NODE, and a subset of its CALLERS, try to populate blanks slots in KNOWN_CSTS with constants that are also known for all of the CALLERS. */ @@ -4756,10 +4775,19 @@ intersect_with_plats (class ipcp_param_lattices *plats, if (aglat->offset - offset == item->offset) { gcc_checking_assert (item->value); - if (aglat->is_single_const () - && values_equal_for_ipcp_p (item->value, - aglat->values->value)) - found = true; + if (aglat->is_single_const ()) + { + tree value = aglat->values->value; + + if (values_equal_for_ipcp_p (item->value, value)) + found = true; + else if (item->value == error_mark_node) + { + /* Replace unknown place holder value with real one. */ + item->value = value; + found = true; + } + } break; } aglat = aglat->next; @@ -4827,6 +4855,12 @@ intersect_with_agg_replacements (struct cgraph_node *node, int index, { if (values_equal_for_ipcp_p (item->value, av->value)) found = true; + else if (item->value == error_mark_node) + { + /* Replace place holder value with real one. */ + item->value = av->value; + found = true; + } break; } } @@ -4931,17 +4965,31 @@ intersect_aggregates_with_edge (struct cgraph_edge *cs, int index, for (unsigned i = 0; i < jfunc->agg.items->length (); i++) { struct ipa_agg_jf_item *agg_item = &(*jfunc->agg.items)[i]; - tree value = ipa_agg_value_from_node (caller_info, cs->caller, - agg_item); - if (value) + struct ipa_agg_value agg_value; + + if (self_recursive_agg_pass_through_p (cs, agg_item, index)) { - struct ipa_agg_value agg_value; + /* For a self-recursive call, if aggregate jump function is a + simple pass-through, the exact value that it stands for is + not known at this point, which must comes from other call + sites. But we still need to add a place holder in value + sets to indicate it, here we use error_mark_node to + represent the special unknown value, which will be replaced + with real one during later intersecting operations. */ + agg_value.value = error_mark_node; + } + else + { + tree value = ipa_agg_value_from_node (caller_info, cs->caller, + agg_item); + if (!value) + continue; - agg_value.offset = agg_item->offset; agg_value.value = value; - - inter.safe_push (agg_value); } + + agg_value.offset = agg_item->offset; + inter.safe_push (agg_value); } else FOR_EACH_VEC_ELT (inter, k, item) @@ -4960,11 +5008,27 @@ intersect_aggregates_with_edge (struct cgraph_edge *cs, int index, break; if (ti->offset == item->offset) { - tree value = ipa_agg_value_from_node (caller_info, - cs->caller, ti); - if (value - && values_equal_for_ipcp_p (item->value, value)) - found = true; + tree value; + + if (self_recursive_agg_pass_through_p (cs, ti, index)) + { + /* A simple aggregate pass-through in self-recursive + call should lead to same value. */ + found = true; + } + else if ((value = ipa_agg_value_from_node (caller_info, + cs->caller, ti))) + { + if (values_equal_for_ipcp_p (item->value, value)) + found = true; + else if (item->value == error_mark_node) + { + /* Replace unknown place holder value with real + one. */ + item->value = value; + found = true; + } + } break; } l++; @@ -5040,6 +5104,9 @@ find_aggregate_values_for_callers_subset (struct cgraph_node *node, if (!item->value) continue; + /* All values must be real values, not unknown place holders. */ + gcc_assert (item->value != error_mark_node); + v = ggc_alloc<ipa_agg_replacement_value> (); v->index = i; v->offset = item->offset; @@ -5117,7 +5184,6 @@ cgraph_edge_brings_all_agg_vals_for_node (struct cgraph_edge *cs, for (i = 0; i < count; i++) { - static vec<ipa_agg_value> values = vNULL; class ipcp_param_lattices *plats; bool interesting = false; for (struct ipa_agg_replacement_value *av = aggval; av; av = av->next) @@ -5133,7 +5199,7 @@ cgraph_edge_brings_all_agg_vals_for_node (struct cgraph_edge *cs, if (plats->aggs_bottom) return false; - values = intersect_aggregates_with_edge (cs, i, values); + vec<ipa_agg_value> values = intersect_aggregates_with_edge (cs, i, vNULL); if (!values.exists ()) return false; @@ -5157,6 +5223,7 @@ cgraph_edge_brings_all_agg_vals_for_node (struct cgraph_edge *cs, return false; } } + values.release (); } return true; } diff --git a/gcc/ipa-fnsummary.c b/gcc/ipa-fnsummary.c index a46b144..a54703f 100644 --- a/gcc/ipa-fnsummary.c +++ b/gcc/ipa-fnsummary.c @@ -4364,24 +4364,24 @@ static void ipa_fn_summary_write (void) { struct output_block *ob = create_output_block (LTO_section_ipa_fn_summary); + lto_symtab_encoder_iterator lsei; lto_symtab_encoder_t encoder = ob->decl_state->symtab_node_encoder; unsigned int count = 0; - int i; - for (i = 0; i < lto_symtab_encoder_size (encoder); i++) + for (lsei = lsei_start_function_in_partition (encoder); !lsei_end_p (lsei); + lsei_next_function_in_partition (&lsei)) { - symtab_node *snode = lto_symtab_encoder_deref (encoder, i); - cgraph_node *cnode = dyn_cast <cgraph_node *> (snode); - if (cnode && cnode->definition && !cnode->alias) + cgraph_node *cnode = lsei_cgraph_node (lsei); + if (cnode->definition && !cnode->alias) count++; } streamer_write_uhwi (ob, count); - for (i = 0; i < lto_symtab_encoder_size (encoder); i++) + for (lsei = lsei_start_function_in_partition (encoder); !lsei_end_p (lsei); + lsei_next_function_in_partition (&lsei)) { - symtab_node *snode = lto_symtab_encoder_deref (encoder, i); - cgraph_node *cnode = dyn_cast <cgraph_node *> (snode); - if (cnode && cnode->definition && !cnode->alias) + cgraph_node *cnode = lsei_cgraph_node (lsei); + if (cnode->definition && !cnode->alias) { class ipa_fn_summary *info = ipa_fn_summaries->get (cnode); class ipa_size_summary *size_info = ipa_size_summaries->get (cnode); diff --git a/gcc/ipa-param-manipulation.c b/gcc/ipa-param-manipulation.c index 28ac2b8..b756b5d 100644 --- a/gcc/ipa-param-manipulation.c +++ b/gcc/ipa-param-manipulation.c @@ -324,6 +324,18 @@ ipa_param_adjustments::get_updated_indices (vec<int> *new_indices) } } +/* Return the original index for the given new parameter index. Return a + negative number if not available. */ + +int +ipa_param_adjustments::get_original_index (int newidx) +{ + const ipa_adjusted_param *adj = &(*m_adj_params)[newidx]; + if (adj->op != IPA_PARAM_OP_COPY) + return -1; + return adj->base_index; +} + /* Return true if the first parameter (assuming there was one) survives the transformation intact and remains the first one. */ diff --git a/gcc/ipa-param-manipulation.h b/gcc/ipa-param-manipulation.h index 8e95545..5d7278e 100644 --- a/gcc/ipa-param-manipulation.h +++ b/gcc/ipa-param-manipulation.h @@ -258,6 +258,9 @@ public: void get_surviving_params (vec<bool> *surviving_params); /* Fill a vector with new indices of surviving original parameters. */ void get_updated_indices (vec<int> *new_indices); + /* Return the original index for the given new parameter index. Return a + negative number if not available. */ + int get_original_index (int newidx); void dump (FILE *f); void debug (); diff --git a/gcc/ipa-prop.c b/gcc/ipa-prop.c index 1a59c35..c9c6a82 100644 --- a/gcc/ipa-prop.c +++ b/gcc/ipa-prop.c @@ -5480,6 +5480,43 @@ ipcp_modif_dom_walker::before_dom_children (basic_block bb) return NULL; } +/* Return true if we have recorded VALUE and MASK about PARM. + Set VALUE and MASk accordingly. */ + +bool +ipcp_get_parm_bits (tree parm, tree *value, widest_int *mask) +{ + cgraph_node *cnode = cgraph_node::get (current_function_decl); + ipcp_transformation *ts = ipcp_get_transformation_summary (cnode); + if (!ts || vec_safe_length (ts->bits) == 0) + return false; + + int i = 0; + for (tree p = DECL_ARGUMENTS (current_function_decl); + p != parm; p = DECL_CHAIN (p)) + { + i++; + /* Ignore static chain. */ + if (!p) + return false; + } + + if (cnode->clone.param_adjustments) + { + i = cnode->clone.param_adjustments->get_original_index (i); + if (i < 0) + return false; + } + + vec<ipa_bits *, va_gc> &bits = *ts->bits; + if (!bits[i]) + return false; + *mask = bits[i]->mask; + *value = wide_int_to_tree (TREE_TYPE (parm), bits[i]->value); + return true; +} + + /* Update bits info of formal parameters as described in ipcp_transformation. */ diff --git a/gcc/ipa-prop.h b/gcc/ipa-prop.h index 1958e1e..4ce367a 100644 --- a/gcc/ipa-prop.h +++ b/gcc/ipa-prop.h @@ -1041,6 +1041,7 @@ ipa_agg_value_set ipa_agg_value_set_from_jfunc (ipa_node_params *, void ipa_dump_param (FILE *, class ipa_node_params *info, int i); void ipa_release_body_info (struct ipa_func_body_info *); tree ipa_get_callee_param_type (struct cgraph_edge *e, int i); +bool ipcp_get_parm_bits (tree, tree *, widest_int *); /* From tree-sra.c: */ tree build_ref_for_offset (location_t, tree, poly_int64, bool, tree, diff --git a/gcc/ipa-pure-const.c b/gcc/ipa-pure-const.c index a142e0c..58ab668 100644 --- a/gcc/ipa-pure-const.c +++ b/gcc/ipa-pure-const.c @@ -511,35 +511,34 @@ worse_state (enum pure_const_state_e *state, bool *looping, but function using them is. */ static bool special_builtin_state (enum pure_const_state_e *state, bool *looping, - tree callee) + tree callee) { if (DECL_BUILT_IN_CLASS (callee) == BUILT_IN_NORMAL) switch (DECL_FUNCTION_CODE (callee)) { - case BUILT_IN_RETURN: - case BUILT_IN_UNREACHABLE: - CASE_BUILT_IN_ALLOCA: - case BUILT_IN_STACK_SAVE: - case BUILT_IN_STACK_RESTORE: - case BUILT_IN_EH_POINTER: - case BUILT_IN_EH_FILTER: - case BUILT_IN_UNWIND_RESUME: - case BUILT_IN_CXA_END_CLEANUP: - case BUILT_IN_EH_COPY_VALUES: - case BUILT_IN_FRAME_ADDRESS: - case BUILT_IN_APPLY: - case BUILT_IN_APPLY_ARGS: - case BUILT_IN_ASAN_BEFORE_DYNAMIC_INIT: - case BUILT_IN_ASAN_AFTER_DYNAMIC_INIT: - *looping = false; - *state = IPA_CONST; - return true; - case BUILT_IN_PREFETCH: - *looping = true; - *state = IPA_CONST; - return true; - default: - break; + case BUILT_IN_RETURN: + case BUILT_IN_UNREACHABLE: + CASE_BUILT_IN_ALLOCA: + case BUILT_IN_STACK_SAVE: + case BUILT_IN_STACK_RESTORE: + case BUILT_IN_EH_POINTER: + case BUILT_IN_EH_FILTER: + case BUILT_IN_UNWIND_RESUME: + case BUILT_IN_CXA_END_CLEANUP: + case BUILT_IN_EH_COPY_VALUES: + case BUILT_IN_FRAME_ADDRESS: + case BUILT_IN_APPLY_ARGS: + case BUILT_IN_ASAN_BEFORE_DYNAMIC_INIT: + case BUILT_IN_ASAN_AFTER_DYNAMIC_INIT: + *looping = false; + *state = IPA_CONST; + return true; + case BUILT_IN_PREFETCH: + *looping = true; + *state = IPA_CONST; + return true; + default: + break; } return false; } @@ -624,9 +623,10 @@ check_call (funct_state local, gcall *call, bool ipa) case BUILT_IN_LONGJMP: case BUILT_IN_NONLOCAL_GOTO: if (dump_file) - fprintf (dump_file, " longjmp and nonlocal goto is not const/pure\n"); + fprintf (dump_file, + " longjmp and nonlocal goto is not const/pure\n"); local->pure_const_state = IPA_NEITHER; - local->looping = true; + local->looping = true; break; default: break; @@ -1532,7 +1532,7 @@ propagate_pure_const (void) } } else if (special_builtin_state (&edge_state, &edge_looping, - y->decl)) + y->decl)) ; else state_from_flags (&edge_state, &edge_looping, @@ -5192,8 +5192,6 @@ ira (FILE *f) int ira_max_point_before_emit; bool saved_flag_caller_saves = flag_caller_saves; enum ira_region saved_flag_ira_region = flag_ira_region; - unsigned int i; - int num_used_regs = 0; clear_bb_flags (); @@ -5207,18 +5205,28 @@ ira (FILE *f) /* Perform target specific PIC register initialization. */ targetm.init_pic_reg (); - ira_conflicts_p = optimize > 0; - - /* Determine the number of pseudos actually requiring coloring. */ - for (i = FIRST_PSEUDO_REGISTER; i < DF_REG_SIZE (df); i++) - num_used_regs += !!(DF_REG_USE_COUNT (i) + DF_REG_DEF_COUNT (i)); - - /* If there are too many pseudos and/or basic blocks (e.g. 10K - pseudos and 10K blocks or 100K pseudos and 1K blocks), we will - use simplified and faster algorithms in LRA. */ - lra_simple_p - = (ira_use_lra_p - && num_used_regs >= (1 << 26) / last_basic_block_for_fn (cfun)); + if (optimize) + { + ira_conflicts_p = true; + + /* Determine the number of pseudos actually requiring coloring. */ + unsigned int num_used_regs = 0; + for (unsigned int i = FIRST_PSEUDO_REGISTER; i < DF_REG_SIZE (df); i++) + if (DF_REG_DEF_COUNT (i) || DF_REG_USE_COUNT (i)) + num_used_regs++; + + /* If there are too many pseudos and/or basic blocks (e.g. 10K + pseudos and 10K blocks or 100K pseudos and 1K blocks), we will + use simplified and faster algorithms in LRA. */ + lra_simple_p + = ira_use_lra_p + && num_used_regs >= (1U << 26) / last_basic_block_for_fn (cfun); + } + else + { + ira_conflicts_p = false; + lra_simple_p = ira_use_lra_p; + } if (lra_simple_p) { diff --git a/gcc/lto-streamer-in.c b/gcc/lto-streamer-in.c index 675e1a7..f49f38d 100644 --- a/gcc/lto-streamer-in.c +++ b/gcc/lto-streamer-in.c @@ -1698,7 +1698,31 @@ lto_input_mode_table (struct lto_file_decl_data *file_data) } /* FALLTHRU */ default: - fatal_error (UNKNOWN_LOCATION, "unsupported mode %qs", mname); + /* This is only used for offloading-target compilations and + is a user-facing error. Give a better error message for + the common modes; see also mode-classes.def. */ + if (mclass == MODE_FLOAT) + fatal_error (UNKNOWN_LOCATION, + "%s - %u-bit-precision floating-point numbers " + "unsupported (mode %qs)", TARGET_MACHINE, + prec.to_constant (), mname); + else if (mclass == MODE_DECIMAL_FLOAT) + fatal_error (UNKNOWN_LOCATION, + "%s - %u-bit-precision decimal floating-point " + "numbers unsupported (mode %qs)", TARGET_MACHINE, + prec.to_constant (), mname); + else if (mclass == MODE_COMPLEX_FLOAT) + fatal_error (UNKNOWN_LOCATION, + "%s - %u-bit-precision complex floating-point " + "numbers unsupported (mode %qs)", TARGET_MACHINE, + prec.to_constant (), mname); + else if (mclass == MODE_INT) + fatal_error (UNKNOWN_LOCATION, + "%s - %u-bit integer numbers unsupported (mode " + "%qs)", TARGET_MACHINE, prec.to_constant (), mname); + else + fatal_error (UNKNOWN_LOCATION, "%s - unsupported mode %qs", + TARGET_MACHINE, mname); break; } } diff --git a/gcc/lto-wrapper.c b/gcc/lto-wrapper.c index 9a7bbd0..9ee1d93 100644 --- a/gcc/lto-wrapper.c +++ b/gcc/lto-wrapper.c @@ -408,7 +408,7 @@ merge_and_complain (struct cl_decoded_option **decoded_options, /* Merge PIC options: -fPIC + -fpic = -fpic -fPIC + -fno-pic = -fno-pic - -fpic/-fPIC + nothin = nothing. + -fpic/-fPIC + nothing = nothing. It is a common mistake to mix few -fPIC compiled objects into otherwise non-PIC code. We do not want to build everything with PIC then. @@ -438,9 +438,10 @@ merge_and_complain (struct cl_decoded_option **decoded_options, && pie_option->opt_index == OPT_fPIE; (*decoded_options)[j].opt_index = big ? OPT_fPIE : OPT_fpie; if (pie_option->value) - (*decoded_options)[j].canonical_option[0] = big ? "-fPIE" : "-fpie"; + (*decoded_options)[j].canonical_option[0] + = big ? "-fPIE" : "-fpie"; else - (*decoded_options)[j].canonical_option[0] = big ? "-fno-pie" : "-fno-pie"; + (*decoded_options)[j].canonical_option[0] = "-fno-pie"; (*decoded_options)[j].value = pie_option->value; j++; } @@ -482,7 +483,7 @@ merge_and_complain (struct cl_decoded_option **decoded_options, { (*decoded_options)[j].opt_index = OPT_fpie; (*decoded_options)[j].canonical_option[0] - = pic_option->value ? "-fpie" : "-fno-pie"; + = pic_option->value ? "-fpie" : "-fno-pie"; } else if (!pic_option->value) (*decoded_options)[j].canonical_option[0] = "-fno-pie"; diff --git a/gcc/omp-low.c b/gcc/omp-low.c index d422c20..deed83b 100644 --- a/gcc/omp-low.c +++ b/gcc/omp-low.c @@ -11431,6 +11431,7 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) case GOMP_MAP_STRUCT: case GOMP_MAP_ALWAYS_POINTER: break; + case GOMP_MAP_IF_PRESENT: case GOMP_MAP_FORCE_ALLOC: case GOMP_MAP_FORCE_TO: case GOMP_MAP_FORCE_FROM: @@ -11842,6 +11843,7 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) switch (tkind) { case GOMP_MAP_ALLOC: + case GOMP_MAP_IF_PRESENT: case GOMP_MAP_TO: case GOMP_MAP_FROM: case GOMP_MAP_TOFROM: @@ -2407,6 +2407,10 @@ common_handle_option (struct gcc_options *opts, dc->parseable_fixits_p = value; break; + case OPT_fdiagnostics_show_cwe: + dc->show_cwe = value; + break; + case OPT_fdiagnostics_show_option: dc->show_option_requested = value; break; diff --git a/gcc/pretty-print.c b/gcc/pretty-print.c index 084e03c..2ecb034 100644 --- a/gcc/pretty-print.c +++ b/gcc/pretty-print.c @@ -907,6 +907,54 @@ pp_write_text_as_dot_label_to_stream (pretty_printer *pp, bool for_record) pp_clear_output_area (pp); } +/* As pp_write_text_to_stream, but for GraphViz HTML-like strings. + + Flush the formatted text of pretty-printer PP onto the attached stream, + escaping these characters + " & < > + using XML escape sequences. + + http://www.graphviz.org/doc/info/lang.html#html states: + special XML escape sequences for ", &, <, and > may be necessary in + order to embed these characters in attribute values or raw text + This doesn't list "'" (which would normally be escaped in XML + as "'" or in HTML as "'");. + + Experiments show that escaping "'" doesn't seem to be necessary. */ + +void +pp_write_text_as_html_like_dot_to_stream (pretty_printer *pp) +{ + const char *text = pp_formatted_text (pp); + const char *p = text; + FILE *fp = pp_buffer (pp)->stream; + + for (;*p; p++) + { + switch (*p) + { + case '"': + fputs (""", fp); + break; + case '&': + fputs ("&", fp); + break; + case '<': + fputs ("<", fp); + break; + case '>': + fputs (">",fp); + break; + + default: + fputc (*p, fp); + break; + } + } + + pp_clear_output_area (pp); +} + /* Wrap a text delimited by START and END into PRETTY-PRINTER. */ static void pp_wrap_text (pretty_printer *pp, const char *start, const char *end) diff --git a/gcc/pretty-print.h b/gcc/pretty-print.h index 493507d..86b9e86 100644 --- a/gcc/pretty-print.h +++ b/gcc/pretty-print.h @@ -393,8 +393,11 @@ extern void pp_indent (pretty_printer *); extern void pp_newline (pretty_printer *); extern void pp_character (pretty_printer *, int); extern void pp_string (pretty_printer *, const char *); + extern void pp_write_text_to_stream (pretty_printer *); extern void pp_write_text_as_dot_label_to_stream (pretty_printer *, bool); +extern void pp_write_text_as_html_like_dot_to_stream (pretty_printer *pp); + extern void pp_maybe_space (pretty_printer *); extern void pp_begin_quote (pretty_printer *, bool); diff --git a/gcc/symtab.c b/gcc/symtab.c index a88f45c..10b8ed1 100644 --- a/gcc/symtab.c +++ b/gcc/symtab.c @@ -1952,6 +1952,11 @@ symtab_node::get_partitioning_class (void) if (DECL_EXTERNAL (decl)) return SYMBOL_EXTERNAL; + /* Even static aliases of external functions as external. Those can happen + when COMDAT got resolved to non-IL implementation. */ + if (alias && DECL_EXTERNAL (ultimate_alias_target ()->decl)) + return SYMBOL_EXTERNAL; + if (varpool_node *vnode = dyn_cast <varpool_node *> (this)) { if (alias && definition && !ultimate_alias_target ()->definition) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 2a4d9a0..e66980e 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,266 @@ +2019-12-19 Feng Xue <fxue@os.amperecomputing.com> + + PR ipa/92794 + * gcc.dg/ipa/92794.c: New test. + +2019-12-18 David Malcolm <dmalcolm@redhat.com> + + * gcc.dg/plugin/diagnostic-test-metadata.c: New test. + * gcc.dg/plugin/diagnostic_plugin_test_metadata.c: New test plugin. + * gcc.dg/plugin/plugin.exp (plugin_test_list): Add them. + +2019-12-19 Jakub Jelinek <jakub@redhat.com> + + PR fortran/92977 + * gfortran.dg/gomp/pr92977.f90: New test. + +2019-12-19 Julian Brown <julian@codesourcery.com> + Maciej W. Rozycki <macro@codesourcery.com> + Tobias Burnus <tobias@codesourcery.com> + Thomas Schwinge <thomas@codesourcery.com> + + * gfortran.dg/goacc/common-block-1.f90: Add no_create-clause tests. + * gfortran.dg/goacc/common-block-1.f90: Likewise. + * gfortran.dg/goacc/data-clauses.f95: Likewise. + * gfortran.dg/goacc/data-tree.f95: Likewise. + * gfortran.dg/goacc/kernels-tree.f95: Likewise. + * gfortran.dg/goacc/parallel-tree.f95: Likewise. + +2019-12-18 Paolo Carlini <paolo.carlini@oracle.com> + + * g++.dg/diagnostic/alignof2.C: New. + * g++.dg/diagnostic/alignof3.C: Likewise. + * g++.dg/diagnostic/incomplete-type-1.C: Likewise. + * g++.dg/warn/Wcatch-value-3b.C: Likewise. + * g++.dg/cpp0x/alignof3.C: Check location(s) too. + * g++.dg/cpp1z/decomp-bitfield1.C: Likewise. + * g++.dg/cpp1z/has-unique-obj-representations2.C: Likewise. + * g++.dg/expr/sizeof3.C: Likewise. + * g++.dg/ext/flexary6.C: Likewise. + * g++.dg/ext/vla4.C: Likewise. + * g++.dg/template/sizeof11.C: Likewise. + * g++.dg/warn/Wcatch-value-1.C: Likewise. + * g++.dg/warn/Wcatch-value-2.C: Likewise. + * g++.dg/warn/Wcatch-value-3.C: Likewise. + * g++.old-deja/g++.brendan/sizeof1.C: Likewise. + * g++.old-deja/g++.brendan/sizeof3.C: Likewise. + * g++.old-deja/g++.brendan/sizeof4.C: Likewise. + * g++.old-deja/g++.eh/ctor1.C: Likewise. + * g++.old-deja/g++.jason/ambig1.C: Likewise. + * g++.old-deja/g++.other/sizeof4.C: Likewise. + +2019-12-18 Peter Bergner <bergner@linux.ibm.com> + + PR bootstrap/92661 + * gcc.target/powerpc/pr92661.c: New test. + * gcc.target/powerpc/dfp-dd.c: Add dg-require-effective-target hard_dfp. + Remove unneeded powerpc_fprs test. + * gcc.target/powerpc/dfp-td.c: Likewise. + * gcc.target/powerpc/dfp-dd-2.c: Add dg-require-effective-target dfp. + * gcc.target/powerpc/dfp-td-2.c: Likewise. + * gcc.target/powerpc/dfp-td-3.c: Likewise. + * gcc.target/powerpc/dfp/dfp.exp: Remove rs6000-*-* and + powerpc*-*-darwin* target tests. Add check_effective_target_dfp test. + * gcc.target/powerpc/dfp/dtstsfi-0.c: Remove unneeded target test. + Remove unneeded dg-skip-if. + * gcc.target/powerpc/dfp/dtstsfi-1.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-10.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-11.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-12.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-13.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-14.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-15.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-16.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-17.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-18.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-19.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-2.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-20.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-21.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-22.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-23.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-24.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-25.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-26.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-27.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-28.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-29.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-3.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-30.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-31.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-32.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-33.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-34.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-35.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-36.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-37.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-38.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-39.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-4.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-40.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-41.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-42.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-43.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-44.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-45.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-46.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-47.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-48.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-49.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-5.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-50.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-51.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-52.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-53.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-54.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-55.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-56.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-57.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-58.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-59.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-6.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-60.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-61.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-62.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-63.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-64.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-65.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-66.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-67.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-68.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-69.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-7.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-70.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-71.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-72.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-73.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-74.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-75.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-76.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-77.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-78.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-79.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-8.c: Likewise. + * gcc.target/powerpc/dfp/dtstsfi-9.c: Likewise. + +2019-12-18 Thomas Schwinge <thomas@codesourcery.com> + + * c-c++-common/goacc/finalize-1.c: Extend. + * gfortran.dg/goacc/finalize-1.f: Likewise. + +2019-12-18 Harald Anlauf <anlauf@gmx.de> + + PR fortran/70853 + * gfortran.dg/pr70853.f90: New test. + +2019-12-18 Martin Jambor <mjambor@suse.cz> + + PR ipa/92971 + * gcc.dg/ipa/ipcp-agg-12.c: New test. + +2019-12-17 Jan Hubicka <hubicka@ucw.cz> + Martin Jambor <mjambor@suse.cz> + + * gcc.dg/ipa/ipa-bit-cp.c: New testcase. + * gcc.dg/ipa/ipa-bit-cp-1.c: New testcase. + * gcc.dg/ipa/ipa-bit-cp-2.c: New testcase. + +2019-12-18 Andrew Stubbs <ams@codesourcery.com> + + * gcc.dg/vect/pr65947-8.c: Change pass conditions for amdgcn. + +2019-12-18 Eric Botcazou <ebotcazou@adacore.com> + + * gnat.dg/warn32.adb: New test. + +2019-12-17 Martin Sebor <msebor@redhat.com> + + PR c++/61339 + * g++.dg/warn/Wmismatched-tags.C: New test. + * g++.dg/warn/Wredundant-tags.C: New test. + * g++.dg/pch/Wmismatched-tags.C: New test. + * g++.dg/pch/Wmismatched-tags.Hs: New test header. + +2019-12-17 Jakub Jelinek <jakub@redhat.com> + + PR c++/59655 + * g++.dg/cpp0x/diag3.C: New test. + + PR target/92841 + * gcc.target/i386/pr92841.c: New test. + +2019-12-17 Christophe Lyon <christophe.lyon@linaro.org> + + * gcc.target/arm/pr45701-1.c: Adjust for -mpure-code. + * gcc.target/arm/pr45701-2.c: Likewise. + * gcc.target/arm/pure-code/no-literal-pool.c: Add tests for + __fp16. + * gcc.target/arm/pure-code/pure-code.exp: Remove thumb2 and movt + conditions. + * gcc.target/arm/thumb1-Os-mult.c: Skip if -mpure-code is used. + +2019-12-17 Andrew Stubbs <ams@codesourcery.com> + + * lib/target-supports.exp + (check_effective_target_vect_fold_extract_last): Add amdgcn. + +2019-12-17 Hongyu Wang <hongyu.wang@intel.com> + + * gcc.target/i386/pr92651.c: New testcase. + +2019-12-17 H.J. Lu <hjl.tools@gmail.com> + + PR target/92807 + * gcc.target/i386/pr92807-1.c: New test. + +2019-12-16 Jozef Lawrynowicz <jozef.l@mittosystems.com> + + * g++.dg/init/dso_handle1.C: Require cxa_atexit support. + * g++.dg/init/dso_handle2.C: Likewise. + * g++.dg/other/cxa-atexit1.C: Likewise. + * gcc.target/msp430/msp430.exp: Update csv-using-installed.c test to + handle msp430-elfbare configuration. + +2019-12-16 Eric Botcazou <ebotcazou@adacore.com> + + * gnat.dg/specs/clause_on_volatile.ads, + gnat.dg/specs/size_clause3.ads: Update expected diagnostics. + +2019-12-16 Andreas Krebbel <krebbel@linux.ibm.com> + + PR target/92950 + * gcc.target/s390/vector/pr92950.c: New test. + +2019-12-15 Andrew Pinski <apinski@marvell.com> + + * gcc.c-torture/compile/bitfield-1.c: New test. + * gcc.c-torture/compile/bitfield-endian-1.c: New test. + * gcc.c-torture/compile/bitfield-endian-2.c: New test. + +2019-12-14 Jakub Jelinek <jakub@redhat.com> + + PR tree-optimization/92930 + * gcc.dg/tree-ssa/pr92930.c: New test. + +2019-12-13 Martin Sebor <msebor@redhat.com> + + PR middle-end/91582 + * c-c++-common/Wrestrict.c: Adjust expected warnings. + * c-c++-common/Wstringop-truncation-4.c: Enable more + warnings. + * c-c++-common/Wstringop-truncation.c: Remove an xfail. + * gcc.dg/Warray-bounds-46.c: Disable -Wstringop-overflow. + * gcc.dg/Warray-bounds-47.c: Same. + * gcc.dg/Warray-bounds-52.c: New test. + * gcc.dg/Wstringop-overflow-27.c: New test. + * gcc.dg/Wstringop-overflow-28.c: New test. + * gcc.dg/Wstringop-overflow-29.c: New test. + * gcc.dg/attr-alloc_size.c (test): Disable -Warray-bounds. + * gcc.dg/attr-copy-2.c: Adjust expected warnings. + * gcc.dg/builtin-stringop-chk-5.c: Adjust text of expected messages. + * gcc.dg/strlenopt-86.c: Relax test. + * gcc.target/i386/pr82002-1.c: Prune expected warnings. + 2019-12-13 Roman Zhuykov <zhroma@ispras.ru> PR rtl-optimization/92591 diff --git a/gcc/testsuite/c-c++-common/Wrestrict.c b/gcc/testsuite/c-c++-common/Wrestrict.c index c852b06..1903f50 100644 --- a/gcc/testsuite/c-c++-common/Wrestrict.c +++ b/gcc/testsuite/c-c++-common/Wrestrict.c @@ -731,10 +731,16 @@ void test_strcpy_range (void) r = SR (3, DIFF_MAX - 3); T (8, "01", a + r, a); - T (8, "012", a + r, a); /* { dg-warning "accessing 4 bytes at offsets \\\[3, \[0-9\]+] and 0 may overlap 1 byte at offset 3" "strcpy" } */ + + /* The accesses below might trigger either + -Wrestrict: accessing 4 bytes at offsets [3, \[0-9\]+] and 0 may overlap 1 byte at offset 3 + or + -Wstringop-overflow: writing 4 bytes into a region of size 0 + Either of the two is appropriate. */ + T (8, "012", a + r, a); /* { dg-warning "\\\[-Wrestrict|-Wstringop-overflow" } */ r = SR (DIFF_MAX - 2, DIFF_MAX - 1); - T (8, "012", a + r, a); /* { dg-warning "accessing 4 bytes at offsets \\\[\[0-9\]+, \[0-9\]+] and 0 overlaps" "strcpy" } */ + T (8, "012", a + r, a); /* { dg-warning "\\\[-Wrestrict|-Wstringop-overflow" } */ /* Exercise the full range of ptrdiff_t. */ r = signed_value (); diff --git a/gcc/testsuite/c-c++-common/Wstringop-truncation-4.c b/gcc/testsuite/c-c++-common/Wstringop-truncation-4.c index 1520953..6ed6a28 100644 --- a/gcc/testsuite/c-c++-common/Wstringop-truncation-4.c +++ b/gcc/testsuite/c-c++-common/Wstringop-truncation-4.c @@ -21,9 +21,13 @@ struct Arrays void test_arrays (struct Arrays *p, const char *s) { + /* Expect accesses to all three arrays to trigger the warning, + including the trailing one. The size argument is a good + enough indication that it is not being used as a "legacy" + flexible array member. */ strncpy (p->a, s, sizeof p->a); /* { dg-warning "\\\[-Wstringop-truncation" } */ strncpy ((char*)p->b, s, sizeof p->b); /* { dg-warning "\\\[-Wstringop-truncation" } */ - strncpy ((char*)p->c, s, sizeof p->c); /* { dg-bogus "\\\[-Wstringop-truncation" } */ + strncpy ((char*)p->c, s, sizeof p->c); /* { dg-warning "\\\[-Wstringop-truncation" } */ } struct Pointers @@ -49,9 +53,11 @@ struct ConstArrays void test_const_arrays (struct ConstArrays *p, const char *s) { + /* Expect accesses to all three arrays to trigger the warning, + including the trailing one. */ strncpy ((char*)p->a, s, sizeof p->a); /* { dg-warning "\\\[-Wstringop-truncation" } */ strncpy ((char*)p->b, s, sizeof p->b); /* { dg-warning "\\\[-Wstringop-truncation" } */ - strncpy ((char*)p->c, s, sizeof p->c); /* { dg-bogus "\\\[-Wstringop-truncation" } */ + strncpy ((char*)p->c, s, sizeof p->c); /* { dg-warning "\\\[-Wstringop-truncation" } */ } struct ConstPointers @@ -77,9 +83,11 @@ struct VolatileArrays void test_volatile_arrays (struct VolatileArrays *p, const char *s) { + /* Expect accesses to all three arrays to trigger the warning, + including the trailing one. */ strncpy ((char*)p->a, s, sizeof p->a); /* { dg-warning "\\\[-Wstringop-truncation" } */ strncpy ((char*)p->b, s, sizeof p->b); /* { dg-warning "\\\[-Wstringop-truncation" } */ - strncpy ((char*)p->c, s, sizeof p->c); /* { dg-bogus "\\\[-Wstringop-truncation" } */ + strncpy ((char*)p->c, s, sizeof p->c); /* { dg-warning "\\\[-Wstringop-truncation" } */ } struct VolatilePointers @@ -105,9 +113,11 @@ struct ConstVolatileArrays void test_const_volatile_arrays (struct ConstVolatileArrays *p, const char *s) { + /* Expect accesses to all three arrays to trigger the warning, + including the trailing one. */ strncpy ((char*)p->a, s, sizeof p->a); /* { dg-warning "\\\[-Wstringop-truncation" } */ strncpy ((char*)p->b, s, sizeof p->b); /* { dg-warning "\\\[-Wstringop-truncation" } */ - strncpy ((char*)p->c, s, sizeof p->c); /* { dg-bogus "\\\[-Wstringop-truncation" } */ + strncpy ((char*)p->c, s, sizeof p->c); /* { dg-warning "\\\[-Wstringop-truncation" } */ } struct ConstVolatilePointers diff --git a/gcc/testsuite/c-c++-common/Wstringop-truncation.c b/gcc/testsuite/c-c++-common/Wstringop-truncation.c index 592a949..5e43405 100644 --- a/gcc/testsuite/c-c++-common/Wstringop-truncation.c +++ b/gcc/testsuite/c-c++-common/Wstringop-truncation.c @@ -300,8 +300,7 @@ void test_strncpy_array (Dest *pd, int i, const char* s) CPY (pd->a5, s, 5); /* { dg-warning "specified bound 5 equals destination size" } */ CPY (pd->a5, s, sizeof pd->a5); /* { dg-warning "specified bound 5 equals destination size" } */ - /* The following is not yet handled. */ - CPY (pd->a5 + i, s, sizeof pd->a5); /* { dg-warning "specified bound 5 equals destination size" "member array" { xfail *-*-* } } */ + CPY (pd->a5 + i, s, sizeof pd->a5); /* { dg-warning "specified bound 5 equals destination size" "member array" } */ /* Verify that a copy that nul-terminates is not diagnosed. */ CPY (pd->a5, "1234", sizeof pd->a5); diff --git a/gcc/testsuite/c-c++-common/goacc/finalize-1.c b/gcc/testsuite/c-c++-common/goacc/finalize-1.c index 9482029..3d64b2e 100644 --- a/gcc/testsuite/c-c++-common/goacc/finalize-1.c +++ b/gcc/testsuite/c-c++-common/goacc/finalize-1.c @@ -4,8 +4,10 @@ extern int del_r; extern float del_f[3]; +extern char *del_f_p; extern double cpo_r[8]; extern long cpo_f; +extern char *cpo_f_p; void f () { @@ -17,6 +19,10 @@ void f () /* { dg-final { scan-tree-dump-times "(?n)#pragma acc exit data map\\(release:del_f\\) finalize;$" 1 "original" } } { dg-final { scan-tree-dump-times "(?n)#pragma omp target oacc_enter_exit_data map\\(delete:del_f \\\[len: \[0-9\]+\\\]\\) finalize$" 1 "gimple" } } */ +#pragma acc exit data finalize delete (del_f_p[2:5]) +/* { dg-final { scan-tree-dump-times "(?n)#pragma acc exit data map\\(release:\\*\\(del_f_p \\+ 2\\) \\\[len: 5\\\]\\) map\\(firstprivate:del_f_p \\\[pointer assign, bias: 2\\\]\\) finalize;$" 1 "original" } } + { dg-final { scan-tree-dump-times "(?n)#pragma omp target oacc_enter_exit_data map\\(delete:\[^ \]+ \\\[len: 5\\\]\\) finalize$" 1 "gimple" } } */ + #pragma acc exit data copyout (cpo_r) /* { dg-final { scan-tree-dump-times "(?n)#pragma acc exit data map\\(from:cpo_r\\);$" 1 "original" } } { dg-final { scan-tree-dump-times "(?n)#pragma omp target oacc_enter_exit_data map\\(from:cpo_r \\\[len: \[0-9\]+\\\]\\)$" 1 "gimple" } } */ @@ -24,5 +30,8 @@ void f () #pragma acc exit data copyout (cpo_f) finalize /* { dg-final { scan-tree-dump-times "(?n)#pragma acc exit data finalize map\\(from:cpo_f\\);$" 1 "original" } } { dg-final { scan-tree-dump-times "(?n)#pragma omp target oacc_enter_exit_data finalize map\\(force_from:cpo_f \\\[len: \[0-9\]+\\\]\\)$" 1 "gimple" } } */ -} +#pragma acc exit data copyout (cpo_f_p[4:10]) finalize +/* { dg-final { scan-tree-dump-times "(?n)#pragma acc exit data finalize map\\(from:\\*\\(cpo_f_p \\+ 4\\) \\\[len: 10\\\]\\) map\\(firstprivate:cpo_f_p \\\[pointer assign, bias: 4\\\]\\);$" 1 "original" } } + { dg-final { scan-tree-dump-times "(?n)#pragma omp target oacc_enter_exit_data finalize map\\(force_from:\[^ \]+ \\\[len: 10\\\]\\)$" 1 "gimple" } } */ +} diff --git a/gcc/testsuite/g++.dg/cpp0x/alignof3.C b/gcc/testsuite/g++.dg/cpp0x/alignof3.C index c349cec..fa373ec 100644 --- a/gcc/testsuite/g++.dg/cpp0x/alignof3.C +++ b/gcc/testsuite/g++.dg/cpp0x/alignof3.C @@ -2,5 +2,5 @@ // { dg-options "-pedantic" } int main(void) { - alignof(void (void)); // { dg-warning "function type" } + alignof(void (void)); // { dg-warning "3:ISO C\\+\\+ does not permit .alignof. applied to a function type" } } diff --git a/gcc/testsuite/g++.dg/cpp0x/constexpr-nsdmi1.C b/gcc/testsuite/g++.dg/cpp0x/constexpr-nsdmi1.C new file mode 100644 index 0000000..b94cf30 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/constexpr-nsdmi1.C @@ -0,0 +1,12 @@ +// PR c++/79592 +// { dg-do compile { target c++11 } } + +struct pthread_mutex { + void *m_ptr; +}; + +struct M { + pthread_mutex m = { ((void *) 1LL) }; // { dg-error "reinterpret_cast" } +}; + +constexpr M m; // { dg-error "M::M" } diff --git a/gcc/testsuite/g++.dg/cpp0x/constexpr-string2.C b/gcc/testsuite/g++.dg/cpp0x/constexpr-string2.C new file mode 100644 index 0000000..a64d815 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/constexpr-string2.C @@ -0,0 +1,13 @@ +// PR c++/91165 +// { dg-do compile { target c++11 } } +// { dg-additional-options -O } + +template <typename T> constexpr T bar (T c) { return c; } +template <typename T, typename U> struct S { + T f; + U g; +}; +template <typename T, typename U> +constexpr S<T, U> foo (T &&c, U h) { return S<T, U> {c, bar (h)}; } +void baz (int a) { foo (a, ""); } +void qux () { foo (0, ""); } diff --git a/gcc/testsuite/g++.dg/cpp0x/diag3.C b/gcc/testsuite/g++.dg/cpp0x/diag3.C new file mode 100644 index 0000000..7409b30 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/diag3.C @@ -0,0 +1,20 @@ +// PR c++/59655 +// { dg-do compile { target c++11 } } + +template<typename T> struct A { static constexpr bool value = false; }; + +struct B { + template<typename T> + B (T t) + { + static_assert (A<T>::value, "baz"); // { dg-error "static assertion failed" } + foo (t); + } + template<typename T> void foo (T) {} // { dg-bogus "used but never defined" } +}; + +int +main () +{ + B t([](int) { }); +} diff --git a/gcc/testsuite/g++.dg/cpp1y/var-templ32.C b/gcc/testsuite/g++.dg/cpp1y/var-templ32.C index 80077a1..6767ff1 100644 --- a/gcc/testsuite/g++.dg/cpp1y/var-templ32.C +++ b/gcc/testsuite/g++.dg/cpp1y/var-templ32.C @@ -4,4 +4,4 @@ template<typename T> bool V1 = true; template<typename T> -bool V1<int> = false; // { dg-error "primary template|not deducible" } +bool V1<int> = false; // { dg-error "primary template|redefinition|not deducible" } diff --git a/gcc/testsuite/g++.dg/cpp1y/var-templ65.C b/gcc/testsuite/g++.dg/cpp1y/var-templ65.C new file mode 100644 index 0000000..10398bb --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp1y/var-templ65.C @@ -0,0 +1,5 @@ +// PR c++/84255 +// { dg-do compile { target c++14 } } + +template<typename T> constexpr int var; +template<typename T> constexpr int var = 1; // { dg-error "redefinition" } diff --git a/gcc/testsuite/g++.dg/cpp1z/decomp-bitfield1.C b/gcc/testsuite/g++.dg/cpp1z/decomp-bitfield1.C index 1a14997..fcf93eb 100644 --- a/gcc/testsuite/g++.dg/cpp1z/decomp-bitfield1.C +++ b/gcc/testsuite/g++.dg/cpp1z/decomp-bitfield1.C @@ -15,5 +15,5 @@ void f() long &r = x; // { dg-error "bit" } &x; // { dg-error "bit" } - sizeof(x); // { dg-error "bit" } + sizeof(x); // { dg-error "10:invalid application of .sizeof. to a bit-field" } } diff --git a/gcc/testsuite/g++.dg/cpp1z/has-unique-obj-representations2.C b/gcc/testsuite/g++.dg/cpp1z/has-unique-obj-representations2.C index f1f3388..3daea89 100644 --- a/gcc/testsuite/g++.dg/cpp1z/has-unique-obj-representations2.C +++ b/gcc/testsuite/g++.dg/cpp1z/has-unique-obj-representations2.C @@ -1,6 +1,6 @@ struct S; -struct T { S t; }; // { dg-error "incomplete type" } -struct U { int u[sizeof (S)]; }; // { dg-error "incomplete type" } +struct T { S t; }; // { dg-error "14:field .t. has incomplete type" } +struct U { int u[sizeof (S)]; }; // { dg-error "18:invalid application of .sizeof. to incomplete type" } union V { char c; char d[]; }; // { dg-error "24:flexible array member in union" } bool a = __has_unique_object_representations (S); // { dg-error "incomplete type" } bool b = __has_unique_object_representations (T); diff --git a/gcc/testsuite/g++.dg/diagnostic/alignof2.C b/gcc/testsuite/g++.dg/diagnostic/alignof2.C new file mode 100644 index 0000000..0498cb5 --- /dev/null +++ b/gcc/testsuite/g++.dg/diagnostic/alignof2.C @@ -0,0 +1,2 @@ +void f(); +int i = __alignof(f); // { dg-error "19:ISO C\\+\\+ forbids applying .__alignof." } diff --git a/gcc/testsuite/g++.dg/diagnostic/alignof3.C b/gcc/testsuite/g++.dg/diagnostic/alignof3.C new file mode 100644 index 0000000..5a3e3f5 --- /dev/null +++ b/gcc/testsuite/g++.dg/diagnostic/alignof3.C @@ -0,0 +1,5 @@ +struct A { long i: 2; }; +void f() +{ + __alignof(A::i); // { dg-error "16:invalid application of .__alignof. to a bit-field" } +} diff --git a/gcc/testsuite/g++.dg/diagnostic/incomplete-type-1.C b/gcc/testsuite/g++.dg/diagnostic/incomplete-type-1.C new file mode 100644 index 0000000..8b08d73 --- /dev/null +++ b/gcc/testsuite/g++.dg/diagnostic/incomplete-type-1.C @@ -0,0 +1,2 @@ +template<typename> struct A; // { dg-message "27:declaration" } +template<typename T> A<T>::A(); // { dg-error "22:invalid use of incomplete type" } diff --git a/gcc/testsuite/g++.dg/expr/sizeof3.C b/gcc/testsuite/g++.dg/expr/sizeof3.C index 31338b0..915c86b 100644 --- a/gcc/testsuite/g++.dg/expr/sizeof3.C +++ b/gcc/testsuite/g++.dg/expr/sizeof3.C @@ -1,4 +1,4 @@ // PR c++/15337 class CCC; -int main() { sizeof(CCC); return 0; } // { dg-error ".*CCC.*" } +int main() { sizeof(CCC); return 0; } // { dg-error "14:invalid application of .sizeof. to incomplete type .CCC." } diff --git a/gcc/testsuite/g++.dg/ext/flexary6.C b/gcc/testsuite/g++.dg/ext/flexary6.C index 92677cd..e53c5d6 100644 --- a/gcc/testsuite/g++.dg/ext/flexary6.C +++ b/gcc/testsuite/g++.dg/ext/flexary6.C @@ -9,7 +9,7 @@ struct A { int n; int a[]; enum { - e = sizeof a // { dg-error "invalid application of .sizeof. to incomplete type" } + e = sizeof a // { dg-error "9:invalid application of .sizeof. to incomplete type" } }; }; @@ -18,6 +18,6 @@ struct B { typedef int A[]; A a; enum { - e = sizeof a // { dg-error "invalid application of .sizeof. to incomplete type" } + e = sizeof a // { dg-error "9:invalid application of .sizeof. to incomplete type" } }; }; diff --git a/gcc/testsuite/g++.dg/ext/vla4.C b/gcc/testsuite/g++.dg/ext/vla4.C index 90e4160..e96f273 100644 --- a/gcc/testsuite/g++.dg/ext/vla4.C +++ b/gcc/testsuite/g++.dg/ext/vla4.C @@ -6,7 +6,7 @@ void f(int i) { try { int a[i]; - throw &a; // { dg-error "int \\(\\*\\)\\\[i\\\]" } + throw &a; // { dg-error "11:cannot throw expression of type .int \\(\\*\\)\\\[i\\\]." } } catch (int (*)[i]) { // { dg-error "variable size" } } } diff --git a/gcc/testsuite/g++.dg/init/dso_handle1.C b/gcc/testsuite/g++.dg/init/dso_handle1.C index 97f67ca..0377c4e 100644 --- a/gcc/testsuite/g++.dg/init/dso_handle1.C +++ b/gcc/testsuite/g++.dg/init/dso_handle1.C @@ -1,6 +1,7 @@ // PR c++/17042 // { dg-do assemble } /* { dg-require-weak "" } */ +// { dg-require-effective-target cxa_atexit } // { dg-options "-fuse-cxa-atexit" } struct A diff --git a/gcc/testsuite/g++.dg/init/dso_handle2.C b/gcc/testsuite/g++.dg/init/dso_handle2.C index b219dc0..a4daaf3 100644 --- a/gcc/testsuite/g++.dg/init/dso_handle2.C +++ b/gcc/testsuite/g++.dg/init/dso_handle2.C @@ -1,4 +1,5 @@ // PR c++/58846 +// { dg-require-effective-target cxa_atexit } // { dg-options "-fuse-cxa-atexit" } extern "C" { char* __dso_handle; } diff --git a/gcc/testsuite/g++.dg/lookup/dtor1.C b/gcc/testsuite/g++.dg/lookup/dtor1.C new file mode 100644 index 0000000..2912287 --- /dev/null +++ b/gcc/testsuite/g++.dg/lookup/dtor1.C @@ -0,0 +1,13 @@ +// PR c++/12333 + +struct A { }; + +struct X { + void f () { + X::~X (); + this->~X(); + ~X(); // { dg-error "" "unary ~" } + A::~A (); // { dg-error "" } + X::~A (); // { dg-error "" } + } +}; diff --git a/gcc/testsuite/g++.dg/lookup/missing-std-include-9.C b/gcc/testsuite/g++.dg/lookup/missing-std-include-9.C new file mode 100644 index 0000000..f8e1e1d --- /dev/null +++ b/gcc/testsuite/g++.dg/lookup/missing-std-include-9.C @@ -0,0 +1,3 @@ +std::byte b; // { dg-error "byte" } +// { dg-message "cstddef" "" { target c++17 } .-1 } +// { dg-message "C..17" "" { target c++14_down } .-2 } diff --git a/gcc/testsuite/g++.dg/other/cxa-atexit1.C b/gcc/testsuite/g++.dg/other/cxa-atexit1.C index a51f334..b22911d 100644 --- a/gcc/testsuite/g++.dg/other/cxa-atexit1.C +++ b/gcc/testsuite/g++.dg/other/cxa-atexit1.C @@ -1,4 +1,5 @@ // { dg-do compile } +// { dg-require-effective-target cxa_atexit } // { dg-options "-O2 -fuse-cxa-atexit" } # 1 "cxa-atexit1.C" diff --git a/gcc/testsuite/g++.dg/parse/dtor3.C b/gcc/testsuite/g++.dg/parse/dtor3.C index 3041ae4..6121bed 100644 --- a/gcc/testsuite/g++.dg/parse/dtor3.C +++ b/gcc/testsuite/g++.dg/parse/dtor3.C @@ -4,13 +4,13 @@ // destructor call. struct Y { - ~Y() {} // { dg-bogus "note" "implemented DR272" { xfail *-*-* } } + ~Y() {} // { dg-bogus "note" "implemented DR272" } }; struct X : Y { - ~X() {} // { dg-bogus "note" "implemented DR272" { xfail *-*-* } } + ~X() {} // { dg-bogus "note" "implemented DR272" } void f() { - X::~X(); // { dg-bogus "" "implemented DR272" { xfail *-*-* } } - Y::~Y(); // { dg-bogus "" "implemented DR272" { xfail *-*-* } } + X::~X(); // { dg-bogus "" "implemented DR272" } + Y::~Y(); // { dg-bogus "" "implemented DR272" } } }; diff --git a/gcc/testsuite/g++.dg/pch/Wmismatched-tags.C b/gcc/testsuite/g++.dg/pch/Wmismatched-tags.C new file mode 100644 index 0000000..89b6ba5 --- /dev/null +++ b/gcc/testsuite/g++.dg/pch/Wmismatched-tags.C @@ -0,0 +1,15 @@ +/* PR c++/61339 - add mismatch between struct and class + Verify that declarations that don't match definitions in precompiled + headers are diagnosed. + { dg-options "-Wall -Wmismatched-tags" } */ + +#include "Wmismatched-tags.H" + +class PCHDeclaredClass; +struct PCHDeclaredStruct; + +struct PCHDefinedClass; // { dg-warning "declared with a mismatched class-key 'struct'" } +class PCHDefinedStruct; // { dg-warning "declared with a mismatched class-key 'class'" } + +class PCHDeclaredClass { }; +struct PCHDeclaredStruct { }; diff --git a/gcc/testsuite/g++.dg/pch/Wmismatched-tags.Hs b/gcc/testsuite/g++.dg/pch/Wmismatched-tags.Hs new file mode 100644 index 0000000..f4c5dc5 --- /dev/null +++ b/gcc/testsuite/g++.dg/pch/Wmismatched-tags.Hs @@ -0,0 +1,7 @@ +class PCHDeclaredClass; + +struct PCHDeclaredStruct; + +class PCHDefinedClass { }; + +struct PCHDefinedStruct { };
\ No newline at end of file diff --git a/gcc/testsuite/g++.dg/template/sizeof11.C b/gcc/testsuite/g++.dg/template/sizeof11.C index 7428e0b..b1d4f72 100644 --- a/gcc/testsuite/g++.dg/template/sizeof11.C +++ b/gcc/testsuite/g++.dg/template/sizeof11.C @@ -9,6 +9,6 @@ template < int> void g() template < class T > struct B; template < int> void f() { - sizeof (B<int>); // { dg-error "incomplete" } + sizeof (B<int>); // { dg-error "3:invalid application of .sizeof. to incomplete type" } } diff --git a/gcc/testsuite/g++.dg/warn/Wcatch-value-1.C b/gcc/testsuite/g++.dg/warn/Wcatch-value-1.C index 94ee934..a84b337 100644 --- a/gcc/testsuite/g++.dg/warn/Wcatch-value-1.C +++ b/gcc/testsuite/g++.dg/warn/Wcatch-value-1.C @@ -10,8 +10,8 @@ void foo() try {} catch (D) {} catch (C) {} - catch (B) {} // { dg-warning "catching polymorphic type" } - catch (A) {} // { dg-warning "catching polymorphic type" } + catch (B) {} // { dg-warning "10:catching polymorphic type" } + catch (A) {} // { dg-warning "10:catching polymorphic type" } catch (A*) {} catch (int) {} @@ -27,7 +27,7 @@ void foo() template<typename T> void foo1() { try {} - catch (T) {} // { dg-warning "catching polymorphic type" } + catch (T) {} // { dg-warning "10:catching polymorphic type" } } template<typename T> void foo2() diff --git a/gcc/testsuite/g++.dg/warn/Wcatch-value-2.C b/gcc/testsuite/g++.dg/warn/Wcatch-value-2.C index 1bcf405..e20719c 100644 --- a/gcc/testsuite/g++.dg/warn/Wcatch-value-2.C +++ b/gcc/testsuite/g++.dg/warn/Wcatch-value-2.C @@ -8,10 +8,10 @@ struct D : C {}; void foo() { try {} - catch (D) {} // { dg-warning "catching type" } - catch (C) {} // { dg-warning "catching type" } - catch (B) {} // { dg-warning "catching polymorphic type" } - catch (A) {} // { dg-warning "catching polymorphic type" } + catch (D) {} // { dg-warning "10:catching type" } + catch (C) {} // { dg-warning "10:catching type" } + catch (B) {} // { dg-warning "10:catching polymorphic type" } + catch (A) {} // { dg-warning "10:catching polymorphic type" } catch (A*) {} catch (int) {} @@ -27,7 +27,7 @@ void foo() template<typename T> void foo1() { try {} - catch (T) {} // { dg-warning "catching" } + catch (T) {} // { dg-warning "10:catching" } } template<typename T> void foo2() diff --git a/gcc/testsuite/g++.dg/warn/Wcatch-value-3.C b/gcc/testsuite/g++.dg/warn/Wcatch-value-3.C index 88ae698..c91a3c0 100644 --- a/gcc/testsuite/g++.dg/warn/Wcatch-value-3.C +++ b/gcc/testsuite/g++.dg/warn/Wcatch-value-3.C @@ -8,12 +8,12 @@ struct D : C {}; void foo() { try {} - catch (D) {} // { dg-warning "catching type" } - catch (C) {} // { dg-warning "catching type" } - catch (B) {} // { dg-warning "catching polymorphic type" } - catch (A) {} // { dg-warning "catching polymorphic type" } + catch (D) {} // { dg-warning "10:catching type" } + catch (C) {} // { dg-warning "10:catching type" } + catch (B) {} // { dg-warning "10:catching polymorphic type" } + catch (A) {} // { dg-warning "10:catching polymorphic type" } catch (A*) {} // { dg-warning "catching non-reference type" } - catch (int) {} // { dg-warning "catching non-reference type" } + catch (int) {} // { dg-warning "10:catching non-reference type" } try {} catch (D&) {} @@ -27,7 +27,7 @@ void foo() template<typename T> void foo1() { try {} - catch (T) {} // { dg-warning "catching" } + catch (T) {} // { dg-warning "10:catching" } } template<typename T> void foo2() diff --git a/gcc/testsuite/g++.dg/warn/Wcatch-value-3b.C b/gcc/testsuite/g++.dg/warn/Wcatch-value-3b.C new file mode 100644 index 0000000..cb9af4a --- /dev/null +++ b/gcc/testsuite/g++.dg/warn/Wcatch-value-3b.C @@ -0,0 +1,64 @@ +// { dg-options "-Wcatch-value=3" } + +struct A { virtual ~A() {} }; +struct B : A {}; +struct C {}; +struct D : C {}; + +void foo() +{ + try {} + catch (D d) {} // { dg-warning "12:catching type" } + catch (C c) {} // { dg-warning "12:catching type" } + catch (B b) {} // { dg-warning "12:catching polymorphic type" } + catch (A a) {} // { dg-warning "12:catching polymorphic type" } + catch (A* a) {} // { dg-warning "13:catching non-reference type" } + catch (int i) {} // { dg-warning "14:catching non-reference type" } + + try {} + catch (D& d) {} + catch (C& c) {} + catch (B& b) {} + catch (A& a) {} + catch (A* a) {} // { dg-warning "13:catching non-reference type" } + catch (int& i) {} +} + +template<typename T> void foo1() +{ + try {} + catch (T t) {} // { dg-warning "12:catching" } +} + +template<typename T> void foo2() +{ + try {} + catch (T* t) {} // { dg-warning "13:catching non-reference type" } + + try {} + catch (T&) {} + + try {} + catch (const T&) {} +} + +void bar() +{ + foo1<int&>(); + foo1<const A&>(); + foo1<B&>(); + foo1<const C&>(); + foo1<D&>(); + + foo1<int>(); // { dg-message "required" } + foo1<A>(); // { dg-message "required" } + foo1<B>(); // { dg-message "required" } + foo1<C>(); // { dg-message "required" } + foo1<D>(); // { dg-message "required" } + + foo2<int>(); // { dg-message "required" } + foo2<A>(); // { dg-message "required" } + foo2<B>(); // { dg-message "required" } + foo2<C>(); // { dg-message "required" } + foo2<D>(); // { dg-message "required" } +} diff --git a/gcc/testsuite/g++.dg/warn/Wmismatched-tags.C b/gcc/testsuite/g++.dg/warn/Wmismatched-tags.C new file mode 100644 index 0000000..36a7903 --- /dev/null +++ b/gcc/testsuite/g++.dg/warn/Wmismatched-tags.C @@ -0,0 +1,278 @@ +/* PR c++/61339 - add mismatch between struct and class + Test to verify that -Wmismatched-tags is issued for declarations + of the same class using different class-ids. + { dg-do compile } + { dg-options "-Wmismatched-tags" } */ + +namespace Classes +{ +class A; +class A; + +struct B; +struct B; + +union C; +union C; + +struct D; // { dg-warning "Classes::D' declared with a mismatched class-key 'struct'" } +class D { }; // { dg-message "Classes::D' defined as 'class' here" } + +class E; // { dg-warning "Classes::E' declared with a mismatched class-key 'class'" } +struct E { }; // { dg-message "Classes::E' defined as 'struct' here" } + +class D; +struct E; + +class D; +struct E; + +struct D; // { dg-warning "Classes::D' declared with a mismatched class-key" } + +class E; // { dg-warning "Classes::E' declared with a mismatched class-key" } + +class F; // { dg-message "Classes::F' first declared as 'class' here" } +class F; + +struct G { }; // { dg-message "Classes::G' defined as 'struct' here" } +} // namespace Classes + + +namespace Classes +{ +class A; +struct B; +union C; +class D; +struct E; + +struct F; // { dg-warning "Classes::F' declared with a mismatched class-key" } + +struct G; +} + +// Verify that the correct hint is provided, one to remove the class-key +// when it's redundant, and one to (only) replace it with the correct one +// when it's needed to disambiguate the reference to the class type. +namespace RemoveOrReplace +{ +struct Func; +class Func; // { dg-warning "RemoveOrReplace::Func' declared with a mismatched class-key 'class'" } + // { dg-message "replace the class-key with 'struct'" "hint to remove" { target *-*-* } .-1 } + +void Func (); + +class Func; // { dg-warning "RemoveOrReplace::Func' declared with a mismatched class-key 'class'" } + // { dg-message "replace the class-key with 'struct'" "hint to replace" { target *-*-* } .-1 } + +class Var; +struct Var; // { dg-warning "RemoveOrReplace::Var' declared with a mismatched class-key 'struct'" } + // { dg-message "replace the class-key with 'class'" "hint to remove" { target *-*-* } .-1 } +void f (struct Var*); // { dg-warning "RemoveOrReplace::Var' declared with a mismatched class-key 'struct'" } + // { dg-message "remove the class-key or replace it with 'class'" "hint to remove" { target *-*-* } .-1 } + +int Var; + +struct Var; // { dg-warning "RemoveOrReplace::Var' declared with a mismatched class-key 'struct'" } + // { dg-message "replace the class-key with 'class'" "hint to replace" { target *-*-* } .-1 } +} + +namespace GlobalObjects +{ +class A; // { dg-message "'GlobalObjects::A' first declared as 'class' here" } +struct B; // { dg-message "'GlobalObjects::B' first declared as 'struct' here" } +class C { }; // { dg-message "'GlobalObjects::C' defined as 'class' here" } + +extern A a0; +extern class A a1; +extern class A a2; + +extern B b0; +extern struct B b1; +extern struct B b2; + +extern struct A a3; // { dg-warning "GlobalObjects::A' declared with a mismatched class-key" } +extern class A a4; + +extern class B b3; // { dg-warning "GlobalObjects::B' declared with a mismatched class-key" } +extern struct B b4; + +extern struct C c[]; // { dg-warning "GlobalObjects::C' declared with a mismatched class-key" } + // { dg-message "remove the class-key or replace it with 'class'" "hint to remove" { target *-*-* } .-1 } + +extern char +arr[sizeof (struct C)]; // { dg-warning "GlobalObjects::C' declared with a mismatched class-key" } + // { dg-message "remove the class-key or replace it with 'class'" "hint to remove" { target *-*-* } .-1 } +} // namespace GlobalObjects + + +namespace LocalObjects +{ +class A; // { dg-message "LocalObjects::A' first declared as 'class' here" } +struct B; // { dg-message "LocalObjects::B' first declared as 'struct' here" } + +void f (A*, B&) +{ + class A *a1; + class A *a2; + + struct B *b1; + struct B *b2; + + struct A *a3; // { dg-warning "LocalObjects::A' declared with a mismatched class-key" } + class A *a4; + + class B *b3; // { dg-warning "LocalObjects::B' declared with a mismatched class-key" } + struct B *b4; +} + +void g (struct A*); // { dg-warning "LocalObjects::A' declared with a mismatched class-key" } + +} // namespace LocalObjects + + +namespace MemberClasses +{ +struct A { struct B; }; +struct C { struct D; struct D; struct D { }; }; +struct E { class F; class F { }; class F; }; + +struct G { + struct H; // { dg-message "MemberClasses::G::H' first declared as 'struct' here" } + class H; // { dg-warning "MemberClasses::G::H' declared with a mismatched class-key" } + class I { }; // { dg-message "MemberClasses::G::I' defined as 'class' here" } + struct I; // { dg-warning "MemberClasses::G::I' declared with a mismatched class-key" } +}; +} // namespace MemberClasses + + +namespace DataMembers +{ +struct A { struct B *p; }; +struct C { struct D *p; struct D *q; struct D { } d; }; +struct E { class F &r; class F { } f; class F *p; }; + +class G; // { dg-message "DataMembers::G' first declared as 'class' here" } +struct H; // { dg-message "DataMembers::H' first declared as 'struct' here" } + +struct I { + struct G *p0; // { dg-warning "DataMembers::G' declared with a mismatched class-key" } + class G *p1; + + struct H &r0; + class H &r1; // { dg-warning "DataMembers::H' declared with a mismatched class-key" } + + class J { }; // { dg-message "DataMembers::I::J' defined as 'class' here" } + struct K { }; // { dg-message "DataMembers::I::K' defined as 'struct' here" } + + class J j0; + class K k0; // { dg-warning "DataMembers::I::K' declared with a mismatched class-key" } + + struct J j1; // { dg-warning "DataMembers::I::J' declared with a mismatched class-key" } + struct K k1; +}; +} // namespace DataMembers + + +namespace Templates +{ +template <int> class A; +template <int> class A; + +template <int> struct B; +template <int> struct B; + +template <int> union C; +template <int> union C; + +template <int> struct D; // { dg-warning "Templates::D\[^\n\r]*' declared with a mismatched class-key" } +template <int> +class D // { dg-message "Templates::D\[^\n\r]*' defined as 'class' here" } +{ public: D (); }; + +template <int> class E; // { dg-warning "Templates::E\[^\n\r]*' declared with a mismatched class-key" } +template <int> +struct E // { dg-message "Templates::E\[^\n\r]*' defined as 'struct' here" } +{ int i; }; + +template <int> class D; +template <int> struct E; + +template <int> +struct D; // { dg-warning "Templates::D\[^\n\r]*' declared with a mismatched class-key" } + // { dg-message "replace the class-key with 'class'" "hint" { target *-*-* } .-1 } +} // namespace Templates + + +namespace ExplicitSpecializations +{ +template <int> class A; +template <> class A<0>; +template <> struct A<1>; +template <> struct A<1> { }; + +template <int> struct B; +template <> struct B<0>; +template <> class B<1>; +template <> class B<2> { public: B (); }; + +template <int> union C; +template <> union C<0>; + +template <int> class D; +template <> class D<0>; // { dg-warning "ExplicitSpecializations::D\[^\n\r]*' declared with a mismatched class-key " } +template <> +struct D<0> { }; // { dg-message "ExplicitSpecializations::D\[^\n\r]*' defined as 'struct' here" } + +template <int> struct E; +template <> struct E<0>; // { dg-warning "ExplicitSpecializations::E\[^\n\r]*' declared with a mismatched class-key" } +template <> +class E<0> { }; // { dg-message "ExplicitSpecializations::E\[^\n\r]*' defined as 'class' here" } + +template <int> struct F; +template <> class F<0> { }; // { dg-message "ExplicitSpecializations::F\[^\n\r]*' defined as 'class' here" } + +template <> +struct F<0>; // { dg-warning "ExplicitSpecializations::F\[^\n\r]*' declared with a mismatched class-key" } +} // namespace ExplicitSpecializations + + +namespace PartialSpecializations +{ +template <class> class A; +template <class T> struct A<const T>; +template <class T> struct A<volatile T>; + +template <class> struct B; +template <class T> class B<const T>; +template <class T> class B<volatile T>; + +template <class> class C { }; +template <class T> struct C<const T> { }; +template <class T> struct C<volatile T> { }; + +template <class> struct D { }; +template <class T> class D<const T> { }; +template <class T> class D<volatile T> { }; + +template <class> class E; +template <class T> +struct E<const T>; // { dg-message "PartialSpecializations::E<const T>' first declared as 'struct' here" } + +template <class T> +class E<const T>; // { dg-warning "PartialSpecializations::E<const T>' declared with a mismatched class-key" } + +template <class> class F; +template <class T> +class F<const T>; // { dg-message "PartialSpecializations::F<const T>' first declared as 'class' here" } +template <class T> +struct F<const T>; // { dg-warning "PartialSpecializations::F<const T>' declared with a mismatched class-key" } +} // namespace PartialSpecializations + + +namespace Classes +{ +struct G; + +class G; // { dg-warning "Classes::G' declared with a mismatched class-key 'class'" } +} diff --git a/gcc/testsuite/g++.dg/warn/Wredundant-tags.C b/gcc/testsuite/g++.dg/warn/Wredundant-tags.C new file mode 100644 index 0000000..ac5afa9 --- /dev/null +++ b/gcc/testsuite/g++.dg/warn/Wredundant-tags.C @@ -0,0 +1,128 @@ +/* PR c++/61339 - add mismatch between struct and class + Test to verify that -Wredundant-tags is issued for references to class + types that use the class-key even though they don't need to. + { dg-do compile } + { dg-options "-Wredundant-tags" } */ + +struct A; + +extern A *pa; +extern struct A *pa; // { dg-warning "redundant class-key 'struct' in reference to 'struct A'" } + +extern A aa[]; +extern struct A aa[]; // { dg-warning "redundant class-key 'struct' in reference to 'struct A'" } + +void func (A*); +void func (struct A*); // { dg-warning "redundant class-key 'struct' in reference to 'struct A'" } + +int A; + +extern struct A *pa; +extern struct A aa[]; +void func (struct A*); + + +class B; + +extern B *pb; +extern class B *pb; // { dg-warning "redundant class-key 'class' in reference to 'class B'" } + +extern B ab[]; +extern class B ab[]; // { dg-warning "redundant class-key 'class' in reference to 'class B'" } + +void func (B*); +void func (class B*); // { dg-warning "redundant class-key 'class' in reference to 'class B'" } + +int B; + +extern class B *pb; +extern class B ab[]; +void func (class B*); + + +enum C { c0 }; + +extern C *pc; +extern enum C *pc; // { dg-warning "redundant enum-key 'enum' in reference to 'enum C'" } + +extern C ac[]; +extern enum C ac[]; // { dg-warning "redundant enum-key 'enum' in reference to 'enum C'" } + +void func (C*); +void func (enum C*); // { dg-warning "redundant enum-key 'enum' in reference to 'enum C'" } + +int C; + +extern enum C *pc; +extern enum C ac[]; +void func (enum C*); + + +#if __cplusplus > 199711L + +enum class D1 { d1 }; +enum struct D2 { d2 }; + +#else + +enum D1 { d1 }; +enum D2 { d2 }; + +#endif + +extern D1 *pd1; +extern D2 *pd2; +extern enum D1 *pd1; // { dg-warning "redundant enum-key 'enum' in reference to 'enum class D1'" "C++ 11 and above" { target c++11 } } + // { dg-warning "redundant enum-key 'enum' in reference to 'enum D1'" "C++ 98" { target c++98_only } .-1 } + +extern enum D2 *pd2; // { dg-warning "redundant enum-key 'enum' in reference to 'enum class D2'" "C++ 11 and above" { target c++11 } } + // { dg-warning "redundant enum-key 'enum' in reference to 'enum D2'" "C++ 98" { target c++98_only } .-1 } + +extern D1 ad1[]; +extern D2 ad2[]; + +#if __cplusplus > 199711L +extern enum class D1 ad1[]; // { dg-warning "redundant enum-key 'enum class' in reference to 'enum class D1'" "C++ 11 and above" { target c++11 } } + // { dg-warning "elaborated-type-specifier for a scoped enum must not use the 'class' keyword" "C++ 11 and above" { target c++11 } .-1 } +/* The pretty printer cannot differentiate between enum class and enum struct + because the C++ front-end doesn't encode it so allow for both in the text + of the warning below. */ +extern enum struct D2 ad2[]; // { dg-warning "redundant enum-key 'enum struct' in reference to 'enum \(class|struct\) D2'" "C++ 11 and above" { target c++11 } } + // { dg-warning "elaborated-type-specifier for a scoped enum must not use the 'struct' keyword" "C++ 11 and above" { target c++11 } .-1 } +#else +extern enum D1 ad1[]; // { dg-warning "redundant enum-key 'enum' in reference to 'enum D1'" "C++ 98" { target c++98_only } } +#endif + +void func (D1*); +void func (enum D1*); // { dg-warning "redundant enum-key 'enum' in reference to 'enum " } + +void func (D2*); +void func (enum D2*); // { dg-warning "redundant enum-key 'enum' in reference to 'enum " } + +int D1, D2; + +extern enum D1 *pd1; +extern enum D1 ad1[]; +void func (enum D1*); + +extern enum D2 *pd2; +extern enum D2 ad2[]; +void func (enum D2*); + + +union U; + +extern U *pu; +extern union U *pu; // { dg-warning "redundant class-key 'union' in reference to 'union U'" } + +extern U au[]; +extern union U au[]; // { dg-warning "redundant class-key 'union' in reference to 'union U'" } + +void func (U*); +void func (union U*); // { dg-warning "redundant class-key 'union' in reference to 'union U'" } + +int U; + +extern union U *pu; +extern union U au[]; +void func (union U*); diff --git a/gcc/testsuite/g++.dg/warn/Wstringop-overflow-3.C b/gcc/testsuite/g++.dg/warn/Wstringop-overflow-3.C index db67136..da9ad6f 100644 --- a/gcc/testsuite/g++.dg/warn/Wstringop-overflow-3.C +++ b/gcc/testsuite/g++.dg/warn/Wstringop-overflow-3.C @@ -12,7 +12,7 @@ void sink (void*); struct Ax { char n; - char a[]; // { dg-message "at offset \[0-2\] to object 'Ax::a' declared here" } + char a[]; // { dg-message "at offset \[0-2\] to object 'Ax::a' declared here" "note: flexarray" } }; // Verify warning for a definition with no initializer. @@ -93,7 +93,7 @@ NOIPA void gaxx () struct A0 { char n; - char a[0]; // { dg-message "at offset \[0-2\] to object 'A0::a' with size 0 declared here" } + char a[0]; // { dg-message "at offset \[0-2\] to object 'A0::a' with size 0 declared here" "note: trailing zero-length array" } }; // Verify warning for a definition with no initializer. @@ -160,7 +160,7 @@ NOIPA void ga0x () struct A1 { char n; - char a[1]; // { dg-message "at offset \[1-9\] to object 'A1::a' with size 1 declared here" } + char a[1]; // { dg-message "at offset \[1-9\] to object 'A1::a' with size 1 declared here" "note: trailing one-element array" } }; // Verify warning for a definition with no initializer. @@ -234,7 +234,7 @@ NOIPA void ga1x () struct A1i { char n; - char a[1]; // { dg-message "at offset \[1-9\] to object 'A1i::a' with size 1 declared here" } + char a[1]; // { dg-message "at offset \[1-9\] to object 'A1i::a' with size 1 declared here" "note: interior one-element array" } char x; }; @@ -307,7 +307,7 @@ NOIPA void ga1ix () struct Bx { char n; - char a[]; // { dg-message "at offset 0 to object 'Bx::a' declared here" } + char a[]; // { dg-message "at offset 0 to object 'Bx::a' declared here" "note: flexarray class member" } // Verify the warning for a constant. Bx () { a[0] = 0; } // { dg-warning "\\\[-Wstringop-overflow" } @@ -332,7 +332,7 @@ NOIPA void gbxi (int i) struct B0 { char n; - char a[0]; // { dg-message "at offset 0 to object 'B0::a' with size 0 declared here" } + char a[0]; // { dg-message "at offset 0 to object 'B0::a' with size 0 declared here" "note: zero-length trailing array class member" } B0 () { a[0] = 0; } // { dg-warning "\\\[-Wstringop-overflow" } }; @@ -348,7 +348,7 @@ NOIPA void gb0 (void) struct B1 { char n; - char a[1]; // { dg-message "at offset 1 to object 'B1::a' with size 1 declared here" } + char a[1]; // { dg-message "at offset 1 to object 'B1::a' with size 1 declared here" "note: one-element trailing array class member" } B1 () { a[1] = 0; } // { dg-warning "\\\[-Wstringop-overflow" } }; @@ -362,7 +362,7 @@ NOIPA void gb1 (void) struct B123 { - char a[123]; // { dg-message "at offset 123 to object 'B123::a' with size 123 declared here" } + char a[123]; // { dg-message "at offset 123 to object 'B123::a' with size 123 declared here" "note: large trailing array class member" } B123 () { a[123] = 0; } // { dg-warning "\\\[-Wstringop-overflow" } }; @@ -376,7 +376,7 @@ NOIPA void gb123 (void) struct B234 { - char a[234]; // { dg-message "at offset 234 to object 'B234::a' with size 234 declared here" } + char a[234]; // { dg-message "at offset 234 to object 'B234::a' with size 234 declared here" "note: large trailing array class member" } B234 (int i) { a[i] = 0; } // { dg-warning "\\\[-Wstringop-overflow" } }; diff --git a/gcc/testsuite/g++.old-deja/g++.brendan/sizeof1.C b/gcc/testsuite/g++.old-deja/g++.brendan/sizeof1.C index bc2f181..47ee162 100644 --- a/gcc/testsuite/g++.old-deja/g++.brendan/sizeof1.C +++ b/gcc/testsuite/g++.old-deja/g++.brendan/sizeof1.C @@ -9,7 +9,7 @@ int main() { // sizeof may not be applied to a function - int i = sizeof( f);// { dg-error "" } .* + int i = sizeof( f);// { dg-error "19:ISO C\\+\\+ forbids applying .sizeof." } .* return 0; } diff --git a/gcc/testsuite/g++.old-deja/g++.brendan/sizeof3.C b/gcc/testsuite/g++.old-deja/g++.brendan/sizeof3.C index 3596a1e..309f1b6 100644 --- a/gcc/testsuite/g++.old-deja/g++.brendan/sizeof3.C +++ b/gcc/testsuite/g++.old-deja/g++.brendan/sizeof3.C @@ -9,7 +9,7 @@ int main() { // sizeof may not be applied to an undefined class - int k = sizeof (bar);// { dg-error "" } .* + int k = sizeof (bar);// { dg-error "11:invalid application of .sizeof. to incomplete type" } .* return 0; } diff --git a/gcc/testsuite/g++.old-deja/g++.brendan/sizeof4.C b/gcc/testsuite/g++.old-deja/g++.brendan/sizeof4.C index 3ac0a8e..8649c75 100644 --- a/gcc/testsuite/g++.old-deja/g++.brendan/sizeof4.C +++ b/gcc/testsuite/g++.old-deja/g++.brendan/sizeof4.C @@ -7,7 +7,7 @@ int main() { // sizeof may not be applied to the type void - int l = sizeof (void);// { dg-error "" } .* + int l = sizeof (void);// { dg-error "11:invalid application of .sizeof. to a void type" } .* return 0; } diff --git a/gcc/testsuite/g++.old-deja/g++.eh/ctor1.C b/gcc/testsuite/g++.old-deja/g++.eh/ctor1.C index 93f6dcd..cc39ac3 100644 --- a/gcc/testsuite/g++.old-deja/g++.eh/ctor1.C +++ b/gcc/testsuite/g++.old-deja/g++.eh/ctor1.C @@ -11,7 +11,7 @@ main () try { throw A(); // { dg-error "rvalue" "" { target c++14_down } } can't copy - // { dg-error "thrown expression" "expr" { target c++14_down } .-1 } + // { dg-message "13:thrown expression" "expr" { target c++14_down } .-1 } } catch (...) { } } diff --git a/gcc/testsuite/g++.old-deja/g++.jason/ambig1.C b/gcc/testsuite/g++.old-deja/g++.jason/ambig1.C index 9be10eb..e612399 100644 --- a/gcc/testsuite/g++.old-deja/g++.jason/ambig1.C +++ b/gcc/testsuite/g++.old-deja/g++.jason/ambig1.C @@ -3,5 +3,5 @@ // Testcase for ambiguity between functional cast and abstract declarator. // This ambiguity accounts for 6 of the r/r conflicts. -int i = sizeof (int ()); // { dg-error "" } sizeof applied to fn type +int i = sizeof (int ()); // { dg-error "9:invalid application of .sizeof. to a function type" } sizeof applied to fn type int j = sizeof (int () + 1); diff --git a/gcc/testsuite/g++.old-deja/g++.other/sizeof4.C b/gcc/testsuite/g++.old-deja/g++.other/sizeof4.C index 325d3d0..3a2699a 100644 --- a/gcc/testsuite/g++.old-deja/g++.other/sizeof4.C +++ b/gcc/testsuite/g++.old-deja/g++.other/sizeof4.C @@ -17,21 +17,21 @@ void fn () {} int main (int argc, char **argv) { - sizeof (s); // { dg-error "" } incomplete - sizeof (0, s); // { dg-error "" } incomplete - sizeof (argc ? s : s); // { dg-error "" } incomplete + sizeof (s); // { dg-error "3:invalid application of .sizeof. to incomplete type" } incomplete + sizeof (0, s); // { dg-error "3:invalid application of .sizeof. to incomplete type" } incomplete + sizeof (argc ? s : s); // { dg-error "3:invalid application of .sizeof. to incomplete type" } incomplete - sizeof (arys); // { dg-error "" } incomplete - sizeof (0, arys); // { dg-error "" } incomplete - sizeof (argc ? arys : arys); // { dg-error "" } incomplete + sizeof (arys); // { dg-error "3:invalid application of .sizeof. to incomplete type" } incomplete + sizeof (0, arys); // { dg-error "3:invalid application of .sizeof. to incomplete type" } incomplete + sizeof (argc ? arys : arys); // { dg-error "3:invalid application of .sizeof. to incomplete type" } incomplete - sizeof (aryt); // { dg-error "" } incomplete - sizeof (0, aryt); // { dg-error "" } incomplete - sizeof (argc ? aryt : aryt); // { dg-error "" } incomplete + sizeof (aryt); // { dg-error "3:invalid application of .sizeof. to incomplete type" } incomplete + sizeof (0, aryt); // { dg-error "3:invalid application of .sizeof. to incomplete type" } incomplete + sizeof (argc ? aryt : aryt); // { dg-error "3:invalid application of .sizeof. to incomplete type" } incomplete - sizeof (fn); // { dg-error "" } cannot take size of function - sizeof (0, fn); // { dg-error "" } cannot take size of function - sizeof (argc ? fn : fn); // { dg-error "" } cannot take size of function + sizeof (fn); // { dg-error "11:ISO C\\+\\+ forbids applying .sizeof." } cannot take size of function + sizeof (0, fn); // { dg-error "3:invalid application of .sizeof. to a function type" } cannot take size of function + sizeof (argc ? fn : fn); // { dg-error "3:invalid application of .sizeof. to a function type" } cannot take size of function sizeof (&fn); // ok sizeof (0, &fn); // ok diff --git a/gcc/testsuite/gcc.c-torture/compile/bitfield-1.c b/gcc/testsuite/gcc.c-torture/compile/bitfield-1.c new file mode 100644 index 0000000..0d5a82c --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/bitfield-1.c @@ -0,0 +1,13 @@ +/* { dg-require-effective-target int128 } */ + +struct f +{ + __uint128_t t:124; + __uint128_t t1:4; +}; + +struct f g(void) +{ + struct f t = {1, 2}; + return t; +} diff --git a/gcc/testsuite/gcc.c-torture/compile/bitfield-endian-1.c b/gcc/testsuite/gcc.c-torture/compile/bitfield-endian-1.c new file mode 100644 index 0000000..90920c9 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/bitfield-endian-1.c @@ -0,0 +1,15 @@ +/* { dg-require-effective-target int128 } */ + +#define ENDIAN __attribute((scalar_storage_order ("big-endian"))) + +typedef struct ENDIAN +{ + __uint128_t t:124; + __uint128_t t1:4; +}f; + +f g(void) +{ + f t = {1, 2}; + return t; +} diff --git a/gcc/testsuite/gcc.c-torture/compile/bitfield-endian-2.c b/gcc/testsuite/gcc.c-torture/compile/bitfield-endian-2.c new file mode 100644 index 0000000..7644f71 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/bitfield-endian-2.c @@ -0,0 +1,15 @@ +/* { dg-require-effective-target int128 } */ + +#define ENDIAN __attribute((scalar_storage_order ("little-endian"))) + +typedef struct ENDIAN +{ + __uint128_t t:124; + __uint128_t t1:4; +}f; + +f g(void) +{ + f t = {1, 2}; + return t; +} diff --git a/gcc/testsuite/gcc.dg/Warray-bounds-46.c b/gcc/testsuite/gcc.dg/Warray-bounds-46.c index 4980f93..74e78cb 100644 --- a/gcc/testsuite/gcc.dg/Warray-bounds-46.c +++ b/gcc/testsuite/gcc.dg/Warray-bounds-46.c @@ -3,7 +3,7 @@ Test to verify that past-the-end accesses by string functions to member arrays by-reference objects are diagnosed. { dg-do compile } - { dg-options "-O2 -Wall -Wno-unused-local-typedefs -ftrack-macro-expansion=0" } */ + { dg-options "-O2 -Wall -Wno-unused-local-typedefs -Wno-stringop-overflow -ftrack-macro-expansion=0" } */ #define SA(expr) typedef int StaticAssert [2 * !!(expr) - 1] diff --git a/gcc/testsuite/gcc.dg/Warray-bounds-47.c b/gcc/testsuite/gcc.dg/Warray-bounds-47.c index 06ad488..848ef36 100644 --- a/gcc/testsuite/gcc.dg/Warray-bounds-47.c +++ b/gcc/testsuite/gcc.dg/Warray-bounds-47.c @@ -1,7 +1,7 @@ /* PR middle-end/91830 - Bogus -Warray-bounds on strcpy into a member of a subobject compiling binutils { dg-do compile } - { dg-options "-O2 -Wall -ftrack-macro-expansion=0" } */ + { dg-options "-O2 -Wall -Wno-stringop-overflow -ftrack-macro-expansion=0" } */ extern char* strcpy (char*, const char*); extern void sink (void*); diff --git a/gcc/testsuite/gcc.dg/Warray-bounds-52.c b/gcc/testsuite/gcc.dg/Warray-bounds-52.c new file mode 100644 index 0000000..1a7d76f --- /dev/null +++ b/gcc/testsuite/gcc.dg/Warray-bounds-52.c @@ -0,0 +1,97 @@ +/* PR middle-end/92341 - missing -Warray-bounds indexing past the end + of a compound literal + { dg-do compile } + { dg-options "-O2 -Wall -ftrack-macro-expansion=0" } */ + +#include "range.h" + +#define INT_MAX __INT_MAX__ +#define INT_MIN (-__INT_MAX__ - 1) + +void sink (int, ...); + + +#define T(...) sink (__LINE__, (__VA_ARGS__)) + + +void direct_idx_cst (void) +{ + T ((int[]){ }[-1]); // { dg-warning "array subscript -1 is outside array bounds of 'int\\\[0]'" } + T ((int[]){ }[0]); // { dg-warning "array subscript 0 is outside array bounds of 'int\\\[0]'" } + T ((int[]){ }[1]); // { dg-warning "array subscript 1 is outside array bounds of 'int\\\[0]'" } + + T ((int[]){ 1 }[-1]); // { dg-warning "array subscript -1 is below array bounds of 'int\\\[1]'" } + T ((int[]){ 1 }[0]); + T ((int[]){ 1 }[1]); // { dg-warning "array subscript 1 is above array bounds of 'int\\\[1]'" } + T ((int[]){ 1 }[INT_MIN]); // { dg-warning "array subscript -\[0-9\]+ is below array bounds of 'int\\\[1]'" } + T ((int[]){ 1 }[INT_MAX]); // { dg-warning "array subscript \[0-9\]+ is above array bounds of 'int\\\[1]'" } + T ((int[]){ 1 }[SIZE_MAX]); // { dg-warning "array subscript \[0-9\]+ is above array bounds of 'int\\\[1]'" } +} + + +void direct_idx_var (int i) +{ + T ((char[]){ }[i]); // { dg-warning "array subscript i is outside array bounds of 'char\\\[0]'" } + T ((int[]){ }[i]); // { dg-warning "array subscript i is outside array bounds of 'int\\\[0]'" } +} + + +void direct_idx_range (void) +{ + ptrdiff_t i = SR (-2, -1); + + T ((int[]){ 1 }[i]); // { dg-warning "array subscript \[ \n\r]+ is outside array bounds of 'int\\\[0]'" "pr?????" { xfail *-*-* } } +} + + +#undef T +#define T(idx, ...) do { \ + int *p = (__VA_ARGS__); \ + sink (p[idx]); \ + } while (0) + +void ptr_idx_cst (void) +{ + T (-1, (int[]){ }); // { dg-warning "array subscript -1 is outside array bounds of 'int\\\[0]'" } + T ( 0, (int[]){ }); // { dg-warning "array subscript 0 is outside array bounds of 'int\\\[0]'" } + T (+1, (int[]){ }); // { dg-warning "array subscript 1 is outside array bounds of 'int\\\[0]'" } + + T (-1, (int[]){ 1 }); // { dg-warning "array subscript -1 is outside array bounds of 'int\\\[1]'" } + T ( 0, (int[]){ 1 }); + T (+1, (int[]){ 1 }); // { dg-warning "array subscript 1 is outside array bounds of 'int\\\[1]'" } + T (INT_MIN, (int[]){ 1 }); // { dg-warning "array subscript -\[0-9\]+ is outside array bounds of 'int\\\[1]'" "lp64" { xfail ilp32 } } + T (INT_MAX, (int[]){ 1 }); // { dg-warning "array subscript \[0-9\]+ is outside array bounds of 'int\\\[1]'" "lp64" { target lp64 } } + // { dg-warning "array subscript -1 is outside array bounds of 'int\\\[1]'" "ilp32" { target ilp32 } .-1 } + T (SIZE_MAX, (int[]){ 1 }); // { dg-warning "array subscript -?\[0-9\]+ is outside array bounds of 'int\\\[1]'" } +} + + +void ptr_idx_var (int i) +{ + T (i, (int[]){ }); // { dg-warning "array subscript \[^\n\r\]+ is outside array bounds of 'int\\\[0]'" } + T (i, (int[]){ 1 }); + T (i, (int[]){ i, 1 }); +} + +void ptr_idx_range (void) +{ + ptrdiff_t i = SR (-2, -1); + + T (i, (int[]){ }); // { dg-warning "array subscript \\\[-2, -1] is outside array bounds of 'int\\\[0]'" } + T (i, (int[]){ 1 }); // { dg-warning "array subscript \\\[-2, -1] is outside array bounds of 'int\\\[1]'" } + T (i, (int[]){ i }); // { dg-warning "array subscript \\\[-2, -1] is outside array bounds of 'int\\\[1]'" } + + i = SR (0, 1); + + T (i, (int[]){ }); // { dg-warning "array subscript \\\[0, 1] is outside array bounds of 'int\\\[0]'" } + T (i, (int[]){ 1 }); + + i = SR (1, 2); + T (i, (int[]){ 1 }); // { dg-warning "array subscript \\\[1, 2] is outside array bounds of 'int\\\[1]'" } + + i = SR (2, 3); + T (i, (int[]){ 1, 2, 3 }); + + i = SR (3, 4); + T (i, (int[]){ 2, 3, 4 }); // { dg-warning "array subscript \\\[3, 4] is outside array bounds of 'int\\\[3]'" } +} diff --git a/gcc/testsuite/gcc.dg/Wstringop-overflow-27.c b/gcc/testsuite/gcc.dg/Wstringop-overflow-27.c new file mode 100644 index 0000000..249ce2b --- /dev/null +++ b/gcc/testsuite/gcc.dg/Wstringop-overflow-27.c @@ -0,0 +1,293 @@ +/* PR middle-end/91582 - missing heap overflow detection for strcpy + PR middle-end/85484 - missing -Wstringop-overflow for strcpy with + a string of non-const length + { dg-do compile } + { dg-options "-O2 -Wall -Wno-array-bounds" } */ + +typedef __SIZE_TYPE__ size_t; + +extern void* calloc (size_t, size_t); +extern void* malloc (size_t); +extern void* memcpy (void*, const void*, size_t); +extern void* memset (void*, int, size_t); +extern char* strcpy (char*, const char*); +extern size_t strlen (const char*); + +void sink (void*); + + +void test_memcpy_nowarn (const void *s, int i, size_t n) +{ + sink (memcpy (calloc (1, 1), s, 1)); + sink (memcpy (calloc (1, 2), s, 1)); + sink (memcpy (calloc (2, 1), s, 1)); + sink (memcpy (calloc (3, 1), s, 2)); + sink (memcpy (calloc (3, 1), "12", 2)); + sink (memcpy (calloc (3, 1), s, 3)); + sink (memcpy (calloc (3, 1), "12", 3)); + sink (memcpy (calloc (i, 1), s, 1)); + sink (memcpy (calloc (n, 1), s, 1)); + sink (memcpy (calloc (1, n), "", 1)); + sink (memcpy (calloc (1, i), "", 1)); + sink (memcpy (calloc (i, 1), "123", 3)); + sink (memcpy (calloc (n, 1), "123", 3)); + sink (memcpy (calloc (1, i), "123456", 7)); + sink (memcpy (calloc (1, n), "123456", 7)); + sink (memcpy (calloc (n, 1), s, 12345)); + sink (memcpy (calloc (1, n), s, n - 1)); + sink (memcpy (calloc (n, 1), s, n)); + + sink (memcpy ((char*)calloc (1, 1) + i, "123", 1)); + sink (memcpy ((char*)calloc (n, 1) + i, "123", n)); + + sink (memcpy ((char*)calloc (1, 1) + i, s, 1)); + sink (memcpy ((char*)calloc (n, 1) + i, s, n)); + + sink (memcpy (malloc (1), s, 1)); + sink (memcpy (malloc (2), s, 1)); + sink (memcpy (malloc (3), s, 2)); + sink (memcpy (malloc (3), "12", 2)); + sink (memcpy (malloc (3), s, 3)); + sink (memcpy (malloc (3), "12", 3)); + sink (memcpy (malloc (n), s, 1)); + sink (memcpy (malloc (n), "", 1)); + sink (memcpy (malloc (n), "123", 3)); + sink (memcpy (malloc (n), "123456", 7)); + sink (memcpy (malloc (n), s, 12345)); + sink (memcpy (malloc (n), s, n - 1)); + sink (memcpy (malloc (n), s, n)); + + { + const int a[] = { 1, 2, 3, 4 }; + void *p = (char*)malloc (sizeof a); + memcpy (p, a, sizeof a); + sink (p); + } + + { + const int a[] = { 1, 2, 3, 4, 5 }; + size_t nelts = sizeof a / sizeof *a; + int vla[nelts]; + memcpy (vla, a, nelts * sizeof *vla); + sink (vla); + } +} + + +void test_memcpy_warn (const int *s, size_t n) +{ + { + void *p = (char*)malloc (0); + memcpy (p, s, 1); // { dg-warning "writing 1 byte into a region of size 0" } + sink (p); + } + + { + void *p = (char*)malloc (1); + memcpy (p, s, 2); // { dg-warning "writing 2 bytes into a region of size 1" } + sink (p); + } + + { + void *p = (char*)malloc (2); + memcpy (p, s, 3); // { dg-warning "writing 3 bytes into a region of size 2" } + sink (p); + } + + { + void *p = (char*)malloc (3); + memcpy (p, s, 4); // { dg-warning "writing 4 bytes into a region of size 3" } + sink (p); + } + + { + const int a[] = { 1, 2, 3, 4 }; + void *p = (char*)malloc (sizeof *a); + memcpy (p, a, sizeof a); // { dg-warning "" } + sink (p); + } + + { + const int a[] = { 1, 2, 3, 4, 5 }; + size_t nelts = sizeof a / sizeof *a; + char vla[nelts]; + memcpy (vla, a, nelts * sizeof *a); // { dg-warning "" } + sink (vla); + } + + { + void *p = malloc (n); + memcpy (p, s, n * sizeof *s); // { dg-warning "\\\[-Wstringop-overflow" "" { xfail *-*-* } } + sink (p); + } +} + +void test_memset_nowarn (int x, size_t n) +{ + sink (memset (calloc (1, 1), x, 1)); + sink (memset (calloc (1, 2), x, 1)); + sink (memset (calloc (2, 1), x, 1)); + sink (memset (calloc (3, 1), x, 2)); + sink (memset (calloc (3, 1), x, 3)); + sink (memset (calloc (n, 1), x, 1)); + sink (memset (calloc (n, 1), x, 12345)); + sink (memset (calloc (1, n), x, n - 1)); + sink (memset (calloc (n, 1), x, n)); + + sink (memset (malloc (1), x, 1)); + sink (memset (malloc (2), x, 1)); + sink (memset (malloc (3), x, 2)); + sink (memset (malloc (3), x, 3)); + sink (memset (malloc (n), x, 1)); + sink (memset (malloc (n), x, 12345)); + sink (memset (malloc (n), x, n - 1)); + sink (memset (malloc (n), x, n)); + + { + const int a[] = { 1, 2, 3, 4 }; + void *p = (char*)malloc (sizeof a); + memset (p, x, sizeof a); + sink (p); + } + + { + const int a[] = { 1, 2, 3, 4, 5 }; + size_t nelts = sizeof a / sizeof *a; + int vla[nelts]; + memset (vla, x, nelts * sizeof *vla); + sink (vla); + } +} + + +void test_memset_warn (int x, size_t n) +{ + { + void *p = (char*)malloc (0); + memset (p, x, 1); // { dg-warning "writing 1 byte into a region of size 0" } + sink (p); + } + + { + void *p = (char*)malloc (1); + memset (p, x, 2); // { dg-warning "writing 2 bytes into a region of size 1" } + sink (p); + } + + { + void *p = (char*)malloc (2); + memset (p, x, 3); // { dg-warning "writing 3 bytes into a region of size 2" } + sink (p); + } + + { + void *p = (char*)malloc (3); + memset (p, x, 4); // { dg-warning "writing 4 bytes into a region of size 3" } + sink (p); + } + + { + const int a[] = { 1, 2, 3, 4 }; + void *p = (char*)malloc (sizeof *a); + memset (p, 0, sizeof a); // { dg-warning "" } + sink (p); + } + + { + const int a[] = { 1, 2, 3, 4, 5 }; + size_t nelts = sizeof a / sizeof *a; + char vla[nelts]; + memset (vla, 0, nelts * sizeof *a); // { dg-warning "" } + sink (vla); + } + + { + void *p = malloc (n); + memset (p, x, n * sizeof (int)); // { dg-warning "\\\[-Wstringop-overflow" "" { xfail *-*-* } } + sink (p); + } +} + + +void test_strcpy_nowarn (const char *s) +{ + { + const char a[] = "12"; + int n = strlen (a); + char *t = (char*)calloc (2, n); + strcpy (t, a); + sink (t); + } + + { + const char a[] = "123"; + unsigned n = strlen (a) + 1; + char *t = (char*)calloc (n, 1); + strcpy (t, a); + sink (t); + } + + { + const char a[] = "1234"; + size_t n = strlen (a) * 2; + char *t = (char*)malloc (n); + strcpy (t, a); + sink (t); + } + + { + const char a[] = "1234"; + size_t len = strlen (a) + 1; + char vla[len]; + strcpy (vla, a); + sink (vla); + } + + { + size_t n = strlen (s) + 1; + char *t = (char*)malloc (n); + strcpy (t, s); + sink (t); + } +} + + +void test_strcpy_warn (const char *s) +{ + { + const char a[] = "123"; + /* Verify that using signed int for the strlen result works (i.e., + that the conversion from signed int to size_t doesn't prevent + the detection. */ + int n = strlen (a); + char *t = (char*)calloc (n, 1); // { dg-message "at offset 0 to an object with size 3 allocated by 'calloc' here" "calloc note" { xfail *-*-* } } + // { dg-message "at offset 0 to an object with size at most 3 allocated by 'calloc' here" "calloc note" { target *-*-* } .-1 } + strcpy (t, a); // { dg-warning "writing 4 bytes into a region of size (between 0 and )?3 " } + + sink (t); + } + + { + const char a[] = "1234"; + size_t n = strlen (a); + char *t = (char*)malloc (n); // { dg-message "at offset 0 to an object with size 4 allocated by 'malloc' here" "malloc note" { xfail *-*-* } } + // { dg-message "at offset 0 to an object with size at most 4 allocated by 'malloc' here" "malloc note" { target *-*-* } .-1 } + strcpy (t, a); // { dg-warning "writing 5 bytes into a region of size (between 0 and )?4 " } + sink (t); + } + + // Exercise PR middle-end/85484. + { + size_t len = strlen (s); + char vla[len]; // { dg-message "at offset 0 to an object declared here" "vla note" } + strcpy (vla, s); // { dg-warning "writing one too many bytes into a region of a size that depends on 'strlen'" } + sink (vla); + } + + { + size_t n = strlen (s); + char *t = (char*)malloc (n); // { dg-message "at offset 0 to an object allocated by 'malloc' here" "malloc note" } + strcpy (t, s); // { dg-warning "writing one too many bytes into a region of a size that depends on 'strlen'" } + sink (t); + } +} diff --git a/gcc/testsuite/gcc.dg/Wstringop-overflow-28.c b/gcc/testsuite/gcc.dg/Wstringop-overflow-28.c new file mode 100644 index 0000000..8844b9f --- /dev/null +++ b/gcc/testsuite/gcc.dg/Wstringop-overflow-28.c @@ -0,0 +1,236 @@ +/* PR middle-end/91582 - missing heap overflow detection for strcpy + { dg-do compile } + { dg-options "-O2 -Wall -Wno-array-bounds -ftrack-macro-expansion=0" } */ + +#include "range.h" + +#define INT_MAX __INT_MAX__ +#define INT_MIN (-INT_MAX - 1) + +#define ATTR(...) __attribute__ ((__VA_ARGS__)) +#define NOIPA ATTR (noipa) + +extern void* alloca (size_t); +extern void* calloc (size_t, size_t); +extern void* malloc (size_t); + +extern ATTR (alloc_size (1), malloc) char* alloc1 (size_t); +extern ATTR (alloc_size (1, 2), malloc) char* alloc2 (size_t, size_t); + +extern char* strcpy (char*, const char*); + +void sink (void*, ...); + + +/* Verify warning in stores to an object of variable size N in a known + range, at an offset (N + I) with a constant I. */ + +void same_size_and_offset_idx_cst (void) +{ +#define T(size, off, idx) do { \ + size_t n_ = size; \ + ptrdiff_t i_ = idx; \ + char *p_ = alloc1 (n_); \ + p_ += off; \ + p_[i_] = 0; \ + sink (p_); \ + } while (0) + + { + const size_t n = UR (2, 3); + + T (n, n, -4); // { dg-warning "writing 1 byte into a region of size 0" } + // { dg-message "at offset \\\[-2, -1] to an object with size between 2 and 3 allocated by 'alloc1'" "note" { target *-*-* } .-1 } + T (n, n, -3); + T (n, n, -2); + T (n, n, -1); + T (n, n, 0); + T (n, n, 1); // { dg-warning "writing 1 byte into a region of size 0" } + // { dg-message "at offset \\\[3, 4] to an object with size between 2 and 3 allocated by 'alloc1'" "note" { target *-*-* } .-1 } + } + + { + const size_t n = UR (3, 4); + + T (n, n, -5); // { dg-warning "writing 1 byte into a region of size 0" } + // { dg-message "at offset \\\[-2, -1] to an object with size between 3 and 4 allocated by 'alloc1'" "note" { target *-*-* } .-1 } + T (n, n, -4); + T (n, n, -3); + T (n, n, -2); + T (n, n, -1); + T (n, n, 0); + T (n, n, 1); // { dg-warning "writing 1 byte into a region of size 0" } + // { dg-message "at offset \\\[4, 5] to an object with size between 3 and 4 allocated by 'alloc1'" "note" { target *-*-* } .-1 } + } + + { + const size_t n = UR (5, SIZE_MAX - 2); + T (n, n, -1); + T (n, n, -1); + T (n, n, -1); + T (n, n, -1); + } +} + + +/* Verify warning in stores to an object of variable size N in a known + range, at an offset (M + I) with a variable M in some range and + constant I. */ + +void different_size_and_offset_idx_cst (void) +{ + { + const size_t n = UR (2, 3); + const size_t i = UR (1, 2); + + T (n, i, -4); // { dg-warning "writing 1 byte into a region of size 0" } + // { dg-message "at offset \\\[-3, -2] to an object with size between 2 and 3 allocated by 'alloc1'" "note" { target *-*-* } .-1 } + T (n, i, -3); // { dg-warning "writing 1 byte into a region of size 0" } + // { dg-message "at offset \\\[-2, -1] to an object with size between 2 and 3 allocated by 'alloc1'" "note" { target *-*-* } .-1 } + T (n, i, -2); + T (n, i, -1); + T (n, i, 0); + T (n, i, 1); + T (n, i, 2); // { dg-warning "writing 1 byte into a region of size 0" } + // { dg-message "at offset \\\[3, 4] to an object with size between 2 and 3 allocated by 'alloc1'" "note" { target *-*-* } .-1 } + } + + { + const size_t n = UR (3, 4); + const size_t i = UR (2, 5); + + T (n, i, -6); // { dg-warning "writing 1 byte into a region of size 0" } + // { dg-message "at offset \\\[-4, -1] to an object with size between 3 and 4 allocated by 'alloc1'" "note" { target *-*-* } .-1 } + + /* The offsets -5 and -4 are both necessarily invalid even if the sum + (i - 5) and (i - 4) are (or could be) in bounds because they imply + that the intermediate offset (p + i) is out of bounds. */ + T (n, i, -5); // { dg-warning "" "intermediate offset" { xfail *-*-* } } + T (n, i, -4); // { dg-warning "" "intermediate offset" { xfail *-*-* } } + T (n, i, -3); + T (n, i, -2); + T (n, i, -1); + T (n, i, 0); + T (n, i, 1); + T (n, i, 2); // { dg-warning "writing 1 byte into a region of size 0" } + // { dg-message "at offset \\\[4, 7] to an object with size between 3 and 4 allocated by 'alloc1'" "note" { target *-*-* } .-1 } + } +} + + +/* Verify warning in stores to an object of variable size N in a known + range, at an offset (M + I) with a variable M in some range and + constant I. */ +void different_size_and_offset_idx_var (void) +{ + { + const size_t n = UR (3, 4); + const size_t i = UR (1, 2); + + T (n, i, SR (DIFF_MIN, 0)); + T (n, i, SR ( -3, 0)); + T (n, i, SR ( -1, 0)); + T (n, i, SR ( 0, 1)); + T (n, i, SR ( 1, 2)); + T (n, i, SR ( 2, 3)); + /* The warning is issued below but the offset and the size in + the note are wrong. See the FIXME in compute_objsize(). */ + T (n, i, SR ( 3, 4)); // { dg-warning "\\\[-Wstringop-overflow" } + // { dg-message "at offset 4 to an object with size between 3 and 4 allocated by 'alloc1'" "pr92940 note: offset addition" { xfail *-*-* } .-1 } + // { dg-message "at offset . to an object with size . allocated by 'alloc1'" "note: offset addition" { target *-*-* } .-2 } + } +} + + +void ptr_add_2 (int n, int i0, int i1) +{ + if (n < 1 || 2 < n) n = 2; + + if (i0 < 0 || 1 < i0) i0 = 0; + if (i1 < 1 || 2 < i1) i1 = 1; + + char *p = (char*)__builtin_malloc (n); + char *q = p; + + q += i0; + q[0] = 0; // p[0] + q += i1; + q[0] = 1; // p[1] + q[1] = 2; // p[2] // { dg-warning "\\\[-Wstringop-overflow" } + + sink (p, q); +} + +void ptr_add_3 (int n, int i0, int i1, int i2) +{ + if (n < 3 || 4 < n) n = 3; + + if (i0 < 0 || 1 < i0) i0 = 0; + if (i1 < 1 || 2 < i1) i1 = 1; + if (i2 < 2 || 3 < i2) i2 = 2; + + char *p = (char*)__builtin_malloc (n); + char *q = p; + + q += i0; + q[0] = 0; // p[0] + q += i1; + q[0] = 1; // p[1] + q[1] = 2; // p[2] + q += i2; + q[0] = 3; // p[3] + q[1] = 4; // p[4] // { dg-warning "\\\[-Wstringop-overflow" } + + sink (p, q); +} + +void ptr_add_4 (int n, int i0, int i1, int i2, int i3) +{ + if (n < 7 || 8 < n) n = 7; + + if (i0 < 0 || 1 < i0) i0 = 0; + if (i1 < 1 || 2 < i1) i1 = 1; + if (i2 < 2 || 3 < i2) i2 = 2; + if (i3 < 3 || 4 < i3) i3 = 3; + + char *p = (char*)__builtin_malloc (n); + char *q = p; + + q += i0; + q[0] = 0; // p[0] + q += i1; + q[0] = 1; // p[1] + q[1] = 2; // p[2] + q += i2; + q[0] = 3; // p[3] + q[1] = 4; // p[4] + q[2] = 5; // p[5] + q += i3; + q[0] = 6; // p[6] + q[1] = 7; // p[7] + q[2] = 8; // p[8] // { dg-warning "\\\[-Wstringop-overflow" } + + sink (p, q); +} + +void ptr_sub_from_end (int n, int i0, int i1, int i2, int i3) +{ + if (n < 1 || 2 < n) n = 2; + + char *p = (char*)__builtin_malloc (n); + char *q = p; + + // The following isn't diagnosed due to a bug/limitation. + q += n; // N=1 N=2 + q[-1] = 0; // p[0] p[1] + q[-2] = 1; // p[-1] p[0] + q[-3] = 2; // p[-2] p[-1] // { dg-warning "\\\[-Wstringop-overflow" "pr92939: negative offset from end" { xfail *-*-* } } + + /* The following isn't diagnosed because the warning doesn't recognize + the index below as necessarily having the same value as the size + argument to malloc. All it considers is the range. */ + q[0] = 2; // { dg-warning "\\\[-Wstringop-overflow" "pr92937: store just past the end" { xfail *-*-* } } + q[1] = 3; // { dg-warning "\\\[-Wstringop-overflow" } + + sink (p, q); +} diff --git a/gcc/testsuite/gcc.dg/Wstringop-overflow-29.c b/gcc/testsuite/gcc.dg/Wstringop-overflow-29.c new file mode 100644 index 0000000..c011d05 --- /dev/null +++ b/gcc/testsuite/gcc.dg/Wstringop-overflow-29.c @@ -0,0 +1,66 @@ +/* PR middle-end/91582 - missing heap overflow detection for strcpy + Verify calls via function pointers. + { dg-do compile } + { dg-options "-O2 -Wall -Wno-array-bounds -ftrack-macro-expansion=0" } */ + +typedef __attribute__ ((alloc_size (1))) char* allocfn_t (unsigned); + +extern allocfn_t allocfn; + +void sink (void*); + +void direct_call (void) +{ + char *q = allocfn (0); // { dg-message "at offset 0 to an object with size 0 allocated by 'allocfn'" } + q[0] = 0; // { dg-warning "\\\[-Wstringop-overflow" } + sink (q); +} + + +void local_ptr_call (void) +{ + allocfn_t *ptr = allocfn; + char *q = ptr (1); // { dg-message "at offset -1 to an object with size 1 allocated by 'allocfn'" } + q[0] = 0; + q[-1] = 0; // { dg-warning "\\\[-Wstringop-overflow" } + sink (q); +} + + +void global_ptr_call (void) +{ + extern allocfn_t *ptralloc; + + allocfn_t *ptr = ptralloc; + char *q = ptr (2); // { dg-message "at offset 3 to an object with size 2 allocated by 'ptralloc'" } + q[0] = 0; + q[1] = 1; + q[3] = 3; // { dg-warning "\\\[-Wstringop-overflow" } + sink (q); +} + +void global_ptr_array_call (void) +{ + extern allocfn_t * (arralloc[]); + + allocfn_t *ptr = arralloc[0]; + char *q = ptr (2); // { dg-message "at offset 3 to an object with size 2 allocated by 'ptr'" } + q[0] = 1; + q[1] = 2; + q[3] = 3; // { dg-warning "\\\[-Wstringop-overflow" } + sink (q); +} + + +struct S { allocfn_t *ptralloc; }; + +void member_ptr_call (struct S *p) +{ + char *q = p->ptralloc (3); // { dg-message "at offset 5 to an object with size 3 allocated by 'ptralloc' here" } + q[0] = 0; + q[1] = 1; + q[2] = 2; + q[5] = 0; // { dg-warning "\\\[-Wstringop-overflow" } + sink (q); +} + diff --git a/gcc/testsuite/gcc.dg/attr-alloc_size.c b/gcc/testsuite/gcc.dg/attr-alloc_size.c index 7b0dc6e..4c0cd9a 100644 --- a/gcc/testsuite/gcc.dg/attr-alloc_size.c +++ b/gcc/testsuite/gcc.dg/attr-alloc_size.c @@ -22,15 +22,15 @@ test (void) strcpy (p, "Hello"); p = malloc1 (6); strcpy (p, "Hello"); - strcpy (p, "Hello World"); /* { dg-warning "writing" "strcpy" } */ + strcpy (p, "Hello World"); /* { dg-warning "\\\[-Warray-bounds|-Wstringop-overflow" "strcpy" } */ p = malloc2 (__INT_MAX__ >= 1700000 ? 424242 : __INT_MAX__ / 4, 6); strcpy (p, "World"); - strcpy (p, "Hello World"); /* { dg-warning "writing" "strcpy" } */ + strcpy (p, "Hello World"); /* { dg-warning "\\\[-Warray-bounds|-Wstringop-overflow" "strcpy" } */ p = calloc1 (2, 5); strcpy (p, "World"); - strcpy (p, "Hello World"); /* { dg-warning "writing" "strcpy" } */ + strcpy (p, "Hello World"); /* { dg-warning "\\\[-Warray-bounds|-Wstringop-overflow" "strcpy" } */ p = calloc2 (2, __INT_MAX__ >= 1700000 ? 424242 : __INT_MAX__ / 4, 5); strcpy (p, "World"); - strcpy (p, "Hello World"); /* { dg-warning "writing" "strcpy" } */ + strcpy (p, "Hello World"); /* { dg-warning "\\\[-Warray-bounds|-Wstringop-overflow" "strcpy" } */ } diff --git a/gcc/testsuite/gcc.dg/attr-copy-2.c b/gcc/testsuite/gcc.dg/attr-copy-2.c index f311ca3..ffc7208 100644 --- a/gcc/testsuite/gcc.dg/attr-copy-2.c +++ b/gcc/testsuite/gcc.dg/attr-copy-2.c @@ -99,7 +99,7 @@ void* xref12 (int); void* call_xref12 (void) { void *p = xref12 (3); - __builtin___strcpy_chk (p, "123", __builtin_object_size (p, 0)); /* { dg-warning "\\\[-Wstringop-overflow=]" } */ + __builtin___strcpy_chk (p, "123", __builtin_object_size (p, 0)); /* { dg-warning "\\\[-Warray-bounds|-Wstringop-overflow" } */ return p; } @@ -197,7 +197,7 @@ void* falias_malloc (void); void* call_falias_malloc (void) { char *p = falias_malloc (); - __builtin___strcpy_chk (p, "123", __builtin_object_size (p, 0)); /* { dg-warning "\\\[-Wstringop-overflow=]" } */ + __builtin___strcpy_chk (p, "123", __builtin_object_size (p, 0)); /* { dg-warning "\\\[-Warray-bounds|-Wstringop-overflow" } */ return p; } diff --git a/gcc/testsuite/gcc.dg/builtin-stringop-chk-5.c b/gcc/testsuite/gcc.dg/builtin-stringop-chk-5.c index 320cd51..87dd6ac 100644 --- a/gcc/testsuite/gcc.dg/builtin-stringop-chk-5.c +++ b/gcc/testsuite/gcc.dg/builtin-stringop-chk-5.c @@ -110,7 +110,7 @@ void test_memop_warn_alloc (const void *src) struct A *a = __builtin_malloc (sizeof *a * 2); - memcpy (a, src, n); /* { dg-warning "writing between 8 and 32 bytes into a region of size 4 overflows the destination" "memcpy into allocated" } */ + memcpy (a, src, n); /* { dg-warning "writing between 8 and 32 bytes into a region of size 4 " "memcpy into allocated" } */ escape (a, src); /* At -Wstringop-overflow=1 the destination is considered to be @@ -127,7 +127,7 @@ void test_memop_warn_alloc (const void *src) struct B *b = __builtin_malloc (sizeof *b * 2); - memcpy (&b[0], src, n); /* { dg-warning "writing between 12 and 32 bytes into a region of size 8 overflows the destination" "memcpy into allocated" } */ + memcpy (&b[0], src, n); /* { dg-warning "writing between 12 and 32 bytes into a region of size 8 " "memcpy into allocated" } */ escape (b); /* The following idiom of clearing multiple members of a struct is diff --git a/gcc/testsuite/gcc.dg/ipa/ipa-bit-cp-1.c b/gcc/testsuite/gcc.dg/ipa/ipa-bit-cp-1.c new file mode 100644 index 0000000..2ec5fe5 --- /dev/null +++ b/gcc/testsuite/gcc.dg/ipa/ipa-bit-cp-1.c @@ -0,0 +1,16 @@ +/* { dg-do run } */ +/* { dg-options "-O2 -w -fipa-bit-cp" } */ +static int +__attribute__ ((noinline)) +test (int a) +{ + if (!(a&2)) + link_error (); +} +main() +{ + test (2); + test (3); + test (6); + return 0; +} diff --git a/gcc/testsuite/gcc.dg/ipa/ipa-bit-cp-2.c b/gcc/testsuite/gcc.dg/ipa/ipa-bit-cp-2.c new file mode 100644 index 0000000..42ce346 --- /dev/null +++ b/gcc/testsuite/gcc.dg/ipa/ipa-bit-cp-2.c @@ -0,0 +1,19 @@ +/* { dg-do run } */ +/* { dg-options "-O2 -w -fipa-bit-cp" } */ +static int +__attribute__ ((noinline)) +test (int __attribute__((unused)) b, int a) +{ + if (!(a&2)) + link_error (); +} + +extern int __attribute__((const)) getint (); + +main() +{ + test (getint(), 2); + test (getint(), 3); + test (getint(), 6); + return 0; +} diff --git a/gcc/testsuite/gcc.dg/ipa/ipa-bit-cp.c b/gcc/testsuite/gcc.dg/ipa/ipa-bit-cp.c new file mode 100644 index 0000000..2ec5fe5 --- /dev/null +++ b/gcc/testsuite/gcc.dg/ipa/ipa-bit-cp.c @@ -0,0 +1,16 @@ +/* { dg-do run } */ +/* { dg-options "-O2 -w -fipa-bit-cp" } */ +static int +__attribute__ ((noinline)) +test (int a) +{ + if (!(a&2)) + link_error (); +} +main() +{ + test (2); + test (3); + test (6); + return 0; +} diff --git a/gcc/testsuite/gcc.dg/ipa/ipcp-agg-12.c b/gcc/testsuite/gcc.dg/ipa/ipcp-agg-12.c new file mode 100644 index 0000000..5c57913 --- /dev/null +++ b/gcc/testsuite/gcc.dg/ipa/ipcp-agg-12.c @@ -0,0 +1,53 @@ +/* { dg-do compile } */ +/* { dg-options "-O3 -fno-ipa-sra -fdump-ipa-cp-details --param=ipa-cp-eval-threshold=2" } */ + +struct S +{ + int a, b, c; +}; + +int __attribute__((noinline)) foo (int i, struct S s); +int __attribute__((noinline)) bar (int i, struct S s); +int __attribute__((noinline)) baz (int i, struct S s); + + +int __attribute__((noinline)) +bar (int i, struct S s) +{ + return baz (i, s); +} + +int __attribute__((noinline)) +baz (int i, struct S s) +{ + return foo (i, s); +} + +int __attribute__((noinline)) +foo (int i, struct S s) +{ + if (i == 2) + return 0; + else + return s.b * s.b + bar (i - 1, s); +} + +volatile int g; + +void entry (void) +{ + struct S s; + s.b = 4; + g = bar (g, s); +} + + +void entry2 (void) +{ + struct S s; + s.b = 6; + g = baz (g, s); +} + + +/* { dg-final { scan-ipa-dump-times "adding an extra caller" 2 "cp" } } */ diff --git a/gcc/testsuite/gcc.dg/ipa/pr92794.c b/gcc/testsuite/gcc.dg/ipa/pr92794.c new file mode 100644 index 0000000..c354617 --- /dev/null +++ b/gcc/testsuite/gcc.dg/ipa/pr92794.c @@ -0,0 +1,30 @@ +/* { dg-do compile } */ +/* { dg-options "-O3 --param ipa-cp-eval-threshold=1" } */ + +int data[100]; +int depth = 0; + +int recur_fn (int *__restrict p) +{ + int i = *p; + + if (depth++ > 6) + return 10; + + data[i] = i; + + recur_fn (&i); + + depth--; + + return i; +} + +int main () +{ + int i = 1; + + recur_fn (&i); + + return 0; +} diff --git a/gcc/testsuite/gcc.dg/plugin/diagnostic-test-metadata.c b/gcc/testsuite/gcc.dg/plugin/diagnostic-test-metadata.c new file mode 100644 index 0000000..d2babd3 --- /dev/null +++ b/gcc/testsuite/gcc.dg/plugin/diagnostic-test-metadata.c @@ -0,0 +1,9 @@ +/* { dg-do compile } */ + +extern char *gets (char *s); + +void test_cwe (void) +{ + char buf[1024]; + gets (buf); /* { dg-warning "never use 'gets' \\\[CWE-242\\\]" } */ +} diff --git a/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_test_metadata.c b/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_test_metadata.c new file mode 100644 index 0000000..5e58115 --- /dev/null +++ b/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_test_metadata.c @@ -0,0 +1,140 @@ +/* This plugin exercises diagnostic_metadata. */ + +#include "gcc-plugin.h" +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "tm.h" +#include "tree.h" +#include "stringpool.h" +#include "toplev.h" +#include "basic-block.h" +#include "hash-table.h" +#include "vec.h" +#include "ggc.h" +#include "basic-block.h" +#include "tree-ssa-alias.h" +#include "internal-fn.h" +#include "gimple-fold.h" +#include "tree-eh.h" +#include "gimple-expr.h" +#include "is-a.h" +#include "gimple.h" +#include "gimple-iterator.h" +#include "tree.h" +#include "tree-pass.h" +#include "intl.h" +#include "plugin-version.h" +#include "diagnostic.h" +#include "context.h" +#include "gcc-rich-location.h" +#include "diagnostic-metadata.h" + +int plugin_is_GPL_compatible; + +const pass_data pass_data_test_metadata = +{ + GIMPLE_PASS, /* type */ + "test_metadata", /* name */ + OPTGROUP_NONE, /* optinfo_flags */ + TV_NONE, /* tv_id */ + PROP_ssa, /* properties_required */ + 0, /* properties_provided */ + 0, /* properties_destroyed */ + 0, /* todo_flags_start */ + 0, /* todo_flags_finish */ +}; + +class pass_test_metadata : public gimple_opt_pass +{ +public: + pass_test_metadata(gcc::context *ctxt) + : gimple_opt_pass(pass_data_test_metadata, ctxt) + {} + + /* opt_pass methods: */ + bool gate (function *) { return true; } + virtual unsigned int execute (function *); + +}; // class pass_test_metadata + +/* Determine if STMT is a call with NUM_ARGS arguments to a function + named FUNCNAME. + If so, return STMT as a gcall *. Otherwise return NULL. */ + +static gcall * +check_for_named_call (gimple *stmt, + const char *funcname, unsigned int num_args) +{ + gcc_assert (funcname); + + gcall *call = dyn_cast <gcall *> (stmt); + if (!call) + return NULL; + + tree fndecl = gimple_call_fndecl (call); + if (!fndecl) + return NULL; + + if (strcmp (IDENTIFIER_POINTER (DECL_NAME (fndecl)), funcname)) + return NULL; + + if (gimple_call_num_args (call) != num_args) + { + error_at (stmt->location, "expected number of args: %i (got %i)", + num_args, gimple_call_num_args (call)); + return NULL; + } + + return call; +} + +/* Exercise diagnostic_metadata. */ + +unsigned int +pass_test_metadata::execute (function *fun) +{ + gimple_stmt_iterator gsi; + basic_block bb; + + FOR_EACH_BB_FN (bb, fun) + for (gsi = gsi_start_bb (bb); !gsi_end_p (gsi); gsi_next (&gsi)) + { + gimple *stmt = gsi_stmt (gsi); + + /* Example of CWE: complain about uses of gets. */ + if (gcall *call = check_for_named_call (stmt, "gets", 1)) + { + gcc_rich_location richloc (gimple_location (call)); + /* CWE-242: Use of Inherently Dangerous Function. */ + diagnostic_metadata m; + m.add_cwe (242); + warning_at (&richloc, m, 0, + "never use %qs", "gets"); + } + } + + return 0; +} + +int +plugin_init (struct plugin_name_args *plugin_info, + struct plugin_gcc_version *version) +{ + struct register_pass_info pass_info; + const char *plugin_name = plugin_info->base_name; + int argc = plugin_info->argc; + struct plugin_argument *argv = plugin_info->argv; + + if (!plugin_default_version_check (version, &gcc_version)) + return 1; + + pass_info.pass = new pass_test_metadata (g); + pass_info.reference_pass_name = "ssa"; + pass_info.ref_pass_instance_number = 1; + pass_info.pos_op = PASS_POS_INSERT_AFTER; + register_callback (plugin_name, PLUGIN_PASS_MANAGER_SETUP, NULL, + &pass_info); + + return 0; +} diff --git a/gcc/testsuite/gcc.dg/plugin/plugin.exp b/gcc/testsuite/gcc.dg/plugin/plugin.exp index 2f75463..439fbd7 100644 --- a/gcc/testsuite/gcc.dg/plugin/plugin.exp +++ b/gcc/testsuite/gcc.dg/plugin/plugin.exp @@ -94,6 +94,7 @@ set plugin_test_list [list \ diagnostic-test-inlining-2.c \ diagnostic-test-inlining-3.c \ diagnostic-test-inlining-4.c } \ + { diagnostic_plugin_test_metadata.c diagnostic-test-metadata.c } \ { location_overflow_plugin.c \ location-overflow-test-1.c \ location-overflow-test-2.c \ diff --git a/gcc/testsuite/gcc.dg/strlenopt-86.c b/gcc/testsuite/gcc.dg/strlenopt-86.c index 3e86fa3..d202944 100644 --- a/gcc/testsuite/gcc.dg/strlenopt-86.c +++ b/gcc/testsuite/gcc.dg/strlenopt-86.c @@ -9,11 +9,11 @@ unsigned n0, n1; void* -keep_strlen_calloc_store_cst_memset (unsigned a, unsigned b) +keep_strlen_calloc_store_cst_memset (int i, unsigned a, unsigned b) { char *p = __builtin_calloc (a, 1); - p[1] = 'x'; + p[i] = 'x'; __builtin_memset (p, 0, b); @@ -23,11 +23,11 @@ keep_strlen_calloc_store_cst_memset (unsigned a, unsigned b) } void* -keep_strlen_calloc_store_var_memset (int x, unsigned a, unsigned b) +keep_strlen_calloc_store_var_memset (int i, int x, unsigned a, unsigned b) { char *p = __builtin_calloc (a, 1); - p[1] = x; + p[i] = x; __builtin_memset (p, 0, b); @@ -37,11 +37,11 @@ keep_strlen_calloc_store_var_memset (int x, unsigned a, unsigned b) } void* -keep_strlen_calloc_store_memset_2 (int x, unsigned a, unsigned b, unsigned c) +keep_strlen_calloc_store_memset_2 (int i, int x, unsigned a, unsigned b, unsigned c) { char *p = __builtin_calloc (a, 1); - p[1] = x; + p[i] = x; __builtin_memset (p, 0, b); n0 = __builtin_strlen (p); diff --git a/gcc/testsuite/gcc.dg/tree-ssa/pr92930.c b/gcc/testsuite/gcc.dg/tree-ssa/pr92930.c new file mode 100644 index 0000000..67e604b --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/pr92930.c @@ -0,0 +1,19 @@ +/* PR tree-optimization/92930 */ +/* { dg-do compile { target untyped_assembly } } */ +/* { dg-options "-O2 -fdump-tree-optimized" } */ +/* { dg-final { scan-tree-dump "__builtin_apply " "optimized" } } */ +/* { dg-final { scan-tree-dump "__builtin_apply_args" "optimized" } } */ + +void foo (int a, int b, int c, int d, int e, int f, int g); + +static void bar (int a, ...) +{ + __builtin_apply (foo, __builtin_apply_args (), 20); +} + +int +main () +{ + bar (1024, 1025, 1026, 1027, 1028, 1029, 1030); + return 0; +} diff --git a/gcc/testsuite/gcc.dg/vect/pr65947-8.c b/gcc/testsuite/gcc.dg/vect/pr65947-8.c index f0f1ac2..a2a940d 100644 --- a/gcc/testsuite/gcc.dg/vect/pr65947-8.c +++ b/gcc/testsuite/gcc.dg/vect/pr65947-8.c @@ -7,7 +7,7 @@ extern void abort (void) __attribute__ ((noreturn)); #define N 27 /* Condition reduction with multiple types in the comparison. Will fail to - vectorize. */ + vectorize on architectures requiring matching vector sizes. */ int condition_reduction (char *a, int min_v) @@ -41,5 +41,6 @@ main (void) return 0; } -/* { dg-final { scan-tree-dump-not "LOOP VECTORIZED" "vect" } } */ -/* { dg-final { scan-tree-dump "multiple types in double reduction or condition reduction" "vect" } } */ +/* { dg-final { scan-tree-dump-not "LOOP VECTORIZED" "vect" { target { ! amdgcn*-*-* } } } } */ +/* { dg-final { scan-tree-dump "LOOP VECTORIZED" "vect" { target amdgcn*-*-* } } } */ +/* { dg-final { scan-tree-dump "multiple types in double reduction or condition reduction" "vect" { target { ! amdgcn*-*-* } } } } */ diff --git a/gcc/testsuite/gcc.target/arm/pr45701-1.c b/gcc/testsuite/gcc.target/arm/pr45701-1.c index b26011b..15913d8 100644 --- a/gcc/testsuite/gcc.target/arm/pr45701-1.c +++ b/gcc/testsuite/gcc.target/arm/pr45701-1.c @@ -2,7 +2,7 @@ /* { dg-skip-if "" { ! { arm_thumb1_ok || arm_thumb2_ok } } } */ /* { dg-options "-mthumb -Os" } */ /* { dg-final { scan-assembler "push\t\{r3" { target { ! arm*-*-uclinuxfdpiceabi } } } } */ -/* { dg-final { scan-assembler-not "\[^\-\]r8" { target { ! arm*-*-uclinuxfdpiceabi } } } } */ +/* { dg-final { scan-assembler-not "\[^\-e\]r8" { target { ! arm*-*-uclinuxfdpiceabi } } } } */ extern int hist_verify; extern int a1; diff --git a/gcc/testsuite/gcc.target/arm/pr45701-2.c b/gcc/testsuite/gcc.target/arm/pr45701-2.c index 32eed4d..bb2d36e 100644 --- a/gcc/testsuite/gcc.target/arm/pr45701-2.c +++ b/gcc/testsuite/gcc.target/arm/pr45701-2.c @@ -2,7 +2,7 @@ /* { dg-skip-if "" { ! { arm_thumb1_ok || arm_thumb2_ok } } } */ /* { dg-options "-mthumb -Os" } */ /* { dg-final { scan-assembler "push\t\{r3" { target { ! arm*-*-uclinuxfdpiceabi } } } } */ -/* { dg-final { scan-assembler-not "\[^\-\]r8" { target { ! arm*-*-uclinuxfdpiceabi } } } } */ +/* { dg-final { scan-assembler-not "\[^\-e\]r8" { target { ! arm*-*-uclinuxfdpiceabi } } } } */ extern int hist_verify; extern int a1; diff --git a/gcc/testsuite/gcc.target/arm/pure-code/no-literal-pool.c b/gcc/testsuite/gcc.target/arm/pure-code/no-literal-pool.c index 4b893fd..3de1620 100644 --- a/gcc/testsuite/gcc.target/arm/pure-code/no-literal-pool.c +++ b/gcc/testsuite/gcc.target/arm/pure-code/no-literal-pool.c @@ -1,12 +1,24 @@ /* { dg-do compile } */ -/* { dg-options "-mpure-code" } */ +/* { dg-options "-mpure-code -mfp16-format=ieee" } */ /* { dg-skip-if "" { *-*-* } { "-g" "-fpic" "-fPIC" } { "" } } */ +__fp16 hf; float sf; double df; long long l; static char *p = "Hello World"; +__fp16 +testsfp16 (__fp16 *p) +{ + hf = 1.3; + *p += hf; + if (*p > 1.1234f) + return 2.1234f; + else + return 3.1234f; +} + float testsf (float *p) { diff --git a/gcc/testsuite/gcc.target/arm/pure-code/pure-code.exp b/gcc/testsuite/gcc.target/arm/pure-code/pure-code.exp index bf7e4ad..b05cfd6 100644 --- a/gcc/testsuite/gcc.target/arm/pure-code/pure-code.exp +++ b/gcc/testsuite/gcc.target/arm/pure-code/pure-code.exp @@ -25,11 +25,8 @@ if ![info exists DEFAULT_CFLAGS] then { set DEFAULT_CFLAGS " -ansi -pedantic-errors" } -# The -mpure-code option is only available for M-profile targets that support -# the MOVT instruction. -if {([check_effective_target_arm_thumb2_ok] - || [check_effective_target_arm_thumb1_movt_ok]) - && [check_effective_target_arm_cortex_m]} then { +# The -mpure-code option is only available for M-profile targets. +if {[check_effective_target_arm_cortex_m]} then { # Initialize `dg'. dg-init @@ -56,4 +53,4 @@ set LTO_TORTURE_OPTIONS ${saved-lto_torture_options} # All done. dg-finish -} +#} diff --git a/gcc/testsuite/gcc.target/arm/thumb1-Os-mult.c b/gcc/testsuite/gcc.target/arm/thumb1-Os-mult.c index b989c42..92772d4 100644 --- a/gcc/testsuite/gcc.target/arm/thumb1-Os-mult.c +++ b/gcc/testsuite/gcc.target/arm/thumb1-Os-mult.c @@ -1,6 +1,7 @@ /* { dg-do compile } */ /* { dg-require-effective-target arm_thumb1_ok } */ /* { dg-options "-Os" } */ +/* { dg-skip-if "-mpure-code generates an inline multiplication code sequence" { *-*-* } { "-mpure-code" } } */ /* { dg-skip-if "" { ! { arm_thumb1 } } } */ int diff --git a/gcc/testsuite/gcc.target/i386/pr82002-1.c b/gcc/testsuite/gcc.target/i386/pr82002-1.c index 86678a0..b4d4bd3 100644 --- a/gcc/testsuite/gcc.target/i386/pr82002-1.c +++ b/gcc/testsuite/gcc.target/i386/pr82002-1.c @@ -10,3 +10,5 @@ b () a (c); a (c); } + +// { dg-prune-output "\\\[-Wstringop-overflow" } diff --git a/gcc/testsuite/gcc.target/i386/pr92651.c b/gcc/testsuite/gcc.target/i386/pr92651.c new file mode 100644 index 0000000..3d0c3c7 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr92651.c @@ -0,0 +1,16 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -march=corei7" } */ + +#include <stdlib.h> + +int foo(unsigned char a, unsigned char b) +{ + int isum=abs(a - b); + return isum; +} + +/* { dg-final { scan-assembler-not "cmov*" } } */ +/* { dg-final { scan-assembler "(cltd|cdq|shr)" } } */ +/* { dg-final { scan-assembler-times "xor" 1 } } */ +/* { dg-final { scan-assembler-times "sub" 2 } } */ + diff --git a/gcc/testsuite/gcc.target/i386/pr92807-1.c b/gcc/testsuite/gcc.target/i386/pr92807-1.c new file mode 100644 index 0000000..00f9293 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr92807-1.c @@ -0,0 +1,11 @@ +/* { dg-do compile } */ +/* { dg-options "-O2" } */ + +unsigned int +abs2 (unsigned int a) +{ + unsigned int s = ((a>>15)&0x10001)*0xffff; + return (a+s)^s; +} + +/* { dg-final { scan-assembler-not "leal" } } */ diff --git a/gcc/testsuite/gcc.target/i386/pr92841.c b/gcc/testsuite/gcc.target/i386/pr92841.c new file mode 100644 index 0000000..30be2b6 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr92841.c @@ -0,0 +1,17 @@ +/* PR target/92841 */ +/* { dg-do compile { target fstack_protector } } */ +/* { dg-options "-O2 -fstack-protector-strong -masm=att" } */ +/* { dg-final { scan-assembler-not "xor\[lq]\t%(\[re]\[a-z0-9]*), %\\1\[\n\r]*\tmov\[lq]\t\[^\n\r]*, %\\1" } } */ + +const struct S { int b; } c[] = {30, 12, 20, 0, 11}; +void bar (int *); + +void +foo (void) +{ + int e[4]; + const struct S *a; + for (a = c; a < c + sizeof (c) / sizeof (c[0]); a++) + if (a->b) + bar (e); +} diff --git a/gcc/testsuite/gcc.target/msp430/msp430.exp b/gcc/testsuite/gcc.target/msp430/msp430.exp index 3758661..42dc911 100644 --- a/gcc/testsuite/gcc.target/msp430/msp430.exp +++ b/gcc/testsuite/gcc.target/msp430/msp430.exp @@ -141,18 +141,20 @@ proc msp430_device_permutations_runtest { tests } { } -# Return $TOOLCHAIN_ROOT/msp430-elf/include/devices/ +# Return $TOOLCHAIN_ROOT/$target_alias/include/devices/ +# target_alias is expected to be either msp430-elf or msp430-elfbare. proc get_installed_device_data_path { } { + global target_alias set compiler [lindex [regexp -all -inline {\S+} \ [board_info [target_info name] compiler]] 0] # $compiler is actually a file, but normalize will still get us the desired # result. return [file normalize \ - "$compiler/../../msp430-elf/include/devices/devices.csv"] + "$compiler/../../$target_alias/include/devices/devices.csv"] } # If the devices.csv is installed in -# $TOOLCHAIN_ROOT/msp430-elf/include/devices/, rename it so it doesn't +# $TOOLCHAIN_ROOT/$target_alias/include/devices/, rename it so it doesn't # interfere with the hard-coded device data tests. proc msp430_hide_installed_devices_data { } { set devices_path [get_installed_device_data_path] diff --git a/gcc/testsuite/gcc.target/powerpc/dfp-dd-2.c b/gcc/testsuite/gcc.target/powerpc/dfp-dd-2.c index eeef037..668b21d 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp-dd-2.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp-dd-2.c @@ -1,5 +1,6 @@ /* Test generation of DFP instructions for POWER6. */ /* { dg-do compile { target { powerpc*-*-linux* && powerpc_fprs } } } */ +/* { dg-require-effective-target dfp } */ /* { dg-options "-std=gnu99 -O1 -mdejagnu-cpu=power6" } */ /* { dg-final { scan-assembler-times "fneg" 1 } } */ diff --git a/gcc/testsuite/gcc.target/powerpc/dfp-dd.c b/gcc/testsuite/gcc.target/powerpc/dfp-dd.c index 2c2a10c..700dd97 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp-dd.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp-dd.c @@ -1,6 +1,7 @@ /* Test generation of DFP instructions for POWER6. */ /* Origin: Janis Johnson <janis187@us.ibm.com> */ -/* { dg-do compile { target { powerpc*-*-linux* && powerpc_fprs } } } */ +/* { dg-do compile { target { powerpc*-*-linux* } } } */ +/* { dg-require-effective-target hard_dfp } */ /* { dg-options "-std=gnu99 -mdejagnu-cpu=power6" } */ /* { dg-final { scan-assembler "dadd" } } */ diff --git a/gcc/testsuite/gcc.target/powerpc/dfp-td-2.c b/gcc/testsuite/gcc.target/powerpc/dfp-td-2.c index 6e906f7..11705f6 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp-td-2.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp-td-2.c @@ -1,5 +1,6 @@ /* Test generation of DFP instructions for POWER6. */ /* { dg-do compile { target { powerpc*-*-linux* && powerpc_fprs } } } */ +/* { dg-require-effective-target dfp } */ /* { dg-options "-std=gnu99 -O1 -mdejagnu-cpu=power6" } */ /* { dg-final { scan-assembler-times "fneg" 1 } } */ diff --git a/gcc/testsuite/gcc.target/powerpc/dfp-td-3.c b/gcc/testsuite/gcc.target/powerpc/dfp-td-3.c index 847c591..0bf1947 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp-td-3.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp-td-3.c @@ -1,5 +1,6 @@ /* Test generation of DFP instructions for POWER6. */ /* { dg-do compile { target { powerpc*-*-linux* && powerpc_fprs } } } */ +/* { dg-require-effective-target dfp } */ /* { dg-options "-std=gnu99 -O1 -mdejagnu-cpu=power6" } */ /* { dg-final { scan-assembler-times "fneg" 1 } } */ diff --git a/gcc/testsuite/gcc.target/powerpc/dfp-td.c b/gcc/testsuite/gcc.target/powerpc/dfp-td.c index 1760804..af78e4a 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp-td.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp-td.c @@ -1,6 +1,7 @@ /* Test generation of DFP instructions for POWER6. */ /* Origin: Janis Johnson <janis187@us.ibm.com> */ -/* { dg-do compile { target { powerpc*-*-linux* && powerpc_fprs } } } */ +/* { dg-do compile { target { powerpc*-*-linux* } } } */ +/* { dg-require-effective-target hard_dfp } */ /* { dg-options "-std=gnu99 -mdejagnu-cpu=power6" } */ /* { dg-final { scan-assembler "daddq" } } */ diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dfp.exp b/gcc/testsuite/gcc.target/powerpc/dfp/dfp.exp index ea0211a..187ec65 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dfp.exp +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dfp.exp @@ -16,11 +16,9 @@ # along with GCC; see the file COPYING3. If not see # <http://www.gnu.org/licenses/>. -# Exit immediately if this isn't a PowerPC target, also exit if we -# are on Darwin which doesn't support decimal float. -if { (![istarget powerpc*-*-*] && ![istarget rs6000-*-*]) - || [istarget "powerpc*-*-darwin*"] -} then { +# Exit immediately if this isn't a PowerPC target, or if the +# target doesn't support decimal float. +if { ![istarget powerpc*-*-*] || ![check_effective_target_dfp] } then { return } diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-0.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-0.c index ce1f2c9..4f7562b 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-0.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-0.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ /* This test should succeed on both 32- and 64-bit configurations. */ diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-1.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-1.c index e660b74..6338a0e 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-1.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-1.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power8" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-10.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-10.c index ab2c4f2..822030b 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-10.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-10.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ /* This test should succeed on both 32- and 64-bit configurations. */ diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-11.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-11.c index 92145f0..044e768 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-11.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-11.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power8" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-12.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-12.c index 8ec5925..350b4c1 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-12.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-12.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-13.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-13.c index bef09ce..cc54c6b 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-13.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-13.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-14.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-14.c index 364c3aa..011d200 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-14.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-14.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-15.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-15.c index 2f55f74..54d2557 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-15.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-15.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ /* This test should succeed on both 32- and 64-bit configurations. */ diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-16.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-16.c index 62dc52d..8626c57 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-16.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-16.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power8" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-17.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-17.c index 8fbc15a..28033db 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-17.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-17.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-18.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-18.c index 2b11ac9..8ce9390 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-18.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-18.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-19.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-19.c index cc94e30..092b9c0 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-19.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-19.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-2.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-2.c index 6b8748c..4b72fa8 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-2.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-2.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-20.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-20.c index 6a5b8a5..ee098bc 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-20.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-20.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ /* This test should succeed on both 32- and 64-bit configurations. */ diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-21.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-21.c index a8e435b..0d47cc2 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-21.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-21.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power8" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-22.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-22.c index 64256d3..15d7a35 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-22.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-22.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-23.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-23.c index f0abd6f..236f393 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-23.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-23.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-24.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-24.c index 8755987..f6ed00a 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-24.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-24.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-25.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-25.c index e6987e9..1390c83 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-25.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-25.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ /* This test should succeed on both 32- and 64-bit configurations. */ diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-26.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-26.c index 40790f4..f070a0c 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-26.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-26.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power8" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-27.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-27.c index 2d266d1..8e3954d 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-27.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-27.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-28.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-28.c index 3b54e00..a2b9229 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-28.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-28.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-29.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-29.c index 82af9a2..f6c0ede 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-29.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-29.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-3.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-3.c index bc1dbd0..af07fbb 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-3.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-3.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-30.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-30.c index e774c4e..6d8869e 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-30.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-30.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ /* This test should succeed on both 32- and 64-bit configurations. */ diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-31.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-31.c index a7f3908..439fcb2 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-31.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-31.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power8" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-32.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-32.c index 3abfc47..d24f398 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-32.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-32.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-33.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-33.c index 8a5da5a..6d978a0 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-33.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-33.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-34.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-34.c index 82deb10..b6620c5 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-34.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-34.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-35.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-35.c index 7e73389..fdafaf9 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-35.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-35.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ /* This test should succeed on both 32- and 64-bit configurations. */ diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-36.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-36.c index 1b48867..822f6d5 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-36.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-36.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power8" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-37.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-37.c index db4b504..dc4c8ec 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-37.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-37.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-38.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-38.c index cb32c9f..fce744c 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-38.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-38.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-39.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-39.c index 58b4c60..1aee9ef 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-39.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-39.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-4.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-4.c index 49d6767..6397aae 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-4.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-4.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-40.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-40.c index 43c2dfd..4663fc6 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-40.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-40.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ /* This test should succeed on both 32- and 64-bit configurations. */ diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-41.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-41.c index 640e6c8..451a9e7 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-41.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-41.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power8" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-42.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-42.c index 440a310..fc6b356 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-42.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-42.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-43.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-43.c index 5a0ed7d..9c19437 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-43.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-43.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-44.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-44.c index 1aa9506..b896865 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-44.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-44.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-45.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-45.c index 65e1c8d..5c6fcc4 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-45.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-45.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ /* This test should succeed on both 32- and 64-bit configurations. */ diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-46.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-46.c index 6557a63..d0833c8 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-46.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-46.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power8" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-47.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-47.c index 7269cb5..edfac68 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-47.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-47.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-48.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-48.c index ad18828..9a94371d 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-48.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-48.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-49.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-49.c index 3eb3bcb..e7b50dc1 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-49.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-49.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-5.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-5.c index 8bd59bf..6f57baf 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-5.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-5.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ /* This test should succeed on both 32- and 64-bit configurations. */ diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-50.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-50.c index 62e1bf2..25b35ed 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-50.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-50.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ /* This test should succeed on both 32- and 64-bit configurations. */ diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-51.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-51.c index 801c8c7..e6b5fe5 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-51.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-51.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power8" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-52.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-52.c index 769f722..c9431b5 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-52.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-52.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-53.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-53.c index aab1769..d11f497 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-53.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-53.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-54.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-54.c index 07800d4..2fdb58f 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-54.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-54.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-55.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-55.c index ad54b9d..912ae7f 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-55.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-55.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ /* This test should succeed on both 32- and 64-bit configurations. */ diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-56.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-56.c index 589adeb..218d2f6 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-56.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-56.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power8" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-57.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-57.c index 432c255..275bf8d 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-57.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-57.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-58.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-58.c index d214486..0626d87 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-58.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-58.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-59.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-59.c index 7b5d097..e1da3d8 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-59.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-59.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-6.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-6.c index 873ad9f..d889bdd 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-6.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-6.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power8" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-60.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-60.c index 781b2ed..c584d98 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-60.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-60.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ /* This test should succeed on both 32- and 64-bit configurations. */ diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-61.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-61.c index 3b2867c..1a54150 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-61.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-61.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power8" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-62.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-62.c index 54edaab..44aaab2 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-62.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-62.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-63.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-63.c index ca23be3..e7d2a27 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-63.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-63.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-64.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-64.c index 137c98d..fb33311 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-64.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-64.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-65.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-65.c index 9e9407f..7c75265d 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-65.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-65.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ /* This test should succeed on both 32- and 64-bit configurations. */ diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-66.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-66.c index 2b6d30a..74269fa 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-66.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-66.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power8" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-67.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-67.c index dc18051..59471cf 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-67.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-67.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-68.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-68.c index 0cde0f9..1bda795 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-68.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-68.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-69.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-69.c index 5020386..c9e1721 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-69.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-69.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-7.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-7.c index 56fb232..d0d3f23 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-7.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-7.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-70.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-70.c index 39236c5..875354c 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-70.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-70.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ /* This test should succeed on both 32- and 64-bit configurations. */ diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-71.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-71.c index 8fe0b6a..68758cf 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-71.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-71.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power8" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-72.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-72.c index ddcd81b..725cc54 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-72.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-72.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-73.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-73.c index 77efcc9..f368c38 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-73.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-73.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-74.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-74.c index 005d7cb..c6ffd51 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-74.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-74.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-75.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-75.c index 9de8c9f1..910fb7d 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-75.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-75.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ /* This test should succeed on both 32- and 64-bit configurations. */ diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-76.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-76.c index dccc388..d867a98 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-76.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-76.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power8" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-77.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-77.c index 5f89438..d279bfb 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-77.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-77.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-78.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-78.c index a9cb785..3034300 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-78.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-78.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-79.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-79.c index e478b71..b88b5a8 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-79.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-79.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-8.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-8.c index c784e4d..28bc10c 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-8.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-8.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-9.c b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-9.c index f23e293..b2073f5 100644 --- a/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-9.c +++ b/gcc/testsuite/gcc.target/powerpc/dfp/dtstsfi-9.c @@ -1,6 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-require-effective-target powerpc_p9vector_ok } */ -/* { dg-skip-if "" { powerpc*-*-aix* } } */ /* { dg-options "-mdejagnu-cpu=power9" } */ #include <altivec.h> diff --git a/gcc/testsuite/gcc.target/powerpc/pr92661.c b/gcc/testsuite/gcc.target/powerpc/pr92661.c new file mode 100644 index 0000000..d9500db --- /dev/null +++ b/gcc/testsuite/gcc.target/powerpc/pr92661.c @@ -0,0 +1,19 @@ +/* { dg-do compile } */ +/* { dg-options "-w -O2 -mdejagnu-cpu=power9" } */ + +/* PR92661: The following tests should not ICE, regardless of + whether the target supports DFP or not. */ + +/* Test that a normal builtin function doesn't ICE. */ +int +foo (_Decimal64 src) /* { dg-error "decimal floating-point not supported for this target" "not supported" { target { ! dfp } } } */ +{ + return __builtin_dfp_dtstsfi_lt_dd (5, src); +} + +/* Test that an overloaded builtin function doesn't ICE. */ +int +bar (_Decimal64 src) /* { dg-error "decimal floating-point not supported for this target" "not supported" { target { ! dfp } } } */ +{ + return __builtin_dfp_dtstsfi_lt (5, src); +} diff --git a/gcc/testsuite/gcc.target/s390/vector/pr92950.c b/gcc/testsuite/gcc.target/s390/vector/pr92950.c new file mode 100644 index 0000000..9c7ed12 --- /dev/null +++ b/gcc/testsuite/gcc.target/s390/vector/pr92950.c @@ -0,0 +1,24 @@ +/* { dg-do run } */ +/* { dg-options "-O3 -mzarch -march=z13 --save-temps" } */ + +struct a { + int b; + char c; +}; +struct a d = {1, 16}; +struct a *e = &d; + +int f = 0; + +int main() { + struct a g = {0, 0 }; + f = 0; + + for (; f <= 1; f++) { + g = d; + *e = g; + } + + if (d.c != 16) + __builtin_abort(); +} diff --git a/gcc/testsuite/gfortran.dg/goacc/common-block-1.f90 b/gcc/testsuite/gfortran.dg/goacc/common-block-1.f90 index 228637f..6df5aa6 100644 --- a/gcc/testsuite/gfortran.dg/goacc/common-block-1.f90 +++ b/gcc/testsuite/gfortran.dg/goacc/common-block-1.f90 @@ -51,6 +51,9 @@ program test !$acc data pcopyout(/blockA/, /blockB/, e, v) !$acc end data + !$acc data no_create(/blockA/, /blockB/, e, v) + !$acc end data + !$acc parallel private(/blockA/, /blockB/, e, v) !$acc end parallel diff --git a/gcc/testsuite/gfortran.dg/goacc/common-block-2.f90 b/gcc/testsuite/gfortran.dg/goacc/common-block-2.f90 index 5d49f61..30c87a9 100644 --- a/gcc/testsuite/gfortran.dg/goacc/common-block-2.f90 +++ b/gcc/testsuite/gfortran.dg/goacc/common-block-2.f90 @@ -39,6 +39,9 @@ program test !$acc data pcopyout(/blockA/, /blockB/, e, v, a) ! { dg-error "Symbol .a. present on multiple clauses" } !$acc end data + !$acc data no_create(/blockA/, /blockB/, e, v, a) ! { dg-error "Symbol .a. present on multiple clauses" } + !$acc end data + !$acc parallel private(/blockA/, /blockB/, e, v, a) ! { dg-error "Symbol .a. present on multiple clauses" } !$acc end parallel diff --git a/gcc/testsuite/gfortran.dg/goacc/data-clauses.f95 b/gcc/testsuite/gfortran.dg/goacc/data-clauses.f95 index b94214e..30930a0 100644 --- a/gcc/testsuite/gfortran.dg/goacc/data-clauses.f95 +++ b/gcc/testsuite/gfortran.dg/goacc/data-clauses.f95 @@ -111,6 +111,27 @@ contains !$acc end data + !$acc parallel no_create (tip) ! { dg-error "POINTER" } + !$acc end parallel + !$acc parallel no_create (tia) ! { dg-error "ALLOCATABLE" } + !$acc end parallel + !$acc parallel deviceptr (i) no_create (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel copy (i) no_create (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel copyin (i) no_create (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel copyout (i) no_create (i) ! { dg-error "multiple clauses" } + !$acc end parallel + + !$acc parallel no_create (i, c, r, ia, ca, ra, asa, rp, ti, vi, aa) + !$acc end parallel + !$acc kernels no_create (i, c, r, ia, ca, ra, asa, rp, ti, vi, aa) + !$acc end kernels + !$acc data no_create (i, c, r, ia, ca, ra, asa, rp, ti, vi, aa) + !$acc end data + + !$acc parallel present (tip) ! { dg-error "POINTER" } !$acc end parallel !$acc parallel present (tia) ! { dg-error "ALLOCATABLE" } diff --git a/gcc/testsuite/gfortran.dg/goacc/data-tree.f95 b/gcc/testsuite/gfortran.dg/goacc/data-tree.f95 index f16d62c..454417d 100644 --- a/gcc/testsuite/gfortran.dg/goacc/data-tree.f95 +++ b/gcc/testsuite/gfortran.dg/goacc/data-tree.f95 @@ -7,6 +7,7 @@ program test logical :: l = .true. !$acc data if(l) copy(i), copyin(j), copyout(k), create(m) & + !$acc no_create(n) & !$acc present(o), pcopy(p), pcopyin(r), pcopyout(s), pcreate(t) & !$acc deviceptr(u) !$acc end data @@ -19,7 +20,7 @@ end program test ! { dg-final { scan-tree-dump-times "map\\(to:j\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "map\\(from:k\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "map\\(alloc:m\\)" 1 "original" } } - +! { dg-final { scan-tree-dump-times "map\\(no_alloc:n\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "map\\(force_present:o\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "map\\(tofrom:p\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "map\\(to:r\\)" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/goacc/finalize-1.f b/gcc/testsuite/gfortran.dg/goacc/finalize-1.f index 5c7a921..ca64215 100644 --- a/gcc/testsuite/gfortran.dg/goacc/finalize-1.f +++ b/gcc/testsuite/gfortran.dg/goacc/finalize-1.f @@ -6,8 +6,10 @@ IMPLICIT NONE INTEGER :: del_r REAL, DIMENSION (3) :: del_f + INTEGER (1), DIMENSION (:), ALLOCATABLE :: del_f_p DOUBLE PRECISION, DIMENSION (8) :: cpo_r LOGICAL :: cpo_f + INTEGER (1), DIMENSION (:), ALLOCATABLE :: cpo_f_p !$ACC EXIT DATA DELETE (del_r) ! { dg-final { scan-tree-dump-times "(?n)#pragma acc exit data map\\(release:del_r\\);$" 1 "original" } } @@ -17,6 +19,10 @@ ! { dg-final { scan-tree-dump-times "(?n)#pragma acc exit data map\\(release:del_f\\) finalize;$" 1 "original" } } ! { dg-final { scan-tree-dump-times "(?n)#pragma omp target oacc_enter_exit_data map\\(delete:del_f \\\[len: \[0-9\]+\\\]\\) finalize$" 1 "gimple" } } +!$ACC EXIT DATA FINALIZE DELETE (del_f_p(2:5)) +! { dg-final { scan-tree-dump-times "(?n)#pragma acc exit data map\\(release:\\*\\(c_char \\*\\) parm\\.0\\.data \\\[len: \[^\\\]\]+\\\]\\) map\\(to:del_f_p \\\[pointer set, len: \[0-9\]+\\\]\\) map\\(alloc:\\(integer\\(kind=1\\)\\\[0:\\\] \\* restrict\\) del_f_p\\.data \\\[pointer assign, bias: \\(sizetype\\) parm\\.0\\.data - \\(sizetype\\) del_f_p\\.data\\\]\\) finalize;$" 1 "original" } } +! { dg-final { scan-tree-dump-times "(?n)#pragma omp target oacc_enter_exit_data map\\(delete:MEM\\\[\\(c_char \\*\\)\[^\\\]\]+\\\] \\\[len: \[^\\\]\]+\\\]\\) map\\(to:del_f_p \\\[pointer set, len: \[0-9\]+\\\]\\) map\\(alloc:del_f_p\\.data \\\[pointer assign, bias: \[^\\\]\]+\\\]\\) finalize$" 1 "gimple" } } + !$ACC EXIT DATA COPYOUT (cpo_r) ! { dg-final { scan-tree-dump-times "(?n)#pragma acc exit data map\\(from:cpo_r\\);$" 1 "original" } } ! { dg-final { scan-tree-dump-times "(?n)#pragma omp target oacc_enter_exit_data map\\(from:cpo_r \\\[len: \[0-9\]+\\\]\\)$" 1 "gimple" } } @@ -24,4 +30,8 @@ !$ACC EXIT DATA COPYOUT (cpo_f) FINALIZE ! { dg-final { scan-tree-dump-times "(?n)#pragma acc exit data map\\(from:cpo_f\\) finalize;$" 1 "original" } } ! { dg-final { scan-tree-dump-times "(?n)#pragma omp target oacc_enter_exit_data map\\(force_from:cpo_f \\\[len: \[0-9\]+\\\]\\) finalize$" 1 "gimple" } } + +!$ACC EXIT DATA COPYOUT (cpo_f_p(4:10)) FINALIZE +! { dg-final { scan-tree-dump-times "(?n)#pragma acc exit data map\\(from:\\*\\(c_char \\*\\) parm\\.1\\.data \\\[len: \[^\\\]\]+\\\]\\) map\\(to:cpo_f_p \\\[pointer set, len: \[0-9\]+\\\]\\) map\\(alloc:\\(integer\\(kind=1\\)\\\[0:\\\] \\* restrict\\) cpo_f_p\\.data \\\[pointer assign, bias: \\(sizetype\\) parm\\.1\\.data - \\(sizetype\\) cpo_f_p\\.data\\\]\\) finalize;$" 1 "original" } } +! { dg-final { scan-tree-dump-times "(?n)#pragma omp target oacc_enter_exit_data map\\(force_from:MEM\\\[\\(c_char \\*\\)\[^\\\]\]+\\\] \\\[len: \[^\\\]\]+\\\]\\) map\\(to:cpo_f_p \\\[pointer set, len: \[0-9\]+\\\]\\) map\\(alloc:cpo_f_p\\.data \\\[pointer assign, bias: \[^\\\]\]+\\\]\\) finalize$" 1 "gimple" } } END SUBROUTINE f diff --git a/gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95 b/gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95 index a70f1e7..5583ffb 100644 --- a/gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95 +++ b/gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95 @@ -8,6 +8,7 @@ program test !$acc kernels if(l) async num_gangs(i) num_workers(i) vector_length(i) & !$acc copy(i), copyin(j), copyout(k), create(m) & + !$acc no_create(n) & !$acc present(o), pcopy(p), pcopyin(r), pcopyout(s), pcreate(t) & !$acc deviceptr(u) !$acc end kernels @@ -25,7 +26,7 @@ end program test ! { dg-final { scan-tree-dump-times "map\\(to:j\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "map\\(from:k\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "map\\(alloc:m\\)" 1 "original" } } - +! { dg-final { scan-tree-dump-times "map\\(no_alloc:n\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "map\\(force_present:o\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "map\\(tofrom:p\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "map\\(to:r\\)" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95 b/gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95 index 2697bb7..e33653b 100644 --- a/gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95 +++ b/gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95 @@ -9,6 +9,7 @@ program test !$acc parallel if(l) async num_gangs(i) num_workers(i) vector_length(i) & !$acc reduction(max:q), copy(i), copyin(j), copyout(k), create(m) & + !$acc no_create(n) & !$acc present(o), pcopy(p), pcopyin(r), pcopyout(s), pcreate(t) & !$acc deviceptr(u), private(v), firstprivate(w) !$acc end parallel @@ -28,7 +29,7 @@ end program test ! { dg-final { scan-tree-dump-times "map\\(to:j\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "map\\(from:k\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "map\\(alloc:m\\)" 1 "original" } } - +! { dg-final { scan-tree-dump-times "map\\(no_alloc:n\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "map\\(force_present:o\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "map\\(tofrom:p\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "map\\(to:r\\)" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/pr92977.f90 b/gcc/testsuite/gfortran.dg/gomp/pr92977.f90 new file mode 100644 index 0000000..0c31f47 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr92977.f90 @@ -0,0 +1,15 @@ +! PR fortran/92977 +! { dg-do compile } +! { dg-additional-options "-O2" } + +program pr92977 + integer :: n = 1 + integer :: a +!$omp atomic write + a = f(n) - f(n) +contains + integer function f(x) + integer, intent(in) :: x + f = x + end +end diff --git a/gcc/testsuite/gfortran.dg/pr70853.f90 b/gcc/testsuite/gfortran.dg/pr70853.f90 new file mode 100644 index 0000000..9ae44cc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr70853.f90 @@ -0,0 +1,8 @@ +! { dg-do compile } +! PR fortran/70853 +! Contributed by Gerhard Steinmetz +program p + real, pointer :: z(:) + z(1:2) => null() ! { dg-error "pointer target shall not be NULL" } + z(2:1) => null() ! { dg-error "pointer target shall not be NULL" } +end diff --git a/gcc/testsuite/gnat.dg/specs/clause_on_volatile.ads b/gcc/testsuite/gnat.dg/specs/clause_on_volatile.ads index 0dcffbc..157f724 100644 --- a/gcc/testsuite/gnat.dg/specs/clause_on_volatile.ads +++ b/gcc/testsuite/gnat.dg/specs/clause_on_volatile.ads @@ -57,7 +57,7 @@ package Clause_On_Volatile is end record; For V1'Alignment use 4; for V1 use record - VW at 0 range 0 .. 15; + VW at 0 range 0 .. 15; -- { dg-error "too small*" } end record; type V2 is record @@ -67,7 +67,7 @@ package Clause_On_Volatile is For V2'Alignment use 4; for V2 use record B at 0 range 0 .. 7; - VW at 1 range 0 .. 31; + VW at 1 range 0 .. 31; -- { dg-error "must be multiple|alignment" } end record; type V3 is record @@ -77,7 +77,7 @@ package Clause_On_Volatile is For V3'Alignment use 4; for V3 use record B at 0 range 0 .. 7; - VW at 1 range 0 .. 15; + VW at 1 range 0 .. 15; -- { dg-error "must be multiple|alignment|too small" } end record; end Clause_On_Volatile; diff --git a/gcc/testsuite/gnat.dg/specs/size_clause3.ads b/gcc/testsuite/gnat.dg/specs/size_clause3.ads index 12ca2d1..a9ab5c5 100644 --- a/gcc/testsuite/gnat.dg/specs/size_clause3.ads +++ b/gcc/testsuite/gnat.dg/specs/size_clause3.ads @@ -14,7 +14,7 @@ package Size_Clause3 is rr : R1; -- size must be 40 end record; for S1 use record - rr at 0 range 0 .. 39; -- { dg-error "size for .rr. too small" } + rr at 0 range 0 .. 39; -- { dg-error "size for .rr. with aliased part too small" } end record; -- The record is explicitly given alignment 1 so its real type is 40. @@ -44,7 +44,7 @@ package Size_Clause3 is rr : R3; -- size must be 40 end record; for S3 use record - rr at 0 range 0 .. 39; -- { dg-error "size for .rr. too small" } + rr at 0 range 0 .. 39; -- { dg-error "size for .rr. with aliased part too small" } end record; end Size_Clause3; diff --git a/gcc/testsuite/gnat.dg/warn32.adb b/gcc/testsuite/gnat.dg/warn32.adb new file mode 100644 index 0000000..e3ffefb --- /dev/null +++ b/gcc/testsuite/gnat.dg/warn32.adb @@ -0,0 +1,19 @@ +-- { dg-do compile } +-- { dg-options "-O -gnatn -Winline -cargs --param max-inline-insns-single=50 -margs" } + +with Ada.Containers.Vectors; +with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; +with Ada.Text_IO; + +procedure Warn32 is + type Selected_Block_T is record + Contents : Unbounded_String; + File_Name : Unbounded_String; + end record; + + pragma Warnings (Off, "-Winline"); + package Selected_Block_List is + new Ada.Containers.Vectors (Natural, Selected_Block_T); +begin + Ada.Text_Io.Put_Line ("Hello World!"); +end; diff --git a/gcc/testsuite/lib/target-supports.exp b/gcc/testsuite/lib/target-supports.exp index 80e9d67..98f1141 100644 --- a/gcc/testsuite/lib/target-supports.exp +++ b/gcc/testsuite/lib/target-supports.exp @@ -6974,7 +6974,8 @@ proc check_effective_target_vect_logical_reduc { } { # Return 1 if the target supports the fold_extract_last optab. proc check_effective_target_vect_fold_extract_last { } { - return [check_effective_target_aarch64_sve] + return [expr { [check_effective_target_aarch64_sve] + || [istarget amdgcn*-*-*] }] } # Return 1 if the target supports section-anchors diff --git a/gcc/toplev.c b/gcc/toplev.c index 059046f..6f5b53a 100644 --- a/gcc/toplev.c +++ b/gcc/toplev.c @@ -1179,6 +1179,8 @@ general_init (const char *argv0, bool init_signals) = global_options_init.x_flag_diagnostics_show_labels; global_dc->show_line_numbers_p = global_options_init.x_flag_diagnostics_show_line_numbers; + global_dc->show_cwe + = global_options_init.x_flag_diagnostics_show_cwe; global_dc->show_option_requested = global_options_init.x_flag_diagnostics_show_option; global_dc->min_margin_width diff --git a/gcc/tree-pretty-print.c b/gcc/tree-pretty-print.c index 1cf7a91..6036173 100644 --- a/gcc/tree-pretty-print.c +++ b/gcc/tree-pretty-print.c @@ -788,6 +788,9 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags) case GOMP_MAP_POINTER: pp_string (pp, "alloc"); break; + case GOMP_MAP_IF_PRESENT: + pp_string (pp, "no_alloc"); + break; case GOMP_MAP_TO: case GOMP_MAP_TO_PSET: pp_string (pp, "to"); diff --git a/gcc/tree-ssa-ccp.c b/gcc/tree-ssa-ccp.c index 72e15b1..a77c036 100644 --- a/gcc/tree-ssa-ccp.c +++ b/gcc/tree-ssa-ccp.c @@ -146,6 +146,11 @@ along with GCC; see the file COPYING3. If not see #include "stringpool.h" #include "attribs.h" #include "tree-vector-builder.h" +#include "cgraph.h" +#include "alloc-pool.h" +#include "symbol-summary.h" +#include "ipa-utils.h" +#include "ipa-prop.h" /* Possible lattice values. */ typedef enum @@ -292,11 +297,26 @@ get_default_value (tree var) if (flag_tree_bit_ccp) { wide_int nonzero_bits = get_nonzero_bits (var); - if (nonzero_bits != -1) + tree value; + widest_int mask; + + if (SSA_NAME_VAR (var) + && TREE_CODE (SSA_NAME_VAR (var)) == PARM_DECL + && ipcp_get_parm_bits (SSA_NAME_VAR (var), &value, &mask)) + { + val.lattice_val = CONSTANT; + val.value = value; + val.mask = mask; + if (nonzero_bits != -1) + val.mask &= extend_mask (nonzero_bits, + TYPE_SIGN (TREE_TYPE (var))); + } + else if (nonzero_bits != -1) { val.lattice_val = CONSTANT; val.value = build_zero_cst (TREE_TYPE (var)); - val.mask = extend_mask (nonzero_bits, TYPE_SIGN (TREE_TYPE (var))); + val.mask = extend_mask (nonzero_bits, + TYPE_SIGN (TREE_TYPE (var))); } } } diff --git a/gcc/tree-ssa-strlen.c b/gcc/tree-ssa-strlen.c index 212ac71..6ef0741 100644 --- a/gcc/tree-ssa-strlen.c +++ b/gcc/tree-ssa-strlen.c @@ -84,14 +84,20 @@ struct strinfo tree nonzero_chars; /* Any of the corresponding pointers for querying alias oracle. */ tree ptr; - /* This is used for two things: + /* STMT is used for two things: - To record the statement that should be used for delayed length computations. We maintain the invariant that all related strinfos have delayed lengths or none do. - - To record the malloc or calloc call that produced this result. */ + - To record the malloc or calloc call that produced this result + to optimize away malloc/memset sequences. STMT is reset after + a calloc-allocated object has been stored a non-zero value into. */ gimple *stmt; + /* Set to the dynamic allocation statement for the object (alloca, + calloc, malloc, or VLA). Unlike STMT, once set for a strinfo + object, ALLOC doesn't change. */ + gimple *alloc; /* Pointer to '\0' if known, if NULL, it can be computed as ptr + length. */ tree endptr; @@ -189,20 +195,21 @@ static int get_stridx_plus_constant (strinfo *, unsigned HOST_WIDE_INT, tree); static void handle_builtin_stxncpy (built_in_function, gimple_stmt_iterator *); /* Sets MINMAX to either the constant value or the range VAL is in - and returns true on success. When nonnull, uses RVALS to get - VAL's range. Otherwise uses get_range_info. */ + and returns either the constant value or VAL on success or null + when the range couldn't be determined. Uses RVALS when nonnull + to determine the range, otherwise get_range_info. */ -static bool -get_range (tree val, wide_int minmax[2], const vr_values *rvals = NULL) +tree +get_range (tree val, wide_int minmax[2], const vr_values *rvals /* = NULL */) { - if (tree_fits_uhwi_p (val)) + if (TREE_CODE (val) == INTEGER_CST) { minmax[0] = minmax[1] = wi::to_wide (val); - return true; + return val; } if (TREE_CODE (val) != SSA_NAME) - return false; + return NULL_TREE; if (rvals) { @@ -215,20 +222,20 @@ get_range (tree val, wide_int minmax[2], const vr_values *rvals = NULL) = (CONST_CAST (class vr_values *, rvals)->get_value_range (val)); value_range_kind rng = vr->kind (); if (rng != VR_RANGE || !range_int_cst_p (vr)) - return false; + return NULL_TREE; minmax[0] = wi::to_wide (vr->min ()); minmax[1] = wi::to_wide (vr->max ()); - return true; + return val; } value_range_kind rng = get_range_info (val, minmax, minmax + 1); if (rng == VR_RANGE) - return true; + return val; /* Do not handle anti-ranges and instead make use of the on-demand VRP if/when it becomes available (hopefully in GCC 11). */ - return false; + return NULL_TREE; } /* Return: @@ -320,7 +327,7 @@ get_next_strinfo (strinfo *si) /* Helper function for get_stridx. Return the strinfo index of the address of EXP, which is available in PTR if nonnull. If OFFSET_OUT, it is OK to return the index for some X <= &EXP and store &EXP - X in - *OFFSET_OUT. */ + *OFFSET_OUT. When nonnull uses RVALS to determine range information. */ static int get_addr_stridx (tree exp, tree ptr, unsigned HOST_WIDE_INT *offset_out, @@ -380,13 +387,14 @@ get_addr_stridx (tree exp, tree ptr, unsigned HOST_WIDE_INT *offset_out, to a known strinfo with an offset and OFFRNG is non-null, sets both elements of the OFFRNG array to the range of the offset and returns the index of the known strinfo. In this case the result - must not be used in for functions that modify the string. */ + must not be used in for functions that modify the string. + When nonnull, uses RVALS to determine range information. */ static int -get_stridx (tree exp, wide_int offrng[2] = NULL) +get_stridx (tree exp, wide_int offrng[2] = NULL, const vr_values *rvals = NULL) { if (offrng) - offrng[0] = offrng[1] = wi::zero (TYPE_PRECISION (sizetype)); + offrng[0] = offrng[1] = wi::zero (TYPE_PRECISION (ptrdiff_type_node)); if (TREE_CODE (exp) == SSA_NAME) { @@ -465,7 +473,7 @@ get_stridx (tree exp, wide_int offrng[2] = NULL) return the index corresponding to the SSA_NAME. Do this irrespective of the whether the offset is known. */ - if (get_range (off, offrng)) + if (get_range (off, offrng, rvals)) { /* When the offset range is known, increment it it by the constant offset computed in prior @@ -672,6 +680,7 @@ new_strinfo (tree ptr, int idx, tree nonzero_chars, bool full_string_p) si->nonzero_chars = nonzero_chars; si->ptr = ptr; si->stmt = NULL; + si->alloc = NULL; si->endptr = NULL_TREE; si->refcount = 1; si->idx = idx; @@ -838,6 +847,8 @@ get_string_length (strinfo *si) if (chainsi->nonzero_chars == NULL) set_endptr_and_length (loc, chainsi, lhs); break; + case BUILT_IN_ALLOCA: + case BUILT_IN_ALLOCA_WITH_ALIGN: case BUILT_IN_MALLOC: break; /* BUILT_IN_CALLOC always has si->nonzero_chars set. */ @@ -885,45 +896,57 @@ dump_strlen_info (FILE *fp, gimple *stmt, const vr_values *rvals) fprintf (fp, ", ptr = "); print_generic_expr (fp, si->ptr); } - fprintf (fp, ", nonzero_chars = "); - print_generic_expr (fp, si->nonzero_chars); - if (TREE_CODE (si->nonzero_chars) == SSA_NAME) + + if (si->nonzero_chars) { - value_range_kind rng = VR_UNDEFINED; - wide_int min, max; - if (rvals) + fprintf (fp, ", nonzero_chars = "); + print_generic_expr (fp, si->nonzero_chars); + if (TREE_CODE (si->nonzero_chars) == SSA_NAME) { - const value_range_equiv *vr - = CONST_CAST (class vr_values *, rvals) - ->get_value_range (si->nonzero_chars); - rng = vr->kind (); - if (range_int_cst_p (vr)) + value_range_kind rng = VR_UNDEFINED; + wide_int min, max; + if (rvals) { - min = wi::to_wide (vr->min ()); - max = wi::to_wide (vr->max ()); + const value_range *vr + = CONST_CAST (class vr_values *, rvals) + ->get_value_range (si->nonzero_chars); + rng = vr->kind (); + if (range_int_cst_p (vr)) + { + min = wi::to_wide (vr->min ()); + max = wi::to_wide (vr->max ()); + } + else + rng = VR_UNDEFINED; } else - rng = VR_UNDEFINED; - } - else - rng = get_range_info (si->nonzero_chars, &min, &max); + rng = get_range_info (si->nonzero_chars, &min, &max); - if (rng == VR_RANGE || rng == VR_ANTI_RANGE) - { - fprintf (fp, " %s[%llu, %llu]", - rng == VR_RANGE ? "" : "~", - (long long) min.to_uhwi (), - (long long) max.to_uhwi ()); + if (rng == VR_RANGE || rng == VR_ANTI_RANGE) + { + fprintf (fp, " %s[%llu, %llu]", + rng == VR_RANGE ? "" : "~", + (long long) min.to_uhwi (), + (long long) max.to_uhwi ()); + } } } - fprintf (fp, " , refcount = %i", si->refcount); + + fprintf (fp, ", refcount = %i", si->refcount); if (si->stmt) { fprintf (fp, ", stmt = "); print_gimple_expr (fp, si->stmt, 0); } + if (si->alloc) + { + fprintf (fp, ", alloc = "); + print_gimple_expr (fp, si->alloc, 0); + } if (si->writable) fprintf (fp, ", writable"); + if (si->dont_invalidate) + fprintf (fp, ", dont_invalidate"); if (si->full_string_p) fprintf (fp, ", full_string_p"); if (strinfo *next = get_next_strinfo (si)) @@ -1197,80 +1220,87 @@ get_range_strlen_dynamic (tree src, c_strlen_data *pdata, BITMAP_FREE (visited); } -/* Invalidate string length information for strings whose length - might change due to stores in stmt, except those marked DON'T - INVALIDATE. For string-modifying statements, ZERO_WRITE is - set when the statement wrote only zeros. */ +/* Invalidate string length information for strings whose length might + change due to stores in STMT, except those marked DONT_INVALIDATE. + For string-modifying statements, ZERO_WRITE is set when the statement + wrote only zeros. + Returns true if any STRIDX_TO_STRINFO entries were considered + for invalidation. */ static bool maybe_invalidate (gimple *stmt, bool zero_write = false) { if (dump_file && (dump_flags & TDF_DETAILS)) - fprintf (dump_file, " %s()\n", __func__); + { + fprintf (dump_file, "%s called for ", __func__); + print_gimple_stmt (dump_file, stmt, TDF_LINENO); + } strinfo *si; - unsigned int i; bool nonempty = false; - for (i = 1; vec_safe_iterate (stridx_to_strinfo, i, &si); ++i) - if (si != NULL) - { - if (!si->dont_invalidate) - { - ao_ref r; - tree size = NULL_TREE; - if (si->nonzero_chars) - { - /* Include the terminating nul in the size of the string - to consider when determining possible clobber. */ - tree type = TREE_TYPE (si->nonzero_chars); - size = fold_build2 (PLUS_EXPR, type, si->nonzero_chars, - build_int_cst (type, 1)); - } - ao_ref_init_from_ptr_and_size (&r, si->ptr, size); - if (stmt_may_clobber_ref_p_1 (stmt, &r)) - { - if (dump_file && (dump_flags & TDF_DETAILS)) - { - if (size && tree_fits_uhwi_p (size)) - fprintf (dump_file, - " statement may clobber string " - HOST_WIDE_INT_PRINT_UNSIGNED " long\n", - tree_to_uhwi (size)); - else - fprintf (dump_file, - " statement may clobber string\n"); - } + for (unsigned i = 1; vec_safe_iterate (stridx_to_strinfo, i, &si); ++i) + { + if (si == NULL || !POINTER_TYPE_P (TREE_TYPE (si->ptr))) + continue; - set_strinfo (i, NULL); - free_strinfo (si); - continue; - } + nonempty = true; - if (size - && !zero_write - && si->stmt - && is_gimple_call (si->stmt) - && (DECL_FUNCTION_CODE (gimple_call_fndecl (si->stmt)) - == BUILT_IN_CALLOC)) - { - /* If the clobber test above considered the length of - the string (including the nul), then for (potentially) - non-zero writes that might modify storage allocated by - calloc consider the whole object and if it might be - clobbered by the statement reset the allocation - statement. */ - ao_ref_init_from_ptr_and_size (&r, si->ptr, NULL_TREE); - if (stmt_may_clobber_ref_p_1 (stmt, &r)) - si->stmt = NULL; - } - } - si->dont_invalidate = false; - nonempty = true; - } + /* Unconditionally reset DONT_INVALIDATE. */ + bool dont_invalidate = si->dont_invalidate; + si->dont_invalidate = false; + + if (dont_invalidate) + continue; + + ao_ref r; + tree size = NULL_TREE; + if (si->nonzero_chars) + { + /* Include the terminating nul in the size of the string + to consider when determining possible clobber. */ + tree type = TREE_TYPE (si->nonzero_chars); + size = fold_build2 (PLUS_EXPR, type, si->nonzero_chars, + build_int_cst (type, 1)); + } + ao_ref_init_from_ptr_and_size (&r, si->ptr, size); + if (stmt_may_clobber_ref_p_1 (stmt, &r)) + { + if (dump_file && (dump_flags & TDF_DETAILS)) + { + fputs (" statement may clobber object ", dump_file); + print_generic_expr (dump_file, si->ptr); + if (size && tree_fits_uhwi_p (size)) + fprintf (dump_file, " " HOST_WIDE_INT_PRINT_UNSIGNED + " bytes in size", tree_to_uhwi (size)); + fputc ('\n', dump_file); + } + + set_strinfo (i, NULL); + free_strinfo (si); + continue; + } + + if (size + && !zero_write + && si->stmt + && is_gimple_call (si->stmt) + && (DECL_FUNCTION_CODE (gimple_call_fndecl (si->stmt)) + == BUILT_IN_CALLOC)) + { + /* If the clobber test above considered the length of + the string (including the nul), then for (potentially) + non-zero writes that might modify storage allocated by + calloc consider the whole object and if it might be + clobbered by the statement reset the statement. */ + ao_ref_init_from_ptr_and_size (&r, si->ptr, NULL_TREE); + if (stmt_may_clobber_ref_p_1 (stmt, &r)) + si->stmt = NULL; + } + } if (dump_file && (dump_flags & TDF_DETAILS)) - fprintf (dump_file, " %s() ==> %i\n", __func__, nonempty); + fprintf (dump_file, "%s returns %i\n", __func__, nonempty); return nonempty; } @@ -1289,6 +1319,7 @@ unshare_strinfo (strinfo *si) nsi = new_strinfo (si->ptr, si->idx, si->nonzero_chars, si->full_string_p); nsi->stmt = si->stmt; + nsi->alloc = si->alloc; nsi->endptr = si->endptr; nsi->first = si->first; nsi->prev = si->prev; @@ -1582,6 +1613,8 @@ valid_builtin_call (gimple *stmt) return false; break; + case BUILT_IN_ALLOCA: + case BUILT_IN_ALLOCA_WITH_ALIGN: case BUILT_IN_CALLOC: case BUILT_IN_MALLOC: case BUILT_IN_MEMCPY: @@ -1858,92 +1891,159 @@ maybe_set_strlen_range (tree lhs, tree src, tree bound) } /* Diagnose buffer overflow by a STMT writing LEN + PLUS_ONE bytes, - into an object designated by the LHS of STMT otherise. */ + either into a region allocated for the object SI when non-null, + or into an object designated by the LHS of STMT otherwise. + When nonnull uses RVALS to determine range information. + RAWMEM may be set by memcpy and other raw memory functions + to allow accesses across subobject boundaries. */ static void maybe_warn_overflow (gimple *stmt, tree len, const vr_values *rvals = NULL, - strinfo *si = NULL, bool plus_one = false) + strinfo *si = NULL, bool plus_one = false, + bool rawmem = false) { if (!len || gimple_no_warning_p (stmt)) return; + /* The DECL of the function performing the write if it is done + by one. */ tree writefn = NULL_TREE; - tree destdecl = NULL_TREE; - tree destsize = NULL_TREE; + /* The destination expression involved in the store STMT. */ tree dest = NULL_TREE; - /* The offset into the destination object set by compute_objsize - but already reflected in DESTSIZE. */ - tree destoff = NULL_TREE; - if (is_gimple_assign (stmt)) - { - dest = gimple_assign_lhs (stmt); - if (TREE_NO_WARNING (dest)) - return; - - /* For assignments try to determine the size of the destination - first. Set DESTOFF to the the offset on success. */ - tree off = size_zero_node; - destsize = compute_objsize (dest, 1, &destdecl, &off); - if (destsize) - destoff = off; - } + dest = gimple_assign_lhs (stmt); else if (is_gimple_call (stmt)) { - writefn = gimple_call_fndecl (stmt); dest = gimple_call_arg (stmt, 0); + writefn = gimple_call_fndecl (stmt); } + if (TREE_NO_WARNING (dest)) + return; + /* The offset into the destination object computed below and not - reflected in DESTSIZE. Either DESTOFF is set above or OFFRNG - below. */ + reflected in DESTSIZE. */ wide_int offrng[2]; - offrng[0] = wi::zero (TYPE_PRECISION (sizetype)); - offrng[1] = offrng[0]; + const int off_prec = TYPE_PRECISION (ptrdiff_type_node); + offrng[0] = offrng[1] = wi::zero (off_prec); - if (!destsize && !si && dest) + if (!si) { - /* For both assignments and calls, if no destination STRINFO was - provided, try to get it from the DEST. */ + /* If no destination STRINFO was provided try to get it from + the DEST argument. */ tree ref = dest; - tree off = NULL_TREE; if (TREE_CODE (ref) == ARRAY_REF) { /* Handle stores to VLAs (represented as ARRAY_REF (MEM_REF (vlaptr, 0), N]. */ - off = TREE_OPERAND (ref, 1); + tree off = TREE_OPERAND (ref, 1); ref = TREE_OPERAND (ref, 0); + if (get_range (off, offrng, rvals)) + { + offrng[0] = offrng[0].from (offrng[0], off_prec, SIGNED); + offrng[1] = offrng[1].from (offrng[1], off_prec, SIGNED); + } + else + { + offrng[0] = wi::to_wide (TYPE_MIN_VALUE (ptrdiff_type_node)); + offrng[1] = wi::to_wide (TYPE_MAX_VALUE (ptrdiff_type_node)); + } } if (TREE_CODE (ref) == MEM_REF) { tree mem_off = TREE_OPERAND (ref, 1); - if (off) + ref = TREE_OPERAND (ref, 0); + wide_int memoffrng[2]; + if (get_range (mem_off, memoffrng, rvals)) { - if (!integer_zerop (mem_off)) - return; + offrng[0] += memoffrng[0]; + offrng[1] += memoffrng[1]; } else - off = mem_off; - ref = TREE_OPERAND (ref, 0); + { + offrng[0] = wi::to_wide (TYPE_MIN_VALUE (ptrdiff_type_node)); + offrng[1] = wi::to_wide (TYPE_MAX_VALUE (ptrdiff_type_node)); + } } - if (int idx = get_stridx (ref, offrng)) + wide_int stroffrng[2]; + if (int idx = get_stridx (ref, stroffrng, rvals)) { si = get_strinfo (idx); - if (off && TREE_CODE (off) == INTEGER_CST) + offrng[0] += stroffrng[0]; + offrng[1] += stroffrng[1]; + } + } + + /* The allocation call if the destination object was allocated + by one. */ + gimple *alloc_call = NULL; + /* The DECL of the destination object if known and not dynamically + allocated. */ + tree destdecl = NULL_TREE; + /* The offset into the destination object set by compute_objsize + but already reflected in DESTSIZE. */ + tree destoff = NULL_TREE; + /* The size of the destination region (which is smaller than + the destination object for stores at a non-zero offset). */ + tree destsize = NULL_TREE; + + /* Compute the range of sizes of the destination object. The range + is constant for declared objects but may be a range for allocated + objects. */ + const int siz_prec = TYPE_PRECISION (size_type_node); + wide_int sizrng[2]; + if (si) + { + destsize = gimple_call_alloc_size (si->alloc, sizrng, rvals); + alloc_call = si->alloc; + } + else + offrng[0] = offrng[1] = wi::zero (off_prec); + + if (!destsize) + { + /* If there is no STRINFO for DEST, fall back on compute_objsize. */ + tree off = NULL_TREE; + destsize = compute_objsize (dest, rawmem ? 0 : 1, &destdecl, &off, rvals); + if (destsize) + { + /* Remember OFF but clear OFFRNG that may have been set above. */ + destoff = off; + offrng[0] = offrng[1] = wi::zero (off_prec); + + if (destdecl && TREE_CODE (destdecl) == SSA_NAME) { - wide_int wioff = wi::to_wide (off, offrng->get_precision ()); - offrng[0] += wioff; - offrng[1] += wioff; + gimple *stmt = SSA_NAME_DEF_STMT (destdecl); + if (is_gimple_call (stmt)) + alloc_call = stmt; + destdecl = NULL_TREE; + } + + if (!get_range (destsize, sizrng, rvals)) + { + /* On failure, rather than failing, set the maximum range + so that overflow in allocated objects whose size depends + on the strlen of the source can still be diagnosed + below. */ + sizrng[0] = wi::zero (siz_prec); + sizrng[1] = wi::to_wide (TYPE_MAX_VALUE (sizetype)); } } - else - return; } + if (!destsize) + { + sizrng[0] = wi::zero (siz_prec); + sizrng[1] = wi::to_wide (TYPE_MAX_VALUE (sizetype)); + }; + + sizrng[0] = sizrng[0].from (sizrng[0], siz_prec, UNSIGNED); + sizrng[1] = sizrng[1].from (sizrng[1], siz_prec, UNSIGNED); + /* Return early if the DESTSIZE size expression is the same as LEN and the offset into the destination is zero. This might happen in the case of a pair of malloc and memset calls to allocate @@ -1961,37 +2061,43 @@ maybe_warn_overflow (gimple *stmt, tree len, lenrng[1] += 1; } - /* Compute the range of sizes of the destination object. The range - is constant for declared objects but may be a range for allocated - objects. */ - wide_int sizrng[2]; - if (!destsize || !get_range (destsize, sizrng, rvals)) - { - /* On failure, rather than bailing outright, use the maximum range - so that overflow in allocated objects whose size depends on - the strlen of the source can still be diagnosed below. */ - sizrng[0] = wi::zero (lenrng->get_precision ()); - sizrng[1] = wi::to_wide (TYPE_MAX_VALUE (ptrdiff_type_node)); - } - - /* The size of the remaining space in the destination computed as - the size of the latter minus the offset into it. */ + /* The size of the remaining space in the destination computed + as the size of the latter minus the offset into it. */ wide_int spcrng[2] = { sizrng[0], sizrng[1] }; - if (wi::sign_mask (offrng[0])) + if (wi::neg_p (offrng[0]) && wi::neg_p (offrng[1])) { - /* FIXME: Handle negative offsets into allocated objects. */ - if (destdecl) - spcrng[0] = spcrng[1] = wi::zero (spcrng->get_precision ()); - else + /* When the offset is negative and the size of the destination + object unknown there is little to do. + FIXME: Detect offsets that are necessarily invalid regardless + of the size of the object. */ + if (!destsize) return; + + /* The remaining space is necessarily zero. */ + spcrng[0] = spcrng[1] = wi::zero (spcrng->get_precision ()); + } + else if (wi::neg_p (offrng[0])) + { + /* When the lower bound of the offset is negative but the upper + bound is not, reduce the upper bound of the remaining space + by the upper bound of the offset but leave the lower bound + unchanged. If that makes the upper bound of the space less + than the lower bound swap the two. */ + spcrng[1] -= wi::ltu_p (offrng[1], spcrng[1]) ? offrng[1] : spcrng[1]; + if (wi::ltu_p (spcrng[1], spcrng[0])) + std::swap (spcrng[1], spcrng[0]); } else { + /* When the offset is positive reduce the remaining space by + the lower bound of the offset or clear it if the offset is + greater. */ spcrng[0] -= wi::ltu_p (offrng[0], spcrng[0]) ? offrng[0] : spcrng[0]; spcrng[1] -= wi::ltu_p (offrng[0], spcrng[1]) ? offrng[0] : spcrng[1]; } - if (wi::leu_p (lenrng[0], spcrng[0])) + if (wi::leu_p (lenrng[0], spcrng[0]) + && wi::leu_p (lenrng[1], spcrng[1])) return; if (lenrng[0] == spcrng[1] @@ -2092,6 +2198,8 @@ maybe_warn_overflow (gimple *stmt, tree len, if (!warned) return; + gimple_set_no_warning (stmt, true); + /* If DESTOFF is not null, use it to format the offset value/range. */ if (destoff) get_range (destoff, offrng); @@ -2117,17 +2225,91 @@ maybe_warn_overflow (gimple *stmt, tree len, offstr, destdecl); return; } + + if (!alloc_call) + return; + + tree allocfn = gimple_call_fndecl (alloc_call); + if (!allocfn) + { + /* For an ALLOC_CALL via a function pointer make a small effort + to determine the destination of the pointer. */ + allocfn = gimple_call_fn (alloc_call); + if (TREE_CODE (allocfn) == SSA_NAME) + { + gimple *def = SSA_NAME_DEF_STMT (allocfn); + if (gimple_assign_single_p (def)) + { + tree rhs = gimple_assign_rhs1 (def); + if (DECL_P (rhs)) + allocfn = rhs; + else if (TREE_CODE (rhs) == COMPONENT_REF) + allocfn = TREE_OPERAND (rhs, 1); + } + } + } + + if (gimple_call_builtin_p (alloc_call, BUILT_IN_ALLOCA_WITH_ALIGN)) + { + if (sizrng[0] == sizrng[1]) + inform (gimple_location (alloc_call), + "at offset %s to an object with size %wu declared here", + offstr, sizrng[0].to_uhwi ()); + else if (sizrng[0] == 0) + { + /* Avoid printing impossible sizes. */ + if (wi::ltu_p (sizrng[1], + wi::to_wide (TYPE_MAX_VALUE (ptrdiff_type_node)) - 2)) + inform (gimple_location (alloc_call), + "at offset %s to an object with size at most %wu " + "declared here", + offstr, sizrng[1].to_uhwi ()); + else + inform (gimple_location (alloc_call), + "at offset %s to an object declared here", offstr); + } + else + inform (gimple_location (alloc_call), + "at offset %s to an object with size between %wu and %wu " + "declared here", + offstr, sizrng[0].to_uhwi (), sizrng[1].to_uhwi ()); + return; + } + + if (sizrng[0] == sizrng[1]) + inform (gimple_location (alloc_call), + "at offset %s to an object with size %wu allocated by %qE here", + offstr, sizrng[0].to_uhwi (), allocfn); + else if (sizrng[0] == 0) + { + /* Avoid printing impossible sizes. */ + if (wi::ltu_p (sizrng[1], + wi::to_wide (TYPE_MAX_VALUE (ptrdiff_type_node)) - 2)) + inform (gimple_location (alloc_call), + "at offset %s to an object with size at most %wu allocated " + "by %qD here", + offstr, sizrng[1].to_uhwi (), allocfn); + else + inform (gimple_location (alloc_call), + "at offset %s to an object allocated by %qE here", + offstr, allocfn); + } + else + inform (gimple_location (alloc_call), + "at offset %s to an object with size between %wu and %wu " + "allocated by %qE here", + offstr, sizrng[0].to_uhwi (), sizrng[1].to_uhwi (), allocfn); } /* Convenience wrapper for the above. */ static inline void maybe_warn_overflow (gimple *stmt, unsigned HOST_WIDE_INT len, - const vr_values *rvals = NULL, - strinfo *si = NULL, bool plus_one = false) + const vr_values *rvals = NULL, strinfo *si = NULL, + bool plus_one = false, bool rawmem = false) { maybe_warn_overflow (stmt, build_int_cst (size_type_node, len), rvals, - si, plus_one); + si, plus_one, rawmem); } /* Handle a strlen call. If strlen of the argument is known, replace @@ -2243,7 +2425,7 @@ handle_builtin_strlen (gimple_stmt_iterator *gsi) tree old = si->nonzero_chars; si->nonzero_chars = lhs; si->full_string_p = true; - if (TREE_CODE (old) == INTEGER_CST) + if (old && TREE_CODE (old) == INTEGER_CST) { old = fold_convert_loc (loc, TREE_TYPE (lhs), old); tree adj = fold_build2_loc (loc, MINUS_EXPR, @@ -2422,10 +2604,11 @@ handle_builtin_strchr (gimple_stmt_iterator *gsi) /* Handle a strcpy-like ({st{r,p}cpy,__st{r,p}cpy_chk}) call. If strlen of the second argument is known, strlen of the first argument is the same after this call. Furthermore, attempt to convert it to - memcpy. */ + memcpy. Uses RVALS to determine range information. */ static void -handle_builtin_strcpy (enum built_in_function bcode, gimple_stmt_iterator *gsi) +handle_builtin_strcpy (enum built_in_function bcode, gimple_stmt_iterator *gsi, + const vr_values *rvals) { int idx, didx; tree src, dst, srclen, len, lhs, type, fn, oldlen; @@ -2459,6 +2642,11 @@ handle_builtin_strcpy (enum built_in_function bcode, gimple_stmt_iterator *gsi) else if (idx < 0) srclen = build_int_cst (size_type_node, ~idx); + maybe_warn_overflow (stmt, srclen, rvals, olddsi, true); + + if (olddsi != NULL) + adjust_last_stmt (olddsi, stmt, false); + loc = gimple_location (stmt); if (srclen == NULL_TREE) switch (bcode) @@ -2709,26 +2897,58 @@ is_strlen_related_p (tree src, tree len) if (TREE_CODE (len) != SSA_NAME) return false; - gimple *def_stmt = SSA_NAME_DEF_STMT (len); - if (!def_stmt) + if (TREE_CODE (src) == SSA_NAME) + { + gimple *srcdef = SSA_NAME_DEF_STMT (src); + if (is_gimple_assign (srcdef)) + { + /* Handle bitwise AND used in conversions from wider size_t + to narrower unsigned types. */ + tree_code code = gimple_assign_rhs_code (srcdef); + if (code == BIT_AND_EXPR + || code == NOP_EXPR) + return is_strlen_related_p (gimple_assign_rhs1 (srcdef), len); + + return false; + } + + if (gimple_call_builtin_p (srcdef, BUILT_IN_NORMAL)) + { + /* If SRC is the result of a call to an allocation function + or strlen, use the function's argument instead. */ + tree func = gimple_call_fndecl (srcdef); + built_in_function code = DECL_FUNCTION_CODE (func); + if (code == BUILT_IN_ALLOCA + || code == BUILT_IN_ALLOCA_WITH_ALIGN + || code == BUILT_IN_MALLOC + || code == BUILT_IN_STRLEN) + return is_strlen_related_p (gimple_call_arg (srcdef, 0), len); + + /* FIXME: Handle other functions with attribute alloc_size. */ + return false; + } + } + + gimple *lendef = SSA_NAME_DEF_STMT (len); + if (!lendef) return false; - if (is_gimple_call (def_stmt)) + if (is_gimple_call (lendef)) { - tree func = gimple_call_fndecl (def_stmt); - if (!valid_builtin_call (def_stmt) + tree func = gimple_call_fndecl (lendef); + if (!valid_builtin_call (lendef) || DECL_FUNCTION_CODE (func) != BUILT_IN_STRLEN) return false; - tree arg = gimple_call_arg (def_stmt, 0); + tree arg = gimple_call_arg (lendef, 0); return is_strlen_related_p (src, arg); } - if (!is_gimple_assign (def_stmt)) + if (!is_gimple_assign (lendef)) return false; - tree_code code = gimple_assign_rhs_code (def_stmt); - tree rhs1 = gimple_assign_rhs1 (def_stmt); + tree_code code = gimple_assign_rhs_code (lendef); + tree rhs1 = gimple_assign_rhs1 (lendef); tree rhstype = TREE_TYPE (rhs1); if ((TREE_CODE (rhstype) == POINTER_TYPE && code == POINTER_PLUS_EXPR) @@ -2741,7 +2961,7 @@ is_strlen_related_p (tree src, tree len) return is_strlen_related_p (src, rhs1); } - if (tree rhs2 = gimple_assign_rhs2 (def_stmt)) + if (tree rhs2 = gimple_assign_rhs2 (lendef)) { /* Integer subtraction is considered strlen-related when both arguments are integers and second one is strlen-related. */ @@ -3187,34 +3407,37 @@ handle_builtin_stxncpy (built_in_function, gimple_stmt_iterator *gsi) /* Handle a memcpy-like ({mem{,p}cpy,__mem{,p}cpy_chk}) call. If strlen of the second argument is known and length of the third argument is that plus one, strlen of the first argument is the same after this - call. */ + call. Uses RVALS to determine range information. */ static void -handle_builtin_memcpy (enum built_in_function bcode, gimple_stmt_iterator *gsi) +handle_builtin_memcpy (enum built_in_function bcode, gimple_stmt_iterator *gsi, + const vr_values *rvals) { - int idx, didx; - tree src, dst, len, lhs, oldlen, newlen; + tree lhs, oldlen, newlen; gimple *stmt = gsi_stmt (*gsi); - strinfo *si, *dsi, *olddsi; + strinfo *si, *dsi; - len = gimple_call_arg (stmt, 2); - src = gimple_call_arg (stmt, 1); - dst = gimple_call_arg (stmt, 0); - idx = get_stridx (src); - if (idx == 0) - return; + tree len = gimple_call_arg (stmt, 2); + tree src = gimple_call_arg (stmt, 1); + tree dst = gimple_call_arg (stmt, 0); - didx = get_stridx (dst); - olddsi = NULL; + int didx = get_stridx (dst); + strinfo *olddsi = NULL; if (didx > 0) olddsi = get_strinfo (didx); else if (didx < 0) return; if (olddsi != NULL - && tree_fits_uhwi_p (len) && !integer_zerop (len)) - adjust_last_stmt (olddsi, stmt, false); + { + maybe_warn_overflow (stmt, len, rvals, olddsi, false, true); + adjust_last_stmt (olddsi, stmt, false); + } + + int idx = get_stridx (src); + if (idx == 0) + return; bool full_string_p; if (idx > 0) @@ -3611,10 +3834,11 @@ handle_builtin_strcat (enum built_in_function bcode, gimple_stmt_iterator *gsi) gimple_set_no_warning (stmt, true); } -/* Handle a call to malloc or calloc. */ +/* Handle a call to an allocation function like alloca, malloc or calloc, + or an ordinary allocation function declared with attribute alloc_size. */ static void -handle_builtin_malloc (enum built_in_function bcode, gimple_stmt_iterator *gsi) +handle_alloc_call (enum built_in_function bcode, gimple_stmt_iterator *gsi) { gimple *stmt = gsi_stmt (*gsi); tree lhs = gimple_call_lhs (stmt); @@ -3628,59 +3852,89 @@ handle_builtin_malloc (enum built_in_function bcode, gimple_stmt_iterator *gsi) length = build_int_cst (size_type_node, 0); strinfo *si = new_strinfo (lhs, idx, length, length != NULL_TREE); if (bcode == BUILT_IN_CALLOC) - si->endptr = lhs; + { + /* Only set STMT for calloc and malloc. */ + si->stmt = stmt; + /* Only set ENDPTR for calloc. */ + si->endptr = lhs; + } + else if (bcode == BUILT_IN_MALLOC) + si->stmt = stmt; + + /* Set ALLOC is set for all allocation functions. */ + si->alloc = stmt; set_strinfo (idx, si); si->writable = true; - si->stmt = stmt; si->dont_invalidate = true; } /* Handle a call to memset. After a call to calloc, memset(,0,) is unnecessary. memset(malloc(n),0,n) is calloc(n,1). - return true when the call is transformed, false otherwise. */ + return true when the call is transformed, false otherwise. + When nonnull uses RVALS to determine range information. */ static bool -handle_builtin_memset (gimple_stmt_iterator *gsi, bool *zero_write) +handle_builtin_memset (gimple_stmt_iterator *gsi, bool *zero_write, + const vr_values *rvals) { - gimple *stmt2 = gsi_stmt (*gsi); - if (!integer_zerop (gimple_call_arg (stmt2, 1))) - return false; - - /* Let the caller know the memset call cleared the destination. */ - *zero_write = true; - - tree ptr = gimple_call_arg (stmt2, 0); - int idx1 = get_stridx (ptr); + gimple *memset_stmt = gsi_stmt (*gsi); + tree ptr = gimple_call_arg (memset_stmt, 0); + /* Set to the non-constant offset added to PTR. */ + wide_int offrng[2]; + int idx1 = get_stridx (ptr, offrng, rvals); if (idx1 <= 0) return false; strinfo *si1 = get_strinfo (idx1); if (!si1) return false; - gimple *stmt1 = si1->stmt; - if (!stmt1 || !is_gimple_call (stmt1)) + gimple *alloc_stmt = si1->alloc; + if (!alloc_stmt || !is_gimple_call (alloc_stmt)) + return false; + tree callee1 = gimple_call_fndecl (alloc_stmt); + if (!valid_builtin_call (alloc_stmt)) + return false; + tree alloc_size = gimple_call_arg (alloc_stmt, 0); + tree memset_size = gimple_call_arg (memset_stmt, 2); + + /* Check for overflow. */ + maybe_warn_overflow (memset_stmt, memset_size, rvals, NULL, false, true); + + /* Bail when there is no statement associated with the destination + (the statement may be null even when SI1->ALLOC is not). */ + if (!si1->stmt) return false; - tree callee1 = gimple_call_fndecl (stmt1); - if (!valid_builtin_call (stmt1)) + + /* Avoid optimizing if store is at a variable offset from the beginning + of the allocated object. */ + if (offrng[0] != 0 || offrng[0] != offrng[1]) return false; + + /* Bail when the call writes a non-zero value. */ + if (!integer_zerop (gimple_call_arg (memset_stmt, 1))) + return false; + + /* Let the caller know the memset call cleared the destination. */ + *zero_write = true; + enum built_in_function code1 = DECL_FUNCTION_CODE (callee1); - tree size = gimple_call_arg (stmt2, 2); if (code1 == BUILT_IN_CALLOC) - /* Not touching stmt1 */ ; + /* Not touching alloc_stmt */ ; else if (code1 == BUILT_IN_MALLOC - && operand_equal_p (gimple_call_arg (stmt1, 0), size, 0)) + && operand_equal_p (memset_size, alloc_size, 0)) { - gimple_stmt_iterator gsi1 = gsi_for_stmt (stmt1); + /* Replace the malloc + memset calls with calloc. */ + gimple_stmt_iterator gsi1 = gsi_for_stmt (si1->stmt); update_gimple_call (&gsi1, builtin_decl_implicit (BUILT_IN_CALLOC), 2, - size, build_one_cst (size_type_node)); + alloc_size, build_one_cst (size_type_node)); si1->nonzero_chars = build_int_cst (size_type_node, 0); si1->full_string_p = true; si1->stmt = gsi_stmt (gsi1); } else return false; - tree lhs = gimple_call_lhs (stmt2); - unlink_stmt_vdef (stmt2); + tree lhs = gimple_call_lhs (memset_stmt); + unlink_stmt_vdef (memset_stmt); if (lhs) { gimple *assign = gimple_build_assign (lhs, ptr); @@ -3689,7 +3943,7 @@ handle_builtin_memset (gimple_stmt_iterator *gsi, bool *zero_write) else { gsi_remove (gsi, true); - release_defs (stmt2); + release_defs (memset_stmt); } return true; @@ -4391,7 +4645,8 @@ int ssa_name_limit_t::next_ssa_name (tree ssa_name) OFFSET and NBYTES are the offset into the representation and the size of the access to it determined from a MEM_REF or zero for other expressions. - Avoid recursing deeper than the limits in SNLIM allow. + Uses RVALS to determine range information. + Avoids recursing deeper than the limits in SNLIM allow. Returns true on success and false otherwise. */ static bool @@ -4438,6 +4693,29 @@ count_nonzero_bytes (tree exp, unsigned HOST_WIDE_INT offset, if (maxlen + 1 < nbytes) return false; + if (!nbytes + && TREE_CODE (si->ptr) == SSA_NAME + && !POINTER_TYPE_P (TREE_TYPE (si->ptr))) + { + /* SI->PTR is an SSA_NAME with a DEF_STMT like + _1 = MEM <unsigned int> [(char * {ref-all})s_4(D)]; */ + gimple *stmt = SSA_NAME_DEF_STMT (exp); + if (gimple_assign_single_p (stmt) + && gimple_assign_rhs_code (stmt) == MEM_REF) + { + tree rhs = gimple_assign_rhs1 (stmt); + if (tree refsize = TYPE_SIZE_UNIT (TREE_TYPE (rhs))) + if (tree_fits_uhwi_p (refsize)) + { + nbytes = tree_to_uhwi (refsize); + maxlen = nbytes; + } + } + + if (!nbytes) + return false; + } + if (nbytes <= minlen) *nulterm = false; @@ -4454,7 +4732,7 @@ count_nonzero_bytes (tree exp, unsigned HOST_WIDE_INT offset, lenrange[1] = maxlen; if (lenrange[2] < nbytes) - (lenrange[2] = nbytes); + lenrange[2] = nbytes; /* Since only the length of the string are known and not its contents, clear ALLNUL and ALLNONNUL purely on the basis of the length. */ @@ -4672,7 +4950,8 @@ count_nonzero_bytes (tree exp, unsigned lenrange[3], bool *nulterm, the next statement in the basic block and false otherwise. */ static bool -handle_store (gimple_stmt_iterator *gsi, bool *zero_write, const vr_values *rvals) +handle_store (gimple_stmt_iterator *gsi, bool *zero_write, + const vr_values *rvals) { int idx = -1; strinfo *si = NULL; @@ -5076,16 +5355,23 @@ is_char_type (tree type) } /* Check the built-in call at GSI for validity and optimize it. + Uses RVALS to determine range information. Return true to let the caller advance *GSI to the next statement in the basic block and false otherwise. */ static bool -strlen_check_and_optimize_call (gimple_stmt_iterator *gsi, - bool *zero_write, +strlen_check_and_optimize_call (gimple_stmt_iterator *gsi, bool *zero_write, const vr_values *rvals) { gimple *stmt = gsi_stmt (*gsi); + if (!gimple_call_builtin_p (stmt, BUILT_IN_NORMAL)) + { + tree fntype = gimple_call_fntype (stmt); + if (fntype && lookup_attribute ("alloc_size", TYPE_ATTRIBUTES (fntype))) + handle_alloc_call (BUILT_IN_NONE, gsi); + } + /* When not optimizing we must be checking printf calls which we do even for user-defined functions when they are declared with attribute format. */ @@ -5108,7 +5394,7 @@ strlen_check_and_optimize_call (gimple_stmt_iterator *gsi, case BUILT_IN_STRCPY_CHK: case BUILT_IN_STPCPY: case BUILT_IN_STPCPY_CHK: - handle_builtin_strcpy (DECL_FUNCTION_CODE (callee), gsi); + handle_builtin_strcpy (DECL_FUNCTION_CODE (callee), gsi, rvals); break; case BUILT_IN_STRNCAT: @@ -5127,18 +5413,20 @@ strlen_check_and_optimize_call (gimple_stmt_iterator *gsi, case BUILT_IN_MEMCPY_CHK: case BUILT_IN_MEMPCPY: case BUILT_IN_MEMPCPY_CHK: - handle_builtin_memcpy (DECL_FUNCTION_CODE (callee), gsi); + handle_builtin_memcpy (DECL_FUNCTION_CODE (callee), gsi, rvals); break; case BUILT_IN_STRCAT: case BUILT_IN_STRCAT_CHK: handle_builtin_strcat (DECL_FUNCTION_CODE (callee), gsi); break; + case BUILT_IN_ALLOCA: + case BUILT_IN_ALLOCA_WITH_ALIGN: case BUILT_IN_MALLOC: case BUILT_IN_CALLOC: - handle_builtin_malloc (DECL_FUNCTION_CODE (callee), gsi); + handle_alloc_call (DECL_FUNCTION_CODE (callee), gsi); break; case BUILT_IN_MEMSET: - if (handle_builtin_memset (gsi, zero_write)) + if (handle_builtin_memset (gsi, zero_write, rvals)) return false; break; case BUILT_IN_MEMCMP: @@ -5163,7 +5451,8 @@ strlen_check_and_optimize_call (gimple_stmt_iterator *gsi, If GSI's basic block needs clean-up of EH, set *CLEANUP_EH to true. */ static void -handle_integral_assign (gimple_stmt_iterator *gsi, bool *cleanup_eh) +handle_integral_assign (gimple_stmt_iterator *gsi, bool *cleanup_eh, + const vr_values *rvals) { gimple *stmt = gsi_stmt (*gsi); tree lhs = gimple_assign_lhs (stmt); @@ -5266,6 +5555,31 @@ handle_integral_assign (gimple_stmt_iterator *gsi, bool *cleanup_eh) } } } + else if (code == MEM_REF && TREE_CODE (lhs) == SSA_NAME) + { + if (int idx = new_stridx (lhs)) + { + /* Record multi-byte assignments from MEM_REFs. */ + bool storing_all_nonzero_p; + bool storing_all_zeros_p; + bool full_string_p; + unsigned lenrange[] = { UINT_MAX, 0, 0 }; + tree rhs = gimple_assign_rhs1 (stmt); + const bool ranges_valid + = count_nonzero_bytes (rhs, lenrange, &full_string_p, + &storing_all_zeros_p, &storing_all_nonzero_p, + rvals); + if (ranges_valid) + { + tree length = build_int_cst (sizetype, lenrange[0]); + strinfo *si = new_strinfo (lhs, idx, length, full_string_p); + set_strinfo (idx, si); + si->writable = true; + si->dont_invalidate = true; + maybe_warn_overflow (stmt, lenrange[2], rvals); + } + } + } if (strlen_to_stridx) { @@ -5318,29 +5632,35 @@ check_and_optimize_stmt (gimple_stmt_iterator *gsi, bool *cleanup_eh, } else if (TREE_CODE (lhs) == SSA_NAME && INTEGRAL_TYPE_P (lhs_type)) /* Handle assignment to a character. */ - handle_integral_assign (gsi, cleanup_eh); + handle_integral_assign (gsi, cleanup_eh, rvals); else if (TREE_CODE (lhs) != SSA_NAME && !TREE_SIDE_EFFECTS (lhs)) { tree type = TREE_TYPE (lhs); if (TREE_CODE (type) == ARRAY_TYPE) type = TREE_TYPE (type); - bool is_char_store = is_char_type (type); - if (!is_char_store && TREE_CODE (lhs) == MEM_REF) - { - /* To consider stores into char objects via integer types - other than char but not those to non-character objects, - determine the type of the destination rather than just - the type of the access. */ - tree ref = TREE_OPERAND (lhs, 0); - type = TREE_TYPE (ref); - if (TREE_CODE (type) == POINTER_TYPE) - type = TREE_TYPE (type); - if (TREE_CODE (type) == ARRAY_TYPE) - type = TREE_TYPE (type); - if (is_char_type (type)) - is_char_store = true; - } + bool is_char_store = is_char_type (type); + if (!is_char_store && TREE_CODE (lhs) == MEM_REF) + { + /* To consider stores into char objects via integer types + other than char but not those to non-character objects, + determine the type of the destination rather than just + the type of the access. */ + for (int i = 0; i != 2; ++i) + { + tree ref = TREE_OPERAND (lhs, i); + type = TREE_TYPE (ref); + if (TREE_CODE (type) == POINTER_TYPE) + type = TREE_TYPE (type); + if (TREE_CODE (type) == ARRAY_TYPE) + type = TREE_TYPE (type); + if (is_char_type (type)) + { + is_char_store = true; + break; + } + } + } /* Handle a single or multibyte assignment. */ if (is_char_store && !handle_store (gsi, &zero_write, rvals)) diff --git a/gcc/tree-ssa-strlen.h b/gcc/tree-ssa-strlen.h index 4d43fc6..46f2c0a 100644 --- a/gcc/tree-ssa-strlen.h +++ b/gcc/tree-ssa-strlen.h @@ -25,8 +25,10 @@ extern bool is_strlen_related_p (tree, tree); extern bool maybe_diag_stxncpy_trunc (gimple_stmt_iterator, tree, tree); extern tree set_strlen_range (tree, wide_int, wide_int, tree = NULL_TREE); -struct c_strlen_data; class vr_values; +extern tree get_range (tree, wide_int[2], const vr_values * = NULL); + +struct c_strlen_data; extern void get_range_strlen_dynamic (tree , c_strlen_data *, const vr_values *); /* APIs internal to strlen pass. Defined in in gimple-ssa-sprintf.c. */ diff --git a/gcc/tree-vect-loop.c b/gcc/tree-vect-loop.c index 353a5ff..68699f2 100644 --- a/gcc/tree-vect-loop.c +++ b/gcc/tree-vect-loop.c @@ -4534,7 +4534,10 @@ vect_create_epilog_for_reduction (stmt_vec_info stmt_info, containing the last time the condition passed for that vector lane. The first match will be a 1 to allow 0 to be used for non-matching indexes. If there are no matches at all then the vector will be all - zeroes. */ + zeroes. + + PR92772: This algorithm is broken for architectures that support + masked vectors, but do not provide fold_extract_last. */ if (STMT_VINFO_REDUC_TYPE (reduc_info) == COND_REDUCTION) { auto_vec<std::pair<tree, bool>, 2> ccompares; @@ -13583,8 +13583,8 @@ get_initializer_for (tree init, tree decl) determine the size of an initialized flexible array member. If non-null, *INTERIOR_ZERO_LENGTH is set when REF refers to an interior zero-length array. - Returns the size (which might be zero for an object with - an uninitialized flexible array member) or null if the size + Returns the size as sizetype (which might be zero for an object + with an uninitialized flexible array member) or null if the size cannot be determined. */ tree @@ -13733,7 +13733,7 @@ component_ref_size (tree ref, bool *interior_zero_length /* = NULL */) memsz64 -= baseoff; return wide_int_to_tree (TREE_TYPE (memsize), memsz64); } - return integer_zero_node; + return size_zero_node; } /* Return "don't know" for an external non-array object since its @@ -13744,7 +13744,7 @@ component_ref_size (tree ref, bool *interior_zero_length /* = NULL */) && DECL_EXTERNAL (base) && (!typematch || TREE_CODE (basetype) != ARRAY_TYPE) - ? NULL_TREE : integer_zero_node); + ? NULL_TREE : size_zero_node); } /* Return the machine mode of T. For vectors, returns the mode of the diff --git a/include/ChangeLog b/include/ChangeLog index 6364ab4..faeb5c4 100644 --- a/include/ChangeLog +++ b/include/ChangeLog @@ -1,3 +1,10 @@ +2019-12-19 Julian Brown <julian@codesourcery.com> + Maciej W. Rozycki <macro@codesourcery.com> + Tobias Burnus <tobias@codesourcery.com> + Thomas Schwinge <thomas@codesourcery.com> + + * gomp-constants.h (gomp_map_kind): Support GOMP_MAP_NO_ALLOC. + 2019-11-16 Tim Ruehsen <tim.ruehsen@gmx.de> * demangle.h (struct demangle_component): Add member diff --git a/include/gomp-constants.h b/include/gomp-constants.h index 9e356cd..79c5de3 100644 --- a/include/gomp-constants.h +++ b/include/gomp-constants.h @@ -75,6 +75,8 @@ enum gomp_map_kind GOMP_MAP_DEVICE_RESIDENT = (GOMP_MAP_FLAG_SPECIAL_1 | 1), /* OpenACC link. */ GOMP_MAP_LINK = (GOMP_MAP_FLAG_SPECIAL_1 | 2), + /* Use device data if present, fall back to host address otherwise. */ + GOMP_MAP_IF_PRESENT = (GOMP_MAP_FLAG_SPECIAL_1 | 3), /* Do not map, copy bits for firstprivate instead. */ GOMP_MAP_FIRSTPRIVATE = (GOMP_MAP_FLAG_SPECIAL | 0), /* Similarly, but store the value in the pointer rather than diff --git a/libcc1/ChangeLog b/libcc1/ChangeLog index b288fc9..a56deb5 100644 --- a/libcc1/ChangeLog +++ b/libcc1/ChangeLog @@ -1,3 +1,10 @@ +2019-12-18 Paolo Carlini <paolo.carlini@oracle.com> + + * libcp1plugin.cc (plugin_build_unary_expr): Update build_throw + and cxx_sizeof_or_alignof_expr calls. + (plugin_build_unary_type_expr): Likewise for + cxx_sizeof_or_alignof_type. + 2019-12-09 Paolo Carlini <paolo.carlini@oracle.com> * libcp1plugin.cc (plugin_build_cast_expr): Adjust build_cast diff --git a/libcc1/libcp1plugin.cc b/libcc1/libcp1plugin.cc index aa9844a..56eaf9b 100644 --- a/libcc1/libcp1plugin.cc +++ b/libcc1/libcp1plugin.cc @@ -2797,7 +2797,7 @@ plugin_build_unary_expr (cc1_plugin::connection *self, break; case THROW_EXPR: - result = build_throw (op0); + result = build_throw (input_location, op0); break; case TYPEID_EXPR: @@ -2806,7 +2806,8 @@ plugin_build_unary_expr (cc1_plugin::connection *self, case SIZEOF_EXPR: case ALIGNOF_EXPR: - result = cxx_sizeof_or_alignof_expr (op0, opcode, true); + result = cxx_sizeof_or_alignof_expr (input_location, + op0, opcode, true); break; case DELETE_EXPR: @@ -3048,7 +3049,8 @@ plugin_build_unary_type_expr (cc1_plugin::connection *self, default: /* Use the C++11 alignof semantics. */ - result = cxx_sizeof_or_alignof_type (type, opcode, true, true); + result = cxx_sizeof_or_alignof_type (input_location, type, + opcode, true, true); } if (template_dependent_p) diff --git a/libcpp/ChangeLog b/libcpp/ChangeLog index 2090bd7..a11da28 100644 --- a/libcpp/ChangeLog +++ b/libcpp/ChangeLog @@ -1,3 +1,18 @@ +2019-12-18 David Malcolm <dmalcolm@redhat.com> + + PR preprocessor/92982 + * charset.c + (cpp_string_location_reader::cpp_string_location_reader): Delete + initialization of m_line_table. + * include/cpplib.h (cpp_string_location_reader::m_line_table): + Delete unused member. + +2019-12-14 Jakub Jelinek <jakub@redhat.com> + + PR preprocessor/92919 + * charset.c (wide_str_to_charconst): If str contains just the + NUL terminator, punt quietly. + 2019-12-09 David Malcolm <dmalcolm@redhat.com> * include/line-map.h (label_text::label_text): Make private. diff --git a/libcpp/charset.c b/libcpp/charset.c index 956d2da..5da39a6 100644 --- a/libcpp/charset.c +++ b/libcpp/charset.c @@ -1970,6 +1970,17 @@ wide_str_to_charconst (cpp_reader *pfile, cpp_string str, size_t off, i; cppchar_t result = 0, c; + if (str.len <= nbwc) + { + /* Error recovery, if no errors have been diagnosed previously, + there should be at least two wide characters. Empty literals + are diagnosed earlier and we can get just the zero terminator + only if there were errors diagnosed during conversion. */ + *pchars_seen = 0; + *unsignedp = 0; + return 0; + } + /* This is finicky because the string is in the target's byte order, which may not be our byte order. Only the last character, ignoring the NUL terminator, is relevant. */ @@ -2237,7 +2248,6 @@ _cpp_default_encoding (void) cpp_string_location_reader:: cpp_string_location_reader (location_t src_loc, line_maps *line_table) -: m_line_table (line_table) { src_loc = get_range_from_loc (line_table, src_loc).m_start; diff --git a/libcpp/include/cpplib.h b/libcpp/include/cpplib.h index e199aec..1349871 100644 --- a/libcpp/include/cpplib.h +++ b/libcpp/include/cpplib.h @@ -912,7 +912,6 @@ class cpp_string_location_reader { private: location_t m_loc; int m_offset_per_column; - line_maps *m_line_table; }; /* A class for storing the source ranges of all of the characters within diff --git a/libgcc/ChangeLog b/libgcc/ChangeLog index 90ea2a4..6faa4d3 100644 --- a/libgcc/ChangeLog +++ b/libgcc/ChangeLog @@ -1,3 +1,11 @@ +2019-12-16 Jozef Lawrynowicz <jozef.l@mittosystems.com> + + * config.host: s/msp430*-*-elf/msp430-*-elf*. + Override default "extra_parts" variable. + * configure: Regenerate. + * configure.ac: Disable TM clone registry by default for + msp430-elfbare. + 2019-12-11 Jozef Lawrynowicz <jozef.l@mittosystems.com> * config.host (msp430*-*-elf): Add crt{begin,end}_no_eh.o to diff --git a/libgcc/config.host b/libgcc/config.host index 5686871..efcf5f0 100644 --- a/libgcc/config.host +++ b/libgcc/config.host @@ -1043,9 +1043,9 @@ moxie-*-elf | moxie-*-moxiebox* | moxie-*-uclinux* | moxie-*-rtems*) tmake_file="$tmake_file moxie/t-moxie t-softfp-sfdf t-softfp-excl t-softfp" extra_parts="$extra_parts crti.o crtn.o crtbegin.o crtend.o" ;; -msp430*-*-elf) +msp430-*-elf*) tmake_file="$tm_file t-crtstuff t-fdpbit msp430/t-msp430" - extra_parts="$extra_parts crtbegin_no_eh.o crtend_no_eh.o" + extra_parts="crtbegin.o crtend.o crtbegin_no_eh.o crtend_no_eh.o" extra_parts="$extra_parts libmul_none.a libmul_16.a libmul_32.a libmul_f5.a" ;; nds32*-linux*) diff --git a/libgcc/configure b/libgcc/configure index 117e9c9..97cbad3 100755 --- a/libgcc/configure +++ b/libgcc/configure @@ -4964,6 +4964,15 @@ if test "$enable_tm_clone_registry" = no; then use_tm_clone_registry=-DUSE_TM_CLONE_REGISTRY=0 fi +else + +use_tm_clone_registry= +case $target in + msp430*elfbare) + use_tm_clone_registry=-DUSE_TM_CLONE_REGISTRY=0 + ;; +esac + fi diff --git a/libgcc/configure.ac b/libgcc/configure.ac index f63c5e7..2d22f05 100644 --- a/libgcc/configure.ac +++ b/libgcc/configure.ac @@ -268,6 +268,14 @@ use_tm_clone_registry= if test "$enable_tm_clone_registry" = no; then use_tm_clone_registry=-DUSE_TM_CLONE_REGISTRY=0 fi +], +[ +use_tm_clone_registry= +case $target in + msp430*elfbare) + use_tm_clone_registry=-DUSE_TM_CLONE_REGISTRY=0 + ;; +esac ]) AC_SUBST([use_tm_clone_registry]) diff --git a/libgomp/ChangeLog b/libgomp/ChangeLog index ce44039..cde315c 100644 --- a/libgomp/ChangeLog +++ b/libgomp/ChangeLog @@ -1,3 +1,127 @@ +2019-12-18 Jakub Jelinek <jakub@redhat.com> + + PR middle-end/86416 + * testsuite/libgomp.c/pr86416-1.c (main): Use L suffixes rather than + q or none. + * testsuite/libgomp.c/pr86416-2.c (main): Use Q suffixes rather than + L or none. + +2019-12-19 Julian Brown <julian@codesourcery.com> + Maciej W. Rozycki <macro@codesourcery.com> + Tobias Burnus <tobias@codesourcery.com> + Thomas Schwinge <thomas@codesourcery.com> + + * target.c (gomp_map_vars_async): Support GOMP_MAP_NO_ALLOC. + * testsuite/libgomp.oacc-c-c++-common/no_create-1.c: New test. + * testsuite/libgomp.oacc-c-c++-common/no_create-2.c: New test. + * testsuite/libgomp.oacc-c-c++-common/no_create-3.c: New test. + * testsuite/libgomp.oacc-c-c++-common/no_create-4.c: New test. + * testsuite/libgomp.oacc-c-c++-common/no_create-5.c: New test. + * testsuite/libgomp.oacc-fortran/no_create-1.f90: New test. + * testsuite/libgomp.oacc-fortran/no_create-2.f90: New test. + * testsuite/libgomp.oacc-fortran/no_create-3.F90: New test. + +2019-12-18 Thomas Schwinge <thomas@codesourcery.com> + + * oacc-mem.c (goacc_enter_data): Refactor, so that it can be + called... + (goacc_insert_pointer): ... from here, "present" case. + (goacc_insert_pointer): Inline function into... + (GOACC_enter_exit_data): ... here, and simplify. + + * oacc-mem.c (goacc_enter_data): Refactor, so that it can be + called... + (goacc_insert_pointer): ... from here, "not present" case. + + * oacc-mem.c (goacc_remove_pointer): Refactor interface. Adjust + all users. + + * oacc-mem.c (GOACC_enter_exit_data): Refactor code to call + 'goacc_enter_data', 'goacc_exit_data'. + + * oacc-mem.c (delete_copyout): Refactor into... + (goacc_exit_data): ... this. Adjust all users. + + * oacc-mem.c (present_create_copy): Refactor into... + (goacc_enter_data): ... this. Adjust all users. + + * target.c (gomp_unmap_vars_internal): Add a safeguard to + 'gomp_remove_var'. + + * target.c (gomp_to_device_kind_p): Handle 'GOMP_MAP_FORCE_FROM' + like 'GOMP_MAP_FROM'. + + PR libgomp/92726 + PR libgomp/92970 + PR libgomp/92984 + * oacc-mem.c (delete_copyout): No-op behavior if 'lookup_host' + fails. + (GOACC_enter_exit_data): Simplify accordingly. + * testsuite/libgomp.oacc-c-c++-common/pr92970-1.c: New file, + subsuming... + * testsuite/libgomp.oacc-c-c++-common/lib-17.c: ... this file... + * testsuite/libgomp.oacc-c-c++-common/lib-18.c: ..., and this + file. + * testsuite/libgomp.oacc-c-c++-common/pr92984-1.c: New file, + subsuming... + * testsuite/libgomp.oacc-c-c++-common/lib-21.c: ... this file... + * testsuite/libgomp.oacc-c-c++-common/lib-29.c: ..., and this + file. + * testsuite/libgomp.oacc-c-c++-common/pr92726-1.c: New file, + subsuming... + * testsuite/libgomp.oacc-c-c++-common/lib-28.c: ... this file. + + * oacc-mem.c (GOACC_enter_exit_data): Simplify 'exit data' + 'finalize' handling. + + PR libgomp/92848 + * oacc-mem.c (acc_map_data, present_create_copy) + (goacc_insert_pointer): Use 'GOMP_MAP_VARS_ENTER_DATA'. + (acc_unmap_data, delete_copyout, goacc_remove_pointer): Adjust. + * testsuite/libgomp.oacc-c-c++-common/lib-50.c: Remove. + * testsuite/libgomp.oacc-c-c++-common/pr92848-1-d-a.c: New file + * testsuite/libgomp.oacc-c-c++-common/pr92848-1-d-p.c: Likewise. + * testsuite/libgomp.oacc-c-c++-common/pr92848-1-r-a.c: Likewise. + * testsuite/libgomp.oacc-c-c++-common/pr92848-1-r-p.c: Likewise. + * testsuite/libgomp.oacc-c-c++-common/subset-subarray-mappings-1-r-p.c: + Remove "XFAIL"s. + + * target.c (gomp_unmap_tgt): Make it 'static'. + * libgomp.h (gomp_unmap_tgt): Remove. + +2019-12-18 Tobias Burnus <tobias@codesourcery.com> + + PR middle-end/86416 + * testsuite/libgomp.c/pr86416-1.c: New. + * testsuite/libgomp.c/pr86416-2.c: New. + +2019-12-17 Tobias Burnus <tobias@codesourcery.com> + + * config/accel/openacc.f90 (module openacc_kinds): Use 'PUBLIC' to mark + all symbols as public except for the 'use …, only' imported symbol, + which is private. + (module openacc): Default to 'PRIVATE' to exclude openacc_internal; mark + all symbols from module openacc_kinds as PUBLIC + * openacc.f90: Add comment with crossref to that file and openmp_lib.h; + fix comment typo. + * openacc_lib.h (acc_device_gcn): Add this PARAMETER. + +2019-12-13 Julian Brown <julian@codesourcery.com> + + PR libgomp/92881 + + * libgomp.h (gomp_remove_var_async): Add prototype. + * oacc-mem.c (delete_copyout): Call gomp_remove_var_async instead of + gomp_remove_var. + * target.c (gomp_unref_tgt): Change return type to bool, indicating + whether target_mem_desc was unmapped. + (gomp_unref_tgt_void): New. + (gomp_remove_var): Reimplement in terms of... + (gomp_remove_var_internal): ...this new helper function. + (gomp_remove_var_async): New, implemented using above helper function. + (gomp_unmap_vars_internal): Use gomp_unref_tgt_void instead of + gomp_unref_tgt. + 2019-12-13 Andrew Stubbs <ams@codesourcery.com> * testsuite/libgomp.oacc-c-c++-common/acc_prof-init-1.c: Handle gcn. diff --git a/libgomp/config/accel/openacc.f90 b/libgomp/config/accel/openacc.f90 index 6a8c5e9..badf5e1 100644 --- a/libgomp/config/accel/openacc.f90 +++ b/libgomp/config/accel/openacc.f90 @@ -36,13 +36,12 @@ module openacc_kinds use iso_fortran_env, only: int32 implicit none + public private :: int32 - public :: acc_device_kind - integer, parameter :: acc_device_kind = int32 + ! When adding items, also update 'public' setting in 'module openacc' below. - public :: acc_device_none, acc_device_default, acc_device_host - public :: acc_device_not_host, acc_device_nvidia + integer, parameter :: acc_device_kind = int32 ! Keep in sync with include/gomp-constants.h. integer (acc_device_kind), parameter :: acc_device_none = 0 @@ -53,7 +52,7 @@ module openacc_kinds integer (acc_device_kind), parameter :: acc_device_nvidia = 5 integer (acc_device_kind), parameter :: acc_device_gcn = 8 -end module +end module openacc_kinds module openacc_internal use openacc_kinds @@ -75,13 +74,20 @@ module openacc_internal integer (c_int), value :: d end function end interface -end module +end module openacc_internal module openacc use openacc_kinds use openacc_internal implicit none + private + + ! From openacc_kinds + public :: acc_device_kind + public :: acc_device_none, acc_device_default, acc_device_host + public :: acc_device_not_host, acc_device_nvidia, acc_device_gcn + public :: acc_on_device interface acc_on_device diff --git a/libgomp/libgomp.h b/libgomp/libgomp.h index 9f4d042..038e356 100644 --- a/libgomp/libgomp.h +++ b/libgomp/libgomp.h @@ -1157,7 +1157,6 @@ extern struct target_mem_desc *gomp_map_vars_async (struct gomp_device_descr *, size_t, void **, void **, size_t *, void *, bool, enum gomp_map_vars_kind); -extern void gomp_unmap_tgt (struct target_mem_desc *); extern void gomp_unmap_vars (struct target_mem_desc *, bool); extern void gomp_unmap_vars_async (struct target_mem_desc *, bool, struct goacc_asyncqueue *); @@ -1166,6 +1165,8 @@ extern bool gomp_fini_device (struct gomp_device_descr *); extern void gomp_free_memmap (struct splay_tree_s *); extern void gomp_unload_device (struct gomp_device_descr *); extern bool gomp_remove_var (struct gomp_device_descr *, splay_tree_key); +extern void gomp_remove_var_async (struct gomp_device_descr *, splay_tree_key, + struct goacc_asyncqueue *); /* work.c */ diff --git a/libgomp/oacc-mem.c b/libgomp/oacc-mem.c index a809d04..15eb17b 100644 --- a/libgomp/oacc-mem.c +++ b/libgomp/oacc-mem.c @@ -403,7 +403,8 @@ acc_map_data (void *h, void *d, size_t s) gomp_mutex_unlock (&acc_dev->lock); tgt = gomp_map_vars (acc_dev, mapnum, &hostaddrs, &devaddrs, &sizes, - &kinds, true, GOMP_MAP_VARS_OPENACC); + &kinds, true, GOMP_MAP_VARS_ENTER_DATA); + assert (tgt); splay_tree_key n = tgt->list[0].key; assert (n->refcount == 1); assert (n->dynamic_refcount == 0); @@ -468,23 +469,21 @@ acc_unmap_data (void *h) (void *) h, (int) host_size); } - /* Mark for removal. */ - n->refcount = 1; - t = n->tgt; - if (t->refcount == 2) + if (t->refcount == 1) { /* This is the last reference, so pull the descriptor off the - chain. This avoids gomp_unmap_vars via gomp_unmap_tgt from + chain. This prevents 'gomp_unmap_tgt' via 'gomp_remove_var' from freeing the device memory. */ t->tgt_end = 0; t->to_free = 0; } - gomp_mutex_unlock (&acc_dev->lock); + bool is_tgt_unmapped = gomp_remove_var (acc_dev, n); + assert (is_tgt_unmapped); - gomp_unmap_vars (t, true); + gomp_mutex_unlock (&acc_dev->lock); if (profiling_p) { @@ -493,18 +492,30 @@ acc_unmap_data (void *h) } } -#define FLAG_PRESENT (1 << 0) -#define FLAG_CREATE (1 << 1) -#define FLAG_COPY (1 << 2) + +/* Enter dynamic mappings. + + The handling for MAPNUM bigger than one is special handling for + 'GOMP_MAP_POINTER', 'GOMP_MAP_TO_PSET'. For these, only the first mapping + is considered in reference counting; the following ones implicitly follow + suit. + + If there's just one mapping, return the device pointer. */ static void * -present_create_copy (unsigned f, void *h, size_t s, int async) +goacc_enter_data (size_t mapnum, void **hostaddrs, size_t *sizes, void *kinds, + int async) { void *d; splay_tree_key n; - if (!h || !s) - gomp_fatal ("[%p,+%d] is a bad range", (void *)h, (int)s); + assert (mapnum > 0); + if (mapnum == 1 + && (!hostaddrs[0] || !sizes[0])) + gomp_fatal ("[%p,+%d] is a bad range", hostaddrs[0], (int) sizes[0]); + else if (mapnum > 1 + && !hostaddrs[0]) + return /* n/a */ (void *) -1; goacc_lazy_initialize (); @@ -512,7 +523,12 @@ present_create_copy (unsigned f, void *h, size_t s, int async) struct gomp_device_descr *acc_dev = thr->dev; if (acc_dev->capabilities & GOMP_OFFLOAD_CAP_SHARED_MEM) - return h; + { + if (mapnum == 1) + return hostaddrs[0]; + else + return /* n/a */ (void *) -1; + } acc_prof_info prof_info; acc_api_info api_info; @@ -525,18 +541,15 @@ present_create_copy (unsigned f, void *h, size_t s, int async) gomp_mutex_lock (&acc_dev->lock); - n = lookup_host (acc_dev, h, s); - if (n) + n = lookup_host (acc_dev, hostaddrs[0], sizes[0]); + if (n && mapnum == 1) { + void *h = hostaddrs[0]; + size_t s = sizes[0]; + /* Present. */ d = (void *) (n->tgt->tgt_start + n->tgt_offset + h - n->host_start); - if (!(f & FLAG_PRESENT)) - { - gomp_mutex_unlock (&acc_dev->lock); - gomp_fatal ("[%p,+%d] already mapped to [%p,+%d]", - (void *)h, (int)s, (void *)d, (int)s); - } if ((h + s) > (void *)n->host_end) { gomp_mutex_unlock (&acc_dev->lock); @@ -550,29 +563,42 @@ present_create_copy (unsigned f, void *h, size_t s, int async) gomp_mutex_unlock (&acc_dev->lock); } - else if (!(f & FLAG_CREATE)) + else if (n && mapnum > 1) { + d = /* n/a */ (void *) -1; + + assert (n->refcount != REFCOUNT_INFINITY + && n->refcount != REFCOUNT_LINK); + + bool processed = false; + + struct target_mem_desc *tgt = n->tgt; + for (size_t i = 0; i < tgt->list_count; i++) + if (tgt->list[i].key == n) + { + for (size_t j = 0; j < mapnum; j++) + if (i + j < tgt->list_count && tgt->list[i + j].key) + { + tgt->list[i + j].key->refcount++; + tgt->list[i + j].key->dynamic_refcount++; + } + processed = true; + } + gomp_mutex_unlock (&acc_dev->lock); - gomp_fatal ("[%p,+%d] not mapped", (void *)h, (int)s); + if (!processed) + gomp_fatal ("dynamic refcount incrementing failed for pointer/pset"); } else { - struct target_mem_desc *tgt; - size_t mapnum = 1; - unsigned short kinds; - void *hostaddrs = h; - - if (f & FLAG_COPY) - kinds = GOMP_MAP_TO; - else - kinds = GOMP_MAP_ALLOC; - gomp_mutex_unlock (&acc_dev->lock); goacc_aq aq = get_goacc_asyncqueue (async); - tgt = gomp_map_vars_async (acc_dev, aq, mapnum, &hostaddrs, NULL, &s, - &kinds, true, GOMP_MAP_VARS_OPENACC); + struct target_mem_desc *tgt + = gomp_map_vars_async (acc_dev, aq, mapnum, hostaddrs, NULL, sizes, + kinds, true, GOMP_MAP_VARS_ENTER_DATA); + assert (tgt); n = tgt->list[0].key; assert (n->refcount == 1); assert (n->dynamic_refcount == 0); @@ -593,13 +619,15 @@ present_create_copy (unsigned f, void *h, size_t s, int async) void * acc_create (void *h, size_t s) { - return present_create_copy (FLAG_PRESENT | FLAG_CREATE, h, s, acc_async_sync); + unsigned short kinds[1] = { GOMP_MAP_ALLOC }; + return goacc_enter_data (1, &h, &s, &kinds, acc_async_sync); } void acc_create_async (void *h, size_t s, int async) { - present_create_copy (FLAG_PRESENT | FLAG_CREATE, h, s, async); + unsigned short kinds[1] = { GOMP_MAP_ALLOC }; + goacc_enter_data (1, &h, &s, &kinds, async); } /* acc_present_or_create used to be what acc_create is now. */ @@ -624,14 +652,15 @@ acc_pcreate (void *h, size_t s) void * acc_copyin (void *h, size_t s) { - return present_create_copy (FLAG_PRESENT | FLAG_CREATE | FLAG_COPY, h, s, - acc_async_sync); + unsigned short kinds[1] = { GOMP_MAP_TO }; + return goacc_enter_data (1, &h, &s, &kinds, acc_async_sync); } void acc_copyin_async (void *h, size_t s, int async) { - present_create_copy (FLAG_PRESENT | FLAG_CREATE | FLAG_COPY, h, s, async); + unsigned short kinds[1] = { GOMP_MAP_TO }; + goacc_enter_data (1, &h, &s, &kinds, async); } /* acc_present_or_copyin used to be what acc_copyin is now. */ @@ -653,14 +682,17 @@ acc_pcopyin (void *h, size_t s) } #endif -#define FLAG_COPYOUT (1 << 0) -#define FLAG_FINALIZE (1 << 1) + +/* Exit a dynamic mapping. */ static void -delete_copyout (unsigned f, void *h, size_t s, int async, const char *libfnname) +goacc_exit_data (void *h, size_t s, unsigned short kind, int async) { - splay_tree_key n; - void *d; + /* No need to call lazy open, as the data must already have been + mapped. */ + + kind &= 0xff; + struct goacc_thread *thr = goacc_thread (); struct gomp_device_descr *acc_dev = thr->dev; @@ -678,19 +710,10 @@ delete_copyout (unsigned f, void *h, size_t s, int async, const char *libfnname) gomp_mutex_lock (&acc_dev->lock); - n = lookup_host (acc_dev, h, s); - - /* No need to call lazy open, as the data must already have been - mapped. */ - + splay_tree_key n = lookup_host (acc_dev, h, s); if (!n) - { - gomp_mutex_unlock (&acc_dev->lock); - gomp_fatal ("[%p,%d] is not mapped", (void *)h, (int)s); - } - - d = (void *) (n->tgt->tgt_start + n->tgt_offset - + (uintptr_t) h - n->host_start); + /* PR92726, RP92970, PR92984: no-op. */ + goto out; if ((uintptr_t) h < n->host_start || (uintptr_t) h + s > n->host_end) { @@ -708,7 +731,9 @@ delete_copyout (unsigned f, void *h, size_t s, int async, const char *libfnname) gomp_fatal ("Dynamic reference counting assert fail\n"); } - if (f & FLAG_FINALIZE) + bool finalize = (kind == GOMP_MAP_DELETE + || kind == GOMP_MAP_FORCE_FROM); + if (finalize) { if (n->refcount != REFCOUNT_INFINITY) n->refcount -= n->dynamic_refcount; @@ -723,14 +748,31 @@ delete_copyout (unsigned f, void *h, size_t s, int async, const char *libfnname) if (n->refcount == 0) { - if (f & FLAG_COPYOUT) + goacc_aq aq = get_goacc_asyncqueue (async); + + bool copyout = (kind == GOMP_MAP_FROM + || kind == GOMP_MAP_FORCE_FROM); + if (copyout) { - goacc_aq aq = get_goacc_asyncqueue (async); + void *d = (void *) (n->tgt->tgt_start + n->tgt_offset + + (uintptr_t) h - n->host_start); gomp_copy_dev2host (acc_dev, aq, h, d, s); } - gomp_remove_var (acc_dev, n); + + if (aq) + /* TODO We can't do the 'is_tgt_unmapped' checking -- see the + 'gomp_unref_tgt' comment in + <http://mid.mail-archive.com/878snl36eu.fsf@euler.schwinge.homeip.net>; + PR92881. */ + gomp_remove_var_async (acc_dev, n, aq); + else + { + bool is_tgt_unmapped = gomp_remove_var (acc_dev, n); + assert (is_tgt_unmapped); + } } + out: gomp_mutex_unlock (&acc_dev->lock); if (profiling_p) @@ -743,50 +785,49 @@ delete_copyout (unsigned f, void *h, size_t s, int async, const char *libfnname) void acc_delete (void *h , size_t s) { - delete_copyout (0, h, s, acc_async_sync, __FUNCTION__); + goacc_exit_data (h, s, GOMP_MAP_RELEASE, acc_async_sync); } void acc_delete_async (void *h , size_t s, int async) { - delete_copyout (0, h, s, async, __FUNCTION__); + goacc_exit_data (h, s, GOMP_MAP_RELEASE, async); } void acc_delete_finalize (void *h , size_t s) { - delete_copyout (FLAG_FINALIZE, h, s, acc_async_sync, __FUNCTION__); + goacc_exit_data (h, s, GOMP_MAP_DELETE, acc_async_sync); } void acc_delete_finalize_async (void *h , size_t s, int async) { - delete_copyout (FLAG_FINALIZE, h, s, async, __FUNCTION__); + goacc_exit_data (h, s, GOMP_MAP_DELETE, async); } void acc_copyout (void *h, size_t s) { - delete_copyout (FLAG_COPYOUT, h, s, acc_async_sync, __FUNCTION__); + goacc_exit_data (h, s, GOMP_MAP_FROM, acc_async_sync); } void acc_copyout_async (void *h, size_t s, int async) { - delete_copyout (FLAG_COPYOUT, h, s, async, __FUNCTION__); + goacc_exit_data (h, s, GOMP_MAP_FROM, async); } void acc_copyout_finalize (void *h, size_t s) { - delete_copyout (FLAG_COPYOUT | FLAG_FINALIZE, h, s, acc_async_sync, - __FUNCTION__); + goacc_exit_data (h, s, GOMP_MAP_FORCE_FROM, acc_async_sync); } void acc_copyout_finalize_async (void *h, size_t s, int async) { - delete_copyout (FLAG_COPYOUT | FLAG_FINALIZE, h, s, async, __FUNCTION__); + goacc_exit_data (h, s, GOMP_MAP_FORCE_FROM, async); } static void @@ -878,64 +919,18 @@ acc_update_self_async (void *h, size_t s, int async) /* Special handling for 'GOMP_MAP_POINTER', 'GOMP_MAP_TO_PSET'. Only the first mapping is considered in reference counting; the following - ones implicitly follow suit. */ + ones implicitly follow suit. Similarly, 'copyout' is done only for the + first mapping. */ static void -goacc_insert_pointer (size_t mapnum, void **hostaddrs, size_t *sizes, - void *kinds, int async) +goacc_remove_pointer (void *h, size_t s, unsigned short kind, int async) { - struct target_mem_desc *tgt; - struct goacc_thread *thr = goacc_thread (); - struct gomp_device_descr *acc_dev = thr->dev; - - if (*hostaddrs == NULL) - return; + kind &= 0xff; - if (acc_is_present (*hostaddrs, *sizes)) - { - splay_tree_key n; - gomp_mutex_lock (&acc_dev->lock); - n = lookup_host (acc_dev, *hostaddrs, *sizes); - assert (n->refcount != REFCOUNT_INFINITY - && n->refcount != REFCOUNT_LINK); - gomp_mutex_unlock (&acc_dev->lock); - - tgt = n->tgt; - for (size_t i = 0; i < tgt->list_count; i++) - if (tgt->list[i].key == n) - { - for (size_t j = 0; j < mapnum; j++) - if (i + j < tgt->list_count && tgt->list[i + j].key) - { - tgt->list[i + j].key->refcount++; - tgt->list[i + j].key->dynamic_refcount++; - } - return; - } - /* Should not reach here. */ - gomp_fatal ("Dynamic refcount incrementing failed for pointer/pset"); - } - - gomp_debug (0, " %s: prepare mappings\n", __FUNCTION__); - goacc_aq aq = get_goacc_asyncqueue (async); - tgt = gomp_map_vars_async (acc_dev, aq, mapnum, hostaddrs, - NULL, sizes, kinds, true, GOMP_MAP_VARS_OPENACC); - splay_tree_key n = tgt->list[0].key; - assert (n->refcount == 1); - assert (n->dynamic_refcount == 0); - n->dynamic_refcount++; - gomp_debug (0, " %s: mappings prepared\n", __FUNCTION__); -} - -static void -goacc_remove_pointer (void *h, size_t s, bool force_copyfrom, int async, - int finalize, int mapnum) -{ struct goacc_thread *thr = goacc_thread (); struct gomp_device_descr *acc_dev = thr->dev; splay_tree_key n; struct target_mem_desc *t; - int minrefs = (mapnum == 1) ? 2 : 3; if (!acc_is_present (h, s)) return; @@ -962,6 +957,8 @@ goacc_remove_pointer (void *h, size_t s, bool force_copyfrom, int async, gomp_fatal ("Dynamic reference counting assert fail\n"); } + bool finalize = (kind == GOMP_MAP_DELETE + || kind == GOMP_MAP_FORCE_FROM); if (finalize) { n->refcount -= n->dynamic_refcount; @@ -973,28 +970,41 @@ goacc_remove_pointer (void *h, size_t s, bool force_copyfrom, int async, n->dynamic_refcount--; } - gomp_mutex_unlock (&acc_dev->lock); - if (n->refcount == 0) { - /* Set refcount to 1 to allow gomp_unmap_vars to unmap it. */ - n->refcount = 1; - t->refcount = minrefs; - for (size_t i = 0; i < t->list_count; i++) - if (t->list[i].key == n) - { - t->list[i].copy_from = force_copyfrom ? 1 : 0; - break; - } + goacc_aq aq = get_goacc_asyncqueue (async); - /* If running synchronously, unmap immediately. */ - if (async < acc_async_noval) - gomp_unmap_vars (t, true); - else + bool copyout = (kind == GOMP_MAP_FROM + || kind == GOMP_MAP_FORCE_FROM); + if (copyout) { - goacc_aq aq = get_goacc_asyncqueue (async); - gomp_unmap_vars_async (t, true, aq); + void *d = (void *) (t->tgt_start + n->tgt_offset + + (uintptr_t) h - n->host_start); + gomp_copy_dev2host (acc_dev, aq, h, d, s); } + + if (aq) + { + /* TODO The way the following code is currently implemented, we need + the 'is_tgt_unmapped' return value from 'gomp_remove_var', so + can't use 'gomp_remove_var_async' here -- see the 'gomp_unref_tgt' + comment in + <http://mid.mail-archive.com/878snl36eu.fsf@euler.schwinge.homeip.net>; + PR92881 -- so have to synchronize here. */ + if (!acc_dev->openacc.async.synchronize_func (aq)) + { + gomp_mutex_unlock (&acc_dev->lock); + gomp_fatal ("synchronize failed"); + } + } + bool is_tgt_unmapped = false; + for (size_t i = 0; i < t->list_count; i++) + { + is_tgt_unmapped = gomp_remove_var (acc_dev, t->list[i].key); + if (is_tgt_unmapped) + break; + } + assert (is_tgt_unmapped); } gomp_mutex_unlock (&acc_dev->lock); @@ -1038,17 +1048,6 @@ GOACC_enter_exit_data (int flags_m, size_t mapnum, void **hostaddrs, thr = goacc_thread (); acc_dev = thr->dev; - /* Determine whether "finalize" semantics apply to all mappings of this - OpenACC directive. */ - bool finalize = false; - if (mapnum > 0) - { - unsigned char kind = kinds[0] & 0xff; - if (kind == GOMP_MAP_DELETE - || kind == GOMP_MAP_FORCE_FROM) - finalize = true; - } - /* Determine if this is an "acc enter data". */ for (i = 0; i < mapnum; ++i) { @@ -1161,81 +1160,64 @@ GOACC_enter_exit_data (int flags_m, size_t mapnum, void **hostaddrs, { for (i = 0; i < mapnum; i++) { - unsigned char kind = kinds[i] & 0xff; - /* Scan for pointers and PSETs. */ int pointer = find_pointer (i, mapnum, kinds); if (!pointer) { + unsigned char kind = kinds[i] & 0xff; switch (kind) { case GOMP_MAP_ALLOC: case GOMP_MAP_FORCE_ALLOC: - acc_create_async (hostaddrs[i], sizes[i], async); - break; case GOMP_MAP_TO: case GOMP_MAP_FORCE_TO: - acc_copyin_async (hostaddrs[i], sizes[i], async); break; default: gomp_fatal (">>>> GOACC_enter_exit_data UNHANDLED kind 0x%.2x", kind); break; } + + /* We actually have one mapping. */ + pointer = 1; } - else - { - goacc_insert_pointer (pointer, &hostaddrs[i], &sizes[i], &kinds[i], - async); - /* Increment 'i' by two because OpenACC requires fortran - arrays to be contiguous, so each PSET is associated with - one of MAP_FORCE_ALLOC/MAP_FORCE_PRESET/MAP_FORCE_TO, and - one MAP_POINTER. */ - i += pointer - 1; - } + + goacc_enter_data (pointer, &hostaddrs[i], &sizes[i], &kinds[i], + async); + /* If applicable, increment 'i' further; OpenACC requires fortran + arrays to be contiguous, so each PSET is associated with + one of MAP_FORCE_ALLOC/MAP_FORCE_PRESET/MAP_FORCE_TO, and + one MAP_POINTER. */ + i += pointer - 1; } } else for (i = 0; i < mapnum; ++i) { - unsigned char kind = kinds[i] & 0xff; - int pointer = find_pointer (i, mapnum, kinds); if (!pointer) { + unsigned char kind = kinds[i] & 0xff; switch (kind) { case GOMP_MAP_RELEASE: case GOMP_MAP_DELETE: - if (acc_is_present (hostaddrs[i], sizes[i])) - { - if (finalize) - acc_delete_finalize_async (hostaddrs[i], sizes[i], async); - else - acc_delete_async (hostaddrs[i], sizes[i], async); - } - break; case GOMP_MAP_FROM: case GOMP_MAP_FORCE_FROM: - if (finalize) - acc_copyout_finalize_async (hostaddrs[i], sizes[i], async); - else - acc_copyout_async (hostaddrs[i], sizes[i], async); break; default: gomp_fatal (">>>> GOACC_enter_exit_data UNHANDLED kind 0x%.2x", kind); break; } + + goacc_exit_data (hostaddrs[i], sizes[i], kinds[i], async); } else { - bool copyfrom = (kind == GOMP_MAP_FORCE_FROM - || kind == GOMP_MAP_FROM); - goacc_remove_pointer (hostaddrs[i], sizes[i], copyfrom, async, - finalize, pointer); + goacc_remove_pointer (hostaddrs[i], sizes[i], kinds[i], async); /* See the above comment. */ i += pointer - 1; } diff --git a/libgomp/openacc.f90 b/libgomp/openacc.f90 index b37f187..fb7fc6e 100644 --- a/libgomp/openacc.f90 +++ b/libgomp/openacc.f90 @@ -27,6 +27,8 @@ ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! <http://www.gnu.org/licenses/>. +! Keep in sync with config/accel/openacc.f90 and openacc_lib.h. + module openacc_kinds use iso_fortran_env, only: int32 implicit none @@ -34,7 +36,7 @@ module openacc_kinds public private :: int32 - ! When adding items, also update 'public' setting in 'module openmp' below. + ! When adding items, also update 'public' setting in 'module openacc' below. integer, parameter :: acc_device_kind = int32 @@ -52,7 +54,7 @@ module openacc_kinds ! Keep in sync with include/gomp-constants.h. integer (acc_handle_kind), parameter :: acc_async_noval = -1 integer (acc_handle_kind), parameter :: acc_async_sync = -2 -end module +end module openacc_kinds module openacc_internal use openacc_kinds @@ -704,7 +706,7 @@ module openacc_internal integer (c_int), value :: async end subroutine end interface -end module +end module openacc_internal module openacc use openacc_kinds @@ -712,6 +714,7 @@ module openacc implicit none private + ! From openacc_kinds public :: acc_device_kind, acc_handle_kind public :: acc_device_none, acc_device_default, acc_device_host @@ -933,7 +936,7 @@ module openacc procedure :: acc_update_self_async_array_h end interface -end module +end module openacc function acc_get_num_devices_h (d) use openacc_internal, only: acc_get_num_devices_l diff --git a/libgomp/openacc_lib.h b/libgomp/openacc_lib.h index fbd8f5e..a928414 100644 --- a/libgomp/openacc_lib.h +++ b/libgomp/openacc_lib.h @@ -32,6 +32,8 @@ ! Alternatively, the user can use the module version, which permits ! compilation with -std=f95. +! Keep in sync with openacc.f90 and config/accel/openacc.f90. + integer, parameter :: acc_device_kind = 4 ! Keep in sync with include/gomp-constants.h. @@ -42,6 +44,7 @@ ! removed. integer (acc_device_kind), parameter :: acc_device_not_host = 4 integer (acc_device_kind), parameter :: acc_device_nvidia = 5 + integer (acc_device_kind), parameter :: acc_device_gcn = 8 integer, parameter :: acc_handle_kind = 4 diff --git a/libgomp/target.c b/libgomp/target.c index 1151deb..d83b353 100644 --- a/libgomp/target.c +++ b/libgomp/target.c @@ -279,6 +279,7 @@ gomp_to_device_kind_p (int kind) case GOMP_MAP_ALLOC: case GOMP_MAP_FROM: case GOMP_MAP_FORCE_ALLOC: + case GOMP_MAP_FORCE_FROM: case GOMP_MAP_ALWAYS_FROM: return false; default: @@ -706,6 +707,21 @@ gomp_map_vars_internal (struct gomp_device_descr *devicep, { tgt->list[i].key = NULL; + if ((kind & typemask) == GOMP_MAP_IF_PRESENT) + { + /* Not present, hence, skip entry - including its MAP_POINTER, + when existing. */ + tgt->list[i].offset = 0; + if (i + 1 < mapnum + && ((typemask & get_kind (short_mapkind, kinds, i + 1)) + == GOMP_MAP_POINTER)) + { + ++i; + tgt->list[i].key = NULL; + tgt->list[i].offset = 0; + } + continue; + } size_t align = (size_t) 1 << (kind >> rshift); not_found_cnt++; if (tgt_align < align) @@ -892,6 +908,14 @@ gomp_map_vars_internal (struct gomp_device_descr *devicep, cur_node.tgt_offset = n->tgt->tgt_start + n->tgt_offset + cur_node.host_start - n->host_start; continue; + case GOMP_MAP_IF_PRESENT: + /* Not present - otherwise handled above. Skip over its + MAP_POINTER as well. */ + if (i + 1 < mapnum + && ((typemask & get_kind (short_mapkind, kinds, i + 1)) + == GOMP_MAP_POINTER)) + ++i; + continue; default: break; } @@ -1105,7 +1129,7 @@ gomp_map_vars_async (struct gomp_device_descr *devicep, sizes, kinds, short_mapkind, pragma_kind); } -attribute_hidden void +static void gomp_unmap_tgt (struct target_mem_desc *tgt) { /* Deallocate on target the tgt->tgt_start .. tgt->tgt_end region. */ @@ -1116,32 +1140,63 @@ gomp_unmap_tgt (struct target_mem_desc *tgt) free (tgt); } -attribute_hidden bool -gomp_remove_var (struct gomp_device_descr *devicep, splay_tree_key k) +static bool +gomp_unref_tgt (void *ptr) { bool is_tgt_unmapped = false; - splay_tree_remove (&devicep->mem_map, k); - if (k->link_key) - splay_tree_insert (&devicep->mem_map, (splay_tree_node) k->link_key); - if (k->tgt->refcount > 1) - k->tgt->refcount--; + + struct target_mem_desc *tgt = (struct target_mem_desc *) ptr; + + if (tgt->refcount > 1) + tgt->refcount--; else { + gomp_unmap_tgt (tgt); is_tgt_unmapped = true; - gomp_unmap_tgt (k->tgt); } + return is_tgt_unmapped; } static void -gomp_unref_tgt (void *ptr) +gomp_unref_tgt_void (void *ptr) { - struct target_mem_desc *tgt = (struct target_mem_desc *) ptr; + (void) gomp_unref_tgt (ptr); +} - if (tgt->refcount > 1) - tgt->refcount--; +static inline __attribute__((always_inline)) bool +gomp_remove_var_internal (struct gomp_device_descr *devicep, splay_tree_key k, + struct goacc_asyncqueue *aq) +{ + bool is_tgt_unmapped = false; + splay_tree_remove (&devicep->mem_map, k); + if (k->link_key) + splay_tree_insert (&devicep->mem_map, (splay_tree_node) k->link_key); + if (aq) + devicep->openacc.async.queue_callback_func (aq, gomp_unref_tgt_void, + (void *) k->tgt); else - gomp_unmap_tgt (tgt); + is_tgt_unmapped = gomp_unref_tgt ((void *) k->tgt); + return is_tgt_unmapped; +} + +attribute_hidden bool +gomp_remove_var (struct gomp_device_descr *devicep, splay_tree_key k) +{ + return gomp_remove_var_internal (devicep, k, NULL); +} + +/* Remove a variable asynchronously. This actually removes the variable + mapping immediately, but retains the linked target_mem_desc until the + asynchronous operation has completed (as it may still refer to target + memory). The device lock must be held before entry, and remains locked on + exit. */ + +attribute_hidden void +gomp_remove_var_async (struct gomp_device_descr *devicep, splay_tree_key k, + struct goacc_asyncqueue *aq) +{ + (void) gomp_remove_var_internal (devicep, k, aq); } /* Unmap variables described by TGT. If DO_COPYFROM is true, copy relevant @@ -1193,11 +1248,19 @@ gomp_unmap_vars_internal (struct target_mem_desc *tgt, bool do_copyfrom, + tgt->list[i].offset), tgt->list[i].length); if (do_unmap) - gomp_remove_var (devicep, k); + { + struct target_mem_desc *k_tgt = k->tgt; + bool is_tgt_unmapped = gomp_remove_var (devicep, k); + /* It would be bad if TGT got unmapped while we're still iterating + over its LIST_COUNT, and also expect to use it in the following + code. */ + assert (!is_tgt_unmapped + || k_tgt != tgt); + } } if (aq) - devicep->openacc.async.queue_callback_func (aq, gomp_unref_tgt, + devicep->openacc.async.queue_callback_func (aq, gomp_unref_tgt_void, (void *) tgt); else gomp_unref_tgt ((void *) tgt); diff --git a/libgomp/testsuite/libgomp.c/pr86416-1.c b/libgomp/testsuite/libgomp.c/pr86416-1.c new file mode 100644 index 0000000..ad9370f --- /dev/null +++ b/libgomp/testsuite/libgomp.c/pr86416-1.c @@ -0,0 +1,22 @@ +/* { dg-do link } */ +/* { dg-require-effective-target large_long_double } */ + +/* PR middle-end/86416 */ +/* { dg-error "bit-precision floating-point numbers unsupported .mode '.F'." "" { target offload_device } 0 } */ +/* { dg-excess-errors "Follow-up errors from mkoffload and lto-wrapper" { target offload_device } } */ + +#include <stdlib.h> /* For abort. */ + +long double foo (long double x) +{ + #pragma omp target map(tofrom:x) + x *= 2.0; + return x; +} + +int main() +{ + long double v = foo (10.0L) - 20.0L; + if (v > 1.0e-5L || v < -1.0e-5L) abort(); + return 0; +} diff --git a/libgomp/testsuite/libgomp.c/pr86416-2.c b/libgomp/testsuite/libgomp.c/pr86416-2.c new file mode 100644 index 0000000..ec45e40 --- /dev/null +++ b/libgomp/testsuite/libgomp.c/pr86416-2.c @@ -0,0 +1,22 @@ +/* { dg-do link { target __float128 } } */ +/* { dg-add-options __float128 } */ + +/* PR middle-end/86416 */ +/* { dg-error "bit-precision floating-point numbers unsupported .mode '.F'." "" { target offload_device } 0 } */ +/* { dg-excess-errors "Follow-up errors from mkoffload and lto-wrapper" { target offload_device } } */ + +#include <stdlib.h> /* For abort. */ + +__float128 foo(__float128 y) +{ + #pragma omp target map(tofrom: y) + y *= 4.0; + return y; +} + +int main() +{ + __float128 v = foo (5.0Q) - 20.0Q; + if (v > 1.0e-5Q || v < -1.0e-5Q) abort(); + return 0; +} diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-17.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-17.c deleted file mode 100644 index a3487e8..0000000 --- a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-17.c +++ /dev/null @@ -1,38 +0,0 @@ -/* Check acc_copyout failure with acc_device_nvidia. */ - -/* { dg-do run { target openacc_nvidia_accel_selected } } */ - - -#include <stdio.h> -#include <stdlib.h> -#include <openacc.h> - -int -main (int argc, char **argv) -{ - const int N = 256; - int i; - unsigned char *h; - - h = (unsigned char *) malloc (N); - - for (i = 0; i < N; i++) - { - h[i] = i; - } - - (void) acc_copyin (h, N); - - acc_copyout (h, N); - - fprintf (stderr, "CheCKpOInT\n"); - acc_copyout (h, N); - - free (h); - - return 0; -} - -/* { dg-output "CheCKpOInT(\n|\r\n|\r).*" } */ -/* { dg-output "\\\[\[0-9a-fA-FxX\]+,256\\\] is not mapped" } */ -/* { dg-shouldfail "" } */ diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-18.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-18.c deleted file mode 100644 index 93bfb99..0000000 --- a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-18.c +++ /dev/null @@ -1,38 +0,0 @@ -/* Verify that acc_delete unregisters data mappings on the device. */ - -/* { dg-do run { target openacc_nvidia_accel_selected } } */ - -#include <stdio.h> -#include <stdlib.h> -#include <openacc.h> - -int -main (int argc, char **argv) -{ - const int N = 256; - int i; - unsigned char *h; - void *d; - - h = (unsigned char *) malloc (N); - - for (i = 0; i < N; i++) - { - h[i] = i; - } - - d = acc_copyin (h, N); - - acc_delete (h, N); - - fprintf (stderr, "CheCKpOInT\n"); - acc_copyout (h, N); - - free (h); - - return 0; -} - -/* { dg-output "CheCKpOInT(\n|\r\n|\r).*" } */ -/* { dg-output "\\\[\[0-9a-fA-FxX\]+,256\\\] is not mapped" } */ -/* { dg-shouldfail "" } */ diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-21.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-21.c deleted file mode 100644 index b170f81..0000000 --- a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-21.c +++ /dev/null @@ -1,35 +0,0 @@ -/* Exercise acc_copyin and acc_copyout on nvidia targets. */ - -/* { dg-do run { target openacc_nvidia_accel_selected } } */ - -#include <stdio.h> -#include <stdlib.h> -#include <openacc.h> - -int -main (int argc, char **argv) -{ - const int N = 256; - int i; - unsigned char *h; - - h = (unsigned char *) malloc (N); - - for (i = 0; i < N; i++) - { - h[i] = i; - } - - (void) acc_copyin (h, N); - - fprintf (stderr, "CheCKpOInT\n"); - acc_copyout (h, 0); - - free (h); - - return 0; -} - -/* { dg-output "CheCKpOInT(\n|\r\n|\r).*" } */ -/* { dg-output "\\\[\[0-9a-fA-FxX\]+,0\\\] is not mapped" } */ -/* { dg-shouldfail "" } */ diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-28.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-28.c deleted file mode 100644 index 7a96ab26..0000000 --- a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-28.c +++ /dev/null @@ -1,32 +0,0 @@ -/* Exercise acc_delete with a NULL address on nvidia targets. */ - -/* { dg-do run { target openacc_nvidia_accel_selected } } */ - -#include <stdio.h> -#include <stdlib.h> -#include <openacc.h> - -int -main (int argc, char **argv) -{ - const int N = 256; - unsigned char *h; - void *d; - - h = (unsigned char *) malloc (N); - - d = acc_create (h, N); - if (!d) - abort (); - - fprintf (stderr, "CheCKpOInT\n"); - acc_delete (0, N); - - free (h); - - return 0; -} - -/* { dg-output "CheCKpOInT(\n|\r\n|\r).*" } */ -/* { dg-output "\\\[\[^\n\r]*,256\\\] is not mapped" } */ -/* { dg-shouldfail "" } */ diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-29.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-29.c deleted file mode 100644 index 318a060..0000000 --- a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-29.c +++ /dev/null @@ -1,32 +0,0 @@ -/* Exercise acc_delete with size zero on nvidia targets. */ - -/* { dg-do run { target openacc_nvidia_accel_selected } } */ - -#include <stdio.h> -#include <stdlib.h> -#include <openacc.h> - -int -main (int argc, char **argv) -{ - const int N = 256; - unsigned char *h; - void *d; - - h = (unsigned char *) malloc (N); - - d = acc_create (h, N); - if (!d) - abort (); - - fprintf (stderr, "CheCKpOInT\n"); - acc_delete (h, 0); - - free (h); - - return 0; -} - -/* { dg-output "CheCKpOInT(\n|\r\n|\r).*" } */ -/* { dg-output "\\\[\[0-9a-fA-FxX\]+,0\\\] is not mapped" } */ -/* { dg-shouldfail "" } */ diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-50.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-50.c deleted file mode 100644 index e8294e1..0000000 --- a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-50.c +++ /dev/null @@ -1,30 +0,0 @@ -/* { dg-do run } */ -/* { dg-skip-if "" { *-*-* } { "*" } { "-DACC_MEM_SHARED=0" } } */ - -#include <stdlib.h> -#include <openacc.h> - -int -main (int argc, char **argv) -{ - const int N = 256; - unsigned char *h; - void *d; - - h = (unsigned char *) malloc (N); - - d = acc_malloc (N); - - acc_map_data (h, d, N); - - if (acc_is_present (h, N) != 1) - abort (); - - acc_unmap_data (h); - - acc_free (d); - - free (h); - - return 0; -} diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/no_create-1.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/no_create-1.c new file mode 100644 index 0000000..22e0c20 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/no_create-1.c @@ -0,0 +1,49 @@ +/* Test 'no_create' clause on compute construct, with data present on the + device. */ + +#include <stdlib.h> +#include <stdio.h> +#include <openacc.h> + +#define N 128 + +int +main (int argc, char *argv[]) +{ + int var; + int *arr = (int *) malloc (N * sizeof (*arr)); + int *devptr[2]; + + acc_copyin (&var, sizeof (var)); + acc_copyin (arr, N * sizeof (*arr)); + +#pragma acc parallel no_create(var, arr[0:N]) copyout(devptr) + { + devptr[0] = &var; + devptr[1] = &arr[2]; + } + + if (acc_hostptr (devptr[0]) != (void *) &var) + __builtin_abort (); + if (acc_hostptr (devptr[1]) != (void *) &arr[2]) + __builtin_abort (); + + acc_delete (&var, sizeof (var)); + acc_delete (arr, N * sizeof (*arr)); + +#if ACC_MEM_SHARED + if (devptr[0] != &var) + __builtin_abort (); + if (devptr[1] != &arr[2]) + __builtin_abort (); +#else + if (devptr[0] == &var) + __builtin_abort (); + if (devptr[1] == &arr[2]) + __builtin_abort (); +#endif + + free (arr); + + return 0; +} diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/no_create-2.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/no_create-2.c new file mode 100644 index 0000000..fbd01a2 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/no_create-2.c @@ -0,0 +1,30 @@ +/* Test 'no_create' clause on compute construct, with data not present on the + device. */ + +#include <stdlib.h> +#include <stdio.h> + +#define N 128 + +int +main (int argc, char *argv[]) +{ + int var; + int *arr = (int *) malloc (N * sizeof (*arr)); + int *devptr[2]; + +#pragma acc parallel no_create(var, arr[0:N]) copyout(devptr) + { + devptr[0] = &var; + devptr[1] = &arr[2]; + } + + if (devptr[0] != &var) + __builtin_abort (); + if (devptr[1] != &arr[2]) + __builtin_abort (); + + free (arr); + + return 0; +} diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/no_create-3.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/no_create-3.c new file mode 100644 index 0000000..18466b8 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/no_create-3.c @@ -0,0 +1,25 @@ +#include <float.h> /* For FLT_EPSILON. */ +#include <math.h> /* For fabs. */ +#include <stdlib.h> /* For abort. */ + + +int main() +{ +#define N 100 + float b[N]; + float c[N]; + +#pragma acc enter data create(b) + +#pragma acc parallel loop no_create(b) no_create(c) + for (int i = 0; i < N; ++i) + b[i] = i; + +#pragma acc exit data copyout(b) + + for (int i = 0; i < N; ++i) + if (fabs (b[i] - i) > 10.0*FLT_EPSILON) + abort (); + + return 0; +} diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/no_create-4.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/no_create-4.c new file mode 100644 index 0000000..963cb3a --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/no_create-4.c @@ -0,0 +1,82 @@ +/* Test 'no_create' clause on 'data' construct and nested compute construct, + with data present on the device. */ + +#include <stdlib.h> +#include <stdio.h> +#include <openacc.h> + +#define N 128 + +int +main (int argc, char *argv[]) +{ + int var; + int *arr = (int *) malloc (N * sizeof (*arr)); + int *devptr[2]; + + acc_copyin (&var, sizeof (var)); + acc_copyin (arr, N * sizeof (*arr)); + +#pragma acc data no_create(var, arr[0:N]) + { + devptr[0] = (int *) acc_deviceptr (&var); + devptr[1] = (int *) acc_deviceptr (&arr[2]); + + if (devptr[0] == NULL) + __builtin_abort (); + if (devptr[1] == NULL) + __builtin_abort (); + + if (acc_hostptr (devptr[0]) != (void *) &var) + __builtin_abort (); + if (acc_hostptr (devptr[1]) != (void *) &arr[2]) + __builtin_abort (); + +#if ACC_MEM_SHARED + if (devptr[0] != &var) + __builtin_abort (); + if (devptr[1] != &arr[2]) + __builtin_abort (); +#else + if (devptr[0] == &var) + __builtin_abort (); + if (devptr[1] == &arr[2]) + __builtin_abort (); +#endif + +#pragma acc parallel copyout(devptr) + { + devptr[0] = &var; + devptr[1] = &arr[2]; + } + + if (devptr[0] == NULL) + __builtin_abort (); + if (devptr[1] == NULL) + __builtin_abort (); + + if (acc_hostptr (devptr[0]) != (void *) &var) + __builtin_abort (); + if (acc_hostptr (devptr[1]) != (void *) &arr[2]) + __builtin_abort (); + +#if ACC_MEM_SHARED + if (devptr[0] != &var) + __builtin_abort (); + if (devptr[1] != &arr[2]) + __builtin_abort (); +#else + if (devptr[0] == &var) + __builtin_abort (); + if (devptr[1] == &arr[2]) + __builtin_abort (); +#endif + } + + acc_delete (&var, sizeof (var)); + acc_delete (arr, N * sizeof (*arr)); + + free (arr); + + return 0; +} diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/no_create-5.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/no_create-5.c new file mode 100644 index 0000000..6f0ace5 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/no_create-5.c @@ -0,0 +1,49 @@ +/* Test 'no_create' clause on 'data' construct and nested compute construct, + with data not present on the device. */ + +#include <stdlib.h> +#include <stdio.h> +#include <openacc.h> + +#define N 128 + +int +main (int argc, char *argv[]) +{ + int var; + int *arr = (int *) malloc (N * sizeof (*arr)); + int *devptr[2]; + +#pragma acc data no_create(var, arr[0:N]) + { + devptr[0] = (int *) acc_deviceptr (&var); + devptr[1] = (int *) acc_deviceptr (&arr[2]); + +#if ACC_MEM_SHARED + if (devptr[0] == NULL) + __builtin_abort (); + if (devptr[1] == NULL) + __builtin_abort (); +#else + if (devptr[0] != NULL) + __builtin_abort (); + if (devptr[1] != NULL) + __builtin_abort (); +#endif + +#pragma acc parallel copyout(devptr) // TODO implicit 'copy(var)' -- huh?! + { + devptr[0] = &var; + devptr[1] = &arr[2]; + } + + if (devptr[0] != &var) + __builtin_abort (); // { dg-xfail-run-if "TODO" { *-*-* } { "-DACC_MEM_SHARED=0" } } + if (devptr[1] != &arr[2]) + __builtin_abort (); + } + + free (arr); + + return 0; +} diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/pr92726-1.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/pr92726-1.c new file mode 100644 index 0000000..fb69adf --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/pr92726-1.c @@ -0,0 +1,26 @@ +/* Verify that 'acc_delete' etc. with a 'NULL' address is a no-op. */ + +#include <assert.h> +#include <stdlib.h> +#include <openacc.h> + +int +main (int argc, char **argv) +{ + const int N = 256; + + unsigned char *a = (unsigned char *) malloc (N); + assert (a); + + void *a_d = acc_create (a, N); + assert (a_d); + + acc_delete (NULL, N); + assert (acc_is_present (a, N)); + //TODO similar for others. + + acc_delete (a, N); + free (a); + + return 0; +} diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/pr92848-1-d-a.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/pr92848-1-d-a.c new file mode 100644 index 0000000..6fe6a9a --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/pr92848-1-d-a.c @@ -0,0 +1,7 @@ +/* Verify device memory allocation/deallocation + { dg-additional-options "-DOPENACC_DIRECTIVES" } using OpenACC directives, + { dg-additional-options "-DARRAYS" } using arrays. */ + +/* { dg-skip-if "" { *-*-* } { "-DACC_MEM_SHARED=1" } } */ + +#include "pr92848-1-r-p.c" diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/pr92848-1-d-p.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/pr92848-1-d-p.c new file mode 100644 index 0000000..2228b2d --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/pr92848-1-d-p.c @@ -0,0 +1,7 @@ +/* Verify device memory allocation/deallocation + { dg-additional-options "-DOPENACC_DIRECTIVES" } using OpenACC directives, + { dg-additional-options "-DPOINTERS" } using pointers. */ + +/* { dg-skip-if "" { *-*-* } { "-DACC_MEM_SHARED=1" } } */ + +#include "pr92848-1-r-p.c" diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/pr92848-1-r-a.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/pr92848-1-r-a.c new file mode 100644 index 0000000..3f5f0ac --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/pr92848-1-r-a.c @@ -0,0 +1,7 @@ +/* Verify device memory allocation/deallocation + { dg-additional-options "-DOPENACC_RUNTIME" } using OpenACC Runtime Library routines, + { dg-additional-options "-DARRAYS" } using arrays. */ + +/* { dg-skip-if "" { *-*-* } { "-DACC_MEM_SHARED=1" } } */ + +#include "pr92848-1-r-p.c" diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/pr92848-1-r-p.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/pr92848-1-r-p.c new file mode 100644 index 0000000..95565ba --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/pr92848-1-r-p.c @@ -0,0 +1,321 @@ +/* Verify device memory allocation/deallocation + { dg-additional-options "-DOPENACC_RUNTIME" } using OpenACC Runtime Library routines, + { dg-additional-options "-DPOINTERS" } using pointers. */ + +/* { dg-skip-if "" { *-*-* } { "-DACC_MEM_SHARED=1" } } */ + +#if OPENACC_RUNTIME +#elif OPENACC_DIRECTIVES +#else +# error +#endif + +#if POINTERS +#elif ARRAYS +#else +# error +#endif + + +#include <openacc.h> +#include <acc_prof.h> +#include <stdlib.h> +#include <string.h> +#include <assert.h> +#include <stdint.h> +#include <stdbool.h> + + +static bool cb_ev_alloc_expected; +static size_t cb_ev_alloc_bytes; +static const void *cb_ev_alloc_device_ptr; +static void +cb_ev_alloc (acc_prof_info *prof_info, acc_event_info *event_info, acc_api_info *api_info) +{ + assert (cb_ev_alloc_expected); + cb_ev_alloc_expected = false; + + cb_ev_alloc_bytes = event_info->data_event.bytes; + cb_ev_alloc_device_ptr = event_info->data_event.device_ptr; +} + +static bool cb_ev_free_expected; +static const void *cb_ev_free_device_ptr; +static void +cb_ev_free (acc_prof_info *prof_info, acc_event_info *event_info, acc_api_info *api_info) +{ + assert (cb_ev_free_expected); + cb_ev_free_expected = false; + + cb_ev_free_device_ptr = event_info->data_event.device_ptr; +} + + +/* Match the alignment processing that + 'libgomp/target.c:gomp_map_vars_internal' is doing; simplified, not + considering special alignment requirements of certain data types. */ + +static size_t +aligned_size (size_t tgt_size) +{ + size_t tgt_align = sizeof (void *); + return tgt_size + tgt_align - 1; +} + +static const void * +aligned_address (const void *tgt_start) +{ + size_t tgt_align = sizeof (void *); + return (void *) (((uintptr_t) tgt_start + tgt_align - 1) & ~(tgt_align - 1)); +} + + +#define SIZE 1024 +#define SUBSET 32 + + +/* A "create", [...], "delete" sequence. */ + +static void +f1 (void) +{ + cb_ev_alloc_expected = false; + cb_ev_free_expected = false; + acc_prof_register (acc_ev_alloc, cb_ev_alloc, acc_reg); + acc_prof_register (acc_ev_free, cb_ev_free, acc_reg); + +#if POINTERS + char *h = (char *) malloc (SIZE); +#else + char h[SIZE]; +#endif + + void *d; + cb_ev_alloc_expected = true; +#if OPENACC_RUNTIME + d = acc_create (h, SIZE); +#else +# if POINTERS +# pragma acc enter data create (h[0:SIZE]) +# else +# pragma acc enter data create (h) +# endif + d = acc_deviceptr (h); +#endif + assert (d); + assert (!cb_ev_alloc_expected); + assert (cb_ev_alloc_bytes == aligned_size (SIZE)); + assert (aligned_address (cb_ev_alloc_device_ptr) == d); + assert (acc_is_present (h, SIZE)); + +#if OPENACC_RUNTIME + acc_create (h, SIZE); +#else +# if POINTERS +# pragma acc enter data create (h[0:SIZE]) +# else +# pragma acc enter data create (h) +# endif +#endif + +#if POINTERS +# pragma acc data create (h[0:SIZE]) + ; +#else +# pragma acc data create (h) + ; +#endif + assert (acc_is_present (h, SIZE)); + +#if OPENACC_RUNTIME + acc_delete (h, SIZE); +#else +# if POINTERS +# pragma acc exit data delete (h[0:SIZE]) +# else +# pragma acc exit data delete (h) +# endif +#endif + assert (acc_is_present (h, SIZE)); + + cb_ev_free_expected = true; +#if OPENACC_RUNTIME + acc_delete (h, SIZE); +#else +# if POINTERS +# pragma acc exit data delete (h[0:SIZE]) +# else +# pragma acc exit data delete (h) +# endif +#endif + assert (!cb_ev_free_expected); + assert (cb_ev_free_device_ptr == cb_ev_alloc_device_ptr); + assert (!acc_is_present (h, SIZE)); + +#if POINTERS + free (h); +#endif + + acc_prof_unregister (acc_ev_alloc, cb_ev_alloc, acc_reg); + acc_prof_unregister (acc_ev_free, cb_ev_free, acc_reg); +} + + +/* A "map", [...] "unmap" sequence. */ + +static void +f2 (void) +{ + cb_ev_alloc_expected = false; + cb_ev_free_expected = false; + acc_prof_register (acc_ev_alloc, cb_ev_alloc, acc_reg); + acc_prof_register (acc_ev_free, cb_ev_free, acc_reg); + +#if POINTERS + char *h = (char *) malloc (SIZE); +#else + char h[SIZE]; +#endif + + void *d; + cb_ev_alloc_expected = true; + d = acc_malloc (SIZE); + assert (d); + assert (!cb_ev_alloc_expected); + assert (cb_ev_alloc_bytes == SIZE); + assert (cb_ev_alloc_device_ptr == d); + + acc_map_data (h, d, SIZE); + assert (acc_is_present (h, SIZE)); + +#if OPENACC_RUNTIME + acc_create (h, SIZE); +#else +# if POINTERS +# pragma acc enter data create (h[0:SIZE]) +# else +# pragma acc enter data create (h) +# endif +#endif + +#if POINTERS +# pragma acc data create (h[0:SIZE]) + ; +#else +# pragma acc data create (h) + ; +#endif + assert (acc_is_present (h, SIZE)); + +#if OPENACC_RUNTIME + acc_delete (h, SIZE); +#else +# if POINTERS +# pragma acc exit data delete (h[0:SIZE]) +# else +# pragma acc exit data delete (h) +# endif +#endif + assert (acc_is_present (h, SIZE)); + + acc_unmap_data (h); + assert (!acc_is_present (h, SIZE)); + + cb_ev_free_expected = true; + acc_free (d); + assert (!cb_ev_free_expected); + assert (cb_ev_free_device_ptr == cb_ev_alloc_device_ptr); + +#if POINTERS + free (h); +#endif + + acc_prof_unregister (acc_ev_alloc, cb_ev_alloc, acc_reg); + acc_prof_unregister (acc_ev_free, cb_ev_free, acc_reg); +} + + +/* A structured 'data' construct. */ + +static void +f3 (void) +{ + cb_ev_alloc_expected = false; + cb_ev_free_expected = false; + acc_prof_register (acc_ev_alloc, cb_ev_alloc, acc_reg); + acc_prof_register (acc_ev_free, cb_ev_free, acc_reg); + +#if POINTERS + char *h = (char *) malloc (SIZE); +#else + char h[SIZE]; +#endif + + cb_ev_alloc_expected = true; +#if POINTERS +# pragma acc data create (h[0:SIZE]) +#else +# pragma acc data create (h) +#endif + { + void *d = acc_deviceptr (h); + assert (d); + assert (!cb_ev_alloc_expected); + assert (cb_ev_alloc_bytes == aligned_size (SIZE)); + assert (aligned_address (cb_ev_alloc_device_ptr) == d); + assert (acc_is_present (h, SIZE)); + +#if OPENACC_RUNTIME + acc_create (h, SIZE); +#else +# if POINTERS +# pragma acc enter data create (h[0:SIZE]) +# else +# pragma acc enter data create (h) +# endif +#endif + +#if POINTERS +# pragma acc data create (h[0:SIZE]) + ; +#else +# pragma acc data create (h) + ; +#endif + assert (acc_is_present (h, SIZE)); + +#if OPENACC_RUNTIME + acc_delete (h, SIZE); +#else +# if POINTERS +# pragma acc exit data delete (h[0:SIZE]) +# else +# pragma acc exit data delete (h) +# endif +#endif + assert (acc_is_present (h, SIZE)); + + cb_ev_free_expected = true; + } + assert (!cb_ev_free_expected); + assert (cb_ev_free_device_ptr == cb_ev_alloc_device_ptr); + assert (!acc_is_present (h, SIZE)); + +#if POINTERS + free (h); +#endif + + acc_prof_unregister (acc_ev_alloc, cb_ev_alloc, acc_reg); + acc_prof_unregister (acc_ev_free, cb_ev_free, acc_reg); +} + + +int +main () +{ + f1 (); + f2 (); + f3 (); + + return 0; +} diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/pr92970-1.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/pr92970-1.c new file mode 100644 index 0000000..380f679 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/pr92970-1.c @@ -0,0 +1,33 @@ +/* Verify that 'acc_delete' etc. on non-present data is a no-op. */ + +#include <openacc.h> + +int +main () +{ + int a; + + int async = 0; + +#pragma acc exit data copyout (a) + acc_copyout (&a, sizeof a); +#pragma acc exit data copyout (a) async (async++) + acc_copyout_async (&a, sizeof a, async++); +#pragma acc exit data copyout (a) finalize + acc_copyout_finalize (&a, sizeof a); +#pragma acc exit data copyout (a) finalize async (async++) + acc_copyout_finalize_async (&a, sizeof a, async++); + +#pragma acc exit data delete (a) + acc_delete (&a, sizeof a); +#pragma acc exit data delete (a) async (async++) + acc_delete_async (&a, sizeof a, async++); +#pragma acc exit data delete (a) finalize + acc_delete_finalize (&a, sizeof a); +#pragma acc exit data delete (a) finalize async (async++) + acc_delete_finalize_async (&a, sizeof a, async++); + + acc_wait_all (); + + return 0; +} diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/pr92984-1.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/pr92984-1.c new file mode 100644 index 0000000..319d6cc --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/pr92984-1.c @@ -0,0 +1,100 @@ +/* Verify that 'acc_delete' etc. with zero size is a no-op. */ + +#include <assert.h> +#include <stdlib.h> +#include <openacc.h> + + +#define UNHANDLED_GOMP_MAP_ZERO_LEN_ARRAY_SECTION + + +static void +verify_mapped_unchanged (unsigned char *a, size_t N) +{ + assert (acc_is_present (a, N)); + + for (size_t i = 0; i < N; ++i) + assert (a[i] == (unsigned char) i); +} + +int +main (int argc, char **argv) +{ + const size_t N = 256; + + unsigned char *a = (unsigned char *) malloc (N); + assert (a); + + for (size_t i = 0; i < N; ++i) + a[i] = 51; + + void *a_d = acc_copyin (a, N); + assert (a_d); + + for (size_t i = 0; i < N; ++i) + a[i] = i; + + int async = 0; + + const size_t size = 0; + +#ifndef UNHANDLED_GOMP_MAP_ZERO_LEN_ARRAY_SECTION +#pragma acc exit data copyout (a[0:size]) + verify_mapped_unchanged (a, N); +#endif + acc_copyout (a, size); + verify_mapped_unchanged (a, N); +#ifndef UNHANDLED_GOMP_MAP_ZERO_LEN_ARRAY_SECTION +#pragma acc exit data copyout (a[0:size]) async (async++) + verify_mapped_unchanged (a, N); +#endif + acc_copyout_async (a, size, async++); + verify_mapped_unchanged (a, N); +#ifndef UNHANDLED_GOMP_MAP_ZERO_LEN_ARRAY_SECTION +#pragma acc exit data copyout (a[0:size]) finalize + verify_mapped_unchanged (a, N); +#endif + acc_copyout_finalize (a, size); + verify_mapped_unchanged (a, N); +#ifndef UNHANDLED_GOMP_MAP_ZERO_LEN_ARRAY_SECTION +#pragma acc exit data copyout (a[0:size]) finalize async (async++) + verify_mapped_unchanged (a, N); +#endif + acc_copyout_finalize_async (a, size, async++); + verify_mapped_unchanged (a, N); + +#ifndef UNHANDLED_GOMP_MAP_ZERO_LEN_ARRAY_SECTION +#pragma acc exit data delete (a[0:size]) + verify_mapped_unchanged (a, N); +#endif + acc_delete (a, size); + verify_mapped_unchanged (a, N); +#ifndef UNHANDLED_GOMP_MAP_ZERO_LEN_ARRAY_SECTION +#pragma acc exit data delete (a[0:size]) async (async++) + verify_mapped_unchanged (a, N); +#endif + acc_delete_async (a, size, async++); + verify_mapped_unchanged (a, N); +#ifndef UNHANDLED_GOMP_MAP_ZERO_LEN_ARRAY_SECTION +#pragma acc exit data delete (a[0:size]) finalize + verify_mapped_unchanged (a, N); +#endif + acc_delete_finalize (a, size); + verify_mapped_unchanged (a, N); +#ifndef UNHANDLED_GOMP_MAP_ZERO_LEN_ARRAY_SECTION +#pragma acc exit data delete (a[0:size]) finalize async (async++) + verify_mapped_unchanged (a, N); +#endif + acc_delete_finalize_async (a, size, async++); + verify_mapped_unchanged (a, N); + + acc_wait_all (); + + acc_delete (a, N); +#if !ACC_MEM_SHARED + assert (!acc_is_present (a, N)); +#endif + free (a); + + return 0; +} diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/subset-subarray-mappings-1-r-p.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/subset-subarray-mappings-1-r-p.c index 9b5d83c..907b858 100644 --- a/libgomp/testsuite/libgomp.oacc-c-c++-common/subset-subarray-mappings-1-r-p.c +++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/subset-subarray-mappings-1-r-p.c @@ -156,20 +156,16 @@ f1 (void) assert (acc_is_present (&myblock[i], SUBSET)); assert (acc_is_present (myblock, SIZE)); -#if 0 //TODO PR92848 if (last) cb_ev_free_expected = true; -#endif #if OPENACC_RUNTIME acc_delete (&myblock[i], SUBSET); #else # pragma acc exit data delete (myblock[i:SUBSET]) #endif -#if 0 //TODO PR92848 assert (!cb_ev_free_expected); if (last) assert (cb_ev_free_device_ptr == cb_ev_alloc_device_ptr); -#endif assert (acc_is_present (&myblock[i], SUBSET) != last); assert (acc_is_present (myblock, SIZE) != last); } @@ -331,9 +327,7 @@ f3 () assert (acc_is_present (h, SIZE)); assert (acc_is_present (&h[2], SIZE - 2)); -#if 0 //TODO PR92848 cb_ev_free_expected = true; -#endif #if OPENACC_RUNTIME acc_delete (h, SIZE); #else @@ -343,10 +337,8 @@ f3 () # pragma acc exit data delete (h) # endif #endif -#if 0 //TODO PR92848 assert (!cb_ev_free_expected); assert (cb_ev_free_device_ptr == cb_ev_alloc_device_ptr); -#endif assert (!acc_is_present (h, SIZE)); assert (!acc_is_present (&h[2], SIZE - 2)); @@ -401,19 +393,15 @@ f_lib_22 (void) memset (h, c1, SIZE); /* Now 'copyout' not the whole but only a "subset" subarray, missing one SUBSET at the beginning, and half a SUBSET at the end... */ -#if 0 //TODO PR92848 cb_ev_free_expected = true; -#endif #if OPENACC_RUNTIME acc_copyout (h + SUBSET, SIZE - SUBSET - SUBSET / 2); #else # pragma acc exit data copyout (h[SUBSET:SIZE - SUBSET - SUBSET / 2]) #endif -#if 0 //TODO PR92848 /* ..., yet, expect the device memory object to be 'free'd... */ assert (!cb_ev_free_expected); assert (cb_ev_free_device_ptr == cb_ev_alloc_device_ptr); -#endif /* ..., and the mapping to be removed... */ assert (!acc_is_present (h, SIZE)); assert (!acc_is_present (&h[SUBSET], SIZE - SUBSET - SUBSET / 2)); @@ -474,19 +462,15 @@ f_lib_30 (void) assert (aligned_address (cb_ev_alloc_device_ptr) == d); /* We 'delete' not the whole but only a "subset" subarray... */ -#if 0 //TODO PR92848 cb_ev_free_expected = true; -#endif #if OPENACC_RUNTIME acc_delete (h, SIZE - SUBSET); #else # pragma acc exit data delete (h[0:SIZE - SUBSET]) #endif -#if 0 //TODO PR92848 /* ..., yet, expect the device memory object to be 'free'd... */ assert (!cb_ev_free_expected); assert (cb_ev_free_device_ptr == cb_ev_alloc_device_ptr); -#endif /* ..., and the mapping to be removed. */ assert (!acc_is_present (h, SIZE)); assert (!acc_is_present (h, SIZE - SUBSET)); diff --git a/libgomp/testsuite/libgomp.oacc-fortran/no_create-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/no_create-1.f90 new file mode 100644 index 0000000..4a1d5da --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/no_create-1.f90 @@ -0,0 +1,39 @@ +! { dg-do run } + +! Test no_create clause with data construct when data is present/not present. + +program no_create + use openacc + implicit none + logical :: shared_memory + integer, parameter :: n = 512 + integer :: myvar, myarr(n) + integer i + + shared_memory = .false. + !$acc kernels copyin (shared_memory) + shared_memory = .true. + !$acc end kernels + + myvar = 77 + do i = 1, n + myarr(i) = 0 + end do + + !$acc data no_create (myvar, myarr) + if (acc_is_present (myvar) .neqv. shared_memory) stop 10 + if (acc_is_present (myarr) .neqv. shared_memory) stop 11 + !$acc end data + + !$acc enter data copyin (myvar, myarr) + !$acc data no_create (myvar, myarr) + if (acc_is_present (myvar) .eqv. .false.) stop 20 + if (acc_is_present (myarr) .eqv. .false.) stop 21 + !$acc end data + !$acc exit data copyout (myvar, myarr) + + if (myvar .ne. 77) stop 30 + do i = 1, n + if (myarr(i) .ne. 0) stop 31 + end do +end program no_create diff --git a/libgomp/testsuite/libgomp.oacc-fortran/no_create-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/no_create-2.f90 new file mode 100644 index 0000000..0b11f45 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/no_create-2.f90 @@ -0,0 +1,90 @@ +! { dg-do run } + +! Test no_create clause with data/parallel constructs. + +program no_create + use openacc + implicit none + logical :: shared_memory + integer, parameter :: n = 512 + integer :: myvar, myarr(n) + integer i + + shared_memory = .false. + !$acc kernels copyin (shared_memory) + shared_memory = .true. + !$acc end kernels + + myvar = 55 + do i = 1, n + myarr(i) = 0 + end do + + call do_on_target(myvar, n, myarr) + + if (shared_memory) then + if (myvar .ne. 44) stop 10 + else + if (myvar .ne. 33) stop 11 + end if + do i = 1, n + if (shared_memory) then + if (myarr(i) .ne. i * 2) stop 20 + else + if (myarr(i) .ne. i) stop 21 + end if + end do + + myvar = 55 + do i = 1, n + myarr(i) = 0 + end do + + !$acc enter data copyin(myvar, myarr) + call do_on_target(myvar, n, myarr) + !$acc exit data copyout(myvar, myarr) + + if (myvar .ne. 44) stop 30 + do i = 1, n + if (myarr(i) .ne. i * 2) stop 31 + end do +end program no_create + +subroutine do_on_target (var, n, arr) + use openacc + implicit none + integer :: var, n, arr(n) + integer :: i + +!$acc data no_create (var, arr) + +if (acc_is_present(var)) then + ! The no_create clause is meant for partially shared-memory machines. This + ! test is written to work on non-shared-memory machines, though this is not + ! necessarily a useful way to use the no_create clause in practice. + + !$acc parallel !no_create (var) + var = 44 + !$acc end parallel +else + var = 33 +end if +if (acc_is_present(arr)) then + ! The no_create clause is meant for partially shared-memory machines. This + ! test is written to work on non-shared-memory machines, though this is not + ! necessarily a useful way to use the no_create clause in practice. + + !$acc parallel loop !no_create (arr) + do i = 1, n + arr(i) = i * 2 + end do + !$acc end parallel loop +else + do i = 1, n + arr(i) = i + end do +end if + +!$acc end data + +end subroutine do_on_target diff --git a/libgomp/testsuite/libgomp.oacc-fortran/no_create-3.F90 b/libgomp/testsuite/libgomp.oacc-fortran/no_create-3.F90 new file mode 100644 index 0000000..4362688 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/no_create-3.F90 @@ -0,0 +1,39 @@ +! { dg-do run } + +program main + use iso_c_binding, only: c_sizeof + use openacc, only: acc_is_present + implicit none + integer i + integer, parameter :: n = 100 + real*4 b(n), c(n) + real :: d(n), e(n) + common /BLOCK/ d, e + + !$acc enter data create(b) create(d) + + if (.not. acc_is_present(b, c_sizeof(b))) stop 1 + if (.not. acc_is_present(d, c_sizeof(d))) stop 2 +#if !ACC_MEM_SHARED + if (acc_is_present(c, 1) .or. acc_is_present(c, c_sizeof(c))) stop 3 + if (acc_is_present(e, 1) .or. acc_is_present(e, c_sizeof(d))) stop 4 +#endif + + !$acc parallel loop no_create(b) no_create(c) no_create(/BLOCK/) + do i = 1, n + b(i) = i + d(i) = -i + end do + !$acc end parallel loop + + if (.not. acc_is_present(b, c_sizeof(b))) stop 5 + if (.not. acc_is_present(d, c_sizeof(d))) stop 6 +#if !ACC_MEM_SHARED + if (acc_is_present(c, 1) .or. acc_is_present(c, c_sizeof(c))) stop 7 + if (acc_is_present(e, 1) .or. acc_is_present(e, c_sizeof(e))) stop 8 +#endif + + !$acc exit data copyout(b) copyout(d) + if (any(abs(b - [(real(i), i = 1, n)]) > 10*epsilon(b))) stop 9 + if (any(abs(d - [(real(-i), i = 1, n)]) > 10*epsilon(d))) stop 10 +end program main |