diff options
author | Gaius Mulley <gaius.mulley@southwales.ac.uk> | 2022-05-19 19:40:55 +0100 |
---|---|---|
committer | Gaius Mulley <gaius.mulley@southwales.ac.uk> | 2022-05-19 19:40:55 +0100 |
commit | 2bbc95a9c0622cd3d83db660f6a5230ef6e99927 (patch) | |
tree | 6a7b7827c6129927da78e529d94adede90d28c78 /gcc | |
parent | 3c46ace3d1075f3278526529586bd41889ffa30d (diff) | |
parent | d863ba23fb16122bb0547b0c678173be0d98f43c (diff) | |
download | gcc-2bbc95a9c0622cd3d83db660f6a5230ef6e99927.zip gcc-2bbc95a9c0622cd3d83db660f6a5230ef6e99927.tar.gz gcc-2bbc95a9c0622cd3d83db660f6a5230ef6e99927.tar.bz2 |
Merge branch 'master' into devel/modula-2.
Diffstat (limited to 'gcc')
570 files changed, 16063 insertions, 11094 deletions
diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 31c63f6..66fe54b 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,369 @@ +2022-05-18 Marek Polacek <polacek@redhat.com> + + PR c/105131 + * doc/invoke.texi: Document -Wenum-int-mismatch. + +2022-05-18 Uros Bizjak <ubizjak@gmail.com> + + * config/i386/gnu-user-common.h (defined): Only define + TARGET_CAN_SPLIT_STACK for glibc targets. + * config/i386/gnu.h (defined): Ditto. + +2022-05-18 Roger Sayle <roger@nextmovesoftware.com> + + * config/i386/i386.cc (ix86_rtx_costs) [MULT]: When mode size + is wider than word_mode, a multiplication costs three word_mode + multiplications and two word_mode additions. + +2022-05-18 Roger Sayle <roger@nextmovesoftware.com> + + * config/i386/i386.md (define_split): Split *andsi_1 + and *andn_si_ccno after reload with -Oz. + +2022-05-18 Frederik Harwath <frederik@codesourcery.com> + + * graphite-scop-detection.cc (scop_detection::can_represent_loop): + Output reason for failure to dump file. + (scop_detection::harmful_loop_in_region): Likewise. + (scop_detection::graphite_can_represent_expr): Likewise. + (scop_detection::stmt_has_simple_data_refs_p): Likewise. + (scop_detection::stmt_simple_for_scop_p): Likewise. + (print_sese_loop_numbers): New function. + (scop_detection::add_scop): Use from here. + +2022-05-18 liuhongt <hongtao.liu@intel.com> + + PR middle-end/103462 + * match.pd (bitwise_induction_p): New match. + * tree-scalar-evolution.cc (gimple_bitwise_induction_p): + Declare. + (analyze_and_compute_bitwise_induction_effect): New function. + (enum bit_op_kind): New enum. + (final_value_replacement_loop): Enhanced to handle bitwise + induction. + +2022-05-18 Haochen Gui <guihaoc@gcc.gnu.org> + + PR target/95737 + * config/rs6000/rs6000.md (*subfsi3_carry_in_xx_64): New. + +2022-05-18 liuhongt <hongtao.liu@intel.com> + + PR target/104375 + * config/i386/i386.md (*bmi2_bzhi_zero_extendsidi_4): New + define_insn. + +2022-05-18 liuhongt <hongtao.liu@intel.com> + + PR target/104610 + * config/i386/i386-expand.cc (ix86_expand_branch): Use ptest + for QImode when code is EQ or NE. + * config/i386/i386.md (cbranchoi4): New expander. + +2022-05-18 Peter Bergner <bergner@linux.ibm.com> + Segher Boessenkool <segher@kernel.crashing.org> + + PR target/105556 + * config/rs6000/mma.md (mma_<vv>, mma_<avv>, mma_<pv>, mma_<apv>, + mma_<vvi4i4i8>, mma_<avvi4i4i8>, mma_<vvi4i4i2>, mma_<avvi4i4i2>, + mma_<vvi4i4>, mma_<avvi4i4>, mma_<pvi4i2>, mma_<apvi4i2>, + mma_<vvi4i4i4>, mma_<avvi4i4i4>): Replace "wa" constraints with "v,?wa". + Update other operands accordingly. + +2022-05-17 Marek Polacek <polacek@redhat.com> + + * godump.cc (go_output_typedef): Use the DECL_INITIAL of the TREE_VALUE. + +2022-05-17 Pat Haugen <pthaugen@linux.ibm.com> + + PR target/99685 + * config/rs6000/rs6000-call.cc (rs6000_function_arg_advance_1): Bump + register count when not splitting IEEE 128-bit Complex. + +2022-05-17 Tobias Burnus <tobias@codesourcery.com> + + * omp-low.cc (check_omp_nesting_restrictions): Skip warning for + target inside target if inner is reverse offload. + +2022-05-17 Tobias Burnus <tobias@codesourcery.com> + + * config/gcn/mkoffload.cc (process_obj): Revert: Use ARRAY_SIZE. + * config/nvptx/mkoffload.cc (process): Likewise. + +2022-05-17 Andrew MacLeod <amacleod@redhat.com> + + * Makefile.in (OBJS): Add gimple-range-side-effect.o. + * gimple-range-cache.cc (non_null_ref::non_null_ref): Delete. + (non_null_ref::~non_null_ref): Delete. + (non_null_ref::set_nonnull): Delete. + (non_null_ref::non_null_deref_p): Delete. + (non_null_ref::process_name): Delete. + (ranger_cache::ranger_cache): Initialize m_exit object. + (ranger_cache::fill_block_cache): Use m_exit object intead of nonnull. + (ranger_cache::range_from_dom): Use side_effect class and m_exit object. + (ranger_cache::update_to_nonnull): Delete. + (non_null_loadstore): Delete. + (ranger_cache::block_apply_nonnull): Delete. + (ranger_cache::apply_side_effects): New. + * gimple-range-cache.h (class non_null_ref): Delete. + (non_null_ref::adjust_range): Delete. + (class ranger_cache): Adjust prototypes, add side effect manager. + * gimple-range-path.cc (path_range_query::range_defined_in_block): Use + side effect manager for queries. + (path_range_query::adjust_for_non_null_uses): Ditto. + * gimple-range-path.h (class path_range_query): Delete non_null_ref. + * gimple-range-side-effect.cc: New. + * gimple-range-side-effect.h: New. + * gimple-range.cc (gimple_ranger::gimple_ranger): Update contructor. + (gimple_ranger::range_of_expr): Check def block for override value. + (gimple_ranger::range_on_entry): Don't scan dominators for non-null. + (gimple_ranger::range_on_edge): Check for outgoing side-effects. + (gimple_ranger::register_side_effects): Call apply_side_effects. + (enable_ranger): Update contructor. + * gimple-range.h (class gimple_ranger): Update prototype. + (enable_ranger): Update prototype. + * tree-vrp.cc (execute_ranger_vrp): Invoke without immediate-use flag. + +2022-05-17 Giuliano Belinassi <gbelinassi@suse.de> + + PR c++/105169 + * targhooks.cc (default_print_patchable_function_entry_1): Handle COMDAT case. + * varasm.cc (switch_to_comdat_section): New + (handle_vtv_comdat_section): Call switch_to_comdat_section. + * varasm.h: Declare switch_to_comdat_section. + +2022-05-17 Richard Biener <rguenther@suse.de> + + * cfgloopmanip.cc (duplicate_loop_body_to_header_edge): Do + not clear bb->aux of the copied blocks. + +2022-05-17 Andrew MacLeod <amacleod@redhat.com> + + PR tree-optimization/105458 + * value-relation.cc (path_oracle::register_relation): Merge, then check + for equivalence. + +2022-05-17 UroÅ¡ Bizjak <ubizjak@gmail.com> + + PR target/105624 + Revert: + * config/i386/i386.md: Remove constraints when used with + const_int_operand, const0_operand, const_1_operand, constm1_operand, + const8_operand, const128_operand, const248_operand, const123_operand, + const2367_operand, const1248_operand, const359_operand, + const_4_or_8_to_11_operand, const48_operand, const_0_to_1_operand, + const_0_to_3_operand, const_0_to_4_operand, const_0_to_5_operand, + const_0_to_7_operand, const_0_to_15_operand, const_0_to_31_operand, + const_0_to_63_operand, const_0_to_127_operand, const_0_to_255_operand, + const_0_to_255_mul_8_operand, const_1_to_31_operand, + const_1_to_63_operand, const_2_to_3_operand, const_4_to_5_operand, + const_4_to_7_operand, const_6_to_7_operand, const_8_to_9_operand, + const_8_to_11_operand, const_8_to_15_operand, const_10_to_11_operand, + const_12_to_13_operand, const_12_to_15_operand, const_14_to_15_operand, + const_16_to_19_operand, const_16_to_31_operand, const_20_to_23_operand, + const_24_to_27_operand and const_28_to_31_operand. + * config/i386/mmx.md: Ditto. + * config/i386/sse.md: Ditto. + * config/i386/subst.md: Ditto. + * config/i386/sync.md: Ditto. + +2022-05-17 Thomas Schwinge <thomas@codesourcery.com> + + * diagnostic.cc: Don't advise to call 'abort' instead of + 'internal_error'. + * system.h: Advise to call 'internal_error' instead of 'abort' or + 'fancy_abort'. + +2022-05-17 Frederik Harwath <frederik@codesourcery.com> + + * graphite-sese-to-poly.cc (build_poly_sr_1): Fix a typo and + a reference to a variable which does not exist. + * graphite-isl-ast-to-gimple.cc (gsi_insert_earliest): Fix typo + in comment. + +2022-05-17 Frederik Harwath <frederik@codesourcery.com> + + * graphite-sese-to-poly.cc (isl_id_for_ssa_name): Rename to ... + (isl_id_for_parameter): ... this new function name. + (build_scop_context): Adjust function use. + +2022-05-17 Tobias Burnus <tobias@codesourcery.com> + + PR target/105602 + * config/gcn/t-omp-device (arch): Add 'amdgcn' besides existing 'gcn'. + * config/gcn/gcn.cc (gcn_omp_device_kind_arch_isa): Likewise. + +2022-05-17 Jakub Jelinek <jakub@redhat.com> + + * tree-core.h (enum omp_clause_depend_kind): Add + OMP_CLAUSE_DEPEND_INOUTSET. + * tree-pretty-print.cc (dump_omp_clause): Handle + OMP_CLAUSE_DEPEND_INOUTSET. + * gimplify.cc (gimplify_omp_depend): Likewise. + * omp-low.cc (lower_depend_clauses): Likewise. + +2022-05-17 Jakub Jelinek <jakub@redhat.com> + + PR target/105613 + * config/i386/sse.md (vec_cmpeqv2div2di, vec_cmpeqv1tiv1ti): Use + andv4si3 only for EQ, for NE use iorv4si3 instead. + +2022-05-17 Richard Biener <rguenther@suse.de> + + PR tree-optimization/105618 + * tree-ssa-sink.cc (statement_sink_location): For virtual + PHI uses ignore those defining the used virtual operand. + +2022-05-17 Jakub Jelinek <jakub@redhat.com> + + * tree-ssa-forwprop.cc (simplify_bitfield_ref): Spelling fix: + hanlde -> handle. Fix up comment formatting. + +2022-05-17 liuhongt <hongtao.liu@intel.com> + + PR target/105033 + * config/i386/sse.md (*vec_concatv4si): Extend to .. + (*vec_concat<mode>): .. V16QI and V8HImode. + (*vec_concatv16qi_permt2): New pre_reload define_insn_and_split. + (*vec_concatv8hi_permt2): Ditto. + +2022-05-17 liuhongt <hongtao.liu@intel.com> + + PR tree-optimization/105591 + * tree-ssa-forwprop.cc (simplify_bitfield_ref): Clamp + vec_perm_expr index. + +2022-05-16 Jason Merrill <jason@redhat.com> + + PR c/105492 + * attribs.cc (decl_attributes): Fix broken typedefs here. + +2022-05-16 David Malcolm <dmalcolm@redhat.com> + + PR analyzer/105103 + * Makefile.in (ANALYZER_OBJS): Add analyzer/varargs.o. + * doc/invoke.texi: Add -Wanalyzer-va-arg-type-mismatch, + -Wanalyzer-va-list-exhausted, -Wanalyzer-va-list-leak, and + -Wanalyzer-va-list-use-after-va-end. + +2022-05-16 Richard Biener <rguenther@suse.de> + + * gimple-match.h (gimple_build): Move code_helper overloads ... + * gimple-fold.h (gimple_build): ... here. + (gimple_build): Transition to new worker API. Provide + overloads from sequence-based API. + (gimple_convert): Likewise. + (gimple_convert_to_ptrofftype): Likewise. + (gimple_build_vector_from_val): Likewise. + (gimple_build_vector): Likewise. + (gimple_build_round_up): Likewise. + * gimple-fold.cc (gimple_build_insert_seq): New helper. + (gimple_build): Use it. Transition combined_fn and code_helper + API parts. + (gimple_convert): Transition to new worker API. + (gimple_convert_to_ptrofftype): Likewise. + (gimple_build_vector_from_val): Likewise. + (gimple_build_vector): Likewise. + (gimple_build_round_up): Likewise. + +2022-05-16 Richard Biener <rguenther@suse.de> + + * gimple-match.h (code_helper): Move class ... + * tree.h (code_helper): ... here. + +2022-05-16 Martin Liska <mliska@suse.cz> + + * opts-global.cc (write_langs): Add comment. + +2022-05-16 Eric Botcazou <ebotcazou@adacore.com> + + * dwarf2out.cc (loc_list_from_tree_1) <TRUTH_NOT_EXPR>: Do a logical + instead of a bitwise negation. + <COND_EXPR>: Swap the operands if the condition is TRUTH_NOT_EXPR. + +2022-05-16 Martin Liska <mliska@suse.cz> + + * attribs.cc (diag_attr_exclusions): Use ARRAY_SIZE. + (decls_mismatched_attributes): Likewise. + * builtins.cc (c_strlen): Likewise. + * cfg.cc (DEF_BASIC_BLOCK_FLAG): Likewise. + * common/config/aarch64/aarch64-common.cc (aarch64_option_init_struct): Likewise. + * config/aarch64/aarch64-builtins.cc (aarch64_lookup_simd_builtin_type): Likewise. + (aarch64_init_simd_builtin_types): Likewise. + (aarch64_init_builtin_rsqrt): Likewise. + * config/aarch64/aarch64.cc (is_madd_op): Likewise. + * config/arm/arm-builtins.cc (arm_lookup_simd_builtin_type): Likewise. + (arm_init_simd_builtin_types): Likewise. + * config/avr/gen-avr-mmcu-texi.cc (mcus[ARRAY_SIZE): Likewise. + (c_prefix): Likewise. + (main): Likewise. + * config/c6x/c6x.cc (N_SAVE_ORDER): Likewise. + * config/darwin-c.cc (darwin_register_frameworks): Likewise. + * config/gcn/mkoffload.cc (process_obj): Likewise. + * config/i386/i386-builtins.cc (get_builtin_code_for_version): Likewise. + (fold_builtin_cpu): Likewise. + * config/m32c/m32c.cc (PUSHM_N): Likewise. + * config/nvptx/mkoffload.cc (process): Likewise. + * config/rs6000/driver-rs6000.cc (host_detect_local_cpu): Likewise. + * config/s390/s390.cc (NR_C_MODES): Likewise. + * config/tilepro/gen-mul-tables.cc (find_sequences): Likewise. + (create_insn_code_compression_table): Likewise. + * config/vms/vms.cc (NBR_CRTL_NAMES): Likewise. + * diagnostic-format-json.cc (json_from_expanded_location): Likewise. + * dwarf2out.cc (ARRAY_SIZE): Likewise. + * genhooks.cc (emit_documentation): Likewise. + (emit_init_macros): Likewise. + * gimple-ssa-sprintf.cc (format_floating): Likewise. + * gimple-ssa-warn-access.cc (memmodel_name): Likewise. + * godump.cc (keyword_hash_init): Likewise. + * hash-table.cc (hash_table_higher_prime_index): Likewise. + * input.cc (for_each_line_table_case): Likewise. + * ipa-free-lang-data.cc (free_lang_data): Likewise. + * ipa-inline.cc (sanitize_attrs_match_for_inline_p): Likewise. + * optc-save-gen.awk: Likewise. + * spellcheck.cc (test_metric_conditions): Likewise. + * tree-vect-slp-patterns.cc (sizeof): Likewise. + (ARRAY_SIZE): Likewise. + * tree.cc (build_common_tree_nodes): Likewise. + +2022-05-16 Martin Liska <mliska@suse.cz> + + * opts-global.cc (write_langs): Allocate at least one byte. + +2022-05-16 Richard Biener <rguenther@suse.de> + + * match.pd (A cmp B ? A : B -> min/max): New patterns + carried over from fold_cond_expr_with_comparison. + +2022-05-16 liuhongt <hongtao.liu@intel.com> + + PR target/105587 + * config/i386/i386-expand.cc + (expand_vec_perm_pslldq_psrldq_por): Fail when (d->perm[i] == + d->perm[i-1] + 1) && d->perm[i] == nelt && start != -1. + +2022-05-15 UroÅ¡ Bizjak <ubizjak@gmail.com> + + * config/i386/i386.md: Remove constraints when used with + const_int_operand, const0_operand, const_1_operand, constm1_operand, + const8_operand, const128_operand, const248_operand, const123_operand, + const2367_operand, const1248_operand, const359_operand, + const_4_or_8_to_11_operand, const48_operand, const_0_to_1_operand, + const_0_to_3_operand, const_0_to_4_operand, const_0_to_5_operand, + const_0_to_7_operand, const_0_to_15_operand, const_0_to_31_operand, + const_0_to_63_operand, const_0_to_127_operand, const_0_to_255_operand, + const_0_to_255_mul_8_operand, const_1_to_31_operand, + const_1_to_63_operand, const_2_to_3_operand, const_4_to_5_operand, + const_4_to_7_operand, const_6_to_7_operand, const_8_to_9_operand, + const_8_to_11_operand, const_8_to_15_operand, const_10_to_11_operand, + const_12_to_13_operand, const_12_to_15_operand, const_14_to_15_operand, + const_16_to_19_operand, const_16_to_31_operand, const_20_to_23_operand, + const_24_to_27_operand and const_28_to_31_operand. + * config/i386/mmx.md: Ditto. + * config/i386/sse.md: Ditto. + * config/i386/subst.md: Ditto. + * config/i386/sync.md: Ditto. + 2022-05-13 Roger Sayle <roger@nextmovesoftware.com> UroÅ¡ Bizjak <ubizjak@gmail.com> diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index df5469f..756cdcb 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20220515 +20220519 diff --git a/gcc/Makefile.in b/gcc/Makefile.in index 31ff955..97e5450 100644 --- a/gcc/Makefile.in +++ b/gcc/Makefile.in @@ -1278,7 +1278,8 @@ ANALYZER_OBJS = \ analyzer/store.o \ analyzer/supergraph.o \ analyzer/svalue.o \ - analyzer/trimmed-graph.o + analyzer/trimmed-graph.o \ + analyzer/varargs.o # Language-independent object files. # We put the *-match.o and insn-*.o files first so that a parallel make @@ -1409,6 +1410,7 @@ OBJS = \ gimple-range-edge.o \ gimple-range-fold.o \ gimple-range-gori.o \ + gimple-range-side-effect.o \ gimple-range-trace.o \ gimple-ssa-backprop.o \ gimple-ssa-evrp.o \ diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d09eeb9..746aee8 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,730 @@ +2022-05-18 Claire Dross <dross@adacore.com> + + * libgnat/s-imageu.adb (Set_Image_Unsigned): Change assertion. + +2022-05-18 Doug Rupp <rupp@adacore.com> + + * sigtramp-qnx.c: Change struct sigcontext * to mcontext_t *. + +2022-05-18 Doug Rupp <rupp@adacore.com> + + * sigtramp-arm-qnx.c: Rewrite. + +2022-05-18 Yannick Moy <moy@adacore.com> + + * libgnat/s-aridou.adb (Big3): Change return type. + (Lemma_Mult_Non_Negative, Lemma_Mult_Non_Positive): Reorder + alphabetically. + (Lemma_Concat_Definition, Lemma_Double_Big_2xxsingle): New + lemmas. + (Double_Divide, Scaled_Divide): Add assertions. + +2022-05-18 Claire Dross <dross@adacore.com> + + * libgnat/s-valueu.adb (Scan_Raw_Unsigned): Add assertions. + +2022-05-18 Kévin Le Gouguec <legouguec@adacore.com> + + * libgnat/s-dwalin.adb (Read_Aranges_Header): Initialize output + parameter in case we return early. + +2022-05-18 Bob Duff <duff@adacore.com> + + * libgnat/a-crbtgo.ads, libgnat/a-rbtgbo.ads, + libgnat/a-cbdlli.adb, libgnat/a-cbhama.adb, + libgnat/a-cbhase.adb, libgnat/a-cdlili.adb, + libgnat/a-cfdlli.adb, libgnat/a-cfhama.adb, + libgnat/a-cfhase.adb, libgnat/a-cidlli.adb, + libgnat/a-cihama.adb, libgnat/a-cihase.adb, + libgnat/a-cohama.adb, libgnat/a-cohase.adb, + libgnat/a-crbtgo.adb, libgnat/a-crdlli.adb, libgnat/a-rbtgbo.adb + (Vet): Make the Vet functions do nothing when + Container_Checks'Enabled is False, and inline them, so the calls + disappear when optimizing. + +2022-05-18 Doug Rupp <rupp@adacore.com> + + * Makefile.rtl (arm-qnx): Use default (non-fma) target pair. + +2022-05-18 Kévin Le Gouguec <legouguec@adacore.com> + + * libgnat/s-dwalin.adb (Aranges_Lookup, Enable_Cache): Adapt to + changes in the signature of Read_Aranges_*. + (Debug_Info_Lookup): Do not control address size read from + DWARF. + (Read_Aranges_Header): Do not control address size read from + DWARF; return this size. + (Read_Aranges_Entry): Use the size returned by + Read_Aranges_Header. + +2022-05-18 Gary Dismukes <dismukes@adacore.com> + + * errout.ads (Error_Msg_GNAT_Extension): Add formal Loc and + revise comment. + * errout.adb (Error_Msg_GNAT_Extension): Condition message on + the flag Ada_Version_Pragma, and add suggestion to use of pragma + Extensions_Allowed in messages. + * par-ch3.adb, par-ch5.adb, par-ch6.adb, par-ch11.adb, + par-ch12.adb: Add actual Token_Ptr on calls to + Error_Msg_GNAT_Extension. + * par-ch4.adb: Change Error_Msg to Error_Msg_GNAT_Extension for + error calls related to use of extension features. + * sem_ch13.adb: Likewise. + +2022-05-18 Johannes Kliemann <kliemann@adacore.com> + + * libgnarl/s-osinte__qnx.adb (To_Target_Priority): Perform + arithmetic in int. + +2022-05-18 Eric Botcazou <ebotcazou@adacore.com> + + * exp_ch7.adb (Build_BIP_Cleanup_Stmts): Use Needs_BIP_Alloc_Form. + +2022-05-18 Javier Miranda <miranda@adacore.com> + + * sem_ch6.adb (Find_Corresponding_Spec): Avoid calling + Is_Null_Extension with a class-wide type entity. + (Overrides_Visible_Function): Handle alias entities. + * sem_res.adb (Has_Applicable_User_Defined_Literal): Conversion + not needed if the result type of the call is class-wide or if + the result type matches the context type. + * sem_util.ads (Is_Null_Extension): Adding documentation. + (Is_Null_Extension_Of): Adding documentation. + * sem_util.adb (Is_Null_Extension): Adding assertion. + (Is_Null_Extension_Of): Adding assertions. + +2022-05-18 Javier Miranda <miranda@adacore.com> + + * snames.ads-tmpl (Name_Index): New attribute name. + (Attribute_Id): Adding Attribute_Index as regular attribute. + * sem_attr.adb (Attribute_22): Adding Attribute_Index as Ada + 2022 attribute. + (Analyze_Index_Attribute): Check that 'Index appears in a + pre-/postcondition aspect or pragma associated with an entry + family. + (Analyze_Attribute): Adding semantic analysis for 'Index. + (Eval_Attribute): Register 'Index as can never be folded. + (Resolve_Attribute): Resolve attribute 'Index. + * sem_ch9.adb (Check_Wrong_Attribute_In_Postconditions): New + subprogram. + (Analyze_Requeue): Check that the requeue target shall not have + an applicable specific or class-wide postcondition which + includes an Index attribute reference. + * exp_attr.adb (Expand_N_Attribute_Reference): Transform + attribute Index into a renaming of the second formal of the + wrapper built for an entry family that has contract cases. + * einfo.ads (Is_Entry_Wrapper): Complete documentation. + +2022-05-18 Yannick Moy <moy@adacore.com> + + * libgnat/s-imagei.adb (Set_Digits): Add assertion. + * libgnat/s-imgboo.adb (Image_Boolean): Add assertions. + * libgnat/s-valueu.adb (Scan_Raw_Unsigned): Add assertion. + +2022-05-18 Arnaud Charlet <charlet@adacore.com> + + * sem_aux.adb (Is_Immutably_Limited_Type): Do not look through + private types as per RM 7.5(8.1). + * sem_ch6.adb (Analyze_Function_Return): Use + Is_Immutably_Limited_Type as per RM 6.5(5.10). + +2022-05-18 Marc Poulhiès <poulhies@adacore.com> + + * gen_il-gen-gen_nodes.adb (Gen_IL.Gen.Gen_Nodes): Add + Is_Homogeneous_Aggregate field for N_Delta_Aggregate nodes. + * par-ch4.adb (P_Aggregate_Or_Paren_Expr): Minor reformatting. + * sem_aggr.adb (Resolve_Delta_Aggregate): Reject square brackets + for record aggregate. + (Resolve_Record_Aggregate): Uniformise error message. + +2022-05-18 Arnaud Charlet <charlet@adacore.com> + + * ali.adb (Scan_ALI): Special case a-tags.ali when setting + Sec_Stack_Used. + * bindgen.adb (Gen_Adainit): Simplify handling of secondary + stack related code, and only import __gnat_binder_ss_count when + needed. + * libgnat/s-secsta.adb (Binder_SS_Count): Default initialize to + 0. + +2022-05-18 Eric Botcazou <ebotcazou@adacore.com> + + * libgnat/s-dourea.adb ("/"): Add guard for zero and infinite + divisor. + * libgnat/s-valuer.adb (Scan_Raw_Real): Add guard for very large + exponent values. + +2022-05-18 Yannick Moy <moy@adacore.com> + + * sem_elab.adb (Is_Suitable_Construct): Fix for generated + constructs. + +2022-05-18 Marc Poulhiès <poulhies@adacore.com> + + * sem_ch3.adb (Analyze_Object_Declaration): Skip predicate check + for type conversion if object's subtype and expression's subtype + statically match. + * exp_prag.adb (Expand_Pragma_Check): Typo fix in comment. + +2022-05-18 Eric Botcazou <ebotcazou@adacore.com> + + * exp_dbug.ads (Build_Subprogram_Instance_Renamings): Fix typo. + * exp_dbug.adb (Build_Subprogram_Instance_Renamings): Build the + renaming only for actuals of formal objects. + +2022-05-18 Gary Dismukes <dismukes@adacore.com> + + * sem_ch3.adb (Check_Abstract_Overriding): If the type is + derived from an untagged type, then don't perform any of the + abstract overriding error checks. + +2022-05-18 Piotr Trojanek <trojanek@adacore.com> + + * exp_aggr.adb (Component_Count): Calculate size as an Uint and + only then check if it is in the range of Int, as otherwise the + multiplication of Int values can overflow. + +2022-05-18 Eric Botcazou <ebotcazou@adacore.com> + + * Makefile.rtl (GNATRTL_NONTASKING_OBJS): Add g-gfmafu$(objext). + (SIMD_PATH_TARGET_PAIRS): New variable. + (TRASYM_DWARF_COMMON_OBJS): Minor tweak. + (x86-64/Linux): Use SIMD_PATH_TARGET_PAIRS. + (x32/Linux): Likewise. + * doc/gnat_rm/the_gnat_library.rst (Generic_Fast_Math_Functions): + New entry. + * gnat_rm.texi: Regenerate. + * impunit.adb (Non_Imp_File_Names_95): Add g-gfmafu. + * sem_ch7.adb (Has_Referencer): Do not set In_Nested_Instance for + instances of generic packages that do not have a body. + * libgnat/a-nalofl__simd.ads: New SIMD-enabled version. + * libgnat/a-nuaufl__simd.ads: Likewise. + * libgnat/g-gfmafu.ads: New package renaming unit. + +2022-05-18 Arnaud Charlet <charlet@adacore.com> + + * freeze.adb (Should_Freeze_Type): Fix handling of freezing in + instances. + +2022-05-18 Marc Poulhiès <poulhies@adacore.com> + + * sem_ch12.adb (Check_Generic_Parent): Use + Get_Unit_Instantiation_Node instead of Next. + +2022-05-18 Alexandre Oliva <oliva@adacore.com> + + * libgnat/a-nagefl.ads: Replace mentions of C/unix math library + with intrinsics. + * libgnat/a-nallfl.ads: Likewise. State compatibility + requirements. + * libgnat/a-nalofl.ads: Likewise. + * libgnat/a-nuaufl.ads: Likewise. + +2022-05-18 Eric Botcazou <ebotcazou@adacore.com> + + * sem_ch8.adb (Analyze_Subprogram_Renaming): Move final test on + In_Instance to outer condition. + +2022-05-18 Doug Rupp <rupp@adacore.com> + + * Makefile.rtl: Rename system-qnx-aarch64.ads to + system-qnx-arm.ads. + (AARCH64 QNX section): Modify to handle both arm and arch64. + * tracebak.c (__QNX__): Add new __ARMEL__ section. + * sigtramp-arm-qnx.c: New file. + * libgnat/system-qnx-aarch64.ads: Renamed to ... + * libgnat/system-qnx-arm.ads: this. + +2022-05-17 Piotr Trojanek <trojanek@adacore.com> + + * sem_res.adb (Flag_Effectively_Volatile_Objects): Restore + redundant guard. + +2022-05-17 Gary Dismukes <dismukes@adacore.com> + + * sem_ch8.adb (Analyze_Subprogram_Renaming): Add error check for + the case of a renamed subprogram given by an expanded name whose + outermost prefix names a unit that is hidden by the name of the + renaming. + (Ult_Expanded_Prefix): New local expression function to return + the ultimate prefix of an expanded name. + +2022-05-17 Ghjuvan Lacambre <lacambre@adacore.com> + + * gnat_cuda.ads: Update package-level comments. + (Build_And_Insert_CUDA_Initialization): Remove function. + * gnat_cuda.adb (Build_And_Insert_CUDA_Initialization): Remove + function. + (Expand_CUDA_Package): Remove call to + Build_And_Insert_CUDA_Initialization. + +2022-05-17 Etienne Servais <servais@adacore.com> + + * freeze.adb (Freeze_Enumeration_Type): Fix comment, enhance + message and silence warning for size > 32. + +2022-05-17 Yannick Moy <moy@adacore.com> + + * exp_spark.adb (Expand_SPARK_Potential_Renaming): Deal with no + entity case. + * inline.ads (Check_Object_Renaming_In_GNATprove_Mode): New + procedure. + * inline.adb (Check_Object_Renaming_In_GNATprove_Mode): New + procedure. + (Can_Be_Inlined_In_GNATprove_Mode): Remove case forbidding + inlining for subprograms inside generics. + * sem_ch12.adb (Copy_Generic_Node): Preserve global entities + when inlining in GNATprove mode. + * sem_ch6.adb (Analyse_Subprogram_Body_Helper): Remove body to + inline if renaming is detected in GNATprove mode. + +2022-05-17 Gary Dismukes <dismukes@adacore.com> + + * exp_ch4.adb (Expand_N_Allocator): For an allocator with an + unconstrained discriminated designated type, and whose + allocation subtype is constrained, set the + Actual_Designated_Subtype of the dereference passed to the init + proc of the designated type to be the allocation subtype. + * sinfo.ads: Add documentation of new setting of + Actual_Designated_Subtype on a dereference used as an actual + parameter of call to an init proc associated with an allocator. + Also add missing syntax and documentation for the GNAT language + extension that allows an expression as a default for a concrete + generic formal function. + +2022-05-17 Bob Duff <duff@adacore.com> + + * sinfo.ads: Remove From_At_End. Update comments. + * gen_il-fields.ads, gen_il-gen-gen_nodes.adb, sem_ch11.adb: + Remove From_At_End. + * exp_ch11.adb (Expand_At_End_Handler): Remove assertion. + * fe.h (Exception_Mechanism, Exception_Mechanism_Type, Has_DIC, + Has_Invariants, Is_List_Member, List_Containing): Remove + declarations that are not used in gigi. + * opt.ads (Exception_Mechanism): This is not used in gigi. + * exp_util.ads: Minor comment fix. + +2022-05-17 Dmitriy Anisimkov <anisimko@adacore.com> + + * impunit.adb: Add "g-binsea" to Non_Imp_File_Names_95 list. + +2022-05-17 Yannick Moy <moy@adacore.com> + + * sem_ch5.adb (Analyze_Iterator_Specification): Use + Insert_Action when possibly inside an expression. + +2022-05-17 Marc Poulhiès <poulhies@adacore.com> + + * libgnat/g-forstr.adb (Is_Number): Add scientific notation and + shortest representation. + +2022-05-17 Eric Botcazou <ebotcazou@adacore.com> + + * exp_ch3.adb (Expand_N_Full_Type_Declaration): Look into N. + +2022-05-17 Bob Duff <duff@adacore.com> + + * exp_util.adb (Requires_Cleanup_Actions): Remove + N_Protected_Body from the case statement, so that case will be + covered by "raise Program_Error". + +2022-05-17 Bob Duff <duff@adacore.com> + + * output.adb (Pop_Output, Set_Output): Unconditionally flush + output when switching from one output destination to another. + Otherwise buffering can cause garbled output. + (w): Push/pop the current settings, and temporarily + Set_Standard_Error during these procedures. + +2022-05-17 Dmitriy Anisimkov <anisimko@adacore.com> + + * libgnat/g-binsea.ads, libgnat/g-binsea.adb + (GNAT.Binary_Search): New package. + * Makefile.rtl (GNATRTL_NONTASKING_OBJS): New item in list. + * doc/gnat_rm/the_gnat_library.rst (GNAT.Binary_Search): New + package record. + * gnat_rm.texi: Regenerate. + +2022-05-17 Eric Botcazou <ebotcazou@adacore.com> + + * sem_ch12.ads (Is_Abbreviated_Instance): Declare. + * sem_ch12.adb (Check_Abbreviated_Instance): Declare. + (Requires_Conformance_Checking): Declare. + (Analyze_Association.Process_Default): Fix subtype of parameter. + (Analyze_Formal_Object_Declaration): Check whether it is in the + visible part of abbreviated instance. + (Analyze_Formal_Subprogram_Declaration): Likewise. + (Analyze_Formal_Type_Declaration): Likewise. + (Analyze_Package_Instantiation): Do not check for a generic child + unit in the case of an abbreviated instance. + (Check_Abbreviated_Instance): New procedure. + (Check_Formal_Packages): Tidy up. + (Copy_Generic_Elist): Fix comment. + (Instantiate_Formal_Package): Tidy up. If the generic unit is a + child unit, copy the qualified name onto the abbreviated instance. + (Is_Abbreviated_Instance): New function. + (Collect_Previous_Instances): Call Is_Abbreviated_Instance. + (Requires_Conformance_Checking): New function. + * sem_ch7.adb (Analyze_Package_Specification): Do not install the + private declarations of the parent for an abbreviated instance. + +2022-05-17 Etienne Servais <servais@adacore.com> + + * sem_ch3.adb (Analyze_Subtype_Declaration): Use underlying type + of Indic_Typ. + (Constrain_Array): Ditto for T. + +2022-05-17 Arnaud Charlet <charlet@adacore.com> + + * sem_attr.adb (Analyze_Attribute [Attribute_Reduce]): Allow + 'Reduce for Ada 2022 and above. + * sem_attr.ads (Attribute_Impl_Def): 'Reduce is no longer + implementation defined. + +2022-05-17 Ghjuvan Lacambre <lacambre@adacore.com> + + * exp_ch9.adb (Expand_N_Asynchronous_Select): Don't generate + Abort_Undefers when not Abort_Allowed. + +2022-05-17 Marc Poulhiès <poulhies@adacore.com> + + * exp_ch7.adb: Fix typo. + +2022-05-17 Etienne Servais <servais@adacore.com> + + * lib.ads: initialize `Compiler_State` to `Parsing`. + +2022-05-17 Eric Botcazou <ebotcazou@adacore.com> + + * sem_ch13.adb (Has_Compatible_Representation): Return true for + derived untagged record types without representation clause. + +2022-05-17 Eric Botcazou <ebotcazou@adacore.com> + + * sem_ch13.ads (Has_Compatible_Representation): Minor tweaks. + * sem_ch13.adb (Has_Compatible_Representation): Look directly into + the (implementation) base types and simplifiy accordingly. + * exp_ch5.adb (Change_Of_Representation): Adjust. + * exp_ch6.adb (Expand_Actuals): Likewise. + +2022-05-17 Etienne Servais <servais@adacore.com> + + * sem_ch5.adb (Analyze_Assignment): Remove superfluous call to + Original_Node. + +2022-05-17 Javier Miranda <miranda@adacore.com> + + * freeze.adb (Freeze_Entity): Protect the call to + Declaration_Node against entities of expressions replaced by the + frontend with an N_Raise_CE node. + +2022-05-17 Javier Miranda <miranda@adacore.com> + + * freeze.adb (Build_DTW_Spec): Do not inherit the not-overriding + indicator because the DTW wrapper overrides its wrapped + subprogram. + * contracts.ads (Make_Class_Precondition_Subps): Adding + documentation. + +2022-05-17 Eric Botcazou <ebotcazou@adacore.com> + + * exp_ch13.adb (Expand_N_Freeze_Entity): Delete freeze nodes for + subprograms only if they have no actions. + * exp_ch6.adb (Freeze_Subprogram): Put the actions into the Actions + field of the freeze node instead of inserting them after it. + * sem_elab.adb (Is_SPARK_Semantic_Target): Fix typo in comment. + * gcc-interface/trans.cc (process_freeze_entity): Return early for + freeze nodes of subprograms with Interface_Alias set. + +2022-05-17 Javier Miranda <miranda@adacore.com> + + * contracts.adb (Build_Call_Helper_Body): Improve handling of + the case of a (legal) non-dispatching call to an abstract + subprogram. + +2022-05-17 Piotr Trojanek <trojanek@adacore.com> + + * doc/gnat_rm/implementation_defined_attributes.rst + (Loop_Entry): Mention pragmas Assert, Assert_And_Cut and Assume; + refill. + * gnat_rm.texi: Regenerate. + +2022-05-17 Etienne Servais <servais@adacore.com> + + * par-ch3.adb (P_Access_Type_Definition): Outputs an error if + token is not "access". + +2022-05-17 Piotr Trojanek <trojanek@adacore.com> + + * exp_ch2.adb (Expand_Current_Value): Remove special case for + references immediately within pragma argument associations. + * exp_prag.adb (Expand_Pragma_Inspection_Point): Remove special + case for privals. + +2022-05-16 Eric Botcazou <ebotcazou@adacore.com> + + * sem_ch7.adb (Inspect_Untagged_Record_Completion): Also move the + equality operator on the homonym chain if there is another equality + operator in the private part. + +2022-05-16 Piotr Trojanek <trojanek@adacore.com> + + * exp_attr.adb (Expand_Loop_Entry_Attribute): Disable value + propagation when analysing the constant that holds the + Loop_Entry prefix value. + +2022-05-16 Piotr Trojanek <trojanek@adacore.com> + + * sem_attr.adb (Address_Checks): Remove call to + Kill_Current_Values for subprogram entities, because this + routine only does something for object entities. + +2022-05-16 Justin Squirek <squirek@adacore.com> + + * exp_ch7.adb (Build_Finalizer): Disable late evaluation of + postconditions for functions returning types which where + Has_Unconstrained_Elements is true or are unconstrained arrays. + +2022-05-16 Etienne Servais <servais@adacore.com> + + * exp_ch4.adb (Expand_N_Qualified_Expression): Freeze + Target_Type. + +2022-05-16 Yannick Moy <moy@adacore.com> + + * libgnat/s-aridou.adb (Double_Divide): Add intermediate + assertions. + +2022-05-16 Ghjuvan Lacambre <lacambre@adacore.com> + + * lib-writ.adb (Output_CUDA_Symbols): Check for null packages. + +2022-05-16 Joel Brobecker <brobecker@adacore.com> + + * libgnat/g-debpoo.ads: Improve documentation of the + Stack_Trace_Depth parameter. + +2022-05-16 Joel Brobecker <brobecker@adacore.com> + + * init.c (__gnat_install_handler) [__QNX__]: Save sigaction's + return value in err before checking err's value. Fix incorrect + signal names in perror messages. + +2022-05-16 Joel Brobecker <brobecker@adacore.com> + + * init.c (__gnat_install_handler) [__QNX__]: Set + act.sa_sigaction rather than act.sa_handler. + +2022-05-16 Joel Brobecker <brobecker@adacore.com> + + * cstreams.c: Add <stdlib.h> #include. + +2022-05-16 Joel Brobecker <brobecker@adacore.com> + + * terminals.c: Remove bzero #define on HP/UX or Solaris + platforms. + (child_setup_tty): Replace bzero call by equivalent call to + memset. + +2022-05-16 Gary Dismukes <dismukes@adacore.com> + + * sem_util.ads (Storage_Model_Support): Revise comments on most + operations within this nested package to reflect that they can + now be passed either a type that has aspect Storage_Model_Type + or an object of such a type. Change the names of the relevant + formals to SM_Obj_Or_Type. Also, add more precise semantic + descriptions in some cases, and declare the subprograms in a + more logical order. + * sem_util.adb (Storage_Model_Support.Storage_Model_Object): Add + an assertion that the type must specify aspect + Designated_Storage_Model, rather than returning Empty when it + doesn't specify that aspect. + (Storage_Model_Support.Storage_Model_Type): Add an assertion + that formal must be an object whose type specifies aspect + Storage_Model_Type, rather than returning Empty for when it + doesn't have such a type (and test Has_Storage_Model_Type_Aspect + rather than Find_Value_Of_Aspect). + (Storage_Model_Support.Get_Storage_Model_Type_Entity): Allow + both objects and types, and add an assertion that the type (or + the type of the object) has a value for aspect + Storage_Model_Type. + +2022-05-16 Etienne Servais <servais@adacore.com> + + * checks.adb (Apply_Arithmetic_Overflow_Minimized_Eliminated): + Fix condition to return. + +2022-05-16 Yannick Moy <moy@adacore.com> + + * inline.adb (Can_Be_Inlined_In_GNATprove_Mode): Update comment. + +2022-05-16 Marc Poulhiès <poulhies@adacore.com> + + * sem_aggr.adb (Resolve_Iterated_Association): Create scope + around N_Iterated_Element_Association handling. Analyze a copy + of the Loop_Parameter_Specification. Call Analyze instead + Analyze_* to be more homogeneous. + (Sem_Ch5): Remove now unused package. + +2022-05-16 Eric Botcazou <ebotcazou@adacore.com> + + * exp_util.adb (Insert_Actions) <N_Iterated_Component_Association>: + Climb up out of the node if the actions come from Discrete_Choices. + +2022-05-16 Javier Miranda <miranda@adacore.com> + + * sem_disp.adb (Check_Dispatching_Context): When checking to see + whether an expression occurs in a class-wide pre/post-condition, + also check for the possibility that it occurs in a class-wide + preconditions subprogram that was introduced as part of + expansion. Without this fix, some legal calls occuring in + class-wide preconditions may be incorrectly flagged as violating + the "a call to an abstract subprogram must be dispatching" rule. + +2022-05-16 Eric Botcazou <ebotcazou@adacore.com> + + * inline.adb (Cleanup_Scopes): Test the underlying type. + +2022-05-16 Eric Botcazou <ebotcazou@adacore.com> + + * sem_util.ads (Is_Entity_Of_Quantified_Expression): Declare. + * sem_util.adb (Is_Entity_Of_Quantified_Expression): New + predicate. + (New_Copy_Tree): Deal with all entities of quantified + expressions. + * sem_ch13.adb (Build_Predicate_Functions): Get rid of + superfluous tree copying and remove obsolete code. + * sem_ch6.adb (Fully_Conformant_Expressions): Deal with all + entities of quantified expressions. + +2022-05-16 Steve Baird <baird@adacore.com> + + * exp_ch7.adb (Build_Finalize_Statements): Add Last_POC_Call + variable to keep track of the last "early finalization" call + generated for type extension's finalization procedure. If + non-empty, then this will indicate the point at which to insert + the call to the parent type's finalization procedure. Modify + nested function Process_Component_List_For_Finalize to set this + variable (and avoid setting it during a recursive call). If + Last_POC_Call is empty, then insert the parent finalization call + before, rather than after, the finalization code for the + extension components. + +2022-05-16 Eric Botcazou <ebotcazou@adacore.com> + + * einfo-utils.adb (Remove_Entity): Fix couple of oversights. + * exp_ch3.adb (Is_User_Defined_Equality): Delete. + (User_Defined_Eq): Call Get_User_Defined_Equality. + (Make_Eq_Body): Likewise. + (Predefined_Primitive_Eq_Body): Call Is_User_Defined_Equality. + * exp_ch4.adb (Build_Eq_Call): Call Get_User_Defined_Equality. + (Is_Equality): Delete. + (User_Defined_Primitive_Equality_Op): Likewise. + (Find_Aliased_Equality): Call Is_User_Defined_Equality. + (Expand_N_Op_Eq): Call Underlying_Type unconditionally. + Do not implement AI12-0101 + AI05-0123 here. + (Expand_Set_Membership): Call Resolve_Membership_Equality. + * exp_ch6.adb (Expand_Call_Helper): Remove obsolete code. + * sem_aux.ads (Is_Record_Or_Limited_Type): Delete. + * sem_aux.adb (Is_Record_Or_Limited_Type): Likewise. + * sem_ch4.ads (Nondispatching_Call_To_Abstract_Operation): Declare. + * sem_ch4.adb (Analyze_Call): Call Call_Abstract_Operation. + (Analyze_Membership_Op): Call Resolve_Membership_Equality. + (Nondispatching_Call_To_Abstract_Operation): New procedure. + (Remove_Abstract_Operations): Call it. + * sem_ch6.adb (Check_Untagged_Equality): Remove obsolete error and + call Is_User_Defined_Equality. + * sem_ch7.adb (Inspect_Untagged_Record_Completion): New procedure + implementing AI12-0101 + AI05-0123. + (Analyze_Package_Specification): Call it. + (Declare_Inherited_Private_Subprograms): Minor tweak. + (Uninstall_Declarations): Likewise. + * sem_disp.adb (Check_Direct_Call): Adjust to new implementation + of Is_User_Defined_Equality. + * sem_res.ads (Resolve_Membership_Equality): Declare. + * sem_res.adb (Resolve): Replace direct error handling with call to + Nondispatching_Call_To_Abstract_Operation + (Resolve_Call): Likewise. + (Resolve_Equality_Op): Likewise. mplement AI12-0413. + (Resolve_Membership_Equality): New procedure. + (Resolve_Membership_Op): Call Get_User_Defined_Equality. + * sem_util.ads (Get_User_Defined_Eq): Rename into... + (Get_User_Defined_Equality): ...this. + * sem_util.adb (Get_User_Defined_Eq): Rename into... + (Get_User_Defined_Equality): ...this. Call Is_User_Defined_Equality. + (Is_User_Defined_Equality): Also check the profile but remove tests + on Comes_From_Source and Parent. + * sinfo.ads (Generic_Parent_Type): Adjust field description. + * uintp.ads (Ubool): Invoke user-defined equality in predicate. + +2022-05-16 Piotr Trojanek <trojanek@adacore.com> + + * exp_ch3.adb (User_Defined_Eq): Replace duplicated code with a + call to Get_User_Defined_Eq. + +2022-05-16 Piotr Trojanek <trojanek@adacore.com> + + * exp_ch3.adb (Build_Untagged_Equality): Exit early when the + outcome of a loop is already known. + +2022-05-16 Olivier Hainque <hainque@adacore.com> + + * Makefile.rtl: Add aarch64 to the list of CPUs for which + GNATLIB_SHARED maps to gnatlib-shared-dual for vxworks7r2. + +2022-05-16 Eric Botcazou <ebotcazou@adacore.com> + + * sem_ch4.adb (Analyze_Negation): Minor tweak. + (Analyze_Unary_Op): Likewise. + +2022-05-16 Eric Botcazou <ebotcazou@adacore.com> + + * exp_ch3.adb (Build_Assignment): Adjust to the new definition of + Incomplete_View field. + * sem_ch10.ads (Decorate_Type): Declare. + * sem_ch10.adb (Decorate_Type): Move to library level. + (Install_Limited_With_Clause): In the already analyzed case, also + deal with incomplete type declarations present in the sources and + simplify the replacement code. + (Build_Shadow_Entity): Deal with swapped views in package body. + (Restore_Chain_For_Shadow): Deal with incomplete type declarations + present in the sources. + * sem_ch3.adb (Analyze_Full_Type_Declaration): Adjust to the new + definition of Incomplete_View field. + (Build_Incomplete_Type_Declaration): Small consistency tweak. + Set the incomplete type as the Incomplete_View of the full type. + If the scope is a package with a limited view, build a shadow + entity for the incomplete type. + * sem_ch6.adb (Analyze_Subprogram_Body_Helper): When replacing + the limited view of a CW type as designated type of an anonymous + access return type, get to the CW type of the incomplete view of + the tagged type, if any. + (Collect_Primitive_Operations): Adjust to the new definition of + Incomplete_View field. + * sinfo.ads (Incomplete_View): Denote the entity itself instead + of its declaration. + * sem_util.adb: Remove call to Defining_Entity. + +2022-05-16 Piotr Trojanek <trojanek@adacore.com> + + * sem_util.adb (Type_Or_Variable_Has_Enabled_Property): Given a + subtype recurse into its base type. + +2022-05-16 Piotr Trojanek <trojanek@adacore.com> + + * sem_util.adb (Type_Or_Variable_Has_Enabled_Property): Clarify. + +2022-05-16 Piotr Trojanek <trojanek@adacore.com> + + * sem_util.adb (Is_Enabled): Remove; use Is_Enabled_Pragma + instead. + +2022-05-16 Martin Liska <mliska@suse.cz> + + * locales.c (iso_639_1_to_639_3): Use ARRAY_SIZE. + (language_name_to_639_3): Likewise. + (country_name_to_3166): Likewise. + 2022-05-13 Alexandre Oliva <oliva@adacore.com> * gcc-interface/decl.cc (is_cplusplus_method): Build proper diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index 0394d96..ed3d334 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -416,6 +416,7 @@ GNATRTL_NONTASKING_OBJS= \ g-arrspl$(objext) \ g-awk$(objext) \ g-binenv$(objext) \ + g-binsea$(objext) \ g-brapre$(objext) \ g-bubsor$(objext) \ g-busora$(objext) \ @@ -450,6 +451,7 @@ GNATRTL_NONTASKING_OBJS= \ g-exptty$(objext) \ g-flocon$(objext) \ g-forstr$(objext) \ + g-gfmafu$(objext) \ g-graphs$(objext) \ g-heasor$(objext) \ g-hesora$(objext) \ @@ -737,6 +739,7 @@ GNATRTL_NONTASKING_OBJS= \ s-regpat$(objext) \ s-resfil$(objext) \ s-restri$(objext) \ + s-retsta$(objext) \ s-rident$(objext) \ s-rpc$(objext) \ s-scaval$(objext) \ @@ -896,7 +899,7 @@ ATOMICS_TARGET_PAIRS = \ ATOMICS_BUILTINS_TARGET_PAIRS = \ s-atocou.adb<libgnat/s-atocou__builtin.adb -# Special version of units for x86 and x86-64 platforms. +# Special version of units for x86 and x86-64 platforms X86_TARGET_PAIRS = \ a-nuauco.ads<libgnat/a-nuauco__x86.ads \ @@ -906,7 +909,14 @@ X86_64_TARGET_PAIRS = \ a-nuauco.ads<libgnat/a-nuauco__x86.ads \ s-atocou.adb<libgnat/s-atocou__builtin.adb -# Implementation of symbolic traceback based on dwarf +# Special version of units for platforms with SIMD math functions + +SIMD_PATH_TARGET_PAIRS = \ + a-nalofl.ads<libgnat/a-nalofl__simd.ads \ + a-nuaufl.ads<libgnat/a-nuaufl__simd.ads + +# Implementation of symbolic traceback based on DWARF + TRASYM_DWARF_UNIX_PAIRS = \ s-trasym.adb<libgnat/s-trasym__dwarf.adb \ s-mmosin.ads<libgnat/s-mmosin__unix.ads \ @@ -918,13 +928,18 @@ TRASYM_DWARF_MINGW_PAIRS = \ s-mmosin.ads<libgnat/s-mmosin__mingw.ads \ s-mmosin.adb<libgnat/s-mmosin__mingw.adb -TRASYM_DWARF_COMMON_OBJS = s-objrea$(objext) s-dwalin$(objext) s-mmap$(objext) \ +TRASYM_DWARF_COMMON_OBJS = \ + s-objrea$(objext) \ + s-dwalin$(objext) \ + s-mmap$(objext) \ s-mmosin$(objext) TRASYM_DWARF_UNIX_OBJS = $(TRASYM_DWARF_COMMON_OBJS) s-mmauni$(objext) TRASYM_DWARF_MINGW_OBJS = $(TRASYM_DWARF_COMMON_OBJS) +# Support for 128-bit types + GNATRTL_128BIT_PAIRS = \ a-decima.ads<libgnat/a-decima__128.ads \ a-tideio.adb<libgnat/a-tideio__128.adb \ @@ -943,7 +958,6 @@ GNATRTL_128BIT_PAIRS = \ s-scaval.ads<libgnat/s-scaval__128.ads \ s-scaval.adb<libgnat/s-scaval__128.adb -# Objects needed for 128-bit types GNATRTL_128BIT_OBJS = \ s-arit128$(objext) \ s-casi128$(objext) \ @@ -1492,12 +1506,11 @@ ifeq ($(strip $(filter-out arm% linux-androideabi,$(target_cpu) $(target_os))),) LIBRARY_VERSION := $(LIB_VERSION) endif -# AARCH64 QNX -ifeq ($(strip $(filter-out aarch64 %qnx,$(target_cpu) $(target_os))),) +# ARM and AARCH64 QNX +ifeq ($(strip $(filter-out arm aarch64 %qnx,$(target_cpu) $(target_os))),) LIBGNAT_TARGET_PAIRS = \ a-intnam.ads<libgnarl/a-intnam__qnx.ads \ a-nallfl.ads<libgnat/a-nallfl__wraplf.ads \ - s-dorepr.adb<libgnat/s-dorepr__fma.adb \ s-inmaop.adb<libgnarl/s-inmaop__posix.adb \ s-intman.adb<libgnarl/s-intman__qnx.adb \ s-osinte.adb<libgnarl/s-osinte__qnx.adb \ @@ -1510,21 +1523,32 @@ ifeq ($(strip $(filter-out aarch64 %qnx,$(target_cpu) $(target_os))),) g-soliop.ads<libgnat/g-soliop__qnx.ads \ $(ATOMICS_TARGET_PAIRS) \ $(ATOMICS_BUILTINS_TARGET_PAIRS) \ - $(GNATRTL_128BIT_PAIRS) \ - system.ads<libgnat/system-qnx-aarch64.ads + system.ads<libgnat/system-qnx-arm.ads TOOLS_TARGET_PAIRS = indepsw.adb<indepsw-gnu.adb - EXTRA_GNATRTL_NONTASKING_OBJS = $(GNATRTL_128BIT_OBJS) EXTRA_GNATRTL_TASKING_OBJS=s-qnx.o - EXTRA_LIBGNAT_OBJS+=sigtramp-qnx.o + ifeq ($(strip $(filter-out arm%, $(target_cpu))),) + EH_MECHANISM=-arm + SIGTRAMP_OBJ=sigtramp-arm-qnx.o + else + EH_MECHANISM=-gcc + SIGTRAMP_OBJ=sigtramp-qnx.o + # "fma*" instructions not available for ARM fpu=vfpv3 + # but not an issue on AARCH64. + LIBGNAT_TARGET_PAIRS += \ + s-dorepr.adb<libgnat/s-dorepr__fma.adb + LIBGNAT_TARGET_PAIRS += $(GNATRTL_128BIT_PAIRS) + EXTRA_GNATRTL_NONTASKING_OBJS = $(GNATRTL_128BIT_OBJS) + # Temporarily restrict shared library build to aarch64 (V303-025) + GNATLIB_SHARED = gnatlib-shared-dual + endif + EXTRA_LIBGNAT_OBJS+=$(SIGTRAMP_OBJ) EXTRA_LIBGNAT_SRCS+=sigtramp.h - EH_MECHANISM=-gcc SO_OPTS= -shared-libgcc -Wl,-soname, MISCLIB= -lsocket THREADSLIB= - GNATLIB_SHARED = gnatlib-shared-dual LIBRARY_VERSION := $(LIB_VERSION) endif @@ -2613,6 +2637,7 @@ ifeq ($(strip $(filter-out %x86_64 linux%,$(target_cpu) $(target_os))),) s-tsmona.adb<libgnat/s-tsmona__linux.adb \ $(ATOMICS_TARGET_PAIRS) \ $(X86_64_TARGET_PAIRS) \ + $(SIMD_PATH_TARGET_PAIRS) \ $(GNATRTL_128BIT_PAIRS) \ system.ads<libgnat/system-linux-x86.ads @@ -2657,6 +2682,7 @@ ifeq ($(strip $(filter-out %x32 linux%,$(target_cpu) $(target_os))),) s-tsmona.adb<libgnat/s-tsmona__linux.adb \ $(ATOMICS_TARGET_PAIRS) \ $(X86_64_TARGET_PAIRS) \ + $(SIMD_PATH_TARGET_PAIRS) \ $(GNATRTL_128BIT_PAIRS) \ system.ads<libgnat/system-linux-x86.ads @@ -2854,7 +2880,7 @@ endif # Turn on shared gnatlib for specific vx7r2 targets for RTP runtimes. Once # all targets are ported the target_cpu selector can be removed. -ifeq ($(strip $(filter-out vxworks7r2 powerpc64 x86_64 rtp rtp-smp, $(target_os) $(target_cpu) $(THREAD_KIND))),) +ifeq ($(strip $(filter-out vxworks7r2 powerpc64 x86_64 aarch64 rtp rtp-smp, $(target_os) $(target_cpu) $(THREAD_KIND))),) GNATLIB_SHARED = gnatlib-shared-dual LIBRARY_VERSION := $(LIB_VERSION) endif diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index a5fba5d..bcc8822 100644 --- a/gcc/ada/ali.adb +++ b/gcc/ada/ali.adb @@ -2079,7 +2079,15 @@ package body ALI is -- Processing for SS elsif C = 'S' then - Opt.Sec_Stack_Used := True; + -- Special case: a-tags.ali by itself should not set + -- Sec_Stack_Used, only if other code uses the secondary + -- stack should we set this flag. This ensures that we do + -- not bring the secondary stack unnecessarily when using + -- Ada.Tags and not actually using the secondary stack. + + if Get_Name_String (F) /= "a-tags.ali" then + Opt.Sec_Stack_Used := True; + end if; -- Invalid switch starting with S diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index 3558708..3b55cc9 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -80,12 +80,6 @@ package body Bindgen is -- domains just before calling the main procedure from the environment -- task. - System_Secondary_Stack_Package_In_Closure : Boolean := False; - -- Flag indicating whether the unit System.Secondary_Stack is in the - -- closure of the partition. This is set by Resolve_Binder_Options, and - -- is used to initialize the package in cases where the run-time brings - -- in package but the secondary stack is not used. - System_Tasking_Restricted_Stages_Used : Boolean := False; -- Flag indicating whether the unit System.Tasking.Restricted.Stages is in -- the closure of the partition. This is set by Resolve_Binder_Options, @@ -612,33 +606,27 @@ package body Bindgen is """__gnat_initialize_stack_limit"");"); end if; - if System_Secondary_Stack_Package_In_Closure then - -- System.Secondary_Stack is in the closure of the program - -- because the program uses the secondary stack or the restricted - -- run-time is unconditionally calling SS_Init. In both cases, - -- SS_Init needs to know the number of secondary stacks created by - -- the binder. - + if Num_Sec_Stacks > 0 then WBI (" Binder_Sec_Stacks_Count : Natural;"); WBI (" pragma Import (Ada, Binder_Sec_Stacks_Count, " & """__gnat_binder_ss_count"");"); WBI (""); + end if; - -- Import secondary stack pool variables if the secondary stack - -- used. They are not referenced otherwise. + -- Import secondary stack pool variables if the secondary stack is + -- used. They are not referenced otherwise. - if Sec_Stack_Used then - WBI (" Default_Secondary_Stack_Size : " & - "System.Parameters.Size_Type;"); - WBI (" pragma Import (C, Default_Secondary_Stack_Size, " & - """__gnat_default_ss_size"");"); + if Sec_Stack_Used then + WBI (" Default_Secondary_Stack_Size : " & + "System.Parameters.Size_Type;"); + WBI (" pragma Import (C, Default_Secondary_Stack_Size, " & + """__gnat_default_ss_size"");"); - WBI (" Default_Sized_SS_Pool : System.Address;"); - WBI (" pragma Import (Ada, Default_Sized_SS_Pool, " & - """__gnat_default_ss_pool"");"); + WBI (" Default_Sized_SS_Pool : System.Address;"); + WBI (" pragma Import (Ada, Default_Sized_SS_Pool, " & + """__gnat_default_ss_pool"");"); - WBI (""); - end if; + WBI (""); end if; WBI (" begin"); @@ -686,46 +674,36 @@ package body Bindgen is -- Generate the default-sized secondary stack pool if the secondary -- stack is used by the program. - if System_Secondary_Stack_Package_In_Closure then - if Sec_Stack_Used then - -- Elaborate the body of the binder to initialize the default- - -- sized secondary stack pool. - - WBI (""); - WBI (" " & Get_Ada_Main_Name & "'Elab_Body;"); - - -- Generate the default-sized secondary stack pool and set the - -- related secondary stack globals. + if Sec_Stack_Used then + -- Elaborate the body of the binder to initialize the default- + -- sized secondary stack pool. - Set_String (" Default_Secondary_Stack_Size := "); + WBI (""); + WBI (" " & Get_Ada_Main_Name & "'Elab_Body;"); - if Opt.Default_Sec_Stack_Size /= Opt.No_Stack_Size then - Set_Int (Opt.Default_Sec_Stack_Size); - else - Set_String - ("System.Parameters.Runtime_Default_Sec_Stack_Size"); - end if; + -- Generate the default-sized secondary stack pool and set the + -- related secondary stack globals. - Set_Char (';'); - Write_Statement_Buffer; + Set_String (" Default_Secondary_Stack_Size := "); - Set_String (" Binder_Sec_Stacks_Count := "); - Set_Int (Num_Sec_Stacks); - Set_Char (';'); - Write_Statement_Buffer; + if Opt.Default_Sec_Stack_Size /= Opt.No_Stack_Size then + Set_Int (Opt.Default_Sec_Stack_Size); + else + Set_String + ("System.Parameters.Runtime_Default_Sec_Stack_Size"); + end if; - WBI (" Default_Sized_SS_Pool := " & - "Sec_Default_Sized_Stacks'Address;"); - WBI (""); + Set_Char (';'); + Write_Statement_Buffer; - else - -- The presence of System.Secondary_Stack in the closure of the - -- program implies the restricted run-time is unconditionally - -- calling SS_Init. Let SS_Init know that no stacks were - -- created. + Set_String (" Binder_Sec_Stacks_Count := "); + Set_Int (Num_Sec_Stacks); + Set_Char (';'); + Write_Statement_Buffer; - WBI (" Binder_Sec_Stacks_Count := 0;"); - end if; + WBI (" Default_Sized_SS_Pool := " & + "Sec_Default_Sized_Stacks'Address;"); + WBI (""); end if; -- Normal case (standard library not suppressed). Set all global values @@ -3276,12 +3254,6 @@ package body Bindgen is Check_Package (System_Restrictions_Used, "system.restrictions%s"); - -- Ditto for the use of System.Secondary_Stack - - Check_Package - (System_Secondary_Stack_Package_In_Closure, - "system.secondary_stack%s"); - -- Ditto for use of an SMP bareboard runtime Check_Package (System_BB_CPU_Primitives_Multiprocessors_Used, diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 9950c18..14f4f95 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -1237,11 +1237,16 @@ package body Checks is -- ops, but if they appear in an assignment or similar contexts -- there is no overflow check that starts from that parent node, -- so apply check now. + -- Similarly, if these expressions are nested, we should go on. if Nkind (P) in N_If_Expression | N_Case_Expression and then not Is_Signed_Integer_Arithmetic_Op (Parent (P)) then null; + elsif Nkind (P) in N_If_Expression | N_Case_Expression + and then Nkind (Op) in N_If_Expression | N_Case_Expression + then + null; else return; end if; diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb index 7ce3cfa..9463642 100644 --- a/gcc/ada/contracts.adb +++ b/gcc/ada/contracts.adb @@ -3899,7 +3899,16 @@ package body Contracts is Set_Corresponding_Body (Helper_Decl, Body_Id); Set_Must_Override (Body_Spec, False); - if Present (Class_Preconditions (Subp_Id)) then + if Present (Class_Preconditions (Subp_Id)) + -- Evaluate the expression if we are building a dynamic helper + -- or we are building a static helper for a non-abstract tagged + -- type; for abstract tagged types the helper just returns True + -- since it is called by the indirect call wrapper (ICW). + and then + (Is_Dynamic + or else + not Is_Abstract_Type (Find_Dispatching_Type (Subp_Id))) + then Return_Expr := Copy_And_Update_References (Class_Preconditions (Subp_Id)); @@ -3910,7 +3919,8 @@ package body Contracts is -- enabled. else - pragma Assert (Present (Ignored_Class_Preconditions (Subp_Id))); + pragma Assert (Present (Ignored_Class_Preconditions (Subp_Id)) + or else Is_Abstract_Type (Find_Dispatching_Type (Subp_Id))); Return_Expr := New_Occurrence_Of (Standard_True, Loc); end if; diff --git a/gcc/ada/contracts.ads b/gcc/ada/contracts.ads index adbb0e6..5178373 100644 --- a/gcc/ada/contracts.ads +++ b/gcc/ada/contracts.ads @@ -226,6 +226,39 @@ package Contracts is -- overrides an inherited class-wide precondition (see AI12-0195-1). -- Late_Overriding enables special handling required for late-overriding -- subprograms. + -- + -- For example, if we have a subprogram with the following profile: + -- + -- procedure Prim (Obj : TagTyp; <additional formals>) + -- with Pre'Class => F1 (Obj) and F2(Obj) + -- + -- We build the following helper that evaluates statically the class-wide + -- precondition: + -- + -- function PrimSP (Obj : TagTyp) return Boolean is + -- begin + -- return F1 (Obj) and F2(Obj); + -- end PrimSP; + -- + -- ... and the following helper that evaluates dynamically the class-wide + -- precondition: + -- + -- function PrimDP (Obj : TagTyp'Class; ...) return Boolean is + -- begin + -- return F1 (Obj) and F2(Obj); + -- end PrimSP; + -- + -- ... and the following indirect-call wrapper (ICW) that is used by the + -- code generated by the compiler for indirect calls: + -- + -- procedure PrimICW (Obj : TagTyp; <additional formals> is + -- begin + -- if not PrimSP (Obj) then + -- $raise_assert_failure ("failed precondition in call at ..."); + -- end if; + -- + -- Prim (Obj, ...); + -- end Prim; procedure Merge_Class_Conditions (Spec_Id : Entity_Id); -- Merge and preanalyze all class-wide conditions of Spec_Id (class-wide diff --git a/gcc/ada/cstreams.c b/gcc/ada/cstreams.c index e714162..48f996d 100644 --- a/gcc/ada/cstreams.c +++ b/gcc/ada/cstreams.c @@ -46,6 +46,7 @@ #include <sys/types.h> #include <sys/stat.h> #include <unistd.h> +#include <stdlib.h> #ifdef _AIX /* needed to avoid conflicting declarations */ diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 8a0ba021..a03c88d 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -156,7 +156,7 @@ package body Debug is -- d_o -- d_p Ignore assertion pragmas for elaboration -- d_q - -- d_r + -- d_r Disable the use of the return slot in functions -- d_s Stop elaboration checks on synchronous suspension -- d_t In LLVM-based CCG, dump LLVM IR after transformations are done -- d_u In LLVM-based CCG, dump flows @@ -993,6 +993,11 @@ package body Debug is -- semantics of invariants and postconditions in both the static and -- dynamic elaboration models. + -- d_r The compiler does not make use of the return slot in the expansion + -- of functions returning a by-reference type. If this use is required + -- for these functions to return on the primary stack, then they are + -- changed to return on the secondary stack instead. + -- d_s The compiler stops the examination of a task body once it reaches -- a call to routine Ada.Synchronous_Task_Control.Suspend_Until_True -- or Ada.Synchronous_Barriers.Wait_For_Release. diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_attributes.rst b/gcc/ada/doc/gnat_rm/implementation_defined_attributes.rst index dc5a1ab..1b4f4fe 100644 --- a/gcc/ada/doc/gnat_rm/implementation_defined_attributes.rst +++ b/gcc/ada/doc/gnat_rm/implementation_defined_attributes.rst @@ -629,10 +629,13 @@ to the value an expression had upon entry to the subprogram. The relevant loop is either identified by the given loop name, or it is the innermost enclosing loop when no loop name is given. -A ``Loop_Entry`` attribute can only occur within a -``Loop_Variant`` or ``Loop_Invariant`` pragma. A common use of -``Loop_Entry`` is to compare the current value of objects with their -initial value at loop entry, in a ``Loop_Invariant`` pragma. +A ``Loop_Entry`` attribute can only occur within an ``Assert``, +``Assert_And_Cut``, ``Assume``, ``Loop_Variant`` or ``Loop_Invariant`` pragma. +In addition, such a pragma must be one of the items in the sequence +of statements of a loop body, or nested inside block statements that +appear in the sequence of statements of a loop body. +A common use of ``Loop_Entry`` is to compare the current value of objects with +their initial value at loop entry, in a ``Loop_Invariant`` pragma. The effect of using ``X'Loop_Entry`` is the same as declaring a constant initialized with the initial value of ``X`` at loop diff --git a/gcc/ada/doc/gnat_rm/the_gnat_library.rst b/gcc/ada/doc/gnat_rm/the_gnat_library.rst index abc848c..72ec5e6 100644 --- a/gcc/ada/doc/gnat_rm/the_gnat_library.rst +++ b/gcc/ada/doc/gnat_rm/the_gnat_library.rst @@ -721,6 +721,18 @@ Provides AWK-like parsing functions, with an easy interface for parsing one or more files containing formatted data. The file is viewed as a database where each record is a line and a field is a data element in this line. +.. _`GNAT.Binary_Search_(g-binsea.ads)`: + +``GNAT.Binary_Search`` (:file:`g-binsea.ads`) +================================================ + +.. index:: GNAT.Binary_Search (g-binsea.ads) + +.. index:: Binary search + +Allow binary search of a sorted array (or of an array-like container; +the generic does not reference the array directly). + .. _`GNAT.Bind_Environment_(g-binenv.ads)`: ``GNAT.Bind_Environment`` (:file:`g-binenv.ads`) @@ -1290,6 +1302,24 @@ output. Some generic routines are provided to be able to use types derived from Integer, Float or enumerations as values for the formatted string. +.. _`GNAT.Generic_Fast_Math_Functions_(g-gfmafu.ads)`: + +``GNAT.Generic_Fast_Math_Functions`` (:file:`g-gfmafu.ads`) +=========================================================== + +.. index:: GNAT.Generic_Fast_Math_Functions (g-gfmafu.ads) + +.. index:: Mathematical functions + +Provides direct access to the underlying implementation of the common +mathematical functions, generally from the system mathematical library. +This differs from ``Ada.Numerics.Generic_Elementary_Functions`` in that +the implementation may deviate from the semantics specified for these +functions in the Reference Manual, for example ``Numerics.Argument_Error`` +is not raised. On selected platforms, some of these functions may also +have a vector implementation that can be automatically used by the +compiler when auto-vectorization is enabled. + .. _`GNAT.Heap_Sort_(g-heasor.ads)`: ``GNAT.Heap_Sort`` (:file:`g-heasor.ads`) 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 1dd3162..ed6b463 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 @@ -6015,10 +6015,10 @@ Debugging Control :switch:`-gnatx` Normally the compiler generates full cross-referencing information in - the :file:`ALI` file. This information is used by a number of tools, - including ``gnatfind`` and ``gnatxref``. The :switch:`-gnatx` switch - suppresses this information. This saves some space and may slightly - speed up compilation, but means that these tools cannot be used. + the :file:`ALI` file. This information is used by a number of tools. + The :switch:`-gnatx` switch suppresses this information. This saves some space + and may slightly speed up compilation, but means that tools depending + on this information cannot be used. .. index:: -fgnat-encodings (gcc) diff --git a/gcc/ada/doc/gnat_ugn/the_gnat_compilation_model.rst b/gcc/ada/doc/gnat_ugn/the_gnat_compilation_model.rst index 68209bf..3636703 100644 --- a/gcc/ada/doc/gnat_ugn/the_gnat_compilation_model.rst +++ b/gcc/ada/doc/gnat_ugn/the_gnat_compilation_model.rst @@ -1743,8 +1743,7 @@ The following information is contained in the :file:`ALI` file. if any of these units are modified. * Cross-reference data. Contains information on all entities referenced - in the unit. Used by tools like ``gnatxref`` and ``gnatfind`` to - provide cross-reference information. + in the unit. Used by some tools to provide cross-reference information. For a full detailed description of the format of the :file:`ALI` file, see the source of the body of unit ``Lib.Writ``, contained in file @@ -2009,8 +2008,8 @@ be :file:`adalib`). You can also specify a new default path to the run-time library at compilation time with the switch :switch:`--RTS=rts-path`. You can thus choose / change the run-time library you want your program to be compiled with. This switch is -recognized by ``gcc``, ``gnatmake``, ``gnatbind``, -``gnatls``, ``gnatfind`` and ``gnatxref``. +recognized by ``gcc``, ``gnatmake``, ``gnatbind``, ``gnatls``, and all +project aware tools. It is possible to install a library before or after the standard GNAT library, by reordering the lines in the configuration files. In general, a diff --git a/gcc/ada/einfo-utils.adb b/gcc/ada/einfo-utils.adb index 31d261a..48a1bce 100644 --- a/gcc/ada/einfo-utils.adb +++ b/gcc/ada/einfo-utils.adb @@ -2390,53 +2390,6 @@ package body Einfo.Utils is return Empty; end Predicate_Function; - -------------------------- - -- Predicate_Function_M -- - -------------------------- - - function Predicate_Function_M (Id : E) return E is - Subp_Elmt : Elmt_Id; - Subp_Id : Entity_Id; - Subps : Elist_Id; - Typ : Entity_Id; - - begin - pragma Assert (Is_Type (Id)); - - -- If type is private and has a completion, predicate may be defined on - -- the full view. - - if Is_Private_Type (Id) - and then - (not Has_Predicates (Id) or else No (Subprograms_For_Type (Id))) - and then Present (Full_View (Id)) - then - Typ := Full_View (Id); - - else - Typ := Id; - end if; - - Subps := Subprograms_For_Type (Typ); - - if Present (Subps) then - Subp_Elmt := First_Elmt (Subps); - while Present (Subp_Elmt) loop - Subp_Id := Node (Subp_Elmt); - - if Ekind (Subp_Id) = E_Function - and then Is_Predicate_Function_M (Subp_Id) - then - return Subp_Id; - end if; - - Next_Elmt (Subp_Elmt); - end loop; - end if; - - return Empty; - end Predicate_Function_M; - ------------------------- -- Present_In_Rep_Item -- ------------------------- @@ -2520,11 +2473,13 @@ package body Einfo.Utils is elsif Id = First then Set_First_Entity (Scop, Next); + Set_Prev_Entity (Next, Empty); -- Empty <-- First_Entity -- The eliminated entity was the tail of the entity chain elsif Id = Last then Set_Last_Entity (Scop, Prev); + Set_Next_Entity (Prev, Empty); -- Last_Entity --> Empty -- Otherwise the eliminated entity comes from the middle of the entity -- chain. @@ -2877,43 +2832,6 @@ package body Einfo.Utils is end loop; end Set_Predicate_Function; - ------------------------------ - -- Set_Predicate_Function_M -- - ------------------------------ - - procedure Set_Predicate_Function_M (Id : E; V : E) is - Subp_Elmt : Elmt_Id; - Subp_Id : Entity_Id; - Subps : Elist_Id; - - begin - pragma Assert (Is_Type (Id) and then Has_Predicates (Id)); - - Subps := Subprograms_For_Type (Id); - - if No (Subps) then - Subps := New_Elmt_List; - Set_Subprograms_For_Type (Id, Subps); - end if; - - Subp_Elmt := First_Elmt (Subps); - Prepend_Elmt (V, Subps); - - -- Check for a duplicate predication function - - while Present (Subp_Elmt) loop - Subp_Id := Node (Subp_Elmt); - - if Ekind (Subp_Id) = E_Function - and then Is_Predicate_Function_M (Subp_Id) - then - raise Program_Error; - end if; - - Next_Elmt (Subp_Elmt); - end loop; - end Set_Predicate_Function_M; - ----------------- -- Size_Clause -- ----------------- diff --git a/gcc/ada/einfo-utils.ads b/gcc/ada/einfo-utils.ads index f914de7..d830c8d 100644 --- a/gcc/ada/einfo-utils.ads +++ b/gcc/ada/einfo-utils.ads @@ -437,14 +437,12 @@ package Einfo.Utils is function Invariant_Procedure (Id : E) return E; function Partial_Invariant_Procedure (Id : E) return E; function Predicate_Function (Id : E) return E; - function Predicate_Function_M (Id : E) return E; procedure Set_DIC_Procedure (Id : E; V : E); procedure Set_Partial_DIC_Procedure (Id : E; V : E); procedure Set_Invariant_Procedure (Id : E; V : E); procedure Set_Partial_Invariant_Procedure (Id : E; V : E); procedure Set_Predicate_Function (Id : E; V : E); - procedure Set_Predicate_Function_M (Id : E; V : E); --------------- -- Iterators -- diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 9fed73d..b0601a9 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -2599,7 +2599,8 @@ package Einfo is -- test for the need to replace references in Exp_Ch2. -- Is_Entry_Wrapper --- Defined on wrappers created for entries that have precondition aspects +-- Defined on wrappers created for entries that have precondition or +-- postcondition aspects. -- Is_Enumeration_Type (synthesized) -- Defined in all entities, true for enumeration types and subtypes @@ -3105,11 +3106,6 @@ package Einfo is -- Present in functions and procedures. Set for generated predicate -- functions. --- Is_Predicate_Function_M --- Present in functions and procedures. Set for special version of --- predicate function generated for use in membership tests, where --- raise expressions are transformed to return False. - -- Is_Preelaborated -- Defined in all entities, set in E_Package and E_Generic_Package -- entities to which a pragma Preelaborate is applied, and also in @@ -4009,8 +4005,9 @@ package Einfo is -- Defined in all types. Set for types for which (Has_Predicates is True) -- and for which a predicate procedure has been built that tests that the -- specified predicates are True. Contains the entity for the function --- which takes a single argument of the given type, and returns True if --- the predicate holds and False if it does not. +-- which takes a single argument of the given type (and sometimes an +-- additional Boolean parameter), and returns True if the predicate +-- holds and False if it does not. -- -- Note: flag Has_Predicate does not imply that Predicate_Function is set -- to a non-empty entity; this happens, for example, for itypes created @@ -4023,11 +4020,14 @@ package Einfo is -- Note: the reason this is marked as a synthesized attribute is that the -- way this is stored is as an element of the Subprograms_For_Type field. --- Predicate_Function_M (synthesized) --- Defined in all types. Present only if Predicate_Function is present, --- and only if the predicate function has Raise_Expression nodes. It --- is the special version created for membership tests, where if one of --- these raise expressions is executed, the result is to return False. +-- Predicate_Expression +-- Defined on functions. For the defining identifier of the subprogram +-- declaration (not of the subprogram body) of a predicate function, +-- yields the expression for the noninherited portion of the given +-- predicate (except in the case where the inherited portion is +-- non-empty and the non-inherited portion is empty, in which case the +-- expression for the inherited portion is returned). Otherwise yields +-- empty. -- Predicated_Parent -- Defined on itypes created by subtype indications, when the parent @@ -5114,7 +5114,6 @@ package Einfo is -- Partial_DIC_Procedure (synth) -- Partial_Invariant_Procedure (synth) -- Predicate_Function (synth) - -- Predicate_Function_M (synth) -- Root_Type (synth) -- Size_Clause (synth) @@ -5590,7 +5589,6 @@ package Einfo is -- Is_Machine_Code_Subprogram (non-generic case only) -- Is_Partial_Invariant_Procedure (non-generic case only) -- Is_Predicate_Function (non-generic case only) - -- Is_Predicate_Function_M (non-generic case only) -- Is_Primitive -- Is_Primitive_Wrapper (non-generic case only) -- Is_Private_Descendant @@ -5955,7 +5953,6 @@ package Einfo is -- Is_Partial_DIC_Procedure (synth) (non-generic case only) -- Is_Partial_Invariant_Procedure (non-generic case only) -- Is_Predicate_Function (non-generic case only) - -- Is_Predicate_Function_M (non-generic case only) -- Is_Primitive -- Is_Primitive_Wrapper (non-generic case only) -- Is_Private_Descendant diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index bc7c7d3..101aed4 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -896,12 +896,19 @@ package body Errout is -- Error_Msg_GNAT_Extension -- ------------------------------ - procedure Error_Msg_GNAT_Extension (Extension : String) is - Loc : constant Source_Ptr := Token_Ptr; + procedure Error_Msg_GNAT_Extension (Extension : String; Loc : Source_Ptr) is begin if not Extensions_Allowed then - Error_Msg (Extension & " is a 'G'N'A'T specific extension", Loc); - Error_Msg ("\unit must be compiled with -gnatX switch", Loc); + Error_Msg (Extension & " is a 'G'N'A'T-specific extension", Loc); + + if No (Ada_Version_Pragma) then + Error_Msg ("\unit must be compiled with -gnatX " + & "or use pragma Extensions_Allowed (On)", Loc); + else + Error_Msg_Sloc := Sloc (Ada_Version_Pragma); + Error_Msg ("\incompatible with Ada version set#", Loc); + Error_Msg ("\must use pragma Extensions_Allowed (On)", Loc); + end if; end if; end Error_Msg_GNAT_Extension; diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index ff36344..c115a1b 100644 --- a/gcc/ada/errout.ads +++ b/gcc/ada/errout.ads @@ -943,10 +943,11 @@ package Errout is procedure Error_Msg_Ada_2022_Feature (Feature : String; Loc : Source_Ptr); -- Analogous to Error_Msg_Ada_2012_Feature, for Ada 2022 - procedure Error_Msg_GNAT_Extension (Extension : String); + procedure Error_Msg_GNAT_Extension (Extension : String; Loc : Source_Ptr); -- If not operating with extensions allowed, posts errors complaining - -- that Extension is only supported when the -gnatX switch is enabled, - -- with appropriate suggestions to fix it. + -- that Extension is only supported when the -gnatX switch is enabled + -- or pragma Extensions_Allowed (On) is used. Loc indicates the source + -- location of the extension construct. procedure dmsg (Id : Error_Msg_Id) renames Erroutc.dmsg; -- Debugging routine to dump an error message diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads index eaac7dc..be8755b 100644 --- a/gcc/ada/erroutc.ads +++ b/gcc/ada/erroutc.ads @@ -465,7 +465,7 @@ package Erroutc is -- Tests if message buffer ends with given string preceded by a space procedure Buffer_Remove (C : Character); - -- Remove given character fron end of buffer if it is present + -- Remove given character from end of buffer if it is present procedure Buffer_Remove (S : String); -- Removes given string from end of buffer if it is present at end of diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 72f6555..13be987 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -661,10 +661,10 @@ package body Exp_Aggr is declare UI : constant Uint := - Expr_Value (Hi) - Expr_Value (Lo) + 1; + (Expr_Value (Hi) - Expr_Value (Lo) + 1) * Siz; begin if UI_Is_In_Int_Range (UI) then - return Siz * UI_To_Int (UI); + return UI_To_Int (UI); else return Int'Last; end if; @@ -2280,8 +2280,10 @@ package body Exp_Aggr is New_Code : constant List_Id := New_List; - Aggr_L : constant Node_Id := Low_Bound (Aggregate_Bounds (N)); - Aggr_H : constant Node_Id := High_Bound (Aggregate_Bounds (N)); + Aggr_Bounds : constant Range_Nodes := + Get_Index_Bounds (Aggregate_Bounds (N)); + Aggr_L : Node_Id renames Aggr_Bounds.First; + Aggr_H : Node_Id renames Aggr_Bounds.Last; -- The aggregate bounds of this specific subaggregate. Note that if the -- code generated by Build_Array_Aggr_Code is executed then these bounds -- are OK. Otherwise a Constraint_Error would have been raised. @@ -2577,7 +2579,7 @@ package body Exp_Aggr is -- If Typ is derived, and constrains discriminants of the parent type, -- these discriminants are not components of the aggregate, and must be -- initialized. The assignments are appended to List. The same is done - -- if Typ derives fron an already constrained subtype of a discriminated + -- if Typ derives from an already constrained subtype of a discriminated -- parent type. procedure Init_Stored_Discriminants; @@ -5226,6 +5228,11 @@ package body Exp_Aggr is Others_Present := False; if Present (Component_Associations (N)) then + if Is_Empty_List (Component_Associations (N)) then + -- an expanded null array aggregate + return False; + end if; + declare Assoc : Node_Id; Choice : Node_Id; @@ -5914,8 +5921,10 @@ package body Exp_Aggr is ---------------------------- procedure Check_Same_Aggr_Bounds (Sub_Aggr : Node_Id; Dim : Pos) is - Sub_Lo : constant Node_Id := Low_Bound (Aggregate_Bounds (Sub_Aggr)); - Sub_Hi : constant Node_Id := High_Bound (Aggregate_Bounds (Sub_Aggr)); + Sub_Bounds : constant Range_Nodes + := Get_Index_Bounds (Aggregate_Bounds (Sub_Aggr)); + Sub_Lo : Node_Id renames Sub_Bounds.First; + Sub_Hi : Node_Id renames Sub_Bounds.Last; -- The bounds of this specific subaggregate Aggr_Lo : constant Node_Id := Aggr_Low (Dim); @@ -6019,7 +6028,9 @@ package body Exp_Aggr is if Present (Component_Associations (Sub_Aggr)) then Assoc := Last (Component_Associations (Sub_Aggr)); - if Nkind (First (Choice_List (Assoc))) = N_Others_Choice then + if Present (Assoc) + and then Nkind (First (Choice_List (Assoc))) = N_Others_Choice + then Others_Present (Dim) := True; -- An others_clause may be superfluous if previous components @@ -6107,7 +6118,10 @@ package body Exp_Aggr is elsif Present (Expressions (Sub_Aggr)) and then Present (Component_Associations (Sub_Aggr)) then - Need_To_Check := True; + Need_To_Check := + not (Is_Empty_List (Expressions (Sub_Aggr)) + and then Is_Empty_List + (Component_Associations (Sub_Aggr))); elsif Present (Component_Associations (Sub_Aggr)) then Assoc := Last (Component_Associations (Sub_Aggr)); @@ -6666,8 +6680,8 @@ package body Exp_Aggr is -- Save the low and high bounds of the aggregate index as well as -- the index type for later use in checks (b) and (c) below. - Aggr_Low (J) := Low_Bound (Aggr_Index_Range); - Aggr_High (J) := High_Bound (Aggr_Index_Range); + Get_Index_Bounds + (Aggr_Index_Range, L => Aggr_Low (J), H => Aggr_High (J)); Aggr_Index_Typ (J) := Etype (Index_Constraint); @@ -7180,7 +7194,8 @@ package body Exp_Aggr is MX : constant := 80; begin - if Nkind (First (Choice_List (CA))) = N_Others_Choice + if Present (CA) + and then Nkind (First (Choice_List (CA))) = N_Others_Choice and then Nkind (Expression (CA)) = N_Character_Literal and then No (Expressions (N)) then diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index e6d3e74..ad75453 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -26,6 +26,7 @@ with Aspects; use Aspects; with Atree; use Atree; with Checks; use Checks; +with Debug; use Debug; with Einfo; use Einfo; with Einfo.Entities; use Einfo.Entities; with Einfo.Utils; use Einfo.Utils; @@ -1792,23 +1793,30 @@ package body Exp_Attr is Push_Scope (Scope (Loop_Id)); end if; - -- The analysis of the conditional block takes care of the constant - -- declaration. + -- Analyze constant declaration with simple value propagation disabled, + -- because the values at the loop entry might be different than the + -- values at the occurrence of Loop_Entry attribute. - if Present (Result) then - Rewrite (Loop_Stmt, Result); - Analyze (Loop_Stmt); - - -- The conditional block was analyzed when a previous 'Loop_Entry was - -- expanded. There is no point in reanalyzing the block, simply analyze - -- the declaration of the constant. + declare + Save_Debug_Flag_MM : constant Boolean := Debug_Flag_MM; + begin + Debug_Flag_MM := True; - else if Present (Aux_Decl) then Analyze (Aux_Decl); end if; Analyze (Temp_Decl); + + Debug_Flag_MM := Save_Debug_Flag_MM; + end; + + -- If the conditional block has just been created, then analyze it; + -- otherwise it was analyzed when a previous 'Loop_Entry was expanded. + + if Present (Result) then + Rewrite (Loop_Stmt, Result); + Analyze (Loop_Stmt); end if; Rewrite (N, New_Occurrence_Of (Temp_Id, Loc)); @@ -2100,12 +2108,86 @@ package body Exp_Attr is Ref_Object : constant Node_Id := Get_Referenced_Object (Pref); Btyp_DDT : Entity_Id; + procedure Add_Implicit_Interface_Type_Conversion; + -- Ada 2005 (AI-251): The designated type is an interface type; + -- add an implicit type conversion to force the displacement of + -- the pointer to reference the secondary dispatch table. + function Enclosing_Object (N : Node_Id) return Node_Id; -- If N denotes a compound name (selected component, indexed -- component, or slice), returns the name of the outermost such -- enclosing object. Otherwise returns N. If the object is a -- renaming, then the renamed object is returned. + -------------------------------------------- + -- Add_Implicit_Interface_Type_Conversion -- + -------------------------------------------- + + procedure Add_Implicit_Interface_Type_Conversion is + begin + pragma Assert (Is_Interface (Btyp_DDT)); + + -- Handle cases were no action is required. + + if not Comes_From_Source (N) + and then not Comes_From_Source (Ref_Object) + and then (Nkind (Ref_Object) not in N_Has_Chars + or else Chars (Ref_Object) /= Name_uInit) + then + return; + end if; + + -- Common case + + if Nkind (Ref_Object) /= N_Explicit_Dereference then + + -- No implicit conversion required if types match, or if + -- the prefix is the class_wide_type of the interface. In + -- either case passing an object of the interface type has + -- already set the pointer correctly. + + if Btyp_DDT = Etype (Ref_Object) + or else + (Is_Class_Wide_Type (Etype (Ref_Object)) + and then + Class_Wide_Type (Btyp_DDT) = Etype (Ref_Object)) + then + null; + + else + Rewrite (Prefix (N), + Convert_To (Btyp_DDT, + New_Copy_Tree (Prefix (N)))); + + Analyze_And_Resolve (Prefix (N), Btyp_DDT); + end if; + + -- When the object is an explicit dereference, convert the + -- dereference's prefix. + + else + declare + Obj_DDT : constant Entity_Id := + Base_Type + (Directly_Designated_Type + (Etype (Prefix (Ref_Object)))); + begin + -- No implicit conversion required if designated types + -- match. + + if Obj_DDT /= Btyp_DDT + and then not (Is_Class_Wide_Type (Obj_DDT) + and then Etype (Obj_DDT) = Btyp_DDT) + then + Rewrite (N, + Convert_To (Typ, + New_Copy_Tree (Prefix (Ref_Object)))); + Analyze_And_Resolve (N, Typ); + end if; + end; + end if; + end Add_Implicit_Interface_Type_Conversion; + ---------------------- -- Enclosing_Object -- ---------------------- @@ -2390,62 +2472,20 @@ package body Exp_Attr is then Apply_Accessibility_Check (Prefix (Enc_Object), Typ, N); + -- Ada 2005 (AI-251): If the designated type is an interface we + -- add an implicit conversion to force the displacement of the + -- pointer to reference the secondary dispatch table. + + if Is_Interface (Btyp_DDT) then + Add_Implicit_Interface_Type_Conversion; + end if; + -- Ada 2005 (AI-251): If the designated type is an interface we -- add an implicit conversion to force the displacement of the -- pointer to reference the secondary dispatch table. - elsif Is_Interface (Btyp_DDT) - and then (Comes_From_Source (N) - or else Comes_From_Source (Ref_Object) - or else (Nkind (Ref_Object) in N_Has_Chars - and then Chars (Ref_Object) = Name_uInit)) - then - if Nkind (Ref_Object) /= N_Explicit_Dereference then - - -- No implicit conversion required if types match, or if - -- the prefix is the class_wide_type of the interface. In - -- either case passing an object of the interface type has - -- already set the pointer correctly. - - if Btyp_DDT = Etype (Ref_Object) - or else (Is_Class_Wide_Type (Etype (Ref_Object)) - and then - Class_Wide_Type (Btyp_DDT) = Etype (Ref_Object)) - then - null; - - else - Rewrite (Prefix (N), - Convert_To (Btyp_DDT, - New_Copy_Tree (Prefix (N)))); - - Analyze_And_Resolve (Prefix (N), Btyp_DDT); - end if; - - -- When the object is an explicit dereference, convert the - -- dereference's prefix. - - else - declare - Obj_DDT : constant Entity_Id := - Base_Type - (Directly_Designated_Type - (Etype (Prefix (Ref_Object)))); - begin - -- No implicit conversion required if designated types - -- match. - - if Obj_DDT /= Btyp_DDT - and then not (Is_Class_Wide_Type (Obj_DDT) - and then Etype (Obj_DDT) = Btyp_DDT) - then - Rewrite (N, - Convert_To (Typ, - New_Copy_Tree (Prefix (Ref_Object)))); - Analyze_And_Resolve (N, Typ); - end if; - end; - end if; + elsif Is_Interface (Btyp_DDT) then + Add_Implicit_Interface_Type_Conversion; end if; end Access_Cases; @@ -3987,6 +4027,24 @@ package body Exp_Attr is when Attribute_Img => Exp_Imgv.Expand_Image_Attribute (N); + ----------- + -- Index -- + ----------- + + -- Transforms 'Index attribute into a reference to the second formal of + -- the wrapper built for an entry family that has contract cases (see + -- Exp_Ch9.Build_Contract_Wrapper). + + when Attribute_Index => Index : declare + Entry_Id : constant Entity_Id := Entity (Pref); + Entry_Idx : constant Entity_Id := + Next_Entity + (First_Entity (Contract_Wrapper (Entry_Id))); + begin + Rewrite (N, New_Occurrence_Of (Entry_Idx, Loc)); + Analyze_And_Resolve (N, Typ); + end Index; + ----------------- -- Initialized -- ----------------- diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index 1867469..c61f154 100644 --- a/gcc/ada/exp_ch11.adb +++ b/gcc/ada/exp_ch11.adb @@ -85,8 +85,6 @@ package body Exp_Ch11 is pragma Unreferenced (Blk_Id); begin pragma Assert (Present (Entity (At_End_Proc (HSS)))); - pragma Assert (No (Exception_Handlers (HSS))); - return; end Expand_At_End_Handler; ------------------------------- diff --git a/gcc/ada/exp_ch13.adb b/gcc/ada/exp_ch13.adb index d3765e2..6b6da81 100644 --- a/gcc/ada/exp_ch13.adb +++ b/gcc/ada/exp_ch13.adb @@ -617,14 +617,12 @@ package body Exp_Ch13 is elsif Is_Subprogram (E) then Exp_Ch6.Freeze_Subprogram (N); - -- Ada 2005 (AI-251): Remove the freezing node associated with the - -- entities internally used by the frontend to register primitives - -- covering abstract interfaces. The call to Freeze_Subprogram has - -- already expanded the code that fills the corresponding entry in - -- its secondary dispatch table and therefore the code generator - -- has nothing else to do with this freezing node. - - Delete := Present (Interface_Alias (E)); + -- Ada 2005 (AI-251): Remove the freeze nodes associated with the + -- entities internally used by the front end to register primitives + -- covering abstract interfaces if they have no side effects. For the + -- others, gigi must discard them after evaluating the side effects. + + Delete := Present (Interface_Alias (E)) and then No (Actions (N)); end if; -- Analyze actions generated by freezing. The init_proc contains source diff --git a/gcc/ada/exp_ch2.adb b/gcc/ada/exp_ch2.adb index 921a8b7..8f97b43 100644 --- a/gcc/ada/exp_ch2.adb +++ b/gcc/ada/exp_ch2.adb @@ -150,13 +150,6 @@ package body Exp_Ch2 is and then OK_To_Do_Constant_Replacement (E) - -- Do not replace occurrences in pragmas (where names typically - -- appear not as values, but as simply names. If there are cases - -- where values are required, it is only a very minor efficiency - -- issue that they do not get replaced when they could be). - - and then Nkind (Parent (N)) /= N_Pragma_Argument_Association - -- Do not replace the prefixes of attribute references, since this -- causes trouble with cases like 4'Size. Also for Name_Asm_Input and -- Name_Asm_Output, don't do replacement anywhere, since we can have diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index d1b3388..4216fec 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -271,9 +271,6 @@ package body Exp_Ch3 is -- in a case statement, recursively. This latter pattern may occur for the -- initialization procedure of an unchecked union. - function Is_User_Defined_Equality (Prim : Node_Id) return Boolean; - -- Returns true if Prim is a user defined equality function - function Make_Eq_Body (Typ : Entity_Id; Eq_Name : Name_Id) return Node_Id; @@ -2100,8 +2097,7 @@ package body Exp_Ch3 is and then Present (Incomplete_View (Parent (Rec_Type))) then Append_Elmt ( - N => Defining_Identifier - (Incomplete_View (Parent (Rec_Type))), + N => Incomplete_View (Parent (Rec_Type)), To => Map); Append_Elmt ( N => Defining_Identifier @@ -4488,7 +4484,6 @@ package body Exp_Ch3 is Comp : Entity_Id; Decl : Node_Id; Op : Entity_Id; - Prim : Elmt_Id; Eq_Op : Entity_Id; function User_Defined_Eq (T : Entity_Id) return Entity_Id; @@ -4501,32 +4496,14 @@ package body Exp_Ch3 is --------------------- function User_Defined_Eq (T : Entity_Id) return Entity_Id is - Prim : Elmt_Id; - Op : Entity_Id; + Op : constant Entity_Id := TSS (T, TSS_Composite_Equality); begin - Op := TSS (T, TSS_Composite_Equality); - if Present (Op) then return Op; + else + return Get_User_Defined_Equality (T); end if; - - Prim := First_Elmt (Collect_Primitive_Operations (T)); - while Present (Prim) loop - Op := Node (Prim); - - if Chars (Op) = Name_Op_Eq - and then Etype (Op) = Standard_Boolean - and then Etype (First_Formal (Op)) = T - and then Etype (Next_Formal (First_Formal (Op))) = T - then - return Op; - end if; - - Next_Elmt (Prim); - end loop; - - return Empty; end User_Defined_Eq; -- Start of processing for Build_Untagged_Equality @@ -4542,6 +4519,7 @@ package body Exp_Ch3 is and then Present (User_Defined_Eq (Etype (Comp))) then Build_Eq := True; + exit; end if; Next_Component (Comp); @@ -4550,23 +4528,14 @@ package body Exp_Ch3 is -- If there is a user-defined equality for the type, we do not create -- the implicit one. - Prim := First_Elmt (Collect_Primitive_Operations (Typ)); - Eq_Op := Empty; - while Present (Prim) loop - if Chars (Node (Prim)) = Name_Op_Eq - and then Comes_From_Source (Node (Prim)) - - -- Don't we also need to check formal types and return type as in - -- User_Defined_Eq above??? - - then - Eq_Op := Node (Prim); + Eq_Op := Get_User_Defined_Equality (Typ); + if Present (Eq_Op) then + if Comes_From_Source (Eq_Op) then Build_Eq := False; - exit; + else + Eq_Op := Empty; end if; - - Next_Elmt (Prim); - end loop; + end if; -- If the type is derived, inherit the operation, if present, from the -- parent type. It may have been declared after the type derivation. If @@ -4575,35 +4544,28 @@ package body Exp_Ch3 is -- flags. Ditto for inequality. if No (Eq_Op) and then Is_Derived_Type (Typ) then - Prim := First_Elmt (Collect_Primitive_Operations (Etype (Typ))); - while Present (Prim) loop - if Chars (Node (Prim)) = Name_Op_Eq then - Copy_TSS (Node (Prim), Typ); - Build_Eq := False; + Eq_Op := Get_User_Defined_Equality (Etype (Typ)); + if Present (Eq_Op) then + Copy_TSS (Eq_Op, Typ); + Build_Eq := False; - declare - Op : constant Entity_Id := User_Defined_Eq (Typ); - Eq_Op : constant Entity_Id := Node (Prim); - NE_Op : constant Entity_Id := Next_Entity (Eq_Op); + declare + Op : constant Entity_Id := User_Defined_Eq (Typ); + NE_Op : constant Entity_Id := Next_Entity (Eq_Op); - begin - if Present (Op) then - Set_Alias (Op, Eq_Op); - Set_Is_Abstract_Subprogram - (Op, Is_Abstract_Subprogram (Eq_Op)); + begin + if Present (Op) then + Set_Alias (Op, Eq_Op); + Set_Is_Abstract_Subprogram + (Op, Is_Abstract_Subprogram (Eq_Op)); - if Chars (Next_Entity (Op)) = Name_Op_Ne then - Set_Is_Abstract_Subprogram - (Next_Entity (Op), Is_Abstract_Subprogram (NE_Op)); - end if; + if Chars (Next_Entity (Op)) = Name_Op_Ne then + Set_Is_Abstract_Subprogram + (Next_Entity (Op), Is_Abstract_Subprogram (NE_Op)); end if; - end; - - exit; - end if; - - Next_Elmt (Prim); - end loop; + end if; + end; + end if; end if; -- If not inherited and not user-defined, build body as for a type with @@ -6140,8 +6102,7 @@ package body Exp_Ch3 is Par_Id := Base_Type (Full_View (Par_Id)); end if; - if Nkind (Type_Definition (Original_Node (N))) = - N_Derived_Type_Definition + if Nkind (Type_Definition (N)) = N_Derived_Type_Definition and then not Is_Tagged_Type (Def_Id) and then Present (Freeze_Node (Par_Id)) and then Present (TSS_Elist (Freeze_Node (Par_Id))) @@ -9846,18 +9807,6 @@ package body Exp_Ch3 is return True; end Is_Null_Statement_List; - ------------------------------ - -- Is_User_Defined_Equality -- - ------------------------------ - - function Is_User_Defined_Equality (Prim : Node_Id) return Boolean is - begin - return Chars (Prim) = Name_Op_Eq - and then Etype (First_Formal (Prim)) = - Etype (Next_Formal (First_Formal (Prim))) - and then Base_Type (Etype (Prim)) = Standard_Boolean; - end Is_User_Defined_Equality; - ---------------------------------------- -- Make_Controlling_Function_Wrappers -- ---------------------------------------- @@ -11230,15 +11179,8 @@ package body Exp_Ch3 is Prim := First_Elmt (Primitive_Operations (Tag_Typ)); while Present (Prim) loop - if Chars (Node (Prim)) = Name_Op_Eq + if Is_User_Defined_Equality (Node (Prim)) and then not Is_Internal (Node (Prim)) - - -- The predefined equality primitive must have exactly two - -- formals whose type is this tagged type. - - and then Number_Formals (Node (Prim)) = 2 - and then Etype (First_Formal (Node (Prim))) = Tag_Typ - and then Etype (Last_Formal (Node (Prim))) = Tag_Typ then Eq_Needed := False; Eq_Name := No_Name; @@ -11254,7 +11196,7 @@ package body Exp_Ch3 is Prim := First_Elmt (Primitive_Operations (Tag_Typ)); while Present (Prim) loop - if Chars (Node (Prim)) = Name_Op_Eq + if Is_User_Defined_Equality (Node (Prim)) and then Is_Internal (Node (Prim)) then Eq_Needed := True; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index f827fb0..75f0e56 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -425,36 +425,21 @@ package body Exp_Ch4 is Lhs : Node_Id; Rhs : Node_Id) return Node_Id is - Prim : Node_Id; - Prim_E : Elmt_Id; + Eq : constant Entity_Id := Get_User_Defined_Equality (Typ); begin - Prim_E := First_Elmt (Collect_Primitive_Operations (Typ)); - while Present (Prim_E) loop - Prim := Node (Prim_E); + if Present (Eq) then + if Is_Abstract_Subprogram (Eq) then + return Make_Raise_Program_Error (Loc, + Reason => PE_Explicit_Raise); - -- Locate primitive equality with the right signature - - if Chars (Prim) = Name_Op_Eq - and then Etype (First_Formal (Prim)) = - Etype (Next_Formal (First_Formal (Prim))) - and then Etype (Prim) = Standard_Boolean - then - if Is_Abstract_Subprogram (Prim) then - return - Make_Raise_Program_Error (Loc, - Reason => PE_Explicit_Raise); - - else - return - Make_Function_Call (Loc, - Name => New_Occurrence_Of (Prim, Loc), - Parameter_Associations => New_List (Lhs, Rhs)); - end if; + else + return + Make_Function_Call (Loc, + Name => New_Occurrence_Of (Eq, Loc), + Parameter_Associations => New_List (Lhs, Rhs)); end if; - - Next_Elmt (Prim_E); - end loop; + end if; -- If not found, predefined operation will be used @@ -4552,7 +4537,10 @@ package body Exp_Ch4 is if Present (Pool) then Set_Storage_Pool (N, Pool); - if Is_RTE (Pool, RE_SS_Pool) then + if Is_RTE (Pool, RE_RS_Pool) then + Set_Procedure_To_Call (N, RTE (RE_RS_Allocate)); + + elsif Is_RTE (Pool, RE_SS_Pool) then Check_Restriction (No_Secondary_Stack, N); Set_Procedure_To_Call (N, RTE (RE_SS_Allocate)); @@ -5150,6 +5138,30 @@ package body Exp_Ch4 is Set_Expression (N, New_Occurrence_Of (Typ, Loc)); end if; + -- When the designated subtype is unconstrained and + -- the allocator specifies a constrained subtype (or + -- such a subtype has been created, such as above by + -- Build_Default_Subtype), associate that subtype with + -- the dereference of the allocator's access value. + -- This is needed by the back end for cases where + -- the access type has a Designated_Storage_Model, + -- to support allocation of a host object of the right + -- size for passing to the initialization procedure. + + if not Is_Constrained (Dtyp) + and then Is_Constrained (Typ) + then + declare + Init_Deref : constant Node_Id := + Unqual_Conv (Init_Arg1); + begin + pragma Assert + (Nkind (Init_Deref) = N_Explicit_Dereference); + + Set_Actual_Designated_Subtype (Init_Deref, Typ); + end; + end if; + Discr := First_Elmt (Discriminant_Constraint (Typ)); while Present (Discr) loop Nod := Node (Discr); @@ -6950,7 +6962,9 @@ package body Exp_Ch4 is and then Nkind (Rop) /= N_Range then if not In_Range_Check then - R_Op := Make_Predicate_Call (Rtyp, Lop, Mem => True); + -- Indicate via Static_Mem parameter that this predicate + -- evaluation is for a membership test. + R_Op := Make_Predicate_Call (Rtyp, Lop, Static_Mem => True); else R_Op := New_Occurrence_Of (Standard_True, Loc); end if; @@ -7817,21 +7831,10 @@ package body Exp_Ch4 is -- build and analyze call, adding conversions if the operation is -- inherited. - function Is_Equality (Subp : Entity_Id; - Typ : Entity_Id := Empty) return Boolean; - -- Determine whether arbitrary Entity_Id denotes a function with the - -- right name and profile for an equality op, specifically for the - -- base type Typ if Typ is nonempty. - function Find_Equality (Prims : Elist_Id) return Entity_Id; -- Find a primitive equality function within primitive operation list -- Prims. - function User_Defined_Primitive_Equality_Op - (Typ : Entity_Id) return Entity_Id; - -- Find a user-defined primitive equality function for a given untagged - -- record type, ignoring visibility. Return Empty if no such op found. - function Has_Unconstrained_UU_Component (Typ : Entity_Id) return Boolean; -- Determines whether a type has a subcomponent of an unconstrained -- Unchecked_Union subtype. Typ is a record type. @@ -8080,43 +8083,6 @@ package body Exp_Ch4 is Analyze_And_Resolve (N, Standard_Boolean, Suppress => All_Checks); end Build_Equality_Call; - ----------------- - -- Is_Equality -- - ----------------- - - function Is_Equality (Subp : Entity_Id; - Typ : Entity_Id := Empty) return Boolean is - Formal_1 : Entity_Id; - Formal_2 : Entity_Id; - begin - -- The equality function carries name "=", returns Boolean, and has - -- exactly two formal parameters of an identical type. - - if Ekind (Subp) = E_Function - and then Chars (Subp) = Name_Op_Eq - and then Base_Type (Etype (Subp)) = Standard_Boolean - then - Formal_1 := First_Formal (Subp); - Formal_2 := Empty; - - if Present (Formal_1) then - Formal_2 := Next_Formal (Formal_1); - end if; - - return - Present (Formal_1) - and then Present (Formal_2) - and then No (Next_Formal (Formal_2)) - and then Base_Type (Etype (Formal_1)) = - Base_Type (Etype (Formal_2)) - and then - (not Present (Typ) - or else Implementation_Base_Type (Etype (Formal_1)) = Typ); - end if; - - return False; - end Is_Equality; - ------------------- -- Find_Equality -- ------------------- @@ -8139,7 +8105,7 @@ package body Exp_Ch4 is Candid := Prim; while Present (Candid) loop - if Is_Equality (Candid) then + if Is_User_Defined_Equality (Candid) then return Candid; end if; @@ -8178,43 +8144,6 @@ package body Exp_Ch4 is return Eq_Prim; end Find_Equality; - ---------------------------------------- - -- User_Defined_Primitive_Equality_Op -- - ---------------------------------------- - - function User_Defined_Primitive_Equality_Op - (Typ : Entity_Id) return Entity_Id - is - Enclosing_Scope : constant Entity_Id := Scope (Typ); - E : Entity_Id; - begin - for Private_Entities in Boolean loop - if Private_Entities then - if Ekind (Enclosing_Scope) /= E_Package then - exit; - end if; - E := First_Private_Entity (Enclosing_Scope); - - else - E := First_Entity (Enclosing_Scope); - end if; - - while Present (E) loop - if Is_Equality (E, Typ) then - return E; - end if; - Next_Entity (E); - end loop; - end loop; - - if Is_Derived_Type (Typ) then - return User_Defined_Primitive_Equality_Op - (Implementation_Base_Type (Etype (Typ))); - end if; - - return Empty; - end User_Defined_Primitive_Equality_Op; - ------------------------------------ -- Has_Unconstrained_UU_Component -- ------------------------------------ @@ -8358,14 +8287,7 @@ package body Exp_Ch4 is -- Deal with private types - Typl := A_Typ; - - if Ekind (Typl) = E_Private_Type then - Typl := Underlying_Type (Typl); - - elsif Ekind (Typl) = E_Private_Subtype then - Typl := Underlying_Type (Base_Type (Typl)); - end if; + Typl := Underlying_Type (A_Typ); -- It may happen in error situations that the underlying type is not -- set. The error will be detected later, here we just defend the @@ -8529,15 +8451,6 @@ package body Exp_Ch4 is (Find_Equality (Primitive_Operations (Typl))); end if; - -- See AI12-0101 (which only removes a legality rule) and then - -- AI05-0123 (which then applies in the previously illegal case). - -- AI12-0101 is a binding interpretation. - - elsif Ada_Version >= Ada_2012 - and then Present (User_Defined_Primitive_Equality_Op (Typl)) - then - Build_Equality_Call (User_Defined_Primitive_Equality_Op (Typl)); - -- Ada 2005 (AI-216): Program_Error is raised when evaluating the -- predefined equality operator for a type which has a subcomponent -- of an Unchecked_Union type whose nominal subtype is unconstrained. @@ -10892,6 +10805,8 @@ package body Exp_Ch4 is Ensure_Valid (Operand); end if; + Freeze_Before (Operand, Target_Type); + -- Apply possible constraint check Apply_Constraint_Check (Operand, Target_Type, No_Sliding => True); @@ -13132,23 +13047,11 @@ package body Exp_Ch4 is if (Is_Entity_Name (Alt) and then Is_Type (Entity (Alt))) or else Nkind (Alt) = N_Range then - Cond := - Make_In (Sloc (Alt), - Left_Opnd => L, - Right_Opnd => R); - else - Cond := - Make_Op_Eq (Sloc (Alt), - Left_Opnd => L, - Right_Opnd => R); + Cond := Make_In (Sloc (Alt), Left_Opnd => L, Right_Opnd => R); - if Is_Record_Or_Limited_Type (Etype (Alt)) then - - -- We reset the Entity in order to use the primitive equality - -- of the type, as per RM 4.5.2 (28.1/4). - - Set_Entity (Cond, Empty); - end if; + else + Cond := Make_Op_Eq (Sloc (Alt), Left_Opnd => L, Right_Opnd => R); + Resolve_Membership_Equality (Cond, Etype (Alt)); end if; return Cond; @@ -14205,6 +14108,7 @@ package body Exp_Ch4 is procedure Narrow_Large_Operation (N : Node_Id) is Kind : constant Node_Kind := Nkind (N); + Otyp : constant Entity_Id := Etype (N); In_Rng : constant Boolean := Kind = N_In; Binary : constant Boolean := Kind in N_Binary_Op or else In_Rng; Compar : constant Boolean := Kind in N_Op_Compare or else In_Rng; @@ -14359,8 +14263,7 @@ package body Exp_Ch4 is -- Analyze it with the comparison type and checks suppressed since -- the conversions of the operands cannot overflow. - Analyze_And_Resolve - (N, Etype (Original_Node (N)), Suppress => Overflow_Check); + Analyze_And_Resolve (N, Otyp, Suppress => Overflow_Check); else -- Analyze it with the narrower type and checks suppressed, but only diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 2e401ca..9c7a370 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -292,8 +292,8 @@ package body Exp_Ch5 is return Nkind (Rhs) = N_Type_Conversion and then not Has_Compatible_Representation - (Target_Type => Etype (Rhs), - Operand_Type => Etype (Expression (Rhs))); + (Target_Typ => Etype (Rhs), + Operand_Typ => Etype (Expression (Rhs))); end Change_Of_Representation; ------------------------------ diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 3ceb55d..44d1987 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -1576,8 +1576,8 @@ package body Exp_Ch6 is Var := Make_Var (Expression (Actual)); Crep := not Has_Compatible_Representation - (Target_Type => F_Typ, - Operand_Type => Etype (Expression (Actual))); + (Target_Typ => F_Typ, + Operand_Typ => Etype (Expression (Actual))); else V_Typ := Etype (Actual); @@ -2379,8 +2379,8 @@ package body Exp_Ch6 is -- Also pass by copy if change of representation or else not Has_Compatible_Representation - (Target_Type => Etype (Formal), - Operand_Type => Etype (Expression (Actual)))) + (Target_Typ => Etype (Formal), + Operand_Typ => Etype (Expression (Actual)))) then Add_Call_By_Copy_Code; @@ -4475,16 +4475,6 @@ package body Exp_Ch6 is Set_Entity (Name (Call_Node), Parent_Subp); - -- Move this check to sem??? - - if Is_Abstract_Subprogram (Parent_Subp) - and then not In_Instance - then - Error_Msg_NE - ("cannot call abstract subprogram &!", - Name (Call_Node), Parent_Subp); - end if; - -- Inspect all formals of derived subprogram Subp. Compare parameter -- types with the parent subprogram and check whether an actual may -- need a type conversion to the corresponding formal of the parent @@ -4566,8 +4556,8 @@ package body Exp_Ch6 is -- warning, and do the change of representation. elsif not Has_Compatible_Representation - (Target_Type => Formal_Typ, - Operand_Type => Parent_Typ) + (Target_Typ => Formal_Typ, + Operand_Typ => Parent_Typ) then Error_Msg_N ("??change of representation required", Actual); @@ -4909,8 +4899,8 @@ package body Exp_Ch6 is -- the return type is limited, then the context is initialization and -- different processing applies. If the call is to a protected function, -- the expansion above will call Expand_Call recursively. Otherwise the - -- function call is transformed into a temporary which obtains the - -- result from the secondary stack. + -- function call is transformed into a reference to the result that has + -- been built either on the return or the secondary stack. if Needs_Finalization (Etype (Subp)) then if not Is_Build_In_Place_Function_Call (Call_Node) @@ -4937,10 +4927,11 @@ package body Exp_Ch6 is and then (Ekind (Current_Scope) /= E_Loop or else Nkind (Parent (Call_Node)) /= N_Function_Call - or else not Is_Build_In_Place_Function_Call - (Parent (Call_Node))) + or else not + Is_Build_In_Place_Function_Call (Parent (Call_Node))) then - Establish_Transient_Scope (Call_Node, Manage_Sec_Stack => True); + Establish_Transient_Scope + (Call_Node, Returns_On_Secondary_Stack (Etype (Subp))); end if; end if; end Expand_Call_Helper; @@ -7335,10 +7326,9 @@ package body Exp_Ch6 is -- 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) + elsif not Returns_On_Secondary_Stack (R_Type) or else Is_Ignored_Ghost_Entity (Scope_Id) then - -- Mutable records with variable-length components are not returned -- on the sec-stack, so we need to make sure that the back end will -- only copy back the size of the actual value, and not the maximum @@ -7351,6 +7341,7 @@ package body Exp_Ch6 is Ubt : constant Entity_Id := Underlying_Type (Base_Type (Exp_Typ)); Decl : Node_Id; Ent : Entity_Id; + begin if not Exp_Is_Function_Call and then Has_Discriminants (Ubt) @@ -7365,6 +7356,72 @@ package body Exp_Ch6 is end if; end; + -- For types which need finalization, do the allocation on the return + -- stack manually in order to call Adjust at the right time: + + -- type Ann is access R_Type; + -- for Ann'Storage_pool use rs_pool; + -- Rnn : Ann := new Exp_Typ'(Exp); + -- return Rnn.all; + + -- but optimize the case where the result is a function call that + -- also needs finalization. In this case the result is already on + -- the return stack and no further processing is required. + + if Present (Utyp) + and then Needs_Finalization (Utyp) + and then not (Exp_Is_Function_Call + and then Needs_Finalization (Exp_Typ)) + then + declare + Loc : constant Source_Ptr := Sloc (N); + Acc_Typ : constant Entity_Id := Make_Temporary (Loc, 'A'); + Alloc_Node : Node_Id; + Temp : Entity_Id; + + begin + Mutate_Ekind (Acc_Typ, E_Access_Type); + + Set_Associated_Storage_Pool (Acc_Typ, RTE (RE_RS_Pool)); + + -- This is an allocator for the return stack, and it's fine + -- to have Comes_From_Source set False on it, as gigi knows not + -- to flag it as a violation of No_Implicit_Heap_Allocations. + + Alloc_Node := + Make_Allocator (Loc, + Expression => + Make_Qualified_Expression (Loc, + Subtype_Mark => New_Occurrence_Of (Exp_Typ, Loc), + Expression => Relocate_Node (Exp))); + + -- We do not want discriminant checks on the declaration, + -- given that it gets its value from the allocator. + + Set_No_Initialization (Alloc_Node); + + Temp := Make_Temporary (Loc, 'R', Alloc_Node); + + Insert_Actions (Exp, New_List ( + Make_Full_Type_Declaration (Loc, + Defining_Identifier => Acc_Typ, + Type_Definition => + Make_Access_To_Object_Definition (Loc, + Subtype_Indication => Subtype_Ind)), + + Make_Object_Declaration (Loc, + Defining_Identifier => Temp, + Object_Definition => New_Occurrence_Of (Acc_Typ, Loc), + Expression => Alloc_Node))); + + Rewrite (Exp, + Make_Explicit_Dereference (Loc, + Prefix => New_Occurrence_Of (Temp, Loc))); + + Analyze_And_Resolve (Exp, R_Type); + end; + end if; + -- Here if secondary stack is used else @@ -7382,8 +7439,8 @@ package body Exp_Ch6 is -- wrong in the case of a controlled type, where gigi does not know -- how to do a copy.) - pragma Assert (Requires_Transient_Scope (R_Type)); - if Exp_Is_Function_Call and then Requires_Transient_Scope (Exp_Typ) + if Exp_Is_Function_Call + and then Returns_On_Secondary_Stack (Exp_Typ) then Set_By_Ref (N); @@ -7403,19 +7460,20 @@ package body Exp_Ch6 is Analyze_And_Resolve (Exp, R_Type); - -- For controlled types, do the allocation on the secondary stack - -- manually in order to call adjust at the right time: + -- For types which both need finalization and are returned on the + -- secondary stack, do the allocation on secondary stack manually + -- in order to call Adjust at the right time: - -- type Anon1 is access R_Type; - -- for Anon1'Storage_pool use ss_pool; - -- Anon2 : anon1 := new R_Type'(expr); - -- return Anon2.all; + -- type Ann is access R_Type; + -- for Ann'Storage_pool use ss_pool; + -- Rnn : Ann := new Exp_Typ'(Exp); + -- return Rnn.all; - -- We do the same for classwide types that are not potentially + -- And we do the same for class-wide types that are not potentially -- controlled (by the virtue of restriction No_Finalization) because -- gigi is not able to properly allocate class-wide types. - elsif CW_Or_Has_Controlled_Part (Utyp) then + elsif CW_Or_Needs_Finalization (Utyp) then declare Loc : constant Source_Ptr := Sloc (N); Acc_Typ : constant Entity_Id := Make_Temporary (Loc, 'A'); @@ -7866,6 +7924,8 @@ package body Exp_Ch6 is declare Typ : constant Entity_Id := Scope (DTC_Entity (Subp)); + L : List_Id; + begin -- Handle private overridden primitives @@ -7905,8 +7965,17 @@ package body Exp_Ch6 is Register_Predefined_DT_Entry (Subp); end if; - Insert_Actions_After (N, - Register_Primitive (Loc, Prim => Subp)); + L := Register_Primitive (Loc, Prim => Subp); + + if Is_Empty_List (L) then + null; + + elsif No (Actions (N)) then + Set_Actions (N, L); + + else + Append_List (L, Actions (N)); + end if; end if; end if; end; diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index d7863c3..bb6712d 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -109,18 +109,13 @@ package body Exp_Ch7 is -- pass the address of a constrained object as the target object for the -- function result. - -- By allocating tagged results in the secondary stack a number of + -- By always allocating tagged results in the secondary stack, a couple of -- implementation difficulties are avoided: - -- - If it is a dispatching function call, the computation of the size of - -- the result is possible but complex from the outside. + -- - If this is a dispatching function call, the computation of the size + -- of the result is possible but complex from the outside. - -- - If the returned type is controlled, the assignment of the returned - -- value to the anonymous object involves an Adjust, and we have no - -- easy way to access the anonymous object created by the back end. - - -- - If the returned type is class-wide, this is an unconstrained type - -- anyway. + -- - If the result type is class-wide, it is unconstrained anyway. -- Furthermore, the small loss in efficiency which is the result of this -- decision is not such a big deal because functions returning tagged types @@ -157,14 +152,14 @@ package body Exp_Ch7 is -- Finalization Management -- ----------------------------- - -- This part describe how Initialization/Adjustment/Finalization procedures - -- are generated and called. Two cases must be considered, types that are - -- Controlled (Is_Controlled flag set) and composite types that contain - -- controlled components (Has_Controlled_Component flag set). In the first - -- case the procedures to call are the user-defined primitive operations - -- Initialize/Adjust/Finalize. In the second case, GNAT generates - -- Deep_Initialize, Deep_Adjust and Deep_Finalize that are in charge - -- of calling the former procedures on the controlled components. + -- This part describes how Initialization/Adjustment/Finalization + -- procedures are generated and called. Two cases must be considered: types + -- that are Controlled (Is_Controlled flag set) and composite types that + -- contain controlled components (Has_Controlled_Component flag set). In + -- the first case the procedures to call are the user-defined primitive + -- operations Initialize/Adjust/Finalize. In the second case, GNAT + -- generates Deep_Initialize, Deep_Adjust and Deep_Finalize that are in + -- charge of calling the former procedures on the controlled components. -- For records with Has_Controlled_Component set, a hidden "controller" -- component is inserted. This controller component contains its own @@ -2850,16 +2845,14 @@ package body Exp_Ch7 is Left_Opnd => New_Occurrence_Of (Fin_Mas_Id, Loc), Right_Opnd => Make_Null (Loc)); - -- For constrained or tagged results escalate the condition to + -- For unconstrained or tagged results, escalate the condition to -- include the allocation format. Generate: -- if BIPallocform > Secondary_Stack'Pos -- and then BIPfinalizationmaster /= null -- then - if not Is_Constrained (Func_Typ) - or else Is_Tagged_Type (Func_Typ) - then + if Needs_BIP_Alloc_Form (Func_Id) then declare Alloc : constant Entity_Id := Build_In_Place_Formal (Func_Id, BIP_Alloc_Form); @@ -4247,14 +4240,33 @@ package body Exp_Ch7 is -- -- Postcond_Enable := False; - Append_To (Top_Decls, - Make_Assignment_Statement (Loc, - Name => - New_Occurrence_Of - (Get_Postcond_Enabled (Def_Ent), Loc), - Expression => - New_Occurrence_Of - (Standard_False, Loc))); + -- Note that we do not disable early evaluation of postconditions + -- for return types that are unconstrained or have unconstrained + -- elements since the temporary result object could get allocated on + -- the stack and be out of scope at the point where we perform late + -- evaluation of postconditions - leading to uninitialized memory + -- reads. + + -- This disabling of early evaluation can lead to incorrect run-time + -- semantics where functions with unconstrained elements will + -- have their corresponding postconditions evaluated before + -- finalization. The proper solution here is to generate a wrapper + -- to capture the result instead of using multiple flags and playing + -- with flags which does not even work in all cases ??? + + if not Has_Unconstrained_Elements (Etype (Def_Ent)) + or else (Is_Array_Type (Etype (Def_Ent)) + and then not Is_Constrained (Etype (Def_Ent))) + then + Append_To (Top_Decls, + Make_Assignment_Statement (Loc, + Name => + New_Occurrence_Of + (Get_Postcond_Enabled (Def_Ent), Loc), + Expression => + New_Occurrence_Of + (Standard_False, Loc))); + end if; -- Add the subprogram to the list of declarations an analyze it @@ -8273,19 +8285,23 @@ package body Exp_Ch7 is Counter : Nat := 0; Finalizer_Data : Finalization_Exception_Data; + Last_POC_Call : Node_Id := Empty; function Process_Component_List_For_Finalize - (Comps : Node_Id) return List_Id; + (Comps : Node_Id; + In_Variant_Part : Boolean := False) return List_Id; -- Build all necessary finalization statements for a single component -- list. The statements may include a jump circuitry if flag Is_Local - -- is enabled. + -- is enabled. In_Variant_Part indicates whether this is a recursive + -- call. ----------------------------------------- -- Process_Component_List_For_Finalize -- ----------------------------------------- function Process_Component_List_For_Finalize - (Comps : Node_Id) return List_Id + (Comps : Node_Id; + In_Variant_Part : Boolean := False) return List_Id is procedure Process_Component_For_Finalize (Decl : Node_Id; @@ -8467,7 +8483,8 @@ package body Exp_Ch7 is New_Copy_List (Discrete_Choices (Var)), Statements => Process_Component_List_For_Finalize ( - Component_List (Var)))); + Component_List (Var), + In_Variant_Part => True))); Next_Non_Pragma (Var); end loop; @@ -8534,6 +8551,12 @@ package body Exp_Ch7 is end loop; end if; + if not In_Variant_Part then + Last_POC_Call := Last (Stmts); + -- In the case of a type extension, the deep-finalize call + -- for the _Parent component will be inserted here. + end if; + -- Process the rest of the components in reverse order Decl := Last_Non_Pragma (Component_Items (Comps)); @@ -8749,7 +8772,38 @@ package body Exp_Ch7 is (Finalizer_Data)))); end if; - Append_To (Bod_Stmts, Fin_Stmt); + -- The intended component finalization order is + -- 1) POC components of extension + -- 2) _Parent component + -- 3) non-POC components of extension. + -- + -- With this "finalize the parent part in the middle" + -- ordering, we can avoid the need for making two + -- calls to the parent's subprogram in the way that + -- is necessary for Init_Procs. This does have the + -- peculiar (but legal) consequence that the parent's + -- non-POC components are finalized before the + -- non-POC extension components. This violates the + -- usual "finalize in reverse declaration order" + -- principle, but that's ok (see Ada RM 7.6.1(9)). + -- + -- Last_POC_Call should be non-empty if the extension + -- has at least one POC. Interactions with variant + -- parts are incorrectly ignored. + + if Present (Last_POC_Call) then + Insert_After (Last_POC_Call, Fin_Stmt); + else + -- At this point, we could look for the common case + -- where there are no POC components anywhere in + -- sight (inherited or not) and, in that common case, + -- call Append_To instead of Prepend_To. That would + -- result in finalizing the parent part after, rather + -- than before, the extension components. That might + -- be more intuitive (as discussed in preceding + -- comment), but it is not required. + Prepend_To (Bod_Stmts, Fin_Stmt); + end if; end if; end if; end; @@ -10282,7 +10336,7 @@ package body Exp_Ch7 is -- reclamation is done by the caller. if Ekind (Curr_S) = E_Function - and then Requires_Transient_Scope (Etype (Curr_S)) + and then Returns_On_Secondary_Stack (Etype (Curr_S)) then null; diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index f706780..be791c3 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -2793,20 +2793,23 @@ package body Exp_Ch9 is Expression => Make_Integer_Literal (Loc, 1)); else - pragma Assert (Present (Ret)); + -- Ranges are in increasing order, so last one doesn't need guard - if Nkind (Ret) = N_If_Statement then + declare + Nod : constant Node_Id := Last (Elsif_Parts (Ret)); + begin + Remove (Nod); + Set_Else_Statements (Ret, Then_Statements (Nod)); - -- Ranges are in increasing order, so last one doesn't need - -- guard. + -- If Elsif_Parts becomes empty then remove it entirely, as + -- otherwise we would violate the invariant of If_Statement + -- node described in Sinfo. - declare - Nod : constant Node_Id := Last (Elsif_Parts (Ret)); - begin - Remove (Nod); - Set_Else_Statements (Ret, Then_Statements (Nod)); - end; - end if; + if Is_Empty_List (Elsif_Parts (Ret)) then + pragma Assert (Elsif_Parts (Ret) /= No_List); + Set_Elsif_Parts (Ret, No_List); + end if; + end; end if; end if; @@ -7812,7 +7815,9 @@ package body Exp_Ch9 is Hdle := New_List (Build_Abort_Block_Handler (Loc)); - Prepend_To (Astats, Build_Runtime_Call (Loc, RE_Abort_Undefer)); + if Abort_Allowed then + Prepend_To (Astats, Build_Runtime_Call (Loc, RE_Abort_Undefer)); + end if; Abortable_Block := Make_Block_Statement (Loc, diff --git a/gcc/ada/exp_dbug.adb b/gcc/ada/exp_dbug.adb index 2231b9c..76f08e3 100644 --- a/gcc/ada/exp_dbug.adb +++ b/gcc/ada/exp_dbug.adb @@ -1028,6 +1028,7 @@ package body Exp_Dbug is E := First_Entity (Wrapper); while Present (E) loop if Nkind (Parent (E)) = N_Object_Declaration + and then Present (Corresponding_Generic_Association (Parent (E))) and then Is_Elementary_Type (Etype (E)) then Loc := Sloc (Expression (Parent (E))); diff --git a/gcc/ada/exp_dbug.ads b/gcc/ada/exp_dbug.ads index 0c0dd1a..273d6ed 100644 --- a/gcc/ada/exp_dbug.ads +++ b/gcc/ada/exp_dbug.ads @@ -1444,7 +1444,7 @@ package Exp_Dbug is -- placed within the wrapper package of the instance, and the entity in -- these declarations is encoded in a complex way that GDB does not handle -- well. These new renaming declarations appear within the body of the - -- subprogram, and are redundant from a visibility point of view, but They + -- subprogram, and are redundant from a visibility point of view, but they -- should have no measurable performance impact, and require no special -- decoding in the debugger. diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb index b39b2a7..d4a62ac 100644 --- a/gcc/ada/exp_pakd.adb +++ b/gcc/ada/exp_pakd.adb @@ -1930,9 +1930,17 @@ package body Exp_Pakd is -- modular case we guarantee that the unused bits are always zeroes. -- We do have to compare the lengths because we could be comparing -- two different subtypes of the same base type. We can only do this - -- if the PATs on both sides are the same. + -- if the PATs on both sides are modular (in which case they are + -- necessarily structurally the same -- same Modulus and so on); + -- otherwise, we have a case where the right operand is not of + -- compile time known size. + + if Is_Modular_Integer_Type (PAT) + and then Is_Modular_Integer_Type (Etype (R)) + then + pragma Assert (RM_Size (Etype (R)) = RM_Size (PAT)); + pragma Assert (Modulus (Etype (R)) = Modulus (PAT)); - if Is_Modular_Integer_Type (PAT) and then PAT = Etype (R) then Rewrite (N, Make_And_Then (Loc, Left_Opnd => diff --git a/gcc/ada/exp_pakd.ads b/gcc/ada/exp_pakd.ads index f61ae08..e80787a 100644 --- a/gcc/ada/exp_pakd.ads +++ b/gcc/ada/exp_pakd.ads @@ -41,7 +41,8 @@ package Exp_Pakd is -- This packed array type has the name xxxPn, where xxx is the name -- of the packed type, and n is the component size. The expanded - -- declaration declares a type that is one of the following: + -- declaration declares a type that is one of the following (sizes + -- below are in bytes): -- For an unconstrained array with component size 1,2,4 or any other -- odd component size. These are the cases in which we do not need @@ -49,10 +50,10 @@ package Exp_Pakd is -- type xxxPn is new Packed_Bytes1; - -- For an unconstrained array with component size that is divisible - -- by 2, but not divisible by 4 (other than 2 itself). These are the - -- cases in which we can generate better code if the underlying array - -- is 2-byte aligned (see System.Pack_14 in file s-pack14 for example). + -- For an unconstrained array with component size greater than 2, that is + -- divisible by 2, but not divisible by 4. These are the cases in which + -- we can generate better code if the underlying array is 2-byte aligned + -- (see System.Pack_14 in file s-pack14 for example). -- type xxxPn is new Packed_Bytes2; @@ -942,7 +943,7 @@ package Exp_Pakd is -- N is an N_Op_Eq node where the operands are packed arrays whose -- representation is an array-of-bytes type (the case where a modular -- type is used for the representation does not require any special - -- handling, because in the modular case, unused bits are zeroes. + -- handling, because in the modular case, unused bits are zeroes). procedure Expand_Packed_Not (N : Node_Id); -- N is an N_Op_Not node where the operand is packed array of Boolean diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index 27ea708..5f13087 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -34,7 +34,6 @@ with Elists; use Elists; with Errout; use Errout; with Exp_Ch11; use Exp_Ch11; with Exp_Util; use Exp_Util; -with Expander; use Expander; with Inline; use Inline; with Lib; use Lib; with Namet; use Namet; @@ -286,7 +285,7 @@ package body Exp_Prag is -- expression is not usually the best choice here, because it points to -- the location of the topmost tree node, which may be an operator in -- the middle of the source text of the expression. For example, it gets - -- located on the last AND keyword in a chain of boolean expressiond + -- located on the last AND keyword in a chain of boolean expressions -- AND'ed together. It is best to put the message on the first character -- of the condition, which is the effect of the First_Node call here. -- This source location is used to build the default exception message, @@ -2390,10 +2389,7 @@ package body Exp_Prag is Set_Pragma_Argument_Associations (N, A); end if; - -- Process the arguments of the pragma and expand them. Expanding an - -- entity reference is a noop, except in a protected operation, where - -- a reference may have to be transformed into a reference to the - -- corresponding prival. Are there other pragmas that require this ??? + -- Process the arguments of the pragma Rip := False; Assoc := First (Pragma_Argument_Associations (N)); @@ -2402,8 +2398,6 @@ package body Exp_Prag is Set_Address_Taken (Entity (Expression (Assoc))); - Expand (Expression (Assoc)); - -- If any of the objects have a freeze node, it must appear before -- pragma Inspection_Point, otherwise the entity won't be elaborated -- when Gigi processes the pragma. diff --git a/gcc/ada/exp_spark.adb b/gcc/ada/exp_spark.adb index 00e0fcc..c89d604 100644 --- a/gcc/ada/exp_spark.adb +++ b/gcc/ada/exp_spark.adb @@ -850,9 +850,12 @@ package body Exp_SPARK is -- Start of processing for Expand_SPARK_Potential_Renaming begin - -- Replace a reference to a renaming with the actual renamed object + -- Replace a reference to a renaming with the actual renamed object. + -- Protect against previous errors leaving no entity in N. - if Is_Object (Obj_Id) then + if Present (Obj_Id) + and then Is_Object (Obj_Id) + then Ren := Renamed_Object (Obj_Id); if Present (Ren) then diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 4198cea..290c380 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -897,6 +897,11 @@ package body Exp_Util is if No (Pool_Id) then return; + -- Do not process allocations from the return stack + + elsif Is_RTE (Pool_Id, RE_RS_Pool) then + return; + -- Do not process allocations on / deallocations from the secondary -- stack, except for access types used to implement indirect temps. @@ -7751,12 +7756,17 @@ package body Exp_Util is -- We must not climb up out of an N_Iterated_xxx_Association -- because the actions might contain references to the loop - -- parameter. But it turns out that setting the Loop_Actions - -- attribute in the case of an N_Component_Association - -- when the attribute was not already set can lead to - -- (as yet not understood) bugboxes (gcc failures that are - -- presumably due to malformed trees). So we don't do that. - + -- parameter, except if we come from the Discrete_Choices of + -- N_Iterated_Component_Association which cannot contain any. + -- But it turns out that setting the Loop_Actions field in + -- the case of an N_Component_Association when the field was + -- not already set can lead to gigi assertion failures that + -- are presumably due to malformed trees, so don't do that. + + and then (Nkind (P) /= N_Iterated_Component_Association + or else not Is_List_Member (N) + or else + List_Containing (N) /= Discrete_Choices (P)) and then (Nkind (P) /= N_Component_Association or else Present (Loop_Actions (P))) then @@ -9917,9 +9927,10 @@ package body Exp_Util is -- Ghost mode. function Make_Predicate_Call - (Typ : Entity_Id; - Expr : Node_Id; - Mem : Boolean := False) return Node_Id + (Typ : Entity_Id; + Expr : Node_Id; + Static_Mem : Boolean := False; + Dynamic_Mem : Node_Id := Empty) return Node_Id is Loc : constant Source_Ptr := Sloc (Expr); @@ -9927,9 +9938,9 @@ package body Exp_Util is Saved_IGR : constant Node_Id := Ignored_Ghost_Region; -- Save the Ghost-related attributes to restore on exit - Call : Node_Id; - Func_Id : Entity_Id; - + Call : Node_Id; + Func_Id : Entity_Id; + Param_Assocs : List_Id; begin Func_Id := Predicate_Function (Typ); pragma Assert (Present (Func_Id)); @@ -9939,12 +9950,6 @@ package body Exp_Util is Set_Ghost_Mode (Typ); - -- Call special membership version if requested and available - - if Mem and then Present (Predicate_Function_M (Typ)) then - Func_Id := Predicate_Function_M (Typ); - end if; - -- Case of calling normal predicate function -- If the type is tagged, the expression may be class-wide, in which @@ -9954,18 +9959,26 @@ package body Exp_Util is -- extensions are involved. if Is_Tagged_Type (Typ) then - Call := - Make_Function_Call (Loc, - Name => New_Occurrence_Of (Func_Id, Loc), - Parameter_Associations => - New_List (OK_Convert_To (Typ, Relocate_Node (Expr)))); + Param_Assocs := New_List (OK_Convert_To (Typ, Relocate_Node (Expr))); else - Call := - Make_Function_Call (Loc, - Name => New_Occurrence_Of (Func_Id, Loc), - Parameter_Associations => New_List (Relocate_Node (Expr))); + Param_Assocs := New_List (Relocate_Node (Expr)); + end if; + + if Predicate_Function_Needs_Membership_Parameter (Typ) then + -- Pass in parameter indicating whether this call is for a + -- membership test. + Append ((if Present (Dynamic_Mem) + then Dynamic_Mem + else New_Occurrence_Of + (Boolean_Literals (Static_Mem), Loc)), + Param_Assocs); end if; + Call := + Make_Function_Call (Loc, + Name => New_Occurrence_Of (Func_Id, Loc), + Parameter_Associations => Param_Assocs); + Restore_Ghost_Region (Saved_GM, Saved_IGR); return Call; @@ -9981,161 +9994,6 @@ package body Exp_Util is is Loc : constant Source_Ptr := Sloc (Expr); - procedure Add_Failure_Expression (Args : List_Id); - -- Add the failure expression of pragma Predicate_Failure (if any) to - -- list Args. - - ---------------------------- - -- Add_Failure_Expression -- - ---------------------------- - - procedure Add_Failure_Expression (Args : List_Id) is - function Failure_Expression return Node_Id; - pragma Inline (Failure_Expression); - -- Find aspect or pragma Predicate_Failure that applies to type Typ - -- and return its expression. Return Empty if no such annotation is - -- available. - - function Is_OK_PF_Aspect (Asp : Node_Id) return Boolean; - pragma Inline (Is_OK_PF_Aspect); - -- Determine whether aspect Asp is a suitable Predicate_Failure - -- aspect that applies to type Typ. - - function Is_OK_PF_Pragma (Prag : Node_Id) return Boolean; - pragma Inline (Is_OK_PF_Pragma); - -- Determine whether pragma Prag is a suitable Predicate_Failure - -- pragma that applies to type Typ. - - procedure Replace_Subtype_Reference (N : Node_Id); - -- Replace the current instance of type Typ denoted by N with - -- expression Expr. - - ------------------------ - -- Failure_Expression -- - ------------------------ - - function Failure_Expression return Node_Id is - Item : Node_Id; - - begin - -- The management of the rep item chain involves "inheritance" of - -- parent type chains. If a parent [sub]type is already subject to - -- pragma Predicate_Failure, then the pragma will also appear in - -- the chain of the child [sub]type, which in turn may possess a - -- pragma of its own. Avoid order-dependent issues by inspecting - -- the rep item chain directly. Note that routine Get_Pragma may - -- return a parent pragma. - - Item := First_Rep_Item (Typ); - while Present (Item) loop - - -- Predicate_Failure appears as an aspect - - if Nkind (Item) = N_Aspect_Specification - and then Is_OK_PF_Aspect (Item) - then - return Expression (Item); - - -- Predicate_Failure appears as a pragma - - elsif Nkind (Item) = N_Pragma - and then Is_OK_PF_Pragma (Item) - then - return - Get_Pragma_Arg - (Next (First (Pragma_Argument_Associations (Item)))); - end if; - - Next_Rep_Item (Item); - end loop; - - return Empty; - end Failure_Expression; - - --------------------- - -- Is_OK_PF_Aspect -- - --------------------- - - function Is_OK_PF_Aspect (Asp : Node_Id) return Boolean is - begin - -- To qualify, the aspect must apply to the type subjected to the - -- predicate check. - - return - Chars (Identifier (Asp)) = Name_Predicate_Failure - and then Present (Entity (Asp)) - and then Entity (Asp) = Typ; - end Is_OK_PF_Aspect; - - --------------------- - -- Is_OK_PF_Pragma -- - --------------------- - - function Is_OK_PF_Pragma (Prag : Node_Id) return Boolean is - Args : constant List_Id := Pragma_Argument_Associations (Prag); - Typ_Arg : Node_Id; - - begin - -- Nothing to do when the pragma does not denote Predicate_Failure - - if Pragma_Name (Prag) /= Name_Predicate_Failure then - return False; - - -- Nothing to do when the pragma lacks arguments, in which case it - -- is illegal. - - elsif Is_Empty_List (Args) then - return False; - end if; - - Typ_Arg := Get_Pragma_Arg (First (Args)); - - -- To qualify, the local name argument of the pragma must denote - -- the type subjected to the predicate check. - - return - Is_Entity_Name (Typ_Arg) - and then Present (Entity (Typ_Arg)) - and then Entity (Typ_Arg) = Typ; - end Is_OK_PF_Pragma; - - -------------------------------- - -- Replace_Subtype_Reference -- - -------------------------------- - - procedure Replace_Subtype_Reference (N : Node_Id) is - begin - Rewrite (N, New_Copy_Tree (Expr)); - end Replace_Subtype_Reference; - - procedure Replace_Subtype_References is - new Replace_Type_References_Generic (Replace_Subtype_Reference); - - -- Local variables - - PF_Expr : constant Node_Id := Failure_Expression; - Expr : Node_Id; - - -- Start of processing for Add_Failure_Expression - - begin - if Present (PF_Expr) then - - -- Replace any occurrences of the current instance of the type - -- with the object subjected to the predicate check. - - Expr := New_Copy_Tree (PF_Expr); - Replace_Subtype_References (Expr, Typ); - - -- The failure expression appears as the third argument of the - -- Check pragma. - - Append_To (Args, - Make_Pragma_Argument_Association (Loc, - Expression => Expr)); - end if; - end Add_Failure_Expression; - -- Local variables Args : List_Id; @@ -10178,8 +10036,6 @@ package body Exp_Util is -- If the subtype is subject to pragma Predicate_Failure, add the -- failure expression as an additional parameter. - Add_Failure_Expression (Args); - return Make_Pragma (Loc, Chars => Name_Check, @@ -12103,7 +11959,7 @@ package body Exp_Util is elsif Nkind (Exp) = N_Unchecked_Type_Conversion and then not Safe_Unchecked_Type_Conversion (Exp) then - if CW_Or_Has_Controlled_Part (Exp_Type) then + if CW_Or_Needs_Finalization (Exp_Type) then -- Use a renaming to capture the expression, rather than create -- a controlled temporary. @@ -12776,7 +12632,6 @@ package body Exp_Util is | N_Block_Statement | N_Entry_Body | N_Package_Body - | N_Protected_Body | N_Subprogram_Body | N_Task_Body => @@ -14330,7 +14185,6 @@ package body Exp_Util is elsif Get_TSS_Name (S) /= TSS_Null and then not Is_Predicate_Function (S) - and then not Is_Predicate_Function_M (S) then return False; end if; diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index d384567..464f66f 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -820,6 +820,8 @@ package Exp_Util is -- Determine whether object Id is related to an expanded return statement. -- The case concerned is "return Id.all;". + -- WARNING: There is a matching C declaration of this subprogram in fe.h + function Is_Renamed_Object (N : Node_Id) return Boolean; -- Returns True if the node N is a renamed object. An expression is -- considered to be a renamed object if either it is the Name of an object @@ -874,13 +876,19 @@ package Exp_Util is -- expression Expr. Expr is passed as an actual parameter in the call. function Make_Predicate_Call - (Typ : Entity_Id; - Expr : Node_Id; - Mem : Boolean := False) return Node_Id; + (Typ : Entity_Id; + Expr : Node_Id; + Static_Mem : Boolean := False; + Dynamic_Mem : Node_Id := Empty) return Node_Id; -- Typ is a type with Predicate_Function set. This routine builds a call to -- this function passing Expr as the argument, and returns it unanalyzed. - -- If Mem is set True, this is the special call for the membership case, - -- and the function called is the Predicate_Function_M if present. + -- If the callee takes a second parameter (as determined by + -- Sem_Util.Predicate_Function_Needs_Membership_Parameter), then the + -- actual parameter is determined by the two Mem parameters. + -- If Dynamic_Mem is nonempty, then Dynamic_Mem is the actual parameter. + -- Otherwise, the value of the Static_Mem parameter is passed in as + -- a Boolean literal. It is an error if Dynamic_Mem is nonempty but + -- the callee does not take a second parameter. function Make_Predicate_Check (Typ : Entity_Id; @@ -1105,8 +1113,8 @@ package Exp_Util is -- 1) controlled objects -- 2) library-level tagged types -- - -- These cases require special actions on scope exit. The flag Lib_Level - -- is set True if the construct is at library level, and False otherwise. + -- These cases require special actions on scope exit. Lib_Level is True if + -- the construct is at library level, and False otherwise. function Safe_Unchecked_Type_Conversion (Exp : Node_Id) return Boolean; -- Given the node for an N_Unchecked_Type_Conversion, return True if this diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h index dc3a1af..bfd9054 100644 --- a/gcc/ada/fe.h +++ b/gcc/ada/fe.h @@ -183,9 +183,11 @@ extern Boolean Is_Init_Proc (Entity_Id); /* exp_util: */ #define Is_Fully_Repped_Tagged_Type exp_util__is_fully_repped_tagged_type +#define Is_Related_To_Func_Return exp_util__is_related_to_func_return #define Find_Interface_Tag exp_util__find_interface_tag -extern Boolean Is_Fully_Repped_Tagged_Type (Entity_Id); +extern Boolean Is_Fully_Repped_Tagged_Type (Entity_Id); +extern Boolean Is_Related_To_Func_Return (Entity_Id); extern Entity_Id Find_Interface_Tag (Entity_Id, Entity_Id); /* lib: */ @@ -207,7 +209,6 @@ extern Boolean In_Extended_Main_Code_Unit (Entity_Id); #define Enable_128bit_Types opt__enable_128bit_types #define Exception_Extra_Info opt__exception_extra_info #define Exception_Locations_Suppressed opt__exception_locations_suppressed -#define Exception_Mechanism opt__exception_mechanism #define Generate_SCO_Instance_Table opt__generate_sco_instance_table #define GNAT_Mode opt__gnat_mode #define List_Representation_Info opt__list_representation_info @@ -218,10 +219,6 @@ typedef enum { Ada_83, Ada_95, Ada_2005, Ada_2012, Ada_2022, Ada_With_Extensions } Ada_Version_Type; -typedef enum { - Back_End_ZCX, Back_End_SJLJ -} Exception_Mechanism_Type; - extern Ada_Version_Type Ada_Version; extern Boolean Assume_No_Invalid_Values; extern Boolean Back_End_Inlining; @@ -229,7 +226,6 @@ extern Boolean Debug_Generated_Code; extern Boolean Enable_128bit_Types; extern Boolean Exception_Extra_Info; extern Boolean Exception_Locations_Suppressed; -extern Exception_Mechanism_Type Exception_Mechanism; extern Boolean Generate_SCO_Instance_Table; extern Boolean GNAT_Mode; extern Int List_Representation_Info; @@ -304,14 +300,14 @@ extern Boolean Compile_Time_Known_Value (Node_Id); #define Is_Expression_Function sem_util__is_expression_function #define Is_Variable_Size_Record sem_util__is_variable_size_record #define Next_Actual sem_util__next_actual -#define Requires_Transient_Scope sem_util__requires_transient_scope +#define Returns_On_Secondary_Stack sem_util__returns_on_secondary_stack -extern Entity_Id Defining_Entity (Node_Id); -extern Node_Id First_Actual (Node_Id); -extern Boolean Is_Expression_Function (Entity_Id); -extern Boolean Is_Variable_Size_Record (Entity_Id); -extern Node_Id Next_Actual (Node_Id); -extern Boolean Requires_Transient_Scope (Entity_Id); +extern Entity_Id Defining_Entity (Node_Id); +extern Node_Id First_Actual (Node_Id); +extern Boolean Is_Expression_Function (Entity_Id); +extern Boolean Is_Variable_Size_Record (Entity_Id); +extern Node_Id Next_Actual (Node_Id); +extern Boolean Returns_On_Secondary_Stack (Entity_Id); /* sinfo: */ @@ -645,12 +641,6 @@ B Is_Floating_Point_Type (E Id); #define Is_Record_Type einfo__utils__is_record_type B Is_Record_Type (E Id); -#define Has_DIC einfo__utils__has_dic -B Has_DIC (E Id); - -#define Has_Invariants einfo__utils__has_invariants -B Has_Invariants (E Id); - #define Is_Full_Access einfo__utils__is_full_access B Is_Full_Access (E Id); @@ -668,12 +658,6 @@ E Next_Stored_Discriminant (E Id); // fe.h is included before einfo.h. Entity_Kind Parameter_Mode (E Id); -#define Is_List_Member einfo__utils__is_list_member -B Is_List_Member (N Node); - -#define List_Containing einfo__utils__list_containing -S List_Containing (N Node); - // The following is needed because Convention in Sem_Util is a renaming // of Basic_Convention. diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 7d90f51..4ff7036 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -184,9 +184,11 @@ package body Freeze is -- the designated type. Otherwise freezing the access type does not freeze -- the designated type. - function Should_Freeze_Type (Typ : Entity_Id; E : Entity_Id) return Boolean; - -- If Typ is in the current scope or in an instantiation, then return True. - -- ???Expression functions (represented by E) shouldn't freeze types in + function Should_Freeze_Type + (Typ : Entity_Id; E : Entity_Id; N : Node_Id) return Boolean; + -- If Typ is in the current scope, then return True. + -- N is a node whose source location corresponds to the freeze point. + -- ??? Expression functions (represented by E) shouldn't freeze types in -- general, but our current expansion and freezing model requires an early -- freezing when the dispatch table is needed or when building an aggregate -- with a subtype of Typ, so return True also in this case. @@ -198,7 +200,7 @@ package body Freeze is ------------------------ function Should_Freeze_Type - (Typ : Entity_Id; E : Entity_Id) return Boolean + (Typ : Entity_Id; E : Entity_Id; N : Node_Id) return Boolean is function Is_Dispatching_Call_Or_Aggregate (N : Node_Id) return Traverse_Result; @@ -244,7 +246,8 @@ package body Freeze is begin return Within_Scope (Typ, Current_Scope) - or else In_Instance + or else (Nkind (N) = N_Subprogram_Renaming_Declaration + and then Present (Corresponding_Formal_Spec (N))) or else (Present (Decl) and then Nkind (Decl) = N_Expression_Function and then Need_Dispatch_Table (Expression (Decl)) = Abandon); @@ -1619,6 +1622,13 @@ package body Freeze is DTW_Spec := Build_Overriding_Spec (Par_Prim, R); DTW_Id := Defining_Entity (DTW_Spec); + -- Clear the not-overriding indicator since the DTW wrapper overrides + -- its wrapped subprogram; required because if present in the parent + -- primitive, given that Build_Overriding_Spec inherits it, we report + -- spurious errors. + + Set_Must_Not_Override (DTW_Spec, False); + -- Add minimal decoration of fields Mutate_Ekind (DTW_Id, Ekind (Par_Prim)); @@ -4599,7 +4609,7 @@ package body Freeze is end if; if not From_Limited_With (F_Type) - and then Should_Freeze_Type (F_Type, E) + and then Should_Freeze_Type (F_Type, E, N) then Freeze_And_Append (F_Type, N, Result); end if; @@ -4779,7 +4789,7 @@ package body Freeze is Set_Etype (E, R_Type); end if; - if Should_Freeze_Type (R_Type, E) then + if Should_Freeze_Type (R_Type, E, N) then Freeze_And_Append (R_Type, N, Result); end if; @@ -6575,9 +6585,13 @@ package body Freeze is end if; end if; - -- Special processing for objects created by object declaration + -- Special processing for objects created by object declaration; + -- we protect the call to Declaration_Node against entities of + -- expressions replaced by the frontend with an N_Raise_CE node. - if Nkind (Declaration_Node (E)) = N_Object_Declaration then + if Ekind (E) in E_Constant | E_Variable + and then Nkind (Declaration_Node (E)) = N_Object_Declaration + then Freeze_Object_Declaration (E); end if; @@ -7957,15 +7971,17 @@ package body Freeze is else -- If the enumeration type interfaces to C, and it has a size clause - -- that specifies less than int size, it warrants a warning. The - -- user may intend the C type to be an enum or a char, so this is + -- that is smaller than the size of int, it warrants a warning. The + -- user may intend the C type to be a boolean or a char, so this is -- not by itself an error that the Ada compiler can detect, but it - -- it is a worth a heads-up. For Boolean and Character types we + -- is worth a heads-up. For Boolean and Character types we -- assume that the programmer has the proper C type in mind. + -- For explicit sizes larger than int, assume the user knows what + -- he is doing and that the code is intentional. if Convention (Typ) = Convention_C and then Has_Size_Clause (Typ) - and then Esize (Typ) /= Esize (Standard_Integer) + and then Esize (Typ) < Standard_Integer_Size and then not Is_Boolean_Type (Typ) and then not Is_Character_Type (Typ) @@ -7974,7 +7990,12 @@ package body Freeze is and then not Target_Short_Enums then Error_Msg_N - ("C enum types have the size of a C int??", Size_Clause (Typ)); + ("??the size of enums in C is implementation-defined", + Size_Clause (Typ)); + Error_Msg_N + ("\??check that the C counterpart has size of " & + UI_Image (Esize (Typ)), + Size_Clause (Typ)); end if; Adjust_Esize_For_Alignment (Typ); diff --git a/gcc/ada/gcc-interface/ada-builtin-types.def b/gcc/ada/gcc-interface/ada-builtin-types.def index f00845b..000d429 100644 --- a/gcc/ada/gcc-interface/ada-builtin-types.def +++ b/gcc/ada/gcc-interface/ada-builtin-types.def @@ -1,7 +1,7 @@ /* This file contains the type definitions for the builtins exclusively used in the GNU Ada compiler. - Copyright (C) 2019 Free Software Foundation, Inc. + Copyright (C) 2019-2022 Free Software Foundation, Inc. This file is part of GCC. @@ -22,4 +22,5 @@ along with GCC; see the file COPYING3. If not see /* See builtin-types.def for details. */ DEF_FUNCTION_TYPE_1 (BT_FN_BOOL_BOOL, BT_BOOL, BT_BOOL) +DEF_FUNCTION_TYPE_1 (BT_FN_PTR_SSIZE, BT_PTR, BT_SSIZE) DEF_FUNCTION_TYPE_2 (BT_FN_BOOL_BOOL_BOOL, BT_BOOL, BT_BOOL, BT_BOOL) diff --git a/gcc/ada/gcc-interface/ada-builtins.def b/gcc/ada/gcc-interface/ada-builtins.def index dcdc4d9..8ba89a8 100644 --- a/gcc/ada/gcc-interface/ada-builtins.def +++ b/gcc/ada/gcc-interface/ada-builtins.def @@ -1,7 +1,7 @@ /* This file contains the definitions for the builtins exclusively used in the GNU Ada compiler. - Copyright (C) 2019 Free Software Foundation, Inc. + Copyright (C) 2019-2022 Free Software Foundation, Inc. This file is part of GCC. @@ -28,3 +28,4 @@ along with GCC; see the file COPYING3. If not see DEF_ADA_BUILTIN (BUILT_IN_EXPECT, "expect", BT_FN_BOOL_BOOL_BOOL, ATTR_CONST_NOTHROW_LEAF_LIST) DEF_ADA_BUILTIN (BUILT_IN_LIKELY, "likely", BT_FN_BOOL_BOOL, ATTR_CONST_NOTHROW_LEAF_LIST) DEF_ADA_BUILTIN (BUILT_IN_UNLIKELY, "unlikely", BT_FN_BOOL_BOOL, ATTR_CONST_NOTHROW_LEAF_LIST) +DEF_ADA_BUILTIN (BUILT_IN_RETURN_SLOT, "return_slot", BT_FN_PTR_SSIZE, ATTR_CONST_NOTHROW_LEAF_LIST) diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h index 0ec81bc..ec52024 100644 --- a/gcc/ada/gcc-interface/ada-tree.h +++ b/gcc/ada/gcc-interface/ada-tree.h @@ -6,7 +6,7 @@ * * * C Header File * * * - * Copyright (C) 1992-2021, Free Software Foundation, Inc. * + * Copyright (C) 1992-2022, 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- * @@ -577,5 +577,6 @@ do { \ /* Small kludge to be able to define Ada built-in functions locally. We overload them on top of the C++ coroutines builtin functions. */ -#define BUILT_IN_LIKELY BUILT_IN_CORO_PROMISE -#define BUILT_IN_UNLIKELY BUILT_IN_CORO_RESUME +#define BUILT_IN_LIKELY BUILT_IN_CORO_PROMISE +#define BUILT_IN_UNLIKELY BUILT_IN_CORO_RESUME +#define BUILT_IN_RETURN_SLOT BUILT_IN_CORO_DESTROY diff --git a/gcc/ada/gcc-interface/ada.h b/gcc/ada/gcc-interface/ada.h index 242a14e..d9efb63 100644 --- a/gcc/ada/gcc-interface/ada.h +++ b/gcc/ada/gcc-interface/ada.h @@ -6,7 +6,7 @@ * * * C Header File * * * - * Copyright (C) 1992-2021, Free Software Foundation, Inc. * + * Copyright (C) 1992-2022, 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- * diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc index 28e1ab7..50d17f7 100644 --- a/gcc/ada/gcc-interface/decl.cc +++ b/gcc/ada/gcc-interface/decl.cc @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 1992-2021, Free Software Foundation, Inc. * + * Copyright (C) 1992-2022, 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- * @@ -363,10 +363,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) if (Is_Type (gnat_temp)) gnat_temp = Underlying_Type (gnat_temp); - if (Ekind (gnat_temp) == E_Subprogram_Body) - gnat_temp - = Corresponding_Spec (Parent (Declaration_Node (gnat_temp))); - if (Is_Subprogram (gnat_temp) && Present (Protected_Body_Subprogram (gnat_temp))) gnat_temp = Protected_Body_Subprogram (gnat_temp); @@ -634,6 +630,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) break; case E_Constant: + /* If this is a constant related to a return in a function returning by + invisible reference without expression, get the return object. */ + if (Is_Related_To_Func_Return (gnat_entity) + && current_function_decl + && TREE_ADDRESSABLE (TREE_TYPE (current_function_decl)) + && !gnu_expr) + { + gnu_decl = DECL_RESULT (current_function_decl); + break; + } + /* Ignore constant definitions already marked with the error node. See the N_Object_Declaration case of gnat_to_gnu for the rationale. */ if (definition @@ -2138,6 +2145,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) suppress expanding incomplete types. */ gnu_type = make_node (UNCONSTRAINED_ARRAY_TYPE); + /* The component may refer to this type, so defer completion of any + incomplete types. */ if (!definition) { defer_incomplete_level++; @@ -3070,7 +3079,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) process_attributes (&gnu_type, &attr_list, true, gnat_entity); - /* If we are not defining it, suppress expanding incomplete types. */ + /* Some component may refer to this type, so defer completion of any + incomplete types. */ if (!definition) { defer_incomplete_level++; @@ -3443,7 +3453,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) { Entity_Id gnat_base_type = Implementation_Base_Type (gnat_entity); - if (!definition) + /* Some component may refer to this type, so defer completion of any + incomplete types. We also need to do it for the special subtypes + designated by access subtypes in case they are recursive, see the + E_Access_Subtype case below. */ + if (!definition + || (Is_Itype (gnat_entity) + && Is_Frozen (gnat_entity) + && No (Freeze_Node (gnat_entity)))) { defer_incomplete_level++; this_deferred = true; @@ -3840,17 +3857,18 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) maybe_present = true; /* The designated subtype must be elaborated as well, if it does - not have its own freeze node. But designated subtypes created - for constrained components of records with discriminants are - not frozen by the front-end and not elaborated here, because - their use may appear before the base type is frozen and it is - not clear that they are needed in gigi. With the current model, - there is no correct place where they could be elaborated. */ + not have its own freeze node. */ if (Is_Itype (Directly_Designated_Type (gnat_entity)) && !present_gnu_tree (Directly_Designated_Type (gnat_entity)) && Is_Frozen (Directly_Designated_Type (gnat_entity)) && No (Freeze_Node (Directly_Designated_Type (gnat_entity)))) { + tree gnu_base_type = TREE_TYPE (gnu_decl); + tree gnu_desig_base_type + = TYPE_IS_FAT_POINTER_P (gnu_base_type) + ? TREE_TYPE (TREE_TYPE (TYPE_FIELDS (gnu_base_type))) + : TREE_TYPE (gnu_base_type); + /* If we are to defer elaborating incomplete types, make a dummy type node and elaborate it later. */ if (defer_incomplete_level != 0) @@ -3863,8 +3881,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) p->next = defer_incomplete_list; defer_incomplete_list = p; } - else if (!Is_Incomplete_Or_Private_Type - (Base_Type (Directly_Designated_Type (gnat_entity)))) + + /* Otherwise elaborate the designated subtype only if its base type + has already been elaborated. */ + else if (!TYPE_IS_DUMMY_P (gnu_desig_base_type)) gnat_to_gnu_entity (Directly_Designated_Type (gnat_entity), NULL_TREE, false); } @@ -3993,6 +4013,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) { gnu_decl = gnu_type; gnu_type = TREE_TYPE (gnu_decl); + process_attributes (&gnu_decl, &attr_list, true, gnat_entity); break; } @@ -5041,6 +5062,13 @@ inline_status_for_subprog (Entity_Id subprog) && compare_tree_int (TYPE_SIZE (gnu_type), MAX_FIXED_MODE_SIZE) <= 0) return is_prescribed; + /* If this is an expression function and we're not optimizing for size, + override the heuristics, unless -gnatd.8 is specified. */ + if (Is_Expression_Function (subprog) + && !optimize_size + && !Debug_Flag_Dot_8) + return is_prescribed; + return is_requested; } @@ -5835,10 +5863,8 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, return_unconstrained_p = true; } - /* Likewise, if the return type requires a transient scope, the return - value will also be allocated on the secondary stack so the actual - return type is the reference type. */ - else if (Requires_Transient_Scope (gnat_return_type)) + /* This is for the other types returned on the secondary stack. */ + else if (Returns_On_Secondary_Stack (gnat_return_type)) { gnu_return_type = build_reference_type (gnu_return_type); return_unconstrained_p = true; @@ -6850,7 +6876,9 @@ prepend_one_attribute_pragma (struct attrib **attr_list, Node_Id gnat_pragma) const char *const p = TREE_STRING_POINTER (gnu_arg1); const bool string_args - = strcmp (p, "target") == 0 || strcmp (p, "target_clones") == 0; + = strcmp (p, "simd") == 0 + || strcmp (p, "target") == 0 + || strcmp (p, "target_clones") == 0; gnu_arg1 = get_identifier (p); if (IDENTIFIER_LENGTH (gnu_arg1) == 0) return; @@ -7967,6 +7995,7 @@ components_to_record (Node_Id gnat_component_list, Entity_Id gnat_record_type, tree gnu_union_type; tree this_first_free_pos, gnu_variant_list = NULL_TREE; bool union_field_needs_strict_alignment = false; + bool innermost_variant_level = true; auto_vec <vinfo_t, 16> variant_types; vinfo_t *gnu_variant; unsigned int variants_align = 0; @@ -8012,6 +8041,19 @@ components_to_record (Node_Id gnat_component_list, Entity_Id gnat_record_type, } } + /* For an unchecked union with a fixed part, we need to compute whether + we are at the innermost level of the variant part. */ + if (unchecked_union && gnu_field_list) + for (variant = First_Non_Pragma (Variants (gnat_variant_part)); + Present (variant); + variant = Next_Non_Pragma (variant)) + if (Present (Component_List (variant)) + && Present (Variant_Part (Component_List (variant)))) + { + innermost_variant_level = false; + break; + } + /* We build the variants in two passes. The bulk of the work is done in the first pass, that is to say translating the GNAT nodes, building the container types and computing the associated properties. However @@ -8052,11 +8094,12 @@ components_to_record (Node_Id gnat_component_list, Entity_Id gnat_record_type, /* Add the fields into the record type for the variant but note that we aren't sure to really use it at this point, see below. In the - case of an unchecked union, we force the fields with a rep clause - present in a nested variant to be moved to the outermost variant, - so as to flatten the rep-ed layout as much as possible, the reason - being that we cannot do any flattening when a subtype statically - selects a variant later on, for example for an aggregate. */ + case of an unchecked union with a fixed part, we force the fields + with a rep clause present in the innermost variant to be moved to + the outer variant, so as to flatten the rep-ed layout as much as + possible, the reason being that we cannot do any flattening when + a subtype statically selects a variant later on, for example for + an aggregate. */ has_rep = components_to_record (Component_List (variant), gnat_record_type, NULL_TREE, gnu_variant_type, packed, @@ -8064,7 +8107,9 @@ components_to_record (Node_Id gnat_component_list, Entity_Id gnat_record_type, unchecked_union, true, needs_xv_encodings, true, this_first_free_pos, (all_rep || this_first_free_pos) - && !(in_variant && unchecked_union) + && !(unchecked_union + && gnu_field_list + && innermost_variant_level) ? NULL : &gnu_rep_list); /* Translate the qualifier and annotate the GNAT node. */ diff --git a/gcc/ada/gcc-interface/gadaint.h b/gcc/ada/gcc-interface/gadaint.h index 89b9a11..ac80eeb 100644 --- a/gcc/ada/gcc-interface/gadaint.h +++ b/gcc/ada/gcc-interface/gadaint.h @@ -6,7 +6,7 @@ * * * C Header File * * * - * Copyright (C) 2010-2021, Free Software Foundation, Inc. * + * Copyright (C) 2010-2022, 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- * diff --git a/gcc/ada/gcc-interface/targtyps.cc b/gcc/ada/gcc-interface/targtyps.cc index fb103a1..84949e3 100644 --- a/gcc/ada/gcc-interface/targtyps.cc +++ b/gcc/ada/gcc-interface/targtyps.cc @@ -4,7 +4,7 @@ * * * T A R G T Y P S * * * - * Body * + * C Implementation File * * * * Copyright (C) 1992-2021, Free Software Foundation, Inc. * * * diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc index 5741986..e80200e 100644 --- a/gcc/ada/gcc-interface/trans.cc +++ b/gcc/ada/gcc-interface/trans.cc @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 1992-2021, Free Software Foundation, Inc. * + * Copyright (C) 1992-2022, 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- * @@ -1149,9 +1149,9 @@ Gigi_Types_Compatible (Entity_Id type, Entity_Id def_type) return false; } -/* Subroutine of gnat_to_gnu to translate gnat_node, an N_Identifier, - to a GCC tree, which is returned. GNU_RESULT_TYPE_P is a pointer - to where we should place the result type. */ +/* Subroutine of gnat_to_gnu to translate GNAT_NODE, an N_Identifier, to a GCC + tree, which is returned. GNU_RESULT_TYPE_P is a pointer to where we should + place the result type. */ static tree Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) @@ -1353,8 +1353,8 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) return gnu_result; } -/* Subroutine of gnat_to_gnu to process gnat_node, an N_Pragma. Return - any statements we generate. */ +/* Subroutine of gnat_to_gnu to translate GNAT_NODE, an N_Pragma, to a GCC + tree, which is returned. */ static tree Pragma_to_gnu (Node_Id gnat_node) @@ -1700,9 +1700,9 @@ get_type_length (tree type, tree result_type) return length; } -/* Subroutine of gnat_to_gnu to translate GNAT_NODE, an N_Attribute node, - to a GCC tree, which is returned. GNU_RESULT_TYPE_P is a pointer to - where we should place the result type. ATTRIBUTE is the attribute ID. */ +/* Subroutine of gnat_to_gnu to translate GNAT_NODE, an N_Attribute node, to a + GCC tree, which is returned. GNU_RESULT_TYPE_P is a pointer to where we + should place the result type. ATTRIBUTE is the attribute ID. */ static tree Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) @@ -2613,8 +2613,8 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) return gnu_result; } -/* Subroutine of gnat_to_gnu to translate gnat_node, an N_Case_Statement, - to a GCC tree, which is returned. */ +/* Subroutine of gnat_to_gnu to translate GNAT_NODE, an N_Case_Statement, to a + GCC tree, which is returned. */ static tree Case_Statement_to_gnu (Node_Id gnat_node) @@ -2951,8 +2951,8 @@ independent_iterations_p (tree stmt_list) return true; } -/* Subroutine of gnat_to_gnu to translate gnat_node, an N_Loop_Statement, - to a GCC tree, which is returned. */ +/* Subroutine of gnat_to_gnu to translate GNAT_NODE, an N_Loop_Statement, to a + GCC tree, which is returned. */ static tree Loop_Statement_to_gnu (Node_Id gnat_node) @@ -3836,23 +3836,20 @@ build_return_expr (tree ret_obj, tree ret_val) return build1 (RETURN_EXPR, void_type_node, result_expr); } -/* Subroutine of gnat_to_gnu to process gnat_node, an N_Subprogram_Body. We - don't return anything. */ +/* Subroutine of gnat_to_gnu to translate GNAT_NODE, an N_Subprogram_Body. */ static void Subprogram_Body_to_gnu (Node_Id gnat_node) { - /* Defining identifier of a parameter to the subprogram. */ - Entity_Id gnat_param; /* The defining identifier for the subprogram body. Note that if a specification has appeared before for this body, then the identifier - occurring in that specification will also be a defining identifier and all - the calls to this subprogram will point to that specification. */ - Entity_Id gnat_subprog_id + occurring in that specification will also be a defining identifier + and calls to this subprogram will point to that specification. */ + Entity_Id gnat_subprog = (Present (Corresponding_Spec (gnat_node)) ? Corresponding_Spec (gnat_node) : Defining_Entity (gnat_node)); - /* The FUNCTION_DECL node corresponding to the subprogram spec. */ - tree gnu_subprog_decl; + /* The FUNCTION_DECL node corresponding to the defining identifier. */ + tree gnu_subprog; /* Its RESULT_DECL node. */ tree gnu_result_decl; /* Its FUNCTION_TYPE node. */ @@ -3860,17 +3857,12 @@ Subprogram_Body_to_gnu (Node_Id gnat_node) /* The TYPE_CI_CO_LIST of its FUNCTION_TYPE node, if any. */ tree gnu_cico_list; /* The entry in the CI_CO_LIST that represents a function return, if any. */ - tree gnu_return_var_elmt = NULL_TREE; - tree gnu_result; + tree gnu_return_var_elmt; + /* Its source location. */ location_t locus; - struct language_function *gnu_subprog_language; - vec<parm_attr, va_gc> *cache; - - /* If this is a generic object or if it has been eliminated, - ignore it. */ - if (Ekind (gnat_subprog_id) == E_Generic_Procedure - || Ekind (gnat_subprog_id) == E_Generic_Function - || Is_Eliminated (gnat_subprog_id)) + + /* If this is a generic subprogram or it has been eliminated, ignore it. */ + if (Is_Generic_Subprogram (gnat_subprog) || Is_Eliminated (gnat_subprog)) return; /* If this subprogram acts as its own spec, define it. Otherwise, just get @@ -3879,19 +3871,21 @@ Subprogram_Body_to_gnu (Node_Id gnat_node) treat it as not being defined in that case. Such a subprogram cannot have an address clause or a freeze node, so this test is safe, though it does disable some otherwise-useful error checking. */ - gnu_subprog_decl - = gnat_to_gnu_entity (gnat_subprog_id, NULL_TREE, + gnu_subprog + = gnat_to_gnu_entity (gnat_subprog, NULL_TREE, Acts_As_Spec (gnat_node) - && !present_gnu_tree (gnat_subprog_id)); - DECL_FUNCTION_IS_DEF (gnu_subprog_decl) = true; - gnu_result_decl = DECL_RESULT (gnu_subprog_decl); - gnu_subprog_type = TREE_TYPE (gnu_subprog_decl); + && !present_gnu_tree (gnat_subprog)); + DECL_FUNCTION_IS_DEF (gnu_subprog) = true; + gnu_result_decl = DECL_RESULT (gnu_subprog); + gnu_subprog_type = TREE_TYPE (gnu_subprog); gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type); if (gnu_cico_list && TREE_VALUE (gnu_cico_list) == void_type_node) gnu_return_var_elmt = gnu_cico_list; + else + gnu_return_var_elmt = NULL_TREE; /* If the function returns by invisible reference, make it explicit in the - function body. See gnat_to_gnu_entity, E_Subprogram_Type case. */ + function body. See gnat_to_gnu_subprog_type for more details. */ if (TREE_ADDRESSABLE (gnu_subprog_type)) { TREE_TYPE (gnu_result_decl) @@ -3900,30 +3894,25 @@ Subprogram_Body_to_gnu (Node_Id gnat_node) } /* Set the line number in the decl to correspond to that of the body. */ - if (DECL_IGNORED_P (gnu_subprog_decl)) + if (DECL_IGNORED_P (gnu_subprog)) locus = UNKNOWN_LOCATION; - else if (!Sloc_to_locus (Sloc (gnat_node), &locus, false, gnu_subprog_decl)) + else if (!Sloc_to_locus (Sloc (gnat_node), &locus, false, gnu_subprog)) locus = input_location; - DECL_SOURCE_LOCATION (gnu_subprog_decl) = locus; - - /* If the body comes from an expression function, arrange it to be inlined - in almost all cases. */ - if (Was_Expression_Function (gnat_node) && !Debug_Flag_Dot_8) - DECL_DISREGARD_INLINE_LIMITS (gnu_subprog_decl) = 1; + DECL_SOURCE_LOCATION (gnu_subprog) = locus; /* Try to create a bona-fide thunk and hand it over to the middle-end. */ - if (Is_Thunk (gnat_subprog_id) - && maybe_make_gnu_thunk (gnat_subprog_id, gnu_subprog_decl)) + if (Is_Thunk (gnat_subprog) + && maybe_make_gnu_thunk (gnat_subprog, gnu_subprog)) return; /* Initialize the information structure for the function. */ - allocate_struct_function (gnu_subprog_decl, false); - gnu_subprog_language = ggc_cleared_alloc<language_function> (); - DECL_STRUCT_FUNCTION (gnu_subprog_decl)->language = gnu_subprog_language; - DECL_STRUCT_FUNCTION (gnu_subprog_decl)->function_start_locus = locus; + allocate_struct_function (gnu_subprog, false); + language_function *gnu_subprog_lang = ggc_cleared_alloc<language_function> (); + DECL_STRUCT_FUNCTION (gnu_subprog)->language = gnu_subprog_lang; + DECL_STRUCT_FUNCTION (gnu_subprog)->function_start_locus = locus; set_cfun (NULL); - begin_subprog_body (gnu_subprog_decl); + begin_subprog_body (gnu_subprog); /* If there are copy-in/copy-out parameters, we need to ensure that they are properly copied out by the return statement. We do this by making a new @@ -3931,7 +3920,7 @@ Subprogram_Body_to_gnu (Node_Id gnat_node) block. */ if (gnu_cico_list) { - tree gnu_return_var = NULL_TREE; + tree gnu_return_var; vec_safe_push (gnu_return_label_stack, create_artificial_label (input_location)); @@ -3951,9 +3940,11 @@ Subprogram_Body_to_gnu (Node_Id gnat_node) = create_var_decl (get_identifier ("RETVAL"), NULL_TREE, gnu_return_type, NULL_TREE, false, false, false, false, false, - true, false, NULL, gnat_subprog_id); + true, false, NULL, gnat_subprog); TREE_VALUE (gnu_return_var_elmt) = gnu_return_var; } + else + gnu_return_var = NULL_TREE; vec_safe_push (gnu_return_var_stack, gnu_return_var); @@ -3962,7 +3953,7 @@ Subprogram_Body_to_gnu (Node_Id gnat_node) put it into TYPE_CI_CO_LIST, which must contain an empty entry too. We can match up the entries because TYPE_CI_CO_LIST is in the order of the parameters. */ - for (gnat_param = First_Formal_With_Extras (gnat_subprog_id); + for (Entity_Id gnat_param = First_Formal_With_Extras (gnat_subprog); Present (gnat_param); gnat_param = Next_Formal_With_Extras (gnat_param)) if (!present_gnu_tree (gnat_param)) @@ -3993,23 +3984,25 @@ Subprogram_Body_to_gnu (Node_Id gnat_node) start_stmt_group (); gnat_pushlevel (); + /* First translate the declarations of the subprogram. */ process_decls (Declarations (gnat_node), Empty, Empty, true, true); - /* Generate the code of the subprogram itself. A return statement will be - present and any Out parameters will be handled there. */ + /* Then generate the code of the subprogram itself. A return statement will + be present and any Out parameters will be handled there. */ add_stmt (gnat_to_gnu (Handled_Statement_Sequence (gnat_node))); + gnat_poplevel (); - gnu_result = end_stmt_group (); + tree gnu_result = end_stmt_group (); /* Attempt setting the end_locus of our GCC body tree, typically a BIND_EXPR, then the end_locus of our GCC subprogram declaration tree. */ set_end_locus_from_node (gnu_result, gnat_node); - set_end_locus_from_node (gnu_subprog_decl, gnat_node); + set_end_locus_from_node (gnu_subprog, gnat_node); /* If we populated the parameter attributes cache, we need to make sure that the cached expressions are evaluated on all the possible paths leading to their uses. So we force their evaluation on entry of the function. */ - cache = gnu_subprog_language->parm_attr_cache; + vec<parm_attr, va_gc> *cache = gnu_subprog_lang->parm_attr_cache; if (cache) { struct parm_attr_d *pa; @@ -4030,7 +4023,7 @@ Subprogram_Body_to_gnu (Node_Id gnat_node) add_stmt (gnu_result); gnu_result = end_stmt_group (); - gnu_subprog_language->parm_attr_cache = NULL; + gnu_subprog_lang->parm_attr_cache = NULL; } /* If we are dealing with a return from an Ada procedure with parameters @@ -4102,7 +4095,7 @@ Subprogram_Body_to_gnu (Node_Id gnat_node) /* On SEH targets, install an exception handler around the main entry point to catch unhandled exceptions. */ - if (DECL_NAME (gnu_subprog_decl) == main_identifier_node + if (DECL_NAME (gnu_subprog) == main_identifier_node && targetm_common.except_unwind_info (&global_options) == UI_SEH) { tree t; @@ -4124,7 +4117,7 @@ Subprogram_Body_to_gnu (Node_Id gnat_node) /* Finally annotate the parameters and disconnect the trees for parameters that we have turned into variables since they are now unusable. */ - for (gnat_param = First_Formal_With_Extras (gnat_subprog_id); + for (Entity_Id gnat_param = First_Formal_With_Extras (gnat_subprog); Present (gnat_param); gnat_param = Next_Formal_With_Extras (gnat_param)) { @@ -4144,22 +4137,22 @@ Subprogram_Body_to_gnu (Node_Id gnat_node) /* If the function returns an aggregate type and we have candidates for a Named Return Value, finalize the optimization. */ - if (optimize && !optimize_debug && gnu_subprog_language->named_ret_val) + if (optimize && !optimize_debug && gnu_subprog_lang->named_ret_val) { - finalize_nrv (gnu_subprog_decl, - gnu_subprog_language->named_ret_val, - gnu_subprog_language->other_ret_val, - gnu_subprog_language->gnat_ret); - gnu_subprog_language->named_ret_val = NULL; - gnu_subprog_language->other_ret_val = NULL; + finalize_nrv (gnu_subprog, + gnu_subprog_lang->named_ret_val, + gnu_subprog_lang->other_ret_val, + gnu_subprog_lang->gnat_ret); + gnu_subprog_lang->named_ret_val = NULL; + gnu_subprog_lang->other_ret_val = NULL; } /* If this is an inlined external function that has been marked uninlinable, drop the body and stop there. Otherwise compile the body. */ - if (DECL_EXTERNAL (gnu_subprog_decl) && DECL_UNINLINABLE (gnu_subprog_decl)) - DECL_SAVED_TREE (gnu_subprog_decl) = NULL_TREE; + if (DECL_EXTERNAL (gnu_subprog) && DECL_UNINLINABLE (gnu_subprog)) + DECL_SAVED_TREE (gnu_subprog) = NULL_TREE; else - rest_of_subprog_body_compilation (gnu_subprog_decl); + rest_of_subprog_body_compilation (gnu_subprog); } /* The type of an atomic access. */ @@ -4471,7 +4464,7 @@ elaborate_profile (Entity_Id first_formal, Entity_Id result_type) (void) gnat_to_gnu_type (result_type); } -/* Subroutine of gnat_to_gnu to translate gnat_node, either an N_Function_Call +/* Subroutine of gnat_to_gnu to translate GNAT_NODE, 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 @@ -5288,6 +5281,15 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, && return_slot_opt_for_pure_call_p (gnu_target, gnu_call)) op_code = INIT_EXPR; + /* If this is the initialization of a return object in a function + returning by invisible reference, we can always use the return + slot optimization. */ + else if (TREE_CODE (gnu_target) == INDIRECT_REF + && TREE_CODE (TREE_OPERAND (gnu_target, 0)) == RESULT_DECL + && current_function_decl + && TREE_ADDRESSABLE (TREE_TYPE (current_function_decl))) + op_code = INIT_EXPR; + else op_code = MODIFY_EXPR; @@ -5351,7 +5353,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, return gnu_result; } -/* Subroutine of gnat_to_gnu to translate gnat_node, an +/* Subroutine of gnat_to_gnu to translate GNAT_NODE, an N_Handled_Sequence_Of_Statements, to a GCC tree, which is returned. */ static tree @@ -5495,12 +5497,11 @@ stmt_list_cannot_alter_control_flow_p (List_Id gnat_list) return true; } -/* Subroutine of gnat_to_gnu to translate gnat_node, an N_Exception_Handler, - to a GCC tree, which is returned. This is the variant for GCC exception - schemes. */ +/* Subroutine of gnat_to_gnu to translate GNAT_NODE, an N_Exception_Handler, + to a GCC tree, which is returned. */ static tree -Exception_Handler_to_gnu_gcc (Node_Id gnat_node) +Exception_Handler_to_gnu (Node_Id gnat_node) { tree gnu_etypes_list = NULL_TREE; @@ -5672,7 +5673,7 @@ Exception_Handler_to_gnu_gcc (Node_Id gnat_node) build2 (CATCH_EXPR, void_type_node, gnu_etypes_list, end_stmt_group ()); } -/* Subroutine of gnat_to_gnu to generate code for an N_Compilation unit. */ +/* Subroutine of gnat_to_gnu to translate GNAT_NODE, an N_Compilation_Unit. */ static void Compilation_Unit_to_gnu (Node_Id gnat_node) @@ -5853,8 +5854,8 @@ Range_to_gnu (Node_Id gnat_range, tree *gnu_low, tree *gnu_high) } /* Subroutine of gnat_to_gnu to translate GNAT_NODE, an N_Raise_xxx_Error, - to a GCC tree and return it. GNU_RESULT_TYPE_P is a pointer to where - we should place the result type. */ + to a GCC tree, which is returned. GNU_RESULT_TYPE_P is a pointer to + where we should place the result type. */ static tree Raise_Error_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) @@ -6147,7 +6148,8 @@ gnat_to_gnu (Node_Id gnat_node) bool aa_sync; /* Save node number for error message and set location information. */ - Current_Error_Node = gnat_node; + if (Sloc (gnat_node) > No_Location) + Current_Error_Node = gnat_node; Sloc_to_locus (Sloc (gnat_node), &input_location); /* If we are only annotating types and this node is a statement, return @@ -6387,6 +6389,39 @@ gnat_to_gnu (Node_Id gnat_node) || Is_Concurrent_Type (Etype (gnat_temp)))) break; + /* If this is a constant related to a return initialized by a reference + to a function call in a function returning by invisible reference: + + type Ann is access all Result_Type; + Rnn : constant Ann := Func'reference; + [...] + return Rnn.all; + + then elide the temporary by forwarding the return object to Func: + + *<retval> = Func (); [return slot optimization] + [...] + return <retval>; + + That's necessary if the result type needs finalization because the + temporary would never be adjusted as Expand_Simple_Function_Return + also elides the temporary in this case. */ + if (Ekind (gnat_temp) == E_Constant + && Is_Related_To_Func_Return (gnat_temp) + && Nkind (Expression (gnat_node)) == N_Reference + && Nkind (Prefix (Expression (gnat_node))) == N_Function_Call + && current_function_decl + && TREE_ADDRESSABLE (TREE_TYPE (current_function_decl))) + { + gnu_result = gnat_to_gnu_entity (gnat_temp, NULL_TREE, true); + gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_result); + gnu_result + = Call_to_gnu (Prefix (Expression (gnat_node)), + &gnu_result_type, gnu_result, + NOT_ATOMIC, false); + break; + } + if (Present (Expression (gnat_node)) && !(kind == N_Object_Declaration && No_Initialization (gnat_node)) && (!type_annotate_only @@ -7464,6 +7499,14 @@ gnat_to_gnu (Node_Id gnat_node) gnu_ret_obj); gnu_result = build2 (INIT_EXPR, void_type_node, gnu_ret_deref, gnu_ret_val); + /* Avoid a useless copy with __builtin_return_slot. */ + if (TREE_CODE (gnu_ret_val) == INDIRECT_REF) + gnu_result + = build3 (COND_EXPR, void_type_node, + fold_build2 (NE_EXPR, boolean_type_node, + TREE_OPERAND (gnu_ret_val, 0), + gnu_ret_obj), + gnu_result, NULL_TREE); add_stmt_with_node (gnu_result, gnat_node); gnu_ret_val = NULL_TREE; } @@ -7679,7 +7722,7 @@ gnat_to_gnu (Node_Id gnat_node) break; case N_Exception_Handler: - gnu_result = Exception_Handler_to_gnu_gcc (gnat_node); + gnu_result = Exception_Handler_to_gnu (gnat_node); break; case N_Raise_Statement: @@ -8637,30 +8680,6 @@ gnat_gimplify_expr (tree *expr_p, gimple_seq *pre_p, switch (TREE_CODE (expr)) { - case NULL_EXPR: - /* If this is an aggregate type, build a null pointer of the appropriate - type and dereference it. */ - if (AGGREGATE_TYPE_P (type) - || TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE) - *expr_p = build_unary_op (INDIRECT_REF, NULL_TREE, - convert (build_pointer_type (type), - integer_zero_node)); - /* Otherwise, just make a VAR_DECL. */ - else - { - *expr_p = create_tmp_var (type, NULL); - suppress_warning (*expr_p); - } - - gimplify_and_add (TREE_OPERAND (expr, 0), pre_p); - return GS_OK; - - case UNCONSTRAINED_ARRAY_REF: - /* We should only do this if we are just elaborating for side-effects, - but we can't know that yet. */ - *expr_p = TREE_OPERAND (*expr_p, 0); - return GS_OK; - case ADDR_EXPR: op = TREE_OPERAND (expr, 0); @@ -8694,8 +8713,7 @@ gnat_gimplify_expr (tree *expr_p, gimple_seq *pre_p, else op = inner; } - - return GS_UNHANDLED; + break; case CALL_EXPR: /* If we are passing a constant fat pointer CONSTRUCTOR, make sure it is @@ -8719,8 +8737,62 @@ gnat_gimplify_expr (tree *expr_p, gimple_seq *pre_p, *(CALL_EXPR_ARGP (expr) + i) = tree_output_constant_def (arg); } } + break; + + case DECL_EXPR: + op = DECL_EXPR_DECL (expr); + + /* The expressions for the RM bounds must be gimplified to ensure that + they are properly elaborated. See gimplify_decl_expr. */ + if ((TREE_CODE (op) == TYPE_DECL || TREE_CODE (op) == VAR_DECL) + && !TYPE_SIZES_GIMPLIFIED (TREE_TYPE (op)) + && (INTEGRAL_TYPE_P (TREE_TYPE (op)) + || SCALAR_FLOAT_TYPE_P (TREE_TYPE (op)))) + { + tree type = TYPE_MAIN_VARIANT (TREE_TYPE (op)), t, val; - return GS_UNHANDLED; + val = TYPE_RM_MIN_VALUE (type); + if (val) + { + gimplify_one_sizepos (&val, pre_p); + for (t = type; t; t = TYPE_NEXT_VARIANT (t)) + SET_TYPE_RM_MIN_VALUE (t, val); + } + + val = TYPE_RM_MAX_VALUE (type); + if (val) + { + gimplify_one_sizepos (&val, pre_p); + for (t = type; t; t = TYPE_NEXT_VARIANT (t)) + SET_TYPE_RM_MAX_VALUE (t, val); + } + } + break; + + case NULL_EXPR: + /* If this is an aggregate type, build a null pointer of the appropriate + type and dereference it. */ + if (AGGREGATE_TYPE_P (type) + || TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE) + *expr_p = build_unary_op (INDIRECT_REF, NULL_TREE, + convert (build_pointer_type (type), + integer_zero_node)); + + /* Otherwise, just make a VAR_DECL. */ + else + { + *expr_p = create_tmp_var (type, NULL); + suppress_warning (*expr_p); + } + + gimplify_and_add (TREE_OPERAND (expr, 0), pre_p); + return GS_OK; + + case UNCONSTRAINED_ARRAY_REF: + /* We should only do this if we are just elaborating for side effects, + but we can't know that yet. */ + *expr_p = TREE_OPERAND (*expr_p, 0); + return GS_OK; case VIEW_CONVERT_EXPR: op = TREE_OPERAND (expr, 0); @@ -8741,53 +8813,13 @@ gnat_gimplify_expr (tree *expr_p, gimple_seq *pre_p, TREE_OPERAND (expr, 0) = new_var; return GS_OK; } - - return GS_UNHANDLED; - - case DECL_EXPR: - op = DECL_EXPR_DECL (expr); - - /* The expressions for the RM bounds must be gimplified to ensure that - they are properly elaborated. See gimplify_decl_expr. */ - if ((TREE_CODE (op) == TYPE_DECL || TREE_CODE (op) == VAR_DECL) - && !TYPE_SIZES_GIMPLIFIED (TREE_TYPE (op))) - switch (TREE_CODE (TREE_TYPE (op))) - { - case INTEGER_TYPE: - case ENUMERAL_TYPE: - case BOOLEAN_TYPE: - case REAL_TYPE: - { - tree type = TYPE_MAIN_VARIANT (TREE_TYPE (op)), t, val; - - val = TYPE_RM_MIN_VALUE (type); - if (val) - { - gimplify_one_sizepos (&val, pre_p); - for (t = type; t; t = TYPE_NEXT_VARIANT (t)) - SET_TYPE_RM_MIN_VALUE (t, val); - } - - val = TYPE_RM_MAX_VALUE (type); - if (val) - { - gimplify_one_sizepos (&val, pre_p); - for (t = type; t; t = TYPE_NEXT_VARIANT (t)) - SET_TYPE_RM_MAX_VALUE (t, val); - } - - } - break; - - default: - break; - } - - /* ... fall through ... */ + break; default: - return GS_UNHANDLED; + break; } + + return GS_UNHANDLED; } /* Generate GIMPLE in place for the statement at *STMT_P. */ @@ -9045,6 +9077,11 @@ process_freeze_entity (Node_Id gnat_node) if (kind == E_Class_Wide_Type) return; + /* Likewise for the entities internally used by the front-end to register + primitives covering abstract interfaces, see Expand_N_Freeze_Entity. */ + if (Is_Subprogram (gnat_entity) && Present (Interface_Alias (gnat_entity))) + return; + /* Check for an old definition if this isn't an object with address clause, since the saved GCC tree is the address expression in that case. */ gnu_old @@ -9224,31 +9261,29 @@ process_decls (List_Id gnat_decls, List_Id gnat_decls2, record_code_position (Proper_Body (Unit (Library_Unit (gnat_decl)))); - /* We defer most subprogram bodies to the second pass. */ + /* We defer most subprogram bodies to the second pass. For bodies + that act as their own specs and stubs, the entity itself must be + elaborated in the first pass, because it may be used in other + declarations. */ else if (Nkind (gnat_decl) == N_Subprogram_Body) { if (Acts_As_Spec (gnat_decl)) { - Node_Id gnat_subprog_id = Defining_Entity (gnat_decl); + Entity_Id gnat_subprog = Defining_Entity (gnat_decl); - if (Ekind (gnat_subprog_id) != E_Generic_Procedure - && Ekind (gnat_subprog_id) != E_Generic_Function) - gnat_to_gnu_entity (gnat_subprog_id, NULL_TREE, true); + if (!Is_Generic_Subprogram (gnat_subprog)) + gnat_to_gnu_entity (gnat_subprog, NULL_TREE, true); } } - /* For bodies and stubs that act as their own specs, the entity - itself must be elaborated in the first pass, because it may - be used in other declarations. */ else if (Nkind (gnat_decl) == N_Subprogram_Body_Stub) { - Node_Id gnat_subprog_id + Entity_Id gnat_subprog = Defining_Entity (Specification (gnat_decl)); - if (Ekind (gnat_subprog_id) != E_Subprogram_Body - && Ekind (gnat_subprog_id) != E_Generic_Procedure - && Ekind (gnat_subprog_id) != E_Generic_Function) - gnat_to_gnu_entity (gnat_subprog_id, NULL_TREE, true); + if (!Is_Generic_Subprogram (gnat_subprog) + && Ekind (gnat_subprog) != E_Subprogram_Body) + gnat_to_gnu_entity (gnat_subprog, NULL_TREE, true); } /* Concurrent stubs stand for the corresponding subprogram bodies, diff --git a/gcc/ada/gcc-interface/utils.cc b/gcc/ada/gcc-interface/utils.cc index 5722ed2..c583aca 100644 --- a/gcc/ada/gcc-interface/utils.cc +++ b/gcc/ada/gcc-interface/utils.cc @@ -107,6 +107,7 @@ static tree handle_flatten_attribute (tree *, tree, tree, int, bool *); static tree handle_used_attribute (tree *, tree, tree, int, bool *); static tree handle_cold_attribute (tree *, tree, tree, int, bool *); static tree handle_hot_attribute (tree *, tree, tree, int, bool *); +static tree handle_simd_attribute (tree *, tree, tree, int, bool *); static tree handle_target_attribute (tree *, tree, tree, int, bool *); static tree handle_target_clones_attribute (tree *, tree, tree, int, bool *); static tree handle_vector_size_attribute (tree *, tree, tree, int, bool *); @@ -185,6 +186,8 @@ const struct attribute_spec gnat_internal_attribute_table[] = handle_cold_attribute, attr_cold_hot_exclusions }, { "hot", 0, 0, true, false, false, false, handle_hot_attribute, attr_cold_hot_exclusions }, + { "simd", 0, 1, true, false, false, false, + handle_simd_attribute, NULL }, { "target", 1, -1, true, false, false, false, handle_target_attribute, NULL }, { "target_clones",1, -1, true, false, false, false, @@ -849,8 +852,11 @@ gnat_pushdecl (tree decl, Node_Id gnat_node) if (!deferred_decl_context) DECL_CONTEXT (decl) = context; - suppress_warning (decl, all_warnings, - No (gnat_node) || Warnings_Off (gnat_node)); + /* Disable warnings for compiler-generated entities or explicit request. */ + if (No (gnat_node) + || !Comes_From_Source (gnat_node) + || Warnings_Off (gnat_node)) + suppress_warning (decl); /* Set the location of DECL and emit a declaration for it. */ if (Present (gnat_node) && !renaming_from_instantiation_p (gnat_node)) @@ -5637,6 +5643,13 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) return unchecked_convert (type, expr, notrunc_p); } + /* If we are converting a string constant to a pointer to character, make + sure that the string is not folded into an integer constant. */ + else if (TREE_CODE (expr) == STRING_CST + && POINTER_TYPE_P (type) + && TYPE_STRING_FLAG (TREE_TYPE (type))) + expr = build1 (VIEW_CONVERT_EXPR, type, expr); + /* Otherwise, just build a VIEW_CONVERT_EXPR of the expression. */ else { @@ -6873,6 +6886,54 @@ handle_hot_attribute (tree *node, tree name, tree ARG_UNUSED (args), return NULL_TREE; } +/* Handle a "simd" attribute. */ + +static tree +handle_simd_attribute (tree *node, tree name, tree args, int, bool *no_add_attrs) +{ + if (TREE_CODE (*node) == FUNCTION_DECL) + { + tree t = get_identifier ("omp declare simd"); + tree attr = NULL_TREE; + if (args) + { + tree id = TREE_VALUE (args); + + if (TREE_CODE (id) != STRING_CST) + { + error ("attribute %qE argument not a string", name); + *no_add_attrs = true; + return NULL_TREE; + } + + if (strcmp (TREE_STRING_POINTER (id), "notinbranch") == 0) + attr = build_omp_clause (DECL_SOURCE_LOCATION (*node), + OMP_CLAUSE_NOTINBRANCH); + else if (strcmp (TREE_STRING_POINTER (id), "inbranch") == 0) + attr = build_omp_clause (DECL_SOURCE_LOCATION (*node), + OMP_CLAUSE_INBRANCH); + else + { + error ("only %<inbranch%> and %<notinbranch%> flags are " + "allowed for %<__simd__%> attribute"); + *no_add_attrs = true; + return NULL_TREE; + } + } + + DECL_ATTRIBUTES (*node) + = tree_cons (t, build_tree_list (NULL_TREE, attr), + DECL_ATTRIBUTES (*node)); + } + else + { + warning (OPT_Wattributes, "%qE attribute ignored", name); + *no_add_attrs = true; + } + + return NULL_TREE; +} + /* Handle a "target" attribute. */ static tree diff --git a/gcc/ada/gcc-interface/utils2.cc b/gcc/ada/gcc-interface/utils2.cc index 76622da..ae81a0d 100644 --- a/gcc/ada/gcc-interface/utils2.cc +++ b/gcc/ada/gcc-interface/utils2.cc @@ -2141,9 +2141,9 @@ build_call_alloc_dealloc_proc (tree gnu_obj, tree gnu_size, tree gnu_type, tree gnu_proc = gnat_to_gnu (gnat_proc); tree gnu_call; - /* A storage pool's underlying type is a record type (for both predefined - storage pools and GNAT simple storage pools). The secondary stack uses - the same mechanism, but its pool object (SS_Pool) is an integer. */ + /* A storage pool's underlying type is a record type for both predefined + storage pools and GNAT simple storage pools. The return and secondary + stacks use the same mechanism, but their pool object is an integer. */ if (Is_Record_Type (Underlying_Type (Etype (gnat_pool)))) { /* The size is the third parameter; the alignment is the @@ -2170,7 +2170,6 @@ build_call_alloc_dealloc_proc (tree gnu_obj, tree gnu_size, tree gnu_type, gnu_size, gnu_align); } - /* Secondary stack case. */ else { /* The size is the second parameter. */ @@ -2180,10 +2179,42 @@ build_call_alloc_dealloc_proc (tree gnu_obj, tree gnu_size, tree gnu_type, gnu_size = convert (gnu_size_type, gnu_size); + if (DECL_BUILT_IN_CLASS (gnu_proc) == BUILT_IN_FRONTEND + && DECL_FE_FUNCTION_CODE (gnu_proc) == BUILT_IN_RETURN_SLOT) + { + /* This must be an allocation of the return stack in a function that + returns by invisible reference. */ + gcc_assert (!gnu_obj); + gcc_assert (current_function_decl + && TREE_ADDRESSABLE (TREE_TYPE (current_function_decl))); + tree gnu_ret_size; + + gnu_call = DECL_RESULT (current_function_decl); + + /* The allocation has alreay been done by the caller so we check that + we are not going to overflow the return slot. */ + if (TYPE_CI_CO_LIST (TREE_TYPE (current_function_decl))) + gnu_ret_size + = TYPE_SIZE_UNIT + (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (TREE_TYPE (gnu_call))))); + else + gnu_ret_size = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (gnu_call))); + + gnu_call + = fold_build3 (COND_EXPR, TREE_TYPE (gnu_call), + fold_build2 (LE_EXPR, boolean_type_node, + fold_convert (sizetype, gnu_size), + gnu_ret_size), + gnu_call, + build_call_raise (PE_Explicit_Raise, Empty, + N_Raise_Program_Error)); + } + /* The first arg is the address of the object, for a deallocator, then the size. */ - if (gnu_obj) + else if (gnu_obj) gnu_call = build_call_n_expr (gnu_proc, 2, gnu_obj, gnu_size); + else gnu_call = build_call_n_expr (gnu_proc, 1, gnu_size); } diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads index 6a3e7b2..878755b 100644 --- a/gcc/ada/gen_il-fields.ads +++ b/gcc/ada/gen_il-fields.ads @@ -191,7 +191,6 @@ package Gen_IL.Fields is Formal_Type_Definition, Forwards_OK, From_Aspect_Specification, - From_At_End, From_At_Mod, From_Conditional_Expression, From_Default, @@ -757,7 +756,6 @@ package Gen_IL.Fields is Is_Partial_Invariant_Procedure, Is_Potentially_Use_Visible, Is_Predicate_Function, - Is_Predicate_Function_M, Is_Preelaborated, Is_Primitive, Is_Primitive_Wrapper, @@ -852,6 +850,7 @@ package Gen_IL.Fields is Partial_View_Has_Unknown_Discr, Pending_Access_Types, Postconditions_Proc, + Predicate_Expression, Prev_Entity, Prival, Prival_Link, diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb index 5b8603b..89d8659 100644 --- a/gcc/ada/gen_il-gen-gen_entities.adb +++ b/gcc/ada/gen_il-gen-gen_entities.adb @@ -1031,7 +1031,6 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Is_Invariant_Procedure, Flag), Sm (Is_Partial_Invariant_Procedure, Flag), Sm (Is_Predicate_Function, Flag), - Sm (Is_Predicate_Function_M, Flag), Sm (Is_Primitive_Wrapper, Flag), Sm (Is_Private_Primitive, Flag), Sm (LSP_Subprogram, Node_Id), @@ -1039,6 +1038,7 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Next_Inlined_Subprogram, Node_Id), Sm (Original_Protected_Subprogram, Node_Id), Sm (Postconditions_Proc, Node_Id), + Sm (Predicate_Expression, Node_Id), Sm (Protected_Subprogram, Node_Id), Sm (Protection_Object, Node_Id), Sm (Related_Expression, Node_Id), @@ -1080,7 +1080,6 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Is_Null_Init_Proc, Flag), Sm (Is_Partial_Invariant_Procedure, Flag), Sm (Is_Predicate_Function, Flag), - Sm (Is_Predicate_Function_M, Flag), Sm (Is_Primitive_Wrapper, Flag), Sm (Is_Private_Primitive, Flag), Sm (Is_Valued_Procedure, Flag), diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb index 755f3cc..96e1c76 100644 --- a/gcc/ada/gen_il-gen-gen_nodes.adb +++ b/gcc/ada/gen_il-gen-gen_nodes.adb @@ -509,6 +509,7 @@ begin -- Gen_IL.Gen.Gen_Nodes Cc (N_Delta_Aggregate, N_Subexpr, (Sy (Expression, Node_Id, Default_Empty), + Sy (Is_Homogeneous_Aggregate, Flag), Sy (Component_Associations, List_Id, Default_No_List))); Cc (N_Extension_Aggregate, N_Subexpr, @@ -1043,8 +1044,7 @@ begin -- Gen_IL.Gen.Gen_Nodes Cc (N_Raise_Statement, N_Statement_Other_Than_Procedure_Call, (Sy (Name, Node_Id, Default_Empty), - Sy (Expression, Node_Id, Default_Empty), - Sm (From_At_End, Flag))); + Sy (Expression, Node_Id, Default_Empty))); Cc (N_Raise_When_Statement, N_Statement_Other_Than_Procedure_Call, (Sy (Name, Node_Id, Default_Empty), diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 79d5847..49ddf03 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -186,6 +186,7 @@ procedure Gnat1drv is Building_Static_Dispatch_Tables := False; Minimize_Expression_With_Actions := True; Expand_Nonbinary_Modular_Ops := True; + Back_End_Return_Slot := False; -- Set operating mode to Generate_Code to benefit from full front-end -- expansion (e.g. generics). @@ -726,6 +727,12 @@ procedure Gnat1drv is Back_End_Handles_Limited_Types := False; end if; + -- Return slot support is disabled if -gnatd_r is specified + + if Debug_Flag_Underscore_R then + Back_End_Return_Slot := False; + end if; + -- If the inlining level has not been set by the user, compute it from -- the optimization level: 1 at -O1/-O2 (and -Os), 2 at -O3 and above. @@ -1435,7 +1442,7 @@ begin -- Do not generate an ALI file in this case, because it would -- become obsolete when the parent is compiled, and thus - -- confuse tools such as gnatfind. + -- confuse some tools. elsif Main_Unit_Kind = N_Subprogram_Declaration then Write_Str (" (subprogram spec)"); diff --git a/gcc/ada/gnat_cuda.adb b/gcc/ada/gnat_cuda.adb index 4bb8c5a..44394b7 100644 --- a/gcc/ada/gnat_cuda.adb +++ b/gcc/ada/gnat_cuda.adb @@ -31,19 +31,12 @@ with Einfo.Entities; use Einfo.Entities; with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; -with Namet; use Namet; with Nlists; use Nlists; with Nmake; use Nmake; -with Rtsfind; use Rtsfind; -with Sem; use Sem; with Sem_Aux; use Sem_Aux; with Sem_Util; use Sem_Util; with Sinfo.Nodes; use Sinfo.Nodes; with Sinfo; use Sinfo; -with Snames; use Snames; -with Stringt; use Stringt; -with Tbuild; use Tbuild; -with Uintp; use Uintp; with GNAT.HTable; @@ -83,25 +76,6 @@ package body GNAT_CUDA is -- least one procedure marked with aspect CUDA_Global. The values are -- Elists of the marked procedures. - procedure Build_And_Insert_CUDA_Initialization (N : Node_Id); - -- Builds declarations necessary for CUDA initialization and inserts them - -- in N, the package body that contains CUDA_Global nodes. These - -- declarations are: - -- - -- * A symbol to hold the pointer P to the CUDA fat binary. - -- - -- * A type definition T for a wrapper that contains the pointer to the - -- CUDA fat binary. - -- - -- * An object of the aforementioned type to hold the aforementioned - -- pointer. - -- - -- * For each CUDA_Global procedure in the package, a declaration of a C - -- string containing the function's name. - -- - -- * A procedure that takes care of calling CUDA functions that register - -- CUDA_Global procedures with the runtime. - procedure Empty_CUDA_Global_Subprograms (Pack_Id : Entity_Id); -- For all subprograms marked CUDA_Global in Pack_Id, remove declarations -- and replace statements with a single null statement. @@ -234,13 +208,6 @@ package body GNAT_CUDA is Remove_CUDA_Device_Entities (Package_Specification (Corresponding_Spec (N))); - - -- If procedures marked with CUDA_Global have been defined within N, - -- we need to register them with the CUDA runtime at program startup. - -- This requires multiple declarations and function calls which need - -- to be appended to N's declarations. - - Build_And_Insert_CUDA_Initialization (N); end Expand_CUDA_Package; ---------- @@ -270,463 +237,6 @@ package body GNAT_CUDA is return CUDA_Kernels_Table.Get (Pack_Id); end Get_CUDA_Kernels; - ------------------------------------------ - -- Build_And_Insert_CUDA_Initialization -- - ------------------------------------------ - - procedure Build_And_Insert_CUDA_Initialization (N : Node_Id) is - - -- For the following kernel declaration: - -- - -- package body <Package_Name> is - -- procedure <Proc_Name> (X : Integer) with CUDA_Global; - -- end package; - -- - -- Insert the following declarations: - -- - -- Fat_Binary : System.Address; - -- pragma Import - -- (Convention => C, - -- Entity => Fat_Binary, - -- External_Name => "_binary_<Package_Name>_fatbin_start"); - -- - -- Wrapper : Fatbin_Wrapper := - -- (16#466243b1#, 1, Fat_Binary'Address, System.Null_Address); - -- - -- Proc_Symbol_Name : Interfaces.C.Strings.Chars_Ptr := - -- Interfaces.C.Strings.New_Char_Array("<Proc_Name>"); - -- - -- Fat_Binary_Handle : System.Address := - -- CUDA.Internal.Register_Fat_Binary (Wrapper'Address); - -- - -- procedure Initialize_CUDA_Kernel is - -- begin - -- CUDA.Internal.Register_Function - -- (Fat_Binary_Handle, - -- <Proc_Name>'Address, - -- Proc_Symbol_Name, - -- Proc_Symbol_Name, - -- -1, - -- System.Null_Address, - -- System.Null_Address, - -- System.Null_Address, - -- System.Null_Address, - -- System.Null_Address); - -- CUDA.Internal.Register_Fat_Binary_End (Fat_Binary_Handle); - -- end Initialize_CUDA_Kernel; - -- - -- Proc_Symbol_Name is the name of the procedure marked with - -- CUDA_Global. The CUDA runtime uses this in order to be able to find - -- kernels in the fat binary, so it has to match the name of the - -- procedure symbol compiled by GNAT_LLVM. When looking at the code - -- generated by NVCC, it seems that the CUDA runtime also needs the name - -- of the procedure symbol of the host. Fortuantely, the procedures are - -- named the same way whether they are compiled for the host or the - -- device, so we use Vector_Add_Name to specify the name of the symbol - -- for both the host and the device. The meaning of the rest of the - -- arguments is unknown. - - function Build_CUDA_Init_Proc - (Init_Id : Entity_Id; - CUDA_Kernels : Elist_Id; - Handle_Id : Entity_Id; - Pack_Decls : List_Id) return Node_Id; - -- Create the declaration of Init_Id, the function that binds each - -- kernel present in CUDA_Kernels with the fat binary Handle_Id and then - -- tells the CUDA runtime that no new function will be bound to the fat - -- binary. - - function Build_Fat_Binary_Declaration - (Bin_Id : Entity_Id) return Node_Id; - -- Create a declaration for Bin_Id, the entity that represents the fat - -- binary, i.e.: - -- - -- Bin_Id : System.Address; - - function Build_Fat_Binary_Handle_Declaration - (Handle_Id : Entity_Id; - Wrapper_Id : Entity_Id) return Node_Id; - -- Create the declaration of Handle_Id, a System.Address that will - -- receive the results of passing the address of Wrapper_Id to - -- CUDA.Register_Fat_Binary, i.e.: - -- - -- Handle_Id : System.Address := - -- CUDA.Register_Fat_Binary (Wrapper_Id'Address) - - function Build_Fat_Binary_Wrapper_Declaration - (Wrapper_Id : Entity_Id; - Bin_Id : Entity_Id) return Node_Id; - -- Create the declaration of the fat binary wrapper Wrapper_Id, which - -- holds magic numbers and Bin_Id'Address, i.e.: - -- - -- Wrapper_Id : System.Address := - -- (16#466243b1#, 1, Bin_Id'Address, System.Null_Address); - - function Build_Import_Pragma - (Bin_Id : Entity_Id; - Pack_Body : Node_Id) return Node_Id; - -- Create a pragma that will bind the fat binary Bin_Id to its external - -- symbol. N is the package body Bin_Id belongs to, i.e.: - -- - -- pragma Import - -- (Convention => C, - -- Entity => Bin_Id, - -- External_Name => "_binary_<Pack_Body's name>_fatbin_start"); - - function Build_Kernel_Name_Declaration - (Kernel : Entity_Id) return Node_Id; - -- Create the declaration of a C string that contains the name of - -- Kernel's symbol, i.e.: - -- - -- Kernel : Interfaces.C.Strings.Chars_Ptr := - -- Interfaces.C.Strings.New_Char_Array("<Kernel's name>"); - - function Build_Register_Procedure_Call - (Loc : Source_Ptr; - Bin : Entity_Id; - Kernel : Entity_Id; - Kernel_Name : Entity_Id) return Node_Id; - -- Return a call to CUDA.Internal.Register_Function that binds Kernel - -- (the entity of a procedure) to the symbol described by the C string - -- Kernel_Name in the fat binary Bin, using Loc as location. - - -------------------------- - -- Build_CUDA_Init_Proc -- - -------------------------- - - function Build_CUDA_Init_Proc - (Init_Id : Entity_Id; - CUDA_Kernels : Elist_Id; - Handle_Id : Entity_Id; - Pack_Decls : List_Id) return Node_Id - is - Loc : constant Source_Ptr := Sloc (Init_Id); - - Stmts : constant List_Id := New_List; - -- List of statements that will be used by the cuda initialization - -- function. - - New_Stmt : Node_Id; - -- Temporary variable to hold the various newly-created nodes - - Kernel_Elmt : Elmt_Id; - Kernel_Id : Entity_Id; - - begin - -- For each CUDA_Global function, declare a C string that holds - -- its symbol's name (i.e. packagename __ functionname). - - -- Also create a function call to CUDA.Internal.Register_Function - -- that takes the declared C string, a pointer to the function and - -- the fat binary handle. - - Kernel_Elmt := First_Elmt (CUDA_Kernels); - while Present (Kernel_Elmt) loop - Kernel_Id := Node (Kernel_Elmt); - - New_Stmt := Build_Kernel_Name_Declaration (Kernel_Id); - Append (New_Stmt, Pack_Decls); - Analyze (New_Stmt); - - Append_To (Stmts, - Build_Register_Procedure_Call (Loc, - Bin => Handle_Id, - Kernel => Kernel_Id, - Kernel_Name => Defining_Entity (New_Stmt))); - - Next_Elmt (Kernel_Elmt); - end loop; - - -- Finish the CUDA initialization function: add a call to - -- register_fat_binary_end, to let the CUDA runtime know that we - -- won't be registering any other symbol with the current fat binary. - - Append_To (Stmts, - Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_Register_Fat_Binary_End), Loc), - Parameter_Associations => - New_List (New_Occurrence_Of (Handle_Id, Loc)))); - - -- Now that we have all the declarations and calls we need, we can - -- build and and return the initialization procedure. - - return - Make_Subprogram_Body (Loc, - Specification => - Make_Procedure_Specification (Loc, Init_Id), - Declarations => New_List, - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, Stmts)); - end Build_CUDA_Init_Proc; - - ---------------------------------- - -- Build_Fat_Binary_Declaration -- - ---------------------------------- - - function Build_Fat_Binary_Declaration - (Bin_Id : Entity_Id) return Node_Id - is - begin - return - Make_Object_Declaration (Sloc (Bin_Id), - Defining_Identifier => Bin_Id, - Object_Definition => - New_Occurrence_Of (RTE (RE_Address), Sloc (Bin_Id))); - end Build_Fat_Binary_Declaration; - - ----------------------------------------- - -- Build_Fat_Binary_Handle_Declaration -- - ----------------------------------------- - - function Build_Fat_Binary_Handle_Declaration - (Handle_Id : Entity_Id; - Wrapper_Id : Entity_Id) return Node_Id - is - Loc : constant Source_Ptr := Sloc (Handle_Id); - begin - -- Generate: - -- Handle_Id : System.Address := - -- CUDA.Register_Fat_Binary (Wrapper_Id'Address); - - return - Make_Object_Declaration (Loc, - Defining_Identifier => Handle_Id, - Object_Definition => New_Occurrence_Of (RTE (RE_Address), Loc), - Expression => - Make_Function_Call (Loc, - Name => - New_Occurrence_Of (RTE (RE_Register_Fat_Binary), Loc), - Parameter_Associations => New_List ( - Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Wrapper_Id, Loc), - Attribute_Name => Name_Address)))); - end Build_Fat_Binary_Handle_Declaration; - - ------------------------------------------ - -- Build_Fat_Binary_Wrapper_Declaration -- - ------------------------------------------ - - function Build_Fat_Binary_Wrapper_Declaration - (Wrapper_Id : Entity_Id; - Bin_Id : Entity_Id) return Node_Id - is - Loc : constant Source_Ptr := Sloc (Wrapper_Id); - begin - return - Make_Object_Declaration (Loc, - Defining_Identifier => Wrapper_Id, - Object_Definition => - New_Occurrence_Of (RTE (RE_Fatbin_Wrapper), Loc), - Expression => - Make_Aggregate (Loc, - Expressions => New_List ( - Make_Integer_Literal (Loc, UI_From_Int (16#466243b1#)), - Make_Integer_Literal (Loc, Uint_1), - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Bin_Id, Loc), - Attribute_Name => Name_Address), - New_Occurrence_Of (RTE (RE_Null_Address), Loc)))); - end Build_Fat_Binary_Wrapper_Declaration; - - ------------------------- - -- Build_Import_Pragma -- - ------------------------- - - function Build_Import_Pragma - (Bin_Id : Entity_Id; - Pack_Body : Node_Id) return Node_Id - is - Loc : constant Source_Ptr := Sloc (Bin_Id); - External_Symbol : String_Id; - begin - Start_String; - Store_String_Chars - ("_binary_" - & Get_Name_String (Chars (Defining_Unit_Name (Pack_Body))) - & "_fatbin_start"); - External_Symbol := End_String; - - return - Make_Pragma (Loc, - Pragma_Identifier => - Make_Identifier (Loc, Name_Import), - Pragma_Argument_Associations => New_List ( - Make_Pragma_Argument_Association (Loc, - Chars => Name_Convention, - Expression => Make_Identifier (Loc, Name_C)), - Make_Pragma_Argument_Association (Loc, - Chars => Name_Entity, - Expression => New_Occurrence_Of (Bin_Id, Loc)), - Make_Pragma_Argument_Association (Loc, - Chars => Name_External_Name, - Expression => Make_String_Literal (Loc, External_Symbol)))); - end Build_Import_Pragma; - - ------------------------------------- - -- Build_Kernel_Name_Declaration -- - ------------------------------------- - - function Build_Kernel_Name_Declaration - (Kernel : Entity_Id) return Node_Id - is - Loc : constant Source_Ptr := Sloc (Kernel); - - Package_Name : constant String := - Get_Name_String (Chars (Scope (Kernel))); - - Symbol_Name : constant String := Get_Name_String (Chars (Kernel)); - - Kernel_Name : String_Id; - begin - Start_String; - Store_String_Chars (Package_Name & "__" & Symbol_Name); - Kernel_Name := End_String; - - return - Make_Object_Declaration (Loc, - Defining_Identifier => Make_Temporary (Loc, 'C'), - Object_Definition => - New_Occurrence_Of (RTE (RE_Chars_Ptr), Loc), - Expression => - Make_Function_Call (Loc, - Name => - New_Occurrence_Of (RTE (RE_New_Char_Array), Loc), - Parameter_Associations => New_List ( - Make_String_Literal (Loc, Kernel_Name)))); - end Build_Kernel_Name_Declaration; - - ----------------------------------- - -- Build_Register_Procedure_Call -- - ----------------------------------- - - function Build_Register_Procedure_Call - (Loc : Source_Ptr; - Bin : Entity_Id; - Kernel : Entity_Id; - Kernel_Name : Entity_Id) return Node_Id - is - Args : constant List_Id := New_List; - begin - -- First argument: the handle of the fat binary - - Append (New_Occurrence_Of (Bin, Loc), Args); - - -- Second argument: the host address of the function that is marked - -- with CUDA_Global. - - Append_To (Args, - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Kernel, Loc), - Attribute_Name => Name_Address)); - - -- Third argument, the name of the function on the host - - Append (New_Occurrence_Of (Kernel_Name, Loc), Args); - - -- Fourth argument, the name of the function on the device - - Append (New_Occurrence_Of (Kernel_Name, Loc), Args); - - -- Fith argument: -1. Meaning unknown - this has been copied from - -- LLVM. - - Append (Make_Integer_Literal (Loc, Uint_Minus_1), Args); - - -- Args 6, 7, 8, 9, 10: Null pointers. Again, meaning unknown - - for Arg_Count in 6 .. 10 loop - Append_To (Args, New_Occurrence_Of (RTE (RE_Null_Address), Loc)); - end loop; - - -- Build the call to CUDARegisterFunction, passing the argument list - -- we just built. - - return - Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_Register_Function), Loc), - Parameter_Associations => Args); - end Build_Register_Procedure_Call; - - -- Local declarations - - Loc : constant Source_Ptr := Sloc (N); - - Spec_Id : constant Node_Id := Corresponding_Spec (N); - -- The specification of the package we're adding a cuda init func to - - Pack_Decls : constant List_Id := Declarations (N); - - CUDA_Node_List : constant Elist_Id := Get_CUDA_Kernels (Spec_Id); - -- CUDA nodes that belong to the package - - CUDA_Init_Func : Entity_Id; - -- Entity of the cuda init func - - Fat_Binary : Entity_Id; - -- Entity of the fat binary of N. Bound to said fat binary by a pragma - - Fat_Binary_Handle : Entity_Id; - -- Entity of the result of passing the fat binary wrapper to - -- CUDA.Register_Fat_Binary. - - Fat_Binary_Wrapper : Entity_Id; - -- Entity of a record that holds a bunch of magic numbers and a - -- reference to Fat_Binary. - - New_Stmt : Node_Id; - -- Node to store newly-created declarations - - -- Start of processing for Build_And_Insert_CUDA_Initialization - - begin - if No (CUDA_Node_List) then - return; - end if; - - Fat_Binary := Make_Temporary (Loc, 'C'); - New_Stmt := Build_Fat_Binary_Declaration (Fat_Binary); - Append_To (Pack_Decls, New_Stmt); - Analyze (New_Stmt); - - New_Stmt := Build_Import_Pragma (Fat_Binary, N); - Append_To (Pack_Decls, New_Stmt); - Analyze (New_Stmt); - - Fat_Binary_Wrapper := Make_Temporary (Loc, 'C'); - New_Stmt := - Build_Fat_Binary_Wrapper_Declaration - (Wrapper_Id => Fat_Binary_Wrapper, - Bin_Id => Fat_Binary); - Append_To (Pack_Decls, New_Stmt); - Analyze (New_Stmt); - - Fat_Binary_Handle := Make_Temporary (Loc, 'C'); - New_Stmt := - Build_Fat_Binary_Handle_Declaration - (Fat_Binary_Handle, Fat_Binary_Wrapper); - Append_To (Pack_Decls, New_Stmt); - Analyze (New_Stmt); - - CUDA_Init_Func := Make_Temporary (Loc, 'C'); - New_Stmt := - Build_CUDA_Init_Proc - (Init_Id => CUDA_Init_Func, - CUDA_Kernels => CUDA_Node_List, - Handle_Id => Fat_Binary_Handle, - Pack_Decls => Pack_Decls); - Append_To (Pack_Decls, New_Stmt); - Analyze (New_Stmt); - - New_Stmt := - Make_Procedure_Call_Statement (Loc, - Name => New_Occurrence_Of (CUDA_Init_Func, Loc)); - Append_To (Pack_Decls, New_Stmt); - Analyze (New_Stmt); - end Build_And_Insert_CUDA_Initialization; - --------------------------------- -- Remove_CUDA_Device_Entities -- --------------------------------- diff --git a/gcc/ada/gnat_cuda.ads b/gcc/ada/gnat_cuda.ads index e756162..1333a65 100644 --- a/gcc/ada/gnat_cuda.ads +++ b/gcc/ada/gnat_cuda.ads @@ -43,14 +43,13 @@ -- compiling for the host, the frontend stores procedures marked with -- CUDA_Global in a hash table the key of which is the Node_Id of the package -- body that contains the CUDA_Global procedure. This is done in sem_prag.adb. --- Once the declarations of a package body have been analyzed, variable, type --- and procedure declarations necessary for the initialization of the CUDA --- runtime are appended to the package that contains the CUDA_Global --- procedure. --- --- These declarations are used to register the CUDA kernel with the CUDA --- runtime when the program is launched. Registering a CUDA kernel with the --- CUDA runtime requires multiple function calls: +-- When emitting an ALI file for a compilation unit, the frontend emits 'K' +-- lines for each visible CUDA kernel (see Output_CUDA_Symbols in +-- lib-writ.adb). This allows the binder to see all kernels in a program and +-- emit code to register the kernels with the CUDA runtime. + +-- Registering a CUDA kernel with the CUDA runtime requires multiple function +-- calls: -- - The first one registers the fat binary which corresponds to the package -- with the CUDA runtime. -- - Then, as many function calls as there are kernels in order to bind them @@ -58,9 +57,7 @@ -- fat binary. -- - The last call lets the CUDA runtime know that we are done initializing -- CUDA. --- Expansion of the CUDA_Global aspect is triggered in sem_ch7.adb, during --- analysis of the package. All of this expansion is performed in the --- Insert_CUDA_Initialization procedure defined in GNAT_CUDA. +-- All of that is performed by the code emitted by bindgen.adb. -- -- Once a CUDA package is initialized, its kernels are ready to be used. -- Launching CUDA kernels is done by using the CUDA_Execute pragma. When @@ -87,8 +84,6 @@ package GNAT_CUDA is procedure Expand_CUDA_Package (N : Node_Id); -- When compiling for the host: - -- - Generate code to register kernels with the CUDA runtime and - -- post-process kernels. -- - Empty content of CUDA_Global procedures. -- - Remove declarations of CUDA_Device entities. diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index c5a8779..bf7c532 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -735,6 +735,7 @@ The GNAT Library * GNAT.Altivec.Vector_Views (g-alvevi.ads): GNAT Altivec Vector_Views g-alvevi ads. * GNAT.Array_Split (g-arrspl.ads): GNAT Array_Split g-arrspl ads. * GNAT.AWK (g-awk.ads): GNAT AWK g-awk ads. +* GNAT.Binary_Search (g-binsea.ads): GNAT Binary_Search g-binsea ads. * GNAT.Bind_Environment (g-binenv.ads): GNAT Bind_Environment g-binenv ads. * GNAT.Branch_Prediction (g-brapre.ads): GNAT Branch_Prediction g-brapre ads. * GNAT.Bounded_Buffers (g-boubuf.ads): GNAT Bounded_Buffers g-boubuf ads. @@ -772,6 +773,7 @@ The GNAT Library * GNAT.Expect.TTY (g-exptty.ads): GNAT Expect TTY g-exptty ads. * GNAT.Float_Control (g-flocon.ads): GNAT Float_Control g-flocon ads. * GNAT.Formatted_String (g-forstr.ads): GNAT Formatted_String g-forstr ads. +* GNAT.Generic_Fast_Math_Functions (g-gfmafu.ads): GNAT Generic_Fast_Math_Functions g-gfmafu ads. * GNAT.Heap_Sort (g-heasor.ads): GNAT Heap_Sort g-heasor ads. * GNAT.Heap_Sort_A (g-hesora.ads): GNAT Heap_Sort_A g-hesora ads. * GNAT.Heap_Sort_G (g-hesorg.ads): GNAT Heap_Sort_G g-hesorg ads. @@ -11028,10 +11030,13 @@ to the value an expression had upon entry to the subprogram. The relevant loop is either identified by the given loop name, or it is the innermost enclosing loop when no loop name is given. -A @code{Loop_Entry} attribute can only occur within a -@code{Loop_Variant} or @code{Loop_Invariant} pragma. A common use of -@code{Loop_Entry} is to compare the current value of objects with their -initial value at loop entry, in a @code{Loop_Invariant} pragma. +A @code{Loop_Entry} attribute can only occur within an @code{Assert}, +@code{Assert_And_Cut}, @code{Assume}, @code{Loop_Variant} or @code{Loop_Invariant} pragma. +In addition, such a pragma must be one of the items in the sequence +of statements of a loop body, or nested inside block statements that +appear in the sequence of statements of a loop body. +A common use of @code{Loop_Entry} is to compare the current value of objects with +their initial value at loop entry, in a @code{Loop_Invariant} pragma. The effect of using @code{X'Loop_Entry} is the same as declaring a constant initialized with the initial value of @code{X} at loop @@ -23156,6 +23161,7 @@ of GNAT, and will generate a warning message. * GNAT.Altivec.Vector_Views (g-alvevi.ads): GNAT Altivec Vector_Views g-alvevi ads. * GNAT.Array_Split (g-arrspl.ads): GNAT Array_Split g-arrspl ads. * GNAT.AWK (g-awk.ads): GNAT AWK g-awk ads. +* GNAT.Binary_Search (g-binsea.ads): GNAT Binary_Search g-binsea ads. * GNAT.Bind_Environment (g-binenv.ads): GNAT Bind_Environment g-binenv ads. * GNAT.Branch_Prediction (g-brapre.ads): GNAT Branch_Prediction g-brapre ads. * GNAT.Bounded_Buffers (g-boubuf.ads): GNAT Bounded_Buffers g-boubuf ads. @@ -23193,6 +23199,7 @@ of GNAT, and will generate a warning message. * GNAT.Expect.TTY (g-exptty.ads): GNAT Expect TTY g-exptty ads. * GNAT.Float_Control (g-flocon.ads): GNAT Float_Control g-flocon ads. * GNAT.Formatted_String (g-forstr.ads): GNAT Formatted_String g-forstr ads. +* GNAT.Generic_Fast_Math_Functions (g-gfmafu.ads): GNAT Generic_Fast_Math_Functions g-gfmafu ads. * GNAT.Heap_Sort (g-heasor.ads): GNAT Heap_Sort g-heasor ads. * GNAT.Heap_Sort_A (g-hesora.ads): GNAT Heap_Sort_A g-hesora ads. * GNAT.Heap_Sort_G (g-hesorg.ads): GNAT Heap_Sort_G g-hesorg ads. @@ -23961,7 +23968,7 @@ Useful array-manipulation routines: given a set of separators, split an array wherever the separators appear, and provide direct access to the resulting slices. -@node GNAT AWK g-awk ads,GNAT Bind_Environment g-binenv ads,GNAT Array_Split g-arrspl ads,The GNAT Library +@node GNAT AWK g-awk ads,GNAT Binary_Search g-binsea ads,GNAT Array_Split g-arrspl ads,The GNAT Library @anchor{gnat_rm/the_gnat_library gnat-awk-g-awk-ads}@anchor{32e}@anchor{gnat_rm/the_gnat_library id45}@anchor{32f} @section @code{GNAT.AWK} (@code{g-awk.ads}) @@ -23976,8 +23983,20 @@ Provides AWK-like parsing functions, with an easy interface for parsing one or more files containing formatted data. The file is viewed as a database where each record is a line and a field is a data element in this line. -@node GNAT Bind_Environment g-binenv ads,GNAT Branch_Prediction g-brapre ads,GNAT AWK g-awk ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-bind-environment-g-binenv-ads}@anchor{330}@anchor{gnat_rm/the_gnat_library id46}@anchor{331} +@node GNAT Binary_Search g-binsea ads,GNAT Bind_Environment g-binenv ads,GNAT AWK g-awk ads,The GNAT Library +@anchor{gnat_rm/the_gnat_library gnat-binary-search-g-binsea-ads}@anchor{330}@anchor{gnat_rm/the_gnat_library id46}@anchor{331} +@section @code{GNAT.Binary_Search} (@code{g-binsea.ads}) + + +@geindex GNAT.Binary_Search (g-binsea.ads) + +@geindex Binary search + +Allow binary search of a sorted array (or of an array-like container; +the generic does not reference the array directly). + +@node GNAT Bind_Environment g-binenv ads,GNAT Branch_Prediction g-brapre ads,GNAT Binary_Search g-binsea ads,The GNAT Library +@anchor{gnat_rm/the_gnat_library gnat-bind-environment-g-binenv-ads}@anchor{332}@anchor{gnat_rm/the_gnat_library id47}@anchor{333} @section @code{GNAT.Bind_Environment} (@code{g-binenv.ads}) @@ -23990,7 +24009,7 @@ These associations can be specified using the @code{-V} binder command line switch. @node GNAT Branch_Prediction g-brapre ads,GNAT Bounded_Buffers g-boubuf ads,GNAT Bind_Environment g-binenv ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-branch-prediction-g-brapre-ads}@anchor{332}@anchor{gnat_rm/the_gnat_library id47}@anchor{333} +@anchor{gnat_rm/the_gnat_library gnat-branch-prediction-g-brapre-ads}@anchor{334}@anchor{gnat_rm/the_gnat_library id48}@anchor{335} @section @code{GNAT.Branch_Prediction} (@code{g-brapre.ads}) @@ -24001,7 +24020,7 @@ line switch. Provides routines giving hints to the branch predictor of the code generator. @node GNAT Bounded_Buffers g-boubuf ads,GNAT Bounded_Mailboxes g-boumai ads,GNAT Branch_Prediction g-brapre ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-bounded-buffers-g-boubuf-ads}@anchor{334}@anchor{gnat_rm/the_gnat_library id48}@anchor{335} +@anchor{gnat_rm/the_gnat_library gnat-bounded-buffers-g-boubuf-ads}@anchor{336}@anchor{gnat_rm/the_gnat_library id49}@anchor{337} @section @code{GNAT.Bounded_Buffers} (@code{g-boubuf.ads}) @@ -24016,7 +24035,7 @@ useful directly or as parts of the implementations of other abstractions, such as mailboxes. @node GNAT Bounded_Mailboxes g-boumai ads,GNAT Bubble_Sort g-bubsor ads,GNAT Bounded_Buffers g-boubuf ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-bounded-mailboxes-g-boumai-ads}@anchor{336}@anchor{gnat_rm/the_gnat_library id49}@anchor{337} +@anchor{gnat_rm/the_gnat_library gnat-bounded-mailboxes-g-boumai-ads}@anchor{338}@anchor{gnat_rm/the_gnat_library id50}@anchor{339} @section @code{GNAT.Bounded_Mailboxes} (@code{g-boumai.ads}) @@ -24029,7 +24048,7 @@ such as mailboxes. Provides a thread-safe asynchronous intertask mailbox communication facility. @node GNAT Bubble_Sort g-bubsor ads,GNAT Bubble_Sort_A g-busora ads,GNAT Bounded_Mailboxes g-boumai ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-bubble-sort-g-bubsor-ads}@anchor{338}@anchor{gnat_rm/the_gnat_library id50}@anchor{339} +@anchor{gnat_rm/the_gnat_library gnat-bubble-sort-g-bubsor-ads}@anchor{33a}@anchor{gnat_rm/the_gnat_library id51}@anchor{33b} @section @code{GNAT.Bubble_Sort} (@code{g-bubsor.ads}) @@ -24044,7 +24063,7 @@ data items. Exchange and comparison procedures are provided by passing access-to-procedure values. @node GNAT Bubble_Sort_A g-busora ads,GNAT Bubble_Sort_G g-busorg ads,GNAT Bubble_Sort g-bubsor ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-bubble-sort-a-g-busora-ads}@anchor{33a}@anchor{gnat_rm/the_gnat_library id51}@anchor{33b} +@anchor{gnat_rm/the_gnat_library gnat-bubble-sort-a-g-busora-ads}@anchor{33c}@anchor{gnat_rm/the_gnat_library id52}@anchor{33d} @section @code{GNAT.Bubble_Sort_A} (@code{g-busora.ads}) @@ -24060,7 +24079,7 @@ access-to-procedure values. This is an older version, retained for compatibility. Usually @code{GNAT.Bubble_Sort} will be preferable. @node GNAT Bubble_Sort_G g-busorg ads,GNAT Byte_Order_Mark g-byorma ads,GNAT Bubble_Sort_A g-busora ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-bubble-sort-g-g-busorg-ads}@anchor{33c}@anchor{gnat_rm/the_gnat_library id52}@anchor{33d} +@anchor{gnat_rm/the_gnat_library gnat-bubble-sort-g-g-busorg-ads}@anchor{33e}@anchor{gnat_rm/the_gnat_library id53}@anchor{33f} @section @code{GNAT.Bubble_Sort_G} (@code{g-busorg.ads}) @@ -24076,7 +24095,7 @@ if the procedures can be inlined, at the expense of duplicating code for multiple instantiations. @node GNAT Byte_Order_Mark g-byorma ads,GNAT Byte_Swapping g-bytswa ads,GNAT Bubble_Sort_G g-busorg ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-byte-order-mark-g-byorma-ads}@anchor{33e}@anchor{gnat_rm/the_gnat_library id53}@anchor{33f} +@anchor{gnat_rm/the_gnat_library gnat-byte-order-mark-g-byorma-ads}@anchor{340}@anchor{gnat_rm/the_gnat_library id54}@anchor{341} @section @code{GNAT.Byte_Order_Mark} (@code{g-byorma.ads}) @@ -24092,7 +24111,7 @@ the encoding of the string. The routine includes detection of special XML sequences for various UCS input formats. @node GNAT Byte_Swapping g-bytswa ads,GNAT Calendar g-calend ads,GNAT Byte_Order_Mark g-byorma ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-byte-swapping-g-bytswa-ads}@anchor{340}@anchor{gnat_rm/the_gnat_library id54}@anchor{341} +@anchor{gnat_rm/the_gnat_library gnat-byte-swapping-g-bytswa-ads}@anchor{342}@anchor{gnat_rm/the_gnat_library id55}@anchor{343} @section @code{GNAT.Byte_Swapping} (@code{g-bytswa.ads}) @@ -24106,7 +24125,7 @@ General routines for swapping the bytes in 2-, 4-, and 8-byte quantities. Machine-specific implementations are available in some cases. @node GNAT Calendar g-calend ads,GNAT Calendar Time_IO g-catiio ads,GNAT Byte_Swapping g-bytswa ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-calendar-g-calend-ads}@anchor{342}@anchor{gnat_rm/the_gnat_library id55}@anchor{343} +@anchor{gnat_rm/the_gnat_library gnat-calendar-g-calend-ads}@anchor{344}@anchor{gnat_rm/the_gnat_library id56}@anchor{345} @section @code{GNAT.Calendar} (@code{g-calend.ads}) @@ -24120,7 +24139,7 @@ Also provides conversion of @code{Ada.Calendar.Time} values to and from the C @code{timeval} format. @node GNAT Calendar Time_IO g-catiio ads,GNAT CRC32 g-crc32 ads,GNAT Calendar g-calend ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-calendar-time-io-g-catiio-ads}@anchor{344}@anchor{gnat_rm/the_gnat_library id56}@anchor{345} +@anchor{gnat_rm/the_gnat_library gnat-calendar-time-io-g-catiio-ads}@anchor{346}@anchor{gnat_rm/the_gnat_library id57}@anchor{347} @section @code{GNAT.Calendar.Time_IO} (@code{g-catiio.ads}) @@ -24131,7 +24150,7 @@ C @code{timeval} format. @geindex GNAT.Calendar.Time_IO (g-catiio.ads) @node GNAT CRC32 g-crc32 ads,GNAT Case_Util g-casuti ads,GNAT Calendar Time_IO g-catiio ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-crc32-g-crc32-ads}@anchor{346}@anchor{gnat_rm/the_gnat_library id57}@anchor{347} +@anchor{gnat_rm/the_gnat_library gnat-crc32-g-crc32-ads}@anchor{348}@anchor{gnat_rm/the_gnat_library id58}@anchor{349} @section @code{GNAT.CRC32} (@code{g-crc32.ads}) @@ -24148,7 +24167,7 @@ of this algorithm see Aug. 1988. Sarwate, D.V. @node GNAT Case_Util g-casuti ads,GNAT CGI g-cgi ads,GNAT CRC32 g-crc32 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-case-util-g-casuti-ads}@anchor{348}@anchor{gnat_rm/the_gnat_library id58}@anchor{349} +@anchor{gnat_rm/the_gnat_library gnat-case-util-g-casuti-ads}@anchor{34a}@anchor{gnat_rm/the_gnat_library id59}@anchor{34b} @section @code{GNAT.Case_Util} (@code{g-casuti.ads}) @@ -24163,7 +24182,7 @@ without the overhead of the full casing tables in @code{Ada.Characters.Handling}. @node GNAT CGI g-cgi ads,GNAT CGI Cookie g-cgicoo ads,GNAT Case_Util g-casuti ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-cgi-g-cgi-ads}@anchor{34a}@anchor{gnat_rm/the_gnat_library id59}@anchor{34b} +@anchor{gnat_rm/the_gnat_library gnat-cgi-g-cgi-ads}@anchor{34c}@anchor{gnat_rm/the_gnat_library id60}@anchor{34d} @section @code{GNAT.CGI} (@code{g-cgi.ads}) @@ -24178,7 +24197,7 @@ builds a table whose index is the key and provides some services to deal with this table. @node GNAT CGI Cookie g-cgicoo ads,GNAT CGI Debug g-cgideb ads,GNAT CGI g-cgi ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-cgi-cookie-g-cgicoo-ads}@anchor{34c}@anchor{gnat_rm/the_gnat_library id60}@anchor{34d} +@anchor{gnat_rm/the_gnat_library gnat-cgi-cookie-g-cgicoo-ads}@anchor{34e}@anchor{gnat_rm/the_gnat_library id61}@anchor{34f} @section @code{GNAT.CGI.Cookie} (@code{g-cgicoo.ads}) @@ -24193,7 +24212,7 @@ Common Gateway Interface (CGI). It exports services to deal with Web cookies (piece of information kept in the Web client software). @node GNAT CGI Debug g-cgideb ads,GNAT Command_Line g-comlin ads,GNAT CGI Cookie g-cgicoo ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-cgi-debug-g-cgideb-ads}@anchor{34e}@anchor{gnat_rm/the_gnat_library id61}@anchor{34f} +@anchor{gnat_rm/the_gnat_library gnat-cgi-debug-g-cgideb-ads}@anchor{350}@anchor{gnat_rm/the_gnat_library id62}@anchor{351} @section @code{GNAT.CGI.Debug} (@code{g-cgideb.ads}) @@ -24205,7 +24224,7 @@ This is a package to help debugging CGI (Common Gateway Interface) programs written in Ada. @node GNAT Command_Line g-comlin ads,GNAT Compiler_Version g-comver ads,GNAT CGI Debug g-cgideb ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-command-line-g-comlin-ads}@anchor{350}@anchor{gnat_rm/the_gnat_library id62}@anchor{351} +@anchor{gnat_rm/the_gnat_library gnat-command-line-g-comlin-ads}@anchor{352}@anchor{gnat_rm/the_gnat_library id63}@anchor{353} @section @code{GNAT.Command_Line} (@code{g-comlin.ads}) @@ -24218,7 +24237,7 @@ including the ability to scan for named switches with optional parameters and expand file names using wildcard notations. @node GNAT Compiler_Version g-comver ads,GNAT Ctrl_C g-ctrl_c ads,GNAT Command_Line g-comlin ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-compiler-version-g-comver-ads}@anchor{352}@anchor{gnat_rm/the_gnat_library id63}@anchor{353} +@anchor{gnat_rm/the_gnat_library gnat-compiler-version-g-comver-ads}@anchor{354}@anchor{gnat_rm/the_gnat_library id64}@anchor{355} @section @code{GNAT.Compiler_Version} (@code{g-comver.ads}) @@ -24236,7 +24255,7 @@ of the compiler if a consistent tool set is used to compile all units of a partition). @node GNAT Ctrl_C g-ctrl_c ads,GNAT Current_Exception g-curexc ads,GNAT Compiler_Version g-comver ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-ctrl-c-g-ctrl-c-ads}@anchor{354}@anchor{gnat_rm/the_gnat_library id64}@anchor{355} +@anchor{gnat_rm/the_gnat_library gnat-ctrl-c-g-ctrl-c-ads}@anchor{356}@anchor{gnat_rm/the_gnat_library id65}@anchor{357} @section @code{GNAT.Ctrl_C} (@code{g-ctrl_c.ads}) @@ -24247,7 +24266,7 @@ of a partition). Provides a simple interface to handle Ctrl-C keyboard events. @node GNAT Current_Exception g-curexc ads,GNAT Debug_Pools g-debpoo ads,GNAT Ctrl_C g-ctrl_c ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-current-exception-g-curexc-ads}@anchor{356}@anchor{gnat_rm/the_gnat_library id65}@anchor{357} +@anchor{gnat_rm/the_gnat_library gnat-current-exception-g-curexc-ads}@anchor{358}@anchor{gnat_rm/the_gnat_library id66}@anchor{359} @section @code{GNAT.Current_Exception} (@code{g-curexc.ads}) @@ -24264,7 +24283,7 @@ This is particularly useful in simulating typical facilities for obtaining information about exceptions provided by Ada 83 compilers. @node GNAT Debug_Pools g-debpoo ads,GNAT Debug_Utilities g-debuti ads,GNAT Current_Exception g-curexc ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-debug-pools-g-debpoo-ads}@anchor{358}@anchor{gnat_rm/the_gnat_library id66}@anchor{359} +@anchor{gnat_rm/the_gnat_library gnat-debug-pools-g-debpoo-ads}@anchor{35a}@anchor{gnat_rm/the_gnat_library id67}@anchor{35b} @section @code{GNAT.Debug_Pools} (@code{g-debpoo.ads}) @@ -24281,7 +24300,7 @@ problems. See @code{The GNAT Debug_Pool Facility} section in the @cite{GNAT User’s Guide}. @node GNAT Debug_Utilities g-debuti ads,GNAT Decode_String g-decstr ads,GNAT Debug_Pools g-debpoo ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-debug-utilities-g-debuti-ads}@anchor{35a}@anchor{gnat_rm/the_gnat_library id67}@anchor{35b} +@anchor{gnat_rm/the_gnat_library gnat-debug-utilities-g-debuti-ads}@anchor{35c}@anchor{gnat_rm/the_gnat_library id68}@anchor{35d} @section @code{GNAT.Debug_Utilities} (@code{g-debuti.ads}) @@ -24294,7 +24313,7 @@ to and from string images of address values. Supports both C and Ada formats for hexadecimal literals. @node GNAT Decode_String g-decstr ads,GNAT Decode_UTF8_String g-deutst ads,GNAT Debug_Utilities g-debuti ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-decode-string-g-decstr-ads}@anchor{35c}@anchor{gnat_rm/the_gnat_library id68}@anchor{35d} +@anchor{gnat_rm/the_gnat_library gnat-decode-string-g-decstr-ads}@anchor{35e}@anchor{gnat_rm/the_gnat_library id69}@anchor{35f} @section @code{GNAT.Decode_String} (@code{g-decstr.ads}) @@ -24318,7 +24337,7 @@ Useful in conjunction with Unicode character coding. Note there is a preinstantiation for UTF-8. See next entry. @node GNAT Decode_UTF8_String g-deutst ads,GNAT Directory_Operations g-dirope ads,GNAT Decode_String g-decstr ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-decode-utf8-string-g-deutst-ads}@anchor{35e}@anchor{gnat_rm/the_gnat_library id69}@anchor{35f} +@anchor{gnat_rm/the_gnat_library gnat-decode-utf8-string-g-deutst-ads}@anchor{360}@anchor{gnat_rm/the_gnat_library id70}@anchor{361} @section @code{GNAT.Decode_UTF8_String} (@code{g-deutst.ads}) @@ -24339,7 +24358,7 @@ preinstantiation for UTF-8. See next entry. A preinstantiation of GNAT.Decode_Strings for UTF-8 encoding. @node GNAT Directory_Operations g-dirope ads,GNAT Directory_Operations Iteration g-diopit ads,GNAT Decode_UTF8_String g-deutst ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-directory-operations-g-dirope-ads}@anchor{360}@anchor{gnat_rm/the_gnat_library id70}@anchor{361} +@anchor{gnat_rm/the_gnat_library gnat-directory-operations-g-dirope-ads}@anchor{362}@anchor{gnat_rm/the_gnat_library id71}@anchor{363} @section @code{GNAT.Directory_Operations} (@code{g-dirope.ads}) @@ -24352,7 +24371,7 @@ the current directory, making new directories, and scanning the files in a directory. @node GNAT Directory_Operations Iteration g-diopit ads,GNAT Dynamic_HTables g-dynhta ads,GNAT Directory_Operations g-dirope ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-directory-operations-iteration-g-diopit-ads}@anchor{362}@anchor{gnat_rm/the_gnat_library id71}@anchor{363} +@anchor{gnat_rm/the_gnat_library gnat-directory-operations-iteration-g-diopit-ads}@anchor{364}@anchor{gnat_rm/the_gnat_library id72}@anchor{365} @section @code{GNAT.Directory_Operations.Iteration} (@code{g-diopit.ads}) @@ -24364,7 +24383,7 @@ A child unit of GNAT.Directory_Operations providing additional operations for iterating through directories. @node GNAT Dynamic_HTables g-dynhta ads,GNAT Dynamic_Tables g-dyntab ads,GNAT Directory_Operations Iteration g-diopit ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-dynamic-htables-g-dynhta-ads}@anchor{364}@anchor{gnat_rm/the_gnat_library id72}@anchor{365} +@anchor{gnat_rm/the_gnat_library gnat-dynamic-htables-g-dynhta-ads}@anchor{366}@anchor{gnat_rm/the_gnat_library id73}@anchor{367} @section @code{GNAT.Dynamic_HTables} (@code{g-dynhta.ads}) @@ -24382,7 +24401,7 @@ dynamic instances of the hash table, while an instantiation of @code{GNAT.HTable} creates a single instance of the hash table. @node GNAT Dynamic_Tables g-dyntab ads,GNAT Encode_String g-encstr ads,GNAT Dynamic_HTables g-dynhta ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-dynamic-tables-g-dyntab-ads}@anchor{366}@anchor{gnat_rm/the_gnat_library id73}@anchor{367} +@anchor{gnat_rm/the_gnat_library gnat-dynamic-tables-g-dyntab-ads}@anchor{368}@anchor{gnat_rm/the_gnat_library id74}@anchor{369} @section @code{GNAT.Dynamic_Tables} (@code{g-dyntab.ads}) @@ -24402,7 +24421,7 @@ dynamic instances of the table, while an instantiation of @code{GNAT.Table} creates a single instance of the table type. @node GNAT Encode_String g-encstr ads,GNAT Encode_UTF8_String g-enutst ads,GNAT Dynamic_Tables g-dyntab ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-encode-string-g-encstr-ads}@anchor{368}@anchor{gnat_rm/the_gnat_library id74}@anchor{369} +@anchor{gnat_rm/the_gnat_library gnat-encode-string-g-encstr-ads}@anchor{36a}@anchor{gnat_rm/the_gnat_library id75}@anchor{36b} @section @code{GNAT.Encode_String} (@code{g-encstr.ads}) @@ -24424,7 +24443,7 @@ encoding method. Useful in conjunction with Unicode character coding. Note there is a preinstantiation for UTF-8. See next entry. @node GNAT Encode_UTF8_String g-enutst ads,GNAT Exception_Actions g-excact ads,GNAT Encode_String g-encstr ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-encode-utf8-string-g-enutst-ads}@anchor{36a}@anchor{gnat_rm/the_gnat_library id75}@anchor{36b} +@anchor{gnat_rm/the_gnat_library gnat-encode-utf8-string-g-enutst-ads}@anchor{36c}@anchor{gnat_rm/the_gnat_library id76}@anchor{36d} @section @code{GNAT.Encode_UTF8_String} (@code{g-enutst.ads}) @@ -24445,7 +24464,7 @@ Note there is a preinstantiation for UTF-8. See next entry. A preinstantiation of GNAT.Encode_Strings for UTF-8 encoding. @node GNAT Exception_Actions g-excact ads,GNAT Exception_Traces g-exctra ads,GNAT Encode_UTF8_String g-enutst ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-exception-actions-g-excact-ads}@anchor{36c}@anchor{gnat_rm/the_gnat_library id76}@anchor{36d} +@anchor{gnat_rm/the_gnat_library gnat-exception-actions-g-excact-ads}@anchor{36e}@anchor{gnat_rm/the_gnat_library id77}@anchor{36f} @section @code{GNAT.Exception_Actions} (@code{g-excact.ads}) @@ -24458,7 +24477,7 @@ for specific exceptions, or when any exception is raised. This can be used for instance to force a core dump to ease debugging. @node GNAT Exception_Traces g-exctra ads,GNAT Exceptions g-except ads,GNAT Exception_Actions g-excact ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-exception-traces-g-exctra-ads}@anchor{36e}@anchor{gnat_rm/the_gnat_library id77}@anchor{36f} +@anchor{gnat_rm/the_gnat_library gnat-exception-traces-g-exctra-ads}@anchor{370}@anchor{gnat_rm/the_gnat_library id78}@anchor{371} @section @code{GNAT.Exception_Traces} (@code{g-exctra.ads}) @@ -24472,7 +24491,7 @@ Provides an interface allowing to control automatic output upon exception occurrences. @node GNAT Exceptions g-except ads,GNAT Expect g-expect ads,GNAT Exception_Traces g-exctra ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-exceptions-g-except-ads}@anchor{370}@anchor{gnat_rm/the_gnat_library id78}@anchor{371} +@anchor{gnat_rm/the_gnat_library gnat-exceptions-g-except-ads}@anchor{372}@anchor{gnat_rm/the_gnat_library id79}@anchor{373} @section @code{GNAT.Exceptions} (@code{g-except.ads}) @@ -24493,7 +24512,7 @@ predefined exceptions, and for example allow raising @code{Constraint_Error} with a message from a pure subprogram. @node GNAT Expect g-expect ads,GNAT Expect TTY g-exptty ads,GNAT Exceptions g-except ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-expect-g-expect-ads}@anchor{372}@anchor{gnat_rm/the_gnat_library id79}@anchor{373} +@anchor{gnat_rm/the_gnat_library gnat-expect-g-expect-ads}@anchor{374}@anchor{gnat_rm/the_gnat_library id80}@anchor{375} @section @code{GNAT.Expect} (@code{g-expect.ads}) @@ -24509,7 +24528,7 @@ It is not implemented for cross ports, and in particular is not implemented for VxWorks or LynxOS. @node GNAT Expect TTY g-exptty ads,GNAT Float_Control g-flocon ads,GNAT Expect g-expect ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-expect-tty-g-exptty-ads}@anchor{374}@anchor{gnat_rm/the_gnat_library id80}@anchor{375} +@anchor{gnat_rm/the_gnat_library gnat-expect-tty-g-exptty-ads}@anchor{376}@anchor{gnat_rm/the_gnat_library id81}@anchor{377} @section @code{GNAT.Expect.TTY} (@code{g-exptty.ads}) @@ -24521,7 +24540,7 @@ ports. It is not implemented for cross ports, and in particular is not implemented for VxWorks or LynxOS. @node GNAT Float_Control g-flocon ads,GNAT Formatted_String g-forstr ads,GNAT Expect TTY g-exptty ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-float-control-g-flocon-ads}@anchor{376}@anchor{gnat_rm/the_gnat_library id81}@anchor{377} +@anchor{gnat_rm/the_gnat_library gnat-float-control-g-flocon-ads}@anchor{378}@anchor{gnat_rm/the_gnat_library id82}@anchor{379} @section @code{GNAT.Float_Control} (@code{g-flocon.ads}) @@ -24534,8 +24553,8 @@ mode required for correct semantic operation in Ada. Some third party library calls may cause this mode to be modified, and the Reset procedure in this package can be used to reestablish the required mode. -@node GNAT Formatted_String g-forstr ads,GNAT Heap_Sort g-heasor ads,GNAT Float_Control g-flocon ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-formatted-string-g-forstr-ads}@anchor{378}@anchor{gnat_rm/the_gnat_library id82}@anchor{379} +@node GNAT Formatted_String g-forstr ads,GNAT Generic_Fast_Math_Functions g-gfmafu ads,GNAT Float_Control g-flocon ads,The GNAT Library +@anchor{gnat_rm/the_gnat_library gnat-formatted-string-g-forstr-ads}@anchor{37a}@anchor{gnat_rm/the_gnat_library id83}@anchor{37b} @section @code{GNAT.Formatted_String} (@code{g-forstr.ads}) @@ -24549,8 +24568,26 @@ output. Some generic routines are provided to be able to use types derived from Integer, Float or enumerations as values for the formatted string. -@node GNAT Heap_Sort g-heasor ads,GNAT Heap_Sort_A g-hesora ads,GNAT Formatted_String g-forstr ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-heap-sort-g-heasor-ads}@anchor{37a}@anchor{gnat_rm/the_gnat_library id83}@anchor{37b} +@node GNAT Generic_Fast_Math_Functions g-gfmafu ads,GNAT Heap_Sort g-heasor ads,GNAT Formatted_String g-forstr ads,The GNAT Library +@anchor{gnat_rm/the_gnat_library gnat-generic-fast-math-functions-g-gfmafu-ads}@anchor{37c}@anchor{gnat_rm/the_gnat_library id84}@anchor{37d} +@section @code{GNAT.Generic_Fast_Math_Functions} (@code{g-gfmafu.ads}) + + +@geindex GNAT.Generic_Fast_Math_Functions (g-gfmafu.ads) + +@geindex Mathematical functions + +Provides direct access to the underlying implementation of the common +mathematical functions, generally from the system mathematical library. +This differs from @code{Ada.Numerics.Generic_Elementary_Functions} in that +the implementation may deviate from the semantics specified for these +functions in the Reference Manual, for example @code{Numerics.Argument_Error} +is not raised. On selected platforms, some of these functions may also +have a vector implementation that can be automatically used by the +compiler when auto-vectorization is enabled. + +@node GNAT Heap_Sort g-heasor ads,GNAT Heap_Sort_A g-hesora ads,GNAT Generic_Fast_Math_Functions g-gfmafu ads,The GNAT Library +@anchor{gnat_rm/the_gnat_library gnat-heap-sort-g-heasor-ads}@anchor{37e}@anchor{gnat_rm/the_gnat_library id85}@anchor{37f} @section @code{GNAT.Heap_Sort} (@code{g-heasor.ads}) @@ -24564,7 +24601,7 @@ access-to-procedure values. The algorithm used is a modified heap sort that performs approximately N*log(N) comparisons in the worst case. @node GNAT Heap_Sort_A g-hesora ads,GNAT Heap_Sort_G g-hesorg ads,GNAT Heap_Sort g-heasor ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-heap-sort-a-g-hesora-ads}@anchor{37c}@anchor{gnat_rm/the_gnat_library id84}@anchor{37d} +@anchor{gnat_rm/the_gnat_library gnat-heap-sort-a-g-hesora-ads}@anchor{380}@anchor{gnat_rm/the_gnat_library id86}@anchor{381} @section @code{GNAT.Heap_Sort_A} (@code{g-hesora.ads}) @@ -24580,7 +24617,7 @@ This differs from @code{GNAT.Heap_Sort} in having a less convenient interface, but may be slightly more efficient. @node GNAT Heap_Sort_G g-hesorg ads,GNAT HTable g-htable ads,GNAT Heap_Sort_A g-hesora ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-heap-sort-g-g-hesorg-ads}@anchor{37e}@anchor{gnat_rm/the_gnat_library id85}@anchor{37f} +@anchor{gnat_rm/the_gnat_library gnat-heap-sort-g-g-hesorg-ads}@anchor{382}@anchor{gnat_rm/the_gnat_library id87}@anchor{383} @section @code{GNAT.Heap_Sort_G} (@code{g-hesorg.ads}) @@ -24594,7 +24631,7 @@ if the procedures can be inlined, at the expense of duplicating code for multiple instantiations. @node GNAT HTable g-htable ads,GNAT IO g-io ads,GNAT Heap_Sort_G g-hesorg ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-htable-g-htable-ads}@anchor{380}@anchor{gnat_rm/the_gnat_library id86}@anchor{381} +@anchor{gnat_rm/the_gnat_library gnat-htable-g-htable-ads}@anchor{384}@anchor{gnat_rm/the_gnat_library id88}@anchor{385} @section @code{GNAT.HTable} (@code{g-htable.ads}) @@ -24607,7 +24644,7 @@ data. Provides two approaches, one a simple static approach, and the other allowing arbitrary dynamic hash tables. @node GNAT IO g-io ads,GNAT IO_Aux g-io_aux ads,GNAT HTable g-htable ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-io-g-io-ads}@anchor{382}@anchor{gnat_rm/the_gnat_library id87}@anchor{383} +@anchor{gnat_rm/the_gnat_library gnat-io-g-io-ads}@anchor{386}@anchor{gnat_rm/the_gnat_library id89}@anchor{387} @section @code{GNAT.IO} (@code{g-io.ads}) @@ -24623,7 +24660,7 @@ Standard_Input, and writing characters, strings and integers to either Standard_Output or Standard_Error. @node GNAT IO_Aux g-io_aux ads,GNAT Lock_Files g-locfil ads,GNAT IO g-io ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-io-aux-g-io-aux-ads}@anchor{384}@anchor{gnat_rm/the_gnat_library id88}@anchor{385} +@anchor{gnat_rm/the_gnat_library gnat-io-aux-g-io-aux-ads}@anchor{388}@anchor{gnat_rm/the_gnat_library id90}@anchor{389} @section @code{GNAT.IO_Aux} (@code{g-io_aux.ads}) @@ -24637,7 +24674,7 @@ Provides some auxiliary functions for use with Text_IO, including a test for whether a file exists, and functions for reading a line of text. @node GNAT Lock_Files g-locfil ads,GNAT MBBS_Discrete_Random g-mbdira ads,GNAT IO_Aux g-io_aux ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-lock-files-g-locfil-ads}@anchor{386}@anchor{gnat_rm/the_gnat_library id89}@anchor{387} +@anchor{gnat_rm/the_gnat_library gnat-lock-files-g-locfil-ads}@anchor{38a}@anchor{gnat_rm/the_gnat_library id91}@anchor{38b} @section @code{GNAT.Lock_Files} (@code{g-locfil.ads}) @@ -24651,7 +24688,7 @@ Provides a general interface for using files as locks. Can be used for providing program level synchronization. @node GNAT MBBS_Discrete_Random g-mbdira ads,GNAT MBBS_Float_Random g-mbflra ads,GNAT Lock_Files g-locfil ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-mbbs-discrete-random-g-mbdira-ads}@anchor{388}@anchor{gnat_rm/the_gnat_library id90}@anchor{389} +@anchor{gnat_rm/the_gnat_library gnat-mbbs-discrete-random-g-mbdira-ads}@anchor{38c}@anchor{gnat_rm/the_gnat_library id92}@anchor{38d} @section @code{GNAT.MBBS_Discrete_Random} (@code{g-mbdira.ads}) @@ -24663,7 +24700,7 @@ The original implementation of @code{Ada.Numerics.Discrete_Random}. Uses a modified version of the Blum-Blum-Shub generator. @node GNAT MBBS_Float_Random g-mbflra ads,GNAT MD5 g-md5 ads,GNAT MBBS_Discrete_Random g-mbdira ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-mbbs-float-random-g-mbflra-ads}@anchor{38a}@anchor{gnat_rm/the_gnat_library id91}@anchor{38b} +@anchor{gnat_rm/the_gnat_library gnat-mbbs-float-random-g-mbflra-ads}@anchor{38e}@anchor{gnat_rm/the_gnat_library id93}@anchor{38f} @section @code{GNAT.MBBS_Float_Random} (@code{g-mbflra.ads}) @@ -24675,7 +24712,7 @@ The original implementation of @code{Ada.Numerics.Float_Random}. Uses a modified version of the Blum-Blum-Shub generator. @node GNAT MD5 g-md5 ads,GNAT Memory_Dump g-memdum ads,GNAT MBBS_Float_Random g-mbflra ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-md5-g-md5-ads}@anchor{38c}@anchor{gnat_rm/the_gnat_library id92}@anchor{38d} +@anchor{gnat_rm/the_gnat_library gnat-md5-g-md5-ads}@anchor{390}@anchor{gnat_rm/the_gnat_library id94}@anchor{391} @section @code{GNAT.MD5} (@code{g-md5.ads}) @@ -24688,7 +24725,7 @@ the HMAC-MD5 message authentication function as described in RFC 2104 and FIPS PUB 198. @node GNAT Memory_Dump g-memdum ads,GNAT Most_Recent_Exception g-moreex ads,GNAT MD5 g-md5 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-memory-dump-g-memdum-ads}@anchor{38e}@anchor{gnat_rm/the_gnat_library id93}@anchor{38f} +@anchor{gnat_rm/the_gnat_library gnat-memory-dump-g-memdum-ads}@anchor{392}@anchor{gnat_rm/the_gnat_library id95}@anchor{393} @section @code{GNAT.Memory_Dump} (@code{g-memdum.ads}) @@ -24701,7 +24738,7 @@ standard output or standard error files. Uses GNAT.IO for actual output. @node GNAT Most_Recent_Exception g-moreex ads,GNAT OS_Lib g-os_lib ads,GNAT Memory_Dump g-memdum ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-most-recent-exception-g-moreex-ads}@anchor{390}@anchor{gnat_rm/the_gnat_library id94}@anchor{391} +@anchor{gnat_rm/the_gnat_library gnat-most-recent-exception-g-moreex-ads}@anchor{394}@anchor{gnat_rm/the_gnat_library id96}@anchor{395} @section @code{GNAT.Most_Recent_Exception} (@code{g-moreex.ads}) @@ -24715,7 +24752,7 @@ various logging purposes, including duplicating functionality of some Ada 83 implementation dependent extensions. @node GNAT OS_Lib g-os_lib ads,GNAT Perfect_Hash_Generators g-pehage ads,GNAT Most_Recent_Exception g-moreex ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-os-lib-g-os-lib-ads}@anchor{392}@anchor{gnat_rm/the_gnat_library id95}@anchor{393} +@anchor{gnat_rm/the_gnat_library gnat-os-lib-g-os-lib-ads}@anchor{396}@anchor{gnat_rm/the_gnat_library id97}@anchor{397} @section @code{GNAT.OS_Lib} (@code{g-os_lib.ads}) @@ -24731,7 +24768,7 @@ including a portable spawn procedure, and access to environment variables and error return codes. @node GNAT Perfect_Hash_Generators g-pehage ads,GNAT Random_Numbers g-rannum ads,GNAT OS_Lib g-os_lib ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-perfect-hash-generators-g-pehage-ads}@anchor{394}@anchor{gnat_rm/the_gnat_library id96}@anchor{395} +@anchor{gnat_rm/the_gnat_library gnat-perfect-hash-generators-g-pehage-ads}@anchor{398}@anchor{gnat_rm/the_gnat_library id98}@anchor{399} @section @code{GNAT.Perfect_Hash_Generators} (@code{g-pehage.ads}) @@ -24749,7 +24786,7 @@ hashcode are in the same order. These hashing functions are very convenient for use with realtime applications. @node GNAT Random_Numbers g-rannum ads,GNAT Regexp g-regexp ads,GNAT Perfect_Hash_Generators g-pehage ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-random-numbers-g-rannum-ads}@anchor{396}@anchor{gnat_rm/the_gnat_library id97}@anchor{397} +@anchor{gnat_rm/the_gnat_library gnat-random-numbers-g-rannum-ads}@anchor{39a}@anchor{gnat_rm/the_gnat_library id99}@anchor{39b} @section @code{GNAT.Random_Numbers} (@code{g-rannum.ads}) @@ -24761,7 +24798,7 @@ Provides random number capabilities which extend those available in the standard Ada library and are more convenient to use. @node GNAT Regexp g-regexp ads,GNAT Registry g-regist ads,GNAT Random_Numbers g-rannum ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-regexp-g-regexp-ads}@anchor{25d}@anchor{gnat_rm/the_gnat_library id98}@anchor{398} +@anchor{gnat_rm/the_gnat_library gnat-regexp-g-regexp-ads}@anchor{25d}@anchor{gnat_rm/the_gnat_library id100}@anchor{39c} @section @code{GNAT.Regexp} (@code{g-regexp.ads}) @@ -24777,7 +24814,7 @@ simplest of the three pattern matching packages provided, and is particularly suitable for ‘file globbing’ applications. @node GNAT Registry g-regist ads,GNAT Regpat g-regpat ads,GNAT Regexp g-regexp ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-registry-g-regist-ads}@anchor{399}@anchor{gnat_rm/the_gnat_library id99}@anchor{39a} +@anchor{gnat_rm/the_gnat_library gnat-registry-g-regist-ads}@anchor{39d}@anchor{gnat_rm/the_gnat_library id101}@anchor{39e} @section @code{GNAT.Registry} (@code{g-regist.ads}) @@ -24791,7 +24828,7 @@ registry API, but at a lower level of abstraction, refer to the Win32.Winreg package provided with the Win32Ada binding @node GNAT Regpat g-regpat ads,GNAT Rewrite_Data g-rewdat ads,GNAT Registry g-regist ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-regpat-g-regpat-ads}@anchor{39b}@anchor{gnat_rm/the_gnat_library id100}@anchor{39c} +@anchor{gnat_rm/the_gnat_library gnat-regpat-g-regpat-ads}@anchor{39f}@anchor{gnat_rm/the_gnat_library id102}@anchor{3a0} @section @code{GNAT.Regpat} (@code{g-regpat.ads}) @@ -24806,7 +24843,7 @@ from the original V7 style regular expression library written in C by Henry Spencer (and binary compatible with this C library). @node GNAT Rewrite_Data g-rewdat ads,GNAT Secondary_Stack_Info g-sestin ads,GNAT Regpat g-regpat ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-rewrite-data-g-rewdat-ads}@anchor{39d}@anchor{gnat_rm/the_gnat_library id101}@anchor{39e} +@anchor{gnat_rm/the_gnat_library gnat-rewrite-data-g-rewdat-ads}@anchor{3a1}@anchor{gnat_rm/the_gnat_library id103}@anchor{3a2} @section @code{GNAT.Rewrite_Data} (@code{g-rewdat.ads}) @@ -24820,7 +24857,7 @@ full content to be processed is not loaded into memory all at once. This makes this interface usable for large files or socket streams. @node GNAT Secondary_Stack_Info g-sestin ads,GNAT Semaphores g-semaph ads,GNAT Rewrite_Data g-rewdat ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-secondary-stack-info-g-sestin-ads}@anchor{39f}@anchor{gnat_rm/the_gnat_library id102}@anchor{3a0} +@anchor{gnat_rm/the_gnat_library gnat-secondary-stack-info-g-sestin-ads}@anchor{3a3}@anchor{gnat_rm/the_gnat_library id104}@anchor{3a4} @section @code{GNAT.Secondary_Stack_Info} (@code{g-sestin.ads}) @@ -24832,7 +24869,7 @@ Provide the capability to query the high water mark of the current task’s secondary stack. @node GNAT Semaphores g-semaph ads,GNAT Serial_Communications g-sercom ads,GNAT Secondary_Stack_Info g-sestin ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-semaphores-g-semaph-ads}@anchor{3a1}@anchor{gnat_rm/the_gnat_library id103}@anchor{3a2} +@anchor{gnat_rm/the_gnat_library gnat-semaphores-g-semaph-ads}@anchor{3a5}@anchor{gnat_rm/the_gnat_library id105}@anchor{3a6} @section @code{GNAT.Semaphores} (@code{g-semaph.ads}) @@ -24843,7 +24880,7 @@ secondary stack. Provides classic counting and binary semaphores using protected types. @node GNAT Serial_Communications g-sercom ads,GNAT SHA1 g-sha1 ads,GNAT Semaphores g-semaph ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-serial-communications-g-sercom-ads}@anchor{3a3}@anchor{gnat_rm/the_gnat_library id104}@anchor{3a4} +@anchor{gnat_rm/the_gnat_library gnat-serial-communications-g-sercom-ads}@anchor{3a7}@anchor{gnat_rm/the_gnat_library id106}@anchor{3a8} @section @code{GNAT.Serial_Communications} (@code{g-sercom.ads}) @@ -24855,7 +24892,7 @@ Provides a simple interface to send and receive data over a serial port. This is only supported on GNU/Linux and Windows. @node GNAT SHA1 g-sha1 ads,GNAT SHA224 g-sha224 ads,GNAT Serial_Communications g-sercom ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-sha1-g-sha1-ads}@anchor{3a5}@anchor{gnat_rm/the_gnat_library id105}@anchor{3a6} +@anchor{gnat_rm/the_gnat_library gnat-sha1-g-sha1-ads}@anchor{3a9}@anchor{gnat_rm/the_gnat_library id107}@anchor{3aa} @section @code{GNAT.SHA1} (@code{g-sha1.ads}) @@ -24868,7 +24905,7 @@ and RFC 3174, and the HMAC-SHA1 message authentication function as described in RFC 2104 and FIPS PUB 198. @node GNAT SHA224 g-sha224 ads,GNAT SHA256 g-sha256 ads,GNAT SHA1 g-sha1 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-sha224-g-sha224-ads}@anchor{3a7}@anchor{gnat_rm/the_gnat_library id106}@anchor{3a8} +@anchor{gnat_rm/the_gnat_library gnat-sha224-g-sha224-ads}@anchor{3ab}@anchor{gnat_rm/the_gnat_library id108}@anchor{3ac} @section @code{GNAT.SHA224} (@code{g-sha224.ads}) @@ -24881,7 +24918,7 @@ and the HMAC-SHA224 message authentication function as described in RFC 2104 and FIPS PUB 198. @node GNAT SHA256 g-sha256 ads,GNAT SHA384 g-sha384 ads,GNAT SHA224 g-sha224 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-sha256-g-sha256-ads}@anchor{3a9}@anchor{gnat_rm/the_gnat_library id107}@anchor{3aa} +@anchor{gnat_rm/the_gnat_library gnat-sha256-g-sha256-ads}@anchor{3ad}@anchor{gnat_rm/the_gnat_library id109}@anchor{3ae} @section @code{GNAT.SHA256} (@code{g-sha256.ads}) @@ -24894,7 +24931,7 @@ and the HMAC-SHA256 message authentication function as described in RFC 2104 and FIPS PUB 198. @node GNAT SHA384 g-sha384 ads,GNAT SHA512 g-sha512 ads,GNAT SHA256 g-sha256 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-sha384-g-sha384-ads}@anchor{3ab}@anchor{gnat_rm/the_gnat_library id108}@anchor{3ac} +@anchor{gnat_rm/the_gnat_library gnat-sha384-g-sha384-ads}@anchor{3af}@anchor{gnat_rm/the_gnat_library id110}@anchor{3b0} @section @code{GNAT.SHA384} (@code{g-sha384.ads}) @@ -24907,7 +24944,7 @@ and the HMAC-SHA384 message authentication function as described in RFC 2104 and FIPS PUB 198. @node GNAT SHA512 g-sha512 ads,GNAT Signals g-signal ads,GNAT SHA384 g-sha384 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-sha512-g-sha512-ads}@anchor{3ad}@anchor{gnat_rm/the_gnat_library id109}@anchor{3ae} +@anchor{gnat_rm/the_gnat_library gnat-sha512-g-sha512-ads}@anchor{3b1}@anchor{gnat_rm/the_gnat_library id111}@anchor{3b2} @section @code{GNAT.SHA512} (@code{g-sha512.ads}) @@ -24920,7 +24957,7 @@ and the HMAC-SHA512 message authentication function as described in RFC 2104 and FIPS PUB 198. @node GNAT Signals g-signal ads,GNAT Sockets g-socket ads,GNAT SHA512 g-sha512 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-signals-g-signal-ads}@anchor{3af}@anchor{gnat_rm/the_gnat_library id110}@anchor{3b0} +@anchor{gnat_rm/the_gnat_library gnat-signals-g-signal-ads}@anchor{3b3}@anchor{gnat_rm/the_gnat_library id112}@anchor{3b4} @section @code{GNAT.Signals} (@code{g-signal.ads}) @@ -24932,7 +24969,7 @@ Provides the ability to manipulate the blocked status of signals on supported targets. @node GNAT Sockets g-socket ads,GNAT Source_Info g-souinf ads,GNAT Signals g-signal ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-sockets-g-socket-ads}@anchor{3b1}@anchor{gnat_rm/the_gnat_library id111}@anchor{3b2} +@anchor{gnat_rm/the_gnat_library gnat-sockets-g-socket-ads}@anchor{3b5}@anchor{gnat_rm/the_gnat_library id113}@anchor{3b6} @section @code{GNAT.Sockets} (@code{g-socket.ads}) @@ -24947,7 +24984,7 @@ on all native GNAT ports and on VxWorks cross prots. It is not implemented for the LynxOS cross port. @node GNAT Source_Info g-souinf ads,GNAT Spelling_Checker g-speche ads,GNAT Sockets g-socket ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-source-info-g-souinf-ads}@anchor{3b3}@anchor{gnat_rm/the_gnat_library id112}@anchor{3b4} +@anchor{gnat_rm/the_gnat_library gnat-source-info-g-souinf-ads}@anchor{3b7}@anchor{gnat_rm/the_gnat_library id114}@anchor{3b8} @section @code{GNAT.Source_Info} (@code{g-souinf.ads}) @@ -24961,7 +24998,7 @@ subprograms yielding the date and time of the current compilation (like the C macros @code{__DATE__} and @code{__TIME__}) @node GNAT Spelling_Checker g-speche ads,GNAT Spelling_Checker_Generic g-spchge ads,GNAT Source_Info g-souinf ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-spelling-checker-g-speche-ads}@anchor{3b5}@anchor{gnat_rm/the_gnat_library id113}@anchor{3b6} +@anchor{gnat_rm/the_gnat_library gnat-spelling-checker-g-speche-ads}@anchor{3b9}@anchor{gnat_rm/the_gnat_library id115}@anchor{3ba} @section @code{GNAT.Spelling_Checker} (@code{g-speche.ads}) @@ -24973,7 +25010,7 @@ Provides a function for determining whether one string is a plausible near misspelling of another string. @node GNAT Spelling_Checker_Generic g-spchge ads,GNAT Spitbol Patterns g-spipat ads,GNAT Spelling_Checker g-speche ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-spelling-checker-generic-g-spchge-ads}@anchor{3b7}@anchor{gnat_rm/the_gnat_library id114}@anchor{3b8} +@anchor{gnat_rm/the_gnat_library gnat-spelling-checker-generic-g-spchge-ads}@anchor{3bb}@anchor{gnat_rm/the_gnat_library id116}@anchor{3bc} @section @code{GNAT.Spelling_Checker_Generic} (@code{g-spchge.ads}) @@ -24986,7 +25023,7 @@ determining whether one string is a plausible near misspelling of another string. @node GNAT Spitbol Patterns g-spipat ads,GNAT Spitbol g-spitbo ads,GNAT Spelling_Checker_Generic g-spchge ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-spitbol-patterns-g-spipat-ads}@anchor{3b9}@anchor{gnat_rm/the_gnat_library id115}@anchor{3ba} +@anchor{gnat_rm/the_gnat_library gnat-spitbol-patterns-g-spipat-ads}@anchor{3bd}@anchor{gnat_rm/the_gnat_library id117}@anchor{3be} @section @code{GNAT.Spitbol.Patterns} (@code{g-spipat.ads}) @@ -25002,7 +25039,7 @@ the SNOBOL4 dynamic pattern construction and matching capabilities, using the efficient algorithm developed by Robert Dewar for the SPITBOL system. @node GNAT Spitbol g-spitbo ads,GNAT Spitbol Table_Boolean g-sptabo ads,GNAT Spitbol Patterns g-spipat ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-spitbol-g-spitbo-ads}@anchor{3bb}@anchor{gnat_rm/the_gnat_library id116}@anchor{3bc} +@anchor{gnat_rm/the_gnat_library gnat-spitbol-g-spitbo-ads}@anchor{3bf}@anchor{gnat_rm/the_gnat_library id118}@anchor{3c0} @section @code{GNAT.Spitbol} (@code{g-spitbo.ads}) @@ -25017,7 +25054,7 @@ useful for constructing arbitrary mappings from strings in the style of the SNOBOL4 TABLE function. @node GNAT Spitbol Table_Boolean g-sptabo ads,GNAT Spitbol Table_Integer g-sptain ads,GNAT Spitbol g-spitbo ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-spitbol-table-boolean-g-sptabo-ads}@anchor{3bd}@anchor{gnat_rm/the_gnat_library id117}@anchor{3be} +@anchor{gnat_rm/the_gnat_library gnat-spitbol-table-boolean-g-sptabo-ads}@anchor{3c1}@anchor{gnat_rm/the_gnat_library id119}@anchor{3c2} @section @code{GNAT.Spitbol.Table_Boolean} (@code{g-sptabo.ads}) @@ -25032,7 +25069,7 @@ for type @code{Standard.Boolean}, giving an implementation of sets of string values. @node GNAT Spitbol Table_Integer g-sptain ads,GNAT Spitbol Table_VString g-sptavs ads,GNAT Spitbol Table_Boolean g-sptabo ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-spitbol-table-integer-g-sptain-ads}@anchor{3bf}@anchor{gnat_rm/the_gnat_library id118}@anchor{3c0} +@anchor{gnat_rm/the_gnat_library gnat-spitbol-table-integer-g-sptain-ads}@anchor{3c3}@anchor{gnat_rm/the_gnat_library id120}@anchor{3c4} @section @code{GNAT.Spitbol.Table_Integer} (@code{g-sptain.ads}) @@ -25049,7 +25086,7 @@ for type @code{Standard.Integer}, giving an implementation of maps from string to integer values. @node GNAT Spitbol Table_VString g-sptavs ads,GNAT SSE g-sse ads,GNAT Spitbol Table_Integer g-sptain ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-spitbol-table-vstring-g-sptavs-ads}@anchor{3c1}@anchor{gnat_rm/the_gnat_library id119}@anchor{3c2} +@anchor{gnat_rm/the_gnat_library gnat-spitbol-table-vstring-g-sptavs-ads}@anchor{3c5}@anchor{gnat_rm/the_gnat_library id121}@anchor{3c6} @section @code{GNAT.Spitbol.Table_VString} (@code{g-sptavs.ads}) @@ -25066,7 +25103,7 @@ a variable length string type, giving an implementation of general maps from strings to strings. @node GNAT SSE g-sse ads,GNAT SSE Vector_Types g-ssvety ads,GNAT Spitbol Table_VString g-sptavs ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-sse-g-sse-ads}@anchor{3c3}@anchor{gnat_rm/the_gnat_library id120}@anchor{3c4} +@anchor{gnat_rm/the_gnat_library gnat-sse-g-sse-ads}@anchor{3c7}@anchor{gnat_rm/the_gnat_library id122}@anchor{3c8} @section @code{GNAT.SSE} (@code{g-sse.ads}) @@ -25078,7 +25115,7 @@ targets. It exposes vector component types together with a general introduction to the binding contents and use. @node GNAT SSE Vector_Types g-ssvety ads,GNAT String_Hash g-strhas ads,GNAT SSE g-sse ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-sse-vector-types-g-ssvety-ads}@anchor{3c5}@anchor{gnat_rm/the_gnat_library id121}@anchor{3c6} +@anchor{gnat_rm/the_gnat_library gnat-sse-vector-types-g-ssvety-ads}@anchor{3c9}@anchor{gnat_rm/the_gnat_library id123}@anchor{3ca} @section @code{GNAT.SSE.Vector_Types} (@code{g-ssvety.ads}) @@ -25087,7 +25124,7 @@ introduction to the binding contents and use. SSE vector types for use with SSE related intrinsics. @node GNAT String_Hash g-strhas ads,GNAT Strings g-string ads,GNAT SSE Vector_Types g-ssvety ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-string-hash-g-strhas-ads}@anchor{3c7}@anchor{gnat_rm/the_gnat_library id122}@anchor{3c8} +@anchor{gnat_rm/the_gnat_library gnat-string-hash-g-strhas-ads}@anchor{3cb}@anchor{gnat_rm/the_gnat_library id124}@anchor{3cc} @section @code{GNAT.String_Hash} (@code{g-strhas.ads}) @@ -25099,7 +25136,7 @@ Provides a generic hash function working on arrays of scalars. Both the scalar type and the hash result type are parameters. @node GNAT Strings g-string ads,GNAT String_Split g-strspl ads,GNAT String_Hash g-strhas ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-strings-g-string-ads}@anchor{3c9}@anchor{gnat_rm/the_gnat_library id123}@anchor{3ca} +@anchor{gnat_rm/the_gnat_library gnat-strings-g-string-ads}@anchor{3cd}@anchor{gnat_rm/the_gnat_library id125}@anchor{3ce} @section @code{GNAT.Strings} (@code{g-string.ads}) @@ -25109,7 +25146,7 @@ Common String access types and related subprograms. Basically it defines a string access and an array of string access types. @node GNAT String_Split g-strspl ads,GNAT Table g-table ads,GNAT Strings g-string ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-string-split-g-strspl-ads}@anchor{3cb}@anchor{gnat_rm/the_gnat_library id124}@anchor{3cc} +@anchor{gnat_rm/the_gnat_library gnat-string-split-g-strspl-ads}@anchor{3cf}@anchor{gnat_rm/the_gnat_library id126}@anchor{3d0} @section @code{GNAT.String_Split} (@code{g-strspl.ads}) @@ -25123,7 +25160,7 @@ to the resulting slices. This package is instantiated from @code{GNAT.Array_Split}. @node GNAT Table g-table ads,GNAT Task_Lock g-tasloc ads,GNAT String_Split g-strspl ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-table-g-table-ads}@anchor{3cd}@anchor{gnat_rm/the_gnat_library id125}@anchor{3ce} +@anchor{gnat_rm/the_gnat_library gnat-table-g-table-ads}@anchor{3d1}@anchor{gnat_rm/the_gnat_library id127}@anchor{3d2} @section @code{GNAT.Table} (@code{g-table.ads}) @@ -25143,7 +25180,7 @@ while an instantiation of @code{GNAT.Dynamic_Tables} creates a type that can be used to define dynamic instances of the table. @node GNAT Task_Lock g-tasloc ads,GNAT Time_Stamp g-timsta ads,GNAT Table g-table ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-task-lock-g-tasloc-ads}@anchor{3cf}@anchor{gnat_rm/the_gnat_library id126}@anchor{3d0} +@anchor{gnat_rm/the_gnat_library gnat-task-lock-g-tasloc-ads}@anchor{3d3}@anchor{gnat_rm/the_gnat_library id128}@anchor{3d4} @section @code{GNAT.Task_Lock} (@code{g-tasloc.ads}) @@ -25160,7 +25197,7 @@ single global task lock. Appropriate for use in situations where contention between tasks is very rarely expected. @node GNAT Time_Stamp g-timsta ads,GNAT Threads g-thread ads,GNAT Task_Lock g-tasloc ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-time-stamp-g-timsta-ads}@anchor{3d1}@anchor{gnat_rm/the_gnat_library id127}@anchor{3d2} +@anchor{gnat_rm/the_gnat_library gnat-time-stamp-g-timsta-ads}@anchor{3d5}@anchor{gnat_rm/the_gnat_library id129}@anchor{3d6} @section @code{GNAT.Time_Stamp} (@code{g-timsta.ads}) @@ -25175,7 +25212,7 @@ represents the current date and time in ISO 8601 format. This is a very simple routine with minimal code and there are no dependencies on any other unit. @node GNAT Threads g-thread ads,GNAT Traceback g-traceb ads,GNAT Time_Stamp g-timsta ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-threads-g-thread-ads}@anchor{3d3}@anchor{gnat_rm/the_gnat_library id128}@anchor{3d4} +@anchor{gnat_rm/the_gnat_library gnat-threads-g-thread-ads}@anchor{3d7}@anchor{gnat_rm/the_gnat_library id130}@anchor{3d8} @section @code{GNAT.Threads} (@code{g-thread.ads}) @@ -25192,7 +25229,7 @@ further details if your program has threads that are created by a non-Ada environment which then accesses Ada code. @node GNAT Traceback g-traceb ads,GNAT Traceback Symbolic g-trasym ads,GNAT Threads g-thread ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-traceback-g-traceb-ads}@anchor{3d5}@anchor{gnat_rm/the_gnat_library id129}@anchor{3d6} +@anchor{gnat_rm/the_gnat_library gnat-traceback-g-traceb-ads}@anchor{3d9}@anchor{gnat_rm/the_gnat_library id131}@anchor{3da} @section @code{GNAT.Traceback} (@code{g-traceb.ads}) @@ -25204,7 +25241,7 @@ Provides a facility for obtaining non-symbolic traceback information, useful in various debugging situations. @node GNAT Traceback Symbolic g-trasym ads,GNAT UTF_32 g-table ads,GNAT Traceback g-traceb ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-traceback-symbolic-g-trasym-ads}@anchor{3d7}@anchor{gnat_rm/the_gnat_library id130}@anchor{3d8} +@anchor{gnat_rm/the_gnat_library gnat-traceback-symbolic-g-trasym-ads}@anchor{3db}@anchor{gnat_rm/the_gnat_library id132}@anchor{3dc} @section @code{GNAT.Traceback.Symbolic} (@code{g-trasym.ads}) @@ -25213,7 +25250,7 @@ in various debugging situations. @geindex Trace back facilities @node GNAT UTF_32 g-table ads,GNAT Wide_Spelling_Checker g-u3spch ads,GNAT Traceback Symbolic g-trasym ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-utf-32-g-table-ads}@anchor{3d9}@anchor{gnat_rm/the_gnat_library id131}@anchor{3da} +@anchor{gnat_rm/the_gnat_library gnat-utf-32-g-table-ads}@anchor{3dd}@anchor{gnat_rm/the_gnat_library id133}@anchor{3de} @section @code{GNAT.UTF_32} (@code{g-table.ads}) @@ -25232,7 +25269,7 @@ lower case to upper case fold routine corresponding to the Ada 2005 rules for identifier equivalence. @node GNAT Wide_Spelling_Checker g-u3spch ads,GNAT Wide_Spelling_Checker g-wispch ads,GNAT UTF_32 g-table ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-wide-spelling-checker-g-u3spch-ads}@anchor{3db}@anchor{gnat_rm/the_gnat_library id132}@anchor{3dc} +@anchor{gnat_rm/the_gnat_library gnat-wide-spelling-checker-g-u3spch-ads}@anchor{3df}@anchor{gnat_rm/the_gnat_library id134}@anchor{3e0} @section @code{GNAT.Wide_Spelling_Checker} (@code{g-u3spch.ads}) @@ -25245,7 +25282,7 @@ near misspelling of another wide wide string, where the strings are represented using the UTF_32_String type defined in System.Wch_Cnv. @node GNAT Wide_Spelling_Checker g-wispch ads,GNAT Wide_String_Split g-wistsp ads,GNAT Wide_Spelling_Checker g-u3spch ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-wide-spelling-checker-g-wispch-ads}@anchor{3dd}@anchor{gnat_rm/the_gnat_library id133}@anchor{3de} +@anchor{gnat_rm/the_gnat_library gnat-wide-spelling-checker-g-wispch-ads}@anchor{3e1}@anchor{gnat_rm/the_gnat_library id135}@anchor{3e2} @section @code{GNAT.Wide_Spelling_Checker} (@code{g-wispch.ads}) @@ -25257,7 +25294,7 @@ Provides a function for determining whether one wide string is a plausible near misspelling of another wide string. @node GNAT Wide_String_Split g-wistsp ads,GNAT Wide_Wide_Spelling_Checker g-zspche ads,GNAT Wide_Spelling_Checker g-wispch ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-wide-string-split-g-wistsp-ads}@anchor{3df}@anchor{gnat_rm/the_gnat_library id134}@anchor{3e0} +@anchor{gnat_rm/the_gnat_library gnat-wide-string-split-g-wistsp-ads}@anchor{3e3}@anchor{gnat_rm/the_gnat_library id136}@anchor{3e4} @section @code{GNAT.Wide_String_Split} (@code{g-wistsp.ads}) @@ -25271,7 +25308,7 @@ to the resulting slices. This package is instantiated from @code{GNAT.Array_Split}. @node GNAT Wide_Wide_Spelling_Checker g-zspche ads,GNAT Wide_Wide_String_Split g-zistsp ads,GNAT Wide_String_Split g-wistsp ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-wide-wide-spelling-checker-g-zspche-ads}@anchor{3e1}@anchor{gnat_rm/the_gnat_library id135}@anchor{3e2} +@anchor{gnat_rm/the_gnat_library gnat-wide-wide-spelling-checker-g-zspche-ads}@anchor{3e5}@anchor{gnat_rm/the_gnat_library id137}@anchor{3e6} @section @code{GNAT.Wide_Wide_Spelling_Checker} (@code{g-zspche.ads}) @@ -25283,7 +25320,7 @@ Provides a function for determining whether one wide wide string is a plausible near misspelling of another wide wide string. @node GNAT Wide_Wide_String_Split g-zistsp ads,Interfaces C Extensions i-cexten ads,GNAT Wide_Wide_Spelling_Checker g-zspche ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-wide-wide-string-split-g-zistsp-ads}@anchor{3e3}@anchor{gnat_rm/the_gnat_library id136}@anchor{3e4} +@anchor{gnat_rm/the_gnat_library gnat-wide-wide-string-split-g-zistsp-ads}@anchor{3e7}@anchor{gnat_rm/the_gnat_library id138}@anchor{3e8} @section @code{GNAT.Wide_Wide_String_Split} (@code{g-zistsp.ads}) @@ -25297,7 +25334,7 @@ to the resulting slices. This package is instantiated from @code{GNAT.Array_Split}. @node Interfaces C Extensions i-cexten ads,Interfaces C Streams i-cstrea ads,GNAT Wide_Wide_String_Split g-zistsp ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id137}@anchor{3e5}@anchor{gnat_rm/the_gnat_library interfaces-c-extensions-i-cexten-ads}@anchor{3e6} +@anchor{gnat_rm/the_gnat_library id139}@anchor{3e9}@anchor{gnat_rm/the_gnat_library interfaces-c-extensions-i-cexten-ads}@anchor{3ea} @section @code{Interfaces.C.Extensions} (@code{i-cexten.ads}) @@ -25308,7 +25345,7 @@ for use with either manually or automatically generated bindings to C libraries. @node Interfaces C Streams i-cstrea ads,Interfaces Packed_Decimal i-pacdec ads,Interfaces C Extensions i-cexten ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id138}@anchor{3e7}@anchor{gnat_rm/the_gnat_library interfaces-c-streams-i-cstrea-ads}@anchor{3e8} +@anchor{gnat_rm/the_gnat_library id140}@anchor{3eb}@anchor{gnat_rm/the_gnat_library interfaces-c-streams-i-cstrea-ads}@anchor{3ec} @section @code{Interfaces.C.Streams} (@code{i-cstrea.ads}) @@ -25321,7 +25358,7 @@ This package is a binding for the most commonly used operations on C streams. @node Interfaces Packed_Decimal i-pacdec ads,Interfaces VxWorks i-vxwork ads,Interfaces C Streams i-cstrea ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id139}@anchor{3e9}@anchor{gnat_rm/the_gnat_library interfaces-packed-decimal-i-pacdec-ads}@anchor{3ea} +@anchor{gnat_rm/the_gnat_library id141}@anchor{3ed}@anchor{gnat_rm/the_gnat_library interfaces-packed-decimal-i-pacdec-ads}@anchor{3ee} @section @code{Interfaces.Packed_Decimal} (@code{i-pacdec.ads}) @@ -25336,7 +25373,7 @@ from a packed decimal format compatible with that used on IBM mainframes. @node Interfaces VxWorks i-vxwork ads,Interfaces VxWorks Int_Connection i-vxinco ads,Interfaces Packed_Decimal i-pacdec ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id140}@anchor{3eb}@anchor{gnat_rm/the_gnat_library interfaces-vxworks-i-vxwork-ads}@anchor{3ec} +@anchor{gnat_rm/the_gnat_library id142}@anchor{3ef}@anchor{gnat_rm/the_gnat_library interfaces-vxworks-i-vxwork-ads}@anchor{3f0} @section @code{Interfaces.VxWorks} (@code{i-vxwork.ads}) @@ -25352,7 +25389,7 @@ In particular, it interfaces with the VxWorks hardware interrupt facilities. @node Interfaces VxWorks Int_Connection i-vxinco ads,Interfaces VxWorks IO i-vxwoio ads,Interfaces VxWorks i-vxwork ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id141}@anchor{3ed}@anchor{gnat_rm/the_gnat_library interfaces-vxworks-int-connection-i-vxinco-ads}@anchor{3ee} +@anchor{gnat_rm/the_gnat_library id143}@anchor{3f1}@anchor{gnat_rm/the_gnat_library interfaces-vxworks-int-connection-i-vxinco-ads}@anchor{3f2} @section @code{Interfaces.VxWorks.Int_Connection} (@code{i-vxinco.ads}) @@ -25368,7 +25405,7 @@ intConnect() with a custom routine for installing interrupt handlers. @node Interfaces VxWorks IO i-vxwoio ads,System Address_Image s-addima ads,Interfaces VxWorks Int_Connection i-vxinco ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id142}@anchor{3ef}@anchor{gnat_rm/the_gnat_library interfaces-vxworks-io-i-vxwoio-ads}@anchor{3f0} +@anchor{gnat_rm/the_gnat_library id144}@anchor{3f3}@anchor{gnat_rm/the_gnat_library interfaces-vxworks-io-i-vxwoio-ads}@anchor{3f4} @section @code{Interfaces.VxWorks.IO} (@code{i-vxwoio.ads}) @@ -25391,7 +25428,7 @@ function codes. A particular use of this package is to enable the use of Get_Immediate under VxWorks. @node System Address_Image s-addima ads,System Assertions s-assert ads,Interfaces VxWorks IO i-vxwoio ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id143}@anchor{3f1}@anchor{gnat_rm/the_gnat_library system-address-image-s-addima-ads}@anchor{3f2} +@anchor{gnat_rm/the_gnat_library id145}@anchor{3f5}@anchor{gnat_rm/the_gnat_library system-address-image-s-addima-ads}@anchor{3f6} @section @code{System.Address_Image} (@code{s-addima.ads}) @@ -25407,7 +25444,7 @@ function that gives an (implementation dependent) string which identifies an address. @node System Assertions s-assert ads,System Atomic_Counters s-atocou ads,System Address_Image s-addima ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id144}@anchor{3f3}@anchor{gnat_rm/the_gnat_library system-assertions-s-assert-ads}@anchor{3f4} +@anchor{gnat_rm/the_gnat_library id146}@anchor{3f7}@anchor{gnat_rm/the_gnat_library system-assertions-s-assert-ads}@anchor{3f8} @section @code{System.Assertions} (@code{s-assert.ads}) @@ -25423,7 +25460,7 @@ by an run-time assertion failure, as well as the routine that is used internally to raise this assertion. @node System Atomic_Counters s-atocou ads,System Memory s-memory ads,System Assertions s-assert ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id145}@anchor{3f5}@anchor{gnat_rm/the_gnat_library system-atomic-counters-s-atocou-ads}@anchor{3f6} +@anchor{gnat_rm/the_gnat_library id147}@anchor{3f9}@anchor{gnat_rm/the_gnat_library system-atomic-counters-s-atocou-ads}@anchor{3fa} @section @code{System.Atomic_Counters} (@code{s-atocou.ads}) @@ -25437,7 +25474,7 @@ on most targets, including all Alpha, AARCH64, ARM, ia64, PowerPC, SPARC V9, x86, and x86_64 platforms. @node System Memory s-memory ads,System Multiprocessors s-multip ads,System Atomic_Counters s-atocou ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id146}@anchor{3f7}@anchor{gnat_rm/the_gnat_library system-memory-s-memory-ads}@anchor{3f8} +@anchor{gnat_rm/the_gnat_library id148}@anchor{3fb}@anchor{gnat_rm/the_gnat_library system-memory-s-memory-ads}@anchor{3fc} @section @code{System.Memory} (@code{s-memory.ads}) @@ -25455,7 +25492,7 @@ calls to this unit may be made for low level allocation uses (for example see the body of @code{GNAT.Tables}). @node System Multiprocessors s-multip ads,System Multiprocessors Dispatching_Domains s-mudido ads,System Memory s-memory ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id147}@anchor{3f9}@anchor{gnat_rm/the_gnat_library system-multiprocessors-s-multip-ads}@anchor{3fa} +@anchor{gnat_rm/the_gnat_library id149}@anchor{3fd}@anchor{gnat_rm/the_gnat_library system-multiprocessors-s-multip-ads}@anchor{3fe} @section @code{System.Multiprocessors} (@code{s-multip.ads}) @@ -25468,7 +25505,7 @@ in GNAT we also make it available in Ada 95 and Ada 2005 (where it is technically an implementation-defined addition). @node System Multiprocessors Dispatching_Domains s-mudido ads,System Partition_Interface s-parint ads,System Multiprocessors s-multip ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id148}@anchor{3fb}@anchor{gnat_rm/the_gnat_library system-multiprocessors-dispatching-domains-s-mudido-ads}@anchor{3fc} +@anchor{gnat_rm/the_gnat_library id150}@anchor{3ff}@anchor{gnat_rm/the_gnat_library system-multiprocessors-dispatching-domains-s-mudido-ads}@anchor{400} @section @code{System.Multiprocessors.Dispatching_Domains} (@code{s-mudido.ads}) @@ -25481,7 +25518,7 @@ in GNAT we also make it available in Ada 95 and Ada 2005 (where it is technically an implementation-defined addition). @node System Partition_Interface s-parint ads,System Pool_Global s-pooglo ads,System Multiprocessors Dispatching_Domains s-mudido ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id149}@anchor{3fd}@anchor{gnat_rm/the_gnat_library system-partition-interface-s-parint-ads}@anchor{3fe} +@anchor{gnat_rm/the_gnat_library id151}@anchor{401}@anchor{gnat_rm/the_gnat_library system-partition-interface-s-parint-ads}@anchor{402} @section @code{System.Partition_Interface} (@code{s-parint.ads}) @@ -25494,7 +25531,7 @@ is used primarily in a distribution context when using Annex E with @code{GLADE}. @node System Pool_Global s-pooglo ads,System Pool_Local s-pooloc ads,System Partition_Interface s-parint ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id150}@anchor{3ff}@anchor{gnat_rm/the_gnat_library system-pool-global-s-pooglo-ads}@anchor{400} +@anchor{gnat_rm/the_gnat_library id152}@anchor{403}@anchor{gnat_rm/the_gnat_library system-pool-global-s-pooglo-ads}@anchor{404} @section @code{System.Pool_Global} (@code{s-pooglo.ads}) @@ -25511,7 +25548,7 @@ declared. It uses malloc/free to allocate/free and does not attempt to do any automatic reclamation. @node System Pool_Local s-pooloc ads,System Restrictions s-restri ads,System Pool_Global s-pooglo ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id151}@anchor{401}@anchor{gnat_rm/the_gnat_library system-pool-local-s-pooloc-ads}@anchor{402} +@anchor{gnat_rm/the_gnat_library id153}@anchor{405}@anchor{gnat_rm/the_gnat_library system-pool-local-s-pooloc-ads}@anchor{406} @section @code{System.Pool_Local} (@code{s-pooloc.ads}) @@ -25528,7 +25565,7 @@ a list of allocated blocks, so that all storage allocated for the pool can be freed automatically when the pool is finalized. @node System Restrictions s-restri ads,System Rident s-rident ads,System Pool_Local s-pooloc ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id152}@anchor{403}@anchor{gnat_rm/the_gnat_library system-restrictions-s-restri-ads}@anchor{404} +@anchor{gnat_rm/the_gnat_library id154}@anchor{407}@anchor{gnat_rm/the_gnat_library system-restrictions-s-restri-ads}@anchor{408} @section @code{System.Restrictions} (@code{s-restri.ads}) @@ -25544,7 +25581,7 @@ compiler determined information on which restrictions are violated by one or more packages in the partition. @node System Rident s-rident ads,System Strings Stream_Ops s-ststop ads,System Restrictions s-restri ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id153}@anchor{405}@anchor{gnat_rm/the_gnat_library system-rident-s-rident-ads}@anchor{406} +@anchor{gnat_rm/the_gnat_library id155}@anchor{409}@anchor{gnat_rm/the_gnat_library system-rident-s-rident-ads}@anchor{40a} @section @code{System.Rident} (@code{s-rident.ads}) @@ -25560,7 +25597,7 @@ since the necessary instantiation is included in package System.Restrictions. @node System Strings Stream_Ops s-ststop ads,System Unsigned_Types s-unstyp ads,System Rident s-rident ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id154}@anchor{407}@anchor{gnat_rm/the_gnat_library system-strings-stream-ops-s-ststop-ads}@anchor{408} +@anchor{gnat_rm/the_gnat_library id156}@anchor{40b}@anchor{gnat_rm/the_gnat_library system-strings-stream-ops-s-ststop-ads}@anchor{40c} @section @code{System.Strings.Stream_Ops} (@code{s-ststop.ads}) @@ -25576,7 +25613,7 @@ stream attributes are applied to string types, but the subprograms in this package can be used directly by application programs. @node System Unsigned_Types s-unstyp ads,System Wch_Cnv s-wchcnv ads,System Strings Stream_Ops s-ststop ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id155}@anchor{409}@anchor{gnat_rm/the_gnat_library system-unsigned-types-s-unstyp-ads}@anchor{40a} +@anchor{gnat_rm/the_gnat_library id157}@anchor{40d}@anchor{gnat_rm/the_gnat_library system-unsigned-types-s-unstyp-ads}@anchor{40e} @section @code{System.Unsigned_Types} (@code{s-unstyp.ads}) @@ -25589,7 +25626,7 @@ also contains some related definitions for other specialized types used by the compiler in connection with packed array types. @node System Wch_Cnv s-wchcnv ads,System Wch_Con s-wchcon ads,System Unsigned_Types s-unstyp ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id156}@anchor{40b}@anchor{gnat_rm/the_gnat_library system-wch-cnv-s-wchcnv-ads}@anchor{40c} +@anchor{gnat_rm/the_gnat_library id158}@anchor{40f}@anchor{gnat_rm/the_gnat_library system-wch-cnv-s-wchcnv-ads}@anchor{410} @section @code{System.Wch_Cnv} (@code{s-wchcnv.ads}) @@ -25610,7 +25647,7 @@ encoding method. It uses definitions in package @code{System.Wch_Con}. @node System Wch_Con s-wchcon ads,,System Wch_Cnv s-wchcnv ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id157}@anchor{40d}@anchor{gnat_rm/the_gnat_library system-wch-con-s-wchcon-ads}@anchor{40e} +@anchor{gnat_rm/the_gnat_library id159}@anchor{411}@anchor{gnat_rm/the_gnat_library system-wch-con-s-wchcon-ads}@anchor{412} @section @code{System.Wch_Con} (@code{s-wchcon.ads}) @@ -25622,7 +25659,7 @@ in ordinary strings. These definitions are used by the package @code{System.Wch_Cnv}. @node Interfacing to Other Languages,Specialized Needs Annexes,The GNAT Library,Top -@anchor{gnat_rm/interfacing_to_other_languages doc}@anchor{40f}@anchor{gnat_rm/interfacing_to_other_languages id1}@anchor{410}@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-other-languages}@anchor{11} +@anchor{gnat_rm/interfacing_to_other_languages doc}@anchor{413}@anchor{gnat_rm/interfacing_to_other_languages id1}@anchor{414}@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-other-languages}@anchor{11} @chapter Interfacing to Other Languages @@ -25640,7 +25677,7 @@ provided. @end menu @node Interfacing to C,Interfacing to C++,,Interfacing to Other Languages -@anchor{gnat_rm/interfacing_to_other_languages id2}@anchor{411}@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-c}@anchor{412} +@anchor{gnat_rm/interfacing_to_other_languages id2}@anchor{415}@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-c}@anchor{416} @section Interfacing to C @@ -25780,7 +25817,7 @@ of the length corresponding to the @code{type'Size} value in Ada. @end itemize @node Interfacing to C++,Interfacing to COBOL,Interfacing to C,Interfacing to Other Languages -@anchor{gnat_rm/interfacing_to_other_languages id3}@anchor{47}@anchor{gnat_rm/interfacing_to_other_languages id4}@anchor{413} +@anchor{gnat_rm/interfacing_to_other_languages id3}@anchor{47}@anchor{gnat_rm/interfacing_to_other_languages id4}@anchor{417} @section Interfacing to C++ @@ -25837,7 +25874,7 @@ The @code{External_Name} is the name of the C++ RTTI symbol. You can then cover a specific C++ exception in an exception handler. @node Interfacing to COBOL,Interfacing to Fortran,Interfacing to C++,Interfacing to Other Languages -@anchor{gnat_rm/interfacing_to_other_languages id5}@anchor{414}@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-cobol}@anchor{415} +@anchor{gnat_rm/interfacing_to_other_languages id5}@anchor{418}@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-cobol}@anchor{419} @section Interfacing to COBOL @@ -25845,7 +25882,7 @@ Interfacing to COBOL is achieved as described in section B.4 of the Ada Reference Manual. @node Interfacing to Fortran,Interfacing to non-GNAT Ada code,Interfacing to COBOL,Interfacing to Other Languages -@anchor{gnat_rm/interfacing_to_other_languages id6}@anchor{416}@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-fortran}@anchor{417} +@anchor{gnat_rm/interfacing_to_other_languages id6}@anchor{41a}@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-fortran}@anchor{41b} @section Interfacing to Fortran @@ -25855,7 +25892,7 @@ multi-dimensional array causes the array to be stored in column-major order as required for convenient interface to Fortran. @node Interfacing to non-GNAT Ada code,,Interfacing to Fortran,Interfacing to Other Languages -@anchor{gnat_rm/interfacing_to_other_languages id7}@anchor{418}@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-non-gnat-ada-code}@anchor{419} +@anchor{gnat_rm/interfacing_to_other_languages id7}@anchor{41c}@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-non-gnat-ada-code}@anchor{41d} @section Interfacing to non-GNAT Ada code @@ -25879,7 +25916,7 @@ values or simple record types without variants, or simple array types with fixed bounds. @node Specialized Needs Annexes,Implementation of Specific Ada Features,Interfacing to Other Languages,Top -@anchor{gnat_rm/specialized_needs_annexes doc}@anchor{41a}@anchor{gnat_rm/specialized_needs_annexes id1}@anchor{41b}@anchor{gnat_rm/specialized_needs_annexes specialized-needs-annexes}@anchor{12} +@anchor{gnat_rm/specialized_needs_annexes doc}@anchor{41e}@anchor{gnat_rm/specialized_needs_annexes id1}@anchor{41f}@anchor{gnat_rm/specialized_needs_annexes specialized-needs-annexes}@anchor{12} @chapter Specialized Needs Annexes @@ -25920,7 +25957,7 @@ in Ada 2005) is fully implemented. @end table @node Implementation of Specific Ada Features,Implementation of Ada 2012 Features,Specialized Needs Annexes,Top -@anchor{gnat_rm/implementation_of_specific_ada_features doc}@anchor{41c}@anchor{gnat_rm/implementation_of_specific_ada_features id1}@anchor{41d}@anchor{gnat_rm/implementation_of_specific_ada_features implementation-of-specific-ada-features}@anchor{13} +@anchor{gnat_rm/implementation_of_specific_ada_features doc}@anchor{420}@anchor{gnat_rm/implementation_of_specific_ada_features id1}@anchor{421}@anchor{gnat_rm/implementation_of_specific_ada_features implementation-of-specific-ada-features}@anchor{13} @chapter Implementation of Specific Ada Features @@ -25939,7 +25976,7 @@ facilities. @end menu @node Machine Code Insertions,GNAT Implementation of Tasking,,Implementation of Specific Ada Features -@anchor{gnat_rm/implementation_of_specific_ada_features id2}@anchor{41e}@anchor{gnat_rm/implementation_of_specific_ada_features machine-code-insertions}@anchor{166} +@anchor{gnat_rm/implementation_of_specific_ada_features id2}@anchor{422}@anchor{gnat_rm/implementation_of_specific_ada_features machine-code-insertions}@anchor{166} @section Machine Code Insertions @@ -26107,7 +26144,7 @@ according to normal visibility rules. In particular if there is no qualification is required. @node GNAT Implementation of Tasking,GNAT Implementation of Shared Passive Packages,Machine Code Insertions,Implementation of Specific Ada Features -@anchor{gnat_rm/implementation_of_specific_ada_features gnat-implementation-of-tasking}@anchor{41f}@anchor{gnat_rm/implementation_of_specific_ada_features id3}@anchor{420} +@anchor{gnat_rm/implementation_of_specific_ada_features gnat-implementation-of-tasking}@anchor{423}@anchor{gnat_rm/implementation_of_specific_ada_features id3}@anchor{424} @section GNAT Implementation of Tasking @@ -26123,7 +26160,7 @@ to compliance with the Real-Time Systems Annex. @end menu @node Mapping Ada Tasks onto the Underlying Kernel Threads,Ensuring Compliance with the Real-Time Annex,,GNAT Implementation of Tasking -@anchor{gnat_rm/implementation_of_specific_ada_features id4}@anchor{421}@anchor{gnat_rm/implementation_of_specific_ada_features mapping-ada-tasks-onto-the-underlying-kernel-threads}@anchor{422} +@anchor{gnat_rm/implementation_of_specific_ada_features id4}@anchor{425}@anchor{gnat_rm/implementation_of_specific_ada_features mapping-ada-tasks-onto-the-underlying-kernel-threads}@anchor{426} @subsection Mapping Ada Tasks onto the Underlying Kernel Threads @@ -26192,7 +26229,7 @@ support this functionality when the parent contains more than one task. @geindex Forking a new process @node Ensuring Compliance with the Real-Time Annex,Support for Locking Policies,Mapping Ada Tasks onto the Underlying Kernel Threads,GNAT Implementation of Tasking -@anchor{gnat_rm/implementation_of_specific_ada_features ensuring-compliance-with-the-real-time-annex}@anchor{423}@anchor{gnat_rm/implementation_of_specific_ada_features id5}@anchor{424} +@anchor{gnat_rm/implementation_of_specific_ada_features ensuring-compliance-with-the-real-time-annex}@anchor{427}@anchor{gnat_rm/implementation_of_specific_ada_features id5}@anchor{428} @subsection Ensuring Compliance with the Real-Time Annex @@ -26243,7 +26280,7 @@ placed at the end. @c Support_for_Locking_Policies @node Support for Locking Policies,,Ensuring Compliance with the Real-Time Annex,GNAT Implementation of Tasking -@anchor{gnat_rm/implementation_of_specific_ada_features support-for-locking-policies}@anchor{425} +@anchor{gnat_rm/implementation_of_specific_ada_features support-for-locking-policies}@anchor{429} @subsection Support for Locking Policies @@ -26277,7 +26314,7 @@ then ceiling locking is used. Otherwise, the @code{Ceiling_Locking} policy is ignored. @node GNAT Implementation of Shared Passive Packages,Code Generation for Array Aggregates,GNAT Implementation of Tasking,Implementation of Specific Ada Features -@anchor{gnat_rm/implementation_of_specific_ada_features gnat-implementation-of-shared-passive-packages}@anchor{426}@anchor{gnat_rm/implementation_of_specific_ada_features id6}@anchor{427} +@anchor{gnat_rm/implementation_of_specific_ada_features gnat-implementation-of-shared-passive-packages}@anchor{42a}@anchor{gnat_rm/implementation_of_specific_ada_features id6}@anchor{42b} @section GNAT Implementation of Shared Passive Packages @@ -26375,7 +26412,7 @@ This is used to provide the required locking semantics for proper protected object synchronization. @node Code Generation for Array Aggregates,The Size of Discriminated Records with Default Discriminants,GNAT Implementation of Shared Passive Packages,Implementation of Specific Ada Features -@anchor{gnat_rm/implementation_of_specific_ada_features code-generation-for-array-aggregates}@anchor{428}@anchor{gnat_rm/implementation_of_specific_ada_features id7}@anchor{429} +@anchor{gnat_rm/implementation_of_specific_ada_features code-generation-for-array-aggregates}@anchor{42c}@anchor{gnat_rm/implementation_of_specific_ada_features id7}@anchor{42d} @section Code Generation for Array Aggregates @@ -26406,7 +26443,7 @@ component values and static subtypes also lead to simpler code. @end menu @node Static constant aggregates with static bounds,Constant aggregates with unconstrained nominal types,,Code Generation for Array Aggregates -@anchor{gnat_rm/implementation_of_specific_ada_features id8}@anchor{42a}@anchor{gnat_rm/implementation_of_specific_ada_features static-constant-aggregates-with-static-bounds}@anchor{42b} +@anchor{gnat_rm/implementation_of_specific_ada_features id8}@anchor{42e}@anchor{gnat_rm/implementation_of_specific_ada_features static-constant-aggregates-with-static-bounds}@anchor{42f} @subsection Static constant aggregates with static bounds @@ -26453,7 +26490,7 @@ Zero2: constant two_dim := (others => (others => 0)); @end example @node Constant aggregates with unconstrained nominal types,Aggregates with static bounds,Static constant aggregates with static bounds,Code Generation for Array Aggregates -@anchor{gnat_rm/implementation_of_specific_ada_features constant-aggregates-with-unconstrained-nominal-types}@anchor{42c}@anchor{gnat_rm/implementation_of_specific_ada_features id9}@anchor{42d} +@anchor{gnat_rm/implementation_of_specific_ada_features constant-aggregates-with-unconstrained-nominal-types}@anchor{430}@anchor{gnat_rm/implementation_of_specific_ada_features id9}@anchor{431} @subsection Constant aggregates with unconstrained nominal types @@ -26468,7 +26505,7 @@ Cr_Unc : constant One_Unc := (12,24,36); @end example @node Aggregates with static bounds,Aggregates with nonstatic bounds,Constant aggregates with unconstrained nominal types,Code Generation for Array Aggregates -@anchor{gnat_rm/implementation_of_specific_ada_features aggregates-with-static-bounds}@anchor{42e}@anchor{gnat_rm/implementation_of_specific_ada_features id10}@anchor{42f} +@anchor{gnat_rm/implementation_of_specific_ada_features aggregates-with-static-bounds}@anchor{432}@anchor{gnat_rm/implementation_of_specific_ada_features id10}@anchor{433} @subsection Aggregates with static bounds @@ -26496,7 +26533,7 @@ end loop; @end example @node Aggregates with nonstatic bounds,Aggregates in assignment statements,Aggregates with static bounds,Code Generation for Array Aggregates -@anchor{gnat_rm/implementation_of_specific_ada_features aggregates-with-nonstatic-bounds}@anchor{430}@anchor{gnat_rm/implementation_of_specific_ada_features id11}@anchor{431} +@anchor{gnat_rm/implementation_of_specific_ada_features aggregates-with-nonstatic-bounds}@anchor{434}@anchor{gnat_rm/implementation_of_specific_ada_features id11}@anchor{435} @subsection Aggregates with nonstatic bounds @@ -26507,7 +26544,7 @@ have to be applied to sub-arrays individually, if they do not have statically compatible subtypes. @node Aggregates in assignment statements,,Aggregates with nonstatic bounds,Code Generation for Array Aggregates -@anchor{gnat_rm/implementation_of_specific_ada_features aggregates-in-assignment-statements}@anchor{432}@anchor{gnat_rm/implementation_of_specific_ada_features id12}@anchor{433} +@anchor{gnat_rm/implementation_of_specific_ada_features aggregates-in-assignment-statements}@anchor{436}@anchor{gnat_rm/implementation_of_specific_ada_features id12}@anchor{437} @subsection Aggregates in assignment statements @@ -26549,7 +26586,7 @@ a temporary (created either by the front-end or the code generator) and then that temporary will be copied onto the target. @node The Size of Discriminated Records with Default Discriminants,Image Values For Nonscalar Types,Code Generation for Array Aggregates,Implementation of Specific Ada Features -@anchor{gnat_rm/implementation_of_specific_ada_features id13}@anchor{434}@anchor{gnat_rm/implementation_of_specific_ada_features the-size-of-discriminated-records-with-default-discriminants}@anchor{435} +@anchor{gnat_rm/implementation_of_specific_ada_features id13}@anchor{438}@anchor{gnat_rm/implementation_of_specific_ada_features the-size-of-discriminated-records-with-default-discriminants}@anchor{439} @section The Size of Discriminated Records with Default Discriminants @@ -26629,7 +26666,7 @@ say) must be consistent, so it is imperative that the object, once created, remain invariant. @node Image Values For Nonscalar Types,Strict Conformance to the Ada Reference Manual,The Size of Discriminated Records with Default Discriminants,Implementation of Specific Ada Features -@anchor{gnat_rm/implementation_of_specific_ada_features id14}@anchor{436}@anchor{gnat_rm/implementation_of_specific_ada_features image-values-for-nonscalar-types}@anchor{437} +@anchor{gnat_rm/implementation_of_specific_ada_features id14}@anchor{43a}@anchor{gnat_rm/implementation_of_specific_ada_features image-values-for-nonscalar-types}@anchor{43b} @section Image Values For Nonscalar Types @@ -26649,7 +26686,7 @@ control of image text is required for some type T, then T’Put_Image should be explicitly specified. @node Strict Conformance to the Ada Reference Manual,,Image Values For Nonscalar Types,Implementation of Specific Ada Features -@anchor{gnat_rm/implementation_of_specific_ada_features id15}@anchor{438}@anchor{gnat_rm/implementation_of_specific_ada_features strict-conformance-to-the-ada-reference-manual}@anchor{439} +@anchor{gnat_rm/implementation_of_specific_ada_features id15}@anchor{43c}@anchor{gnat_rm/implementation_of_specific_ada_features strict-conformance-to-the-ada-reference-manual}@anchor{43d} @section Strict Conformance to the Ada Reference Manual @@ -26676,7 +26713,7 @@ behavior (although at the cost of a significant performance penalty), so infinite and NaN values are properly generated. @node Implementation of Ada 2012 Features,Security Hardening Features,Implementation of Specific Ada Features,Top -@anchor{gnat_rm/implementation_of_ada_2012_features doc}@anchor{43a}@anchor{gnat_rm/implementation_of_ada_2012_features id1}@anchor{43b}@anchor{gnat_rm/implementation_of_ada_2012_features implementation-of-ada-2012-features}@anchor{14} +@anchor{gnat_rm/implementation_of_ada_2012_features doc}@anchor{43e}@anchor{gnat_rm/implementation_of_ada_2012_features id1}@anchor{43f}@anchor{gnat_rm/implementation_of_ada_2012_features implementation-of-ada-2012-features}@anchor{14} @chapter Implementation of Ada 2012 Features @@ -28842,7 +28879,7 @@ RM References: H.04 (8/1) @end itemize @node Security Hardening Features,Obsolescent Features,Implementation of Ada 2012 Features,Top -@anchor{gnat_rm/security_hardening_features doc}@anchor{43c}@anchor{gnat_rm/security_hardening_features id1}@anchor{43d}@anchor{gnat_rm/security_hardening_features security-hardening-features}@anchor{15} +@anchor{gnat_rm/security_hardening_features doc}@anchor{440}@anchor{gnat_rm/security_hardening_features id1}@anchor{441}@anchor{gnat_rm/security_hardening_features security-hardening-features}@anchor{15} @chapter Security Hardening Features @@ -28861,7 +28898,7 @@ are provided by GNAT. @end menu @node Register Scrubbing,Stack Scrubbing,,Security Hardening Features -@anchor{gnat_rm/security_hardening_features register-scrubbing}@anchor{43e} +@anchor{gnat_rm/security_hardening_features register-scrubbing}@anchor{442} @section Register Scrubbing @@ -28889,7 +28926,7 @@ For usage and more details on the command-line option, and on the @c Stack Scrubbing: @node Stack Scrubbing,Hardened Conditionals,Register Scrubbing,Security Hardening Features -@anchor{gnat_rm/security_hardening_features stack-scrubbing}@anchor{43f} +@anchor{gnat_rm/security_hardening_features stack-scrubbing}@anchor{443} @section Stack Scrubbing @@ -28972,7 +29009,7 @@ Bar_Callable_Ptr. @c Hardened Conditionals: @node Hardened Conditionals,Hardened Booleans,Stack Scrubbing,Security Hardening Features -@anchor{gnat_rm/security_hardening_features hardened-conditionals}@anchor{440} +@anchor{gnat_rm/security_hardening_features hardened-conditionals}@anchor{444} @section Hardened Conditionals @@ -29015,7 +29052,7 @@ different performance impact of the hardening transformations. @c Hardened Booleans: @node Hardened Booleans,Control Flow Redundancy,Hardened Conditionals,Security Hardening Features -@anchor{gnat_rm/security_hardening_features hardened-booleans}@anchor{441} +@anchor{gnat_rm/security_hardening_features hardened-booleans}@anchor{445} @section Hardened Booleans @@ -29052,7 +29089,7 @@ Note that @code{-gnatVn} will disable even @code{hardbool} testing. @c Control Flow Redundancy: @node Control Flow Redundancy,,Hardened Booleans,Security Hardening Features -@anchor{gnat_rm/security_hardening_features control-flow-redundancy}@anchor{442} +@anchor{gnat_rm/security_hardening_features control-flow-redundancy}@anchor{446} @section Control Flow Redundancy @@ -29097,7 +29134,7 @@ observed in dump files generated by the command-line option @code{-fdump-tree-hardcfr}. @node Obsolescent Features,Compatibility and Porting Guide,Security Hardening Features,Top -@anchor{gnat_rm/obsolescent_features doc}@anchor{443}@anchor{gnat_rm/obsolescent_features id1}@anchor{444}@anchor{gnat_rm/obsolescent_features obsolescent-features}@anchor{16} +@anchor{gnat_rm/obsolescent_features doc}@anchor{447}@anchor{gnat_rm/obsolescent_features id1}@anchor{448}@anchor{gnat_rm/obsolescent_features obsolescent-features}@anchor{16} @chapter Obsolescent Features @@ -29116,7 +29153,7 @@ compatibility purposes. @end menu @node pragma No_Run_Time,pragma Ravenscar,,Obsolescent Features -@anchor{gnat_rm/obsolescent_features id2}@anchor{445}@anchor{gnat_rm/obsolescent_features pragma-no-run-time}@anchor{446} +@anchor{gnat_rm/obsolescent_features id2}@anchor{449}@anchor{gnat_rm/obsolescent_features pragma-no-run-time}@anchor{44a} @section pragma No_Run_Time @@ -29129,7 +29166,7 @@ preferred usage is to use an appropriately configured run-time that includes just those features that are to be made accessible. @node pragma Ravenscar,pragma Restricted_Run_Time,pragma No_Run_Time,Obsolescent Features -@anchor{gnat_rm/obsolescent_features id3}@anchor{447}@anchor{gnat_rm/obsolescent_features pragma-ravenscar}@anchor{448} +@anchor{gnat_rm/obsolescent_features id3}@anchor{44b}@anchor{gnat_rm/obsolescent_features pragma-ravenscar}@anchor{44c} @section pragma Ravenscar @@ -29138,7 +29175,7 @@ The pragma @code{Ravenscar} has exactly the same effect as pragma is part of the new Ada 2005 standard. @node pragma Restricted_Run_Time,pragma Task_Info,pragma Ravenscar,Obsolescent Features -@anchor{gnat_rm/obsolescent_features id4}@anchor{449}@anchor{gnat_rm/obsolescent_features pragma-restricted-run-time}@anchor{44a} +@anchor{gnat_rm/obsolescent_features id4}@anchor{44d}@anchor{gnat_rm/obsolescent_features pragma-restricted-run-time}@anchor{44e} @section pragma Restricted_Run_Time @@ -29148,7 +29185,7 @@ preferred since the Ada 2005 pragma @code{Profile} is intended for this kind of implementation dependent addition. @node pragma Task_Info,package System Task_Info s-tasinf ads,pragma Restricted_Run_Time,Obsolescent Features -@anchor{gnat_rm/obsolescent_features id5}@anchor{44b}@anchor{gnat_rm/obsolescent_features pragma-task-info}@anchor{44c} +@anchor{gnat_rm/obsolescent_features id5}@anchor{44f}@anchor{gnat_rm/obsolescent_features pragma-task-info}@anchor{450} @section pragma Task_Info @@ -29174,7 +29211,7 @@ in the spec of package System.Task_Info in the runtime library. @node package System Task_Info s-tasinf ads,,pragma Task_Info,Obsolescent Features -@anchor{gnat_rm/obsolescent_features package-system-task-info}@anchor{44d}@anchor{gnat_rm/obsolescent_features package-system-task-info-s-tasinf-ads}@anchor{44e} +@anchor{gnat_rm/obsolescent_features package-system-task-info}@anchor{451}@anchor{gnat_rm/obsolescent_features package-system-task-info-s-tasinf-ads}@anchor{452} @section package System.Task_Info (@code{s-tasinf.ads}) @@ -29184,7 +29221,7 @@ to support the @code{Task_Info} pragma. The predefined Ada package standard replacement for GNAT’s @code{Task_Info} functionality. @node Compatibility and Porting Guide,GNU Free Documentation License,Obsolescent Features,Top -@anchor{gnat_rm/compatibility_and_porting_guide doc}@anchor{44f}@anchor{gnat_rm/compatibility_and_porting_guide compatibility-and-porting-guide}@anchor{17}@anchor{gnat_rm/compatibility_and_porting_guide id1}@anchor{450} +@anchor{gnat_rm/compatibility_and_porting_guide doc}@anchor{453}@anchor{gnat_rm/compatibility_and_porting_guide compatibility-and-porting-guide}@anchor{17}@anchor{gnat_rm/compatibility_and_porting_guide id1}@anchor{454} @chapter Compatibility and Porting Guide @@ -29206,7 +29243,7 @@ applications developed in other Ada environments. @end menu @node Writing Portable Fixed-Point Declarations,Compatibility with Ada 83,,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide id2}@anchor{451}@anchor{gnat_rm/compatibility_and_porting_guide writing-portable-fixed-point-declarations}@anchor{452} +@anchor{gnat_rm/compatibility_and_porting_guide id2}@anchor{455}@anchor{gnat_rm/compatibility_and_porting_guide writing-portable-fixed-point-declarations}@anchor{456} @section Writing Portable Fixed-Point Declarations @@ -29328,7 +29365,7 @@ If you follow this scheme you will be guaranteed that your fixed-point types will be portable. @node Compatibility with Ada 83,Compatibility between Ada 95 and Ada 2005,Writing Portable Fixed-Point Declarations,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-ada-83}@anchor{453}@anchor{gnat_rm/compatibility_and_porting_guide id3}@anchor{454} +@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-ada-83}@anchor{457}@anchor{gnat_rm/compatibility_and_porting_guide id3}@anchor{458} @section Compatibility with Ada 83 @@ -29356,7 +29393,7 @@ following subsections treat the most likely issues to be encountered. @end menu @node Legal Ada 83 programs that are illegal in Ada 95,More deterministic semantics,,Compatibility with Ada 83 -@anchor{gnat_rm/compatibility_and_porting_guide id4}@anchor{455}@anchor{gnat_rm/compatibility_and_porting_guide legal-ada-83-programs-that-are-illegal-in-ada-95}@anchor{456} +@anchor{gnat_rm/compatibility_and_porting_guide id4}@anchor{459}@anchor{gnat_rm/compatibility_and_porting_guide legal-ada-83-programs-that-are-illegal-in-ada-95}@anchor{45a} @subsection Legal Ada 83 programs that are illegal in Ada 95 @@ -29456,7 +29493,7 @@ the fix is usually simply to add the @code{(<>)} to the generic declaration. @end itemize @node More deterministic semantics,Changed semantics,Legal Ada 83 programs that are illegal in Ada 95,Compatibility with Ada 83 -@anchor{gnat_rm/compatibility_and_porting_guide id5}@anchor{457}@anchor{gnat_rm/compatibility_and_porting_guide more-deterministic-semantics}@anchor{458} +@anchor{gnat_rm/compatibility_and_porting_guide id5}@anchor{45b}@anchor{gnat_rm/compatibility_and_porting_guide more-deterministic-semantics}@anchor{45c} @subsection More deterministic semantics @@ -29484,7 +29521,7 @@ which open select branches are executed. @end itemize @node Changed semantics,Other language compatibility issues,More deterministic semantics,Compatibility with Ada 83 -@anchor{gnat_rm/compatibility_and_porting_guide changed-semantics}@anchor{459}@anchor{gnat_rm/compatibility_and_porting_guide id6}@anchor{45a} +@anchor{gnat_rm/compatibility_and_porting_guide changed-semantics}@anchor{45d}@anchor{gnat_rm/compatibility_and_porting_guide id6}@anchor{45e} @subsection Changed semantics @@ -29526,7 +29563,7 @@ covers only the restricted range. @end itemize @node Other language compatibility issues,,Changed semantics,Compatibility with Ada 83 -@anchor{gnat_rm/compatibility_and_porting_guide id7}@anchor{45b}@anchor{gnat_rm/compatibility_and_porting_guide other-language-compatibility-issues}@anchor{45c} +@anchor{gnat_rm/compatibility_and_porting_guide id7}@anchor{45f}@anchor{gnat_rm/compatibility_and_porting_guide other-language-compatibility-issues}@anchor{460} @subsection Other language compatibility issues @@ -29559,7 +29596,7 @@ include @code{pragma Interface} and the floating point type attributes @end itemize @node Compatibility between Ada 95 and Ada 2005,Implementation-dependent characteristics,Compatibility with Ada 83,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide compatibility-between-ada-95-and-ada-2005}@anchor{45d}@anchor{gnat_rm/compatibility_and_porting_guide id8}@anchor{45e} +@anchor{gnat_rm/compatibility_and_porting_guide compatibility-between-ada-95-and-ada-2005}@anchor{461}@anchor{gnat_rm/compatibility_and_porting_guide id8}@anchor{462} @section Compatibility between Ada 95 and Ada 2005 @@ -29631,7 +29668,7 @@ can declare a function returning a value from an anonymous access type. @end itemize @node Implementation-dependent characteristics,Compatibility with Other Ada Systems,Compatibility between Ada 95 and Ada 2005,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide id9}@anchor{45f}@anchor{gnat_rm/compatibility_and_porting_guide implementation-dependent-characteristics}@anchor{460} +@anchor{gnat_rm/compatibility_and_porting_guide id9}@anchor{463}@anchor{gnat_rm/compatibility_and_porting_guide implementation-dependent-characteristics}@anchor{464} @section Implementation-dependent characteristics @@ -29654,7 +29691,7 @@ transition from certain Ada 83 compilers. @end menu @node Implementation-defined pragmas,Implementation-defined attributes,,Implementation-dependent characteristics -@anchor{gnat_rm/compatibility_and_porting_guide id10}@anchor{461}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-pragmas}@anchor{462} +@anchor{gnat_rm/compatibility_and_porting_guide id10}@anchor{465}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-pragmas}@anchor{466} @subsection Implementation-defined pragmas @@ -29676,7 +29713,7 @@ avoiding compiler rejection of units that contain such pragmas; they are not relevant in a GNAT context and hence are not otherwise implemented. @node Implementation-defined attributes,Libraries,Implementation-defined pragmas,Implementation-dependent characteristics -@anchor{gnat_rm/compatibility_and_porting_guide id11}@anchor{463}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-attributes}@anchor{464} +@anchor{gnat_rm/compatibility_and_porting_guide id11}@anchor{467}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-attributes}@anchor{468} @subsection Implementation-defined attributes @@ -29690,7 +29727,7 @@ Ada 83, GNAT supplies the attributes @code{Bit}, @code{Machine_Size} and @code{Type_Class}. @node Libraries,Elaboration order,Implementation-defined attributes,Implementation-dependent characteristics -@anchor{gnat_rm/compatibility_and_porting_guide id12}@anchor{465}@anchor{gnat_rm/compatibility_and_porting_guide libraries}@anchor{466} +@anchor{gnat_rm/compatibility_and_porting_guide id12}@anchor{469}@anchor{gnat_rm/compatibility_and_porting_guide libraries}@anchor{46a} @subsection Libraries @@ -29719,7 +29756,7 @@ be preferable to retrofit the application using modular types. @end itemize @node Elaboration order,Target-specific aspects,Libraries,Implementation-dependent characteristics -@anchor{gnat_rm/compatibility_and_porting_guide elaboration-order}@anchor{467}@anchor{gnat_rm/compatibility_and_porting_guide id13}@anchor{468} +@anchor{gnat_rm/compatibility_and_porting_guide elaboration-order}@anchor{46b}@anchor{gnat_rm/compatibility_and_porting_guide id13}@anchor{46c} @subsection Elaboration order @@ -29755,7 +29792,7 @@ pragmas either globally (as an effect of the @emph{-gnatE} switch) or locally @end itemize @node Target-specific aspects,,Elaboration order,Implementation-dependent characteristics -@anchor{gnat_rm/compatibility_and_porting_guide id14}@anchor{469}@anchor{gnat_rm/compatibility_and_porting_guide target-specific-aspects}@anchor{46a} +@anchor{gnat_rm/compatibility_and_porting_guide id14}@anchor{46d}@anchor{gnat_rm/compatibility_and_porting_guide target-specific-aspects}@anchor{46e} @subsection Target-specific aspects @@ -29768,10 +29805,10 @@ on the robustness of the original design. Moreover, Ada 95 (and thus Ada 2005 and Ada 2012) are sometimes incompatible with typical Ada 83 compiler practices regarding implicit packing, the meaning of the Size attribute, and the size of access values. -GNAT’s approach to these issues is described in @ref{46b,,Representation Clauses}. +GNAT’s approach to these issues is described in @ref{46f,,Representation Clauses}. @node Compatibility with Other Ada Systems,Representation Clauses,Implementation-dependent characteristics,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-other-ada-systems}@anchor{46c}@anchor{gnat_rm/compatibility_and_porting_guide id15}@anchor{46d} +@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-other-ada-systems}@anchor{470}@anchor{gnat_rm/compatibility_and_porting_guide id15}@anchor{471} @section Compatibility with Other Ada Systems @@ -29814,7 +29851,7 @@ far beyond this minimal set, as described in the next section. @end itemize @node Representation Clauses,Compatibility with HP Ada 83,Compatibility with Other Ada Systems,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide id16}@anchor{46e}@anchor{gnat_rm/compatibility_and_porting_guide representation-clauses}@anchor{46b} +@anchor{gnat_rm/compatibility_and_porting_guide id16}@anchor{472}@anchor{gnat_rm/compatibility_and_porting_guide representation-clauses}@anchor{46f} @section Representation Clauses @@ -29907,7 +29944,7 @@ with thin pointers. @end itemize @node Compatibility with HP Ada 83,,Representation Clauses,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-hp-ada-83}@anchor{46f}@anchor{gnat_rm/compatibility_and_porting_guide id17}@anchor{470} +@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-hp-ada-83}@anchor{473}@anchor{gnat_rm/compatibility_and_porting_guide id17}@anchor{474} @section Compatibility with HP Ada 83 @@ -29937,7 +29974,7 @@ extension of package System. @end itemize @node GNU Free Documentation License,Index,Compatibility and Porting Guide,Top -@anchor{share/gnu_free_documentation_license doc}@anchor{471}@anchor{share/gnu_free_documentation_license gnu-fdl}@anchor{1}@anchor{share/gnu_free_documentation_license gnu-free-documentation-license}@anchor{472} +@anchor{share/gnu_free_documentation_license doc}@anchor{475}@anchor{share/gnu_free_documentation_license gnu-fdl}@anchor{1}@anchor{share/gnu_free_documentation_license gnu-free-documentation-license}@anchor{476} @chapter GNU Free Documentation License diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 218c375..1664c49 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -3197,8 +3197,7 @@ if any of these units are modified. @item Cross-reference data. Contains information on all entities referenced -in the unit. Used by tools like @code{gnatxref} and @code{gnatfind} to -provide cross-reference information. +in the unit. Used by some tools to provide cross-reference information. @end itemize For a full detailed description of the format of the @code{ALI} file, @@ -3505,8 +3504,8 @@ be @code{adalib}). You can also specify a new default path to the run-time library at compilation time with the switch @code{--RTS=rts-path}. You can thus choose / change the run-time library you want your program to be compiled with. This switch is -recognized by @code{gcc}, @code{gnatmake}, @code{gnatbind}, -@code{gnatls}, @code{gnatfind} and @code{gnatxref}. +recognized by @code{gcc}, @code{gnatmake}, @code{gnatbind}, @code{gnatls}, and all +project aware tools. It is possible to install a library before or after the standard GNAT library, by reordering the lines in the configuration files. In general, a @@ -15077,10 +15076,10 @@ types in package Standard. @item @code{-gnatx} Normally the compiler generates full cross-referencing information in -the @code{ALI} file. This information is used by a number of tools, -including @code{gnatfind} and @code{gnatxref}. The @code{-gnatx} switch -suppresses this information. This saves some space and may slightly -speed up compilation, but means that these tools cannot be used. +the @code{ALI} file. This information is used by a number of tools. +The @code{-gnatx} switch suppresses this information. This saves some space +and may slightly speed up compilation, but means that tools depending +on this information cannot be used. @end table @geindex -fgnat-encodings (gcc) diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 0062736..74192bc 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -57,7 +57,6 @@ procedure GNATCmd is Compile, Check, Elim, - Find, Krunch, Link, List, @@ -69,10 +68,9 @@ procedure GNATCmd is Stack, Stub, Test, - Xref, Undefined); - subtype Real_Command_Type is Command_Type range Bind .. Xref; + subtype Real_Command_Type is Command_Type range Bind .. Test; -- All real command types (excludes only Undefined). type Alternate_Command is (Comp, Ls, Kr, Pp, Prep); @@ -160,11 +158,6 @@ procedure GNATCmd is Unixcmd => new String'("gnatelim"), Unixsws => null), - Find => - (Cname => new String'("FIND"), - Unixcmd => new String'("gnatfind"), - Unixsws => null), - Krunch => (Cname => new String'("KRUNCH"), Unixcmd => new String'("gnatkr"), @@ -218,11 +211,6 @@ procedure GNATCmd is Test => (Cname => new String'("TEST"), Unixcmd => new String'("gnattest"), - Unixsws => null), - - Xref => - (Cname => new String'("XREF"), - Unixcmd => new String'("gnatxref"), Unixsws => null) ); @@ -590,30 +578,6 @@ begin end loop; end if; - -- For FIND and XREF, look for switch -P. If it is specified, then - -- report an error indicating that the command does not support project - -- files. - - if The_Command in Find | Xref then - declare - Argv : String_Access; - begin - for Arg_Num in 1 .. Last_Switches.Last loop - Argv := Last_Switches.Table (Arg_Num); - - if Argv'Length >= 2 - and then Argv (Argv'First .. Argv'First + 1) = "-P" - then - if The_Command = Find then - Fail ("'gnat find -P' is not supported;"); - else - Fail ("'gnat xref -P' is not supported;"); - end if; - end if; - end loop; - end; - end if; - -- Gather all the arguments and invoke the executable declare diff --git a/gcc/ada/gnatfind.adb b/gcc/ada/gnatfind.adb deleted file mode 100644 index 04b0fe4..0000000 --- a/gcc/ada/gnatfind.adb +++ /dev/null @@ -1,407 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- G N A T F I N D -- --- -- --- B o d y -- --- -- --- Copyright (C) 1998-2022, 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. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Opt; -with Osint; use Osint; -with Switch; use Switch; -with Types; use Types; -with Xr_Tabls; -with Xref_Lib; use Xref_Lib; - -with Ada.Command_Line; use Ada.Command_Line; -with Ada.Strings.Fixed; use Ada.Strings.Fixed; -with Ada.Text_IO; use Ada.Text_IO; - -with GNAT.Command_Line; use GNAT.Command_Line; - -with System.Strings; use System.Strings; - --------------- --- Gnatfind -- --------------- - -procedure Gnatfind is - Output_Ref : Boolean := False; - Pattern : Xref_Lib.Search_Pattern; - Local_Symbols : Boolean := True; - Prj_File : File_Name_String; - Prj_File_Length : Natural := 0; - Nb_File : Natural := 0; - Usage_Error : exception; - Full_Path_Name : Boolean := False; - Have_Entity : Boolean := False; - Wide_Search : Boolean := True; - Glob_Mode : Boolean := True; - Der_Info : Boolean := False; - Type_Tree : Boolean := False; - Read_Only : Boolean := False; - Source_Lines : Boolean := False; - - Has_File_In_Entity : Boolean := False; - -- Will be true if a file name was specified in the entity - - RTS_Specified : String_Access := null; - -- Used to detect multiple use of --RTS= switch - - EXT_Specified : String_Access := null; - -- Used to detect multiple use of --ext= switch - - procedure Parse_Cmd_Line; - -- Parse every switch on the command line - - procedure Usage; - -- Display the usage - - procedure Write_Usage; - pragma No_Return (Write_Usage); - -- Print a small help page for program usage and exit program - - -------------------- - -- Parse_Cmd_Line -- - -------------------- - - procedure Parse_Cmd_Line is - - procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage); - - -- Start of processing for Parse_Cmd_Line - - begin - -- First check for --version or --help - - Check_Version_And_Help ("GNATFIND", "1998"); - - -- Now scan the other switches - - GNAT.Command_Line.Initialize_Option_Scan; - - loop - case - GNAT.Command_Line.Getopt - ("a aI: aO: d e f g h I: nostdinc nostdlib p: r s t -RTS= -ext=") - is - when ASCII.NUL => - exit; - - when 'a' => - if GNAT.Command_Line.Full_Switch = "a" then - Read_Only := True; - elsif GNAT.Command_Line.Full_Switch = "aI" then - Osint.Add_Src_Search_Dir (GNAT.Command_Line.Parameter); - else - Osint.Add_Lib_Search_Dir (GNAT.Command_Line.Parameter); - end if; - - when 'd' => - Der_Info := True; - - when 'e' => - Glob_Mode := False; - - when 'f' => - Full_Path_Name := True; - - when 'g' => - Local_Symbols := False; - - when 'h' => - Write_Usage; - - when 'I' => - Osint.Add_Src_Search_Dir (GNAT.Command_Line.Parameter); - Osint.Add_Lib_Search_Dir (GNAT.Command_Line.Parameter); - - when 'n' => - if GNAT.Command_Line.Full_Switch = "nostdinc" then - Opt.No_Stdinc := True; - elsif GNAT.Command_Line.Full_Switch = "nostdlib" then - Opt.No_Stdlib := True; - end if; - - when 'p' => - declare - S : constant String := GNAT.Command_Line.Parameter; - begin - Prj_File_Length := S'Length; - Prj_File (1 .. Prj_File_Length) := S; - end; - - when 'r' => - Output_Ref := True; - - when 's' => - Source_Lines := True; - - when 't' => - Type_Tree := True; - - -- Only switch starting with -- recognized is --RTS - - when '-' => - if GNAT.Command_Line.Full_Switch = "-RTS" then - - -- Check that it is the first time we see this switch - - if RTS_Specified = null then - RTS_Specified := new String'(GNAT.Command_Line.Parameter); - elsif RTS_Specified.all /= GNAT.Command_Line.Parameter then - Osint.Fail ("--RTS cannot be specified multiple times"); - end if; - - Opt.No_Stdinc := True; - Opt.RTS_Switch := True; - - declare - Src_Path_Name : constant String_Ptr := - Get_RTS_Search_Dir - (GNAT.Command_Line.Parameter, - Include); - Lib_Path_Name : constant String_Ptr := - Get_RTS_Search_Dir - (GNAT.Command_Line.Parameter, - Objects); - - begin - if Src_Path_Name /= null - and then Lib_Path_Name /= null - then - Add_Search_Dirs (Src_Path_Name, Include); - Add_Search_Dirs (Lib_Path_Name, Objects); - - elsif Src_Path_Name = null - and then Lib_Path_Name = null - then - Osint.Fail ("RTS path not valid: missing " & - "adainclude and adalib directories"); - - elsif Src_Path_Name = null then - Osint.Fail ("RTS path not valid: missing " & - "adainclude directory"); - - elsif Lib_Path_Name = null then - Osint.Fail ("RTS path not valid: missing " & - "adalib directory"); - end if; - end; - - -- Process -ext switch - - elsif GNAT.Command_Line.Full_Switch = "-ext" then - - -- Check that it is the first time we see this switch - - if EXT_Specified = null then - EXT_Specified := new String'(GNAT.Command_Line.Parameter); - elsif EXT_Specified.all /= GNAT.Command_Line.Parameter then - Osint.Fail ("--ext cannot be specified multiple times"); - end if; - - if - EXT_Specified'Length = Osint.ALI_Default_Suffix'Length - then - Osint.ALI_Suffix := EXT_Specified.all'Access; - else - Osint.Fail ("--ext argument must have 3 characters"); - end if; - - end if; - - when others => - Try_Help; - raise Usage_Error; - end case; - end loop; - - -- Get the other arguments - - loop - declare - S : constant String := GNAT.Command_Line.Get_Argument; - - begin - exit when S'Length = 0; - - -- First argument is the pattern - - if not Have_Entity then - Add_Entity (Pattern, S, Glob_Mode); - Have_Entity := True; - - if not Has_File_In_Entity - and then Index (S, ":") /= 0 - then - Has_File_In_Entity := True; - end if; - - -- Next arguments are the files to search - - else - Add_Xref_File (S); - Wide_Search := False; - Nb_File := Nb_File + 1; - end if; - end; - end loop; - - exception - when GNAT.Command_Line.Invalid_Switch => - Ada.Text_IO.Put_Line ("Invalid switch : " - & GNAT.Command_Line.Full_Switch); - Try_Help; - raise Usage_Error; - - when GNAT.Command_Line.Invalid_Parameter => - Ada.Text_IO.Put_Line ("Parameter missing for : " - & GNAT.Command_Line.Full_Switch); - Try_Help; - raise Usage_Error; - - when Xref_Lib.Invalid_Argument => - Ada.Text_IO.Put_Line ("Invalid line or column in the pattern"); - Try_Help; - raise Usage_Error; - end Parse_Cmd_Line; - - ----------- - -- Usage -- - ----------- - - procedure Usage is - begin - Put_Line ("Usage: gnatfind pattern[:sourcefile[:line[:column]]] " - & "[file1 file2 ...]"); - New_Line; - Put_Line (" pattern Name of the entity to look for (can have " - & "wildcards)"); - Put_Line (" sourcefile Only find entities referenced from this " - & "file"); - Put_Line (" line Only find entities referenced from this line " - & "of file"); - Put_Line (" column Only find entities referenced from this columns" - & " of file"); - Put_Line (" file ... Set of Ada source files to search for " - & "references. This parameters are optional"); - New_Line; - Put_Line ("gnatfind switches:"); - Display_Usage_Version_And_Help; - Put_Line (" -a Consider all files, even when the ali file is " - & "readonly"); - Put_Line (" -aIdir Specify source files search path"); - Put_Line (" -aOdir Specify library/object files search path"); - Put_Line (" -d Output derived type information"); - Put_Line (" -e Use the full regular expression set for " - & "pattern"); - Put_Line (" -f Output full path name"); - Put_Line (" -g Output information only for global symbols"); - Put_Line (" -Idir Like -aIdir -aOdir"); - Put_Line (" -nostdinc Don't look for sources in the system default" - & " directory"); - Put_Line (" -nostdlib Don't look for library files in the system" - & " default directory"); - Put_Line (" --ext=xxx Specify alternate ali file extension"); - Put_Line (" --RTS=dir specify the default source and object search" - & " path"); - Put_Line (" -p file Use file as the configuration file"); - Put_Line (" -r Find all references (default to find declaration" - & " only)"); - Put_Line (" -s Print source line"); - Put_Line (" -t Print type hierarchy"); - end Usage; - - ----------------- - -- Write_Usage -- - ----------------- - - procedure Write_Usage is - begin - Display_Version ("GNATFIND", "1998"); - New_Line; - - Usage; - - raise Usage_Error; - end Write_Usage; - --- Start of processing for Gnatfind - -begin - Put_Line - ("WARNING: gnatfind is obsolete and will be removed in the next release"); - Put_Line - ("Consider using Libadalang or GNAT Studio python scripting instead"); - - Parse_Cmd_Line; - - if not Have_Entity then - if Argument_Count = 0 then - Write_Usage; - else - Try_Help; - raise Usage_Error; - end if; - end if; - - -- Special case to speed things up: if the user has a command line of the - -- form 'gnatfind entity:file', i.e. has specified a file and only wants - -- the bodies and specs, then we can restrict the search to the .ali file - -- associated with 'file'. - - if Has_File_In_Entity - and then not Output_Ref - then - Wide_Search := False; - end if; - - -- Find the project file - - if Prj_File_Length = 0 then - Xr_Tabls.Create_Project_File (Default_Project_File (".")); - else - Xr_Tabls.Create_Project_File (Prj_File (1 .. Prj_File_Length)); - end if; - - -- Fill up the table - - if Type_Tree and then Nb_File > 1 then - Ada.Text_IO.Put_Line ("Error: for type hierarchy output you must " - & "specify only one file."); - Ada.Text_IO.New_Line; - Try_Help; - raise Usage_Error; - end if; - - Search (Pattern, Local_Symbols, Wide_Search, Read_Only, - Der_Info, Type_Tree); - - if Source_Lines then - Xr_Tabls.Grep_Source_Files; - end if; - - Print_Gnatfind (Output_Ref, Full_Path_Name); - -exception - when Usage_Error => - null; -end Gnatfind; diff --git a/gcc/ada/gnatxref.adb b/gcc/ada/gnatxref.adb deleted file mode 100644 index 9499d11..0000000 --- a/gcc/ada/gnatxref.adb +++ /dev/null @@ -1,344 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- G N A T X R E F -- --- -- --- B o d y -- --- -- --- Copyright (C) 1998-2022, 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. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Opt; -with Osint; use Osint; -with Types; use Types; -with Switch; use Switch; -with Xr_Tabls; -with Xref_Lib; use Xref_Lib; - -with Ada.Command_Line; use Ada.Command_Line; -with Ada.Strings.Fixed; -with Ada.Text_IO; use Ada.Text_IO; - -with GNAT.Command_Line; use GNAT.Command_Line; - -with System.Strings; use System.Strings; - -procedure Gnatxref is - Search_Unused : Boolean := False; - Local_Symbols : Boolean := True; - Prj_File : File_Name_String; - Prj_File_Length : Natural := 0; - Usage_Error : exception; - Full_Path_Name : Boolean := False; - Vi_Mode : Boolean := False; - Read_Only : Boolean := False; - Have_File : Boolean := False; - Der_Info : Boolean := False; - - RTS_Specified : String_Access := null; - -- Used to detect multiple use of --RTS= switch - - EXT_Specified : String_Access := null; - -- Used to detect multiple use of --ext= switch - - procedure Parse_Cmd_Line; - -- Parse every switch on the command line - - procedure Usage; - -- Display the usage - - procedure Write_Usage; - pragma No_Return (Write_Usage); - -- Print a small help page for program usage - - -------------------- - -- Parse_Cmd_Line -- - -------------------- - - procedure Parse_Cmd_Line is - - procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage); - - -- Start of processing for Parse_Cmd_Line - - begin - -- First check for --version or --help - - Check_Version_And_Help ("GNATXREF", "1998"); - - loop - case - GNAT.Command_Line.Getopt - ("a aI: aO: d f g h I: nostdinc nostdlib p: u v -RTS= -ext=") - is - when ASCII.NUL => - exit; - - when 'a' => - if GNAT.Command_Line.Full_Switch = "a" then - Read_Only := True; - - elsif GNAT.Command_Line.Full_Switch = "aI" then - Osint.Add_Src_Search_Dir (GNAT.Command_Line.Parameter); - - else - Osint.Add_Lib_Search_Dir (GNAT.Command_Line.Parameter); - end if; - - when 'd' => - Der_Info := True; - - when 'f' => - Full_Path_Name := True; - - when 'g' => - Local_Symbols := False; - - when 'h' => - Write_Usage; - - when 'I' => - Osint.Add_Src_Search_Dir (GNAT.Command_Line.Parameter); - Osint.Add_Lib_Search_Dir (GNAT.Command_Line.Parameter); - - when 'n' => - if GNAT.Command_Line.Full_Switch = "nostdinc" then - Opt.No_Stdinc := True; - elsif GNAT.Command_Line.Full_Switch = "nostdlib" then - Opt.No_Stdlib := True; - end if; - - when 'p' => - declare - S : constant String := GNAT.Command_Line.Parameter; - begin - Prj_File_Length := S'Length; - Prj_File (1 .. Prj_File_Length) := S; - end; - - when 'u' => - Search_Unused := True; - Vi_Mode := False; - - when 'v' => - Vi_Mode := True; - Search_Unused := False; - - -- The only switch starting with -- recognized is --RTS - - when '-' => - - -- Check that it is the first time we see this switch - - if Full_Switch = "-RTS" then - if RTS_Specified = null then - RTS_Specified := new String'(GNAT.Command_Line.Parameter); - - elsif RTS_Specified.all /= GNAT.Command_Line.Parameter then - Osint.Fail ("--RTS cannot be specified multiple times"); - end if; - - Opt.No_Stdinc := True; - Opt.RTS_Switch := True; - - declare - Src_Path_Name : constant String_Ptr := - Get_RTS_Search_Dir - (GNAT.Command_Line.Parameter, - Include); - - Lib_Path_Name : constant String_Ptr := - Get_RTS_Search_Dir - (GNAT.Command_Line.Parameter, - Objects); - - begin - if Src_Path_Name /= null - and then Lib_Path_Name /= null - then - Add_Search_Dirs (Src_Path_Name, Include); - Add_Search_Dirs (Lib_Path_Name, Objects); - - elsif Src_Path_Name = null - and then Lib_Path_Name = null - then - Osint.Fail - ("RTS path not valid: missing adainclude and " - & "adalib directories"); - - elsif Src_Path_Name = null then - Osint.Fail - ("RTS path not valid: missing adainclude directory"); - - elsif Lib_Path_Name = null then - Osint.Fail - ("RTS path not valid: missing adalib directory"); - end if; - end; - - elsif GNAT.Command_Line.Full_Switch = "-ext" then - - -- Check that it is the first time we see this switch - - if EXT_Specified = null then - EXT_Specified := new String'(GNAT.Command_Line.Parameter); - - elsif EXT_Specified.all /= GNAT.Command_Line.Parameter then - Osint.Fail ("--ext cannot be specified multiple times"); - end if; - - if EXT_Specified'Length = Osint.ALI_Default_Suffix'Length - then - Osint.ALI_Suffix := EXT_Specified.all'Access; - else - Osint.Fail ("--ext argument must have 3 characters"); - end if; - end if; - - when others => - Try_Help; - raise Usage_Error; - end case; - end loop; - - -- Get the other arguments - - loop - declare - S : constant String := GNAT.Command_Line.Get_Argument; - - begin - exit when S'Length = 0; - - if Ada.Strings.Fixed.Index (S, ":") /= 0 then - Ada.Text_IO.Put_Line - ("Only file names are allowed on the command line"); - Try_Help; - raise Usage_Error; - end if; - - Add_Xref_File (S); - Have_File := True; - end; - end loop; - - exception - when GNAT.Command_Line.Invalid_Switch => - Ada.Text_IO.Put_Line ("Invalid switch : " - & GNAT.Command_Line.Full_Switch); - Try_Help; - raise Usage_Error; - - when GNAT.Command_Line.Invalid_Parameter => - Ada.Text_IO.Put_Line ("Parameter missing for : " - & GNAT.Command_Line.Full_Switch); - Try_Help; - raise Usage_Error; - end Parse_Cmd_Line; - - ----------- - -- Usage -- - ----------- - - procedure Usage is - begin - Put_Line ("Usage: gnatxref [switches] file1 file2 ..."); - New_Line; - Put_Line (" file ... list of source files to xref, " & - "including with'ed units"); - New_Line; - Put_Line ("gnatxref switches:"); - Display_Usage_Version_And_Help; - Put_Line (" -a Consider all files, even when the ali file is" - & " readonly"); - Put_Line (" -aIdir Specify source files search path"); - Put_Line (" -aOdir Specify library/object files search path"); - Put_Line (" -d Output derived type information"); - Put_Line (" -f Output full path name"); - Put_Line (" -g Output information only for global symbols"); - Put_Line (" -Idir Like -aIdir -aOdir"); - Put_Line (" -nostdinc Don't look for sources in the system default" - & " directory"); - Put_Line (" -nostdlib Don't look for library files in the system" - & " default directory"); - Put_Line (" --ext=xxx Specify alternate ali file extension"); - Put_Line (" --RTS=dir specify the default source and object search" - & " path"); - Put_Line (" -p file Use file as the configuration file"); - Put_Line (" -u List unused entities"); - Put_Line (" -v Print a 'tags' file for vi"); - New_Line; - - end Usage; - - ----------------- - -- Write_Usage -- - ----------------- - - procedure Write_Usage is - begin - Display_Version ("GNATXREF", "1998"); - New_Line; - Usage; - raise Usage_Error; - end Write_Usage; - -begin - Put_Line - ("WARNING: gnatxref is obsolete and will be removed in the next release"); - Put_Line - ("Consider using Libadalang or GNAT Studio python scripting instead"); - - Parse_Cmd_Line; - - if not Have_File then - if Argument_Count = 0 then - Write_Usage; - else - Try_Help; - raise Usage_Error; - end if; - end if; - - Xr_Tabls.Set_Default_Match (True); - - -- Find the project file - - if Prj_File_Length = 0 then - Xr_Tabls.Create_Project_File - (Default_Project_File (Osint.To_Host_Dir_Spec (".", False).all)); - else - Xr_Tabls.Create_Project_File (Prj_File (1 .. Prj_File_Length)); - end if; - - -- Fill up the table - - Search_Xref (Local_Symbols, Read_Only, Der_Info); - - if Search_Unused then - Print_Unused (Full_Path_Name); - elsif Vi_Mode then - Print_Vi (Full_Path_Name); - else - Print_Xref (Full_Path_Name); - end if; - -exception - when Usage_Error => - null; -end Gnatxref; diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb index 5e7df1c..0b1b13b 100644 --- a/gcc/ada/impunit.adb +++ b/gcc/ada/impunit.adb @@ -241,6 +241,7 @@ package body Impunit is ("g-arrspl", F), -- GNAT.Array_Split ("g-awk ", F), -- GNAT.AWK ("g-binenv", F), -- GNAT.Bind_Environment + ("g-binsea", F), -- GNAT.Binary_Search ("g-boubuf", F), -- GNAT.Bounded_Buffers ("g-boumai", F), -- GNAT.Bounded_Mailboxes ("g-brapre", F), -- GNAT.Branch_Prediction @@ -278,6 +279,7 @@ package body Impunit is ("g-exptty", F), -- GNAT.Expect.TTY ("g-flocon", F), -- GNAT.Float_Control ("g-forstr", F), -- GNAT.Formatted_String + ("g-gfmafu", F), -- GNAT.Generic_Fast_Math_Functions ("g-graphs", F), -- GNAT.Graphs ("g-heasor", F), -- GNAT.Heap_Sort ("g-hesora", F), -- GNAT.Heap_Sort_A diff --git a/gcc/ada/init.c b/gcc/ada/init.c index 9eedffc..89f16a1 100644 --- a/gcc/ada/init.c +++ b/gcc/ada/init.c @@ -2611,7 +2611,7 @@ __gnat_install_handler (void) struct sigaction act; int err; - act.sa_handler = __gnat_error_handler; + act.sa_sigaction = __gnat_error_handler; act.sa_flags = SA_NODEFER | SA_SIGINFO; sigemptyset (&act.sa_mask); @@ -2625,26 +2625,26 @@ __gnat_install_handler (void) } } if (__gnat_get_interrupt_state (SIGILL) != 's') { - sigaction (SIGILL, &act, NULL); + err = sigaction (SIGILL, &act, NULL); if (err == -1) { err = errno; - perror ("error while attaching SIGFPE"); + perror ("error while attaching SIGILL"); perror (strerror (err)); } } if (__gnat_get_interrupt_state (SIGSEGV) != 's') { - sigaction (SIGSEGV, &act, NULL); + err = sigaction (SIGSEGV, &act, NULL); if (err == -1) { err = errno; - perror ("error while attaching SIGFPE"); + perror ("error while attaching SIGSEGV"); perror (strerror (err)); } } if (__gnat_get_interrupt_state (SIGBUS) != 's') { - sigaction (SIGBUS, &act, NULL); + err = sigaction (SIGBUS, &act, NULL); if (err == -1) { err = errno; - perror ("error while attaching SIGFPE"); + perror ("error while attaching SIGBUS"); perror (strerror (err)); } } diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 5944aed..cc10c29 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -1893,12 +1893,6 @@ package body Inline is then return False; - -- Subprograms in generic instances are currently not inlined, to avoid - -- problems with inlining of standard library subprograms. - - elsif Instantiation_Location (Sloc (Id)) /= No_Location then - return False; - -- Do not inline subprograms and entries defined inside protected types, -- which typically are not helper subprograms, which also avoids getting -- spurious messages on calls that cannot be inlined. @@ -2642,6 +2636,75 @@ package body Inline is end if; end Check_And_Split_Unconstrained_Function; + --------------------------------------------- + -- Check_Object_Renaming_In_GNATprove_Mode -- + --------------------------------------------- + + procedure Check_Object_Renaming_In_GNATprove_Mode (Spec_Id : Entity_Id) is + Decl : constant Node_Id := Unit_Declaration_Node (Spec_Id); + Body_Decl : constant Node_Id := + Unit_Declaration_Node (Corresponding_Body (Decl)); + + function Check_Object_Renaming (N : Node_Id) return Traverse_Result; + -- Returns Abandon on node N if this is a reference to an object + -- renaming, which will be expanded into the renamed object in + -- GNATprove mode. + + --------------------------- + -- Check_Object_Renaming -- + --------------------------- + + function Check_Object_Renaming (N : Node_Id) return Traverse_Result is + begin + case Nkind (Original_Node (N)) is + when N_Expanded_Name + | N_Identifier + => + declare + Obj_Id : constant Entity_Id := Entity (Original_Node (N)); + begin + -- Recognize the case when SPARK expansion rewrites a + -- reference to an object renaming. + + if Present (Obj_Id) + and then Is_Object (Obj_Id) + and then Present (Renamed_Object (Obj_Id)) + and then Nkind (Renamed_Object (Obj_Id)) not in N_Entity + + -- Copy_Generic_Node called for inlining expects the + -- references to global entities to have the same kind + -- in the "generic" code and its "instantiation". + + and then Nkind (Original_Node (N)) /= + Nkind (Renamed_Object (Obj_Id)) + then + return Abandon; + else + return OK; + end if; + end; + + when others => + return OK; + end case; + end Check_Object_Renaming; + + function Check_All_Object_Renamings is new + Traverse_Func (Check_Object_Renaming); + + -- Start of processing for Check_Object_Renaming_In_GNATprove_Mode + + begin + -- Subprograms with object renamings replaced by the special SPARK + -- expansion cannot be inlined. + + if Check_All_Object_Renamings (Body_Decl) /= OK then + Cannot_Inline ("cannot inline & (object renaming)?", + Body_Decl, Spec_Id); + Set_Body_To_Inline (Decl, Empty); + end if; + end Check_Object_Renaming_In_GNATprove_Mode; + ------------------------------------- -- Check_Package_Body_For_Inlining -- ------------------------------------- @@ -2773,7 +2836,7 @@ package body Inline is Scop := Protected_Body_Subprogram (Scop); elsif Is_Subprogram (Scop) - and then Is_Protected_Type (Scope (Scop)) + and then Is_Protected_Type (Underlying_Type (Scope (Scop))) and then Present (Protected_Body_Subprogram (Scop)) then -- If a protected operation contains an instance, its cleanup diff --git a/gcc/ada/inline.ads b/gcc/ada/inline.ads index a5422aa..05aaac7 100644 --- a/gcc/ada/inline.ads +++ b/gcc/ada/inline.ads @@ -198,6 +198,15 @@ package Inline is -- cases documented in Check_Body_To_Inline) then build the body-to-inline -- associated with N and attach it to the declaration node of Spec_Id. + procedure Check_Object_Renaming_In_GNATprove_Mode (Spec_Id : Entity_Id) + with + Pre => GNATprove_Mode; + -- This procedure is called only in GNATprove mode, on subprograms for + -- which a Body_To_Inline was created, to check if the subprogram has + -- references to object renamings which will be replaced by the special + -- SPARK expansion into nodes of a different kind, which is not expected + -- by the inlining mechanism. In that case, the Body_To_Inline is deleted. + procedure Check_Package_Body_For_Inlining (N : Node_Id; P : Entity_Id); -- If front-end inlining is enabled and a package declaration contains -- inlined subprograms, load and compile the package body to collect the diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index 556df9a..b525bba 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -403,7 +403,9 @@ package body Lib.Writ is Kernel_Elm : Elmt_Id; Kernel : Entity_Id; begin - if not Enable_CUDA_Expansion then + if not Enable_CUDA_Expansion + or else Nkind (Unit_Id) = N_Null_Statement + then return; end if; Spec_Id := (if Nkind (Unit_Id) = N_Package_Body diff --git a/gcc/ada/lib.ads b/gcc/ada/lib.ads index 4a79913..e29d42a 100644 --- a/gcc/ada/lib.ads +++ b/gcc/ada/lib.ads @@ -39,7 +39,7 @@ package Lib is -- Type to hold list of indirect references to unit number table type Compiler_State_Type is (Parsing, Analyzing); - Compiler_State : Compiler_State_Type; + Compiler_State : Compiler_State_Type := Parsing; -- Indicates current state of compilation. This is used to implement the -- function In_Extended_Main_Source_Unit. diff --git a/gcc/ada/libgnarl/s-osinte__qnx.adb b/gcc/ada/libgnarl/s-osinte__qnx.adb index f446ac8cb..8315c12 100644 --- a/gcc/ada/libgnarl/s-osinte__qnx.adb +++ b/gcc/ada/libgnarl/s-osinte__qnx.adb @@ -87,7 +87,7 @@ package body System.OS_Interface is (Prio : System.Any_Priority) return Interfaces.C.int is begin - return Interfaces.C.int (Prio + 1); + return Interfaces.C.int (Prio) + 1; end To_Target_Priority; ----------------- diff --git a/gcc/ada/libgnat/a-cbdlli.adb b/gcc/ada/libgnat/a-cbdlli.adb index 540fc93..d8cf6c3c 100644 --- a/gcc/ada/libgnat/a-cbdlli.adb +++ b/gcc/ada/libgnat/a-cbdlli.adb @@ -75,7 +75,7 @@ is Src_Pos : Count_Type; Tgt_Pos : out Count_Type); - function Vet (Position : Cursor) return Boolean; + function Vet (Position : Cursor) return Boolean with Inline; -- Checks invariants of the cursor and its designated container, as a -- simple way of detecting dangling references (see operation Free for a -- description of the detection mechanism), returning True if all checks @@ -2210,6 +2210,10 @@ is function Vet (Position : Cursor) return Boolean is begin + if not Container_Checks'Enabled then + return True; + end if; + if Position.Node = 0 then return Position.Container = null; end if; diff --git a/gcc/ada/libgnat/a-cbhama.adb b/gcc/ada/libgnat/a-cbhama.adb index 59c4c7e..f557ff9 100644 --- a/gcc/ada/libgnat/a-cbhama.adb +++ b/gcc/ada/libgnat/a-cbhama.adb @@ -66,7 +66,7 @@ is procedure Set_Next (Node : in out Node_Type; Next : Count_Type); pragma Inline (Set_Next); - function Vet (Position : Cursor) return Boolean; + function Vet (Position : Cursor) return Boolean with Inline; -------------------------- -- Local Instantiations -- @@ -1175,6 +1175,10 @@ is function Vet (Position : Cursor) return Boolean is begin + if not Container_Checks'Enabled then + return True; + end if; + if Position.Node = 0 then return Position.Container = null; end if; diff --git a/gcc/ada/libgnat/a-cbhase.adb b/gcc/ada/libgnat/a-cbhase.adb index 3c1c7b4..9076d8e 100644 --- a/gcc/ada/libgnat/a-cbhase.adb +++ b/gcc/ada/libgnat/a-cbhase.adb @@ -79,7 +79,7 @@ is procedure Set_Next (Node : in out Node_Type; Next : Count_Type); pragma Inline (Set_Next); - function Vet (Position : Cursor) return Boolean; + function Vet (Position : Cursor) return Boolean with Inline; -------------------------- -- Local Instantiations -- @@ -1496,6 +1496,10 @@ is function Vet (Position : Cursor) return Boolean is begin + if not Container_Checks'Enabled then + return True; + end if; + if Position.Node = 0 then return Position.Container = null; end if; diff --git a/gcc/ada/libgnat/a-cdlili.adb b/gcc/ada/libgnat/a-cdlili.adb index 5828607..22cb146 100644 --- a/gcc/ada/libgnat/a-cdlili.adb +++ b/gcc/ada/libgnat/a-cdlili.adb @@ -64,7 +64,7 @@ is Source : in out List; Position : Node_Access); - function Vet (Position : Cursor) return Boolean; + function Vet (Position : Cursor) return Boolean with Inline; -- Checks invariants of the cursor and its designated container, as a -- simple way of detecting dangling references (see operation Free for a -- description of the detection mechanism), returning True if all checks @@ -1991,6 +1991,10 @@ is function Vet (Position : Cursor) return Boolean is begin + if not Container_Checks'Enabled then + return True; + end if; + if Position.Node = null then return Position.Container = null; end if; diff --git a/gcc/ada/libgnat/a-cfdlli.adb b/gcc/ada/libgnat/a-cfdlli.adb index 14f0304..383d031 100644 --- a/gcc/ada/libgnat/a-cfdlli.adb +++ b/gcc/ada/libgnat/a-cfdlli.adb @@ -48,7 +48,7 @@ is Before : Count_Type; New_Node : Count_Type); - function Vet (L : List; Position : Cursor) return Boolean; + function Vet (L : List; Position : Cursor) return Boolean with Inline; --------- -- "=" -- @@ -1766,8 +1766,11 @@ is function Vet (L : List; Position : Cursor) return Boolean is N : Node_Array renames L.Nodes; - begin + if not Container_Checks'Enabled then + return True; + end if; + if L.Length = 0 then return False; end if; diff --git a/gcc/ada/libgnat/a-cfhama.adb b/gcc/ada/libgnat/a-cfhama.adb index c2a7c59..0b60a01 100644 --- a/gcc/ada/libgnat/a-cfhama.adb +++ b/gcc/ada/libgnat/a-cfhama.adb @@ -68,7 +68,8 @@ is procedure Set_Next (Node : in out Node_Type; Next : Count_Type); pragma Inline (Set_Next); - function Vet (Container : Map; Position : Cursor) return Boolean; + function Vet (Container : Map; Position : Cursor) return Boolean + with Inline; -------------------------- -- Local Instantiations -- @@ -901,6 +902,10 @@ is function Vet (Container : Map; Position : Cursor) return Boolean is begin + if not Container_Checks'Enabled then + return True; + end if; + if Position.Node = 0 then return True; end if; diff --git a/gcc/ada/libgnat/a-cfhase.adb b/gcc/ada/libgnat/a-cfhase.adb index 834f43a..544ad2b 100644 --- a/gcc/ada/libgnat/a-cfhase.adb +++ b/gcc/ada/libgnat/a-cfhase.adb @@ -89,7 +89,8 @@ is procedure Set_Next (Node : in out Node_Type; Next : Count_Type); pragma Inline (Set_Next); - function Vet (Container : Set; Position : Cursor) return Boolean; + function Vet (Container : Set; Position : Cursor) return Boolean + with Inline; -------------------------- -- Local Instantiations -- @@ -1506,6 +1507,10 @@ is function Vet (Container : Set; Position : Cursor) return Boolean is begin + if not Container_Checks'Enabled then + return True; + end if; + if Position.Node = 0 then return True; end if; diff --git a/gcc/ada/libgnat/a-cidlli.adb b/gcc/ada/libgnat/a-cidlli.adb index 9a11f4c..b34df04 100644 --- a/gcc/ada/libgnat/a-cidlli.adb +++ b/gcc/ada/libgnat/a-cidlli.adb @@ -67,7 +67,7 @@ is Source : in out List; Position : Node_Access); - function Vet (Position : Cursor) return Boolean; + function Vet (Position : Cursor) return Boolean with Inline; -- Checks invariants of the cursor and its designated container, as a -- simple way of detecting dangling references (see operation Free for a -- description of the detection mechanism), returning True if all checks @@ -2103,6 +2103,10 @@ is function Vet (Position : Cursor) return Boolean is begin + if not Container_Checks'Enabled then + return True; + end if; + if Position.Node = null then return Position.Container = null; end if; diff --git a/gcc/ada/libgnat/a-cihama.adb b/gcc/ada/libgnat/a-cihama.adb index 4734e64..30a2f4d 100644 --- a/gcc/ada/libgnat/a-cihama.adb +++ b/gcc/ada/libgnat/a-cihama.adb @@ -85,7 +85,7 @@ is procedure Set_Next (Node : Node_Access; Next : Node_Access); pragma Inline (Set_Next); - function Vet (Position : Cursor) return Boolean; + function Vet (Position : Cursor) return Boolean with Inline; procedure Write_Node (Stream : not null access Root_Stream_Type'Class; @@ -1299,6 +1299,10 @@ is function Vet (Position : Cursor) return Boolean is begin + if not Container_Checks'Enabled then + return True; + end if; + if Position.Node = null then return Position.Container = null; end if; diff --git a/gcc/ada/libgnat/a-cihase.adb b/gcc/ada/libgnat/a-cihase.adb index cb55bbb..090d01c 100644 --- a/gcc/ada/libgnat/a-cihase.adb +++ b/gcc/ada/libgnat/a-cihase.adb @@ -99,7 +99,7 @@ is procedure Set_Next (Node : Node_Access; Next : Node_Access); pragma Inline (Set_Next); - function Vet (Position : Cursor) return Boolean; + function Vet (Position : Cursor) return Boolean with Inline; procedure Write_Node (Stream : not null access Root_Stream_Type'Class; @@ -1932,6 +1932,10 @@ is function Vet (Position : Cursor) return Boolean is begin + if not Container_Checks'Enabled then + return True; + end if; + if Position.Node = null then return Position.Container = null; end if; diff --git a/gcc/ada/libgnat/a-cohama.adb b/gcc/ada/libgnat/a-cohama.adb index 2fcf4c8..013e2cd 100644 --- a/gcc/ada/libgnat/a-cohama.adb +++ b/gcc/ada/libgnat/a-cohama.adb @@ -80,7 +80,7 @@ is procedure Set_Next (Node : Node_Access; Next : Node_Access); pragma Inline (Set_Next); - function Vet (Position : Cursor) return Boolean; + function Vet (Position : Cursor) return Boolean with Inline; procedure Write_Node (Stream : not null access Root_Stream_Type'Class; @@ -1156,6 +1156,10 @@ is function Vet (Position : Cursor) return Boolean is begin + if not Container_Checks'Enabled then + return True; + end if; + if Position.Node = null then return Position.Container = null; end if; diff --git a/gcc/ada/libgnat/a-cohase.adb b/gcc/ada/libgnat/a-cohase.adb index e9662cc..986b354 100644 --- a/gcc/ada/libgnat/a-cohase.adb +++ b/gcc/ada/libgnat/a-cohase.adb @@ -99,7 +99,7 @@ is procedure Set_Next (Node : Node_Access; Next : Node_Access); pragma Inline (Set_Next); - function Vet (Position : Cursor) return Boolean; + function Vet (Position : Cursor) return Boolean with Inline; procedure Write_Node (Stream : not null access Root_Stream_Type'Class; @@ -1749,6 +1749,10 @@ is function Vet (Position : Cursor) return Boolean is begin + if not Container_Checks'Enabled then + return True; + end if; + if Position.Node = null then return Position.Container = null; end if; diff --git a/gcc/ada/libgnat/a-crbtgo.adb b/gcc/ada/libgnat/a-crbtgo.adb index 7757aad..d689b1c 100644 --- a/gcc/ada/libgnat/a-crbtgo.adb +++ b/gcc/ada/libgnat/a-crbtgo.adb @@ -1060,6 +1060,10 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is function Vet (Tree : Tree_Type; Node : Node_Access) return Boolean is begin + if not Container_Checks'Enabled then + return True; + end if; + if Node = null then return True; end if; diff --git a/gcc/ada/libgnat/a-crbtgo.ads b/gcc/ada/libgnat/a-crbtgo.ads index fde9c45..609fe4b 100644 --- a/gcc/ada/libgnat/a-crbtgo.ads +++ b/gcc/ada/libgnat/a-crbtgo.ads @@ -61,7 +61,8 @@ package Ada.Containers.Red_Black_Trees.Generic_Operations is -- procedure Check_Invariant (Tree : Tree_Type); - function Vet (Tree : Tree_Type; Node : Node_Access) return Boolean; + function Vet (Tree : Tree_Type; Node : Node_Access) return Boolean + with Inline; -- Inspects Node to determine (to the extent possible) whether -- the node is valid; used to detect if the node is dangling. diff --git a/gcc/ada/libgnat/a-crdlli.adb b/gcc/ada/libgnat/a-crdlli.adb index a5fe431..bdb6475 100644 --- a/gcc/ada/libgnat/a-crdlli.adb +++ b/gcc/ada/libgnat/a-crdlli.adb @@ -51,7 +51,7 @@ package body Ada.Containers.Restricted_Doubly_Linked_Lists is Before : Count_Type; New_Node : Count_Type); - function Vet (Position : Cursor) return Boolean; + function Vet (Position : Cursor) return Boolean with Inline; --------- -- "=" -- @@ -1330,6 +1330,10 @@ package body Ada.Containers.Restricted_Doubly_Linked_Lists is function Vet (Position : Cursor) return Boolean is begin + if not Container_Checks'Enabled then + return True; + end if; + if Position.Node = 0 then return Position.Container = null; end if; diff --git a/gcc/ada/libgnat/a-nagefl.ads b/gcc/ada/libgnat/a-nagefl.ads index ad2e5e3..dc2a0f4 100644 --- a/gcc/ada/libgnat/a-nagefl.ads +++ b/gcc/ada/libgnat/a-nagefl.ads @@ -31,10 +31,10 @@ ------------------------------------------------------------------------------ -- This package provides the basic computational interface for the generic --- elementary functions. The C library version interfaces with the routines --- in the C mathematical library. +-- elementary functions. --- This version here is for use with normal Unix math functions. +-- This version here delegates to interfaces that typically import as +-- intrinsics the expected math functions. with Ada.Numerics.Aux_Long_Long_Float; with Ada.Numerics.Aux_Long_Float; diff --git a/gcc/ada/libgnat/a-nallfl.ads b/gcc/ada/libgnat/a-nallfl.ads index db849da..cf08fce 100644 --- a/gcc/ada/libgnat/a-nallfl.ads +++ b/gcc/ada/libgnat/a-nallfl.ads @@ -5,7 +5,7 @@ -- A D A . N U M E R I C S . A U X . L O N G _ L O N G _ F L O A T -- -- -- -- S p e c -- --- (C Math Library Version, Long Long Float) -- +-- (Instrinsic Version, Long Long Float) -- -- -- -- Copyright (C) 1992-2022, Free Software Foundation, Inc. -- -- -- @@ -30,9 +30,12 @@ -- -- ------------------------------------------------------------------------------ --- This package provides the basic computational interface for the generic --- elementary functions. The C library version interfaces with the routines --- in the C mathematical library, and is thus quite portable. +-- This package provides the basic computational interface for the +-- generic elementary functions. With the intrinsic version, the +-- compiler can use its knowledge of the functions to select the most +-- suitable implementation. It is thus quite portable. These +-- interfaces are suitable for cases in which Long Long Float and C's +-- long double share the same representation. with Ada.Numerics.Aux_Linker_Options; pragma Warnings (Off, Ada.Numerics.Aux_Linker_Options); @@ -42,7 +45,7 @@ package Ada.Numerics.Aux_Long_Long_Float is subtype T is Long_Long_Float; - -- We import these functions directly from C. Note that we label them + -- We import these functions as intrinsics. Note that we label them -- all as pure functions, because indeed all of them are in fact pure. function Sin (X : T) return T with diff --git a/gcc/ada/libgnat/a-nalofl.ads b/gcc/ada/libgnat/a-nalofl.ads index e4e440b..86d1fc2 100644 --- a/gcc/ada/libgnat/a-nalofl.ads +++ b/gcc/ada/libgnat/a-nalofl.ads @@ -5,7 +5,7 @@ -- A D A . N U M E R I C S . A U X _ L O N G _ F L O A T -- -- -- -- S p e c -- --- (C Math Library Version, Long Float) -- +-- (Intrinsic Version, Long Float) -- -- -- -- Copyright (C) 1992-2022, Free Software Foundation, Inc. -- -- -- @@ -30,9 +30,12 @@ -- -- ------------------------------------------------------------------------------ --- This package provides the basic computational interface for the generic --- elementary functions. The C library version interfaces with the routines --- in the C mathematical library, and is thus quite portable. +-- This package provides the basic computational interface for the +-- generic elementary functions. With the intrinsic version, the +-- compiler can use its knowledge of the functions to select the most +-- suitable implementation. It is thus quite portable. These +-- interfaces are suitable for cases in which Long Float and C's +-- double share the same representation. with Ada.Numerics.Aux_Linker_Options; pragma Warnings (Off, Ada.Numerics.Aux_Linker_Options); @@ -42,7 +45,7 @@ package Ada.Numerics.Aux_Long_Float is subtype T is Long_Float; - -- We import these functions directly from C. Note that we label them + -- We import these functions as intrinsics. Note that we label them -- all as pure functions, because indeed all of them are in fact pure. function Sin (X : T) return T with diff --git a/gcc/ada/libgnat/a-nalofl__simd.ads b/gcc/ada/libgnat/a-nalofl__simd.ads new file mode 100644 index 0000000..34a798b --- /dev/null +++ b/gcc/ada/libgnat/a-nalofl__simd.ads @@ -0,0 +1,95 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- A D A . N U M E R I C S . A U X _ L O N G _ F L O A T -- +-- -- +-- S p e c -- +-- (Intrinsic/SIMD Version, Long Float) -- +-- -- +-- Copyright (C) 1992-2022, 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 the basic computational interface for the +-- generic elementary functions. With the intrinsic/SIMD version, the +-- compiler can use its knowledge of the functions to select the most +-- suitable implementation, including a vector implementation. These +-- interfaces are suitable for cases in which Long Float and C's +-- double share the same representation. + +with Ada.Numerics.Aux_Linker_Options; +pragma Warnings (Off, Ada.Numerics.Aux_Linker_Options); + +package Ada.Numerics.Aux_Long_Float is + pragma Pure; + + subtype T is Long_Float; + + -- We import these functions as intrinsics. Note that we label them + -- all as pure functions, because indeed all of them are in fact pure. + + function Sin (X : T) return T with + Import, Convention => Intrinsic, External_Name => "sin"; + pragma Machine_Attribute (Sin, "simd", "notinbranch"); + + function Cos (X : T) return T with + Import, Convention => Intrinsic, External_Name => "cos"; + pragma Machine_Attribute (Cos, "simd", "notinbranch"); + + function Tan (X : T) return T with + Import, Convention => Intrinsic, External_Name => "tan"; + + function Exp (X : T) return T with + Import, Convention => Intrinsic, External_Name => "exp"; + pragma Machine_Attribute (Exp, "simd", "notinbranch"); + + function Sqrt (X : T) return T with + Import, Convention => Intrinsic, External_Name => "sqrt"; + + function Log (X : T) return T with + Import, Convention => Intrinsic, External_Name => "log"; + pragma Machine_Attribute (Log, "simd", "notinbranch"); + + function Acos (X : T) return T with + Import, Convention => Intrinsic, External_Name => "acos"; + + function Asin (X : T) return T with + Import, Convention => Intrinsic, External_Name => "asin"; + + function Atan (X : T) return T with + Import, Convention => Intrinsic, External_Name => "atan"; + + function Sinh (X : T) return T with + Import, Convention => Intrinsic, External_Name => "sinh"; + + function Cosh (X : T) return T with + Import, Convention => Intrinsic, External_Name => "cosh"; + + function Tanh (X : T) return T with + Import, Convention => Intrinsic, External_Name => "tanh"; + + function Pow (X, Y : T) return T with + Import, Convention => Intrinsic, External_Name => "pow"; + pragma Machine_Attribute (Pow, "simd", "notinbranch"); + +end Ada.Numerics.Aux_Long_Float; diff --git a/gcc/ada/libgnat/a-nuaufl.ads b/gcc/ada/libgnat/a-nuaufl.ads index e38ebb5..0ee5dfc 100644 --- a/gcc/ada/libgnat/a-nuaufl.ads +++ b/gcc/ada/libgnat/a-nuaufl.ads @@ -5,7 +5,7 @@ -- A D A . N U M E R I C S . A U X _ F L O A T -- -- -- -- S p e c -- --- (C Math Library Version, Float) -- +-- (Intrinsic Version, Float) -- -- -- -- Copyright (C) 1992-2022, Free Software Foundation, Inc. -- -- -- @@ -30,9 +30,12 @@ -- -- ------------------------------------------------------------------------------ --- This package provides the basic computational interface for the generic --- elementary functions. The C library version interfaces with the routines --- in the C mathematical library, and is thus quite portable. +-- This package provides the basic computational interface for the +-- generic elementary functions. With the intrinsic version, the +-- compiler can use its knowledge of the functions to select the most +-- suitable implementation. It is thus quite portable. These +-- interfaces are suitable for cases in which Float and C's float +-- share the same representation. with Ada.Numerics.Aux_Linker_Options; pragma Warnings (Off, Ada.Numerics.Aux_Linker_Options); @@ -42,7 +45,7 @@ package Ada.Numerics.Aux_Float is subtype T is Float; - -- We import these functions directly from C. Note that we label them + -- We import these functions as intrinsics. Note that we label them -- all as pure functions, because indeed all of them are in fact pure. function Sin (X : T) return T with diff --git a/gcc/ada/libgnat/a-nuaufl__simd.ads b/gcc/ada/libgnat/a-nuaufl__simd.ads new file mode 100644 index 0000000..0f335ac --- /dev/null +++ b/gcc/ada/libgnat/a-nuaufl__simd.ads @@ -0,0 +1,95 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- A D A . N U M E R I C S . A U X _ F L O A T -- +-- -- +-- S p e c -- +-- (Intrinsic/SIMD Version, Float) -- +-- -- +-- Copyright (C) 1992-2022, 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 the basic computational interface for the +-- generic elementary functions. With the intrinsic/SIMD version, the +-- compiler can use its knowledge of the functions to select the most +-- suitable implementation, including a vector implementation. These +-- interfaces are suitable for cases in which Float and C's float +-- share the same representation. + +with Ada.Numerics.Aux_Linker_Options; +pragma Warnings (Off, Ada.Numerics.Aux_Linker_Options); + +package Ada.Numerics.Aux_Float is + pragma Pure; + + subtype T is Float; + + -- We import these functions as intrinsics. Note that we label them + -- all as pure functions, because indeed all of them are in fact pure. + + function Sin (X : T) return T with + Import, Convention => Intrinsic, External_Name => "sinf"; + pragma Machine_Attribute (Sin, "simd", "notinbranch"); + + function Cos (X : T) return T with + Import, Convention => Intrinsic, External_Name => "cosf"; + pragma Machine_Attribute (Cos, "simd", "notinbranch"); + + function Tan (X : T) return T with + Import, Convention => Intrinsic, External_Name => "tanf"; + + function Exp (X : T) return T with + Import, Convention => Intrinsic, External_Name => "expf"; + pragma Machine_Attribute (Exp, "simd", "notinbranch"); + + function Sqrt (X : T) return T with + Import, Convention => Intrinsic, External_Name => "sqrtf"; + + function Log (X : T) return T with + Import, Convention => Intrinsic, External_Name => "logf"; + pragma Machine_Attribute (Log, "simd", "notinbranch"); + + function Acos (X : T) return T with + Import, Convention => Intrinsic, External_Name => "acosf"; + + function Asin (X : T) return T with + Import, Convention => Intrinsic, External_Name => "asinf"; + + function Atan (X : T) return T with + Import, Convention => Intrinsic, External_Name => "atanf"; + + function Sinh (X : T) return T with + Import, Convention => Intrinsic, External_Name => "sinhf"; + + function Cosh (X : T) return T with + Import, Convention => Intrinsic, External_Name => "coshf"; + + function Tanh (X : T) return T with + Import, Convention => Intrinsic, External_Name => "tanhf"; + + function Pow (X, Y : T) return T with + Import, Convention => Intrinsic, External_Name => "powf"; + pragma Machine_Attribute (Pow, "simd", "notinbranch"); + +end Ada.Numerics.Aux_Float; diff --git a/gcc/ada/libgnat/a-rbtgbo.adb b/gcc/ada/libgnat/a-rbtgbo.adb index c077788..0c3f25f 100644 --- a/gcc/ada/libgnat/a-rbtgbo.adb +++ b/gcc/ada/libgnat/a-rbtgbo.adb @@ -1038,8 +1038,11 @@ package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations is function Vet (Tree : Tree_Type'Class; Index : Count_Type) return Boolean is Nodes : Nodes_Type renames Tree.Nodes; Node : Node_Type renames Nodes (Index); - begin + if not Container_Checks'Enabled then + return True; + end if; + if Parent (Node) = Index or else Left (Node) = Index or else Right (Node) = Index diff --git a/gcc/ada/libgnat/a-rbtgbo.ads b/gcc/ada/libgnat/a-rbtgbo.ads index 97c0ee0..b3e0106 100644 --- a/gcc/ada/libgnat/a-rbtgbo.ads +++ b/gcc/ada/libgnat/a-rbtgbo.ads @@ -70,7 +70,8 @@ package Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations is function Max (Tree : Tree_Type'Class; Node : Count_Type) return Count_Type; -- Returns the largest-valued node of the subtree rooted at Node - function Vet (Tree : Tree_Type'Class; Index : Count_Type) return Boolean; + function Vet (Tree : Tree_Type'Class; Index : Count_Type) return Boolean + with Inline; -- Inspects Node to determine (to the extent possible) whether -- the node is valid; used to detect if the node is dangling. diff --git a/gcc/ada/libgnat/a-strfix.adb b/gcc/ada/libgnat/a-strfix.adb index 7475254..a04bf9a 100644 --- a/gcc/ada/libgnat/a-strfix.adb +++ b/gcc/ada/libgnat/a-strfix.adb @@ -628,6 +628,11 @@ package body Ada.Strings.Fixed with SPARK_Mode is (Result (1 .. Integer'Max (0, Low - Source'First)) = Source (Source'First .. Low - 1)); Result (Front_Len + 1 .. Front_Len + By'Length) := By; + pragma Assert + (Result + (Integer'Max (0, Low - Source'First) + 1 + .. Integer'Max (0, Low - Source'First) + By'Length) + = By); if High < Source'Last then Result (Front_Len + By'Length + 1 .. Result'Last) := diff --git a/gcc/ada/libgnat/a-strsup.adb b/gcc/ada/libgnat/a-strsup.adb index f1a40a2..e301564 100644 --- a/gcc/ada/libgnat/a-strsup.adb +++ b/gcc/ada/libgnat/a-strsup.adb @@ -1150,6 +1150,14 @@ package body Ada.Strings.Superbounded with SPARK_Mode is Result.Data (Position .. Position - 1 + New_Item'Length) := Super_String_Data (New_Item); Result.Current_Length := Source.Current_Length; + pragma Assert + (String'(Super_Slice (Result, 1, Position - 1)) = + Super_Slice (Source, 1, Position - 1)); + pragma Assert + (Super_Slice (Result, + Position, Position - 1 + New_Item'Length) = + New_Item); + return Result; elsif Position - 1 <= Max_Length - New_Item'Length then @@ -1157,6 +1165,14 @@ package body Ada.Strings.Superbounded with SPARK_Mode is Result.Data (Position .. Position - 1 + New_Item'Length) := Super_String_Data (New_Item); Result.Current_Length := Position - 1 + New_Item'Length; + pragma Assert + (String'(Super_Slice (Result, 1, Position - 1)) = + Super_Slice (Source, 1, Position - 1)); + pragma Assert + (Super_Slice (Result, + Position, Position - 1 + New_Item'Length) = + New_Item); + return Result; else @@ -1189,6 +1205,7 @@ package body Ada.Strings.Superbounded with SPARK_Mode is end case; Result.Current_Length := Max_Length; + pragma Assert (Super_Length (Result) = Source.Max_Length); return Result; end if; end Super_Overwrite; diff --git a/gcc/ada/libgnat/g-binsea.adb b/gcc/ada/libgnat/g-binsea.adb new file mode 100644 index 0000000..fcf0185 --- /dev/null +++ b/gcc/ada/libgnat/g-binsea.adb @@ -0,0 +1,123 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- GNAT.BINARY_SEARCH -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2022, AdaCore -- +-- -- +-- 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/>. -- +------------------------------------------------------------------------------ + +package body GNAT.Binary_Search is + + function Index + (First, Last, Start : Index_Type; + Element : Element_Type) return Index_Type'Base is + begin + if Leftmost then + declare + function Before + (Index : Index_Type; Element : Element_Type) return Boolean + is (Before (Get (Index), Element)) with Inline_Always; + + function Find is new Binary_Search.Leftmost + (Index_Type, Element_Type, Before); + begin + return Find (First, Last, Start, Element); + end; + + else + declare + function Before + (Element : Element_Type; Index : Index_Type) return Boolean + is (Before (Element, Get (Index))) with Inline_Always; + + function Find is new Rightmost (Index_Type, Element_Type, Before); + begin + return Find (First, Last, Start, Element); + end; + end if; + end Index; + + -------------- + -- Leftmost -- + -------------- + + function Leftmost + (First, Last, Start : Index_Type; + Element : Element_Type) return Index_Type'Base + is + L : Index_Type := First; + R : Index_Type := Index_Type'Succ (Last); + M : Index_Type := Start; + begin + if First <= Last then + loop + if Before (M, Element) then + L := Index_Type'Succ (M); + else + R := M; + end if; + + exit when L >= R; + + M := Index_Type'Val + (Index_Type'Pos (L) + + (Index_Type'Pos (R) - Index_Type'Pos (L)) / 2); + end loop; + end if; + + return L; + end Leftmost; + + --------------- + -- Rightmost -- + --------------- + + function Rightmost + (First, Last, Start : Index_Type; + Element : Element_Type) return Index_Type'Base + is + L : Index_Type := First; + R : Index_Type := Index_Type'Succ (Last); + M : Index_Type := Start; + begin + if First > Last then + return Last; + else + loop + if Before (Element, M) then + R := M; + else + L := Index_Type'Succ (M); + end if; + + exit when L >= R; + + M := Index_Type'Val + (Index_Type'Pos (L) + + (Index_Type'Pos (R) - Index_Type'Pos (L)) / 2); + end loop; + end if; + + return Index_Type'Pred (R); + end Rightmost; + +end GNAT.Binary_Search; diff --git a/gcc/ada/libgnat/g-binsea.ads b/gcc/ada/libgnat/g-binsea.ads new file mode 100644 index 0000000..372b830 --- /dev/null +++ b/gcc/ada/libgnat/g-binsea.ads @@ -0,0 +1,93 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- GNAT.BINARY_SEARCH -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2022, AdaCore -- +-- -- +-- 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/>. -- +------------------------------------------------------------------------------ + +-- Allow binary search of a sorted array (or of an array-like container; +-- the generic does not reference the array directly). + +package GNAT.Binary_Search is + + generic + type Index_Type is (<>); + type Element_Type (<>) is private; + with function Get (Index : Index_Type) return Element_Type; + with function Before (Left, Right : Element_Type) return Boolean; + Leftmost : Boolean := True; + function Index + (First, Last, Start : Index_Type; + Element : Element_Type) return Index_Type'Base; + -- Search for element in sorted container. Function Before should return + -- True when Left and Right are in the container's sort order and not + -- equal. Function Get returns the container element indexed by Index; + -- Index will be in the range First .. Last. If there is at least one index + -- value in the range First .. Last for which Get would return Element, + -- then the Leftmost generic parameter indicates whether the least (if + -- Leftmost is True) or the greatest (if Leftmost is False) such index + -- value is returned. If no such index value exists, then Leftmost + -- determines whether to return the greater (if Leftmost is True) or the + -- smaller (if Leftmost is False) of the two index values between which + -- Element could be inserted. If First > Last (so that a null range is + -- being searched), some Index_Type'Base value will be returned. + -- Start is the index for the first probe of the binary search. It can + -- improve speed of many search operations when user can guess the most + -- likely values. If you do not know what value should be used there, use + -- (First + Last) / 2. + + generic + type Index_Type is (<>); + type Element_Type (<>) is private; + with function Before + (Index : Index_Type; Element : Element_Type) return Boolean; + function Leftmost + (First, Last, Start : Index_Type; + Element : Element_Type) return Index_Type'Base + with Pre => First > Last -- Empty array + or else (Start in First .. Last + and then ( -- To prevent overflow in function result + Index_Type'Base'Last > Last + or else not Before (Last, Element))); + -- Leftmost returns the result described for Index in the case where the + -- Leftmost parameter is True, with Index_Type values mapped to + -- Element_Type values via Get as needed. + + generic + type Index_Type is (<>); + type Element_Type (<>) is private; + with function Before + (Element : Element_Type; Index : Index_Type) return Boolean; + function Rightmost + (First, Last, Start : Index_Type; + Element : Element_Type) return Index_Type'Base + with Pre => First > Last -- Empty array + or else (Start in First .. Last + and then ( -- To prevent overflow in function result + Index_Type'Base'First < First + or else not Before (Element, First))); + -- Rightmost returns the result described for Index in the case where the + -- Leftmost parameter is False, with Index_Type values mapped to + -- Element_Type values via Get as needed. + +end GNAT.Binary_Search; diff --git a/gcc/ada/libgnat/g-debpoo.ads b/gcc/ada/libgnat/g-debpoo.ads index bf21369..e3df752 100644 --- a/gcc/ada/libgnat/g-debpoo.ads +++ b/gcc/ada/libgnat/g-debpoo.ads @@ -123,7 +123,8 @@ package GNAT.Debug_Pools is -- traces that are output to indicate locations of actions for error -- conditions such as bad allocations. If set to zero, the debug pool -- will not try to compute backtraces. This is more efficient but gives - -- less information on problem locations + -- less information on problem locations (and in particular, this + -- disables the tracking of the biggest users of memory). -- -- Maximum_Logically_Freed_Memory: maximum amount of memory (bytes) -- that should be kept before starting to physically deallocate some. @@ -275,8 +276,12 @@ package GNAT.Debug_Pools is Size : Positive; Report : Report_Type := All_Reports); -- Dump information about memory usage. - -- Size is the number of the biggest memory users we want to show. Report - -- indicates which sorting order is used in the report. + -- Size is the number of the biggest memory users we want to show + -- (requires that the Debug_Pool has been configured with Stack_Trace_Depth + -- greater than zero). Also, for efficiency reasons, tracebacks with + -- a memory allocation below 1_000 bytes are not shown in the "biggest + -- memory users" part of the report. + -- Report indicates which sorting order is used in the report. procedure Dump_Stdout (Pool : Debug_Pool; diff --git a/gcc/ada/libgnat/g-forstr.adb b/gcc/ada/libgnat/g-forstr.adb index 8ce8d1c..8821de6 100644 --- a/gcc/ada/libgnat/g-forstr.adb +++ b/gcc/ada/libgnat/g-forstr.adb @@ -58,7 +58,7 @@ package body GNAT.Formatted_String is type Sign_Kind is (Neg, Zero, Pos); - subtype Is_Number is F_Kind range Decimal_Int .. Decimal_Float; + subtype Is_Number is F_Kind range Decimal_Int .. Shortest_Decimal_Float_Up; type F_Sign is (If_Neg, Forced, Space) with Default_Value => If_Neg; diff --git a/gcc/ada/libgnat/g-gfmafu.ads b/gcc/ada/libgnat/g-gfmafu.ads new file mode 100644 index 0000000..410a37c --- /dev/null +++ b/gcc/ada/libgnat/g-gfmafu.ads @@ -0,0 +1,35 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- G N A T . G E N E R I C _ F A S T _ M A T H _ F U N C T I O N S -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2022, 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.Numerics.Aux_Generic_Float; + +generic package GNAT.Generic_Fast_Math_Functions + renames Ada.Numerics.Aux_Generic_Float; diff --git a/gcc/ada/libgnat/s-aridou.adb b/gcc/ada/libgnat/s-aridou.adb index ffb6f4ca..d214968 100644 --- a/gcc/ada/libgnat/s-aridou.adb +++ b/gcc/ada/libgnat/s-aridou.adb @@ -133,7 +133,7 @@ is Post => Big_2xx'Result > 0; -- 2**N as a big integer - function Big3 (X1, X2, X3 : Single_Uns) return Big_Integer is + function Big3 (X1, X2, X3 : Single_Uns) return Big_Natural is (Big_2xxSingle * Big_2xxSingle * Big (Double_Uns (X1)) + Big_2xxSingle * Big (Double_Uns (X2)) + Big (Double_Uns (X3))) @@ -208,19 +208,12 @@ is Ghost, Post => abs (X * Y) = abs X * abs Y; - procedure Lemma_Mult_Non_Negative (X, Y : Big_Integer) + procedure Lemma_Abs_Range (X : Big_Integer) with Ghost, - Pre => (X >= Big_0 and then Y >= Big_0) - or else (X <= Big_0 and then Y <= Big_0), - Post => X * Y >= Big_0; - - procedure Lemma_Mult_Non_Positive (X, Y : Big_Integer) - with - Ghost, - Pre => (X <= Big_0 and then Y >= Big_0) - or else (X >= Big_0 and then Y <= Big_0), - Post => X * Y <= Big_0; + Pre => In_Double_Int_Range (X), + Post => abs (X) <= Big_2xxDouble_Minus_1 + and then In_Double_Int_Range (-abs (X)); procedure Lemma_Abs_Rem_Commutation (X, Y : Big_Integer) with @@ -246,6 +239,12 @@ is Pre => M < N and then N < Double_Size, Post => Double_Uns'(2)**M < Double_Uns'(2)**N; + procedure Lemma_Concat_Definition (X, Y : Single_Uns) + with + Ghost, + Post => Big (X & Y) = Big_2xxSingle * Big (Double_Uns (X)) + + Big (Double_Uns (Y)); + procedure Lemma_Deep_Mult_Commutation (Factor : Big_Integer; X, Y : Single_Uns) @@ -289,6 +288,11 @@ is Pre => A * S = B * S + R and then S /= 0, Post => A = B + R / S; + procedure Lemma_Double_Big_2xxSingle + with + Ghost, + Post => Big_2xxSingle * Big_2xxSingle = Big_2xxDouble; + procedure Lemma_Double_Shift (X : Double_Uns; S, S1 : Double_Uns) with Ghost, @@ -309,6 +313,20 @@ is Pre => S <= Double_Size - S1, Post => Shift_Left (Shift_Left (X, S), S1) = Shift_Left (X, S + S1); + procedure Lemma_Double_Shift_Left (X : Double_Uns; S, S1 : Double_Uns) + with + Ghost, + Pre => S <= Double_Uns (Double_Size) + and then S1 <= Double_Uns (Double_Size), + Post => Shift_Left (Shift_Left (X, Natural (S)), Natural (S1)) = + Shift_Left (X, Natural (S + S1)); + + procedure Lemma_Double_Shift_Left (X : Double_Uns; S, S1 : Natural) + with + Ghost, + Pre => S <= Double_Size - S1, + Post => Shift_Left (Shift_Left (X, S), S1) = Shift_Left (X, S + S1); + procedure Lemma_Double_Shift_Right (X : Double_Uns; S, S1 : Double_Uns) with Ghost, @@ -419,6 +437,20 @@ is Ghost, Post => X * (Y + Z) = X * Y + X * Z; + procedure Lemma_Mult_Non_Negative (X, Y : Big_Integer) + with + Ghost, + Pre => (X >= Big_0 and then Y >= Big_0) + or else (X <= Big_0 and then Y <= Big_0), + Post => X * Y >= Big_0; + + procedure Lemma_Mult_Non_Positive (X, Y : Big_Integer) + with + Ghost, + Pre => (X <= Big_0 and then Y >= Big_0) + or else (X >= Big_0 and then Y <= Big_0), + Post => X * Y <= Big_0; + procedure Lemma_Neg_Div (X, Y : Big_Integer) with Ghost, @@ -494,6 +526,13 @@ is Pre => A = B * Q + R and then R < B, Post => Q = A / B and then R = A rem B; + procedure Lemma_Shift_Left (X : Double_Uns; Shift : Natural) + with + Ghost, + Pre => Shift < Double_Size + and then Big (X) * Big_2xx (Shift) < Big_2xxDouble, + Post => Big (Shift_Left (X, Shift)) = Big (X) * Big_2xx (Shift); + procedure Lemma_Shift_Right (X : Double_Uns; Shift : Natural) with Ghost, @@ -549,6 +588,7 @@ is procedure Inline_Le3 (X1, X2, X3, Y1, Y2, Y3 : Single_Uns) is null; procedure Lemma_Abs_Commutation (X : Double_Int) is null; procedure Lemma_Abs_Mult_Commutation (X, Y : Big_Integer) is null; + procedure Lemma_Abs_Range (X : Big_Integer) is null; procedure Lemma_Add_Commutation (X : Double_Uns; Y : Single_Uns) is null; procedure Lemma_Add_One (X : Double_Uns) is null; procedure Lemma_Bounded_Powers_Of_2_Increasing (M, N : Natural) is null; @@ -566,8 +606,11 @@ is procedure Lemma_Div_Ge (X, Y, Z : Big_Integer) is null; procedure Lemma_Div_Lt (X, Y, Z : Big_Natural) is null; procedure Lemma_Div_Eq (A, B, S, R : Big_Integer) is null; + procedure Lemma_Double_Big_2xxSingle is null; procedure Lemma_Double_Shift (X : Double_Uns; S, S1 : Double_Uns) is null; procedure Lemma_Double_Shift (X : Single_Uns; S, S1 : Natural) is null; + procedure Lemma_Double_Shift_Left (X : Double_Uns; S, S1 : Double_Uns) + is null; procedure Lemma_Double_Shift_Right (X : Double_Uns; S, S1 : Double_Uns) is null; procedure Lemma_Ge_Commutation (A, B : Double_Uns) is null; @@ -929,10 +972,19 @@ is pragma Assert (Big (Double_Uns'(Yhi * Zhi)) >= 1); if Yhi > 1 or else Zhi > 1 then pragma Assert (Big (Double_Uns'(Yhi * Zhi)) > 1); + pragma Assert (if X = Double_Int'First and then Round then + Mult > Big_2xxDouble); elsif Zlo > 0 then pragma Assert (Big (Double_Uns'(Yhi * Zlo)) > 0); + pragma Assert (if X = Double_Int'First and then Round then + Mult > Big_2xxDouble); elsif Ylo > 0 then + pragma Assert (Double_Uns'(Ylo * Zhi) > 0); pragma Assert (Big (Double_Uns'(Ylo * Zhi)) > 0); + pragma Assert (if X = Double_Int'First and then Round then + Mult > Big_2xxDouble); + else + pragma Assert (not (X = Double_Int'First and then Round)); end if; Prove_Quotient_Zero; end if; @@ -941,11 +993,13 @@ is else T2 := Yhi * Zlo; pragma Assert (Big (T2) = Big (Double_Uns'(Yhi * Zlo))); + pragma Assert (Big_0 = Big (Double_Uns'(Ylo * Zhi))); end if; else T2 := Ylo * Zhi; pragma Assert (Big (T2) = Big (Double_Uns'(Ylo * Zhi))); + pragma Assert (Big_0 = Big (Double_Uns'(Yhi * Zlo))); end if; T1 := Ylo * Zlo; @@ -974,6 +1028,7 @@ is Lemma_Mult_Distribution (Big_2xxSingle, Big (Double_Uns (Hi (T2))), Big (Double_Uns (Lo (T2)))); + Lemma_Double_Big_2xxSingle; pragma Assert (Mult = Big_2xxDouble * Big (Double_Uns (Hi (T2))) + Big_2xxSingle * Big (Double_Uns (Lo (T2))) @@ -1000,15 +1055,24 @@ is pragma Assert (Big (Double_Uns (Hi (T2))) >= 1); pragma Assert (Big (Double_Uns (Lo (T2))) >= 0); pragma Assert (Big (Double_Uns (Lo (T1))) >= 0); + pragma Assert (Mult >= Big_2xxDouble * Big (Double_Uns (Hi (T2)))); pragma Assert (Mult >= Big_2xxDouble); if Hi (T2) > 1 then pragma Assert (Big (Double_Uns (Hi (T2))) > 1); + pragma Assert (if X = Double_Int'First and then Round then + Mult > Big_2xxDouble); elsif Lo (T2) > 0 then pragma Assert (Big (Double_Uns (Lo (T2))) > 0); + pragma Assert (if X = Double_Int'First and then Round then + Mult > Big_2xxDouble); elsif Lo (T1) > 0 then pragma Assert (Double_Uns (Lo (T1)) > 0); Lemma_Gt_Commutation (Double_Uns (Lo (T1)), 0); pragma Assert (Big (Double_Uns (Lo (T1))) > 0); + pragma Assert (if X = Double_Int'First and then Round then + Mult > Big_2xxDouble); + else + pragma Assert (not (X = Double_Int'First and then Round)); end if; Prove_Quotient_Zero; end if; @@ -1148,6 +1212,18 @@ is end if; end Lemma_Abs_Rem_Commutation; + ----------------------------- + -- Lemma_Concat_Definition -- + ----------------------------- + + procedure Lemma_Concat_Definition (X, Y : Single_Uns) is + Hi : constant Double_Uns := Shift_Left (Double_Uns (X), Single_Size); + Lo : constant Double_Uns := Double_Uns (Y); + begin + pragma Assert (Hi = Double_Uns'(2 ** Single_Size) * Double_Uns (X)); + pragma Assert ((Hi or Lo) = Hi + Lo); + end Lemma_Concat_Definition; + ------------------------ -- Lemma_Double_Shift -- ------------------------ @@ -1161,6 +1237,19 @@ is = Shift_Left (X, Natural (Double_Uns (S + S1)))); end Lemma_Double_Shift; + ----------------------------- + -- Lemma_Double_Shift_Left -- + ----------------------------- + + procedure Lemma_Double_Shift_Left (X : Double_Uns; S, S1 : Natural) is + begin + Lemma_Double_Shift_Left (X, Double_Uns (S), Double_Uns (S1)); + pragma Assert (Shift_Left (Shift_Left (X, S), S1) + = Shift_Left (Shift_Left (X, S), Natural (Double_Uns (S1)))); + pragma Assert (Shift_Left (X, S + S1) + = Shift_Left (X, Natural (Double_Uns (S + S1)))); + end Lemma_Double_Shift_Left; + ------------------------------ -- Lemma_Double_Shift_Right -- ------------------------------ @@ -1304,15 +1393,78 @@ is Lemma_Neg_Rem (X, Y); end Lemma_Rem_Abs; + ---------------------- + -- Lemma_Shift_Left -- + ---------------------- + + procedure Lemma_Shift_Left (X : Double_Uns; Shift : Natural) is + + procedure Lemma_Mult_Pow2 (X : Double_Uns; I : Natural) + with + Ghost, + Pre => I < Double_Size - 1, + Post => X * Double_Uns'(2) ** I * Double_Uns'(2) + = X * Double_Uns'(2) ** (I + 1); + + procedure Lemma_Mult_Pow2 (X : Double_Uns; I : Natural) is + Mul1 : constant Double_Uns := Double_Uns'(2) ** I; + Mul2 : constant Double_Uns := Double_Uns'(2); + Left : constant Double_Uns := X * Mul1 * Mul2; + begin + pragma Assert (Left = X * (Mul1 * Mul2)); + pragma Assert (Mul1 * Mul2 = Double_Uns'(2) ** (I + 1)); + end Lemma_Mult_Pow2; + + XX : Double_Uns := X; + + begin + for J in 1 .. Shift loop + declare + Cur_XX : constant Double_Uns := XX; + begin + XX := Shift_Left (XX, 1); + pragma Assert (XX = Cur_XX * Double_Uns'(2)); + Lemma_Mult_Pow2 (X, J - 1); + end; + Lemma_Double_Shift_Left (X, J - 1, 1); + pragma Loop_Invariant (XX = Shift_Left (X, J)); + pragma Loop_Invariant (XX = X * Double_Uns'(2) ** J); + end loop; + end Lemma_Shift_Left; + ----------------------- -- Lemma_Shift_Right -- ----------------------- procedure Lemma_Shift_Right (X : Double_Uns; Shift : Natural) is + + procedure Lemma_Div_Pow2 (X : Double_Uns; I : Natural) + with + Ghost, + Pre => I < Double_Size - 1, + Post => X / Double_Uns'(2) ** I / Double_Uns'(2) + = X / Double_Uns'(2) ** (I + 1); + + procedure Lemma_Div_Pow2 (X : Double_Uns; I : Natural) is + Div1 : constant Double_Uns := Double_Uns'(2) ** I; + Div2 : constant Double_Uns := Double_Uns'(2); + Left : constant Double_Uns := X / Div1 / Div2; + begin + pragma Assert (Left = X / (Div1 * Div2)); + pragma Assert (Div1 * Div2 = Double_Uns'(2) ** (I + 1)); + end Lemma_Div_Pow2; + XX : Double_Uns := X; + begin for J in 1 .. Shift loop - XX := Shift_Right (XX, 1); + declare + Cur_XX : constant Double_Uns := XX; + begin + XX := Shift_Right (XX, 1); + pragma Assert (XX = Cur_XX / Double_Uns'(2)); + Lemma_Div_Pow2 (X, J - 1); + end; Lemma_Double_Shift_Right (X, J - 1, 1); pragma Loop_Invariant (XX = Shift_Right (X, J)); pragma Loop_Invariant (XX = X / Double_Uns'(2) ** J); @@ -1583,6 +1735,7 @@ is "Intentional Unsigned->Signed conversion"); else Prove_Neg_Int; + Lemma_Abs_Range (Big (X) * Big (Y)); return To_Neg_Int (T2); end if; else -- X < 0 @@ -1593,6 +1746,7 @@ is "Intentional Unsigned->Signed conversion"); else Prove_Neg_Int; + Lemma_Abs_Range (Big (X) * Big (Y)); return To_Neg_Int (T2); end if; end if; @@ -1877,6 +2031,9 @@ is procedure Prove_Dividend_Scaling is begin + Lemma_Shift_Left (D (1) & D (2), Scale); + Lemma_Shift_Left (Double_Uns (D (3)), Scale); + Lemma_Shift_Left (Double_Uns (D (4)), Scale); Lemma_Hi_Lo (D (1) & D (2), D (1), D (2)); pragma Assert (Mult * Big_2xx (Scale) = Big_2xxSingle @@ -1888,7 +2045,14 @@ is Big_2xx (Scale), Big_2xxDouble); Lemma_Lt_Mult (Big (Double_Uns (D (4))), Big_2xxSingle, Big_2xx (Scale), Big_2xxDouble); - Lemma_Mult_Commutation (2 ** Scale, D (1) & D (2), T1); + declare + Two_xx_Scale : constant Double_Uns := Double_Uns'(2 ** Scale); + D12 : constant Double_Uns := D (1) & D (2); + begin + pragma Assert (Big_2xx (Scale) * Big (D12) < Big_2xxDouble); + pragma Assert (Big (Two_xx_Scale) * Big (D12) < Big_2xxDouble); + Lemma_Mult_Commutation (Two_xx_Scale, D12, T1); + end; declare Big_D12 : constant Big_Integer := Big_2xx (Scale) * Big (D (1) & D (2)); @@ -1952,6 +2116,10 @@ is pragma Assert (Big (Double_Uns (Hi (T3))) + Big (Double_Uns (Hi (T2))) = Big (Double_Uns (S1))); + pragma Assert + (Big_2xxSingle * Big_2xxSingle * Big (Double_Uns (Hi (T2))) + + Big_2xxSingle * Big_2xxSingle * Big (Double_Uns (Hi (T3))) + = Big_2xxSingle * Big_2xxSingle * Big (Double_Uns (S1))); end Prove_Multiplication; ----------------------------- @@ -2081,6 +2249,7 @@ is pragma Assert (Double_Uns (Lo (T1 rem Zlo)) = T1 rem Zlo); Lemma_Hi_Lo (T2, Lo (T1 rem Zlo), D (4)); pragma Assert (T1 rem Zlo + Double_Uns'(1) <= Double_Uns (Zlo)); + Lemma_Ge_Commutation (Double_Uns (Zlo), T1 rem Zlo + Double_Uns'(1)); Lemma_Add_Commutation (T1 rem Zlo, 1); pragma Assert (Big (T1 rem Zlo) + 1 <= Big (Double_Uns (Zlo))); Lemma_Div_Definition (T2, Zlo, T2 / Zlo, Ru); @@ -2090,6 +2259,9 @@ is Lemma_Div_Lt (Big (T1), Big_2xxSingle, Big (Double_Uns (Zlo))); Lemma_Div_Commutation (T1, Double_Uns (Zlo)); Lemma_Lo_Is_Ident (T1 / Zlo); + pragma Assert + (Big (T2) <= Big_2xxSingle * (Big (Double_Uns (Zlo)) - 1) + + Big (Double_Uns (D (4)))); Lemma_Div_Lt (Big (T2), Big_2xxSingle, Big (Double_Uns (Zlo))); Lemma_Div_Commutation (T2, Double_Uns (Zlo)); Lemma_Lo_Is_Ident (T2 / Zlo); @@ -2302,6 +2474,9 @@ is -- First normalize the divisor so that it has the leading bit on. -- We do this by finding the appropriate left shift amount. + Lemma_Lt_Commutation (D (1) & D (2), Zu); + pragma Assert (Mult < Big_2xxDouble * Big (Zu)); + Shift := Single_Size; Mask := Single_Uns'Last; Scale := 0; @@ -2374,6 +2549,8 @@ is procedure Prove_Shift_Progress is null; begin + pragma Assert (Mask = Shift_Left (Single_Uns'Last, + Single_Size - Shift_Prev)); Prove_Power; Shift := Shift / 2; @@ -2468,6 +2645,16 @@ is + Big (Double_Uns (D (3))), Big3 (D (1), D (2), D (3)), Big (Double_Uns (D (4)))); + Lemma_Concat_Definition (D (1), D (2)); + Lemma_Double_Big_2xxSingle; + Lemma_Substitution + (Mult * Big_2xx (Scale), Big_2xxSingle * Big_2xxSingle, + Big_2xxSingle * Big (Double_Uns (D (1))) + + Big (Double_Uns (D (2))), + Big (D (1) & D (2)), + Big_2xxSingle * Big (Double_Uns (D (3))) + + Big (Double_Uns (D (4)))); + pragma Assert (Big (D (1) & D (2)) < Big (Zu)); -- Loop to compute quotient digits, runs twice for Qd (1) and Qd (2) @@ -2514,6 +2701,21 @@ is elsif D (J) = Zhi then Qd (J) := Single_Uns'Last; + Lemma_Concat_Definition (D (J), D (J + 1)); + pragma Assert (Big_2xxSingle > Big (Double_Uns (D (J + 2)))); + pragma Assert (Big3 (D (J), D (J + 1), 0) + Big_2xxSingle + > Big3 (D (J), D (J + 1), D (J + 2))); + pragma Assert (Big (Double_Uns'(0)) = 0); + pragma Assert (Big (D (J) & D (J + 1)) * Big_2xxSingle = + Big_2xxSingle * (Big_2xxSingle * Big (Double_Uns (D (J))) + + Big (Double_Uns (D (J + 1))))); + pragma Assert (Big (D (J) & D (J + 1)) * Big_2xxSingle = + Big_2xxSingle * Big_2xxSingle * Big (Double_Uns (D (J))) + + Big_2xxSingle * Big (Double_Uns (D (J + 1)))); + pragma Assert (Big (D (J) & D (J + 1)) * Big_2xxSingle + = Big3 (D (J), D (J + 1), 0)); + pragma Assert ((Big (D (J) & D (J + 1)) + 1) * Big_2xxSingle + = Big3 (D (J), D (J + 1), 0) + Big_2xxSingle); Lemma_Gt_Mult (Big (Zu), Big (D (J) & D (J + 1)) + 1, Big_2xxSingle, Big3 (D (J), D (J + 1), D (J + 2))); @@ -2564,6 +2766,8 @@ is pragma Loop_Invariant (Qd (J)'Initialized); pragma Loop_Invariant (Big3 (S1, S2, S3) = Big (Double_Uns (Qd (J))) * Big (Zu)); + pragma Loop_Invariant + (Big3 (S1, S2, S3) > Big3 (D (J), D (J + 1), D (J + 2))); pragma Assert (Big3 (S1, S2, S3) > 0); if Qd (J) = 0 then pragma Assert (Big3 (S1, S2, S3) = 0); @@ -2579,6 +2783,9 @@ is (Big3 (S1, S2, S3) > Big3 (D (J), D (J + 1), D (J + 2)) - Big (Zu)); Lemma_Subtract_Commutation (Double_Uns (Qd (J)), 1); + pragma Assert (Double_Uns (Qd (J)) - Double_Uns'(1) + = Double_Uns (Qd (J) - 1)); + pragma Assert (Big (Double_Uns'(1)) = 1); Lemma_Substitution (Big3 (S1, S2, S3), Big (Zu), Big (Double_Uns (Qd (J))) - 1, Big (Double_Uns (Qd (J) - 1)), 0); @@ -2607,8 +2814,7 @@ is pragma Assert (Big3 (D (J), D (J + 1), D (J + 2)) < Big (Zu)); if D (J) > 0 then - pragma Assert - (Big_2xxSingle * Big_2xxSingle = Big_2xxDouble); + Lemma_Double_Big_2xxSingle; pragma Assert (Big3 (D (J), D (J + 1), D (J + 2)) = Big_2xxSingle * Big_2xxSingle * Big (Double_Uns (D (J))) @@ -2618,9 +2824,22 @@ is Big_2xxDouble * Big (Double_Uns (D (J))) + Big_2xxSingle * Big (Double_Uns (D (J + 1))) + Big (Double_Uns (D (J + 2)))); + pragma Assert (Big_2xxSingle >= 0); + pragma Assert (Big (Double_Uns (D (J + 1))) >= 0); + pragma Assert + (Big_2xxSingle * Big (Double_Uns (D (J + 1))) >= 0); + pragma Assert + (Big_2xxSingle * Big (Double_Uns (D (J + 1))) + + Big (Double_Uns (D (J + 2))) >= 0); pragma Assert (Big3 (D (J), D (J + 1), D (J + 2)) >= Big_2xxDouble * Big (Double_Uns (D (J)))); Lemma_Ge_Commutation (Double_Uns (D (J)), Double_Uns'(1)); + Lemma_Ge_Mult (Big (Double_Uns (D (J))), + Big (Double_Uns'(1)), + Big_2xxDouble, + Big (Double_Uns'(1)) * Big_2xxDouble); + pragma Assert + (Big_2xxDouble * Big (Double_Uns'(1)) = Big_2xxDouble); pragma Assert (Big3 (D (J), D (J + 1), D (J + 2)) >= Big_2xxDouble); pragma Assert (False); @@ -2986,6 +3205,7 @@ is begin pragma Assert (Ru = Double_Uns (X) - Double_Uns (Y)); if Ru < 2 ** (Double_Size - 1) then -- R >= 0 + pragma Assert (To_Uns (Y) <= To_Uns (X)); Lemma_Subtract_Double_Uns (X => Y, Y => X); pragma Assert (Ru = Double_Uns (X - Y)); diff --git a/gcc/ada/libgnat/s-dourea.adb b/gcc/ada/libgnat/s-dourea.adb index a6cf2a1..4f378d6 100644 --- a/gcc/ada/libgnat/s-dourea.adb +++ b/gcc/ada/libgnat/s-dourea.adb @@ -178,6 +178,12 @@ package body System.Double_Real is P, R : Double_T; begin + if Is_Infinity (B) or else Is_Zero (B) then + return (A.Hi / B, 0.0); + end if; + pragma Annotate (CodePeer, Intentional, "test always false", + "code deals with infinity"); + Q1 := A.Hi / B; -- Compute R = A - B * Q1 @@ -196,6 +202,12 @@ package body System.Double_Real is R, S : Double_T; begin + if Is_Infinity (B.Hi) or else Is_Zero (B.Hi) then + return (A.Hi / B.Hi, 0.0); + end if; + pragma Annotate (CodePeer, Intentional, "test always false", + "code deals with infinity"); + Q1 := A.Hi / B.Hi; R := A - B * Q1; diff --git a/gcc/ada/libgnat/s-dwalin.adb b/gcc/ada/libgnat/s-dwalin.adb index aff552c..5a0a2f6 100644 --- a/gcc/ada/libgnat/s-dwalin.adb +++ b/gcc/ada/libgnat/s-dwalin.adb @@ -44,8 +44,6 @@ with System.Storage_Elements; use System.Storage_Elements; package body System.Dwarf_Lines is - SSU : constant := System.Storage_Unit; - function Get_Load_Displacement (C : Dwarf_Context) return Storage_Offset; -- Return the displacement between the load address present in the binary -- and the run-time address at which it is loaded (i.e. non-zero for PIE). @@ -76,14 +74,16 @@ package body System.Dwarf_Lines is -- Read an entry format array, as specified by 6.2.4.1 procedure Read_Aranges_Entry - (C : in out Dwarf_Context; - Start : out Address; - Len : out Storage_Count); + (C : in out Dwarf_Context; + Addr_Size : Natural; + Start : out Address; + Len : out Storage_Count); -- Read a single .debug_aranges pair procedure Read_Aranges_Header (C : in out Dwarf_Context; Info_Offset : out Offset; + Addr_Size : out Natural; Success : out Boolean); -- Read .debug_aranges header @@ -1069,12 +1069,13 @@ package body System.Dwarf_Lines is Info_Offset : out Offset; Success : out Boolean) is + Addr_Size : Natural; begin Info_Offset := 0; Seek (C.Aranges, 0); while Tell (C.Aranges) < Length (C.Aranges) loop - Read_Aranges_Header (C, Info_Offset, Success); + Read_Aranges_Header (C, Info_Offset, Addr_Size, Success); exit when not Success; loop @@ -1082,7 +1083,7 @@ package body System.Dwarf_Lines is Start : Address; Len : Storage_Count; begin - Read_Aranges_Entry (C, Start, Len); + Read_Aranges_Entry (C, Addr_Size, Start, Len); exit when Start = 0 and Len = 0; if Addr >= Start and then Addr < Start + Len @@ -1280,9 +1281,6 @@ package body System.Dwarf_Lines is Unit_Type := Read (C.Info); Addr_Sz := Read (C.Info); - if Addr_Sz /= (Address'Size / SSU) then - return; - end if; Read_Section_Offset (C.Info, Abbrev_Offset, Is64); @@ -1290,9 +1288,6 @@ package body System.Dwarf_Lines is Read_Section_Offset (C.Info, Abbrev_Offset, Is64); Addr_Sz := Read (C.Info); - if Addr_Sz /= (Address'Size / SSU) then - return; - end if; else return; @@ -1354,6 +1349,7 @@ package body System.Dwarf_Lines is procedure Read_Aranges_Header (C : in out Dwarf_Context; Info_Offset : out Offset; + Addr_Size : out Natural; Success : out Boolean) is Unit_Length : Offset; @@ -1364,6 +1360,7 @@ package body System.Dwarf_Lines is begin Success := False; Info_Offset := 0; + Addr_Size := 0; Read_Initial_Length (C.Aranges, Unit_Length, Is64); @@ -1376,10 +1373,7 @@ package body System.Dwarf_Lines is -- Read address_size (ubyte) - Sz := Read (C.Aranges); - if Sz /= (Address'Size / SSU) then - return; - end if; + Addr_Size := Natural (uint8'(Read (C.Aranges))); -- Read segment_size (ubyte) @@ -1392,7 +1386,7 @@ package body System.Dwarf_Lines is declare Cur_Off : constant Offset := Tell (C.Aranges); - Align : constant Offset := 2 * Address'Size / SSU; + Align : constant Offset := 2 * Offset (Addr_Size); Space : constant Offset := Cur_Off mod Align; begin if Space /= 0 then @@ -1408,14 +1402,15 @@ package body System.Dwarf_Lines is ------------------------ procedure Read_Aranges_Entry - (C : in out Dwarf_Context; - Start : out Address; - Len : out Storage_Count) + (C : in out Dwarf_Context; + Addr_Size : Natural; + Start : out Address; + Len : out Storage_Count) is begin -- Read table - if Address'Size = 32 then + if Addr_Size = 4 then declare S, L : uint32; begin @@ -1425,7 +1420,7 @@ package body System.Dwarf_Lines is Len := Storage_Count (L); end; - elsif Address'Size = 64 then + elsif Addr_Size = 8 then declare S, L : uint64; begin @@ -1520,6 +1515,7 @@ package body System.Dwarf_Lines is declare Info_Offset : Offset; Line_Offset : Offset; + Addr_Size : Natural; Success : Boolean; Ar_Start : Address; Ar_Len : Storage_Count; @@ -1531,7 +1527,7 @@ package body System.Dwarf_Lines is Seek (C.Aranges, 0); while Tell (C.Aranges) < Length (C.Aranges) loop - Read_Aranges_Header (C, Info_Offset, Success); + Read_Aranges_Header (C, Info_Offset, Addr_Size, Success); exit when not Success; Debug_Info_Lookup (C, Info_Offset, Line_Offset, Success); @@ -1540,7 +1536,7 @@ package body System.Dwarf_Lines is -- Read table loop - Read_Aranges_Entry (C, Ar_Start, Ar_Len); + Read_Aranges_Entry (C, Addr_Size, Ar_Start, Ar_Len); exit when Ar_Start = Null_Address and Ar_Len = 0; Len := uint32 (Ar_Len); diff --git a/gcc/ada/libgnat/s-imagei.adb b/gcc/ada/libgnat/s-imagei.adb index f340d13..ff853d3 100644 --- a/gcc/ada/libgnat/s-imagei.adb +++ b/gcc/ada/libgnat/s-imagei.adb @@ -388,6 +388,8 @@ package body System.Image_I is Prove_Uns_Of_Non_Positive_Value; pragma Assert (Uns_Value rem 10 = Uns_Of_Non_Positive (Value rem 10)); pragma Assert (Uns_Value rem 10 = Uns (-(Value rem 10))); + pragma Assert + (Uns_Value = From_Big (Big (Uns_T) / Big_10 ** (Nb_Digits - J))); Prev_Value := Uns_Value; Prev_S := S; diff --git a/gcc/ada/libgnat/s-imageu.adb b/gcc/ada/libgnat/s-imageu.adb index d6d9d46..6932487 100644 --- a/gcc/ada/libgnat/s-imageu.adb +++ b/gcc/ada/libgnat/s-imageu.adb @@ -390,16 +390,9 @@ package body System.Image_U is Acc => Value) = Wrap_Option (V)); end loop; + pragma Assert (Value = 0); Prove_Unchanged; - pragma Assert - (Scan_Based_Number_Ghost - (Str => S, - From => P + 1, - To => P + Nb_Digits, - Base => 10, - Acc => Value) - = Wrap_Option (V)); P := P + Nb_Digits; end Set_Image_Unsigned; diff --git a/gcc/ada/libgnat/s-imgboo.adb b/gcc/ada/libgnat/s-imgboo.adb index 221c0c6..eb2cc96 100644 --- a/gcc/ada/libgnat/s-imgboo.adb +++ b/gcc/ada/libgnat/s-imgboo.adb @@ -37,6 +37,8 @@ pragma Assertion_Policy (Ghost => Ignore, Loop_Invariant => Ignore, Assert => Ignore); +with System.Val_Util; + package body System.Img_Bool with SPARK_Mode is @@ -55,9 +57,13 @@ is if V then S (1 .. 4) := "TRUE"; P := 4; + pragma Assert + (System.Val_Util.First_Non_Space_Ghost (S, S'First, S'Last) = 1); else S (1 .. 5) := "FALSE"; P := 5; + pragma Assert + (System.Val_Util.First_Non_Space_Ghost (S, S'First, S'Last) = 1); end if; end Image_Boolean; diff --git a/gcc/ada/libgnat/s-objrea.adb b/gcc/ada/libgnat/s-objrea.adb index 854bbb2..843ccf5 100644 --- a/gcc/ada/libgnat/s-objrea.adb +++ b/gcc/ada/libgnat/s-objrea.adb @@ -979,7 +979,7 @@ package body System.Object_Reader is -- Map section table - Opt_Stream := Create_Stream (Res.Mf, Signature_Loc_Offset, 4); + Opt_Stream := Create_Stream (Res.MF, Signature_Loc_Offset, 4); Hdr_Offset := Offset (uint32'(Read (Opt_Stream))); Close (Opt_Stream); Res.Sectab_Stream := Create_Stream @@ -999,7 +999,7 @@ package body System.Object_Reader is Opt_32 : Optional_Header_PE32; begin Opt_Stream := Create_Stream - (Res.Mf, Opt_Offset, Opt_32'Size / SSU); + (Res.MF, Opt_Offset, Opt_32'Size / SSU); Read_Raw (Opt_Stream, Opt_32'Address, uint32 (Opt_32'Size / SSU)); Res.ImageBase := uint64 (Opt_32.ImageBase); @@ -1011,7 +1011,7 @@ package body System.Object_Reader is Opt_64 : Optional_Header_PE64; begin Opt_Stream := Create_Stream - (Res.Mf, Opt_Offset, Opt_64'Size / SSU); + (Res.MF, Opt_Offset, Opt_64'Size / SSU); Read_Raw (Opt_Stream, Opt_64'Address, uint32 (Opt_64'Size / SSU)); Res.ImageBase := Opt_64.ImageBase; @@ -1367,7 +1367,7 @@ package body System.Object_Reader is Strtab_Sz : uint32; begin - Res.Mf := F; + Res.MF := F; Res.In_Exception := In_Exception; Res.Arch := PPC; @@ -1515,14 +1515,14 @@ package body System.Object_Reader is end Arch; function Create_Stream - (Mf : Mapped_File; + (MF : Mapped_File; File_Offset : File_Size; File_Length : File_Size) return Mapped_Stream is Region : Mapped_Region; begin - Read (Mf, Region, File_Offset, File_Length, False); + Read (MF, Region, File_Offset, File_Length, False); return (Region, 0, Offset (File_Length)); end Create_Stream; @@ -1531,7 +1531,7 @@ package body System.Object_Reader is Sec : Object_Section) return Mapped_Stream is begin - return Create_Stream (Obj.Mf, File_Size (Sec.Off), File_Size (Sec.Size)); + return Create_Stream (Obj.MF, File_Size (Sec.Off), File_Size (Sec.Size)); end Create_Stream; procedure Tell (Obj : in out Mapped_Stream; Off : out Offset) is @@ -1573,7 +1573,7 @@ package body System.Object_Reader is null; end case; - Close (Obj.Mf); + Close (Obj.MF); end Close; ------------------------ diff --git a/gcc/ada/libgnat/s-objrea.ads b/gcc/ada/libgnat/s-objrea.ads index fc440ff..ee72114 100644 --- a/gcc/ada/libgnat/s-objrea.ads +++ b/gcc/ada/libgnat/s-objrea.ads @@ -187,7 +187,7 @@ package System.Object_Reader is type Mapped_Stream is private; -- Provide an abstraction of a stream on a memory mapped file - function Create_Stream (Mf : System.Mmap.Mapped_File; + function Create_Stream (MF : System.Mmap.Mapped_File; File_Offset : System.Mmap.File_Size; File_Length : System.Mmap.File_Size) return Mapped_Stream; @@ -381,7 +381,7 @@ private subtype Any_PECOFF is Object_Format range PECOFF .. PECOFF_PLUS; type Object_File (Format : Object_Format) is record - Mf : System.Mmap.Mapped_File := System.Mmap.Invalid_Mapped_File; + MF : System.Mmap.Mapped_File := System.Mmap.Invalid_Mapped_File; Arch : Object_Arch := Unknown; Num_Sections : uint32 := 0; diff --git a/gcc/ada/libgnat/s-retsta.ads b/gcc/ada/libgnat/s-retsta.ads new file mode 100644 index 0000000..8340341 --- /dev/null +++ b/gcc/ada/libgnat/s-retsta.ads @@ -0,0 +1,57 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S Y S T E M . R E T U R N _ S T A C K -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2022, 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 small package provides direct access to the return stack of the code +-- generator for functions returning a by-reference type. This return stack +-- is the portion of the primary stack that has been allocated by callers of +-- the functions and onto which the functions put the result before returning. + +with System.Storage_Elements; + +package System.Return_Stack is + pragma Preelaborate; + + package SSE renames System.Storage_Elements; + + procedure RS_Allocate + (Addr : out Address; + Storage_Size : SSE.Storage_Count); + pragma Import (Intrinsic, RS_Allocate, "__builtin_return_slot"); + -- Allocate enough space on the return stack of the invoking task to + -- accommodate a return of size Storage_Size. Return the address of the + -- first byte of the allocation in Addr. + +private + RS_Pool : Integer; + -- Unused entity that is just present to ease the sharing of the pool + -- mechanism for specific allocation/deallocation in the compiler. + +end System.Return_Stack; diff --git a/gcc/ada/libgnat/s-secsta.adb b/gcc/ada/libgnat/s-secsta.adb index c2ab922..ac929c0 100644 --- a/gcc/ada/libgnat/s-secsta.adb +++ b/gcc/ada/libgnat/s-secsta.adb @@ -53,7 +53,7 @@ package body System.Secondary_Stack is -- in order to avoid depending on the binder. Their values are set by the -- binder. - Binder_SS_Count : Natural; + Binder_SS_Count : Natural := 0; pragma Export (Ada, Binder_SS_Count, "__gnat_binder_ss_count"); -- The number of secondary stacks in the pool created by the binder diff --git a/gcc/ada/libgnat/s-valuer.adb b/gcc/ada/libgnat/s-valuer.adb index 4b4e887..b474f84 100644 --- a/gcc/ada/libgnat/s-valuer.adb +++ b/gcc/ada/libgnat/s-valuer.adb @@ -645,7 +645,14 @@ package body System.Value_R is Ptr.all := Index; Scan_Exponent (Str, Ptr, Max, Expon, Real => True); - Scale := Scale + Expon; + + -- Handle very large exponents like Scan_Exponent + + if Expon < Integer'First / 10 or else Expon > Integer'Last / 10 then + Scale := Expon; + else + Scale := Scale + Expon; + end if; -- Here is where we check for a bad based number diff --git a/gcc/ada/libgnat/s-valueu.adb b/gcc/ada/libgnat/s-valueu.adb index 461d957..f5a6881 100644 --- a/gcc/ada/libgnat/s-valueu.adb +++ b/gcc/ada/libgnat/s-valueu.adb @@ -522,6 +522,9 @@ package body System.Value_U is Uval := Base; Base := 10; pragma Assert (Ptr.all = Last_Num_Init + 1); + pragma Assert + (if Starts_As_Based then P = Last_Num_Based + 1); + pragma Assert (not Is_Based); pragma Assert (if not Overflow then Uval = Init_Val.Value); exit; end if; @@ -569,10 +572,6 @@ package body System.Value_U is end if; end if; - Lemma_Scan_Digit - (Str, P, Last_Num_Based, Digit, Base, Old_Uval, Uval, - Based_Val, Old_Overflow, Overflow); - -- If at end of string with no base char, not a based number -- but we signal Constraint_Error and set the pointer past -- the end of the field, since this is what the ACVC tests @@ -580,6 +579,10 @@ package body System.Value_U is P := P + 1; + Lemma_Scan_Digit + (Str, P - 1, Last_Num_Based, Digit, Base, Old_Uval, Uval, + Based_Val, Old_Overflow, Overflow); + if P > Max then Ptr.all := P; Bad_Value (Str); @@ -590,6 +593,7 @@ package body System.Value_U is if Str (P) = Base_Char then Ptr.all := P + 1; pragma Assert (Ptr.all = Last_Num_Based + 2); + pragma Assert (Is_Based); pragma Assert (if not Overflow then Based_Val = Scan_Based_Number_Ghost @@ -645,6 +649,7 @@ package body System.Value_U is Scan_Exponent (Str, Ptr, Max, Expon); + pragma Assert (Ptr.all = Raw_Unsigned_Last_Ghost (Str, Ptr_Old, Max)); pragma Assert (if Starts_As_Exponent_Format_Ghost (Str (First_Exp .. Max)) then Expon = Scan_Exponent_Ghost (Str (First_Exp .. Max))); diff --git a/gcc/ada/libgnat/system-qnx-aarch64.ads b/gcc/ada/libgnat/system-qnx-arm.ads index 7e61ae3..5f4b90e 100644 --- a/gcc/ada/libgnat/system-qnx-aarch64.ads +++ b/gcc/ada/libgnat/system-qnx-arm.ads @@ -5,7 +5,7 @@ -- S Y S T E M -- -- -- -- S p e c -- --- (QNX/Aarch64 Version) -- +-- (QNX-ARM/AARCH64 Version) -- -- -- -- Copyright (C) 1992-2022, Free Software Foundation, Inc. -- -- -- diff --git a/gcc/ada/locales.c b/gcc/ada/locales.c index ee1385a..01cb45b 100644 --- a/gcc/ada/locales.c +++ b/gcc/ada/locales.c @@ -35,6 +35,8 @@ #include <ctype.h> #include <stddef.h> +#define ARRAY_SIZE(a) (sizeof (a) / sizeof ((a)[0])) + typedef char char4 [4]; /* Table containing equivalences between ISO_639_1 codes and their ISO_639_3 @@ -649,7 +651,7 @@ str_get_last_byte (char *lc_all) { static char* iso_639_1_to_639_3(char* iso_639_1_code) { - int len = sizeof(iso_639)/sizeof(iso_639[0]); + int len = ARRAY_SIZE (iso_639); char **p = iso_639; int j; @@ -673,7 +675,7 @@ iso_639_1_to_639_3(char* iso_639_1_code) { static char* language_name_to_639_3(char* name) { - int len = sizeof(iso_639)/sizeof(iso_639[0]); + int len = ARRAY_SIZE (iso_639); char **p = iso_639; int j; @@ -695,7 +697,7 @@ language_name_to_639_3(char* name) { static char* country_name_to_3166 (char* name) { - int len = sizeof(iso_3166)/sizeof(iso_3166[0]); + int len = ARRAY_SIZE (iso_3166); char **p = iso_3166; int j; diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index e747397..2ce24ee 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -202,7 +202,7 @@ package Opt is -- values. Back_End_Handles_Limited_Types : Boolean; - -- This flag is set true if the back end can properly handle limited or + -- This flag is set True if the back end can properly handle limited or -- other by reference types, and avoid copies. If this flag is False, then -- the front end does special expansion for if/case expressions to make -- sure that no copy occurs. If the flag is True, then the expansion for @@ -214,12 +214,20 @@ package Opt is Back_End_Inlining : Boolean := False; -- GNAT -- Set True to activate inlining by back-end expansion. This is the normal - -- default mode for gcc targets, so it is True on such targets unless the + -- default mode for GCC targets, so it is True on such targets unless the -- switches -gnatN or -gnatd.z are used. See circuitry in gnat1drv for the -- exact conditions for setting this switch. -- WARNING: There is a matching C declaration of this variable in fe.h + Back_End_Return_Slot : Boolean := True; + -- GNAT + -- This flag is set True if the return slot of the back end for functions + -- returning a by-reference type can be accessed by means of an intrinsic + -- function callable in the body of these functions. This is the normal + -- default mode for GCC targets, so it is True on such targets unless the + -- switch -gnatd_r is used. + Bind_Alternate_Main_Name : Boolean := False; -- GNATBIND -- True if main should be called Alternate_Main_Name.all. @@ -585,16 +593,11 @@ 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 := Back_End_SJLJ; -- GNAT -- Set to the appropriate value depending on the flags in system.ads - -- (ZCX_By_Default). The C convention is there to allow access by gigi. - - -- WARNING: There is a matching C declaration of this variable in fe.h + -- (ZCX_By_Default). function ZCX_Exceptions return Boolean; function SJLJ_Exceptions return Boolean; diff --git a/gcc/ada/output.adb b/gcc/ada/output.adb index bdb2a44..33d027d 100644 --- a/gcc/ada/output.adb +++ b/gcc/ada/output.adb @@ -235,6 +235,7 @@ package body Output is procedure Pop_Output is begin + Flush_Buffer; pragma Assert (FD_Stack_Idx >= FD_Array'First); Current_FD := FD_Stack (FD_Stack_Idx); FD_Stack_Idx := FD_Stack_Idx - 1; @@ -292,10 +293,7 @@ package body Output is procedure Set_Output (FD : File_Descriptor) is begin - if Special_Output_Proc = null then - Flush_Buffer; - end if; - + Flush_Buffer; Current_FD := FD; end Set_Output; @@ -323,59 +321,99 @@ package body Output is procedure w (C : Character) is begin + Push_Output; + Set_Standard_Error; + Write_Char ('''); Write_Char (C); Write_Char ('''); Write_Eol; + + Pop_Output; end w; procedure w (S : String) is begin + Push_Output; + Set_Standard_Error; + Write_Str (S); Write_Eol; + + Pop_Output; end w; procedure w (V : Int) is begin + Push_Output; + Set_Standard_Error; + Write_Int (V); Write_Eol; + + Pop_Output; end w; procedure w (B : Boolean) is begin + Push_Output; + Set_Standard_Error; + if B then w ("True"); else w ("False"); end if; + + Pop_Output; end w; procedure w (L : String; C : Character) is begin + Push_Output; + Set_Standard_Error; + Write_Str (L); Write_Char (' '); w (C); + + Pop_Output; end w; procedure w (L : String; S : String) is begin + Push_Output; + Set_Standard_Error; + Write_Str (L); Write_Char (' '); w (S); + + Pop_Output; end w; procedure w (L : String; V : Int) is begin + Push_Output; + Set_Standard_Error; + Write_Str (L); Write_Char (' '); w (V); + + Pop_Output; end w; procedure w (L : String; B : Boolean) is begin + Push_Output; + Set_Standard_Error; + Write_Str (L); Write_Char (' '); w (B); + + Pop_Output; end w; ---------------- diff --git a/gcc/ada/par-ch11.adb b/gcc/ada/par-ch11.adb index cc10ba7..158050a 100644 --- a/gcc/ada/par-ch11.adb +++ b/gcc/ada/par-ch11.adb @@ -234,7 +234,7 @@ package body Ch11 is end if; if Token = Tok_When then - Error_Msg_GNAT_Extension ("raise when statement"); + Error_Msg_GNAT_Extension ("raise when statement", Token_Ptr); Mutate_Nkind (Raise_Node, N_Raise_When_Statement); diff --git a/gcc/ada/par-ch12.adb b/gcc/ada/par-ch12.adb index 991e93f..fc76ad4 100644 --- a/gcc/ada/par-ch12.adb +++ b/gcc/ada/par-ch12.adb @@ -1225,7 +1225,7 @@ package body Ch12 is elsif Token = Tok_Left_Paren then Error_Msg_GNAT_Extension - ("expression default for formal subprograms"); + ("expression default for formal subprograms", Token_Ptr); if Nkind (Spec_Node) = N_Function_Specification then Scan; -- past "(" diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index 08ffd7b..2359b8c 100644 --- a/gcc/ada/par-ch3.adb +++ b/gcc/ada/par-ch3.adb @@ -2788,7 +2788,7 @@ package body Ch3 is else P_Index_Subtype_Def_With_Fixed_Lower_Bound (Subtype_Mark_Node); - Error_Msg_GNAT_Extension ("fixed-lower-bound array"); + Error_Msg_GNAT_Extension ("fixed-lower-bound array", Token_Ptr); end if; exit when Token = Tok_Right_Paren or else Token = Tok_Of; @@ -2857,7 +2857,8 @@ package body Ch3 is P_Index_Subtype_Def_With_Fixed_Lower_Bound (Subtype_Mark_Node); - Error_Msg_GNAT_Extension ("fixed-lower-bound array"); + Error_Msg_GNAT_Extension + ("fixed-lower-bound array", Token_Ptr); end if; exit when Token = Tok_Right_Paren or else Token = Tok_Of; @@ -3359,7 +3360,7 @@ package body Ch3 is -- later during analysis), and scan to the next token. if Token = Tok_Box then - Error_Msg_GNAT_Extension ("fixed-lower-bound array"); + Error_Msg_GNAT_Extension ("fixed-lower-bound array", Token_Ptr); Expr_Node := Empty; Scan; @@ -4205,7 +4206,15 @@ package body Ch3 is -- second null exclusion is present in the access type definition. Not_Null_Present := P_Null_Exclusion; -- Ada 2005 (AI-231) + + if Token /= Tok_Access then + Error_Msg + ("ACCESS expected", + Token_Ptr); + end if; + Scan; -- past ACCESS + Not_Null_Subtype_Loc := Token_Ptr; Not_Null_Subtype := P_Null_Exclusion; -- Might also appear end if; diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb index 0895be1..4ab4dcb 100644 --- a/gcc/ada/par-ch4.adb +++ b/gcc/ada/par-ch4.adb @@ -1405,6 +1405,7 @@ package body Ch4 is Scan; -- past ] Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc); Set_Expressions (Aggregate_Node, New_List); + Set_Component_Associations (Aggregate_Node, New_List); Set_Is_Homogeneous_Aggregate (Aggregate_Node); return Aggregate_Node; end if; @@ -1682,6 +1683,7 @@ package body Ch4 is case Start_Token is when Tok_Left_Bracket => + Set_Component_Associations (Aggregate_Node, Assoc_List); Set_Is_Homogeneous_Aggregate (Aggregate_Node); T_Right_Bracket; @@ -1782,9 +1784,8 @@ package body Ch4 is Box_With_Identifier_Present := True; Scan; -- past ">" else - Error_Msg - ("Identifier within box only supported under -gnatX", - Token_Ptr); + Error_Msg_GNAT_Extension + ("identifier within box", Token_Ptr); Box_Present := True; -- Avoid cascading errors by ignoring the identifier end if; @@ -1815,10 +1816,8 @@ package body Ch4 is Id := P_Defining_Identifier; if not Extensions_Allowed then - Error_Msg - ("IS following component association" - & " only supported under -gnatX", - Token_Ptr); + Error_Msg_GNAT_Extension + ("IS following component association", Token_Ptr); elsif Box_With_Identifier_Present then Error_Msg ("Both identifier-in-box and trailing identifier" diff --git a/gcc/ada/par-ch5.adb b/gcc/ada/par-ch5.adb index 91f2442..0421bd5 100644 --- a/gcc/ada/par-ch5.adb +++ b/gcc/ada/par-ch5.adb @@ -1975,7 +1975,7 @@ package body Ch5 is Append_Elmt (Goto_Node, Goto_List); if Token = Tok_When then - Error_Msg_GNAT_Extension ("goto when statement"); + Error_Msg_GNAT_Extension ("goto when statement", Token_Ptr); Scan; -- past WHEN Mutate_Nkind (Goto_Node, N_Goto_When_Statement); diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb index d972ead..2832fd4 100644 --- a/gcc/ada/par-ch6.adb +++ b/gcc/ada/par-ch6.adb @@ -1999,7 +1999,7 @@ package body Ch6 is -- at a Return_when_statement if Token = Tok_When and then not Missing_Semicolon_On_When then - Error_Msg_GNAT_Extension ("return when statement"); + Error_Msg_GNAT_Extension ("return when statement", Token_Ptr); Mutate_Nkind (Ret_Node, N_Return_When_Statement); Scan; -- past WHEN @@ -2008,7 +2008,7 @@ package body Ch6 is -- Allow IF instead of WHEN, giving error message elsif Token = Tok_If then - Error_Msg_GNAT_Extension ("return when statement"); + Error_Msg_GNAT_Extension ("return when statement", Token_Ptr); Mutate_Nkind (Ret_Node, N_Return_When_Statement); T_When; diff --git a/gcc/ada/raise-gcc.c b/gcc/ada/raise-gcc.c index 801edb6..f4c42c0 100644 --- a/gcc/ada/raise-gcc.c +++ b/gcc/ada/raise-gcc.c @@ -78,7 +78,7 @@ (SJLJ or DWARF). We need a consistently named interface to import from a-except, so wrappers are defined here. */ -#ifdef __CYGWIN__ +#if defined (__CYGWIN__) || (defined(__SEH__) && defined(STANDALONE)) /* Prevent compile error due to unwind-generic.h including <windows.h>, see comment above #include <windows.h> in mingw32.h. */ #include "mingw32.h" diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 8c831f0..280e2bd 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -428,6 +428,7 @@ package Rtsfind is System_Put_Images, System_Put_Task_Images, System_Relative_Delays, + System_Return_Stack, System_RPC, System_Scalar_Values, System_Secondary_Stack, @@ -1843,6 +1844,9 @@ package Rtsfind is RO_RD_Delay_For, -- System.Relative_Delays + RE_RS_Allocate, -- System.Return_Stack + RE_RS_Pool, -- System.Return_Stack + RE_IS_Is1, -- System.Scalar_Values RE_IS_Is2, -- System.Scalar_Values RE_IS_Is4, -- System.Scalar_Values @@ -3535,6 +3539,9 @@ package Rtsfind is RO_RD_Delay_For => System_Relative_Delays, + RE_RS_Allocate => System_Return_Stack, + RE_RS_Pool => System_Return_Stack, + RE_Do_Apc => System_RPC, RE_Do_Rpc => System_RPC, RE_Params_Stream_Type => System_RPC, @@ -4021,6 +4028,7 @@ package Rtsfind is System_Fat_LLF => True, System_Fat_SFlt => True, System_Machine_Code => True, + System_Return_Stack => True, System_Secondary_Stack => True, System_Storage_Elements => True, System_Task_Info => True, diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 0437a50..b85f766 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -51,7 +51,6 @@ with Sem_Aux; use Sem_Aux; with Sem_Case; use Sem_Case; with Sem_Cat; use Sem_Cat; with Sem_Ch3; use Sem_Ch3; -with Sem_Ch5; use Sem_Ch5; with Sem_Ch8; use Sem_Ch8; with Sem_Ch13; use Sem_Ch13; with Sem_Dim; use Sem_Dim; @@ -405,11 +404,25 @@ package body Sem_Aggr is -- The bounds of the aggregate itype are cooked up to look reasonable -- (in this particular case the bounds will be 1 .. 2). + function Is_Null_Aggregate (N : Node_Id) return Boolean; + -- Returns True for a "[]" aggregate (an Ada 2022 feature), even after + -- it has been transformed by expansion. Returns False otherwise. + procedure Make_String_Into_Aggregate (N : Node_Id); -- A string literal can appear in a context in which a one dimensional -- array of characters is expected. This procedure simply rewrites the -- string as an aggregate, prior to resolution. + function Resolve_Null_Array_Aggregate (N : Node_Id) return Boolean; + -- For the Ada 2022 construct, build a subtype with a null range for each + -- dimension, using the bounds from the context subtype (if the subtype + -- is constrained). If the subtype is unconstrained, then the bounds + -- are determined in much the same way as the bounds for a null string + -- literal with no applicable index constraint. + -- Emit a check that the bounds for each dimension define a null + -- range; no check is emitted if it is statically known that the + -- check would succeed. + --------------------------------- -- Delta aggregate processing -- --------------------------------- @@ -755,6 +768,34 @@ package body Sem_Aggr is and then No (Next (First (Choice_List (First (Assoc))))); end Is_Single_Aggregate; + ----------------------- + -- Is_Null_Aggregate -- + ----------------------- + + function Is_Null_Aggregate (N : Node_Id) return Boolean is + begin + return Ada_Version >= Ada_2022 + and then Is_Homogeneous_Aggregate (N) + and then Is_Empty_List (Expressions (N)) + and then Is_Empty_List (Component_Associations (N)); + end Is_Null_Aggregate; + + ---------------------------------------- + -- Is_Null_Array_Aggregate_High_Bound -- + ---------------------------------------- + + function Is_Null_Array_Aggregate_High_Bound (N : Node_Id) return Boolean is + Original_N : constant Node_Id := Original_Node (N); + begin + return Ada_Version >= Ada_2022 + and then not Comes_From_Source (Original_N) + and then Nkind (Original_N) = N_Attribute_Reference + and then + Get_Attribute_Id (Attribute_Name (Original_N)) = Attribute_Pred + and then Nkind (Parent (N)) in N_Range | N_Op_Le + and then not Comes_From_Source (Parent (N)); + end Is_Null_Array_Aggregate_High_Bound; + -------------------------------- -- Make_String_Into_Aggregate -- -------------------------------- @@ -984,13 +1025,14 @@ package body Sem_Aggr is Array_Aggregate : declare Aggr_Resolved : Boolean; - Aggr_Typ : constant Entity_Id := Etype (Typ); -- This is the unconstrained array type, which is the type against -- which the aggregate is to be resolved. Typ itself is the array -- type of the context which may not be the same subtype as the -- subtype for the final aggregate. + Is_Null_Aggr : constant Boolean := Is_Null_Aggregate (N); + begin -- In the following we determine whether an OTHERS choice is -- allowed inside the array aggregate. The test checks the context @@ -1022,7 +1064,11 @@ package body Sem_Aggr is Set_Etype (N, Aggr_Typ); -- May be overridden later on - if Nkind (Parent (N)) = N_Assignment_Statement + if Is_Null_Aggr then + Set_Etype (N, Typ); + Aggr_Resolved := Resolve_Null_Array_Aggregate (N); + + elsif Nkind (Parent (N)) = N_Assignment_Statement or else Inside_Init_Proc or else (Is_Constrained (Typ) and then Nkind (Parent (N)) in @@ -1075,6 +1121,9 @@ package body Sem_Aggr is Aggr_Subtyp := Any_Composite; + elsif Is_Null_Aggr then + Aggr_Subtyp := Etype (N); + else Aggr_Subtyp := Array_Aggr_Subtype (N, Typ); end if; @@ -2890,12 +2939,12 @@ package body Sem_Aggr is is Loc : constant Source_Ptr := Sloc (N); Choice : Node_Id; + Copy : Node_Id; Ent : Entity_Id; Expr : Node_Id; Key_Expr : Node_Id; Id : Entity_Id; Id_Name : Name_Id; - Iter : Node_Id; Typ : Entity_Id := Empty; begin @@ -2906,15 +2955,29 @@ package body Sem_Aggr is -- is present. In both cases a Key_Expression is present. if Nkind (Comp) = N_Iterated_Element_Association then + + -- Create a temporary scope to avoid some modifications from + -- escaping the Analyze call below. The original Tree will be + -- reanalyzed later. + + Ent := New_Internal_Entity + (E_Loop, Current_Scope, Sloc (Comp), 'L'); + Set_Etype (Ent, Standard_Void_Type); + Set_Parent (Ent, Parent (Comp)); + Push_Scope (Ent); + if Present (Loop_Parameter_Specification (Comp)) then - Analyze_Loop_Parameter_Specification - (Loop_Parameter_Specification (Comp)); + Copy := Copy_Separate_Tree (Comp); + + Analyze + (Loop_Parameter_Specification (Copy)); + Id_Name := Chars (Defining_Identifier (Loop_Parameter_Specification (Comp))); else - Iter := Copy_Separate_Tree (Iterator_Specification (Comp)); - Analyze (Iter); - Typ := Etype (Defining_Identifier (Iter)); + Copy := Copy_Separate_Tree (Iterator_Specification (Comp)); + Analyze (Copy); + Id_Name := Chars (Defining_Identifier (Iterator_Specification (Comp))); end if; @@ -2926,12 +2989,14 @@ package body Sem_Aggr is Key_Expr := Key_Expression (Comp); Analyze_And_Resolve (New_Copy_Tree (Key_Expr), Key_Type); + End_Scope; elsif Present (Iterator_Specification (Comp)) then - Iter := Copy_Separate_Tree (Iterator_Specification (Comp)); + Copy := Copy_Separate_Tree (Iterator_Specification (Comp)); Id_Name := Chars (Defining_Identifier (Comp)); - Analyze (Iter); - Typ := Etype (Defining_Identifier (Iter)); + + Analyze (Copy); + Typ := Etype (Defining_Identifier (Copy)); else Choice := First (Discrete_Choices (Comp)); @@ -2965,7 +3030,8 @@ package body Sem_Aggr is -- analysis. Id := Make_Defining_Identifier (Sloc (Comp), Id_Name); - Ent := New_Internal_Entity (E_Loop, Current_Scope, Sloc (Comp), 'L'); + Ent := New_Internal_Entity (E_Loop, + Current_Scope, Sloc (Comp), 'L'); Set_Etype (Ent, Standard_Void_Type); Set_Parent (Ent, Parent (Comp)); Push_Scope (Ent); @@ -3000,6 +3066,8 @@ package body Sem_Aggr is end Resolve_Iterated_Association; + -- Start of processing for Resolve_Container_Aggregate + begin pragma Assert (Nkind (Asp) = N_Aggregate); @@ -3121,8 +3189,12 @@ package body Sem_Aggr is end loop; end if; - if Present (Component_Associations (N)) then - if Present (Expressions (N)) then + if Present (Component_Associations (N)) + and then not Is_Empty_List (Component_Associations (N)) + then + if Present (Expressions (N)) + and then not Is_Empty_List (Expressions (N)) + then Error_Msg_N ("container aggregate cannot be " & "both positional and named", N); return; @@ -3273,6 +3345,15 @@ package body Sem_Aggr is if Is_Array_Type (Typ) then Resolve_Delta_Array_Aggregate (N, Typ); else + + -- Delta aggregates for record types must use parentheses, + -- not square brackets. + + if Is_Homogeneous_Aggregate (N) then + Error_Msg_N + ("delta aggregates for record types must use (), not '[']", N); + end if; + Resolve_Delta_Record_Aggregate (N, Typ); end if; @@ -3930,6 +4011,77 @@ package body Sem_Aggr is Check_Function_Writable_Actuals (N); end Resolve_Extension_Aggregate; + ---------------------------------- + -- Resolve_Null_Array_Aggregate -- + ---------------------------------- + + function Resolve_Null_Array_Aggregate (N : Node_Id) return Boolean is + -- Never returns False, but declared as a function to match + -- other Resolve_Mumble functions. + + Loc : constant Source_Ptr := Sloc (N); + Typ : constant Entity_Id := Etype (N); + + Check : Node_Id; + Decl : Node_Id; + Index : Node_Id; + Lo, Hi : Node_Id; + Constr : constant List_Id := New_List; + Subt : constant Entity_Id := Make_Temporary (Loc, 'S'); + + begin + -- Create a constrained subtype with null dimensions + + Index := First_Index (Typ); + while Present (Index) loop + Get_Index_Bounds (Index, L => Lo, H => Hi); + + -- The upper bound is the predecessor of the lower bound + + Hi := Make_Attribute_Reference + (Loc, + Prefix => New_Occurrence_Of (Etype (Index), Loc), + Attribute_Name => Name_Pred, + Expressions => New_List (New_Copy_Tree (Lo))); + + -- Check that high bound (i.e., low bound predecessor) exists. + -- Fail if low bound is low bound of base subtype (in all cases, + -- including modular). + + Check := + Make_If_Statement (Loc, + Condition => + Make_Op_Le (Loc, New_Copy_Tree (Lo), New_Copy_Tree (Hi)), + Then_Statements => + New_List (Make_Raise_Constraint_Error + (Loc, Reason => CE_Range_Check_Failed))); + + Insert_Action (N, Check); + + Append (Make_Range (Loc, Lo, Hi), Constr); + + Index := Next_Index (Index); + end loop; + + Decl := Make_Subtype_Declaration (Loc, + Defining_Identifier => Subt, + Subtype_Indication => + Make_Subtype_Indication (Loc, + Subtype_Mark => + New_Occurrence_Of (Base_Type (Typ), Loc), + Constraint => + Make_Index_Or_Discriminant_Constraint (Loc, Constr))); + + Insert_Action (N, Decl); + Set_Is_Internal (Subt); + Analyze (Decl); + Set_Etype (N, Subt); + Set_Compile_Time_Known_Aggregate (N); + Set_Aggregate_Bounds (N, New_Copy_Tree (First_Index (Etype (N)))); + + return True; + end Resolve_Null_Array_Aggregate; + ------------------------------ -- Resolve_Record_Aggregate -- ------------------------------ @@ -4898,7 +5050,7 @@ package body Sem_Aggr is if Nkind (N) = N_Aggregate and then Is_Homogeneous_Aggregate (N) then - Error_Msg_N ("record aggregate must use () and not '[']", N); + Error_Msg_N ("record aggregate must use (), not '[']", N); return; end if; diff --git a/gcc/ada/sem_aggr.ads b/gcc/ada/sem_aggr.ads index ee65210..75af8f7 100644 --- a/gcc/ada/sem_aggr.ads +++ b/gcc/ada/sem_aggr.ads @@ -43,4 +43,7 @@ package Sem_Aggr is -- WARNING: There is a matching C declaration of this subprogram in fe.h + function Is_Null_Array_Aggregate_High_Bound (N : Node_Id) return Boolean; + -- Returns True for the high bound of a null array aggregate. + end Sem_Aggr; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 55da9ef..7b05cdc 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -52,6 +52,7 @@ with Rident; use Rident; with Rtsfind; use Rtsfind; with Sdefault; with Sem; use Sem; +with Sem_Aggr; use Sem_Aggr; with Sem_Aux; use Sem_Aux; with Sem_Cat; use Sem_Cat; with Sem_Ch6; use Sem_Ch6; @@ -176,6 +177,7 @@ package body Sem_Attr is Attribute_22 : constant Attribute_Class_Array := Attribute_Class_Array'( Attribute_Enum_Rep | Attribute_Enum_Val => True, + Attribute_Index => True, Attribute_Preelaborable_Initialization => True, others => False); @@ -276,6 +278,15 @@ package body Sem_Attr is -- sets the type of the attribute to the one specified by Str_Typ (e.g. -- Standard_String for 'Image and Standard_Wide_String for 'Wide_Image). + procedure Analyze_Index_Attribute + (Legal : out Boolean; + Spec_Id : out Entity_Id); + -- Processing for attribute 'Index. It checks that the attribute appears + -- in a pre/postcondition-like aspect or pragma associated with an entry + -- family. Flag Legal is set when the above criteria are met. Spec_Id + -- denotes the entity of the wrapper of the entry family or Empty if + -- the attribute is illegal. + procedure Bad_Attribute_For_Predicate; -- Output error message for use of a predicate (First, Last, Range) not -- allowed with a type that has predicates. If the type is a generic @@ -504,7 +515,6 @@ package body Sem_Attr is begin if Is_Subprogram (Ent) then Set_Address_Taken (Ent); - Kill_Current_Values (Ent); -- An Address attribute is accepted when generated by the -- compiler for dispatching operation, and an error is @@ -1586,6 +1596,178 @@ package body Sem_Attr is end if; end Analyze_Image_Attribute; + ----------------------------- + -- Analyze_Index_Attribute -- + ----------------------------- + + procedure Analyze_Index_Attribute + (Legal : out Boolean; + Spec_Id : out Entity_Id) + is + procedure Check_Placement_In_Check (Prag : Node_Id); + -- Verify that the attribute appears within pragma Check that mimics + -- a postcondition. + + procedure Placement_Error; + pragma No_Return (Placement_Error); + -- Emit a general error when the attributes does not appear in a + -- precondition or postcondition aspect or pragma, and then raises + -- Bad_Attribute to avoid any further semantic processing. + + ------------------------------ + -- Check_Placement_In_Check -- + ------------------------------ + + procedure Check_Placement_In_Check (Prag : Node_Id) is + Args : constant List_Id := Pragma_Argument_Associations (Prag); + Nam : constant Name_Id := Chars (Get_Pragma_Arg (First (Args))); + + begin + -- The "Name" argument of pragma Check denotes a precondition or + -- postcondition. + + if Nam in Name_Post + | Name_Postcondition + | Name_Pre + | Name_Precondition + | Name_Refined_Post + then + null; + + -- Otherwise the placement of the attribute is illegal + + else + Placement_Error; + end if; + end Check_Placement_In_Check; + + --------------------- + -- Placement_Error -- + --------------------- + + procedure Placement_Error is + begin + Error_Attr + ("attribute % can only appear in pre- or postcondition", P); + end Placement_Error; + + -- Local variables + + Prag : Node_Id; + Prag_Nam : Name_Id; + Subp_Decl : Node_Id; + + -- Start of processing for Analyze_Index_Attribute + + begin + -- Assume that the attribute is illegal + + Legal := False; + Spec_Id := Empty; + + -- Skip processing during preanalysis of class-wide preconditions and + -- postconditions since at this stage the expression is not installed + -- yet on its definite context. + + if Inside_Class_Condition_Preanalysis then + Legal := True; + Spec_Id := Current_Scope; + return; + end if; + + -- Traverse the parent chain to find the aspect or pragma where the + -- attribute resides. + + Prag := N; + while Present (Prag) loop + if Nkind (Prag) in N_Aspect_Specification | N_Pragma then + exit; + + -- Prevent the search from going too far + + elsif Is_Body_Or_Package_Declaration (Prag) then + exit; + end if; + + Prag := Parent (Prag); + end loop; + + -- The attribute is allowed to appear only in precondition and + -- postcondition-like aspects or pragmas. + + if Nkind (Prag) in N_Aspect_Specification | N_Pragma then + if Nkind (Prag) = N_Aspect_Specification then + Prag_Nam := Chars (Identifier (Prag)); + else + Prag_Nam := Pragma_Name (Prag); + end if; + + if Prag_Nam = Name_Check then + Check_Placement_In_Check (Prag); + + elsif Prag_Nam in Name_Post + | Name_Postcondition + | Name_Pre + | Name_Precondition + | Name_Refined_Post + then + null; + + else + Placement_Error; + return; + end if; + + -- Otherwise the placement of the attribute is illegal + + else + Placement_Error; + return; + end if; + + -- Find the related subprogram subject to the aspect or pragma + + if Nkind (Prag) = N_Aspect_Specification then + Subp_Decl := Parent (Prag); + else + Subp_Decl := Find_Related_Declaration_Or_Body (Prag); + end if; + + -- The aspect or pragma where the attribute resides should be + -- associated with a subprogram declaration or a body since the + -- analysis of pre-/postconditions of entry and entry families is + -- performed in their wrapper subprogram. If this is not the case, + -- then the aspect or pragma is illegal and no further analysis is + -- required. + + if Nkind (Subp_Decl) not in N_Subprogram_Body + | N_Subprogram_Declaration + then + return; + end if; + + Spec_Id := Unique_Defining_Entity (Subp_Decl); + + -- If we get here and Spec_Id denotes the entity of the entry wrapper + -- (or the postcondition procedure of the entry wrapper) then the + -- attribute is legal. + + if Is_Entry_Wrapper (Spec_Id) then + Legal := True; + + elsif Chars (Spec_Id) = Name_uPostconditions + and then Is_Entry_Wrapper (Scope (Spec_Id)) + then + Spec_Id := Scope (Spec_Id); + Legal := True; + + -- Otherwise the attribute is illegal and we return Empty + + else + Spec_Id := Empty; + end if; + end Analyze_Index_Attribute; + --------------------------------- -- Bad_Attribute_For_Predicate -- --------------------------------- @@ -4280,6 +4462,55 @@ package body Sem_Attr is Check_Object_Reference (E1); Set_Etype (N, Standard_Boolean); + ----------- + -- Index -- + ----------- + + when Attribute_Index => Index : declare + Ent : Entity_Id; + Legal : Boolean; + Spec_Id : Entity_Id; + + begin + Check_E0; + Analyze_Index_Attribute (Legal, Spec_Id); + + if not Legal or else No (Spec_Id) then + Error_Attr ("attribute % must apply to entry family", P); + return; + end if; + + -- Legality checks + + if Nkind (P) in N_Identifier | N_Expanded_Name then + Ent := Entity (P); + + if Ekind (Ent) /= E_Entry_Family then + Error_Attr + ("attribute % must apply to entry family", P); + + -- Analysis of pre/postconditions of an entry [family] occurs when + -- the conditions are relocated to the contract wrapper procedure + -- (see subprogram Build_Contract_Wrapper). + + elsif Contract_Wrapper (Ent) /= Spec_Id then + Error_Attr + ("attribute % must apply to current entry family", P); + end if; + + elsif Nkind (P) in N_Indexed_Component + | N_Selected_Component + then + Error_Attr + ("attribute % must apply to current entry family", P); + + else + Error_Attr ("invalid entry family name", N); + end if; + + Set_Etype (N, Entry_Index_Type (Ent)); + end Index; + ----------------------- -- Has_Tagged_Values -- ----------------------- @@ -5776,11 +6007,7 @@ package body Sem_Attr is when Attribute_Reduce => Check_E2; - - if not Extensions_Allowed then - Error_Attr - ("% attribute only supported under -gnatX", P); - end if; + Error_Msg_Ada_2022_Feature ("Reduce attribute", Sloc (N)); declare Stream : constant Node_Id := Prefix (N); @@ -8212,6 +8439,12 @@ package body Sem_Attr is or else (Is_Static_Expression (E2) and then Is_Scalar_Type (Etype (E1)))) and then Id /= Attribute_Descriptor_Size + + -- If the front-end conjures up Integer'Pred (Integer'First) + -- as the high bound of a null array aggregate, then we don't + -- want to reject that as an illegal static expression. + + and then not Is_Null_Array_Aggregate_High_Bound (N) then Static := True; Set_Is_Static_Expression (N, True); @@ -9697,6 +9930,25 @@ package body Sem_Attr is Check_Expressions; return; + + -- Rewrite the FE-constructed high bound of a null array + -- aggregate to raise CE. + + elsif Is_Signed_Integer_Type (P_Type) + and then Expr_Value (E1) = + Expr_Value (Type_Low_Bound (P_Base_Type)) + and then Is_Null_Array_Aggregate_High_Bound (N) + then + Apply_Compile_Time_Constraint_Error + (N, "Pred of `&''First`", + CE_Overflow_Check_Failed, + Ent => P_Base_Type, + Warn => True); + + Rewrite (N, Make_Raise_Constraint_Error (Sloc (N), + Reason => CE_Overflow_Check_Failed)); + Set_Etype (N, P_Base_Type); + return; end if; Fold_Uint (N, Expr_Value (E1) - 1, Static); @@ -10600,6 +10852,7 @@ package body Sem_Attr is | Attribute_First_Bit | Attribute_Img | Attribute_Input + | Attribute_Index | Attribute_Initialized | Attribute_Last_Bit | Attribute_Library_Level @@ -12092,6 +12345,24 @@ package body Sem_Attr is when Attribute_Enabled => null; + ----------- + -- Index -- + ----------- + + when Attribute_Index => + if Nkind (P) = N_Indexed_Component + and then Is_Entity_Name (Prefix (P)) + then + declare + Indx : constant Node_Id := First (Expressions (P)); + Fam : constant Entity_Id := Entity (Prefix (P)); + + begin + Resolve (Indx, Entry_Index_Type (Fam)); + Apply_Scalar_Range_Check (Indx, Entry_Index_Type (Fam)); + end; + end if; + ---------------- -- Loop_Entry -- ---------------- diff --git a/gcc/ada/sem_attr.ads b/gcc/ada/sem_attr.ads index b9a7cd2..37e77fd 100644 --- a/gcc/ada/sem_attr.ads +++ b/gcc/ada/sem_attr.ads @@ -407,13 +407,6 @@ package Sem_Attr is -- as Range applied to the array itself. The result is of type universal -- integer. - ------------ - -- Reduce -- - ------------ - - Attribute_Reduce => True, - -- See AI12-0262-1 - --------- -- Ref -- --------- diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index 88948f7..43c33b4 100644 --- a/gcc/ada/sem_aux.adb +++ b/gcc/ada/sem_aux.adb @@ -1059,15 +1059,7 @@ package body Sem_Aux is end if; else - declare - Utyp : constant Entity_Id := Underlying_Type (Btype); - begin - if No (Utyp) then - return False; - else - return Is_Immutably_Limited_Type (Utyp); - end if; - end; + return False; end if; elsif Is_Concurrent_Type (Btype) then @@ -1261,15 +1253,6 @@ package body Sem_Aux is end if; end Is_Limited_View; - ------------------------------- - -- Is_Record_Or_Limited_Type -- - ------------------------------- - - function Is_Record_Or_Limited_Type (Typ : Entity_Id) return Boolean is - begin - return Is_Record_Type (Typ) or else Is_Limited_Type (Typ); - end Is_Record_Or_Limited_Type; - ---------------------- -- Nearest_Ancestor -- ---------------------- diff --git a/gcc/ada/sem_aux.ads b/gcc/ada/sem_aux.ads index 719fad5..66cbcfb 100644 --- a/gcc/ada/sem_aux.ads +++ b/gcc/ada/sem_aux.ads @@ -334,9 +334,6 @@ package Sem_Aux is -- these types). This older routine overlaps with the previous one, this -- should be cleaned up??? - function Is_Record_Or_Limited_Type (Typ : Entity_Id) return Boolean; - -- Return True if Typ requires is a record or limited type. - function Nearest_Ancestor (Typ : Entity_Id) return Entity_Id; -- Given a subtype Typ, this function finds out the nearest ancestor from -- which constraints and predicates are inherited. There is no simple link diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 9dbb871..80a729f 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -3107,6 +3107,72 @@ package body Sem_Ch10 is end if; end Check_Stub_Level; + ------------------- + -- Decorate_Type -- + ------------------- + + procedure Decorate_Type + (Ent : Entity_Id; + Scop : Entity_Id; + Is_Tagged : Boolean := False; + Materialize : Boolean := False) + is + CW_Typ : Entity_Id; + + begin + -- An unanalyzed type or a shadow entity of a type is treated as an + -- incomplete type, and carries the corresponding attributes. + + Mutate_Ekind (Ent, E_Incomplete_Type); + Set_Etype (Ent, Ent); + Set_Full_View (Ent, Empty); + Set_Is_First_Subtype (Ent); + Set_Scope (Ent, Scop); + Set_Stored_Constraint (Ent, No_Elist); + Reinit_Size_Align (Ent); + + if From_Limited_With (Ent) then + Set_Private_Dependents (Ent, New_Elmt_List); + end if; + + -- A tagged type and its corresponding shadow entity share one common + -- class-wide type. The list of primitive operations for the shadow + -- entity is empty. + + if Is_Tagged then + Set_Is_Tagged_Type (Ent); + Set_Direct_Primitive_Operations (Ent, New_Elmt_List); + + CW_Typ := + New_External_Entity + (E_Void, Scope (Ent), Sloc (Ent), Ent, 'C', 0, 'T'); + + Set_Class_Wide_Type (Ent, CW_Typ); + + -- Set parent to be the same as the parent of the tagged type. + -- We need a parent field set, and it is supposed to point to + -- the declaration of the type. The tagged type declaration + -- essentially declares two separate types, the tagged type + -- itself and the corresponding class-wide type, so it is + -- reasonable for the parent fields to point to the declaration + -- in both cases. + + Set_Parent (CW_Typ, Parent (Ent)); + + Mutate_Ekind (CW_Typ, E_Class_Wide_Type); + Set_Class_Wide_Type (CW_Typ, CW_Typ); + Set_Etype (CW_Typ, Ent); + Set_Equivalent_Type (CW_Typ, Empty); + Set_From_Limited_With (CW_Typ, From_Limited_With (Ent)); + Set_Has_Unknown_Discriminants (CW_Typ); + Set_Is_First_Subtype (CW_Typ); + Set_Is_Tagged_Type (CW_Typ); + Set_Materialize_Entity (CW_Typ, Materialize); + Set_Scope (CW_Typ, Scop); + Reinit_Size_Align (CW_Typ); + end if; + end Decorate_Type; + ------------------------ -- Expand_With_Clause -- ------------------------ @@ -5021,9 +5087,8 @@ package body Sem_Ch10 is -- by the shadow ones. -- This code must be kept synchronized with the code that replaces the - -- shadow entities by the real entities (see body of Remove_Limited - -- With_Clause); otherwise the contents of the homonym chains are not - -- consistent. + -- shadow entities by the real entities in Remove_Limited_With_Unit, + -- otherwise the contents of the homonym chains are not consistent. else -- Hide all the type entities of the public part of the package to @@ -5060,14 +5125,16 @@ package body Sem_Ch10 is and then not Is_Child_Unit (Lim_Typ) then declare + Non_Lim_View : constant Entity_Id := + Non_Limited_View (Lim_Typ); + Prev : Entity_Id; begin Prev := Current_Entity (Lim_Typ); - E := Prev; - -- Replace E in the homonyms list, so that the limited view - -- becomes available. + -- Replace Non_Lim_View in the homonyms list, so that the + -- limited view becomes available. -- If the nonlimited view is a record with an anonymous -- self-referential component, the analysis of the record @@ -5076,31 +5143,53 @@ package body Sem_Ch10 is -- entity is now the incomplete type, and that is the one to -- replace in the visibility structure. - if E = Non_Limited_View (Lim_Typ) + -- Similarly, if the source already contains the incomplete + -- type declaration, the limited view of the incomplete type + -- is in fact never visible (AI05-129) but we have created a + -- shadow entity E1 for it that points to E2, the incomplete + -- type at stake. This in turn has full view E3 that is the + -- full declaration, with a corresponding shadow entity E4. + -- When reinstalling the limited view, the visible entity E2 + -- is first replaced with E1, but E4 must eventually become + -- the visible entity as per the AI and thus displace E1, as + -- it is replacing E3 in the homonyms list. + -- + -- regular views limited views + -- + -- * E2 (incomplete) <-- E1 (shadow) + -- + -- | + -- V + -- + -- E3 (full) <-- E4 (shadow) * + -- + -- [*] denotes the visible entity (Current_Entity) + + if Prev = Non_Lim_View or else - (Ekind (E) = E_Incomplete_Type - and then Full_View (E) = Non_Limited_View (Lim_Typ)) + (Ekind (Prev) = E_Incomplete_Type + and then Full_View (Prev) = Non_Lim_View) + or else + (Ekind (Prev) = E_Incomplete_Type + and then From_Limited_With (Prev) + and then + Ekind (Non_Limited_View (Prev)) = E_Incomplete_Type + and then + Full_View (Non_Limited_View (Prev)) = Non_Lim_View) then - Set_Homonym (Lim_Typ, Homonym (Prev)); Set_Current_Entity (Lim_Typ); else + while Present (Homonym (Prev)) + and then Homonym (Prev) /= Non_Lim_View loop - E := Homonym (Prev); - - -- E may have been removed when installing a previous - -- limited_with_clause. - - exit when No (E); - exit when E = Non_Limited_View (Lim_Typ); Prev := Homonym (Prev); end loop; - if Present (E) then - Set_Homonym (Lim_Typ, Homonym (Homonym (Prev))); - Set_Homonym (Prev, Lim_Typ); - end if; + Set_Homonym (Prev, Lim_Typ); end if; + + Set_Homonym (Lim_Typ, Homonym (Non_Lim_View)); end; if Debug_Flag_I then @@ -5665,7 +5754,7 @@ package body Sem_Ch10 is -- Create a shadow entity that hides Ent and offers an abstract or -- incomplete view of Ent. Scop is the proper scope. Flag Is_Tagged -- should be set when Ent is a tagged type. The generated entity is - -- added to Lim_Header. This routine updates the value of Last_Shadow. + -- added to Shadow_Pack. The routine updates the value of Last_Shadow. procedure Decorate_Package (Ent : Entity_Id; Scop : Entity_Id); -- Perform minimal decoration of a package or its corresponding shadow @@ -5675,17 +5764,6 @@ package body Sem_Ch10 is -- Perform full decoration of an abstract state or its corresponding -- shadow entity denoted by Ent. Scop is the proper scope. - procedure Decorate_Type - (Ent : Entity_Id; - Scop : Entity_Id; - Is_Tagged : Boolean := False; - Materialize : Boolean := False); - -- Perform minimal decoration of a type or its corresponding shadow - -- entity denoted by Ent. Scop is the proper scope. Flag Is_Tagged - -- should be set when Ent is a tagged type. Flag Materialize should be - -- set when Ent is a tagged type and its class-wide type needs to appear - -- in the tree. - procedure Decorate_Variable (Ent : Entity_Id; Scop : Entity_Id); -- Perform minimal decoration of a variable denoted by Ent. Scop is the -- proper scope. @@ -5745,8 +5823,21 @@ package body Sem_Ch10 is Decorate_Package (Shadow, Scop); elsif Is_Type (Ent) then - Decorate_Type (Shadow, Scop, Is_Tagged); - Set_Non_Limited_View (Shadow, Ent); + Decorate_Type (Shadow, Scop, Is_Tagged); + + -- If Ent is a private type and we are analyzing the body of its + -- scope, its private and full views are swapped and, therefore, + -- we need to undo this swapping in order to build the same shadow + -- entity as we would have in other contexts. + + if Is_Private_Type (Ent) + and then Present (Full_View (Ent)) + and then In_Package_Body (Scop) + then + Set_Non_Limited_View (Shadow, Full_View (Ent)); + else + Set_Non_Limited_View (Shadow, Ent); + end if; if Is_Tagged then Set_Non_Limited_View @@ -5786,72 +5877,6 @@ package body Sem_Ch10 is Set_Encapsulating_State (Ent, Empty); end Decorate_State; - ------------------- - -- Decorate_Type -- - ------------------- - - procedure Decorate_Type - (Ent : Entity_Id; - Scop : Entity_Id; - Is_Tagged : Boolean := False; - Materialize : Boolean := False) - is - CW_Typ : Entity_Id; - - begin - -- An unanalyzed type or a shadow entity of a type is treated as an - -- incomplete type, and carries the corresponding attributes. - - Mutate_Ekind (Ent, E_Incomplete_Type); - Set_Etype (Ent, Ent); - Set_Full_View (Ent, Empty); - Set_Is_First_Subtype (Ent); - Set_Scope (Ent, Scop); - Set_Stored_Constraint (Ent, No_Elist); - Reinit_Size_Align (Ent); - - if From_Limited_With (Ent) then - Set_Private_Dependents (Ent, New_Elmt_List); - end if; - - -- A tagged type and its corresponding shadow entity share one common - -- class-wide type. The list of primitive operations for the shadow - -- entity is empty. - - if Is_Tagged then - Set_Is_Tagged_Type (Ent); - Set_Direct_Primitive_Operations (Ent, New_Elmt_List); - - CW_Typ := - New_External_Entity - (E_Void, Scope (Ent), Sloc (Ent), Ent, 'C', 0, 'T'); - - Set_Class_Wide_Type (Ent, CW_Typ); - - -- Set parent to be the same as the parent of the tagged type. - -- We need a parent field set, and it is supposed to point to - -- the declaration of the type. The tagged type declaration - -- essentially declares two separate types, the tagged type - -- itself and the corresponding class-wide type, so it is - -- reasonable for the parent fields to point to the declaration - -- in both cases. - - Set_Parent (CW_Typ, Parent (Ent)); - - Mutate_Ekind (CW_Typ, E_Class_Wide_Type); - Set_Class_Wide_Type (CW_Typ, CW_Typ); - Set_Etype (CW_Typ, Ent); - Set_Equivalent_Type (CW_Typ, Empty); - Set_From_Limited_With (CW_Typ, From_Limited_With (Ent)); - Set_Has_Unknown_Discriminants (CW_Typ); - Set_Is_First_Subtype (CW_Typ); - Set_Is_Tagged_Type (CW_Typ); - Set_Materialize_Entity (CW_Typ, Materialize); - Set_Scope (CW_Typ, Scop); - Reinit_Size_Align (CW_Typ); - end if; - end Decorate_Type; - ----------------------- -- Decorate_Variable -- ----------------------- @@ -6577,6 +6602,10 @@ package body Sem_Ch10 is -- Remove_Shadow_Entities_With_Restore -- ----------------------------------------- + -- This code must be kept synchronized with the code that replaces the + -- real entities by the shadow entities in Install_Limited_With_Clause, + -- otherwise the contents of the homonym chains are not consistent. + procedure Remove_Shadow_Entities_With_Restore (Pack_Id : Entity_Id) is procedure Restore_Chain_For_Shadow (Shadow : Entity_Id); -- Remove shadow entity Shadow by updating the entity and homonym @@ -6599,44 +6628,61 @@ package body Sem_Ch10 is ------------------------------ procedure Restore_Chain_For_Shadow (Shadow : Entity_Id) is - Prev : Entity_Id; - Typ : Entity_Id; + Is_E3 : Boolean; + Prev : Entity_Id; + Typ : Entity_Id; begin -- If the package has incomplete types, the limited view of the -- incomplete type is in fact never visible (AI05-129) but we -- have created a shadow entity E1 for it, that points to E2, - -- a nonlimited incomplete type. This in turn has a full view - -- E3 that is the full declaration. There is a corresponding + -- the incomplete type at stake. This in turn has a full view + -- E3 that is the full declaration, with a corresponding -- shadow entity E4. When reinstalling the nonlimited view, - -- E2 must become the current entity and E3 must be ignored. + -- the nonvisible entity E1 is first replaced with E2, but then + -- E3 must *not* become the visible entity as it is replacing E4 + -- in the homonyms list and simply be ignored. + -- + -- regular views limited views + -- + -- * E2 (incomplete) <-- E1 (shadow) + -- + -- | + -- V + -- + -- E3 (full) <-- E4 (shadow) * + -- + -- [*] denotes the visible entity (Current_Entity) Typ := Non_Limited_View (Shadow); - - -- Shadow is the limited view of a full type declaration that has - -- a previous incomplete declaration, i.e. E3 from the previous - -- description. Nothing to insert. - - if Present (Current_Entity (Typ)) - and then Ekind (Current_Entity (Typ)) = E_Incomplete_Type - and then Full_View (Current_Entity (Typ)) = Typ - then - return; - end if; - pragma Assert (not In_Chain (Typ)); + Is_E3 := Nkind (Parent (Typ)) = N_Full_Type_Declaration + and then Present (Incomplete_View (Parent (Typ))); + Prev := Current_Entity (Shadow); if Prev = Shadow then - Set_Current_Entity (Typ); + if Is_E3 then + Set_Name_Entity_Id (Chars (Prev), Homonym (Prev)); + return; + + else + Set_Current_Entity (Typ); + end if; else - while Present (Prev) and then Homonym (Prev) /= Shadow loop + while Present (Homonym (Prev)) + and then Homonym (Prev) /= Shadow + loop Prev := Homonym (Prev); end loop; - if Present (Prev) then + if Is_E3 then + Set_Homonym (Prev, Homonym (Shadow)); + return; + + else Set_Homonym (Prev, Typ); end if; end if; @@ -6760,9 +6806,6 @@ package body Sem_Ch10 is -- and the previously hidden entities must be entered back into direct -- visibility. - -- WARNING: This code must be kept synchronized with that of routine - -- Install_Limited_Withed_Clause. - if Analyzed (Pack_Decl) then Remove_Shadow_Entities_With_Restore (Pack_Id); diff --git a/gcc/ada/sem_ch10.ads b/gcc/ada/sem_ch10.ads index bc8eec1..3dfae84 100644 --- a/gcc/ada/sem_ch10.ads +++ b/gcc/ada/sem_ch10.ads @@ -34,6 +34,17 @@ package Sem_Ch10 is procedure Analyze_Protected_Body_Stub (N : Node_Id); procedure Analyze_Subunit (N : Node_Id); + procedure Decorate_Type + (Ent : Entity_Id; + Scop : Entity_Id; + Is_Tagged : Boolean := False; + Materialize : Boolean := False); + -- Perform minimal decoration of a type or its corresponding shadow + -- entity denoted by Ent. Scop is the proper scope. Flag Is_Tagged + -- should be set when Ent is a tagged type. Flag Materialize should be + -- set when Ent is a tagged type and its class-wide type needs to appear + -- in the tree. + procedure Install_Context (N : Node_Id; Chain : Boolean := True); -- Installs the entities from the context clause of the given compilation -- unit into the visibility chains. This is done before analyzing a unit. diff --git a/gcc/ada/sem_ch11.adb b/gcc/ada/sem_ch11.adb index 1e5ab59..034d4cd 100644 --- a/gcc/ada/sem_ch11.adb +++ b/gcc/ada/sem_ch11.adb @@ -611,15 +611,7 @@ package body Sem_Ch11 is else Set_Local_Raise_Not_OK (P); - - -- Do not check the restriction if the reraise statement is part - -- of the code generated for an AT-END handler. That's because - -- if the restriction is actually active, we never generate this - -- raise anyway, so the apparent violation is bogus. - - if not From_At_End (N) then - Check_Restriction (No_Exception_Propagation, N); - end if; + Check_Restriction (No_Exception_Propagation, N); end if; -- Normal case with exception id present diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 6a914ec..c5f2eed 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -516,6 +516,22 @@ package body Sem_Ch12 is -- The body of the wrapper is a call to the actual, with the generated -- pre/postconditon checks added. + procedure Check_Abbreviated_Instance + (N : Node_Id; + Parent_Installed : in out Boolean); + -- If the name of the generic unit in an abbreviated instantiation is an + -- expanded name, then the prefix may be an instance and the selector may + -- designate a child unit. If the parent is installed as a result of this + -- call, then Parent_Installed is set True, otherwise Parent_Installed is + -- unchanged by the call. + + -- This routine needs to be called for declaration nodes of formal objects, + -- types and subprograms to check whether they are the copy, present in the + -- visible part of the abbreviated instantiation of formal packages, of the + -- declaration node of their corresponding formal parameter in the template + -- of the formal package, as specified by RM 12.7(10/2), so as to establish + -- the proper context for their analysis. + procedure Check_Access_Definition (N : Node_Id); -- Subsidiary routine to null exclusion processing. Perform an assertion -- check on Ada version and the presence of an access definition in N. @@ -865,6 +881,10 @@ package body Sem_Ch12 is procedure Remove_Parent (In_Body : Boolean := False); -- Reverse effect after instantiation of child is complete + function Requires_Conformance_Checking (N : Node_Id) return Boolean; + -- Determine whether the formal package declaration N requires conformance + -- checking with actuals in instantiations. + procedure Restore_Hidden_Primitives (Prims_List : in out Elist_Id); -- Restore suffix 'P' to primitives of Prims_List and leave Prims_List -- set to No_Elist. @@ -1144,7 +1164,7 @@ package body Sem_Ch12 is function Matching_Actual (F : Entity_Id; A_F : Entity_Id) return Node_Id; - -- Find actual that corresponds to a given a formal parameter. If the + -- Find actual that corresponds to a given formal parameter. If the -- actuals are positional, return the next one, if any. If the actuals -- are named, scan the parameter associations to find the right one. -- A_F is the corresponding entity in the analyzed generic, which is @@ -1160,10 +1180,10 @@ package body Sem_Ch12 is -- association for it includes a box, or whether the associations -- include an Others clause. - procedure Process_Default (F : Entity_Id); - -- Add a copy of the declaration of generic formal F to the list of - -- associations, and add an explicit box association for F if there - -- is none yet, and the default comes from an Others_Choice. + procedure Process_Default (Formal : Node_Id); + -- Add a copy of the declaration of a generic formal to the list of + -- associations, and add an explicit box association for its entity + -- if there is none yet, and the default comes from an Others_Choice. function Renames_Standard_Subprogram (Subp : Entity_Id) return Boolean; -- Determine whether Subp renames one of the subprograms defined in the @@ -1517,9 +1537,9 @@ package body Sem_Ch12 is -- Process_Default -- --------------------- - procedure Process_Default (F : Entity_Id) is + procedure Process_Default (Formal : Node_Id) is Loc : constant Source_Ptr := Sloc (I_Node); - F_Id : constant Entity_Id := Defining_Entity (F); + F_Id : constant Entity_Id := Defining_Entity (Formal); Decl : Node_Id; Default : Node_Id; Id : Entity_Id; @@ -1528,10 +1548,10 @@ package body Sem_Ch12 is -- Append copy of formal declaration to associations, and create new -- defining identifier for it. - Decl := New_Copy_Tree (F); + Decl := New_Copy_Tree (Formal); Id := Make_Defining_Identifier (Sloc (F_Id), Chars (F_Id)); - if Nkind (F) in N_Formal_Subprogram_Declaration then + if Nkind (Formal) in N_Formal_Subprogram_Declaration then Set_Defining_Unit_Name (Specification (Decl), Id); else @@ -2043,7 +2063,7 @@ package body Sem_Ch12 is procedure Check_Generic_Parent is Inst : constant Node_Id := - Next (Unit_Declaration_Node (Actual)); + Get_Unit_Instantiation_Node (Actual); Par : Entity_Id; begin @@ -2612,12 +2632,16 @@ package body Sem_Ch12 is procedure Analyze_Formal_Object_Declaration (N : Node_Id) is E : constant Node_Id := Default_Expression (N); Id : constant Node_Id := Defining_Identifier (N); - K : Entity_Kind; - T : Node_Id; + + K : Entity_Kind; + Parent_Installed : Boolean := False; + T : Node_Id; begin Enter_Name (Id); + Check_Abbreviated_Instance (Parent (N), Parent_Installed); + -- Determine the mode of the formal object if Out_Present (N) then @@ -2740,6 +2764,10 @@ package body Sem_Ch12 is if Has_Aspects (N) then Analyze_Aspect_Specifications (N, Id); end if; + + if Parent_Installed then + Remove_Parent; + end if; end Analyze_Formal_Object_Declaration; ---------------------------------------------- @@ -3279,7 +3307,9 @@ package body Sem_Ch12 is Def : constant Node_Id := Default_Name (N); Expr : constant Node_Id := Expression (N); Nam : constant Entity_Id := Defining_Unit_Name (Spec); - Subp : Entity_Id; + + Parent_Installed : Boolean := False; + Subp : Entity_Id; begin if Nam = Error then @@ -3291,6 +3321,8 @@ package body Sem_Ch12 is goto Leave; end if; + Check_Abbreviated_Instance (Parent (N), Parent_Installed); + Analyze_Subprogram_Declaration (N); Set_Is_Formal_Subprogram (Nam); Set_Has_Completion (Nam); @@ -3490,6 +3522,9 @@ package body Sem_Ch12 is Analyze_Aspect_Specifications (N, Nam); end if; + if Parent_Installed then + Remove_Parent; + end if; end Analyze_Formal_Subprogram_Declaration; ------------------------------------- @@ -3498,7 +3533,9 @@ package body Sem_Ch12 is procedure Analyze_Formal_Type_Declaration (N : Node_Id) is Def : constant Node_Id := Formal_Type_Definition (N); - T : Entity_Id; + + Parent_Installed : Boolean := False; + T : Entity_Id; begin T := Defining_Identifier (N); @@ -3510,6 +3547,8 @@ package body Sem_Ch12 is ("discriminants not allowed for this formal type", T); end if; + Check_Abbreviated_Instance (Parent (N), Parent_Installed); + -- Enter the new name, and branch to specific routine case Nkind (Def) is @@ -3578,6 +3617,10 @@ package body Sem_Ch12 is if Has_Aspects (N) then Analyze_Aspect_Specifications (N, T); end if; + + if Parent_Installed then + Remove_Parent; + end if; end Analyze_Formal_Type_Declaration; ------------------------------------ @@ -4258,7 +4301,13 @@ package body Sem_Ch12 is Generic_Renamings.Set_Last (0); Generic_Renamings_HTable.Reset; - Check_Generic_Child_Unit (Gen_Id, Parent_Installed); + -- Except for an abbreviated instance created to check a formal package, + -- install the parent if this is a generic child unit. + + if not Is_Abbreviated_Instance (Inst_Id) then + Check_Generic_Child_Unit (Gen_Id, Parent_Installed); + end if; + Gen_Unit := Entity (Gen_Id); -- A package instantiation is Ghost when it is subject to pragma Ghost @@ -6289,6 +6338,25 @@ package body Sem_Ch12 is Build_Elaboration_Entity (Decl_Cunit, New_Main); end Build_Instance_Compilation_Unit_Nodes; + -------------------------------- + -- Check_Abbreviated_Instance -- + -------------------------------- + + procedure Check_Abbreviated_Instance + (N : Node_Id; + Parent_Installed : in out Boolean) + is + Inst_Node : Node_Id; + + begin + if Nkind (N) = N_Package_Specification + and then Is_Abbreviated_Instance (Defining_Entity (N)) + then + Inst_Node := Get_Unit_Instantiation_Node (Defining_Entity (N)); + Check_Generic_Child_Unit (Name (Inst_Node), Parent_Installed); + end if; + end Check_Abbreviated_Instance; + ----------------------------- -- Check_Access_Definition -- ----------------------------- @@ -6738,43 +6806,23 @@ package body Sem_Ch12 is E : Entity_Id; Formal_P : Entity_Id; Formal_Decl : Node_Id; + begin -- Iterate through the declarations in the instance, looking for package - -- renaming declarations that denote instances of formal packages. Stop - -- when we find the renaming of the current package itself. The - -- declaration for a formal package without a box is followed by an - -- internal entity that repeats the instantiation. + -- renaming declarations that denote instances of formal packages, until + -- we find the renaming of the current package itself. The declaration + -- of a formal package that requires conformance checking is followed by + -- an internal entity that is the abbreviated instance. E := First_Entity (P_Id); while Present (E) loop if Ekind (E) = E_Package then - if Renamed_Entity (E) = P_Id then - exit; - - elsif Nkind (Parent (E)) /= N_Package_Renaming_Declaration then - null; + exit when Renamed_Entity (E) = P_Id; - else + if Nkind (Parent (E)) = N_Package_Renaming_Declaration then Formal_Decl := Parent (Associated_Formal_Package (E)); - -- Nothing to check if the formal has a box or an others_clause - -- (necessarily with a box), or no associations altogether - - if Box_Present (Formal_Decl) - or else No (Generic_Associations (Formal_Decl)) - then - null; - - elsif Nkind (First (Generic_Associations (Formal_Decl))) = - N_Others_Choice - then - -- The internal validating package was generated but formal - -- and instance are known to be compatible. - - Formal_P := Next_Entity (E); - Remove (Unit_Declaration_Node (Formal_P)); - - else + if Requires_Conformance_Checking (Formal_Decl) then Formal_P := Next_Entity (E); -- If the instance is within an enclosing instance body @@ -7708,7 +7756,7 @@ package body Sem_Ch12 is function Copy_Generic_List (L : List_Id; Parent_Id : Node_Id) return List_Id; - -- Apply Copy_Node recursively to the members of a node list + -- Apply Copy_Generic_Node recursively to the members of a node list function In_Defining_Unit_Name (Nam : Node_Id) return Boolean; -- True if an identifier is part of the defining program unit name of @@ -8074,7 +8122,10 @@ package body Sem_Ch12 is Set_Entity (New_N, Entity (Name (Assoc))); elsif Nkind (Assoc) in N_Entity - and then Expander_Active + and then (Expander_Active or + (GNATprove_Mode + and then not In_Spec_Expression + and then not Inside_A_Generic)) then -- Inlining case: we are copying a tree that contains -- global entities, which are preserved in the copy to be @@ -10247,12 +10298,13 @@ package body Sem_Ch12 is is Loc : constant Source_Ptr := Sloc (Actual); Hidden_Formals : constant Elist_Id := New_Elmt_List; - Actual_Pack : Entity_Id; - Formal_Pack : Entity_Id; - Gen_Parent : Entity_Id; - Decls : List_Id; - Nod : Node_Id; - Parent_Spec : Node_Id; + + Actual_Pack : Entity_Id; + Formal_Pack : Entity_Id; + Gen_Parent : Entity_Id; + Decls : List_Id; + Nod : Node_Id; + Parent_Spec : Node_Id; procedure Find_Matching_Actual (F : Node_Id; @@ -10533,15 +10585,15 @@ package body Sem_Ch12 is Actual_Pack := Renamed_Entity (Actual_Pack); end if; - if Nkind (Analyzed_Formal) = N_Formal_Package_Declaration then - Gen_Parent := Get_Instance_Of (Entity (Name (Analyzed_Formal))); - Formal_Pack := Defining_Identifier (Analyzed_Formal); - else - Gen_Parent := - Generic_Parent (Specification (Analyzed_Formal)); - Formal_Pack := - Defining_Unit_Name (Specification (Analyzed_Formal)); - end if; + -- The analyzed formal is expected to be the result of the rewriting + -- of the formal package into a regular package by analysis. + + pragma Assert (Nkind (Analyzed_Formal) = N_Package_Declaration + and then Nkind (Original_Node (Analyzed_Formal)) = + N_Formal_Package_Declaration); + + Gen_Parent := Generic_Parent (Specification (Analyzed_Formal)); + Formal_Pack := Defining_Unit_Name (Specification (Analyzed_Formal)); if Nkind (Parent (Actual_Pack)) = N_Defining_Program_Unit_Name then Parent_Spec := Package_Specification (Actual_Pack); @@ -10708,20 +10760,9 @@ package body Sem_Ch12 is Next_Entity (Actual_Ent); end loop; - - -- No conformance to check if the generic has no formal parameters - -- and the formal package has no generic associations. - - if Is_Empty_List (Formals) - and then - (Box_Present (Formal) - or else No (Generic_Associations (Formal))) - then - return Decls; - end if; end; - -- If the formal is not declared with a box, reanalyze it as an + -- If the formal requires conformance checking, reanalyze it as an -- abbreviated instantiation, to verify the matching rules of 12.7. -- The actual checks are performed after the generic associations -- have been analyzed, to guarantee the same visibility for this @@ -10733,22 +10774,40 @@ package body Sem_Ch12 is -- checking, because it contains formal declarations for those -- defaulted parameters, and those should not reach the back-end. - if not Box_Present (Formal) then + if Requires_Conformance_Checking (Formal) then declare - I_Pack : constant Entity_Id := - Make_Temporary (Sloc (Actual), 'P'); + I_Pack : constant Entity_Id := Make_Temporary (Loc, 'P'); + + I_Nam : Node_Id; begin Set_Is_Internal (I_Pack); Mutate_Ekind (I_Pack, E_Package); + + -- Insert the package into the list of its hidden entities so + -- that the list is not empty for Is_Abbreviated_Instance. + + Append_Elmt (I_Pack, Hidden_Formals); + Set_Hidden_In_Formal_Instance (I_Pack, Hidden_Formals); + -- If the generic is a child unit, Check_Generic_Child_Unit + -- needs its original name in case it is qualified. + + if Is_Child_Unit (Gen_Parent) then + I_Nam := + New_Copy_Tree (Name (Original_Node (Analyzed_Formal))); + pragma Assert (Entity (I_Nam) = Gen_Parent); + + else + I_Nam := + New_Occurrence_Of (Get_Instance_Of (Gen_Parent), Loc); + end if; + Append_To (Decls, - Make_Package_Instantiation (Sloc (Actual), + Make_Package_Instantiation (Loc, Defining_Unit_Name => I_Pack, - Name => - New_Occurrence_Of - (Get_Instance_Of (Gen_Parent), Sloc (Actual)), + Name => I_Nam, Generic_Associations => Generic_Associations (Formal))); end; end if; @@ -14234,6 +14293,16 @@ package body Sem_Ch12 is return Decl_Nodes; end Instantiate_Type; + ----------------------------- + -- Is_Abbreviated_Instance -- + ----------------------------- + + function Is_Abbreviated_Instance (E : Entity_Id) return Boolean is + begin + return Ekind (E) = E_Package + and then Present (Hidden_In_Formal_Instance (E)); + end Is_Abbreviated_Instance; + --------------------- -- Is_In_Main_Unit -- --------------------- @@ -14323,7 +14392,7 @@ package body Sem_Ch12 is -- not analyzed here either. elsif Nkind (Decl) = N_Package_Instantiation - and then not Is_Internal (Defining_Entity (Decl)) + and then not Is_Abbreviated_Instance (Defining_Entity (Decl)) then Append_Elmt (Decl, Previous_Instances); @@ -15206,6 +15275,20 @@ package body Sem_Ch12 is end if; end Remove_Parent; + ----------------------------------- + -- Requires_Conformance_Checking -- + ----------------------------------- + + function Requires_Conformance_Checking (N : Node_Id) return Boolean is + begin + -- No conformance checking required if the generic actual part is empty, + -- or is a box or an others_clause (necessarily with a box). + + return Present (Generic_Associations (N)) + and then not Box_Present (N) + and then Nkind (First (Generic_Associations (N))) /= N_Others_Choice; + end Requires_Conformance_Checking; + ----------------- -- Restore_Env -- ----------------- diff --git a/gcc/ada/sem_ch12.ads b/gcc/ada/sem_ch12.ads index e7ba11f..58a9455 100644 --- a/gcc/ada/sem_ch12.ads +++ b/gcc/ada/sem_ch12.ads @@ -110,6 +110,10 @@ package Sem_Ch12 is -- function and procedure instances. The flag Body_Optional has the -- same purpose as described for Instantiate_Package_Body. + function Is_Abbreviated_Instance (E : Entity_Id) return Boolean; + -- Return true if E is a package created for an abbreviated instantiation + -- to check conformance between formal package and corresponding actual. + function Need_Subprogram_Instance_Body (N : Node_Id; Subp : Entity_Id) return Boolean; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 61f7ba7..11abdd8 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -133,7 +133,7 @@ package body Sem_Ch13 is -- may be before the freeze point of the type. The predicate expression is -- preanalyzed at this point, to catch visibility errors. - procedure Build_Predicate_Functions (Typ : Entity_Id; N : Node_Id); + procedure Build_Predicate_Function (Typ : Entity_Id; N : Node_Id); -- If Typ has predicates (indicated by Has_Predicates being set for Typ), -- then either there are pragma Predicate entries on the rep chain for the -- type (note that Predicate aspects are converted to pragma Predicate), or @@ -141,9 +141,7 @@ package body Sem_Ch13 is -- This procedure builds body for the Predicate function that tests these -- predicates. N is the freeze node for the type. The spec of the function -- is inserted before the freeze node, and the body of the function is - -- inserted after the freeze node. If the predicate expression has a least - -- one Raise_Expression, then this procedure also builds the M version of - -- the predicate function for use in membership tests. + -- inserted after the freeze node. procedure Check_Pool_Size_Clash (Ent : Entity_Id; SP, SS : Node_Id); -- Called if both Storage_Pool and Storage_Size attribute definition @@ -2601,10 +2599,8 @@ package body Sem_Ch13 is Aspect); elsif Is_Imported_Intrinsic then - Error_Msg_N - ("aspect % on intrinsic function is an extension: " & - "use -gnatX", - Aspect); + Error_Msg_GNAT_Extension + ("aspect % on intrinsic function", Sloc (Aspect)); else Error_Msg_N @@ -4411,11 +4407,7 @@ package body Sem_Ch13 is when Aspect_Designated_Storage_Model => if not Extensions_Allowed then - Error_Msg_N - ("aspect only allowed if extensions enabled", - Aspect); - Error_Msg_N - ("\unit must be compiled with -gnatX switch", Aspect); + Error_Msg_GNAT_Extension ("aspect %", Sloc (Aspect)); elsif not Is_Type (E) or else Ekind (E) /= E_Access_Type @@ -4430,11 +4422,7 @@ package body Sem_Ch13 is when Aspect_Storage_Model_Type => if not Extensions_Allowed then - Error_Msg_N - ("aspect only allowed if extensions enabled", - Aspect); - Error_Msg_N - ("\unit must be compiled with -gnatX switch", Aspect); + Error_Msg_GNAT_Extension ("aspect %", Sloc (Aspect)); elsif not Is_Type (E) or else not Is_Immutably_Limited_Type (E) @@ -9472,10 +9460,7 @@ package body Sem_Ch13 is declare Ent : constant Entity_Id := Entity (Name (Exp)); begin - if Is_Predicate_Function (Ent) - or else - Is_Predicate_Function_M (Ent) - then + if Is_Predicate_Function (Ent) then return Stat_Pred (Etype (First_Formal (Ent)), Static); end if; end; @@ -10016,11 +10001,11 @@ package body Sem_Ch13 is return Prag; end Build_Export_Import_Pragma; - ------------------------------- - -- Build_Predicate_Functions -- - ------------------------------- + ------------------------------ + -- Build_Predicate_Function -- + ------------------------------ - -- The functions that are constructed here have the form: + -- The function constructed here has the form: -- function typPredicate (Ixxx : typ) return Boolean is -- begin @@ -10031,6 +10016,18 @@ package body Sem_Ch13 is -- and then exp1 and then exp2 and then ...; -- end typPredicate; + -- If Predicate_Function_Needs_Membership_Parameter is true, then this + -- function takes an additional boolean parameter; the parameter + -- indicates whether the predicate evaluation is part of a membership + -- test. This parameter is used in two cases: 1) It is passed along + -- if another predicate function is called and that predicate function + -- expects to be passed a boolean parameter. 2) If the Predicate_Failure + -- aspect is directly specified for typ, then we replace the return + -- expression described above with + -- (if <expression described above> then True + -- elsif For_Membership_Test then False + -- else (raise Assertion_Error + -- with <Predicate_Failure expression>)) -- Here exp1, and exp2 are expressions from Predicate pragmas. Note that -- this is the point at which these expressions get analyzed, providing the -- required delay, and typ1, typ2, are entities from which predicates are @@ -10043,26 +10040,17 @@ package body Sem_Ch13 is -- Note that Sem_Eval.Real_Or_String_Static_Predicate_Matches depends on -- the form of this return expression. - -- If the expression has at least one Raise_Expression, then we also build - -- the typPredicateM version of the function, in which any occurrence of a - -- Raise_Expression is converted to "return False". - -- WARNING: This routine manages Ghost regions. Return statements must be -- replaced by gotos which jump to the end of the routine and restore the -- Ghost mode. - procedure Build_Predicate_Functions (Typ : Entity_Id; N : Node_Id) is + procedure Build_Predicate_Function (Typ : Entity_Id; N : Node_Id) is Loc : constant Source_Ptr := Sloc (Typ); Expr : Node_Id; -- This is the expression for the result of the function. It is -- is build by connecting the component predicates with AND THEN. - Expr_M : Node_Id := Empty; -- init to avoid warning - -- This is the corresponding return expression for the Predicate_M - -- function. It differs in that raise expressions are marked for - -- special expansion (see Process_REs). - Object_Name : Name_Id; -- Name for argument of Predicate procedure. Note that we use the same -- name for both predicate functions. That way the reference within the @@ -10071,18 +10059,15 @@ package body Sem_Ch13 is Object_Entity : Entity_Id; -- Entity for argument of Predicate procedure - Object_Entity_M : Entity_Id; - -- Entity for argument of separate Predicate procedure when exceptions - -- are present in expression. - FDecl : Node_Id; -- The function declaration SId : Entity_Id; -- Its entity - Raise_Expression_Present : Boolean := False; - -- Set True if Expr has at least one Raise_Expression + Ancestor_Predicate_Function_Called : Boolean := False; + -- Does this predicate function include a call to the + -- predication function of an ancestor subtype? procedure Add_Condition (Cond : Node_Id); -- Append Cond to Expr using "and then" (or just copy Cond to Expr if @@ -10098,19 +10083,11 @@ package body Sem_Ch13 is -- Includes a call to the predicate function for type T in Expr if -- Predicate_Function (T) is non-empty. - function Process_RE (N : Node_Id) return Traverse_Result; - -- Used in Process REs, tests if node N is a raise expression, and if - -- so, marks it to be converted to return False. - - procedure Process_REs is new Traverse_Proc (Process_RE); - -- Marks any raise expressions in Expr_M to return False - - function Test_RE (N : Node_Id) return Traverse_Result; - -- Used in Test_REs, tests one node for being a raise expression, and if - -- so sets Raise_Expression_Present True. - - procedure Test_REs is new Traverse_Proc (Test_RE); - -- Tests to see if Expr contains any raise expressions + procedure Replace_Current_Instance_References + (N : Node_Id; Typ, New_Entity : Entity_Id); + -- Replace all references to Typ in the tree rooted at N with + -- references to Param. [New_Entity will be a formal parameter of a + -- predicate function.] -------------- -- Add_Call -- @@ -10126,16 +10103,34 @@ package body Sem_Ch13 is -- Build the call to the predicate function of T. The type may be -- derived, so use an unchecked conversion for the actual. - Exp := - Make_Predicate_Call - (Typ => T, - Expr => - Unchecked_Convert_To (T, - Make_Identifier (Loc, Object_Name))); + declare + Dynamic_Mem : Node_Id := Empty; + Second_Formal : constant Entity_Id := + Next_Entity (Object_Entity); + begin + -- Some predicate functions require a second parameter; + -- If one predicate function calls another and the second + -- requires two parameters, then the first should also + -- take two parameters (so that the first function has + -- something to pass to the second function). + if Predicate_Function_Needs_Membership_Parameter (T) then + pragma Assert (Present (Second_Formal)); + Dynamic_Mem := New_Occurrence_Of (Second_Formal, Loc); + end if; + + Exp := + Make_Predicate_Call + (Typ => T, + Expr => + Unchecked_Convert_To (T, + Make_Identifier (Loc, Object_Name)), + Dynamic_Mem => Dynamic_Mem); + end; -- "and"-in the call to evolving expression Add_Condition (Exp); + Ancestor_Predicate_Function_Called := True; -- Output info message on inheritance if required. Note we do not -- give this information for generic actual types, since it is @@ -10192,32 +10187,6 @@ package body Sem_Ch13 is ------------------- procedure Add_Predicate (Prag : Node_Id) is - procedure Replace_Type_Reference (N : Node_Id); - -- Replace a single occurrence N of the subtype name with a - -- reference to the formal of the predicate function. N can be an - -- identifier referencing the subtype, or a selected component, - -- representing an appropriately qualified occurrence of the - -- subtype name. - - procedure Replace_Type_References is - new Replace_Type_References_Generic (Replace_Type_Reference); - -- Traverse an expression changing every occurrence of an - -- identifier whose name matches the name of the subtype with a - -- reference to the formal parameter of the predicate function. - - ---------------------------- - -- Replace_Type_Reference -- - ---------------------------- - - procedure Replace_Type_Reference (N : Node_Id) is - begin - Rewrite (N, Make_Identifier (Sloc (N), Object_Name)); - -- Use the Sloc of the usage name, not the defining name - - Set_Etype (N, Typ); - Set_Entity (N, Object_Entity); - end Replace_Type_Reference; - -- Local variables Asp : constant Node_Id := Corresponding_Aspect (Prag); @@ -10231,16 +10200,13 @@ package body Sem_Ch13 is Set_SCO_Pragma_Enabled (Sloc (Prag)); - -- Extract the arguments of the pragma. The expression itself - -- is copied for use in the predicate function, to preserve the - -- original version for ASIS use. - -- Is this still needed??? + -- Extract the arguments of the pragma Arg1 := First (Pragma_Argument_Associations (Prag)); Arg2 := Next (Arg1); Arg1 := Get_Pragma_Arg (Arg1); - Arg2 := New_Copy_Tree (Get_Pragma_Arg (Arg2)); + Arg2 := Get_Pragma_Arg (Arg2); -- When the predicate pragma applies to the current type or its -- full view, replace all occurrences of the subtype name with @@ -10249,20 +10215,25 @@ package body Sem_Ch13 is if Entity (Arg1) = Typ or else Full_View (Entity (Arg1)) = Typ then - Replace_Type_References (Arg2, Typ); + declare + Arg2_Copy : constant Node_Id := New_Copy_Tree (Arg2); + begin + Replace_Current_Instance_References + (Arg2_Copy, Typ => Typ, New_Entity => Object_Entity); - -- If the predicate pragma comes from an aspect, replace the - -- saved expression because we need the subtype references - -- replaced for the calls to Preanalyze_Spec_Expression in - -- Check_Aspect_At_xxx routines. + -- If the predicate pragma comes from an aspect, replace the + -- saved expression because we need the subtype references + -- replaced for the calls to Preanalyze_Spec_Expression in + -- Check_Aspect_At_xxx routines. - if Present (Asp) then - Set_Entity (Identifier (Asp), New_Copy_Tree (Arg2)); - end if; + if Present (Asp) then + Set_Entity (Identifier (Asp), New_Copy_Tree (Arg2_Copy)); + end if; - -- "and"-in the Arg2 condition to evolving expression + -- "and"-in the Arg2 condition to evolving expression - Add_Condition (Relocate_Node (Arg2)); + Add_Condition (Arg2_Copy); + end; end if; end Add_Predicate; @@ -10316,33 +10287,34 @@ package body Sem_Ch13 is end loop; end Add_Predicates; - ---------------- - -- Process_RE -- - ---------------- + ----------------------------------------- + -- Replace_Current_Instance_References -- + ----------------------------------------- - function Process_RE (N : Node_Id) return Traverse_Result is - begin - if Nkind (N) = N_Raise_Expression then - Set_Convert_To_Return_False (N); - return Skip; - else - return OK; - end if; - end Process_RE; + procedure Replace_Current_Instance_References + (N : Node_Id; Typ, New_Entity : Entity_Id) + is + Root : Node_Id renames N; - ------------- - -- Test_RE -- - ------------- + procedure Replace_One_Reference (N : Node_Id); + -- Actual parameter for Replace_Type_References_Generic instance + + --------------------------- + -- Replace_One_Reference -- + --------------------------- + + procedure Replace_One_Reference (N : Node_Id) is + pragma Assert (In_Subtree (N, Root => Root)); + begin + Rewrite (N, New_Occurrence_Of (New_Entity, Sloc (N))); + -- Use the Sloc of the usage name, not the defining name + end Replace_One_Reference; - function Test_RE (N : Node_Id) return Traverse_Result is + procedure Replace_Type_References is + new Replace_Type_References_Generic (Replace_One_Reference); begin - if Nkind (N) = N_Raise_Expression then - Raise_Expression_Present := True; - return Abandon; - else - return OK; - end if; - end Test_RE; + Replace_Type_References (N, Typ); + end Replace_Current_Instance_References; -- Local variables @@ -10350,7 +10322,7 @@ package body Sem_Ch13 is Saved_IGR : constant Node_Id := Ignored_Ghost_Region; -- Save the Ghost-related attributes to restore on exit - -- Start of processing for Build_Predicate_Functions + -- Start of processing for Build_Predicate_Function begin -- Return if already built, if type does not have predicates, @@ -10412,8 +10384,7 @@ package body Sem_Ch13 is Defining_Identifier (First (Parameter_Specifications (Specification (FDecl)))); - Object_Name := Chars (Object_Entity); - Object_Entity_M := Make_Defining_Identifier (Loc, Chars => Object_Name); + Object_Name := Chars (Object_Entity); -- Add predicates for ancestor if present. These must come before the -- ones for the current type, as required by AI12-0071-1. @@ -10445,58 +10416,6 @@ package body Sem_Ch13 is if Present (Expr) then - -- Test for raise expression present - - Test_REs (Expr); - - -- If raise expression is present, capture a copy of Expr for use - -- in building the predicateM function version later on. For this - -- copy we replace references to Object_Entity by Object_Entity_M. - - if Raise_Expression_Present then - declare - function Reset_Loop_Variable - (N : Node_Id) return Traverse_Result; - - procedure Reset_Loop_Variables is - new Traverse_Proc (Reset_Loop_Variable); - - ------------------------ - -- Reset_Loop_Variable -- - ------------------------ - - function Reset_Loop_Variable - (N : Node_Id) return Traverse_Result - is - begin - if Nkind (N) = N_Iterator_Specification then - Set_Defining_Identifier (N, - Make_Defining_Identifier - (Sloc (N), Chars (Defining_Identifier (N)))); - end if; - - return OK; - end Reset_Loop_Variable; - - -- Local variables - - Map : constant Elist_Id := New_Elmt_List; - - begin - Append_Elmt (Object_Entity, Map); - Append_Elmt (Object_Entity_M, Map); - Expr_M := New_Copy_Tree (Expr, Map => Map); - - -- The unanalyzed expression will be copied and appear in - -- both functions. Normally expressions do not declare new - -- entities, but quantified expressions do, so we need to - -- create new entities for their bound variables, to prevent - -- multiple definitions in gigi. - - Reset_Loop_Variables (Expr_M); - end; - end if; - -- Build the main predicate function declare @@ -10514,27 +10433,189 @@ package body Sem_Ch13 is -- Build function body - Spec := - Make_Function_Specification (Loc, - Defining_Unit_Name => SIdB, - Parameter_Specifications => New_List ( - Make_Parameter_Specification (Loc, - Defining_Identifier => - Make_Defining_Identifier (Loc, Object_Name), - Parameter_Type => - New_Occurrence_Of (Typ, Loc))), - Result_Definition => - New_Occurrence_Of (Standard_Boolean, Loc)); - - FBody := - Make_Subprogram_Body (Loc, - Specification => Spec, - Declarations => Empty_List, - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_List ( - Make_Simple_Return_Statement (Loc, - Expression => Expr)))); + declare + Param_Specs : constant List_Id := New_List ( + Make_Parameter_Specification (Loc, + Defining_Identifier => + Make_Defining_Identifier (Loc, Object_Name), + Parameter_Type => + New_Occurrence_Of (Typ, Loc))); + begin + -- if Spec has 2 parameters, then body should too + if Present (Next_Entity (Object_Entity)) then + Append (Make_Parameter_Specification (Loc, + Defining_Identifier => + Make_Defining_Identifier + (Loc, Chars (Next_Entity (Object_Entity))), + Parameter_Type => + New_Occurrence_Of (Standard_Boolean, Loc)), + Param_Specs); + end if; + + Spec := + Make_Function_Specification (Loc, + Defining_Unit_Name => SIdB, + Parameter_Specifications => Param_Specs, + Result_Definition => + New_Occurrence_Of (Standard_Boolean, Loc)); + end; + + -- The Predicate_Expression attribute is used by SPARK. + -- + -- If Ancestor_Predicate_Function_Called is True, then + -- we try to exclude that call to the ancestor's + -- predicate function by calling Right_Opnd. + -- The call is not excluded in the case where + -- it is not "and"ed with anything else (so we don't have + -- an N_And_Then node). This exclusion is required if the + -- Predicate_Failure aspect is specified for Typ because + -- in that case we are going to drop the N_And_Then node + -- on the floor. Otherwise, it is a question of what is + -- most convenient for SPARK. + + Set_Predicate_Expression + (SId, (if Ancestor_Predicate_Function_Called + and then Nkind (Expr) = N_And_Then + then Right_Opnd (Expr) + else Expr)); + + declare + Result_Expr : Node_Id := Expr; + PF_Expr : Node_Id := Predicate_Failure_Expression + (Typ, Inherited_OK => False); + PF_Expr_Copy : Node_Id; + Second_Formal : constant Entity_Id := + Next_Entity (Object_Entity); + begin + -- In GNATprove mode we are only interested in the predicate + -- expression itself and don't want a raise expression that + -- comes from the Predicate_Failure. Ditto for CodePeer. + -- And an illegal Predicate_Failure aspect can lead to cases + -- we want to avoid. + + if Present (PF_Expr) + and then not GNATprove_Mode + and then not CodePeer_Mode + and then Serious_Errors_Detected = 0 + then + pragma Assert (Present (Second_Formal)); + + -- This is an ugly hack to cope with an ugly situation. + -- PF_Expr may have children whose Parent attribute + -- does not point back to PF_Expr. If we pass such a + -- tree to New_Copy_Tree, then it does not make a deep + -- copy. But we need a deep copy. So we need to find a + -- tree for which New_Copy_Tree *will* make a deep copy. + + declare + function Check_Node_Parent (Parent_Node, Node : Node_Id) + return Traverse_Result; + function Check_Node_Parent (Parent_Node, Node : Node_Id) + return Traverse_Result is + begin + if Parent_Node = PF_Expr + and then not Is_List_Member (Node) + then + pragma Assert + (Nkind (PF_Expr) = Nkind (Parent (Node))); + + -- We need PF_Expr to be a node for which + -- New_Copy_Tree will make a deep copy. + PF_Expr := Parent (Node); + return Abandon; + end if; + return OK; + end Check_Node_Parent; + procedure Check_Parentage is + new Traverse_Proc_With_Parent (Check_Node_Parent); + begin + Check_Parentage (PF_Expr); + PF_Expr_Copy := New_Copy_Tree (PF_Expr); + end; + + -- Current instance uses need to have their Entity + -- fields set so that Replace_Current_Instance_References + -- can find them. So we preanalyze. Just for purposes of + -- calls to Is_Current_Instance during this preanalysis, + -- we set the Parent field. + Set_Parent (PF_Expr_Copy, Parent (PF_Expr)); + Preanalyze (PF_Expr_Copy); + Set_Parent (PF_Expr_Copy, Empty); + + Replace_Current_Instance_References + (PF_Expr_Copy, Typ => Typ, New_Entity => Object_Entity); + + if Ancestor_Predicate_Function_Called then + -- If the call to an ancestor predicate function + -- returns False, we do not want to raise an + -- exception here. Our Predicate_Failure aspect does + -- not apply in that case. So we have to build a + -- more complicated result expression: + -- (if not Ancestor_Predicate_Function (...) then False + -- elsif Noninherited_Predicates (...) then True + -- elsif Is_Membership_Test then False + -- else (raise Assertion_Error with PF text)) + + declare + Ancestor_Call : constant Node_Id := + Left_Opnd (Result_Expr); + Local_Preds : constant Node_Id := + Right_Opnd (Result_Expr); + begin + Result_Expr := + Make_If_Expression (Loc, + Expressions => New_List ( + Make_Op_Not (Loc, Ancestor_Call), + New_Occurrence_Of (Standard_False, Loc), + Make_If_Expression (Loc, + Is_Elsif => True, + Expressions => New_List ( + Local_Preds, + New_Occurrence_Of (Standard_True, Loc), + Make_If_Expression (Loc, + Is_Elsif => True, + Expressions => New_List ( + New_Occurrence_Of (Second_Formal, Loc), + New_Occurrence_Of (Standard_False, Loc), + Make_Raise_Expression (Loc, + New_Occurrence_Of (RTE + (RE_Assert_Failure), Loc), + PF_Expr_Copy))))))); + end; + + else + -- Build a conditional expression: + -- (if <predicate evaluates to True> then True + -- elsif Is_Membership_Test then False + -- else (raise Assertion_Error with PF text)) + + Result_Expr := + Make_If_Expression (Loc, + Expressions => New_List ( + Result_Expr, + New_Occurrence_Of (Standard_True, Loc), + Make_If_Expression (Loc, + Is_Elsif => True, + Expressions => New_List ( + New_Occurrence_Of (Second_Formal, Loc), + New_Occurrence_Of (Standard_False, Loc), + Make_Raise_Expression (Loc, + New_Occurrence_Of (RTE + (RE_Assert_Failure), Loc), + PF_Expr_Copy))))); + end if; + end if; + + FBody := + Make_Subprogram_Body (Loc, + Specification => Spec, + Declarations => Empty_List, + Handled_Statement_Sequence => + Make_Handled_Sequence_Of_Statements (Loc, + Statements => New_List ( + Make_Simple_Return_Statement (Loc, + Expression => Result_Expr)))); + end; -- The declaration has been analyzed when created, and placed -- after type declaration. Insert body itself after freeze node, @@ -10605,121 +10686,6 @@ package body Sem_Ch13 is end if; end; - -- Test for raise expressions present and if so build M version - - if Raise_Expression_Present then - declare - SId : constant Entity_Id := - Make_Defining_Identifier (Loc, - Chars => New_External_Name (Chars (Typ), "PredicateM")); - -- The entity for the function spec - - SIdB : constant Entity_Id := - Make_Defining_Identifier (Loc, - Chars => New_External_Name (Chars (Typ), "PredicateM")); - -- The entity for the function body - - Spec : Node_Id; - FBody : Node_Id; - FDecl : Node_Id; - BTemp : Entity_Id; - - CRec_Typ : Entity_Id; - -- The corresponding record type of Full_Typ - - Full_Typ : Entity_Id; - -- The full view of Typ - - Priv_Typ : Entity_Id; - -- The partial view of Typ - - UFull_Typ : Entity_Id; - -- The underlying full view of Full_Typ - - begin - -- Mark any raise expressions for special expansion - - Process_REs (Expr_M); - - -- Build function declaration - - Mutate_Ekind (SId, E_Function); - Set_Is_Predicate_Function_M (SId); - Set_Predicate_Function_M (Typ, SId); - - -- Obtain all views of the input type - - Get_Views (Typ, Priv_Typ, Full_Typ, UFull_Typ, CRec_Typ); - - -- Associate the predicate function with all views - - Propagate_Predicate_Attributes (Priv_Typ, From_Typ => Typ); - Propagate_Predicate_Attributes (Full_Typ, From_Typ => Typ); - Propagate_Predicate_Attributes (UFull_Typ, From_Typ => Typ); - Propagate_Predicate_Attributes (CRec_Typ, From_Typ => Typ); - - Spec := - Make_Function_Specification (Loc, - Defining_Unit_Name => SId, - Parameter_Specifications => New_List ( - Make_Parameter_Specification (Loc, - Defining_Identifier => Object_Entity_M, - Parameter_Type => New_Occurrence_Of (Typ, Loc))), - Result_Definition => - New_Occurrence_Of (Standard_Boolean, Loc)); - - FDecl := - Make_Subprogram_Declaration (Loc, - Specification => Spec); - - -- Build function body - - Spec := - Make_Function_Specification (Loc, - Defining_Unit_Name => SIdB, - Parameter_Specifications => New_List ( - Make_Parameter_Specification (Loc, - Defining_Identifier => - Make_Defining_Identifier (Loc, Object_Name), - Parameter_Type => - New_Occurrence_Of (Typ, Loc))), - Result_Definition => - New_Occurrence_Of (Standard_Boolean, Loc)); - - -- Build the body, we declare the boolean expression before - -- doing the return, because we are not really confident of - -- what happens if a return appears within a return. - - BTemp := - Make_Temporary (Loc, 'B'); - - FBody := - Make_Subprogram_Body (Loc, - Specification => Spec, - - Declarations => New_List ( - Make_Object_Declaration (Loc, - Defining_Identifier => BTemp, - Constant_Present => True, - Object_Definition => - New_Occurrence_Of (Standard_Boolean, Loc), - Expression => Expr_M)), - - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_List ( - Make_Simple_Return_Statement (Loc, - Expression => New_Occurrence_Of (BTemp, Loc))))); - - -- Insert declaration before freeze node and body after - - Insert_Before_And_Analyze (N, FDecl); - Insert_After_And_Analyze (N, FBody); - - -- Should quantified expressions be handled here as well ??? - end; - end if; - -- See if we have a static predicate. Note that the answer may be -- yes even if we have an explicit Dynamic_Predicate present. @@ -10812,7 +10778,7 @@ package body Sem_Ch13 is end if; Restore_Ghost_Region (Saved_GM, Saved_IGR); - end Build_Predicate_Functions; + end Build_Predicate_Function; ------------------------------------------ -- Build_Predicate_Function_Declaration -- @@ -10881,15 +10847,28 @@ package body Sem_Ch13 is Propagate_Predicate_Attributes (UFull_Typ, From_Typ => Typ); Propagate_Predicate_Attributes (CRec_Typ, From_Typ => Typ); - Spec := - Make_Function_Specification (Loc, - Defining_Unit_Name => Func_Id, - Parameter_Specifications => New_List ( - Make_Parameter_Specification (Loc, - Defining_Identifier => Make_Temporary (Loc, 'I'), - Parameter_Type => New_Occurrence_Of (Typ, Loc))), - Result_Definition => - New_Occurrence_Of (Standard_Boolean, Loc)); + declare + Param_Specs : constant List_Id := New_List ( + Make_Parameter_Specification (Loc, + Defining_Identifier => Make_Temporary (Loc, 'I'), + Parameter_Type => New_Occurrence_Of (Typ, Loc))); + begin + if Predicate_Function_Needs_Membership_Parameter (Typ) then + -- Add Boolean-valued For_Membership_Test param + Append (Make_Parameter_Specification (Loc, + Defining_Identifier => Make_Temporary (Loc, 'M'), + Parameter_Type => + New_Occurrence_Of (Standard_Boolean, Loc)), + Param_Specs); + end if; + + Spec := + Make_Function_Specification (Loc, + Defining_Unit_Name => Func_Id, + Parameter_Specifications => Param_Specs, + Result_Definition => + New_Occurrence_Of (Standard_Boolean, Loc)); + end; Func_Decl := Make_Subprogram_Declaration (Loc, Specification => Spec); @@ -13153,7 +13132,7 @@ package body Sem_Ch13 is end if; end; - Build_Predicate_Functions (E, N); + Build_Predicate_Function (E, N); end if; -- If type has delayed aspects, this is where we do the preanalysis at @@ -13472,56 +13451,40 @@ package body Sem_Ch13 is ----------------------------------- function Has_Compatible_Representation - (Target_Type, Operand_Type : Entity_Id) return Boolean + (Target_Typ, Operand_Typ : Entity_Id) return Boolean is - T1 : constant Entity_Id := Underlying_Type (Target_Type); - T2 : constant Entity_Id := Underlying_Type (Operand_Type); + -- The subtype-specific representation attributes (Size and Alignment) + -- do not affect representation from the point of view of this function. - begin - -- A quick check, if base types are the same, then we definitely have - -- the same representation, because the subtype specific representation - -- attributes (Size and Alignment) do not affect representation from - -- the point of view of this test. - - if Base_Type (T1) = Base_Type (T2) then - return True; - - elsif Is_Private_Type (Base_Type (T2)) - and then Base_Type (T1) = Full_View (Base_Type (T2)) - then - return True; + T1 : constant Entity_Id := Implementation_Base_Type (Target_Typ); + T2 : constant Entity_Id := Implementation_Base_Type (Operand_Typ); - -- If T2 is a generic actual it is declared as a subtype, so - -- check against its base type. + begin + -- Return true immediately for the same base type - elsif Is_Generic_Actual_Type (T1) - and then Has_Compatible_Representation (Base_Type (T1), T2) - then + if T1 = T2 then return True; - end if; -- Tagged types always have the same representation, because it is not -- possible to specify different representations for common fields. - if Is_Tagged_Type (T1) then + elsif Is_Tagged_Type (T1) then return True; - end if; -- Representations are definitely different if conventions differ - if Convention (T1) /= Convention (T2) then + elsif Convention (T1) /= Convention (T2) then return False; - end if; -- Representations are different if component alignments or scalar -- storage orders differ. - if (Is_Record_Type (T1) or else Is_Array_Type (T1)) - and then - (Is_Record_Type (T2) or else Is_Array_Type (T2)) - and then - (Component_Alignment (T1) /= Component_Alignment (T2) - or else Reverse_Storage_Order (T1) /= Reverse_Storage_Order (T2)) + elsif (Is_Record_Type (T1) or else Is_Array_Type (T1)) + and then + (Is_Record_Type (T2) or else Is_Array_Type (T2)) + and then (Component_Alignment (T1) /= Component_Alignment (T2) + or else + Reverse_Storage_Order (T1) /= Reverse_Storage_Order (T2)) then return False; end if; @@ -13548,11 +13511,10 @@ package body Sem_Ch13 is then return True; end if; - end if; - -- For records, representations are different if reorderings differ + -- For records, representations are different if reordering differs - if Is_Record_Type (T1) + elsif Is_Record_Type (T1) and then Is_Record_Type (T2) and then No_Reordering (T1) /= No_Reordering (T2) then @@ -13592,6 +13554,16 @@ package body Sem_Ch13 is if Is_Packed (T1) /= Is_Packed (T2) then return False; + -- If the operand type is derived from the target type and no clause + -- has been given after the derivation, then the representations are + -- the same since the derived type inherits that of the parent type. + + elsif Is_Derived_Type (T2) + and then Etype (T2) = T1 + and then not Has_Record_Rep_Clause (T2) + then + return True; + -- Otherwise we must check components. Typ2 maybe a constrained -- subtype with fewer components, so we compare the components -- of the base types. diff --git a/gcc/ada/sem_ch13.ads b/gcc/ada/sem_ch13.ads index a16171d..e0d84c9 100644 --- a/gcc/ada/sem_ch13.ads +++ b/gcc/ada/sem_ch13.ads @@ -130,12 +130,11 @@ package Sem_Ch13 is -- clause, T is the component type. function Has_Compatible_Representation - (Target_Type, Operand_Type : Entity_Id) return Boolean; - -- Given two types, where the two types are related by possible derivation, - -- determines if the two types have compatible representation, or different - -- representations, requiring the special processing for representation - -- change. A False result is possible only for array, enumeration or - -- record types. + (Target_Typ, Operand_Typ : Entity_Id) return Boolean; + -- Given an explicit or implicit conversion from Operand_Typ to Target_Typ, + -- determine whether the types have compatible or different representation, + -- thus requiring special processing for the conversion in the latter case. + -- A False result is possible only for array, enumeration and record types. procedure Parse_Aspect_Aggregate (N : Node_Id; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 054648b..34dac1d 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -61,6 +61,7 @@ with Sem_Cat; use Sem_Cat; with Sem_Ch6; use Sem_Ch6; with Sem_Ch7; use Sem_Ch7; with Sem_Ch8; use Sem_Ch8; +with Sem_Ch10; use Sem_Ch10; with Sem_Ch13; use Sem_Ch13; with Sem_Dim; use Sem_Dim; with Sem_Disp; use Sem_Disp; @@ -3158,7 +3159,7 @@ package body Sem_Ch3 is and then Present (Full_View (Prev)) then T := Full_View (Prev); - Set_Incomplete_View (N, Parent (Prev)); + Set_Incomplete_View (N, Prev); else T := Prev; end if; @@ -4571,11 +4572,15 @@ package body Sem_Ch3 is null; -- Do not generate a predicate check if the initialization expression - -- is a type conversion because the conversion has been subjected to - -- the same check. This is a small optimization which avoid redundant + -- is a type conversion whose target subtype statically matches the + -- object's subtype because the conversion has been subjected to the + -- same check. This is a small optimization which avoids redundant -- checks. - elsif Present (E) and then Nkind (E) = N_Type_Conversion then + elsif Present (E) + and then Nkind (E) in N_Type_Conversion + and then Subtypes_Statically_Match (Etype (Subtype_Mark (E)), T) + then null; else @@ -5977,7 +5982,7 @@ package body Sem_Ch3 is if Nkind (Subtype_Indication (N)) = N_Subtype_Indication then declare Indic_Typ : constant Entity_Id := - Etype (Subtype_Mark (Subtype_Indication (N))); + Underlying_Type (Etype (Subtype_Mark (Subtype_Indication (N)))); Subt_Index : Node_Id; Target_Index : Node_Id; @@ -11046,6 +11051,14 @@ package body Sem_Ch3 is Subp := Node (Elmt); Alias_Subp := Alias (Subp); + -- If the parent type is untagged, then no overriding error checks + -- are needed (such as in the case of an implicit full type for + -- a derived type whose parent is an untagged private type with + -- a tagged full type). + + if not Is_Tagged_Type (Etype (T)) then + null; + -- Inherited subprograms are identified by the fact that they do not -- come from source, and the associated source location is the -- location of the first subtype of the derived type. @@ -11064,7 +11077,7 @@ package body Sem_Ch3 is -- overriding in Ada 2005, but wrappers need to be built for them -- (see exp_ch3, Build_Controlling_Function_Wrappers). - if Is_Null_Extension (T) + elsif Is_Null_Extension (T) and then Has_Controlling_Result (Subp) and then Ada_Version >= Ada_2005 and then Present (Alias_Subp) @@ -11600,10 +11613,9 @@ package body Sem_Ch3 is if H = Typ then Set_Name_Entity_Id (Chars (Typ), Homonym (Typ)); + else - while Present (H) - and then Homonym (H) /= Typ - loop + while Present (Homonym (H)) and then Homonym (H) /= Typ loop H := Homonym (Typ); end loop; @@ -11613,16 +11625,48 @@ package body Sem_Ch3 is Insert_Before (Typ_Decl, Decl); Analyze (Decl); Set_Full_View (Inc_T, Typ); + Set_Incomplete_View (Typ_Decl, Inc_T); - if Is_Tagged then - - -- Create a common class-wide type for both views, and set the - -- Etype of the class-wide type to the full view. + -- If the type is tagged, create a common class-wide type for + -- both views, and set the Etype of the class-wide type to the + -- full view. + if Is_Tagged then Make_Class_Wide_Type (Inc_T); Set_Class_Wide_Type (Typ, Class_Wide_Type (Inc_T)); Set_Etype (Class_Wide_Type (Typ), Typ); end if; + + -- If the scope is a package with a limited view, create a shadow + -- entity for the incomplete type like Build_Limited_Views, so as + -- to make it possible for Remove_Limited_With_Unit to reinstall + -- this incomplete type as the visible entity. + + if Ekind (Scope (Inc_T)) = E_Package + and then Present (Limited_View (Scope (Inc_T))) + then + declare + Shadow : constant Entity_Id := Make_Temporary (Loc, 'Z'); + + begin + -- This is modeled on Build_Shadow_Entity + + Set_Chars (Shadow, Chars (Inc_T)); + Set_Parent (Shadow, Decl); + Decorate_Type (Shadow, Scope (Inc_T), Is_Tagged); + Set_Is_Internal (Shadow); + Set_From_Limited_With (Shadow); + Set_Non_Limited_View (Shadow, Inc_T); + Set_Private_Dependents (Shadow, New_Elmt_List); + + if Is_Tagged then + Set_Non_Limited_View + (Class_Wide_Type (Shadow), Class_Wide_Type (Inc_T)); + end if; + + Append_Entity (Shadow, Limited_View (Scope (Inc_T))); + end; + end if; end if; end Build_Incomplete_Type_Declaration; @@ -13563,6 +13607,8 @@ package body Sem_Ch3 is T := Designated_Type (T); end if; + T := Underlying_Type (T); + -- If an index constraint follows a subtype mark in a subtype indication -- then the type or subtype denoted by the subtype mark must not already -- impose an index constraint. The subtype mark must denote either an diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index ad7448f..8fe2077 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -1253,19 +1253,11 @@ package body Sem_Ch4 is -- If the nonoverloaded interpretation is a call to an abstract -- nondispatching operation, then flag an error and return. - -- Should this be incorporated in Remove_Abstract_Operations (which - -- currently only deals with cases where the name is overloaded)? ??? - if Is_Overloadable (Nam_Ent) and then Is_Abstract_Subprogram (Nam_Ent) and then not Is_Dispatching_Operation (Nam_Ent) then - Set_Etype (N, Any_Type); - - Error_Msg_Sloc := Sloc (Nam_Ent); - Error_Msg_NE - ("cannot call abstract operation& declared#", N, Nam_Ent); - + Nondispatching_Call_To_Abstract_Operation (N, Nam_Ent); return; end if; @@ -3386,18 +3378,11 @@ package body Sem_Ch4 is Check_Fully_Declared (Entity (R), R); elsif Ada_Version >= Ada_2012 and then Find_Interp then - if Nkind (N) = N_In then - Op := Make_Op_Eq (Loc, Left_Opnd => L, Right_Opnd => R); - else - Op := Make_Op_Ne (Loc, Left_Opnd => L, Right_Opnd => R); - end if; + Op := Make_Op_Eq (Loc, Left_Opnd => L, Right_Opnd => R); + Resolve_Membership_Equality (Op, Etype (L)); - if Is_Record_Or_Limited_Type (Etype (L)) then - - -- We reset the Entity in order to use the primitive equality - -- of the type, as per RM 4.5.2 (28.1/4). - - Set_Entity (Op, Empty); + if Nkind (N) = N_Not_In then + Op := Make_Op_Not (Loc, Op); end if; Rewrite (N, Op); @@ -3461,8 +3446,9 @@ package body Sem_Ch4 is ---------------------- procedure Analyze_Negation (N : Node_Id) is - R : constant Node_Id := Right_Opnd (N); - Op_Id : Entity_Id := Entity (N); + R : constant Node_Id := Right_Opnd (N); + + Op_Id : Entity_Id; begin Set_Etype (N, Any_Type); @@ -3470,7 +3456,15 @@ package body Sem_Ch4 is Analyze_Expression (R); - if Present (Op_Id) then + -- If the entity is already set, the node is the instantiation of a + -- generic node with a non-local reference, or was manufactured by a + -- call to Make_Op_xxx. In either case the entity is known to be valid, + -- and we do not need to collect interpretations, instead we just get + -- the single possible interpretation. + + if Present (Entity (N)) then + Op_Id := Entity (N); + if Ekind (Op_Id) = E_Operator then Find_Negation_Types (R, Op_Id, N); else @@ -6067,8 +6061,9 @@ package body Sem_Ch4 is ---------------------- procedure Analyze_Unary_Op (N : Node_Id) is - R : constant Node_Id := Right_Opnd (N); - Op_Id : Entity_Id := Entity (N); + R : constant Node_Id := Right_Opnd (N); + + Op_Id : Entity_Id; begin Set_Etype (N, Any_Type); @@ -6076,7 +6071,15 @@ package body Sem_Ch4 is Analyze_Expression (R); - if Present (Op_Id) then + -- If the entity is already set, the node is the instantiation of a + -- generic node with a non-local reference, or was manufactured by a + -- call to Make_Op_xxx. In either case the entity is known to be valid, + -- and we do not need to collect interpretations, instead we just get + -- the single possible interpretation. + + if Present (Entity (N)) then + Op_Id := Entity (N); + if Ekind (Op_Id) = E_Operator then Find_Unary_Types (R, Op_Id, N); else @@ -7854,6 +7857,42 @@ package body Sem_Ch4 is return Etype (N) /= Any_Type; end Has_Possible_Literal_Aspects; + ----------------------------------------------- + -- Nondispatching_Call_To_Abstract_Operation -- + ----------------------------------------------- + + procedure Nondispatching_Call_To_Abstract_Operation + (N : Node_Id; + Abstract_Op : Entity_Id) + is + Typ : constant Entity_Id := Etype (N); + + begin + -- In an instance body, this is a runtime check, but one we know will + -- fail, so give an appropriate warning. As usual this kind of warning + -- is an error in SPARK mode. + + Error_Msg_Sloc := Sloc (Abstract_Op); + + if In_Instance_Body and then SPARK_Mode /= On then + Error_Msg_NE + ("??cannot call abstract operation& declared#", + N, Abstract_Op); + Error_Msg_N ("\Program_Error [??", N); + Rewrite (N, + Make_Raise_Program_Error (Sloc (N), + Reason => PE_Explicit_Raise)); + Analyze (N); + Set_Etype (N, Typ); + + else + Error_Msg_NE + ("cannot call abstract operation& declared#", + N, Abstract_Op); + Set_Etype (N, Any_Type); + end if; + end Nondispatching_Call_To_Abstract_Operation; + ---------------------------------------------- -- Possible_Type_For_Conditional_Expression -- ---------------------------------------------- @@ -8173,10 +8212,7 @@ package body Sem_Ch4 is -- Removal of abstract operation left no viable candidate - Set_Etype (N, Any_Type); - Error_Msg_Sloc := Sloc (Abstract_Op); - Error_Msg_NE - ("cannot call abstract operation& declared#", N, Abstract_Op); + Nondispatching_Call_To_Abstract_Operation (N, Abstract_Op); -- In Ada 2005, an abstract operation may disable predefined -- operators. Since the context is not yet known, we mark the diff --git a/gcc/ada/sem_ch4.ads b/gcc/ada/sem_ch4.ads index 870edea..ed2b132 100644 --- a/gcc/ada/sem_ch4.ads +++ b/gcc/ada/sem_ch4.ads @@ -67,6 +67,12 @@ package Sem_Ch4 is -- The resolution of the construct requires some semantic information -- on the prefix and the indexes. + procedure Nondispatching_Call_To_Abstract_Operation + (N : Node_Id; + Abstract_Op : Entity_Id); + -- Give an error, or a warning and rewrite N to raise Program_Error because + -- it is a nondispatching call to an abstract operation. + function Try_Object_Operation (N : Node_Id; CW_Test_Only : Boolean := False; diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 7fd5ab3..e6d34c3 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -1111,7 +1111,7 @@ package body Sem_Ch5 is -- Where the object is the same on both sides - and then Same_Object (Lhs, Original_Node (Rhs)) + and then Same_Object (Lhs, Rhs) -- But exclude the case where the right side was an operation that -- got rewritten (e.g. JUNK + K, where K was known to be zero). We @@ -2316,7 +2316,7 @@ package body Sem_Ch5 is Defining_Identifier => S, Subtype_Indication => New_Copy_Tree (Subt)); begin - Insert_Before (Parent (Parent (N)), Decl); + Insert_Action (N, Decl); Analyze (Decl); Rewrite (Subt, New_Occurrence_Of (S, Sloc (Subt))); end; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 17e7d26..a537358 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -190,14 +190,12 @@ package body Sem_Ch6 is -- in posting the warning message. procedure Check_Untagged_Equality (Eq_Op : Entity_Id); - -- In Ada 2012, a primitive equality operator on an untagged record type - -- must appear before the type is frozen, and have the same visibility as - -- that of the type. This procedure checks that this rule is met, and - -- otherwise emits an error on the subprogram declaration and a warning - -- on the earlier freeze point if it is easy to locate. In Ada 2012 mode, - -- this routine outputs errors (or warnings if -gnatd.E is set). In earlier - -- versions of Ada, warnings are output if Warn_On_Ada_2012_Incompatibility - -- is set, otherwise the call has no effect. + -- In Ada 2012, a primitive equality operator for an untagged record type + -- must appear before the type is frozen. This procedure checks that this + -- rule is met, and otherwise gives an error on the subprogram declaration + -- and a warning on the earlier freeze point if it is easy to pinpoint. In + -- earlier versions of Ada, the call has not effect, unless compatibility + -- warnings are requested by means of Warn_On_Ada_2012_Incompatibility. procedure Enter_Overloaded_Entity (S : Entity_Id); -- This procedure makes S, a new overloaded entity, into the first visible @@ -1568,17 +1566,18 @@ package body Sem_Ch6 is -- Check RM 6.5 (5.9/3) - if Has_Aliased then + if Has_Aliased and then not Is_Immutably_Limited_Type (R_Type) then if Ada_Version < Ada_2012 and then Warn_On_Ada_2012_Compatibility then Error_Msg_N - ("ALIASED only allowed for limited return objects " - & "in Ada 2012?y?", N); + ("ALIASED only allowed for immutably limited return " & + "objects in Ada 2012?y?", N); - elsif not Is_Limited_View (R_Type) then + else Error_Msg_N - ("ALIASED only allowed for limited return objects", N); + ("ALIASED only allowed for immutably limited return " & + "objects", N); end if; end if; @@ -3733,6 +3732,7 @@ package body Sem_Ch6 is procedure Detect_And_Exchange (Id : Entity_Id) is Typ : constant Entity_Id := Etype (Id); + begin if From_Limited_With (Typ) and then Has_Non_Limited_View (Typ) @@ -5189,23 +5189,34 @@ package body Sem_Ch6 is -- is the limited view of a class-wide type and the non-limited view is -- available, update the return type accordingly. - if Ada_Version >= Ada_2005 and then Present (Spec_Id) then + if Ada_Version >= Ada_2005 + and then Present (Spec_Id) + and then Ekind (Etype (Spec_Id)) = E_Anonymous_Access_Type + then declare Etyp : Entity_Id; - Rtyp : Entity_Id; begin - Rtyp := Etype (Spec_Id); + Etyp := Directly_Designated_Type (Etype (Spec_Id)); - if Ekind (Rtyp) = E_Anonymous_Access_Type then - Etyp := Directly_Designated_Type (Rtyp); + if Is_Class_Wide_Type (Etyp) + and then From_Limited_With (Etyp) + and then Has_Non_Limited_View (Etyp) + then + Desig_View := Etyp; + Etyp := Non_Limited_View (Etyp); - if Is_Class_Wide_Type (Etyp) - and then From_Limited_With (Etyp) + -- If the class-wide type has been created by the completion of + -- an incomplete tagged type declaration, get the class-wide + -- type of the incomplete tagged type to match Find_Type_Name. + + if Nkind (Parent (Etyp)) = N_Full_Type_Declaration + and then Present (Incomplete_View (Parent (Etyp))) then - Desig_View := Etyp; - Set_Directly_Designated_Type (Rtyp, Available_View (Etyp)); + Etyp := Class_Wide_Type (Incomplete_View (Parent (Etyp))); end if; + + Set_Directly_Designated_Type (Etype (Spec_Id), Etyp); end if; end; end if; @@ -5449,6 +5460,22 @@ package body Sem_Ch6 is end; end; + -- Check if a Body_To_Inline was created, but the subprogram has + -- references to object renamings which will be replaced by the special + -- SPARK expansion into nodes of a different kind, which is not expected + -- by the inlining mechanism. In that case, the Body_To_Inline is + -- deleted prior to being analyzed. This check needs to take place + -- after analysis of the subprogram body. + + if GNATprove_Mode + and then Present (Spec_Id) + and then + Nkind (Unit_Declaration_Node (Spec_Id)) = N_Subprogram_Declaration + and then Present (Body_To_Inline (Unit_Declaration_Node (Spec_Id))) + then + Check_Object_Renaming_In_GNATprove_Mode (Spec_Id); + end if; + -- Check for variables that are never modified declare @@ -9499,12 +9526,12 @@ package body Sem_Ch6 is begin -- This check applies only if we have a subprogram declaration with an - -- untagged record type that is conformant to the predefined op. + -- untagged record type that is conformant to the predefined operator. if Nkind (Decl) /= N_Subprogram_Declaration or else not Is_Record_Type (Typ) or else Is_Tagged_Type (Typ) - or else Etype (Next_Formal (First_Formal (Eq_Op))) /= Typ + or else not Is_User_Defined_Equality (Eq_Op) then return; end if; @@ -9616,22 +9643,7 @@ package body Sem_Ch6 is end if; end if; - -- Here if type is not frozen yet. It is illegal to have a primitive - -- equality declared in the private part if the type is visible - -- (RM 4.5.2(9.8)). - - elsif not In_Same_List (Parent (Typ), Decl) - and then not Is_Limited_Type (Typ) - then - if Ada_Version >= Ada_2012 then - Error_Msg_N - ("equality operator appears too late<<", Eq_Op); - else - Error_Msg_N - ("equality operator appears too late (Ada 2012)?y?", Eq_Op); - end if; - - -- Finally check for AI12-0352: declaration of a user-defined primitive + -- Now check for AI12-0352: the declaration of a user-defined primitive -- equality operation for a record type T is illegal if it occurs after -- a type has been derived from T. @@ -9855,7 +9867,8 @@ package body Sem_Ch6 is and then Ada_Version >= Ada_2005 and then not Comes_From_Source (E) and then Has_Controlling_Result (E) - and then Is_Null_Extension (Etype (E)) + and then (not Is_Class_Wide_Type (Etype (E)) + and then Is_Null_Extension (Etype (E))) and then Comes_From_Source (Spec) then Set_Has_Completion (E, False); @@ -10111,14 +10124,13 @@ package body Sem_Ch6 is and then Discriminal_Link (Entity (E1)) = Discriminal_Link (Entity (E2))) - -- AI12-050: The loop variables of quantified expressions match - -- if they have the same identifier, even though they may have - -- different entities. + -- AI12-050: The entities of quantified expressions match if they + -- have the same identifier, even if they may be distinct nodes. or else (Chars (Entity (E1)) = Chars (Entity (E2)) - and then Ekind (Entity (E1)) = E_Loop_Parameter - and then Ekind (Entity (E2)) = E_Loop_Parameter) + and then Is_Entity_Of_Quantified_Expression (Entity (E1)) + and then Is_Entity_Of_Quantified_Expression (Entity (E2))) -- A call to an instantiation of Unchecked_Conversion is -- rewritten with the name of the generated function created for @@ -11254,7 +11266,8 @@ package body Sem_Ch6 is function Overrides_Private_Part_Op return Boolean is Over_Decl : constant Node_Id := - Unit_Declaration_Node (Overridden_Operation (S)); + Unit_Declaration_Node + (Ultimate_Alias (Overridden_Operation (S))); Subp_Decl : constant Node_Id := Unit_Declaration_Node (S); begin diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index e94971f..c43686b 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -269,7 +269,8 @@ package body Sem_Ch7 is -- declaration. Examine all declarations in list Decls in reverse -- and determine whether one such referencer exists. All entities -- in the range Last (Decls) .. Referencer are hidden from external - -- visibility. + -- visibility. In_Nested_Instance is true if we are inside a package + -- instance that has a body. function Scan_Subprogram_Ref (N : Node_Id) return Traverse_Result; -- Determine whether a node denotes a reference to a subprogram @@ -282,8 +283,7 @@ package body Sem_Ch7 is -- tree traversal. procedure Scan_Subprogram_Refs (Node : Node_Id); - -- If we haven't already traversed Node, then mark it and traverse - -- it. + -- If we haven't already traversed Node, then mark and traverse it. -------------------- -- Has_Referencer -- @@ -294,16 +294,17 @@ package body Sem_Ch7 is In_Nested_Instance : Boolean; Has_Outer_Referencer_Of_Non_Subprograms : Boolean) return Boolean is - Decl : Node_Id; - Decl_Id : Entity_Id; - Spec : Node_Id; - Has_Referencer_Of_Non_Subprograms : Boolean := Has_Outer_Referencer_Of_Non_Subprograms; -- Set if an inlined subprogram body was detected as a referencer. -- In this case, we do not return True immediately but keep hiding -- subprograms from external visibility. + Decl : Node_Id; + Decl_Id : Entity_Id; + In_Instance : Boolean; + Spec : Node_Id; + begin if No (Decls) then return False; @@ -331,16 +332,22 @@ package body Sem_Ch7 is -- and hide more entities from external visibility. if not Is_Generic_Unit (Decl_Id) then + if In_Nested_Instance then + In_Instance := True; + elsif Is_Generic_Instance (Decl_Id) then + In_Instance := + Has_Completion (Decl_Id) + or else Unit_Requires_Body (Generic_Parent (Spec)); + else + In_Instance := False; + end if; + if Has_Referencer (Private_Declarations (Spec), - In_Nested_Instance - or else - Is_Generic_Instance (Decl_Id), + In_Instance, Has_Referencer_Of_Non_Subprograms) or else Has_Referencer (Visible_Declarations (Spec), - In_Nested_Instance - or else - Is_Generic_Instance (Decl_Id), + In_Instance, Has_Referencer_Of_Non_Subprograms) then return True; @@ -474,6 +481,11 @@ package body Sem_Ch7 is then Decl_Id := Defining_Entity (Decl); + -- We cannot say anything for objects declared in nested + -- instances because instantiations are not done yet so the + -- bodies are not visible and could contain references to + -- them. + if not In_Nested_Instance and then not Is_Imported (Decl_Id) and then not Is_Exported (Decl_Id) @@ -1313,6 +1325,11 @@ package body Sem_Ch7 is -- Reject completion of an incomplete or private type declarations -- having a known discriminant part by an unchecked union. + procedure Inspect_Untagged_Record_Completion (Decls : List_Id); + -- Find out whether a nonlimited untagged record completion has got a + -- primitive equality operator and, if so, make it so that it will be + -- used as the predefined operator of the private view of the record. + procedure Install_Parent_Private_Declarations (Inst_Id : Entity_Id); -- Given the package entity of a generic package instantiation or -- formal package whose corresponding generic is a child unit, installs @@ -1437,7 +1454,7 @@ package body Sem_Ch7 is Decl := First (Decls); while Present (Decl) loop - -- We are looking at an incomplete or private type declaration + -- We are looking for an incomplete or private type declaration -- with a known_discriminant_part whose full view is an -- Unchecked_Union. The seemingly useless check with Is_Type -- prevents cascaded errors when routines defined only for type @@ -1461,6 +1478,103 @@ package body Sem_Ch7 is end loop; end Inspect_Unchecked_Union_Completion; + ---------------------------------------- + -- Inspect_Untagged_Record_Completion -- + ---------------------------------------- + + procedure Inspect_Untagged_Record_Completion (Decls : List_Id) is + Decl : Node_Id; + + begin + Decl := First (Decls); + while Present (Decl) loop + + -- We are looking for a full type declaration of an untagged + -- record with a private declaration and primitive operations. + + if Nkind (Decl) in N_Full_Type_Declaration + and then Is_Record_Type (Defining_Identifier (Decl)) + and then not Is_Limited_Type (Defining_Identifier (Decl)) + and then not Is_Tagged_Type (Defining_Identifier (Decl)) + and then Has_Private_Declaration (Defining_Identifier (Decl)) + and then Has_Primitive_Operations (Defining_Identifier (Decl)) + then + declare + Prim_List : constant Elist_Id := + Collect_Primitive_Operations (Defining_Identifier (Decl)); + + E : Entity_Id; + Ne_Id : Entity_Id; + Op_Decl : Node_Id; + Op_Id : Entity_Id; + Prim : Elmt_Id; + + begin + Prim := First_Elmt (Prim_List); + while Present (Prim) loop + Op_Id := Node (Prim); + Op_Decl := Declaration_Node (Op_Id); + if Nkind (Op_Decl) in N_Subprogram_Specification then + Op_Decl := Parent (Op_Decl); + end if; + + -- We are looking for an equality operator immediately + -- visible and declared in the private part followed by + -- the synthesized inequality operator. + + if Is_User_Defined_Equality (Op_Id) + and then Is_Immediately_Visible (Op_Id) + and then List_Containing (Op_Decl) = Decls + then + Ne_Id := Next_Entity (Op_Id); + pragma Assert (Ekind (Ne_Id) = E_Function + and then Corresponding_Equality (Ne_Id) = Op_Id); + + E := First_Private_Entity (Id); + + -- Move them from the private part of the entity list + -- up to the end of the visible part of the same list. + + Remove_Entity (Op_Id); + Remove_Entity (Ne_Id); + + Link_Entities (Prev_Entity (E), Op_Id); + Link_Entities (Op_Id, Ne_Id); + Link_Entities (Ne_Id, E); + + -- And if the private part contains another equality + -- operator, move the equality operator to after it + -- in the homonym chain, so that all its next homonyms + -- in the same scope, if any, also are in the visible + -- part. This is relied upon to resolve expanded names + -- in Collect_Interps for example. + + while Present (E) loop + exit when Ekind (E) = E_Function + and then Chars (E) = Name_Op_Eq; + + Next_Entity (E); + end loop; + + if Present (E) then + Remove_Homonym (Op_Id); + + Set_Homonym (Op_Id, Homonym (E)); + Set_Homonym (E, Op_Id); + end if; + + exit; + end if; + + Next_Elmt (Prim); + end loop; + end; + end if; + + Next (Decl); + end loop; + end Inspect_Untagged_Record_Completion; + ----------------------------------------- -- Install_Parent_Private_Declarations -- ----------------------------------------- @@ -1711,14 +1825,18 @@ package body Sem_Ch7 is -- If this is a package associated with a generic instance or formal -- package, then the private declarations of each of the generic's - -- parents must be installed at this point. + -- parents must be installed at this point, but not if this is the + -- abbreviated instance created to check a formal package, see the + -- same condition in Analyze_Package_Instantiation. - if Is_Generic_Instance (Id) then + if Is_Generic_Instance (Id) + and then not Is_Abbreviated_Instance (Id) + then Install_Parent_Private_Declarations (Id); end if; -- Analyze private part if present. The flag In_Private_Part is reset - -- in End_Package_Scope. + -- in Uninstall_Declarations. L := Last_Entity (Id); @@ -1815,6 +1933,14 @@ package body Sem_Ch7 is Inspect_Unchecked_Union_Completion (Priv_Decls); end if; + -- Implement AI12-0101 (which only removes a legality rule) and then + -- AI05-0123 (which directly applies in the previously illegal case) + -- in Ada 2012. Note that AI12-0101 is a binding interpretation. + + if Present (Priv_Decls) and then Ada_Version >= Ada_2012 then + Inspect_Untagged_Record_Completion (Priv_Decls); + end if; + if Ekind (Id) = E_Generic_Package and then Nkind (Orig_Decl) = N_Generic_Package_Declaration and then Present (Priv_Decls) @@ -2172,9 +2298,8 @@ package body Sem_Ch7 is -- a derived scalar type). Further declarations cannot -- include inherited operations of the type. - if Present (Prim_Op) then - exit when Ekind (Prim_Op) not in Overloadable_Kind; - end if; + exit when Present (Prim_Op) + and then not Is_Overloadable (Prim_Op); end loop; end if; end if; @@ -3093,10 +3218,12 @@ package body Sem_Ch7 is if not In_Private_Part (P) then return; - else - Set_In_Private_Part (P, False); end if; + -- Reset the flag now + + Set_In_Private_Part (P, False); + -- Make private entities invisible and exchange full and private -- declarations for private types. Id is now the first private entity -- in the package. diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 60c2ce6..35a9054 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -3967,6 +3967,30 @@ package body Sem_Ch8 is ("implicit operation& is not visible (RM 8.3 (15))", Nam, Old_S); end if; + + -- Check whether an expanded name used for the renamed subprogram + -- begins with the same name as the renaming itself, and if so, + -- issue an error about the prefix being hidden by the renaming. + -- We exclude generic instances from this checking, since such + -- normally illegal renamings can be constructed when expanding + -- instantiations. + + elsif Nkind (Nam) = N_Expanded_Name and then not In_Instance then + declare + function Ult_Expanded_Prefix (N : Node_Id) return Node_Id is + (if Nkind (N) /= N_Expanded_Name + then N + else Ult_Expanded_Prefix (Prefix (N))); + -- Returns the ultimate prefix of an expanded name + + begin + if Chars (Entity (Ult_Expanded_Prefix (Nam))) = Chars (New_S) + then + Error_Msg_Sloc := Sloc (N); + Error_Msg_NE + ("& is hidden by declaration#", Nam, New_S); + end if; + end; end if; Set_Convention (New_S, Convention (Old_S)); @@ -6971,6 +6995,8 @@ package body Sem_Ch8 is Standard_Standard) then if not Error_Posted (N) then + Error_Msg_NE + ("& is not a visible entity of&", Prefix (N), Selector); Error_Missing_With_Of_Known_Unit (Prefix (N)); end if; diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index c27de57..2f8f01b 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -2293,6 +2293,64 @@ package body Sem_Ch9 is --------------------- procedure Analyze_Requeue (N : Node_Id) is + + procedure Check_Wrong_Attribute_In_Postconditions + (Entry_Id : Entity_Id; + Error_Node : Node_Id); + -- Check that the requeue target Entry_Id does not have an specific or + -- class-wide postcondition that references an Old or Index attribute. + + --------------------------------------------- + -- Check_Wrong_Attribute_In_Postconditions -- + --------------------------------------------- + + procedure Check_Wrong_Attribute_In_Postconditions + (Entry_Id : Entity_Id; + Error_Node : Node_Id) + is + function Check_Node (N : Node_Id) return Traverse_Result; + -- Check that N is not a reference to attribute Index or Old; report + -- an error otherwise. + + ---------------- + -- Check_Node -- + ---------------- + + function Check_Node (N : Node_Id) return Traverse_Result is + begin + if Nkind (N) = N_Attribute_Reference + and then Attribute_Name (N) in Name_Index + | Name_Old + then + Error_Msg_Name_1 := Attribute_Name (N); + Error_Msg_N + ("target of requeue must not have references to attribute % " + & "in postcondition", + Error_Node); + end if; + + return OK; + end Check_Node; + + procedure Check_Attr_Refs is new Traverse_Proc (Check_Node); + + -- Local variables + + Prag : Node_Id; + begin + Prag := Pre_Post_Conditions (Contract (Entry_Id)); + + while Present (Prag) loop + if Pragma_Name (Prag) = Name_Postcondition then + Check_Attr_Refs (First (Pragma_Argument_Associations (Prag))); + end if; + + Prag := Next_Pragma (Prag); + end loop; + end Check_Wrong_Attribute_In_Postconditions; + + -- Local variables + Count : Natural := 0; Entry_Name : Node_Id := Name (N); Entry_Id : Entity_Id; @@ -2305,6 +2363,8 @@ package body Sem_Ch9 is Outer_Ent : Entity_Id; Synch_Type : Entity_Id := Empty; + -- Start of processing for Analyze_Requeue + begin -- Preserve relevant elaboration-related attributes of the context which -- are no longer available or very expensive to recompute once analysis, @@ -2588,6 +2648,18 @@ package body Sem_Ch9 is ("target protected object of requeue must be a variable", N); end if; + -- Ada 2022 (AI12-0143): The requeue target shall not have an + -- applicable specific or class-wide postcondition which includes + -- an Old or Index attribute reference. + + if Ekind (Entry_Id) = E_Entry_Family + and then Present (Contract (Entry_Id)) + then + Check_Wrong_Attribute_In_Postconditions + (Entry_Id => Entry_Id, + Error_Node => Entry_Name); + end if; + -- A requeue statement is treated as a call for purposes of ABE checks -- and diagnostics. Annotate the tree by creating a call marker in case -- the requeue statement is transformed by expansion. diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index cafe2c3..0372ff8 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -566,7 +566,10 @@ package body Sem_Disp is -- when it is user-defined. if Is_Predefined_Dispatching_Operation (Subp_Entity) - and then not Is_User_Defined_Equality (Subp_Entity) + and then not (Is_User_Defined_Equality (Subp_Entity) + and then Comes_From_Source (Subp_Entity) + and then Nkind (Parent (Subp_Entity)) = + N_Function_Specification) then return; end if; @@ -748,14 +751,22 @@ package body Sem_Disp is elsif Is_Subprogram (Scop) and then not Is_Tag_Indeterminate (N) - and then In_Pre_Post_Condition (Call, Class_Wide_Only => True) + and then + -- The context is an internally built helper or an indirect + -- call wrapper that handles class-wide preconditions + (Present (Class_Preconditions_Subprogram (Scop)) - -- The tagged type associated with the called subprogram must be - -- the same as that of the subprogram with a class-wide aspect. + -- ... or the context is a class-wide pre/postcondition. + or else + (In_Pre_Post_Condition (Call, Class_Wide_Only => True) - and then Is_Dispatching_Operation (Scop) - and then - Find_Dispatching_Type (Subp) = Find_Dispatching_Type (Scop) + -- The tagged type associated with the called + -- subprogram must be the same as that of the + -- subprogram with a class-wide aspect. + + and then Is_Dispatching_Operation (Scop) + and then Find_Dispatching_Type (Subp) + = Find_Dispatching_Type (Scop))) then null; diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 8e38f8c..068402a 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -1845,7 +1845,7 @@ package body Sem_Elab is function Is_SPARK_Semantic_Target (Id : Entity_Id) return Boolean; pragma Inline (Is_SPARK_Semantic_Target); - -- Determine whether arbitrary entity Id nodes a source or internally + -- Determine whether arbitrary entity Id denotes a source or internally -- generated subprogram which emulates SPARK semantics. function Is_Subprogram_Inst (Id : Entity_Id) return Boolean; @@ -7346,7 +7346,7 @@ package body Sem_Elab is -- is a byproduct of the parser. Such a null statement should be -- excluded from the early call region because it carries the -- source location of the "end" keyword, and may lead to confusing - -- diagnistics. + -- diagnostics. if Nkind (N) = N_Null_Statement and then not Comes_From_Source (N) @@ -7354,6 +7354,16 @@ package body Sem_Elab is and then Nkind (Context) = N_Handled_Sequence_Of_Statements then return False; + + -- Similarly, internally-generated objects and types may have + -- out-of-order source locations that confuse diagnostics, e.g. + -- source locations in the body for objects/types generated in + -- the spec. + + elsif Nkind (N) in N_Full_Type_Declaration | N_Object_Declaration + and then not Comes_From_Source (N) + then + return False; end if; -- Otherwise only constructs which correspond to pure Ada diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index af24de3..553c7e1 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -43,6 +43,7 @@ with Opt; use Opt; with Par_SCO; use Par_SCO; with Rtsfind; use Rtsfind; with Sem; use Sem; +with Sem_Aggr; use Sem_Aggr; with Sem_Aux; use Sem_Aux; with Sem_Cat; use Sem_Cat; with Sem_Ch3; use Sem_Ch3; @@ -6054,6 +6055,16 @@ package body Sem_Eval is ------------------ procedure Out_Of_Range (N : Node_Id) is + + -- If the FE conjures up an expression that would normally be + -- an illegal static expression (e.g., an integer literal with + -- a value outside of its base subtype), we don't want to + -- flag it as illegal; we only want a warning in such cases. + + function Force_Warning return Boolean is + (if Comes_From_Source (Original_Node (N)) then False + elsif Nkind (Original_Node (N)) = N_Type_Conversion then True + else Is_Null_Array_Aggregate_High_Bound (N)); begin -- If we have the static expression case, then this is an illegality -- in Ada 95 mode, except that in an instance, we never generate an @@ -6093,9 +6104,7 @@ package body Sem_Eval is -- Determine if the out-of-range violation constitutes a warning -- or an error based on context, according to RM 4.9 (34/3). - if Nkind (Original_Node (N)) = N_Type_Conversion - and then not Comes_From_Source (Original_Node (N)) - then + if Force_Warning then Apply_Compile_Time_Constraint_Error (N, "value not in range of}??", CE_Range_Check_Failed); else diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 0bee4a1..8cc42c6 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -16008,7 +16008,6 @@ package body Sem_Prag is end loop Innr; if Citem = N then - Set_Error_Posted (N); Error_Pragma_Arg ("argument of pragma% is not withed unit", Arg); end if; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 4306e49..930980e 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -559,7 +559,12 @@ package body Sem_Res is Set_Etype (Call, Etype (Callee)); - if Base_Type (Etype (Call)) /= Base_Type (Typ) then + -- Conversion not needed if the result type of the call is class-wide + -- or if the result type matches the context type. + + if not Is_Class_Wide_Type (Typ) + and then Base_Type (Etype (Call)) /= Base_Type (Typ) + then -- Conversion may be needed in case of an inherited -- aspect of a derived type. For a null extension, we -- use a null extension aggregate instead because the @@ -3215,11 +3220,11 @@ package body Sem_Res is then Get_First_Interp (N, I, It); while Present (It.Typ) loop - if Present (It.Abstract_Op) and then - Etype (It.Abstract_Op) = Typ + if Present (It.Abstract_Op) + and then Etype (It.Abstract_Op) = Typ then - Error_Msg_NE - ("cannot call abstract subprogram &!", N, It.Abstract_Op); + Nondispatching_Call_To_Abstract_Operation + (N, It.Abstract_Op); return; end if; @@ -3873,7 +3878,8 @@ package body Sem_Res is -- selector_name in selected_component or as a choice in -- component_association. - if Is_Object (Id) + if Present (Id) + and then Is_Object (Id) and then Ekind (Id) not in E_Component | E_Discriminant and then Is_Effectively_Volatile_For_Reading (Id) and then @@ -6949,7 +6955,8 @@ package body Sem_Res is and then Requires_Transient_Scope (Etype (Nam)) and then not Is_Ignored_Ghost_Entity (Nam) then - Establish_Transient_Scope (N, Manage_Sec_Stack => True); + Establish_Transient_Scope + (N, Returns_On_Secondary_Stack (Etype (Nam))); -- If the call appears within the bounds of a loop, it will be -- rewritten and reanalyzed, nothing left to do here. @@ -7063,24 +7070,19 @@ package body Sem_Res is -- If the subprogram is a primitive operation, check whether or not -- it is a correct dispatching call. - if Is_Overloadable (Nam) - and then Is_Dispatching_Operation (Nam) - then + if Is_Overloadable (Nam) and then Is_Dispatching_Operation (Nam) then Check_Dispatching_Call (N); - elsif Ekind (Nam) /= E_Subprogram_Type - and then Is_Abstract_Subprogram (Nam) - and then not In_Instance - then - Error_Msg_NE ("cannot call abstract subprogram &!", N, Nam); + -- If the subprogram is an abstract operation, then flag an error + + elsif Is_Overloadable (Nam) and then Is_Abstract_Subprogram (Nam) then + Nondispatching_Call_To_Abstract_Operation (N, Nam); end if; -- If this is a dispatching call, generate the appropriate reference, -- for better source navigation in GNAT Studio. - if Is_Overloadable (Nam) - and then Present (Controlling_Argument (N)) - then + if Is_Overloadable (Nam) and then Present (Controlling_Argument (N)) then Generate_Reference (Nam, Subp, 'R'); -- Normal case, not a dispatching call: generate a call reference @@ -8534,7 +8536,8 @@ package body Sem_Res is elsif Expander_Active and then Requires_Transient_Scope (Etype (Nam)) then - Establish_Transient_Scope (N, Manage_Sec_Stack => True); + Establish_Transient_Scope + (N, Returns_On_Secondary_Stack (Etype (Nam))); end if; -- Now we know that this is not a call to a function that returns an @@ -8918,6 +8921,41 @@ package body Sem_Res is Resolve (L, T); Resolve (R, T); + -- AI12-0413: user-defined primitive equality of an untagged record + -- type hides the predefined equality operator, including within a + -- generic, and if it is declared abstract, results in an illegal + -- instance if the operator is used in the spec, or in the raising + -- of Program_Error if used in the body of an instance. + + if Nkind (N) = N_Op_Eq + and then In_Instance + and then Ada_Version >= Ada_2012 + then + declare + U : constant Entity_Id := Underlying_Type (T); + + Eq : Entity_Id; + + begin + if Present (U) + and then Is_Record_Type (U) + and then not Is_Tagged_Type (U) + then + Eq := Get_User_Defined_Equality (T); + + if Present (Eq) then + if Is_Abstract_Subprogram (Eq) then + Nondispatching_Call_To_Abstract_Operation (N, Eq); + else + Rewrite_Operator_As_Call (N, Eq); + end if; + + return; + end if; + end if; + end; + end if; + -- If the unique type is a class-wide type then it will be expanded -- into a dispatching call to the predefined primitive. Therefore we -- check here for potential violation of such restriction. @@ -8977,8 +9015,8 @@ package body Sem_Res is if Nkind (N) = N_Op_Eq or else Comes_From_Source (Entity (N)) or else Ekind (Entity (N)) = E_Operator - or else Is_Intrinsic_Subprogram - (Corresponding_Equality (Entity (N))) + or else + Is_Intrinsic_Subprogram (Corresponding_Equality (Entity (N))) then Analyze_Dimension (N); Eval_Relational_Op (N); @@ -8986,7 +9024,7 @@ package body Sem_Res is elsif Nkind (N) = N_Op_Ne and then Is_Abstract_Subprogram (Entity (N)) then - Error_Msg_NE ("cannot call abstract subprogram &!", N, Entity (N)); + Nondispatching_Call_To_Abstract_Operation (N, Entity (N)); end if; end if; end Resolve_Equality_Op; @@ -9837,6 +9875,38 @@ package body Sem_Res is Eval_Logical_Op (N); end Resolve_Logical_Op; + --------------------------------- + -- Resolve_Membership_Equality -- + --------------------------------- + + procedure Resolve_Membership_Equality (N : Node_Id; Typ : Entity_Id) is + Utyp : constant Entity_Id := Underlying_Type (Typ); + + begin + -- RM 4.5.2(4.1/3): if the type is limited, then it shall have a visible + -- primitive equality operator. This means that we can use the regular + -- visibility-based resolution and reset Entity in order to trigger it. + + if Is_Limited_Type (Typ) then + Set_Entity (N, Empty); + + -- RM 4.5.2(28.1/3): if the type is a record, then the membership test + -- uses the primitive equality for the type [even if it is not visible]. + -- We only deal with the untagged case here, because the tagged case is + -- handled uniformly in the expander. + + elsif Is_Record_Type (Utyp) and then not Is_Tagged_Type (Utyp) then + declare + Eq_Id : constant Entity_Id := Get_User_Defined_Equality (Typ); + + begin + if Present (Eq_Id) then + Rewrite_Operator_As_Call (N, Eq_Id); + end if; + end; + end if; + end Resolve_Membership_Equality; + --------------------------- -- Resolve_Membership_Op -- --------------------------- @@ -9953,7 +10023,7 @@ package body Sem_Res is -- following warning appears useful for the most common case. if Is_Scalar_Type (Etype (L)) - and then Present (Get_User_Defined_Eq (Etype (L))) + and then Present (Get_User_Defined_Equality (Etype (L))) then Error_Msg_NE ("membership test on& uses predefined equality?", N, Etype (L)); diff --git a/gcc/ada/sem_res.ads b/gcc/ada/sem_res.ads index 29a5005..4e97b7a 100644 --- a/gcc/ada/sem_res.ads +++ b/gcc/ada/sem_res.ads @@ -125,6 +125,9 @@ package Sem_Res is -- own type. For now we assume that the prefix cannot be overloaded and -- the name of the entry plays no role in the resolution. + procedure Resolve_Membership_Equality (N : Node_Id; Typ : Entity_Id); + -- Resolve the equality operator in an individual membership test + function Valid_Conversion (N : Node_Id; Target : Entity_Id; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index b7ebd4a..0a80915 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -6475,7 +6475,7 @@ package body Sem_Util is elsif Nkind (Parent (B_Type)) = N_Full_Type_Declaration and then Present (Incomplete_View (Parent (B_Type))) then - Id := Defining_Entity (Incomplete_View (Parent (B_Type))); + Id := Incomplete_View (Parent (B_Type)); -- If T is a derived from a type with an incomplete view declared -- elsewhere, that incomplete view is irrelevant, we want the @@ -6808,13 +6808,18 @@ package body Sem_Util is procedure Compute_Returns_By_Ref (Func : Entity_Id) is Typ : constant Entity_Id := Etype (Func); - Utyp : constant Entity_Id := Underlying_Type (Typ); begin if Is_Limited_View (Typ) then Set_Returns_By_Ref (Func); - elsif Present (Utyp) and then CW_Or_Has_Controlled_Part (Utyp) then + -- For class-wide types and types which both need finalization and are + -- returned on the secondary stack, the secondary stack allocation is + -- done by the front end, see Expand_Simple_Function_Return. + + elsif Returns_On_Secondary_Stack (Typ) + and then CW_Or_Needs_Finalization (Underlying_Type (Typ)) + then Set_Returns_By_Ref (Func); end if; end Compute_Returns_By_Ref; @@ -7294,14 +7299,14 @@ package body Sem_Util is end if; end Current_Subprogram; - ------------------------------- - -- CW_Or_Has_Controlled_Part -- - ------------------------------- + ------------------------------ + -- CW_Or_Needs_Finalization -- + ------------------------------ - function CW_Or_Has_Controlled_Part (T : Entity_Id) return Boolean is + function CW_Or_Needs_Finalization (Typ : Entity_Id) return Boolean is begin - return Is_Class_Wide_Type (T) or else Needs_Finalization (T); - end CW_Or_Has_Controlled_Part; + return Is_Class_Wide_Type (Typ) or else Needs_Finalization (Typ); + end CW_Or_Needs_Finalization; ------------------------------- -- Deepest_Type_Access_Level -- @@ -11770,32 +11775,25 @@ package body Sem_Util is return Task_Body_Procedure (Underlying_Type (Root_Type (E))); end Get_Task_Body_Procedure; - ------------------------- - -- Get_User_Defined_Eq -- - ------------------------- + ------------------------------- + -- Get_User_Defined_Equality -- + ------------------------------- - function Get_User_Defined_Eq (E : Entity_Id) return Entity_Id is + function Get_User_Defined_Equality (E : Entity_Id) return Entity_Id is Prim : Elmt_Id; - Op : Entity_Id; begin Prim := First_Elmt (Collect_Primitive_Operations (E)); while Present (Prim) loop - Op := Node (Prim); - - if Chars (Op) = Name_Op_Eq - and then Etype (Op) = Standard_Boolean - and then Etype (First_Formal (Op)) = E - and then Etype (Next_Formal (First_Formal (Op))) = E - then - return Op; + if Is_User_Defined_Equality (Node (Prim)) then + return Node (Prim); end if; Next_Elmt (Prim); end loop; return Empty; - end Get_User_Defined_Eq; + end Get_User_Defined_Equality; --------------- -- Get_Views -- @@ -12632,44 +12630,6 @@ package body Sem_Util is function Type_Or_Variable_Has_Enabled_Property (Item_Id : Entity_Id) return Boolean is - function Is_Enabled (Prag : Node_Id) return Boolean; - -- Determine whether property pragma Prag (if present) denotes an - -- enabled property. - - ---------------- - -- Is_Enabled -- - ---------------- - - function Is_Enabled (Prag : Node_Id) return Boolean is - Arg1 : Node_Id; - - begin - if Present (Prag) then - Arg1 := First (Pragma_Argument_Associations (Prag)); - - -- The pragma has an optional Boolean expression, the related - -- property is enabled only when the expression evaluates to - -- True. - - if Present (Arg1) then - return Is_True (Expr_Value (Get_Pragma_Arg (Arg1))); - - -- Otherwise the lack of expression enables the property by - -- default. - - else - return True; - end if; - - -- The property was never set in the first place - - else - return False; - end if; - end Is_Enabled; - - -- Local variables - AR : constant Node_Id := Get_Pragma (Item_Id, Pragma_Async_Readers); AW : constant Node_Id := @@ -12683,8 +12643,6 @@ package body Sem_Util is Is_Derived_Type (Item_Id) and then Is_Effectively_Volatile (Etype (Base_Type (Item_Id))); - -- Start of processing for Type_Or_Variable_Has_Enabled_Property - begin -- A non-effectively volatile object can never possess external -- properties. @@ -12699,16 +12657,16 @@ package body Sem_Util is -- missing altogether. elsif Property = Name_Async_Readers and then Present (AR) then - return Is_Enabled (AR); + return Is_Enabled_Pragma (AR); elsif Property = Name_Async_Writers and then Present (AW) then - return Is_Enabled (AW); + return Is_Enabled_Pragma (AW); elsif Property = Name_Effective_Reads and then Present (ER) then - return Is_Enabled (ER); + return Is_Enabled_Pragma (ER); elsif Property = Name_Effective_Writes and then Present (EW) then - return Is_Enabled (EW); + return Is_Enabled_Pragma (EW); -- If other properties are set explicitly, then this one is set -- implicitly to False, except in the case of a derived type @@ -12723,7 +12681,8 @@ package body Sem_Util is then return False; - -- For a private type, may need to look at the full view + -- For a private type (including subtype of a private types), look at + -- the full view. elsif Is_Private_Type (Item_Id) and then Present (Full_View (Item_Id)) then @@ -12736,10 +12695,17 @@ package body Sem_Util is return Type_Or_Variable_Has_Enabled_Property (First_Subtype (Etype (Base_Type (Item_Id)))); - -- If not specified explicitly for an object and the type + -- For a subtype, the property will be inherited from its base type. + + elsif Is_Type (Item_Id) + and then not Is_Base_Type (Item_Id) + then + return Type_Or_Variable_Has_Enabled_Property (Etype (Item_Id)); + + -- If not specified explicitly for an object and its type -- is effectively volatile, then take result from the type. - elsif not Is_Type (Item_Id) + elsif Is_Object (Item_Id) and then Is_Effectively_Volatile (Etype (Item_Id)) then return Has_Enabled_Property (Etype (Item_Id), Property); @@ -16926,6 +16892,8 @@ package body Sem_Util is elsif Nkind (P) = N_Aspect_Specification and then Nkind (Parent (P)) = N_Subtype_Declaration + and then Underlying_Type (Defining_Identifier (Parent (P))) = + Underlying_Type (Typ) then return True; @@ -16933,7 +16901,14 @@ package body Sem_Util is and then Get_Pragma_Id (P) in Pragma_Predicate | Pragma_Predicate_Failure then - return True; + declare + Arg : constant Entity_Id := + Entity (Expression (Get_Argument (P))); + begin + if Underlying_Type (Arg) = Underlying_Type (Typ) then + return True; + end if; + end; end if; P := Parent (P); @@ -16967,7 +16942,6 @@ package body Sem_Util is and then Ekind (Scope (Entity (N))) in E_Function | E_Procedure and then (Is_Predicate_Function (Scope (Entity (N))) - or else Is_Predicate_Function_M (Scope (Entity (N))) or else Is_Invariant_Procedure (Scope (Entity (N))) or else Is_Partial_Invariant_Procedure (Scope (Entity (N))) or else Is_DIC_Procedure (Scope (Entity (N)))); @@ -17663,6 +17637,21 @@ package body Sem_Util is end if; end Is_Effectively_Volatile_Object_Shared; + ---------------------------------------- + -- Is_Entity_Of_Quantified_Expression -- + ---------------------------------------- + + function Is_Entity_Of_Quantified_Expression (Id : Entity_Id) return Boolean + is + Par : constant Node_Id := Parent (Id); + + begin + return (Nkind (Par) = N_Loop_Parameter_Specification + or else Nkind (Par) = N_Iterator_Specification) + and then Defining_Identifier (Par) = Id + and then Nkind (Parent (Par)) = N_Quantified_Expression; + end Is_Entity_Of_Quantified_Expression; + ------------------- -- Is_Entry_Body -- ------------------- @@ -19303,6 +19292,8 @@ package body Sem_Util is Type_Decl : Node_Id; Type_Def : Node_Id; begin + pragma Assert (not Is_Class_Wide_Type (T)); + if Ignore_Privacy then Type_Decl := Parent (Underlying_Type (Base_Type (T))); else @@ -19335,7 +19326,10 @@ package body Sem_Util is := Underlying_Type (Base_Type (Ancestor)); Descendant_Type : Entity_Id := Underlying_Type (Base_Type (Descendant)); begin + pragma Assert (not Is_Class_Wide_Type (Descendant)); + pragma Assert (not Is_Class_Wide_Type (Ancestor)); pragma Assert (Descendant_Type /= Ancestor_Type); + while Descendant_Type /= Ancestor_Type loop if not Is_Null_Extension (Descendant_Type, Ignore_Privacy => True) @@ -21530,15 +21524,31 @@ package body Sem_Util is ------------------------------ function Is_User_Defined_Equality (Id : Entity_Id) return Boolean is + F1, F2 : Entity_Id; + begin - return Ekind (Id) = E_Function + -- An equality operator is a function that carries the name "=", returns + -- Boolean, and has exactly two formal parameters of an identical type. + + if Ekind (Id) = E_Function and then Chars (Id) = Name_Op_Eq - and then Comes_From_Source (Id) + and then Base_Type (Etype (Id)) = Standard_Boolean + then + F1 := First_Formal (Id); - -- Internally generated equalities have a full type declaration - -- as their parent. + if No (F1) then + return False; + end if; - and then Nkind (Parent (Id)) = N_Function_Specification; + F2 := Next_Formal (F1); + + return Present (F2) + and then No (Next_Formal (F2)) + and then Base_Type (Etype (F1)) = Base_Type (Etype (F2)); + + else + return False; + end if; end Is_User_Defined_Equality; ----------------------------- @@ -24645,22 +24655,20 @@ package body Sem_Util is -- ??? this list is flaky, and may hide dormant bugs -- Should functions be included??? - -- Loop parameters appear within quantified expressions and contain - -- an entity declaration that must be replaced when the expander is - -- active if the expression has been preanalyzed or analyzed. + -- Quantified expressions contain an entity declaration that must + -- always be replaced when the expander is active, even if it has + -- not been analyzed yet like e.g. in predicates. - elsif Ekind (Id) not in - E_Block | E_Constant | E_Label | E_Loop_Parameter | - E_Procedure | E_Variable + elsif Ekind (Id) not in E_Block + | E_Constant + | E_Label + | E_Procedure + | E_Variable + and then not Is_Entity_Of_Quantified_Expression (Id) and then not Is_Type (Id) then return; - elsif Ekind (Id) = E_Loop_Parameter - and then No (Etype (Condition (Parent (Parent (Id))))) - then - return; - -- Nothing to do when the entity was already visited elsif NCT_Tables_In_Use @@ -24684,9 +24692,12 @@ package body Sem_Util is New_Id := New_Copy (Id); -- Create a new name for the new entity because the back end needs - -- distinct names for debugging purposes. + -- distinct names for debugging purposes, provided that the entity + -- has already been analyzed. - Set_Chars (New_Id, New_Internal_Name ('T')); + if Ekind (Id) /= E_Void then + Set_Chars (New_Id, New_Internal_Name ('T')); + end if; -- Update the Comes_From_Source and Sloc attributes of the entity in -- case the caller has supplied new values. @@ -26537,6 +26548,69 @@ package body Sem_Util is end Predicate_Enabled; ---------------------------------- + -- Predicate_Failure_Expression -- + ---------------------------------- + + function Predicate_Failure_Expression + (Typ : Entity_Id; Inherited_OK : Boolean) return Node_Id + is + PF_Aspect : constant Node_Id := + Find_Aspect (Typ, Aspect_Predicate_Failure); + begin + -- Check for Predicate_Failure aspect specification via an + -- aspect_specification (as opposed to via a pragma). + + if Present (PF_Aspect) then + if Inherited_OK or else Entity (PF_Aspect) = Typ then + return Expression (PF_Aspect); + else + return Empty; + end if; + end if; + + -- Check for Predicate_Failure aspect specification via a pragma. + + declare + Rep_Item : Node_Id := First_Rep_Item (Typ); + begin + while Present (Rep_Item) loop + if Nkind (Rep_Item) = N_Pragma + and then Get_Pragma_Id (Rep_Item) = Pragma_Predicate_Failure + then + declare + Arg1 : constant Node_Id := + Get_Pragma_Arg + (First (Pragma_Argument_Associations (Rep_Item))); + Arg2 : constant Node_Id := + Get_Pragma_Arg + (Next (First (Pragma_Argument_Associations (Rep_Item)))); + begin + if Inherited_OK or else + (Nkind (Arg1) in N_Has_Entity + and then Entity (Arg1) = Typ) + then + return Arg2; + end if; + end; + end if; + + Next_Rep_Item (Rep_Item); + end loop; + end; + + -- If we are interested in an inherited Predicate_Failure aspect + -- and we have an ancestor to inherit from, then recursively check + -- for that case. + + if Inherited_OK and then Present (Nearest_Ancestor (Typ)) then + return Predicate_Failure_Expression (Nearest_Ancestor (Typ), + Inherited_OK => True); + end if; + + return Empty; + end Predicate_Failure_Expression; + + ---------------------------------- -- Predicate_Tests_On_Arguments -- ---------------------------------- @@ -26571,9 +26645,7 @@ package body Sem_Util is -- would cause infinite recursion. elsif Ekind (Subp) = E_Function - and then (Is_Predicate_Function (Subp) - or else - Is_Predicate_Function_M (Subp)) + and then Is_Predicate_Function (Subp) then return False; @@ -27026,9 +27098,7 @@ package body Sem_Util is (Typ : Entity_Id; From_Typ : Entity_Id) is - Pred_Func : Entity_Id; - Pred_Func_M : Entity_Id; - + Pred_Func : Entity_Id; begin if Present (Typ) and then Present (From_Typ) then pragma Assert (Is_Type (Typ) and then Is_Type (From_Typ)); @@ -27041,7 +27111,6 @@ package body Sem_Util is end if; Pred_Func := Predicate_Function (From_Typ); - Pred_Func_M := Predicate_Function_M (From_Typ); -- The setting of the attributes is intentionally conservative. This -- prevents accidental clobbering of enabled attributes. @@ -27053,10 +27122,6 @@ package body Sem_Util is if Present (Pred_Func) and then No (Predicate_Function (Typ)) then Set_Predicate_Function (Typ, Pred_Func); end if; - - if Present (Pred_Func_M) and then No (Predicate_Function_M (Typ)) then - Set_Predicate_Function_M (Typ, Pred_Func_M); - end if; end if; end Propagate_Predicate_Attributes; @@ -27303,11 +27368,61 @@ package body Sem_Util is -- Requires_Transient_Scope -- ------------------------------ - -- A transient scope is required when variable-sized temporaries are - -- allocated on the secondary stack, or when finalization actions must be - -- generated before the next instruction. + function Requires_Transient_Scope (Typ : Entity_Id) return Boolean is + begin + return Returns_On_Secondary_Stack (Typ) or else Needs_Finalization (Typ); + end Requires_Transient_Scope; + + -------------------------- + -- Reset_Analyzed_Flags -- + -------------------------- + + procedure Reset_Analyzed_Flags (N : Node_Id) is + function Clear_Analyzed (N : Node_Id) return Traverse_Result; + -- Function used to reset Analyzed flags in tree. Note that we do + -- not reset Analyzed flags in entities, since there is no need to + -- reanalyze entities, and indeed, it is wrong to do so, since it + -- can result in generating auxiliary stuff more than once. + + -------------------- + -- Clear_Analyzed -- + -------------------- + + function Clear_Analyzed (N : Node_Id) return Traverse_Result is + begin + if Nkind (N) not in N_Entity then + Set_Analyzed (N, False); + end if; + + return OK; + end Clear_Analyzed; + + procedure Reset_Analyzed is new Traverse_Proc (Clear_Analyzed); + + -- Start of processing for Reset_Analyzed_Flags - function Requires_Transient_Scope (Id : Entity_Id) return Boolean is + begin + Reset_Analyzed (N); + end Reset_Analyzed_Flags; + + ------------------------ + -- Restore_SPARK_Mode -- + ------------------------ + + procedure Restore_SPARK_Mode + (Mode : SPARK_Mode_Type; + Prag : Node_Id) + is + begin + SPARK_Mode := Mode; + SPARK_Mode_Pragma := Prag; + end Restore_SPARK_Mode; + + --------------------------------- + -- Returns_On_Secondary_Stack -- + --------------------------------- + + function Returns_On_Secondary_Stack (Id : Entity_Id) return Boolean is pragma Assert (if Present (Id) then Ekind (Id) in E_Void | Type_Kind); function Caller_Known_Size_Record (Typ : Entity_Id) return Boolean; @@ -27320,11 +27435,6 @@ package body Sem_Util is -- could be nested inside some other record that is constrained by -- nondiscriminants). That is, the recursive calls are too conservative. - procedure Ensure_Minimum_Decoration (Typ : Entity_Id); - -- If Typ is not frozen then add to Typ the minimum decoration required - -- by Requires_Transient_Scope to reliably provide its functionality; - -- otherwise no action is performed. - function Large_Max_Size_Mutable (Typ : Entity_Id) return Boolean; -- Returns True if Typ is a nonlimited record with defaulted -- discriminants whose max size makes it unsuitable for allocating on @@ -27380,46 +27490,6 @@ package body Sem_Util is return True; end Caller_Known_Size_Record; - ------------------------------- - -- Ensure_Minimum_Decoration -- - ------------------------------- - - procedure Ensure_Minimum_Decoration (Typ : Entity_Id) is - Comp : Entity_Id; - begin - -- Do not set Has_Controlled_Component on a class-wide equivalent - -- type. See Make_CW_Equivalent_Type. - - if not Is_Frozen (Typ) - and then Is_Base_Type (Typ) - and then (Is_Record_Type (Typ) - or else Is_Concurrent_Type (Typ) - or else Is_Incomplete_Or_Private_Type (Typ)) - and then not Is_Class_Wide_Equivalent_Type (Typ) - then - Comp := First_Component (Typ); - while Present (Comp) loop - if Has_Controlled_Component (Etype (Comp)) - or else - (Chars (Comp) /= Name_uParent - and then Is_Controlled (Etype (Comp))) - or else - (Is_Protected_Type (Etype (Comp)) - and then - Present (Corresponding_Record_Type (Etype (Comp))) - and then - Has_Controlled_Component - (Corresponding_Record_Type (Etype (Comp)))) - then - Set_Has_Controlled_Component (Typ); - exit; - end if; - - Next_Component (Comp); - end loop; - end if; - end Ensure_Minimum_Decoration; - ------------------------------ -- Large_Max_Size_Mutable -- ------------------------------ @@ -27504,7 +27574,7 @@ package body Sem_Util is Typ : constant Entity_Id := Underlying_Type (Id); - -- Start of processing for Requires_Transient_Scope + -- Start of processing for Returns_On_Secondary_Stack begin -- This is a private type which is not completed yet. This can only @@ -27515,8 +27585,6 @@ package body Sem_Util is return False; end if; - Ensure_Minimum_Decoration (Id); - -- Do not expand transient scope for non-existent procedure return or -- string literal types. @@ -27531,20 +27599,23 @@ package body Sem_Util is elsif Ekind (Typ) = E_Record_Subtype and then Present (Cloned_Subtype (Typ)) then - return Requires_Transient_Scope (Cloned_Subtype (Typ)); + return Returns_On_Secondary_Stack (Cloned_Subtype (Typ)); -- Functions returning specific tagged types may dispatch on result, so -- their returned value is allocated on the secondary stack, even in the -- definite case. We must treat nondispatching functions the same way, -- because access-to-function types can point at both, so the calling - -- conventions must be compatible. Is_Tagged_Type includes controlled - -- types and class-wide types. Controlled type temporaries need - -- finalization. + -- conventions must be compatible. - -- ???It's not clear why we need to return noncontrolled types with - -- controlled components on the secondary stack. + elsif Is_Tagged_Type (Typ) then + return True; - elsif Is_Tagged_Type (Typ) or else Has_Controlled_Component (Typ) then + -- If the return slot of the back end cannot be accessed, then there + -- is no way to call Adjust at the right time for the return object if + -- the type needs finalization, so the return object must be allocated + -- on the secondary stack. + + elsif not Back_End_Return_Slot and then Needs_Finalization (Typ) then return True; -- Untagged definite subtypes are known size. This includes all @@ -27573,52 +27644,7 @@ package body Sem_Util is pragma Assert (Is_Array_Type (Typ) and not Is_Definite_Subtype (Typ)); return True; end if; - end Requires_Transient_Scope; - - -------------------------- - -- Reset_Analyzed_Flags -- - -------------------------- - - procedure Reset_Analyzed_Flags (N : Node_Id) is - function Clear_Analyzed (N : Node_Id) return Traverse_Result; - -- Function used to reset Analyzed flags in tree. Note that we do - -- not reset Analyzed flags in entities, since there is no need to - -- reanalyze entities, and indeed, it is wrong to do so, since it - -- can result in generating auxiliary stuff more than once. - - -------------------- - -- Clear_Analyzed -- - -------------------- - - function Clear_Analyzed (N : Node_Id) return Traverse_Result is - begin - if Nkind (N) not in N_Entity then - Set_Analyzed (N, False); - end if; - - return OK; - end Clear_Analyzed; - - procedure Reset_Analyzed is new Traverse_Proc (Clear_Analyzed); - - -- Start of processing for Reset_Analyzed_Flags - - begin - Reset_Analyzed (N); - end Reset_Analyzed_Flags; - - ------------------------ - -- Restore_SPARK_Mode -- - ------------------------ - - procedure Restore_SPARK_Mode - (Mode : SPARK_Mode_Type; - Prag : Node_Id) - is - begin - SPARK_Mode := Mode; - SPARK_Mode_Pragma := Prag; - end Restore_SPARK_Mode; + end Returns_On_Secondary_Stack; -------------------------------- -- Returns_Unconstrained_Type -- @@ -32309,47 +32335,6 @@ package body Sem_Util is package body Storage_Model_Support is - ----------------------------------- - -- Get_Storage_Model_Type_Entity -- - ----------------------------------- - - function Get_Storage_Model_Type_Entity - (Typ : Entity_Id; - Nam : Name_Id) return Entity_Id - is - pragma Assert - (Is_Type (Typ) - and then - Nam in Name_Address_Type - | Name_Null_Address - | Name_Allocate - | Name_Deallocate - | Name_Copy_From - | Name_Copy_To - | Name_Storage_Size); - - SMT_Aspect_Value : constant Node_Id := - Find_Value_Of_Aspect (Typ, Aspect_Storage_Model_Type); - Assoc : Node_Id; - - begin - if No (SMT_Aspect_Value) then - return Empty; - - else - Assoc := First (Component_Associations (SMT_Aspect_Value)); - while Present (Assoc) loop - if Chars (First (Choices (Assoc))) = Nam then - return Entity (Expression (Assoc)); - end if; - - Next (Assoc); - end loop; - - return Empty; - end if; - end Get_Storage_Model_Type_Entity; - ----------------------------------------- -- Has_Designated_Storage_Model_Aspect -- ----------------------------------------- @@ -32377,13 +32362,11 @@ package body Sem_Util is function Storage_Model_Object (Typ : Entity_Id) return Entity_Id is begin - if Has_Designated_Storage_Model_Aspect (Typ) then - return - Entity - (Find_Value_Of_Aspect (Typ, Aspect_Designated_Storage_Model)); - else - return Empty; - end if; + pragma Assert (Has_Designated_Storage_Model_Aspect (Typ)); + + return + Entity + (Find_Value_Of_Aspect (Typ, Aspect_Designated_Storage_Model)); end Storage_Model_Object; ------------------------ @@ -32392,76 +32375,132 @@ package body Sem_Util is function Storage_Model_Type (Obj : Entity_Id) return Entity_Id is begin - if Present - (Find_Value_Of_Aspect (Etype (Obj), Aspect_Storage_Model_Type)) - then - return Etype (Obj); - else - return Empty; - end if; + pragma Assert (Has_Storage_Model_Type_Aspect (Etype (Obj))); + + return Etype (Obj); end Storage_Model_Type; + ----------------------------------- + -- Get_Storage_Model_Type_Entity -- + ----------------------------------- + + function Get_Storage_Model_Type_Entity + (SM_Obj_Or_Type : Entity_Id; + Nam : Name_Id) return Entity_Id + is + Typ : constant Entity_Id := (if Is_Object (SM_Obj_Or_Type) then + Storage_Model_Type (SM_Obj_Or_Type) + else + SM_Obj_Or_Type); + pragma Assert + (Is_Type (Typ) + and then + Nam in Name_Address_Type + | Name_Null_Address + | Name_Allocate + | Name_Deallocate + | Name_Copy_From + | Name_Copy_To + | Name_Storage_Size); + + Assoc : Node_Id; + SMT_Aspect_Value : constant Node_Id := + Find_Value_Of_Aspect (Typ, Aspect_Storage_Model_Type); + + begin + pragma Assert (Present (SMT_Aspect_Value)); + + Assoc := First (Component_Associations (SMT_Aspect_Value)); + while Present (Assoc) loop + if Chars (First (Choices (Assoc))) = Nam then + return Entity (Expression (Assoc)); + end if; + + Next (Assoc); + end loop; + + return Empty; + end Get_Storage_Model_Type_Entity; + -------------------------------- -- Storage_Model_Address_Type -- -------------------------------- - function Storage_Model_Address_Type (Typ : Entity_Id) return Entity_Id is + function Storage_Model_Address_Type + (SM_Obj_Or_Type : Entity_Id) return Entity_Id + is begin - return Get_Storage_Model_Type_Entity (Typ, Name_Address_Type); + return + Get_Storage_Model_Type_Entity (SM_Obj_Or_Type, Name_Address_Type); end Storage_Model_Address_Type; -------------------------------- -- Storage_Model_Null_Address -- -------------------------------- - function Storage_Model_Null_Address (Typ : Entity_Id) return Entity_Id is + function Storage_Model_Null_Address + (SM_Obj_Or_Type : Entity_Id) return Entity_Id + is begin - return Get_Storage_Model_Type_Entity (Typ, Name_Null_Address); + return + Get_Storage_Model_Type_Entity (SM_Obj_Or_Type, Name_Null_Address); end Storage_Model_Null_Address; ---------------------------- -- Storage_Model_Allocate -- ---------------------------- - function Storage_Model_Allocate (Typ : Entity_Id) return Entity_Id is + function Storage_Model_Allocate + (SM_Obj_Or_Type : Entity_Id) return Entity_Id + is begin - return Get_Storage_Model_Type_Entity (Typ, Name_Allocate); + return Get_Storage_Model_Type_Entity (SM_Obj_Or_Type, Name_Allocate); end Storage_Model_Allocate; ------------------------------ -- Storage_Model_Deallocate -- ------------------------------ - function Storage_Model_Deallocate (Typ : Entity_Id) return Entity_Id is + function Storage_Model_Deallocate + (SM_Obj_Or_Type : Entity_Id) return Entity_Id + is begin - return Get_Storage_Model_Type_Entity (Typ, Name_Deallocate); + return + Get_Storage_Model_Type_Entity (SM_Obj_Or_Type, Name_Deallocate); end Storage_Model_Deallocate; ----------------------------- -- Storage_Model_Copy_From -- ----------------------------- - function Storage_Model_Copy_From (Typ : Entity_Id) return Entity_Id is + function Storage_Model_Copy_From + (SM_Obj_Or_Type : Entity_Id) return Entity_Id + is begin - return Get_Storage_Model_Type_Entity (Typ, Name_Copy_From); + return Get_Storage_Model_Type_Entity (SM_Obj_Or_Type, Name_Copy_From); end Storage_Model_Copy_From; --------------------------- -- Storage_Model_Copy_To -- --------------------------- - function Storage_Model_Copy_To (Typ : Entity_Id) return Entity_Id is + function Storage_Model_Copy_To + (SM_Obj_Or_Type : Entity_Id) return Entity_Id + is begin - return Get_Storage_Model_Type_Entity (Typ, Name_Copy_To); + return Get_Storage_Model_Type_Entity (SM_Obj_Or_Type, Name_Copy_To); end Storage_Model_Copy_To; -------------------------------- -- Storage_Model_Storage_Size -- -------------------------------- - function Storage_Model_Storage_Size (Typ : Entity_Id) return Entity_Id is + function Storage_Model_Storage_Size + (SM_Obj_Or_Type : Entity_Id) return Entity_Id + is begin - return Get_Storage_Model_Type_Entity (Typ, Name_Storage_Size); + return + Get_Storage_Model_Type_Entity (SM_Obj_Or_Type, Name_Storage_Size); end Storage_Model_Storage_Size; end Storage_Model_Support; diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index e5e1d01..2d9cbd3 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -672,11 +672,10 @@ package Sem_Util is -- Current_Scope is returned. The returned value is Empty if this is called -- from a library package which is not within any subprogram. - function CW_Or_Has_Controlled_Part (T : Entity_Id) return Boolean; - -- True if T is a class-wide type, or if it has controlled parts ("part" - -- means T or any of its subcomponents). Same as Needs_Finalization, except - -- when pragma Restrictions (No_Finalization) applies, in which case we - -- know that class-wide objects do not contain controlled parts. + function CW_Or_Needs_Finalization (Typ : Entity_Id) return Boolean; + -- True if Typ is a class-wide type or requires finalization actions. Same + -- as Needs_Finalization except with pragma Restrictions (No_Finalization), + -- in which case we know that class-wide objects do not need finalization. function Deepest_Type_Access_Level (Typ : Entity_Id; @@ -1338,7 +1337,7 @@ package Sem_Util is -- Given an entity for a task type or subtype, retrieves the -- Task_Body_Procedure field from the corresponding task type declaration. - function Get_User_Defined_Eq (E : Entity_Id) return Entity_Id; + function Get_User_Defined_Equality (E : Entity_Id) return Entity_Id; -- For a type entity, return the entity of the primitive equality function -- for the type if it exists, otherwise return Empty. @@ -2055,6 +2054,9 @@ package Sem_Util is -- Determine whether an arbitrary node denotes an effectively volatile -- object for reading (SPARK RM 7.1.2). + function Is_Entity_Of_Quantified_Expression (Id : Entity_Id) return Boolean; + -- Determine whether entity Id is the entity of a quantified expression + function Is_Entry_Body (Id : Entity_Id) return Boolean; -- Determine whether entity Id is the body entity of an entry [family] @@ -2206,12 +2208,14 @@ package Sem_Util is -- Given a tagged type, returns True if argument is a type extension -- that introduces no new components (discriminant or nondiscriminant). -- Ignore_Privacy should be True for use in implementing dynamic semantics. + -- Cannot be called with class-wide types. function Is_Null_Extension_Of (Descendant, Ancestor : Entity_Id) return Boolean; -- Given two tagged types, the first a descendant of the second, -- returns True if every component of Descendant is inherited -- (directly or indirectly) from Ancestor. Privacy is ignored. + -- Cannot be called with class-wide types. function Is_Null_Record_Definition (Record_Def : Node_Id) return Boolean; -- Returns True for an N_Record_Definition node that has no user-defined @@ -2926,6 +2930,26 @@ package Sem_Util is -- Typ, taking into account Predicates_Ignored and -- Predicate_Checks_Suppressed. + function Predicate_Failure_Expression + (Typ : Entity_Id; Inherited_OK : Boolean) return Node_Id; + -- If the given type or subtype is subject to a Predicate_Failure + -- aspect specification, then returns the specified expression. + -- Otherwise, if Inherited_OK is False then returns Empty. + -- Otherwise, if Typ denotes a subtype or a derived type then + -- returns the result of recursing on the ancestor subtype. + -- Otherwise, returns Empty. + + function Predicate_Function_Needs_Membership_Parameter (Typ : Entity_Id) + return Boolean is + (Present (Predicate_Failure_Expression (Typ, Inherited_OK => True))); + -- The predicate function for some, but not all, subtypes needs to + -- know whether the predicate is being evaluated as part of a membership + -- test. The predicate function for such a subtype takes an additional + -- boolean to convey this information. This function returns True if this + -- additional parameter is needed. More specifically, this function + -- returns true if the Predicate_Failure aspect is specified for the + -- given subtype or for any of its "ancestor" subtypes. + function Predicate_Tests_On_Arguments (Subp : Entity_Id) return Boolean; -- Subp is the entity for a subprogram call. This function returns True if -- predicate tests are required for the arguments in this call (this is the @@ -3043,14 +3067,13 @@ package Sem_Util is -- This is used as a defense mechanism against ill-formed trees caused by -- previous errors (particularly in -gnatq mode). - function Requires_Transient_Scope (Id : Entity_Id) return Boolean; - -- Id is a type entity. The result is True when temporaries of this type - -- need to be wrapped in a transient scope to be reclaimed properly when a - -- secondary stack is in use. Examples of types requiring such wrapping are - -- controlled types and variable-sized types including unconstrained - -- arrays. - - -- WARNING: There is a matching C declaration of this subprogram in fe.h + function Requires_Transient_Scope (Typ : Entity_Id) return Boolean; + pragma Inline (Requires_Transient_Scope); + -- Return true if temporaries of Typ need to be wrapped in a transient + -- scope, either because they are allocated on the secondary stack or + -- finalization actions must be generated before the next instruction. + -- Examples of types requiring such wrapping are variable-sized types, + -- including unconstrained arrays, and controlled types. procedure Reset_Analyzed_Flags (N : Node_Id); -- Reset the Analyzed flags in all nodes of the tree whose root is N @@ -3059,6 +3082,12 @@ package Sem_Util is -- Set the current SPARK_Mode to Mode and SPARK_Mode_Pragma to Prag. This -- routine must be used in tandem with Set_SPARK_Mode. + function Returns_On_Secondary_Stack (Id : Entity_Id) return Boolean; + -- Return true if functions whose result type is Id must return on the + -- secondary stack, i.e. allocate the return object on this stack. + + -- WARNING: There is a matching C declaration of this subprogram in fe.h + function Returns_Unconstrained_Type (Subp : Entity_Id) return Boolean; -- Return true if Subp is a function that returns an unconstrained type @@ -3161,9 +3190,8 @@ package Sem_Util is -- This procedure has the same calling sequence as Set_Entity, but it -- performs additional checks as follows: -- - -- If Style_Check is set, then it calls a style checking routine which - -- can check identifier spelling style. This procedure also takes care - -- of checking the restriction No_Implementation_Identifiers. + -- If Style_Check is set, then it calls a style checking routine that + -- can check identifier spelling style. -- -- If restriction No_Abort_Statements is set, then it checks that the -- entity is not Ada.Task_Identification.Abort_Task. @@ -3588,68 +3616,78 @@ package Sem_Util is -- for the Storage_Model feature. These functions provide an interface -- that the compiler (in particular back-end phases such as gigi and -- GNAT-LLVM) can use to easily obtain entities and operations that - -- are specified for types in the aspects Storage_Model_Type and + -- are specified for types that have aspects Storage_Model_Type or -- Designated_Storage_Model. - function Get_Storage_Model_Type_Entity - (Typ : Entity_Id; - Nam : Name_Id) return Entity_Id; - -- Given type Typ with aspect Storage_Model_Type, returns the Entity_Id - -- corresponding to the entity associated with Nam in the aspect. If the - -- type does not specify the aspect, or such an entity is not present, - -- then returns Empty. (Note: This function is modeled on function - -- Get_Iterable_Type_Primitive.) + function Has_Storage_Model_Type_Aspect (Typ : Entity_Id) return Boolean; + -- Returns True iff Typ specifies aspect Storage_Model_Type function Has_Designated_Storage_Model_Aspect (Typ : Entity_Id) return Boolean; -- Returns True iff Typ specifies aspect Designated_Storage_Model - function Has_Storage_Model_Type_Aspect (Typ : Entity_Id) return Boolean; - -- Returns True iff Typ specifies aspect Storage_Model_Type - function Storage_Model_Object (Typ : Entity_Id) return Entity_Id; - -- Given an access type with aspect Designated_Storage_Model, returns - -- the storage-model object associated with that type; returns Empty - -- if there is no associated object. + -- Given an access type Typ with aspect Designated_Storage_Model, + -- returns the storage-model object associated with that type. + -- The object Entity_Ids returned by this function can be passed + -- other functions declared in this interface to retrieve operations + -- associated with Storage_Model_Type aspect of the object's type. function Storage_Model_Type (Obj : Entity_Id) return Entity_Id; -- Given an object Obj of a type specifying aspect Storage_Model_Type, - -- returns that type; otherwise returns Empty. - - function Storage_Model_Address_Type (Typ : Entity_Id) return Entity_Id; - -- Given a type Typ that specifies aspect Storage_Model_Type, returns - -- the type specified for the Address_Type choice in that aspect; - -- returns Empty if the aspect or the type isn't specified. - - function Storage_Model_Null_Address (Typ : Entity_Id) return Entity_Id; - -- Given a type Typ that specifies aspect Storage_Model_Type, returns - -- constant specified for Null_Address choice in that aspect; returns - -- Empty if the aspect or the constant object isn't specified. - - function Storage_Model_Allocate (Typ : Entity_Id) return Entity_Id; - -- Given a type Typ that specifies aspect Storage_Model_Type, returns - -- procedure specified for the Allocate choice in that aspect; returns - -- Empty if the aspect or the procedure isn't specified. - - function Storage_Model_Deallocate (Typ : Entity_Id) return Entity_Id; - -- Given a type Typ that specifies aspect Storage_Model_Type, returns - -- procedure specified for the Deallocate choice in that aspect; returns - -- Empty if the aspect or the procedure isn't specified. - - function Storage_Model_Copy_From (Typ : Entity_Id) return Entity_Id; - -- Given a type Typ that specifies aspect Storage_Model_Type, returns - -- procedure specified for the Copy_From choice in that aspect; returns - -- Empty if the aspect or the procedure isn't specified. - - function Storage_Model_Copy_To (Typ : Entity_Id) return Entity_Id; - -- Given a type Typ that specifies aspect Storage_Model_Type, returns - -- procedure specified for the Copy_To choice in that aspect; returns - -- Empty if the aspect or the procedure isn't specified. - - function Storage_Model_Storage_Size (Typ : Entity_Id) return Entity_Id; - -- Given a type Typ that specifies aspect Storage_Model_Type, returns - -- function specified for Storage_Size choice in that aspect; returns - -- Empty if the aspect or the procedure isn't specified. + -- returns that type. + + function Get_Storage_Model_Type_Entity + (SM_Obj_Or_Type : Entity_Id; + Nam : Name_Id) return Entity_Id; + -- Given a type with aspect Storage_Model_Type or an object of such a + -- type, and Nam denoting the name of one of the argument kinds allowed + -- for that aspect, returns the Entity_Id corresponding to the entity + -- associated with Nam in the aspect. If such an entity is not present, + -- then returns Empty. (Note: This function is modeled on function + -- Get_Iterable_Type_Primitive.) + + function Storage_Model_Address_Type + (SM_Obj_Or_Type : Entity_Id) return Entity_Id; + -- Given a type with aspect Storage_Model_Type or an object of such a + -- type, returns the type specified for the Address_Type choice in that + -- aspect; returns Empty if the type isn't specified. + + function Storage_Model_Null_Address + (SM_Obj_Or_Type : Entity_Id) return Entity_Id; + -- Given a type with aspect Storage_Model_Type or an object of such a + -- type, returns the constant specified for the Null_Address choice in + -- that aspect; returns Empty if the constant object isn't specified. + + function Storage_Model_Allocate + (SM_Obj_Or_Type : Entity_Id) return Entity_Id; + -- Given a type with aspect Storage_Model_Type or an object of such a + -- type, returns the procedure specified for the Allocate choice in that + -- aspect; returns Empty if the procedure isn't specified. + + function Storage_Model_Deallocate + (SM_Obj_Or_Type : Entity_Id) return Entity_Id; + -- Given a type with aspect Storage_Model_Type or an object of such a + -- type, returns the procedure specified for the Deallocate choice in + -- that aspect; returns Empty if the procedure isn't specified. + + function Storage_Model_Copy_From + (SM_Obj_Or_Type : Entity_Id) return Entity_Id; + -- Given a type with aspect Storage_Model_Type or an object of such a + -- type, returns the procedure specified for the Copy_From choice in + -- that aspect; returns Empty if the procedure isn't specified. + + function Storage_Model_Copy_To + (SM_Obj_Or_Type : Entity_Id) return Entity_Id; + -- Given a type with aspect Storage_Model_Type or an object of such a + -- type, returns the procedure specified for the Copy_To choice in that + -- aspect; returns Empty if the procedure isn't specified. + + function Storage_Model_Storage_Size + (SM_Obj_Or_Type : Entity_Id) return Entity_Id; + -- Given a type with aspect Storage_Model_Type or an object of such a + -- type, returns the function specified for the Storage_Size choice in + -- that aspect; returns Empty if the procedure isn't specified. end Storage_Model_Support; diff --git a/gcc/ada/sigtramp-arm-qnx.c b/gcc/ada/sigtramp-arm-qnx.c new file mode 100644 index 0000000..24a3b64 --- /dev/null +++ b/gcc/ada/sigtramp-arm-qnx.c @@ -0,0 +1,148 @@ +/**************************************************************************** + * * + * GNAT COMPILER COMPONENTS * + * * + * S I G T R A M P * + * * + * Asm Implementation File * + * * + * Copyright (C) 2011-2022, 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. * + * * + * In particular, you can freely distribute your programs built with the * + * GNAT Pro compiler, including any required library run-time units, using * + * any licensing terms of your choosing. See the AdaCore Software License * + * for full details. * + * * + * GNAT was originally developed by the GNAT team at New York University. * + * Extensive contributions were provided by Ada Core Technologies Inc. * + * * + ****************************************************************************/ + +/************************************************** + * ARM-QNX version of the __gnat_sigtramp service * + **************************************************/ + +#include <signal.h> +#include <ucontext.h> + +#include "sigtramp.h" +/* See sigtramp.h for a general explanation of functionality. */ + +/* ------------------------------------------- + -- Prototypes for our internal asm stubs -- + ------------------------------------------- + + Eventhough our symbols will remain local, the prototype claims "extern" + and not "static" to prevent compiler complaints about a symbol used but + never defined. */ + +/* sigtramp stub providing ARM unwinding info for common registers. */ + +extern void __gnat_sigtramp_common +(int signo, void *siginfo, void *sigcontext, + __sigtramphandler_t * handler, void * sc_pregs); + +/* ------------------------------------- + -- Common interface implementation -- + ------------------------------------- + + We enforce optimization to minimize the overhead of the extra layer. */ + +void __gnat_sigtramp (int signo, void *si, void *sc, + __sigtramphandler_t * handler) + __attribute__((optimize(2))); + +void __gnat_sigtramp (int signo, void *si, void *sc, + __sigtramphandler_t * handler) +{ + mcontext_t *mcontext = &((ucontext_t *) sc)->uc_mcontext; + + /* Pass MCONTEXT in the fifth position so that the assembly code can find + it at the same stack location as SC_PREGS. */ + __gnat_sigtramp_common (signo, si, mcontext, handler, &mcontext->cpu); +} + +/* asm string construction helpers. */ + +#define STR(TEXT) #TEXT +/* stringify expanded TEXT, surrounding it with double quotes. */ + +#define S(E) STR(E) +/* stringify E, which will resolve as text but may contain macros + still to be expanded. */ + +/* asm (TEXT) outputs <tab>TEXT. These facilitate the output of + multiline contents: */ +#define TAB(S) "\t" S +#define CR(S) S "\n" + +#undef TCR +#define TCR(S) TAB(CR(S)) + +/* Trampoline body block + --------------------- */ + +/* The 5 arguments passed to __gnat_sigtramp_common are located in: + - r0-r2: arguments to pass on to the actual handler + - r3: the actual handler + - sp: the address of the reg set to restore + All we have to do then is to instruct the unwinder to restore the registers + from the value in VSP. Unwinder instructions are executed backwards, so we + 1- instruct to pop r2 from the VSP (.save {r2}) + 2- move the VSP to the address pointed to by r2 (.movsp r2) + 3- restore all registers from there. (.save {r0-r15}) + Once the unwinding instructions are set, we just need to call the handler + as r0-r2 are already properly set. +*/ +#define SIGTRAMP_BODY \ +CR("") \ +TCR(".save {r0-r15}") \ +TCR(".movsp r2") \ +TCR(".save {r2}") \ +TCR("blx r3") \ +TCR("# No return here.") + +/* Symbol definition block + ----------------------- */ + +#define SIGTRAMP_START(SYM) \ +CR("# " S(SYM) " unwind trampoline") \ +TCR(".type " S(SYM) ", %function") \ +CR("") \ +CR(S(SYM) ":") \ +TCR(".fnstart") + +/* Symbol termination block + ------------------------ */ + +#define SIGTRAMP_END(SYM) \ +CR(".fnend") \ +TCR(".size " S(SYM) ", .-" S(SYM)) + +/*---------------------------- + -- And now, the real code -- + ---------------------------- */ + +/* Text section start. The compiler isn't aware of that switch. */ + +asm (".text\n" + TCR(".align 2")); + +/* sigtramp stub for common registers. */ + +#define TRAMP_COMMON __gnat_sigtramp_common + +asm (SIGTRAMP_START(TRAMP_COMMON)); +asm (SIGTRAMP_BODY); +asm (SIGTRAMP_END(TRAMP_COMMON)); diff --git a/gcc/ada/sigtramp-qnx.c b/gcc/ada/sigtramp-qnx.c index f44b971..b3a5fa8 100644 --- a/gcc/ada/sigtramp-qnx.c +++ b/gcc/ada/sigtramp-qnx.c @@ -49,7 +49,7 @@ void __gnat_sigtramp (int signo, void *si, void *sc, void __gnat_sigtramp (int signo, void *si, void *ucontext, __sigtramphandler_t * handler) { - struct sigcontext *mcontext = &((ucontext_t *) ucontext)->uc_mcontext; + mcontext_t *mcontext = &((ucontext_t *) ucontext)->uc_mcontext; __gnat_sigtramp_common (signo, si, mcontext, handler); } diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index a5f348f..e3e06ee 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -816,12 +816,15 @@ package Sinfo is -- Actual_Designated_Subtype -- Present in N_Free_Statement and N_Explicit_Dereference nodes. If gigi - -- needs to known the dynamic constrained subtype of the designated - -- object, this attribute is set to that type. This is done for - -- N_Free_Statements for access-to-classwide types and access to - -- unconstrained packed array types, and for N_Explicit_Dereference when - -- the designated type is an unconstrained packed array and the - -- dereference is the prefix of a 'Size attribute reference. + -- needs to know the dynamic constrained subtype of the designated + -- object, this attribute is set to that subtype. This is done for + -- N_Free_Statements for access-to-classwide types and access-to- + -- unconstrained packed array types. For N_Explicit_Dereference, + -- this is done in two circumstances: 1) when the designated type is + -- an unconstrained packed array and the dereference is the prefix of + -- a 'Size attribute reference, or 2) when the dereference node is + -- created for the expansion of an allocator with a subtype_indication + -- and the designated subtype is an unconstrained discriminated type. -- Address_Warning_Posted -- Present in N_Attribute_Definition nodes. Set to indicate that we have @@ -1354,13 +1357,6 @@ package Sinfo is -- These generated nodes have the From_Aspect_Specification flag set to -- indicate that they came from aspect specifications originally. - -- From_At_End - -- This flag is set on an N_Raise_Statement node if it corresponds to - -- the reraise statement generated as the last statement of an AT END - -- handler when SJLJ exception handling is active. It is used to stop - -- a bogus violation of restriction (No_Exception_Propagation), bogus - -- because if the restriction is set, the reraise is not generated. - -- From_At_Mod -- This flag is set on the attribute definition clause node that is -- generated by a transformation of an at mod phrase in a record @@ -1536,10 +1532,8 @@ package Sinfo is -- Incomplete_View -- Present in full type declarations that are completions of incomplete - -- type declarations. Denotes the corresponding incomplete type - -- declaration. Used to simplify the retrieval of primitive operations - -- that may be declared between the partial and the full view of an - -- untagged type. + -- type declarations. Denotes the corresponding incomplete view declared + -- by the incomplete declaration. -- Inherited_Discriminant -- This flag is present in N_Component_Association nodes. It indicates @@ -2828,7 +2822,7 @@ package Sinfo is -- Defining_Identifier -- Null_Exclusion_Present -- Subtype_Indication - -- Generic_Parent_Type (set for an actual derived type). + -- Generic_Parent_Type (for actual of formal private or derived type) -- Exception_Junk ------------------------------- @@ -6813,38 +6807,24 @@ package Sinfo is -- The AT END phrase is a GNAT extension to provide for cleanups. It is -- used only internally currently, but is considered to be syntactic. - -- At the moment, the only cleanup action allowed is a single call to - -- a parameterless procedure, and the Identifier field of the node is - -- the procedure to be called. The cleanup action occurs whenever the - -- sequence of statements is left for any reason. The possible reasons - -- are: + -- At the moment, the only cleanup action allowed is a single call to a + -- parameterless procedure; this restriction could be lifted if we make + -- some changes in gigi. The At_End_Proc field is an N_Identifier node + -- that denotes the procedure to be called. The cleanup action occurs + -- whenever the sequence of statements is left for any reason. The + -- possible reasons are: + -- -- 1. reaching the end of the sequence -- 2. exit, return, or goto -- 3. exception or abort - -- For some back ends, such as gcc with ZCX, "at end" is implemented - -- entirely in the back end. In this case, a handled sequence of - -- statements with an "at end" cannot also have exception handlers. - -- For other back ends, such as gcc with front-end SJLJ, the - -- implementation is split between the front end and back end; the front - -- end implements 3, and the back end implements 1 and 2. In this case, - -- if there is an "at end", the front end inserts the appropriate - -- exception handler, and this handler takes precedence over "at end" - -- in case of exception. - - -- The inserted exception handler is of the form: - - -- when all others => - -- cleanup; - -- raise; - - -- where cleanup is the procedure to be called. The reason we do this is - -- so that the front end can handle the necessary entries in the - -- exception tables, and other exception handler actions required as - -- part of the normal handling for exception handlers. + -- + -- The cleanup action also occurs whenever the exception handlers are + -- left. -- The AT END cleanup handler protects only the sequence of statements - -- (not the associated declarations of the parent), just like exception - -- handlers. The big difference is that the cleanup procedure is called + -- and the exception handlers (not the associated declarations of + -- the parent), just like exception handlers do not protect the + -- declarations. The big difference is that the cleanup actions occur -- on either a normal or an abnormal exit from the statement sequence. -- Note: the list of Exception_Handlers can contain pragmas as well @@ -6875,6 +6855,9 @@ package Sinfo is -- At_End_Proc (set to Empty if no clean up procedure) -- First_Real_Statement + -- Note: A Handled_Sequence_Of_Statements can contain both + -- Exception_Handlers and an At_End_Proc. + -- Note: the parent always contains a Declarations field which contains -- declarations associated with the handled sequence of statements. This -- is true even in the case of an accept statement (see description of @@ -6938,7 +6921,6 @@ package Sinfo is -- Sloc points to RAISE -- Name (set to Empty if no exception name present) -- Expression (set to Empty if no expression present) - -- From_At_End ---------------------------- -- 11.3 Raise Expression -- @@ -7334,10 +7316,15 @@ package Sinfo is -- Specification -- Default_Name (set to Empty if no subprogram default) -- Box_Present + -- Expression (set to Empty if no expression present) - -- Note: if no subprogram default is present, then Name is set + -- Note: If no subprogram default is present, then Name is set -- to Empty, and Box_Present is False. + -- Note: The Expression field is only used for the GNAT extension + -- that allows a FORMAL_CONCRETE_SUBPROGRAM_DECLARATION to specify + -- an expression default for generic formal functions. + -------------------------------------------------- -- 12.6 Formal Abstract Subprogram Declaration -- -------------------------------------------------- @@ -7359,13 +7346,17 @@ package Sinfo is -- 12.6 Subprogram Default -- ------------------------------ - -- SUBPROGRAM_DEFAULT ::= DEFAULT_NAME | <> + -- SUBPROGRAM_DEFAULT ::= DEFAULT_NAME | <> | (EXPRESSION) -- There is no separate node in the tree for a subprogram default. -- Instead the parent (N_Formal_Concrete_Subprogram_Declaration -- or N_Formal_Abstract_Subprogram_Declaration) node contains the -- default name or box indication, as needed. + -- Note: The syntax "(EXPRESSION)" is a GNAT extension, and allows + -- a FORMAL_CONCRETE_SUBPROGRAM_DECLARATION to specify an expression + -- default for formal functions, in analogy with expression_functions. + ------------------------ -- 12.6 Default Name -- ------------------------ diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index cbcb1cf..73e7304 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -958,6 +958,7 @@ package Snames is Name_Has_Tagged_Values : constant Name_Id := N + $; -- GNAT Name_Identity : constant Name_Id := N + $; Name_Implicit_Dereference : constant Name_Id := N + $; -- GNAT + Name_Index : constant Name_Id := N + $; -- Ada 22 Name_Initialized : constant Name_Id := N + $; -- GNAT Name_Integer_Value : constant Name_Id := N + $; -- GNAT Name_Invalid_Value : constant Name_Id := N + $; -- GNAT @@ -1480,6 +1481,7 @@ package Snames is Attribute_Has_Tagged_Values, Attribute_Identity, Attribute_Implicit_Dereference, + Attribute_Index, Attribute_Initialized, Attribute_Integer_Value, Attribute_Invalid_Value, diff --git a/gcc/ada/style.adb b/gcc/ada/style.adb index 60bfc93..cf7bc19 100644 --- a/gcc/ada/style.adb +++ b/gcc/ada/style.adb @@ -126,9 +126,14 @@ package body Style is elsif Error_Posted (Ref) or else Error_Posted (Def) then return; - -- Case of definition comes from source + -- Case of definition comes from source, or a record component whose + -- Original_Record_Component comes from source. - elsif Comes_From_Source (Def) then + elsif Comes_From_Source (Def) or else + (Ekind (Def) in Record_Field_Kind + and then Present (Original_Record_Component (Def)) + and then Comes_From_Source (Original_Record_Component (Def))) + then -- Check same casing if we are checking references diff --git a/gcc/ada/terminals.c b/gcc/ada/terminals.c index 32d30a4..330128a 100644 --- a/gcc/ada/terminals.c +++ b/gcc/ada/terminals.c @@ -1123,12 +1123,6 @@ __gnat_setup_winsize (void *desc ATTRIBUTE_UNUSED, #define CDISABLE _POSIX_VDISABLE -/* On HP-UX and Sun system, there is a bzero function but with a different - signature. Use memset instead */ -#if defined (__hpux__) || defined (__sun__) || defined (_AIX) -# define bzero(s,n) memset (s,0,n) -#endif - /* POSIX does not specify how to open the master side of a terminal.Several methods are available (system specific): 1- using a cloning device (USE_CLONE_DEVICE) @@ -1289,8 +1283,15 @@ child_setup_tty (int fd) struct termios s; int status; - /* ensure that s is filled with 0 */ - bzero (&s, sizeof (s)); + /* Ensure that s is filled with 0. + + Note that we avoid using bzero for a few reasons: + - On HP-UX and Sun system, there is a bzero function but with + a different signature, thus making the use of bzero more + complicated on these platforms (we used to define a bzero + macro that rewrote calls to bzero into calls to memset); + - bzero is deprecated (marked as LEGACY in POSIX.1-2001). */ + memset (&s, 0, sizeof (s)); /* Get the current terminal settings */ status = tcgetattr (fd, &s); diff --git a/gcc/ada/tracebak.c b/gcc/ada/tracebak.c index 6cc5d30..f4e739d 100644 --- a/gcc/ada/tracebak.c +++ b/gcc/ada/tracebak.c @@ -555,6 +555,9 @@ is_return_from(void *symbol_addr, void *ret_addr) #if defined (__aarch64__) #define PC_ADJUST -4 +#elif defined (__ARMEL__) +#define PC_ADJUST -2 +#define USING_ARM_UNWINDING 1 #else #error Unhandled QNX architecture. #endif diff --git a/gcc/ada/uintp.ads b/gcc/ada/uintp.ads index 05b4e6e..55f5b97 100644 --- a/gcc/ada/uintp.ads +++ b/gcc/ada/uintp.ads @@ -105,7 +105,8 @@ package Uintp is subtype Upos is Valid_Uint with Predicate => Upos >= Uint_1; -- positive subtype Nonzero_Uint is Valid_Uint with Predicate => Nonzero_Uint /= Uint_0; subtype Unegative is Valid_Uint with Predicate => Unegative < Uint_0; - subtype Ubool is Valid_Uint with Predicate => Ubool in Uint_0 | Uint_1; + subtype Ubool is Valid_Uint with + Predicate => Ubool = Uint_0 or else Ubool = Uint_1; subtype Opt_Ubool is Uint with Predicate => No (Opt_Ubool) or else Opt_Ubool in Ubool; diff --git a/gcc/ada/uname.adb b/gcc/ada/uname.adb index 60ef2b6..200c036 100644 --- a/gcc/ada/uname.adb +++ b/gcc/ada/uname.adb @@ -715,7 +715,7 @@ package body Uname is Buf : Bounded_String; begin Get_Unit_Name_String (Buf, N); - Write_Str (Buf.chars (1 .. Buf.Length)); + Write_Str (Buf.Chars (1 .. Buf.Length)); end Write_Unit_Name; ------------------------------- diff --git a/gcc/ada/xr_tabls.adb b/gcc/ada/xr_tabls.adb deleted file mode 100644 index 8f6fb7a..0000000 --- a/gcc/ada/xr_tabls.adb +++ /dev/null @@ -1,1628 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- X R _ T A B L S -- --- -- --- B o d y -- --- -- --- Copyright (C) 1998-2022, 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. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Types; use Types; -with Osint; - -with Ada.Unchecked_Conversion; -with Ada.Unchecked_Deallocation; -with Ada.Strings.Fixed; -with Ada.Strings; -with Ada.Text_IO; -with Ada.Characters.Handling; use Ada.Characters.Handling; -with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; - -with GNAT.OS_Lib; use GNAT.OS_Lib; -with GNAT.Directory_Operations; use GNAT.Directory_Operations; -with GNAT.HTable; -with GNAT.Heap_Sort_G; - -package body Xr_Tabls is - - type HTable_Headers is range 1 .. 10000; - - procedure Set_Next (E : File_Reference; Next : File_Reference); - function Next (E : File_Reference) return File_Reference; - function Get_Key (E : File_Reference) return Cst_String_Access; - function Hash (F : Cst_String_Access) return HTable_Headers; - function Equal (F1, F2 : Cst_String_Access) return Boolean; - -- The five subprograms above are used to instantiate the static - -- htable to store the files that should be processed. - - package File_HTable is new GNAT.HTable.Static_HTable - (Header_Num => HTable_Headers, - Element => File_Record, - Elmt_Ptr => File_Reference, - Null_Ptr => null, - Set_Next => Set_Next, - Next => Next, - Key => Cst_String_Access, - Get_Key => Get_Key, - Hash => Hash, - Equal => Equal); - -- A hash table to store all the files referenced in the - -- application. The keys in this htable are the name of the files - -- themselves, therefore it is assumed that the source path - -- doesn't contain twice the same source or ALI file name - - type Unvisited_Files_Record; - type Unvisited_Files_Access is access Unvisited_Files_Record; - type Unvisited_Files_Record is record - File : File_Reference; - Next : Unvisited_Files_Access; - end record; - -- A special list, in addition to File_HTable, that only stores - -- the files that haven't been visited so far. Note that the File - -- list points to some data in File_HTable, and thus should never be freed. - - function Next (E : Declaration_Reference) return Declaration_Reference; - procedure Set_Next (E, Next : Declaration_Reference); - function Get_Key (E : Declaration_Reference) return Cst_String_Access; - -- The subprograms above are used to instantiate the static - -- htable to store the entities that have been found in the application - - package Entities_HTable is new GNAT.HTable.Static_HTable - (Header_Num => HTable_Headers, - Element => Declaration_Record, - Elmt_Ptr => Declaration_Reference, - Null_Ptr => null, - Set_Next => Set_Next, - Next => Next, - Key => Cst_String_Access, - Get_Key => Get_Key, - Hash => Hash, - Equal => Equal); - -- A hash table to store all the entities defined in the - -- application. For each entity, we store a list of its reference - -- locations as well. - -- The keys in this htable should be created with Key_From_Ref, - -- and are the file, line and column of the declaration, which are - -- unique for every entity. - - Entities_Count : Natural := 0; - -- Number of entities in Entities_HTable. This is used in the end - -- when sorting the table. - - Longest_File_Name_In_Table : Natural := 0; - -- The length of the longest file name stored - - Unvisited_Files : Unvisited_Files_Access := null; - -- Linked list of unvisited files - - Directories : Project_File_Ptr; - -- Store the list of directories to visit - - Default_Match : Boolean := False; - -- Default value for match in declarations - - function Parse_Gnatls_Src return String; - -- Return the standard source directories (taking into account the - -- ADA_INCLUDE_PATH environment variable, if Osint.Add_Default_Search_Dirs - -- was called first). - - function Parse_Gnatls_Obj return String; - -- Return the standard object directories (taking into account the - -- ADA_OBJECTS_PATH environment variable). - - function Key_From_Ref - (File_Ref : File_Reference; - Line : Natural; - Column : Natural) - return String; - -- Return a key for the symbol declared at File_Ref, Line, - -- Column. This key should be used for lookup in Entity_HTable - - function Is_Less_Than (Decl1, Decl2 : Declaration_Reference) return Boolean; - -- Compare two declarations (the comparison is case-insensitive) - - function Is_Less_Than (Ref1, Ref2 : Reference) return Boolean; - -- Compare two references - - procedure Store_References - (Decl : Declaration_Reference; - Get_Writes : Boolean := False; - Get_Reads : Boolean := False; - Get_Bodies : Boolean := False; - Get_Declaration : Boolean := False; - Arr : in out Reference_Array; - Index : in out Natural); - -- Store in Arr, starting at Index, all the references to Decl. The Get_* - -- parameters can be used to indicate which references should be stored. - -- Constraint_Error will be raised if Arr is not big enough. - - procedure Sort (Arr : in out Reference_Array); - -- Sort an array of references (Arr'First must be 1) - - -------------- - -- Set_Next -- - -------------- - - procedure Set_Next (E : File_Reference; Next : File_Reference) is - begin - E.Next := Next; - end Set_Next; - - procedure Set_Next - (E : Declaration_Reference; Next : Declaration_Reference) is - begin - E.Next := Next; - end Set_Next; - - ------------- - -- Get_Key -- - ------------- - - function Get_Key (E : File_Reference) return Cst_String_Access is - begin - return E.File; - end Get_Key; - - function Get_Key (E : Declaration_Reference) return Cst_String_Access is - begin - return E.Key; - end Get_Key; - - ---------- - -- Hash -- - ---------- - - function Hash (F : Cst_String_Access) return HTable_Headers is - function H is new GNAT.HTable.Hash (HTable_Headers); - - begin - return H (F.all); - end Hash; - - ----------- - -- Equal -- - ----------- - - function Equal (F1, F2 : Cst_String_Access) return Boolean is - begin - return F1.all = F2.all; - end Equal; - - ------------------ - -- Key_From_Ref -- - ------------------ - - function Key_From_Ref - (File_Ref : File_Reference; - Line : Natural; - Column : Natural) - return String - is - begin - return File_Ref.File.all & Natural'Image (Line) & Natural'Image (Column); - end Key_From_Ref; - - --------------------- - -- Add_Declaration -- - --------------------- - - function Add_Declaration - (File_Ref : File_Reference; - Symbol : String; - Line : Natural; - Column : Natural; - Decl_Type : Character; - Is_Parameter : Boolean := False; - Remove_Only : Boolean := False; - Symbol_Match : Boolean := True) - return Declaration_Reference - is - procedure Unchecked_Free is new Ada.Unchecked_Deallocation - (Declaration_Record, Declaration_Reference); - - Key : aliased constant String := Key_From_Ref (File_Ref, Line, Column); - - New_Decl : Declaration_Reference := - Entities_HTable.Get (Key'Unchecked_Access); - - Is_Param : Boolean := Is_Parameter; - - begin - -- Insert the Declaration in the table. There might already be a - -- declaration in the table if the entity is a parameter, so we - -- need to check that first. - - if New_Decl /= null and then New_Decl.Symbol_Length = 0 then - Is_Param := Is_Parameter or else New_Decl.Is_Parameter; - Entities_HTable.Remove (Key'Unrestricted_Access); - Entities_Count := Entities_Count - 1; - Free (New_Decl.Key); - Unchecked_Free (New_Decl); - New_Decl := null; - end if; - - -- The declaration might also already be there for parent types. In - -- this case, we should keep the entry, since some other entries are - -- pointing to it. - - if New_Decl = null - and then not Remove_Only - then - New_Decl := - new Declaration_Record' - (Symbol_Length => Symbol'Length, - Symbol => Symbol, - Key => new String'(Key), - Decl => new Reference_Record' - (File => File_Ref, - Line => Line, - Column => Column, - Source_Line => null, - Next => null), - Is_Parameter => Is_Param, - Decl_Type => Decl_Type, - Body_Ref => null, - Ref_Ref => null, - Modif_Ref => null, - Match => Symbol_Match - and then - (Default_Match - or else Match (File_Ref, Line, Column)), - Par_Symbol => null, - Next => null); - - Entities_HTable.Set (New_Decl); - Entities_Count := Entities_Count + 1; - - if New_Decl.Match then - Longest_File_Name_In_Table := - Natural'Max (File_Ref.File'Length, Longest_File_Name_In_Table); - end if; - - elsif New_Decl /= null - and then not New_Decl.Match - then - New_Decl.Match := Default_Match - or else Match (File_Ref, Line, Column); - New_Decl.Is_Parameter := New_Decl.Is_Parameter or Is_Param; - - elsif New_Decl /= null then - New_Decl.Is_Parameter := New_Decl.Is_Parameter or Is_Param; - end if; - - return New_Decl; - end Add_Declaration; - - ---------------------- - -- Add_To_Xref_File -- - ---------------------- - - function Add_To_Xref_File - (File_Name : String; - Visited : Boolean := True; - Emit_Warning : Boolean := False; - Gnatchop_File : String := ""; - Gnatchop_Offset : Integer := 0) return File_Reference - is - Base : aliased constant String := Base_Name (File_Name); - Dir : constant String := Dir_Name (File_Name); - Dir_Acc : GNAT.OS_Lib.String_Access := null; - Ref : File_Reference; - - begin - -- Do we have a directory name as well? - - if File_Name /= Base then - Dir_Acc := new String'(Dir); - end if; - - Ref := File_HTable.Get (Base'Unchecked_Access); - if Ref = null then - Ref := new File_Record' - (File => new String'(Base), - Dir => Dir_Acc, - Lines => null, - Visited => Visited, - Emit_Warning => Emit_Warning, - Gnatchop_File => new String'(Gnatchop_File), - Gnatchop_Offset => Gnatchop_Offset, - Next => null); - File_HTable.Set (Ref); - - if not Visited then - - -- Keep a separate list for faster access - - Set_Unvisited (Ref); - end if; - end if; - return Ref; - end Add_To_Xref_File; - - -------------- - -- Add_Line -- - -------------- - - procedure Add_Line - (File : File_Reference; - Line : Natural; - Column : Natural) - is - begin - File.Lines := new Ref_In_File'(Line => Line, - Column => Column, - Next => File.Lines); - end Add_Line; - - ---------------- - -- Add_Parent -- - ---------------- - - procedure Add_Parent - (Declaration : in out Declaration_Reference; - Symbol : String; - Line : Natural; - Column : Natural; - File_Ref : File_Reference) - is - begin - Declaration.Par_Symbol := - Add_Declaration - (File_Ref, Symbol, Line, Column, - Decl_Type => ' ', - Symbol_Match => False); - end Add_Parent; - - ------------------- - -- Add_Reference -- - ------------------- - - procedure Add_Reference - (Declaration : Declaration_Reference; - File_Ref : File_Reference; - Line : Natural; - Column : Natural; - Ref_Type : Character; - Labels_As_Ref : Boolean) - is - New_Ref : Reference; - New_Decl : Declaration_Reference; - pragma Unreferenced (New_Decl); - - begin - case Ref_Type is - when ' ' | 'b' | 'c' | 'H' | 'i' | 'm' | 'o' | 'r' | 'R' | 's' | 'x' - => - null; - - when 'l' | 'w' => - if not Labels_As_Ref then - return; - end if; - - when '=' | '<' | '>' | '^' => - - -- Create dummy declaration in table to report it as a parameter - - -- In a given ALI file, the declaration of the subprogram comes - -- before the declaration of the parameter. However, it is - -- possible that another ALI file has been parsed that also - -- references the parameter (for instance a named parameter in - -- a call), so we need to check whether there already exists a - -- declaration for the parameter. - - New_Decl := - Add_Declaration - (File_Ref => File_Ref, - Symbol => "", - Line => Line, - Column => Column, - Decl_Type => ' ', - Is_Parameter => True); - - when 'd' | 'e' | 'E' | 'k' | 'p' | 'P' | 't' | 'z' => - return; - - when others => - Ada.Text_IO.Put_Line ("Unknown reference type: " & Ref_Type); - return; - end case; - - New_Ref := new Reference_Record' - (File => File_Ref, - Line => Line, - Column => Column, - Source_Line => null, - Next => null); - - -- We can insert the reference into the list directly, since all the - -- references will appear only once in the ALI file corresponding to the - -- file where they are referenced. This saves a lot of time compared to - -- checking the list to check if it exists. - - case Ref_Type is - when 'b' | 'c' => - New_Ref.Next := Declaration.Body_Ref; - Declaration.Body_Ref := New_Ref; - - when ' ' | 'H' | 'i' | 'l' | 'o' | 'r' | 'R' | 's' | 'w' | 'x' => - New_Ref.Next := Declaration.Ref_Ref; - Declaration.Ref_Ref := New_Ref; - - when 'm' => - New_Ref.Next := Declaration.Modif_Ref; - Declaration.Modif_Ref := New_Ref; - - when others => - null; - end case; - - if not Declaration.Match then - Declaration.Match := Match (File_Ref, Line, Column); - end if; - - if Declaration.Match then - Longest_File_Name_In_Table := - Natural'Max (File_Ref.File'Length, Longest_File_Name_In_Table); - end if; - end Add_Reference; - - ------------------- - -- ALI_File_Name -- - ------------------- - - function ALI_File_Name (Ada_File_Name : String) return String is - -- Should ideally be based on the naming scheme defined in - -- project files but this is too late for an obsolescent feature. - - Index : constant Natural := - Ada.Strings.Fixed.Index - (Ada_File_Name, ".", Going => Ada.Strings.Backward); - - begin - if Index /= 0 then - return Ada_File_Name (Ada_File_Name'First .. Index) - & Osint.ALI_Suffix.all; - else - return Ada_File_Name & "." & Osint.ALI_Suffix.all; - end if; - end ALI_File_Name; - - ------------------ - -- Is_Less_Than -- - ------------------ - - function Is_Less_Than (Ref1, Ref2 : Reference) return Boolean is - begin - if Ref1 = null then - return False; - elsif Ref2 = null then - return True; - end if; - - if Ref1.File.File.all < Ref2.File.File.all then - return True; - - elsif Ref1.File.File.all = Ref2.File.File.all then - return (Ref1.Line < Ref2.Line - or else (Ref1.Line = Ref2.Line - and then Ref1.Column < Ref2.Column)); - end if; - - return False; - end Is_Less_Than; - - ------------------ - -- Is_Less_Than -- - ------------------ - - function Is_Less_Than (Decl1, Decl2 : Declaration_Reference) return Boolean - is - -- We cannot store the data case-insensitive in the table, - -- since we wouldn't be able to find the right casing for the - -- display later on. - - S1 : constant String := To_Lower (Decl1.Symbol); - S2 : constant String := To_Lower (Decl2.Symbol); - - begin - if S1 < S2 then - return True; - elsif S1 > S2 then - return False; - end if; - - return Decl1.Key.all < Decl2.Key.all; - end Is_Less_Than; - - ------------------------- - -- Create_Project_File -- - ------------------------- - - procedure Create_Project_File (Name : String) is - Obj_Dir : Unbounded_String := Null_Unbounded_String; - Src_Dir : Unbounded_String := Null_Unbounded_String; - Build_Dir : GNAT.OS_Lib.String_Access := new String'(""); - - F : File_Descriptor; - Len : Positive; - File_Name : aliased String := Name & ASCII.NUL; - - begin - -- Read the size of the file - - F := Open_Read (File_Name'Address, Text); - - -- Project file not found - - if F /= Invalid_FD then - Len := Positive (File_Length (F)); - - declare - Buffer : String (1 .. Len); - Index : Positive := Buffer'First; - Last : Positive; - - begin - Len := Read (F, Buffer'Address, Len); - Close (F); - - -- First, look for Build_Dir, since all the source and object - -- path are relative to it. - - while Index <= Buffer'Last loop - - -- Find the end of line - - Last := Index; - while Last <= Buffer'Last - and then Buffer (Last) /= ASCII.LF - and then Buffer (Last) /= ASCII.CR - loop - Last := Last + 1; - end loop; - - if Index <= Buffer'Last - 9 - and then Buffer (Index .. Index + 9) = "build_dir=" - then - Index := Index + 10; - while Index <= Last - and then (Buffer (Index) = ' ' - or else Buffer (Index) = ASCII.HT) - loop - Index := Index + 1; - end loop; - - Free (Build_Dir); - Build_Dir := new String'(Buffer (Index .. Last - 1)); - end if; - - Index := Last + 1; - - -- In case we had a ASCII.CR/ASCII.LF end of line, skip the - -- remaining symbol - - if Index <= Buffer'Last - and then Buffer (Index) = ASCII.LF - then - Index := Index + 1; - end if; - end loop; - - -- Now parse the source and object paths - - Index := Buffer'First; - while Index <= Buffer'Last loop - - -- Find the end of line - - Last := Index; - while Last <= Buffer'Last - and then Buffer (Last) /= ASCII.LF - and then Buffer (Last) /= ASCII.CR - loop - Last := Last + 1; - end loop; - - if Index <= Buffer'Last - 7 - and then Buffer (Index .. Index + 7) = "src_dir=" - then - Append (Src_Dir, Normalize_Pathname - (Name => Ada.Strings.Fixed.Trim - (Buffer (Index + 8 .. Last - 1), Ada.Strings.Both), - Directory => Build_Dir.all) & Path_Separator); - - elsif Index <= Buffer'Last - 7 - and then Buffer (Index .. Index + 7) = "obj_dir=" - then - Append (Obj_Dir, Normalize_Pathname - (Name => Ada.Strings.Fixed.Trim - (Buffer (Index + 8 .. Last - 1), Ada.Strings.Both), - Directory => Build_Dir.all) & Path_Separator); - end if; - - -- In case we had a ASCII.CR/ASCII.LF end of line, skip the - -- remaining symbol - Index := Last + 1; - - if Index <= Buffer'Last - and then Buffer (Index) = ASCII.LF - then - Index := Index + 1; - end if; - end loop; - end; - end if; - - Osint.Add_Default_Search_Dirs; - - declare - Src : constant String := Parse_Gnatls_Src; - Obj : constant String := Parse_Gnatls_Obj; - - begin - Directories := new Project_File' - (Src_Dir_Length => Length (Src_Dir) + Src'Length, - Obj_Dir_Length => Length (Obj_Dir) + Obj'Length, - Src_Dir => To_String (Src_Dir) & Src, - Obj_Dir => To_String (Obj_Dir) & Obj, - Src_Dir_Index => 1, - Obj_Dir_Index => 1, - Last_Obj_Dir_Start => 0); - end; - - Free (Build_Dir); - end Create_Project_File; - - --------------------- - -- Current_Obj_Dir -- - --------------------- - - function Current_Obj_Dir return String is - begin - return Directories.Obj_Dir - (Directories.Last_Obj_Dir_Start .. Directories.Obj_Dir_Index - 2); - end Current_Obj_Dir; - - ---------------- - -- Get_Column -- - ---------------- - - function Get_Column (Decl : Declaration_Reference) return String is - begin - return Ada.Strings.Fixed.Trim (Natural'Image (Decl.Decl.Column), - Ada.Strings.Left); - end Get_Column; - - function Get_Column (Ref : Reference) return String is - begin - return Ada.Strings.Fixed.Trim (Natural'Image (Ref.Column), - Ada.Strings.Left); - end Get_Column; - - --------------------- - -- Get_Declaration -- - --------------------- - - function Get_Declaration - (File_Ref : File_Reference; - Line : Natural; - Column : Natural) - return Declaration_Reference - is - Key : aliased constant String := Key_From_Ref (File_Ref, Line, Column); - - begin - return Entities_HTable.Get (Key'Unchecked_Access); - end Get_Declaration; - - ---------------------- - -- Get_Emit_Warning -- - ---------------------- - - function Get_Emit_Warning (File : File_Reference) return Boolean is - begin - return File.Emit_Warning; - end Get_Emit_Warning; - - -------------- - -- Get_File -- - -------------- - - function Get_File - (Decl : Declaration_Reference; - With_Dir : Boolean := False) return String - is - begin - return Get_File (Decl.Decl.File, With_Dir); - end Get_File; - - function Get_File - (Ref : Reference; - With_Dir : Boolean := False) return String - is - begin - return Get_File (Ref.File, With_Dir); - end Get_File; - - function Get_File - (File : File_Reference; - With_Dir : Boolean := False; - Strip : Natural := 0) return String - is - pragma Annotate (CodePeer, Skip_Analysis); - -- Disable CodePeer false positives - - Tmp : GNAT.OS_Lib.String_Access; - - function Internal_Strip (Full_Name : String) return String; - -- Internal function to process the Strip parameter - - -------------------- - -- Internal_Strip -- - -------------------- - - function Internal_Strip (Full_Name : String) return String is - Unit_End : Natural; - Extension_Start : Natural; - S : Natural; - - begin - if Strip = 0 then - return Full_Name; - end if; - - -- Isolate the file extension - - Extension_Start := Full_Name'Last; - while Extension_Start >= Full_Name'First - and then Full_Name (Extension_Start) /= '.' - loop - Extension_Start := Extension_Start - 1; - end loop; - - -- Strip the right number of subunit_names - - S := Strip; - Unit_End := Extension_Start - 1; - while Unit_End >= Full_Name'First - and then S > 0 - loop - if Full_Name (Unit_End) = '-' then - S := S - 1; - end if; - - Unit_End := Unit_End - 1; - end loop; - - if Unit_End < Full_Name'First then - return ""; - else - return Full_Name (Full_Name'First .. Unit_End) - & Full_Name (Extension_Start .. Full_Name'Last); - end if; - end Internal_Strip; - - -- Start of processing for Get_File - - begin - -- If we do not want the full path name - - if not With_Dir then - return Internal_Strip (File.File.all); - end if; - - if File.Dir = null then - if Ada.Strings.Fixed.Tail (File.File.all, 3) = - Osint.ALI_Suffix.all - then - Tmp := Locate_Regular_File - (Internal_Strip (File.File.all), Directories.Obj_Dir); - else - Tmp := Locate_Regular_File - (File.File.all, Directories.Src_Dir); - end if; - - if Tmp = null then - File.Dir := new String'(""); - else - File.Dir := new String'(Dir_Name (Tmp.all)); - Free (Tmp); - end if; - end if; - - return Internal_Strip (File.Dir.all & File.File.all); - end Get_File; - - ------------------ - -- Get_File_Ref -- - ------------------ - - function Get_File_Ref (Ref : Reference) return File_Reference is - begin - return Ref.File; - end Get_File_Ref; - - ----------------------- - -- Get_Gnatchop_File -- - ----------------------- - - function Get_Gnatchop_File - (File : File_Reference; - With_Dir : Boolean := False) - return String - is - begin - if File.Gnatchop_File.all = "" then - return Get_File (File, With_Dir); - else - return File.Gnatchop_File.all; - end if; - end Get_Gnatchop_File; - - function Get_Gnatchop_File - (Ref : Reference; - With_Dir : Boolean := False) - return String - is - begin - return Get_Gnatchop_File (Ref.File, With_Dir); - end Get_Gnatchop_File; - - function Get_Gnatchop_File - (Decl : Declaration_Reference; - With_Dir : Boolean := False) - return String - is - begin - return Get_Gnatchop_File (Decl.Decl.File, With_Dir); - end Get_Gnatchop_File; - - -------------- - -- Get_Line -- - -------------- - - function Get_Line (Decl : Declaration_Reference) return String is - begin - return Ada.Strings.Fixed.Trim (Natural'Image (Decl.Decl.Line), - Ada.Strings.Left); - end Get_Line; - - function Get_Line (Ref : Reference) return String is - begin - return Ada.Strings.Fixed.Trim (Natural'Image (Ref.Line), - Ada.Strings.Left); - end Get_Line; - - ---------------- - -- Get_Parent -- - ---------------- - - function Get_Parent - (Decl : Declaration_Reference) - return Declaration_Reference - is - begin - return Decl.Par_Symbol; - end Get_Parent; - - --------------------- - -- Get_Source_Line -- - --------------------- - - function Get_Source_Line (Ref : Reference) return String is - begin - if Ref.Source_Line /= null then - return Ref.Source_Line.all; - else - return ""; - end if; - end Get_Source_Line; - - function Get_Source_Line (Decl : Declaration_Reference) return String is - begin - if Decl.Decl.Source_Line /= null then - return Decl.Decl.Source_Line.all; - else - return ""; - end if; - end Get_Source_Line; - - ---------------- - -- Get_Symbol -- - ---------------- - - function Get_Symbol (Decl : Declaration_Reference) return String is - begin - return Decl.Symbol; - end Get_Symbol; - - -------------- - -- Get_Type -- - -------------- - - function Get_Type (Decl : Declaration_Reference) return Character is - begin - return Decl.Decl_Type; - end Get_Type; - - ---------- - -- Sort -- - ---------- - - procedure Sort (Arr : in out Reference_Array) is - Tmp : Reference; - - function Lt (Op1, Op2 : Natural) return Boolean; - procedure Move (From, To : Natural); - -- See GNAT.Heap_Sort_G - - -------- - -- Lt -- - -------- - - function Lt (Op1, Op2 : Natural) return Boolean is - begin - if Op1 = 0 then - return Is_Less_Than (Tmp, Arr (Op2)); - elsif Op2 = 0 then - return Is_Less_Than (Arr (Op1), Tmp); - else - return Is_Less_Than (Arr (Op1), Arr (Op2)); - end if; - end Lt; - - ---------- - -- Move -- - ---------- - - procedure Move (From, To : Natural) is - begin - if To = 0 then - Tmp := Arr (From); - elsif From = 0 then - Arr (To) := Tmp; - else - Arr (To) := Arr (From); - end if; - end Move; - - package Ref_Sort is new GNAT.Heap_Sort_G (Move, Lt); - - -- Start of processing for Sort - - begin - Ref_Sort.Sort (Arr'Last); - end Sort; - - ----------------------- - -- Grep_Source_Files -- - ----------------------- - - procedure Grep_Source_Files is - Length : Natural := 0; - Decl : Declaration_Reference := Entities_HTable.Get_First; - Arr : Reference_Array_Access; - Index : Natural; - End_Index : Natural := 0; - Current_File : File_Reference; - Current_Line : Cst_String_Access; - Buffer : GNAT.OS_Lib.String_Access; - Ref : Reference; - Line : Natural := Natural'Last; - - begin - -- Create a temporary array, where all references will be - -- sorted by files. This way, we only have to read the source - -- files once. - - while Decl /= null loop - - -- Add 1 for the declaration itself - - Length := Length + References_Count (Decl, True, True, True) + 1; - Decl := Entities_HTable.Get_Next; - end loop; - - Arr := new Reference_Array (1 .. Length); - Index := Arr'First; - - Decl := Entities_HTable.Get_First; - while Decl /= null loop - Store_References (Decl, True, True, True, True, Arr.all, Index); - Decl := Entities_HTable.Get_Next; - end loop; - - Sort (Arr.all); - - -- Now traverse the whole array and find the appropriate source - -- lines. - - for R in Arr'Range loop - Ref := Arr (R); - - if Ref.File /= Current_File then - Free (Buffer); - begin - Read_File (Get_File (Ref.File, With_Dir => True), Buffer); - End_Index := Buffer'First - 1; - Line := 0; - exception - when Ada.Text_IO.Name_Error | Ada.Text_IO.End_Error => - Line := Natural'Last; - end; - Current_File := Ref.File; - end if; - - if Ref.Line > Line then - - -- Do not free Current_Line, it is referenced by the last - -- Ref we processed. - - loop - Index := End_Index + 1; - - loop - End_Index := End_Index + 1; - exit when End_Index > Buffer'Last - or else Buffer (End_Index) = ASCII.LF; - end loop; - - -- Skip spaces at beginning of line - - while Index < End_Index and then - (Buffer (Index) = ' ' or else Buffer (Index) = ASCII.HT) - loop - Index := Index + 1; - end loop; - - Line := Line + 1; - exit when Ref.Line = Line; - end loop; - - Current_Line := new String'(Buffer (Index .. End_Index - 1)); - end if; - - Ref.Source_Line := Current_Line; - end loop; - - Free (Buffer); - Free (Arr); - end Grep_Source_Files; - - --------------- - -- Read_File -- - --------------- - - procedure Read_File - (File_Name : String; - Contents : out GNAT.OS_Lib.String_Access) - is - Name_0 : constant String := File_Name & ASCII.NUL; - FD : constant File_Descriptor := Open_Read (Name_0'Address, Binary); - Length : Natural; - - begin - if FD = Invalid_FD then - raise Ada.Text_IO.Name_Error; - end if; - - -- Include room for EOF char - - Length := Natural (File_Length (FD)); - - declare - Buffer : String (1 .. Length + 1); - This_Read : Integer; - Read_Ptr : Natural := 1; - - begin - loop - This_Read := Read (FD, - A => Buffer (Read_Ptr)'Address, - N => Length + 1 - Read_Ptr); - Read_Ptr := Read_Ptr + Integer'Max (This_Read, 0); - exit when This_Read <= 0; - end loop; - - Buffer (Read_Ptr) := EOF; - Contents := new String'(Buffer (1 .. Read_Ptr)); - - if Read_Ptr /= Length + 1 then - raise Ada.Text_IO.End_Error; - end if; - - Close (FD); - end; - end Read_File; - - ----------------------- - -- Longest_File_Name -- - ----------------------- - - function Longest_File_Name return Natural is - begin - return Longest_File_Name_In_Table; - end Longest_File_Name; - - ----------- - -- Match -- - ----------- - - function Match - (File : File_Reference; - Line : Natural; - Column : Natural) - return Boolean - is - Ref : Ref_In_File_Ptr := File.Lines; - - begin - while Ref /= null loop - if (Ref.Line = 0 or else Ref.Line = Line) - and then (Ref.Column = 0 or else Ref.Column = Column) - then - return True; - end if; - - Ref := Ref.Next; - end loop; - - return False; - end Match; - - ----------- - -- Match -- - ----------- - - function Match (Decl : Declaration_Reference) return Boolean is - begin - return Decl.Match; - end Match; - - ---------- - -- Next -- - ---------- - - function Next (E : File_Reference) return File_Reference is - begin - return E.Next; - end Next; - - function Next (E : Declaration_Reference) return Declaration_Reference is - begin - return E.Next; - end Next; - - ------------------ - -- Next_Obj_Dir -- - ------------------ - - function Next_Obj_Dir return String is - First : constant Integer := Directories.Obj_Dir_Index; - Last : Integer; - - begin - Last := Directories.Obj_Dir_Index; - - if Last > Directories.Obj_Dir_Length then - return String'(1 .. 0 => ' '); - end if; - - while Directories.Obj_Dir (Last) /= Path_Separator loop - Last := Last + 1; - end loop; - - Directories.Obj_Dir_Index := Last + 1; - Directories.Last_Obj_Dir_Start := First; - return Directories.Obj_Dir (First .. Last - 1); - end Next_Obj_Dir; - - ------------------------- - -- Next_Unvisited_File -- - ------------------------- - - function Next_Unvisited_File return File_Reference is - procedure Unchecked_Free is new Ada.Unchecked_Deallocation - (Unvisited_Files_Record, Unvisited_Files_Access); - - Ref : File_Reference; - Tmp : Unvisited_Files_Access; - - begin - if Unvisited_Files = null then - return Empty_File; - else - Tmp := Unvisited_Files; - Ref := Unvisited_Files.File; - Unvisited_Files := Unvisited_Files.Next; - Unchecked_Free (Tmp); - return Ref; - end if; - end Next_Unvisited_File; - - ---------------------- - -- Parse_Gnatls_Src -- - ---------------------- - - function Parse_Gnatls_Src return String is - Length : Natural; - - begin - Length := 0; - for J in 1 .. Osint.Nb_Dir_In_Src_Search_Path loop - if Osint.Dir_In_Src_Search_Path (J)'Length = 0 then - Length := Length + 2; - else - Length := Length + Osint.Dir_In_Src_Search_Path (J)'Length + 1; - end if; - end loop; - - declare - Result : String (1 .. Length); - L : Natural; - - begin - L := Result'First; - for J in 1 .. Osint.Nb_Dir_In_Src_Search_Path loop - if Osint.Dir_In_Src_Search_Path (J)'Length = 0 then - Result (L .. L + 1) := "." & Path_Separator; - L := L + 2; - - else - Result (L .. L + Osint.Dir_In_Src_Search_Path (J)'Length - 1) := - Osint.Dir_In_Src_Search_Path (J).all; - L := L + Osint.Dir_In_Src_Search_Path (J)'Length; - Result (L) := Path_Separator; - L := L + 1; - end if; - end loop; - - return Result; - end; - end Parse_Gnatls_Src; - - ---------------------- - -- Parse_Gnatls_Obj -- - ---------------------- - - function Parse_Gnatls_Obj return String is - Length : Natural; - - begin - Length := 0; - for J in 1 .. Osint.Nb_Dir_In_Obj_Search_Path loop - if Osint.Dir_In_Obj_Search_Path (J)'Length = 0 then - Length := Length + 2; - else - Length := Length + Osint.Dir_In_Obj_Search_Path (J)'Length + 1; - end if; - end loop; - - declare - Result : String (1 .. Length); - L : Natural; - - begin - L := Result'First; - for J in 1 .. Osint.Nb_Dir_In_Obj_Search_Path loop - if Osint.Dir_In_Obj_Search_Path (J)'Length = 0 then - Result (L .. L + 1) := "." & Path_Separator; - L := L + 2; - else - Result (L .. L + Osint.Dir_In_Obj_Search_Path (J)'Length - 1) := - Osint.Dir_In_Obj_Search_Path (J).all; - L := L + Osint.Dir_In_Obj_Search_Path (J)'Length; - Result (L) := Path_Separator; - L := L + 1; - end if; - end loop; - - return Result; - end; - end Parse_Gnatls_Obj; - - ------------------- - -- Reset_Obj_Dir -- - ------------------- - - procedure Reset_Obj_Dir is - begin - Directories.Obj_Dir_Index := 1; - end Reset_Obj_Dir; - - ----------------------- - -- Set_Default_Match -- - ----------------------- - - procedure Set_Default_Match (Value : Boolean) is - begin - Default_Match := Value; - end Set_Default_Match; - - ---------- - -- Free -- - ---------- - - procedure Free (Str : in out Cst_String_Access) is - function Convert is new Ada.Unchecked_Conversion - (Cst_String_Access, GNAT.OS_Lib.String_Access); - - S : GNAT.OS_Lib.String_Access := Convert (Str); - - begin - Free (S); - Str := null; - end Free; - - --------------------- - -- Reset_Directory -- - --------------------- - - procedure Reset_Directory (File : File_Reference) is - begin - Free (File.Dir); - end Reset_Directory; - - ------------------- - -- Set_Unvisited -- - ------------------- - - procedure Set_Unvisited (File_Ref : File_Reference) is - F : constant String := Get_File (File_Ref, With_Dir => False); - - begin - File_Ref.Visited := False; - - -- Do not add a source file to the list. This is true for gnatxref - -- gnatfind, so good enough. - - if F'Length > 4 - and then F (F'Last - 3 .. F'Last) = "." & Osint.ALI_Suffix.all - then - Unvisited_Files := new Unvisited_Files_Record' - (File => File_Ref, - Next => Unvisited_Files); - end if; - end Set_Unvisited; - - ---------------------- - -- Get_Declarations -- - ---------------------- - - function Get_Declarations - (Sorted : Boolean := True) - return Declaration_Array_Access - is - Arr : constant Declaration_Array_Access := - new Declaration_Array (1 .. Entities_Count); - Decl : Declaration_Reference := Entities_HTable.Get_First; - Index : Natural := Arr'First; - Tmp : Declaration_Reference; - - procedure Move (From : Natural; To : Natural); - function Lt (Op1, Op2 : Natural) return Boolean; - -- See GNAT.Heap_Sort_G - - -------- - -- Lt -- - -------- - - function Lt (Op1, Op2 : Natural) return Boolean is - begin - if Op1 = 0 then - return Is_Less_Than (Tmp, Arr (Op2)); - elsif Op2 = 0 then - return Is_Less_Than (Arr (Op1), Tmp); - else - return Is_Less_Than (Arr (Op1), Arr (Op2)); - end if; - end Lt; - - ---------- - -- Move -- - ---------- - - procedure Move (From : Natural; To : Natural) is - begin - if To = 0 then - Tmp := Arr (From); - elsif From = 0 then - Arr (To) := Tmp; - else - Arr (To) := Arr (From); - end if; - end Move; - - package Decl_Sort is new GNAT.Heap_Sort_G (Move, Lt); - - -- Start of processing for Get_Declarations - - begin - while Decl /= null loop - Arr (Index) := Decl; - Index := Index + 1; - Decl := Entities_HTable.Get_Next; - end loop; - - if Sorted and then Arr'Length /= 0 then - Decl_Sort.Sort (Entities_Count); - end if; - - return Arr; - end Get_Declarations; - - ---------------------- - -- References_Count -- - ---------------------- - - function References_Count - (Decl : Declaration_Reference; - Get_Reads : Boolean := False; - Get_Writes : Boolean := False; - Get_Bodies : Boolean := False) - return Natural - is - function List_Length (E : Reference) return Natural; - -- Return the number of references in E - - ----------------- - -- List_Length -- - ----------------- - - function List_Length (E : Reference) return Natural is - L : Natural := 0; - E1 : Reference := E; - - begin - while E1 /= null loop - L := L + 1; - E1 := E1.Next; - end loop; - - return L; - end List_Length; - - Length : Natural := 0; - - -- Start of processing for References_Count - - begin - if Get_Reads then - Length := List_Length (Decl.Ref_Ref); - end if; - - if Get_Writes then - Length := Length + List_Length (Decl.Modif_Ref); - end if; - - if Get_Bodies then - Length := Length + List_Length (Decl.Body_Ref); - end if; - - return Length; - end References_Count; - - ---------------------- - -- Store_References -- - ---------------------- - - procedure Store_References - (Decl : Declaration_Reference; - Get_Writes : Boolean := False; - Get_Reads : Boolean := False; - Get_Bodies : Boolean := False; - Get_Declaration : Boolean := False; - Arr : in out Reference_Array; - Index : in out Natural) - is - procedure Add (List : Reference); - -- Add all the references in List to Arr - - --------- - -- Add -- - --------- - - procedure Add (List : Reference) is - E : Reference := List; - begin - while E /= null loop - Arr (Index) := E; - Index := Index + 1; - E := E.Next; - end loop; - end Add; - - -- Start of processing for Store_References - - begin - if Get_Declaration then - Add (Decl.Decl); - end if; - - if Get_Reads then - Add (Decl.Ref_Ref); - end if; - - if Get_Writes then - Add (Decl.Modif_Ref); - end if; - - if Get_Bodies then - Add (Decl.Body_Ref); - end if; - end Store_References; - - -------------------- - -- Get_References -- - -------------------- - - function Get_References - (Decl : Declaration_Reference; - Get_Reads : Boolean := False; - Get_Writes : Boolean := False; - Get_Bodies : Boolean := False) - return Reference_Array_Access - is - Length : constant Natural := - References_Count (Decl, Get_Reads, Get_Writes, Get_Bodies); - - Arr : constant Reference_Array_Access := - new Reference_Array (1 .. Length); - - Index : Natural := Arr'First; - - begin - Store_References - (Decl => Decl, - Get_Writes => Get_Writes, - Get_Reads => Get_Reads, - Get_Bodies => Get_Bodies, - Get_Declaration => False, - Arr => Arr.all, - Index => Index); - - if Arr'Length /= 0 then - Sort (Arr.all); - end if; - - return Arr; - end Get_References; - - ---------- - -- Free -- - ---------- - - procedure Free (Arr : in out Reference_Array_Access) is - procedure Internal is new Ada.Unchecked_Deallocation - (Reference_Array, Reference_Array_Access); - begin - Internal (Arr); - end Free; - - ------------------ - -- Is_Parameter -- - ------------------ - - function Is_Parameter (Decl : Declaration_Reference) return Boolean is - begin - return Decl.Is_Parameter; - end Is_Parameter; - -end Xr_Tabls; diff --git a/gcc/ada/xr_tabls.ads b/gcc/ada/xr_tabls.ads deleted file mode 100644 index e8662b7..0000000 --- a/gcc/ada/xr_tabls.ads +++ /dev/null @@ -1,388 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- X R _ T A B L S -- --- -- --- S p e c -- --- -- --- Copyright (C) 1998-2022, 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. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- Cross reference utilities used by gnatxref and gnatfind - -with GNAT.OS_Lib; - -package Xr_Tabls is - - ------------------- - -- Project files -- - ------------------- - - function ALI_File_Name (Ada_File_Name : String) return String; - -- Returns the ali file name corresponding to Ada_File_Name - - procedure Create_Project_File (Name : String); - -- Open and parse a new project file. If the file Name could not be - -- opened or is not a valid project file, then a project file associated - -- with the standard default directories is returned - - function Next_Obj_Dir return String; - -- Returns the next directory to visit to find related ali files - -- If there are no more such directories, returns a null string. - - function Current_Obj_Dir return String; - -- Returns the obj_dir which was returned by the last Next_Obj_Dir call - - procedure Reset_Obj_Dir; - -- Reset the iterator for Obj_Dir - - ------------ - -- Tables -- - ------------ - - type Declaration_Reference is private; - Empty_Declaration : constant Declaration_Reference; - - type Declaration_Array is array (Natural range <>) of Declaration_Reference; - type Declaration_Array_Access is access Declaration_Array; - - type File_Reference is private; - Empty_File : constant File_Reference; - - type Reference is private; - Empty_Reference : constant Reference; - - type Reference_Array is array (Natural range <>) of Reference; - type Reference_Array_Access is access Reference_Array; - - procedure Free (Arr : in out Reference_Array_Access); - - function Add_Declaration - (File_Ref : File_Reference; - Symbol : String; - Line : Natural; - Column : Natural; - Decl_Type : Character; - Is_Parameter : Boolean := False; - Remove_Only : Boolean := False; - Symbol_Match : Boolean := True) - return Declaration_Reference; - -- Add a new declaration in the table and return the index to it. Decl_Type - -- is the type of the entity Any previous instance of this entity in the - -- htable is removed. If Remove_Only is True, then any previous instance is - -- removed, but the new entity is never inserted. Symbol_Match should be - -- set to False if the name of the symbol doesn't match the pattern from - -- the command line. In that case, the entity will not be output by - -- gnatfind. If Symbol_Match is True, the entity will only be output if - -- the file name itself matches. Is_Parameter should be set to True if - -- the entity is known to be a subprogram parameter. - - procedure Add_Parent - (Declaration : in out Declaration_Reference; - Symbol : String; - Line : Natural; - Column : Natural; - File_Ref : File_Reference); - -- The parent declaration (Symbol in file File_Ref at position Line and - -- Column) information is added to Declaration. - - function Add_To_Xref_File - (File_Name : String; - Visited : Boolean := True; - Emit_Warning : Boolean := False; - Gnatchop_File : String := ""; - Gnatchop_Offset : Integer := 0) - return File_Reference; - -- Add a new reference to a file in the table. Ref is used to return the - -- index in the table where this file is stored. Visited is the value which - -- will be used in the table (if True, the file will not be returned by - -- Next_Unvisited_File). If Emit_Warning is True and the ali file does - -- not exist or does not have cross-referencing information, then a - -- warning will be emitted. Gnatchop_File is the name of the file that - -- File_Name was extracted from through a call to "gnatchop -r" (using - -- pragma Source_Reference). Gnatchop_Offset should be the index of the - -- first line of File_Name within the Gnatchop_File. - - procedure Add_Line - (File : File_Reference; - Line : Natural; - Column : Natural); - -- Add a new reference in a file, which the user has provided on the - -- command line. This is used for an optimized matching algorithm. - - procedure Add_Reference - (Declaration : Declaration_Reference; - File_Ref : File_Reference; - Line : Natural; - Column : Natural; - Ref_Type : Character; - Labels_As_Ref : Boolean); - -- Add a new reference (Ref_Type = 'r'), body (Ref_Type = 'b') or - -- modification (Ref_Type = 'm') to an entity. If Labels_As_Ref is True, - -- then the references to the entity after the end statements ("end Foo") - -- are counted as actual references. This means that the entity will never - -- be reported as unreferenced (for instance in the case of gnatxref -u). - - function Get_Declarations - (Sorted : Boolean := True) - return Declaration_Array_Access; - -- Return a sorted list of all the declarations in the application. - -- Freeing this array is the responsibility of the caller, however it - -- shouldn't free the actual contents of the array, which are pointers - -- to internal data - - function References_Count - (Decl : Declaration_Reference; - Get_Reads : Boolean := False; - Get_Writes : Boolean := False; - Get_Bodies : Boolean := False) - return Natural; - -- Return the number of references in Decl for the categories specified - -- by the Get_* parameters (read-only accesses, write accesses and bodies) - - function Get_References - (Decl : Declaration_Reference; - Get_Reads : Boolean := False; - Get_Writes : Boolean := False; - Get_Bodies : Boolean := False) - return Reference_Array_Access; - -- Return a sorted list of all references to the entity in decl. The - -- parameters Get_* are used to specify what kind of references should be - -- merged and returned (read-only accesses, write accesses and bodies). - - function Get_Column (Decl : Declaration_Reference) return String; - function Get_Column (Ref : Reference) return String; - - function Get_Declaration - (File_Ref : File_Reference; - Line : Natural; - Column : Natural) - return Declaration_Reference; - -- Returns reference to the declaration found in file File_Ref at the - -- given Line and Column - - function Get_Parent - (Decl : Declaration_Reference) - return Declaration_Reference; - -- Returns reference to Decl's parent declaration - - function Get_Emit_Warning (File : File_Reference) return Boolean; - -- Returns the Emit_Warning field of the structure - - function Get_Gnatchop_File - (File : File_Reference; - With_Dir : Boolean := False) - return String; - function Get_Gnatchop_File - (Ref : Reference; - With_Dir : Boolean := False) - return String; - function Get_Gnatchop_File - (Decl : Declaration_Reference; - With_Dir : Boolean := False) - return String; - -- Return the name of the file that File was extracted from through a - -- call to "gnatchop -r". The file name for File is returned if File - -- was not extracted from such a file. The directory will be given only - -- if With_Dir is True. - - function Get_File - (Decl : Declaration_Reference; - With_Dir : Boolean := False) return String; - pragma Inline (Get_File); - -- Extract column number or file name from reference - - function Get_File - (Ref : Reference; - With_Dir : Boolean := False) return String; - pragma Inline (Get_File); - - function Get_File - (File : File_Reference; - With_Dir : Boolean := False; - Strip : Natural := 0) return String; - -- Returns the file name (and its directory if With_Dir is True or the user - -- has used the -f switch on the command line. If Strip is not 0, then the - -- last Strip-th "-..." substrings are removed first. For instance, with - -- Strip=2, a file name "parent-child1-child2-child3.ali" would be returned - -- as "parent-child1.ali". This is used when looking for the ALI file to - -- use for a package, since for separates with have to use the parent's - -- ALI. The null string is returned if there is no such parent unit. - -- - -- Note that this version of Get_File is not inlined - - function Get_File_Ref (Ref : Reference) return File_Reference; - function Get_Line (Decl : Declaration_Reference) return String; - function Get_Line (Ref : Reference) return String; - function Get_Symbol (Decl : Declaration_Reference) return String; - function Get_Type (Decl : Declaration_Reference) return Character; - function Is_Parameter (Decl : Declaration_Reference) return Boolean; - -- Functions that return the contents of a declaration - - function Get_Source_Line (Ref : Reference) return String; - function Get_Source_Line (Decl : Declaration_Reference) return String; - -- Return the source line associated with the reference - - procedure Grep_Source_Files; - -- Parse all the source files which have at least one reference, and grep - -- the appropriate source lines so that we'll be able to display them. This - -- function should be called once all the .ali files have been parsed, and - -- only if the appropriate user switch - -- has been used (gnatfind -s). - -- - -- Note: To save memory, the strings for the source lines are shared. Thus - -- it is no longer possible to free the references, or we would free the - -- same chunk multiple times. It doesn't matter, though, since this is only - -- called once, prior to exiting gnatfind. - - function Longest_File_Name return Natural; - -- Returns the longest file name found - - function Match (Decl : Declaration_Reference) return Boolean; - -- Return True if the declaration matches - - function Match - (File : File_Reference; - Line : Natural; - Column : Natural) - return Boolean; - -- Returns True if File:Line:Column was given on the command line - -- by the user - - function Next_Unvisited_File return File_Reference; - -- Returns the next unvisited library file in the list If there is no more - -- unvisited file, return Empty_File. Two calls to this subprogram will - -- return different files. - - procedure Set_Default_Match (Value : Boolean); - -- Set the default value for match in declarations. - -- This is used so that if no file was provided in the - -- command line, then every file match - - procedure Reset_Directory (File : File_Reference); - -- Reset the cached directory for file. Next time Get_File is called, the - -- directory will be recomputed. - - procedure Set_Unvisited (File_Ref : File_Reference); - -- Set File_Ref as unvisited. So Next_Unvisited_File will return it - - procedure Read_File - (File_Name : String; - Contents : out GNAT.OS_Lib.String_Access); - -- Reads File_Name into the newly allocated string Contents. Types.EOF - -- character will be added to the returned Contents to simplify parsing. - -- Name_Error is raised if the file was not found. End_Error is raised if - -- the file could not be read correctly. For most systems correct reading - -- means that the number of bytes read is equal to the file size. - -private - type Project_File (Src_Dir_Length, Obj_Dir_Length : Natural) is record - Src_Dir_Index : Integer; - Obj_Dir_Index : Integer; - Last_Obj_Dir_Start : Natural; - Src_Dir : String (1 .. Src_Dir_Length); - Obj_Dir : String (1 .. Obj_Dir_Length); - end record; - - type Project_File_Ptr is access all Project_File; - -- This is actually a list of all the directories to be searched, - -- either for source files or for library files - - type Ref_In_File; - type Ref_In_File_Ptr is access all Ref_In_File; - - type Ref_In_File is record - Line : Natural; - Column : Natural; - Next : Ref_In_File_Ptr := null; - end record; - - type File_Record; - type File_Reference is access all File_Record; - - Empty_File : constant File_Reference := null; - type Cst_String_Access is access constant String; - - procedure Free (Str : in out Cst_String_Access); - - type File_Record is record - File : Cst_String_Access; - Dir : GNAT.OS_Lib.String_Access; - Lines : Ref_In_File_Ptr := null; - Visited : Boolean := False; - Emit_Warning : Boolean := False; - Gnatchop_File : GNAT.OS_Lib.String_Access := null; - Gnatchop_Offset : Integer := 0; - Next : File_Reference := null; - end record; - -- Holds a reference to a source file, that was referenced in at least one - -- ALI file. Gnatchop_File will contain the name of the file that File was - -- extracted From. Gnatchop_Offset contains the index of the first line of - -- File within Gnatchop_File. These two fields are used to properly support - -- gnatchop files and pragma Source_Reference. - -- - -- Lines is used for files that were given on the command line, to - -- memorize the lines and columns that the user specified. - - type Reference_Record; - type Reference is access all Reference_Record; - - Empty_Reference : constant Reference := null; - - type Reference_Record is record - File : File_Reference; - Line : Natural; - Column : Natural; - Source_Line : Cst_String_Access; - Next : Reference := null; - end record; - -- File is a reference to the Ada source file - -- Source_Line is the Line as it appears in the source file. This - -- field is only used when the switch is set on the command line of - -- gnatfind. - - type Declaration_Record; - type Declaration_Reference is access all Declaration_Record; - - Empty_Declaration : constant Declaration_Reference := null; - - type Declaration_Record (Symbol_Length : Natural) is record - Key : Cst_String_Access; - Decl : Reference; - Is_Parameter : Boolean := False; -- True if entity is subprog param - Decl_Type : Character; - Body_Ref : Reference := null; - Ref_Ref : Reference := null; - Modif_Ref : Reference := null; - Match : Boolean := False; - Par_Symbol : Declaration_Reference := null; - Next : Declaration_Reference := null; - Symbol : String (1 .. Symbol_Length); - end record; - -- The lists of referenced (Body_Ref, Ref_Ref and Modif_Ref) are - -- kept unsorted until the results needs to be printed. This saves - -- lots of time while the internal tables are created. - - pragma Inline (Get_Column); - pragma Inline (Get_Emit_Warning); - pragma Inline (Get_File_Ref); - pragma Inline (Get_Line); - pragma Inline (Get_Symbol); - pragma Inline (Get_Type); - pragma Inline (Longest_File_Name); -end Xr_Tabls; diff --git a/gcc/ada/xref_lib.adb b/gcc/ada/xref_lib.adb deleted file mode 100644 index 3cb7bcb..0000000 --- a/gcc/ada/xref_lib.adb +++ /dev/null @@ -1,1892 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- X R E F _ L I B -- --- -- --- B o d y -- --- -- --- Copyright (C) 1998-2022, 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. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -pragma Ada_2012; - -with Osint; -with Output; use Output; -with Types; use Types; - -with Ada.Strings.Fixed; use Ada.Strings.Fixed; -with Ada.Text_IO; -with Ada.Unchecked_Deallocation; - -with GNAT.Command_Line; use GNAT.Command_Line; -with GNAT.IO_Aux; use GNAT.IO_Aux; - -package body Xref_Lib is - - Type_Position : constant := 50; - -- Column for label identifying type of entity - - --------------------- - -- Local Variables -- - --------------------- - - Pipe : constant Character := '|'; - -- First character on xref lines in the .ali file - - No_Xref_Information : exception; - -- Exception raised when there is no cross-referencing information in - -- the .ali files. - - procedure Parse_EOL - (Source : not null access String; - Ptr : in out Positive; - Skip_Continuation_Line : Boolean := False); - -- On return Source (Ptr) is the first character of the next line - -- or EOF. Source.all must be terminated by EOF. - -- - -- If Skip_Continuation_Line is True, this subprogram skips as many - -- lines as required when the second or more lines starts with '.' - -- (continuation lines in ALI files). - - function Current_Xref_File (File : ALI_File) return File_Reference; - -- Return the file matching the last 'X' line we found while parsing - -- the ALI file. - - function File_Name (File : ALI_File; Num : Positive) return File_Reference; - -- Returns the dependency file name number Num - - function Get_Full_Type (Decl : Declaration_Reference) return String; - -- Returns the full type corresponding to a type letter as found in - -- the .ali files. - - procedure Open - (Name : String; - File : in out ALI_File; - Dependencies : Boolean := False); - -- Open a new ALI file. If Dependencies is True, the insert every library - -- file 'with'ed in the files database (used for gnatxref) - - procedure Parse_Identifier_Info - (Pattern : Search_Pattern; - File : in out ALI_File; - Local_Symbols : Boolean; - Der_Info : Boolean := False; - Type_Tree : Boolean := False; - Wide_Search : Boolean := True; - Labels_As_Ref : Boolean := True); - -- Output the file and the line where the identifier was referenced, - -- If Local_Symbols is False then only the publicly visible symbols - -- will be processed. - -- - -- If Labels_As_Ref is true, then the references to the entities after - -- the end statements ("end Foo") will be counted as actual references. - -- The entity will never be reported as unreferenced by gnatxref -u - - procedure Parse_Token - (Source : not null access String; - Ptr : in out Positive; - Token_Ptr : out Positive); - -- Skips any separators and stores the start of the token in Token_Ptr. - -- Then stores the position of the next separator in Ptr. On return - -- Source (Token_Ptr .. Ptr - 1) is the token. Separators are space - -- and ASCII.HT. Parse_Token will never skip to the next line. - - procedure Parse_Number - (Source : not null access String; - Ptr : in out Positive; - Number : out Natural); - -- Skips any separators and parses Source up to the first character that - -- is not a decimal digit. Returns value of parsed digits or 0 if none. - - procedure Parse_X_Filename (File : in out ALI_File); - -- Reads and processes "X..." lines in the ALI file - -- and updates the File.X_File information. - - procedure Skip_To_First_X_Line - (File : in out ALI_File; - D_Lines : Boolean; - W_Lines : Boolean); - -- Skip the lines in the ALI file until the first cross-reference line - -- (^X...) is found. Search is started from the beginning of the file. - -- If not such line is found, No_Xref_Information is raised. - -- If W_Lines is false, then the lines "^W" are not parsed. - -- If D_Lines is false, then the lines "^D" are not parsed. - - ---------------- - -- Add_Entity -- - ---------------- - - procedure Add_Entity - (Pattern : in out Search_Pattern; - Entity : String; - Glob : Boolean := False) - is - File_Start : Natural; - Line_Start : Natural; - Col_Start : Natural; - Line_Num : Natural := 0; - Col_Num : Natural := 0; - - File_Ref : File_Reference := Empty_File; - pragma Warnings (Off, File_Ref); - - begin - -- Find the end of the first item in Entity (pattern or file?) - -- If there is no ':', we only have a pattern - - File_Start := Index (Entity, ":"); - - -- If the regular expression is invalid, just consider it as a string - - if File_Start = 0 then - begin - Pattern.Entity := Compile (Entity, Glob, False); - Pattern.Initialized := True; - - exception - when Error_In_Regexp => - - -- The basic idea is to insert a \ before every character - - declare - Tmp_Regexp : String (1 .. 2 * Entity'Length); - Index : Positive := 1; - - begin - for J in Entity'Range loop - Tmp_Regexp (Index) := '\'; - Tmp_Regexp (Index + 1) := Entity (J); - Index := Index + 2; - end loop; - - Pattern.Entity := Compile (Tmp_Regexp, True, False); - Pattern.Initialized := True; - end; - end; - - Set_Default_Match (True); - return; - end if; - - -- If there is a dot in the pattern, then it is a file name - - if (Glob and then - Index (Entity (Entity'First .. File_Start - 1), ".") /= 0) - or else - (not Glob - and then Index (Entity (Entity'First .. File_Start - 1), - "\.") /= 0) - then - Pattern.Entity := Compile (".*", False); - Pattern.Initialized := True; - File_Start := Entity'First; - - else - -- If the regular expression is invalid, just consider it as a string - - begin - Pattern.Entity := - Compile (Entity (Entity'First .. File_Start - 1), Glob, False); - Pattern.Initialized := True; - - exception - when Error_In_Regexp => - - -- The basic idea is to insert a \ before every character - - declare - Tmp_Regexp : String (1 .. 2 * (File_Start - Entity'First)); - Index : Positive := 1; - - begin - for J in Entity'First .. File_Start - 1 loop - Tmp_Regexp (Index) := '\'; - Tmp_Regexp (Index + 1) := Entity (J); - Index := Index + 2; - end loop; - - Pattern.Entity := Compile (Tmp_Regexp, True, False); - Pattern.Initialized := True; - end; - end; - - File_Start := File_Start + 1; - end if; - - -- Parse the file name - - Line_Start := Index (Entity (File_Start .. Entity'Last), ":"); - - -- Check if it was a disk:\directory item (for Windows) - - if File_Start = Line_Start - 1 - and then Line_Start < Entity'Last - and then Entity (Line_Start + 1) = '\' - then - Line_Start := Index (Entity (Line_Start + 1 .. Entity'Last), ":"); - end if; - - if Line_Start = 0 then - Line_Start := Entity'Length + 1; - - elsif Line_Start /= Entity'Last then - Col_Start := Index (Entity (Line_Start + 1 .. Entity'Last), ":"); - - if Col_Start = 0 then - Col_Start := Entity'Last + 1; - end if; - - if Col_Start > Line_Start + 1 then - begin - Line_Num := Natural'Value - (Entity (Line_Start + 1 .. Col_Start - 1)); - - exception - when Constraint_Error => - raise Invalid_Argument; - end; - end if; - - if Col_Start < Entity'Last then - begin - Col_Num := Natural'Value (Entity - (Col_Start + 1 .. Entity'Last)); - - exception - when Constraint_Error => raise Invalid_Argument; - end; - end if; - end if; - - declare - File_Name : String := Entity (File_Start .. Line_Start - 1); - - begin - Osint.Canonical_Case_File_Name (File_Name); - File_Ref := Add_To_Xref_File (File_Name, Visited => True); - Pattern.File_Ref := File_Ref; - - Add_Line (Pattern.File_Ref, Line_Num, Col_Num); - - File_Ref := - Add_To_Xref_File - (ALI_File_Name (File_Name), - Visited => False, - Emit_Warning => True); - end; - end Add_Entity; - - ------------------- - -- Add_Xref_File -- - ------------------- - - procedure Add_Xref_File (File : String) is - File_Ref : File_Reference := Empty_File; - pragma Unreferenced (File_Ref); - - Iterator : Expansion_Iterator; - - procedure Add_Xref_File_Internal (File : String); - -- Do the actual addition of the file - - ---------------------------- - -- Add_Xref_File_Internal -- - ---------------------------- - - procedure Add_Xref_File_Internal (File : String) is - begin - -- Case where we have an ALI file, accept it even though this is - -- not official usage, since the intention is obvious - - if Tail (File, 4) = "." & Osint.ALI_Suffix.all then - File_Ref := Add_To_Xref_File - (File, Visited => False, Emit_Warning => True); - - -- Normal non-ali file case - - else - File_Ref := Add_To_Xref_File (File, Visited => True); - - File_Ref := Add_To_Xref_File - (ALI_File_Name (File), - Visited => False, Emit_Warning => True); - end if; - end Add_Xref_File_Internal; - - -- Start of processing for Add_Xref_File - - begin - -- Check if we need to do the expansion - - if Ada.Strings.Fixed.Index (File, "*") /= 0 - or else Ada.Strings.Fixed.Index (File, "?") /= 0 - then - Start_Expansion (Iterator, File); - - loop - declare - S : constant String := Expansion (Iterator); - - begin - exit when S'Length = 0; - Add_Xref_File_Internal (S); - end; - end loop; - - else - Add_Xref_File_Internal (File); - end if; - end Add_Xref_File; - - ----------------------- - -- Current_Xref_File -- - ----------------------- - - function Current_Xref_File (File : ALI_File) return File_Reference is - begin - return File.X_File; - end Current_Xref_File; - - -------------------------- - -- Default_Project_File -- - -------------------------- - - function Default_Project_File (Dir_Name : String) return String is - My_Dir : Dir_Type; - Dir_Ent : File_Name_String; - Last : Natural; - - begin - Open (My_Dir, Dir_Name); - - loop - Read (My_Dir, Dir_Ent, Last); - exit when Last = 0; - - if Tail (Dir_Ent (1 .. Last), 4) = ".adp" then - - -- The first project file found is the good one - - Close (My_Dir); - return Dir_Ent (1 .. Last); - end if; - end loop; - - Close (My_Dir); - return String'(1 .. 0 => ' '); - - exception - when Directory_Error => return String'(1 .. 0 => ' '); - end Default_Project_File; - - --------------- - -- File_Name -- - --------------- - - function File_Name - (File : ALI_File; - Num : Positive) return File_Reference - is - Table : Table_Type renames File.Dep.Table (1 .. Last (File.Dep)); - begin - return Table (Num); - end File_Name; - - -------------------- - -- Find_ALI_Files -- - -------------------- - - procedure Find_ALI_Files is - My_Dir : Rec_DIR; - Dir_Ent : File_Name_String; - Last : Natural; - - File_Ref : File_Reference; - pragma Unreferenced (File_Ref); - - function Open_Next_Dir return Boolean; - -- Tries to open the next object directory, and return False if - -- the directory cannot be opened. - - ------------------- - -- Open_Next_Dir -- - ------------------- - - function Open_Next_Dir return Boolean is - begin - -- Until we are able to open a new directory - - loop - declare - Obj_Dir : constant String := Next_Obj_Dir; - - begin - -- Case of no more Obj_Dir lines - - if Obj_Dir'Length = 0 then - return False; - end if; - - Open (My_Dir.Dir, Obj_Dir); - exit; - - exception - - -- Could not open the directory - - when Directory_Error => null; - end; - end loop; - - return True; - end Open_Next_Dir; - - -- Start of processing for Find_ALI_Files - - begin - Reset_Obj_Dir; - - if Open_Next_Dir then - loop - Read (My_Dir.Dir, Dir_Ent, Last); - - if Last = 0 then - Close (My_Dir.Dir); - - if not Open_Next_Dir then - return; - end if; - - elsif Last > 4 - and then Dir_Ent (Last - 3 .. Last) = "." & Osint.ALI_Suffix.all - then - File_Ref := - Add_To_Xref_File (Dir_Ent (1 .. Last), Visited => False); - end if; - end loop; - end if; - end Find_ALI_Files; - - ------------------- - -- Get_Full_Type -- - ------------------- - - function Get_Full_Type (Decl : Declaration_Reference) return String is - - function Param_String return String; - -- Return the string to display depending on whether Decl is a parameter - - ------------------ - -- Param_String -- - ------------------ - - function Param_String return String is - begin - if Is_Parameter (Decl) then - return "parameter "; - else - return ""; - end if; - end Param_String; - - -- Start of processing for Get_Full_Type - - begin - case Get_Type (Decl) is - when 'A' => return "array type"; - when 'B' => return "boolean type"; - when 'C' => return "class-wide type"; - when 'D' => return "decimal type"; - when 'E' => return "enumeration type"; - when 'F' => return "float type"; - when 'H' => return "abstract type"; - when 'I' => return "integer type"; - when 'M' => return "modular type"; - when 'O' => return "fixed type"; - when 'P' => return "access type"; - when 'R' => return "record type"; - when 'S' => return "string type"; - when 'T' => return "task type"; - when 'W' => return "protected type"; - - when 'a' => return Param_String & "array object"; - when 'b' => return Param_String & "boolean object"; - when 'c' => return Param_String & "class-wide object"; - when 'd' => return Param_String & "decimal object"; - when 'e' => return Param_String & "enumeration object"; - when 'f' => return Param_String & "float object"; - when 'i' => return Param_String & "integer object"; - when 'j' => return Param_String & "class object"; - when 'm' => return Param_String & "modular object"; - when 'o' => return Param_String & "fixed object"; - when 'p' => return Param_String & "access object"; - when 'r' => return Param_String & "record object"; - when 's' => return Param_String & "string object"; - when 't' => return Param_String & "task object"; - when 'w' => return Param_String & "protected object"; - when 'x' => return Param_String & "abstract procedure"; - when 'y' => return Param_String & "abstract function"; - - when 'h' => return "interface"; - when 'g' => return "macro"; - when 'G' => return "function macro"; - when 'J' => return "class"; - when 'K' => return "package"; - when 'k' => return "generic package"; - when 'L' => return "statement label"; - when 'l' => return "loop label"; - when 'N' => return "named number"; - when 'n' => return "enumeration literal"; - when 'q' => return "block label"; - when 'Q' => return "include file"; - when 'U' => return "procedure"; - when 'u' => return "generic procedure"; - when 'V' => return "function"; - when 'v' => return "generic function"; - when 'X' => return "exception"; - when 'Y' => return "entry"; - - when '+' => return "private type"; - when '*' => return "private variable"; - - -- The above should be the only possibilities, but for this kind - -- of informational output, we don't want to bomb if we find - -- something else, so just return three question marks when we - -- have an unknown Abbrev value - - when others => - if Is_Parameter (Decl) then - return "parameter"; - else - return "??? (" & Get_Type (Decl) & ")"; - end if; - end case; - end Get_Full_Type; - - -------------------------- - -- Skip_To_First_X_Line -- - -------------------------- - - procedure Skip_To_First_X_Line - (File : in out ALI_File; - D_Lines : Boolean; - W_Lines : Boolean) - is - Ali : String_Access renames File.Buffer; - Token : Positive; - Ptr : Positive := Ali'First; - Num_Dependencies : Natural := 0; - File_Start : Positive; - File_End : Positive; - Gnatchop_Offset : Integer; - Gnatchop_Name : Positive; - - File_Ref : File_Reference; - pragma Unreferenced (File_Ref); - - begin - -- Read all the lines possibly processing with-clauses and dependency - -- information and exit on finding the first Xref line. - -- A fall-through of the loop means that there is no xref information - -- which is an error condition. - - while Ali (Ptr) /= EOF loop - if D_Lines and then Ali (Ptr) = 'D' then - - -- Found dependency information. Format looks like: - -- D src-nam time-stmp checksum [subunit-name] [line:file-name] - - -- Skip the D and parse the filenam - - Ptr := Ptr + 1; - Parse_Token (Ali, Ptr, Token); - File_Start := Token; - File_End := Ptr - 1; - - Num_Dependencies := Num_Dependencies + 1; - Set_Last (File.Dep, Num_Dependencies); - - Parse_Token (Ali, Ptr, Token); -- Skip time-stamp - Parse_Token (Ali, Ptr, Token); -- Skip checksum - Parse_Token (Ali, Ptr, Token); -- Read next entity on the line - - if not (Ali (Token) in '0' .. '9') then - Parse_Token (Ali, Ptr, Token); -- Was a subunit name - end if; - - -- Did we have a gnatchop-ed file with a pragma Source_Reference ? - - Gnatchop_Offset := 0; - - if Ali (Token) in '0' .. '9' then - Gnatchop_Name := Token; - while Ali (Gnatchop_Name) /= ':' loop - Gnatchop_Name := Gnatchop_Name + 1; - end loop; - - Gnatchop_Offset := - 2 - Natural'Value (Ali (Token .. Gnatchop_Name - 1)); - Token := Gnatchop_Name + 1; - end if; - - declare - Table : Table_Type renames - File.Dep.Table (1 .. Last (File.Dep)); - begin - Table (Num_Dependencies) := Add_To_Xref_File - (Ali (File_Start .. File_End), - Gnatchop_File => Ali (Token .. Ptr - 1), - Gnatchop_Offset => Gnatchop_Offset); - end; - - elsif W_Lines and then Ali (Ptr) = 'W' then - - -- Found with-clause information. Format looks like: - -- "W debug%s debug.adb debug.ali" - - -- Skip the W and parse the .ali filename (3rd token) - - Parse_Token (Ali, Ptr, Token); - Parse_Token (Ali, Ptr, Token); - Parse_Token (Ali, Ptr, Token); - - File_Ref := - Add_To_Xref_File (Ali (Token .. Ptr - 1), Visited => False); - - elsif Ali (Ptr) = 'X' then - - -- Found a cross-referencing line - stop processing - - File.Current_Line := Ptr; - File.Xref_Line := Ptr; - return; - end if; - - Parse_EOL (Ali, Ptr); - end loop; - - raise No_Xref_Information; - end Skip_To_First_X_Line; - - ---------- - -- Open -- - ---------- - - procedure Open - (Name : String; - File : in out ALI_File; - Dependencies : Boolean := False) - is - Ali : String_Access renames File.Buffer; - pragma Warnings (Off, Ali); - - begin - if File.Buffer /= null then - Free (File.Buffer); - end if; - - Init (File.Dep); - - begin - Read_File (Name, Ali); - - exception - when Ada.Text_IO.Name_Error | Ada.Text_IO.End_Error => - raise No_Xref_Information; - end; - - Skip_To_First_X_Line (File, D_Lines => True, W_Lines => Dependencies); - end Open; - - --------------- - -- Parse_EOL -- - --------------- - - procedure Parse_EOL - (Source : not null access String; - Ptr : in out Positive; - Skip_Continuation_Line : Boolean := False) - is - begin - loop - pragma Assert (Source (Ptr) /= EOF); - - -- Skip to end of line - - while Source (Ptr) /= ASCII.CR and then Source (Ptr) /= ASCII.LF - and then Source (Ptr) /= EOF - loop - Ptr := Ptr + 1; - end loop; - - -- Skip CR or LF if not at end of file - - if Source (Ptr) /= EOF then - Ptr := Ptr + 1; - end if; - - -- Skip past CR/LF - - if Source (Ptr - 1) = ASCII.CR and then Source (Ptr) = ASCII.LF then - Ptr := Ptr + 1; - end if; - - exit when not Skip_Continuation_Line or else Source (Ptr) /= '.'; - end loop; - end Parse_EOL; - - --------------------------- - -- Parse_Identifier_Info -- - --------------------------- - - procedure Parse_Identifier_Info - (Pattern : Search_Pattern; - File : in out ALI_File; - Local_Symbols : Boolean; - Der_Info : Boolean := False; - Type_Tree : Boolean := False; - Wide_Search : Boolean := True; - Labels_As_Ref : Boolean := True) - is - Ptr : Positive renames File.Current_Line; - Ali : String_Access renames File.Buffer; - - E_Line : Natural; -- Line number of current entity - E_Col : Natural; -- Column number of current entity - E_Name : Positive; -- Pointer to begin of entity name - E_Global : Boolean; -- True iff entity is global - E_Type : Character; -- Type of current entity - - R_Line : Natural; -- Line number of current reference - R_Col : Natural; -- Column number of current reference - - R_Type : Character := ASCII.NUL; -- Type of current reference - - Decl_Ref : Declaration_Reference; - File_Ref : File_Reference := Current_Xref_File (File); - - function Get_Symbol_Name (Eun, Line, Col : Natural) return String; - -- Returns the symbol name for the entity defined at the specified - -- line and column in the dependent unit number Eun. For this we need - -- to parse the ali file again because the parent entity is not in - -- the declaration table if it did not match the search pattern. - -- If the symbol is not found, we return (1 .. 3 => '?'). - - procedure Skip_To_Matching_Closing_Bracket; - -- When Ptr points to an opening square bracket, moves it to the - -- character following the matching closing bracket - - --------------------- - -- Get_Symbol_Name -- - --------------------- - - function Get_Symbol_Name (Eun, Line, Col : Natural) return String is - Ptr : Positive := 1; - E_Eun : Positive; -- Unit number of current entity - E_Line : Natural; -- Line number of current entity - E_Col : Natural; -- Column number of current entity - E_Name : Positive; -- Pointer to begin of entity name - - begin - -- Look for the X lines corresponding to unit Eun - - loop - if Ali (Ptr) = EOF then - return "???"; - end if; - - if Ali (Ptr) = 'X' then - Ptr := Ptr + 1; - Parse_Number (Ali, Ptr, E_Eun); - exit when E_Eun = Eun; - end if; - - Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True); - end loop; - - -- Here we are in the right Ali section, we now look for the entity - -- declared at position (Line, Col). - - loop - Parse_Number (Ali, Ptr, E_Line); - exit when Ali (Ptr) = EOF; - Ptr := Ptr + 1; - Parse_Number (Ali, Ptr, E_Col); - exit when Ali (Ptr) = EOF; - Ptr := Ptr + 1; - - if Line = E_Line and then Col = E_Col then - Parse_Token (Ali, Ptr, E_Name); - return Ali (E_Name .. Ptr - 1); - end if; - - Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True); - exit when Ali (Ptr) = EOF; - end loop; - - return "???"; - end Get_Symbol_Name; - - -------------------------------------- - -- Skip_To_Matching_Closing_Bracket -- - -------------------------------------- - - procedure Skip_To_Matching_Closing_Bracket is - Num_Brackets : Natural; - - begin - Num_Brackets := 1; - while Num_Brackets /= 0 loop - Ptr := Ptr + 1; - if Ali (Ptr) = '[' then - Num_Brackets := Num_Brackets + 1; - elsif Ali (Ptr) = ']' then - Num_Brackets := Num_Brackets - 1; - end if; - end loop; - - Ptr := Ptr + 1; - end Skip_To_Matching_Closing_Bracket; - - Table : Table_Type renames File.Dep.Table (1 .. Last (File.Dep)); - - -- Start of processing for Parse_Identifier_Info - - begin - -- The identifier info looks like: - -- "38U9*Debug 12|36r6 36r19" - - -- Extract the line, column and entity name information - - Parse_Number (Ali, Ptr, E_Line); - - if Ali (Ptr) > ' ' then - E_Type := Ali (Ptr); - Ptr := Ptr + 1; - - -- Ignore some of the entities (labels,...) - - if E_Type in 'l' | 'L' | 'q' then - Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True); - return; - end if; - else - -- Unexpected contents, skip line and return - - Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True); - return; - end if; - - Parse_Number (Ali, Ptr, E_Col); - - E_Global := False; - if Ali (Ptr) >= ' ' then - E_Global := (Ali (Ptr) = '*'); - Ptr := Ptr + 1; - end if; - - Parse_Token (Ali, Ptr, E_Name); - - -- Exit if the symbol does not match or if we have a local symbol and we - -- do not want it or if the file is unknown. - - if File.X_File = Empty_File then - return; - end if; - - if (not Local_Symbols and not E_Global) - or else (Pattern.Initialized - and then not Match (Ali (E_Name .. Ptr - 1), Pattern.Entity)) - or else (E_Name >= Ptr) - then - Decl_Ref := Add_Declaration - (File.X_File, Ali (E_Name .. Ptr - 1), E_Line, E_Col, E_Type, - Remove_Only => True); - Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True); - return; - end if; - - -- Insert the declaration in the table - - Decl_Ref := Add_Declaration - (File.X_File, Ali (E_Name .. Ptr - 1), E_Line, E_Col, E_Type); - - if Ali (Ptr) = '[' then - Skip_To_Matching_Closing_Bracket; - end if; - - -- Skip any renaming indication - - if Ali (Ptr) = '=' then - declare - P_Line, P_Column : Natural; - pragma Warnings (Off, P_Line); - pragma Warnings (Off, P_Column); - begin - Ptr := Ptr + 1; - Parse_Number (Ali, Ptr, P_Line); - Ptr := Ptr + 1; - Parse_Number (Ali, Ptr, P_Column); - end; - end if; - - while Ptr <= Ali'Last - and then (Ali (Ptr) = '<' - or else Ali (Ptr) = '(' - or else Ali (Ptr) = '{') - loop - -- Here we have a type derivation information. The format is - -- <3|12I45> which means that the current entity is derived from the - -- type defined in unit number 3, line 12 column 45. The pipe and - -- unit number is optional. It is specified only if the parent type - -- is not defined in the current unit. - - -- We also have the format for generic instantiations, as in - -- 7a5*Uid(3|5I8[4|2]) 2|4r74 - - -- We could also have something like - -- 16I9*I<integer> - -- that indicates that I derives from the predefined type integer. - - Ptr := Ptr + 1; - - if Ali (Ptr) in '0' .. '9' then - Parse_Derived_Info : declare - P_Line : Natural; -- parent entity line - P_Column : Natural; -- parent entity column - P_Eun : Natural := 0; -- parent entity file number - - begin - Parse_Number (Ali, Ptr, P_Line); - - -- If we have a pipe then the first number was the unit number - - if Ali (Ptr) = '|' then - P_Eun := P_Line; - Ptr := Ptr + 1; - - -- Now we have the line number - - Parse_Number (Ali, Ptr, P_Line); - - else - -- We don't have a unit number specified, so we set P_Eun to - -- the current unit. - - for K in Table'Range loop - P_Eun := K; - exit when Table (K) = File_Ref; - end loop; - end if; - - -- Then parse the type and column number - - Ptr := Ptr + 1; - Parse_Number (Ali, Ptr, P_Column); - - -- Skip the information for generics instantiations - - if Ali (Ptr) = '[' then - Skip_To_Matching_Closing_Bracket; - end if; - - -- Skip '>', or ')' or '>' - - Ptr := Ptr + 1; - - -- The derived info is needed only is the derived info mode is - -- on or if we want to output the type hierarchy - - if Der_Info or else Type_Tree then - pragma Assert (P_Eun /= 0); - - declare - Symbol : constant String := - Get_Symbol_Name (P_Eun, P_Line, P_Column); - begin - if Symbol /= "???" then - Add_Parent - (Decl_Ref, - Symbol, - P_Line, - P_Column, - Table (P_Eun)); - end if; - end; - end if; - - if Type_Tree - and then (Pattern.File_Ref = Empty_File - or else - Pattern.File_Ref = Current_Xref_File (File)) - then - Search_Parent_Tree : declare - Pattern : Search_Pattern; -- Parent type pattern - File_Pos_Backup : Positive; - - begin - Add_Entity - (Pattern, - Get_Symbol_Name (P_Eun, P_Line, P_Column) - & ':' & Get_Gnatchop_File (Table (P_Eun)) - & ':' & Get_Line (Get_Parent (Decl_Ref)) - & ':' & Get_Column (Get_Parent (Decl_Ref)), - False); - - -- No default match is needed to look for the parent type - -- since we are using the fully qualified symbol name: - -- symbol:file:line:column - - Set_Default_Match (False); - - -- The parent hierarchy is defined in the same unit as - -- the derived type. So we want to revisit the unit. - - File_Pos_Backup := File.Current_Line; - - Skip_To_First_X_Line - (File, D_Lines => False, W_Lines => False); - - while File.Buffer (File.Current_Line) /= EOF loop - Parse_X_Filename (File); - Parse_Identifier_Info - (Pattern => Pattern, - File => File, - Local_Symbols => False, - Der_Info => Der_Info, - Type_Tree => True, - Wide_Search => False, - Labels_As_Ref => Labels_As_Ref); - end loop; - - File.Current_Line := File_Pos_Backup; - end Search_Parent_Tree; - end if; - end Parse_Derived_Info; - - else - while Ali (Ptr) /= '>' - and then Ali (Ptr) /= ')' - and then Ali (Ptr) /= '}' - loop - Ptr := Ptr + 1; - end loop; - Ptr := Ptr + 1; - end if; - end loop; - - -- To find the body, we will have to parse the file too - - if Wide_Search then - declare - File_Name : constant String := Get_Gnatchop_File (File.X_File); - Ignored : File_Reference; - begin - Ignored := Add_To_Xref_File (ALI_File_Name (File_Name), False); - end; - end if; - - -- Parse references to this entity. - -- Ptr points to next reference with leading blanks - - loop - -- Process references on current line - - while Ali (Ptr) = ' ' or else Ali (Ptr) = ASCII.HT loop - - -- For every reference read the line, type and column, - -- optionally preceded by a file number and a pipe symbol. - - Parse_Number (Ali, Ptr, R_Line); - - if Ali (Ptr) = Pipe then - Ptr := Ptr + 1; - File_Ref := File_Name (File, R_Line); - - Parse_Number (Ali, Ptr, R_Line); - end if; - - if Ali (Ptr) > ' ' then - R_Type := Ali (Ptr); - Ptr := Ptr + 1; - end if; - - -- Imported entities may have an indication specifying information - -- about the corresponding external name: - -- 5U14*Foo2 5>20 6b<c,myfoo2>22 # Imported entity - -- 5U14*Foo2 5>20 6i<c,myfoo2>22 # Exported entity - - if Ali (Ptr) = '<' - and then (R_Type = 'b' or else R_Type = 'i') - then - while Ptr <= Ali'Last - and then Ali (Ptr) /= '>' - loop - Ptr := Ptr + 1; - end loop; - Ptr := Ptr + 1; - end if; - - Parse_Number (Ali, Ptr, R_Col); - - pragma Assert (R_Type /= ASCII.NUL); - - -- Insert the reference or body in the table - - Add_Reference - (Decl_Ref, File_Ref, R_Line, R_Col, R_Type, Labels_As_Ref); - - -- Skip generic information, if any - - if Ali (Ptr) = '[' then - declare - Num_Nested : Integer := 1; - - begin - Ptr := Ptr + 1; - while Num_Nested /= 0 loop - if Ali (Ptr) = ']' then - Num_Nested := Num_Nested - 1; - elsif Ali (Ptr) = '[' then - Num_Nested := Num_Nested + 1; - end if; - - Ptr := Ptr + 1; - end loop; - end; - end if; - - end loop; - - Parse_EOL (Ali, Ptr); - - -- Loop until new line is no continuation line - - exit when Ali (Ptr) /= '.'; - Ptr := Ptr + 1; - end loop; - end Parse_Identifier_Info; - - ------------------ - -- Parse_Number -- - ------------------ - - procedure Parse_Number - (Source : not null access String; - Ptr : in out Positive; - Number : out Natural) - is - begin - -- Skip separators - - while Source (Ptr) = ' ' or else Source (Ptr) = ASCII.HT loop - Ptr := Ptr + 1; - end loop; - - Number := 0; - while Source (Ptr) in '0' .. '9' loop - Number := - 10 * Number + (Character'Pos (Source (Ptr)) - Character'Pos ('0')); - Ptr := Ptr + 1; - end loop; - end Parse_Number; - - ----------------- - -- Parse_Token -- - ----------------- - - procedure Parse_Token - (Source : not null access String; - Ptr : in out Positive; - Token_Ptr : out Positive) - is - In_Quotes : Character := ASCII.NUL; - - begin - -- Skip separators - - while Source (Ptr) = ' ' or else Source (Ptr) = ASCII.HT loop - Ptr := Ptr + 1; - end loop; - - Token_Ptr := Ptr; - - -- Find end-of-token - - while (In_Quotes /= ASCII.NUL or else - not (Source (Ptr) = ' ' - or else Source (Ptr) = ASCII.HT - or else Source (Ptr) = '<' - or else Source (Ptr) = '{' - or else Source (Ptr) = '[' - or else Source (Ptr) = '=' - or else Source (Ptr) = '(')) - and then Source (Ptr) >= ' ' - loop - -- Double-quotes are used for operators - -- Simple-quotes are used for character constants, for instance when - -- they are found in an enumeration type "type A is ('+', '-');" - - case Source (Ptr) is - when '"' | ''' => - if In_Quotes = Source (Ptr) then - In_Quotes := ASCII.NUL; - elsif In_Quotes = ASCII.NUL then - In_Quotes := Source (Ptr); - end if; - - when others => - null; - end case; - - Ptr := Ptr + 1; - end loop; - end Parse_Token; - - ---------------------- - -- Parse_X_Filename -- - ---------------------- - - procedure Parse_X_Filename (File : in out ALI_File) is - Ali : String_Access renames File.Buffer; - Ptr : Positive renames File.Current_Line; - File_Nr : Natural; - - Table : Table_Type renames File.Dep.Table (1 .. Last (File.Dep)); - - begin - while Ali (Ptr) = 'X' loop - - -- The current line is the start of a new Xref file section, - -- whose format looks like: - - -- " X 1 debug.ads" - - -- Skip the X and read the file number for the new X_File - - Ptr := Ptr + 1; - Parse_Number (Ali, Ptr, File_Nr); - - -- If the referenced file is unknown, we simply ignore it - - if File_Nr in Table'Range then - File.X_File := Table (File_Nr); - else - File.X_File := Empty_File; - end if; - - Parse_EOL (Ali, Ptr); - end loop; - end Parse_X_Filename; - - -------------------- - -- Print_Gnatfind -- - -------------------- - - procedure Print_Gnatfind - (References : Boolean; - Full_Path_Name : Boolean) - is - Decls : constant Declaration_Array_Access := Get_Declarations; - Decl : Declaration_Reference; - Arr : Reference_Array_Access; - - procedure Print_Ref - (Ref : Reference; - Msg : String := " "); - -- Print a reference, according to the extended tag of the output - - --------------- - -- Print_Ref -- - --------------- - - procedure Print_Ref - (Ref : Reference; - Msg : String := " ") - is - F : String_Access := - Osint.To_Host_File_Spec - (Get_Gnatchop_File (Ref, Full_Path_Name)); - - Buffer : constant String := - F.all & - ":" & Get_Line (Ref) & - ":" & Get_Column (Ref) & - ": "; - - Num_Blanks : Integer := Longest_File_Name + 10 - Buffer'Length; - - begin - Free (F); - Num_Blanks := Integer'Max (0, Num_Blanks); - Write_Line - (Buffer - & String'(1 .. Num_Blanks => ' ') - & Msg & " " & Get_Symbol (Decl)); - - if Get_Source_Line (Ref)'Length /= 0 then - Write_Line (" " & Get_Source_Line (Ref)); - end if; - end Print_Ref; - - -- Start of processing for Print_Gnatfind - - begin - for D in Decls'Range loop - Decl := Decls (D); - - if Match (Decl) then - - -- Output the declaration - - declare - Parent : constant Declaration_Reference := Get_Parent (Decl); - - F : String_Access := - Osint.To_Host_File_Spec - (Get_Gnatchop_File (Decl, Full_Path_Name)); - - Buffer : constant String := - F.all & - ":" & Get_Line (Decl) & - ":" & Get_Column (Decl) & - ": "; - - Num_Blanks : Integer := Longest_File_Name + 10 - Buffer'Length; - - begin - Free (F); - Num_Blanks := Integer'Max (0, Num_Blanks); - Write_Line - (Buffer & String'(1 .. Num_Blanks => ' ') - & "(spec) " & Get_Symbol (Decl)); - - if Parent /= Empty_Declaration then - F := Osint.To_Host_File_Spec (Get_Gnatchop_File (Parent)); - Write_Line - (Buffer & String'(1 .. Num_Blanks => ' ') - & " derived from " & Get_Symbol (Parent) - & " (" - & F.all - & ':' & Get_Line (Parent) - & ':' & Get_Column (Parent) & ')'); - Free (F); - end if; - end; - - if Get_Source_Line (Decl)'Length /= 0 then - Write_Line (" " & Get_Source_Line (Decl)); - end if; - - -- Output the body (sorted) - - Arr := Get_References (Decl, Get_Bodies => True); - - for R in Arr'Range loop - Print_Ref (Arr (R), "(body)"); - end loop; - - Free (Arr); - - if References then - Arr := Get_References - (Decl, Get_Writes => True, Get_Reads => True); - - for R in Arr'Range loop - Print_Ref (Arr (R)); - end loop; - - Free (Arr); - end if; - end if; - end loop; - end Print_Gnatfind; - - ------------------ - -- Print_Unused -- - ------------------ - - procedure Print_Unused (Full_Path_Name : Boolean) is - Decls : constant Declaration_Array_Access := Get_Declarations; - Decl : Declaration_Reference; - Arr : Reference_Array_Access; - F : String_Access; - - begin - for D in Decls'Range loop - Decl := Decls (D); - - if References_Count - (Decl, Get_Reads => True, Get_Writes => True) = 0 - then - F := Osint.To_Host_File_Spec - (Get_Gnatchop_File (Decl, Full_Path_Name)); - Write_Str (Get_Symbol (Decl) - & " (" - & Get_Full_Type (Decl) - & ") " - & F.all - & ':' - & Get_Line (Decl) - & ':' - & Get_Column (Decl)); - Free (F); - - -- Print the body if any - - Arr := Get_References (Decl, Get_Bodies => True); - - for R in Arr'Range loop - F := Osint.To_Host_File_Spec - (Get_Gnatchop_File (Arr (R), Full_Path_Name)); - Write_Str (' ' - & F.all - & ':' & Get_Line (Arr (R)) - & ':' & Get_Column (Arr (R))); - Free (F); - end loop; - - Write_Eol; - Free (Arr); - end if; - end loop; - end Print_Unused; - - -------------- - -- Print_Vi -- - -------------- - - procedure Print_Vi (Full_Path_Name : Boolean) is - Tab : constant Character := ASCII.HT; - Decls : constant Declaration_Array_Access := - Get_Declarations (Sorted => False); - Decl : Declaration_Reference; - Arr : Reference_Array_Access; - F : String_Access; - - begin - for D in Decls'Range loop - Decl := Decls (D); - - F := Osint.To_Host_File_Spec (Get_File (Decl, Full_Path_Name)); - Write_Line (Get_Symbol (Decl) & Tab & F.all & Tab & Get_Line (Decl)); - Free (F); - - -- Print the body if any - - Arr := Get_References (Decl, Get_Bodies => True); - - for R in Arr'Range loop - F := Osint.To_Host_File_Spec (Get_File (Arr (R), Full_Path_Name)); - Write_Line - (Get_Symbol (Decl) & Tab & F.all & Tab & Get_Line (Arr (R))); - Free (F); - end loop; - - Free (Arr); - - -- Print the modifications - - Arr := Get_References (Decl, Get_Writes => True, Get_Reads => True); - - for R in Arr'Range loop - F := Osint.To_Host_File_Spec (Get_File (Arr (R), Full_Path_Name)); - Write_Line - (Get_Symbol (Decl) & Tab & F.all & Tab & Get_Line (Arr (R))); - Free (F); - end loop; - - Free (Arr); - end loop; - end Print_Vi; - - ---------------- - -- Print_Xref -- - ---------------- - - procedure Print_Xref (Full_Path_Name : Boolean) is - Decls : constant Declaration_Array_Access := Get_Declarations; - Decl : Declaration_Reference; - - Margin : constant := 10; - -- Column where file names start - - procedure New_Line80; - -- Go to start of new line - - procedure Print80 (S : String); - -- Print the text, respecting the 80 columns rule - - procedure Print_Ref (Line, Column : String); - -- The beginning of the output is aligned on a column multiple of 9 - - procedure Print_List - (Decl : Declaration_Reference; - Msg : String; - Get_Reads : Boolean := False; - Get_Writes : Boolean := False; - Get_Bodies : Boolean := False); - -- Print a list of references. If the list is not empty, Msg will - -- be printed prior to the list. - - ---------------- - -- New_Line80 -- - ---------------- - - procedure New_Line80 is - begin - Write_Eol; - Write_Str (String'(1 .. Margin - 1 => ' ')); - end New_Line80; - - ------------- - -- Print80 -- - ------------- - - procedure Print80 (S : String) is - Align : Natural := Margin - (Integer (Column) mod Margin); - - begin - if Align = Margin then - Align := 0; - end if; - - Write_Str (String'(1 .. Align => ' ') & S); - end Print80; - - --------------- - -- Print_Ref -- - --------------- - - procedure Print_Ref (Line, Column : String) is - Line_Align : constant Integer := 4 - Line'Length; - - S : constant String := String'(1 .. Line_Align => ' ') - & Line & ':' & Column; - - Align : Natural := Margin - (Integer (Output.Column) mod Margin); - - begin - if Align = Margin then - Align := 0; - end if; - - if Integer (Output.Column) + Align + S'Length > 79 then - New_Line80; - Align := 0; - end if; - - Write_Str (String'(1 .. Align => ' ') & S); - end Print_Ref; - - ---------------- - -- Print_List -- - ---------------- - - procedure Print_List - (Decl : Declaration_Reference; - Msg : String; - Get_Reads : Boolean := False; - Get_Writes : Boolean := False; - Get_Bodies : Boolean := False) - is - Arr : Reference_Array_Access := - Get_References - (Decl, - Get_Writes => Get_Writes, - Get_Reads => Get_Reads, - Get_Bodies => Get_Bodies); - File : File_Reference := Empty_File; - F : String_Access; - - begin - if Arr'Length /= 0 then - Write_Eol; - Write_Str (Msg); - end if; - - for R in Arr'Range loop - if Get_File_Ref (Arr (R)) /= File then - if File /= Empty_File then - New_Line80; - end if; - - File := Get_File_Ref (Arr (R)); - F := Osint.To_Host_File_Spec - (Get_Gnatchop_File (Arr (R), Full_Path_Name)); - - if F = null then - Write_Str ("<unknown> "); - else - Write_Str (F.all & ' '); - Free (F); - end if; - end if; - - Print_Ref (Get_Line (Arr (R)), Get_Column (Arr (R))); - end loop; - - Free (Arr); - end Print_List; - - F : String_Access; - - -- Start of processing for Print_Xref - - begin - for D in Decls'Range loop - Decl := Decls (D); - - Write_Str (Get_Symbol (Decl)); - - -- Put the declaration type in column Type_Position, but if the - -- declaration name is too long, put at least one space between its - -- name and its type. - - while Column < Type_Position - 1 loop - Write_Char (' '); - end loop; - - Write_Char (' '); - - Write_Line (Get_Full_Type (Decl)); - - Write_Parent_Info : declare - Parent : constant Declaration_Reference := Get_Parent (Decl); - - begin - if Parent /= Empty_Declaration then - Write_Str (" Ptype: "); - F := Osint.To_Host_File_Spec (Get_Gnatchop_File (Parent)); - Print80 (F.all); - Free (F); - Print_Ref (Get_Line (Parent), Get_Column (Parent)); - Print80 (" " & Get_Symbol (Parent)); - Write_Eol; - end if; - end Write_Parent_Info; - - Write_Str (" Decl: "); - F := Osint.To_Host_File_Spec - (Get_Gnatchop_File (Decl, Full_Path_Name)); - - if F = null then - Print80 ("<unknown> "); - else - Print80 (F.all & ' '); - Free (F); - end if; - - Print_Ref (Get_Line (Decl), Get_Column (Decl)); - - Print_List - (Decl, " Body: ", Get_Bodies => True); - Print_List - (Decl, " Modi: ", Get_Writes => True); - Print_List - (Decl, " Ref: ", Get_Reads => True); - Write_Eol; - end loop; - end Print_Xref; - - ------------ - -- Search -- - ------------ - - procedure Search - (Pattern : Search_Pattern; - Local_Symbols : Boolean; - Wide_Search : Boolean; - Read_Only : Boolean; - Der_Info : Boolean; - Type_Tree : Boolean) - is - type String_Access is access String; - procedure Free is new Ada.Unchecked_Deallocation (String, String_Access); - - ALIfile : ALI_File; - File_Ref : File_Reference; - Strip_Num : Natural := 0; - Ali_Name : String_Access; - - begin - -- If we want all the .ali files, then find them - - if Wide_Search then - Find_ALI_Files; - end if; - - loop - -- Get the next unread ali file - - File_Ref := Next_Unvisited_File; - - exit when File_Ref = Empty_File; - - -- Find the ALI file to use. Most of the time, it will be the unit - -- name, with a different extension. However, when dealing with - -- separates the ALI file is in fact the parent's ALI file (and this - -- is recursive, in case the parent itself is a separate). - - Strip_Num := 0; - loop - Free (Ali_Name); - Ali_Name := new String' - (Get_File (File_Ref, With_Dir => True, Strip => Strip_Num)); - - -- Stripped too many things... - - if Ali_Name.all = "" then - if Get_Emit_Warning (File_Ref) then - Set_Standard_Error; - Write_Line - ("warning : file " & Get_File (File_Ref, With_Dir => True) - & " not found"); - Set_Standard_Output; - end if; - Free (Ali_Name); - exit; - - -- If not found, try the parent's ALI file (this is needed for - -- separate units and subprograms). - - -- Reset the cached directory first, in case the separate's - -- ALI file is not in the same directory. - - elsif not File_Exists (Ali_Name.all) then - Strip_Num := Strip_Num + 1; - Reset_Directory (File_Ref); - - -- Else we finally found it - - else - exit; - end if; - end loop; - - -- If we had to get the parent's ALI, insert it in the list as usual. - -- This is to avoid parsing it twice in case it has already been - -- parsed. - - if Ali_Name /= null and then Strip_Num /= 0 then - File_Ref := Add_To_Xref_File - (File_Name => Ali_Name.all, - Visited => False); - - -- Now that we have a file name, parse it to find any reference to - -- the entity. - - elsif Ali_Name /= null - and then (Read_Only or else Is_Writable_File (Ali_Name.all)) - then - begin - Open (Ali_Name.all, ALIfile); - - -- The cross-reference section in the ALI file may be followed - -- by other sections, which can be identified by the starting - -- character of every line, which should neither be 'X' nor a - -- figure in '1' .. '9'. - - -- The loop tests below also take into account the end-of-file - -- possibility. - - while ALIfile.Buffer (ALIfile.Current_Line) = 'X' loop - Parse_X_Filename (ALIfile); - - while ALIfile.Buffer (ALIfile.Current_Line) in '1' .. '9' - loop - Parse_Identifier_Info - (Pattern, ALIfile, Local_Symbols, Der_Info, Type_Tree, - Wide_Search, Labels_As_Ref => True); - end loop; - end loop; - - exception - when No_Xref_Information => - if Get_Emit_Warning (File_Ref) then - Set_Standard_Error; - Write_Line - ("warning : No cross-referencing information in " - & Ali_Name.all); - Set_Standard_Output; - end if; - end; - end if; - end loop; - - Free (Ali_Name); - end Search; - - ----------------- - -- Search_Xref -- - ----------------- - - procedure Search_Xref - (Local_Symbols : Boolean; - Read_Only : Boolean; - Der_Info : Boolean) - is - ALIfile : ALI_File; - File_Ref : File_Reference; - Null_Pattern : Search_Pattern; - - begin - Null_Pattern.Initialized := False; - - loop - -- Find the next unvisited file - - File_Ref := Next_Unvisited_File; - exit when File_Ref = Empty_File; - - -- Search the object directories for the .ali file - - declare - F : constant String := Get_File (File_Ref, With_Dir => True); - - begin - if Read_Only or else Is_Writable_File (F) then - Open (F, ALIfile, True); - - -- The cross-reference section in the ALI file may be followed - -- by other sections, which can be identified by the starting - -- character of every line, which should neither be 'X' nor a - -- figure in '1' .. '9'. - - -- The loop tests below also take into account the end-of-file - -- possibility. - - while ALIfile.Buffer (ALIfile.Current_Line) = 'X' loop - Parse_X_Filename (ALIfile); - - while ALIfile.Buffer (ALIfile.Current_Line) in '1' .. '9' - loop - Parse_Identifier_Info - (Null_Pattern, ALIfile, Local_Symbols, Der_Info, - Labels_As_Ref => False); - end loop; - end loop; - end if; - - exception - when No_Xref_Information => null; - end; - end loop; - end Search_Xref; - -end Xref_Lib; diff --git a/gcc/ada/xref_lib.ads b/gcc/ada/xref_lib.ads deleted file mode 100644 index 467e3a5..0000000 --- a/gcc/ada/xref_lib.ads +++ /dev/null @@ -1,179 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- X R E F _ L I B -- --- -- --- S p e c -- --- -- --- Copyright (C) 1998-2022, 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. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- Miscellaneous utilities for the cross-referencing tool - -with Hostparm; -with Xr_Tabls; use Xr_Tabls; - -with GNAT.Directory_Operations; use GNAT.Directory_Operations; -with GNAT.OS_Lib; use GNAT.OS_Lib; -with GNAT.Dynamic_Tables; -with GNAT.Regexp; use GNAT.Regexp; - -package Xref_Lib is - - subtype File_Name_String is String (1 .. Hostparm.Max_Name_Length); - subtype Line_String is String (1 .. Hostparm.Max_Line_Length); - - type ALI_File is limited private; - - --------------------- - -- Directory Input -- - --------------------- - - type Rec_DIR is limited private; - -- This one is used for recursive search of .ali files - - procedure Find_ALI_Files; - -- Find all the ali files that we will have to parse, and have them to - -- the file list - - --------------------- - -- Search patterns -- - --------------------- - - type Search_Pattern is private; - type Search_Pattern_Ptr is access all Search_Pattern; - - procedure Add_Entity - (Pattern : in out Search_Pattern; - Entity : String; - Glob : Boolean := False); - -- Add a new entity to the search pattern (the entity should have the - -- form pattern[:file[:line[:column]]], and it is parsed entirely in - -- this procedure. Glob indicates if we should use the 'globbing - -- patterns' (True) or the full regular expressions (False) - - procedure Add_Xref_File (File : String); - -- Add a new file in the list of files to search for references. File - -- is interpreted as a globbing regular expression, which is expanded. - - Invalid_Argument : exception; - -- Exception raised when there is a syntax error in the command line - - ----------------------- - -- Output Algorithms -- - ----------------------- - - procedure Print_Gnatfind - (References : Boolean; - Full_Path_Name : Boolean); - procedure Print_Unused (Full_Path_Name : Boolean); - procedure Print_Vi (Full_Path_Name : Boolean); - procedure Print_Xref (Full_Path_Name : Boolean); - -- The actual print procedures. These functions step through the symbol - -- table and print all the symbols if they match the files given on the - -- command line (they already match the entities if they are in the - -- symbol table) - - ------------------------ - -- General Algorithms -- - ------------------------ - - function Default_Project_File (Dir_Name : String) return String; - -- Returns the default Project file name for the directory Dir_Name - - procedure Search - (Pattern : Search_Pattern; - Local_Symbols : Boolean; - Wide_Search : Boolean; - Read_Only : Boolean; - Der_Info : Boolean; - Type_Tree : Boolean); - -- Search every ALI file for entities matching Pattern, and add - -- these entities to the internal symbol tables. - -- - -- If Wide_Search is True, all ALI files found in the object path - -- are searched. - -- - -- If Read_Only is True, read-only ALI files will also be parsed, - -- similar to gnatmake -a. - -- - -- If Der_Info is true, then the derived type information will be - -- processed. - -- - -- If Type_Tree is true, then the type hierarchy will be searched - -- going from the pattern to the parent type. - - procedure Search_Xref - (Local_Symbols : Boolean; - Read_Only : Boolean; - Der_Info : Boolean); - -- Search every ali file given in the command line and all their - -- dependencies. If Read_Only is True, we parse the read-only ali - -- files too. If Der_Mode is true then the derived type information will - -- be processed - -private - type Rec_DIR is limited record - Dir : GNAT.Directory_Operations.Dir_Type; - end record; - - package Dependencies_Tables is new GNAT.Dynamic_Tables - (Table_Component_Type => Xr_Tabls.File_Reference, - Table_Index_Type => Natural, - Table_Low_Bound => 1, - Table_Initial => 400, - Table_Increment => 100); - use Dependencies_Tables; - - type Dependencies is new Dependencies_Tables.Instance; - - type ALI_File is limited record - Buffer : String_Access := null; - -- Buffer used to read the whole file at once - - Current_Line : Positive; - -- Start of the current line in Buffer - - Xref_Line : Positive; - -- Start of the xref lines in Buffer - - X_File : Xr_Tabls.File_Reference; - -- Stores the cross-referencing file-name ("X..." lines), as an - -- index into the dependencies table - - Dep : Dependencies; - -- Store file name associated with each number ("D..." lines) - end record; - - -- The following record type stores all the patterns that are searched for - - type Search_Pattern is record - Entity : GNAT.Regexp.Regexp; - -- A regular expression matching the entities we are looking for. - -- File is a list of the places where the declaration of the entities - -- has to be. When the user enters a file:line:column on the command - -- line, it is stored as "Entity_Name Declaration_File:line:column" - - File_Ref : Xr_Tabls.File_Reference; - -- A reference to the source file, if any - - Initialized : Boolean := False; - -- Set to True when Entity has been initialized - end record; - -end Xref_Lib; diff --git a/gcc/analyzer/ChangeLog b/gcc/analyzer/ChangeLog index 5a9551b..e4f67fe 100644 --- a/gcc/analyzer/ChangeLog +++ b/gcc/analyzer/ChangeLog @@ -1,3 +1,83 @@ +2022-05-16 David Malcolm <dmalcolm@redhat.com> + + PR analyzer/105103 + * analyzer.cc (make_label_text_n): New. + * analyzer.h (class var_arg_region): New forward decl. + (make_label_text_n): New decl. + * analyzer.opt (Wanalyzer-va-arg-type-mismatch): New option. + (Wanalyzer-va-list-exhausted): New option. + (Wanalyzer-va-list-leak): New option. + (Wanalyzer-va-list-use-after-va-end): New option. + * checker-path.cc (call_event::get_desc): Split out decl access + into.. + (call_event::get_caller_fndecl): ...this new function and... + (call_event::get_callee_fndecl): ...this new function. + * checker-path.h (call_event::get_desc): Drop "FINAL". + (call_event::get_caller_fndecl): New decl. + (call_event::get_callee_fndecl): New decl. + (class call_event): Make fields protected. + * diagnostic-manager.cc (null_assignment_sm_context::warn): New + overload. + (null_assignment_sm_context::get_new_program_state): New. + (diagnostic_manager::add_events_for_superedge): Move case + SUPEREDGE_CALL to a new pending_diagnostic::add_call_event vfunc. + * engine.cc (impl_sm_context::warn): Implement new override. + (impl_sm_context::get_new_program_state): New. + * pending-diagnostic.cc: Include "analyzer/diagnostic-manager.h", + "cpplib.h", "digraph.h", "ordered-hash-map.h", "cfg.h", + "basic-block.h", "gimple.h", "gimple-iterator.h", "cgraph.h" + "analyzer/supergraph.h", "analyzer/program-state.h", + "alloc-pool.h", "fibonacci_heap.h", "shortest-paths.h", + "sbitmap.h", "analyzer/exploded-graph.h", "diagnostic-path.h", + and "analyzer/checker-path.h". + (ht_ident_eq): New. + (fixup_location_in_macro_p): New. + (pending_diagnostic::fixup_location): New. + (pending_diagnostic::add_call_event): New. + * pending-diagnostic.h (pending_diagnostic::fixup_location): Drop + no-op inline implementation in favor of the more complex + implementation above. + (pending_diagnostic::add_call_event): New vfunc. + * region-model-impl-calls.cc: Include "analyzer/sm.h", + "diagnostic-path.h", and "analyzer/pending-diagnostic.h". + * region-model-manager.cc + (region_model_manager::get_var_arg_region): New. + (region_model_manager::log_stats): Log m_var_arg_regions. + * region-model.cc (region_model::on_call_pre): Handle IFN_VA_ARG, + BUILT_IN_VA_START, and BUILT_IN_VA_COPY. + (region_model::on_call_post): Handle BUILT_IN_VA_END. + (region_model::get_representative_path_var_1): Handle RK_VAR_ARG. + (region_model::push_frame): Push variadic arguments. + * region-model.h (region_model_manager::get_var_arg_region): New + decl. + (region_model_manager::m_var_arg_regions): New field. + (region_model::impl_call_va_start): New decl. + (region_model::impl_call_va_copy): New decl. + (region_model::impl_call_va_arg): New decl. + (region_model::impl_call_va_end): New decl. + * region.cc (alloca_region::dump_to_pp): Dump the id. + (var_arg_region::dump_to_pp): New. + (var_arg_region::get_frame_region): New. + * region.h (enum region_kind): Add RK_VAR_ARG. + (region::dyn_cast_var_arg_region): New. + (class var_arg_region): New. + (is_a_helper <const var_arg_region *>::test): New. + (struct default_hash_traits<var_arg_region::key_t>): New. + * sm.cc (make_checkers): Call make_va_list_state_machine. + * sm.h (sm_context::warn): New vfunc. + (sm_context::get_old_svalue): Drop unused decl. + (sm_context::get_new_program_state): New vfunc. + (make_va_list_state_machine): New decl. + * varargs.cc: New file. + +2022-05-16 Martin Liska <mliska@suse.cz> + + * engine.cc (exploded_node::get_dot_fillcolor): Use ARRAY_SIZE. + * function-set.cc (test_stdio_example): Likewise. + * sm-file.cc (get_file_using_fns): Likewise. + * sm-malloc.cc (malloc_state_machine::unaffected_by_call_p): Likewise. + * sm-signal.cc (get_async_signal_unsafe_fns): Likewise. + 2022-05-13 Richard Biener <rguenther@suse.de> * supergraph.cc: Re-order gimple-fold.h include. diff --git a/gcc/analyzer/analyzer.cc b/gcc/analyzer/analyzer.cc index 2c63a53..c85dbf3 100644 --- a/gcc/analyzer/analyzer.cc +++ b/gcc/analyzer/analyzer.cc @@ -446,4 +446,42 @@ make_label_text (bool can_colorize, const char *fmt, ...) return result; } +/* As above, but with singular vs plural. */ + +label_text +make_label_text_n (bool can_colorize, int n, + const char *singular_fmt, + const char *plural_fmt, ...) +{ + pretty_printer *pp = global_dc->printer->clone (); + pp_clear_output_area (pp); + + if (!can_colorize) + pp_show_color (pp) = false; + + text_info ti; + rich_location rich_loc (line_table, UNKNOWN_LOCATION); + + va_list ap; + + va_start (ap, plural_fmt); + + const char *fmt = ngettext (singular_fmt, plural_fmt, n); + + ti.format_spec = fmt; + ti.args_ptr = ≈ + ti.err_no = 0; + ti.x_data = NULL; + ti.m_richloc = &rich_loc; + + pp_format (pp, &ti); + pp_output_formatted_text (pp); + + va_end (ap); + + label_text result = label_text::take (xstrdup (pp_formatted_text (pp))); + delete pp; + return result; +} + #endif /* #if ENABLE_ANALYZER */ diff --git a/gcc/analyzer/analyzer.h b/gcc/analyzer/analyzer.h index 39934a3..dcefc13 100644 --- a/gcc/analyzer/analyzer.h +++ b/gcc/analyzer/analyzer.h @@ -69,6 +69,7 @@ class region; class field_region; class string_region; class bit_range_region; + class var_arg_region; class region_model_manager; class conjured_purge; struct model_merger; @@ -296,6 +297,9 @@ extern const char *get_user_facing_name (const gcall *call); extern void register_analyzer_pass (); extern label_text make_label_text (bool can_colorize, const char *fmt, ...); +extern label_text make_label_text_n (bool can_colorize, int n, + const char *singular_fmt, + const char *plural_fmt, ...); extern bool fndecl_has_gimple_body_p (tree fndecl); diff --git a/gcc/analyzer/analyzer.opt b/gcc/analyzer/analyzer.opt index a0ba2c9..23dfc79 100644 --- a/gcc/analyzer/analyzer.opt +++ b/gcc/analyzer/analyzer.opt @@ -142,6 +142,22 @@ Wanalyzer-use-of-pointer-in-stale-stack-frame Common Var(warn_analyzer_use_of_pointer_in_stale_stack_frame) Init(1) Warning Warn about code paths in which a pointer to a stale stack frame is used. +Wanalyzer-va-arg-type-mismatch +Common Var(warn_analyzer_va_arg_type_mismatch) Init(1) Warning +Warn about code paths in which va_arg uses the wrong type. + +Wanalyzer-va-list-exhausted +Common Var(warn_analyzer_va_list_exhausted) Init(1) Warning +Warn about code paths in which va_arg is used too many times on a va_list. + +Wanalyzer-va-list-leak +Common Var(warn_analyzer_va_list_leak) Init(1) Warning +Warn about code paths in which va_start or va_copy is used without a corresponding va_end. + +Wanalyzer-va-list-use-after-va-end +Common Var(warn_analyzer_va_list_use_after_va_end) Init(1) Warning +Warn about code paths in which a va_list is used after va_end. + Wanalyzer-write-to-const Common Var(warn_analyzer_write_to_const) Init(1) Warning Warn about code paths which attempt to write to a const object. diff --git a/gcc/analyzer/checker-path.cc b/gcc/analyzer/checker-path.cc index a61b3ee..5fdbc38 100644 --- a/gcc/analyzer/checker-path.cc +++ b/gcc/analyzer/checker-path.cc @@ -686,8 +686,8 @@ call_event::get_desc (bool can_colorize) const return make_label_text (can_colorize, "calling %qE from %qE", - m_dest_snode->m_fun->decl, - m_src_snode->m_fun->decl); + get_callee_fndecl (), + get_caller_fndecl ()); } /* Override of checker_event::is_call_p for calls. */ @@ -698,6 +698,18 @@ call_event::is_call_p () const return true; } +tree +call_event::get_caller_fndecl () const +{ + return m_src_snode->m_fun->decl; +} + +tree +call_event::get_callee_fndecl () const +{ + return m_dest_snode->m_fun->decl; +} + /* class return_event : public superedge_event. */ /* return_event's ctor. */ diff --git a/gcc/analyzer/checker-path.h b/gcc/analyzer/checker-path.h index d37c999..545d7db 100644 --- a/gcc/analyzer/checker-path.h +++ b/gcc/analyzer/checker-path.h @@ -352,10 +352,14 @@ public: call_event (const exploded_edge &eedge, location_t loc, tree fndecl, int depth); - label_text get_desc (bool can_colorize) const FINAL OVERRIDE; + label_text get_desc (bool can_colorize) const OVERRIDE; bool is_call_p () const FINAL OVERRIDE; +protected: + tree get_caller_fndecl () const; + tree get_callee_fndecl () const; + const supernode *m_src_snode; const supernode *m_dest_snode; }; diff --git a/gcc/analyzer/diagnostic-manager.cc b/gcc/analyzer/diagnostic-manager.cc index 2d49a3b..e8a828d 100644 --- a/gcc/analyzer/diagnostic-manager.cc +++ b/gcc/analyzer/diagnostic-manager.cc @@ -1665,6 +1665,11 @@ struct null_assignment_sm_context : public sm_context { delete d; } + void warn (const supernode *, const gimple *, + const svalue *, pending_diagnostic *d) FINAL OVERRIDE + { + delete d; + } tree get_diagnostic_tree (tree expr) FINAL OVERRIDE { @@ -1707,6 +1712,10 @@ struct null_assignment_sm_context : public sm_context { return m_old_state; } + const program_state *get_new_program_state () const FINAL OVERRIDE + { + return m_new_state; + } const program_state *m_old_state; const program_state *m_new_state; @@ -2048,15 +2057,7 @@ diagnostic_manager::add_events_for_superedge (const path_builder &pb, break; case SUPEREDGE_CALL: - { - emission_path->add_event - (new call_event (eedge, - (last_stmt - ? last_stmt->location - : UNKNOWN_LOCATION), - src_point.get_fndecl (), - src_stack_depth)); - } + pd->add_call_event (eedge, emission_path); break; case SUPEREDGE_INTRAPROCEDURAL_CALL: diff --git a/gcc/analyzer/engine.cc b/gcc/analyzer/engine.cc index 0332932..1638662 100644 --- a/gcc/analyzer/engine.cc +++ b/gcc/analyzer/engine.cc @@ -435,6 +435,23 @@ public: var, var_old_sval, current, d); } + void warn (const supernode *snode, const gimple *stmt, + const svalue *sval, pending_diagnostic *d) FINAL OVERRIDE + { + LOG_FUNC (get_logger ()); + gcc_assert (d); // take ownership + impl_region_model_context old_ctxt + (m_eg, m_enode_for_diag, m_old_state, m_new_state, NULL, NULL, NULL); + + state_machine::state_t current + = (sval + ? m_old_smap->get_state (sval, m_eg.get_ext_state ()) + : m_old_smap->get_global_state ()); + m_eg.get_diagnostic_manager ().add_diagnostic + (&m_sm, m_enode_for_diag, snode, stmt, m_stmt_finder, + NULL_TREE, sval, current, d); + } + /* Hook for picking more readable trees for SSA names of temporaries, so that rather than e.g. "double-free of '<unknown>'" @@ -512,6 +529,11 @@ public: return m_old_state; } + const program_state *get_new_program_state () const FINAL OVERRIDE + { + return m_new_state; + } + log_user m_logger; exploded_graph &m_eg; exploded_node *m_enode_for_diag; @@ -1139,7 +1161,7 @@ exploded_node::get_dot_fillcolor () const = {"azure", "coral", "cornsilk", "lightblue", "yellow", "honeydew", "lightpink", "lightsalmon", "palegreen1", "wheat", "seashell"}; - const int num_colors = sizeof (colors) / sizeof (colors[0]); + const int num_colors = ARRAY_SIZE (colors); return colors[total_sm_state % num_colors]; } else diff --git a/gcc/analyzer/function-set.cc b/gcc/analyzer/function-set.cc index 8d9237d..be04186 100644 --- a/gcc/analyzer/function-set.cc +++ b/gcc/analyzer/function-set.cc @@ -166,7 +166,7 @@ test_stdio_example () "getwc_unlocked", "putc_unlocked" }; - const size_t count = sizeof(example) / sizeof (example[0]); + const size_t count = ARRAY_SIZE (example); function_set fs (example, count); fs.assert_sorted (); fs.assert_sane (); diff --git a/gcc/analyzer/pending-diagnostic.cc b/gcc/analyzer/pending-diagnostic.cc index 5e0ea4c..eff050f 100644 --- a/gcc/analyzer/pending-diagnostic.cc +++ b/gcc/analyzer/pending-diagnostic.cc @@ -33,12 +33,30 @@ along with GCC; see the file COPYING3. If not see #include "diagnostic-event-id.h" #include "analyzer/sm.h" #include "analyzer/pending-diagnostic.h" +#include "analyzer/diagnostic-manager.h" #include "selftest.h" #include "tristate.h" #include "analyzer/call-string.h" #include "analyzer/program-point.h" #include "analyzer/store.h" #include "analyzer/region-model.h" +#include "cpplib.h" +#include "digraph.h" +#include "ordered-hash-map.h" +#include "cfg.h" +#include "basic-block.h" +#include "gimple.h" +#include "gimple-iterator.h" +#include "cgraph.h" +#include "analyzer/supergraph.h" +#include "analyzer/program-state.h" +#include "alloc-pool.h" +#include "fibonacci_heap.h" +#include "shortest-paths.h" +#include "sbitmap.h" +#include "analyzer/exploded-graph.h" +#include "diagnostic-path.h" +#include "analyzer/checker-path.h" #if ENABLE_ANALYZER @@ -111,6 +129,70 @@ pending_diagnostic::same_tree_p (tree t1, tree t2) return simple_cst_equal (t1, t2) == 1; } +/* Return true iff IDENT is STR. */ + +static bool +ht_ident_eq (ht_identifier ident, const char *str) +{ + return (strlen (str) == ident.len + && 0 == strcmp (str, (const char *)ident.str)); +} + +/* Return true if we should show the expansion location rather than unwind + within MACRO. */ + +static bool +fixup_location_in_macro_p (cpp_hashnode *macro) +{ + ht_identifier ident = macro->ident; + /* Don't unwind inside <stdarg.h> macros, so that we don't suppress warnings + from them (due to being in system headers). */ + if (ht_ident_eq (ident, "va_start") + || ht_ident_eq (ident, "va_copy") + || ht_ident_eq (ident, "va_arg") + || ht_ident_eq (ident, "va_end")) + return true; + return false; +} + +/* Base implementation of pending_diagnostic::fixup_location. + Don't unwind inside macros for which fixup_location_in_macro_p is true. */ + +location_t +pending_diagnostic::fixup_location (location_t loc) const +{ + if (linemap_location_from_macro_expansion_p (line_table, loc)) + { + line_map *map + = const_cast <line_map *> (linemap_lookup (line_table, loc)); + const line_map_macro *macro_map = linemap_check_macro (map); + if (fixup_location_in_macro_p (macro_map->macro)) + loc = linemap_resolve_location (line_table, loc, + LRK_MACRO_EXPANSION_POINT, NULL); + } + return loc; +} + +/* Base implementation of pending_diagnostic::add_call_event. + Add a call_event to EMISSION_PATH. */ + +void +pending_diagnostic::add_call_event (const exploded_edge &eedge, + checker_path *emission_path) +{ + const exploded_node *src_node = eedge.m_src; + const program_point &src_point = src_node->get_point (); + const int src_stack_depth = src_point.get_stack_depth (); + const gimple *last_stmt = src_point.get_supernode ()->get_last_stmt (); + emission_path->add_event + (new call_event (eedge, + (last_stmt + ? last_stmt->location + : UNKNOWN_LOCATION), + src_point.get_fndecl (), + src_stack_depth)); +} + } // namespace ana #endif /* #if ENABLE_ANALYZER */ diff --git a/gcc/analyzer/pending-diagnostic.h b/gcc/analyzer/pending-diagnostic.h index 51039ea..17db9fe 100644 --- a/gcc/analyzer/pending-diagnostic.h +++ b/gcc/analyzer/pending-diagnostic.h @@ -203,10 +203,7 @@ class pending_diagnostic /* A vfunc for fixing up locations (both the primary location for the diagnostic, and for events in their paths), e.g. to avoid unwinding inside specific macros. */ - virtual location_t fixup_location (location_t loc) const - { - return loc; - } + virtual location_t fixup_location (location_t loc) const; /* For greatest precision-of-wording, the various following "describe_*" virtual functions give the pending diagnostic a way to describe events @@ -295,6 +292,12 @@ class pending_diagnostic return false; } + /* Vfunc for adding a call_event to a checker_path, so that e.g. + the varargs diagnostics can add a custom event subclass that annotates + the variadic arguments. */ + virtual void add_call_event (const exploded_edge &, + checker_path *); + /* Vfunc for determining that this pending_diagnostic supercedes OTHER, and that OTHER should therefore not be emitted. They have already been tested for being at the same stmt. */ diff --git a/gcc/analyzer/region-model-impl-calls.cc b/gcc/analyzer/region-model-impl-calls.cc index 621e700..a76caf7 100644 --- a/gcc/analyzer/region-model-impl-calls.cc +++ b/gcc/analyzer/region-model-impl-calls.cc @@ -57,6 +57,9 @@ along with GCC; see the file COPYING3. If not see #include "analyzer/store.h" #include "analyzer/region-model.h" #include "analyzer/call-info.h" +#include "analyzer/sm.h" +#include "diagnostic-path.h" +#include "analyzer/pending-diagnostic.h" #include "gimple-pretty-print.h" #if ENABLE_ANALYZER diff --git a/gcc/analyzer/region-model-manager.cc b/gcc/analyzer/region-model-manager.cc index 6d248c9..3377f15 100644 --- a/gcc/analyzer/region-model-manager.cc +++ b/gcc/analyzer/region-model-manager.cc @@ -1601,6 +1601,25 @@ region_model_manager::get_bit_range (const region *parent, tree type, return bit_range_reg; } +/* Return the region that describes accessing the IDX-th variadic argument + within PARENT_FRAME, creating it if necessary. */ + +const var_arg_region * +region_model_manager::get_var_arg_region (const frame_region *parent_frame, + unsigned idx) +{ + gcc_assert (parent_frame); + + var_arg_region::key_t key (parent_frame, idx); + if (var_arg_region *reg = m_var_arg_regions.get (key)) + return reg; + + var_arg_region *var_arg_reg + = new var_arg_region (alloc_region_id (), parent_frame, idx); + m_var_arg_regions.put (key, var_arg_reg); + return var_arg_reg; +} + /* If we see a tree code we don't know how to handle, rather than ICE or generate bogus results, create a dummy region, and notify CTXT so that it can mark the new state as being not properly @@ -1773,6 +1792,7 @@ region_model_manager::log_stats (logger *logger, bool show_objs) const log_uniq_map (logger, show_objs, "symbolic_region", m_symbolic_regions); log_uniq_map (logger, show_objs, "string_region", m_string_map); log_uniq_map (logger, show_objs, "bit_range_region", m_bit_range_regions); + log_uniq_map (logger, show_objs, "var_arg_region", m_var_arg_regions); logger->log (" # managed dynamic regions: %i", m_managed_dynamic_regions.length ()); m_store_mgr.log_stats (logger, show_objs); diff --git a/gcc/analyzer/region-model.cc b/gcc/analyzer/region-model.cc index 816b410..de221c3 100644 --- a/gcc/analyzer/region-model.cc +++ b/gcc/analyzer/region-model.cc @@ -1342,6 +1342,9 @@ region_model::on_call_pre (const gcall *call, region_model_context *ctxt, return false; case IFN_UBSAN_BOUNDS: return false; + case IFN_VA_ARG: + impl_call_va_arg (cd); + return false; } } @@ -1428,6 +1431,13 @@ region_model::on_call_pre (const gcall *call, region_model_context *ctxt, on the return value. */ check_call_args (cd); break; + + case BUILT_IN_VA_START: + impl_call_va_start (cd); + return false; + case BUILT_IN_VA_COPY: + impl_call_va_copy (cd); + return false; } else if (is_named_call_p (callee_fndecl, "malloc", call, 1)) { @@ -1570,6 +1580,10 @@ region_model::on_call_post (const gcall *call, case BUILT_IN_REALLOC: impl_call_realloc (cd); return; + + case BUILT_IN_VA_END: + impl_call_va_end (cd); + return; } } @@ -3520,6 +3534,7 @@ region_model::get_representative_path_var_1 (const region *reg, return path_var (string_reg->get_string_cst (), 0); } + case RK_VAR_ARG: case RK_UNKNOWN: return path_var (NULL_TREE, 0); } @@ -3888,6 +3903,17 @@ region_model::push_frame (function *fun, const vec<const svalue *> *arg_svals, const svalue *arg_sval = (*arg_svals)[idx]; set_value (parm_reg, arg_sval, ctxt); } + + /* Handle any variadic args. */ + unsigned va_arg_idx = 0; + for (; idx < arg_svals->length (); idx++, va_arg_idx++) + { + const svalue *arg_sval = (*arg_svals)[idx]; + const region *var_arg_reg + = m_mgr->get_var_arg_region (m_current_frame, + va_arg_idx); + set_value (var_arg_reg, arg_sval, ctxt); + } } else { diff --git a/gcc/analyzer/region-model.h b/gcc/analyzer/region-model.h index eff3d49..4e5cb46 100644 --- a/gcc/analyzer/region-model.h +++ b/gcc/analyzer/region-model.h @@ -326,6 +326,8 @@ public: const string_region *get_region_for_string (tree string_cst); const region *get_bit_range (const region *parent, tree type, const bit_range &bits); + const var_arg_region *get_var_arg_region (const frame_region *parent, + unsigned idx); const region *get_unknown_symbolic_region (tree region_type); @@ -488,6 +490,7 @@ private: string_map_t m_string_map; consolidation_map<bit_range_region> m_bit_range_regions; + consolidation_map<var_arg_region> m_var_arg_regions; store_manager m_store_mgr; @@ -627,6 +630,12 @@ class region_model void impl_call_operator_delete (const call_details &cd); void impl_deallocation_call (const call_details &cd); + /* Implemented in varargs.cc. */ + void impl_call_va_start (const call_details &cd); + void impl_call_va_copy (const call_details &cd); + void impl_call_va_arg (const call_details &cd); + void impl_call_va_end (const call_details &cd); + void handle_unrecognized_call (const gcall *call, region_model_context *ctxt); void get_reachable_svalues (svalue_set *out, diff --git a/gcc/analyzer/region.cc b/gcc/analyzer/region.cc index 1a7949b3f..a828623 100644 --- a/gcc/analyzer/region.cc +++ b/gcc/analyzer/region.cc @@ -1541,9 +1541,9 @@ void alloca_region::dump_to_pp (pretty_printer *pp, bool simple) const { if (simple) - pp_string (pp, "ALLOCA_REGION"); + pp_printf (pp, "ALLOCA_REGION(%i)", get_id ()); else - pp_string (pp, "alloca_region()"); + pp_printf (pp, "alloca_region(%i)", get_id ()); } /* class string_region : public region. */ @@ -1637,6 +1637,34 @@ bit_range_region::get_relative_concrete_offset (bit_offset_t *out) const return true; } +/* class var_arg_region : public region. */ + +void +var_arg_region::dump_to_pp (pretty_printer *pp, bool simple) const +{ + if (simple) + { + pp_string (pp, "VAR_ARG_REG("); + get_parent_region ()->dump_to_pp (pp, simple); + pp_printf (pp, ", arg_idx: %d)", m_idx); + } + else + { + pp_string (pp, "var_arg_region("); + get_parent_region ()->dump_to_pp (pp, simple); + pp_printf (pp, ", arg_idx: %d)", m_idx); + } +} + +/* Get the frame_region for this var_arg_region. */ + +const frame_region * +var_arg_region::get_frame_region () const +{ + gcc_assert (get_parent_region ()); + return as_a <const frame_region *> (get_parent_region ()); +} + /* class unknown_region : public region. */ /* Implementation of region::dump_to_pp vfunc for unknown_region. */ diff --git a/gcc/analyzer/region.h b/gcc/analyzer/region.h index 5150be7..d32110b 100644 --- a/gcc/analyzer/region.h +++ b/gcc/analyzer/region.h @@ -61,7 +61,8 @@ enum region_kind RK_ALLOCA, RK_STRING, RK_BIT_RANGE, - RK_UNKNOWN + RK_VAR_ARG, + RK_UNKNOWN, }; /* Region and its subclasses. @@ -90,6 +91,7 @@ enum region_kind alloca_region (RK_ALLOCA) string_region (RK_STRING) bit_range_region (RK_BIT_RANGE) + var_arg_region (RK_VAR_ARG) unknown_region (RK_UNKNOWN). */ /* Abstract base class for representing ways of accessing chunks of memory. @@ -131,6 +133,8 @@ public: dyn_cast_string_region () const { return NULL; } virtual const bit_range_region * dyn_cast_bit_range_region () const { return NULL; } + virtual const var_arg_region * + dyn_cast_var_arg_region () const { return NULL; } virtual void accept (visitor *v) const; @@ -1251,6 +1255,87 @@ template <> struct default_hash_traits<bit_range_region::key_t> namespace ana { +/* A region for the N-th vararg within a frame_region for a variadic call. */ + +class var_arg_region : public region +{ +public: + /* A support class for uniquifying instances of var_arg_region. */ + struct key_t + { + key_t (const frame_region *parent, unsigned idx) + : m_parent (parent), m_idx (idx) + { + gcc_assert (parent); + } + + hashval_t hash () const + { + inchash::hash hstate; + hstate.add_ptr (m_parent); + hstate.add_int (m_idx); + return hstate.end (); + } + + bool operator== (const key_t &other) const + { + return (m_parent == other.m_parent + && m_idx == other.m_idx); + } + + void mark_deleted () + { + m_parent = reinterpret_cast<const frame_region *> (1); + } + void mark_empty () { m_parent = NULL; } + bool is_deleted () const + { + return m_parent == reinterpret_cast<const frame_region *> (1); + } + bool is_empty () const { return m_parent == NULL; } + + const frame_region *m_parent; + unsigned m_idx; + }; + + var_arg_region (unsigned id, const frame_region *parent, + unsigned idx) + : region (complexity (parent), id, parent, NULL_TREE), + m_idx (idx) + {} + + const var_arg_region * + dyn_cast_var_arg_region () const FINAL OVERRIDE { return this; } + + enum region_kind get_kind () const FINAL OVERRIDE { return RK_VAR_ARG; } + + void dump_to_pp (pretty_printer *pp, bool simple) const FINAL OVERRIDE; + + const frame_region *get_frame_region () const; + unsigned get_index () const { return m_idx; } + +private: + unsigned m_idx; +}; + +} // namespace ana + +template <> +template <> +inline bool +is_a_helper <const var_arg_region *>::test (const region *reg) +{ + return reg->get_kind () == RK_VAR_ARG; +} + +template <> struct default_hash_traits<var_arg_region::key_t> +: public member_function_hash_traits<var_arg_region::key_t> +{ + static const bool empty_zero_p = true; +}; + +namespace ana { + /* An unknown region, for handling unimplemented tree codes. */ class unknown_region : public region diff --git a/gcc/analyzer/sm-file.cc b/gcc/analyzer/sm-file.cc index ffc2809..3a45e62 100644 --- a/gcc/analyzer/sm-file.cc +++ b/gcc/analyzer/sm-file.cc @@ -329,8 +329,7 @@ get_file_using_fns () "ungetc", "vfprintf" }; - const size_t count - = sizeof(funcnames) / sizeof (funcnames[0]); + const size_t count = ARRAY_SIZE (funcnames); function_set fs (funcnames, count); return fs; } diff --git a/gcc/analyzer/sm-malloc.cc b/gcc/analyzer/sm-malloc.cc index 4c03080..20c1677 100644 --- a/gcc/analyzer/sm-malloc.cc +++ b/gcc/analyzer/sm-malloc.cc @@ -2054,8 +2054,7 @@ malloc_state_machine::unaffected_by_call_p (tree fndecl) /* This array must be kept sorted. */ "strsep", }; - const size_t count - = sizeof(funcnames) / sizeof (funcnames[0]); + const size_t count = ARRAY_SIZE (funcnames); function_set fs (funcnames, count); if (fs.contains_decl_p (fndecl)) diff --git a/gcc/analyzer/sm-signal.cc b/gcc/analyzer/sm-signal.cc index 77044e1..9b0213e 100644 --- a/gcc/analyzer/sm-signal.cc +++ b/gcc/analyzer/sm-signal.cc @@ -309,8 +309,7 @@ get_async_signal_unsafe_fns () "vsnprintf", "vsprintf" }; - const size_t count - = sizeof(async_signal_unsafe_fns) / sizeof (async_signal_unsafe_fns[0]); + const size_t count = ARRAY_SIZE (async_signal_unsafe_fns); function_set fs (async_signal_unsafe_fns, count); return fs; } diff --git a/gcc/analyzer/sm.cc b/gcc/analyzer/sm.cc index 515f86d..622cb0b 100644 --- a/gcc/analyzer/sm.cc +++ b/gcc/analyzer/sm.cc @@ -173,6 +173,7 @@ make_checkers (auto_delete_vec <state_machine> &out, logger *logger) out.safe_push (make_taint_state_machine (logger)); out.safe_push (make_sensitive_state_machine (logger)); out.safe_push (make_signal_state_machine (logger)); + out.safe_push (make_va_list_state_machine (logger)); /* We only attempt to run the pattern tests if it might have been manually enabled (for DejaGnu purposes). */ diff --git a/gcc/analyzer/sm.h b/gcc/analyzer/sm.h index 7ce1c73..4cc5453 100644 --- a/gcc/analyzer/sm.h +++ b/gcc/analyzer/sm.h @@ -242,6 +242,8 @@ public: issue a diagnostic D using NODE and STMT for location information. */ virtual void warn (const supernode *node, const gimple *stmt, tree var, pending_diagnostic *d) = 0; + virtual void warn (const supernode *node, const gimple *stmt, + const svalue *var, pending_diagnostic *d) = 0; /* For use when generating trees when creating pending_diagnostics, so that rather than e.g. @@ -275,8 +277,7 @@ public: virtual bool unknown_side_effects_p () const { return false; } virtual const program_state *get_old_program_state () const = 0; - - const svalue *get_old_svalue (tree expr) const; + virtual const program_state *get_new_program_state () const = 0; protected: sm_context (int sm_idx, const state_machine &sm) @@ -299,6 +300,7 @@ extern state_machine *make_taint_state_machine (logger *logger); extern state_machine *make_sensitive_state_machine (logger *logger); extern state_machine *make_signal_state_machine (logger *logger); extern state_machine *make_pattern_test_state_machine (logger *logger); +extern state_machine *make_va_list_state_machine (logger *logger); } // namespace ana diff --git a/gcc/analyzer/varargs.cc b/gcc/analyzer/varargs.cc new file mode 100644 index 0000000..de77fe5d3 --- /dev/null +++ b/gcc/analyzer/varargs.cc @@ -0,0 +1,1025 @@ +/* Implementation of <stdarg.h> within analyzer. + Copyright (C) 2022 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/>. */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "tree.h" +#include "function.h" +#include "basic-block.h" +#include "gimple.h" +#include "diagnostic-path.h" +#include "json.h" +#include "analyzer/analyzer.h" +#include "analyzer/analyzer-logging.h" +#include "analyzer/sm.h" +#include "analyzer/pending-diagnostic.h" +#include "tristate.h" +#include "selftest.h" +#include "analyzer/call-string.h" +#include "analyzer/program-point.h" +#include "analyzer/store.h" +#include "analyzer/region-model.h" +#include "analyzer/program-state.h" +#include "analyzer/checker-path.h" +#include "digraph.h" +#include "ordered-hash-map.h" +#include "cfg.h" +#include "gimple-iterator.h" +#include "analyzer/supergraph.h" +#include "alloc-pool.h" +#include "fibonacci_heap.h" +#include "shortest-paths.h" +#include "sbitmap.h" +#include "analyzer/diagnostic-manager.h" +#include "analyzer/exploded-graph.h" + +#if ENABLE_ANALYZER + +namespace ana { + +/* Implementation of <stdarg.h> within analyzer. + + Objectives: + - detection of interprocedural type errors involving va_arg + - tracking of symbolic values interprocedurally from variadic call + through to va_arg unpacking + - detection of missing va_end + - detection of va_arg outside of a va_start/va_end pair + - detection of uses of a va_list after the frame in containing the + va_start has returned + + The analyzer runs *before* the "stdarg" and "lower_vaarg" gimple + passes, which have target-dependent effects. + + This file implements a state machine on svalues for tracking when + va_start has been called, so that we can detect missing va_end, + and misplaced va_arg, etc. + To do this requires an svalue that can have state, so we implement va_start + by creating a stack-allocated region, and use a pointer to that region + as the svalue that has state. + + We call this stack-allocated region the "impl_reg". Allocating it on + the stack ensures that it is invalidated when the frame containing + the va_start returns, leading to + -Wanalyzer-use-of-pointer-in-stale-stack-frame on attempts to use such + a va_list. + + To track svalues from variadic calls interprocedurally, we implement + variadic arguments via new child regions of the callee's frame_region, + var_arg_region, each one representing a storage slot for one of the + variadic arguments, accessed by index. + + We have: + + stack frame: + va_list: &impl_reg + 'impl_reg': pointer to next var_arg_region + var_arg_region for arg 0 + ... + var_arg_region for arg N-1 + + Hence given test_1 in stdarg-1.c, at the call to: + + __analyzer_called_by_test_1 (int placeholder, ...); + + here: + + __analyzer_called_by_test_1 (42, "foo", 1066, '@'); + + we push this frame for the called function: + clusters within frame: ‘__analyzer_called_by_test_1’@2 + cluster for: placeholder: (int)42 + cluster for: VAR_ARG_REG(frame: ‘__analyzer_called_by_test_1’@2, arg_idx: 0): &"foo" (TOUCHED) + cluster for: VAR_ARG_REG(frame: ‘__analyzer_called_by_test_1’@2, arg_idx: 1): (int)1066 (TOUCHED) + cluster for: VAR_ARG_REG(frame: ‘__analyzer_called_by_test_1’@2, arg_idx: 2): (int)64 (TOUCHED) + where the called function's frame has been populated with both the value + of the regular argument "placeholder", and with values for 3 variadic + arguments. + + At the call to + va_start (ap, placeholder); + we allocate a region ALLOCA_REGION for ap to point to, populate that + region with the address of variadic argument 0, and set sm-state of + &ALLOCA_REGION to "started": + clusters within frame: ‘__analyzer_called_by_test_1’@2 + cluster for: placeholder: (int)42 + cluster for: VAR_ARG_REG(frame: ‘__analyzer_called_by_test_1’@2, arg_idx: 0): &"foo" (TOUCHED) + cluster for: VAR_ARG_REG(frame: ‘__analyzer_called_by_test_1’@2, arg_idx: 1): (int)1066 (TOUCHED) + cluster for: VAR_ARG_REG(frame: ‘__analyzer_called_by_test_1’@2, arg_idx: 2): (int)64 (TOUCHED) + cluster for: ap: &ALLOCA_REGION + cluster for: ALLOCA_REGION: &VAR_ARG_REG(frame: ‘__analyzer_called_by_test_1’@2, arg_idx: 0) (TOUCHED) + va_list: + 0x4c83700: &ALLOCA_REGION: started + + At each call to + va_arg (ap, TYPE); + we can look within *ap, locate the region holding the next variadic + argument to be extracted, extract the svalue, and advance the index + by effectively updating *ap. + + At the va_end, we can set &ALLOCA_REGION's state to "ended". + + The various __builtin_va_* accept ap by pointer, so we have e.g.: + + __builtin_va_start (&ap, [...]); + + except for the 2nd param of __builtin_va_copy, where the type + is already target-dependent (see the discussion of BT_VALIST_ARG + below). */ + +/* Get a tree for diagnostics. + Typically we have "&ap", but it will make more sense to + the user as just "ap", so strip off the ADDR_EXPR. */ + +static tree +get_va_list_diag_arg (tree va_list_tree) +{ + if (TREE_CODE (va_list_tree) == ADDR_EXPR) + va_list_tree = TREE_OPERAND (va_list_tree, 0); + return va_list_tree; +} + +/* Get argument ARG_IDX of type BT_VALIST_ARG (for use by va_copy). + + builtin-types.def has: + DEF_PRIMITIVE_TYPE (BT_VALIST_ARG, va_list_arg_type_node) + + and c_common_nodes_and_builtins initializes va_list_arg_type_node + based on whether TREE_CODE (va_list_type_node) is of ARRAY_TYPE or + not, giving either one or zero levels of indirection. */ + +static const svalue * +get_BT_VALIST_ARG (const region_model *model, + region_model_context *ctxt, + const gcall *call, + unsigned arg_idx) +{ + tree arg = gimple_call_arg (call, arg_idx); + const svalue *arg_sval = model->get_rvalue (arg, ctxt); + if (const svalue *cast = arg_sval->maybe_undo_cast ()) + arg_sval = cast; + if (TREE_CODE (va_list_type_node) == ARRAY_TYPE) + { + /* va_list_arg_type_node is a pointer to a va_list; + return *ARG_SVAL. */ + const region *src_reg = model->deref_rvalue (arg_sval, arg, ctxt); + const svalue *src_reg_sval = model->get_store_value (src_reg, ctxt); + if (const svalue *cast = src_reg_sval->maybe_undo_cast ()) + src_reg_sval = cast; + return src_reg_sval; + } + else + { + /* va_list_arg_type_node is a va_list; return ARG_SVAL. */ + return arg_sval; + } +} + +namespace { + +/* A state machine for tracking the state of a va_list, so that + we can enforce that each va_start is paired with a va_end, + and va_arg only happens within a va_start/va_end pair. + Specifically, this tracks the state of the &ALLOCA_BUFFER + that va_start/va_copy allocate. */ + +class va_list_state_machine : public state_machine +{ +public: + va_list_state_machine (logger *logger); + + bool inherited_state_p () const FINAL OVERRIDE { return false; } + + bool on_stmt (sm_context *sm_ctxt, + const supernode *node, + const gimple *stmt) const FINAL OVERRIDE; + + bool can_purge_p (state_t s) const FINAL OVERRIDE + { + return s != m_started; + } + pending_diagnostic *on_leak (tree var) const FINAL OVERRIDE; + + /* State for a va_list that the result of a va_start or va_copy. */ + state_t m_started; + + /* State for a va_list that has had va_end called on it. */ + state_t m_ended; + +private: + void on_va_start (sm_context *sm_ctxt, const supernode *node, + const gcall *call) const; + void on_va_copy (sm_context *sm_ctxt, const supernode *node, + const gcall *call) const; + void on_va_arg (sm_context *sm_ctxt, const supernode *node, + const gcall *call) const; + void on_va_end (sm_context *sm_ctxt, const supernode *node, + const gcall *call) const; + void check_for_ended_va_list (sm_context *sm_ctxt, + const supernode *node, + const gcall *call, + const svalue *arg, + const char *usage_fnname) const; +}; + +/* va_list_state_machine's ctor. */ + +va_list_state_machine::va_list_state_machine (logger *logger) +: state_machine ("va_list", logger) +{ + m_started = add_state ("started"); + m_ended = add_state ("ended"); +} + +/* Implementation of the various "va_*" functions for + va_list_state_machine. */ + +bool +va_list_state_machine::on_stmt (sm_context *sm_ctxt, + const supernode *node, + const gimple *stmt) const +{ + if (const gcall *call = dyn_cast <const gcall *> (stmt)) + { + if (gimple_call_internal_p (call) + && gimple_call_internal_fn (call) == IFN_VA_ARG) + { + on_va_arg (sm_ctxt, node, call); + return false; + } + + if (tree callee_fndecl = sm_ctxt->get_fndecl_for_call (call)) + if (fndecl_built_in_p (callee_fndecl, BUILT_IN_NORMAL) + && gimple_builtin_call_types_compatible_p (call, callee_fndecl)) + switch (DECL_UNCHECKED_FUNCTION_CODE (callee_fndecl)) + { + default: + break; + + case BUILT_IN_VA_START: + on_va_start (sm_ctxt, node, call); + break; + + case BUILT_IN_VA_COPY: + on_va_copy (sm_ctxt, node, call); + break; + + case BUILT_IN_VA_END: + on_va_end (sm_ctxt, node, call); + break; + } + } + return false; +} + +/* Get the svalue for which va_list_state_machine holds state on argument ARG_ + IDX to CALL. */ + +static const svalue * +get_stateful_arg (sm_context *sm_ctxt, const gcall *call, unsigned arg_idx) +{ + tree ap = gimple_call_arg (call, arg_idx); + if (ap + && POINTER_TYPE_P (TREE_TYPE (ap))) + { + if (const program_state *new_state = sm_ctxt->get_new_program_state ()) + { + const region_model *new_model = new_state->m_region_model; + const svalue *ptr_sval = new_model->get_rvalue (ap, NULL); + const region *reg = new_model->deref_rvalue (ptr_sval, ap, NULL); + const svalue *impl_sval = new_model->get_store_value (reg, NULL); + if (const svalue *cast = impl_sval->maybe_undo_cast ()) + impl_sval = cast; + return impl_sval; + } + } + return NULL; +} + +/* Abstract class for diagnostics relating to va_list_state_machine. */ + +class va_list_sm_diagnostic : public pending_diagnostic +{ +public: + bool subclass_equal_p (const pending_diagnostic &base_other) const OVERRIDE + { + const va_list_sm_diagnostic &other + = (const va_list_sm_diagnostic &)base_other; + return (m_ap_sval == other.m_ap_sval + && same_tree_p (m_ap_tree, other.m_ap_tree)); + } + + label_text describe_state_change (const evdesc::state_change &change) + OVERRIDE + { + if (const char *fnname = maybe_get_fnname (change)) + return change.formatted_print ("%qs called here", fnname); + return label_text (); + } + +protected: + va_list_sm_diagnostic (const va_list_state_machine &sm, + const svalue *ap_sval, tree ap_tree) + : m_sm (sm), m_ap_sval (ap_sval), m_ap_tree (ap_tree) + {} + + static const char *maybe_get_fnname (const evdesc::state_change &change) + { + if (change.m_event.m_stmt) + if (const gcall *call = as_a <const gcall *> (change.m_event.m_stmt)) + if (tree callee_fndecl = gimple_call_fndecl (call)) + { + if (fndecl_built_in_p (callee_fndecl, BUILT_IN_NORMAL)) + switch (DECL_UNCHECKED_FUNCTION_CODE (callee_fndecl)) + { + case BUILT_IN_VA_START: + return "va_start"; + case BUILT_IN_VA_COPY: + return "va_copy"; + case BUILT_IN_VA_END: + return "va_end"; + } + } + return NULL; + } + + const va_list_state_machine &m_sm; + const svalue *m_ap_sval; + tree m_ap_tree; +}; + +/* Concrete class for -Wanalyzer-va-list-use-after-va-end: + complain about use of a va_list after va_end has been called on it. */ + +class va_list_use_after_va_end : public va_list_sm_diagnostic +{ +public: + va_list_use_after_va_end (const va_list_state_machine &sm, + const svalue *ap_sval, tree ap_tree, + const char *usage_fnname) + : va_list_sm_diagnostic (sm, ap_sval, ap_tree), + m_usage_fnname (usage_fnname) + { + } + + int get_controlling_option () const FINAL OVERRIDE + { + return OPT_Wanalyzer_va_list_use_after_va_end; + } + + bool operator== (const va_list_use_after_va_end &other) const + { + return (va_list_sm_diagnostic::subclass_equal_p (other) + && 0 == strcmp (m_usage_fnname, other.m_usage_fnname)); + } + + bool emit (rich_location *rich_loc) FINAL OVERRIDE + { + auto_diagnostic_group d; + return warning_at (rich_loc, get_controlling_option (), + "%qs after %qs", m_usage_fnname, "va_end"); + } + + const char *get_kind () const FINAL OVERRIDE + { + return "va_list_use_after_va_end"; + } + + label_text describe_state_change (const evdesc::state_change &change) + FINAL OVERRIDE + { + if (change.m_new_state == m_sm.m_ended) + m_va_end_event = change.m_event_id; + return va_list_sm_diagnostic::describe_state_change (change); + } + + label_text describe_final_event (const evdesc::final_event &ev) FINAL OVERRIDE + { + if (ev.m_expr) + { + if (m_va_end_event.known_p ()) + return ev.formatted_print + ("%qs on %qE after %qs at %@", + m_usage_fnname, ev.m_expr, "va_end", &m_va_end_event); + else + return ev.formatted_print + ("%qs on %qE after %qs", + m_usage_fnname, ev.m_expr, "va_end"); + } + else + { + if (m_va_end_event.known_p ()) + return ev.formatted_print + ("%qs after %qs at %@", + m_usage_fnname, "va_end", &m_va_end_event); + else + return ev.formatted_print + ("%qs after %qs", + m_usage_fnname, "va_end"); + } + } + +private: + diagnostic_event_id_t m_va_end_event; + const char *m_usage_fnname; +}; + +/* Concrete class for -Wanalyzer-va-list-leak: + complain about a va_list in the "started" state that doesn't get after + va_end called on it. */ + +class va_list_leak : public va_list_sm_diagnostic +{ +public: + va_list_leak (const va_list_state_machine &sm, + const svalue *ap_sval, tree ap_tree) + : va_list_sm_diagnostic (sm, ap_sval, ap_tree), + m_start_event_fnname (NULL) + { + } + + int get_controlling_option () const FINAL OVERRIDE + { + return OPT_Wanalyzer_va_list_leak; + } + + bool operator== (const va_list_leak &other) const + { + return va_list_sm_diagnostic::subclass_equal_p (other); + } + + bool emit (rich_location *rich_loc) + { + auto_diagnostic_group d; + return warning_at (rich_loc, get_controlling_option (), + "missing call to %qs", "va_end"); + } + + const char *get_kind () const FINAL OVERRIDE { return "va_list_leak"; } + + label_text describe_state_change (const evdesc::state_change &change) + FINAL OVERRIDE + { + if (change.m_new_state == m_sm.m_started) + { + m_start_event = change.m_event_id; + m_start_event_fnname = maybe_get_fnname (change); + } + return va_list_sm_diagnostic::describe_state_change (change); + } + + label_text describe_final_event (const evdesc::final_event &ev) FINAL OVERRIDE + { + if (ev.m_expr) + { + if (m_start_event.known_p () && m_start_event_fnname) + return ev.formatted_print + ("missing call to %qs on %qE to match %qs at %@", + "va_end", ev.m_expr, m_start_event_fnname, &m_start_event); + else + return ev.formatted_print + ("missing call to %qs on %qE", + "va_end", ev.m_expr); + } + else + { + if (m_start_event.known_p () && m_start_event_fnname) + return ev.formatted_print + ("missing call to %qs to match %qs at %@", + "va_end", m_start_event_fnname, &m_start_event); + else + return ev.formatted_print + ("missing call to %qs", + "va_end"); + } + } + +private: + diagnostic_event_id_t m_start_event; + const char *m_start_event_fnname; +}; + +/* Update state machine for a "va_start" call. */ + +void +va_list_state_machine::on_va_start (sm_context *sm_ctxt, + const supernode *, + const gcall *call) const +{ + const svalue *arg = get_stateful_arg (sm_ctxt, call, 0); + if (arg) + { + /* Transition from start state to "started". */ + if (sm_ctxt->get_state (call, arg) == m_start) + sm_ctxt->set_next_state (call, arg, m_started); + } +} + +/* Complain if ARG is in the "ended" state. */ + +void +va_list_state_machine::check_for_ended_va_list (sm_context *sm_ctxt, + const supernode *node, + const gcall *call, + const svalue *arg, + const char *usage_fnname) const +{ + if (sm_ctxt->get_state (call, arg) == m_ended) + sm_ctxt->warn (node, call, arg, + new va_list_use_after_va_end (*this, arg, NULL_TREE, + usage_fnname)); +} + +/* Get the svalue with associated va_list_state_machine state for a + BT_VALIST_ARG for ARG_IDX of CALL, if SM_CTXT supports this, + or NULL otherwise. */ + +static const svalue * +get_stateful_BT_VALIST_ARG (sm_context *sm_ctxt, + const gcall *call, + unsigned arg_idx) +{ + if (const program_state *new_state = sm_ctxt->get_new_program_state ()) + { + const region_model *new_model = new_state->m_region_model; + const svalue *arg = get_BT_VALIST_ARG (new_model, NULL, call, arg_idx); + return arg; + } + return NULL; +} + +/* Update state machine for a "va_copy" call. */ + +void +va_list_state_machine::on_va_copy (sm_context *sm_ctxt, + const supernode *node, + const gcall *call) const +{ + const svalue *src_arg = get_stateful_BT_VALIST_ARG (sm_ctxt, call, 1); + if (src_arg) + check_for_ended_va_list (sm_ctxt, node, call, src_arg, "va_copy"); + + const svalue *dst_arg = get_stateful_arg (sm_ctxt, call, 0); + if (dst_arg) + { + /* Transition from start state to "started". */ + if (sm_ctxt->get_state (call, dst_arg) == m_start) + sm_ctxt->set_next_state (call, dst_arg, m_started); + } +} + +/* Update state machine for a "va_arg" call. */ + +void +va_list_state_machine::on_va_arg (sm_context *sm_ctxt, + const supernode *node, + const gcall *call) const +{ + const svalue *arg = get_stateful_arg (sm_ctxt, call, 0); + if (arg) + check_for_ended_va_list (sm_ctxt, node, call, arg, "va_arg"); +} + +/* Update state machine for a "va_end" call. */ + +void +va_list_state_machine::on_va_end (sm_context *sm_ctxt, + const supernode *node, + const gcall *call) const +{ + const svalue *arg = get_stateful_arg (sm_ctxt, call, 0); + if (arg) + { + state_t s = sm_ctxt->get_state (call, arg); + /* Transition from "started" to "ended". */ + if (s == m_started) + sm_ctxt->set_next_state (call, arg, m_ended); + else if (s == m_ended) + check_for_ended_va_list (sm_ctxt, node, call, arg, "va_end"); + } +} + +/* Implementation of state_machine::on_leak vfunc for va_list_state_machine + (for complaining about leaks of values in state 'started'). */ + +pending_diagnostic * +va_list_state_machine::on_leak (tree var) const +{ + return new va_list_leak (*this, NULL, var); +} + +} // anonymous namespace + +/* Internal interface to this file. */ + +state_machine * +make_va_list_state_machine (logger *logger) +{ + return new va_list_state_machine (logger); +} + +/* Handle the on_call_pre part of "__builtin_va_start". */ + +void +region_model::impl_call_va_start (const call_details &cd) +{ + const svalue *out_ptr = cd.get_arg_svalue (0); + const region *out_reg + = deref_rvalue (out_ptr, cd.get_arg_tree (0), cd.get_ctxt ()); + + /* "*out_ptr = &IMPL_REGION;". */ + const region *impl_reg = m_mgr->create_region_for_alloca (m_current_frame); + + /* We abuse the types here, since va_list_type isn't + necessarily anything to do with a pointer. */ + const svalue *ptr_to_impl_reg = m_mgr->get_ptr_svalue (NULL_TREE, impl_reg); + set_value (out_reg, ptr_to_impl_reg, cd.get_ctxt ()); + + /* "*(&IMPL_REGION) = VA_LIST_VAL (0);". */ + const region *init_var_arg_reg + = m_mgr->get_var_arg_region (get_current_frame (), 0); + const svalue *ap_sval = m_mgr->get_ptr_svalue (NULL_TREE, init_var_arg_reg); + set_value (impl_reg, ap_sval, cd.get_ctxt ()); +} + +/* Handle the on_call_pre part of "__builtin_va_copy". */ + +void +region_model::impl_call_va_copy (const call_details &cd) +{ + const svalue *out_dst_ptr = cd.get_arg_svalue (0); + const svalue *in_va_list + = get_BT_VALIST_ARG (this, cd.get_ctxt (), cd.get_call_stmt (), 1); + in_va_list = check_for_poison (in_va_list, + get_va_list_diag_arg (cd.get_arg_tree (1)), + cd.get_ctxt ()); + + const region *out_dst_reg + = deref_rvalue (out_dst_ptr, cd.get_arg_tree (0), cd.get_ctxt ()); + + /* "*out_dst_ptr = &NEW_IMPL_REGION;". */ + const region *new_impl_reg + = m_mgr->create_region_for_alloca (m_current_frame); + const svalue *ptr_to_new_impl_reg + = m_mgr->get_ptr_svalue (NULL_TREE, new_impl_reg); + set_value (out_dst_reg, ptr_to_new_impl_reg, cd.get_ctxt ()); + + if (const region *old_impl_reg = in_va_list->maybe_get_region ()) + { + + /* "(NEW_IMPL_REGION) = (OLD_IMPL_REGION);". */ + const svalue *existing_sval + = get_store_value (old_impl_reg, cd.get_ctxt ()); + set_value (new_impl_reg, existing_sval, cd.get_ctxt ()); + } +} + +/* Get the number of variadic arguments to CALLEE_FNDECL at CALL_STMT. */ + +static int +get_num_variadic_arguments (tree callee_fndecl, + const gcall *call_stmt) +{ + int num_positional = 0; + for (tree iter_parm = DECL_ARGUMENTS (callee_fndecl); iter_parm; + iter_parm = DECL_CHAIN (iter_parm)) + num_positional++; + return gimple_call_num_args (call_stmt) - num_positional; +} + +/* An abstract subclass of pending_diagnostic for diagnostics relating + to bad va_arg invocations. + + This shows the number of variadic arguments at the call of interest. + Ideally we'd also be able to highlight individual arguments, but + that location information isn't generally available from the middle end. */ + +class va_arg_diagnostic : public pending_diagnostic +{ +public: + /* Override of pending_diagnostic::add_call_event, + adding a custom call_event subclass. */ + void add_call_event (const exploded_edge &eedge, + checker_path *emission_path) OVERRIDE + { + /* As per call_event, but show the number of variadic arguments + in the call. */ + class va_arg_call_event : public call_event + { + public: + va_arg_call_event (const exploded_edge &eedge, + location_t loc, tree fndecl, int depth, + int num_variadic_arguments) + : call_event (eedge, loc, fndecl, depth), + m_num_variadic_arguments (num_variadic_arguments) + { + } + + label_text get_desc (bool can_colorize) const OVERRIDE + { + return make_label_text_n + (can_colorize, m_num_variadic_arguments, + "calling %qE from %qE with %i variadic argument", + "calling %qE from %qE with %i variadic arguments", + get_callee_fndecl (), + get_caller_fndecl (), + m_num_variadic_arguments); + } + private: + int m_num_variadic_arguments; + }; + + const frame_region *frame_reg = m_var_arg_reg->get_frame_region (); + const exploded_node *dst_node = eedge.m_dest; + if (dst_node->get_state ().m_region_model->get_current_frame () + == frame_reg) + { + const exploded_node *src_node = eedge.m_src; + const program_point &src_point = src_node->get_point (); + const int src_stack_depth = src_point.get_stack_depth (); + const gimple *last_stmt = src_point.get_supernode ()->get_last_stmt (); + const gcall *call_stmt = as_a <const gcall *> (last_stmt); + int num_variadic_arguments + = get_num_variadic_arguments (dst_node->get_function ()->decl, + call_stmt); + emission_path->add_event + (new va_arg_call_event (eedge, + (last_stmt + ? last_stmt->location + : UNKNOWN_LOCATION), + src_point.get_fndecl (), + src_stack_depth, + num_variadic_arguments)); + } + else + pending_diagnostic::add_call_event (eedge, emission_path); + } + +protected: + va_arg_diagnostic (tree va_list_tree, const var_arg_region *var_arg_reg) + : m_va_list_tree (va_list_tree), m_var_arg_reg (var_arg_reg) + {} + + bool subclass_equal_p (const pending_diagnostic &base_other) const OVERRIDE + { + const va_arg_diagnostic &other = (const va_arg_diagnostic &)base_other; + return (same_tree_p (m_va_list_tree, other.m_va_list_tree) + && m_var_arg_reg == other.m_var_arg_reg); + } + + /* Get the number of arguments consumed so far from the va_list + (*before* this va_arg call). */ + unsigned get_num_consumed () const + { + return m_var_arg_reg->get_index (); + } + + /* Get a 1-based index of which variadic argument is being consumed. */ + unsigned get_variadic_index_for_diagnostic () const + { + return get_num_consumed () + 1; + } + + /* User-readable expr for the va_list argument to va_arg. */ + tree m_va_list_tree; + + /* The region that the va_arg attempted to access. */ + const var_arg_region *m_var_arg_reg; +}; + +/* A subclass of pending_diagnostic for complaining about a type mismatch + between the result of: + va_arg (AP); + and the type of the argument that was passed to the variadic call. */ + +class va_arg_type_mismatch : public va_arg_diagnostic +{ +public: + va_arg_type_mismatch (tree va_list_tree, const var_arg_region *var_arg_reg, + tree expected_type, tree actual_type) + : va_arg_diagnostic (va_list_tree, var_arg_reg), + m_expected_type (expected_type), m_actual_type (actual_type) + {} + + const char *get_kind () const FINAL OVERRIDE + { + return "va_arg_type_mismatch"; + } + + bool subclass_equal_p (const pending_diagnostic &base_other) + const FINAL OVERRIDE + { + if (!va_arg_diagnostic::subclass_equal_p (base_other)) + return false; + const va_arg_type_mismatch &other + = (const va_arg_type_mismatch &)base_other; + return (same_tree_p (m_expected_type, other.m_expected_type) + && same_tree_p (m_actual_type, other.m_actual_type)); + } + + int get_controlling_option () const FINAL OVERRIDE + { + return OPT_Wanalyzer_va_arg_type_mismatch; + } + + bool emit (rich_location *rich_loc) FINAL OVERRIDE + { + auto_diagnostic_group d; + bool warned + = warning_at (rich_loc, get_controlling_option (), + "%<va_arg%> expected %qT but received %qT" + " for variadic argument %i of %qE", + m_expected_type, m_actual_type, + get_variadic_index_for_diagnostic (), m_va_list_tree); + return warned; + } + + label_text describe_final_event (const evdesc::final_event &ev) FINAL OVERRIDE + { + return ev.formatted_print ("%<va_arg%> expected %qT but received %qT" + " for variadic argument %i of %qE", + m_expected_type, m_actual_type, + get_variadic_index_for_diagnostic (), + m_va_list_tree); + } + +private: + tree m_expected_type; + tree m_actual_type; +}; + +/* A subclass of pending_diagnostic for complaining about a + va_arg (AP); + after all of the args in AP have been consumed. */ + +class va_list_exhausted : public va_arg_diagnostic +{ +public: + va_list_exhausted (tree va_list_tree, const var_arg_region *var_arg_reg) + : va_arg_diagnostic (va_list_tree, var_arg_reg) + {} + + const char *get_kind () const FINAL OVERRIDE + { + return "va_list_exhausted"; + } + + int get_controlling_option () const FINAL OVERRIDE + { + return OPT_Wanalyzer_va_list_exhausted; + } + + bool emit (rich_location *rich_loc) FINAL OVERRIDE + { + auto_diagnostic_group d; + bool warned = warning_at (rich_loc, get_controlling_option (), + "%qE has no more arguments (%i consumed)", + m_va_list_tree, get_num_consumed ()); + return warned; + } + + label_text describe_final_event (const evdesc::final_event &ev) FINAL OVERRIDE + { + return ev.formatted_print ("%qE has no more arguments (%i consumed)", + m_va_list_tree, get_num_consumed ()); + } +}; + +/* Return true if it's OK to copy a value from ARG_TYPE to LHS_TYPE via + va_arg (where argument promotion has already happened). */ + +static bool +va_arg_compatible_types_p (tree lhs_type, tree arg_type) +{ + return compat_types_p (arg_type, lhs_type); +} + +/* If AP_SVAL is a pointer to a var_arg_region, return that var_arg_region. + Otherwise return NULL. */ + +static const var_arg_region * +maybe_get_var_arg_region (const svalue *ap_sval) +{ + if (const region *reg = ap_sval->maybe_get_region ()) + return reg->dyn_cast_var_arg_region (); + return NULL; +} + +/* Handle the on_call_pre part of "__builtin_va_arg". */ + +void +region_model::impl_call_va_arg (const call_details &cd) +{ + region_model_context *ctxt = cd.get_ctxt (); + + const svalue *in_ptr = cd.get_arg_svalue (0); + const region *ap_reg = deref_rvalue (in_ptr, cd.get_arg_tree (0), ctxt); + + const svalue *ap_sval = get_store_value (ap_reg, ctxt); + if (const svalue *cast = ap_sval->maybe_undo_cast ()) + ap_sval = cast; + + tree va_list_tree = get_va_list_diag_arg (cd.get_arg_tree (0)); + ap_sval = check_for_poison (ap_sval, va_list_tree, ctxt); + + if (const region *impl_reg = ap_sval->maybe_get_region ()) + { + const svalue *old_impl_sval = get_store_value (impl_reg, ctxt); + if (const var_arg_region *arg_reg + = maybe_get_var_arg_region (old_impl_sval)) + { + bool saw_problem = false; + + const frame_region *frame_reg = arg_reg->get_frame_region (); + unsigned next_arg_idx = arg_reg->get_index (); + + if (get_stack_depth () > 1) + { + /* The interprocedural case: the called frame will have been + populated with any variadic aruguments. + Attempt to extract arg_reg to cd's return region (which already + has a conjured_svalue), or warn if there's a problem + (incompatible types, or if we've run out of args). */ + if (const svalue *arg_sval + = m_store.get_any_binding (m_mgr->get_store_manager (), + arg_reg)) + { + tree lhs_type = cd.get_lhs_type (); + tree arg_type = arg_sval->get_type (); + if (va_arg_compatible_types_p (lhs_type, arg_type)) + cd.maybe_set_lhs (arg_sval); + else + { + if (ctxt) + ctxt->warn (new va_arg_type_mismatch (va_list_tree, + arg_reg, + lhs_type, + arg_type)); + saw_problem = true; + } + } + else + { + if (ctxt) + ctxt->warn (new va_list_exhausted (va_list_tree, arg_reg)); + saw_problem = true; + } + } + else + { + /* This frame is an entry-point to the analysis, so there won't be + any specific var_arg_regions populated within it. + We already have a conjured_svalue for the result, so leave + it untouched. */ + gcc_assert (get_stack_depth () == 1); + } + + if (saw_problem) + { + /* Set impl_reg to UNKNOWN to suppress further warnings. */ + const svalue *new_ap_sval + = m_mgr->get_or_create_unknown_svalue (impl_reg->get_type ()); + set_value (impl_reg, new_ap_sval, ctxt); + } + else + { + /* Update impl_reg to advance to the next arg. */ + const region *next_var_arg_region + = m_mgr->get_var_arg_region (frame_reg, next_arg_idx + 1); + const svalue *new_ap_sval + = m_mgr->get_ptr_svalue (NULL_TREE, next_var_arg_region); + set_value (impl_reg, new_ap_sval, ctxt); + } + } + } +} + +/* Handle the on_call_post part of "__builtin_va_end". */ + +void +region_model::impl_call_va_end (const call_details &) +{ + /* No-op. */ +} + +} // namespace ana + +#endif /* #if ENABLE_ANALYZER */ diff --git a/gcc/attribs.cc b/gcc/attribs.cc index b219f87..fb89616 100644 --- a/gcc/attribs.cc +++ b/gcc/attribs.cc @@ -499,7 +499,7 @@ diag_attr_exclusions (tree last_decl, tree node, tree attrname, /* Iterate over the mutually exclusive attribute names and verify that the symbol doesn't contain it. */ - for (unsigned i = 0; i != sizeof attrs / sizeof *attrs; ++i) + for (unsigned i = 0; i != ARRAY_SIZE (attrs); ++i) { if (!attrs[i]) continue; @@ -872,6 +872,21 @@ decl_attributes (tree *node, tree attributes, int flags, tree ret = (spec->handler) (cur_and_last_decl, name, args, flags|cxx11_flag, &no_add_attrs); + /* Fix up typedefs clobbered by attribute handlers. */ + if (TREE_CODE (*node) == TYPE_DECL + && anode == &TREE_TYPE (*node) + && DECL_ORIGINAL_TYPE (*node) + && TYPE_NAME (*anode) == *node + && TYPE_NAME (cur_and_last_decl[0]) != *node) + { + tree t = cur_and_last_decl[0]; + DECL_ORIGINAL_TYPE (*node) = t; + tree tt = build_variant_type_copy (t); + cur_and_last_decl[0] = tt; + TREE_TYPE (*node) = tt; + TYPE_NAME (tt) = *node; + } + *anode = cur_and_last_decl[0]; if (ret == error_mark_node) { @@ -2106,7 +2121,7 @@ decls_mismatched_attributes (tree tmpl, tree decl, tree attrlist, }; for (unsigned i = 0; i != 2; ++i) - for (unsigned j = 0; j != sizeof whitelist / sizeof *whitelist; ++j) + for (unsigned j = 0; j != ARRAY_SIZE (whitelist); ++j) if (lookup_attribute (whitelist[j], tmpl_attrs[i]) || lookup_attribute (whitelist[j], decl_attrs[i])) return 0; diff --git a/gcc/builtins.cc b/gcc/builtins.cc index 5fc89ad..b9d89b4 100644 --- a/gcc/builtins.cc +++ b/gcc/builtins.cc @@ -613,7 +613,7 @@ c_strlen (tree arg, int only_value, c_strlen_data *data, unsigned eltsize) if (eltsize != tree_to_uhwi (TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (src))))) return NULL_TREE; - /* Set MAXELTS to sizeof (SRC) / sizeof (*SRC) - 1, the maximum possible + /* Set MAXELTS to ARRAY_SIZE (SRC) - 1, the maximum possible length of SRC. Prefer TYPE_SIZE() to TREE_STRING_LENGTH() if possible in case the latter is less than the size of the array, such as when SRC refers to a short string literal used to initialize a large array. diff --git a/gcc/c-family/ChangeLog b/gcc/c-family/ChangeLog index 0d2b277..2f69aeb 100644 --- a/gcc/c-family/ChangeLog +++ b/gcc/c-family/ChangeLog @@ -1,3 +1,44 @@ +2022-05-18 Marek Polacek <polacek@redhat.com> + + PR c/105131 + * c.opt (Wenum-int-mismatch): New. + +2022-05-18 Marek Polacek <polacek@redhat.com> + + PR c++/105497 + * c-warn.cc (c_do_switch_warnings): Don't warn about unhandled + enumerator when it was marked with attribute unused. + +2022-05-18 Eric Botcazou <ebotcazou@adacore.com> + + * c-ada-spec.cc (dump_ada_node) <COMPLEX_TYPE>: Deal with usual + floating-point complex types. + <POINTER_TYPE>: Do not use limited_with clause if the designated + type is a scalar type. + +2022-05-17 Jakub Jelinek <jakub@redhat.com> + + * c-omp.cc (c_finish_omp_depobj): Handle + OMP_CLAUSE_DEPEND_INOUTSET. + +2022-05-16 Jason Merrill <jason@redhat.com> + + PR c/105492 + * c-attribs.cc (handle_mode_attribute): Don't fix broken typedefs + here. + +2022-05-16 Martin Liska <mliska@suse.cz> + + * c-common.cc (ARRAY_SIZE): Use ARRAY_SIZE. + (c_common_nodes_and_builtins): Likewise. + * c-format.cc (check_tokens): Likewise. + (check_plain): Likewise. + * c-pragma.cc (c_pp_lookup_pragma): Likewise. + (init_pragma): Likewise. + * known-headers.cc (get_string_macro_hint): Likewise. + (get_stdlib_header_for_name): Likewise. + * c-attribs.cc: Likewise. + 2022-05-13 Richard Biener <rguenther@suse.de> * c-omp.cc: Remove gimple-fold.h include. diff --git a/gcc/c-family/c-ada-spec.cc b/gcc/c-family/c-ada-spec.cc index f291e15..faf7174 100644 --- a/gcc/c-family/c-ada-spec.cc +++ b/gcc/c-family/c-ada-spec.cc @@ -2105,6 +2105,21 @@ dump_ada_node (pretty_printer *buffer, tree node, tree type, int spc, append_withs ("Interfaces.C.Extensions", false); pp_string (buffer, "Extensions.CFloat_128"); } + else if (TREE_TYPE (node) == float_type_node) + { + append_withs ("Ada.Numerics.Complex_Types", false); + pp_string (buffer, "Ada.Numerics.Complex_Types.Complex"); + } + else if (TREE_TYPE (node) == double_type_node) + { + append_withs ("Ada.Numerics.Long_Complex_Types", false); + pp_string (buffer, "Ada.Numerics.Long_Complex_Types.Complex"); + } + else if (TREE_TYPE (node) == long_double_type_node) + { + append_withs ("Ada.Numerics.Long_Long_Complex_Types", false); + pp_string (buffer, "Ada.Numerics.Long_Long_Complex_Types.Complex"); + } else pp_string (buffer, "<complex>"); break; @@ -2190,7 +2205,7 @@ dump_ada_node (pretty_printer *buffer, tree node, tree type, int spc, { tree ref_type = TREE_TYPE (node); const unsigned int quals = TYPE_QUALS (ref_type); - bool is_access = false; + bool is_access; if (VOID_TYPE_P (ref_type)) { @@ -2242,7 +2257,10 @@ dump_ada_node (pretty_printer *buffer, tree node, tree type, int spc, } if (!package_prefix) - pp_string (buffer, "access"); + { + is_access = false; + pp_string (buffer, "access"); + } else if (AGGREGATE_TYPE_P (ref_type)) { if (!type || TREE_CODE (type) != FUNCTION_DECL) @@ -2256,17 +2274,21 @@ dump_ada_node (pretty_printer *buffer, tree node, tree type, int spc, pp_string (buffer, "all "); } else if (quals & TYPE_QUAL_CONST) - pp_string (buffer, "in "); + { + is_access = false; + pp_string (buffer, "in "); + } else { is_access = true; pp_string (buffer, "access "); - /* ??? should be configurable: access or in out. */ } } else { - is_access = true; + /* We want to use regular with clauses for scalar types, + as they are not involved in circular declarations. */ + is_access = false; pp_string (buffer, "access "); if (!name_only) diff --git a/gcc/c-family/c-attribs.cc b/gcc/c-family/c-attribs.cc index 0f047a1..4dc68db 100644 --- a/gcc/c-family/c-attribs.cc +++ b/gcc/c-family/c-attribs.cc @@ -2215,16 +2215,6 @@ handle_mode_attribute (tree *node, tree name, tree args, TYPE_QUALS (type)); if (TYPE_USER_ALIGN (type)) *node = build_aligned_type (*node, TYPE_ALIGN (type)); - - tree decl = node[2]; - if (decl && TYPE_NAME (type) == decl) - { - /* Set up the typedef all over again. */ - DECL_ORIGINAL_TYPE (decl) = NULL_TREE; - TREE_TYPE (decl) = *node; - set_underlying_type (decl); - *node = TREE_TYPE (decl); - } } return NULL_TREE; @@ -4952,8 +4942,7 @@ handle_access_attribute (tree node[3], tree name, tree args, int flags, int imode; { - const int nmodes = - sizeof attr_access::mode_names / sizeof *attr_access::mode_names; + const int nmodes = ARRAY_SIZE (attr_access::mode_names); for (imode = 0; imode != nmodes; ++imode) if (!strncmp (ps, attr_access::mode_names[imode], diff --git a/gcc/c-family/c-common.cc b/gcc/c-family/c-common.cc index 6156e5f..c9c9e72 100644 --- a/gcc/c-family/c-common.cc +++ b/gcc/c-family/c-common.cc @@ -602,8 +602,7 @@ const struct c_common_resword c_common_reswords[] = { "null_resettable", RID_NULL_RESETTABLE, D_OBJC }, }; -const unsigned int num_c_common_reswords = - sizeof c_common_reswords / sizeof (struct c_common_resword); +const unsigned int num_c_common_reswords = ARRAY_SIZE (c_common_reswords); /* Return identifier for address space AS. */ @@ -4482,9 +4481,7 @@ c_common_nodes_and_builtins (void) /* Make fileptr_type_node a distinct void * type until FILE type is defined. Likewise for const struct tm*. */ - for (unsigned i = 0; - i < sizeof (builtin_structptr_types) / sizeof (builtin_structptr_type); - ++i) + for (unsigned i = 0; i < ARRAY_SIZE (builtin_structptr_types); ++i) builtin_structptr_types[i].node = build_variant_type_copy (builtin_structptr_types[i].base); diff --git a/gcc/c-family/c-format.cc b/gcc/c-family/c-format.cc index ea57fde8..25b1c1d 100644 --- a/gcc/c-family/c-format.cc +++ b/gcc/c-family/c-format.cc @@ -3189,7 +3189,7 @@ check_tokens (const token_t *tokens, unsigned ntoks, else { /* Diagnose some common misspellings. */ - for (unsigned i = 0; i != sizeof badwords / sizeof *badwords; ++i) + for (unsigned i = 0; i != ARRAY_SIZE (badwords); ++i) { unsigned badwlen = strspn (badwords[i].name, " -"); if (wlen >= badwlen @@ -3384,14 +3384,14 @@ check_plain (location_t format_string_loc, tree format_string_cst, if (ISPUNCT (format_chars[0])) { - size_t nelts = sizeof c_opers / sizeof *c_opers; + size_t nelts = ARRAY_SIZE (c_opers); if (const char *ret = check_tokens (c_opers, nelts, format_string_loc, format_string_cst, orig_format_chars, format_chars, baltoks)) return ret; - nelts = c_dialect_cxx () ? sizeof cxx_opers / sizeof *cxx_opers : 0; + nelts = c_dialect_cxx () ? ARRAY_SIZE (cxx_opers) : 0; if (const char *ret = check_tokens (cxx_opers, nelts, format_string_loc, format_string_cst, orig_format_chars, format_chars, @@ -3401,14 +3401,14 @@ check_plain (location_t format_string_loc, tree format_string_cst, if (ISALPHA (format_chars[0])) { - size_t nelts = sizeof c_keywords / sizeof *c_keywords; + size_t nelts = ARRAY_SIZE (c_keywords); if (const char *ret = check_tokens (c_keywords, nelts, format_string_loc, format_string_cst, orig_format_chars, format_chars, baltoks)) return ret; - nelts = c_dialect_cxx () ? sizeof cxx_keywords / sizeof *cxx_keywords : 0; + nelts = c_dialect_cxx () ? ARRAY_SIZE (cxx_keywords) : 0; if (const char *ret = check_tokens (cxx_keywords, nelts, format_string_loc, format_string_cst, orig_format_chars, format_chars, @@ -3527,7 +3527,7 @@ check_plain (location_t format_string_loc, tree format_string_cst, && ISALPHA (format_chars[1])) { /* Diagnose a subset of contractions that are best avoided. */ - for (unsigned i = 0; i != sizeof contrs / sizeof *contrs; ++i) + for (unsigned i = 0; i != ARRAY_SIZE (contrs); ++i) { const char *apos = strchr (contrs[i].name, '\''); gcc_assert (apos != NULL); diff --git a/gcc/c-family/c-omp.cc b/gcc/c-family/c-omp.cc index 01ef4ee..66d17a2 100644 --- a/gcc/c-family/c-omp.cc +++ b/gcc/c-family/c-omp.cc @@ -738,6 +738,7 @@ c_finish_omp_depobj (location_t loc, tree depobj, case OMP_CLAUSE_DEPEND_OUT: case OMP_CLAUSE_DEPEND_INOUT: case OMP_CLAUSE_DEPEND_MUTEXINOUTSET: + case OMP_CLAUSE_DEPEND_INOUTSET: kind = OMP_CLAUSE_DEPEND_KIND (clause); t = OMP_CLAUSE_DECL (clause); gcc_assert (t); @@ -796,6 +797,9 @@ c_finish_omp_depobj (location_t loc, tree depobj, case OMP_CLAUSE_DEPEND_MUTEXINOUTSET: k = GOMP_DEPEND_MUTEXINOUTSET; break; + case OMP_CLAUSE_DEPEND_INOUTSET: + k = GOMP_DEPEND_INOUTSET; + break; case OMP_CLAUSE_DEPEND_LAST: k = -1; break; diff --git a/gcc/c-family/c-pragma.cc b/gcc/c-family/c-pragma.cc index 4c80bdd..cc05b25 100644 --- a/gcc/c-family/c-pragma.cc +++ b/gcc/c-family/c-pragma.cc @@ -1400,8 +1400,8 @@ static const struct omp_pragma_def omp_pragmas_simd[] = { void c_pp_lookup_pragma (unsigned int id, const char **space, const char **name) { - const int n_oacc_pragmas = sizeof (oacc_pragmas) / sizeof (*oacc_pragmas); - const int n_omp_pragmas = sizeof (omp_pragmas) / sizeof (*omp_pragmas); + const int n_oacc_pragmas = ARRAY_SIZE (oacc_pragmas); + const int n_omp_pragmas = ARRAY_SIZE (omp_pragmas); const int n_omp_pragmas_simd = sizeof (omp_pragmas_simd) / sizeof (*omp_pragmas); int i; @@ -1576,8 +1576,7 @@ init_pragma (void) { if (flag_openacc) { - const int n_oacc_pragmas - = sizeof (oacc_pragmas) / sizeof (*oacc_pragmas); + const int n_oacc_pragmas = ARRAY_SIZE (oacc_pragmas); int i; for (i = 0; i < n_oacc_pragmas; ++i) @@ -1587,7 +1586,7 @@ init_pragma (void) if (flag_openmp) { - const int n_omp_pragmas = sizeof (omp_pragmas) / sizeof (*omp_pragmas); + const int n_omp_pragmas = ARRAY_SIZE (omp_pragmas); int i; for (i = 0; i < n_omp_pragmas; ++i) diff --git a/gcc/c-family/c-warn.cc b/gcc/c-family/c-warn.cc index cae8929..ea7335f 100644 --- a/gcc/c-family/c-warn.cc +++ b/gcc/c-family/c-warn.cc @@ -1738,8 +1738,8 @@ c_do_switch_warnings (splay_tree cases, location_t switch_location, for (chain = TYPE_VALUES (type); chain; chain = TREE_CHAIN (chain)) { tree value = TREE_VALUE (chain); - if (TREE_CODE (value) == CONST_DECL) - value = DECL_INITIAL (value); + tree attrs = DECL_ATTRIBUTES (value); + value = DECL_INITIAL (value); node = splay_tree_lookup (cases, (splay_tree_key) value); if (node) { @@ -1769,6 +1769,13 @@ c_do_switch_warnings (splay_tree cases, location_t switch_location, /* We've now determined that this enumerated literal isn't handled by the case labels of the switch statement. */ + /* Don't warn if the enumerator was marked as unused. We can't use + TREE_USED here: it could have been set on the enumerator if the + enumerator was used earlier. */ + if (lookup_attribute ("unused", attrs) + || lookup_attribute ("maybe_unused", attrs)) + continue; + /* If the switch expression is a constant, we only really care about whether that constant is handled by the switch. */ if (cond && tree_int_cst_compare (cond, value)) diff --git a/gcc/c-family/c.opt b/gcc/c-family/c.opt index 035b1de..41a20bc6 100644 --- a/gcc/c-family/c.opt +++ b/gcc/c-family/c.opt @@ -638,6 +638,10 @@ Wenum-conversion C ObjC C++ ObjC++ Var(warn_enum_conversion) Init(0) Warning LangEnabledBy(C ObjC,Wextra) Warn about implicit conversion of enum types. +Wenum-int-mismatch +C ObjC Var(warn_enum_int_mismatch) Warning LangEnabledBy(C ObjC,Wall || Wc++-compat) +Warn about enum/integer type mismatches. + Werror C ObjC C++ ObjC++ ; Documented in common.opt diff --git a/gcc/c-family/known-headers.cc b/gcc/c-family/known-headers.cc index 8ad3eb3f..01c86b2 100644 --- a/gcc/c-family/known-headers.cc +++ b/gcc/c-family/known-headers.cc @@ -79,8 +79,7 @@ get_string_macro_hint (const char *name, enum stdlib lib) if ((lib == STDLIB_C && flag_isoc99) || (lib == STDLIB_CPLUSPLUS && cxx_dialect >= cxx11 )) { - const size_t num_c99_cxx11_macros - = sizeof (c99_cxx11_macros) / sizeof (c99_cxx11_macros[0]); + const size_t num_c99_cxx11_macros = ARRAY_SIZE (c99_cxx11_macros); for (size_t i = 0; i < num_c99_cxx11_macros; i++) if (strcmp (name, c99_cxx11_macros[i]) == 0) return lib == STDLIB_C ? "<inttypes.h>" : "<cinttypes>"; @@ -204,7 +203,7 @@ get_stdlib_header_for_name (const char *name, enum stdlib lib) {"WCHAR_MAX", {"<wchar.h>", "<cwchar>"} }, {"WCHAR_MIN", {"<wchar.h>", "<cwchar>"} } }; - const size_t num_hints = sizeof (hints) / sizeof (hints[0]); + const size_t num_hints = ARRAY_SIZE (hints); for (size_t i = 0; i < num_hints; i++) if (strcmp (name, hints[i].name) == 0) return hints[i].header[lib]; diff --git a/gcc/c/ChangeLog b/gcc/c/ChangeLog index 6db1152d..00e236c 100644 --- a/gcc/c/ChangeLog +++ b/gcc/c/ChangeLog @@ -1,3 +1,26 @@ +2022-05-18 Marek Polacek <polacek@redhat.com> + + PR c/105131 + * c-decl.cc (diagnose_mismatched_decls): Warn about enum/integer type + mismatches. + * c-tree.h (comptypes_check_enum_int): Declare. + * c-typeck.cc (comptypes): No longer static. + +2022-05-17 Marek Polacek <polacek@redhat.com> + + * c-decl.cc (finish_enum): Store the CONST_DECL into TREE_VALUE, not + its value. + +2022-05-17 Jakub Jelinek <jakub@redhat.com> + + * c-parser.cc (c_parser_omp_clause_depend): Parse + inoutset depend-kind. + (c_parser_omp_depobj): Likewise. + +2022-05-16 Martin Liska <mliska@suse.cz> + + * c-decl.cc (match_builtin_function_types): Use ARRAY_SIZE. + 2022-05-12 Jakub Jelinek <jakub@redhat.com> * c-parser.cc (c_parse_init): Register omp_all_memory as keyword diff --git a/gcc/c/c-decl.cc b/gcc/c/c-decl.cc index c701f07..5266a61 100644 --- a/gcc/c/c-decl.cc +++ b/gcc/c/c-decl.cc @@ -1658,7 +1658,7 @@ c_bind (location_t loc, tree decl, bool is_global) Used only by match_builtin_function_types. */ static const unsigned builtin_structptr_type_count - = sizeof builtin_structptr_types / sizeof builtin_structptr_types[0]; + = ARRAY_SIZE (builtin_structptr_types); static GTY(()) tree last_structptr_types[builtin_structptr_type_count]; @@ -1705,10 +1705,8 @@ match_builtin_function_types (tree newtype, tree oldtype, tree newargs = TYPE_ARG_TYPES (newtype); tree tryargs = newargs; - const unsigned nlst - = sizeof last_structptr_types / sizeof last_structptr_types[0]; - const unsigned nbst - = sizeof builtin_structptr_types / sizeof builtin_structptr_types[0]; + const unsigned nlst = ARRAY_SIZE (last_structptr_types); + const unsigned nbst = ARRAY_SIZE (builtin_structptr_types); gcc_checking_assert (nlst == nbst); @@ -1995,9 +1993,12 @@ diagnose_mismatched_decls (tree newdecl, tree olddecl, bool pedwarned = false; bool warned = false; + bool enum_and_int_p = false; auto_diagnostic_group d; - if (!comptypes (oldtype, newtype)) + int comptypes_result = comptypes_check_enum_int (oldtype, newtype, + &enum_and_int_p); + if (!comptypes_result) { if (TREE_CODE (olddecl) == FUNCTION_DECL && fndecl_built_in_p (olddecl, BUILT_IN_NORMAL) @@ -2139,6 +2140,13 @@ diagnose_mismatched_decls (tree newdecl, tree olddecl, return false; } } + /* Warn about enum/integer type mismatches. They are compatible types + (C2X 6.7.2.2/5), but may pose portability problems. */ + else if (enum_and_int_p && TREE_CODE (newdecl) != TYPE_DECL) + warned = warning_at (DECL_SOURCE_LOCATION (newdecl), + OPT_Wenum_int_mismatch, + "conflicting types for %q+D due to enum/integer " + "mismatch; have %qT", newdecl, newtype); /* Redeclaration of a type is a constraint violation (6.7.2.3p1), but silently ignore the redeclaration if either is in a system @@ -2148,7 +2156,6 @@ diagnose_mismatched_decls (tree newdecl, tree olddecl, if (TREE_CODE (newdecl) == TYPE_DECL) { bool types_different = false; - int comptypes_result; comptypes_result = comptypes_check_different_types (oldtype, newtype, &types_different); @@ -9255,7 +9262,9 @@ finish_enum (tree enumtype, tree values, tree attributes) DECL_INITIAL (enu) = ini; TREE_PURPOSE (pair) = DECL_NAME (enu); - TREE_VALUE (pair) = ini; + /* To match the C++ FE, store the CONST_DECL rather than just its + value. */ + TREE_VALUE (pair) = enu; } TYPE_VALUES (enumtype) = values; diff --git a/gcc/c/c-parser.cc b/gcc/c/c-parser.cc index 51a0725..8df8f60 100644 --- a/gcc/c/c-parser.cc +++ b/gcc/c/c-parser.cc @@ -16067,7 +16067,7 @@ c_parser_omp_clause_affinity (c_parser *parser, tree list) depend ( depend-modifier , depend-kind: variable-list ) depend-kind: - in | out | inout | mutexinoutset | depobj + in | out | inout | mutexinoutset | depobj | inoutset depend-modifier: iterator ( iterators-definition ) */ @@ -16099,6 +16099,8 @@ c_parser_omp_clause_depend (c_parser *parser, tree list) kind = OMP_CLAUSE_DEPEND_IN; else if (strcmp ("inout", p) == 0) kind = OMP_CLAUSE_DEPEND_INOUT; + else if (strcmp ("inoutset", p) == 0) + kind = OMP_CLAUSE_DEPEND_INOUTSET; else if (strcmp ("mutexinoutset", p) == 0) kind = OMP_CLAUSE_DEPEND_MUTEXINOUTSET; else if (strcmp ("out", p) == 0) @@ -19063,12 +19065,14 @@ c_parser_omp_depobj (c_parser *parser) kind = OMP_CLAUSE_DEPEND_INOUT; else if (!strcmp ("mutexinoutset", p2)) kind = OMP_CLAUSE_DEPEND_MUTEXINOUTSET; + else if (!strcmp ("inoutset", p2)) + kind = OMP_CLAUSE_DEPEND_INOUTSET; } if (kind == OMP_CLAUSE_DEPEND_SOURCE) { clause = error_mark_node; - error_at (c2_loc, "expected %<in%>, %<out%>, %<inout%> or " - "%<mutexinoutset%>"); + error_at (c2_loc, "expected %<in%>, %<out%>, %<inout%>, " + "%<mutexinoutset%> or %<inoutset%>"); } c_parens.skip_until_found_close (parser); } diff --git a/gcc/c/c-tree.h b/gcc/c/c-tree.h index c70f0ba..2bcb966 100644 --- a/gcc/c/c-tree.h +++ b/gcc/c/c-tree.h @@ -685,6 +685,7 @@ extern tree require_complete_type (location_t, tree); extern bool same_translation_unit_p (const_tree, const_tree); extern int comptypes (tree, tree); extern int comptypes_check_different_types (tree, tree, bool *); +extern int comptypes_check_enum_int (tree, tree, bool *); extern bool c_vla_type_p (const_tree); extern bool c_mark_addressable (tree, bool = false); extern void c_incomplete_type_error (location_t, const_tree, const_tree); diff --git a/gcc/c/c-typeck.cc b/gcc/c/c-typeck.cc index bcfe08b..4f3611f 100644 --- a/gcc/c/c-typeck.cc +++ b/gcc/c/c-typeck.cc @@ -1055,7 +1055,7 @@ comptypes (tree type1, tree type2) /* Like comptypes, but if it returns non-zero because enum and int are compatible, it sets *ENUM_AND_INT_P to true. */ -static int +int comptypes_check_enum_int (tree type1, tree type2, bool *enum_and_int_p) { const struct tagged_tu_seen_cache * tagged_tu_seen_base1 = tagged_tu_seen_base; @@ -787,7 +787,7 @@ dump_bb_info (FILE *outf, basic_block bb, int indent, dump_flags_t flags, NULL #undef DEF_BASIC_BLOCK_FLAG }; - const unsigned n_bitnames = sizeof (bb_bitnames) / sizeof (char *); + const unsigned n_bitnames = ARRAY_SIZE (bb_bitnames); bool first; char *s_indent = (char *) alloca ((size_t) indent + 1); memset ((void *) s_indent, ' ', (size_t) indent); diff --git a/gcc/cfgexpand.cc b/gcc/cfgexpand.cc index 49b9182..bb33c1b 100644 --- a/gcc/cfgexpand.cc +++ b/gcc/cfgexpand.cc @@ -4575,6 +4575,10 @@ expand_debug_expr (tree exp) || SYMBOL_REF_DECL (XEXP (op0, 0)) != exp) return NULL; } + else if (VAR_P (exp) + && is_global_var (exp) + && symtab_node::get (exp) == NULL) + return NULL; else op0 = copy_rtx (op0); diff --git a/gcc/cfgloopmanip.cc b/gcc/cfgloopmanip.cc index b4357c0..7736e3e 100644 --- a/gcc/cfgloopmanip.cc +++ b/gcc/cfgloopmanip.cc @@ -1351,7 +1351,6 @@ duplicate_loop_body_to_header_edge (class loop *loop, edge e, unsigned j; bb = bbs[i]; - bb->aux = 0; auto_vec<basic_block> dom_bbs = get_dominated_by (CDI_DOMINATORS, bb); FOR_EACH_VEC_ELT (dom_bbs, j, dominated) diff --git a/gcc/common/config/aarch64/aarch64-common.cc b/gcc/common/config/aarch64/aarch64-common.cc index dfda5b8..7fac90d 100644 --- a/gcc/common/config/aarch64/aarch64-common.cc +++ b/gcc/common/config/aarch64/aarch64-common.cc @@ -314,8 +314,7 @@ aarch64_option_init_struct (struct gcc_options *opts ATTRIBUTE_UNUSED) pop and attribute change (arm_neon headers, lto etc all cause this to happen quite frequently). It is a trade-off between time and space and so time won. */ - int n_extensions - = sizeof (all_extensions) / sizeof (struct aarch64_option_extension); + int n_extensions = ARRAY_SIZE (all_extensions); qsort (&all_extensions_by_on, n_extensions, sizeof (struct aarch64_option_extension), opt_ext_cmp); } diff --git a/gcc/config/aarch64/aarch64-builtins.cc b/gcc/config/aarch64/aarch64-builtins.cc index c21476d..e0a741a 100644 --- a/gcc/config/aarch64/aarch64-builtins.cc +++ b/gcc/config/aarch64/aarch64-builtins.cc @@ -832,7 +832,7 @@ aarch64_lookup_simd_builtin_type (machine_mode mode, enum aarch64_type_qualifiers q) { int i; - int nelts = sizeof (aarch64_simd_types) / sizeof (aarch64_simd_types[0]); + int nelts = ARRAY_SIZE (aarch64_simd_types); /* Non-poly scalar modes map to standard types not in the table. */ if (q != qualifier_poly && !VECTOR_MODE_P (mode)) @@ -869,7 +869,7 @@ static void aarch64_init_simd_builtin_types (void) { int i; - int nelts = sizeof (aarch64_simd_types) / sizeof (aarch64_simd_types[0]); + int nelts = ARRAY_SIZE (aarch64_simd_types); tree tdecl; /* Init all the element types built by the front-end. */ @@ -1434,7 +1434,7 @@ aarch64_init_builtin_rsqrt (void) }; builtin_decls_data *bdd = bdda; - builtin_decls_data *bdd_end = bdd + (sizeof (bdda) / sizeof (builtin_decls_data)); + builtin_decls_data *bdd_end = bdd + (ARRAY_SIZE (bdda)); for (; bdd < bdd_end; bdd++) { diff --git a/gcc/config/aarch64/aarch64.cc b/gcc/config/aarch64/aarch64.cc index f4d2a80..2902f94 100644 --- a/gcc/config/aarch64/aarch64.cc +++ b/gcc/config/aarch64/aarch64.cc @@ -20755,7 +20755,7 @@ is_madd_op (enum attr_type t1) TYPE_SMMLA, TYPE_UMLAL, TYPE_UMLALS,TYPE_SMLSD, TYPE_SMLSDX, TYPE_SMLSLD }; - for (i = 0; i < sizeof (mlatypes) / sizeof (enum attr_type); i++) + for (i = 0; i < ARRAY_SIZE (mlatypes); i++) { if (t1 == mlatypes[i]) return true; diff --git a/gcc/config/arm/arm-builtins.cc b/gcc/config/arm/arm-builtins.cc index 36a40a1..d917137 100644 --- a/gcc/config/arm/arm-builtins.cc +++ b/gcc/config/arm/arm-builtins.cc @@ -1471,7 +1471,7 @@ arm_lookup_simd_builtin_type (machine_mode mode, enum arm_type_qualifiers q) { int i; - int nelts = sizeof (arm_simd_types) / sizeof (arm_simd_types[0]); + int nelts = ARRAY_SIZE (arm_simd_types); /* Non-poly scalar modes map to standard types not in the table. */ if (q != qualifier_poly && !VECTOR_MODE_P (mode)) @@ -1503,7 +1503,7 @@ static void arm_init_simd_builtin_types (void) { int i; - int nelts = sizeof (arm_simd_types) / sizeof (arm_simd_types[0]); + int nelts = ARRAY_SIZE (arm_simd_types); tree tdecl; /* Poly types are a world of their own. In order to maintain legacy diff --git a/gcc/config/avr/gen-avr-mmcu-texi.cc b/gcc/config/avr/gen-avr-mmcu-texi.cc index d9c3a30..a44e18e 100644 --- a/gcc/config/avr/gen-avr-mmcu-texi.cc +++ b/gcc/config/avr/gen-avr-mmcu-texi.cc @@ -23,10 +23,12 @@ #define IN_GEN_AVR_MMCU_TEXI +#define ARRAY_SIZE(a) (sizeof (a) / sizeof ((a)[0])) + #include "avr-devices.cc" static const avr_mcu_t* -mcus[sizeof avr_mcu_types / sizeof avr_mcu_types[0]]; +mcus[ARRAY_SIZE (avr_mcu_types)]; static int letter (char c) { @@ -56,7 +58,7 @@ c_prefix (const char *str) "attiny", "atmega", "atxmega", "ata", "at90" }; - int i, n = (int) (sizeof (prefixes) / sizeof (*prefixes)); + int i, n = (int) (ARRAY_SIZE (prefixes)); for (i = 0; i < n; i++) if (str_prefix_p (str, prefixes[i])) @@ -185,7 +187,7 @@ int main (void) print_mcus (n_mcus); n_mcus = 0; - for (i = 0; i < sizeof (avr_texinfo) / sizeof (*avr_texinfo); i++) + for (i = 0; i < ARRAY_SIZE (avr_texinfo); i++) if (arch_id == avr_texinfo[i].arch_id) printf ("@item %s\n%s\n", mcu->name, avr_texinfo[i].texinfo); } diff --git a/gcc/config/c6x/c6x.cc b/gcc/config/c6x/c6x.cc index 7fe18d6..dc01a6e 100644 --- a/gcc/config/c6x/c6x.cc +++ b/gcc/config/c6x/c6x.cc @@ -2580,7 +2580,7 @@ static unsigned reg_save_order[] = REG_B14, REG_A15 }; -#define N_SAVE_ORDER (sizeof reg_save_order / sizeof *reg_save_order) +#define N_SAVE_ORDER (ARRAY_SIZE (reg_save_order)) /* Compute the layout of the stack frame and store it in FRAME. */ diff --git a/gcc/config/darwin-c.cc b/gcc/config/darwin-c.cc index 3770857..9203c84 100644 --- a/gcc/config/darwin-c.cc +++ b/gcc/config/darwin-c.cc @@ -505,7 +505,7 @@ darwin_register_frameworks (const char *sysroot, size_t i; /* Setup default search path for frameworks. */ - for (i=0; i<sizeof (framework_defaults)/sizeof(const char *); ++i) + for (i = 0; i < ARRAY_SIZE (framework_defaults); ++i) { char *str; if (sysroot) diff --git a/gcc/config/gcn/gcn.cc b/gcc/config/gcn/gcn.cc index e2e9335..76b27c4 100644 --- a/gcc/config/gcn/gcn.cc +++ b/gcc/config/gcn/gcn.cc @@ -2632,7 +2632,7 @@ gcn_omp_device_kind_arch_isa (enum omp_device_kind_arch_isa trait, case omp_device_kind: return strcmp (name, "gpu") == 0; case omp_device_arch: - return strcmp (name, "gcn") == 0; + return strcmp (name, "amdgcn") == 0 || strcmp (name, "gcn") == 0; case omp_device_isa: if (strcmp (name, "fiji") == 0) return gcn_arch == PROCESSOR_FIJI; diff --git a/gcc/config/gcn/t-omp-device b/gcc/config/gcn/t-omp-device index cd56e2f..e1d9e0d 100644 --- a/gcc/config/gcn/t-omp-device +++ b/gcc/config/gcn/t-omp-device @@ -1,4 +1,4 @@ omp-device-properties-gcn: $(srcdir)/config/gcn/gcn.cc echo kind: gpu > $@ - echo arch: gcn >> $@ + echo arch: amdgcn gcn >> $@ echo isa: fiji gfx900 gfx906 gfx908 >> $@ diff --git a/gcc/config/i386/gnu-user-common.h b/gcc/config/i386/gnu-user-common.h index 23b54c5..cab9be2 100644 --- a/gcc/config/i386/gnu-user-common.h +++ b/gcc/config/i386/gnu-user-common.h @@ -66,7 +66,8 @@ along with GCC; see the file COPYING3. If not see #define STACK_CHECK_STATIC_BUILTIN 1 /* We only build the -fsplit-stack support in libgcc if the - assembler has full support for the CFI directives. */ -#if HAVE_GAS_CFI_PERSONALITY_DIRECTIVE + assembler has full support for the CFI directives. Also + we only support -fsplit-stack on glibc targets. */ +#if (DEFAULT_LIBC == LIBC_GLIBC) && HAVE_GAS_CFI_PERSONALITY_DIRECTIVE #define TARGET_CAN_SPLIT_STACK #endif diff --git a/gcc/config/i386/gnu.h b/gcc/config/i386/gnu.h index 401e60c..fb8d69a 100644 --- a/gcc/config/i386/gnu.h +++ b/gcc/config/i386/gnu.h @@ -41,8 +41,9 @@ along with GCC. If not, see <http://www.gnu.org/licenses/>. #define TARGET_THREAD_SSP_OFFSET 0x14 /* We only build the -fsplit-stack support in libgcc if the - assembler has full support for the CFI directives. */ -#if HAVE_GAS_CFI_PERSONALITY_DIRECTIVE + assembler has full support for the CFI directives. Also + we only support -fsplit-stack on glibc targets. */ +#if (DEFAULT_LIBC == LIBC_GLIBC) && HAVE_GAS_CFI_PERSONALITY_DIRECTIVE #define TARGET_CAN_SPLIT_STACK #endif /* We steal the last transactional memory word. */ diff --git a/gcc/config/i386/i386-builtins.cc b/gcc/config/i386/i386-builtins.cc index 59c7da2..96743e6 100644 --- a/gcc/config/i386/i386-builtins.cc +++ b/gcc/config/i386/i386-builtins.cc @@ -1936,8 +1936,7 @@ get_builtin_code_for_version (tree decl, tree *predicate_list) enum feature_priority priority = P_NONE; - static unsigned int NUM_FEATURES - = sizeof (isa_names_table) / sizeof (_isa_names_table); + static unsigned int NUM_FEATURES = ARRAY_SIZE (isa_names_table); unsigned int i; @@ -2290,8 +2289,7 @@ fold_builtin_cpu (tree fndecl, tree *args) tree final; unsigned int field_val = 0; - unsigned int NUM_ISA_NAMES - = sizeof (isa_names_table) / sizeof (struct _isa_names_table); + unsigned int NUM_ISA_NAMES = ARRAY_SIZE (isa_names_table); for (i = 0; i < NUM_ISA_NAMES; i++) if (strcmp (isa_names_table[i].name, diff --git a/gcc/config/i386/i386-expand.cc b/gcc/config/i386/i386-expand.cc index 0fd3028c..1460bcc 100644 --- a/gcc/config/i386/i386-expand.cc +++ b/gcc/config/i386/i386-expand.cc @@ -2267,12 +2267,20 @@ ix86_expand_branch (enum rtx_code code, rtx op0, rtx op1, rtx label) /* Handle special case - vector comparsion with boolean result, transform it using ptest instruction. */ - if (GET_MODE_CLASS (mode) == MODE_VECTOR_INT) + if (GET_MODE_CLASS (mode) == MODE_VECTOR_INT + || mode == OImode) { rtx flag = gen_rtx_REG (CCZmode, FLAGS_REG); machine_mode p_mode = GET_MODE_SIZE (mode) == 32 ? V4DImode : V2DImode; gcc_assert (code == EQ || code == NE); + + if (mode == OImode) + { + op0 = lowpart_subreg (p_mode, force_reg (mode, op0), mode); + op1 = lowpart_subreg (p_mode, force_reg (mode, op1), mode); + mode = p_mode; + } /* Generate XOR since we can't check that one operand is zero vector. */ tmp = gen_reg_rtx (mode); emit_insn (gen_rtx_SET (tmp, gen_rtx_XOR (mode, op0, op1))); @@ -20963,7 +20971,8 @@ expand_vec_perm_pslldq_psrldq_por (struct expand_vec_perm_d *d, bool pandn) start1 = d->perm[0]; for (i = 1; i < nelt; i++) { - if (d->perm[i] != d->perm[i-1] + 1) + if (d->perm[i] != d->perm[i-1] + 1 + || d->perm[i] == nelt) { if (start2 == -1) { @@ -20973,12 +20982,6 @@ expand_vec_perm_pslldq_psrldq_por (struct expand_vec_perm_d *d, bool pandn) else return false; } - else if (d->perm[i] >= nelt - && start2 == -1) - { - start2 = d->perm[i]; - end1 = d->perm[i-1]; - } } clear_op0 = end1 != nelt - 1; diff --git a/gcc/config/i386/i386.cc b/gcc/config/i386/i386.cc index 86752a6..30a9cd0 100644 --- a/gcc/config/i386/i386.cc +++ b/gcc/config/i386/i386.cc @@ -20634,7 +20634,17 @@ ix86_rtx_costs (rtx x, machine_mode mode, int outer_code_i, int opno, op0 = XEXP (op0, 0), mode = GET_MODE (op0); } - *total = (cost->mult_init[MODE_INDEX (mode)] + int mult_init; + // Double word multiplication requires 3 mults and 2 adds. + if (GET_MODE_SIZE (mode) > UNITS_PER_WORD) + { + mult_init = 3 * cost->mult_init[MODE_INDEX (word_mode)] + + 2 * cost->add; + nbits *= 3; + } + else mult_init = cost->mult_init[MODE_INDEX (mode)]; + + *total = (mult_init + nbits * cost->mult_bit + rtx_cost (op0, mode, outer_code, opno, speed) + rtx_cost (op1, mode, outer_code, opno, speed)); diff --git a/gcc/config/i386/i386.md b/gcc/config/i386/i386.md index f9c06ff..792bae1 100644 --- a/gcc/config/i386/i386.md +++ b/gcc/config/i386/i386.md @@ -1338,6 +1338,22 @@ DONE; }) +(define_expand "cbranchoi4" + [(set (reg:CC FLAGS_REG) + (compare:CC (match_operand:OI 1 "nonimmediate_operand") + (match_operand:OI 2 "nonimmediate_operand"))) + (set (pc) (if_then_else + (match_operator 0 "bt_comparison_operator" + [(reg:CC FLAGS_REG) (const_int 0)]) + (label_ref (match_operand 3)) + (pc)))] + "TARGET_AVX" +{ + ix86_expand_branch (GET_CODE (operands[0]), + operands[1], operands[2], operands[3]); + DONE; +}) + (define_expand "cstore<mode>4" [(set (reg:CC FLAGS_REG) (compare:CC (match_operand:SWIM 2 "nonimmediate_operand") @@ -10401,6 +10417,40 @@ [(set_attr "type" "bitmanip") (set_attr "btver2_decode" "direct, double") (set_attr "mode" "<MODE>")]) + +;; Split *andnsi_1 after reload with -Oz when not;and is shorter. +(define_split + [(set (match_operand:SI 0 "register_operand") + (and:SI (not:SI (match_operand:SI 1 "register_operand")) + (match_operand:SI 2 "nonimmediate_operand"))) + (clobber (reg:CC FLAGS_REG))] + "reload_completed + && optimize_insn_for_size_p () && optimize_size > 1 + && REGNO (operands[0]) == REGNO (operands[1]) + && LEGACY_INT_REG_P (operands[0]) + && !REX_INT_REG_P (operands[2]) + && !reg_overlap_mentioned_p (operands[0], operands[2])" + [(set (match_dup 0) (not:SI (match_dup 1))) + (parallel [(set (match_dup 0) (and:SI (match_dup 0) (match_dup 2))) + (clobber (reg:CC FLAGS_REG))])]) + +;; Split *andn_si_ccno with -Oz when not;test is shorter. +(define_split + [(set (match_operand 0 "flags_reg_operand") + (match_operator 1 "compare_operator" + [(and:SI (not:SI (match_operand:SI 2 "general_reg_operand")) + (match_operand:SI 3 "nonimmediate_operand")) + (const_int 0)])) + (clobber (match_dup 2))] + "reload_completed + && optimize_insn_for_size_p () && optimize_size > 1 + && LEGACY_INT_REG_P (operands[2]) + && !REX_INT_REG_P (operands[3]) + && !reg_overlap_mentioned_p (operands[2], operands[3])" + [(set (match_dup 2) (not:SI (match_dup 2))) + (set (match_dup 0) (match_op_dup 1 + [(and:SI (match_dup 3) (match_dup 2)) + (const_int 0)]))]) ;; Logical inclusive and exclusive OR instructions @@ -16636,6 +16686,22 @@ (set_attr "prefix" "vex") (set_attr "mode" "<MODE>")]) +(define_insn "*bmi2_bzhi_zero_extendsidi_4" + [(set (match_operand:DI 0 "register_operand" "=r") + (zero_extend:DI + (and:SI + (plus:SI + (ashift:SI (const_int 1) + (match_operand:QI 2 "register_operand" "r")) + (const_int -1)) + (match_operand:SI 1 "nonimmediate_operand" "rm")))) + (clobber (reg:CC FLAGS_REG))] + "TARGET_64BIT && TARGET_BMI2" + "bzhi\t{%q2, %q1, %q0|%q0, %q1, %q2}" + [(set_attr "type" "bitmanip") + (set_attr "prefix" "vex") + (set_attr "mode" "DI")]) + (define_insn "bmi2_pdep_<mode>3" [(set (match_operand:SWI48 0 "register_operand" "=r") (unspec:SWI48 [(match_operand:SWI48 1 "register_operand" "r") diff --git a/gcc/config/i386/sse.md b/gcc/config/i386/sse.md index 88fc521..191371b 100644 --- a/gcc/config/i386/sse.md +++ b/gcc/config/i386/sse.md @@ -4407,7 +4407,10 @@ emit_insn (gen_sse2_pshufd (tmp1, ops[0], GEN_INT (0xb1))); rtx tmp2 = gen_reg_rtx (V4SImode); - emit_insn (gen_andv4si3 (tmp2, tmp1, ops[0])); + if (GET_CODE (operands[1]) == EQ) + emit_insn (gen_andv4si3 (tmp2, tmp1, ops[0])); + else + emit_insn (gen_iorv4si3 (tmp2, tmp1, ops[0])); emit_move_insn (operands[0], gen_lowpart (V2DImode, tmp2)); } @@ -4435,7 +4438,10 @@ emit_insn (gen_sse2_pshufd (tmp1, tmp2, GEN_INT (0x4e))); rtx tmp3 = gen_reg_rtx (V4SImode); - emit_insn (gen_andv4si3 (tmp3, tmp2, tmp1)); + if (GET_CODE (operands[1]) == EQ) + emit_insn (gen_andv4si3 (tmp3, tmp2, tmp1)); + else + emit_insn (gen_iorv4si3 (tmp3, tmp2, tmp1)); emit_move_insn (operands[0], gen_lowpart (V1TImode, tmp3)); DONE; @@ -19644,11 +19650,11 @@ (set_attr "type" "sselog,ssemov,sselog,ssemov,mmxcvt,mmxmov") (set_attr "mode" "TI,TI,V4SF,SF,DI,DI")]) -(define_insn "*vec_concatv4si" - [(set (match_operand:V4SI 0 "register_operand" "=x,v,x,x,v") - (vec_concat:V4SI - (match_operand:V2SI 1 "register_operand" " 0,v,0,0,v") - (match_operand:V2SI 2 "nonimmediate_operand" " x,v,x,m,m")))] +(define_insn "*vec_concat<mode>" + [(set (match_operand:VI124_128 0 "register_operand" "=x,v,x,x,v") + (vec_concat:VI124_128 + (match_operand:<ssehalfvecmode> 1 "register_operand" " 0,v,0,0,v") + (match_operand:<ssehalfvecmode> 2 "nonimmediate_operand" " x,v,x,m,m")))] "TARGET_SSE" "@ punpcklqdq\t{%2, %0|%0, %2} @@ -19661,6 +19667,60 @@ (set_attr "prefix" "orig,maybe_evex,orig,orig,maybe_evex") (set_attr "mode" "TI,TI,V4SF,V2SF,V2SF")]) +(define_insn_and_split "*vec_concatv16qi_permt2" + [(set (match_operand:V16QI 0 "register_operand") + (unspec:V16QI + [(const_vector:V16QI [(const_int 0) (const_int 1) + (const_int 2) (const_int 3) + (const_int 4) (const_int 5) + (const_int 6) (const_int 7) + (const_int 16) (const_int 17) + (const_int 18) (const_int 19) + (const_int 20) (const_int 21) + (const_int 22) (const_int 23)]) + (match_operand:V16QI 1 "register_operand") + (match_operand:V16QI 2 "nonimmediate_operand")] + UNSPEC_VPERMT2))] + "TARGET_AVX512VL && TARGET_AVX512VBMI + && ix86_pre_reload_split ()" + "#" + "&& 1" + [(set (match_dup 0) + (vec_concat:V16QI (match_dup 1) (match_dup 2)))] +{ + operands[1] = lowpart_subreg (V8QImode, + force_reg (V16QImode, operands[1]), + V16QImode); + if (!MEM_P (operands[2])) + operands[2] = force_reg (V16QImode, operands[2]); + operands[2] = lowpart_subreg (V8QImode, operands[2], V16QImode); +}) + +(define_insn_and_split "*vec_concatv8hi_permt2" + [(set (match_operand:V8HI 0 "register_operand") + (unspec:V8HI + [(const_vector:V8HI [(const_int 0) (const_int 1) + (const_int 2) (const_int 3) + (const_int 8) (const_int 9) + (const_int 10) (const_int 11)]) + (match_operand:V8HI 1 "register_operand") + (match_operand:V8HI 2 "nonimmediate_operand")] + UNSPEC_VPERMT2))] + "TARGET_AVX512VL && TARGET_AVX512BW + && ix86_pre_reload_split ()" + "#" + "&& 1" + [(set (match_dup 0) + (vec_concat:V8HI (match_dup 1) (match_dup 2)))] +{ + operands[1] = lowpart_subreg (V4HImode, + force_reg (V8HImode, operands[1]), + V8HImode); + if (!MEM_P (operands[2])) + operands[2] = force_reg (V8HImode, operands[2]); + operands[2] = lowpart_subreg (V4HImode, operands[2], V8HImode); +}) + (define_insn "*vec_concat<mode>_0" [(set (match_operand:VI124_128 0 "register_operand" "=v,x") (vec_concat:VI124_128 diff --git a/gcc/config/m32c/m32c.cc b/gcc/config/m32c/m32c.cc index 11ca9a4..5a19faa 100644 --- a/gcc/config/m32c/m32c.cc +++ b/gcc/config/m32c/m32c.cc @@ -1090,7 +1090,7 @@ static struct { FB_REGNO, 0x01, 2, 4 } }; -#define PUSHM_N (sizeof(pushm_info)/sizeof(pushm_info[0])) +#define PUSHM_N (ARRAY_SIZE (pushm_info)) /* Returns TRUE if we need to save/restore the given register. We save everything for exception handlers, so that any register can be diff --git a/gcc/config/rs6000/driver-rs6000.cc b/gcc/config/rs6000/driver-rs6000.cc index ec890e0..b871f0a 100644 --- a/gcc/config/rs6000/driver-rs6000.cc +++ b/gcc/config/rs6000/driver-rs6000.cc @@ -599,7 +599,7 @@ host_detect_local_cpu (int argc, const char **argv) if (assembler) { - for (i = 0; i < sizeof (asm_names) / sizeof (asm_names[0]); i++) + for (i = 0; i < ARRAY_SIZE (asm_names); i++) { if (!asm_names[i].cpu || !strcmp (asm_names[i].cpu, cpu)) return asm_names[i].asm_sw; diff --git a/gcc/config/rs6000/mma.md b/gcc/config/rs6000/mma.md index 907c9d6..a183b6a 100644 --- a/gcc/config/rs6000/mma.md +++ b/gcc/config/rs6000/mma.md @@ -490,50 +490,50 @@ [(set_attr "type" "mma")]) (define_insn "mma_<vv>" - [(set (match_operand:XO 0 "fpr_reg_operand" "=&d") - (unspec:XO [(match_operand:V16QI 1 "vsx_register_operand" "wa") - (match_operand:V16QI 2 "vsx_register_operand" "wa")] + [(set (match_operand:XO 0 "fpr_reg_operand" "=&d,&d") + (unspec:XO [(match_operand:V16QI 1 "vsx_register_operand" "v,?wa") + (match_operand:V16QI 2 "vsx_register_operand" "v,?wa")] MMA_VV))] "TARGET_MMA" "<vv> %A0,%x1,%x2" [(set_attr "type" "mma")]) (define_insn "mma_<avv>" - [(set (match_operand:XO 0 "fpr_reg_operand" "=&d") - (unspec:XO [(match_operand:XO 1 "fpr_reg_operand" "0") - (match_operand:V16QI 2 "vsx_register_operand" "wa") - (match_operand:V16QI 3 "vsx_register_operand" "wa")] + [(set (match_operand:XO 0 "fpr_reg_operand" "=&d,&d") + (unspec:XO [(match_operand:XO 1 "fpr_reg_operand" "0,0") + (match_operand:V16QI 2 "vsx_register_operand" "v,?wa") + (match_operand:V16QI 3 "vsx_register_operand" "v,?wa")] MMA_AVV))] "TARGET_MMA" "<avv> %A0,%x2,%x3" [(set_attr "type" "mma")]) (define_insn "mma_<pv>" - [(set (match_operand:XO 0 "fpr_reg_operand" "=&d") - (unspec:XO [(match_operand:OO 1 "vsx_register_operand" "wa") - (match_operand:V16QI 2 "vsx_register_operand" "wa")] + [(set (match_operand:XO 0 "fpr_reg_operand" "=&d,&d") + (unspec:XO [(match_operand:OO 1 "vsx_register_operand" "v,?wa") + (match_operand:V16QI 2 "vsx_register_operand" "v,?wa")] MMA_PV))] "TARGET_MMA" "<pv> %A0,%x1,%x2" [(set_attr "type" "mma")]) (define_insn "mma_<apv>" - [(set (match_operand:XO 0 "fpr_reg_operand" "=&d") - (unspec:XO [(match_operand:XO 1 "fpr_reg_operand" "0") - (match_operand:OO 2 "vsx_register_operand" "wa") - (match_operand:V16QI 3 "vsx_register_operand" "wa")] + [(set (match_operand:XO 0 "fpr_reg_operand" "=&d,&d") + (unspec:XO [(match_operand:XO 1 "fpr_reg_operand" "0,0") + (match_operand:OO 2 "vsx_register_operand" "v,?wa") + (match_operand:V16QI 3 "vsx_register_operand" "v,?wa")] MMA_APV))] "TARGET_MMA" "<apv> %A0,%x2,%x3" [(set_attr "type" "mma")]) (define_insn "mma_<vvi4i4i8>" - [(set (match_operand:XO 0 "fpr_reg_operand" "=&d") - (unspec:XO [(match_operand:V16QI 1 "vsx_register_operand" "wa") - (match_operand:V16QI 2 "vsx_register_operand" "wa") - (match_operand:SI 3 "const_0_to_15_operand" "n") - (match_operand:SI 4 "const_0_to_15_operand" "n") - (match_operand:SI 5 "u8bit_cint_operand" "n")] + [(set (match_operand:XO 0 "fpr_reg_operand" "=&d,&d") + (unspec:XO [(match_operand:V16QI 1 "vsx_register_operand" "v,?wa") + (match_operand:V16QI 2 "vsx_register_operand" "v,?wa") + (match_operand:SI 3 "const_0_to_15_operand" "n,n") + (match_operand:SI 4 "const_0_to_15_operand" "n,n") + (match_operand:SI 5 "u8bit_cint_operand" "n,n")] MMA_VVI4I4I8))] "TARGET_MMA" "<vvi4i4i8> %A0,%x1,%x2,%3,%4,%5" @@ -541,13 +541,13 @@ (set_attr "prefixed" "yes")]) (define_insn "mma_<avvi4i4i8>" - [(set (match_operand:XO 0 "fpr_reg_operand" "=&d") - (unspec:XO [(match_operand:XO 1 "fpr_reg_operand" "0") - (match_operand:V16QI 2 "vsx_register_operand" "wa") - (match_operand:V16QI 3 "vsx_register_operand" "wa") - (match_operand:SI 4 "const_0_to_15_operand" "n") - (match_operand:SI 5 "const_0_to_15_operand" "n") - (match_operand:SI 6 "u8bit_cint_operand" "n")] + [(set (match_operand:XO 0 "fpr_reg_operand" "=&d,&d") + (unspec:XO [(match_operand:XO 1 "fpr_reg_operand" "0,0") + (match_operand:V16QI 2 "vsx_register_operand" "v,?wa") + (match_operand:V16QI 3 "vsx_register_operand" "v,?wa") + (match_operand:SI 4 "const_0_to_15_operand" "n,n") + (match_operand:SI 5 "const_0_to_15_operand" "n,n") + (match_operand:SI 6 "u8bit_cint_operand" "n,n")] MMA_AVVI4I4I8))] "TARGET_MMA" "<avvi4i4i8> %A0,%x2,%x3,%4,%5,%6" @@ -555,12 +555,12 @@ (set_attr "prefixed" "yes")]) (define_insn "mma_<vvi4i4i2>" - [(set (match_operand:XO 0 "fpr_reg_operand" "=&d") - (unspec:XO [(match_operand:V16QI 1 "vsx_register_operand" "wa") - (match_operand:V16QI 2 "vsx_register_operand" "wa") - (match_operand:SI 3 "const_0_to_15_operand" "n") - (match_operand:SI 4 "const_0_to_15_operand" "n") - (match_operand:SI 5 "const_0_to_3_operand" "n")] + [(set (match_operand:XO 0 "fpr_reg_operand" "=&d,&d") + (unspec:XO [(match_operand:V16QI 1 "vsx_register_operand" "v,?wa") + (match_operand:V16QI 2 "vsx_register_operand" "v,?wa") + (match_operand:SI 3 "const_0_to_15_operand" "n,n") + (match_operand:SI 4 "const_0_to_15_operand" "n,n") + (match_operand:SI 5 "const_0_to_3_operand" "n,n")] MMA_VVI4I4I2))] "TARGET_MMA" "<vvi4i4i2> %A0,%x1,%x2,%3,%4,%5" @@ -568,13 +568,13 @@ (set_attr "prefixed" "yes")]) (define_insn "mma_<avvi4i4i2>" - [(set (match_operand:XO 0 "fpr_reg_operand" "=&d") - (unspec:XO [(match_operand:XO 1 "fpr_reg_operand" "0") - (match_operand:V16QI 2 "vsx_register_operand" "wa") - (match_operand:V16QI 3 "vsx_register_operand" "wa") - (match_operand:SI 4 "const_0_to_15_operand" "n") - (match_operand:SI 5 "const_0_to_15_operand" "n") - (match_operand:SI 6 "const_0_to_3_operand" "n")] + [(set (match_operand:XO 0 "fpr_reg_operand" "=&d,&d") + (unspec:XO [(match_operand:XO 1 "fpr_reg_operand" "0,0") + (match_operand:V16QI 2 "vsx_register_operand" "v,?wa") + (match_operand:V16QI 3 "vsx_register_operand" "v,?wa") + (match_operand:SI 4 "const_0_to_15_operand" "n,n") + (match_operand:SI 5 "const_0_to_15_operand" "n,n") + (match_operand:SI 6 "const_0_to_3_operand" "n,n")] MMA_AVVI4I4I2))] "TARGET_MMA" "<avvi4i4i2> %A0,%x2,%x3,%4,%5,%6" @@ -582,11 +582,11 @@ (set_attr "prefixed" "yes")]) (define_insn "mma_<vvi4i4>" - [(set (match_operand:XO 0 "fpr_reg_operand" "=&d") - (unspec:XO [(match_operand:V16QI 1 "vsx_register_operand" "wa") - (match_operand:V16QI 2 "vsx_register_operand" "wa") - (match_operand:SI 3 "const_0_to_15_operand" "n") - (match_operand:SI 4 "const_0_to_15_operand" "n")] + [(set (match_operand:XO 0 "fpr_reg_operand" "=&d,&d") + (unspec:XO [(match_operand:V16QI 1 "vsx_register_operand" "v,?wa") + (match_operand:V16QI 2 "vsx_register_operand" "v,?wa") + (match_operand:SI 3 "const_0_to_15_operand" "n,n") + (match_operand:SI 4 "const_0_to_15_operand" "n,n")] MMA_VVI4I4))] "TARGET_MMA" "<vvi4i4> %A0,%x1,%x2,%3,%4" @@ -594,12 +594,12 @@ (set_attr "prefixed" "yes")]) (define_insn "mma_<avvi4i4>" - [(set (match_operand:XO 0 "fpr_reg_operand" "=&d") - (unspec:XO [(match_operand:XO 1 "fpr_reg_operand" "0") - (match_operand:V16QI 2 "vsx_register_operand" "wa") - (match_operand:V16QI 3 "vsx_register_operand" "wa") - (match_operand:SI 4 "const_0_to_15_operand" "n") - (match_operand:SI 5 "const_0_to_15_operand" "n")] + [(set (match_operand:XO 0 "fpr_reg_operand" "=&d,&d") + (unspec:XO [(match_operand:XO 1 "fpr_reg_operand" "0,0") + (match_operand:V16QI 2 "vsx_register_operand" "v,?wa") + (match_operand:V16QI 3 "vsx_register_operand" "v,?wa") + (match_operand:SI 4 "const_0_to_15_operand" "n,n") + (match_operand:SI 5 "const_0_to_15_operand" "n,n")] MMA_AVVI4I4))] "TARGET_MMA" "<avvi4i4> %A0,%x2,%x3,%4,%5" @@ -607,11 +607,11 @@ (set_attr "prefixed" "yes")]) (define_insn "mma_<pvi4i2>" - [(set (match_operand:XO 0 "fpr_reg_operand" "=&d") - (unspec:XO [(match_operand:OO 1 "vsx_register_operand" "wa") - (match_operand:V16QI 2 "vsx_register_operand" "wa") - (match_operand:SI 3 "const_0_to_15_operand" "n") - (match_operand:SI 4 "const_0_to_3_operand" "n")] + [(set (match_operand:XO 0 "fpr_reg_operand" "=&d,&d") + (unspec:XO [(match_operand:OO 1 "vsx_register_operand" "v,?wa") + (match_operand:V16QI 2 "vsx_register_operand" "v,?wa") + (match_operand:SI 3 "const_0_to_15_operand" "n,n") + (match_operand:SI 4 "const_0_to_3_operand" "n,n")] MMA_PVI4I2))] "TARGET_MMA" "<pvi4i2> %A0,%x1,%x2,%3,%4" @@ -619,12 +619,12 @@ (set_attr "prefixed" "yes")]) (define_insn "mma_<apvi4i2>" - [(set (match_operand:XO 0 "fpr_reg_operand" "=&d") - (unspec:XO [(match_operand:XO 1 "fpr_reg_operand" "0") - (match_operand:OO 2 "vsx_register_operand" "wa") - (match_operand:V16QI 3 "vsx_register_operand" "wa") - (match_operand:SI 4 "const_0_to_15_operand" "n") - (match_operand:SI 5 "const_0_to_3_operand" "n")] + [(set (match_operand:XO 0 "fpr_reg_operand" "=&d,&d") + (unspec:XO [(match_operand:XO 1 "fpr_reg_operand" "0,0") + (match_operand:OO 2 "vsx_register_operand" "v,?wa") + (match_operand:V16QI 3 "vsx_register_operand" "v,?wa") + (match_operand:SI 4 "const_0_to_15_operand" "n,n") + (match_operand:SI 5 "const_0_to_3_operand" "n,n")] MMA_APVI4I2))] "TARGET_MMA" "<apvi4i2> %A0,%x2,%x3,%4,%5" @@ -632,12 +632,12 @@ (set_attr "prefixed" "yes")]) (define_insn "mma_<vvi4i4i4>" - [(set (match_operand:XO 0 "fpr_reg_operand" "=&d") - (unspec:XO [(match_operand:V16QI 1 "vsx_register_operand" "wa") - (match_operand:V16QI 2 "vsx_register_operand" "wa") - (match_operand:SI 3 "const_0_to_15_operand" "n") - (match_operand:SI 4 "const_0_to_15_operand" "n") - (match_operand:SI 5 "const_0_to_15_operand" "n")] + [(set (match_operand:XO 0 "fpr_reg_operand" "=&d,&d") + (unspec:XO [(match_operand:V16QI 1 "vsx_register_operand" "v,?wa") + (match_operand:V16QI 2 "vsx_register_operand" "v,?wa") + (match_operand:SI 3 "const_0_to_15_operand" "n,n") + (match_operand:SI 4 "const_0_to_15_operand" "n,n") + (match_operand:SI 5 "const_0_to_15_operand" "n,n")] MMA_VVI4I4I4))] "TARGET_MMA" "<vvi4i4i4> %A0,%x1,%x2,%3,%4,%5" @@ -645,13 +645,13 @@ (set_attr "prefixed" "yes")]) (define_insn "mma_<avvi4i4i4>" - [(set (match_operand:XO 0 "fpr_reg_operand" "=&d") - (unspec:XO [(match_operand:XO 1 "fpr_reg_operand" "0") - (match_operand:V16QI 2 "vsx_register_operand" "wa") - (match_operand:V16QI 3 "vsx_register_operand" "wa") - (match_operand:SI 4 "const_0_to_15_operand" "n") - (match_operand:SI 5 "const_0_to_15_operand" "n") - (match_operand:SI 6 "const_0_to_15_operand" "n")] + [(set (match_operand:XO 0 "fpr_reg_operand" "=&d,&d") + (unspec:XO [(match_operand:XO 1 "fpr_reg_operand" "0,0") + (match_operand:V16QI 2 "vsx_register_operand" "v,?wa") + (match_operand:V16QI 3 "vsx_register_operand" "v,?wa") + (match_operand:SI 4 "const_0_to_15_operand" "n,n") + (match_operand:SI 5 "const_0_to_15_operand" "n,n") + (match_operand:SI 6 "const_0_to_15_operand" "n,n")] MMA_AVVI4I4I4))] "TARGET_MMA" "<avvi4i4i4> %A0,%x2,%x3,%4,%5,%6" diff --git a/gcc/config/rs6000/rs6000-builtins.def b/gcc/config/rs6000/rs6000-builtins.def index f4a9f24..f76f547 100644 --- a/gcc/config/rs6000/rs6000-builtins.def +++ b/gcc/config/rs6000/rs6000-builtins.def @@ -1424,9 +1424,10 @@ pure vsc __builtin_vsx_ld_elemrev_v16qi (signed long, const void *); LD_ELEMREV_V16QI vsx_ld_elemrev_v16qi {ldvec,endian} -; TODO: There is apparent intent in rs6000-builtin.def to have -; RS6000_BTC_SPECIAL processing for LXSDX, LXVDSX, and STXSDX, but there are -; no def_builtin calls for any of them. At some point, we may want to add a +; TODO: There was apparent intent in the rs6000-builtin.def to +; have SPECIAL processing for LXSDX, LXVDSX, and STXSDX, but there are +; no def_builtin calls for any of them. That file was removed as part +; of the BIF rewrite, but at some point, we may want to add a ; set of built-ins for whichever vector types make sense for these. pure vsq __builtin_vsx_lxvd2x_v1ti (signed long, const void *); diff --git a/gcc/config/rs6000/rs6000-call.cc b/gcc/config/rs6000/rs6000-call.cc index 6011fe8..551968b 100644 --- a/gcc/config/rs6000/rs6000-call.cc +++ b/gcc/config/rs6000/rs6000-call.cc @@ -1111,6 +1111,12 @@ rs6000_function_arg_advance_1 (CUMULATIVE_ARGS *cum, machine_mode mode, { cum->vregno += n_elts; + /* If we are not splitting Complex IEEE128 args then account for the + fact that they are passed in 2 VSX regs. */ + if (!targetm.calls.split_complex_arg && type + && TREE_CODE (type) == COMPLEX_TYPE && elt_mode == KCmode) + cum->vregno++; + if (!TARGET_ALTIVEC) error ("cannot pass argument in vector register because" " altivec instructions are disabled, use %qs" diff --git a/gcc/config/rs6000/rs6000.h b/gcc/config/rs6000/rs6000.h index 20b9d11..3b8941a 100644 --- a/gcc/config/rs6000/rs6000.h +++ b/gcc/config/rs6000/rs6000.h @@ -2248,54 +2248,6 @@ extern char rs6000_reg_names[][8]; /* register names (0 vs. %r0). */ /* General flags. */ extern int frame_pointer_needed; -/* Classification of the builtin functions as to which switches enable the - builtin, and what attributes it should have. We used to use the target - flags macros, but we've run out of bits, so we now map the options into new - settings used here. */ - -/* Builtin operand count. */ -#define RS6000_BTC_UNARY 0x00000001 /* normal unary function. */ -#define RS6000_BTC_BINARY 0x00000002 /* normal binary function. */ -#define RS6000_BTC_TERNARY 0x00000003 /* normal ternary function. */ -#define RS6000_BTC_QUATERNARY 0x00000004 /* normal quaternary - function. */ -#define RS6000_BTC_QUINARY 0x00000005 /* normal quinary function. */ -#define RS6000_BTC_SENARY 0x00000006 /* normal senary function. */ -#define RS6000_BTC_OPND_MASK 0x00000007 /* Mask to isolate operands. */ - -/* Builtin attributes. */ -#define RS6000_BTC_SPECIAL 0x00000000 /* Special function. */ -#define RS6000_BTC_PREDICATE 0x00000008 /* predicate function. */ -#define RS6000_BTC_ABS 0x00000010 /* Altivec/VSX ABS - function. */ -#define RS6000_BTC_DST 0x00000020 /* Altivec DST function. */ - -#define RS6000_BTC_TYPE_MASK 0x0000003f /* Mask to isolate types */ - -#define RS6000_BTC_MISC 0x00000000 /* No special attributes. */ -#define RS6000_BTC_CONST 0x00000100 /* Neither uses, nor - modifies global state. */ -#define RS6000_BTC_PURE 0x00000200 /* reads global - state/mem and does - not modify global state. */ -#define RS6000_BTC_FP 0x00000400 /* depends on rounding mode. */ -#define RS6000_BTC_QUAD 0x00000800 /* Uses a register quad. */ -#define RS6000_BTC_PAIR 0x00001000 /* Uses a register pair. */ -#define RS6000_BTC_QUADPAIR 0x00001800 /* Uses a quad and a pair. */ -#define RS6000_BTC_ATTR_MASK 0x00001f00 /* Mask of the attributes. */ - -/* Miscellaneous information. */ -#define RS6000_BTC_SPR 0x01000000 /* function references SPRs. */ -#define RS6000_BTC_VOID 0x02000000 /* function has no return value. */ -#define RS6000_BTC_CR 0x04000000 /* function references a CR. */ -#define RS6000_BTC_OVERLOADED 0x08000000 /* function is overloaded. */ -#define RS6000_BTC_GIMPLE 0x10000000 /* function should be expanded - into gimple. */ -#define RS6000_BTC_MISC_MASK 0x1f000000 /* Mask of the misc info. */ - -/* Convenience macros to document the instruction type. */ -#define RS6000_BTC_MEM RS6000_BTC_MISC /* load/store touches mem. */ -#define RS6000_BTC_SAT RS6000_BTC_MISC /* saturate sets VSCR. */ /* Builtin targets. For now, we reuse the masks for those options that are in target flags, and pick a random bit for ldbl128, which isn't in diff --git a/gcc/config/rs6000/rs6000.md b/gcc/config/rs6000/rs6000.md index bf85baa..3eca448a 100644 --- a/gcc/config/rs6000/rs6000.md +++ b/gcc/config/rs6000/rs6000.md @@ -2344,6 +2344,19 @@ "subfe %0,%0,%0" [(set_attr "type" "add")]) +(define_insn_and_split "*subfsi3_carry_in_xx_64" + [(set (match_operand:DI 0 "gpc_reg_operand" "=r") + (sign_extend:DI (plus:SI (reg:SI CA_REGNO) + (const_int -1))))] + "TARGET_POWERPC64" + "#" + "&&1" + [(parallel [(set (match_dup 0) + (plus:DI (reg:DI CA_REGNO) + (const_int -1))) + (clobber (reg:DI CA_REGNO))])] + "" +) (define_insn "@neg<mode>2" [(set (match_operand:GPR 0 "gpc_reg_operand" "=r") diff --git a/gcc/config/s390/s390.cc b/gcc/config/s390/s390.cc index 45bbb6c..d46aba6 100644 --- a/gcc/config/s390/s390.cc +++ b/gcc/config/s390/s390.cc @@ -8769,7 +8769,7 @@ static machine_mode constant_modes[] = QImode, V1QImode }; -#define NR_C_MODES (sizeof (constant_modes) / sizeof (constant_modes[0])) +#define NR_C_MODES (ARRAY_SIZE (constant_modes)) struct constant { diff --git a/gcc/config/tilepro/gen-mul-tables.cc b/gcc/config/tilepro/gen-mul-tables.cc index c9649fb..798766a 100644 --- a/gcc/config/tilepro/gen-mul-tables.cc +++ b/gcc/config/tilepro/gen-mul-tables.cc @@ -462,7 +462,7 @@ find_sequences (ExpressionTree &s, ExpressionTreeMap &best_solution) const Operator *const prev_op = s.m_exprs[num_vals - 1].m_op; const int prev_top_index = (prev_op != NULL) ? prev_op->m_top_index : -1; - for (size_t f = 0; f < sizeof ops / sizeof ops[0]; f++) + for (size_t f = 0; f < ARRAY_SIZE (ops); f++) { const Operator *const op = &ops[f]; @@ -564,7 +564,7 @@ create_insn_code_compression_table () printf ("const enum insn_code %s_multiply_insn_seq_decode_opcode[] = {\n" " CODE_FOR_nothing /* must be first */ ", ARCH); - for (size_t i = 0; i < sizeof ops / sizeof ops[0]; i++) + for (size_t i = 0; i < ARRAY_SIZE (ops); i++) { Operator *op = &ops[i]; int index = -1; diff --git a/gcc/config/vms/vms.cc b/gcc/config/vms/vms.cc index 5d565e3..d0d44ba 100644 --- a/gcc/config/vms/vms.cc +++ b/gcc/config/vms/vms.cc @@ -99,7 +99,7 @@ static const struct vms_crtl_name vms_crtl_names[] = /* Number of entires in the above array. */ -#define NBR_CRTL_NAMES (sizeof (vms_crtl_names) / sizeof (*vms_crtl_names)) +#define NBR_CRTL_NAMES (ARRAY_SIZE (vms_crtl_names)) /* List of aliased identifiers. They must be persistent across gc. */ diff --git a/gcc/cp/ChangeLog b/gcc/cp/ChangeLog index 090124f..41a2615 100644 --- a/gcc/cp/ChangeLog +++ b/gcc/cp/ChangeLog @@ -1,3 +1,52 @@ +2022-05-18 Marek Polacek <polacek@redhat.com> + + PR c++/105634 + * call.cc (maybe_warn_class_memaccess): Avoid % by zero. + +2022-05-17 Jason Merrill <jason@redhat.com> + + PR c++/102307 + * decl.cc (check_initializer): Use build_cplus_new in case of + constexpr failure. + +2022-05-17 Jakub Jelinek <jakub@redhat.com> + + * parser.cc (cp_parser_omp_clause_depend): Parse + inoutset depend-kind. + (cp_parser_omp_depobj): Likewise. + * cxx-pretty-print.cc (cxx_pretty_printer::statement): Handle + OMP_CLAUSE_DEPEND_INOUTSET. + +2022-05-16 Martin Liska <mliska@suse.cz> + + * module.cc (depset::entity_kind_name): Use ARRAY_SIZE. + * name-lookup.cc (get_std_name_hint): Likewise. + * parser.cc (cp_parser_new): Likewise. + +2022-05-16 Marcel Vollweiler <marcel@codesourcery.com> + + * pt.cc (tsubst_omp_clauses): Added OMP_CLAUSE_HAS_DEVICE_ADDR. + * semantics.cc (finish_omp_clauses): Added template decl processing. + +2022-05-15 Jason Merrill <jason@redhat.com> + + PR c++/100502 + PR c++/58993 + * friend.cc (is_friend): Hidden friends count as members. + * search.cc (friend_accessible_p): Likewise. + +2022-05-15 Jason Merrill <jason@redhat.com> + + * parser.cc (cp_parser_template_name): Look through + injected-class-name. + +2022-05-15 Jason Merrill <jason@redhat.com> + + PR c++/105589 + PR c++/105191 + PR c++/92385 + * init.cc (build_value_init): Handle class in template. + 2022-05-13 Nathan Sidwell <nathan@acm.org> * mangle.cc (maybe_write_module): Check external linkage. diff --git a/gcc/cp/call.cc b/gcc/cp/call.cc index 0240e36..14c6037 100644 --- a/gcc/cp/call.cc +++ b/gcc/cp/call.cc @@ -10329,6 +10329,8 @@ maybe_warn_class_memaccess (location_t loc, tree fndecl, /* Finally, warn on partial copies. */ unsigned HOST_WIDE_INT typesize = tree_to_uhwi (TYPE_SIZE_UNIT (desttype)); + if (typesize == 0) + break; if (unsigned HOST_WIDE_INT partial = tree_to_uhwi (sz) % typesize) warned = warning_at (loc, OPT_Wclass_memaccess, (typesize - partial > 1 diff --git a/gcc/cp/cxx-pretty-print.cc b/gcc/cp/cxx-pretty-print.cc index 4f9a090..7e4db2e 100644 --- a/gcc/cp/cxx-pretty-print.cc +++ b/gcc/cp/cxx-pretty-print.cc @@ -2139,6 +2139,9 @@ cxx_pretty_printer::statement (tree t) case OMP_CLAUSE_DEPEND_MUTEXINOUTSET: pp_cxx_ws_string (this, " update(mutexinoutset)"); break; + case OMP_CLAUSE_DEPEND_INOUTSET: + pp_cxx_ws_string (this, " update(inoutset)"); + break; case OMP_CLAUSE_DEPEND_LAST: pp_cxx_ws_string (this, " destroy"); break; diff --git a/gcc/cp/decl.cc b/gcc/cp/decl.cc index 5654bc75..381259c 100644 --- a/gcc/cp/decl.cc +++ b/gcc/cp/decl.cc @@ -7413,12 +7413,19 @@ check_initializer (tree decl, tree init, int flags, vec<tree, va_gc> **cleanups) /* Declared constexpr or constinit, but no suitable initializer; massage init appropriately so we can pass it into store_init_value for the error. */ - if (CLASS_TYPE_P (type) - && (!init || TREE_CODE (init) == TREE_LIST)) + tree new_init = NULL_TREE; + if (!processing_template_decl + && TREE_CODE (init_code) == CALL_EXPR) + new_init = build_cplus_new (type, init_code, tf_none); + else if (CLASS_TYPE_P (type) + && (!init || TREE_CODE (init) == TREE_LIST)) + new_init = build_functional_cast (input_location, type, + init, tf_none); + if (new_init) { - init = build_functional_cast (input_location, type, - init, tf_none); - if (TREE_CODE (init) == TARGET_EXPR) + init = new_init; + if (TREE_CODE (init) == TARGET_EXPR + && !(flags & LOOKUP_ONLYCONVERTING)) TARGET_EXPR_DIRECT_INIT_P (init) = true; } init_code = NULL_TREE; diff --git a/gcc/cp/friend.cc b/gcc/cp/friend.cc index 124ed4f..bf37dad 100644 --- a/gcc/cp/friend.cc +++ b/gcc/cp/friend.cc @@ -131,6 +131,8 @@ is_friend (tree type, tree supplicant) { if (DECL_FUNCTION_MEMBER_P (supplicant)) context = DECL_CONTEXT (supplicant); + else if (tree fc = DECL_FRIEND_CONTEXT (supplicant)) + context = fc; else context = NULL_TREE; } diff --git a/gcc/cp/init.cc b/gcc/cp/init.cc index f1ed933..a4a0a0a 100644 --- a/gcc/cp/init.cc +++ b/gcc/cp/init.cc @@ -343,10 +343,6 @@ build_value_init (tree type, tsubst_flags_t complain) A program that calls for default-initialization or value-initialization of an entity of reference type is ill-formed. */ - /* The AGGR_INIT_EXPR tweaking below breaks in templates. */ - gcc_assert (!processing_template_decl - || (SCALAR_TYPE_P (type) || TREE_CODE (type) == ARRAY_TYPE)); - if (CLASS_TYPE_P (type) && type_build_ctor_call (type)) { tree ctor @@ -354,6 +350,9 @@ build_value_init (tree type, tsubst_flags_t complain) NULL, type, LOOKUP_NORMAL, complain); if (ctor == error_mark_node || TREE_CONSTANT (ctor)) return ctor; + if (processing_template_decl) + /* The AGGR_INIT_EXPR tweaking below breaks in templates. */ + return build_min (CAST_EXPR, type, NULL_TREE); tree fn = NULL_TREE; if (TREE_CODE (ctor) == CALL_EXPR) fn = get_callee_fndecl (ctor); diff --git a/gcc/cp/module.cc b/gcc/cp/module.cc index 547bf36..d1dc737 100644 --- a/gcc/cp/module.cc +++ b/gcc/cp/module.cc @@ -2619,7 +2619,7 @@ depset::entity_kind_name () const {"decl", "specialization", "partial", "using", "namespace", "redirect", "binding"}; entity_kind kind = get_entity_kind (); - gcc_checking_assert (kind < sizeof (names) / sizeof(names[0])); + gcc_checking_assert (kind < ARRAY_SIZE (names)); return names[kind]; } diff --git a/gcc/cp/name-lookup.cc b/gcc/cp/name-lookup.cc index 6bed9da..421bf2e 100644 --- a/gcc/cp/name-lookup.cc +++ b/gcc/cp/name-lookup.cc @@ -6918,7 +6918,7 @@ get_std_name_hint (const char *name) /* <vector>. */ {"vector", "<vector>", cxx98}, }; - const size_t num_hints = sizeof (hints) / sizeof (hints[0]); + const size_t num_hints = ARRAY_SIZE (hints); for (size_t i = 0; i < num_hints; i++) { if (strcmp (name, hints[i].name) == 0) diff --git a/gcc/cp/parser.cc b/gcc/cp/parser.cc index 8969ed0..24585c1 100644 --- a/gcc/cp/parser.cc +++ b/gcc/cp/parser.cc @@ -4200,7 +4200,7 @@ cp_parser_new (cp_lexer *lexer) { /* Initialize the binops_by_token so that we can get the tree directly from the token. */ - for (unsigned i = 0; i < sizeof (binops) / sizeof (binops[0]); i++) + for (unsigned i = 0; i < ARRAY_SIZE (binops); i++) binops_by_token[binops[i].token_type] = binops[i]; cp_parser *parser = ggc_cleared_alloc<cp_parser> (); @@ -18646,6 +18646,9 @@ cp_parser_template_name (cp_parser* parser, (9.3.4), or in a type-only context other than a nested-name-specifier (13.8). */ + /* Handle injected-class-name. */ + decl = maybe_get_template_decl_from_type_decl (decl); + /* If DECL is a template, then the name was a template-name. */ if (TREE_CODE (decl) == TEMPLATE_DECL) { @@ -39443,6 +39446,8 @@ cp_parser_omp_clause_depend (cp_parser *parser, tree list, location_t loc) kind = OMP_CLAUSE_DEPEND_IN; else if (strcmp ("inout", p) == 0) kind = OMP_CLAUSE_DEPEND_INOUT; + else if (strcmp ("inoutset", p) == 0) + kind = OMP_CLAUSE_DEPEND_INOUTSET; else if (strcmp ("mutexinoutset", p) == 0) kind = OMP_CLAUSE_DEPEND_MUTEXINOUTSET; else if (strcmp ("out", p) == 0) @@ -41742,12 +41747,14 @@ cp_parser_omp_depobj (cp_parser *parser, cp_token *pragma_tok) kind = OMP_CLAUSE_DEPEND_INOUT; else if (!strcmp ("mutexinoutset", p2)) kind = OMP_CLAUSE_DEPEND_MUTEXINOUTSET; + else if (!strcmp ("inoutset", p2)) + kind = OMP_CLAUSE_DEPEND_INOUTSET; } if (kind == OMP_CLAUSE_DEPEND_SOURCE) { clause = error_mark_node; - error_at (c2_loc, "expected %<in%>, %<out%>, %<inout%> or " - "%<mutexinoutset%>"); + error_at (c2_loc, "expected %<in%>, %<out%>, %<inout%>, " + "%<mutexinoutset%> or %<inoutset%>"); } if (!c_parens.require_close (parser)) cp_parser_skip_to_closing_parenthesis (parser, diff --git a/gcc/cp/pt.cc b/gcc/cp/pt.cc index fa05e91..5037627 100644 --- a/gcc/cp/pt.cc +++ b/gcc/cp/pt.cc @@ -17722,6 +17722,7 @@ tsubst_omp_clauses (tree clauses, enum c_omp_region_type ort, case OMP_CLAUSE_USE_DEVICE_PTR: case OMP_CLAUSE_USE_DEVICE_ADDR: case OMP_CLAUSE_IS_DEVICE_PTR: + case OMP_CLAUSE_HAS_DEVICE_ADDR: case OMP_CLAUSE_INCLUSIVE: case OMP_CLAUSE_EXCLUSIVE: OMP_CLAUSE_DECL (nc) @@ -17867,6 +17868,7 @@ tsubst_omp_clauses (tree clauses, enum c_omp_region_type ort, case OMP_CLAUSE_USE_DEVICE_PTR: case OMP_CLAUSE_USE_DEVICE_ADDR: case OMP_CLAUSE_IS_DEVICE_PTR: + case OMP_CLAUSE_HAS_DEVICE_ADDR: case OMP_CLAUSE_INCLUSIVE: case OMP_CLAUSE_EXCLUSIVE: case OMP_CLAUSE_ALLOCATE: diff --git a/gcc/cp/search.cc b/gcc/cp/search.cc index b86b3a2..10863a4 100644 --- a/gcc/cp/search.cc +++ b/gcc/cp/search.cc @@ -734,12 +734,9 @@ friend_accessible_p (tree scope, tree decl, tree type, tree otype) && friend_accessible_p (DECL_CONTEXT (scope), decl, type, otype)) return 1; /* Perhaps SCOPE is a friend function defined inside a class from which - DECL is accessible. Checking this is necessary only when the class - is dependent, for otherwise add_friend will already have added the - class to SCOPE's DECL_BEFRIENDING_CLASSES. */ + DECL is accessible. */ if (tree fctx = DECL_FRIEND_CONTEXT (scope)) - if (dependent_type_p (fctx) - && protected_accessible_p (decl, fctx, type, otype)) + if (friend_accessible_p (fctx, decl, type, otype)) return 1; } diff --git a/gcc/cp/semantics.cc b/gcc/cp/semantics.cc index 61f49be..cd7a281 100644 --- a/gcc/cp/semantics.cc +++ b/gcc/cp/semantics.cc @@ -8575,14 +8575,20 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort) else { t = OMP_CLAUSE_DECL (c); + while (TREE_CODE (t) == TREE_LIST) + t = TREE_CHAIN (t); while (TREE_CODE (t) == INDIRECT_REF || TREE_CODE (t) == ARRAY_REF) t = TREE_OPERAND (t, 0); } } - bitmap_set_bit (&is_on_device_head, DECL_UID (t)); if (VAR_P (t) || TREE_CODE (t) == PARM_DECL) - cxx_mark_addressable (t); + { + bitmap_set_bit (&is_on_device_head, DECL_UID (t)); + if (!processing_template_decl + && !cxx_mark_addressable (t)) + remove = true; + } goto check_dup_generic_t; case OMP_CLAUSE_USE_DEVICE_ADDR: diff --git a/gcc/d/ChangeLog b/gcc/d/ChangeLog index 546f21c..d3ac0bc 100644 --- a/gcc/d/ChangeLog +++ b/gcc/d/ChangeLog @@ -1,3 +1,28 @@ +2022-05-16 Iain Buclaw <ibuclaw@gdcproject.org> + + * dmd/MERGE: Merge upstream dmd 60bfa0ee7. + * dmd/VERSION: Update version to v2.100.0. + * d-builtins.cc (d_init_versions): Update for new front-end interface. + * d-codegen.cc (d_decl_context): Use resolvedLinkage to get + declaration linkage. + (build_struct_literal): Track offset in bits. + * d-gimplify.cc (d_gimplify_modify_expr): Check both operands for a + bit-field reference. + * d-lang.cc (d_handle_option): Handle -fpreview=bitfields, remove + -frevert=markdown and -ftransition=vmarkdown. + (d_post_options): Set flag_rtti and flag_exceptions if -fno-druntime + was seen on command-line. + (d_parse_file): Update for new front-end interface. + (d_type_promotes_to): Use resolvedLinkage to get declaration linkage. + * decl.cc (make_thunk): Likewise. + * expr.cc (ExprVisitor::visit (CatAssignExp *)): Remove lowering for + appending of an element or array to another array. + * lang.opt (fpreview=bitfields): New option. + (frevert=markdown): Remove. + (ftransition=vmarkdown): Remove. + * types.cc (layout_aggregate_members): Ignore anonymous fields in + total count. + 2022-04-28 Iain Buclaw <ibuclaw@gdcproject.org> * dmd/MERGE: Merge upstream dmd 313d28b3d. diff --git a/gcc/d/d-builtins.cc b/gcc/d/d-builtins.cc index 7e7fb75..cd9748c 100644 --- a/gcc/d/d-builtins.cc +++ b/gcc/d/d-builtins.cc @@ -475,7 +475,7 @@ d_init_versions (void) if (flag_pie) VersionCondition::addPredefinedGlobalIdent ("D_PIE"); - if (global.params.doDocComments) + if (global.params.ddoc.doOutput) VersionCondition::addPredefinedGlobalIdent ("D_Ddoc"); if (global.params.useUnitTests) diff --git a/gcc/d/d-codegen.cc b/gcc/d/d-codegen.cc index bb96b2f..22090a8 100644 --- a/gcc/d/d-codegen.cc +++ b/gcc/d/d-codegen.cc @@ -76,7 +76,7 @@ d_decl_context (Dsymbol *dsym) but only for extern(D) symbols. */ if (parent->isModule ()) { - if ((decl != NULL && decl->linkage != LINK::d) + if ((decl != NULL && decl->resolvedLinkage () != LINK::d) || (ad != NULL && ad->classKind != ClassKind::d)) return NULL_TREE; @@ -1165,7 +1165,7 @@ build_struct_literal (tree type, vec <constructor_elt, va_gc> *init) } vec <constructor_elt, va_gc> *ve = NULL; - HOST_WIDE_INT offset = 0; + HOST_WIDE_INT bitoffset = 0; bool constant_p = true; bool finished = false; @@ -1210,11 +1210,11 @@ build_struct_literal (tree type, vec <constructor_elt, va_gc> *init) if (is_initialized) { - HOST_WIDE_INT fieldpos = int_byte_position (field); + HOST_WIDE_INT fieldpos = int_bit_position (field); gcc_assert (value != NULL_TREE); /* Must not initialize fields that overlap. */ - if (fieldpos < offset) + if (fieldpos < bitoffset) { /* Find the nearest user defined type and field. */ tree vtype = type; @@ -1243,12 +1243,9 @@ build_struct_literal (tree type, vec <constructor_elt, va_gc> *init) finished = true; } - /* Move offset to the next position in the struct. */ - if (TREE_CODE (type) == RECORD_TYPE) - { - offset = int_byte_position (field) - + int_size_in_bytes (TREE_TYPE (field)); - } + /* Move bit offset to the next position in the struct. */ + if (TREE_CODE (type) == RECORD_TYPE && DECL_SIZE (field)) + bitoffset = int_bit_position (field) + tree_to_shwi (DECL_SIZE (field)); /* If all initializers have been assigned, there's nothing else to do. */ if (vec_safe_is_empty (init)) diff --git a/gcc/d/d-gimplify.cc b/gcc/d/d-gimplify.cc index a98089b7..36b76da 100644 --- a/gcc/d/d-gimplify.cc +++ b/gcc/d/d-gimplify.cc @@ -109,7 +109,8 @@ d_gimplify_modify_expr (tree *expr_p, gimple_seq *pre_p, gimple_seq *post_p) } /* Same as above, but for bit-field assignments. */ - if (bit_field_ref (op0) && TREE_TYPE (op0) != TREE_TYPE (op1)) + if ((bit_field_ref (op0) || bit_field_ref (op1)) + && TREE_TYPE (op0) != TREE_TYPE (op1)) { TREE_OPERAND (*expr_p, 1) = convert (TREE_TYPE (op0), op1); return GS_OK; diff --git a/gcc/d/d-lang.cc b/gcc/d/d-lang.cc index 9adcabd..d1f4959 100644 --- a/gcc/d/d-lang.cc +++ b/gcc/d/d-lang.cc @@ -478,21 +478,21 @@ d_handle_option (size_t scode, const char *arg, HOST_WIDE_INT value, break; case OPT_fdoc: - global.params.doDocComments = value; + global.params.ddoc.doOutput = value; break; case OPT_fdoc_dir_: - global.params.doDocComments = true; - global.params.docdir = arg; + global.params.ddoc.doOutput = true; + global.params.ddoc.dir = arg; break; case OPT_fdoc_file_: - global.params.doDocComments = true; - global.params.docname = arg; + global.params.ddoc.doOutput = true; + global.params.ddoc.name = arg; break; case OPT_fdoc_inc_: - global.params.ddocfiles.push (arg); + global.params.ddoc.files.push (arg); break; case OPT_fdruntime: @@ -500,13 +500,12 @@ d_handle_option (size_t scode, const char *arg, HOST_WIDE_INT value, break; case OPT_fdump_c___spec_: - if (global.params.doCxxHdrGeneration == CxxHeaderMode::none) - global.params.doCxxHdrGeneration = CxxHeaderMode::silent; - global.params.cxxhdrname = arg; + global.params.cxxhdr.doOutput = true; + global.params.cxxhdr.name = arg; break; case OPT_fdump_c___spec_verbose: - global.params.doCxxHdrGeneration = CxxHeaderMode::verbose; + global.params.cxxhdr.fullOutput = true; break; case OPT_fdump_d_original: @@ -572,18 +571,22 @@ d_handle_option (size_t scode, const char *arg, HOST_WIDE_INT value, global.params.useDIP25 = FeatureState::enabled; global.params.useDIP1000 = FeatureState::enabled; global.params.useDIP1021 = value; + global.params.bitfields = value; global.params.dtorFields = FeatureState::enabled; global.params.fieldwise = value; global.params.fixAliasThis = value; global.params.previewIn = value; global.params.fix16997 = value; - global.params.markdown = value; global.params.noSharedAccess = value; global.params.rvalueRefParam = FeatureState::enabled; global.params.inclusiveInContracts = value; global.params.shortenedMethods = value; break; + case OPT_fpreview_bitfields: + global.params.bitfields = value; + break; + case OPT_fpreview_dip1000: global.params.useDIP1000 = FeatureState::enabled; break; @@ -641,7 +644,6 @@ d_handle_option (size_t scode, const char *arg, HOST_WIDE_INT value, global.params.useDIP25 = FeatureState::disabled; global.params.dtorFields = FeatureState::disabled; global.params.fix16997 = !value; - global.params.markdown = !value; break; case OPT_frevert_dip1000: @@ -660,17 +662,14 @@ d_handle_option (size_t scode, const char *arg, HOST_WIDE_INT value, global.params.fix16997 = !value; break; - case OPT_frevert_markdown: - global.params.markdown = !value; - break; - case OPT_frtti: global.params.useTypeInfo = value; break; case OPT_fsave_mixins_: - global.params.mixinFile = arg; - global.params.mixinOut = d_gc_malloc<OutBuffer> (); + global.params.mixinOut.doOutput = true; + global.params.mixinOut.name = arg; + global.params.mixinOut.buffer = d_gc_malloc<OutBuffer> (); break; case OPT_fswitch_errors: @@ -681,7 +680,6 @@ d_handle_option (size_t scode, const char *arg, HOST_WIDE_INT value, global.params.vfield = value; global.params.vgc = value; global.params.vin = value; - global.params.vmarkdown= value; global.params.vtls = value; break; @@ -697,10 +695,6 @@ d_handle_option (size_t scode, const char *arg, HOST_WIDE_INT value, global.params.vgc = value; break; - case OPT_ftransition_vmarkdown: - global.params.vmarkdown = value; - break; - case OPT_ftransition_templates: global.params.vtemplates = value; break; @@ -736,17 +730,17 @@ d_handle_option (size_t scode, const char *arg, HOST_WIDE_INT value, break; case OPT_H: - global.params.doHdrGeneration = true; + global.params.dihdr.doOutput = true; break; case OPT_Hd: - global.params.doHdrGeneration = true; - global.params.hdrdir = arg; + global.params.dihdr.doOutput = true; + global.params.dihdr.dir = arg; break; case OPT_Hf: - global.params.doHdrGeneration = true; - global.params.hdrname = arg; + global.params.dihdr.doOutput = true; + global.params.dihdr.name = arg; break; case OPT_imultilib: @@ -827,11 +821,11 @@ d_handle_option (size_t scode, const char *arg, HOST_WIDE_INT value, break; case OPT_Xf: - global.params.jsonfilename = arg; + global.params.json.name = arg; /* Fall through. */ case OPT_X: - global.params.doJsonGeneration = true; + global.params.json.doOutput = true; break; default: @@ -904,16 +898,26 @@ d_post_options (const char ** fn) ? CHECKENABLEoff : CHECKENABLEon; } + /* When not linking against D runtime, turn off all code generation that + would otherwise reference it. */ if (global.params.betterC) { if (!OPTION_SET_P (flag_moduleinfo)) global.params.useModuleInfo = false; + /* Ensure that the front-end options are in sync with the `-frtti' and + `-fexceptions' flags. */ if (!OPTION_SET_P (flag_rtti)) - global.params.useTypeInfo = false; + { + global.params.useTypeInfo = false; + flag_rtti = false; + } if (!OPTION_SET_P (flag_exceptions)) - global.params.useExceptions = false; + { + global.params.useExceptions = false; + flag_exceptions = false; + } global.params.checkAction = CHECKACTION_C; } @@ -947,19 +951,15 @@ d_post_options (const char ** fn) if (flag_excess_precision == EXCESS_PRECISION_DEFAULT) flag_excess_precision = EXCESS_PRECISION_STANDARD; - global.params.symdebug = write_symbols != NO_DEBUG; global.params.useInline = flag_inline_functions; global.params.showColumns = flag_show_column; global.params.printErrorContext = flag_diagnostics_show_caret; if (global.params.useInline) - global.params.hdrStripPlainFunctions = false; + global.params.dihdr.fullOutput = true; global.params.obj = !flag_syntax_only; - /* Has no effect yet. */ - global.params.pic = flag_pic != 0; - /* Add in versions given on the command line. */ if (global.params.versionids) { @@ -1068,8 +1068,8 @@ d_parse_file (void) /* Handling stdin, generate a unique name for the module. */ Module *m = Module::create (in_fnames[i], Identifier::idPool ("__stdin"), - global.params.doDocComments, - global.params.doHdrGeneration); + global.params.ddoc.doOutput, + global.params.dihdr.doOutput); modules.push (m); /* Overwrite the source file for the module, the one created by @@ -1084,8 +1084,8 @@ d_parse_file (void) const char *name = FileName::removeExt (basename); Module *m = Module::create (in_fnames[i], Identifier::idPool (name), - global.params.doDocComments, - global.params.doHdrGeneration); + global.params.ddoc.doOutput, + global.params.dihdr.doOutput); modules.push (m); FileName::free (name); } @@ -1142,7 +1142,7 @@ d_parse_file (void) if (global.errors) goto had_errors; - if (global.params.doHdrGeneration) + if (global.params.dihdr.doOutput) { /* Generate 'header' import files. Since 'header' import files must be independent of command line switches and what else is imported, they @@ -1316,12 +1316,12 @@ d_parse_file (void) printTemplateStats (); /* Generate JSON files. */ - if (global.params.doJsonGeneration) + if (global.params.json.doOutput) { OutBuffer buf; json_generate (&buf, &modules); - const char *name = global.params.jsonfilename.ptr; + const char *name = global.params.json.name.ptr; FILE *json_stream; if (name && (name[0] != '-' || name[1] != '\0')) @@ -1346,7 +1346,7 @@ d_parse_file (void) } /* Generate Ddoc files. */ - if (global.params.doDocComments && !global.errors && !errorcount) + if (global.params.ddoc.doOutput && !global.errors && !errorcount) { for (size_t i = 0; i < modules.length; i++) { @@ -1370,7 +1370,7 @@ d_parse_file (void) } /* Generate C++ header files. */ - if (global.params.doCxxHdrGeneration != CxxHeaderMode::none) + if (global.params.cxxhdr.doOutput) genCppHdrFiles (modules); if (global.errors) @@ -1403,23 +1403,23 @@ d_parse_file (void) errorcount += (global.errors + global.warnings); /* We want to write the mixin expansion file also on error. */ - if (global.params.mixinOut) + if (global.params.mixinOut.doOutput) { - FILE *mixin_stream = fopen (global.params.mixinFile, "w"); + FILE *mixin_stream = fopen (global.params.mixinOut.name.ptr, "w"); if (mixin_stream) { - OutBuffer *buf = global.params.mixinOut; + OutBuffer *buf = global.params.mixinOut.buffer; fprintf (mixin_stream, "%s", buf->peekChars ()); if (ferror (mixin_stream) || fclose (mixin_stream)) fatal_error (input_location, "closing mixin file %s: %m", - global.params.mixinFile); + global.params.mixinOut.name.ptr); } else { fatal_error (input_location, "opening mixin file %s: %m", - global.params.mixinFile); + global.params.mixinOut.name.ptr); } } @@ -1558,7 +1558,7 @@ d_type_promotes_to (tree type) /* Promotions are only applied on unnamed function arguments for declarations with `extern(C)' or `extern(C++)' linkage. */ if (cfun && DECL_LANG_FRONTEND (cfun->decl) - && DECL_LANG_FRONTEND (cfun->decl)->linkage != LINK::d) + && DECL_LANG_FRONTEND (cfun->decl)->resolvedLinkage () != LINK::d) { /* In [type/integer-promotions], integer promotions are conversions of the following types: diff --git a/gcc/d/decl.cc b/gcc/d/decl.cc index 86ea176..f5c2107 100644 --- a/gcc/d/decl.cc +++ b/gcc/d/decl.cc @@ -1845,7 +1845,7 @@ make_thunk (FuncDeclaration *decl, int offset) forcing a D local thunk to be emitted. */ const char *ident; - if (decl->linkage == LINK::cpp) + if (decl->resolvedLinkage () == LINK::cpp) ident = target.cpp.thunkMangle (decl, offset); else { @@ -1862,7 +1862,7 @@ make_thunk (FuncDeclaration *decl, int offset) d_keep (thunk); - if (decl->linkage != LINK::cpp) + if (decl->resolvedLinkage () != LINK::cpp) free (CONST_CAST (char *, ident)); if (!DECL_EXTERNAL (function)) diff --git a/gcc/d/dmd/MERGE b/gcc/d/dmd/MERGE index d181191..b4d42ec 100644 --- a/gcc/d/dmd/MERGE +++ b/gcc/d/dmd/MERGE @@ -1,4 +1,4 @@ -313d28b3db7523e67880ae3baf8ef28ce9abe9bd +a6c5224b2d6b61fa3856aa8a3369581f7c949b68 The first line of this file holds the git revision number of the last merge done from the dlang/dmd repository. diff --git a/gcc/d/dmd/README.md b/gcc/d/dmd/README.md index b143103..50c5ac3 100644 --- a/gcc/d/dmd/README.md +++ b/gcc/d/dmd/README.md @@ -164,20 +164,21 @@ Note that these groups have no strict meaning, the category assignments are a bi **Other** -| File | Purpose | -|-------------------------------------------------------------------------------|---------------------------------------------------------------------------------------------| -| [aliasthis.d](https://github.com/dlang/dmd/blob/master/src/dmd/aliasthis.d) | Resolve implicit conversions for `alias X this` | -| [traits.d](https://github.com/dlang/dmd/blob/master/src/dmd/traits.d) | `__traits()` | -| [lambdacomp.d](https://github.com/dlang/dmd/blob/master/src/dmd/lambdacomp.d) | `__traits(isSame, x => y, z => w)` | -| [cond.d](https://github.com/dlang/dmd/blob/master/src/dmd/cond.d) | Evaluate `static if`, `version` `debug ` | -| [staticcond.d](https://github.com/dlang/dmd/blob/master/src/dmd/staticcond.d) | Lazily evaluate static conditions for `static if`, `static assert` and template constraints | -| [delegatize.d](https://github.com/dlang/dmd/blob/master/src/dmd/delegatize.d) | Converts expression to delegates for `lazy` parameters | -| [eh.d](https://github.com/dlang/dmd/blob/master/src/dmd/eh.d) | Generate tables for exception handling | -| [nspace.d](https://github.com/dlang/dmd/blob/master/src/dmd/nspace.d) | Namespace for `extern (C++, Module)` | -| [intrange.d](https://github.com/dlang/dmd/blob/master/src/dmd/intrange.d) | [Value range propagation](https://digitalmars.com/articles/b62.html) | -| [dimport.d](https://github.com/dlang/dmd/blob/master/src/dmd/dimport.d) | Renamed imports (`import aliasSymbol = pkg1.pkg2.symbol`) | -| [arrayop.d](https://github.com/dlang/dmd/blob/master/src/dmd/arrayop.d) | Array operations (`a[] = b[] + c[]`) | -| [typinf.d](https://github.com/dlang/dmd/blob/master/src/dmd/typinf.d) | Generate typeinfo for `typeid()` (as well as internals) | +| File | Purpose | +|--------------------------------------------------------------------------------|---------------------------------------------------------------------------------------------| +| [aliasthis.d](https://github.com/dlang/dmd/blob/master/src/dmd/aliasthis.d) | Resolve implicit conversions for `alias X this` | +| [traits.d](https://github.com/dlang/dmd/blob/master/src/dmd/traits.d) | `__traits()` | +| [lambdacomp.d](https://github.com/dlang/dmd/blob/master/src/dmd/lambdacomp.d) | `__traits(isSame, x => y, z => w)` | +| [cond.d](https://github.com/dlang/dmd/blob/master/src/dmd/cond.d) | Evaluate `static if`, `version` `debug ` | +| [staticcond.d](https://github.com/dlang/dmd/blob/master/src/dmd/staticcond.d) | Lazily evaluate static conditions for `static if`, `static assert` and template constraints | +| [delegatize.d](https://github.com/dlang/dmd/blob/master/src/dmd/delegatize.d) | Converts expression to delegates for `lazy` parameters | +| [eh.d](https://github.com/dlang/dmd/blob/master/src/dmd/eh.d) | Generate tables for exception handling | +| [nspace.d](https://github.com/dlang/dmd/blob/master/src/dmd/nspace.d) | Namespace for `extern (C++, Module)` | +| [intrange.d](https://github.com/dlang/dmd/blob/master/src/dmd/intrange.d) | [Value range propagation](https://digitalmars.com/articles/b62.html) | +| [dimport.d](https://github.com/dlang/dmd/blob/master/src/dmd/dimport.d) | Renamed imports (`import aliasSymbol = pkg1.pkg2.symbol`) | +| [arrayop.d](https://github.com/dlang/dmd/blob/master/src/dmd/arrayop.d) | Array operations (`a[] = b[] + c[]`) | +| [cpreprocess.d](https://github.com/dlang/dmd/blob/master/src/dmd/cpreprocess.d)| Run the C preprocessor on C source files | +| [typinf.d](https://github.com/dlang/dmd/blob/master/src/dmd/typinf.d) | Generate typeinfo for `typeid()` (as well as internals) | | File | Purpose | |-----------------------------------------------------------------------------|------------------------------------------------------------------------------------| diff --git a/gcc/d/dmd/VERSION b/gcc/d/dmd/VERSION index 2450fd5..5ea2ba0 100644 --- a/gcc/d/dmd/VERSION +++ b/gcc/d/dmd/VERSION @@ -1 +1 @@ -v2.100.0-beta.1 +v2.100.0 diff --git a/gcc/d/dmd/clone.d b/gcc/d/dmd/clone.d index 9c8c1c3..75a16bd 100644 --- a/gcc/d/dmd/clone.d +++ b/gcc/d/dmd/clone.d @@ -563,9 +563,12 @@ FuncDeclaration buildXopEquals(StructDeclaration sd, Scope* sc) e = new DotIdExp(sd.loc, e, Id.object); e = new DotIdExp(sd.loc, e, id); e = e.expressionSemantic(sc); - Dsymbol s = getDsymbol(e); - assert(s); - sd.xerreq = s.isFuncDeclaration(); + if (!e.isErrorExp()) + { + Dsymbol s = getDsymbol(e); + assert(s); + sd.xerreq = s.isFuncDeclaration(); + } } Loc declLoc; // loc is unnecessary so __xopEquals is never called directly Loc loc; // loc is unnecessary so errors are gagged @@ -684,9 +687,12 @@ FuncDeclaration buildXopCmp(StructDeclaration sd, Scope* sc) e = new DotIdExp(sd.loc, e, Id.object); e = new DotIdExp(sd.loc, e, id); e = e.expressionSemantic(sc); - Dsymbol s = getDsymbol(e); - assert(s); - sd.xerrcmp = s.isFuncDeclaration(); + if (!e.isErrorExp()) + { + Dsymbol s = getDsymbol(e); + assert(s); + sd.xerrcmp = s.isFuncDeclaration(); + } } Loc declLoc; // loc is unnecessary so __xopCmp is never called directly Loc loc; // loc is unnecessary so errors are gagged @@ -867,7 +873,7 @@ void buildDtors(AggregateDeclaration ad, Scope* sc) // Build the field destructor (`ad.fieldDtor`), if needed. // If the user dtor is an extern(C++) prototype, then we expect it performs a full-destruction and skip building. - const bool dtorIsCppPrototype = ad.userDtors.dim && ad.userDtors[0].linkage == LINK.cpp && !ad.userDtors[0].fbody; + const bool dtorIsCppPrototype = ad.userDtors.dim && ad.userDtors[0]._linkage == LINK.cpp && !ad.userDtors[0].fbody; if (!dtorIsCppPrototype) { Expression e = null; @@ -1019,7 +1025,7 @@ void buildDtors(AggregateDeclaration ad, Scope* sc) // Set/build `ad.dtor`. // On Windows, the dtor in the vtable is a shim with different signature. - ad.dtor = (ad.aggrDtor && ad.aggrDtor.linkage == LINK.cpp && !target.cpp.twoDtorInVtable) + ad.dtor = (ad.aggrDtor && ad.aggrDtor._linkage == LINK.cpp && !target.cpp.twoDtorInVtable) ? buildWindowsCppDtor(ad, ad.aggrDtor, sc) : ad.aggrDtor; diff --git a/gcc/d/dmd/common/bitfields.d b/gcc/d/dmd/common/bitfields.d index d17983d..cccaabd 100644 --- a/gcc/d/dmd/common/bitfields.d +++ b/gcc/d/dmd/common/bitfields.d @@ -30,7 +30,7 @@ if (__traits(isUnsigned, T)) enum mask = "(1 << "~i.stringof~")"; result ~= " /// set or get the corresponding "~structName~" member - bool "~mem~"() const { return !!(bitFields & "~mask~"); } + bool "~mem~"() const scope { return !!(bitFields & "~mask~"); } /// ditto bool "~mem~"(bool v) { diff --git a/gcc/d/dmd/common/outbuffer.d b/gcc/d/dmd/common/outbuffer.d index 7e46d29..9a5bd82 100644 --- a/gcc/d/dmd/common/outbuffer.d +++ b/gcc/d/dmd/common/outbuffer.d @@ -309,23 +309,24 @@ struct OutBuffer writenl(); } - // Zero-terminated - void writeString(const(char)* s) pure nothrow @trusted + /** Write string to buffer, ensure it is zero terminated + */ + void writeStringz(const(char)* s) pure nothrow @trusted { write(s[0 .. strlen(s)+1]); } /// ditto - void writeString(const(char)[] s) pure nothrow + void writeStringz(const(char)[] s) pure nothrow { write(s); writeByte(0); } /// ditto - void writeString(string s) pure nothrow + void writeStringz(string s) pure nothrow { - writeString(cast(const(char)[])(s)); + writeStringz(cast(const(char)[])(s)); } extern (C++) void prependstring(const(char)* string) pure nothrow diff --git a/gcc/d/dmd/cond.d b/gcc/d/dmd/cond.d index dee0a17..65085f5 100644 --- a/gcc/d/dmd/cond.d +++ b/gcc/d/dmd/cond.d @@ -370,7 +370,7 @@ extern (C++) final class StaticForeach : RootObject Type ety = new TypeTypeof(aloc, wrapAndCall(aloc, new CompoundStatement(aloc, s1))); auto aty = ety.arrayOf(); auto idres = Identifier.generateId("__res"); - auto vard = new VarDeclaration(aloc, aty, idres, null); + auto vard = new VarDeclaration(aloc, aty, idres, null, STC.temp); auto s2 = new Statements(); // Run 'typeof' gagged to avoid duplicate errors and if it fails just create @@ -984,9 +984,9 @@ bool findCondition(Identifiers* ids, Identifier ident) @safe nothrow pure // Helper for printing dependency information private void printDepsConditional(Scope* sc, DVCondition condition, const(char)[] depType) { - if (!global.params.moduleDeps || global.params.moduleDepsFile) + if (!global.params.moduleDeps.buffer || global.params.moduleDeps.name) return; - OutBuffer* ob = global.params.moduleDeps; + OutBuffer* ob = global.params.moduleDeps.buffer; Module imod = sc ? sc._module : condition.mod; if (!imod) return; diff --git a/gcc/d/dmd/constfold.d b/gcc/d/dmd/constfold.d index bf66408..d90542f 100644 --- a/gcc/d/dmd/constfold.d +++ b/gcc/d/dmd/constfold.d @@ -1181,7 +1181,7 @@ UnionExp Cast(const ref Loc loc, Type type, Type to, Expression e1) { if (type != Type.terror) { - // have to change to Internal Compiler Error + // have to change to internal compiler error // all invalid casts should be handled already in Expression::castTo(). error(loc, "cannot cast `%s` to `%s`", e1.type.toChars(), type.toChars()); } diff --git a/gcc/d/dmd/cparse.d b/gcc/d/dmd/cparse.d index 2b2046f..fde0648 100644 --- a/gcc/d/dmd/cparse.d +++ b/gcc/d/dmd/cparse.d @@ -284,6 +284,7 @@ final class CParser(AST) : Parser!AST case TOK.struct_: case TOK.union_: case TOK.enum_: + case TOK.typeof_: // storage-class-specifiers case TOK.typedef_: @@ -1662,6 +1663,14 @@ final class CParser(AST) : Parser!AST return; } + if (!tspec) + { + error("no type for declarator before `%s`", token.toChars()); + panic(); + nextToken(); + return; + } + if (tspec && specifier.mod & MOD.xconst) { tspec = toConst(tspec); @@ -2287,6 +2296,52 @@ final class CParser(AST) : Parser!AST break; } + case TOK.typeof_: + { + nextToken(); + check(TOK.leftParenthesis); + + auto tk = &token; + AST.Expression e; + if (isTypeName(tk)) + e = new AST.TypeExp(loc, cparseTypeName()); + else + e = cparseExpression(); + t = new AST.TypeTypeof(loc, e); + + if(token.value == TOK.rightParenthesis) + nextToken(); + else + { + t = AST.Type.terror; + error("`typeof` operator expects an expression or type name in parentheses"); + + // skipParens et. al expect to be on the opening parenthesis + int parens; + loop: while(1) + { + switch(token.value) + { + case TOK.leftParenthesis: + parens++; + break; + case TOK.rightParenthesis: + parens--; + if(parens < 0) + goto case; + break; + case TOK.endOfFile: + break loop; + default: + } + nextToken(); + } + } + + tkwx = TKW.xtag; + break; + } + default: break Lwhile; } @@ -2498,7 +2553,7 @@ final class CParser(AST) : Parser!AST private AST.Type cparseDeclarator(DTR declarator, AST.Type t, out Identifier pident, ref Specifier specifier) { - //printf("cparseDeclarator(%d)\n", declarator); + //printf("cparseDeclarator(%d, %p)\n", declarator, t); AST.Types constTypes; // all the Types that will need `const` applied to them constTypes.setDim(0); @@ -4227,6 +4282,7 @@ final class CParser(AST) : Parser!AST // atomic-type-specifier case TOK._Atomic: + case TOK.typeof_: t = peek(t); if (t.value != TOK.leftParenthesis || !skipParens(t, &t)) diff --git a/gcc/d/dmd/cppmangle.d b/gcc/d/dmd/cppmangle.d index 13ef34c..6235342 100644 --- a/gcc/d/dmd/cppmangle.d +++ b/gcc/d/dmd/cppmangle.d @@ -471,7 +471,7 @@ private final class CppMangleVisitor : Visitor } else { - ti.error("Internal Compiler Error: C++ `%s` template value parameter is not supported", tv.valType.toChars()); + ti.error("internal compiler error: C++ `%s` template value parameter is not supported", tv.valType.toChars()); fatal(); } } @@ -506,13 +506,13 @@ private final class CppMangleVisitor : Visitor } else { - ti.error("Internal Compiler Error: C++ `%s` template alias parameter is not supported", o.toChars()); + ti.error("internal compiler error: C++ `%s` template alias parameter is not supported", o.toChars()); fatal(); } } else if (tp.isTemplateThisParameter()) { - ti.error("Internal Compiler Error: C++ `%s` template this parameter is not supported", o.toChars()); + ti.error("internal compiler error: C++ `%s` template this parameter is not supported", o.toChars()); fatal(); } else @@ -995,7 +995,7 @@ private final class CppMangleVisitor : Visitor // fake mangling for fields to fix https://issues.dlang.org/show_bug.cgi?id=16525 if (!(d.storage_class & (STC.extern_ | STC.field | STC.gshared))) { - d.error("Internal Compiler Error: C++ static non-`__gshared` non-`extern` variables not supported"); + d.error("internal compiler error: C++ static non-`__gshared` non-`extern` variables not supported"); fatal(); } Dsymbol p = d.toParent(); @@ -1330,7 +1330,7 @@ private final class CppMangleVisitor : Visitor if (t.ty == Tsarray) { // Static arrays in D are passed by value; no counterpart in C++ - .error(loc, "Internal Compiler Error: unable to pass static array `%s` to extern(C++) function, use pointer instead", + .error(loc, "internal compiler error: unable to pass static array `%s` to extern(C++) function, use pointer instead", t.toChars()); fatal(); } @@ -1369,7 +1369,7 @@ private final class CppMangleVisitor : Visitor p = "`shared` "; else p = ""; - .error(loc, "Internal Compiler Error: %stype `%s` cannot be mapped to C++\n", p, t.toChars()); + .error(loc, "internal compiler error: %stype `%s` cannot be mapped to C++\n", p, t.toChars()); fatal(); //Fatal, because this error should be handled in frontend } diff --git a/gcc/d/dmd/dcast.d b/gcc/d/dmd/dcast.d index 8397839..c0a86f5 100644 --- a/gcc/d/dmd/dcast.d +++ b/gcc/d/dmd/dcast.d @@ -1695,14 +1695,6 @@ Expression castTo(Expression e, Scope* sc, Type t, Type att = null) { // T[n] sa; // cast(U[])sa; // ==> cast(U[])sa[]; - if (global.params.useDIP1000 == FeatureState.enabled) - { - if (auto v = expToVariable(e)) - { - if (e.type.hasPointers() && !checkAddressVar(sc, e, v)) - goto Lfail; - } - } const fsize = t1b.nextOf().size(); const tsize = tob.nextOf().size(); if (fsize == SIZE_INVALID || tsize == SIZE_INVALID) @@ -2236,7 +2228,7 @@ Expression castTo(Expression e, Scope* sc, Type t, Type att = null) ArrayLiteralExp ae = e; Type tb = t.toBasetype(); - if (tb.ty == Tarray && global.params.useDIP1000 == FeatureState.enabled) + if (tb.ty == Tarray) { if (checkArrayLiteralEscape(sc, ae, false)) { @@ -2782,9 +2774,8 @@ Expression scaleFactor(BinExp be, Scope* sc) if (eoff.op == EXP.int64 && eoff.toInteger() == 0) { } - else if (sc.func.setUnsafe()) + else if (sc.func.setUnsafe(false, be.loc, "pointer arithmetic not allowed in @safe functions")) { - be.error("pointer arithmetic not allowed in @safe functions"); return ErrorExp.get(); } } diff --git a/gcc/d/dmd/dclass.d b/gcc/d/dmd/dclass.d index 15ac8d9..a4a2abf 100644 --- a/gcc/d/dmd/dclass.d +++ b/gcc/d/dmd/dclass.d @@ -984,7 +984,7 @@ extern (C++) class ClassDeclaration : AggregateDeclaration auto var = new VarDeclaration(loc, vtype, Identifier.idPool("__vtbl"), null, STC.immutable_ | STC.static_); var.addMember(null, this); var.isdataseg = 1; - var.linkage = LINK.d; + var._linkage = LINK.d; var.semanticRun = PASS.semanticdone; // no more semantic wanted vtblsym = var; } diff --git a/gcc/d/dmd/declaration.d b/gcc/d/dmd/declaration.d index a533d30..bb0feb6 100644 --- a/gcc/d/dmd/declaration.d +++ b/gcc/d/dmd/declaration.d @@ -221,7 +221,7 @@ extern (C++) abstract class Declaration : Dsymbol Type originalType; // before semantic analysis StorageClass storage_class = STC.undefined_; Visibility visibility; - LINK linkage = LINK.default_; + LINK _linkage = LINK.default_; // may be `LINK.system`; use `resolvedLinkage()` to resolve it short inuse; // used to detect cycles ubyte adFlags; // control re-assignment of AliasDeclaration (put here for packing reasons) @@ -336,7 +336,7 @@ extern (C++) abstract class Declaration : Dsymbol { if (ctor.isCpCtor && ctor.isGenerated()) { - .error(loc, "Generating an `inout` copy constructor for `struct %s` failed, therefore instances of it are uncopyable", parent.toPrettyChars()); + .error(loc, "generating an `inout` copy constructor for `struct %s` failed, therefore instances of it are uncopyable", parent.toPrettyChars()); return true; } } @@ -420,6 +420,12 @@ extern (C++) abstract class Declaration : Dsymbol return (storage_class & STC.static_) != 0; } + /// Returns the linkage, resolving the target-specific `System` one. + final LINK resolvedLinkage() const + { + return _linkage == LINK.system ? target.systemLinkage() : _linkage; + } + bool isDelete() { return false; @@ -1506,7 +1512,7 @@ extern (C++) class VarDeclaration : Declaration uint oldgag = global.gag; if (global.gag) { - Dsymbol sym = toParent().isAggregateDeclaration(); + Dsymbol sym = isMember(); if (sym && !sym.isSpeculative()) global.gag = 0; } @@ -1691,6 +1697,32 @@ extern (C++) class BitFieldDeclaration : VarDeclaration v.visit(this); } + /*********************************** + * Retrieve the .min or .max values. + * Only valid after semantic analysis. + * Params: + * id = Id.min or Id.max + * Returns: + * the min or max value + */ + final ulong getMinMax(Identifier id) + { + const width = fieldWidth; + const uns = type.isunsigned(); + const min = id == Id.min; + ulong v; + assert(width != 0); // should have been rejected in semantic pass + if (width == ulong.sizeof * 8) + v = uns ? (min ? ulong.min : ulong.max) + : (min ? long.min : long.max); + else + v = uns ? (min ? 0 + : (1L << width) - 1) + : (min ? -(1L << (width - 1)) + : (1L << (width - 1)) - 1); + return v; + } + override final void setFieldOffset(AggregateDeclaration ad, ref FieldState fieldState, bool isunion) { //printf("BitFieldDeclaration::setFieldOffset(ad: %s, field: %s)\n", ad.toChars(), toChars()); @@ -1919,7 +1951,7 @@ extern (C++) class TypeInfoDeclaration : VarDeclaration this.tinfo = tinfo; storage_class = STC.static_ | STC.gshared; visibility = Visibility(Visibility.Kind.public_); - linkage = LINK.c; + _linkage = LINK.c; alignment.set(target.ptrsize); } diff --git a/gcc/d/dmd/declaration.h b/gcc/d/dmd/declaration.h index 441a966..0bde33d 100644 --- a/gcc/d/dmd/declaration.h +++ b/gcc/d/dmd/declaration.h @@ -28,6 +28,7 @@ struct Ensure class FuncDeclaration; class StructDeclaration; struct IntRange; +struct AttributeViolation; //enum STC : ulong from astenums.d: @@ -115,7 +116,7 @@ public: Type *originalType; // before semantic analysis StorageClass storage_class; Visibility visibility; - LINK linkage; + LINK _linkage; // may be `LINK::system`; use `resolvedLinkage()` to resolve it short inuse; // used to detect cycles uint8_t adFlags; Symbol* isym; // import version of csym @@ -127,6 +128,7 @@ public: Dsymbol *search(const Loc &loc, Identifier *ident, int flags = SearchLocalsOnly); bool isStatic() const { return (storage_class & STCstatic) != 0; } + LINK resolvedLinkage() const; // returns the linkage, resolving the target-specific `System` one virtual bool isDelete(); virtual bool isDataseg(); virtual bool isThreadlocal(); @@ -612,6 +614,10 @@ public: FuncDeclarations *inlinedNestedCallees; +private: + AttributeViolation* safetyViolation; +public: + unsigned flags; // FUNCFLAGxxxxx // Data for a function declaration that is needed for the Objective-C @@ -655,6 +661,7 @@ public: bool isNRVO() const; void isNRVO(bool v); bool isNaked() const; + void isNaked(bool v); bool isGenerated() const; void isGenerated(bool v); bool isIntroducing() const; @@ -664,7 +671,9 @@ public: bool hasDualContext() const; bool hasAlwaysInlines() const; bool isCrtCtor() const; + void isCrtCtor(bool v); bool isCrtDtor() const; + void isCrtDtor(bool v); virtual bool isNested() const; AggregateDeclaration *isThis(); diff --git a/gcc/d/dmd/dinterpret.d b/gcc/d/dmd/dinterpret.d index 3cfc07a..5e7527d 100644 --- a/gcc/d/dmd/dinterpret.d +++ b/gcc/d/dmd/dinterpret.d @@ -674,8 +674,20 @@ private Expression interpretFunction(UnionExp* pue, FuncDeclaration fd, InterSta } } // If fell off the end of a void function, return void - if (!e && tf.next.ty == Tvoid) - e = CTFEExp.voidexp; + if (!e) + { + if (tf.next.ty == Tvoid) + e = CTFEExp.voidexp; + else + { + /* missing a return statement can happen with C functions + * https://issues.dlang.org/show_bug.cgi?id=23056 + */ + fd.error("no return value from function"); + e = CTFEExp.cantexp; + } + } + if (tf.isref && e.op == EXP.variable && e.isVarExp().var == fd.vthis) e = thisarg; if (tf.isref && fd.hasDualContext() && e.op == EXP.index) @@ -695,7 +707,6 @@ private Expression interpretFunction(UnionExp* pue, FuncDeclaration fd, InterSta } } } - assert(e !is null); // Leave the function --ctfeGlobals.callDepth; @@ -1038,6 +1049,21 @@ public: if (exceptionOrCant(e)) return; + /** + * Interpret `return a ~= b` (i.e. `return _d_arrayappendT{,Trace}(a, b)`) as: + * a ~= b; + * return a; + * This is needed because `a ~= b` has to be interpreted as an lvalue, in order to avoid + * assigning a larger array into a smaller one, such as: + * `a = [1, 2], a ~= [3]` => `[1, 2] ~= [3]` => `[1, 2] = [1, 2, 3]` + */ + if (isRuntimeHook(s.exp, Id._d_arrayappendT) || isRuntimeHook(s.exp, Id._d_arrayappendTTrace)) + { + auto rs = new ReturnStatement(s.loc, e); + rs.accept(this); + return; + } + // Disallow returning pointers to stack-allocated variables (bug 7876) if (!stopPointersEscaping(s.loc, e)) { @@ -4826,6 +4852,33 @@ public: result = interpret(ce, istate); return; } + else if (fd.ident == Id._d_arrayappendT || fd.ident == Id._d_arrayappendTTrace) + { + // In expressionsem.d `ea ~= eb` was lowered to `_d_arrayappendT{,Trace}({file, line, funcname}, ea, eb);`. + // The following code will rewrite it back to `ea ~= eb` and then interpret that expression. + Expression lhs, rhs; + + if (fd.ident == Id._d_arrayappendT) + { + assert(e.arguments.dim == 2); + lhs = (*e.arguments)[0]; + rhs = (*e.arguments)[1]; + } + else + { + assert(e.arguments.dim == 5); + lhs = (*e.arguments)[3]; + rhs = (*e.arguments)[4]; + } + + auto cae = new CatAssignExp(e.loc, lhs, rhs); + cae.type = e.type; + + result = interpretRegion(cae, istate, CTFEGoal.LValue); + return; + } + else if (fd.ident == Id._d_arrayappendcTX) + assert(0, "CTFE cannot interpret _d_arrayappendcTX!"); } else if (auto soe = ecall.isSymOffExp()) { @@ -4947,6 +5000,25 @@ public: printf("%s CommaExp::interpret() %s\n", e.loc.toChars(), e.toChars()); } + if (auto ce = isRuntimeHook(e.e1, Id._d_arrayappendcTX)) + { + // In expressionsem.d `arr ~= elem` was lowered to + // `_d_arrayappendcTX(arr, elem), arr[arr.length - 1] = elem, elem;`. + // The following code will rewrite it back to `arr ~= elem` + // and then interpret that expression. + assert(ce.arguments.dim == 2); + + auto arr = (*ce.arguments)[0]; + auto elem = e.e2.isConstructExp().e2; + assert(elem); + + auto cae = new CatAssignExp(e.loc, arr, elem); + cae.type = arr.type; + + result = interpret(cae, istate); + return; + } + // If it creates a variable, and there's no context for // the variable to be created in, we need to create one now. InterState istateComma; @@ -6119,7 +6191,7 @@ public: return; } - if (result.isStringExp()) + if (result.isStringExp() || result.isArrayLiteralExp()) return; if (result.op != EXP.address) @@ -6268,7 +6340,7 @@ public: result = (*se.elements)[i]; if (!result) { - e.error("Internal Compiler Error: null field `%s`", v.toChars()); + e.error("internal compiler error: null field `%s`", v.toChars()); result = CTFEExp.cantexp; return; } @@ -6359,6 +6431,33 @@ public: { assert(0); // This should never be interpreted } + + /********************************************* + * Checks if the given expresion is a call to the runtime hook `id`. + * Params: + * e = the expression to check + * id = the identifier of the runtime hook + * Returns: + * `e` cast to `CallExp` if it's the hook, `null` otherwise + */ + private CallExp isRuntimeHook(Expression e, Identifier id) + { + if (auto ce = e.isCallExp()) + { + if (auto ve = ce.e1.isVarExp()) + { + if (auto fd = ve.var.isFuncDeclaration()) + { + // If `_d_HookTraceImpl` is found, resolve the underlying + // hook and replace `e` and `fd` with it. + removeHookTraceImpl(ce, fd); + return fd.ident == id ? ce : null; + } + } + } + + return null; + } } /******************************************** diff --git a/gcc/d/dmd/dmangle.d b/gcc/d/dmd/dmangle.d index 1f895e0..7604296 100644 --- a/gcc/d/dmd/dmangle.d +++ b/gcc/d/dmd/dmangle.d @@ -1335,15 +1335,19 @@ void realToMangleBuffer(OutBuffer* buf, real_t value) private extern (D) const(char)[] externallyMangledIdentifier(Declaration d) { + assert(!d.mangleOverride, "mangle overrides should have been handled earlier"); + + const linkage = d.resolvedLinkage(); const par = d.toParent(); //toParent() skips over mixin templates - if (!par || par.isModule() || d.linkage == LINK.cpp || - (d.linkage == LINK.c && d.isCsymbol() && d.isFuncDeclaration())) + if (!par || par.isModule() || linkage == LINK.cpp || + (linkage == LINK.c && d.isCsymbol() && + (d.isFuncDeclaration() || + (d.isVarDeclaration() && d.isDataseg() && d.storage_class & STC.extern_)))) { - if (d.linkage != LINK.d && d.localNum) + if (linkage != LINK.d && d.localNum) d.error("the same declaration cannot be in multiple scopes with non-D linkage"); - const l = d.linkage == LINK.system ? target.systemLinkage() : d.linkage; - final switch (l) + final switch (linkage) { case LINK.d: break; diff --git a/gcc/d/dmd/dmodule.d b/gcc/d/dmd/dmodule.d index 2d9f651..26a0ff0 100644 --- a/gcc/d/dmd/dmodule.d +++ b/gcc/d/dmd/dmodule.d @@ -71,7 +71,7 @@ void semantic3OnDependencies(Module m) */ void removeHdrFilesAndFail(ref Param params, ref Modules modules) nothrow { - if (params.doHdrGeneration) + if (params.dihdr.doOutput) { foreach (m; modules) { @@ -472,7 +472,7 @@ extern (C++) final class Module : Package if (doDocComment) setDocfile(); if (doHdrGen) - hdrfile = setOutfilename(global.params.hdrname, global.params.hdrdir, arg, hdr_ext); + hdrfile = setOutfilename(global.params.dihdr.name, global.params.dihdr.dir, arg, hdr_ext); } extern (D) this(const(char)[] filename, Identifier ident, int doDocComment, int doHdrGen) @@ -584,7 +584,7 @@ extern (C++) final class Module : Package extern (D) void setDocfile() { - docfile = setOutfilename(global.params.docname, global.params.docdir, arg, doc_ext); + docfile = setOutfilename(global.params.ddoc.name, global.params.ddoc.dir, arg, doc_ext); } /** @@ -662,11 +662,55 @@ extern (C++) final class Module : Package return true; // already read //printf("Module::read('%s') file '%s'\n", toChars(), srcfile.toChars()); - if (auto result = global.fileManager.lookup(srcfile)) + + /* Preprocess the file if it's a .c file + */ + FileName filename = srcfile; + bool ifile = false; // did we generate a .i file + scope (exit) + { + if (ifile) + File.remove(filename.toChars()); // remove generated file + } + + if (global.preprocess && + FileName.equalsExt(srcfile.toString(), c_ext) && + FileName.exists(srcfile.toString())) + { + /* Look for "importc.h" by searching along import path. + * It should be in the same place as "object.d" + */ + const(char)* importc_h; + + foreach (entry; (global.path ? (*global.path)[] : null)) + { + auto f = FileName.combine(entry, "importc.h"); + if (FileName.exists(f) == 1) + { + importc_h = f; + break; + } + FileName.free(f); + } + + if (importc_h) + { + if (global.params.verbose) + message("include %s", importc_h); + } + else + { + error("cannot find \"importc.h\" along import path"); + fatal(); + } + filename = global.preprocess(srcfile, importc_h, global.params.cppswitches, ifile); // run C preprocessor + } + + if (auto result = global.fileManager.lookup(filename)) { this.src = result; - if (global.params.emitMakeDeps) - global.params.makeDeps.push(srcfile.toChars()); + if (global.params.makeDeps.doOutput) + global.params.makeDeps.files.push(srcfile.toChars()); return true; } diff --git a/gcc/d/dmd/doc.d b/gcc/d/dmd/doc.d index d05060d..6eb433e 100644 --- a/gcc/d/dmd/doc.d +++ b/gcc/d/dmd/doc.d @@ -384,11 +384,11 @@ extern(C++) void gendocfile(Module m) // Override with DDOCFILE specified in the sc.ini file char* p = getenv("DDOCFILE"); if (p) - global.params.ddocfiles.shift(p); + global.params.ddoc.files.shift(p); // Override with the ddoc macro files from the command line - for (size_t i = 0; i < global.params.ddocfiles.dim; i++) + for (size_t i = 0; i < global.params.ddoc.files.dim; i++) { - auto buffer = readFile(m.loc, global.params.ddocfiles[i]); + auto buffer = readFile(m.loc, global.params.ddoc.files[i]); // BUG: convert file contents to UTF-8 before use const data = buffer.data; //printf("file: '%.*s'\n", cast(int)data.length, data.ptr); @@ -628,7 +628,7 @@ private void escapeStrayParenthesis(Loc loc, OutBuffer* buf, size_t start, bool break; case '\\': // replace backslash-escaped parens with their macros - if (!inCode && respectBackslashEscapes && u+1 < buf.length && global.params.markdown) + if (!inCode && respectBackslashEscapes && u+1 < buf.length) { if ((*buf)[u+1] == '(' || (*buf)[u+1] == ')') { @@ -2317,8 +2317,6 @@ private void removeBlankLineMacro(ref OutBuffer buf, ref size_t iAt, ref size_t */ private bool replaceMarkdownThematicBreak(ref OutBuffer buf, ref size_t i, size_t iLineStart, const ref Loc loc) { - if (!global.params.markdown) - return false; const slice = buf[]; const c = buf[i]; @@ -2335,12 +2333,6 @@ private bool replaceMarkdownThematicBreak(ref OutBuffer buf, ref size_t i, size_ { if (j >= buf.length || buf[j] == '\n' || buf[j] == '\r') { - if (global.params.vmarkdown) - { - const s = buf[][i..j]; - message(loc, "Ddoc: converted '%.*s' to a thematic break", cast(int)s.length, s.ptr); - } - buf.remove(iLineStart, j - iLineStart); i = buf.insert(iLineStart, "$(HR)") - 1; return true; @@ -2361,9 +2353,6 @@ private bool replaceMarkdownThematicBreak(ref OutBuffer buf, ref size_t i, size_ */ private int detectAtxHeadingLevel(ref OutBuffer buf, const size_t i) { - if (!global.params.markdown) - return 0; - const iHeadingStart = i; const iAfterHashes = skipChars(buf, i, "#"); const headingLevel = cast(int) (iAfterHashes - iHeadingStart); @@ -2433,14 +2422,6 @@ private void removeAnyAtxHeadingSuffix(ref OutBuffer buf, size_t i) */ private void endMarkdownHeading(ref OutBuffer buf, size_t iStart, ref size_t iEnd, const ref Loc loc, ref int headingLevel) { - if (!global.params.markdown) - return; - if (global.params.vmarkdown) - { - const s = buf[][iStart..iEnd]; - message(loc, "Ddoc: added heading '%.*s'", cast(int)s.length, s.ptr); - } - char[5] heading = "$(H0 "; heading[3] = cast(char) ('0' + headingLevel); buf.insert(iStart, heading); @@ -2503,9 +2484,6 @@ private size_t endAllListsAndQuotes(ref OutBuffer buf, ref size_t i, ref Markdow */ private size_t replaceMarkdownEmphasis(ref OutBuffer buf, const ref Loc loc, ref MarkdownDelimiter[] inlineDelimiters, int downToLevel = 0) { - if (!global.params.markdown) - return 0; - size_t replaceEmphasisPair(ref MarkdownDelimiter start, ref MarkdownDelimiter end) { immutable count = start.count == 1 || end.count == 1 ? 1 : 2; @@ -2521,12 +2499,6 @@ private size_t replaceMarkdownEmphasis(ref OutBuffer buf, const ref Loc loc, ref if (!end.count) end.type = 0; - if (global.params.vmarkdown) - { - const s = buf[][iStart + count..iEnd]; - message(loc, "Ddoc: emphasized text '%.*s'", cast(int)s.length, s.ptr); - } - buf.remove(iStart, count); iEnd -= count; buf.remove(iEnd, count); @@ -2857,9 +2829,6 @@ private struct MarkdownList */ static MarkdownList parseItem(ref OutBuffer buf, size_t iLineStart, size_t i) { - if (!global.params.markdown) - return MarkdownList(); - if (buf[i] == '+' || buf[i] == '-' || buf[i] == '*') return parseUnorderedListItem(buf, iLineStart, i); else @@ -2931,15 +2900,6 @@ private struct MarkdownList i = iStart - 1; iLineStart = i; - if (global.params.vmarkdown) - { - size_t iEnd = iStart; - while (iEnd < buf.length && buf[iEnd] != '\r' && buf[iEnd] != '\n') - ++iEnd; - const s = buf[][iStart..iEnd]; - message(loc, "Ddoc: starting list item '%.*s'", cast(int)s.length, s.ptr); - } - return true; } @@ -3122,13 +3082,6 @@ private struct MarkdownLink immutable delta = replaceMarkdownEmphasis(buf, loc, inlineDelimiters, delimiterIndex); iEnd += delta; i += delta; - - if (global.params.vmarkdown) - { - const s = buf[][delimiter.iStart..iEnd]; - message(loc, "Ddoc: linking '%.*s' to '%.*s'", cast(int)s.length, s.ptr, cast(int)link.href.length, link.href.ptr); - } - link.replaceLink(buf, i, iEnd, delimiter); return true; } @@ -3532,9 +3485,6 @@ private struct MarkdownLink */ private void storeAndReplaceDefinition(ref OutBuffer buf, ref size_t i, size_t iEnd, ref MarkdownLinkReferences linkReferences, const ref Loc loc) { - if (global.params.vmarkdown) - message(loc, "Ddoc: found link reference '%.*s' to '%.*s'", cast(int)label.length, label.ptr, cast(int)href.length, href.ptr); - // Remove the definition and trailing whitespace iEnd = skipChars(buf, iEnd, " \t\r\n"); buf.remove(i, iEnd - i); @@ -4050,12 +4000,6 @@ private bool replaceTableRow(ref OutBuffer buf, size_t iStart, size_t iEnd, cons if (headerRow && cellCount != columnAlignments.length) return false; - if (headerRow && global.params.vmarkdown) - { - const s = buf[][iStart..iEnd]; - message(loc, "Ddoc: formatting table '%.*s'", cast(int)s.length, s.ptr); - } - void replaceTableCell(size_t iCellStart, size_t iCellEnd, int cellIndex, int di) { const eDelta = replaceMarkdownEmphasis(buf, loc, inlineDelimiters, di); @@ -4378,17 +4322,8 @@ private void highlightText(Scope* sc, Dsymbols* a, Loc loc, ref OutBuffer buf, s case '>': { - if (leadingBlank && (!inCode || quoteLevel) && global.params.markdown) + if (leadingBlank && (!inCode || quoteLevel)) { - if (!quoteLevel && global.params.vmarkdown) - { - size_t iEnd = i + 1; - while (iEnd < buf.length && buf[iEnd] != '\n') - ++iEnd; - const s = buf[][i .. iEnd]; - message(loc, "Ddoc: starting quote block with '%.*s'", cast(int)s.length, s.ptr); - } - lineQuoted = true; int lineQuoteLevel = 1; size_t iAfterDelimiters = i + 1; @@ -4488,7 +4423,7 @@ private void highlightText(Scope* sc, Dsymbols* a, Loc loc, ref OutBuffer buf, s } // Perhaps we're starting or ending a Markdown code block - if (leadingBlank && global.params.markdown && count >= 3) + if (leadingBlank && count >= 3) { bool moreBackticks = false; for (size_t j = iAfterDelimiter; !moreBackticks && j < buf.length; ++j) @@ -4548,7 +4483,7 @@ private void highlightText(Scope* sc, Dsymbols* a, Loc loc, ref OutBuffer buf, s case '~': { - if (leadingBlank && global.params.markdown) + if (leadingBlank) { // Perhaps we're starting or ending a Markdown code block const iAfterDelimiter = skipChars(buf, i, "~"); @@ -4613,7 +4548,7 @@ private void highlightText(Scope* sc, Dsymbols* a, Loc loc, ref OutBuffer buf, s // BUG: handle UTF PS and LS too if (c != c0 || iInfoString) { - if (global.params.markdown && !iInfoString && !inCode && i - istart >= 3) + if (!iInfoString && !inCode && i - istart >= 3) { // Start a Markdown info string, like ```ruby codeFenceLength = i - istart; @@ -4711,9 +4646,6 @@ private void highlightText(Scope* sc, Dsymbols* a, Loc loc, ref OutBuffer buf, s if (codeLanguage[j] == '\\' && ispunct(codeLanguage[j + 1])) codeLanguage = codeLanguage[0..j] ~ codeLanguage[j + 1..$]; - if (global.params.vmarkdown) - message(loc, "Ddoc: adding code block for language '%.*s'", cast(int)codeLanguage.length, codeLanguage.ptr); - i = buf.insert(i, "$(OTHER_CODE "); i = buf.insert(i, codeLanguage); i = buf.insert(i, ","); @@ -4779,7 +4711,7 @@ private void highlightText(Scope* sc, Dsymbols* a, Loc loc, ref OutBuffer buf, s case '*': { - if (inCode || inBacktick || !global.params.markdown) + if (inCode || inBacktick) { leadingBlank = false; break; @@ -4829,7 +4761,7 @@ private void highlightText(Scope* sc, Dsymbols* a, Loc loc, ref OutBuffer buf, s { leadingBlank = false; - if (inCode || !global.params.markdown) + if (inCode) break; if (i < buf.length-1 && buf[i+1] == '[') @@ -4842,7 +4774,7 @@ private void highlightText(Scope* sc, Dsymbols* a, Loc loc, ref OutBuffer buf, s } case '[': { - if (inCode || !global.params.markdown) + if (inCode) { leadingBlank = false; break; @@ -4860,7 +4792,7 @@ private void highlightText(Scope* sc, Dsymbols* a, Loc loc, ref OutBuffer buf, s { leadingBlank = false; - if (inCode || !global.params.markdown) + if (inCode) break; for (int d = cast(int) inlineDelimiters.length - 1; d >= 0; --d) @@ -4894,7 +4826,7 @@ private void highlightText(Scope* sc, Dsymbols* a, Loc loc, ref OutBuffer buf, s case '|': { - if (inCode || !global.params.markdown) + if (inCode) { leadingBlank = false; break; @@ -4909,16 +4841,13 @@ private void highlightText(Scope* sc, Dsymbols* a, Loc loc, ref OutBuffer buf, s case '\\': { leadingBlank = false; - if (inCode || i+1 >= buf.length || !global.params.markdown) + if (inCode || i+1 >= buf.length) break; /* Escape Markdown special characters */ char c1 = buf[i+1]; if (ispunct(c1)) { - if (global.params.vmarkdown) - message(loc, "Ddoc: backslash-escaped %c", c1); - buf.remove(i, 1); auto se = sc._module.escapetable.escapeChar(c1); diff --git a/gcc/d/dmd/dscope.d b/gcc/d/dmd/dscope.d index 6339a9e..b546e37 100644 --- a/gcc/d/dmd/dscope.d +++ b/gcc/d/dmd/dscope.d @@ -63,7 +63,6 @@ enum SCOPE free = 0x8000, /// is on free list fullinst = 0x10000, /// fully instantiate templates - alias_ = 0x20000, /// inside alias declaration. // The following are mutually exclusive printf = 0x4_0000, /// printf-style function diff --git a/gcc/d/dmd/dsymbol.d b/gcc/d/dmd/dsymbol.d index 74eaa1d..b006940 100644 --- a/gcc/d/dmd/dsymbol.d +++ b/gcc/d/dmd/dsymbol.d @@ -984,7 +984,7 @@ extern (C++) class Dsymbol : ASTNode */ uinteger_t size(const ref Loc loc) { - error("Dsymbol `%s` has no size", toChars()); + error("symbol `%s` has no size", toChars()); return SIZE_INVALID; } @@ -1641,6 +1641,32 @@ public: } } + + /***************************************** + * Returns: the symbols whose members have been imported, i.e. imported modules + * and template mixins. + * + * See_Also: importScope + */ + extern (D) final Dsymbols* getImportedScopes() nothrow @nogc @safe pure + { + return importedScopes; + } + + /***************************************** + * Returns: the array of visibilities associated with each imported scope. The + * length of the array matches the imported scopes array. + * + * See_Also: getImportedScopes + */ + extern (D) final Visibility.Kind[] getImportVisibilities() nothrow @nogc @safe pure + { + if (!importedScopes) + return null; + + return (() @trusted => visibilities[0 .. importedScopes.dim])(); + } + extern (D) final void addAccessiblePackage(Package p, Visibility visibility) nothrow { auto pary = visibility.kind == Visibility.Kind.private_ ? &privateAccessiblePackages : &accessiblePackages; diff --git a/gcc/d/dmd/dsymbolsem.d b/gcc/d/dmd/dsymbolsem.d index 5415401..5d88056 100644 --- a/gcc/d/dmd/dsymbolsem.d +++ b/gcc/d/dmd/dsymbolsem.d @@ -376,7 +376,7 @@ private extern(C++) final class DsymbolSemanticVisitor : Visitor // https://issues.dlang.org/show_bug.cgi?id=19482 if ((dsym.storage_class & (STC.foreach_ | STC.local)) == (STC.foreach_ | STC.local)) { - dsym.linkage = LINK.d; + dsym._linkage = LINK.d; dsym.visibility = Visibility(Visibility.Kind.public_); dsym.overlapped = false; // unset because it is modified early on this function dsym.userAttribDecl = null; // unset because it is set by Dsymbol.setScope() @@ -389,7 +389,7 @@ private extern(C++) final class DsymbolSemanticVisitor : Visitor dsym.storage_class |= (sc.stc & ~(STC.synchronized_ | STC.override_ | STC.abstract_ | STC.final_)); dsym.userAttribDecl = sc.userAttribDecl; dsym.cppnamespace = sc.namespace; - dsym.linkage = sc.linkage; + dsym._linkage = sc.linkage; dsym.visibility = sc.visibility; dsym.alignment = sc.alignment(); } @@ -472,8 +472,7 @@ private extern(C++) final class DsymbolSemanticVisitor : Visitor { if (dsym.storage_class & STC.gshared && !dsym.isMember()) { - if (sc.func.setUnsafe()) - dsym.error("__gshared not allowed in safe functions; use shared"); + sc.func.setUnsafe(false, dsym.loc, "__gshared not allowed in safe functions; use shared"); } } @@ -863,20 +862,18 @@ private extern(C++) final class DsymbolSemanticVisitor : Visitor if (dsym._init && dsym._init.isVoidInitializer() && (dsym.type.hasPointers() || dsym.type.hasInvariant())) // also computes type size { - if (sc.func.setUnsafe()) - { - if (dsym.type.hasPointers()) - dsym.error("`void` initializers for pointers not allowed in safe functions"); - else - dsym.error("`void` initializers for structs with invariants are not allowed in safe functions"); - } + if (dsym.type.hasPointers()) + sc.func.setUnsafe(false, dsym.loc, + "`void` initializers for pointers not allowed in safe functions"); + else + sc.func.setUnsafe(false, dsym.loc, + "`void` initializers for structs with invariants are not allowed in safe functions"); } else if (!dsym._init && !(dsym.storage_class & (STC.static_ | STC.extern_ | STC.gshared | STC.manifest | STC.field | STC.parameter)) && dsym.type.hasVoidInitPointers()) { - if (sc.func.setUnsafe()) - dsym.error("`void` initializers for pointers not allowed in safe functions"); + sc.func.setUnsafe(false, dsym.loc, "`void` initializers for pointers not allowed in safe functions"); } } @@ -891,6 +888,15 @@ private extern(C++) final class DsymbolSemanticVisitor : Visitor else if (dsym.storage_class & STC.manifest) dsym.error("manifest constants must have initializers"); + // Don't allow non-extern, non-__gshared variables to be interfaced with C++ + if (dsym._linkage == LINK.cpp && !(dsym.storage_class & (STC.ctfe | STC.extern_ | STC.gshared)) && dsym.isDataseg()) + { + const char* p = (dsym.storage_class & STC.shared_) ? "shared" : "static"; + dsym.error("cannot have `extern(C++)` linkage because it is `%s`", p); + errorSupplemental(dsym.loc, "perhaps declare it as `__gshared` instead"); + dsym.errors = true; + } + bool isBlit = false; uinteger_t sz; if (sc.flags & SCOPE.Cfile && !dsym._init) @@ -1191,7 +1197,7 @@ private extern(C++) final class DsymbolSemanticVisitor : Visitor override void visit(TypeInfoDeclaration dsym) { - assert(dsym.linkage == LINK.c); + assert(dsym._linkage == LINK.c); } override void visit(BitFieldDeclaration dsym) @@ -1204,6 +1210,11 @@ private extern(C++) final class DsymbolSemanticVisitor : Visitor if (dsym.errors) return; + if (!dsym.parent.isStructDeclaration() && !dsym.parent.isClassDeclaration()) + { + dsym.error("bit-field must be member of struct, union, or class"); + } + sc = sc.startCTFE(); auto width = dsym.width.expressionSemantic(sc); sc = sc.endCTFE(); @@ -1239,7 +1250,12 @@ private extern(C++) final class DsymbolSemanticVisitor : Visitor override void visit(Import imp) { - //printf("Import::semantic('%s') %s\n", toPrettyChars(), id.toChars()); + static if (LOG) + { + printf("Import::semantic('%s') %s\n", toPrettyChars(), id.toChars()); + scope(exit) + printf("-Import::semantic('%s'), pkg = %p\n", toChars(), pkg); + } if (imp.semanticRun > PASS.initial) return; @@ -1349,70 +1365,69 @@ private extern(C++) final class DsymbolSemanticVisitor : Visitor // don't list pseudo modules __entrypoint.d, __main.d // https://issues.dlang.org/show_bug.cgi?id=11117 // https://issues.dlang.org/show_bug.cgi?id=11164 - if (global.params.moduleDeps !is null && !(imp.id == Id.object && sc._module.ident == Id.object) && - strcmp(sc._module.ident.toChars(), "__main") != 0) - { - /* The grammar of the file is: - * ImportDeclaration - * ::= BasicImportDeclaration [ " : " ImportBindList ] [ " -> " - * ModuleAliasIdentifier ] "\n" - * - * BasicImportDeclaration - * ::= ModuleFullyQualifiedName " (" FilePath ") : " Protection|"string" - * " [ " static" ] : " ModuleFullyQualifiedName " (" FilePath ")" - * - * FilePath - * - any string with '(', ')' and '\' escaped with the '\' character - */ - OutBuffer* ob = global.params.moduleDeps; - Module imod = sc._module; - if (!global.params.moduleDepsFile) - ob.writestring("depsImport "); - ob.writestring(imod.toPrettyChars()); - ob.writestring(" ("); - escapePath(ob, imod.srcfile.toChars()); - ob.writestring(") : "); - // use visibility instead of sc.visibility because it couldn't be - // resolved yet, see the comment above - visibilityToBuffer(ob, imp.visibility); + if (global.params.moduleDeps.buffer is null || (imp.id == Id.object && sc._module.ident == Id.object) || + strcmp(sc._module.ident.toChars(), "__main") == 0) + return; + + /* The grammar of the file is: + * ImportDeclaration + * ::= BasicImportDeclaration [ " : " ImportBindList ] [ " -> " + * ModuleAliasIdentifier ] "\n" + * + * BasicImportDeclaration + * ::= ModuleFullyQualifiedName " (" FilePath ") : " Protection|"string" + * " [ " static" ] : " ModuleFullyQualifiedName " (" FilePath ")" + * + * FilePath + * - any string with '(', ')' and '\' escaped with the '\' character + */ + OutBuffer* ob = global.params.moduleDeps.buffer; + Module imod = sc._module; + if (!global.params.moduleDeps.name) + ob.writestring("depsImport "); + ob.writestring(imod.toPrettyChars()); + ob.writestring(" ("); + escapePath(ob, imod.srcfile.toChars()); + ob.writestring(") : "); + // use visibility instead of sc.visibility because it couldn't be + // resolved yet, see the comment above + visibilityToBuffer(ob, imp.visibility); + ob.writeByte(' '); + if (imp.isstatic) + { + stcToBuffer(ob, STC.static_); ob.writeByte(' '); - if (imp.isstatic) - { - stcToBuffer(ob, STC.static_); - ob.writeByte(' '); - } - ob.writestring(": "); - foreach (pid; imp.packages) - { - ob.printf("%s.", pid.toChars()); - } - ob.writestring(imp.id.toString()); - ob.writestring(" ("); - if (imp.mod) - escapePath(ob, imp.mod.srcfile.toChars()); + } + ob.writestring(": "); + foreach (pid; imp.packages) + { + ob.printf("%s.", pid.toChars()); + } + ob.writestring(imp.id.toString()); + ob.writestring(" ("); + if (imp.mod) + escapePath(ob, imp.mod.srcfile.toChars()); + else + ob.writestring("???"); + ob.writeByte(')'); + foreach (i, name; imp.names) + { + if (i == 0) + ob.writeByte(':'); else - ob.writestring("???"); - ob.writeByte(')'); - foreach (i, name; imp.names) + ob.writeByte(','); + Identifier _alias = imp.aliases[i]; + if (!_alias) { - if (i == 0) - ob.writeByte(':'); - else - ob.writeByte(','); - Identifier _alias = imp.aliases[i]; - if (!_alias) - { - ob.printf("%s", name.toChars()); - _alias = name; - } - else - ob.printf("%s=%s", _alias.toChars(), name.toChars()); + ob.printf("%s", name.toChars()); + _alias = name; } - if (imp.aliasId) - ob.printf(" -> %s", imp.aliasId.toChars()); - ob.writenl(); + else + ob.printf("%s=%s", _alias.toChars(), name.toChars()); } - //printf("-Import::semantic('%s'), pkg = %p\n", toChars(), pkg); + if (imp.aliasId) + ob.printf(" -> %s", imp.aliasId.toChars()); + ob.writenl(); } void attribSemantic(AttribDeclaration ad) @@ -1457,24 +1472,24 @@ private extern(C++) final class DsymbolSemanticVisitor : Visitor return; } - if (scd.decl) + if (!scd.decl) + return; + + sc = sc.push(); + sc.stc &= ~(STC.auto_ | STC.scope_ | STC.static_ | STC.gshared); + sc.inunion = scd.isunion ? scd : null; + sc.flags = 0; + for (size_t i = 0; i < scd.decl.dim; i++) { - sc = sc.push(); - sc.stc &= ~(STC.auto_ | STC.scope_ | STC.static_ | STC.gshared); - sc.inunion = scd.isunion ? scd : null; - sc.flags = 0; - for (size_t i = 0; i < scd.decl.dim; i++) + Dsymbol s = (*scd.decl)[i]; + if (auto var = s.isVarDeclaration) { - Dsymbol s = (*scd.decl)[i]; - if (auto var = s.isVarDeclaration) - { - if (scd.isunion) - var.overlapped = true; - } - s.dsymbolSemantic(sc); + if (scd.isunion) + var.overlapped = true; } - sc = sc.pop(); + s.dsymbolSemantic(sc); } + sc = sc.pop(); } override void visit(PragmaDeclaration pd) @@ -1633,32 +1648,33 @@ private extern(C++) final class DsymbolSemanticVisitor : Visitor } if (pd.ident == Id.msg) { - if (pd.args) + if (!pd.args) + return noDeclarations(); + + for (size_t i = 0; i < pd.args.dim; i++) { - for (size_t i = 0; i < pd.args.dim; i++) + Expression e = (*pd.args)[i]; + sc = sc.startCTFE(); + e = e.expressionSemantic(sc); + e = resolveProperties(sc, e); + sc = sc.endCTFE(); + e = ctfeInterpretForPragmaMsg(e); + if (e.op == EXP.error) { - Expression e = (*pd.args)[i]; - sc = sc.startCTFE(); - e = e.expressionSemantic(sc); - e = resolveProperties(sc, e); - sc = sc.endCTFE(); - e = ctfeInterpretForPragmaMsg(e); - if (e.op == EXP.error) - { - errorSupplemental(pd.loc, "while evaluating `pragma(msg, %s)`", (*pd.args)[i].toChars()); - return; - } - StringExp se = e.toStringExp(); - if (se) - { - se = se.toUTF8(sc); - fprintf(stderr, "%.*s", cast(int)se.len, se.peekString().ptr); - } - else - fprintf(stderr, "%s", e.toChars()); + errorSupplemental(pd.loc, "while evaluating `pragma(msg, %s)`", (*pd.args)[i].toChars()); + return; } - fprintf(stderr, "\n"); + StringExp se = e.toStringExp(); + if (se) + { + se = se.toUTF8(sc); + fprintf(stderr, "%.*s", cast(int)se.len, se.peekString().ptr); + } + else + fprintf(stderr, "%s", e.toChars()); } + fprintf(stderr, "\n"); + return noDeclarations(); } else if (pd.ident == Id.lib) @@ -1675,9 +1691,9 @@ private extern(C++) final class DsymbolSemanticVisitor : Visitor auto name = se.peekString().xarraydup; if (global.params.verbose) message("library %s", name.ptr); - if (global.params.moduleDeps && !global.params.moduleDepsFile) + if (global.params.moduleDeps.buffer && !global.params.moduleDeps.name) { - OutBuffer* ob = global.params.moduleDeps; + OutBuffer* ob = global.params.moduleDeps.buffer; Module imod = sc._module; ob.writestring("depsLib "); ob.writestring(imod.toPrettyChars()); @@ -1892,49 +1908,49 @@ private extern(C++) final class DsymbolSemanticVisitor : Visitor return Identifier.idPool(sident); } - if (ns.ident is null) - { - ns.cppnamespace = sc.namespace; - sc = sc.startCTFE(); - ns.exp = ns.exp.expressionSemantic(sc); - ns.exp = resolveProperties(sc, ns.exp); - sc = sc.endCTFE(); - ns.exp = ns.exp.ctfeInterpret(); - // Can be either a tuple of strings or a string itself - if (auto te = ns.exp.isTupleExp()) - { - expandTuples(te.exps); - CPPNamespaceDeclaration current = ns.cppnamespace; - for (size_t d = 0; d < te.exps.dim; ++d) + if (ns.ident !is null) + return attribSemantic(ns); + + ns.cppnamespace = sc.namespace; + sc = sc.startCTFE(); + ns.exp = ns.exp.expressionSemantic(sc); + ns.exp = resolveProperties(sc, ns.exp); + sc = sc.endCTFE(); + ns.exp = ns.exp.ctfeInterpret(); + // Can be either a tuple of strings or a string itself + if (auto te = ns.exp.isTupleExp()) + { + expandTuples(te.exps); + CPPNamespaceDeclaration current = ns.cppnamespace; + for (size_t d = 0; d < te.exps.dim; ++d) + { + auto exp = (*te.exps)[d]; + auto prev = d ? current : ns.cppnamespace; + current = (d + 1) != te.exps.dim + ? new CPPNamespaceDeclaration(ns.loc, exp, null) + : ns; + current.exp = exp; + current.cppnamespace = prev; + if (auto se = exp.toStringExp()) { - auto exp = (*te.exps)[d]; - auto prev = d ? current : ns.cppnamespace; - current = (d + 1) != te.exps.dim - ? new CPPNamespaceDeclaration(ns.loc, exp, null) - : ns; - current.exp = exp; - current.cppnamespace = prev; - if (auto se = exp.toStringExp()) - { - current.ident = identFromSE(se); - if (current.ident is null) - return; // An error happened in `identFromSE` - } - else - ns.exp.error("`%s`: index %llu is not a string constant, it is a `%s`", - ns.exp.toChars(), cast(ulong) d, ns.exp.type.toChars()); + current.ident = identFromSE(se); + if (current.ident is null) + return; // An error happened in `identFromSE` } + else + ns.exp.error("`%s`: index %llu is not a string constant, it is a `%s`", + ns.exp.toChars(), cast(ulong) d, ns.exp.type.toChars()); } - else if (auto se = ns.exp.toStringExp()) - ns.ident = identFromSE(se); - // Empty Tuple - else if (ns.exp.isTypeExp() && ns.exp.isTypeExp().type.toBasetype().isTypeTuple()) - { - } - else - ns.exp.error("compile time string constant (or tuple) expected, not `%s`", - ns.exp.toChars()); } + else if (auto se = ns.exp.toStringExp()) + ns.ident = identFromSE(se); + // Empty Tuple + else if (ns.exp.isTypeExp() && ns.exp.isTypeExp().type.toBasetype().isTypeTuple()) + { + } + else + ns.exp.error("compile time string constant (or tuple) expected, not `%s`", + ns.exp.toChars()); attribSemantic(ns); } @@ -2174,7 +2190,7 @@ private extern(C++) final class DsymbolSemanticVisitor : Visitor em.semanticRun = PASS.semantic; em.type = Type.tint32; - em.linkage = LINK.c; + em._linkage = LINK.c; em.storage_class |= STC.manifest; if (em.value) { @@ -2264,7 +2280,7 @@ private extern(C++) final class DsymbolSemanticVisitor : Visitor em.semanticRun = PASS.semantic; em.visibility = em.ed.isAnonymous() ? em.ed.visibility : Visibility(Visibility.Kind.public_); - em.linkage = LINK.d; + em._linkage = LINK.d; em.storage_class |= STC.manifest; // https://issues.dlang.org/show_bug.cgi?id=9701 @@ -2538,7 +2554,7 @@ private extern(C++) final class DsymbolSemanticVisitor : Visitor Scope* paramscope = sc.push(paramsym); paramscope.stc = 0; - if (global.params.doDocComments) + if (global.params.ddoc.doOutput) { tempdecl.origParameters = new TemplateParameters(tempdecl.parameters.dim); for (size_t i = 0; i < tempdecl.parameters.dim; i++) @@ -2824,7 +2840,7 @@ private extern(C++) final class DsymbolSemanticVisitor : Visitor */ //if (!sc.func && Module.deferred.dim > deferred_dim) {} - AggregateDeclaration ad = tm.toParent().isAggregateDeclaration(); + AggregateDeclaration ad = tm.isMember(); if (sc.func && !ad) { tm.semantic2(sc2); @@ -2855,6 +2871,7 @@ private extern(C++) final class DsymbolSemanticVisitor : Visitor static if (LOG) { printf("+Nspace::semantic('%s')\n", ns.toChars()); + scope(exit) printf("-Nspace::semantic('%s')\n", ns.toChars()); } if (ns._scope) { @@ -2931,36 +2948,34 @@ private extern(C++) final class DsymbolSemanticVisitor : Visitor // Link does not matter here, if the UDA is present it will error UserAttributeDeclaration.checkGNUABITag(ns, LINK.cpp); - if (ns.members) + if (!ns.members) + { + ns.semanticRun = PASS.semanticdone; + return; + } + assert(sc); + sc = sc.push(ns); + sc.linkage = LINK.cpp; // note that namespaces imply C++ linkage + sc.parent = ns; + foreach (s; *ns.members) { - assert(sc); - sc = sc.push(ns); - sc.linkage = LINK.cpp; // note that namespaces imply C++ linkage - sc.parent = ns; - foreach (s; *ns.members) + if (repopulateMembers) { - if (repopulateMembers) - { - s.addMember(sc, sc.scopesym); - s.setScope(sc); - } - s.importAll(sc); + s.addMember(sc, sc.scopesym); + s.setScope(sc); } - foreach (s; *ns.members) + s.importAll(sc); + } + foreach (s; *ns.members) + { + static if (LOG) { - static if (LOG) - { - printf("\tmember '%s', kind = '%s'\n", s.toChars(), s.kind()); - } - s.dsymbolSemantic(sc); + printf("\tmember '%s', kind = '%s'\n", s.toChars(), s.kind()); } - sc.pop(); + s.dsymbolSemantic(sc); } + sc.pop(); ns.semanticRun = PASS.semanticdone; - static if (LOG) - { - printf("-Nspace::semantic('%s')\n", ns.toChars()); - } } void funcDeclarationSemantic(FuncDeclaration funcdecl) @@ -3024,7 +3039,7 @@ private extern(C++) final class DsymbolSemanticVisitor : Visitor if (sc.flags & SCOPE.compile) funcdecl.flags |= FUNCFLAG.compileTimeOnly; // don't emit code for this function - funcdecl.linkage = sc.linkage; + funcdecl._linkage = sc.linkage; if (auto fld = funcdecl.isFuncLiteralDeclaration()) { if (fld.treq) @@ -3037,7 +3052,7 @@ private extern(C++) final class DsymbolSemanticVisitor : Visitor fld.tok = TOK.function_; else assert(0); - funcdecl.linkage = treq.nextOf().toTypeFunction().linkage; + funcdecl._linkage = treq.nextOf().toTypeFunction().linkage; } } @@ -3045,19 +3060,9 @@ private extern(C++) final class DsymbolSemanticVisitor : Visitor if (auto pragmadecl = sc.inlining) funcdecl.inlining = pragmadecl.evalPragmaInline(sc); - // check pragma(crt_constructor) - if (funcdecl.flags & (FUNCFLAG.CRTCtor | FUNCFLAG.CRTDtor)) - { - if (funcdecl.linkage != LINK.c) - { - funcdecl.error("must be `extern(C)` for `pragma(%s)`", - (funcdecl.flags & FUNCFLAG.CRTCtor) ? "crt_constructor".ptr : "crt_destructor".ptr); - } - } - funcdecl.visibility = sc.visibility; funcdecl.userAttribDecl = sc.userAttribDecl; - UserAttributeDeclaration.checkGNUABITag(funcdecl, funcdecl.linkage); + UserAttributeDeclaration.checkGNUABITag(funcdecl, funcdecl._linkage); checkMustUseReserved(funcdecl); if (!funcdecl.originalType) @@ -3193,7 +3198,7 @@ private extern(C++) final class DsymbolSemanticVisitor : Visitor tf.isScopeQual = false; } - sc.linkage = funcdecl.linkage; + sc.linkage = funcdecl._linkage; if (!tf.isNaked() && !(funcdecl.isThis() || funcdecl.isNested())) { @@ -3243,6 +3248,16 @@ private extern(C++) final class DsymbolSemanticVisitor : Visitor funcdecl.storage_class &= ~(STC.TYPECTOR | STC.FUNCATTR); } + // check pragma(crt_constructor) signature + if (funcdecl.flags & (FUNCFLAG.CRTCtor | FUNCFLAG.CRTDtor)) + { + const idStr = (funcdecl.flags & FUNCFLAG.CRTCtor) ? "crt_constructor" : "crt_destructor"; + if (f.nextOf().ty != Tvoid) + funcdecl.error("must return `void` for `pragma(%s)`", idStr.ptr); + if (funcdecl._linkage != LINK.c && f.parameterList.length != 0) + funcdecl.error("must be `extern(C)` for `pragma(%s)` when taking parameters", idStr.ptr); + } + if (funcdecl.overnext && funcdecl.isCsymbol()) { /* C does not allow function overloading, but it does allow @@ -4027,67 +4042,67 @@ private extern(C++) final class DsymbolSemanticVisitor : Visitor */ if (ad && (!ctd.parent.isTemplateInstance() || ctd.parent.isTemplateMixin())) { - if (sd) + if (!sd) { - if (dim == 0 && tf.parameterList.varargs == VarArg.none) // empty default ctor w/o any varargs - { - if (ctd.fbody || !(ctd.storage_class & STC.disable)) - { - ctd.error("default constructor for structs only allowed " ~ - "with `@disable`, no body, and no parameters"); - ctd.storage_class |= STC.disable; - ctd.fbody = null; - } - sd.noDefaultCtor = true; - } - else if (dim == 0 && tf.parameterList.varargs != VarArg.none) // allow varargs only ctor - { - } - else if (dim && tf.parameterList[0].defaultArg) + if (dim == 0 && tf.parameterList.varargs == VarArg.none) + ad.defaultCtor = ctd; + return; + } + + if (dim == 0 && tf.parameterList.varargs == VarArg.none) // empty default ctor w/o any varargs + { + if (ctd.fbody || !(ctd.storage_class & STC.disable)) { - // if the first parameter has a default argument, then the rest does as well - if (ctd.storage_class & STC.disable) - { - ctd.error("is marked `@disable`, so it cannot have default "~ - "arguments for all parameters."); - errorSupplemental(ctd.loc, "Use `@disable this();` if you want to disable default initialization."); - } - else - ctd.error("all parameters have default arguments, "~ - "but structs cannot have default constructors."); + ctd.error("default constructor for structs only allowed " ~ + "with `@disable`, no body, and no parameters"); + ctd.storage_class |= STC.disable; + ctd.fbody = null; } - else if ((dim == 1 || (dim > 1 && tf.parameterList[1].defaultArg))) + sd.noDefaultCtor = true; + } + else if (dim == 0 && tf.parameterList.varargs != VarArg.none) // allow varargs only ctor + { + } + else if (dim && tf.parameterList[0].defaultArg) + { + // if the first parameter has a default argument, then the rest does as well + if (ctd.storage_class & STC.disable) { - //printf("tf: %s\n", tf.toChars()); - auto param = tf.parameterList[0]; - if (param.storageClass & STC.ref_ && param.type.mutableOf().unSharedOf() == sd.type.mutableOf().unSharedOf()) - { - //printf("copy constructor\n"); - ctd.isCpCtor = true; - } + ctd.error("is marked `@disable`, so it cannot have default "~ + "arguments for all parameters."); + errorSupplemental(ctd.loc, "Use `@disable this();` if you want to disable default initialization."); } + else + ctd.error("all parameters have default arguments, "~ + "but structs cannot have default constructors."); } - else if (dim == 0 && tf.parameterList.varargs == VarArg.none) + else if ((dim == 1 || (dim > 1 && tf.parameterList[1].defaultArg))) { - ad.defaultCtor = ctd; + //printf("tf: %s\n", tf.toChars()); + auto param = tf.parameterList[0]; + if (param.storageClass & STC.ref_ && param.type.mutableOf().unSharedOf() == sd.type.mutableOf().unSharedOf()) + { + //printf("copy constructor\n"); + ctd.isCpCtor = true; + } } } // https://issues.dlang.org/show_bug.cgi?id=22593 else if (auto ti = ctd.parent.isTemplateInstance()) { - if (sd && sd.hasCopyCtor && (dim == 1 || (dim > 1 && tf.parameterList[1].defaultArg))) - { - auto param = tf.parameterList[0]; + if (!sd || !sd.hasCopyCtor || !(dim == 1 || (dim > 1 && tf.parameterList[1].defaultArg))) + return; - // if the template instance introduces an rvalue constructor - // between the members of a struct declaration, we should check if a - // copy constructor exists and issue an error in that case. - if (!(param.storageClass & STC.ref_) && param.type.mutableOf().unSharedOf() == sd.type.mutableOf().unSharedOf()) - { - .error(ctd.loc, "Cannot define both an rvalue constructor and a copy constructor for `struct %s`", sd.toChars); - .errorSupplemental(ti.loc, "Template instance `%s` creates a rvalue constructor for `struct %s`", - ti.toChars(), sd.toChars()); - } + auto param = tf.parameterList[0]; + + // if the template instance introduces an rvalue constructor + // between the members of a struct declaration, we should check if a + // copy constructor exists and issue an error in that case. + if (!(param.storageClass & STC.ref_) && param.type.mutableOf().unSharedOf() == sd.type.mutableOf().unSharedOf()) + { + .error(ctd.loc, "cannot define both an rvalue constructor and a copy constructor for `struct %s`", sd.toChars); + .errorSupplemental(ti.loc, "Template instance `%s` creates a rvalue constructor for `struct %s`", + ti.toChars(), sd.toChars()); } } } @@ -6417,13 +6432,8 @@ void aliasSemantic(AliasDeclaration ds, Scope* sc) ds.visibility = sc.visibility; ds.userAttribDecl = sc.userAttribDecl; - // TypeTraits needs to know if it's located in an AliasDeclaration - const oldflags = sc.flags; - sc.flags |= SCOPE.alias_; - void normalRet() { - sc.flags = oldflags; ds.inuse = 0; ds.semanticRun = PASS.semanticdone; diff --git a/gcc/d/dmd/dtemplate.d b/gcc/d/dmd/dtemplate.d index fb41e2b..ed0126e 100644 --- a/gcc/d/dmd/dtemplate.d +++ b/gcc/d/dmd/dtemplate.d @@ -2777,7 +2777,7 @@ void functionResolve(ref MatchAccumulator m, Dsymbol dstart, Loc loc, Scope* sc, fd.storage_class == m.lastf.storage_class && fd.parent == m.lastf.parent && fd.visibility == m.lastf.visibility && - fd.linkage == m.lastf.linkage) + fd._linkage == m.lastf._linkage) { if (fd.fbody && !m.lastf.fbody) goto LfIsBetter; diff --git a/gcc/d/dmd/dtoh.d b/gcc/d/dmd/dtoh.d index 41fb82b..55f7c72 100644 --- a/gcc/d/dmd/dtoh.d +++ b/gcc/d/dmd/dtoh.d @@ -82,7 +82,7 @@ extern(C++) void genCppHdrFiles(ref Modules ms) foreach (m; ms) m.accept(v); - if (global.params.doCxxHdrGeneration == CxxHeaderMode.verbose) + if (global.params.cxxhdr.fullOutput) buf.printf("// Automatically generated by %s Compiler v%d", global.vendor.ptr, global.versionNumber()); else buf.printf("// Automatically generated by %s Compiler", global.vendor.ptr); @@ -92,9 +92,9 @@ extern(C++) void genCppHdrFiles(ref Modules ms) buf.writestringln("#pragma once"); buf.writenl(); hashInclude(buf, "<assert.h>"); + hashInclude(buf, "<math.h>"); hashInclude(buf, "<stddef.h>"); hashInclude(buf, "<stdint.h>"); - hashInclude(buf, "<math.h>"); // buf.writestring(buf, "#include <stdio.h>\n"); // buf.writestring("#include <string.h>\n"); @@ -189,7 +189,7 @@ struct _d_dynamicArray final buf.remove(buf.length - 1, 1); - if (global.params.cxxhdrname is null) + if (global.params.cxxhdr.name is null) { // Write to stdout; assume it succeeds size_t n = fwrite(buf[].ptr, 1, buf.length, stdout); @@ -197,7 +197,7 @@ struct _d_dynamicArray final } else { - const(char)[] name = FileName.combine(global.params.cxxhdrdir, global.params.cxxhdrname); + const(char)[] name = FileName.combine(global.params.cxxhdr.dir, global.params.cxxhdr.name); writeFile(Loc.initial, name, buf[]); } } @@ -297,7 +297,7 @@ public: this.fwdbuf = fwdbuf; this.donebuf = donebuf; this.buf = buf; - this.printIgnored = global.params.doCxxHdrGeneration == CxxHeaderMode.verbose; + this.printIgnored = global.params.cxxhdr.fullOutput; } /** @@ -966,12 +966,13 @@ public: if (vd.storage_class & (AST.STC.static_ | AST.STC.extern_ | AST.STC.gshared) || vd.parent && vd.parent.isModule()) { - if (vd.linkage != LINK.c && vd.linkage != LINK.cpp && !(tdparent && (this.linkage == LINK.c || this.linkage == LINK.cpp))) + const vdLinkage = vd.resolvedLinkage(); + if (vdLinkage != LINK.c && vdLinkage != LINK.cpp && !(tdparent && (this.linkage == LINK.c || this.linkage == LINK.cpp))) { ignored("variable %s because of linkage", vd.toPrettyChars()); return; } - if (vd.mangleOverride && vd.linkage != LINK.c) + if (vd.mangleOverride && vdLinkage != LINK.c) { ignored("variable %s because C++ doesn't support explicit mangling", vd.toPrettyChars()); return; @@ -987,7 +988,7 @@ public: return; } writeProtection(vd.visibility.kind); - if (vd.linkage == LINK.c) + if (vdLinkage == LINK.c) buf.writestring("extern \"C\" "); else if (!adparent) buf.writestring("extern "); @@ -2302,7 +2303,7 @@ public: this.forwarding = fwdStash; } - if (p.storageClass & AST.STC.ref_) + if (p.storageClass & (AST.STC.ref_ | AST.STC.out_)) buf.writeByte('&'); buf.writeByte(' '); if (ident) @@ -2805,7 +2806,10 @@ public: // Check against the internal information which might be missing, e.g. inside of template declarations if (auto dec = sym.isDeclaration()) - return dec.linkage == LINK.cpp || dec.linkage == LINK.c; + { + const l = dec.resolvedLinkage(); + return l == LINK.cpp || l == LINK.c; + } if (auto ad = sym.isAggregateDeclaration()) return ad.classKind == ClassKind.cpp; @@ -2853,8 +2857,11 @@ public: if (!res) { // Check against the internal information which might be missing, e.g. inside of template declarations - auto dec = sym.isDeclaration(); - res = dec && (dec.linkage == LINK.cpp || dec.linkage == LINK.c); + if (auto dec = sym.isDeclaration()) + { + const l = dec.resolvedLinkage(); + res = (l == LINK.cpp || l == LINK.c); + } } // Remember result for later calls diff --git a/gcc/d/dmd/escape.d b/gcc/d/dmd/escape.d index 44c3757..3f41c29 100644 --- a/gcc/d/dmd/escape.d +++ b/gcc/d/dmd/escape.d @@ -280,13 +280,14 @@ bool checkAssocArrayLiteralEscape(Scope *sc, AssocArrayLiteralExp ae, bool gag) * sc = used to determine current function and module * fdc = function being called, `null` if called indirectly * par = function parameter (`this` if null) + * parStc = storage classes of function parameter (may have added `scope` from `pure`) * arg = initializer for param * assertmsg = true if the parameter is the msg argument to assert(bool, msg). * gag = do not print error messages * Returns: * `true` if pointers to the stack can escape via assignment */ -bool checkParamArgumentEscape(Scope* sc, FuncDeclaration fdc, Parameter par, Expression arg, bool assertmsg, bool gag) +bool checkParamArgumentEscape(Scope* sc, FuncDeclaration fdc, Parameter par, STC parStc, Expression arg, bool assertmsg, bool gag) { enum log = false; if (log) printf("checkParamArgumentEscape(arg: %s par: %s)\n", @@ -301,42 +302,38 @@ bool checkParamArgumentEscape(Scope* sc, FuncDeclaration fdc, Parameter par, Exp escapeByValue(arg, &er); + if (parStc & STC.scope_) + { + // These errors only apply to non-scope parameters + // When the paraneter is `scope`, only `checkScopeVarAddr` on `er.byref` is needed + er.byfunc.setDim(0); + er.byvalue.setDim(0); + er.byexp.setDim(0); + } + if (!er.byref.dim && !er.byvalue.dim && !er.byfunc.dim && !er.byexp.dim) return false; bool result = false; - ScopeRef psr; - if (par && fdc && fdc.type.isTypeFunction()) - psr = buildScopeRef(par.storageClass); - else - psr = ScopeRef.None; - /* 'v' is assigned unsafely to 'par' */ - void unsafeAssign(VarDeclaration v, const char* desc) + void unsafeAssign(string desc)(VarDeclaration v) { - if (setUnsafeDIP1000(sc.func)) + if (assertmsg) { - if (!gag) - { - if (assertmsg) - { - previewErrorFunc(sc.isDeprecated(), global.params.useDIP1000) - (arg.loc, "%s `%s` assigned to non-scope parameter calling `assert()`", - desc, v.toChars()); - } - else - { - previewErrorFunc(sc.isDeprecated(), global.params.useDIP1000) - (arg.loc, "%s `%s` assigned to non-scope parameter `%s` calling %s", - desc, v.toChars(), - par ? par.toChars() : "this", - fdc ? fdc.toPrettyChars() : "indirectly"); - } - } - if (global.params.useDIP1000 == FeatureState.enabled) - result = true; + result |= sc.setUnsafeDIP1000(gag, arg.loc, + desc ~ " `%s` assigned to non-scope parameter calling `assert()`", v); + } + else if (par) + { + result |= sc.setUnsafeDIP1000(gag, arg.loc, + desc ~ " `%s` assigned to non-scope parameter `%s`", v, par); + } + else + { + result |= sc.setUnsafeDIP1000(gag, arg.loc, + desc ~ " `%s` assigned to non-scope parameter `this`", v); } } @@ -352,14 +349,14 @@ bool checkParamArgumentEscape(Scope* sc, FuncDeclaration fdc, Parameter par, Exp if (v.isScope()) { - unsafeAssign(v, "scope variable"); + unsafeAssign!"scope variable"(v); } else if (v.storage_class & STC.variadic && p == sc.func) { Type tb = v.type.toBasetype(); if (tb.ty == Tarray || tb.ty == Tsarray) { - unsafeAssign(v, "variadic variable"); + unsafeAssign!"variadic variable"(v); } } else @@ -382,17 +379,15 @@ bool checkParamArgumentEscape(Scope* sc, FuncDeclaration fdc, Parameter par, Exp Dsymbol p = v.toParent2(); notMaybeScope(v); - - if (p == sc.func) + if (checkScopeVarAddr(v, arg, sc, gag)) { - if (psr == ScopeRef.Scope || - psr == ScopeRef.RefScope || - psr == ScopeRef.ReturnRef_Scope) - { - continue; - } + result = true; + continue; + } - unsafeAssign(v, "reference to local variable"); + if (p == sc.func && !(parStc & STC.scope_)) + { + unsafeAssign!"reference to local variable"(v); continue; } } @@ -414,21 +409,26 @@ bool checkParamArgumentEscape(Scope* sc, FuncDeclaration fdc, Parameter par, Exp if ((v.isReference() || v.isScope()) && p == sc.func) { - unsafeAssign(v, "reference to local"); + unsafeAssign!"reference to local"(v); continue; } } } + if (!sc.func) + return result; + foreach (Expression ee; er.byexp) { - if (sc.func && sc.func.setUnsafe()) + if (!par) { - if (!gag) - error(ee.loc, "reference to stack allocated value returned by `%s` assigned to non-scope parameter `%s`", - ee.toChars(), - par ? par.toChars() : "this"); - result = true; + result |= sc.setUnsafeDIP1000(gag, ee.loc, + "reference to stack allocated value returned by `%s` assigned to non-scope parameter `this`", ee); + } + else + { + result |= sc.setUnsafeDIP1000(gag, ee.loc, + "reference to stack allocated value returned by `%s` assigned to non-scope parameter `%s`", ee, par); } } @@ -688,25 +688,25 @@ bool checkAssignEscape(Scope* sc, Expression e, bool gag, bool byRef) } } - if (va && va.isScope() && va.storage_class & STC.return_ && !(v.storage_class & STC.return_) && - fd.setUnsafe()) + if (va && va.isScope() && va.storage_class & STC.return_ && !(v.storage_class & STC.return_)) { // va may return its value, but v does not allow that, so this is an error - if (!gag) - error(ae.loc, "scope variable `%s` assigned to return scope `%s`", v.toChars(), va.toChars()); - result = true; - continue; + if (sc.setUnsafeDIP1000(gag, ae.loc, "scope variable `%s` assigned to return scope `%s`", v, va)) + { + result = true; + continue; + } } // If va's lifetime encloses v's, then error if (va && !va.isDataseg() && - ((va.enclosesLifetimeOf(v) && !(v.storage_class & STC.temp)) || vaIsRef) && - fd.setUnsafe()) + ((va.enclosesLifetimeOf(v) && !(v.storage_class & STC.temp)) || vaIsRef)) { - if (!gag) - error(ae.loc, "scope variable `%s` assigned to `%s` with longer lifetime", v.toChars(), va.toChars()); - result = true; - continue; + if (sc.setUnsafeDIP1000(gag, ae.loc, "scope variable `%s` assigned to `%s` with longer lifetime", v, va)) + { + result = true; + continue; + } } if (va && !va.isDataseg() && !va.doNotInferScope) @@ -733,12 +733,7 @@ bool checkAssignEscape(Scope* sc, Expression e, bool gag, bool byRef) } continue; } - if (fd.setUnsafe()) - { - if (!gag) - error(ae.loc, "scope variable `%s` assigned to non-scope `%s`", v.toChars(), e1.toChars()); - result = true; - } + result |= sc.setUnsafeDIP1000(gag, ae.loc, "scope variable `%s` assigned to non-scope `%s`", v, e1); } else if (v.storage_class & STC.variadic && p == fd) { @@ -753,12 +748,7 @@ bool checkAssignEscape(Scope* sc, Expression e, bool gag, bool byRef) } continue; } - if (fd.setUnsafe()) - { - if (!gag) - error(ae.loc, "variadic variable `%s` assigned to non-scope `%s`", v.toChars(), e1.toChars()); - result = true; - } + result |= sc.setUnsafeDIP1000(gag, ae.loc, "variadic variable `%s` assigned to non-scope `%s`", v, e1); } } else @@ -777,27 +767,22 @@ bool checkAssignEscape(Scope* sc, Expression e, bool gag, bool byRef) if (v.isDataseg()) continue; - if (global.params.useDIP1000 != FeatureState.disabled) + if (checkScopeVarAddr(v, ae, sc, gag)) { - if (va && va.isScope() && !v.isReference()) - { - if (!(va.storage_class & STC.return_)) - { - va.doNotInferReturn = true; - } - else if (setUnsafeDIP1000(fd)) - { - if (!gag) - previewErrorFunc(sc.isDeprecated(), global.params.useDIP1000) - (ae.loc, "address of local variable `%s` assigned to return scope `%s`", v.toChars(), va.toChars()); - + result = true; + continue; + } - if (global.params.useDIP1000 == FeatureState.enabled) - { - result = true; - continue; - } - } + if (va && va.isScope() && !v.isReference()) + { + if (!(va.storage_class & STC.return_)) + { + va.doNotInferReturn = true; + } + else + { + result |= sc.setUnsafeDIP1000(gag, ae.loc, + "address of local variable `%s` assigned to return scope `%s`", v, va); } } @@ -815,19 +800,19 @@ bool checkAssignEscape(Scope* sc, Expression e, bool gag, bool byRef) // If va's lifetime encloses v's, then error if (va && !(vaIsFirstRef && (v.storage_class & STC.return_)) && - (va.enclosesLifetimeOf(v) || (va.isReference() && !(va.storage_class & STC.temp)) || va.isDataseg()) && - fd.setUnsafe()) + (va.enclosesLifetimeOf(v) || (va.isReference() && !(va.storage_class & STC.temp)) || va.isDataseg())) { - if (!gag) - error(ae.loc, "address of variable `%s` assigned to `%s` with longer lifetime", v.toChars(), va.toChars()); - result = true; - continue; + if (sc.setUnsafeDIP1000(gag, ae.loc, "address of variable `%s` assigned to `%s` with longer lifetime", v, va)) + { + result = true; + continue; + } } if (!(va && va.isScope())) notMaybeScope(v); - if ((global.params.useDIP1000 != FeatureState.enabled && v.isReference()) || p != sc.func) + if (p != sc.func) continue; if (va && !va.isDataseg() && !va.doNotInferScope) @@ -842,12 +827,8 @@ bool checkAssignEscape(Scope* sc, Expression e, bool gag, bool byRef) } if (e1.op == EXP.structLiteral) continue; - if (fd.setUnsafe()) - { - if (!gag) - error(ae.loc, "reference to local variable `%s` assigned to non-scope `%s`", v.toChars(), e1.toChars()); - result = true; - } + + result |= sc.setUnsafeDIP1000(gag, ae.loc, "reference to local variable `%s` assigned to non-scope `%s`", v, e1); } foreach (FuncDeclaration func; er.byfunc) @@ -886,12 +867,8 @@ bool checkAssignEscape(Scope* sc, Expression e, bool gag, bool byRef) //va.storage_class |= STC.scope_ | STC.scopeinferred; continue; } - if (fd.setUnsafe()) - { - if (!gag) - error(ae.loc, "reference to local `%s` assigned to non-scope `%s` in @safe code", v.toChars(), e1.toChars()); - result = true; - } + result |= sc.setUnsafeDIP1000(gag, ae.loc, + "reference to local `%s` assigned to non-scope `%s` in @safe code", v, e1); } } @@ -912,25 +889,23 @@ bool checkAssignEscape(Scope* sc, Expression e, bool gag, bool byRef) } if (ee.op == EXP.call && ee.type.toBasetype().isTypeStruct() && - (!va || !(va.storage_class & STC.temp)) && - fd.setUnsafe()) + (!va || !(va.storage_class & STC.temp))) { - if (!gag) - error(ee.loc, "address of struct temporary returned by `%s` assigned to longer lived variable `%s`", - ee.toChars(), e1.toChars()); - result = true; - continue; + if (sc.setUnsafeDIP1000(gag, ee.loc, "address of struct temporary returned by `%s` assigned to longer lived variable `%s`", ee, e1)) + { + result = true; + continue; + } } if (ee.op == EXP.structLiteral && - (!va || !(va.storage_class & STC.temp)) && - fd.setUnsafe()) + (!va || !(va.storage_class & STC.temp))) { - if (!gag) - error(ee.loc, "address of struct literal `%s` assigned to longer lived variable `%s`", - ee.toChars(), e1.toChars()); - result = true; - continue; + if (sc.setUnsafeDIP1000(gag, ee.loc, "address of struct literal `%s` assigned to longer lived variable `%s`", ee, e1)) + { + result = true; + continue; + } } if (va && !va.isDataseg() && !va.doNotInferScope) @@ -942,13 +917,8 @@ bool checkAssignEscape(Scope* sc, Expression e, bool gag, bool byRef) continue; } - if (fd.setUnsafe()) - { - if (!gag) - error(ee.loc, "reference to stack allocated value returned by `%s` assigned to non-scope `%s`", - ee.toChars(), e1.toChars()); - result = true; - } + result |= sc.setUnsafeDIP1000(gag, ee.loc, + "reference to stack allocated value returned by `%s` assigned to non-scope `%s`", ee, e1); } return result; @@ -985,11 +955,8 @@ bool checkThrowEscape(Scope* sc, Expression e, bool gag) if (v.isScope() && !v.iscatchvar) // special case: allow catch var to be rethrown // despite being `scope` { - if (!gag) - previewErrorFunc(sc.isDeprecated(), global.params.useDIP1000) - (e.loc, "scope variable `%s` may not be thrown", v.toChars()); - if (global.params.useDIP1000 == FeatureState.enabled) // https://issues.dlang.org/show_bug.cgi?id=17029 - result = true; + // https://issues.dlang.org/show_bug.cgi?id=17029 + result |= sc.setUnsafeDIP1000(gag, e.loc, "scope variable `%s` may not be thrown", v); continue; } else @@ -1050,16 +1017,8 @@ bool checkNewEscape(Scope* sc, Expression e, bool gag) */ !(p.parent == sc.func)) { - if (setUnsafeDIP1000(sc.func)) // https://issues.dlang.org/show_bug.cgi?id=20868 - { - // Only look for errors if in module listed on command line - if (!gag) - previewErrorFunc(sc.isDeprecated(), global.params.useDIP1000) - (e.loc, "scope variable `%s` may not be copied into allocated memory", v.toChars()); - if (global.params.useDIP1000 == FeatureState.enabled) - result = true; - } - + // https://issues.dlang.org/show_bug.cgi?id=20868 + result |= sc.setUnsafeDIP1000(gag, e.loc, "scope variable `%s` may not be copied into allocated memory", v); continue; } } @@ -1068,9 +1027,8 @@ bool checkNewEscape(Scope* sc, Expression e, bool gag) Type tb = v.type.toBasetype(); if (tb.ty == Tarray || tb.ty == Tsarray) { - if (!gag) - error(e.loc, "copying `%s` into allocated memory escapes a reference to variadic parameter `%s`", e.toChars(), v.toChars()); - result = false; + result |= sc.setUnsafeDIP1000(gag, e.loc, + "copying `%s` into allocated memory escapes a reference to variadic parameter `%s`", e, v); } } else @@ -1085,16 +1043,13 @@ bool checkNewEscape(Scope* sc, Expression e, bool gag) if (log) printf("byref `%s`\n", v.toChars()); // 'featureState' tells us whether to emit an error or a deprecation, - // depending on the flag passed to the CLI for DIP25 - void escapingRef(VarDeclaration v, FeatureState featureState = FeatureState.enabled) + // depending on the flag passed to the CLI for DIP25 / DIP1000 + bool escapingRef(VarDeclaration v, FeatureState fs) { - if (!gag) - { - const(char)* kind = (v.storage_class & STC.parameter) ? "parameter" : "local"; - const(char)* msg = "copying `%s` into allocated memory escapes a reference to %s variable `%s`"; - previewErrorFunc(sc.isDeprecated(), featureState)(e.loc, msg, e.toChars(), kind, v.toChars()); - } - result |= (featureState == FeatureState.enabled); + const(char)* msg = v.isParameter() ? + "copying `%s` into allocated memory escapes a reference to parameter `%s`" : + "copying `%s` into allocated memory escapes a reference to local variable `%s`"; + return sc.setUnsafePreview(fs, gag, e.loc, msg, e, v); } if (v.isDataseg()) @@ -1106,7 +1061,7 @@ bool checkNewEscape(Scope* sc, Expression e, bool gag) { if (p == sc.func) { - escapingRef(v); + result |= escapingRef(v, global.params.useDIP1000); continue; } } @@ -1122,7 +1077,7 @@ bool checkNewEscape(Scope* sc, Expression e, bool gag) { //printf("escaping reference to local ref variable %s\n", v.toChars()); //printf("storage class = x%llx\n", v.storage_class); - escapingRef(v, global.params.useDIP25); + result |= escapingRef(v, global.params.useDIP25); continue; } // Don't need to be concerned if v's parent does not return a ref @@ -1269,14 +1224,7 @@ private bool checkReturnEscapeImpl(Scope* sc, Expression e, bool refs, bool gag) ) { // https://issues.dlang.org/show_bug.cgi?id=17029 - if (setUnsafeDIP1000(sc.func)) - { - if (!gag) - previewErrorFunc(sc.isDeprecated(), global.params.useDIP1000) - (e.loc, "scope variable `%s` may not be returned", v.toChars()); - if (global.params.useDIP1000 == FeatureState.enabled) - result = true; - } + result |= sc.setUnsafeDIP1000(gag, e.loc, "scope variable `%s` may not be returned", v); continue; } } @@ -1306,16 +1254,18 @@ private bool checkReturnEscapeImpl(Scope* sc, Expression e, bool refs, bool gag) // 'featureState' tells us whether to emit an error or a deprecation, // depending on the flag passed to the CLI for DIP25 - void escapingRef(VarDeclaration v, ScopeRef vsr, FeatureState featureState = FeatureState.enabled) + void escapingRef(VarDeclaration v, FeatureState featureState) { - if (!gag) - { - const(char)* varKind = v.isParameter() ? "parameter" : "local variable"; - previewErrorFunc(sc.isDeprecated(), featureState)(e.loc, - "returning `%s` escapes a reference to %s `%s`", e.toChars(), varKind, v.toChars()); + const(char)* msg = v.isParameter() ? + "returning `%s` escapes a reference to parameter `%s`" : + "returning `%s` escapes a reference to local variable `%s`"; - if (v.isParameter() && v.isReference()) + if (v.isParameter() && v.isReference()) + { + if (sc.setUnsafePreview(featureState, gag, e.loc, msg, e, v) || + sc.func.isSafeBypassingInference()) { + result = true; if (v.storage_class & STC.returnScope) { previewSupplementalFunc(sc.isDeprecated(), featureState)(v.loc, @@ -1329,7 +1279,12 @@ private bool checkReturnEscapeImpl(Scope* sc, Expression e, bool refs, bool gag) } } } - result = true; + else + { + if (!gag) + previewErrorFunc(sc.isDeprecated(), featureState)(e.loc, msg, e.toChars(), v.toChars()); + result = true; + } } if (v.isDataseg()) @@ -1340,14 +1295,23 @@ private bool checkReturnEscapeImpl(Scope* sc, Expression e, bool refs, bool gag) Dsymbol p = v.toParent2(); // https://issues.dlang.org/show_bug.cgi?id=19965 - if (!refs && sc.func.vthis == v) - notMaybeScope(v); + if (!refs) + { + if (sc.func.vthis == v) + notMaybeScope(v); + + if (checkScopeVarAddr(v, e, sc, gag)) + { + result = true; + continue; + } + } if (!v.isReference()) { if (p == sc.func) { - escapingRef(v, vsr, FeatureState.enabled); + escapingRef(v, FeatureState.enabled); continue; } FuncDeclaration fd = p.isFuncDeclaration(); @@ -1388,7 +1352,7 @@ private bool checkReturnEscapeImpl(Scope* sc, Expression e, bool refs, bool gag) { //printf("escaping reference to local ref variable %s\n", v.toChars()); //printf("storage class = x%llx\n", v.storage_class); - escapingRef(v, vsr, global.params.useDIP25); + escapingRef(v, global.params.useDIP25); continue; } // Don't need to be concerned if v's parent does not return a ref @@ -1489,370 +1453,385 @@ private void inferReturn(FuncDeclaration fd, VarDeclaration v, bool returnScope) void escapeByValue(Expression e, EscapeByResults* er, bool live = false) { //printf("[%s] escapeByValue, e: %s\n", e.loc.toChars(), e.toChars()); - extern (C++) final class EscapeVisitor : Visitor - { - alias visit = Visitor.visit; - public: - EscapeByResults* er; - bool live; - - extern (D) this(EscapeByResults* er, bool live) - { - this.er = er; - this.live = live; - } - override void visit(Expression e) - { - } + void visit(Expression e) + { + } - override void visit(AddrExp e) - { - /* Taking the address of struct literal is normally not - * allowed, but CTFE can generate one out of a new expression, - * but it'll be placed in static data so no need to check it. - */ - if (e.e1.op != EXP.structLiteral) - escapeByRef(e.e1, er, live); - } + void visitAddr(AddrExp e) + { + /* Taking the address of struct literal is normally not + * allowed, but CTFE can generate one out of a new expression, + * but it'll be placed in static data so no need to check it. + */ + if (e.e1.op != EXP.structLiteral) + escapeByRef(e.e1, er, live); + } - override void visit(SymOffExp e) - { - VarDeclaration v = e.var.isVarDeclaration(); - if (v) - er.byref.push(v); - } + void visitSymOff(SymOffExp e) + { + VarDeclaration v = e.var.isVarDeclaration(); + if (v) + er.byref.push(v); + } - override void visit(VarExp e) + void visitVar(VarExp e) + { + if (auto v = e.var.isVarDeclaration()) { - if (auto v = e.var.isVarDeclaration()) - { - if (v.type.hasPointers() || // not tracking non-pointers - v.storage_class & STC.lazy_) // lazy variables are actually pointers - er.byvalue.push(v); - } + if (v.type.hasPointers() || // not tracking non-pointers + v.storage_class & STC.lazy_) // lazy variables are actually pointers + er.byvalue.push(v); } + } - override void visit(ThisExp e) - { - if (e.var) - er.byvalue.push(e.var); - } + void visitThis(ThisExp e) + { + if (e.var) + er.byvalue.push(e.var); + } - override void visit(PtrExp e) - { - if (live && e.type.hasPointers()) - e.e1.accept(this); - } + void visitPtr(PtrExp e) + { + if (live && e.type.hasPointers()) + escapeByValue(e.e1, er, live); + } - override void visit(DotVarExp e) + void visitDotVar(DotVarExp e) + { + auto t = e.e1.type.toBasetype(); + if (e.type.hasPointers() && (live || t.ty == Tstruct)) { - auto t = e.e1.type.toBasetype(); - if (e.type.hasPointers() && (live || t.ty == Tstruct)) - { - e.e1.accept(this); - } + escapeByValue(e.e1, er, live); } + } - override void visit(DelegateExp e) - { - Type t = e.e1.type.toBasetype(); - if (t.ty == Tclass || t.ty == Tpointer) - escapeByValue(e.e1, er, live); - else - escapeByRef(e.e1, er, live); - er.byfunc.push(e.func); - } + void visitDelegate(DelegateExp e) + { + Type t = e.e1.type.toBasetype(); + if (t.ty == Tclass || t.ty == Tpointer) + escapeByValue(e.e1, er, live); + else + escapeByRef(e.e1, er, live); + er.byfunc.push(e.func); + } - override void visit(FuncExp e) - { - if (e.fd.tok == TOK.delegate_) - er.byfunc.push(e.fd); - } + void visitFunc(FuncExp e) + { + if (e.fd.tok == TOK.delegate_) + er.byfunc.push(e.fd); + } - override void visit(TupleExp e) - { - assert(0); // should have been lowered by now - } + void visitTuple(TupleExp e) + { + assert(0); // should have been lowered by now + } - override void visit(ArrayLiteralExp e) + void visitArrayLiteral(ArrayLiteralExp e) + { + Type tb = e.type.toBasetype(); + if (tb.ty == Tsarray || tb.ty == Tarray) { - Type tb = e.type.toBasetype(); - if (tb.ty == Tsarray || tb.ty == Tarray) + if (e.basis) + escapeByValue(e.basis, er, live); + foreach (el; *e.elements) { - if (e.basis) - e.basis.accept(this); - foreach (el; *e.elements) - { - if (el) - el.accept(this); - } + if (el) + escapeByValue(el, er, live); } } + } - override void visit(StructLiteralExp e) + void visitStructLiteral(StructLiteralExp e) + { + if (e.elements) { - if (e.elements) + foreach (ex; *e.elements) { - foreach (ex; *e.elements) - { - if (ex) - ex.accept(this); - } + if (ex) + escapeByValue(ex, er, live); } } + } - override void visit(NewExp e) + void visitNew(NewExp e) + { + Type tb = e.newtype.toBasetype(); + if (tb.ty == Tstruct && !e.member && e.arguments) { - Type tb = e.newtype.toBasetype(); - if (tb.ty == Tstruct && !e.member && e.arguments) + foreach (ex; *e.arguments) { - foreach (ex; *e.arguments) - { - if (ex) - ex.accept(this); - } + if (ex) + escapeByValue(ex, er, live); } } + } - override void visit(CastExp e) + void visitCast(CastExp e) + { + if (!e.type.hasPointers()) + return; + Type tb = e.type.toBasetype(); + if (tb.ty == Tarray && e.e1.type.toBasetype().ty == Tsarray) { - if (!e.type.hasPointers()) - return; - Type tb = e.type.toBasetype(); - if (tb.ty == Tarray && e.e1.type.toBasetype().ty == Tsarray) - { - escapeByRef(e.e1, er, live); - } - else - e.e1.accept(this); + escapeByRef(e.e1, er, live); } + else + escapeByValue(e.e1, er, live); + } - override void visit(SliceExp e) + void visitSlice(SliceExp e) + { + if (auto ve = e.e1.isVarExp()) { - if (auto ve = e.e1.isVarExp()) + VarDeclaration v = ve.var.isVarDeclaration(); + Type tb = e.type.toBasetype(); + if (v) { - VarDeclaration v = ve.var.isVarDeclaration(); - Type tb = e.type.toBasetype(); - if (v) + if (tb.ty == Tsarray) + return; + if (v.storage_class & STC.variadic) { - if (tb.ty == Tsarray) - return; - if (v.storage_class & STC.variadic) - { - er.byvalue.push(v); - return; - } + er.byvalue.push(v); + return; } } - Type t1b = e.e1.type.toBasetype(); - if (t1b.ty == Tsarray) - { - Type tb = e.type.toBasetype(); - if (tb.ty != Tsarray) - escapeByRef(e.e1, er, live); - } - else - e.e1.accept(this); } - - override void visit(IndexExp e) - { - if (e.e1.type.toBasetype().ty == Tsarray || - live && e.type.hasPointers()) - { - e.e1.accept(this); - } - } - - override void visit(BinExp e) + Type t1b = e.e1.type.toBasetype(); + if (t1b.ty == Tsarray) { Type tb = e.type.toBasetype(); - if (tb.ty == Tpointer) - { - e.e1.accept(this); - e.e2.accept(this); - } + if (tb.ty != Tsarray) + escapeByRef(e.e1, er, live); } + else + escapeByValue(e.e1, er, live); + } - override void visit(BinAssignExp e) + void visitIndex(IndexExp e) + { + if (e.e1.type.toBasetype().ty == Tsarray || + live && e.type.hasPointers()) { - e.e1.accept(this); + escapeByValue(e.e1, er, live); } + } - override void visit(AssignExp e) + void visitBin(BinExp e) + { + Type tb = e.type.toBasetype(); + if (tb.ty == Tpointer) { - e.e1.accept(this); + escapeByValue(e.e1, er, live); + escapeByValue(e.e2, er, live); } + } - override void visit(CommaExp e) - { - e.e2.accept(this); - } + void visitBinAssign(BinAssignExp e) + { + escapeByValue(e.e1, er, live); + } + + void visitAssign(AssignExp e) + { + escapeByValue(e.e1, er, live); + } - override void visit(CondExp e) + void visitComma(CommaExp e) + { + escapeByValue(e.e2, er, live); + } + + void visitCond(CondExp e) + { + escapeByValue(e.e1, er, live); + escapeByValue(e.e2, er, live); + } + + void visitCall(CallExp e) + { + //printf("CallExp(): %s\n", e.toChars()); + /* Check each argument that is + * passed as 'return scope'. + */ + Type t1 = e.e1.type.toBasetype(); + TypeFunction tf; + TypeDelegate dg; + if (t1.ty == Tdelegate) { - e.e1.accept(this); - e.e2.accept(this); + dg = t1.isTypeDelegate(); + tf = dg.next.isTypeFunction(); } + else if (t1.ty == Tfunction) + tf = t1.isTypeFunction(); + else + return; + + if (!e.type.hasPointers()) + return; - override void visit(CallExp e) + if (e.arguments && e.arguments.dim) { - //printf("CallExp(): %s\n", e.toChars()); - /* Check each argument that is - * passed as 'return scope'. + /* j=1 if _arguments[] is first argument, + * skip it because it is not passed by ref */ - Type t1 = e.e1.type.toBasetype(); - TypeFunction tf; - TypeDelegate dg; - if (t1.ty == Tdelegate) + int j = tf.isDstyleVariadic(); + for (size_t i = j; i < e.arguments.dim; ++i) { - dg = t1.isTypeDelegate(); - tf = dg.next.isTypeFunction(); - } - else if (t1.ty == Tfunction) - tf = t1.isTypeFunction(); - else - return; - - if (!e.type.hasPointers()) - return; - - if (e.arguments && e.arguments.dim) - { - /* j=1 if _arguments[] is first argument, - * skip it because it is not passed by ref - */ - int j = tf.isDstyleVariadic(); - for (size_t i = j; i < e.arguments.dim; ++i) + Expression arg = (*e.arguments)[i]; + size_t nparams = tf.parameterList.length; + if (i - j < nparams && i >= j) { - Expression arg = (*e.arguments)[i]; - size_t nparams = tf.parameterList.length; - if (i - j < nparams && i >= j) + Parameter p = tf.parameterList[i - j]; + const stc = tf.parameterStorageClass(null, p); + ScopeRef psr = buildScopeRef(stc); + if (psr == ScopeRef.ReturnScope || psr == ScopeRef.Ref_ReturnScope) + escapeByValue(arg, er, live); + else if (psr == ScopeRef.ReturnRef || psr == ScopeRef.ReturnRef_Scope) { - Parameter p = tf.parameterList[i - j]; - const stc = tf.parameterStorageClass(null, p); - ScopeRef psr = buildScopeRef(stc); - if (psr == ScopeRef.ReturnScope || psr == ScopeRef.Ref_ReturnScope) - arg.accept(this); - else if (psr == ScopeRef.ReturnRef || psr == ScopeRef.ReturnRef_Scope) + if (tf.isref) { - if (tf.isref) - { - /* Treat: - * ref P foo(return ref P p) - * as: - * p; - */ - arg.accept(this); - } - else - escapeByRef(arg, er, live); + /* Treat: + * ref P foo(return ref P p) + * as: + * p; + */ + escapeByValue(arg, er, live); } + else + escapeByRef(arg, er, live); } } } - // If 'this' is returned, check it too - if (e.e1.op == EXP.dotVariable && t1.ty == Tfunction) + } + // If 'this' is returned, check it too + if (e.e1.op == EXP.dotVariable && t1.ty == Tfunction) + { + DotVarExp dve = e.e1.isDotVarExp(); + FuncDeclaration fd = dve.var.isFuncDeclaration(); + if (global.params.useDIP1000 == FeatureState.enabled) { - DotVarExp dve = e.e1.isDotVarExp(); - FuncDeclaration fd = dve.var.isFuncDeclaration(); - if (global.params.useDIP1000 == FeatureState.enabled) + if (fd && fd.isThis()) { - if (fd && fd.isThis()) - { - /* Calling a non-static member function dve.var, which is returning `this`, and with dve.e1 representing `this` - */ - - /***************************** - * Concoct storage class for member function's implicit `this` parameter. - * Params: - * fd = member function - * Returns: - * storage class for fd's `this` - */ - StorageClass getThisStorageClass(FuncDeclaration fd) - { - StorageClass stc; - auto tf = fd.type.toBasetype().isTypeFunction(); - if (tf.isreturn) - stc |= STC.return_; - if (tf.isreturnscope) - stc |= STC.returnScope; - auto ad = fd.isThis(); - if (ad.isClassDeclaration() || tf.isScopeQual) - stc |= STC.scope_; - if (ad.isStructDeclaration()) - stc |= STC.ref_; // `this` for a struct member function is passed by `ref` - return stc; - } + /* Calling a non-static member function dve.var, which is returning `this`, and with dve.e1 representing `this` + */ - const psr = buildScopeRef(getThisStorageClass(fd)); - if (psr == ScopeRef.ReturnScope || psr == ScopeRef.Ref_ReturnScope) - dve.e1.accept(this); - else if (psr == ScopeRef.ReturnRef || psr == ScopeRef.ReturnRef_Scope) - { - if (tf.isref) - { - /* Treat calling: - * struct S { ref S foo() return; } - * as: - * this; - */ - dve.e1.accept(this); - } - else - escapeByRef(dve.e1, er, live); - } + /***************************** + * Concoct storage class for member function's implicit `this` parameter. + * Params: + * fd = member function + * Returns: + * storage class for fd's `this` + */ + StorageClass getThisStorageClass(FuncDeclaration fd) + { + StorageClass stc; + auto tf = fd.type.toBasetype().isTypeFunction(); + if (tf.isreturn) + stc |= STC.return_; + if (tf.isreturnscope) + stc |= STC.returnScope; + auto ad = fd.isThis(); + if (ad.isClassDeclaration() || tf.isScopeQual) + stc |= STC.scope_; + if (ad.isStructDeclaration()) + stc |= STC.ref_; // `this` for a struct member function is passed by `ref` + return stc; } - } - else - { - // Calling member function before dip1000 - StorageClass stc = dve.var.storage_class & (STC.return_ | STC.scope_ | STC.ref_); - if (tf.isreturn) - stc |= STC.return_; - const psr = buildScopeRef(stc); + const psr = buildScopeRef(getThisStorageClass(fd)); if (psr == ScopeRef.ReturnScope || psr == ScopeRef.Ref_ReturnScope) - dve.e1.accept(this); + escapeByValue(dve.e1, er, live); else if (psr == ScopeRef.ReturnRef || psr == ScopeRef.ReturnRef_Scope) - escapeByRef(dve.e1, er, live); + { + if (tf.isref) + { + /* Treat calling: + * struct S { ref S foo() return; } + * as: + * this; + */ + escapeByValue(dve.e1, er, live); + } + else + escapeByRef(dve.e1, er, live); + } } + } + else + { + // Calling member function before dip1000 + StorageClass stc = dve.var.storage_class & (STC.return_ | STC.scope_ | STC.ref_); + if (tf.isreturn) + stc |= STC.return_; - // If it's also a nested function that is 'return scope' - if (fd && fd.isNested()) - { - if (tf.isreturn && tf.isScopeQual) - er.byexp.push(e); - } + const psr = buildScopeRef(stc); + if (psr == ScopeRef.ReturnScope || psr == ScopeRef.Ref_ReturnScope) + escapeByValue(dve.e1, er, live); + else if (psr == ScopeRef.ReturnRef || psr == ScopeRef.ReturnRef_Scope) + escapeByRef(dve.e1, er, live); } - /* If returning the result of a delegate call, the .ptr - * field of the delegate must be checked. - */ - if (dg) + // If it's also a nested function that is 'return scope' + if (fd && fd.isNested()) { - if (tf.isreturn) - e.e1.accept(this); + if (tf.isreturn && tf.isScopeQual) + er.byexp.push(e); } + } - /* If it's a nested function that is 'return scope' - */ - if (auto ve = e.e1.isVarExp()) + /* If returning the result of a delegate call, the .ptr + * field of the delegate must be checked. + */ + if (dg) + { + if (tf.isreturn) + escapeByValue(e.e1, er, live); + } + + /* If it's a nested function that is 'return scope' + */ + if (auto ve = e.e1.isVarExp()) + { + FuncDeclaration fd = ve.var.isFuncDeclaration(); + if (fd && fd.isNested()) { - FuncDeclaration fd = ve.var.isFuncDeclaration(); - if (fd && fd.isNested()) - { - if (tf.isreturn && tf.isScopeQual) - er.byexp.push(e); - } + if (tf.isreturn && tf.isScopeQual) + er.byexp.push(e); } } } - scope EscapeVisitor v = new EscapeVisitor(er, live); - e.accept(v); + switch (e.op) + { + case EXP.address: return visitAddr(e.isAddrExp()); + case EXP.symbolOffset: return visitSymOff(e.isSymOffExp()); + case EXP.variable: return visitVar(e.isVarExp()); + case EXP.this_: return visitThis(e.isThisExp()); + case EXP.star: return visitPtr(e.isPtrExp()); + case EXP.dotVariable: return visitDotVar(e.isDotVarExp()); + case EXP.delegate_: return visitDelegate(e.isDelegateExp()); + case EXP.function_: return visitFunc(e.isFuncExp()); + case EXP.tuple: return visitTuple(e.isTupleExp()); + case EXP.arrayLiteral: return visitArrayLiteral(e.isArrayLiteralExp()); + case EXP.structLiteral: return visitStructLiteral(e.isStructLiteralExp()); + case EXP.new_: return visitNew(e.isNewExp()); + case EXP.cast_: return visitCast(e.isCastExp()); + case EXP.slice: return visitSlice(e.isSliceExp()); + case EXP.index: return visitIndex(e.isIndexExp()); + case EXP.blit: return visitAssign(e.isBlitExp()); + case EXP.construct: return visitAssign(e.isConstructExp()); + case EXP.assign: return visitAssign(e.isAssignExp()); + case EXP.comma: return visitComma(e.isCommaExp()); + case EXP.question: return visitCond(e.isCondExp()); + case EXP.call: return visitCall(e.isCallExp()); + default: + if (auto b = e.isBinExp()) + return visitBin(b); + if (auto ba = e.isBinAssignExp()) + return visitBinAssign(ba); + return visit(e); + } } @@ -1877,236 +1856,239 @@ void escapeByValue(Expression e, EscapeByResults* er, bool live = false) void escapeByRef(Expression e, EscapeByResults* er, bool live = false) { //printf("[%s] escapeByRef, e: %s\n", e.loc.toChars(), e.toChars()); - extern (C++) final class EscapeRefVisitor : Visitor + void visit(Expression e) { - alias visit = Visitor.visit; - public: - EscapeByResults* er; - bool live; - - extern (D) this(EscapeByResults* er, bool live) - { - this.er = er; - this.live = live; - } - - override void visit(Expression e) - { - } + } - override void visit(VarExp e) + void visitVar(VarExp e) + { + auto v = e.var.isVarDeclaration(); + if (v) { - auto v = e.var.isVarDeclaration(); - if (v) + if (v.storage_class & STC.ref_ && v.storage_class & (STC.foreach_ | STC.temp) && v._init) { - if (v.storage_class & STC.ref_ && v.storage_class & (STC.foreach_ | STC.temp) && v._init) + /* If compiler generated ref temporary + * (ref v = ex; ex) + * look at the initializer instead + */ + if (ExpInitializer ez = v._init.isExpInitializer()) { - /* If compiler generated ref temporary - * (ref v = ex; ex) - * look at the initializer instead - */ - if (ExpInitializer ez = v._init.isExpInitializer()) - { - if (auto ce = ez.exp.isConstructExp()) - ce.e2.accept(this); - else - ez.exp.accept(this); - } + if (auto ce = ez.exp.isConstructExp()) + escapeByRef(ce.e2, er, live); + else + escapeByRef(ez.exp, er, live); } - else - er.byref.push(v); } + else + er.byref.push(v); } + } - override void visit(ThisExp e) - { - if (e.var && e.var.toParent2().isFuncDeclaration().hasDualContext()) - escapeByValue(e, er, live); - else if (e.var) - er.byref.push(e.var); - } + void visitThis(ThisExp e) + { + if (e.var && e.var.toParent2().isFuncDeclaration().hasDualContext()) + escapeByValue(e, er, live); + else if (e.var) + er.byref.push(e.var); + } - override void visit(PtrExp e) - { - escapeByValue(e.e1, er, live); - } + void visitPtr(PtrExp e) + { + escapeByValue(e.e1, er, live); + } - override void visit(IndexExp e) + void visitIndex(IndexExp e) + { + Type tb = e.e1.type.toBasetype(); + if (auto ve = e.e1.isVarExp()) { - Type tb = e.e1.type.toBasetype(); - if (auto ve = e.e1.isVarExp()) + VarDeclaration v = ve.var.isVarDeclaration(); + if (tb.ty == Tarray || tb.ty == Tsarray) { - VarDeclaration v = ve.var.isVarDeclaration(); - if (tb.ty == Tarray || tb.ty == Tsarray) + if (v && v.storage_class & STC.variadic) { - if (v && v.storage_class & STC.variadic) - { - er.byref.push(v); - return; - } + er.byref.push(v); + return; } } - if (tb.ty == Tsarray) - { - e.e1.accept(this); - } - else if (tb.ty == Tarray) - { - escapeByValue(e.e1, er, live); - } } - - override void visit(StructLiteralExp e) + if (tb.ty == Tsarray) { - if (e.elements) - { - foreach (ex; *e.elements) - { - if (ex) - ex.accept(this); - } - } - er.byexp.push(e); + escapeByRef(e.e1, er, live); } - - override void visit(DotVarExp e) + else if (tb.ty == Tarray) { - Type t1b = e.e1.type.toBasetype(); - if (t1b.ty == Tclass) - escapeByValue(e.e1, er, live); - else - e.e1.accept(this); + escapeByValue(e.e1, er, live); } + } - override void visit(BinAssignExp e) + void visitStructLiteral(StructLiteralExp e) + { + if (e.elements) { - e.e1.accept(this); + foreach (ex; *e.elements) + { + if (ex) + escapeByRef(ex, er, live); + } } + er.byexp.push(e); + } - override void visit(AssignExp e) - { - e.e1.accept(this); - } + void visitDotVar(DotVarExp e) + { + Type t1b = e.e1.type.toBasetype(); + if (t1b.ty == Tclass) + escapeByValue(e.e1, er, live); + else + escapeByRef(e.e1, er, live); + } - override void visit(CommaExp e) - { - e.e2.accept(this); - } + void visitBinAssign(BinAssignExp e) + { + escapeByRef(e.e1, er, live); + } - override void visit(CondExp e) - { - e.e1.accept(this); - e.e2.accept(this); - } + void visitAssign(AssignExp e) + { + escapeByRef(e.e1, er, live); + } - override void visit(CallExp e) + void visitComma(CommaExp e) + { + escapeByRef(e.e2, er, live); + } + + void visitCond(CondExp e) + { + escapeByRef(e.e1, er, live); + escapeByRef(e.e2, er, live); + } + + void visitCall(CallExp e) + { + //printf("escapeByRef.CallExp(): %s\n", e.toChars()); + /* If the function returns by ref, check each argument that is + * passed as 'return ref'. + */ + Type t1 = e.e1.type.toBasetype(); + TypeFunction tf; + if (t1.ty == Tdelegate) + tf = t1.isTypeDelegate().next.isTypeFunction(); + else if (t1.ty == Tfunction) + tf = t1.isTypeFunction(); + else + return; + if (tf.isref) { - //printf("escapeByRef.CallExp(): %s\n", e.toChars()); - /* If the function returns by ref, check each argument that is - * passed as 'return ref'. - */ - Type t1 = e.e1.type.toBasetype(); - TypeFunction tf; - if (t1.ty == Tdelegate) - tf = t1.isTypeDelegate().next.isTypeFunction(); - else if (t1.ty == Tfunction) - tf = t1.isTypeFunction(); - else - return; - if (tf.isref) + if (e.arguments && e.arguments.dim) { - if (e.arguments && e.arguments.dim) + /* j=1 if _arguments[] is first argument, + * skip it because it is not passed by ref + */ + int j = tf.isDstyleVariadic(); + for (size_t i = j; i < e.arguments.dim; ++i) { - /* j=1 if _arguments[] is first argument, - * skip it because it is not passed by ref - */ - int j = tf.isDstyleVariadic(); - for (size_t i = j; i < e.arguments.dim; ++i) + Expression arg = (*e.arguments)[i]; + size_t nparams = tf.parameterList.length; + if (i - j < nparams && i >= j) { - Expression arg = (*e.arguments)[i]; - size_t nparams = tf.parameterList.length; - if (i - j < nparams && i >= j) + Parameter p = tf.parameterList[i - j]; + const stc = tf.parameterStorageClass(null, p); + ScopeRef psr = buildScopeRef(stc); + if (psr == ScopeRef.ReturnRef || psr == ScopeRef.ReturnRef_Scope) + escapeByRef(arg, er, live); + else if (psr == ScopeRef.ReturnScope || psr == ScopeRef.Ref_ReturnScope) { - Parameter p = tf.parameterList[i - j]; - const stc = tf.parameterStorageClass(null, p); - ScopeRef psr = buildScopeRef(stc); - if (psr == ScopeRef.ReturnRef || psr == ScopeRef.ReturnRef_Scope) - arg.accept(this); - else if (psr == ScopeRef.ReturnScope || psr == ScopeRef.Ref_ReturnScope) + if (auto de = arg.isDelegateExp()) { - if (auto de = arg.isDelegateExp()) - { - if (de.func.isNested()) - er.byexp.push(de); - } - else - escapeByValue(arg, er, live); + if (de.func.isNested()) + er.byexp.push(de); } + else + escapeByValue(arg, er, live); } } } - // If 'this' is returned by ref, check it too - if (e.e1.op == EXP.dotVariable && t1.ty == Tfunction) + } + // If 'this' is returned by ref, check it too + if (e.e1.op == EXP.dotVariable && t1.ty == Tfunction) + { + DotVarExp dve = e.e1.isDotVarExp(); + + // https://issues.dlang.org/show_bug.cgi?id=20149#c10 + if (dve.var.isCtorDeclaration()) { - DotVarExp dve = e.e1.isDotVarExp(); + er.byexp.push(e); + return; + } - // https://issues.dlang.org/show_bug.cgi?id=20149#c10 - if (dve.var.isCtorDeclaration()) - { - er.byexp.push(e); - return; - } + StorageClass stc = dve.var.storage_class & (STC.return_ | STC.scope_ | STC.ref_); + if (tf.isreturn) + stc |= STC.return_; + if (tf.isref) + stc |= STC.ref_; + if (tf.isScopeQual) + stc |= STC.scope_; + if (tf.isreturnscope) + stc |= STC.returnScope; + + const psr = buildScopeRef(stc); + if (psr == ScopeRef.ReturnRef || psr == ScopeRef.ReturnRef_Scope) + escapeByRef(dve.e1, er, live); + else if (psr == ScopeRef.ReturnScope || psr == ScopeRef.Ref_ReturnScope) + escapeByValue(dve.e1, er, live); - StorageClass stc = dve.var.storage_class & (STC.return_ | STC.scope_ | STC.ref_); - if (tf.isreturn) - stc |= STC.return_; - if (tf.isref) - stc |= STC.ref_; - if (tf.isScopeQual) - stc |= STC.scope_; - if (tf.isreturnscope) - stc |= STC.returnScope; - - const psr = buildScopeRef(stc); - if (psr == ScopeRef.ReturnRef || psr == ScopeRef.ReturnRef_Scope) - dve.e1.accept(this); - else if (psr == ScopeRef.ReturnScope || psr == ScopeRef.Ref_ReturnScope) - escapeByValue(dve.e1, er, live); - - // If it's also a nested function that is 'return ref' - if (FuncDeclaration fd = dve.var.isFuncDeclaration()) + // If it's also a nested function that is 'return ref' + if (FuncDeclaration fd = dve.var.isFuncDeclaration()) + { + if (fd.isNested() && tf.isreturn) { - if (fd.isNested() && tf.isreturn) - { - er.byexp.push(e); - } + er.byexp.push(e); } } - // If it's a delegate, check it too - if (e.e1.op == EXP.variable && t1.ty == Tdelegate) - { - escapeByValue(e.e1, er, live); - } + } + // If it's a delegate, check it too + if (e.e1.op == EXP.variable && t1.ty == Tdelegate) + { + escapeByValue(e.e1, er, live); + } - /* If it's a nested function that is 'return ref' - */ - if (auto ve = e.e1.isVarExp()) + /* If it's a nested function that is 'return ref' + */ + if (auto ve = e.e1.isVarExp()) + { + FuncDeclaration fd = ve.var.isFuncDeclaration(); + if (fd && fd.isNested()) { - FuncDeclaration fd = ve.var.isFuncDeclaration(); - if (fd && fd.isNested()) - { - if (tf.isreturn) - er.byexp.push(e); - } + if (tf.isreturn) + er.byexp.push(e); } } - else - er.byexp.push(e); } + else + er.byexp.push(e); } - scope EscapeRefVisitor v = new EscapeRefVisitor(er, live); - e.accept(v); + switch (e.op) + { + case EXP.variable: return visitVar(e.isVarExp()); + case EXP.this_: return visitThis(e.isThisExp()); + case EXP.star: return visitPtr(e.isPtrExp()); + case EXP.structLiteral: return visitStructLiteral(e.isStructLiteralExp()); + case EXP.dotVariable: return visitDotVar(e.isDotVarExp()); + case EXP.index: return visitIndex(e.isIndexExp()); + case EXP.blit: return visitAssign(e.isBlitExp()); + case EXP.construct: return visitAssign(e.isConstructExp()); + case EXP.assign: return visitAssign(e.isAssignExp()); + case EXP.comma: return visitComma(e.isCommaExp()); + case EXP.question: return visitCond(e.isCondExp()); + case EXP.call: return visitCall(e.isCallExp()); + default: + if (auto ba = e.isBinAssignExp()) + return visitBinAssign(ba); + return visit(e); + } } @@ -2170,7 +2152,7 @@ public void findAllOuterAccessedVariables(FuncDeclaration fd, VarDeclarations* v */ version (none) { - public void notMaybeScope(string file = __FILE__, int line = __LINE__)(VarDeclaration v) + private void notMaybeScope(string file = __FILE__, int line = __LINE__)(VarDeclaration v) { printf("%.*s(%d): notMaybeScope('%s')\n", cast(int)file.length, file.ptr, line, v.toChars()); v.storage_class &= ~STC.maybescope; @@ -2178,12 +2160,88 @@ version (none) } else { - public void notMaybeScope(VarDeclaration v) + private void notMaybeScope(VarDeclaration v) { v.storage_class &= ~STC.maybescope; } } +/*********************************** + * After semantic analysis of the function body, + * try to infer `scope` / `return` on the parameters + * + * Params: + * funcdecl = function declaration that was analyzed + * f = final function type. `funcdecl.type` started as the 'premature type' before attribute + * inference, then its inferred attributes are copied over to final type `f` + */ +void finishScopeParamInference(FuncDeclaration funcdecl, ref TypeFunction f) +{ + if (funcdecl.flags & FUNCFLAG.returnInprocess) + { + funcdecl.flags &= ~FUNCFLAG.returnInprocess; + if (funcdecl.storage_class & STC.return_) + { + if (funcdecl.type == f) + f = cast(TypeFunction)f.copy(); + f.isreturn = true; + f.isreturnscope = cast(bool) (funcdecl.storage_class & STC.returnScope); + if (funcdecl.storage_class & STC.returninferred) + f.isreturninferred = true; + } + } + + funcdecl.flags &= ~FUNCFLAG.inferScope; + + // Eliminate maybescope's + { + // Create and fill array[] with maybe candidates from the `this` and the parameters + VarDeclaration[10] tmp = void; + size_t dim = (funcdecl.vthis !is null) + (funcdecl.parameters ? funcdecl.parameters.dim : 0); + + import dmd.common.string : SmallBuffer; + auto sb = SmallBuffer!VarDeclaration(dim, tmp[]); + VarDeclaration[] array = sb[]; + + size_t n = 0; + if (funcdecl.vthis) + array[n++] = funcdecl.vthis; + if (funcdecl.parameters) + { + foreach (v; *funcdecl.parameters) + { + array[n++] = v; + } + } + eliminateMaybeScopes(array[0 .. n]); + } + + // Infer STC.scope_ + if (funcdecl.parameters && !funcdecl.errors) + { + assert(f.parameterList.length == funcdecl.parameters.dim); + foreach (u, p; f.parameterList) + { + auto v = (*funcdecl.parameters)[u]; + if (v.storage_class & STC.maybescope) + { + //printf("Inferring scope for %s\n", v.toChars()); + notMaybeScope(v); + v.storage_class |= STC.scope_ | STC.scopeinferred; + p.storageClass |= STC.scope_ | STC.scopeinferred; + assert(!(p.storageClass & STC.maybescope)); + } + } + } + + if (funcdecl.vthis && funcdecl.vthis.storage_class & STC.maybescope) + { + notMaybeScope(funcdecl.vthis); + funcdecl.vthis.storage_class |= STC.scope_ | STC.scopeinferred; + f.isScopeQual = true; + f.isscopeinferred = true; + } +} /********************************************** * Have some variables that are maybescopes that were @@ -2207,7 +2265,7 @@ else * Params: * array = array of variables that were assigned to from maybescope variables */ -public void eliminateMaybeScopes(VarDeclaration[] array) +private void eliminateMaybeScopes(VarDeclaration[] array) { enum log = false; if (log) printf("eliminateMaybeScopes()\n"); @@ -2355,10 +2413,89 @@ private void addMaybe(VarDeclaration va, VarDeclaration v) va.maybes.push(v); } +/*************************************** + * Like `FuncDeclaration.setUnsafe`, but modified for dip25 / dip1000 by default transitions + * + * With `-preview=dip1000` it actually sets the function as unsafe / prints an error, while + * without it, it only prints a deprecation in a `@safe` function. + * With `-revert=preview=dip1000`, it doesn't do anything. + * + * Params: + * sc = used for checking whether we are in a deprecated scope + * fs = command line setting of dip1000 / dip25 + * gag = surpress error message + * loc = location of error + * fmt = printf-style format string + * arg0 = (optional) argument for first %s format specifier + * arg1 = (optional) argument for second %s format specifier + * Returns: whether an actual safe error (not deprecation) occured + */ +private bool setUnsafePreview(Scope* sc, FeatureState fs, bool gag, Loc loc, const(char)* msg, RootObject arg0 = null, RootObject arg1 = null) +{ + if (fs == FeatureState.disabled) + { + return false; + } + else if (fs == FeatureState.enabled) + { + return sc.func.setUnsafe(gag, loc, msg, arg0, arg1); + } + else + { + if (sc.func.isSafeBypassingInference()) + { + if (!gag) + previewErrorFunc(sc.isDeprecated(), fs)( + loc, msg, arg0 ? arg0.toChars() : "", arg1 ? arg1.toChars() : "" + ); + } + return false; + } +} + +// `setUnsafePreview` partially evaluated for dip1000 +private bool setUnsafeDIP1000(Scope* sc, bool gag, Loc loc, const(char)* msg, RootObject arg0 = null, RootObject arg1 = null) +{ + return setUnsafePreview(sc, global.params.useDIP1000, gag, loc, msg, arg0, arg1); +} -private bool setUnsafeDIP1000(FuncDeclaration f) +/*************************************** + * Check that taking the address of `v` is `@safe` + * + * It's not possible to take the address of a scope variable, because `scope` only applies + * to the top level indirection. + * + * Params: + * v = variable that a reference is created + * e = expression that takes the referene + * sc = used to obtain function / deprecated status + * gag = don't print errors + * Returns: + * true if taking the address of `v` is problematic because of the lack of transitive `scope` + */ +private bool checkScopeVarAddr(VarDeclaration v, Expression e, Scope* sc, bool gag) { - return global.params.useDIP1000 == FeatureState.enabled - ? f.setUnsafe() - : f.isSafeBypassingInference(); + if (v.storage_class & STC.temp) + return false; + + if (!v.isScope()) + { + v.storage_class &= ~STC.maybescope; + v.doNotInferScope = true; + return false; + } + + if (!e.type) + return false; + + // When the type after dereferencing has no pointers, it's okay. + // Comes up when escaping `&someStruct.intMember` of a `scope` struct: + // scope does not apply to the `int` + Type t = e.type.baseElemOf(); + if ((t.ty == Tarray || t.ty == Tpointer) && !t.nextOf().toBasetype().hasPointers()) + return false; + + // take address of `scope` variable not allowed, requires transitive scope + return sc.setUnsafeDIP1000(gag, e.loc, + "cannot take address of `scope` variable `%s` since `scope` applies to first indirection only", v); } diff --git a/gcc/d/dmd/expression.d b/gcc/d/dmd/expression.d index 107e85b..0872356 100644 --- a/gcc/d/dmd/expression.d +++ b/gcc/d/dmd/expression.d @@ -1370,10 +1370,9 @@ extern (C++) abstract class Expression : ASTNode */ if (v.storage_class & STC.gshared) { - if (sc.func.setUnsafe()) + if (sc.func.setUnsafe(false, this.loc, + "`@safe` function `%s` cannot access `__gshared` data `%s`", sc.func, v)) { - error("`@safe` %s `%s` cannot access `__gshared` data `%s`", - sc.func.kind(), sc.func.toChars(), v.toChars()); err = true; } } @@ -1411,7 +1410,7 @@ extern (C++) abstract class Expression : ASTNode if (!f.isSafe() && !f.isTrusted()) { - if (sc.flags & SCOPE.compile ? sc.func.isSafeBypassingInference() : sc.func.setUnsafe()) + if (sc.flags & SCOPE.compile ? sc.func.isSafeBypassingInference() : sc.func.setUnsafeCall(f)) { if (!loc.isValid()) // e.g. implicitly generated dtor loc = sc.func.loc; @@ -1420,6 +1419,7 @@ extern (C++) abstract class Expression : ASTNode error("`@safe` %s `%s` cannot call `@system` %s `%s`", sc.func.kind(), sc.func.toPrettyChars(), f.kind(), prettyChars); + f.errorSupplementalInferredSafety(/*max depth*/ 10); .errorSupplemental(f.loc, "`%s` is declared here", prettyChars); checkOverridenDtor(sc, f, dd => dd.type.toTypeFunction().trust > TRUST.system, "@system"); @@ -1456,7 +1456,8 @@ extern (C++) abstract class Expression : ASTNode // Lowered non-@nogc'd hooks will print their own error message inside of nogc.d (NOGCVisitor.visit(CallExp e)), // so don't print anything to avoid double error messages. - if (!(f.ident == Id._d_HookTraceImpl || f.ident == Id._d_arraysetlengthT)) + if (!(f.ident == Id._d_HookTraceImpl || f.ident == Id._d_arraysetlengthT + || f.ident == Id._d_arrayappendT || f.ident == Id._d_arrayappendcTX)) error("`@nogc` %s `%s` cannot call non-@nogc %s `%s`", sc.func.kind(), sc.func.toPrettyChars(), f.kind(), f.toPrettyChars()); @@ -5760,9 +5761,8 @@ extern (C++) final class DelegatePtrExp : UnaExp override Expression modifiableLvalue(Scope* sc, Expression e) { - if (sc.func.setUnsafe()) + if (sc.func.setUnsafe(false, this.loc, "cannot modify delegate pointer in `@safe` code `%s`", this)) { - error("cannot modify delegate pointer in `@safe` code `%s`", toChars()); return ErrorExp.get(); } return Expression.modifiableLvalue(sc, e); @@ -5799,9 +5799,8 @@ extern (C++) final class DelegateFuncptrExp : UnaExp override Expression modifiableLvalue(Scope* sc, Expression e) { - if (sc.func.setUnsafe()) + if (sc.func.setUnsafe(false, this.loc, "cannot modify delegate function pointer in `@safe` code `%s`", this)) { - error("cannot modify delegate function pointer in `@safe` code `%s`", toChars()); return ErrorExp.get(); } return Expression.modifiableLvalue(sc, e); diff --git a/gcc/d/dmd/expressionsem.d b/gcc/d/dmd/expressionsem.d index d4e96bb..b65b0ed 100644 --- a/gcc/d/dmd/expressionsem.d +++ b/gcc/d/dmd/expressionsem.d @@ -1276,7 +1276,7 @@ private Expression resolvePropertiesX(Scope* sc, Expression e1, Expression e2 = // @@@DEPRECATED_2.105@@@ // When turning into error, uncomment the return statement TypeFunction tf = fd.type.isTypeFunction(); - deprecation(loc, "Function `%s` of type `%s` is not accessible from module `%s`", + deprecation(loc, "function `%s` of type `%s` is not accessible from module `%s`", fd.toPrettyChars(), tf.toChars, sc._module.toChars); //return ErrorExp.get(); } @@ -1298,7 +1298,7 @@ private Expression resolvePropertiesX(Scope* sc, Expression e1, Expression e2 = { // @@@DEPRECATED_2.105@@@ // When turning into error, uncomment the return statement - deprecation(loc, "Function `%s` of type `%s` is not accessible from module `%s`", + deprecation(loc, "function `%s` of type `%s` is not accessible from module `%s`", fd.toPrettyChars(), tf.toChars, sc._module.toChars); //return ErrorExp.get(); } @@ -2035,20 +2035,26 @@ private bool functionParameters(const ref Loc loc, Scope* sc, /* Argument value can be assigned to firstArg. * Check arg to see if it matters. */ - if (global.params.useDIP1000 == FeatureState.enabled) - err |= checkParamArgumentReturn(sc, firstArg, arg, p, false); + err |= checkParamArgumentReturn(sc, firstArg, arg, p, false); } // Allow 'lazy' to imply 'scope' - lazy parameters can be passed along // as lazy parameters to the next function, but that isn't escaping. - else if (!(pStc & (STC.scope_ | STC.lazy_))) + else if (!(pStc & STC.lazy_)) { /* Argument value can escape from the called function. * Check arg to see if it matters. */ - if (global.params.useDIP1000 == FeatureState.enabled) - err |= checkParamArgumentEscape(sc, fd, p, arg, false, false); + err |= checkParamArgumentEscape(sc, fd, p, cast(STC) pStc, arg, false, false); } - else if (!(pStc & STC.return_)) + + // Turning heap allocations into stack allocations is dangerous without dip1000, since `scope` inference + // may be unreliable when scope violations only manifest as deprecation warnings. + // However, existing `@nogc` code may rely on it, so still do it when the parameter is explicitly marked `scope` + const explicitScope = (p.storageClass & STC.lazy_) || + ((p.storageClass & STC.scope_) && !(p.storageClass & STC.scopeinferred)); + if ((pStc & (STC.scope_ | STC.lazy_)) && + ((global.params.useDIP1000 == FeatureState.enabled) || explicitScope) && + !(pStc & STC.return_)) { /* Argument value cannot escape from the called function. */ @@ -2058,13 +2064,14 @@ private bool functionParameters(const ref Loc loc, Scope* sc, ArrayLiteralExp ale; if (p.type.toBasetype().ty == Tarray && - (ale = a.isArrayLiteralExp()) !is null) + (ale = a.isArrayLiteralExp()) !is null && ale.elements && ale.elements.length > 0) { // allocate the array literal as temporary static array on the stack - ale.type = ale.type.nextOf().sarrayOf(ale.elements ? ale.elements.length : 0); + ale.type = ale.type.nextOf().sarrayOf(ale.elements.length); auto tmp = copyToTemp(0, "__arrayliteral_on_stack", ale); auto declareTmp = new DeclarationExp(ale.loc, tmp); - auto castToSlice = new CastExp(ale.loc, new VarExp(ale.loc, tmp), p.type); + auto castToSlice = new CastExp(ale.loc, new VarExp(ale.loc, tmp), + p.type.substWildTo(MODFlags.mutable)); arg = CommaExp.combine(declareTmp, castToSlice); arg = arg.expressionSemantic(sc); } @@ -2473,7 +2480,7 @@ Package resolveIsPackage(Dsymbol sym) { if (imp.pkg is null) { - .error(sym.loc, "Internal Compiler Error: unable to process forward-referenced import `%s`", + .error(sym.loc, "internal compiler error: unable to process forward-referenced import `%s`", imp.toChars()); assert(0); } @@ -2995,7 +3002,7 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor buffer.write4(0); e.setData(buffer.extractData(), newlen, 4); if (sc && sc.flags & SCOPE.Cfile) - e.type = Type.tuns32.pointerTo(); + e.type = Type.tuns32.sarrayOf(e.len + 1); else e.type = Type.tdchar.immutableOf().arrayOf(); e.committed = 1; @@ -3020,7 +3027,7 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor buffer.writeUTF16(0); e.setData(buffer.extractData(), newlen, 2); if (sc && sc.flags & SCOPE.Cfile) - e.type = Type.tuns16.pointerTo(); + e.type = Type.tuns16.sarrayOf(e.len + 1); else e.type = Type.twchar.immutableOf().arrayOf(); e.committed = 1; @@ -3032,7 +3039,7 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor default: if (sc && sc.flags & SCOPE.Cfile) - e.type = Type.tchar.pointerTo(); + e.type = Type.tchar.sarrayOf(e.len + 1); else e.type = Type.tchar.immutableOf().arrayOf(); break; @@ -3170,11 +3177,8 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor semanticTypeInfo(sc, e.type); - if (global.params.useDIP1000 == FeatureState.enabled) - { - if (checkAssocArrayLiteralEscape(sc, e, false)) - return setError(); - } + if (checkAssocArrayLiteralEscape(sc, e, false)) + return setError(); result = e; } @@ -3261,7 +3265,7 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor // to fix https://issues.dlang.org/show_bug.cgi?id=9490 VarExp ve = e.isVarExp(); if (ve && ve.var && exp.parens && !ve.var.isStatic() && !(sc.stc & STC.static_) && - sc.func && sc.func.needThis && ve.var.toParent2().isAggregateDeclaration()) + sc.func && sc.func.needThis && ve.var.isMember2()) { // printf("apply fix for issue 9490: add `this.` to `%s`...\n", e.toChars()); e = new DotVarExp(exp.loc, new ThisExp(exp.loc), ve.var, false); @@ -3782,13 +3786,10 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor /* Since a `new` allocation may escape, check each of the arguments for escaping */ - if (global.params.useDIP1000 == FeatureState.enabled) + foreach (arg; *exp.arguments) { - foreach (arg; *exp.arguments) - { - if (arg && checkNewEscape(sc, arg, false)) - return setError(); - } + if (arg && checkNewEscape(sc, arg, false)) + return setError(); } } @@ -4677,7 +4678,7 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor } if (exp.f.needThis()) { - AggregateDeclaration ad = exp.f.toParentLocal().isAggregateDeclaration(); + AggregateDeclaration ad = exp.f.isMemberLocal(); ue.e1 = getRightThis(exp.loc, sc, ad, ue.e1, exp.f); if (ue.e1.op == EXP.error) { @@ -4688,7 +4689,7 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor tthis = ue.e1.type; if (!(exp.f.type.ty == Tfunction && (cast(TypeFunction)exp.f.type).isScopeQual)) { - if (global.params.useDIP1000 == FeatureState.enabled && checkParamArgumentEscape(sc, exp.f, null, ethis, false, false)) + if (checkParamArgumentEscape(sc, exp.f, null, STC.undefined_, ethis, false, false)) return setError(); } } @@ -5393,7 +5394,7 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor { if (tb.toDsymbol(sc).isClassDeclaration().classKind == ClassKind.cpp) { - error(exp.loc, "Runtime type information is not supported for `extern(C++)` classes"); + error(exp.loc, "runtime type information is not supported for `extern(C++)` classes"); e = ErrorExp.get(); } else if (!Type.typeinfoclass) @@ -6026,18 +6027,18 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor const slice = se.peekString(); message("file %.*s\t(%s)", cast(int)slice.length, slice.ptr, name); } - if (global.params.moduleDeps !is null) + if (global.params.moduleDeps.buffer !is null) { - OutBuffer* ob = global.params.moduleDeps; + OutBuffer* ob = global.params.moduleDeps.buffer; Module imod = sc._module; - if (!global.params.moduleDepsFile) + if (!global.params.moduleDeps.name) ob.writestring("depsFile "); ob.writestring(imod.toPrettyChars()); ob.writestring(" ("); escapePath(ob, imod.srcfile.toChars()); ob.writestring(") : "); - if (global.params.moduleDepsFile) + if (global.params.moduleDeps.name) ob.writestring("string : "); ob.write(se.peekString()); ob.writestring(" ("); @@ -6045,9 +6046,9 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor ob.writestring(")"); ob.writenl(); } - if (global.params.emitMakeDeps) + if (global.params.makeDeps.doOutput) { - global.params.makeDeps.push(name); + global.params.makeDeps.files.push(name); } { @@ -6349,7 +6350,7 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor exp.msg = resolveProperties(sc, exp.msg); exp.msg = exp.msg.implicitCastTo(sc, Type.tchar.constOf().arrayOf()); exp.msg = exp.msg.optimize(WANTvalue); - checkParamArgumentEscape(sc, null, null, exp.msg, true, false); + checkParamArgumentEscape(sc, null, null, STC.undefined_, exp.msg, true, false); } if (exp.msg && exp.msg.op == EXP.error) @@ -6625,6 +6626,14 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor exp.type = exp.type.addMod(t1.mod); + // https://issues.dlang.org/show_bug.cgi?id=23109 + // Run semantic on the DotVarExp type + if (auto handle = exp.type.isClassHandle()) + { + if (handle.semanticRun < PASS.semanticdone && !handle.isBaseInfoComplete()) + handle.dsymbolSemantic(null); + } + Dsymbol vparent = exp.var.toParent(); AggregateDeclaration ad = vparent ? vparent.isAggregateDeclaration() : null; if (Expression e1x = getRightThis(exp.loc, sc, ad, exp.e1, exp.var, 1)) @@ -6705,24 +6714,12 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor e.type = e.type.typeSemantic(e.loc, sc); FuncDeclaration f = e.func.toAliasFunc(); - AggregateDeclaration ad = f.toParentLocal().isAggregateDeclaration(); + AggregateDeclaration ad = f.isMemberLocal(); if (f.needThis()) e.e1 = getRightThis(e.loc, sc, ad, e.e1, f); if (e.e1.op == EXP.error) return setError(); - /* A delegate takes the address of e.e1 in order to set the .ptr field - * https://issues.dlang.org/show_bug.cgi?id=18575 - */ - if (global.params.useDIP1000 == FeatureState.enabled && e.e1.type.toBasetype().ty == Tstruct) - { - if (auto v = expToVariable(e.e1)) - { - if (!checkAddressVar(sc, e.e1, v)) - return setError(); - } - } - if (f.type.ty == Tfunction) { TypeFunction tf = cast(TypeFunction)f.type; @@ -6809,20 +6806,26 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor if (sc.flags & SCOPE.Cfile) { - /* Special handling for &"string" - * since C regards a string literal as an lvalue + /* Special handling for &"string"/&(T[]){0, 1} + * since C regards string/array literals as lvalues */ - if (auto se = exp.e1.isStringExp()) + auto e = exp.e1; + if(e.isStringExp() || e.isArrayLiteralExp()) { - if (auto tp = se.type.toBasetype().isTypePointer()) + e.type = typeSemantic(e.type, Loc.initial, sc); + // if type is already a pointer exp is an illegal expression of the form `&(&"")` + if (!e.type.isTypePointer()) { - /* Switch from pointer-to-char to pointer-to-static-array-of-char - */ - auto ts = new TypeSArray(tp.nextOf(), new IntegerExp(Loc.initial, se.len + 1, Type.tsize_t)); - se.type = typeSemantic(ts, Loc.initial, sc).pointerTo(); - result = se; + e.type = e.type.pointerTo(); + result = e; return; } + else + { + // `toLvalue` call further below is upon exp.e1, omitting & from the error message + exp.toLvalue(sc, null); + return setError(); + } } } @@ -6891,19 +6894,19 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor * because it might end up being a pointer to undefined * memory. */ - if (sc.func && !sc.intypeof && !(sc.flags & SCOPE.debug_) && sc.func.setUnsafe()) + if (sc.func && !sc.intypeof && !(sc.flags & SCOPE.debug_)) { - exp.error("cannot take address of lazy parameter `%s` in `@safe` function `%s`", - ve.toChars(), sc.func.toChars()); - setError(); - } - else - { - VarExp ve2 = callExp.e1.isVarExp(); - ve2.delegateWasExtracted = true; - ve2.var.storage_class |= STC.scope_; - result = ve2; + if (sc.func.setUnsafe(false, exp.loc, + "cannot take address of lazy parameter `%s` in `@safe` function `%s`", ve, sc.func)) + { + setError(); + return; + } } + VarExp ve2 = callExp.e1.isVarExp(); + ve2.delegateWasExtracted = true; + ve2.var.storage_class |= STC.scope_; + result = ve2; return; } } @@ -6987,15 +6990,6 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor // Look for misaligned pointer in @safe mode if (checkUnsafeAccess(sc, dve, !exp.type.isMutable(), true)) return setError(); - - if (global.params.useDIP1000 == FeatureState.enabled) - { - if (VarDeclaration v = expToVariable(dve.e1)) - { - if (!checkAddressVar(sc, exp.e1, v)) - return setError(); - } - } } else if (exp.e1.op == EXP.variable) { @@ -7049,29 +7043,15 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor result = e; return; } - if (sc.func && !sc.intypeof) + if (sc.func && !sc.intypeof && !(sc.flags & SCOPE.debug_)) { - if (!(sc.flags & SCOPE.debug_) && sc.func.setUnsafe()) - { - exp.error("`this` reference necessary to take address of member `%s` in `@safe` function `%s`", f.toChars(), sc.func.toChars()); - } + sc.func.setUnsafe(false, exp.loc, + "`this` reference necessary to take address of member `%s` in `@safe` function `%s`", + f, sc.func); } } } } - else if ((exp.e1.op == EXP.this_ || exp.e1.op == EXP.super_) && global.params.useDIP1000 == FeatureState.enabled) - { - if (VarDeclaration v = expToVariable(exp.e1)) - { - if (!checkAddressVar(sc, exp.e1, v)) - return setError(); - } - } - else if (auto ce = exp.e1.isCallExp()) - { - if (!checkAddressCall(sc, ce, "take address of")) - return setError(); - } else if (exp.e1.op == EXP.index) { /* For: @@ -7081,9 +7061,6 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor */ if (VarDeclaration v = expToVariable(exp.e1)) { - if (global.params.useDIP1000 == FeatureState.enabled && !checkAddressVar(sc, exp.e1, v)) - return setError(); - exp.e1.checkPurity(sc, v); } } @@ -7839,10 +7816,10 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor return setError(); } - if (sc.func && !sc.intypeof && !(sc.flags & SCOPE.debug_) && sc.func.setUnsafe()) + if (sc.func && !sc.intypeof && !(sc.flags & SCOPE.debug_)) { - exp.error("pointer slicing not allowed in safe functions"); - return setError(); + if (sc.func.setUnsafe(false, exp.loc, "pointer slicing not allowed in safe functions")) + return setError(); } } else if (t1b.ty == Tarray) @@ -7850,34 +7827,6 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor } else if (t1b.ty == Tsarray) { - if (!exp.arrayop && global.params.useDIP1000 == FeatureState.enabled) - { - /* Slicing a static array is like taking the address of it. - * Perform checks as if e[] was &e - */ - if (VarDeclaration v = expToVariable(exp.e1)) - { - if (DotVarExp dve = exp.e1.isDotVarExp()) - { - - if ((dve.e1.op == EXP.this_ || dve.e1.op == EXP.super_) && - !(v.storage_class & STC.ref_)) - { - // because it's a class - v = null; - } - } - - if (v && !checkAddressVar(sc, exp.e1, v)) - return setError(); - } - // https://issues.dlang.org/show_bug.cgi?id=22539 - if (auto ce = exp.e1.isCallExp()) - { - if (!checkAddressCall(sc, ce, "slice static array of")) - return setError(); - } - } } else if (t1b.ty == Ttuple) { @@ -8202,7 +8151,7 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor discardValue(e.e1); } else if (!e.allowCommaExp && !e.isGenerated) - e.error("Using the result of a comma expression is not allowed"); + e.error("using the result of a comma expression is not allowed"); } override void visit(IntervalExp e) @@ -8379,10 +8328,11 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor if (exp.e2.op == EXP.int64 && exp.e2.toInteger() == 0) { } - else if (sc.func && !(sc.flags & SCOPE.debug_) && sc.func.setUnsafe()) + else if (sc.func && !(sc.flags & SCOPE.debug_)) { - exp.error("safe function `%s` cannot index pointer `%s`", sc.func.toPrettyChars(), exp.e1.toChars()); - return setError(); + if (sc.func.setUnsafe(false, exp.loc, + "`@safe` function `%s` cannot index pointer `%s`", sc.func, exp.e1)) + return setError(); } exp.type = (cast(TypeNext)t1b).next; break; @@ -8675,10 +8625,10 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor { static if (LOGSEMANTIC) { - printf("AssignExp::semantic('%s')\n", exp.toChars()); + if (exp.op == EXP.blit) printf("BlitExp.toElem('%s')\n", exp.toChars()); + if (exp.op == EXP.assign) printf("AssignExp.toElem('%s')\n", exp.toChars()); + if (exp.op == EXP.construct) printf("ConstructExp.toElem('%s')\n", exp.toChars()); } - //printf("exp.e1.op = %d, '%s'\n", exp.e1.op, EXPtoString(exp.e1.op).ptr); - //printf("exp.e2.op = %d, '%s'\n", exp.e2.op, EXPtoString(exp.e2.op).ptr); void setResult(Expression e, int line = __LINE__) { @@ -8696,7 +8646,7 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor if (auto e2comma = exp.e2.isCommaExp()) { if (!e2comma.isGenerated && !(sc.flags & SCOPE.Cfile)) - exp.error("Using the result of a comma expression is not allowed"); + exp.error("using the result of a comma expression is not allowed"); /* Rewrite to get rid of the comma from rvalue * e1=(e0,e2) => e0,(e1=e2) @@ -9425,6 +9375,23 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor Expression e1x = exp.e1; Expression e2x = exp.e2; + /* C strings come through as static arrays. May need to adjust the size of the + * string to match the size of e1. + */ + Type t2 = e2x.type.toBasetype(); + if (sc.flags & SCOPE.Cfile && e2x.isStringExp() && t2.isTypeSArray()) + { + uinteger_t dim1 = t1.isTypeSArray().dim.toInteger(); + uinteger_t dim2 = t2.isTypeSArray().dim.toInteger(); + if (dim1 + 1 == dim2 || dim2 < dim1) + { + auto tsa2 = t2.isTypeSArray(); + auto newt = tsa2.next.sarrayOf(dim1).immutableOf(); + e2x = castTo(e2x, sc, newt); + exp.e2 = e2x; + } + } + if (e2x.implicitConvTo(e1x.type)) { if (exp.op != EXP.blit && (e2x.op == EXP.slice && (cast(UnaExp)e2x).e1.isLvalue() || e2x.op == EXP.cast_ && (cast(UnaExp)e2x).e1.isLvalue() || e2x.op != EXP.slice && e2x.isLvalue())) @@ -9686,13 +9653,14 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor tsa2 = cast(TypeSArray)toStaticArrayType(se); else tsa2 = t2.isTypeSArray(); + if (tsa1 && tsa2) { uinteger_t dim1 = tsa1.dim.toInteger(); uinteger_t dim2 = tsa2.dim.toInteger(); if (dim1 != dim2) { - exp.error("mismatched array lengths, %d and %d", cast(int)dim1, cast(int)dim2); + exp.error("mismatched array lengths %d and %d for assignment `%s`", cast(int)dim1, cast(int)dim2, exp.toChars()); return setError(); } } @@ -9761,10 +9729,10 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor } if (t1n.toBasetype.ty == Tvoid && t2n.toBasetype.ty == Tvoid) { - if (!sc.intypeof && sc.func && !(sc.flags & SCOPE.debug_) && sc.func.setUnsafe()) + if (!sc.intypeof && sc.func && !(sc.flags & SCOPE.debug_)) { - exp.error("cannot copy `void[]` to `void[]` in `@safe` code"); - return setError(); + if (sc.func.setUnsafe(false, exp.loc, "cannot copy `void[]` to `void[]` in `@safe` code")) + return setError(); } } } @@ -10190,10 +10158,135 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor exp.type = exp.e1.type; auto res = exp.reorderSettingAAElem(sc); - if ((exp.op == EXP.concatenateElemAssign || exp.op == EXP.concatenateDcharAssign) && - global.params.useDIP1000 == FeatureState.enabled) + if (exp.op == EXP.concatenateElemAssign || exp.op == EXP.concatenateDcharAssign) checkAssignEscape(sc, res, false, false); result = res; + + if ((exp.op == EXP.concatenateAssign || exp.op == EXP.concatenateElemAssign) && + !(sc.flags & (SCOPE.ctfe | SCOPE.compile))) + { + // if aa ordering is triggered, `res` will be a CommaExp + // and `.e2` will be the rewritten original expression. + + // `output` will point to the expression that the lowering will overwrite + Expression* output; + if (auto comma = res.isCommaExp()) + { + output = &comma.e2; + // manual cast because it could be either CatAssignExp or CatElemAssignExp + exp = cast(CatAssignExp)comma.e2; + } + else + { + output = &result; + exp = cast(CatAssignExp)result; + } + + if (exp.op == EXP.concatenateAssign) + { + Identifier hook = global.params.tracegc ? Id._d_arrayappendTTrace : Id._d_arrayappendT; + + if (!verifyHookExist(exp.loc, *sc, hook, "appending array to arrays", Id.object)) + return setError(); + + // Lower to object._d_arrayappendT{,Trace}({file, line, funcname}, e1, e2) + Expression id = new IdentifierExp(exp.loc, Id.empty); + id = new DotIdExp(exp.loc, id, Id.object); + id = new DotIdExp(exp.loc, id, hook); + + auto arguments = new Expressions(); + arguments.reserve(5); + if (global.params.tracegc) + { + auto funcname = (sc.callsc && sc.callsc.func) ? sc.callsc.func.toPrettyChars() : sc.func.toPrettyChars(); + arguments.push(new StringExp(exp.loc, exp.loc.filename.toDString())); + arguments.push(new IntegerExp(exp.loc, exp.loc.linnum, Type.tint32)); + arguments.push(new StringExp(exp.loc, funcname.toDString())); + } + + arguments.push(exp.e1); + arguments.push(exp.e2); + Expression ce = new CallExp(exp.loc, id, arguments); + *output = ce.expressionSemantic(sc); + } + else if (exp.op == EXP.concatenateElemAssign) + { + /* Do not lower concats to the indices array returned by + *`static foreach`, as this array is only used at compile-time. + */ + if (auto ve = exp.e1.isVarExp) + { + import core.stdc.ctype : isdigit; + // The name of the indices array that static foreach loops uses. + // See dmd.cond.lowerNonArrayAggregate + enum varName = "__res"; + const(char)[] id = ve.var.ident.toString; + if (ve.var.storage_class & STC.temp && id.length > varName.length && + id[0 .. varName.length] == varName && id[varName.length].isdigit) + return; + } + + Identifier hook = global.params.tracegc ? Id._d_arrayappendcTXTrace : Id._d_arrayappendcTX; + if (!verifyHookExist(exp.loc, *sc, Id._d_arrayappendcTXImpl, "appending element to arrays", Id.object)) + return setError(); + + // Lower to object._d_arrayappendcTXImpl!(typeof(e1))._d_arrayappendcTX{,Trace}(e1, 1), e1[$-1]=e2 + Expression id = new IdentifierExp(exp.loc, Id.empty); + id = new DotIdExp(exp.loc, id, Id.object); + auto tiargs = new Objects(); + tiargs.push(exp.e1.type); + id = new DotTemplateInstanceExp(exp.loc, id, Id._d_arrayappendcTXImpl, tiargs); + id = new DotIdExp(exp.loc, id, hook); + + auto arguments = new Expressions(); + arguments.reserve(5); + if (global.params.tracegc) + { + auto funcname = (sc.callsc && sc.callsc.func) ? sc.callsc.func.toPrettyChars() : sc.func.toPrettyChars(); + arguments.push(new StringExp(exp.loc, exp.loc.filename.toDString())); + arguments.push(new IntegerExp(exp.loc, exp.loc.linnum, Type.tint32)); + arguments.push(new StringExp(exp.loc, funcname.toDString())); + } + + Expression eValue1; + Expression value1 = extractSideEffect(sc, "__appendtmp", eValue1, exp.e1); + + arguments.push(value1); + arguments.push(new IntegerExp(exp.loc, 1, Type.tsize_t)); + + Expression ce = new CallExp(exp.loc, id, arguments); + + Expression eValue2; + Expression value2 = exp.e2; + if (!value2.isVarExp() && !value2.isConst()) + { + /* Before the template hook, this check was performed in e2ir.d + * for expressions like `a ~= a[$-1]`. Here, $ will be modified + * by calling `_d_arrayappendcT`, so we need to save `a[$-1]` in + * a temporary variable. + */ + value2 = extractSideEffect(sc, "__appendtmp", eValue2, value2, true); + exp.e2 = value2; + + // `__appendtmp*` will be destroyed together with the array `exp.e1`. + auto vd = eValue2.isDeclarationExp().declaration.isVarDeclaration(); + vd.storage_class |= STC.nodtor; + } + + auto ale = new ArrayLengthExp(exp.loc, value1); + auto elem = new IndexExp(exp.loc, value1, new MinExp(exp.loc, ale, IntegerExp.literal!1)); + auto ae = new ConstructExp(exp.loc, elem, value2); + + auto e0 = Expression.combine(ce, ae).expressionSemantic(sc); + e0 = Expression.combine(e0, value1); + e0 = Expression.combine(eValue1, e0); + + e0 = Expression.combine(eValue2, e0); + + *output = e0.expressionSemantic(sc); + } + } + } override void visit(AddExp exp) @@ -11639,7 +11732,7 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor auto t1 = exp.e1.type; auto t2 = exp.e2.type; if (t1.ty == Tenum && t2.ty == Tenum && !t1.equivalent(t2)) - exp.error("Comparison between different enumeration types `%s` and `%s`; If this behavior is intended consider using `std.conv.asOriginalType`", + exp.error("comparison between different enumeration types `%s` and `%s`; If this behavior is intended consider using `std.conv.asOriginalType`", t1.toChars(), t2.toChars()); } @@ -11996,7 +12089,7 @@ private extern (C++) final class ExpressionSemanticVisitor : Visitor } // C11 6.5.1.1 Generic Selection - auto ec = exp.cntlExp.expressionSemantic(sc); + auto ec = exp.cntlExp.expressionSemantic(sc).arrayFuncConv(sc); bool errors = ec.isErrorExp() !is null; auto tc = ec.type; @@ -12622,12 +12715,21 @@ Expression semanticY(DotIdExp exp, Scope* sc, int flag) Expression e = new IntegerExp(exp.loc, actualAlignment, Type.tsize_t); return e; } - else if (cfile && exp.ident == Id.__sizeof && exp.e1.isStringExp()) + else if ((exp.ident == Id.max || exp.ident == Id.min) && + exp.e1.isVarExp() && + exp.e1.isVarExp().var.isBitFieldDeclaration()) { - // Sizeof string literal includes the terminating 0 - auto se = exp.e1.isStringExp(); - Expression e = new IntegerExp(exp.loc, (se.len + 1) * se.sz, Type.tsize_t); - return e; + // For `x.max` and `x.min` get the max/min of the bitfield, not the max/min of its type + auto bf = exp.e1.isVarExp().var.isBitFieldDeclaration(); + return new IntegerExp(exp.loc, bf.getMinMax(exp.ident), bf.type); + } + else if ((exp.ident == Id.max || exp.ident == Id.min) && + exp.e1.isDotVarExp() && + exp.e1.isDotVarExp().var.isBitFieldDeclaration()) + { + // For `x.max` and `x.min` get the max/min of the bitfield, not the max/min of its type + auto bf = exp.e1.isDotVarExp().var.isBitFieldDeclaration(); + return new IntegerExp(exp.loc, bf.getMinMax(exp.ident), bf.type); } else { @@ -12635,7 +12737,9 @@ Expression semanticY(DotIdExp exp, Scope* sc, int flag) flag = 0; Expression e = exp.e1.type.dotExp(sc, exp.e1, exp.ident, flag | (exp.noderef ? DotExpFlag.noDeref : 0)); if (e) + { e = e.expressionSemantic(sc); + } return e; } } @@ -12982,22 +13086,12 @@ bool checkAddressVar(Scope* sc, Expression exp, VarDeclaration v) if (sc.func && !sc.intypeof && !v.isDataseg()) { const(char)* p = v.isParameter() ? "parameter" : "local"; - if (global.params.useDIP1000 == FeatureState.enabled) - { - // Taking the address of v means it cannot be set to 'scope' later - v.storage_class &= ~STC.maybescope; - v.doNotInferScope = true; - if (exp.type.hasPointers() && v.storage_class & STC.scope_ && - !(v.storage_class & STC.temp) && - !(sc.flags & SCOPE.debug_) && sc.func.setUnsafe()) - { - exp.error("cannot take address of `scope` %s `%s` in `@safe` function `%s`", p, v.toChars(), sc.func.toChars()); - return false; - } - } - else if (!(sc.flags & SCOPE.debug_) && - !(v.storage_class & STC.temp) && - sc.func.setUnsafe()) + v.storage_class &= ~STC.maybescope; + v.doNotInferScope = true; + if (global.params.useDIP1000 != FeatureState.enabled && + !(sc.flags & SCOPE.debug_) && + !(v.storage_class & STC.temp) && + sc.func.setUnsafe()) { exp.error("cannot take address of %s `%s` in `@safe` function `%s`", p, v.toChars(), sc.func.toChars()); return false; @@ -13007,37 +13101,6 @@ bool checkAddressVar(Scope* sc, Expression exp, VarDeclaration v) return true; } -/**************************************************** - * Determine if the address of a `ref return` value of - * a function call with type `tf` can be taken safely. - * - * This is currently stricter than necessary: it can be safe to take the - * address of a `ref` with pointer type when the pointer isn't `scope`, but - * that involves inspecting the function arguments and parameter types, which - * is left as a future enhancement. - * - * Params: - * sc = context - * ce = function call in question - * action = for the error message, how the pointer is taken, e.g. "slice static array of" - * Returns: - * `true` if ok, `false` for error - */ -private bool checkAddressCall(Scope* sc, CallExp ce, const(char)* action) -{ - if (auto tf = ce.e1.type.isTypeFunction()) - { - if (tf.isref && sc.func && !sc.intypeof && !(sc.flags & SCOPE.debug_) - && tf.next.hasPointers() && sc.func.setUnsafe()) - { - ce.error("cannot %s `ref return` of `%s()` in `@safe` function `%s`", - action, ce.e1.toChars(), sc.func.toChars()); - ce.errorSupplemental("return type `%s` has pointers that may be `scope`", tf.next.toChars()); - return false; - } - } - return true; -} /******************************* * Checks the attributes of a function. @@ -13241,10 +13304,9 @@ private bool fit(StructDeclaration sd, const ref Loc loc, Scope* sc, Expressions { if ((!stype.alignment.isDefault() && stype.alignment.get() < target.ptrsize || (v.offset & (target.ptrsize - 1))) && - (sc.func && sc.func.setUnsafe())) + (sc.func && sc.func.setUnsafe(false, loc, + "field `%s.%s` cannot assign to misaligned pointers in `@safe` code", sd, v))) { - .error(loc, "field `%s.%s` cannot assign to misaligned pointers in `@safe` code", - sd.toChars(), v.toChars()); return false; } } diff --git a/gcc/d/dmd/func.d b/gcc/d/dmd/func.d index 8d83951..e53a540 100644 --- a/gcc/d/dmd/func.d +++ b/gcc/d/dmd/func.d @@ -344,6 +344,10 @@ extern (C++) class FuncDeclaration : Declaration FuncDeclarations *inlinedNestedCallees; + /// In case of failed `@safe` inference, store the error that made the function `@system` for + /// better diagnostics + private AttributeViolation* safetyViolation; + /// Function flags: A collection of boolean packed for memory efficiency /// See the `FUNCFLAG` enum uint flags = FUNCFLAG.NRVO; @@ -1207,12 +1211,12 @@ extern (C++) class FuncDeclaration : Declaration final bool isMain() const { - return ident == Id.main && linkage != LINK.c && !isMember() && !isNested(); + return ident == Id.main && resolvedLinkage() != LINK.c && !isMember() && !isNested(); } final bool isCMain() const { - return ident == Id.main && linkage == LINK.c && !isMember() && !isNested(); + return ident == Id.main && resolvedLinkage() == LINK.c && !isMember() && !isNested(); } final bool isWinMain() const @@ -1220,24 +1224,24 @@ extern (C++) class FuncDeclaration : Declaration //printf("FuncDeclaration::isWinMain() %s\n", toChars()); version (none) { - bool x = ident == Id.WinMain && linkage != LINK.c && !isMember(); + bool x = ident == Id.WinMain && resolvedLinkage() != LINK.c && !isMember(); printf("%s\n", x ? "yes" : "no"); return x; } else { - return ident == Id.WinMain && linkage != LINK.c && !isMember(); + return ident == Id.WinMain && resolvedLinkage() != LINK.c && !isMember(); } } final bool isDllMain() const { - return ident == Id.DllMain && linkage != LINK.c && !isMember(); + return ident == Id.DllMain && resolvedLinkage() != LINK.c && !isMember(); } final bool isRtInit() const { - return ident == Id.rt_init && linkage == LINK.c && !isMember() && !isNested(); + return ident == Id.rt_init && resolvedLinkage() == LINK.c && !isMember() && !isNested(); } override final bool isExport() const @@ -1349,8 +1353,7 @@ extern (C++) class FuncDeclaration : Declaration flags |= FUNCFLAG.returnInprocess; // Initialize for inferring STC.scope_ - if (global.params.useDIP1000 == FeatureState.enabled) - flags |= FUNCFLAG.inferScope; + flags |= FUNCFLAG.inferScope; } final PURE isPure() @@ -1427,24 +1430,51 @@ extern (C++) class FuncDeclaration : Declaration } /************************************** - * The function is doing something unsafe, - * so mark it as unsafe. - * If there's a safe error, return true. + * The function is doing something unsafe, so mark it as unsafe. + * + * Params: + * gag = surpress error message (used in escape.d) + * loc = location of error + * fmt = printf-style format string + * arg0 = (optional) argument for first %s format specifier + * arg1 = (optional) argument for second %s format specifier + * Returns: whether there's a safe error */ - extern (D) final bool setUnsafe() + extern (D) final bool setUnsafe( + bool gag = false, Loc loc = Loc.init, const(char)* fmt = null, RootObject arg0 = null, RootObject arg1 = null) { if (flags & FUNCFLAG.safetyInprocess) { flags &= ~FUNCFLAG.safetyInprocess; type.toTypeFunction().trust = TRUST.system; + if (!gag && !safetyViolation && (fmt || arg0)) + safetyViolation = new AttributeViolation(loc, fmt, arg0, arg1); + if (fes) fes.func.setUnsafe(); } else if (isSafe()) + { + if (!gag && fmt) + .error(loc, fmt, arg0 ? arg0.toChars() : "", arg1 ? arg1.toChars() : ""); + return true; + } return false; } + /************************************** + * The function is calling `@system` function `f`, so mark it as unsafe. + * + * Params: + * f = function being called (needed for diagnostic of inferred functions) + * Returns: whether there's a safe error + */ + extern (D) final bool setUnsafeCall(FuncDeclaration f) + { + return setUnsafe(false, f.loc, null, f, null); + } + final bool isNogc() { //printf("isNogc() %s, inprocess: %d\n", toChars(), !!(flags & FUNCFLAG.nogcInprocess)); @@ -1474,6 +1504,12 @@ extern (C++) class FuncDeclaration : Declaration return !!(this.flags & FUNCFLAG.naked); } + final void isNaked(bool v) @safe pure nothrow @nogc + { + if (v) this.flags |= FUNCFLAG.naked; + else this.flags &= ~FUNCFLAG.naked; + } + final bool isGenerated() const scope @safe pure nothrow @nogc { return !!(this.flags & FUNCFLAG.generated); @@ -1520,11 +1556,23 @@ extern (C++) class FuncDeclaration : Declaration return !!(this.flags & FUNCFLAG.CRTCtor); } + final void isCrtCtor(bool v) @safe pure nothrow @nogc + { + if (v) this.flags |= FUNCFLAG.CRTCtor; + else this.flags &= ~FUNCFLAG.CRTCtor; + } + final bool isCrtDtor() const scope @safe pure nothrow @nogc { return !!(this.flags & FUNCFLAG.CRTDtor); } + final void isCrtDtor(bool v) @safe pure nothrow @nogc + { + if (v) this.flags |= FUNCFLAG.CRTDtor; + else this.flags &= ~FUNCFLAG.CRTDtor; + } + /************************************** * The function is doing something that may allocate with the GC, * so mark it as not nogc (not no-how). @@ -1758,7 +1806,7 @@ extern (C++) class FuncDeclaration : Declaration auto f = toAliasFunc(); //printf("\ttoParent2() = '%s'\n", f.toParent2().toChars()); return ((f.storage_class & STC.static_) == 0) && - (f.linkage == LINK.d) && + (f._linkage == LINK.d) && (f.toParent2().isFuncDeclaration() !is null || f.toParent2() !is f.toParentLocal()); } @@ -2645,7 +2693,7 @@ extern (C++) class FuncDeclaration : Declaration tf = new TypeFunction(ParameterList(fparams), treturn, LINK.c, stc); fd = new FuncDeclaration(Loc.initial, Loc.initial, id, STC.static_, tf); fd.visibility = Visibility(Visibility.Kind.public_); - fd.linkage = LINK.c; + fd._linkage = LINK.c; st.insert(fd); } @@ -2705,6 +2753,7 @@ extern (C++) class FuncDeclaration : Declaration const nparams = tf.parameterList.length; bool argerr; + const linkage = resolvedLinkage(); if (linkage == LINK.d) { if (nparams == 1) @@ -4271,3 +4320,47 @@ extern (C++) final class NewDeclaration : FuncDeclaration v.visit(this); } } + +/// Stores a reason why a function failed to infer a function attribute like `@safe` or `pure` +/// +/// Has two modes: +/// - a regular safety error, stored in (fmtStr, arg0, arg1) +/// - a call to a function without the attribute, which is a special case, because in that case, +/// that function might recursively also have a `AttributeViolation`. This way, in case +/// of a big call stack, the error can go down all the way to the root cause. +/// The `FunctionDeclaration` is then stored in `arg0` and `fmtStr` must be `null`. +private struct AttributeViolation +{ + /// location of error + Loc loc = Loc.init; + /// printf-style format string + const(char)* fmtStr = null; + /// Arguments for up to two `%s` format specifiers in format string + RootObject arg0 = null; + /// ditto + RootObject arg1 = null; +} + +/// Print the reason why `fd` was inferred `@system` as a supplemental error +/// Params: +/// fd = function to check +/// maxDepth = up to how many functions deep to report errors +void errorSupplementalInferredSafety(FuncDeclaration fd, int maxDepth) +{ + if (auto s = fd.safetyViolation) + { + if (s.fmtStr) + { + errorSupplemental(s.loc, "which was inferred `@system` because of:"); + errorSupplemental(s.loc, s.fmtStr, s.arg0 ? s.arg0.toChars() : "", s.arg1 ? s.arg1.toChars() : ""); + } + else if (FuncDeclaration fd2 = cast(FuncDeclaration) s.arg0) + { + if (maxDepth > 0) + { + errorSupplemental(s.loc, "which calls `%s`", fd2.toPrettyChars()); + errorSupplementalInferredSafety(fd2, maxDepth - 1); + } + } + } +} diff --git a/gcc/d/dmd/globals.d b/gcc/d/dmd/globals.d index 6b6655c..ba4ccbe 100644 --- a/gcc/d/dmd/globals.d +++ b/gcc/d/dmd/globals.d @@ -51,14 +51,6 @@ enum CHECKACTION : ubyte context, /// call D assert with the error context on failure } -/// Position Indepent Code setting -enum PIC : ubyte -{ - fixed, /// located at a specific address - pic, /// Position Independent Code - pie, /// Position Independent Executable -} - /** Each flag represents a field that can be included in the JSON output. @@ -83,14 +75,6 @@ enum CppStdRevision : uint cpp20 = 2020_02, } -/// Configuration for the C++ header generator -enum CxxHeaderMode : uint -{ - none, /// Don't generate headers - silent, /// Generate headers - verbose /// Generate headers and add comments for hidden declarations -} - /// Trivalent boolean to represent the state of a `revert`able change enum FeatureState : byte { @@ -99,15 +83,24 @@ enum FeatureState : byte enabled = 1 /// Specified as `-preview=` } +extern(C++) struct Output +{ + bool doOutput; // Output is enabled + bool fullOutput; // Generate comments for hidden declarations (for -HC), + // and don't strip the bodies of plain (non-template) functions (for -H) + + const(char)[] dir; // write to directory 'dir' + const(char)[] name; // write to file 'name' + Array!(const(char)*) files; // Other files associated with this output, + // e.g. macro include files for Ddoc, dependencies for makedeps + OutBuffer* buffer; // if this output is buffered, this is the buffer + int bufferLines; // number of lines written to the buffer +} /// Put command line switches in here extern (C++) struct Param { bool obj = true; // write object file - bool link = true; // perform link - bool dll; // generate shared dynamic library - bool lib; // write library file instead of object file(s) bool multiobj; // break one object file into multiple ones - bool oneobj; // write one object file instead of multiple ones bool trace; // insert profiling hooks bool tracegc; // instrument calls to 'new' bool verbose; // verbose compile @@ -120,11 +113,7 @@ extern (C++) struct Param bool vfield; // identify non-mutable field variables bool vcomplex = true; // identify complex/imaginary type usage bool vin; // identify 'in' parameters - ubyte symdebug; // insert debug symbolic information - bool symdebugref; // insert debug information for all referenced types, too - bool optimize; // run optimizer DiagnosticReporting useDeprecated = DiagnosticReporting.inform; // how use of deprecated features are handled - bool stackstomp; // add stack stomping code bool useUnitTests; // generate unittest code bool useInline = false; // inline expand functions FeatureState useDIP25; // implement https://wiki.dlang.org/DIP25 @@ -133,12 +122,10 @@ extern (C++) struct Param bool release; // build release version bool preservePaths; // true means don't strip path from source file DiagnosticReporting warnings = DiagnosticReporting.off; // how compiler warnings are handled - PIC pic = PIC.fixed; // generate fixed, pic or pie code bool color; // use ANSI colors in console output bool cov; // generate code coverage data ubyte covPercent; // 0..100 code coverage percentage required bool ctfe_cov = false; // generate coverage data for ctfe - bool nofloat; // code should not pull in floating point support bool ignoreUnsupportedPragmas; // rather than error on them bool useModuleInfo = true; // generate runtime module information bool useTypeInfo = true; // generate runtime type information @@ -162,6 +149,7 @@ extern (C++) struct Param FeatureState dtorFields; // destruct fields of partially constructed objects // https://issues.dlang.org/show_bug.cgi?id=14246 bool fieldwise; // do struct equality testing field-wise rather than by memcmp() + bool bitfields; // support C style bit fields FeatureState rvalueRefParam; // allow rvalues to be arguments to ref parameters // https://dconf.org/2019/talks/alexandrescu.html // https://gist.github.com/andralex/e5405a5d773f07f73196c05f8339435a @@ -170,9 +158,6 @@ extern (C++) struct Param CppStdRevision cplusplus = CppStdRevision.cpp11; // version of C++ standard to support - bool markdown = true; // enable Markdown replacements in Ddoc - bool vmarkdown; // list instances of Markdown replacements in Ddoc - bool showGaggedErrors; // print gagged errors anyway bool printErrorContext; // print errors with the error context (the error line in the source file) bool manual; // open browser on compiler manual @@ -207,27 +192,14 @@ extern (C++) struct Param const(char)[] objname; // .obj file output name const(char)[] libname; // .lib file output name - bool doDocComments; // process embedded documentation comments - const(char)[] docdir; // write documentation file to docdir directory - const(char)[] docname; // write documentation file to docname - Array!(const(char)*) ddocfiles; // macro include files for Ddoc - - bool doHdrGeneration; // process embedded documentation comments - const(char)[] hdrdir; // write 'header' file to docdir directory - const(char)[] hdrname; // write 'header' file to docname - bool hdrStripPlainFunctions = true; // strip the bodies of plain (non-template) functions - - CxxHeaderMode doCxxHdrGeneration; /// Generate 'Cxx header' file - const(char)[] cxxhdrdir; // write 'header' file to docdir directory - const(char)[] cxxhdrname; // write 'header' file to docname - - bool doJsonGeneration; // write JSON file - const(char)[] jsonfilename; // write JSON file to jsonfilename + Output ddoc; // Generate embedded documentation comments + Output dihdr; // Generate `.di` 'header' files + Output cxxhdr; // Generate 'Cxx header' file + Output json; // Generate JSON file JsonFieldFlags jsonFieldFlags; // JSON field flags to include - - OutBuffer* mixinOut; // write expanded mixins for debugging - const(char)* mixinFile; // .mixin file output name - int mixinLines; // Number of lines in writeMixins + Output makeDeps; // Generate make file dependencies + Output mixinOut; // write expanded mixins for debugging + Output moduleDeps; // Generate `.deps` module dependencies uint debuglevel; // debug level Array!(const(char)*)* debugids; // debug identifiers @@ -235,21 +207,12 @@ extern (C++) struct Param uint versionlevel; // version level Array!(const(char)*)* versionids; // version identifiers - const(char)[] defaultlibname; // default library for non-debug builds - const(char)[] debuglibname; // default library for debug builds - const(char)[] mscrtlib; // MS C runtime library - - const(char)[] moduleDepsFile; // filename for deps output - OutBuffer* moduleDeps; // contents to be written to deps file - - bool emitMakeDeps; // whether to emit makedeps - const(char)[] makeDepsFile; // filename for makedeps output - Array!(const(char)*) makeDeps; // dependencies for makedeps MessageStyle messageStyle = MessageStyle.digitalmars; // style of file/line annotations on messages bool run; // run resulting executable Strings runargs; // arguments for executable + Array!(const(char)*) cppswitches; // C preprocessor switches // Linker stuff Array!(const(char)*) objfiles; @@ -335,6 +298,8 @@ extern (C++) struct Global enum recursionLimit = 500; /// number of recursive template expansions before abort + extern (C++) FileName function(FileName, const(char)* importc_h, ref Array!(const(char)*) cppswitches, out bool) preprocess; + nothrow: /** @@ -468,15 +433,6 @@ extern (C++) struct Global { return _version.ptr; } - - /** - Returns: the final defaultlibname based on the command-line parameters - */ - extern (D) const(char)[] finalDefaultlibname() const - { - return params.betterC ? null : - params.symdebug ? params.debuglibname : params.defaultlibname; - } } // Because int64_t and friends may be any integral type of the diff --git a/gcc/d/dmd/globals.h b/gcc/d/dmd/globals.h index 2a33692..5c164fd 100644 --- a/gcc/d/dmd/globals.h +++ b/gcc/d/dmd/globals.h @@ -73,14 +73,6 @@ enum CppStdRevision CppStdRevisionCpp20 = 202002 }; -/// Configuration for the C++ header generator -enum class CxxHeaderMode -{ - none, /// Don't generate headers - silent, /// Generate headers - verbose /// Generate headers and add comments for hidden declarations -}; - /// Trivalent boolean to represent the state of a `revert`able change enum class FeatureState : signed char { @@ -89,15 +81,25 @@ enum class FeatureState : signed char enabled = 1 /// Specified as `-preview=` }; +struct Output +{ + /// Configuration for the compiler generator + bool doOutput; // Output is enabled + bool fullOutput; // Generate comments for hidden declarations (for -HC), + // and don't strip the bodies of plain (non-template) functions (for -H) + DString dir; // write to directory 'dir' + DString name; // write to file 'name' + Array<const char*> files; // Other files associated with this output, + // e.g. macro include files for Ddoc, dependencies for makedeps + OutBuffer* buffer; // if this output is buffered, this is the buffer + int bufferLines; // number of lines written to the buffer +}; + // Put command line switches in here struct Param { bool obj; // write object file - bool link; // perform link - bool dll; // generate shared dynamic library - bool lib; // write library file instead of object file(s) bool multiobj; // break one object file into multiple ones - bool oneobj; // write one object file instead of multiple ones bool trace; // insert profiling hooks bool tracegc; // instrument calls to 'new' bool verbose; // verbose compile @@ -110,11 +112,7 @@ struct Param bool vfield; // identify non-mutable field variables bool vcomplex; // identify complex/imaginary type usage bool vin; // identify 'in' parameters - unsigned char symdebug; // insert debug symbolic information - bool symdebugref; // insert debug information for all referenced types, too - bool optimize; // run optimizer Diagnostic useDeprecated; - bool stackstomp; // add stack stomping code bool useUnitTests; // generate unittest code bool useInline; // inline expand functions FeatureState useDIP25; // implement https://wiki.dlang.org/DIP25 @@ -123,12 +121,10 @@ struct Param bool release; // build release version bool preservePaths; // true means don't strip path from source file Diagnostic warnings; - unsigned char pic; // generate position-independent-code for shared libs bool color; // use ANSI colors in console output bool cov; // generate code coverage data unsigned char covPercent; // 0..100 code coverage percentage required bool ctfe_cov; // generate coverage data for ctfe - bool nofloat; // code should not pull in floating point support bool ignoreUnsupportedPragmas; // rather than error on them bool useModuleInfo; // generate runtime module information bool useTypeInfo; // generate runtime type information @@ -147,10 +143,9 @@ struct Param FeatureState dtorFields; // destruct fields of partially constructed objects // https://issues.dlang.org/show_bug.cgi?id=14246 bool fieldwise; // do struct equality testing field-wise rather than by memcmp() + bool bitfields; // support C style bit fields FeatureState rvalueRefParam; // allow rvalues to be arguments to ref parameters CppStdRevision cplusplus; // version of C++ name mangling to support - bool markdown; // enable Markdown replacements in Ddoc - bool vmarkdown; // list instances of Markdown replacements in Ddoc bool showGaggedErrors; // print gagged errors anyway bool printErrorContext; // print errors with the error context (the error line in the source file) bool manual; // open browser on compiler manual @@ -185,27 +180,14 @@ struct Param DString objname; // .obj file output name DString libname; // .lib file output name - bool doDocComments; // process embedded documentation comments - DString docdir; // write documentation file to docdir directory - DString docname; // write documentation file to docname - Array<const char *> ddocfiles; // macro include files for Ddoc - - bool doHdrGeneration; // process embedded documentation comments - DString hdrdir; // write 'header' file to docdir directory - DString hdrname; // write 'header' file to docname - bool hdrStripPlainFunctions; // strip the bodies of plain (non-template) functions - - CxxHeaderMode doCxxHdrGeneration; // write 'Cxx header' file - DString cxxhdrdir; // write 'header' file to docdir directory - DString cxxhdrname; // write 'header' file to docname - - bool doJsonGeneration; // write JSON file - DString jsonfilename; // write JSON file to jsonfilename + Output ddoc; // Generate embedded documentation comments + Output dihdr; // Generate `.di` 'header' files + Output cxxhdr; // Generate 'Cxx header' file + Output json; // Generate JSON file unsigned jsonFieldFlags; // JSON field flags to include - - OutBuffer *mixinOut; // write expanded mixins for debugging - const char *mixinFile; // .mixin file output name - int mixinLines; // Number of lines in writeMixins + Output makeDeps; // Generate make file dependencies + Output mixinOut; // write expanded mixins for debugging + Output moduleDeps; // Generate `.deps` module dependencies unsigned debuglevel; // debug level Array<const char *> *debugids; // debug identifiers @@ -213,22 +195,14 @@ struct Param unsigned versionlevel; // version level Array<const char *> *versionids; // version identifiers - DString defaultlibname; // default library for non-debug builds - DString debuglibname; // default library for debug builds - DString mscrtlib; // MS C runtime library - - DString moduleDepsFile; // filename for deps output - OutBuffer *moduleDeps; // contents to be written to deps file - - bool emitMakeDeps; // whether to emit makedeps - DString makeDepsFile; // filename for makedeps output - Array<const char *> makeDeps; // dependencies for makedeps MessageStyle messageStyle; // style of file/line annotations on messages bool run; // run resulting executable Strings runargs; // arguments for executable + Array<const char *> cppswitches; // preprocessor switches + // Linker stuff Array<const char *> objfiles; Array<const char *> linkswitches; @@ -296,6 +270,8 @@ struct Global FileManager* fileManager; + FileName (*preprocess)(FileName, const char*, Array<const char *>& cppswitches, bool&); + /* Start gagging. Return the current number of gagged errors */ unsigned startGagging(); diff --git a/gcc/d/dmd/hdrgen.d b/gcc/d/dmd/hdrgen.d index 69fdf27..fd35e1c 100644 --- a/gcc/d/dmd/hdrgen.d +++ b/gcc/d/dmd/hdrgen.d @@ -1536,7 +1536,7 @@ public: bodyToBuffer(f); hgs.autoMember--; } - else if (hgs.tpltMember == 0 && global.params.hdrStripPlainFunctions) + else if (hgs.tpltMember == 0 && global.params.dihdr.fullOutput == false) { if (!f.fbody) { @@ -1621,7 +1621,7 @@ public: void bodyToBuffer(FuncDeclaration f) { - if (!f.fbody || (hgs.hdrgen && global.params.hdrStripPlainFunctions && !hgs.autoMember && !hgs.tpltMember)) + if (!f.fbody || (hgs.hdrgen && global.params.dihdr.fullOutput == false && !hgs.autoMember && !hgs.tpltMember)) { if (!f.fbody && (f.fensures || f.frequires)) { diff --git a/gcc/d/dmd/id.d b/gcc/d/dmd/id.d index 11455af..ab9528a 100644 --- a/gcc/d/dmd/id.d +++ b/gcc/d/dmd/id.d @@ -349,6 +349,11 @@ immutable Msgtable[] msgtable = { "_d_arraysetlengthTImpl"}, { "_d_arraysetlengthT"}, { "_d_arraysetlengthTTrace"}, + { "_d_arrayappendT" }, + { "_d_arrayappendTTrace" }, + { "_d_arrayappendcTXImpl" }, + { "_d_arrayappendcTX" }, + { "_d_arrayappendcTXTrace" }, // varargs implementation { "stdc" }, @@ -454,6 +459,7 @@ immutable Msgtable[] msgtable = { "getVirtualFunctions" }, { "getVirtualMethods" }, { "classInstanceSize" }, + { "classInstanceAlignment" }, { "allMembers" }, { "derivedMembers" }, { "isSame" }, diff --git a/gcc/d/dmd/initsem.d b/gcc/d/dmd/initsem.d index c84a9f6..2cddd28 100644 --- a/gcc/d/dmd/initsem.d +++ b/gcc/d/dmd/initsem.d @@ -198,14 +198,16 @@ extern(C++) Initializer initializerSemantic(Initializer init, Scope* sc, ref Typ { if ((!t.alignment.isDefault() && t.alignment.get() < target.ptrsize || (vd.offset & (target.ptrsize - 1))) && - sc.func && sc.func.setUnsafe()) + sc.func) { - error(i.value[j].loc, "field `%s.%s` cannot assign to misaligned pointers in `@safe` code", - sd.toChars(), vd.toChars()); - errors = true; - elems[fieldi] = ErrorExp.get(); // for better diagnostics on multiple errors - ++fieldi; - continue; + if (sc.func.setUnsafe(false, i.value[j].loc, + "field `%s.%s` cannot assign to misaligned pointers in `@safe` code", sd, vd)) + { + errors = true; + elems[fieldi] = ErrorExp.get(); // for better diagnostics on multiple errors + ++fieldi; + continue; + } } } @@ -502,6 +504,18 @@ extern(C++) Initializer initializerSemantic(Initializer init, Scope* sc, ref Typ i.exp = se.castTo(sc, t); goto L1; } + + /* Lop off terminating 0 of initializer for: + * static char s[5] = "hello"; + */ + if (sc.flags & SCOPE.Cfile && + typeb.ty == Tsarray && + tynto.isSomeChar && + tb.isTypeSArray().dim.toInteger() + 1 == typeb.isTypeSArray().dim.toInteger()) + { + i.exp = se.castTo(sc, t); + goto L1; + } } /* C11 6.7.9-14..15 * Initialize an array of unknown size with a string. @@ -573,7 +587,7 @@ extern(C++) Initializer initializerSemantic(Initializer init, Scope* sc, ref Typ } else if (sc.flags & SCOPE.Cfile && i.exp.isStringExp() && tta && (tta.next.ty == Tint8 || tta.next.ty == Tuns8) && - ti.ty == Tpointer && ti.nextOf().ty == Tchar) + ti.ty == Tsarray && ti.nextOf().ty == Tchar) { /* unsigned char bbb[1] = ""; * signed char ccc[1] = ""; diff --git a/gcc/d/dmd/json.d b/gcc/d/dmd/json.d index fc27039..a22c664 100644 --- a/gcc/d/dmd/json.d +++ b/gcc/d/dmd/json.d @@ -446,7 +446,7 @@ public: return; jsonProperties(cast(Dsymbol)d); propertyStorageClass("storageClass", d.storage_class); - property("linkage", d.linkage); + property("linkage", d._linkage); property("type", "deco", d.type); // Emit originalType if it differs from type if (d.type != d.originalType && d.originalType) @@ -934,7 +934,7 @@ public: propertyStart("ddocFiles"); arrayStart(); - foreach (ddocFile; global.params.ddocfiles) + foreach (ddocFile; global.params.ddoc.files) { item(ddocFile.toDString); } diff --git a/gcc/d/dmd/mtype.d b/gcc/d/dmd/mtype.d index 13df0d7..be17ab3 100644 --- a/gcc/d/dmd/mtype.d +++ b/gcc/d/dmd/mtype.d @@ -4375,8 +4375,6 @@ extern (C++) final class TypeFunction : TypeNext { //printf("parameterStorageClass(p: %s)\n", p.toChars()); auto stc = p.storageClass; - if (global.params.useDIP1000 != FeatureState.enabled) - return stc; // When the preview switch is enable, `in` parameters are `scope` if (stc & STC.in_ && global.params.previewIn) @@ -4441,7 +4439,9 @@ extern (C++) final class TypeFunction : TypeNext // Check escaping through return value Type tret = nextOf().toBasetype(); if (isref || tret.hasPointers()) + { return stc | STC.scope_ | STC.return_ | STC.returnScope; + } else return stc | STC.scope_; } @@ -4764,12 +4764,31 @@ extern (C++) final class TypeFunction : TypeNext s ~= "@safe "; if (!f.isNogc && sc.func.setGC()) s ~= "nogc "; - s[$-1] = '\0'; - buf.printf("`%s` copy constructor cannot be called from a `%s` context", f.type.toChars(), s.ptr); - + if (s) + { + s[$-1] = '\0'; + buf.printf("`%s` copy constructor cannot be called from a `%s` context", f.type.toChars(), s.ptr); + } + else if (f.isGenerated() && f.isDisabled()) + { + /* https://issues.dlang.org/show_bug.cgi?id=23097 + * Compiler generated copy constructor failed. + */ + buf.printf("generating a copy constructor for `struct %s` failed, therefore instances of it are uncopyable", + argStruct.toChars()); + } + else + { + /* Although a copy constructor may exist, no suitable match was found. + * i.e: `inout` constructor creates `const` object, not mutable. + * Fallback to using the original generic error before bugzilla 22202. + */ + goto Lnocpctor; + } } else { + Lnocpctor: buf.printf("`struct %s` does not define a copy constructor for `%s` to `%s` copies", argStruct.toChars(), targ.toChars(), tprm.toChars()); } @@ -5134,22 +5153,6 @@ extern (C++) final class TypeDelegate : TypeNext override Type addStorageClass(StorageClass stc) { TypeDelegate t = cast(TypeDelegate)Type.addStorageClass(stc); - if (global.params.useDIP1000 != FeatureState.enabled) - return t; - - /* The rest is meant to add 'scope' to a delegate declaration if it is of the form: - * alias dg_t = void* delegate(); - * scope dg_t dg = ...; - */ - if(stc & STC.scope_) - { - auto n = t.next.addStorageClass(STC.scope_ | STC.scopeinferred); - if (n != t.next) - { - t.next = n; - t.deco = t.merge().deco; // mangling supposed to not be changed due to STC.scope_inferrred - } - } return t; } @@ -5218,8 +5221,8 @@ extern (C++) final class TypeTraits : Type Loc loc; /// The expression to resolve as type or symbol. TraitsExp exp; - /// After `typeSemantic` the symbol when `exp` doesn't represent a type. - Dsymbol sym; + /// Cached type/symbol after semantic analysis. + RootObject obj; final extern (D) this(const ref Loc loc, TraitsExp exp) { diff --git a/gcc/d/dmd/mtype.h b/gcc/d/dmd/mtype.h index 6ba47df..d2b1364 100644 --- a/gcc/d/dmd/mtype.h +++ b/gcc/d/dmd/mtype.h @@ -670,8 +670,8 @@ class TypeTraits : public Type Loc loc; /// The expression to resolve as type or symbol. TraitsExp *exp; - /// The symbol when exp doesn't represent a type. - Dsymbol *sym; + /// Cached type/symbol after semantic analysis. + RootObject *obj; const char *kind(); TypeTraits *syntaxCopy(); diff --git a/gcc/d/dmd/nogc.d b/gcc/d/dmd/nogc.d index 2957b3a..8cf3585 100644 --- a/gcc/d/dmd/nogc.d +++ b/gcc/d/dmd/nogc.d @@ -84,6 +84,17 @@ public: } f.printGCUsage(e.loc, "setting `length` may cause a GC allocation"); } + else if (fd.ident == Id._d_arrayappendT || fd.ident == Id._d_arrayappendcTX) + { + if (f.setGC()) + { + e.error("cannot use operator `~=` in `@nogc` %s `%s`", + f.kind(), f.toPrettyChars()); + err = true; + return; + } + f.printGCUsage(e.loc, "operator `~=` may cause a GC allocation"); + } } override void visit(ArrayLiteralExp e) @@ -181,14 +192,15 @@ public: override void visit(CatAssignExp e) { + /* CatAssignExp will exist in `__traits(compiles, ...)` and in the `.e1` branch of a `__ctfe ? :` CondExp. + * The other branch will be `_d_arrayappendcTX(e1, 1), e1[$-1]=e2` which will generate the warning about + * GC usage. See visit(CallExp). + */ if (f.setGC()) { - e.error("cannot use operator `~=` in `@nogc` %s `%s`", - f.kind(), f.toPrettyChars()); err = true; return; } - f.printGCUsage(e.loc, "operator `~=` may cause a GC allocation"); } override void visit(CatExp e) diff --git a/gcc/d/dmd/objc.d b/gcc/d/dmd/objc.d index 9e92212..9afedc1 100644 --- a/gcc/d/dmd/objc.d +++ b/gcc/d/dmd/objc.d @@ -578,7 +578,7 @@ extern(C++) private final class Supported : Objc override void checkLinkage(FuncDeclaration fd) { - if (fd.linkage != LINK.objc && fd.objc.selector) + if (fd._linkage != LINK.objc && fd.objc.selector) fd.error("must have Objective-C linkage to attach a selector"); } @@ -640,11 +640,11 @@ extern(C++) private final class Supported : Objc if (!fd.objc.isOptional) return; - if (fd.linkage != LINK.objc) + if (fd._linkage != LINK.objc) { fd.error("only functions with Objective-C linkage can be declared as optional"); - const linkage = linkageToString(fd.linkage); + const linkage = linkageToString(fd._linkage); errorSupplemental(fd.loc, "function is declared with %.*s linkage", cast(uint) linkage.length, linkage.ptr); diff --git a/gcc/d/dmd/optimize.d b/gcc/d/dmd/optimize.d index 3cc36b4..2b7b9ac 100644 --- a/gcc/d/dmd/optimize.d +++ b/gcc/d/dmd/optimize.d @@ -558,6 +558,41 @@ Expression Expression_optimize(Expression e, int result, bool keepLvalue) } else if (auto ae = e.e1.isIndexExp()) { + if (ae.e2.isIntegerExp() && ae.e1.isIndexExp()) + { + /* Rewrite `(a[i])[index]` to `(&a[i]) + index*size` + */ + sinteger_t index = ae.e2.toInteger(); + auto ae1 = ae.e1.isIndexExp(); // ae1 is a[i] + if (auto ts = ae1.type.isTypeSArray()) + { + sinteger_t dim = ts.dim.toInteger(); + + if (index < 0 || index > dim) + { + e.error("array index %lld is out of bounds `[0..%lld]`", index, dim); + return error(); + } + + import core.checkedint : mulu; + bool overflow; + const offset = mulu(index, ts.nextOf().size(e.loc), overflow); // offset = index*size + if (overflow) + { + e.error("array offset overflow"); + return error(); + } + + Expression ex = new AddrExp(ae1.loc, ae1); // &a[i] + ex.type = ae1.type.pointerTo(); + + Expression add = new AddExp(ae.loc, ex, new IntegerExp(ae.loc, offset, e.type)); + add.type = e.type; + ret = Expression_optimize(add, result, keepLvalue); + return; + } + } + // Convert &array[n] to &array+n if (ae.e2.isIntegerExp() && ae.e1.isVarExp()) { diff --git a/gcc/d/dmd/parse.d b/gcc/d/dmd/parse.d index 4b9c0f2..15b7658 100644 --- a/gcc/d/dmd/parse.d +++ b/gcc/d/dmd/parse.d @@ -289,6 +289,15 @@ class Parser(AST, Lexer = dmd.lexer.Lexer) : Lexer return true; } + /************************************ + * Parse declarations and definitions + * Params: + * once = !=0 means parse exactly one decl or def + * pLastDecl = set to last decl or def parsed + * pAttrs = keep track of attributes + * Returns: + * array of declared symbols + */ AST.Dsymbols* parseDeclDefs(int once, AST.Dsymbol* pLastDecl = null, PrefixAttributes!AST* pAttrs = null) { AST.Dsymbol lastDecl = null; // used to link unittest to its previous declaration @@ -480,7 +489,7 @@ class Parser(AST, Lexer = dmd.lexer.Lexer) : Lexer * template instantiations in these unittests as candidates for * further codegen culling. */ - if (mod.isRoot() && (global.params.useUnitTests || global.params.doDocComments || global.params.doHdrGeneration)) + if (mod.isRoot() && (global.params.useUnitTests || global.params.ddoc.doOutput || global.params.dihdr.doOutput)) { s = parseUnitTest(pAttrs); if (*pLastDecl) @@ -713,7 +722,7 @@ class Parser(AST, Lexer = dmd.lexer.Lexer) : Lexer // The deprecation period is longer than usual as `body` // was quite widely used. if (tk.value == TOK.identifier && tk.ident == Id._body) - deprecation("Usage of the `body` keyword is deprecated. Use `do` instead."); + deprecation("usage of the `body` keyword is deprecated. Use `do` instead."); a = parseDeclarations(true, pAttrs, pAttrs.comment); if (a && a.dim) @@ -2649,7 +2658,7 @@ class Parser(AST, Lexer = dmd.lexer.Lexer) : Lexer /** Extract unittest body as a string. Must be done eagerly since memory will be released by the lexer before doc gen. */ char* docline = null; - if (global.params.doDocComments && endPtr > begPtr) + if (global.params.ddoc.doOutput && endPtr > begPtr) { /* Remove trailing whitespaces */ for (const(char)* p = endPtr - 1; begPtr <= p && (*p == ' ' || *p == '\r' || *p == '\n' || *p == '\t'); --p) @@ -4298,7 +4307,8 @@ class Parser(AST, Lexer = dmd.lexer.Lexer) : Lexer * These can be: * 1. declarations at global/class level * 2. declarations at statement level - * Return array of Declaration *'s. + * Returns: + * array of Declarations. */ private AST.Dsymbols* parseDeclarations(bool autodecl, PrefixAttributes!AST* pAttrs, const(char)* comment) { @@ -4422,7 +4432,7 @@ class Parser(AST, Lexer = dmd.lexer.Lexer) : Lexer // The deprecation period is longer than usual as `body` // was quite widely used. if (tk.value == TOK.identifier && tk.ident == Id._body) - deprecation("Usage of the `body` keyword is deprecated. Use `do` instead."); + deprecation("usage of the `body` keyword is deprecated. Use `do` instead."); ts = null; } @@ -4459,6 +4469,12 @@ class Parser(AST, Lexer = dmd.lexer.Lexer) : Lexer else if (t != tfirst) error("multiple declarations must have the same type, not `%s` and `%s`", tfirst.toChars(), t.toChars()); + if (token.value == TOK.colon && !ident && t.ty != Tfunction) + { + // Unnamed bit field + ident = Identifier.generateAnonymousId("BitField"); + } + bool isThis = (t.ty == Tident && (cast(AST.TypeIdentifier)t).ident == Id.This && token.value == TOK.assign); if (ident) checkCstyleTypeSyntax(loc, t, alt, ident); @@ -4591,6 +4607,13 @@ class Parser(AST, Lexer = dmd.lexer.Lexer) : Lexer } else if (ident) { + AST.Expression width; + if (token.value == TOK.colon) + { + nextToken(); + width = parseCondExp(); + } + AST.Initializer _init = null; if (token.value == TOK.assign) { @@ -4598,12 +4621,25 @@ class Parser(AST, Lexer = dmd.lexer.Lexer) : Lexer _init = parseInitializer(); } - auto v = new AST.VarDeclaration(loc, t, ident, _init); - v.storage_class = storage_class; - if (pAttrs) - pAttrs.storageClass = STC.undefined_; - - AST.Dsymbol s = v; + AST.Dsymbol s; + if (width) + { + if (!global.params.bitfields) + error("use -preview=bitfields for bitfield support"); + if (_init) + error("initializer not allowed for bit-field declaration"); + if (storage_class) + error("storage class not allowed for bit-field declaration"); + s = new AST.BitFieldDeclaration(width.loc, t, ident, width); + } + else + { + auto v = new AST.VarDeclaration(loc, t, ident, _init); + v.storage_class = storage_class; + if (pAttrs) + pAttrs.storageClass = STC.undefined_; + s = v; + } if (tpl && _init) { @@ -4616,7 +4652,7 @@ class Parser(AST, Lexer = dmd.lexer.Lexer) : Lexer { auto ax = new AST.Dsymbols(); ax.push(s); - s = new AST.AlignDeclaration(v.loc, ealign, ax); + s = new AST.AlignDeclaration(s.loc, ealign, ax); } if (link != linkage) { @@ -4646,12 +4682,12 @@ class Parser(AST, Lexer = dmd.lexer.Lexer) : Lexer default: if (loc.linnum != token.loc.linnum) { - error("semicolon needed to end declaration of `%s`, instead of `%s`", v.toChars(), token.toChars()); - errorSupplemental(loc, "`%s` declared here", v.toChars()); + error("semicolon needed to end declaration of `%s`, instead of `%s`", s.toChars(), token.toChars()); + errorSupplemental(loc, "`%s` declared here", s.toChars()); } else { - error("semicolon needed to end declaration of `%s` instead of `%s`", v.toChars(), token.toChars()); + error("semicolon needed to end declaration of `%s` instead of `%s`", s.toChars(), token.toChars()); } break; } @@ -4826,7 +4862,7 @@ class Parser(AST, Lexer = dmd.lexer.Lexer) : Lexer if (udas !is null) { if (storage_class != 0) - error("Cannot put a storage-class in an alias declaration."); + error("cannot put a storage-class in an alias declaration."); // parseAttributes shouldn't have set these variables assert(link == linkage && !setAlignment && ealign is null); auto tpl_ = cast(AST.TemplateDeclaration) s; @@ -5034,7 +5070,7 @@ class Parser(AST, Lexer = dmd.lexer.Lexer) : Lexer check(TOK.goesTo); if (token.value == TOK.leftCurly) { - deprecation("Using `(args) => { ... }` to create a delegate that returns a delegate is error-prone."); + deprecation("using `(args) => { ... }` to create a delegate that returns a delegate is error-prone."); deprecationSupplemental(token.loc, "Use `(args) { ... }` for a multi-statement function literal or use `(args) => () { }` if you intended for the lambda to return a delegate."); } const returnloc = token.loc; @@ -5100,7 +5136,7 @@ class Parser(AST, Lexer = dmd.lexer.Lexer) : Lexer // Deprecated in 2.097 - Can be removed from 2.117 // The deprecation period is longer than usual as `body` // was quite widely used. - deprecation("Usage of the `body` keyword is deprecated. Use `do` instead."); + deprecation("usage of the `body` keyword is deprecated. Use `do` instead."); goto case TOK.do_; } goto default; @@ -7426,7 +7462,7 @@ LagainStc: // Deprecated in 2.097 - Can be removed from 2.117 // The deprecation period is longer than usual as `body` // was quite widely used. - deprecation("Usage of the `body` keyword is deprecated. Use `do` instead."); + deprecation("usage of the `body` keyword is deprecated. Use `do` instead."); goto case TOK.do_; } goto default; @@ -8026,7 +8062,7 @@ LagainStc: postfix = token.postfix; } - error("Implicit string concatenation is error-prone and disallowed in D"); + error("implicit string concatenation is error-prone and disallowed in D"); errorSupplemental(token.loc, "Use the explicit syntax instead " ~ "(concatenating literals is `@nogc`): %s ~ %s", prev.toChars(), token.toChars()); @@ -9580,18 +9616,18 @@ private StorageClass getStorageClass(AST)(PrefixAttributes!(AST)* pAttrs) */ private bool writeMixin(const(char)[] s, ref Loc loc) { - if (!global.params.mixinOut) + if (!global.params.mixinOut.doOutput) return false; - OutBuffer* ob = global.params.mixinOut; + OutBuffer* ob = global.params.mixinOut.buffer; ob.writestring("// expansion at "); ob.writestring(loc.toChars()); ob.writenl(); - global.params.mixinLines++; + global.params.mixinOut.bufferLines++; - loc = Loc(global.params.mixinFile, global.params.mixinLines + 1, loc.charnum); + loc = Loc(global.params.mixinOut.name.ptr, global.params.mixinOut.bufferLines + 1, loc.charnum); // write by line to create consistent line endings size_t lastpos = 0; @@ -9603,7 +9639,7 @@ private bool writeMixin(const(char)[] s, ref Loc loc) { ob.writestring(s[lastpos .. i]); ob.writenl(); - global.params.mixinLines++; + global.params.mixinOut.bufferLines++; if (c == '\r') ++i; lastpos = i + 1; @@ -9616,10 +9652,10 @@ private bool writeMixin(const(char)[] s, ref Loc loc) if (s.length == 0 || s[$-1] != '\n') { ob.writenl(); // ensure empty line after expansion - global.params.mixinLines++; + global.params.mixinOut.bufferLines++; } ob.writenl(); - global.params.mixinLines++; + global.params.mixinOut.bufferLines++; return true; } diff --git a/gcc/d/dmd/safe.d b/gcc/d/dmd/safe.d index bad071e..1c5275b 100644 --- a/gcc/d/dmd/safe.d +++ b/gcc/d/dmd/safe.d @@ -53,7 +53,7 @@ bool checkUnsafeAccess(Scope* sc, Expression e, bool readonly, bool printmsg) { if (sc.intypeof || !sc.func || !sc.func.isSafeBypassingInference()) return false; - auto ad = v.toParent2().isAggregateDeclaration(); + auto ad = v.isMember2(); if (!ad) return false; @@ -64,23 +64,22 @@ bool checkUnsafeAccess(Scope* sc, Expression e, bool readonly, bool printmsg) const hasPointers = v.type.hasPointers(); if (hasPointers) { - if (v.overlapped && sc.func.setUnsafe()) + if (v.overlapped) { - if (printmsg) - e.error("field `%s.%s` cannot access pointers in `@safe` code that overlap other fields", - ad.toChars(), v.toChars()); - return true; + if (sc.func.setUnsafe(!printmsg, e.loc, + "field `%s.%s` cannot access pointers in `@safe` code that overlap other fields", ad, v)) + return true; } } if (v.type.hasInvariant()) { - if (v.overlapped && sc.func.setUnsafe()) + if (v.overlapped) { - if (printmsg) - e.error("field `%s.%s` cannot access structs with invariants in `@safe` code that overlap other fields", - ad.toChars(), v.toChars()); - return true; + if (sc.func.setUnsafe(!printmsg, e.loc, + "field `%s.%s` cannot access structs with invariants in `@safe` code that overlap other fields", + ad, v)) + return true; } } @@ -90,22 +89,22 @@ bool checkUnsafeAccess(Scope* sc, Expression e, bool readonly, bool printmsg) if (hasPointers && v.type.toBasetype().ty != Tstruct) { if ((!ad.type.alignment.isDefault() && ad.type.alignment.get() < target.ptrsize || - (v.offset & (target.ptrsize - 1))) && - sc.func.setUnsafe()) + (v.offset & (target.ptrsize - 1)))) { - if (printmsg) - e.error("field `%s.%s` cannot modify misaligned pointers in `@safe` code", - ad.toChars(), v.toChars()); - return true; + if (sc.func.setUnsafe(!printmsg, e.loc, + "field `%s.%s` cannot modify misaligned pointers in `@safe` code", ad, v)) + return true; } } - if (v.overlapUnsafe && sc.func.setUnsafe()) + if (v.overlapUnsafe) { - if (printmsg) - e.error("field `%s.%s` cannot modify fields in `@safe` code that overlap fields with other storage classes", - ad.toChars(), v.toChars()); - return true; + if (sc.func.setUnsafe(!printmsg, e.loc, + "field `%s.%s` cannot modify fields in `@safe` code that overlap fields with other storage classes", + ad, v)) + { + return true; + } } } return false; @@ -215,14 +214,12 @@ bool checkUnsafeDotExp(Scope* sc, Expression e, Identifier id, int flag) if (!(flag & DotExpFlag.noDeref) && // this use is attempting a dereference sc.func && // inside a function !sc.intypeof && // allow unsafe code in typeof expressions - !(sc.flags & SCOPE.debug_) && // allow unsafe code in debug statements - sc.func.setUnsafe()) // infer this function to be unsafe + !(sc.flags & SCOPE.debug_)) // allow unsafe code in debug statements { if (id == Id.ptr) - e.error("`%s.ptr` cannot be used in `@safe` code, use `&%s[0]` instead", e.toChars(), e.toChars()); + return sc.func.setUnsafe(false, e.loc, "`%s.ptr` cannot be used in `@safe` code, use `&%s[0]` instead", e, e); else - e.error("`%s.%s` cannot be used in `@safe` code", e.toChars(), id.toChars()); - return true; + return sc.func.setUnsafe(false, e.loc, "`%s.%s` cannot be used in `@safe` code", e, id); } return false; } diff --git a/gcc/d/dmd/semantic2.d b/gcc/d/dmd/semantic2.d index cd65920..73dcaa6 100644 --- a/gcc/d/dmd/semantic2.d +++ b/gcc/d/dmd/semantic2.d @@ -238,7 +238,7 @@ private extern(C++) final class Semantic2Visitor : Visitor return; } - UserAttributeDeclaration.checkGNUABITag(vd, vd.linkage); + UserAttributeDeclaration.checkGNUABITag(vd, vd._linkage); if (vd._init && !vd.toParent().isFuncDeclaration()) { @@ -379,6 +379,7 @@ private extern(C++) final class Semantic2Visitor : Visitor alias f1 = fd; auto tf1 = cast(TypeFunction) f1.type; auto parent1 = f1.toParent2(); + const linkage1 = f1.resolvedLinkage(); overloadApply(f1, (Dsymbol s) { @@ -391,7 +392,7 @@ private extern(C++) final class Semantic2Visitor : Visitor return 0; // Functions with different manglings can never conflict - if (f1.linkage != f2.linkage) + if (linkage1 != f2.resolvedLinkage()) return 0; // Functions with different names never conflict @@ -428,12 +429,12 @@ private extern(C++) final class Semantic2Visitor : Visitor // @@@DEPRECATED_2.104@@@ // Deprecated in 2020-08, make this an error in 2.104 if (parent1.isModule() && - f1.linkage != LINK.d && f1.linkage != LINK.cpp && + linkage1 != LINK.d && linkage1 != LINK.cpp && (!sameAttr || !sameParams) ) { f2.deprecation("cannot overload `extern(%s)` function at %s", - linkageToChars(f1.linkage), + linkageToChars(f1._linkage), f1.loc.toChars()); return 0; } @@ -443,7 +444,7 @@ private extern(C++) final class Semantic2Visitor : Visitor return 0; // Different attributes don't conflict in extern(D) - if (!sameAttr && f1.linkage == LINK.d) + if (!sameAttr && linkage1 == LINK.d) return 0; error(f2.loc, "%s `%s%s` conflicts with previous declaration at %s", @@ -460,7 +461,7 @@ private extern(C++) final class Semantic2Visitor : Visitor return; TypeFunction f = cast(TypeFunction) fd.type; - UserAttributeDeclaration.checkGNUABITag(fd, fd.linkage); + UserAttributeDeclaration.checkGNUABITag(fd, fd._linkage); //semantic for parameters' UDAs foreach (i, param; f.parameterList) { @@ -643,7 +644,7 @@ private extern(C++) final class Semantic2Visitor : Visitor { //printf(" found\n"); // Check that calling conventions match - if (fd.linkage != ifd.linkage) + if (fd._linkage != ifd._linkage) fd.error("linkage doesn't match interface function"); // Check that it is current diff --git a/gcc/d/dmd/semantic3.d b/gcc/d/dmd/semantic3.d index 5119576..a056c99 100644 --- a/gcc/d/dmd/semantic3.d +++ b/gcc/d/dmd/semantic3.d @@ -327,7 +327,7 @@ private extern(C++) final class Semantic3Visitor : Visitor sc2.scontinue = null; sc2.sw = null; sc2.fes = funcdecl.fes; - sc2.linkage = LINK.d; + sc2.linkage = funcdecl.isCsymbol() ? LINK.c : LINK.d; sc2.stc &= STC.flowThruFunction; sc2.visibility = Visibility(Visibility.Kind.public_); sc2.explicitVisibility = 0; @@ -1053,7 +1053,7 @@ private extern(C++) final class Semantic3Visitor : Visitor { if (!v._init) { - v.error("Zero-length `out` parameters are not allowed."); + v.error("zero-length `out` parameters are not allowed."); return; } ExpInitializer ie = v._init.isExpInitializer(); @@ -1277,70 +1277,7 @@ private extern(C++) final class Semantic3Visitor : Visitor f.isnogc = true; } - if (funcdecl.flags & FUNCFLAG.returnInprocess) - { - funcdecl.flags &= ~FUNCFLAG.returnInprocess; - if (funcdecl.storage_class & STC.return_) - { - if (funcdecl.type == f) - f = cast(TypeFunction)f.copy(); - f.isreturn = true; - f.isreturnscope = cast(bool) (funcdecl.storage_class & STC.returnScope); - if (funcdecl.storage_class & STC.returninferred) - f.isreturninferred = true; - } - } - - funcdecl.flags &= ~FUNCFLAG.inferScope; - - // Eliminate maybescope's - { - // Create and fill array[] with maybe candidates from the `this` and the parameters - VarDeclaration[10] tmp = void; - size_t dim = (funcdecl.vthis !is null) + (funcdecl.parameters ? funcdecl.parameters.dim : 0); - - import dmd.common.string : SmallBuffer; - auto sb = SmallBuffer!VarDeclaration(dim, tmp[]); - VarDeclaration[] array = sb[]; - - size_t n = 0; - if (funcdecl.vthis) - array[n++] = funcdecl.vthis; - if (funcdecl.parameters) - { - foreach (v; *funcdecl.parameters) - { - array[n++] = v; - } - } - eliminateMaybeScopes(array[0 .. n]); - } - - // Infer STC.scope_ - if (funcdecl.parameters && !funcdecl.errors) - { - assert(f.parameterList.length == funcdecl.parameters.dim); - foreach (u, p; f.parameterList) - { - auto v = (*funcdecl.parameters)[u]; - if (v.storage_class & STC.maybescope) - { - //printf("Inferring scope for %s\n", v.toChars()); - notMaybeScope(v); - v.storage_class |= STC.scope_ | STC.scopeinferred; - p.storageClass |= STC.scope_ | STC.scopeinferred; - assert(!(p.storageClass & STC.maybescope)); - } - } - } - - if (funcdecl.vthis && funcdecl.vthis.storage_class & STC.maybescope) - { - notMaybeScope(funcdecl.vthis); - funcdecl.vthis.storage_class |= STC.scope_ | STC.scopeinferred; - f.isScopeQual = true; - f.isscopeinferred = true; - } + finishScopeParamInference(funcdecl, f); // reset deco to apply inference result to mangled name if (f != funcdecl.type) @@ -1353,11 +1290,77 @@ private extern(C++) final class Semantic3Visitor : Visitor if (funcdecl.isCtorDeclaration()) // https://issues.dlang.org/show_bug.cgi?id=#15665 f.isctor = true; sc.stc = 0; - sc.linkage = funcdecl.linkage; // https://issues.dlang.org/show_bug.cgi?id=8496 + sc.linkage = funcdecl._linkage; // https://issues.dlang.org/show_bug.cgi?id=8496 funcdecl.type = f.typeSemantic(funcdecl.loc, sc); sc = sc.pop(); } + // Check `extern(C++)` functions for invalid the return/parameter types + if (funcdecl._linkage == LINK.cpp) + { + static bool isCppNonMappableType(Type type, Parameter param = null, Type origType = null) + { + // Don't allow D `immutable` and `shared` types to be interfaced with C++ + if (type.isImmutable() || type.isShared()) + return true; + else if (Type cpptype = target.cpp.parameterType(type)) + type = cpptype; + + if (origType is null) + origType = type; + + // Permit types that are handled by toCppMangle. This list should be kept in sync with + // each visit method in dmd.cppmangle and dmd.cppmanglewin. + switch (type.ty) + { + case Tnull: + case Tnoreturn: + case Tvector: + case Tpointer: + case Treference: + case Tfunction: + case Tstruct: + case Tenum: + case Tclass: + case Tident: + case Tinstance: + break; + + case Tsarray: + if (!origType.isTypePointer()) + return true; + break; + + default: + if (!type.isTypeBasic()) + return true; + break; + } + + // Descend to the enclosing type + if (auto tnext = type.nextOf()) + return isCppNonMappableType(tnext, param, origType); + + return false; + } + if (isCppNonMappableType(f.next.toBasetype())) + { + funcdecl.error("cannot return type `%s` because its linkage is `extern(C++)`", f.next.toChars()); + funcdecl.errors = true; + } + foreach (i, param; f.parameterList) + { + if (isCppNonMappableType(param.type.toBasetype(), param)) + { + funcdecl.error("cannot have parameter of type `%s` because its linkage is `extern(C++)`", param.type.toChars()); + if (param.type.toBasetype().isTypeSArray()) + errorSupplemental(funcdecl.loc, "perhaps use a `%s*` type instead", + param.type.nextOf().mutableOf().unSharedOf().toChars()); + funcdecl.errors = true; + } + } + } + // Do live analysis if (global.params.useDIP1021 && funcdecl.fbody && funcdecl.type.ty != Terror && funcdecl.type.isTypeFunction().islive) @@ -1535,9 +1538,11 @@ private extern(C++) final class Semantic3Visitor : Visitor sc2.pop(); - // don't do it for unused deprecated types - // or error ypes - if (!ad.getRTInfo && Type.rtinfo && (!ad.isDeprecated() || global.params.useDeprecated != DiagnosticReporting.error) && (ad.type && ad.type.ty != Terror)) + // Instantiate RTInfo!S to provide a pointer bitmap for the GC + // Don't do it in -betterC or on unused deprecated / error types + if (!ad.getRTInfo && global.params.useTypeInfo && Type.rtinfo && + (!ad.isDeprecated() || global.params.useDeprecated != DiagnosticReporting.error) && + (ad.type && ad.type.ty != Terror)) { // Evaluate: RTinfo!type auto tiargs = new Objects(); diff --git a/gcc/d/dmd/statementsem.d b/gcc/d/dmd/statementsem.d index 2916bbc..a7ad84f 100644 --- a/gcc/d/dmd/statementsem.d +++ b/gcc/d/dmd/statementsem.d @@ -3554,13 +3554,13 @@ package (dmd) extern (C++) final class StatementSemanticVisitor : Visitor if (!global.params.useExceptions) { - tcs.error("Cannot use try-catch statements with -betterC"); + tcs.error("cannot use try-catch statements with -betterC"); return setError(); } if (!ClassDeclaration.throwable) { - tcs.error("Cannot use try-catch statements because `object.Throwable` was not declared"); + tcs.error("cannot use try-catch statements because `object.Throwable` was not declared"); return setError(); } @@ -3762,13 +3762,13 @@ package (dmd) extern (C++) final class StatementSemanticVisitor : Visitor { if (!global.params.useExceptions) { - loc.error("Cannot use `throw` statements with -betterC"); + loc.error("cannot use `throw` statements with -betterC"); return false; } if (!ClassDeclaration.throwable) { - loc.error("Cannot use `throw` statements because `object.Throwable` was not declared"); + loc.error("cannot use `throw` statements because `object.Throwable` was not declared"); return false; } @@ -3927,8 +3927,10 @@ package (dmd) extern (C++) final class StatementSemanticVisitor : Visitor cas.error("`asm` statement is assumed to be impure - mark it with `pure` if it is not"); if (!(cas.stc & STC.nogc) && sc.func.setGC()) cas.error("`asm` statement is assumed to use the GC - mark it with `@nogc` if it does not"); - if (!(cas.stc & (STC.trusted | STC.safe)) && sc.func.setUnsafe()) - cas.error("`asm` statement is assumed to be `@system` - mark it with `@trusted` if it is not"); + if (!(cas.stc & (STC.trusted | STC.safe))) + { + sc.func.setUnsafe(false, cas.loc, "`asm` statement is assumed to be `@system` - mark it with `@trusted` if it is not"); + } sc.pop(); result = cas; @@ -4032,10 +4034,10 @@ void catchSemantic(Catch c, Scope* sc) error(c.loc, "catching C++ class objects not supported for this target"); c.errors = true; } - if (sc.func && !sc.intypeof && !c.internalCatch && sc.func.setUnsafe()) + if (sc.func && !sc.intypeof && !c.internalCatch) { - error(c.loc, "cannot catch C++ class objects in `@safe` code"); - c.errors = true; + if (sc.func.setUnsafe(false, c.loc, "cannot catch C++ class objects in `@safe` code")) + c.errors = true; } } else if (cd != ClassDeclaration.throwable && !ClassDeclaration.throwable.isBaseOf(cd, null)) @@ -4044,10 +4046,10 @@ void catchSemantic(Catch c, Scope* sc) c.errors = true; } else if (sc.func && !sc.intypeof && !c.internalCatch && ClassDeclaration.exception && - cd != ClassDeclaration.exception && !ClassDeclaration.exception.isBaseOf(cd, null) && - sc.func.setUnsafe()) + cd != ClassDeclaration.exception && !ClassDeclaration.exception.isBaseOf(cd, null) && + sc.func.setUnsafe(false, c.loc, + "can only catch class objects derived from `Exception` in `@safe` code, not `%s`", c.type)) { - error(c.loc, "can only catch class objects derived from `Exception` in `@safe` code, not `%s`", c.type.toChars()); c.errors = true; } else if (global.params.ehnogc) @@ -4829,7 +4831,7 @@ private Statement toStatement(Dsymbol s) } else { - .error(Loc.initial, "Internal Compiler Error: cannot mixin %s `%s`\n", s.kind(), s.toChars()); + .error(Loc.initial, "internal compiler error: cannot mixin %s `%s`\n", s.kind(), s.toChars()); result = new ErrorStatement(); } diff --git a/gcc/d/dmd/tokens.d b/gcc/d/dmd/tokens.d index 03e8024..170a534 100644 --- a/gcc/d/dmd/tokens.d +++ b/gcc/d/dmd/tokens.d @@ -608,7 +608,7 @@ static immutable TOK[TOK.max + 1] Ckeywords = enum Ckwds = [ auto_, break_, case_, char_, const_, continue_, default_, do_, float64, else_, enum_, extern_, float32, for_, goto_, if_, inline, int32, int64, register, restrict, return_, int16, signed, sizeof_, static_, struct_, switch_, typedef_, - union_, unsigned, void_, volatile, while_, asm_, + union_, unsigned, void_, volatile, while_, asm_, typeof_, _Alignas, _Alignof, _Atomic, _Bool, _Complex, _Generic, _Imaginary, _Noreturn, _Static_assert, _Thread_local, _import, __cdecl, __declspec, __stdcall, __attribute__ ]; diff --git a/gcc/d/dmd/traits.d b/gcc/d/dmd/traits.d index 04e1c47..be95432 100644 --- a/gcc/d/dmd/traits.d +++ b/gcc/d/dmd/traits.d @@ -132,6 +132,7 @@ shared static this() "getVirtualFunctions", "getVirtualMethods", "classInstanceSize", + "classInstanceAlignment", "allMembers", "derivedMembers", "isSame", @@ -1211,7 +1212,7 @@ Expression semanticTraits(TraitsExp e, Scope* sc) else assert(0); } - if (e.ident == Id.classInstanceSize) + if (e.ident == Id.classInstanceSize || e.ident == Id.classInstanceAlignment) { if (dim != 1) return dimError(1); @@ -1234,7 +1235,7 @@ Expression semanticTraits(TraitsExp e, Scope* sc) return ErrorExp.get(); } - return new IntegerExp(e.loc, cd.structsize, Type.tsize_t); + return new IntegerExp(e.loc, e.ident == Id.classInstanceSize ? cd.structsize : cd.alignsize, Type.tsize_t); } if (e.ident == Id.getAliasThis) { @@ -1381,7 +1382,7 @@ Expression semanticTraits(TraitsExp e, Scope* sc) e.error("argument to `__traits(getFunctionVariadicStyle, %s)` is not a function", o.toChars()); return ErrorExp.get(); } - link = fd.linkage; + link = fd._linkage; varargs = fd.getParameterList().varargs; } string style; @@ -1515,7 +1516,7 @@ Expression semanticTraits(TraitsExp e, Scope* sc) if (tf) { - link = fd ? fd.linkage : tf.linkage; + link = fd ? fd.toAliasFunc()._linkage : tf.linkage; } else { @@ -1529,7 +1530,7 @@ Expression semanticTraits(TraitsExp e, Scope* sc) } if (d !is null) - link = d.linkage; + link = d._linkage; else { // Resolves forward references @@ -1574,7 +1575,7 @@ Expression semanticTraits(TraitsExp e, Scope* sc) auto s = getDsymbol(o); if (!s) { - e.error("In expression `%s` `%s` can't have members", e.toChars(), o.toChars()); + e.error("in expression `%s` `%s` can't have members", e.toChars(), o.toChars()); e.errorSupplemental("`%s` must evaluate to either a module, a struct, an union, a class, an interface or a template instantiation", o.toChars()); return ErrorExp.get(); @@ -1595,7 +1596,7 @@ Expression semanticTraits(TraitsExp e, Scope* sc) auto sds = s.isScopeDsymbol(); if (!sds || sds.isTemplateDeclaration()) { - e.error("In expression `%s` %s `%s` has no members", e.toChars(), s.kind(), s.toChars()); + e.error("in expression `%s` %s `%s` has no members", e.toChars(), s.kind(), s.toChars()); e.errorSupplemental("`%s` must evaluate to either a module, a struct, an union, a class, an interface or a template instantiation", s.toChars()); return ErrorExp.get(); } diff --git a/gcc/d/dmd/typesem.d b/gcc/d/dmd/typesem.d index f63b177..ac4c23b 100644 --- a/gcc/d/dmd/typesem.d +++ b/gcc/d/dmd/typesem.d @@ -1154,7 +1154,7 @@ extern(C++) Type typeSemantic(Type type, const ref Loc loc, Scope* sc) //printf("already done\n"); return mtype; } - //printf("TypeFunction::semantic() this = %p\n", this); + //printf("TypeFunction::semantic() this = %p\n", mtype); //printf("TypeFunction::semantic() %s, sc.stc = %llx\n", mtype.toChars(), sc.stc); bool errors = false; @@ -1788,111 +1788,18 @@ extern(C++) Type typeSemantic(Type type, const ref Loc loc, Scope* sc) Type visitTraits(TypeTraits mtype) { - if (mtype.ty == Terror) - return mtype; - - const inAlias = (sc.flags & SCOPE.alias_) != 0; - if (mtype.exp.ident != Id.allMembers && - mtype.exp.ident != Id.derivedMembers && - mtype.exp.ident != Id.getMember && - mtype.exp.ident != Id.parent && - mtype.exp.ident != Id.parameters && - mtype.exp.ident != Id.child && - mtype.exp.ident != Id.toType && - mtype.exp.ident != Id.getOverloads && - mtype.exp.ident != Id.getVirtualFunctions && - mtype.exp.ident != Id.getVirtualMethods && - mtype.exp.ident != Id.getAttributes && - mtype.exp.ident != Id.getUnitTests && - mtype.exp.ident != Id.getAliasThis) - { - static immutable (const(char)*)[2] ctxt = ["as type", "in alias"]; - .error(mtype.loc, "trait `%s` is either invalid or not supported %s", - mtype.exp.ident.toChars, ctxt[inAlias]); - mtype.ty = Terror; - return mtype; - } - - import dmd.traits : semanticTraits; - Type result; - - if (Expression e = semanticTraits(mtype.exp, sc)) - { - switch (e.op) - { - case EXP.dotVariable: - mtype.sym = e.isDotVarExp().var; - break; - case EXP.variable: - mtype.sym = e.isVarExp().var; - break; - case EXP.function_: - auto fe = e.isFuncExp(); - mtype.sym = fe.td ? fe.td : fe.fd; - break; - case EXP.dotTemplateDeclaration: - mtype.sym = e.isDotTemplateExp().td; - break; - case EXP.dSymbol: - mtype.sym = e.isDsymbolExp().s; - break; - case EXP.template_: - mtype.sym = e.isTemplateExp().td; - break; - case EXP.scope_: - mtype.sym = e.isScopeExp().sds; - break; - case EXP.tuple: - TupleExp te = e.isTupleExp(); - Objects* elems = new Objects(te.exps.dim); - foreach (i; 0 .. elems.dim) - { - auto src = (*te.exps)[i]; - switch (src.op) - { - case EXP.type: - (*elems)[i] = src.isTypeExp().type; - break; - case EXP.dotType: - (*elems)[i] = src.isDotTypeExp().sym.isType(); - break; - case EXP.overloadSet: - (*elems)[i] = src.isOverExp().type; - break; - default: - if (auto sym = isDsymbol(src)) - (*elems)[i] = sym; - else - (*elems)[i] = src; - } - } - TupleDeclaration td = new TupleDeclaration(e.loc, Identifier.generateId("__aliastup"), elems); - mtype.sym = td; - break; - case EXP.dotType: - result = e.isDotTypeExp().sym.isType(); - break; - case EXP.type: - result = e.isTypeExp().type; - break; - case EXP.overloadSet: - result = e.isOverExp().type; - break; - default: - break; - } - } + Expression e; + Type t; + Dsymbol s; + mtype.resolve(loc, sc, e, t, s); - if (result) - result = result.addMod(mtype.mod); - if (!inAlias && !result) + if (!t) { if (!global.errors) .error(mtype.loc, "`%s` does not give a valid type", mtype.toChars); return error(); } - - return result; + return t; } Type visitReturn(TypeReturn mtype) @@ -3132,7 +3039,8 @@ void resolve(Type mt, const ref Loc loc, Scope* sc, out Expression pe, out Type if (mt.exp.op == EXP.type || mt.exp.op == EXP.scope_) { - if (mt.exp.checkType()) + if (!(sc.flags & SCOPE.Cfile) && // in (extended) C typeof may be used on types as with sizeof + mt.exp.checkType()) goto Lerr; /* Today, 'typeof(func)' returns void if func is a @@ -3326,14 +3234,99 @@ void resolve(Type mt, const ref Loc loc, Scope* sc, out Expression pe, out Type mt.obj = pe ? pe : (pt ? pt : ps); } - void visitTraits(TypeTraits tt) + void visitTraits(TypeTraits mt) { - if (Type t = typeSemantic(tt, loc, sc)) - returnType(t); - else if (tt.sym) - returnSymbol(tt.sym); + // if already resolved just return the cached object. + if (mt.obj) + { + pt = mt.obj.isType(); + ps = mt.obj.isDsymbol(); + return; + } + + import dmd.traits : semanticTraits; + + if (Expression e = semanticTraits(mt.exp, sc)) + { + switch (e.op) + { + case EXP.dotVariable: + mt.obj = e.isDotVarExp().var; + break; + case EXP.variable: + mt.obj = e.isVarExp().var; + break; + case EXP.function_: + auto fe = e.isFuncExp(); + mt.obj = fe.td ? fe.td : fe.fd; + break; + case EXP.dotTemplateDeclaration: + mt.obj = e.isDotTemplateExp().td; + break; + case EXP.dSymbol: + mt.obj = e.isDsymbolExp().s; + break; + case EXP.template_: + mt.obj = e.isTemplateExp().td; + break; + case EXP.scope_: + mt.obj = e.isScopeExp().sds; + break; + case EXP.tuple: + TupleExp te = e.isTupleExp(); + Objects* elems = new Objects(te.exps.dim); + foreach (i; 0 .. elems.dim) + { + auto src = (*te.exps)[i]; + switch (src.op) + { + case EXP.type: + (*elems)[i] = src.isTypeExp().type; + break; + case EXP.dotType: + (*elems)[i] = src.isDotTypeExp().sym.isType(); + break; + case EXP.overloadSet: + (*elems)[i] = src.isOverExp().type; + break; + default: + if (auto sym = isDsymbol(src)) + (*elems)[i] = sym; + else + (*elems)[i] = src; + } + } + TupleDeclaration td = new TupleDeclaration(e.loc, Identifier.generateId("__aliastup"), elems); + mt.obj = td; + break; + case EXP.dotType: + mt.obj = e.isDotTypeExp().sym.isType(); + break; + case EXP.type: + mt.obj = e.isTypeExp().type; + break; + case EXP.overloadSet: + mt.obj = e.isOverExp().type; + break; + default: + break; + } + } + + if (mt.obj) + { + if (auto t = mt.obj.isType()) + returnType(t.addMod(mt.mod)); + else if (auto s = mt.obj.isDsymbol()) + returnSymbol(s); + else + assert(0); + } else + { + mt.obj = Type.terror; return returnError(); + } } switch (mt.ty) @@ -3391,7 +3384,7 @@ Expression dotExp(Type mt, Scope* sc, Expression e, Identifier ident, int flag) v.dsymbolSemantic(null); if (v.isField()) { - auto ad = v.toParent().isAggregateDeclaration(); + auto ad = v.isMember(); objc.checkOffsetof(e, ad); ad.size(e.loc); if (ad.sizeok != Sizeok.done) @@ -3637,12 +3630,16 @@ Expression dotExp(Type mt, Scope* sc, Expression e, Identifier ident, int flag) } else { + Expression e0; + Expression ev = e; + ev = extractSideEffect(sc, "__tup", e0, ev); + const length = cast(size_t)mt.dim.toUInteger(); auto exps = new Expressions(); exps.reserve(length); foreach (i; 0 .. length) - exps.push(new IndexExp(e.loc, e, new IntegerExp(e.loc, i, Type.tsize_t))); - e = new TupleExp(e.loc, exps); + exps.push(new IndexExp(e.loc, ev, new IntegerExp(e.loc, i, Type.tsize_t))); + e = new TupleExp(e.loc, e0, exps); } } else diff --git a/gcc/d/dmd/utils.d b/gcc/d/dmd/utils.d index 7f3fb64..5be4a19 100644 --- a/gcc/d/dmd/utils.d +++ b/gcc/d/dmd/utils.d @@ -84,7 +84,7 @@ extern (D) void writeFile(Loc loc, const(char)[] filename, const void[] data) ensurePathToNameExists(Loc.initial, filename); if (!File.update(filename, data)) { - error(loc, "Error writing file '%.*s'", cast(int) filename.length, filename.ptr); + error(loc, "error writing file '%.*s'", cast(int) filename.length, filename.ptr); fatal(); } } diff --git a/gcc/d/expr.cc b/gcc/d/expr.cc index c683d9d..7f5e683 100644 --- a/gcc/d/expr.cc +++ b/gcc/d/expr.cc @@ -847,53 +847,10 @@ public: } else { + /* Appending an element or array to another array has already been + handled by the front-end. */ gcc_assert (tb1->ty == TY::Tarray || tb2->ty == TY::Tsarray); - - if ((tb2->ty == TY::Tarray || tb2->ty == TY::Tsarray) - && same_type_p (etype, tb2->nextOf ()->toBasetype ())) - { - /* Append an array to another array: - The assignment is handled by the D run-time library, so only - need to call `_d_arrayappendT(ti, &e1, e2)' */ - result = build_libcall (LIBCALL_ARRAYAPPENDT, e->type, 3, - build_typeinfo (e->loc, e->type), - ptr, d_array_convert (e->e2)); - } - else if (same_type_p (etype, tb2)) - { - /* Append an element to an array: - The assignment is generated inline, so need to handle temporaries - here, and ensure that they are evaluated in the correct order. - - The generated code should end up being equivalent to: - _d_arrayappendcTX(ti, &e1, 1)[e1.length - 1] = e2 - */ - tree callexp = build_libcall (LIBCALL_ARRAYAPPENDCTX, e->type, 3, - build_typeinfo (e->loc, e->type), - ptr, size_one_node); - callexp = d_save_expr (callexp); - - /* Assign e2 to last element. */ - tree offexp = d_array_length (callexp); - offexp = build2 (MINUS_EXPR, TREE_TYPE (offexp), - offexp, size_one_node); - - tree ptrexp = d_array_ptr (callexp); - ptrexp = void_okay_p (ptrexp); - ptrexp = build_array_index (ptrexp, offexp); - - /* Evaluate expression before appending. */ - tree rhs = build_expr (e->e2); - tree rexpr = stabilize_expr (&rhs); - - if (TREE_CODE (rhs) == CALL_EXPR) - rhs = force_target_expr (rhs); - - result = modify_expr (build_deref (ptrexp), rhs); - result = compound_expr (rexpr, result); - } - else - gcc_unreachable (); + gcc_unreachable (); } /* Construct in order: ptr = &e1, _d_arrayappend(ptr, e2), *ptr; */ diff --git a/gcc/d/lang.opt b/gcc/d/lang.opt index b4b8152..c263582 100644 --- a/gcc/d/lang.opt +++ b/gcc/d/lang.opt @@ -340,6 +340,10 @@ fpreview=all D RejectNegative Turn on all upcoming D language features. +fpreview=bitfields +D RejectNegative +Implement D bit-fields. + fpreview=dip1000 D RejectNegative Implement DIP1000: Scoped pointers. @@ -412,10 +416,6 @@ frevert=intpromote D RejectNegative Use C-style integral promotion for unary '+', '-' and '~'. -frevert=markdown -D RejectNegative -Disable Markdown replacements in Ddoc. - frtti D ; Documented in C @@ -452,10 +452,6 @@ ftransition=tls D RejectNegative List all variables going into thread local storage. -ftransition=vmarkdown -D RejectNegative -List instances of Markdown replacements in Ddoc. - funittest D Compile in unittest code. diff --git a/gcc/d/types.cc b/gcc/d/types.cc index d897ec4..c54049d 100644 --- a/gcc/d/types.cc +++ b/gcc/d/types.cc @@ -375,7 +375,7 @@ fixup_anonymous_offset (tree fields, tree offset) /* Iterate over all MEMBERS of an aggregate, and add them as fields to CONTEXT. If INHERITED_P is true, then the members derive from a base class. - Returns the number of fields found. */ + Returns the number of named fields found. */ static size_t layout_aggregate_members (Dsymbols *members, tree context, bool inherited_p) @@ -418,7 +418,8 @@ layout_aggregate_members (Dsymbols *members, tree context, bool inherited_p) /* Insert the field declaration at its given offset. */ if (var->isField ()) { - const char *ident = var->ident ? var->ident->toChars () : NULL; + const char *ident = (var->ident && !var->ident->isAnonymous ()) + ? var->ident->toChars () : NULL; tree field = create_field_decl (declaration_type (var), ident, inherited_p, inherited_p); apply_user_attributes (var, field); @@ -442,7 +443,10 @@ layout_aggregate_members (Dsymbols *members, tree context, bool inherited_p) var->csym = field; } - fields += 1; + /* Only count the named fields in an aggregate. */ + if (ident != NULL) + fields += 1; + continue; } } diff --git a/gcc/diagnostic-format-json.cc b/gcc/diagnostic-format-json.cc index def3718..62594eb 100644 --- a/gcc/diagnostic-format-json.cc +++ b/gcc/diagnostic-format-json.cc @@ -62,7 +62,7 @@ json_from_expanded_location (diagnostic_context *context, location_t loc) {"byte-column", DIAGNOSTICS_COLUMN_UNIT_BYTE} }; int the_column = INT_MIN; - for (int i = 0; i != sizeof column_fields / sizeof (*column_fields); ++i) + for (int i = 0; i != ARRAY_SIZE (column_fields); ++i) { context->column_unit = column_fields[i].unit; const int col = diagnostic_converted_column (context, exploc); diff --git a/gcc/diagnostic.cc b/gcc/diagnostic.cc index 73324a7..fef1146 100644 --- a/gcc/diagnostic.cc +++ b/gcc/diagnostic.cc @@ -1935,9 +1935,7 @@ fatal_error (location_t loc, const char *gmsgid, ...) } /* An internal consistency check has failed. We make no attempt to - continue. Note that unless there is debugging value to be had from - a more specific message, or some other good reason, you should use - abort () instead of calling this function directly. */ + continue. */ void internal_error (const char *gmsgid, ...) { diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index 7a35d96..d8095e3 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -349,6 +349,7 @@ Objective-C and Objective-C++ Dialects}. -Wno-div-by-zero -Wdouble-promotion @gol -Wduplicated-branches -Wduplicated-cond @gol -Wempty-body -Wno-endif-labels -Wenum-compare -Wenum-conversion @gol +-Wenum-int-mismatch @gol -Werror -Werror=* -Wexpansion-to-defined -Wfatal-errors @gol -Wfloat-conversion -Wfloat-equal -Wformat -Wformat=2 @gol -Wno-format-contains-nul -Wno-format-extra-args @gol @@ -464,6 +465,10 @@ Objective-C and Objective-C++ Dialects}. -Wno-analyzer-use-after-free @gol -Wno-analyzer-use-of-pointer-in-stale-stack-frame @gol -Wno-analyzer-use-of-uninitialized-value @gol +-Wno-analyzer-va-arg-type-mismatch @gol +-Wno-analyzer-va-list-exhausted @gol +-Wno-analyzer-va-list-leak @gol +-Wno-analyzer-va-list-use-after-va-end @gol -Wno-analyzer-write-to-const @gol -Wno-analyzer-write-to-string-literal @gol } @@ -5755,6 +5760,7 @@ Options} and @ref{Objective-C and Objective-C++ Dialect Options}. -Wdangling-pointer=2 @gol -Wduplicate-decl-specifier @r{(C and Objective-C only)} @gol -Wenum-compare @r{(in C/ObjC; this is on by default in C++)} @gol +-Wenum-int-mismatch @r{(C and Objective-C only)} @gol -Wformat @gol -Wformat-overflow @gol -Wformat-truncation @gol @@ -8731,6 +8737,25 @@ Warn when a value of enumerated type is implicitly converted to a different enumerated type. This warning is enabled by @option{-Wextra} in C@. +@item -Wenum-int-mismatch @r{(C and Objective-C only)} +@opindex Wenum-int-mismatch +@opindex Wno-enum-int-mismatch +Warn about mismatches between an enumerated type and an integer type in +declarations. For example: + +@smallexample +enum E @{ l = -1, z = 0, g = 1 @}; +int foo(void); +enum E foo(void); +@end smallexample + +In C, an enumerated type is compatible with @code{char}, a signed +integer type, or an unsigned integer type. However, since the choice +of the underlying type of an enumerated type is implementation-defined, +such mismatches may cause portability issues. In C++, such mismatches +are an error. In C, this warning is enabled by @option{-Wall} and +@option{-Wc++-compat}. + @item -Wjump-misses-init @r{(C, Objective-C only)} @opindex Wjump-misses-init @opindex Wno-jump-misses-init @@ -9689,6 +9714,10 @@ Enabling this option effectively enables the following warnings: -Wanalyzer-use-after-free @gol -Wanalyzer-use-of-pointer-in-stale-stack-frame @gol -Wanalyzer-use-of-uninitialized-value @gol +-Wanalyzer-va-arg-type-mismatch @gol +-Wanalyzer-va-list-exhausted @gol +-Wanalyzer-va-list-leak @gol +-Wanalyzer-va-list-use-after-va-end @gol -Wanalyzer-write-to-const @gol -Wanalyzer-write-to-string-literal @gol } @@ -9971,6 +10000,53 @@ to disable it. This diagnostic warns for paths through the code in which a pointer is dereferenced that points to a variable in a stale stack frame. +@item -Wno-analyzer-va-arg-type-mismatch +@opindex Wanalyzer-va-arg-type-mismatch +@opindex Wno-analyzer-va-arg-type-mismatch +This warning requires @option{-fanalyzer}, which enables it; use +@option{-Wno-analyzer-va-arg-type-mismatch} +to disable it. + +This diagnostic warns for interprocedural paths through the code for which +the analyzer detects an attempt to use @code{va_arg} to extract a value +passed to a variadic call, but uses a type that does not match that of +the expression passed to the call. + +@item -Wno-analyzer-va-list-exhausted +@opindex Wanalyzer-va-list-exhausted +@opindex Wno-analyzer-va-list-exhausted +This warning requires @option{-fanalyzer}, which enables it; use +@option{-Wno-analyzer-va-list-exhausted} +to disable it. + +This diagnostic warns for interprocedural paths through the code for which +the analyzer detects an attempt to use @code{va_arg} to access the next +value passed to a variadic call, but all of the values in the +@code{va_list} have already been consumed. + +@item -Wno-analyzer-va-list-leak +@opindex Wanalyzer-va-list-leak +@opindex Wno-analyzer-va-list-leak +This warning requires @option{-fanalyzer}, which enables it; use +@option{-Wno-analyzer-va-list-leak} +to disable it. + +This diagnostic warns for interprocedural paths through the code for which +the analyzer detects that @code{va_start} or @code{va_copy} has been called +on a @code{va_list} without a corresponding call to @code{va_end}. + +@item -Wno-analyzer-va-list-use-after-va-end +@opindex Wanalyzer-va-list-use-after-va-end +@opindex Wno-analyzer-va-list-use-after-va-end +This warning requires @option{-fanalyzer}, which enables it; use +@option{-Wno-analyzer-va-list-use-after-va-end} +to disable it. + +This diagnostic warns for interprocedural paths through the code for which +the analyzer detects an attempt to use a @code{va_list} after +@code{va_end} has been called on it. +@code{va_list}. + @item -Wno-analyzer-write-to-const @opindex Wanalyzer-write-to-const @opindex Wno-analyzer-write-to-const @@ -10053,6 +10129,8 @@ following warnings from @option{-fanalyzer}: -Wanalyzer-possible-null-dereference @gol -Wanalyzer-unsafe-call-within-signal-handler @gol -Wanalyzer-use-after-free @gol +-Wanalyzer-va-list-leak @gol +-Wanalyzer-va-list-use-after-va-end @gol } @item -fno-analyzer-feasibility diff --git a/gcc/dwarf2out.cc b/gcc/dwarf2out.cc index 5681b01..fccf59e 100644 --- a/gcc/dwarf2out.cc +++ b/gcc/dwarf2out.cc @@ -13532,8 +13532,7 @@ static const dwarf_qual_info_t dwarf_qual_info[] = { TYPE_QUAL_RESTRICT, DW_TAG_restrict_type }, { TYPE_QUAL_ATOMIC, DW_TAG_atomic_type } }; -static const unsigned int dwarf_qual_info_size - = sizeof (dwarf_qual_info) / sizeof (dwarf_qual_info[0]); +static const unsigned int dwarf_qual_info_size = ARRAY_SIZE (dwarf_qual_info); /* If DIE is a qualified DIE of some base DIE with the same parent, return the base DIE, otherwise return NULL. Set MASK to the @@ -19449,6 +19448,14 @@ loc_list_from_tree_1 (tree loc, int want_address, break; case TRUTH_NOT_EXPR: + list_ret = loc_list_from_tree_1 (TREE_OPERAND (loc, 0), 0, context); + if (list_ret == 0) + return 0; + + add_loc_descr_to_each (list_ret, new_loc_descr (DW_OP_lit0, 0, 0)); + add_loc_descr_to_each (list_ret, new_loc_descr (DW_OP_eq, 0, 0)); + break; + case BIT_NOT_EXPR: op = DW_OP_not; goto do_unop; @@ -19497,6 +19504,15 @@ loc_list_from_tree_1 (tree loc, int want_address, list_ret = loc_list_from_tree_1 (TREE_OPERAND (TREE_OPERAND (loc, 0), 0), 0, context); + /* Likewise, swap the operands for a logically negated condition. */ + else if (TREE_CODE (TREE_OPERAND (loc, 0)) == TRUTH_NOT_EXPR) + { + lhs = loc_descriptor_from_tree (TREE_OPERAND (loc, 2), 0, context); + rhs = loc_list_from_tree_1 (TREE_OPERAND (loc, 1), 0, context); + list_ret + = loc_list_from_tree_1 (TREE_OPERAND (TREE_OPERAND (loc, 0), 0), + 0, context); + } else list_ret = loc_list_from_tree_1 (TREE_OPERAND (loc, 0), 0, context); if (list_ret == 0 || lhs == 0 || rhs == 0) diff --git a/gcc/expr.cc b/gcc/expr.cc index 1806091..7197996 100644 --- a/gcc/expr.cc +++ b/gcc/expr.cc @@ -9541,6 +9541,38 @@ expand_expr_real_2 (sepops ops, rtx target, machine_mode tmode, } expand_operands (treeop0, treeop1, subtarget, &op0, &op1, EXPAND_NORMAL); + + /* Expand X*Y as X&-Y when Y must be zero or one. */ + if (SCALAR_INT_MODE_P (mode)) + { + bool bit0_p = tree_nonzero_bits (treeop0) == 1; + bool bit1_p = tree_nonzero_bits (treeop1) == 1; + + /* Expand X*Y as X&Y when both X and Y must be zero or one. */ + if (bit0_p && bit1_p) + return REDUCE_BIT_FIELD (expand_and (mode, op0, op1, target)); + + if (bit0_p || bit1_p) + { + bool speed = optimize_insn_for_speed_p (); + int cost = add_cost (speed, mode) + neg_cost (speed, mode); + struct algorithm algorithm; + enum mult_variant variant; + if (CONST_INT_P (op1) + ? !choose_mult_variant (mode, INTVAL (op1), + &algorithm, &variant, cost) + : cost < mul_cost (speed, mode)) + { + target = bit0_p ? expand_and (mode, negate_rtx (mode, op0), + op1, target) + : expand_and (mode, op0, + negate_rtx (mode, op1), + target); + return REDUCE_BIT_FIELD (target); + } + } + } + return REDUCE_BIT_FIELD (expand_mult (mode, op0, op1, target, unsignedp)); case TRUNC_MOD_EXPR: diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b4f2ff8..1b9cb91 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,29 @@ +2022-05-18 Tobias Burnus <tobias@codesourcery.com> + + * gfortran.h (enum gfc_omp_depend_op): Add OMP_DEPEND_INOUTSET. + (gfc_omp_clauses): Enlarge ENUM_BITFIELD. + * dump-parse-tree.cc (show_omp_namelist, show_omp_clauses): Handle + 'inoutset' depend modifier. + * openmp.cc (gfc_match_omp_clauses, gfc_match_omp_depobj): Likewise. + * trans-openmp.cc (gfc_trans_omp_clauses, gfc_trans_omp_depobj): + Likewise. + +2022-05-17 Tobias Burnus <tobias@codesourcery.com> + + * dump-parse-tree.cc (show_omp_namelist): Handle omp_all_memory. + * openmp.cc (gfc_match_omp_variable_list, gfc_match_omp_depend_sink, + gfc_match_omp_clauses, resolve_omp_clauses): Likewise. + * trans-openmp.cc (gfc_trans_omp_clauses, gfc_trans_omp_depobj): + Likewise. + * resolve.cc (resolve_symbol): Reject it as symbol. + +2022-05-16 Martin Liska <mliska@suse.cz> + + * frontend-passes.cc (gfc_code_walker): Use ARRAY_SIZE. + * openmp.cc (gfc_match_omp_context_selector_specification): Likewise. + * trans-intrinsic.cc (conv_intrinsic_ieee_builtin): Likewise. + * trans-types.cc (gfc_get_array_descr_info): Likewise. + 2022-05-13 Tobias Burnus <tobias@codesourcery.com> * trans-openmp.cc (gfc_trans_omp_clauses): When mapping nondescriptor diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc index 3635460..4e8986b 100644 --- a/gcc/fortran/dump-parse-tree.cc +++ b/gcc/fortran/dump-parse-tree.cc @@ -1379,6 +1379,7 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n) case OMP_DEPEND_IN: fputs ("in:", dumpfile); break; case OMP_DEPEND_OUT: fputs ("out:", dumpfile); break; case OMP_DEPEND_INOUT: fputs ("inout:", dumpfile); break; + case OMP_DEPEND_INOUTSET: fputs ("inoutset:", dumpfile); break; case OMP_DEPEND_DEPOBJ: fputs ("depobj:", dumpfile); break; case OMP_DEPEND_MUTEXINOUTSET: fputs ("mutexinoutset:", dumpfile); @@ -1423,7 +1424,7 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n) case OMP_LINEAR_UVAL: fputs ("uval(", dumpfile); break; default: break; } - fprintf (dumpfile, "%s", n->sym->name); + fprintf (dumpfile, "%s", n->sym ? n->sym->name : "omp_all_memory"); if (list_type == OMP_LIST_LINEAR && n->u.linear_op != OMP_LINEAR_DEFAULT) fputc (')', dumpfile); if (n->expr) @@ -1898,6 +1899,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) case OMP_DEPEND_IN: deptype = "IN"; break; case OMP_DEPEND_OUT: deptype = "OUT"; break; case OMP_DEPEND_INOUT: deptype = "INOUT"; break; + case OMP_DEPEND_INOUTSET: deptype = "INOUTSET"; break; case OMP_DEPEND_MUTEXINOUTSET: deptype = "MUTEXINOUTSET"; break; default: gcc_unreachable (); } diff --git a/gcc/fortran/frontend-passes.cc b/gcc/fortran/frontend-passes.cc index 5eba634..612c12d 100644 --- a/gcc/fortran/frontend-passes.cc +++ b/gcc/fortran/frontend-passes.cc @@ -5654,9 +5654,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, WALK_SUBEXPR (co->ext.omp_clauses->detach); for (idx = 0; idx < OMP_IF_LAST; idx++) WALK_SUBEXPR (co->ext.omp_clauses->if_exprs[idx]); - for (idx = 0; - idx < sizeof (list_types) / sizeof (list_types[0]); - idx++) + for (idx = 0; idx < ARRAY_SIZE (list_types); idx++) for (n = co->ext.omp_clauses->lists[list_types[idx]]; n; n = n->next) WALK_SUBEXPR (n->expr); diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 1bce283..5d970bc 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1271,6 +1271,7 @@ enum gfc_omp_depend_op OMP_DEPEND_IN, OMP_DEPEND_OUT, OMP_DEPEND_INOUT, + OMP_DEPEND_INOUTSET, OMP_DEPEND_MUTEXINOUTSET, OMP_DEPEND_DEPOBJ, OMP_DEPEND_SINK_FIRST, @@ -1540,7 +1541,7 @@ typedef struct gfc_omp_clauses ENUM_BITFIELD (gfc_omp_memorder) fail:3; ENUM_BITFIELD (gfc_omp_cancel_kind) cancel:3; ENUM_BITFIELD (gfc_omp_proc_bind_kind) proc_bind:3; - ENUM_BITFIELD (gfc_omp_depend_op) depobj_update:3; + ENUM_BITFIELD (gfc_omp_depend_op) depobj_update:4; ENUM_BITFIELD (gfc_omp_bind_type) bind:2; ENUM_BITFIELD (gfc_omp_at_type) at:2; ENUM_BITFIELD (gfc_omp_severity_type) severity:2; diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 4d3fcc8..63fd4dd 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -296,14 +296,17 @@ gfc_find_omp_udr (gfc_namespace *ns, const char *name, gfc_typespec *ts) } -/* Match a variable/common block list and construct a namelist from it. */ +/* Match a variable/common block list and construct a namelist from it; + if has_all_memory != NULL, *has_all_memory is set and omp_all_memory + yields a list->sym NULL entry. */ static match gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list, bool allow_common, bool *end_colon = NULL, gfc_omp_namelist ***headp = NULL, bool allow_sections = false, - bool allow_derived = false) + bool allow_derived = false, + bool *has_all_memory = NULL) { gfc_omp_namelist *head, *tail, *p; locus old_loc, cur_loc; @@ -315,7 +318,8 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list, head = tail = NULL; old_loc = gfc_current_locus; - + if (has_all_memory) + *has_all_memory = false; m = gfc_match (str); if (m != MATCH_YES) return m; @@ -323,7 +327,35 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list, for (;;) { cur_loc = gfc_current_locus; - m = gfc_match_symbol (&sym, 1); + + m = gfc_match_name (n); + if (m == MATCH_YES && strcmp (n, "omp_all_memory") == 0) + { + if (!has_all_memory) + { + gfc_error ("%<omp_all_memory%> at %C not permitted in this " + "clause"); + goto cleanup; + } + *has_all_memory = true; + p = gfc_get_omp_namelist (); + if (head == NULL) + head = tail = p; + else + { + tail->next = p; + tail = tail->next; + } + tail->where = cur_loc; + goto next_item; + } + if (m == MATCH_YES) + { + gfc_symtree *st; + if ((m = gfc_get_ha_sym_tree (n, &st) ? MATCH_ERROR : MATCH_YES) + == MATCH_YES) + sym = st->n.sym; + } switch (m) { case MATCH_YES: @@ -578,6 +610,12 @@ gfc_match_omp_depend_sink (gfc_omp_namelist **list) tail->sym = sym; tail->expr = NULL; tail->where = cur_loc; + if (UNLIKELY (strcmp (sym->name, "omp_all_memory") == 0)) + { + gfc_error ("%<omp_all_memory%> used with DEPEND kind " + "other than OUT or INOUT at %C"); + goto cleanup; + } if (gfc_match_char ('+') == MATCH_YES) { if (gfc_match_literal_constant (&tail->expr, 0) != MATCH_YES) @@ -1868,6 +1906,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, if ((mask & OMP_CLAUSE_DEPEND) && gfc_match ("depend ( ") == MATCH_YES) { + bool has_omp_all_memory; gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns; match m_it = gfc_match_iterator (&ns_iter, false); if (m_it == MATCH_ERROR) @@ -1876,7 +1915,9 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, break; m = MATCH_YES; gfc_omp_depend_op depend_op = OMP_DEPEND_OUT; - if (gfc_match ("inout") == MATCH_YES) + if (gfc_match ("inoutset") == MATCH_YES) + depend_op = OMP_DEPEND_INOUTSET; + else if (gfc_match ("inout") == MATCH_YES) depend_op = OMP_DEPEND_INOUT; else if (gfc_match ("in") == MATCH_YES) depend_op = OMP_DEPEND_IN; @@ -1920,21 +1961,27 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, if (m == MATCH_YES) m = gfc_match_omp_variable_list (" : ", &c->lists[OMP_LIST_DEPEND], - false, NULL, &head, true); + false, NULL, &head, true, + false, &has_omp_all_memory); + if (m != MATCH_YES) + goto error; gfc_current_ns = ns_curr; - if (m == MATCH_YES) + if (has_omp_all_memory && depend_op != OMP_DEPEND_INOUT + && depend_op != OMP_DEPEND_OUT) { - gfc_omp_namelist *n; - for (n = *head; n; n = n->next) - { - n->u.depend_op = depend_op; - n->u2.ns = ns_iter; - if (ns_iter) - ns_iter->refs++; - } - continue; + gfc_error ("%<omp_all_memory%> used with DEPEND kind " + "other than OUT or INOUT at %C"); + goto error; } - break; + gfc_omp_namelist *n; + for (n = *head; n; n = n->next) + { + n->u.depend_op = depend_op; + n->u2.ns = ns_iter; + if (ns_iter) + ns_iter->refs++; + } + continue; } if ((mask & OMP_CLAUSE_DETACH) && !openacc @@ -3760,7 +3807,9 @@ gfc_match_omp_depobj (void) if (gfc_match ("update ( ") == MATCH_YES) { c = gfc_get_omp_clauses (); - if (gfc_match ("inout )") == MATCH_YES) + if (gfc_match ("inoutset )") == MATCH_YES) + c->depobj_update = OMP_DEPEND_INOUTSET; + else if (gfc_match ("inout )") == MATCH_YES) c->depobj_update = OMP_DEPEND_INOUT; else if (gfc_match ("in )") == MATCH_YES) c->depobj_update = OMP_DEPEND_IN; @@ -3770,8 +3819,8 @@ gfc_match_omp_depobj (void) c->depobj_update = OMP_DEPEND_MUTEXINOUTSET; else { - gfc_error ("Expected IN, OUT, INOUT, MUTEXINOUTSET followed by " - "%<)%> at %C"); + gfc_error ("Expected IN, OUT, INOUT, INOUTSET or MUTEXINOUTSET " + "followed by %<)%> at %C"); goto error; } } @@ -4902,8 +4951,7 @@ gfc_match_omp_context_selector_specification (gfc_omp_declare_variant *odv) match m; const char *selector_sets[] = { "construct", "device", "implementation", "user" }; - const int selector_set_count - = sizeof (selector_sets) / sizeof (*selector_sets); + const int selector_set_count = ARRAY_SIZE (selector_sets); int i; char buf[GFC_MAX_SYMBOL_LEN + 1]; @@ -6491,6 +6539,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, for (list = 0; list < OMP_LIST_NUM; list++) for (n = omp_clauses->lists[list]; n; n = n->next) { + if (!n->sym) /* omp_all_memory. */ + continue; n->sym->mark = 0; n->sym->comp_mark = 0; if (n->sym->attr.flavor == FL_VARIABLE diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index c8335f9..2ebf076 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -15505,6 +15505,13 @@ resolve_symbol (gfc_symbol *sym) if (sym->attr.unlimited_polymorphic) return; + if (UNLIKELY (flag_openmp && strcmp (sym->name, "omp_all_memory") == 0)) + { + gfc_error ("%<omp_all_memory%>, declared at %L, may only be used in " + "the OpenMP DEPEND clause", &sym->declared_at); + return; + } + if (sym->attr.flavor == FL_UNKNOWN || (sym->attr.flavor == FL_PROCEDURE && !sym->attr.intrinsic && !sym->attr.generic && !sym->attr.external diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc index 2249723..6884060 100644 --- a/gcc/fortran/trans-intrinsic.cc +++ b/gcc/fortran/trans-intrinsic.cc @@ -9784,7 +9784,7 @@ conv_intrinsic_ieee_builtin (gfc_se * se, gfc_expr * expr, enum built_in_function code, int nargs) { tree args[2]; - gcc_assert ((unsigned) nargs <= sizeof(args)/sizeof(args[0])); + gcc_assert ((unsigned) nargs <= ARRAY_SIZE (args)); conv_ieee_function_args (se, expr, args, nargs); se->expr = build_call_expr_loc_array (input_location, diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index eb5870c..e1907a4 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -2880,14 +2880,16 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, continue; } - if (!n->sym->attr.referenced) + if (n->sym && !n->sym->attr.referenced) continue; tree node = build_omp_clause (input_location, list == OMP_LIST_DEPEND ? OMP_CLAUSE_DEPEND : OMP_CLAUSE_AFFINITY); - if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL) + if (n->sym == NULL) /* omp_all_memory */ + OMP_CLAUSE_DECL (node) = null_pointer_node; + else if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL) { tree decl = gfc_trans_omp_variable (n->sym, false); if (gfc_omp_privatize_by_reference (decl)) @@ -2935,6 +2937,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, case OMP_DEPEND_INOUT: OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_INOUT; break; + case OMP_DEPEND_INOUTSET: + OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_INOUTSET; + break; case OMP_DEPEND_MUTEXINOUTSET: OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_MUTEXINOUTSET; @@ -5531,7 +5536,9 @@ gfc_trans_omp_depobj (gfc_code *code) if (n) { tree var; - if (n->expr && n->expr->ref->u.ar.type != AR_FULL) + if (!n->sym) /* omp_all_memory. */ + var = null_pointer_node; + else if (n->expr && n->expr->ref->u.ar.type != AR_FULL) { gfc_init_se (&se, NULL); if (n->expr->ref->u.ar.type == AR_ELEMENT) @@ -5589,6 +5596,7 @@ gfc_trans_omp_depobj (gfc_code *code) case OMP_DEPEND_IN: k = GOMP_DEPEND_IN; break; case OMP_DEPEND_OUT: k = GOMP_DEPEND_OUT; break; case OMP_DEPEND_INOUT: k = GOMP_DEPEND_INOUT; break; + case OMP_DEPEND_INOUTSET: k = GOMP_DEPEND_INOUTSET; break; case OMP_DEPEND_MUTEXINOUTSET: k = GOMP_DEPEND_MUTEXINOUTSET; break; default: gcc_unreachable (); } diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc index 3cdc529..3742bf3 100644 --- a/gcc/fortran/trans-types.cc +++ b/gcc/fortran/trans-types.cc @@ -3420,7 +3420,7 @@ gfc_get_array_descr_info (const_tree type, struct array_descr_info *info) } rank = GFC_TYPE_ARRAY_RANK (type); - if (rank >= (int) (sizeof (info->dimen) / sizeof (info->dimen[0]))) + if (rank >= (int) (ARRAY_SIZE (info->dimen))) return false; etype = GFC_TYPE_ARRAY_DATAPTR_TYPE (type); diff --git a/gcc/genhooks.cc b/gcc/genhooks.cc index 20ad607..6bae85d 100644 --- a/gcc/genhooks.cc +++ b/gcc/genhooks.cc @@ -128,7 +128,7 @@ emit_documentation (const char *in_fname) } fclose (f); /* For each hook in hook_array, if it is a start hook, store its position. */ - for (i = 0; i < (int) (sizeof hook_array / sizeof hook_array[0]); i++) + for (i = 0; i < (int) (ARRAY_SIZE (hook_array)); i++) { struct s_hook sh, *shp; void *p; @@ -223,7 +223,7 @@ emit_documentation (const char *in_fname) /* POD-valued hooks sometimes come in groups with common documentation.*/ for (j = i + 1; - j < (int) (sizeof hook_array / sizeof hook_array[0]) + j < (int) (ARRAY_SIZE (hook_array)) && hook_array[j].doc == 0 && hook_array[j].type; j++) { char *namex = upstrdup (hook_array[j].name); @@ -246,8 +246,7 @@ emit_documentation (const char *in_fname) printf ("\n@end %s", deftype); } } - if (++i >= (int) (sizeof hook_array / sizeof hook_array[0]) - || !hook_array[i].doc) + if (++i >= (int) (ARRAY_SIZE (hook_array)) || !hook_array[i].doc) break; free (name); sh.name = name = upstrdup (hook_array[i].name); @@ -270,7 +269,7 @@ emit_init_macros (const char *docname) for (print_nest = 0; print_nest <= MAX_NEST; print_nest++) { - for (i = 0; i < (int) (sizeof hook_array / sizeof hook_array[0]); i++) + for (i = 0; i < (int) (ARRAY_SIZE (hook_array)); i++) { char *name = upstrdup (hook_array[i].name); diff --git a/gcc/gimple-fold.cc b/gcc/gimple-fold.cc index e086b03..8555a2b 100644 --- a/gcc/gimple-fold.cc +++ b/gcc/gimple-fold.cc @@ -8667,6 +8667,29 @@ gimple_build_valueize (tree op) return NULL_TREE; } +/* Helper for gimple_build to perform the final insertion of stmts on SEQ. */ + +static inline void +gimple_build_insert_seq (gimple_stmt_iterator *gsi, + bool before, gsi_iterator_update update, + gimple_seq seq) +{ + if (before) + { + if (gsi->bb) + gsi_insert_seq_before (gsi, seq, update); + else + gsi_insert_seq_before_without_update (gsi, seq, update); + } + else + { + if (gsi->bb) + gsi_insert_seq_after (gsi, seq, update); + else + gsi_insert_seq_after_without_update (gsi, seq, update); + } +} + /* Build the expression CODE OP0 of type TYPE with location LOC, simplifying it first if possible. Returns the built expression value and inserts statements possibly defining it @@ -8699,27 +8722,14 @@ gimple_build (gimple_stmt_iterator *gsi, gimple_set_location (stmt, loc); gimple_seq_add_stmt_without_update (&seq, stmt); } - if (before) - { - if (gsi->bb) - gsi_insert_seq_before (gsi, seq, update); - else - gsi_insert_seq_before_without_update (gsi, seq, update); - } - else - { - if (gsi->bb) - gsi_insert_seq_after (gsi, seq, update); - else - gsi_insert_seq_after_without_update (gsi, seq, update); - } + gimple_build_insert_seq (gsi, before, update, seq); return res; } /* Build the expression OP0 CODE OP1 of type TYPE with location LOC, simplifying it first if possible. Returns the built - expression value and appends statements possibly defining it - to SEQ. */ + expression value inserting any new statements at GSI honoring BEFORE + and UPDATE. */ tree gimple_build (gimple_stmt_iterator *gsi, @@ -8738,27 +8748,14 @@ gimple_build (gimple_stmt_iterator *gsi, gimple_set_location (stmt, loc); gimple_seq_add_stmt_without_update (&seq, stmt); } - if (before) - { - if (gsi->bb) - gsi_insert_seq_before (gsi, seq, update); - else - gsi_insert_seq_before_without_update (gsi, seq, update); - } - else - { - if (gsi->bb) - gsi_insert_seq_after (gsi, seq, update); - else - gsi_insert_seq_after_without_update (gsi, seq, update); - } + gimple_build_insert_seq (gsi, before, update, seq); return res; } /* Build the expression (CODE OP0 OP1 OP2) of type TYPE with location LOC, simplifying it first if possible. Returns the built - expression value and appends statements possibly defining it - to SEQ. */ + expression value inserting any new statements at GSI honoring BEFORE + and UPDATE. */ tree gimple_build (gimple_stmt_iterator *gsi, @@ -8783,31 +8780,22 @@ gimple_build (gimple_stmt_iterator *gsi, gimple_set_location (stmt, loc); gimple_seq_add_stmt_without_update (&seq, stmt); } - if (before) - { - if (gsi->bb) - gsi_insert_seq_before (gsi, seq, update); - else - gsi_insert_seq_before_without_update (gsi, seq, update); - } - else - { - if (gsi->bb) - gsi_insert_seq_after (gsi, seq, update); - else - gsi_insert_seq_after_without_update (gsi, seq, update); - } + gimple_build_insert_seq (gsi, before, update, seq); return res; } /* Build the call FN () with a result of type TYPE (or no result if TYPE is void) with a location LOC. Returns the built expression value (or NULL_TREE - if TYPE is void) and appends statements possibly defining it to SEQ. */ + if TYPE is void) inserting any new statements at GSI honoring BEFORE + and UPDATE. */ tree -gimple_build (gimple_seq *seq, location_t loc, combined_fn fn, tree type) +gimple_build (gimple_stmt_iterator *gsi, + bool before, gsi_iterator_update update, + location_t loc, combined_fn fn, tree type) { tree res = NULL_TREE; + gimple_seq seq = NULL; gcall *stmt; if (internal_fn_p (fn)) stmt = gimple_build_call_internal (as_internal_fn (fn), 0); @@ -8822,21 +8810,25 @@ gimple_build (gimple_seq *seq, location_t loc, combined_fn fn, tree type) gimple_call_set_lhs (stmt, res); } gimple_set_location (stmt, loc); - gimple_seq_add_stmt_without_update (seq, stmt); + gimple_seq_add_stmt_without_update (&seq, stmt); + gimple_build_insert_seq (gsi, before, update, seq); return res; } /* Build the call FN (ARG0) with a result of type TYPE (or no result if TYPE is void) with location LOC, simplifying it first if possible. Returns the built - expression value (or NULL_TREE if TYPE is void) and appends - statements possibly defining it to SEQ. */ + expression value (or NULL_TREE if TYPE is void) inserting any new + statements at GSI honoring BEFORE and UPDATE. */ tree -gimple_build (gimple_seq *seq, location_t loc, combined_fn fn, +gimple_build (gimple_stmt_iterator *gsi, + bool before, gsi_iterator_update update, + location_t loc, combined_fn fn, tree type, tree arg0) { - tree res = gimple_simplify (fn, type, arg0, seq, gimple_build_valueize); + gimple_seq seq = NULL; + tree res = gimple_simplify (fn, type, arg0, &seq, gimple_build_valueize); if (!res) { gcall *stmt; @@ -8853,22 +8845,27 @@ gimple_build (gimple_seq *seq, location_t loc, combined_fn fn, gimple_call_set_lhs (stmt, res); } gimple_set_location (stmt, loc); - gimple_seq_add_stmt_without_update (seq, stmt); + gimple_seq_add_stmt_without_update (&seq, stmt); } + gimple_build_insert_seq (gsi, before, update, seq); return res; } /* Build the call FN (ARG0, ARG1) with a result of type TYPE (or no result if TYPE is void) with location LOC, simplifying it first if possible. Returns the built - expression value (or NULL_TREE if TYPE is void) and appends - statements possibly defining it to SEQ. */ + expression value (or NULL_TREE if TYPE is void) inserting any new + statements at GSI honoring BEFORE and UPDATE. */ tree -gimple_build (gimple_seq *seq, location_t loc, combined_fn fn, +gimple_build (gimple_stmt_iterator *gsi, + bool before, gsi_iterator_update update, + location_t loc, combined_fn fn, tree type, tree arg0, tree arg1) { - tree res = gimple_simplify (fn, type, arg0, arg1, seq, gimple_build_valueize); + gimple_seq seq = NULL; + tree res = gimple_simplify (fn, type, arg0, arg1, &seq, + gimple_build_valueize); if (!res) { gcall *stmt; @@ -8885,23 +8882,27 @@ gimple_build (gimple_seq *seq, location_t loc, combined_fn fn, gimple_call_set_lhs (stmt, res); } gimple_set_location (stmt, loc); - gimple_seq_add_stmt_without_update (seq, stmt); + gimple_seq_add_stmt_without_update (&seq, stmt); } + gimple_build_insert_seq (gsi, before, update, seq); return res; } /* Build the call FN (ARG0, ARG1, ARG2) with a result of type TYPE (or no result if TYPE is void) with location LOC, simplifying it first if possible. Returns the built - expression value (or NULL_TREE if TYPE is void) and appends - statements possibly defining it to SEQ. */ + expression value (or NULL_TREE if TYPE is void) inserting any new + statements at GSI honoring BEFORE and UPDATE. */ tree -gimple_build (gimple_seq *seq, location_t loc, combined_fn fn, +gimple_build (gimple_stmt_iterator *gsi, + bool before, gsi_iterator_update update, + location_t loc, combined_fn fn, tree type, tree arg0, tree arg1, tree arg2) { + gimple_seq seq = NULL; tree res = gimple_simplify (fn, type, arg0, arg1, arg2, - seq, gimple_build_valueize); + &seq, gimple_build_valueize); if (!res) { gcall *stmt; @@ -8919,92 +8920,107 @@ gimple_build (gimple_seq *seq, location_t loc, combined_fn fn, gimple_call_set_lhs (stmt, res); } gimple_set_location (stmt, loc); - gimple_seq_add_stmt_without_update (seq, stmt); + gimple_seq_add_stmt_without_update (&seq, stmt); } + gimple_build_insert_seq (gsi, before, update, seq); return res; } /* Build CODE (OP0) with a result of type TYPE (or no result if TYPE is void) with location LOC, simplifying it first if possible. Returns the - built expression value (or NULL_TREE if TYPE is void) and appends - statements possibly defining it to SEQ. */ + built expression value (or NULL_TREE if TYPE is void) inserting any new + statements at GSI honoring BEFORE and UPDATE. */ tree -gimple_build (gimple_seq *seq, location_t loc, code_helper code, - tree type, tree op0) +gimple_build (gimple_stmt_iterator *gsi, + bool before, gsi_iterator_update update, + location_t loc, code_helper code, tree type, tree op0) { if (code.is_tree_code ()) - return gimple_build (seq, loc, tree_code (code), type, op0); - return gimple_build (seq, loc, combined_fn (code), type, op0); + return gimple_build (gsi, before, update, loc, tree_code (code), type, op0); + return gimple_build (gsi, before, update, loc, combined_fn (code), type, op0); } /* Build CODE (OP0, OP1) with a result of type TYPE (or no result if TYPE is void) with location LOC, simplifying it first if possible. Returns the - built expression value (or NULL_TREE if TYPE is void) and appends - statements possibly defining it to SEQ. */ + built expression value (or NULL_TREE if TYPE is void) inserting any new + statements at GSI honoring BEFORE and UPDATE. */ tree -gimple_build (gimple_seq *seq, location_t loc, code_helper code, - tree type, tree op0, tree op1) +gimple_build (gimple_stmt_iterator *gsi, + bool before, gsi_iterator_update update, + location_t loc, code_helper code, tree type, tree op0, tree op1) { if (code.is_tree_code ()) - return gimple_build (seq, loc, tree_code (code), type, op0, op1); - return gimple_build (seq, loc, combined_fn (code), type, op0, op1); + return gimple_build (gsi, before, update, + loc, tree_code (code), type, op0, op1); + return gimple_build (gsi, before, update, + loc, combined_fn (code), type, op0, op1); } /* Build CODE (OP0, OP1, OP2) with a result of type TYPE (or no result if TYPE is void) with location LOC, simplifying it first if possible. Returns the - built expression value (or NULL_TREE if TYPE is void) and appends statements - possibly defining it to SEQ. */ + built expression value (or NULL_TREE if TYPE is void) inserting any new + statements at GSI honoring BEFORE and UPDATE. */ tree -gimple_build (gimple_seq *seq, location_t loc, code_helper code, +gimple_build (gimple_stmt_iterator *gsi, + bool before, gsi_iterator_update update, + location_t loc, code_helper code, tree type, tree op0, tree op1, tree op2) { if (code.is_tree_code ()) - return gimple_build (seq, loc, tree_code (code), type, op0, op1, op2); - return gimple_build (seq, loc, combined_fn (code), type, op0, op1, op2); + return gimple_build (gsi, before, update, + loc, tree_code (code), type, op0, op1, op2); + return gimple_build (gsi, before, update, + loc, combined_fn (code), type, op0, op1, op2); } /* Build the conversion (TYPE) OP with a result of type TYPE with location LOC if such conversion is neccesary in GIMPLE, simplifying it first. - Returns the built expression value and appends - statements possibly defining it to SEQ. */ + Returns the built expression inserting any new statements + at GSI honoring BEFORE and UPDATE. */ tree -gimple_convert (gimple_seq *seq, location_t loc, tree type, tree op) +gimple_convert (gimple_stmt_iterator *gsi, + bool before, gsi_iterator_update update, + location_t loc, tree type, tree op) { if (useless_type_conversion_p (type, TREE_TYPE (op))) return op; - return gimple_build (seq, loc, NOP_EXPR, type, op); + return gimple_build (gsi, before, update, loc, NOP_EXPR, type, op); } /* Build the conversion (ptrofftype) OP with a result of a type compatible with ptrofftype with location LOC if such conversion is neccesary in GIMPLE, simplifying it first. - Returns the built expression value and appends - statements possibly defining it to SEQ. */ + Returns the built expression value inserting any new statements + at GSI honoring BEFORE and UPDATE. */ tree -gimple_convert_to_ptrofftype (gimple_seq *seq, location_t loc, tree op) +gimple_convert_to_ptrofftype (gimple_stmt_iterator *gsi, + bool before, gsi_iterator_update update, + location_t loc, tree op) { if (ptrofftype_p (TREE_TYPE (op))) return op; - return gimple_convert (seq, loc, sizetype, op); + return gimple_convert (gsi, before, update, loc, sizetype, op); } /* Build a vector of type TYPE in which each element has the value OP. - Return a gimple value for the result, appending any new statements - to SEQ. */ + Return a gimple value for the result, inserting any new statements + at GSI honoring BEFORE and UPDATE. */ tree -gimple_build_vector_from_val (gimple_seq *seq, location_t loc, tree type, - tree op) +gimple_build_vector_from_val (gimple_stmt_iterator *gsi, + bool before, gsi_iterator_update update, + location_t loc, tree type, tree op) { if (!TYPE_VECTOR_SUBPARTS (type).is_constant () && !CONSTANT_CLASS_P (op)) - return gimple_build (seq, loc, VEC_DUPLICATE_EXPR, type, op); + return gimple_build (gsi, before, update, + loc, VEC_DUPLICATE_EXPR, type, op); tree res, vec = build_vector_from_val (type, op); if (is_gimple_val (vec)) @@ -9013,15 +9029,17 @@ gimple_build_vector_from_val (gimple_seq *seq, location_t loc, tree type, res = make_ssa_name (type); else res = create_tmp_reg (type); + gimple_seq seq = NULL; gimple *stmt = gimple_build_assign (res, vec); gimple_set_location (stmt, loc); - gimple_seq_add_stmt_without_update (seq, stmt); + gimple_seq_add_stmt_without_update (&seq, stmt); + gimple_build_insert_seq (gsi, before, update, seq); return res; } /* Build a vector from BUILDER, handling the case in which some elements - are non-constant. Return a gimple value for the result, appending any - new instructions to SEQ. + are non-constant. Return a gimple value for the result, inserting + any new instructions to GSI honoring BEFORE and UPDATE. BUILDER must not have a stepped encoding on entry. This is because the function is not geared up to handle the arithmetic that would @@ -9029,14 +9047,16 @@ gimple_build_vector_from_val (gimple_seq *seq, location_t loc, tree type, is known to be constant should use BUILDER->build () directly. */ tree -gimple_build_vector (gimple_seq *seq, location_t loc, - tree_vector_builder *builder) +gimple_build_vector (gimple_stmt_iterator *gsi, + bool before, gsi_iterator_update update, + location_t loc, tree_vector_builder *builder) { gcc_assert (builder->nelts_per_pattern () <= 2); unsigned int encoded_nelts = builder->encoded_nelts (); for (unsigned int i = 0; i < encoded_nelts; ++i) if (!CONSTANT_CLASS_P ((*builder)[i])) { + gimple_seq seq = NULL; tree type = builder->type (); unsigned int nelts = TYPE_VECTOR_SUBPARTS (type).to_constant (); vec<constructor_elt, va_gc> *v; @@ -9051,7 +9071,8 @@ gimple_build_vector (gimple_seq *seq, location_t loc, res = create_tmp_reg (type); gimple *stmt = gimple_build_assign (res, build_constructor (type, v)); gimple_set_location (stmt, loc); - gimple_seq_add_stmt_without_update (seq, stmt); + gimple_seq_add_stmt_without_update (&seq, stmt); + gimple_build_insert_seq (gsi, before, update, seq); return res; } return builder->build (); @@ -9063,18 +9084,21 @@ gimple_build_vector (gimple_seq *seq, location_t loc, Return the tree node representing this size, it is of TREE_TYPE TYPE. */ tree -gimple_build_round_up (gimple_seq *seq, location_t loc, tree type, +gimple_build_round_up (gimple_stmt_iterator *gsi, + bool before, gsi_iterator_update update, + location_t loc, tree type, tree old_size, unsigned HOST_WIDE_INT align) { unsigned HOST_WIDE_INT tg_mask = align - 1; /* tree new_size = (old_size + tg_mask) & ~tg_mask; */ gcc_assert (INTEGRAL_TYPE_P (type)); tree tree_mask = build_int_cst (type, tg_mask); - tree oversize = gimple_build (seq, loc, PLUS_EXPR, type, old_size, - tree_mask); + tree oversize = gimple_build (gsi, before, update, + loc, PLUS_EXPR, type, old_size, tree_mask); tree mask = build_int_cst (type, -align); - return gimple_build (seq, loc, BIT_AND_EXPR, type, oversize, mask); + return gimple_build (gsi, before, update, + loc, BIT_AND_EXPR, type, oversize, mask); } /* Return true if the result of assignment STMT is known to be non-negative. diff --git a/gcc/gimple-fold.h b/gcc/gimple-fold.h index 520fde8..7d29ee9 100644 --- a/gcc/gimple-fold.h +++ b/gcc/gimple-fold.h @@ -98,59 +98,166 @@ gimple_build (gimple_seq *seq, enum tree_code code, tree type, Args ...ops) UNKNOWN_LOCATION, code, type, ops...); } -extern tree gimple_build (gimple_seq *, location_t, combined_fn, tree); -extern tree gimple_build (gimple_seq *, location_t, combined_fn, tree, tree); -extern tree gimple_build (gimple_seq *, location_t, combined_fn, - tree, tree, tree); -extern tree gimple_build (gimple_seq *, location_t, combined_fn, - tree, tree, tree, tree); +extern tree gimple_build (gimple_stmt_iterator *, bool, + enum gsi_iterator_update, + location_t, combined_fn, tree); +extern tree gimple_build (gimple_stmt_iterator *, bool, + enum gsi_iterator_update, + location_t, combined_fn, tree, tree); +extern tree gimple_build (gimple_stmt_iterator *, bool, + enum gsi_iterator_update, + location_t, combined_fn, tree, tree, tree); +extern tree gimple_build (gimple_stmt_iterator *, bool, + enum gsi_iterator_update, + location_t, combined_fn, tree, tree, tree, tree); +template<class ...Args> +inline tree +gimple_build (gimple_seq *seq, location_t loc, + combined_fn fn, tree type, Args ...args) +{ + static_assert (sizeof...(args) < 4, + "Number of arguments must be less than four"); + gimple_stmt_iterator gsi = gsi_last (*seq); + return gimple_build (&gsi, false, GSI_CONTINUE_LINKING, + loc, fn, type, args...); +} template<class ...Args> inline tree gimple_build (gimple_seq *seq, combined_fn fn, tree type, Args ...args) { static_assert (sizeof...(args) < 4, "Number of arguments must be less than four"); - return gimple_build (seq, UNKNOWN_LOCATION, fn, type, args...); + gimple_stmt_iterator gsi = gsi_last (*seq); + return gimple_build (&gsi, false, GSI_CONTINUE_LINKING, + UNKNOWN_LOCATION, fn, type, args...); } -extern tree gimple_convert (gimple_seq *, location_t, tree, tree); +extern tree gimple_build (gimple_stmt_iterator *, bool, + enum gsi_iterator_update, + location_t, code_helper, tree, tree); +extern tree gimple_build (gimple_stmt_iterator *, bool, + enum gsi_iterator_update, + location_t, code_helper, tree, tree, tree); +extern tree gimple_build (gimple_stmt_iterator *, bool, + enum gsi_iterator_update, + location_t, code_helper, tree, tree, tree, tree); + +template<class ...Args> +inline tree +gimple_build (gimple_seq *seq, location_t loc, + code_helper code, tree type, Args ...ops) +{ + static_assert (sizeof...(ops) < 4, + "Number of operands must be less than four"); + gimple_stmt_iterator gsi = gsi_last (*seq); + return gimple_build (&gsi, false, GSI_CONTINUE_LINKING, + loc, code, type, ops...); +} +template<class ...Args> +inline tree +gimple_build (gimple_seq *seq, + code_helper code, tree type, Args ...ops) +{ + static_assert (sizeof...(ops) < 4, + "Number of operands must be less than four"); + gimple_stmt_iterator gsi = gsi_last (*seq); + return gimple_build (&gsi, false, GSI_CONTINUE_LINKING, + UNKNOWN_LOCATION, code, type, ops...); +} + +extern tree gimple_convert (gimple_stmt_iterator *, bool, + enum gsi_iterator_update, + location_t, tree, tree); +inline tree +gimple_convert (gimple_seq *seq, location_t loc, tree type, tree op) +{ + gimple_stmt_iterator gsi = gsi_last (*seq); + return gimple_convert (&gsi, false, GSI_CONTINUE_LINKING, loc, type, op); +} inline tree gimple_convert (gimple_seq *seq, tree type, tree op) { - return gimple_convert (seq, UNKNOWN_LOCATION, type, op); + gimple_stmt_iterator gsi = gsi_last (*seq); + return gimple_convert (&gsi, false, GSI_CONTINUE_LINKING, + UNKNOWN_LOCATION, type, op); } -extern tree gimple_convert_to_ptrofftype (gimple_seq *, location_t, tree); +extern tree gimple_convert_to_ptrofftype (gimple_stmt_iterator *, bool, + enum gsi_iterator_update, + location_t, tree); +inline tree +gimple_convert_to_ptrofftype (gimple_seq *seq, location_t loc, tree op) +{ + gimple_stmt_iterator gsi = gsi_last (*seq); + return gimple_convert_to_ptrofftype (&gsi, false, GSI_CONTINUE_LINKING, + loc, op); +} inline tree gimple_convert_to_ptrofftype (gimple_seq *seq, tree op) { - return gimple_convert_to_ptrofftype (seq, UNKNOWN_LOCATION, op); + gimple_stmt_iterator gsi = gsi_last (*seq); + return gimple_convert_to_ptrofftype (&gsi, false, GSI_CONTINUE_LINKING, + UNKNOWN_LOCATION, op); } -extern tree gimple_build_vector_from_val (gimple_seq *, location_t, tree, - tree); +extern tree gimple_build_vector_from_val (gimple_stmt_iterator *, bool, + enum gsi_iterator_update, + location_t, tree, tree); +inline tree +gimple_build_vector_from_val (gimple_seq *seq, location_t loc, + tree type, tree op) +{ + gimple_stmt_iterator gsi = gsi_last (*seq); + return gimple_build_vector_from_val (&gsi, false, GSI_CONTINUE_LINKING, + loc, type, op); +} inline tree gimple_build_vector_from_val (gimple_seq *seq, tree type, tree op) { - return gimple_build_vector_from_val (seq, UNKNOWN_LOCATION, type, op); + gimple_stmt_iterator gsi = gsi_last (*seq); + return gimple_build_vector_from_val (&gsi, false, GSI_CONTINUE_LINKING, + UNKNOWN_LOCATION, type, op); } class tree_vector_builder; -extern tree gimple_build_vector (gimple_seq *, location_t, - tree_vector_builder *); +extern tree gimple_build_vector (gimple_stmt_iterator *, bool, + enum gsi_iterator_update, + location_t, tree_vector_builder *); +inline tree +gimple_build_vector (gimple_seq *seq, location_t loc, + tree_vector_builder *builder) +{ + gimple_stmt_iterator gsi = gsi_last (*seq); + return gimple_build_vector (&gsi, false, GSI_CONTINUE_LINKING, + loc, builder); +} inline tree gimple_build_vector (gimple_seq *seq, tree_vector_builder *builder) { - return gimple_build_vector (seq, UNKNOWN_LOCATION, builder); + gimple_stmt_iterator gsi = gsi_last (*seq); + return gimple_build_vector (&gsi, false, GSI_CONTINUE_LINKING, + UNKNOWN_LOCATION, builder); } -extern tree gimple_build_round_up (gimple_seq *, location_t, tree, tree, +extern tree gimple_build_round_up (gimple_stmt_iterator *, bool, + enum gsi_iterator_update, + location_t, tree, tree, unsigned HOST_WIDE_INT); inline tree +gimple_build_round_up (gimple_seq *seq, location_t loc, + tree type, tree old_size, unsigned HOST_WIDE_INT align) +{ + gimple_stmt_iterator gsi = gsi_last (*seq); + return gimple_build_round_up (&gsi, false, GSI_CONTINUE_LINKING, + loc, type, old_size, align); +} +inline tree gimple_build_round_up (gimple_seq *seq, tree type, tree old_size, unsigned HOST_WIDE_INT align) { - return gimple_build_round_up (seq, UNKNOWN_LOCATION, type, old_size, align); + gimple_stmt_iterator gsi = gsi_last (*seq); + return gimple_build_round_up (&gsi, false, GSI_CONTINUE_LINKING, + UNKNOWN_LOCATION, type, old_size, align); } extern bool gimple_stmt_nonnegative_warnv_p (gimple *, bool *, int = 0); diff --git a/gcc/gimple-match.h b/gcc/gimple-match.h index d7b0b67..d03789b 100644 --- a/gcc/gimple-match.h +++ b/gcc/gimple-match.h @@ -23,55 +23,6 @@ along with GCC; see the file COPYING3. If not see #define GCC_GIMPLE_MATCH_H -/* Helper to transparently allow tree codes and builtin function codes - exist in one storage entity. */ -class code_helper -{ -public: - code_helper () {} - code_helper (tree_code code) : rep ((int) code) {} - code_helper (combined_fn fn) : rep (-(int) fn) {} - code_helper (internal_fn fn) : rep (-(int) as_combined_fn (fn)) {} - explicit operator tree_code () const { return (tree_code) rep; } - explicit operator combined_fn () const { return (combined_fn) -rep; } - explicit operator internal_fn () const; - explicit operator built_in_function () const; - bool is_tree_code () const { return rep > 0; } - bool is_fn_code () const { return rep < 0; } - bool is_internal_fn () const; - bool is_builtin_fn () const; - int get_rep () const { return rep; } - bool operator== (const code_helper &other) { return rep == other.rep; } - bool operator!= (const code_helper &other) { return rep != other.rep; } - bool operator== (tree_code c) { return rep == code_helper (c).rep; } - bool operator!= (tree_code c) { return rep != code_helper (c).rep; } - -private: - int rep; -}; - -inline code_helper::operator internal_fn () const -{ - return as_internal_fn (combined_fn (*this)); -} - -inline code_helper::operator built_in_function () const -{ - return as_builtin_fn (combined_fn (*this)); -} - -inline bool -code_helper::is_internal_fn () const -{ - return is_fn_code () && internal_fn_p (combined_fn (*this)); -} - -inline bool -code_helper::is_builtin_fn () const -{ - return is_fn_code () && builtin_fn_p (combined_fn (*this)); -} - /* Represents the condition under which an operation should happen, and the value to use otherwise. The condition applies elementwise (as for VEC_COND_EXPR) if the values are vectors. */ @@ -384,30 +335,4 @@ bool directly_supported_p (code_helper, tree, optab_subtype = optab_default); internal_fn get_conditional_internal_fn (code_helper, tree); -extern tree gimple_build (gimple_seq *, location_t, - code_helper, tree, tree); -inline tree -gimple_build (gimple_seq *seq, code_helper code, tree type, tree op0) -{ - return gimple_build (seq, UNKNOWN_LOCATION, code, type, op0); -} - -extern tree gimple_build (gimple_seq *, location_t, - code_helper, tree, tree, tree); -inline tree -gimple_build (gimple_seq *seq, code_helper code, tree type, tree op0, - tree op1) -{ - return gimple_build (seq, UNKNOWN_LOCATION, code, type, op0, op1); -} - -extern tree gimple_build (gimple_seq *, location_t, - code_helper, tree, tree, tree, tree); -inline tree -gimple_build (gimple_seq *seq, code_helper code, tree type, tree op0, - tree op1, tree op2) -{ - return gimple_build (seq, UNKNOWN_LOCATION, code, type, op0, op1, op2); -} - #endif /* GCC_GIMPLE_MATCH_H */ diff --git a/gcc/gimple-range-cache.cc b/gcc/gimple-range-cache.cc index d3cf8be..56f4577 100644 --- a/gcc/gimple-range-cache.cc +++ b/gcc/gimple-range-cache.cc @@ -38,120 +38,6 @@ along with GCC; see the file COPYING3. If not see #define DEBUG_RANGE_CACHE (dump_file \ && (param_ranger_debug & RANGER_DEBUG_CACHE)) -// During contructor, allocate the vector of ssa_names. - -non_null_ref::non_null_ref () -{ - m_nn.create (num_ssa_names); - m_nn.quick_grow_cleared (num_ssa_names); - bitmap_obstack_initialize (&m_bitmaps); -} - -// Free any bitmaps which were allocated,a swell as the vector itself. - -non_null_ref::~non_null_ref () -{ - bitmap_obstack_release (&m_bitmaps); - m_nn.release (); -} - -// This routine will update NAME in BB to be nonnull if it is not already. -// return TRUE if the update happens. - -bool -non_null_ref::set_nonnull (basic_block bb, tree name) -{ - gcc_checking_assert (gimple_range_ssa_p (name) - && POINTER_TYPE_P (TREE_TYPE (name))); - // Only process when its not already set. - if (non_null_deref_p (name, bb, false)) - return false; - bitmap_set_bit (m_nn[SSA_NAME_VERSION (name)], bb->index); - return true; -} - -// Return true if NAME has a non-null dereference in block bb. If this is the -// first query for NAME, calculate the summary first. -// If SEARCH_DOM is true, the search the dominator tree as well. - -bool -non_null_ref::non_null_deref_p (tree name, basic_block bb, bool search_dom) -{ - if (!POINTER_TYPE_P (TREE_TYPE (name))) - return false; - - unsigned v = SSA_NAME_VERSION (name); - if (v >= m_nn.length ()) - m_nn.safe_grow_cleared (num_ssa_names + 1); - - if (!m_nn[v]) - process_name (name); - - if (bitmap_bit_p (m_nn[v], bb->index)) - return true; - - // See if any dominator has set non-zero. - if (search_dom && dom_info_available_p (CDI_DOMINATORS)) - { - // Search back to the Def block, or the top, whichever is closer. - basic_block def_bb = gimple_bb (SSA_NAME_DEF_STMT (name)); - basic_block def_dom = def_bb - ? get_immediate_dominator (CDI_DOMINATORS, def_bb) - : NULL; - for ( ; - bb && bb != def_dom; - bb = get_immediate_dominator (CDI_DOMINATORS, bb)) - if (bitmap_bit_p (m_nn[v], bb->index)) - return true; - } - return false; -} - -// Allocate an populate the bitmap for NAME. An ON bit for a block -// index indicates there is a non-null reference in that block. In -// order to populate the bitmap, a quick run of all the immediate uses -// are made and the statement checked to see if a non-null dereference -// is made on that statement. - -void -non_null_ref::process_name (tree name) -{ - unsigned v = SSA_NAME_VERSION (name); - use_operand_p use_p; - imm_use_iterator iter; - bitmap b; - - // Only tracked for pointers. - if (!POINTER_TYPE_P (TREE_TYPE (name))) - return; - - // Already processed if a bitmap has been allocated. - if (m_nn[v]) - return; - - b = BITMAP_ALLOC (&m_bitmaps); - - // Loop over each immediate use and see if it implies a non-null value. - FOR_EACH_IMM_USE_FAST (use_p, iter, name) - { - gimple *s = USE_STMT (use_p); - unsigned index = gimple_bb (s)->index; - - // If bit is already set for this block, dont bother looking again. - if (bitmap_bit_p (b, index)) - continue; - - // If we can infer a nonnull range, then set the bit for this BB - if (!SSA_NAME_OCCURS_IN_ABNORMAL_PHI (name) - && infer_nonnull_range (s, name)) - bitmap_set_bit (b, index); - } - - m_nn[v] = b; -} - -// ------------------------------------------------------------------------- - // This class represents the API into a cache of ranges for an SSA_NAME. // Routines must be implemented to set, get, and query if a value is set. @@ -859,8 +745,9 @@ update_list::pop () // -------------------------------------------------------------------------- -ranger_cache::ranger_cache (int not_executable_flag) - : m_gori (not_executable_flag) +ranger_cache::ranger_cache (int not_executable_flag, bool use_imm_uses) + : m_gori (not_executable_flag), + m_exit (use_imm_uses) { m_workback.create (0); m_workback.safe_grow_cleared (last_basic_block_for_fn (cfun)); @@ -1057,9 +944,9 @@ bool ranger_cache::edge_range (irange &r, edge e, tree name, enum rfd_mode mode) { exit_range (r, name, e->src, mode); - // If this is not an abnormal edge, check for a non-null exit. + // If this is not an abnormal edge, check for side effects on exit. if ((e->flags & (EDGE_EH | EDGE_ABNORMAL)) == 0) - m_non_null.adjust_range (r, name, e->src, false); + m_exit.maybe_adjust_range (r, name, e->src); int_range_max er; if (m_gori.outgoing_edge_range_p (er, e, name, *this)) r.intersect (er); @@ -1364,12 +1251,12 @@ ranger_cache::fill_block_cache (tree name, basic_block bb, basic_block def_bb) } // Regardless of whether we have visited pred or not, if the - // pred has a non-null reference, revisit this block. + // pred has side_effects, revisit this block. // Don't search the DOM tree. - if (m_non_null.non_null_deref_p (name, pred, false)) + if (m_exit.has_range_p (name, pred)) { if (DEBUG_RANGE_CACHE) - fprintf (dump_file, "nonnull: update "); + fprintf (dump_file, "side effect: update "); m_update->add (node); } @@ -1429,8 +1316,9 @@ ranger_cache::range_from_dom (irange &r, tree name, basic_block start_bb, basic_block bb; basic_block prev_bb = start_bb; - // Flag if we encounter a block with non-null set. - bool non_null = false; + + // Track any side effects seen + int_range_max side_effect (TREE_TYPE (name)); // Range on entry to the DEF block should not be queried. gcc_checking_assert (start_bb != def_bb); @@ -1444,8 +1332,8 @@ ranger_cache::range_from_dom (irange &r, tree name, basic_block start_bb, bb; prev_bb = bb, bb = get_immediate_dominator (CDI_DOMINATORS, bb)) { - if (!non_null) - non_null |= m_non_null.non_null_deref_p (name, bb, false); + // Accumulate any block exit side effects. + m_exit.maybe_adjust_range (side_effect, name, bb); // This block has an outgoing range. if (m_gori.has_edge_range_p (name, bb)) @@ -1511,14 +1399,10 @@ ranger_cache::range_from_dom (irange &r, tree name, basic_block start_bb, if (m_gori.outgoing_edge_range_p (er, e, name, *this)) { r.intersect (er); - if (r.varying_p () && ((e->flags & (EDGE_EH | EDGE_ABNORMAL)) == 0)) - { - if (m_non_null.non_null_deref_p (name, bb, false)) - { - gcc_checking_assert (POINTER_TYPE_P (TREE_TYPE (name))); - r.set_nonzero (TREE_TYPE (name)); - } - } + // If this is a normal edge, apply any side effects. + if ((e->flags & (EDGE_EH | EDGE_ABNORMAL)) == 0) + m_exit.maybe_adjust_range (r, name, bb); + if (DEBUG_RANGE_CACHE) { fprintf (dump_file, "CACHE: Adjusted edge range for %d->%d : ", @@ -1530,12 +1414,9 @@ ranger_cache::range_from_dom (irange &r, tree name, basic_block start_bb, } // Apply non-null if appropriate. - if (non_null && r.varying_p () - && !has_abnormal_call_or_eh_pred_edge_p (start_bb)) - { - gcc_checking_assert (POINTER_TYPE_P (TREE_TYPE (name))); - r.set_nonzero (TREE_TYPE (name)); - } + if (!has_abnormal_call_or_eh_pred_edge_p (start_bb)) + r.intersect (side_effect); + if (DEBUG_RANGE_CACHE) { fprintf (dump_file, "CACHE: Range for DOM returns : "); @@ -1545,81 +1426,42 @@ ranger_cache::range_from_dom (irange &r, tree name, basic_block start_bb, return true; } -// This routine will update NAME in block BB to the nonnull state. -// It will then update the on-entry cache for this block to be non-null -// if it isn't already. +// This routine is used during a block walk to move the state of non-null for +// any operands on stmt S to nonnull. void -ranger_cache::update_to_nonnull (basic_block bb, tree name) +ranger_cache::apply_side_effects (gimple *s) { - tree type = TREE_TYPE (name); - if (gimple_range_ssa_p (name) && POINTER_TYPE_P (type)) - { - m_non_null.set_nonnull (bb, name); - // Update the on-entry cache for BB to be non-zero. Note this can set - // the on entry value in the DEF block, which can override the def. - int_range_max r; - exit_range (r, name, bb, RFD_READ_ONLY); - if (r.varying_p ()) - { - r.set_nonzero (type); - m_on_entry.set_bb_range (name, bb, r); - } - } -} + int_range_max r; + bool update = true; -// Adapted from infer_nonnull_range_by_dereference and check_loadstore -// to process nonnull ssa_name OP in S. DATA contains the ranger_cache. + basic_block bb = gimple_bb (s); + stmt_side_effects se(s); + if (se.num () == 0) + return; -static bool -non_null_loadstore (gimple *s, tree op, tree, void *data) -{ - if (TREE_CODE (op) == MEM_REF || TREE_CODE (op) == TARGET_MEM_REF) + // Do not update the on-netry cache for block ending stmts. + if (stmt_ends_bb_p (s)) { - /* Some address spaces may legitimately dereference zero. */ - addr_space_t as = TYPE_ADDR_SPACE (TREE_TYPE (op)); - if (!targetm.addr_space.zero_address_valid (as)) - { - tree ssa = TREE_OPERAND (op, 0); - basic_block bb = gimple_bb (s); - ((ranger_cache *)data)->update_to_nonnull (bb, ssa); - } + edge_iterator ei; + edge e; + FOR_EACH_EDGE (e, ei, gimple_bb (s)->succs) + if (!(e->flags & (EDGE_ABNORMAL|EDGE_EH))) + break; + if (e == NULL) + update = false; } - return false; -} - -// This routine is used during a block walk to move the state of non-null for -// any operands on stmt S to nonnull. -void -ranger_cache::block_apply_nonnull (gimple *s) -{ - if (!flag_delete_null_pointer_checks) - return; - if (is_a<gphi *> (s)) - return; - if (gimple_code (s) == GIMPLE_ASM || gimple_clobber_p (s)) - return; - if (is_a<gcall *> (s)) + for (unsigned x = 0; x < se.num (); x++) { - tree fntype = gimple_call_fntype (s); - bitmap nonnullargs = get_nonnull_args (fntype); - // Process any non-null arguments - if (nonnullargs) + tree name = se.name (x); + m_exit.add_range (name, bb, se.range (x)); + if (update) { - basic_block bb = gimple_bb (s); - for (unsigned i = 0; i < gimple_call_num_args (s); i++) - { - if (bitmap_empty_p (nonnullargs) || bitmap_bit_p (nonnullargs, i)) - { - tree op = gimple_call_arg (s, i); - update_to_nonnull (bb, op); - } - } - BITMAP_FREE (nonnullargs); + if (!m_on_entry.get_bb_range (r, name, bb)) + exit_range (r, name, bb, RFD_READ_ONLY); + if (r.intersect (se.range (x))) + m_on_entry.set_bb_range (name, bb, r); } - // Fallthru and walk load/store ops now. } - walk_stmt_load_store_ops (s, (void *)this, non_null_loadstore, - non_null_loadstore); } diff --git a/gcc/gimple-range-cache.h b/gcc/gimple-range-cache.h index 560403b..42aa41b 100644 --- a/gcc/gimple-range-cache.h +++ b/gcc/gimple-range-cache.h @@ -22,56 +22,7 @@ along with GCC; see the file COPYING3. If not see #define GCC_SSA_RANGE_CACHE_H #include "gimple-range-gori.h" - -// Class used to track non-null references of an SSA name. A vector -// of bitmaps indexed by SSA name is maintained. When indexed by -// basic block, an on-bit indicates there is a non-null dereference -// for that SSA in that block. - -class non_null_ref -{ -public: - non_null_ref (); - ~non_null_ref (); - bool non_null_deref_p (tree name, basic_block bb, bool search_dom = true); - bool adjust_range (irange &r, tree name, basic_block bb, - bool search_dom = true); - bool set_nonnull (basic_block bb, tree name); -private: - vec <bitmap> m_nn; - void process_name (tree name); - bitmap_obstack m_bitmaps; -}; - -// If NAME has a non-null dereference in block BB, adjust R with the -// non-zero information from non_null_deref_p, and return TRUE. If -// SEARCH_DOM is true, non_null_deref_p should search the dominator tree. - -inline bool -non_null_ref::adjust_range (irange &r, tree name, basic_block bb, - bool search_dom) -{ - // Non-call exceptions mean we could throw in the middle of the - // block, so just punt on those for now. - if (cfun->can_throw_non_call_exceptions) - return false; - // We only care about the null / non-null property of pointers. - if (!POINTER_TYPE_P (TREE_TYPE (name))) - return false; - if (r.undefined_p () || r.lower_bound () != 0 || r.upper_bound () == 0) - return false; - // Check if pointers have any non-null dereferences. - if (non_null_deref_p (name, bb, search_dom)) - { - // Remove zero from the range. - gcc_checking_assert (TYPE_UNSIGNED (TREE_TYPE (name))); - int_range<2> nz; - nz.set_nonzero (TREE_TYPE (name)); - r.intersect (nz); - return true; - } - return false; -} +#include "gimple-range-side-effect.h" // This class manages a vector of pointers to ssa_block ranges. It // provides the basis for the "range on entry" cache for all @@ -123,7 +74,7 @@ private: class ranger_cache : public range_query { public: - ranger_cache (int not_executable_flag); + ranger_cache (int not_executable_flag, bool use_imm_uses); ~ranger_cache (); virtual bool range_of_expr (irange &r, tree name, gimple *stmt); @@ -136,10 +87,9 @@ public: void propagate_updated_value (tree name, basic_block bb); - void block_apply_nonnull (gimple *s); - void update_to_nonnull (basic_block bb, tree name); - non_null_ref m_non_null; + void apply_side_effects (gimple *s); gori_compute m_gori; + side_effect_manager m_exit; void dump_bb (FILE *f, basic_block bb); virtual void dump (FILE *f) OVERRIDE; diff --git a/gcc/gimple-range-path.cc b/gcc/gimple-range-path.cc index ff39833..459d379 100644 --- a/gcc/gimple-range-path.cc +++ b/gcc/gimple-range-path.cc @@ -357,8 +357,8 @@ path_range_query::range_defined_in_block (irange &r, tree name, basic_block bb) r.set_varying (TREE_TYPE (name)); } - if (bb) - m_non_null.adjust_range (r, name, bb, false); + if (bb && POINTER_TYPE_P (TREE_TYPE (name))) + m_ranger->m_cache.m_exit.maybe_adjust_range (r, name, bb); if (DEBUG_SOLVER && (bb || !r.varying_p ())) { @@ -528,7 +528,7 @@ path_range_query::adjust_for_non_null_uses (basic_block bb) else r.set_varying (TREE_TYPE (name)); - if (m_non_null.adjust_range (r, name, bb, false)) + if (m_ranger->m_cache.m_exit.maybe_adjust_range (r, name, bb)) set_cache (r, name); } } diff --git a/gcc/gimple-range-path.h b/gcc/gimple-range-path.h index 1820626..914983b 100644 --- a/gcc/gimple-range-path.h +++ b/gcc/gimple-range-path.h @@ -91,7 +91,6 @@ private: auto_bitmap m_imports; gimple_ranger *m_ranger; - non_null_ref m_non_null; // Current path position. unsigned m_pos; diff --git a/gcc/gimple-range-side-effect.cc b/gcc/gimple-range-side-effect.cc new file mode 100644 index 0000000..2c8c77d --- /dev/null +++ b/gcc/gimple-range-side-effect.cc @@ -0,0 +1,310 @@ +/* Gimple range side effect implementation. + Copyright (C) 2022 Free Software Foundation, Inc. + Contributed by Andrew MacLeod <amacleod@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/>. */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "backend.h" +#include "insn-codes.h" +#include "tree.h" +#include "gimple.h" +#include "ssa.h" +#include "gimple-pretty-print.h" +#include "gimple-range.h" +#include "tree-cfg.h" +#include "target.h" +#include "attribs.h" +#include "gimple-iterator.h" +#include "gimple-walk.h" +#include "cfganal.h" + +// Adapted from infer_nonnull_range_by_dereference and check_loadstore +// to process nonnull ssa_name OP in S. DATA contains a pointer to a +// stmt side effects instance. + +static bool +non_null_loadstore (gimple *, tree op, tree, void *data) +{ + if (TREE_CODE (op) == MEM_REF || TREE_CODE (op) == TARGET_MEM_REF) + { + /* Some address spaces may legitimately dereference zero. */ + addr_space_t as = TYPE_ADDR_SPACE (TREE_TYPE (op)); + if (!targetm.addr_space.zero_address_valid (as)) + { + tree ssa = TREE_OPERAND (op, 0); + ((stmt_side_effects *)data)->add_nonzero (ssa); + } + } + return false; +} + +// Add NAME and RANGE to the the side effect summary. + +void +stmt_side_effects::add_range (tree name, irange &range) +{ + m_names[num_args] = name; + m_ranges[num_args] = range; + if (num_args < size_limit - 1) + num_args++; +} + +// Add a nonzero range for NAME to the side effect summary. + +void +stmt_side_effects::add_nonzero (tree name) +{ + if (!gimple_range_ssa_p (name)) + return; + int_range<2> nz; + nz.set_nonzero (TREE_TYPE (name)); + add_range (name, nz); +} + +// Process S for side effects and fill in the summary list. +// This is the routine where new side effects should be added. + +stmt_side_effects::stmt_side_effects (gimple *s) +{ + num_args = 0; + + if (is_a<gphi *> (s)) + return; + + if (is_a<gcall *> (s) && flag_delete_null_pointer_checks) + { + tree fntype = gimple_call_fntype (s); + bitmap nonnullargs = get_nonnull_args (fntype); + // Process any non-null arguments + if (nonnullargs) + { + for (unsigned i = 0; i < gimple_call_num_args (s); i++) + { + if (bitmap_empty_p (nonnullargs) + || bitmap_bit_p (nonnullargs, i)) + { + tree op = gimple_call_arg (s, i); + if (POINTER_TYPE_P (TREE_TYPE (op))) + add_nonzero (op); + } + } + BITMAP_FREE (nonnullargs); + } + // Fallthru and walk load/store ops now. + } + + // Look for possible non-null values. + if (flag_delete_null_pointer_checks && gimple_code (s) != GIMPLE_ASM + && !gimple_clobber_p (s)) + walk_stmt_load_store_ops (s, (void *)this, non_null_loadstore, + non_null_loadstore); + +} + +// ------------------------------------------------------------------------- + +// This class is an element in list of side effect ranges. + +class exit_range +{ +public: + tree name; + irange *range; + exit_range *next; +}; + +// If there is an element which matches SSA, return a pointer to the element. +// Otherwise return NULL. + +exit_range * +side_effect_manager::exit_range_head::find_ptr (tree ssa) +{ + // Return NULL if SSA is not in this list. + if (!m_names || !bitmap_bit_p (m_names, SSA_NAME_VERSION (ssa))) + return NULL; + for (exit_range *ptr = head; ptr != NULL; ptr = ptr->next) + if (ptr->name == ssa) + return ptr; + // Should be unreachable. + gcc_unreachable (); + return NULL; +} + +// Construct a side effects manager. DO_SEARCH indicates whether an immediate +// use scan should be made the first time a name is processed. This is for +// on-demand clients who may not visit every statement and may miss uses. + +side_effect_manager::side_effect_manager (bool do_search) +{ + bitmap_obstack_initialize (&m_bitmaps); + m_on_exit.create (0); + m_on_exit.safe_grow_cleared (last_basic_block_for_fn (cfun) + 1); + // m_seen == NULL indicates no scanning. Otherwise the bit indicates a + // scan has been performed on NAME. + if (do_search) + m_seen = BITMAP_ALLOC (&m_bitmaps); + else + m_seen = NULL; + obstack_init (&m_list_obstack); + // Non-zero elements are very common, so cache them for each ssa-name. + m_nonzero.create (0); + m_nonzero.safe_grow_cleared (num_ssa_names + 1); +} + +// Destruct a side effects manager. + +side_effect_manager::~side_effect_manager () +{ + m_nonzero.release (); + obstack_free (&m_list_obstack, NULL); + m_on_exit.release (); + bitmap_obstack_release (&m_bitmaps); +} + +// Return a non-zero range value of the appropriate type for NAME from +// the cache, creating it if necessary. + +const irange& +side_effect_manager::get_nonzero (tree name) +{ + unsigned v = SSA_NAME_VERSION (name); + if (v >= m_nonzero.length ()) + m_nonzero.safe_grow_cleared (num_ssa_names + 20); + if (!m_nonzero[v]) + { + m_nonzero[v] = m_range_allocator.allocate (2); + m_nonzero[v]->set_nonzero (TREE_TYPE (name)); + } + return *(m_nonzero[v]); +} + +// Return TRUE if NAME has a side effect range in block BB. + +bool +side_effect_manager::has_range_p (tree name, basic_block bb) +{ + // Check if this is an immediate use search model. + if (m_seen && !bitmap_bit_p (m_seen, SSA_NAME_VERSION (name))) + register_all_uses (name); + + if (bb->index >= (int)m_on_exit.length ()) + return false; + if (!m_on_exit[bb->index].m_names) + return false; + if (!bitmap_bit_p (m_on_exit[bb->index].m_names, SSA_NAME_VERSION (name))) + return false; + return true; +} + +// Return TRUE if NAME has a side effect range in block BB, and adjust range R +// to include it. + +bool +side_effect_manager::maybe_adjust_range (irange &r, tree name, basic_block bb) +{ + if (!has_range_p (name, bb)) + return false; + exit_range *ptr = m_on_exit[bb->index].find_ptr (name); + gcc_checking_assert (ptr); + // Return true if this exit range changes R, otherwise false. + return r.intersect (*(ptr->range)); +} + +// Add range R as a side effect for NAME in block BB. + +void +side_effect_manager::add_range (tree name, basic_block bb, const irange &r) +{ + if (bb->index >= (int)m_on_exit.length ()) + m_on_exit.safe_grow_cleared (last_basic_block_for_fn (cfun) + 1); + + // Create the summary list bitmap if it doesn't exist. + if (!m_on_exit[bb->index].m_names) + m_on_exit[bb->index].m_names = BITMAP_ALLOC (&m_bitmaps); + + if (dump_file && (dump_flags & TDF_DETAILS)) + { + fprintf (dump_file, " on-exit update "); + print_generic_expr (dump_file, name, TDF_SLIM); + fprintf (dump_file, " in BB%d : ",bb->index); + r.dump (dump_file); + fprintf (dump_file, "\n"); + } + + // If NAME already has a range, intersect them and done. + exit_range *ptr = m_on_exit[bb->index].find_ptr (name); + if (ptr) + { + int_range_max cur = r; + // If no new info is added, just return. + if (!cur.intersect (*(ptr->range))) + return; + if (ptr->range->fits_p (cur)) + *(ptr->range) = cur; + else + ptr->range = m_range_allocator.allocate (cur); + return; + } + + // Otherwise create a record. + bitmap_set_bit (m_on_exit[bb->index].m_names, SSA_NAME_VERSION (name)); + ptr = (exit_range *)obstack_alloc (&m_list_obstack, sizeof (exit_range)); + ptr->range = m_range_allocator.allocate (r); + ptr->name = name; + ptr->next = m_on_exit[bb->index].head; + m_on_exit[bb->index].head = ptr; +} + +// Add a non-zero side effect for NAME in block BB. + +void +side_effect_manager::add_nonzero (tree name, basic_block bb) +{ + add_range (name, bb, get_nonzero (name)); +} + +// Follow immediate use chains and find all side effects for NAME. + +void +side_effect_manager::register_all_uses (tree name) +{ + gcc_checking_assert (m_seen); + + // Check if we've already processed this name. + unsigned v = SSA_NAME_VERSION (name); + if (bitmap_bit_p (m_seen, v)) + return; + bitmap_set_bit (m_seen, v); + + use_operand_p use_p; + imm_use_iterator iter; + + // Loop over each immediate use and see if it has a side effect. + FOR_EACH_IMM_USE_FAST (use_p, iter, name) + { + gimple *s = USE_STMT (use_p); + stmt_side_effects se (s); + for (unsigned x = 0; x < se.num (); x++) + { + if (name == se.name (x)) + add_range (name, gimple_bb (s), se.range (x)); + } + } +} diff --git a/gcc/gimple-range-side-effect.h b/gcc/gimple-range-side-effect.h new file mode 100644 index 0000000..848d94b --- /dev/null +++ b/gcc/gimple-range-side-effect.h @@ -0,0 +1,82 @@ +/* Header file for gimple range side effects. + Copyright (C) 2022 Free Software Foundation, Inc. + Contributed by Andrew MacLeod <amacleod@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_GIMPLE_RANGE_SIDE_H +#define GCC_GIMPLE_RANGE_SIDE_H + +// This class manages an on-demand summary of side effects for a statement. +// It can be instantiated as required and provides a list of side effects. + +// New side effects should added in the constructor of this class. + +class stmt_side_effects +{ +public: + stmt_side_effects (gimple *s); + inline unsigned num () const { return num_args; } + inline tree name (unsigned index) const + { gcc_checking_assert (index < num_args); return m_names[index]; } + inline const irange& range (unsigned index) const + { gcc_checking_assert (index < num_args); return m_ranges[index]; } + void add_range (tree name, irange &range); + void add_nonzero (tree name); +private: + unsigned num_args; + static const int size_limit = 10; + tree m_names[size_limit]; + int_range<3> m_ranges[size_limit]; + inline void bump_index () { if (num_args < size_limit - 1) num_args++; } +}; + +// This class manages a list of side effect ranges for each basic block. +// As side effects are seen, they can be registered to a block and later +// queried. WHen constructed with a TRUE flag, immediate uses chains are +// followed the first time a name is referenced and block populated if +// thre are any side effects. + +class side_effect_manager +{ +public: + side_effect_manager (bool do_search); + ~side_effect_manager (); + void add_range (tree name, basic_block bb, const irange &r); + void add_nonzero (tree name, basic_block bb); + bool has_range_p (tree name, basic_block bb); + bool maybe_adjust_range (irange &r, tree name, basic_block bb); +private: + class exit_range_head + { + public: + bitmap m_names; // list of names with an outgoing range. + class exit_range *head; + int m_num_ranges; + exit_range *find_ptr (tree name); + }; + void register_all_uses (tree name); + vec <exit_range_head> m_on_exit; + const irange &get_nonzero (tree name); + vec <irange *> m_nonzero; + bitmap m_seen; + bitmap_obstack m_bitmaps; + struct obstack m_list_obstack; + irange_allocator m_range_allocator; +}; + +#endif // GCC_GIMPLE_RANGE_SIDE_H diff --git a/gcc/gimple-range.cc b/gcc/gimple-range.cc index 1fdee02..f5e9e77 100644 --- a/gcc/gimple-range.cc +++ b/gcc/gimple-range.cc @@ -37,9 +37,9 @@ along with GCC; see the file COPYING3. If not see #include "gimple-fold.h" #include "gimple-walk.h" -gimple_ranger::gimple_ranger () : +gimple_ranger::gimple_ranger (bool use_imm_uses) : non_executable_edge_flag (cfun), - m_cache (non_executable_edge_flag), + m_cache (non_executable_edge_flag, use_imm_uses), tracer (""), current_bb (NULL) { @@ -118,9 +118,11 @@ gimple_ranger::range_of_expr (irange &r, tree expr, gimple *stmt) // If name is defined in this block, try to get an range from S. if (def_stmt && gimple_bb (def_stmt) == bb) { - // Check for a definition override from a block walk. - if (!POINTER_TYPE_P (TREE_TYPE (expr)) - || !m_cache.block_range (r, bb, expr, false)) + // Declared in ths block, if it has a global set, check for an + // override from a block walk, otherwise calculate it. + if (m_cache.get_global_range (r, expr)) + m_cache.block_range (r, bb, expr, false); + else range_of_stmt (r, def_stmt, expr); } // Otherwise OP comes from outside this block, use range on entry. @@ -154,13 +156,6 @@ gimple_ranger::range_on_entry (irange &r, basic_block bb, tree name) if (m_cache.block_range (entry_range, bb, name)) r.intersect (entry_range); - if (dom_info_available_p (CDI_DOMINATORS)) - { - basic_block dom_bb = get_immediate_dominator (CDI_DOMINATORS, bb); - if (dom_bb) - m_cache.m_non_null.adjust_range (r, name, dom_bb, true); - } - if (idx) tracer.trailer (idx, "range_on_entry", true, name, r); } @@ -237,7 +232,7 @@ gimple_ranger::range_on_edge (irange &r, edge e, tree name) range_on_exit (r, e->src, name); // If this is not an abnormal edge, check for a non-null exit . if ((e->flags & (EDGE_EH | EDGE_ABNORMAL)) == 0) - m_cache.m_non_null.adjust_range (r, name, e->src, false); + m_cache.m_exit.maybe_adjust_range (r, name, e->src); gcc_checking_assert (r.undefined_p () || range_compatible_p (r.type(), TREE_TYPE (name))); @@ -480,7 +475,7 @@ gimple_ranger::register_side_effects (gimple *s) fputc ('\n', dump_file); } } - m_cache.block_apply_nonnull (s); + m_cache.apply_side_effects (s); } // This routine will export whatever global ranges are known to GCC @@ -625,12 +620,12 @@ gimple_ranger::debug () resources. */ gimple_ranger * -enable_ranger (struct function *fun) +enable_ranger (struct function *fun, bool use_imm_uses) { gimple_ranger *r; gcc_checking_assert (!fun->x_range_query); - r = new gimple_ranger; + r = new gimple_ranger (use_imm_uses); fun->x_range_query = r; return r; diff --git a/gcc/gimple-range.h b/gcc/gimple-range.h index 0733a53..ae6c402 100644 --- a/gcc/gimple-range.h +++ b/gcc/gimple-range.h @@ -46,7 +46,7 @@ along with GCC; see the file COPYING3. If not see class gimple_ranger : public range_query { public: - gimple_ranger (); + gimple_ranger (bool use_imm_uses = true); ~gimple_ranger (); virtual bool range_of_stmt (irange &r, gimple *, tree name = NULL) OVERRIDE; virtual bool range_of_expr (irange &r, tree name, gimple * = NULL) OVERRIDE; @@ -69,12 +69,15 @@ protected: range_tracer tracer; basic_block current_bb; vec<tree> m_stmt_list; + friend class path_range_query; }; /* Create a new ranger instance and associate it with a function. Each call must be paired with a call to disable_ranger to release - resources. */ -extern gimple_ranger *enable_ranger (struct function *); + resources. If USE_IMM_USES is true, pre-calculate sideffects like + non-null uses as required using the immediate use chains. */ +extern gimple_ranger *enable_ranger (struct function *m, + bool use_imm_uses = true); extern void disable_ranger (struct function *); #endif // GCC_GIMPLE_RANGE_H diff --git a/gcc/gimple-ssa-sprintf.cc b/gcc/gimple-ssa-sprintf.cc index 961c1b7..8202129 100644 --- a/gcc/gimple-ssa-sprintf.cc +++ b/gcc/gimple-ssa-sprintf.cc @@ -1953,7 +1953,7 @@ format_floating (const directive &dir, tree arg, pointer_query &) &res.range.min, &res.range.max }; - for (int i = 0; i != sizeof minmax / sizeof *minmax; ++i) + for (int i = 0; i != ARRAY_SIZE (minmax); ++i) { /* Convert the GCC real value representation with the precision of the real type to the mpfr_t format rounding down in the diff --git a/gcc/gimple-ssa-warn-access.cc b/gcc/gimple-ssa-warn-access.cc index c420424..9357a4e 100644 --- a/gcc/gimple-ssa-warn-access.cc +++ b/gcc/gimple-ssa-warn-access.cc @@ -2853,7 +2853,7 @@ memmodel_name (unsigned HOST_WIDE_INT val) { val = memmodel_base (val); - for (unsigned i = 0; i != sizeof memory_models / sizeof *memory_models; ++i) + for (unsigned i = 0; i != ARRAY_SIZE (memory_models); ++i) { if (val == memory_models[i].modval) return memory_models[i].modname; diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc index 2f6d995..260993b 100644 --- a/gcc/gimplify.cc +++ b/gcc/gimplify.cc @@ -8270,9 +8270,9 @@ gimplify_omp_depend (tree *list_p, gimple_seq *pre_p) { tree c; gimple *g; - size_t n[4] = { 0, 0, 0, 0 }; - bool unused[4]; - tree counts[4] = { NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE }; + size_t n[5] = { 0, 0, 0, 0, 0 }; + bool unused[5]; + tree counts[5] = { NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE }; tree last_iter = NULL_TREE, last_count = NULL_TREE; size_t i, j; location_t first_loc = UNKNOWN_LOCATION; @@ -8295,6 +8295,9 @@ gimplify_omp_depend (tree *list_p, gimple_seq *pre_p) case OMP_CLAUSE_DEPEND_DEPOBJ: i = 3; break; + case OMP_CLAUSE_DEPEND_INOUTSET: + i = 4; + break; case OMP_CLAUSE_DEPEND_SOURCE: case OMP_CLAUSE_DEPEND_SINK: continue; @@ -8400,14 +8403,14 @@ gimplify_omp_depend (tree *list_p, gimple_seq *pre_p) else n[i]++; } - for (i = 0; i < 4; i++) + for (i = 0; i < 5; i++) if (counts[i]) break; - if (i == 4) + if (i == 5) return 0; tree total = size_zero_node; - for (i = 0; i < 4; i++) + for (i = 0; i < 5; i++) { unused[i] = counts[i] == NULL_TREE && n[i] == 0; if (counts[i] == NULL_TREE) @@ -8423,9 +8426,12 @@ gimplify_omp_depend (tree *list_p, gimple_seq *pre_p) if (gimplify_expr (&total, pre_p, NULL, is_gimple_val, fb_rvalue) == GS_ERROR) return 2; - bool is_old = unused[1] && unused[3]; + bool is_old = unused[1] && unused[3] && unused[4]; tree totalpx = size_binop (PLUS_EXPR, unshare_expr (total), size_int (is_old ? 1 : 4)); + if (!unused[4]) + totalpx = size_binop (PLUS_EXPR, totalpx, + size_binop (MULT_EXPR, counts[4], size_int (2))); tree type = build_array_type (ptr_type_node, build_index_type (totalpx)); tree array = create_tmp_var_raw (type); TREE_ADDRESSABLE (array) = 1; @@ -8471,11 +8477,11 @@ gimplify_omp_depend (tree *list_p, gimple_seq *pre_p) gimplify_and_add (tem, pre_p); } - tree cnts[4]; - for (j = 4; j; j--) + tree cnts[6]; + for (j = 5; j; j--) if (!unused[j - 1]) break; - for (i = 0; i < 4; i++) + for (i = 0; i < 5; i++) { if (i && (i >= j || unused[i - 1])) { @@ -8499,6 +8505,15 @@ gimplify_omp_depend (tree *list_p, gimple_seq *pre_p) } gimple_seq_add_stmt (pre_p, g); } + if (unused[4]) + cnts[5] = NULL_TREE; + else + { + tree t = size_binop (PLUS_EXPR, total, size_int (5)); + cnts[5] = create_tmp_var (sizetype); + g = gimple_build_assign (cnts[i], t); + gimple_seq_add_stmt (pre_p, g); + } last_iter = NULL_TREE; tree last_bind = NULL_TREE; @@ -8521,6 +8536,9 @@ gimplify_omp_depend (tree *list_p, gimple_seq *pre_p) case OMP_CLAUSE_DEPEND_DEPOBJ: i = 3; break; + case OMP_CLAUSE_DEPEND_INOUTSET: + i = 4; + break; case OMP_CLAUSE_DEPEND_SOURCE: case OMP_CLAUSE_DEPEND_SINK: continue; @@ -8625,14 +8643,42 @@ gimplify_omp_depend (tree *list_p, gimple_seq *pre_p) return 2; if (TREE_VALUE (t) != null_pointer_node) TREE_VALUE (t) = build_fold_addr_expr (TREE_VALUE (t)); + if (i == 4) + { + r = build4 (ARRAY_REF, ptr_type_node, array, cnts[i], + NULL_TREE, NULL_TREE); + tree r2 = build4 (ARRAY_REF, ptr_type_node, array, cnts[5], + NULL_TREE, NULL_TREE); + r2 = build_fold_addr_expr_with_type (r2, ptr_type_node); + tem = build2_loc (OMP_CLAUSE_LOCATION (c), MODIFY_EXPR, + void_type_node, r, r2); + append_to_statement_list_force (tem, last_body); + tem = build2_loc (OMP_CLAUSE_LOCATION (c), MODIFY_EXPR, + void_type_node, cnts[i], + size_binop (PLUS_EXPR, cnts[i], + size_int (1))); + append_to_statement_list_force (tem, last_body); + i = 5; + } r = build4 (ARRAY_REF, ptr_type_node, array, cnts[i], NULL_TREE, NULL_TREE); tem = build2_loc (OMP_CLAUSE_LOCATION (c), MODIFY_EXPR, void_type_node, r, TREE_VALUE (t)); append_to_statement_list_force (tem, last_body); + if (i == 5) + { + r = build4 (ARRAY_REF, ptr_type_node, array, + size_binop (PLUS_EXPR, cnts[i], size_int (1)), + NULL_TREE, NULL_TREE); + tem = build_int_cst (ptr_type_node, GOMP_DEPEND_INOUTSET); + tem = build2_loc (OMP_CLAUSE_LOCATION (c), MODIFY_EXPR, + void_type_node, r, tem); + append_to_statement_list_force (tem, last_body); + } tem = build2_loc (OMP_CLAUSE_LOCATION (c), MODIFY_EXPR, void_type_node, cnts[i], - size_binop (PLUS_EXPR, cnts[i], size_int (1))); + size_binop (PLUS_EXPR, cnts[i], + size_int (1 + (i == 5)))); append_to_statement_list_force (tem, last_body); TREE_VALUE (t) = null_pointer_node; } @@ -8656,12 +8702,38 @@ gimplify_omp_depend (tree *list_p, gimple_seq *pre_p) if (gimplify_expr (&OMP_CLAUSE_DECL (c), pre_p, NULL, is_gimple_val, fb_rvalue) == GS_ERROR) return 2; + if (i == 4) + { + r = build4 (ARRAY_REF, ptr_type_node, array, cnts[i], + NULL_TREE, NULL_TREE); + tree r2 = build4 (ARRAY_REF, ptr_type_node, array, cnts[5], + NULL_TREE, NULL_TREE); + r2 = build_fold_addr_expr_with_type (r2, ptr_type_node); + tem = build2 (MODIFY_EXPR, void_type_node, r, r2); + gimplify_and_add (tem, pre_p); + g = gimple_build_assign (cnts[i], size_binop (PLUS_EXPR, + cnts[i], + size_int (1))); + gimple_seq_add_stmt (pre_p, g); + i = 5; + } r = build4 (ARRAY_REF, ptr_type_node, array, cnts[i], NULL_TREE, NULL_TREE); tem = build2 (MODIFY_EXPR, void_type_node, r, OMP_CLAUSE_DECL (c)); gimplify_and_add (tem, pre_p); - g = gimple_build_assign (cnts[i], size_binop (PLUS_EXPR, cnts[i], - size_int (1))); + if (i == 5) + { + r = build4 (ARRAY_REF, ptr_type_node, array, + size_binop (PLUS_EXPR, cnts[i], size_int (1)), + NULL_TREE, NULL_TREE); + tem = build_int_cst (ptr_type_node, GOMP_DEPEND_INOUTSET); + tem = build2 (MODIFY_EXPR, void_type_node, r, tem); + append_to_statement_list_force (tem, last_body); + gimplify_and_add (tem, pre_p); + } + g = gimple_build_assign (cnts[i], + size_binop (PLUS_EXPR, cnts[i], + size_int (1 + (i == 5)))); gimple_seq_add_stmt (pre_p, g); } } @@ -8685,7 +8757,7 @@ gimplify_omp_depend (tree *list_p, gimple_seq *pre_p) else { tree prev = size_int (5); - for (i = 0; i < 4; i++) + for (i = 0; i < 5; i++) { if (unused[i]) continue; diff --git a/gcc/go/gofrontend/MERGE b/gcc/go/gofrontend/MERGE index daa725f..2cf7141 100644 --- a/gcc/go/gofrontend/MERGE +++ b/gcc/go/gofrontend/MERGE @@ -1,4 +1,4 @@ -f5bc28a30b7503015bbef38afb5812313184e822 +0058658a9efb6e5c5faa6f0f65949beea5ddbc98 The first line of this file holds the git revision number of the last merge done from the gofrontend repository. diff --git a/gcc/go/gofrontend/export.cc b/gcc/go/gofrontend/export.cc index 70d3f70..a30b11a 100644 --- a/gcc/go/gofrontend/export.cc +++ b/gcc/go/gofrontend/export.cc @@ -124,6 +124,11 @@ class Collect_export_references : public Traverse void prepare_types(const std::vector<Named_object*>& sorted_exports); + // Third entry point (called after the method above), to find + // all types in expressions referenced by exports. + void + prepare_expressions(const std::vector<Named_object*>& sorted_exports); + protected: // Override of parent class method. int @@ -281,6 +286,28 @@ Collect_export_references::expression(Expression** pexpr) return TRAVERSE_CONTINUE; } +// Collect up the set of types mentioned in expressions of things we're exporting, +// and collect all the packages encountered during type traversal, to make sure +// we can declare things referered to indirectly (for example, in the body of an +// exported inline function from another package). + +void +Collect_export_references::prepare_expressions(const std::vector<Named_object*>& sorted_exports) +{ + for (std::vector<Named_object*>::const_iterator p = sorted_exports.begin(); + p != sorted_exports.end(); + ++p) + { + Named_object* no = *p; + if (no->classification() == Named_object::NAMED_OBJECT_CONST) + { + Expression* e = no->const_value()->expr(); + if (e != NULL) + Expression::traverse(&e, this); + } + } +} + // Collect up the set of types mentioned in things we're exporting, and collect // all the packages encountered during type traversal, to make sure we can // declare things referered to indirectly (for example, in the body of an @@ -891,6 +918,7 @@ Export::export_globals(const std::string& package_name, // Collect up the set of types mentioned in things we're exporting, // and any packages that may be referred to indirectly. collect.prepare_types(sorted_exports); + collect.prepare_expressions(sorted_exports); // Assign indexes to all exported types and types referenced by // things we're exporting. Return value is index of first non-exported diff --git a/gcc/go/gofrontend/statements.cc b/gcc/go/gofrontend/statements.cc index 95fa3c4..b3db843 100644 --- a/gcc/go/gofrontend/statements.cc +++ b/gcc/go/gofrontend/statements.cc @@ -1260,6 +1260,16 @@ Assignment_operation_statement::do_lower(Gogo*, Named_object*, Move_ordered_evals moe(b); this->lhs_->traverse_subexpressions(&moe); + // We can still be left with subexpressions that have to be loaded + // even if they don't have side effects themselves, in case the RHS + // changes variables named on the LHS. + int i; + if (this->lhs_->must_eval_subexpressions_in_order(&i)) + { + Move_subexpressions ms(i, b); + this->lhs_->traverse_subexpressions(&ms); + } + Expression* lval = this->lhs_->copy(); Operator op; diff --git a/gcc/godump.cc b/gcc/godump.cc index 6691688..c0f52bb 100644 --- a/gcc/godump.cc +++ b/gcc/godump.cc @@ -1114,6 +1114,7 @@ go_output_typedef (class godump_container *container, tree decl) struct macro_hash_value *mhval; void **slot; char buf[WIDE_INT_PRINT_BUFFER_SIZE]; + tree value = DECL_INITIAL (TREE_VALUE (element)); name = IDENTIFIER_POINTER (TREE_PURPOSE (element)); @@ -1127,12 +1128,12 @@ go_output_typedef (class godump_container *container, tree decl) if (*slot != NULL) macro_hash_del (*slot); - if (tree_fits_shwi_p (TREE_VALUE (element))) + if (tree_fits_shwi_p (value)) snprintf (buf, sizeof buf, HOST_WIDE_INT_PRINT_DEC, - tree_to_shwi (TREE_VALUE (element))); - else if (tree_fits_uhwi_p (TREE_VALUE (element))) + tree_to_shwi (value)); + else if (tree_fits_uhwi_p (value)) snprintf (buf, sizeof buf, HOST_WIDE_INT_PRINT_UNSIGNED, - tree_to_uhwi (TREE_VALUE (element))); + tree_to_uhwi (value)); else print_hex (wi::to_wide (element), buf); @@ -1326,7 +1327,7 @@ static void keyword_hash_init (class godump_container *container) { size_t i; - size_t count = sizeof (keywords) / sizeof (keywords[0]); + size_t count = ARRAY_SIZE (keywords); void **slot; for (i = 0; i < count; i++) diff --git a/gcc/graphite-isl-ast-to-gimple.cc b/gcc/graphite-isl-ast-to-gimple.cc index 45ed770..844b6d4 100644 --- a/gcc/graphite-isl-ast-to-gimple.cc +++ b/gcc/graphite-isl-ast-to-gimple.cc @@ -1014,7 +1014,7 @@ gsi_insert_earliest (gimple_seq seq) basic_block begin_bb = get_entry_bb (codegen_region); /* Inserting the gimple statements in a vector because gimple_seq behave - in strage ways when inserting the stmts from it into different basic + in strange ways when inserting the stmts from it into different basic blocks one at a time. */ auto_vec<gimple *, 3> stmts; for (gimple_stmt_iterator gsi = gsi_start (seq); !gsi_end_p (gsi); diff --git a/gcc/graphite-scop-detection.cc b/gcc/graphite-scop-detection.cc index 8c0ee99..9792d87 100644 --- a/gcc/graphite-scop-detection.cc +++ b/gcc/graphite-scop-detection.cc @@ -69,12 +69,27 @@ public: fprintf (output.dump_file, "%d", i); return output; } + friend debug_printer & operator<< (debug_printer &output, const char *s) { fprintf (output.dump_file, "%s", s); return output; } + + friend debug_printer & + operator<< (debug_printer &output, gimple* stmt) + { + print_gimple_stmt (output.dump_file, stmt, 0, TDF_VOPS | TDF_MEMSYMS); + return output; + } + + friend debug_printer & + operator<< (debug_printer &output, tree t) + { + print_generic_expr (output.dump_file, t, TDF_SLIM); + return output; + } } dp; #define DEBUG_PRINT(args) do \ @@ -506,6 +521,27 @@ scop_detection::merge_sese (sese_l first, sese_l second) const return combined; } +/* Print the loop numbers of the loops contained in SESE to FILE. */ + +static void +print_sese_loop_numbers (FILE *file, sese_l sese) +{ + bool first_loop = true; + for (loop_p nest = sese.entry->dest->loop_father; nest; nest = nest->next) + { + if (!loop_in_sese_p (nest, sese)) + break; + + for (auto loop : loops_list (cfun, LI_INCLUDE_ROOT, nest)) + { + gcc_assert (loop_in_sese_p (loop, sese)); + + fprintf (file, "%s%d", first_loop ? "" : ", ", loop->num); + first_loop = false; + } + } +} + /* Build scop outer->inner if possible. */ void @@ -519,6 +555,10 @@ scop_detection::build_scop_depth (loop_p loop) if (! next || harmful_loop_in_region (next)) { + if (next) + DEBUG_PRINT (dp << "[scop-detection] Discarding SCoP on loops "; + print_sese_loop_numbers (dump_file, next); + dp << " because of harmful loops\n"); if (s) add_scop (s); build_scop_depth (loop); @@ -560,14 +600,63 @@ scop_detection::can_represent_loop (loop_p loop, sese_l scop) || !single_pred_p (loop->latch) || exit->src != single_pred (loop->latch) || !empty_block_p (loop->latch)) - return false; + { + DEBUG_PRINT (dp << "[can_represent_loop-fail] Loop shape unsupported.\n"); + return false; + } + + bool edge_irreducible = (loop_preheader_edge (loop)->flags + & EDGE_IRREDUCIBLE_LOOP); + if (edge_irreducible) + { + DEBUG_PRINT (dp << "[can_represent_loop-fail] " + "Loop is not a natural loop.\n"); + return false; + } + + bool niter_is_unconditional = number_of_iterations_exit (loop, + single_exit (loop), + &niter_desc, false); + + if (!niter_is_unconditional) + { + DEBUG_PRINT (dp << "[can_represent_loop-fail] " + "Loop niter not unconditional.\n" + "Condition: " << niter_desc.assumptions << "\n"); + return false; + } + + niter = number_of_latch_executions (loop); + if (!niter) + { + DEBUG_PRINT (dp << "[can_represent_loop-fail] Loop niter unknown.\n"); + return false; + } + if (!niter_desc.control.no_overflow) + { + DEBUG_PRINT (dp << "[can_represent_loop-fail] Loop niter can overflow.\n"); + return false; + } - return !(loop_preheader_edge (loop)->flags & EDGE_IRREDUCIBLE_LOOP) - && number_of_iterations_exit (loop, single_exit (loop), &niter_desc, false) - && niter_desc.control.no_overflow - && (niter = number_of_latch_executions (loop)) - && !chrec_contains_undetermined (niter) - && graphite_can_represent_expr (scop, loop, niter); + bool undetermined_coefficients = chrec_contains_undetermined (niter); + if (undetermined_coefficients) + { + DEBUG_PRINT (dp << "[can_represent_loop-fail] " + "Loop niter chrec contains undetermined " + "coefficients.\n"); + return false; + } + + bool can_represent_expr = graphite_can_represent_expr (scop, loop, niter); + if (!can_represent_expr) + { + DEBUG_PRINT (dp << "[can_represent_loop-fail] " + << "Loop niter expression cannot be represented: " + << niter << "\n"); + return false; + } + + return true; } /* Return true when BEGIN is the preheader edge of a loop with a single exit @@ -640,6 +729,13 @@ scop_detection::add_scop (sese_l s) scops.safe_push (s); DEBUG_PRINT (dp << "[scop-detection] Adding SCoP: "; print_sese (dump_file, s)); + + if (dump_file && dump_flags & TDF_DETAILS) + { + fprintf (dump_file, "Loops in SCoP: "); + print_sese_loop_numbers (dump_file, s); + fprintf (dump_file, "\n"); + } } /* Return true when a statement in SCOP cannot be represented by Graphite. */ @@ -665,7 +761,12 @@ scop_detection::harmful_loop_in_region (sese_l scop) const /* The basic block should not be part of an irreducible loop. */ if (bb->flags & BB_IRREDUCIBLE_LOOP) - return true; + { + DEBUG_PRINT (dp << "[scop-detection-fail] Found bb in irreducible " + "loop.\n"); + + return true; + } /* Check for unstructured control flow: CFG not generated by structured if-then-else. */ @@ -676,7 +777,11 @@ scop_detection::harmful_loop_in_region (sese_l scop) const FOR_EACH_EDGE (e, ei, bb->succs) if (!dominated_by_p (CDI_POST_DOMINATORS, bb, e->dest) && !dominated_by_p (CDI_DOMINATORS, e->dest, bb)) - return true; + { + DEBUG_PRINT (dp << "[scop-detection-fail] Found unstructured " + "control flow.\n"); + return true; + } } /* Collect all loops in the current region. */ @@ -688,7 +793,11 @@ scop_detection::harmful_loop_in_region (sese_l scop) const for (gimple_stmt_iterator gsi = gsi_start_bb (bb); !gsi_end_p (gsi); gsi_next (&gsi)) if (!stmt_simple_for_scop_p (scop, gsi_stmt (gsi), bb)) - return true; + { + DEBUG_PRINT (dp << "[scop-detection-fail] " + "Found harmful statement.\n"); + return true; + } for (basic_block dom = first_dom_son (CDI_DOMINATORS, bb); dom; @@ -731,9 +840,10 @@ scop_detection::harmful_loop_in_region (sese_l scop) const && ! loop_nest_has_data_refs (loop)) { DEBUG_PRINT (dp << "[scop-detection-fail] loop_" << loop->num - << "does not have any data reference.\n"); + << " does not have any data reference.\n"); return true; } + DEBUG_PRINT (dp << "[scop-detection] loop_" << loop->num << " is harmless.\n"); } return false; @@ -922,7 +1032,21 @@ scop_detection::graphite_can_represent_expr (sese_l scop, loop_p loop, tree expr) { tree scev = cached_scalar_evolution_in_region (scop, loop, expr); - return graphite_can_represent_scev (scop, scev); + bool can_represent = graphite_can_represent_scev (scop, scev); + + if (!can_represent) + { + if (dump_file) + { + fprintf (dump_file, + "[graphite_can_represent_expr] Cannot represent scev \""); + print_generic_expr (dump_file, scev, TDF_SLIM); + fprintf (dump_file, "\" of expression "); + print_generic_expr (dump_file, expr, TDF_SLIM); + fprintf (dump_file, " in loop %d\n", loop->num); + } + } + return can_represent; } /* Return true if the data references of STMT can be represented by Graphite. @@ -938,7 +1062,11 @@ scop_detection::stmt_has_simple_data_refs_p (sese_l scop, gimple *stmt) auto_vec<data_reference_p> drs; if (! graphite_find_data_references_in_stmt (nest, loop, stmt, &drs)) - return false; + { + DEBUG_PRINT (dp << "[stmt_has_simple_data_refs_p] " + "Unanalyzable statement.\n"); + return false; + } int j; data_reference_p dr; @@ -946,7 +1074,12 @@ scop_detection::stmt_has_simple_data_refs_p (sese_l scop, gimple *stmt) { for (unsigned i = 0; i < DR_NUM_DIMENSIONS (dr); ++i) if (! graphite_can_represent_scev (scop, DR_ACCESS_FN (dr, i))) - return false; + { + DEBUG_PRINT (dp << "[stmt_has_simple_data_refs_p] " + "Cannot represent access function SCEV: " + << DR_ACCESS_FN (dr, i) << "\n"); + return false; + } } return true; @@ -1027,14 +1160,23 @@ scop_detection::stmt_simple_for_scop_p (sese_l scop, gimple *stmt, for (unsigned i = 0; i < 2; ++i) { tree op = gimple_op (stmt, i); - if (!graphite_can_represent_expr (scop, loop, op) - /* We can only constrain on integer type. */ - || ! INTEGRAL_TYPE_P (TREE_TYPE (op))) + if (!graphite_can_represent_expr (scop, loop, op)) + { + DEBUG_PRINT (dump_printf_loc (MSG_MISSED_OPTIMIZATION, stmt, + "[scop-detection-fail] " + "Graphite cannot represent cond " + "stmt operator expression.\n")); + DEBUG_PRINT (dp << op << "\n"); + return false; + } + + if (! INTEGRAL_TYPE_P (TREE_TYPE (op))) { - DEBUG_PRINT (dp << "[scop-detection-fail] " - << "Graphite cannot represent stmt:\n"; - print_gimple_stmt (dump_file, stmt, 0, - TDF_VOPS | TDF_MEMSYMS)); + DEBUG_PRINT (dump_printf_loc (MSG_MISSED_OPTIMIZATION, stmt, + "[scop-detection-fail] " + "Graphite cannot represent cond " + "statement operator. " + "Type must be integral.\n")); return false; } } diff --git a/gcc/graphite-sese-to-poly.cc b/gcc/graphite-sese-to-poly.cc index 5a6d779..51ba3af 100644 --- a/gcc/graphite-sese-to-poly.cc +++ b/gcc/graphite-sese-to-poly.cc @@ -100,14 +100,15 @@ extract_affine_mul (scop_p s, tree e, __isl_take isl_space *space) return isl_pw_aff_mul (lhs, rhs); } -/* Return an isl identifier from the name of the ssa_name E. */ +/* Return an isl identifier for the parameter P. */ static isl_id * -isl_id_for_ssa_name (scop_p s, tree e) +isl_id_for_parameter (scop_p s, tree p) { - char name1[14]; - snprintf (name1, sizeof (name1), "P_%d", SSA_NAME_VERSION (e)); - return isl_id_alloc (s->isl_context, name1, e); + gcc_checking_assert (TREE_CODE (p) == SSA_NAME); + char name[14]; + snprintf (name, sizeof (name), "P_%d", SSA_NAME_VERSION (p)); + return isl_id_alloc (s->isl_context, name, p); } /* Return an isl identifier for the data reference DR. Data references and @@ -648,14 +649,14 @@ build_poly_sr_1 (poly_bb_p pbb, gimple *stmt, tree var, enum poly_dr_type kind, isl_map *acc, isl_set *subscript_sizes) { scop_p scop = PBB_SCOP (pbb); - /* Each scalar variables has a unique alias set number starting from + /* Each scalar variable has a unique alias set number starting from the maximum alias set assigned to a dr. */ int alias_set = scop->max_alias_set + SSA_NAME_VERSION (var); subscript_sizes = isl_set_fix_si (subscript_sizes, isl_dim_set, 0, alias_set); /* Add a constrain to the ACCESSES polyhedron for the alias set of - data reference DR. */ + the reference. */ isl_constraint *c = isl_equality_alloc (isl_local_space_from_space (isl_map_get_space (acc))); c = isl_constraint_set_constant_si (c, -alias_set); @@ -898,15 +899,15 @@ build_scop_context (scop_p scop) isl_space *space = isl_space_set_alloc (scop->isl_context, nbp, 0); unsigned i; - tree e; - FOR_EACH_VEC_ELT (region->params, i, e) + tree p; + FOR_EACH_VEC_ELT (region->params, i, p) space = isl_space_set_dim_id (space, isl_dim_param, i, - isl_id_for_ssa_name (scop, e)); + isl_id_for_parameter (scop, p)); scop->param_context = isl_set_universe (space); - FOR_EACH_VEC_ELT (region->params, i, e) - add_param_constraints (scop, i, e); + FOR_EACH_VEC_ELT (region->params, i, p) + add_param_constraints (scop, i, p); } /* Return true when loop A is nested in loop B. */ diff --git a/gcc/hash-table.cc b/gcc/hash-table.cc index dad1d21..1015c1e 100644 --- a/gcc/hash-table.cc +++ b/gcc/hash-table.cc @@ -84,7 +84,7 @@ unsigned int hash_table_higher_prime_index (unsigned long n) { unsigned int low = 0; - unsigned int high = sizeof (prime_tab) / sizeof (prime_tab[0]); + unsigned int high = ARRAY_SIZE (prime_tab); while (low != high) { diff --git a/gcc/input.cc b/gcc/input.cc index b397061..58beba0 100644 --- a/gcc/input.cc +++ b/gcc/input.cc @@ -3724,8 +3724,7 @@ for_each_line_table_case (void (*testcase) (const line_table_case &)) { /* ...and use each of the "interesting" location values as the starting location within line_table. */ - const int num_boundary_locations - = sizeof (boundary_locations) / sizeof (boundary_locations[0]); + const int num_boundary_locations = ARRAY_SIZE (boundary_locations); for (int loc_idx = 0; loc_idx < num_boundary_locations; loc_idx++) { line_table_case c (default_range_bits, boundary_locations[loc_idx]); diff --git a/gcc/ipa-free-lang-data.cc b/gcc/ipa-free-lang-data.cc index a742156..f99f7be 100644 --- a/gcc/ipa-free-lang-data.cc +++ b/gcc/ipa-free-lang-data.cc @@ -1109,9 +1109,7 @@ free_lang_data (void) free_lang_data_in_cgraph (&fld); /* Create gimple variants for common types. */ - for (unsigned i = 0; - i < sizeof (builtin_structptr_types) / sizeof (builtin_structptr_type); - ++i) + for (unsigned i = 0; i < ARRAY_SIZE (builtin_structptr_types); ++i) builtin_structptr_types[i].node = builtin_structptr_types[i].base; /* Reset some langhooks. Do not reset types_compatible_p, it may diff --git a/gcc/ipa-inline.cc b/gcc/ipa-inline.cc index f8bb072..22a009b 100644 --- a/gcc/ipa-inline.cc +++ b/gcc/ipa-inline.cc @@ -278,7 +278,7 @@ sanitize_attrs_match_for_inline_p (const_tree caller, const_tree callee) SANITIZE_POINTER_SUBTRACT }; - for (unsigned i = 0; i < sizeof (codes) / sizeof (codes[0]); i++) + for (unsigned i = 0; i < ARRAY_SIZE (codes); i++) if (sanitize_flags_p (codes[i], caller) != sanitize_flags_p (codes[i], callee)) return false; diff --git a/gcc/jit/ChangeLog b/gcc/jit/ChangeLog index faab3a7..341766b 100644 --- a/gcc/jit/ChangeLog +++ b/gcc/jit/ChangeLog @@ -1,3 +1,9 @@ +2022-05-16 Martin Liska <mliska@suse.cz> + + * jit-builtins.cc (find_builtin_by_name): Use ARRAY_SIZE. + (get_string_for_type_id): Likewise. + * jit-recording.cc (recording::context::context): Likewise. + 2022-04-14 Iain Sandoe <iain@sandoe.co.uk> * jit-playback.cc (new_bitcast): Cast values returned by tree_to_uhwi diff --git a/gcc/jit/jit-builtins.cc b/gcc/jit/jit-builtins.cc index b949b73..fb86c77 100644 --- a/gcc/jit/jit-builtins.cc +++ b/gcc/jit/jit-builtins.cc @@ -109,9 +109,7 @@ find_builtin_by_name (const char *in_name, We start at index 1 to skip the initial entry (BUILT_IN_NONE), which has a NULL name. */ - for (unsigned int i = 1; - i < sizeof (builtin_data) / sizeof (builtin_data[0]); - i++) + for (unsigned int i = 1; i < ARRAY_SIZE (builtin_data); i++) { const struct builtin_data& bd = builtin_data[i]; if (matches_builtin (in_name, bd)) @@ -320,7 +318,7 @@ static const char * const type_names[] = { static const char * get_string_for_type_id (enum jit_builtin_type type_id) { - gcc_assert (type_id < sizeof (type_names)/sizeof(type_names[0])); + gcc_assert (type_id < ARRAY_SIZE (type_names)); return type_names[type_id]; } diff --git a/gcc/jit/jit-recording.cc b/gcc/jit/jit-recording.cc index a31720f..4305a96 100644 --- a/gcc/jit/jit-recording.cc +++ b/gcc/jit/jit-recording.cc @@ -568,9 +568,7 @@ recording::context::context (context *parent_ctxt) if (parent_ctxt) { /* Inherit options from parent. */ - for (unsigned i = 0; - i < sizeof (m_str_options) / sizeof (m_str_options[0]); - i++) + for (unsigned i = 0; i < ARRAY_SIZE (m_str_options); i++) { const char *parent_opt = parent_ctxt->m_str_options[i]; m_str_options[i] = parent_opt ? xstrdup (parent_opt) : NULL; diff --git a/gcc/lto/ChangeLog b/gcc/lto/ChangeLog index b815c9b..31c3bc2 100644 --- a/gcc/lto/ChangeLog +++ b/gcc/lto/ChangeLog @@ -1,3 +1,8 @@ +2022-05-16 Martin Liska <mliska@suse.cz> + + * lto-common.cc (lto_resolution_read): Use ARRAY_SIZE. + * lto-lang.cc (lto_init): Likewise. + 2022-03-23 Tobias Burnus <tobias@codesourcery.com> PR middle-end/104285 diff --git a/gcc/lto/lto-common.cc b/gcc/lto/lto-common.cc index ca28586..d8d0404 100644 --- a/gcc/lto/lto-common.cc +++ b/gcc/lto/lto-common.cc @@ -2104,8 +2104,7 @@ lto_resolution_read (splay_tree file_ids, FILE *resolution, lto_file *file) char r_str[27]; enum ld_plugin_symbol_resolution r = (enum ld_plugin_symbol_resolution) 0; unsigned int j; - unsigned int lto_resolution_str_len - = sizeof (lto_resolution_str) / sizeof (char *); + unsigned int lto_resolution_str_len = ARRAY_SIZE (lto_resolution_str); res_pair rp; t = fscanf (resolution, "%u " HOST_WIDE_INT_PRINT_HEX_PURE diff --git a/gcc/lto/lto-lang.cc b/gcc/lto/lto-lang.cc index 8d58d92..972a033 100644 --- a/gcc/lto/lto-lang.cc +++ b/gcc/lto/lto-lang.cc @@ -1319,9 +1319,7 @@ lto_init (void) distinction should only be relevant to the front-end, so we always use the C definition here in lto1. Likewise for const struct tm*. */ - for (unsigned i = 0; - i < sizeof (builtin_structptr_types) / sizeof (builtin_structptr_type); - ++i) + for (unsigned i = 0; i < ARRAY_SIZE (builtin_structptr_types); ++i) { gcc_assert (builtin_structptr_types[i].node == builtin_structptr_types[i].base); diff --git a/gcc/match.pd b/gcc/match.pd index f5efa77..c2fed9b 100644 --- a/gcc/match.pd +++ b/gcc/match.pd @@ -4450,6 +4450,52 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (op (min @X { wide_int_to_tree (from_type, real_c1); }) { wide_int_to_tree (from_type, c2); }))))))))) +#if GIMPLE +/* A >= B ? A : B -> max (A, B) and friends. The code is still + in fold_cond_expr_with_comparison for GENERIC folding with + some extra constraints. */ +(for cmp (eq ne le lt unle unlt ge gt unge ungt uneq ltgt) + (simplify + (cond (cmp:c (nop_convert1?@c0 @0) (nop_convert2?@c1 @1)) + (convert3? @0) (convert4? @1)) + (if (!HONOR_SIGNED_ZEROS (type) + && ((INTEGRAL_TYPE_P (type) + /* Allow widening conversions of the data. */ + && TYPE_PRECISION (TREE_TYPE (@0)) <= TYPE_PRECISION (type) + && TYPE_PRECISION (TREE_TYPE (@1)) <= TYPE_PRECISION (type)) + || (tree_nop_conversion_p (type, TREE_TYPE (@0)) + && tree_nop_conversion_p (type, TREE_TYPE (@1))))) + (switch + (if (cmp == EQ_EXPR) + (if (VECTOR_TYPE_P (type)) + (view_convert @c1) + (convert @c1))) + (if (cmp == NE_EXPR) + (if (VECTOR_TYPE_P (type)) + (view_convert @c0) + (convert @c0))) + (if (cmp == LE_EXPR || cmp == UNLE_EXPR || cmp == LT_EXPR || cmp == UNLT_EXPR) + (if (!HONOR_NANS (type)) + (if (VECTOR_TYPE_P (type)) + (view_convert (min @c0 @c1)) + (convert (min @c0 @c1))))) + (if (cmp == GE_EXPR || cmp == UNGE_EXPR || cmp == GT_EXPR || cmp == UNGT_EXPR) + (if (!HONOR_NANS (type)) + (if (VECTOR_TYPE_P (type)) + (view_convert (max @c0 @c1)) + (convert (max @c0 @c1))))) + (if (cmp == UNEQ_EXPR) + (if (!HONOR_NANS (type)) + (if (VECTOR_TYPE_P (type)) + (view_convert @c1) + (convert @c1)))) + (if (cmp == LTGT_EXPR) + (if (!HONOR_NANS (type)) + (if (VECTOR_TYPE_P (type)) + (view_convert @c0) + (convert @c0)))))))) +#endif + /* X != C1 ? -X : C2 simplifies to -X when -C1 == C2. */ (simplify (cond (ne @0 INTEGER_CST@1) (negate@3 @0) INTEGER_CST@2) @@ -7782,3 +7828,13 @@ and, == TYPE_UNSIGNED (TREE_TYPE (@3)))) && single_use (@4) && single_use (@5)))) + +(for bit_op (bit_and bit_ior bit_xor) + (match (bitwise_induction_p @0 @2 @3) + (bit_op:c + (nop_convert1? (bit_not2?@0 (convert3? (lshift integer_onep@1 @2)))) + @3))) + +(match (bitwise_induction_p @0 @2 @3) + (bit_not + (nop_convert1? (bit_xor@0 (convert2? (lshift integer_onep@1 @2)) @3)))) diff --git a/gcc/omp-expand.cc b/gcc/omp-expand.cc index ee70831..9fcc67a 100644 --- a/gcc/omp-expand.cc +++ b/gcc/omp-expand.cc @@ -9092,16 +9092,17 @@ expand_omp_atomic_cas (basic_block load_bb, tree addr, if (cond_stmt) { - g = gimple_build_assign (gimple_assign_lhs (cond_stmt), - NOP_EXPR, im); + g = gimple_build_assign (cond, NOP_EXPR, im); gimple_set_location (g, loc); gsi_insert_before (&gsi, g, GSI_SAME_STMT); } - else if (need_new) + + if (need_new) { g = gimple_build_assign (create_tmp_reg (itype), COND_EXPR, - build2 (NE_EXPR, boolean_type_node, - im, build_zero_cst (itype)), + cond_stmt + ? cond : build2 (NE_EXPR, boolean_type_node, + im, build_zero_cst (itype)), d, re); gimple_set_location (g, loc); gsi_insert_before (&gsi, g, GSI_SAME_STMT); diff --git a/gcc/omp-low.cc b/gcc/omp-low.cc index 8aebaee..c83af6c 100644 --- a/gcc/omp-low.cc +++ b/gcc/omp-low.cc @@ -3883,6 +3883,16 @@ check_omp_nesting_restrictions (gimple *stmt, omp_context *ctx) } else { + if ((gimple_omp_target_kind (ctx->stmt) + == GF_OMP_TARGET_KIND_REGION) + && (gimple_omp_target_kind (stmt) + == GF_OMP_TARGET_KIND_REGION)) + { + c = omp_find_clause (gimple_omp_target_clauses (stmt), + OMP_CLAUSE_DEVICE); + if (c && OMP_CLAUSE_DEVICE_ANCESTOR (c)) + break; + } warning_at (gimple_location (stmt), 0, "%qs construct inside of %qs region", stmt_name, ctx_stmt_name); @@ -12304,7 +12314,7 @@ lower_depend_clauses (tree *pclauses, gimple_seq *iseq, gimple_seq *oseq) { tree c, clauses; gimple *g; - size_t cnt[4] = { 0, 0, 0, 0 }, idx = 2, i; + size_t cnt[5] = { 0, 0, 0, 0, 0 }, idx = 2, i; clauses = omp_find_clause (*pclauses, OMP_CLAUSE_DEPEND); gcc_assert (clauses); @@ -12328,16 +12338,20 @@ lower_depend_clauses (tree *pclauses, gimple_seq *iseq, gimple_seq *oseq) case OMP_CLAUSE_DEPEND_DEPOBJ: cnt[3]++; break; + case OMP_CLAUSE_DEPEND_INOUTSET: + cnt[4]++; + break; case OMP_CLAUSE_DEPEND_SOURCE: case OMP_CLAUSE_DEPEND_SINK: /* FALLTHRU */ default: gcc_unreachable (); } - if (cnt[1] || cnt[3]) + if (cnt[1] || cnt[3] || cnt[4]) idx = 5; - size_t total = cnt[0] + cnt[1] + cnt[2] + cnt[3]; - tree type = build_array_type_nelts (ptr_type_node, total + idx); + size_t total = cnt[0] + cnt[1] + cnt[2] + cnt[3] + cnt[4]; + size_t inoutidx = total + idx; + tree type = build_array_type_nelts (ptr_type_node, total + idx + 2 * cnt[4]); tree array = create_tmp_var (type); TREE_ADDRESSABLE (array) = 1; tree r = build4 (ARRAY_REF, ptr_type_node, array, size_int (0), NULL_TREE, @@ -12358,7 +12372,7 @@ lower_depend_clauses (tree *pclauses, gimple_seq *iseq, gimple_seq *oseq) g = gimple_build_assign (r, build_int_cst (ptr_type_node, cnt[i])); gimple_seq_add_stmt (iseq, g); } - for (i = 0; i < 4; i++) + for (i = 0; i < 5; i++) { if (cnt[i] == 0) continue; @@ -12386,10 +12400,21 @@ lower_depend_clauses (tree *pclauses, gimple_seq *iseq, gimple_seq *oseq) if (i != 3) continue; break; + case OMP_CLAUSE_DEPEND_INOUTSET: + if (i != 4) + continue; + break; default: gcc_unreachable (); } tree t = OMP_CLAUSE_DECL (c); + if (i == 4) + { + t = build4 (ARRAY_REF, ptr_type_node, array, + size_int (inoutidx), NULL_TREE, NULL_TREE); + t = build_fold_addr_expr (t); + inoutidx += 2; + } t = fold_convert (ptr_type_node, t); gimplify_expr (&t, iseq, NULL, is_gimple_val, fb_rvalue); r = build4 (ARRAY_REF, ptr_type_node, array, size_int (idx++), @@ -12398,6 +12423,25 @@ lower_depend_clauses (tree *pclauses, gimple_seq *iseq, gimple_seq *oseq) gimple_seq_add_stmt (iseq, g); } } + if (cnt[4]) + for (c = clauses; c; c = OMP_CLAUSE_CHAIN (c)) + if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND + && OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_INOUTSET) + { + tree t = OMP_CLAUSE_DECL (c); + t = fold_convert (ptr_type_node, t); + gimplify_expr (&t, iseq, NULL, is_gimple_val, fb_rvalue); + r = build4 (ARRAY_REF, ptr_type_node, array, size_int (idx++), + NULL_TREE, NULL_TREE); + g = gimple_build_assign (r, t); + gimple_seq_add_stmt (iseq, g); + t = build_int_cst (ptr_type_node, GOMP_DEPEND_INOUTSET); + r = build4 (ARRAY_REF, ptr_type_node, array, size_int (idx++), + NULL_TREE, NULL_TREE); + g = gimple_build_assign (r, t); + gimple_seq_add_stmt (iseq, g); + } + c = build_omp_clause (UNKNOWN_LOCATION, OMP_CLAUSE_DEPEND); OMP_CLAUSE_DEPEND_KIND (c) = OMP_CLAUSE_DEPEND_LAST; OMP_CLAUSE_DECL (c) = build_fold_addr_expr (array); diff --git a/gcc/optc-save-gen.awk b/gcc/optc-save-gen.awk index 9911bab..233d1fb 100644 --- a/gcc/optc-save-gen.awk +++ b/gcc/optc-save-gen.awk @@ -1104,7 +1104,7 @@ for (i = 0; i < n_target_val; i++) { } if (has_target_explicit_mask) { - print " for (size_t i = 0; i < sizeof (ptr1->explicit_mask) / sizeof (ptr1->explicit_mask[0]); i++)"; + print " for (size_t i = 0; i < ARRAY_SIZE (ptr1->explicit_mask); i++)"; print " if (ptr1->explicit_mask[i] != ptr2->explicit_mask[i])"; print " return false;" } @@ -1152,7 +1152,7 @@ for (i = 0; i < n_target_val; i++) { print " hstate.add_hwi (ptr->" name");"; } if (has_target_explicit_mask) { - print " for (size_t i = 0; i < sizeof (ptr->explicit_mask) / sizeof (ptr->explicit_mask[0]); i++)"; + print " for (size_t i = 0; i < ARRAY_SIZE (ptr->explicit_mask); i++)"; print " hstate.add_hwi (ptr->explicit_mask[i]);"; } @@ -1192,7 +1192,7 @@ for (i = 0; i < n_target_val; i++) { } if (has_target_explicit_mask) { - print " for (size_t i = 0; i < sizeof (ptr->explicit_mask) / sizeof (ptr->explicit_mask[0]); i++)"; + print " for (size_t i = 0; i < ARRAY_SIZE (ptr->explicit_mask); i++)"; print " bp_pack_value (bp, ptr->explicit_mask[i], 64);"; } @@ -1235,7 +1235,7 @@ for (i = 0; i < n_target_val; i++) { } if (has_target_explicit_mask) { - print " for (size_t i = 0; i < sizeof (ptr->explicit_mask) / sizeof (ptr->explicit_mask[0]); i++)"; + print " for (size_t i = 0; i < ARRAY_SIZE (ptr->explicit_mask); i++)"; print " ptr->explicit_mask[i] = bp_unpack_value (bp, 64);"; } @@ -1317,7 +1317,7 @@ for (i = 0; i < n_opt_val; i++) { else print " hstate.add_hwi (ptr->" name");"; } -print " for (size_t i = 0; i < sizeof (ptr->explicit_mask) / sizeof (ptr->explicit_mask[0]); i++)"; +print " for (size_t i = 0; i < ARRAY_SIZE (ptr->explicit_mask); i++)"; print " hstate.add_hwi (ptr->explicit_mask[i]);"; print " return hstate.end ();"; print "}"; @@ -1346,7 +1346,7 @@ for (i = 0; i < n_opt_val; i++) { print " return false;"; } } -print " for (size_t i = 0; i < sizeof (ptr1->explicit_mask) / sizeof (ptr1->explicit_mask[0]); i++)"; +print " for (size_t i = 0; i < ARRAY_SIZE (ptr1->explicit_mask); i++)"; print " if (ptr1->explicit_mask[i] != ptr2->explicit_mask[i])"; print " return false;" print " return true;"; @@ -1380,7 +1380,7 @@ for (i = 0; i < n_opt_val; i++) { } } } -print " for (size_t i = 0; i < sizeof (ptr->explicit_mask) / sizeof (ptr->explicit_mask[0]); i++)"; +print " for (size_t i = 0; i < ARRAY_SIZE (ptr->explicit_mask); i++)"; print " bp_pack_value (bp, ptr->explicit_mask[i], 64);"; print "}"; @@ -1412,7 +1412,7 @@ for (i = 0; i < n_opt_val; i++) { } } } -print " for (size_t i = 0; i < sizeof (ptr->explicit_mask) / sizeof (ptr->explicit_mask[0]); i++)"; +print " for (size_t i = 0; i < ARRAY_SIZE (ptr->explicit_mask); i++)"; print " ptr->explicit_mask[i] = bp_unpack_value (bp, 64);"; print "}"; print "/* Free heap memory used by optimization options */"; diff --git a/gcc/opts-global.cc b/gcc/opts-global.cc index a18c769..4355e26 100644 --- a/gcc/opts-global.cc +++ b/gcc/opts-global.cc @@ -61,7 +61,9 @@ write_langs (unsigned int mask) if (mask & (1U << n)) len += strlen (lang_name) + 1; - result = XNEWVEC (char, len); + /* Allocate at least one character as we'll terminate the string + at the very end of this function. */ + result = XNEWVEC (char, MAX (1, len)); len = 0; for (n = 0; (lang_name = lang_names[n]) != 0; n++) if (mask & (1U << n)) diff --git a/gcc/pointer-query.cc b/gcc/pointer-query.cc index 646606e..67c2550 100644 --- a/gcc/pointer-query.cc +++ b/gcc/pointer-query.cc @@ -555,7 +555,7 @@ gimple_parm_array_size (tree ptr, wide_int rng[2], from the current function declaratation (e.g., attribute access or related). */ tree var = SSA_NAME_VAR (ptr); - if (TREE_CODE (var) != PARM_DECL) + if (TREE_CODE (var) != PARM_DECL || !POINTER_TYPE_P (TREE_TYPE (var))) return NULL_TREE; const unsigned prec = TYPE_PRECISION (sizetype); diff --git a/gcc/spellcheck.cc b/gcc/spellcheck.cc index 3e58344..c7bb012 100644 --- a/gcc/spellcheck.cc +++ b/gcc/spellcheck.cc @@ -489,7 +489,7 @@ static const char * const test_data[] = { static void test_metric_conditions () { - const int num_test_cases = sizeof (test_data) / sizeof (test_data[0]); + const int num_test_cases = ARRAY_SIZE (test_data); for (int i = 0; i < num_test_cases; i++) { diff --git a/gcc/system.h b/gcc/system.h index 1c783c5..67158b7 100644 --- a/gcc/system.h +++ b/gcc/system.h @@ -774,8 +774,10 @@ extern int vsnprintf (char *, size_t, const char *, va_list); #endif #endif -/* Redefine abort to report an internal error w/o coredump, and - reporting the location of the error in the source file. */ +/* Redefine 'abort' to report an internal error w/o coredump, and + reporting the location of the error in the source file. + Instead of directly calling 'abort' or 'fancy_abort', GCC code + should normally call 'internal_error' with a specific message. */ extern void fancy_abort (const char *, int, const char *) ATTRIBUTE_NORETURN ATTRIBUTE_COLD; #define abort() fancy_abort (__FILE__, __LINE__, __FUNCTION__) diff --git a/gcc/targhooks.cc b/gcc/targhooks.cc index 399d6f8..b15ae19 100644 --- a/gcc/targhooks.cc +++ b/gcc/targhooks.cc @@ -2009,8 +2009,12 @@ default_print_patchable_function_entry_1 (FILE *file, patch_area_number++; ASM_GENERATE_INTERNAL_LABEL (buf, "LPFE", patch_area_number); - switch_to_section (get_section ("__patchable_function_entries", - flags, current_function_decl)); + section *sect = get_section ("__patchable_function_entries", + flags, current_function_decl); + if (HAVE_COMDAT_GROUP && DECL_COMDAT_GROUP (current_function_decl)) + switch_to_comdat_section (sect, current_function_decl); + else + switch_to_section (sect); assemble_align (POINTER_SIZE); fputs (asm_op, file); assemble_name_raw (file, buf); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 3109d8e..e4c2c46 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,182 @@ +2022-05-18 Marek Polacek <polacek@redhat.com> + + PR c/105131 + * gcc.dg/Wenum-int-mismatch-1.c: New test. + * gcc.dg/Wenum-int-mismatch-2.c: New test. + * gcc.dg/Wenum-int-mismatch-3.c: New test. + * gcc.dg/Wenum-int-mismatch-4.c: New test. + * gcc.dg/Wenum-int-mismatch-5.c: New test. + +2022-05-18 Paul A. Clarke <pc@us.ibm.com> + + PR target/105620 + * g++.target/powerpc/pr69667.C: Move to ... + * g++.dg/pr69667.C: here. Also, revert recent dg directives changes. + +2022-05-18 Roger Sayle <roger@nextmovesoftware.com> + + * gcc.target/i386/bmi-andn-3.c: New test case. + +2022-05-18 Marek Polacek <polacek@redhat.com> + + PR c++/105497 + * c-c++-common/Wswitch-1.c: New test. + * g++.dg/warn/Wswitch-4.C: New test. + +2022-05-18 Marek Polacek <polacek@redhat.com> + + PR c++/105634 + * g++.dg/Wclass-memaccess-2.C: Moved to... + * g++.dg/warn/Wclass-memaccess-2.C: ...here. + * g++.dg/Wclass-memaccess-3.C: Moved to... + * g++.dg/warn/Wclass-memaccess-3.C: ...here. + * g++.dg/Wclass-memaccess-4.C: Moved to... + * g++.dg/warn/Wclass-memaccess-4.C: ...here. + * g++.dg/Wclass-memaccess-5.C: Moved to... + * g++.dg/warn/Wclass-memaccess-5.C: ...here. + * g++.dg/Wclass-memaccess-6.C: Moved to... + * g++.dg/warn/Wclass-memaccess-6.C: ...here. + * g++.dg/Wclass-memaccess.C: Moved to... + * g++.dg/warn/Wclass-memaccess.C: ...here. + * g++.dg/warn/Wclass-memaccess-7.C: New test. + +2022-05-18 Kewen Lin <linkw@linux.ibm.com> + + * gcc.target/powerpc/pr83660.C: Moved to... + * g++.target/powerpc/pr83660.C: ...here. + +2022-05-18 Frederik Harwath <frederik@codesourcery.com> + + * gcc.dg/graphite/scop-22a.c: New test. + +2022-05-18 Tobias Burnus <tobias@codesourcery.com> + + * gfortran.dg/gomp/all-memory-1.f90: Add inoutset test. + * gfortran.dg/gomp/all-memory-2.f90: Likewise. + * gfortran.dg/gomp/depobj-1.f90: Likewise. + * gfortran.dg/gomp/depobj-2.f90: Likewise. + +2022-05-18 liuhongt <hongtao.liu@intel.com> + + * gcc.target/i386/pr103462-1.c: New test. + * gcc.target/i386/pr103462-2.c: New test. + * gcc.target/i386/pr103462-3.c: New test. + * gcc.target/i386/pr103462-4.c: New test. + * gcc.target/i386/pr103462-5.c: New test. + * gcc.target/i386/pr103462-6.c: New test. + +2022-05-18 Haochen Gui <guihaoc@gcc.gnu.org> + + PR target/95737 + * gcc.target/powerpc/pr95737.c: New. + +2022-05-18 liuhongt <hongtao.liu@intel.com> + + * gcc.target/i386/pr104375.c: New test. + +2022-05-18 liuhongt <hongtao.liu@intel.com> + + * gcc.target/i386/pr104610.c: New test. + +2022-05-17 Jason Merrill <jason@redhat.com> + + PR c++/102307 + * g++.dg/cpp1z/constexpr-array2.C: New test. + +2022-05-17 Tobias Burnus <tobias@codesourcery.com> + + * c-c++-common/gomp/target-device-ancestor-5.c: New test. + +2022-05-17 Giuliano Belinassi <gbelinassi@suse.de> + + PR c++/105169 + * g++.dg/modules/pr105169.h: New file. + * g++.dg/modules/pr105169_a.C: New test. + * g++.dg/modules/pr105169_b.C: New file. + +2022-05-17 Andrew MacLeod <amacleod@redhat.com> + + * gcc.dg/pr105458.c: New. + +2022-05-17 Uroš Bizjak <ubizjak@gmail.com> + + PR target/105624 + * gcc.target/i386/pr105624.c: New test. + +2022-05-17 Jakub Jelinek <jakub@redhat.com> + + * c-c++-common/gomp/all-memory-1.c (boo): Add test with + inoutset depend-kind. + * c-c++-common/gomp/all-memory-2.c (boo): Likewise. + * c-c++-common/gomp/depobj-1.c (f1): Likewise. + (f2): Adjusted expected diagnostics. + * g++.dg/gomp/depobj-1.C (f4): Adjust expected diagnostics. + +2022-05-17 Jakub Jelinek <jakub@redhat.com> + + PR target/105613 + * gcc.c-torture/execute/pr105613.c: New test. + +2022-05-17 Tobias Burnus <tobias@codesourcery.com> + + * gfortran.dg/gomp/all-memory-1.f90: New test. + * gfortran.dg/gomp/all-memory-2.f90: New test. + * gfortran.dg/gomp/all-memory-3.f90: New test. + +2022-05-17 Richard Biener <rguenther@suse.de> + + PR tree-optimization/105618 + * gcc.dg/tree-ssa/ssa-sink-19.c: New testcase. + +2022-05-17 liuhongt <hongtao.liu@intel.com> + + * gcc.target/i386/pr105033.c: New test. + +2022-05-17 liuhongt <hongtao.liu@intel.com> + + * gcc.dg/pr105591.c: New test. + +2022-05-16 David Malcolm <dmalcolm@redhat.com> + + PR analyzer/105103 + * gcc.dg/analyzer/stdarg-1.c: New test. + * gcc.dg/analyzer/stdarg-2.c: New test. + * gcc.dg/analyzer/stdarg-fmtstring-1.c: New test. + * gcc.dg/analyzer/stdarg-lto-1-a.c: New test. + * gcc.dg/analyzer/stdarg-lto-1-b.c: New test. + * gcc.dg/analyzer/stdarg-lto-1.h: New test. + * gcc.dg/analyzer/stdarg-sentinel-1.c: New test. + * gcc.dg/analyzer/stdarg-types-1.c: New test. + * gcc.dg/analyzer/stdarg-types-2.c: New test. + +2022-05-16 Richard Biener <rguenther@suse.de> + + PR rtl-optimization/105577 + * g++.dg/torture/pr105577.C: New testcase. + +2022-05-16 Richard Biener <rguenther@suse.de> + + * gcc.dg/torture/pr105598.c: New testcase. + +2022-05-16 liuhongt <hongtao.liu@intel.com> + + * gcc.target/i386/pr105587.c: New test. + +2022-05-15 Jason Merrill <jason@redhat.com> + + PR c++/100502 + PR c++/58993 + * g++.dg/template/access37.C: Now OK. + * g++.dg/template/friend69.C: Now OK. + * g++.dg/lookup/friend23.C: New test. + +2022-05-15 Jason Merrill <jason@redhat.com> + + PR c++/105589 + PR c++/105191 + PR c++/92385 + * g++.dg/cpp0x/initlist-array16.C: New test. + 2022-05-13 Marek Polacek <polacek@redhat.com> PR c++/81952 diff --git a/gcc/testsuite/c-c++-common/Wswitch-1.c b/gcc/testsuite/c-c++-common/Wswitch-1.c new file mode 100644 index 0000000..de9ee03 --- /dev/null +++ b/gcc/testsuite/c-c++-common/Wswitch-1.c @@ -0,0 +1,29 @@ +/* PR c++/105497 */ +/* { dg-options "-Wswitch" } */ + +enum E { + A, + B, + C __attribute((unused)), + D +}; + +void +g (enum E e) +{ + switch (e) + { + case A: + case B: + case D: + break; + } + + switch (e) // { dg-warning "not handled in switch" } + { + case A: + case B: + case C: + break; + } +} diff --git a/gcc/testsuite/c-c++-common/gomp/all-memory-1.c b/gcc/testsuite/c-c++-common/gomp/all-memory-1.c index 5d63e0d..0fb4570 100644 --- a/gcc/testsuite/c-c++-common/gomp/all-memory-1.c +++ b/gcc/testsuite/c-c++-common/gomp/all-memory-1.c @@ -49,4 +49,6 @@ boo (void) ; #pragma omp task depend(mutexinoutset: omp_all_memory) /* { dg-error "'omp_all_memory' used with 'depend' kind other than 'out' or 'inout'" } */ ; + #pragma omp task depend(inoutset: omp_all_memory) /* { dg-error "'omp_all_memory' used with 'depend' kind other than 'out' or 'inout'" } */ + ; } diff --git a/gcc/testsuite/c-c++-common/gomp/all-memory-2.c b/gcc/testsuite/c-c++-common/gomp/all-memory-2.c index 6f5d31b..99b5945 100644 --- a/gcc/testsuite/c-c++-common/gomp/all-memory-2.c +++ b/gcc/testsuite/c-c++-common/gomp/all-memory-2.c @@ -52,4 +52,6 @@ boo (void) ; #pragma omp task depend(mutexinoutset: omp_all_memory) ; + #pragma omp task depend(inoutset: omp_all_memory) + ; } diff --git a/gcc/testsuite/c-c++-common/gomp/depobj-1.c b/gcc/testsuite/c-c++-common/gomp/depobj-1.c index 688371b..77fd971 100644 --- a/gcc/testsuite/c-c++-common/gomp/depobj-1.c +++ b/gcc/testsuite/c-c++-common/gomp/depobj-1.c @@ -21,6 +21,9 @@ f1 (void) ; #pragma omp depobj(pdepobj[0]) depend(mutexinoutset:a) #pragma omp depobj(*pdepobj) destroy + #pragma omp depobj(depobja[0]) depend(inoutset: a) + #pragma omp depobj(depobja[0]) update(mutexinoutset) + #pragma omp depobj(depobja[0]) update(inoutset) } void @@ -38,7 +41,7 @@ f2 (void) #pragma omp depobj (a) destroy /* { dg-error "type of 'depobj' expression is not 'omp_depend_t'" } */ #pragma omp depobj (depobj) depend(depobj:a) /* { dg-error "does not have 'omp_depend_t' type in 'depend' clause with 'depobj' dependence type" } */ #pragma omp depobj (depobj) depend(depobj:*depobjb) /* { dg-error "'depobj' dependence type specified in 'depend' clause on 'depobj' construct" } */ - #pragma omp depobj (depobj) update(foobar) /* { dg-error "expected 'in', 'out', 'inout' or 'mutexinoutset'" } */ + #pragma omp depobj (depobj) update(foobar) /* { dg-error "expected 'in', 'out', 'inout', 'mutexinoutset' or 'inoutset'" } */ #pragma omp depobj (depobj) depend(in: *depobja) /* { dg-error "should not have 'omp_depend_t' type in 'depend' clause with dependence type" } */ #pragma omp depobj (depobj) depend(in: a) depend(in: b) /* { dg-error "expected" } */ #pragma omp depobj (depobj) depend(in: a) update(out) /* { dg-error "expected" } */ diff --git a/gcc/testsuite/c-c++-common/gomp/target-device-ancestor-5.c b/gcc/testsuite/c-c++-common/gomp/target-device-ancestor-5.c new file mode 100644 index 0000000..b6ff84b --- /dev/null +++ b/gcc/testsuite/c-c++-common/gomp/target-device-ancestor-5.c @@ -0,0 +1,28 @@ +#pragma omp requires reverse_offload /* { dg-message "sorry, unimplemented: 'reverse_offload' clause on 'requires' directive not supported yet" } */ + +void +foo () +{ + /* Good nesting - as reverse offload */ + #pragma omp target + #pragma omp target device(ancestor:1) /* valid -> no warning */ /* { dg-bogus "'target' construct inside of 'target' region" } */ + { } + + /* Bad nesting */ + #pragma omp target + #pragma omp target /* { dg-warning "'target' construct inside of 'target' region" } */ + #pragma omp target /* { dg-warning "'target' construct inside of 'target' region" } */ + { } + + /* Good nesting - as reverse offload */ + #pragma omp target + #pragma omp target /* { dg-warning "'target' construct inside of 'target' region" } */ + #pragma omp target device(ancestor:1) /* valid -> no warning */ /* { dg-bogus "'target' construct inside of 'target' region" } */ + { } + + #pragma omp target + #pragma omp target device(ancestor:1) /* valid -> no warning */ /* { dg-bogus "'target' construct inside of 'target' region" } */ + #pragma omp target device(ancestor:1) /* { dg-error "OpenMP constructs are not allowed in target region with 'ancestor'" } */ + { } + +} diff --git a/gcc/testsuite/g++.dg/cpp0x/initlist-array16.C b/gcc/testsuite/g++.dg/cpp0x/initlist-array16.C new file mode 100644 index 0000000..bb1d8d8 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/initlist-array16.C @@ -0,0 +1,11 @@ +// PR c++/105589 +// { dg-do compile { target c++11 } } + +struct X { X(); }; + +struct array { X m[2]; }; + +template<class> +void f() { + array w = array{}; +} diff --git a/gcc/testsuite/g++.dg/cpp1z/constexpr-array2.C b/gcc/testsuite/g++.dg/cpp1z/constexpr-array2.C new file mode 100644 index 0000000..c30e3f2 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp1z/constexpr-array2.C @@ -0,0 +1,12 @@ +// PR c++/102307 +// { dg-do compile { target c++11 } } + +#include <array> +template <unsigned N, unsigned M> struct Matrix { + constexpr Matrix(double const (&arr)[N][M]); // { dg-warning "never defined" } + constexpr Matrix(std::array<std::array<double, M>, N> const &arr); +}; +int main() { + constexpr Matrix<2, 3> + mat {{ {1.0, 2.0, 3.0}, {4.0, 5.0, 6.0} }}; // { dg-error "before its definition" } +} diff --git a/gcc/testsuite/g++.dg/gomp/depobj-1.C b/gcc/testsuite/g++.dg/gomp/depobj-1.C index 6004f1e..cb091a1 100644 --- a/gcc/testsuite/g++.dg/gomp/depobj-1.C +++ b/gcc/testsuite/g++.dg/gomp/depobj-1.C @@ -83,7 +83,7 @@ f4 (void) #pragma omp depobj (a) destroy // { dg-error "type of 'depobj' expression is not 'omp_depend_t'" } #pragma omp depobj (depobj) depend(depobj:a) // { dg-error "does not have 'omp_depend_t' type in 'depend' clause with 'depobj' dependence type" } #pragma omp depobj (depobj) depend(depobj:*depobjb) // { dg-error "'depobj' dependence type specified in 'depend' clause on 'depobj' construct" } - #pragma omp depobj (depobj) update(foobar) // { dg-error "expected 'in', 'out', 'inout' or 'mutexinoutset'" } + #pragma omp depobj (depobj) update(foobar) // { dg-error "expected 'in', 'out', 'inout', 'mutexinoutset' or 'inoutset'" } #pragma omp depobj (depobj) depend(in: *depobja) // { dg-error "should not have 'omp_depend_t' type in 'depend' clause with dependence type" } #pragma omp depobj (depobj) depend(in: a) depend(in: b) // { dg-error "expected" } #pragma omp depobj (depobj) depend(in: a) update(out) // { dg-error "expected" } diff --git a/gcc/testsuite/g++.dg/lookup/friend23.C b/gcc/testsuite/g++.dg/lookup/friend23.C new file mode 100644 index 0000000..f7b26c9 --- /dev/null +++ b/gcc/testsuite/g++.dg/lookup/friend23.C @@ -0,0 +1,17 @@ +template <class Derived> +struct base { + friend void bar(Derived& d) { + d.bar(); // access in inline friend of friend, ok? + } +}; + +class derived : base<derived> { + friend class base<derived>; + void bar() {} +}; + +int main() { + derived d; + bar(d); +} + diff --git a/gcc/testsuite/g++.dg/modules/pr105169.h b/gcc/testsuite/g++.dg/modules/pr105169.h new file mode 100644 index 0000000..a7e7627 --- /dev/null +++ b/gcc/testsuite/g++.dg/modules/pr105169.h @@ -0,0 +1,22 @@ +class IPXAddressClass +{ +public: + IPXAddressClass(void); +}; + +class WinsockInterfaceClass +{ + +public: + WinsockInterfaceClass(void); + + virtual void Set_Broadcast_Address(void*){}; + + virtual int Get_Protocol(void) + { + return 0; + }; + +protected: +}; + diff --git a/gcc/testsuite/g++.dg/modules/pr105169_a.C b/gcc/testsuite/g++.dg/modules/pr105169_a.C new file mode 100644 index 0000000..02660b3 --- /dev/null +++ b/gcc/testsuite/g++.dg/modules/pr105169_a.C @@ -0,0 +1,25 @@ +/* { dg-module-do link } */ +/* { dg-options "-std=c++11 -fpatchable-function-entry=2 -O2" } */ +/* { dg-additional-options "-std=c++11 -fpatchable-function-entry=2 -O2" } */ + +/* This test is in the "modules" package because it supports multiple files + linkage. */ + +#include "pr105169.h" + +WinsockInterfaceClass* PacketTransport; + +IPXAddressClass::IPXAddressClass(void) +{ +} + +int function() +{ + return PacketTransport->Get_Protocol(); +} + +int main() +{ + IPXAddressClass ipxaddr; + return 0; +} diff --git a/gcc/testsuite/g++.dg/modules/pr105169_b.C b/gcc/testsuite/g++.dg/modules/pr105169_b.C new file mode 100644 index 0000000..7a9c586 --- /dev/null +++ b/gcc/testsuite/g++.dg/modules/pr105169_b.C @@ -0,0 +1,12 @@ +/* { dg-module-do link } */ +/* { dg-options "-std=c++11 -fpatchable-function-entry=2 -O2" } */ +/* { dg-additional-options "-std=c++11 -fpatchable-function-entry=2 -O2" } */ + +/* This test is in the "modules" package because it supports multiple files + linkage. */ + +#include "pr105169.h" + +WinsockInterfaceClass::WinsockInterfaceClass(void) +{ +} diff --git a/gcc/testsuite/g++.target/powerpc/pr69667.C b/gcc/testsuite/g++.dg/pr69667.C index da550cd..422116d 100644 --- a/gcc/testsuite/g++.target/powerpc/pr69667.C +++ b/gcc/testsuite/g++.dg/pr69667.C @@ -1,4 +1,5 @@ -/* { dg-skip-if "" { *-*-darwin* } } */ +/* { dg-do compile { target { powerpc*-*-* && lp64 } } } */ +/* { dg-skip-if "" { powerpc*-*-darwin* } } */ /* { dg-require-effective-target powerpc_p8vector_ok } */ /* { dg-options "-mdejagnu-cpu=power8 -w -std=c++14" } */ diff --git a/gcc/testsuite/g++.dg/template/access37.C b/gcc/testsuite/g++.dg/template/access37.C index 5be532c..407a7dc 100644 --- a/gcc/testsuite/g++.dg/template/access37.C +++ b/gcc/testsuite/g++.dg/template/access37.C @@ -6,10 +6,10 @@ struct EnumeratorRange { EnumeratorRange range_; friend void f(Iterator i) { - i.range_.end_reached_; // { dg-error "private" } - i.range_.EnumeratorRange::end_reached_; // { dg-error "private" } - &i.range_.end_reached_; // { dg-error "private" } - &i.range_.EnumeratorRange::end_reached_; // { dg-error "private" } + i.range_.end_reached_; + i.range_.EnumeratorRange::end_reached_; + &i.range_.end_reached_; + &i.range_.EnumeratorRange::end_reached_; } }; diff --git a/gcc/testsuite/g++.dg/template/friend69.C b/gcc/testsuite/g++.dg/template/friend69.C index f3086a9..9bec6ba 100644 --- a/gcc/testsuite/g++.dg/template/friend69.C +++ b/gcc/testsuite/g++.dg/template/friend69.C @@ -12,7 +12,7 @@ protected: struct A { friend void g(A) { - B::f(); // { dg-error "private" } - B::g(); // { dg-error "protected" } + B::f(); + B::g(); } }; diff --git a/gcc/testsuite/g++.dg/torture/pr105577.C b/gcc/testsuite/g++.dg/torture/pr105577.C new file mode 100644 index 0000000..52f16a5 --- /dev/null +++ b/gcc/testsuite/g++.dg/torture/pr105577.C @@ -0,0 +1,156 @@ +// { dg-do compile } +// { dg-additional-options "-fexceptions -fnon-call-exceptions" } + +namespace { +typedef __SIZE_TYPE__ size_t; +} +typedef __UINT8_TYPE__ uint8_t; +typedef __UINT64_TYPE__ uint64_t; +namespace { +template <typename _Tp, _Tp __v> struct integral_constant { + static constexpr _Tp value = __v; +}; +template <bool __v> using __bool_constant = integral_constant<bool, __v>; +template <bool> struct __conditional { + template <typename _Tp, typename> using type = _Tp; +}; +template <bool _Cond, typename _If, typename _Else> +using __conditional_t = typename __conditional<_Cond>::type<_If, _Else>; +template <typename...> struct __and_; +template <typename _B1, typename _B2> +struct __and_<_B1, _B2> : __conditional_t<_B1::value, _B2, _B1> {}; +template <typename> struct __not_ : __bool_constant<!bool()> {}; +template <typename _Tp> +struct __is_constructible_impl : __bool_constant<__is_constructible(_Tp)> {}; +template <typename _Tp> +struct is_default_constructible : __is_constructible_impl<_Tp> {}; +template <typename _Tp> struct remove_extent { typedef _Tp type; }; +template <bool> struct enable_if; +} // namespace +namespace std { +template <typename _Tp> struct allocator_traits { using pointer = _Tp; }; +template <typename _Alloc> struct __alloc_traits : allocator_traits<_Alloc> {}; +template <typename, typename _Alloc> struct _Vector_base { + typedef typename __alloc_traits<_Alloc>::pointer pointer; + struct { + pointer _M_finish; + pointer _M_end_of_storage; + }; +}; +template <typename _Tp, typename _Alloc = _Tp> +class vector : _Vector_base<_Tp, _Alloc> { +public: + _Tp value_type; + typedef size_t size_type; +}; +template <typename _Tp, typename _Dp> class __uniq_ptr_impl { + template <typename _Up, typename> struct _Ptr { using type = _Up *; }; + +public: + using _DeleterConstraint = + enable_if<__and_<__not_<_Dp>, is_default_constructible<_Dp>>::value>; + using pointer = typename _Ptr<_Tp, _Dp>::type; +}; +template <typename _Tp, typename _Dp = _Tp> class unique_ptr { +public: + using pointer = typename __uniq_ptr_impl<_Tp, _Dp>::pointer; + pointer operator->(); +}; +enum _Lock_policy { _S_atomic } const __default_lock_policy = _S_atomic; +template <_Lock_policy = __default_lock_policy> class _Sp_counted_base; +template <typename, _Lock_policy = __default_lock_policy> class __shared_ptr; +template <_Lock_policy> class __shared_count { _Sp_counted_base<> *_M_pi; }; +template <typename _Tp, _Lock_policy _Lp> class __shared_ptr { + using element_type = typename remove_extent<_Tp>::type; + element_type *_M_ptr; + __shared_count<_Lp> _M_refcount; +}; +template <typename _Tp> class shared_ptr : __shared_ptr<_Tp> { +public: + shared_ptr() noexcept : __shared_ptr<_Tp>() {} +}; +enum CompressionType : char; +class SliceTransform; +enum Temperature : uint8_t; +struct MutableCFOptions { + MutableCFOptions() + : soft_pending_compaction_bytes_limit(), + hard_pending_compaction_bytes_limit(level0_file_num_compaction_trigger), + level0_slowdown_writes_trigger(level0_stop_writes_trigger), + max_compaction_bytes(target_file_size_base), + target_file_size_multiplier(max_bytes_for_level_base), + max_bytes_for_level_multiplier(ttl), compaction_options_fifo(), + min_blob_size(blob_file_size), blob_compression_type(), + enable_blob_garbage_collection(blob_garbage_collection_age_cutoff), + max_sequential_skip_in_iterations(check_flush_compaction_key_order), + paranoid_file_checks(bottommost_compression), bottommost_temperature(), + sample_for_compression() {} + shared_ptr<SliceTransform> prefix_extractor; + uint64_t soft_pending_compaction_bytes_limit; + uint64_t hard_pending_compaction_bytes_limit; + int level0_file_num_compaction_trigger; + int level0_slowdown_writes_trigger; + int level0_stop_writes_trigger; + uint64_t max_compaction_bytes; + uint64_t target_file_size_base; + int target_file_size_multiplier; + uint64_t max_bytes_for_level_base; + double max_bytes_for_level_multiplier; + uint64_t ttl; + vector<int> compaction_options_fifo; + uint64_t min_blob_size; + uint64_t blob_file_size; + CompressionType blob_compression_type; + bool enable_blob_garbage_collection; + double blob_garbage_collection_age_cutoff; + uint64_t max_sequential_skip_in_iterations; + bool check_flush_compaction_key_order; + bool paranoid_file_checks; + CompressionType bottommost_compression; + Temperature bottommost_temperature; + uint64_t sample_for_compression; +}; +template <class T, size_t kSize = 8> class autovector { + using value_type = T; + using size_type = typename vector<T>::size_type; + size_type buf_[kSize * sizeof(value_type)]; +}; +class MemTable; +class ColumnFamilyData; +struct SuperVersion { + MutableCFOptions write_stall_condition; + autovector<MemTable *> to_delete; +}; +class ColumnFamilySet { +public: + class iterator { + public: + iterator operator++(); + bool operator!=(iterator); + ColumnFamilyData *operator*(); + ColumnFamilyData *current_; + }; + iterator begin(); + iterator end(); +}; +class VersionSet { +public: + ColumnFamilySet *GetColumnFamilySet(); +}; +struct SuperVersionContext { + void NewSuperVersion() { new SuperVersion(); } +}; +class DBImpl { + unique_ptr<VersionSet> versions_; + void InstallSuperVersionAndScheduleWork(ColumnFamilyData *, + SuperVersionContext *, + const MutableCFOptions &); +}; +void DBImpl::InstallSuperVersionAndScheduleWork(ColumnFamilyData *, + SuperVersionContext *sv_context, + const MutableCFOptions &) { + sv_context->NewSuperVersion(); + for (auto my_cfd : *versions_->GetColumnFamilySet()) + ; +} +} // namespace std diff --git a/gcc/testsuite/g++.dg/Wclass-memaccess-2.C b/gcc/testsuite/g++.dg/warn/Wclass-memaccess-2.C index f138b8b..f138b8b 100644 --- a/gcc/testsuite/g++.dg/Wclass-memaccess-2.C +++ b/gcc/testsuite/g++.dg/warn/Wclass-memaccess-2.C diff --git a/gcc/testsuite/g++.dg/Wclass-memaccess-3.C b/gcc/testsuite/g++.dg/warn/Wclass-memaccess-3.C index 36e0e68..36e0e68 100644 --- a/gcc/testsuite/g++.dg/Wclass-memaccess-3.C +++ b/gcc/testsuite/g++.dg/warn/Wclass-memaccess-3.C diff --git a/gcc/testsuite/g++.dg/Wclass-memaccess-4.C b/gcc/testsuite/g++.dg/warn/Wclass-memaccess-4.C index 69b8c78..69b8c78 100644 --- a/gcc/testsuite/g++.dg/Wclass-memaccess-4.C +++ b/gcc/testsuite/g++.dg/warn/Wclass-memaccess-4.C diff --git a/gcc/testsuite/g++.dg/Wclass-memaccess-5.C b/gcc/testsuite/g++.dg/warn/Wclass-memaccess-5.C index d0fffea..d0fffea 100644 --- a/gcc/testsuite/g++.dg/Wclass-memaccess-5.C +++ b/gcc/testsuite/g++.dg/warn/Wclass-memaccess-5.C diff --git a/gcc/testsuite/g++.dg/Wclass-memaccess-6.C b/gcc/testsuite/g++.dg/warn/Wclass-memaccess-6.C index 7f6fe03..7f6fe03 100644 --- a/gcc/testsuite/g++.dg/Wclass-memaccess-6.C +++ b/gcc/testsuite/g++.dg/warn/Wclass-memaccess-6.C diff --git a/gcc/testsuite/g++.dg/warn/Wclass-memaccess-7.C b/gcc/testsuite/g++.dg/warn/Wclass-memaccess-7.C new file mode 100644 index 0000000..7e86b24 --- /dev/null +++ b/gcc/testsuite/g++.dg/warn/Wclass-memaccess-7.C @@ -0,0 +1,13 @@ +// PR c++/105634 +// { dg-do compile { target { c++11 } } } +// { dg-options "-Wall" } + +struct s +{ + struct {} a[] = 1.0; // { dg-error "" } + void f (char *c) + { + s s; + __builtin_memcpy (&s, c, sizeof(s)); + } +}; diff --git a/gcc/testsuite/g++.dg/Wclass-memaccess.C b/gcc/testsuite/g++.dg/warn/Wclass-memaccess.C index 1dc23df..1dc23df 100644 --- a/gcc/testsuite/g++.dg/Wclass-memaccess.C +++ b/gcc/testsuite/g++.dg/warn/Wclass-memaccess.C diff --git a/gcc/testsuite/g++.dg/warn/Wswitch-4.C b/gcc/testsuite/g++.dg/warn/Wswitch-4.C new file mode 100644 index 0000000..553a57d --- /dev/null +++ b/gcc/testsuite/g++.dg/warn/Wswitch-4.C @@ -0,0 +1,52 @@ +// PR c++/105497 +// { dg-do compile { target c++11 } } +// { dg-options "-Wswitch" } + +enum class Button +{ + Left, + Right, + Middle, + NumberOfButtons [[maybe_unused]] +}; + +enum class Sound +{ + Bark, + Meow, + Hiss, + Moo __attribute((unused)) +}; + +enum class Chordata +{ + Urochordata, + Cephalochordata, + Vertebrata +}; + +int main() +{ + Button b = Button::Left; + switch (b) { // { dg-bogus "not handled" } + case Button::Left: + case Button::Right: + case Button::Middle: + break; + } + + Sound s = Sound::Bark; + switch (s) { // { dg-bogus "not handled" } + case Sound::Bark: + case Sound::Meow: + case Sound::Hiss: + break; + } + + Chordata c = Chordata::Vertebrata; + switch (c) { // { dg-warning "not handled" } + case Chordata::Cephalochordata: + case Chordata::Vertebrata: + break; + } +} diff --git a/gcc/testsuite/gcc.target/powerpc/pr83660.C b/gcc/testsuite/g++.target/powerpc/pr83660.C index cb01bfd..cb01bfd 100644 --- a/gcc/testsuite/gcc.target/powerpc/pr83660.C +++ b/gcc/testsuite/g++.target/powerpc/pr83660.C diff --git a/gcc/testsuite/gcc.c-torture/execute/pr105613.c b/gcc/testsuite/gcc.c-torture/execute/pr105613.c new file mode 100644 index 0000000..6e51e19 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/pr105613.c @@ -0,0 +1,26 @@ +/* PR target/105613 */ +/* { dg-do run { target int128 } } */ + +typedef unsigned __int128 __attribute__((__vector_size__ (16))) V; + +void +foo (V v, V *r) +{ + *r = v != 0; +} + +int +main () +{ + V r; + foo ((V) {5}, &r); + if (r[0] != ~(unsigned __int128) 0) + __builtin_abort (); + foo ((V) {0x500000005ULL}, &r); + if (r[0] != ~(unsigned __int128) 0) + __builtin_abort (); + foo ((V) {0}, &r); + if (r[0] != 0) + __builtin_abort (); + return 0; +} diff --git a/gcc/testsuite/gcc.dg/Wenum-int-mismatch-1.c b/gcc/testsuite/gcc.dg/Wenum-int-mismatch-1.c new file mode 100644 index 0000000..6298018 --- /dev/null +++ b/gcc/testsuite/gcc.dg/Wenum-int-mismatch-1.c @@ -0,0 +1,43 @@ +/* PR c/105131 */ +/* { dg-do compile } */ +/* { dg-options "-Wall -fno-short-enums" } */ + +enum E { E1 = -1, E2 = 0, E3 = 1 }; + +int foo(void); /* { dg-message "previous declaration" } */ +enum E foo(void) { return E2; } /* { dg-warning "conflicting types" } */ + +void bar(int); /* { dg-message "previous declaration" } */ +void bar(enum E); /* { dg-warning "conflicting types" } */ + +extern int arr[10]; /* { dg-message "previous declaration" } */ +extern enum E arr[10]; /* { dg-warning "conflicting types" } */ + +extern int i; /* { dg-message "previous declaration" } */ +extern enum E i; /* { dg-warning "conflicting types" } */ + +extern int *p; /* { dg-message "previous declaration" } */ +extern enum E *p; /* { dg-warning "conflicting types" } */ + +enum E foo2(void) { return E2; } /* { dg-message "previous definition" } */ +int foo2(void); /* { dg-warning "conflicting types" } */ + +void bar2(enum E); /* { dg-message "previous declaration" } */ +void bar2(int); /* { dg-warning "conflicting types" } */ + +extern enum E arr2[10]; /* { dg-message "previous declaration" } */ +extern int arr2[10]; /* { dg-warning "conflicting types" } */ + +extern enum E i2; /* { dg-message "previous declaration" } */ +extern int i2; /* { dg-warning "conflicting types" } */ + +extern enum E *p2; /* { dg-message "previous declaration" } */ +extern int *p2; /* { dg-warning "conflicting types" } */ + +enum F { F1 = -1, F2, F3 } __attribute__ ((__packed__)); + +enum F fn1(void); /* { dg-message "previous declaration" } */ +signed char fn1(void); /* { dg-warning "conflicting types" } */ + +signed char fn2(void); /* { dg-message "previous declaration" } */ +enum F fn2(void); /* { dg-warning "conflicting types" } */ diff --git a/gcc/testsuite/gcc.dg/Wenum-int-mismatch-2.c b/gcc/testsuite/gcc.dg/Wenum-int-mismatch-2.c new file mode 100644 index 0000000..e5f7500 --- /dev/null +++ b/gcc/testsuite/gcc.dg/Wenum-int-mismatch-2.c @@ -0,0 +1,43 @@ +/* PR c/105131 */ +/* { dg-do compile } */ +/* { dg-options "-Wall -fno-short-enums" } */ + +enum E { E1 = 0, E2, E3 }; + +unsigned int foo(void); /* { dg-message "previous declaration" } */ +enum E foo(void) { return E2; } /* { dg-warning "conflicting types" } */ + +void bar(unsigned int); /* { dg-message "previous declaration" } */ +void bar(enum E); /* { dg-warning "conflicting types" } */ + +extern enum E arr[10]; /* { dg-message "previous declaration" } */ +extern unsigned int arr[10]; /* { dg-warning "conflicting types" } */ + +extern unsigned int i; /* { dg-message "previous declaration" } */ +extern enum E i; /* { dg-warning "conflicting types" } */ + +extern unsigned int *p; /* { dg-message "previous declaration" } */ +extern enum E *p; /* { dg-warning "conflicting types" } */ + +enum E foo2(void) { return E2; } /* { dg-message "previous definition" } */ +unsigned int foo2(void); /* { dg-warning "conflicting types" } */ + +void bar2(enum E); /* { dg-message "previous declaration" } */ +void bar2(unsigned int); /* { dg-warning "conflicting types" } */ + +extern unsigned int arr2[10]; /* { dg-message "previous declaration" } */ +extern enum E arr2[10]; /* { dg-warning "conflicting types" } */ + +extern enum E i2; /* { dg-message "previous declaration" } */ +extern unsigned int i2; /* { dg-warning "conflicting types" } */ + +extern enum E *p2; /* { dg-message "previous declaration" } */ +extern unsigned int *p2; /* { dg-warning "conflicting types" } */ + +enum F { F1 = 1u, F2, F3 } __attribute__ ((__packed__)); + +enum F fn1(void); /* { dg-message "previous declaration" } */ +unsigned char fn1(void); /* { dg-warning "conflicting types" } */ + +unsigned char fn2(void); /* { dg-message "previous declaration" } */ +enum F fn2(void); /* { dg-warning "conflicting types" } */ diff --git a/gcc/testsuite/gcc.dg/Wenum-int-mismatch-3.c b/gcc/testsuite/gcc.dg/Wenum-int-mismatch-3.c new file mode 100644 index 0000000..4ddbeb1 --- /dev/null +++ b/gcc/testsuite/gcc.dg/Wenum-int-mismatch-3.c @@ -0,0 +1,43 @@ +/* PR c/105131 */ +/* { dg-do compile } */ +/* { dg-options "-Wc++-compat -fno-short-enums" } */ + +enum E { E1 = -1, E2 = 0, E3 = 1 }; + +int foo(void); /* { dg-message "previous declaration" } */ +enum E foo(void) { return E2; } /* { dg-warning "conflicting types" } */ + +void bar(int); /* { dg-message "previous declaration" } */ +void bar(enum E); /* { dg-warning "conflicting types" } */ + +extern int arr[10]; /* { dg-message "previous declaration" } */ +extern enum E arr[10]; /* { dg-warning "conflicting types" } */ + +extern int i; /* { dg-message "previous declaration" } */ +extern enum E i; /* { dg-warning "conflicting types" } */ + +extern int *p; /* { dg-message "previous declaration" } */ +extern enum E *p; /* { dg-warning "conflicting types" } */ + +enum E foo2(void) { return E2; } /* { dg-message "previous definition" } */ +int foo2(void); /* { dg-warning "conflicting types" } */ + +void bar2(enum E); /* { dg-message "previous declaration" } */ +void bar2(int); /* { dg-warning "conflicting types" } */ + +extern enum E arr2[10]; /* { dg-message "previous declaration" } */ +extern int arr2[10]; /* { dg-warning "conflicting types" } */ + +extern enum E i2; /* { dg-message "previous declaration" } */ +extern int i2; /* { dg-warning "conflicting types" } */ + +extern enum E *p2; /* { dg-message "previous declaration" } */ +extern int *p2; /* { dg-warning "conflicting types" } */ + +enum F { F1 = -1, F2, F3 } __attribute__ ((__packed__)); + +enum F fn1(void); /* { dg-message "previous declaration" } */ +signed char fn1(void); /* { dg-warning "conflicting types" } */ + +signed char fn2(void); /* { dg-message "previous declaration" } */ +enum F fn2(void); /* { dg-warning "conflicting types" } */ diff --git a/gcc/testsuite/gcc.dg/Wenum-int-mismatch-4.c b/gcc/testsuite/gcc.dg/Wenum-int-mismatch-4.c new file mode 100644 index 0000000..fcaca28 --- /dev/null +++ b/gcc/testsuite/gcc.dg/Wenum-int-mismatch-4.c @@ -0,0 +1,5 @@ +/* PR c/105131 */ +/* { dg-do compile } */ +/* { dg-options "-fno-short-enums" } */ + +#include "Wenum-int-mismatch-1.c" diff --git a/gcc/testsuite/gcc.dg/Wenum-int-mismatch-5.c b/gcc/testsuite/gcc.dg/Wenum-int-mismatch-5.c new file mode 100644 index 0000000..db24fd32 --- /dev/null +++ b/gcc/testsuite/gcc.dg/Wenum-int-mismatch-5.c @@ -0,0 +1,5 @@ +/* PR c/105131 */ +/* { dg-do compile } */ +/* { dg-options "-fno-short-enums" } */ + +#include "Wenum-int-mismatch-2.c" diff --git a/gcc/testsuite/gcc.dg/analyzer/stdarg-1.c b/gcc/testsuite/gcc.dg/analyzer/stdarg-1.c new file mode 100644 index 0000000..295f0ef --- /dev/null +++ b/gcc/testsuite/gcc.dg/analyzer/stdarg-1.c @@ -0,0 +1,433 @@ +#include "analyzer-decls.h" + +/* Unpacking a va_list. */ + +static void __attribute__((noinline)) +__analyzer_called_by_test_1 (int placeholder, ...) +{ + const char *s; + int i; + char c; + + __builtin_va_list ap; + __builtin_va_start (ap, placeholder); + + s = __builtin_va_arg (ap, char *); + __analyzer_eval (s[0] == 'f'); /* { dg-warning "TRUE" } */ + + i = __builtin_va_arg (ap, int); + __analyzer_eval (i == 1066); /* { dg-warning "TRUE" } */ + + c = (char)__builtin_va_arg (ap, int); + __analyzer_eval (c == '@'); /* { dg-warning "TRUE" } */ + + __builtin_va_end (ap); +} + +void test_1 (void) +{ + __analyzer_called_by_test_1 (42, "foo", 1066, '@'); +} + +/* Unpacking a va_list passed from an intermediate function. */ + +static void __attribute__((noinline)) +__analyzer_test_2_inner (__builtin_va_list ap) +{ + const char *s; + int i; + char c; + + s = __builtin_va_arg (ap, char *); + __analyzer_eval (s[0] == 'f'); /* { dg-warning "TRUE" } */ + + i = __builtin_va_arg (ap, int); + __analyzer_eval (i == 1066); /* { dg-warning "TRUE" } */ + + c = (char)__builtin_va_arg (ap, int); + __analyzer_eval (c == '@'); /* { dg-warning "TRUE" } */ +} + +static void __attribute__((noinline)) +__analyzer_test_2_middle (int placeholder, ...) +{ + __builtin_va_list ap; + __builtin_va_start (ap, placeholder); + __analyzer_test_2_inner (ap); + __builtin_va_end (ap); +} + +void test_2 (void) +{ + __analyzer_test_2_middle (42, "foo", 1066, '@'); +} + +/* Not enough args. */ + +static void __attribute__((noinline)) +__analyzer_called_by_test_not_enough_args (int placeholder, ...) +{ + const char *s; + int i; + + __builtin_va_list ap; + __builtin_va_start (ap, placeholder); + + s = __builtin_va_arg (ap, char *); + __analyzer_eval (s[0] == 'f'); /* { dg-warning "TRUE" } */ + + i = __builtin_va_arg (ap, int); /* { dg-warning "'ap' has no more arguments \\(1 consumed\\)" } */ + + __builtin_va_end (ap); +} + +void test_not_enough_args (void) +{ + __analyzer_called_by_test_not_enough_args (42, "foo"); +} + +/* Not enough args, with an intermediate function. */ + +static void __attribute__((noinline)) +__analyzer_test_not_enough_args_2_inner (__builtin_va_list ap) +{ + const char *s; + int i; + + s = __builtin_va_arg (ap, char *); + __analyzer_eval (s[0] == 'f'); /* { dg-warning "TRUE" } */ + + i = __builtin_va_arg (ap, int); /* { dg-warning "'ap' has no more arguments \\(1 consumed\\)" } */ +} + +static void __attribute__((noinline)) +__analyzer_test_not_enough_args_2_middle (int placeholder, ...) +{ + __builtin_va_list ap; + __builtin_va_start (ap, placeholder); + __analyzer_test_not_enough_args_2_inner (ap); + __builtin_va_end (ap); +} + +void test_not_enough_args_2 (void) +{ + __analyzer_test_not_enough_args_2_middle (42, "foo"); +} + +/* Excess args (not a problem). */ + +static void __attribute__((noinline)) +__analyzer_called_by_test_excess_args (int placeholder, ...) +{ + const char *s; + + __builtin_va_list ap; + __builtin_va_start (ap, placeholder); + + s = __builtin_va_arg (ap, char *); + __analyzer_eval (s[0] == 'f'); /* { dg-warning "TRUE" } */ + + __builtin_va_end (ap); +} + +void test_excess_args (void) +{ + __analyzer_called_by_test_excess_args (42, "foo", "bar"); +} + +/* Missing va_start. */ + +void test_missing_va_start (int placeholder, ...) +{ + __builtin_va_list ap; /* { dg-message "region created on stack here" } */ + int i = __builtin_va_arg (ap, int); /* { dg-warning "use of uninitialized value 'ap'" } */ +} + +/* Missing va_end. */ + +void test_missing_va_end (int placeholder, ...) +{ + int i; + __builtin_va_list ap; + __builtin_va_start (ap, placeholder); /* { dg-message "\\(1\\) 'va_start' called here" } */ + i = __builtin_va_arg (ap, int); +} /* { dg-warning "missing call to 'va_end'" "warning" } */ +/* { dg-message "\\(2\\) missing call to 'va_end' to match 'va_start' at \\(1\\)" "final event" { target *-*-* } .-1 } */ + +/* Missing va_end due to error-handling. */ + +int test_missing_va_end_2 (int placeholder, ...) +{ + int i, j; + __builtin_va_list ap; + __builtin_va_start (ap, placeholder); /* { dg-message "\\(1\\) 'va_start' called here" } */ + i = __builtin_va_arg (ap, int); + if (i == 42) + { + __builtin_va_end (ap); + return -1; + } + j = __builtin_va_arg (ap, int); + if (j == 1066) /* { dg-message "branch" } */ + return -1; /* { dg-message "here" } */ + __builtin_va_end (ap); + return 0; +} /* { dg-warning "missing call to 'va_end'" "warning" } */ + +/* va_arg after va_end. */ + +void test_va_arg_after_va_end (int placeholder, ...) +{ + int i; + __builtin_va_list ap; + __builtin_va_start (ap, placeholder); + __builtin_va_end (ap); /* { dg-message "'va_end' called here" } */ + i = __builtin_va_arg (ap, int); /* { dg-warning "'va_arg' after 'va_end'" } */ +} + +/* Type mismatch: expect int, but passed a char *. */ + +static void __attribute__((noinline)) +__analyzer_called_by_test_type_mismatch_1 (int placeholder, ...) +{ + int i; + + __builtin_va_list ap; + __builtin_va_start (ap, placeholder); + + i = __builtin_va_arg (ap, int); /* { dg-warning "'va_arg' expected 'int' but received '\[^\n\r\]*' for variadic argument 1 of 'ap'" } */ + + __builtin_va_end (ap); +} + +void test_type_mismatch_1 (void) +{ + __analyzer_called_by_test_type_mismatch_1 (42, "foo"); +} + +/* Type mismatch: expect char *, but passed an int. */ + +static void __attribute__((noinline)) +__analyzer_called_by_test_type_mismatch_2 (int placeholder, ...) +{ + const char *str; + + __builtin_va_list ap; + __builtin_va_start (ap, placeholder); + + str = __builtin_va_arg (ap, const char *); /* { dg-warning "'va_arg' expected 'const char \\*' but received 'int' for variadic argument 1" } */ + + __builtin_va_end (ap); +} + +void test_type_mismatch_2 (void) +{ + __analyzer_called_by_test_type_mismatch_2 (42, 1066); +} + +/* As above, but with an intermediate function. */ + +static void __attribute__((noinline)) +__analyzer_test_type_mismatch_3_inner (__builtin_va_list ap) +{ + const char *str; + + str = __builtin_va_arg (ap, const char *); /* { dg-warning "'va_arg' expected 'const char \\*' but received 'int' for variadic argument 1 of 'ap'" } */ +} + +static void __attribute__((noinline)) +__analyzer_test_type_mismatch_3_middle (int placeholder, ...) +{ + __builtin_va_list ap; + __builtin_va_start (ap, placeholder); + + __analyzer_test_type_mismatch_3_inner (ap); + + __builtin_va_end (ap); +} + +void test_type_mismatch_3 (void) +{ + __analyzer_test_type_mismatch_3_middle (42, 1066); +} + +/* Multiple traversals of the args. */ + +static void __attribute__((noinline)) +__analyzer_called_by_test_multiple_traversals (int placeholder, ...) +{ + __builtin_va_list ap; + + /* First traversal. */ + { + int i, j; + + __builtin_va_start (ap, placeholder); + + i = __builtin_va_arg (ap, int); + __analyzer_eval (i == 1066); /* { dg-warning "TRUE" } */ + + j = __builtin_va_arg (ap, int); + __analyzer_eval (j == 42); /* { dg-warning "TRUE" } */ + + __builtin_va_end (ap); + } + + /* Second traversal. */ + { + int i, j; + + __builtin_va_start (ap, placeholder); + + i = __builtin_va_arg (ap, int); + __analyzer_eval (i == 1066); /* { dg-warning "TRUE" } */ + + j = __builtin_va_arg (ap, int); + __analyzer_eval (j == 42); /* { dg-warning "TRUE" } */ + + __builtin_va_end (ap); + } +} + +void test_multiple_traversals (void) +{ + __analyzer_called_by_test_multiple_traversals (0, 1066, 42); +} + +/* Multiple traversals, using va_copy. */ + +static void __attribute__((noinline)) +__analyzer_called_by_test_multiple_traversals_2 (int placeholder, ...) +{ + int i, j; + __builtin_va_list args1; + __builtin_va_list args2; + + __builtin_va_start (args1, placeholder); + __builtin_va_copy (args2, args1); + + /* First traversal. */ + i = __builtin_va_arg (args1, int); + __analyzer_eval (i == 1066); /* { dg-warning "TRUE" } */ + j = __builtin_va_arg (args1, int); + __analyzer_eval (j == 42); /* { dg-warning "TRUE" } */ + __builtin_va_end (args1); + + /* Traversal of copy. */ + i = __builtin_va_arg (args2, int); + __analyzer_eval (i == 1066); /* { dg-warning "TRUE" } */ + j = __builtin_va_arg (args2, int); + __analyzer_eval (j == 42); /* { dg-warning "TRUE" } */ + __builtin_va_end (args2); +} + +void test_multiple_traversals_2 (void) +{ + __analyzer_called_by_test_multiple_traversals_2 (0, 1066, 42); +} + +/* Multiple traversals, using va_copy after a va_arg. */ + +static void __attribute__((noinline)) +__analyzer_called_by_test_multiple_traversals_3 (int placeholder, ...) +{ + int i, j; + __builtin_va_list args1; + __builtin_va_list args2; + + __builtin_va_start (args1, placeholder); + + /* First traversal. */ + i = __builtin_va_arg (args1, int); + __analyzer_eval (i == 1066); /* { dg-warning "TRUE" } */ + + /* va_copy after the first va_arg. */ + __builtin_va_copy (args2, args1); + + j = __builtin_va_arg (args1, int); + __analyzer_eval (j == 42); /* { dg-warning "TRUE" } */ + __builtin_va_end (args1); + + /* Traversal of copy. */ + j = __builtin_va_arg (args2, int); + __analyzer_eval (j == 42); /* { dg-warning "TRUE" } */ + __builtin_va_end (args2); +} + +void test_multiple_traversals_3 (void) +{ + __analyzer_called_by_test_multiple_traversals_3 (0, 1066, 42); +} + +/* va_copy after va_end. */ + +void test_va_copy_after_va_end (int placeholder, ...) +{ + __builtin_va_list ap1, ap2; + __builtin_va_start (ap1, placeholder); + __builtin_va_end (ap1); /* { dg-message "'va_end' called here" } */ + __builtin_va_copy (ap2, ap1); /* { dg-warning "'va_copy' after 'va_end'" } */ + __builtin_va_end (ap2); +} + +/* leak of va_copy. */ + +void test_leak_of_va_copy (int placeholder, ...) +{ + __builtin_va_list ap1, ap2; + __builtin_va_start (ap1, placeholder); + __builtin_va_copy (ap2, ap1); /* { dg-message "'va_copy' called here" } */ + __builtin_va_end (ap1); +} /* { dg-warning "missing call to 'va_end'" "warning" } */ + /* { dg-message "missing call to 'va_end' to match 'va_copy' at \\(1\\)" "final event" { target *-*-* } .-1 } */ + +/* double va_end. */ + +void test_double_va_end (int placeholder, ...) +{ + __builtin_va_list ap; + __builtin_va_start (ap, placeholder); + __builtin_va_end (ap); /* { dg-message "'va_end' called here" } */ + __builtin_va_end (ap); /* { dg-warning "'va_end' after 'va_end'" } */ +} + +/* double va_start. */ + +void test_double_va_start (int placeholder, ...) +{ + int i; + __builtin_va_list ap; + __builtin_va_start (ap, placeholder); /* { dg-message "'va_start' called here" } */ + __builtin_va_start (ap, placeholder); /* { dg-warning "missing call to 'va_end'" "warning" } */ + /* { dg-message "missing call to 'va_end' to match 'va_start' at \\(1\\)" "final event" { target *-*-* } .-1 } */ + __builtin_va_end (ap); +} + +/* va_copy before va_start. */ + +void test_va_copy_before_va_start (int placeholder, ...) +{ + __builtin_va_list ap1; /* { dg-message "region created on stack here" } */ + __builtin_va_list ap2; + __builtin_va_copy (ap2, ap1); /* { dg-warning "use of uninitialized value 'ap1'" } */ + __builtin_va_end (ap2); +} + +/* Verify that we complain about uses of a va_list after the function + in which va_start was called has returned. */ + +__builtin_va_list global_ap; + +static void __attribute__((noinline)) +__analyzer_called_by_test_va_arg_after_return (int placeholder, ...) +{ + __builtin_va_start (global_ap, placeholder); + __builtin_va_end (global_ap); +} + +void test_va_arg_after_return (void) +{ + int i; + __analyzer_called_by_test_va_arg_after_return (42, 1066); + i = __builtin_va_arg (global_ap, int); /* { dg-warning "dereferencing pointer 'global_ap' to within stale stack frame" } */ +} diff --git a/gcc/testsuite/gcc.dg/analyzer/stdarg-2.c b/gcc/testsuite/gcc.dg/analyzer/stdarg-2.c new file mode 100644 index 0000000..69a2acb --- /dev/null +++ b/gcc/testsuite/gcc.dg/analyzer/stdarg-2.c @@ -0,0 +1,436 @@ +/* As per stdarg-1.c, but using <stdarg.h>, rather than hardcoded builtins. */ + +#include <stdarg.h> +#include "analyzer-decls.h" + +/* Unpacking a va_list. */ + +static void __attribute__((noinline)) +__analyzer_called_by_test_1 (int placeholder, ...) +{ + const char *s; + int i; + char c; + + va_list ap; + va_start (ap, placeholder); + + s = va_arg (ap, char *); + __analyzer_eval (s[0] == 'f'); /* { dg-warning "TRUE" } */ + + i = va_arg (ap, int); + __analyzer_eval (i == 1066); /* { dg-warning "TRUE" } */ + + c = (char)va_arg (ap, int); + __analyzer_eval (c == '@'); /* { dg-warning "TRUE" } */ + + va_end (ap); +} + +void test_1 (void) +{ + __analyzer_called_by_test_1 (42, "foo", 1066, '@'); +} + +/* Unpacking a va_list passed from an intermediate function. */ + +static void __attribute__((noinline)) +__analyzer_test_2_inner (va_list ap) +{ + const char *s; + int i; + char c; + + s = va_arg (ap, char *); + __analyzer_eval (s[0] == 'f'); /* { dg-warning "TRUE" } */ + + i = va_arg (ap, int); + __analyzer_eval (i == 1066); /* { dg-warning "TRUE" } */ + + c = (char)va_arg (ap, int); + __analyzer_eval (c == '@'); /* { dg-warning "TRUE" } */ +} + +static void __attribute__((noinline)) +__analyzer_test_2_middle (int placeholder, ...) +{ + va_list ap; + va_start (ap, placeholder); + __analyzer_test_2_inner (ap); + va_end (ap); +} + +void test_2 (void) +{ + __analyzer_test_2_middle (42, "foo", 1066, '@'); +} + +/* Not enough args. */ + +static void __attribute__((noinline)) +__analyzer_called_by_test_not_enough_args (int placeholder, ...) +{ + const char *s; + int i; + + va_list ap; + va_start (ap, placeholder); + + s = va_arg (ap, char *); + __analyzer_eval (s[0] == 'f'); /* { dg-warning "TRUE" } */ + + i = va_arg (ap, int); /* { dg-warning "'ap' has no more arguments \\(1 consumed\\)" } */ + + va_end (ap); +} + +void test_not_enough_args (void) +{ + __analyzer_called_by_test_not_enough_args (42, "foo"); +} + +/* Not enough args, with an intermediate function. */ + +static void __attribute__((noinline)) +__analyzer_test_not_enough_args_2_inner (va_list ap) +{ + const char *s; + int i; + + s = va_arg (ap, char *); + __analyzer_eval (s[0] == 'f'); /* { dg-warning "TRUE" } */ + + i = va_arg (ap, int); /* { dg-warning "'ap' has no more arguments \\(1 consumed\\)" } */ +} + +static void __attribute__((noinline)) +__analyzer_test_not_enough_args_2_middle (int placeholder, ...) +{ + va_list ap; + va_start (ap, placeholder); + __analyzer_test_not_enough_args_2_inner (ap); + va_end (ap); +} + +void test_not_enough_args_2 (void) +{ + __analyzer_test_not_enough_args_2_middle (42, "foo"); +} + +/* Excess args (not a problem). */ + +static void __attribute__((noinline)) +__analyzer_called_by_test_excess_args (int placeholder, ...) +{ + const char *s; + + va_list ap; + va_start (ap, placeholder); + + s = va_arg (ap, char *); + __analyzer_eval (s[0] == 'f'); /* { dg-warning "TRUE" } */ + + va_end (ap); +} + +void test_excess_args (void) +{ + __analyzer_called_by_test_excess_args (42, "foo", "bar"); +} + +/* Missing va_start. */ + +void test_missing_va_start (int placeholder, ...) +{ + va_list ap; /* { dg-message "region created on stack here" } */ + int i = va_arg (ap, int); /* { dg-warning "use of uninitialized value 'ap'" } */ +} + +/* Missing va_end. */ + +void test_missing_va_end (int placeholder, ...) +{ + int i; + va_list ap; + va_start (ap, placeholder); /* { dg-message "\\(1\\) 'va_start' called here" } */ + i = va_arg (ap, int); +} /* { dg-warning "missing call to 'va_end'" "warning" } */ +/* { dg-message "\\(2\\) missing call to 'va_end' to match 'va_start' at \\(1\\)" "final event" { target *-*-* } .-1 } */ + +/* Missing va_end due to error-handling. */ + +int test_missing_va_end_2 (int placeholder, ...) +{ + int i, j; + va_list ap; + va_start (ap, placeholder); /* { dg-message "\\(1\\) 'va_start' called here" } */ + i = va_arg (ap, int); + if (i == 42) + { + va_end (ap); + return -1; + } + j = va_arg (ap, int); + if (j == 1066) /* { dg-message "branch" } */ + return -1; /* { dg-message "here" } */ + va_end (ap); + return 0; +} /* { dg-warning "missing call to 'va_end'" "warning" } */ + +/* va_arg after va_end. */ + +void test_va_arg_after_va_end (int placeholder, ...) +{ + int i; + va_list ap; + va_start (ap, placeholder); + va_end (ap); /* { dg-message "'va_end' called here" } */ + i = va_arg (ap, int); /* { dg-warning "'va_arg' after 'va_end'" } */ +} + +/* Type mismatch: expect int, but passed a char *. */ + +static void __attribute__((noinline)) +__analyzer_called_by_test_type_mismatch_1 (int placeholder, ...) +{ + int i; + + va_list ap; + va_start (ap, placeholder); + + i = va_arg (ap, int); /* { dg-warning "'va_arg' expected 'int' but received '\[^\n\r\]*' for variadic argument 1 of 'ap'" } */ + + va_end (ap); +} + +void test_type_mismatch_1 (void) +{ + __analyzer_called_by_test_type_mismatch_1 (42, "foo"); +} + +/* Type mismatch: expect char *, but passed an int. */ + +static void __attribute__((noinline)) +__analyzer_called_by_test_type_mismatch_2 (int placeholder, ...) +{ + const char *str; + + va_list ap; + va_start (ap, placeholder); + + str = va_arg (ap, const char *); /* { dg-warning "'va_arg' expected 'const char \\*' but received 'int' for variadic argument 1 of 'ap'" } */ + + va_end (ap); +} + +void test_type_mismatch_2 (void) +{ + __analyzer_called_by_test_type_mismatch_2 (42, 1066); +} + +/* As above, but with an intermediate function. */ + +static void __attribute__((noinline)) +__analyzer_test_type_mismatch_3_inner (va_list ap) +{ + const char *str; + + str = va_arg (ap, const char *); /* { dg-warning "'va_arg' expected 'const char \\*' but received 'int' for variadic argument 1 of 'ap'" } */ +} + +static void __attribute__((noinline)) +__analyzer_test_type_mismatch_3_middle (int placeholder, ...) +{ + va_list ap; + va_start (ap, placeholder); + + __analyzer_test_type_mismatch_3_inner (ap); + + va_end (ap); +} + +void test_type_mismatch_3 (void) +{ + __analyzer_test_type_mismatch_3_middle (42, 1066); +} + +/* Multiple traversals of the args. */ + +static void __attribute__((noinline)) +__analyzer_called_by_test_multiple_traversals (int placeholder, ...) +{ + va_list ap; + + /* First traversal. */ + { + int i, j; + + va_start (ap, placeholder); + + i = va_arg (ap, int); + __analyzer_eval (i == 1066); /* { dg-warning "TRUE" } */ + + j = va_arg (ap, int); + __analyzer_eval (j == 42); /* { dg-warning "TRUE" } */ + + va_end (ap); + } + + /* Second traversal. */ + { + int i, j; + + va_start (ap, placeholder); + + i = va_arg (ap, int); + __analyzer_eval (i == 1066); /* { dg-warning "TRUE" } */ + + j = va_arg (ap, int); + __analyzer_eval (j == 42); /* { dg-warning "TRUE" } */ + + va_end (ap); + } +} + +void test_multiple_traversals (void) +{ + __analyzer_called_by_test_multiple_traversals (0, 1066, 42); +} + +/* Multiple traversals, using va_copy. */ + +static void __attribute__((noinline)) +__analyzer_called_by_test_multiple_traversals_2 (int placeholder, ...) +{ + int i, j; + va_list args1; + va_list args2; + + va_start (args1, placeholder); + va_copy (args2, args1); + + /* First traversal. */ + i = va_arg (args1, int); + __analyzer_eval (i == 1066); /* { dg-warning "TRUE" } */ + j = va_arg (args1, int); + __analyzer_eval (j == 42); /* { dg-warning "TRUE" } */ + va_end (args1); + + /* Traversal of copy. */ + i = va_arg (args2, int); + __analyzer_eval (i == 1066); /* { dg-warning "TRUE" } */ + j = va_arg (args2, int); + __analyzer_eval (j == 42); /* { dg-warning "TRUE" } */ + va_end (args2); +} + +void test_multiple_traversals_2 (void) +{ + __analyzer_called_by_test_multiple_traversals_2 (0, 1066, 42); +} + +/* Multiple traversals, using va_copy after a va_arg. */ + +static void __attribute__((noinline)) +__analyzer_called_by_test_multiple_traversals_3 (int placeholder, ...) +{ + int i, j; + va_list args1; + va_list args2; + + va_start (args1, placeholder); + + /* First traversal. */ + i = va_arg (args1, int); + __analyzer_eval (i == 1066); /* { dg-warning "TRUE" } */ + + /* va_copy after the first va_arg. */ + va_copy (args2, args1); + + j = va_arg (args1, int); + __analyzer_eval (j == 42); /* { dg-warning "TRUE" } */ + va_end (args1); + + /* Traversal of copy. */ + j = va_arg (args2, int); + __analyzer_eval (j == 42); /* { dg-warning "TRUE" } */ + va_end (args2); +} + +void test_multiple_traversals_3 (void) +{ + __analyzer_called_by_test_multiple_traversals_3 (0, 1066, 42); +} + +/* va_copy after va_end. */ + +void test_va_copy_after_va_end (int placeholder, ...) +{ + va_list ap1, ap2; + va_start (ap1, placeholder); + va_end (ap1); /* { dg-message "'va_end' called here" } */ + va_copy (ap2, ap1); /* { dg-warning "'va_copy' after 'va_end'" } */ + va_end (ap2); +} + +/* leak of va_copy. */ + +void test_leak_of_va_copy (int placeholder, ...) +{ + va_list ap1, ap2; + va_start (ap1, placeholder); + va_copy (ap2, ap1); /* { dg-message "'va_copy' called here" } */ + va_end (ap1); +} /* { dg-warning "missing call to 'va_end'" "warning" } */ + /* { dg-message "missing call to 'va_end' to match 'va_copy' at \\(1\\)" "final event" { target *-*-* } .-1 } */ + +/* double va_end. */ + +void test_double_va_end (int placeholder, ...) +{ + va_list ap; + va_start (ap, placeholder); + va_end (ap); /* { dg-message "'va_end' called here" } */ + va_end (ap); /* { dg-warning "'va_end' after 'va_end'" } */ +} + +/* double va_start. */ + +void test_double_va_start (int placeholder, ...) +{ + int i; + va_list ap; + va_start (ap, placeholder); /* { dg-message "'va_start' called here" } */ + va_start (ap, placeholder); /* { dg-warning "missing call to 'va_end'" "warning" } */ + /* { dg-message "missing call to 'va_end' to match 'va_start' at \\(1\\)" "final event" { target *-*-* } .-1 } */ + va_end (ap); +} + +/* va_copy before va_start. */ + +void test_va_copy_before_va_start (int placeholder, ...) +{ + va_list ap1; /* { dg-message "region created on stack here" } */ + va_list ap2; + va_copy (ap2, ap1); /* { dg-warning "use of uninitialized value 'ap1'" } */ + va_end (ap2); +} + +/* Verify that we complain about uses of a va_list after the function + in which va_start was called has returned. */ + +va_list global_ap; + +static void __attribute__((noinline)) +__analyzer_called_by_test_va_arg_after_return (int placeholder, ...) +{ + va_start (global_ap, placeholder); + va_end (global_ap); +} + +void test_va_arg_after_return (void) +{ + int i; + __analyzer_called_by_test_va_arg_after_return (42, 1066); + i = va_arg (global_ap, int); /* { dg-warning "dereferencing pointer 'global_ap' to within stale stack frame" } */ +} diff --git a/gcc/testsuite/gcc.dg/analyzer/stdarg-fmtstring-1.c b/gcc/testsuite/gcc.dg/analyzer/stdarg-fmtstring-1.c new file mode 100644 index 0000000..3892c3c --- /dev/null +++ b/gcc/testsuite/gcc.dg/analyzer/stdarg-fmtstring-1.c @@ -0,0 +1,103 @@ +/* { dg-additional-options "-fno-analyzer-call-summaries -fno-analyzer-state-merge -Wno-analyzer-too-complex" } */ + +void test_format_string (const char *fmt, ...) +{ + __builtin_va_list ap; + __builtin_va_start (ap, fmt); + while (*fmt) + switch (*fmt++) + { + case 's': + { + const char *s = __builtin_va_arg (ap, char *); /* { dg-warning "'va_arg' expected 'const char \\*' but received 'int' for variadic argument 1 of 'ap'" } */ + __builtin_printf ("string: %s\n", s); + } + break; + case 'd': + { + int i = __builtin_va_arg (ap, int); /* { dg-warning "'va_arg' expected 'int' but received '\[^\n\r\]*' for variadic argument 1 of 'ap'" "type mismatch from wrong_type_for_percent_d" } */ + /* { dg-warning "'ap' has no more arguments \\(1 consumed\\)" "not_enough_args" { target *-*-* } .-1 } */ + __builtin_printf ("int: %d\n", i); + } + break; + case 'c': + { + char c = (char)__builtin_va_arg (ap, int); + __builtin_printf ("char: %c\n", c); + } + break; + } + __builtin_va_end (ap); +} + +void test_missing_va_start (const char *fmt, ...) +{ + __builtin_va_list ap; + + while (*fmt) + switch (*fmt++) + { + case 's': + { + const char *s = __builtin_va_arg (ap, char *); /* { dg-warning "use of uninitialized value 'ap'" } */ + __builtin_printf ("string: %s\n", s); + } + break; + case 'd': + { + int i = __builtin_va_arg (ap, int); /* { dg-warning "use of uninitialized value 'ap'" } */ + __builtin_printf ("int: %d\n", i); + } + break; + case 'c': + { + char c = (char)__builtin_va_arg (ap, int); /* { dg-warning "use of uninitialized value 'ap'" } */ + __builtin_printf ("char: %c\n", c); + } + break; + } + __builtin_va_end (ap); +} + +void test_missing_va_end (const char *fmt, ...) +{ + __builtin_va_list ap; + __builtin_va_start (ap, fmt); + while (*fmt) + switch (*fmt++) + { + case 's': + { + const char *s = __builtin_va_arg (ap, char *); + __builtin_printf ("string: %s\n", s); + } + break; + case 'd': + { + int i = __builtin_va_arg (ap, int); + __builtin_printf ("int: %d\n", i); + } + break; + case 'c': + { + char c = (char)__builtin_va_arg (ap, int); + __builtin_printf ("char: %c\n", c); + } + break; + } +} /* { dg-warning "missing call to 'va_end'" } */ + +void wrong_type_for_percent_s (void) +{ + test_format_string ("%s", 42); +} + +void wrong_type_for_percent_d (void) +{ + test_format_string ("%d", "foo"); +} + +void not_enough_args (void) +{ + test_format_string ("%s%d", "foo"); +} diff --git a/gcc/testsuite/gcc.dg/analyzer/stdarg-lto-1-a.c b/gcc/testsuite/gcc.dg/analyzer/stdarg-lto-1-a.c new file mode 100644 index 0000000..f56ad88 --- /dev/null +++ b/gcc/testsuite/gcc.dg/analyzer/stdarg-lto-1-a.c @@ -0,0 +1,24 @@ +/* { dg-do link } */ +/* { dg-require-effective-target lto } */ +/* { dg-additional-options "-flto" } */ +/* { dg-additional-sources stdarg-lto-1-b.c } */ + +#include <stdarg.h> +#include "stdarg-lto-1.h" + +/* Type mismatch: expect const char *, but passed an int. */ + +void +called_by_test_type_mismatch_1 (int placeholder, ...) +{ + const char *str; + + va_list ap; + va_start (ap, placeholder); + + str = va_arg (ap, const char *); /* { dg-warning "'va_arg' expected '\[^\n\r\]*' but received 'int' for variadic argument 1 of 'ap'" } */ + + va_end (ap); +} + +int main() { return 0; } diff --git a/gcc/testsuite/gcc.dg/analyzer/stdarg-lto-1-b.c b/gcc/testsuite/gcc.dg/analyzer/stdarg-lto-1-b.c new file mode 100644 index 0000000..edd51f0 --- /dev/null +++ b/gcc/testsuite/gcc.dg/analyzer/stdarg-lto-1-b.c @@ -0,0 +1,6 @@ +#include "stdarg-lto-1.h" + +void test_type_mismatch_1 (void) +{ + called_by_test_type_mismatch_1 (42, 1066); +} diff --git a/gcc/testsuite/gcc.dg/analyzer/stdarg-lto-1.h b/gcc/testsuite/gcc.dg/analyzer/stdarg-lto-1.h new file mode 100644 index 0000000..6983574 --- /dev/null +++ b/gcc/testsuite/gcc.dg/analyzer/stdarg-lto-1.h @@ -0,0 +1 @@ +extern void called_by_test_type_mismatch_1 (int placeholder, ...); diff --git a/gcc/testsuite/gcc.dg/analyzer/stdarg-sentinel-1.c b/gcc/testsuite/gcc.dg/analyzer/stdarg-sentinel-1.c new file mode 100644 index 0000000..f8c1f0e --- /dev/null +++ b/gcc/testsuite/gcc.dg/analyzer/stdarg-sentinel-1.c @@ -0,0 +1,25 @@ +/* { dg-additional-options "-Wno-analyzer-too-complex" } */ + +#define NULL ((void *)0) + +void test_sentinel (int arg, ...) +{ + const char *s; + __builtin_va_list ap; + __builtin_va_start (ap, arg); + while (s = __builtin_va_arg (ap, char *)) /* { dg-warning "'ap' has no more arguments \\(2 consumed\\)" } */ + { + (void)s; + } + __builtin_va_end (ap); +} + +void test_caller (void) +{ + test_sentinel (42, "foo", "bar", NULL); +} + +void missing_sentinel (void) +{ + test_sentinel (42, "foo", "bar"); +} diff --git a/gcc/testsuite/gcc.dg/analyzer/stdarg-types-1.c b/gcc/testsuite/gcc.dg/analyzer/stdarg-types-1.c new file mode 100644 index 0000000..dcea87e --- /dev/null +++ b/gcc/testsuite/gcc.dg/analyzer/stdarg-types-1.c @@ -0,0 +1,25 @@ +/* { dg-require-effective-target int32 } */ +/* { dg-require-effective-target lp64 } */ + +/* Type mismatch: expect long, but passed an int. */ + +static void __attribute__((noinline)) +__analyzer_consume_long (int placeholder, ...) +{ + long v; + __builtin_va_list ap; + __builtin_va_start (ap, placeholder); + v = __builtin_va_arg (ap, long); /* { dg-warning "'va_arg' expected 'long int' but received 'int' for variadic argument 1 of 'ap'" } */ + __builtin_va_end (ap); +} + +void test_int_to_long (void) +{ + __analyzer_consume_long (42, 1066); +} + +void test_char_to_long (void) +{ + /* char promoted to int. */ + __analyzer_consume_long (42, 'a'); +} diff --git a/gcc/testsuite/gcc.dg/analyzer/stdarg-types-2.c b/gcc/testsuite/gcc.dg/analyzer/stdarg-types-2.c new file mode 100644 index 0000000..39d5c6e --- /dev/null +++ b/gcc/testsuite/gcc.dg/analyzer/stdarg-types-2.c @@ -0,0 +1,55 @@ +/* Should be OK to add a "const" qualifier to a ptr. */ + +static void __attribute__((noinline)) +__analyzer_consume_const_char_ptr (int placeholder, ...) +{ + const char *v; + __builtin_va_list ap; + __builtin_va_start (ap, placeholder); + v = __builtin_va_arg (ap, const char *); + __builtin_va_end (ap); +} + +void test_char_ptr_to_const_char_ptr (char *p) +{ + __analyzer_consume_const_char_ptr (42, p); /* { dg-bogus "" } */ +} + +/* What about casting away const-ness? + Currently we don't complain. */ + +static void __attribute__((noinline)) +__analyzer_consume_char_ptr (int placeholder, ...) +{ + char *v; + __builtin_va_list ap; + __builtin_va_start (ap, placeholder); + v = __builtin_va_arg (ap, char *); + __builtin_va_end (ap); +} + +void test_const_char_ptr_to_char_ptr (const char *p) +{ + __analyzer_consume_const_char_ptr (42, p); +} + +/* What about casting ptrs? + Currently we don't complain. */ + +struct foo; +struct bar; + +static void __attribute__((noinline)) +__analyzer_consume_bar_ptr (int placeholder, ...) +{ + struct bar *v; + __builtin_va_list ap; + __builtin_va_start (ap, placeholder); + v = __builtin_va_arg (ap, struct bar *); + __builtin_va_end (ap); +} + +void test_foo_ptr_to_bar_ptr (struct foo *p) +{ + __analyzer_consume_bar_ptr (42, p); +} diff --git a/gcc/testsuite/gcc.dg/graphite/scop-22a.c b/gcc/testsuite/gcc.dg/graphite/scop-22a.c new file mode 100644 index 0000000..00d4b53 --- /dev/null +++ b/gcc/testsuite/gcc.dg/graphite/scop-22a.c @@ -0,0 +1,56 @@ +/* { dg-require-effective-target size32plus } */ +double u[1782225]; + +void foo(int N, int *res) +{ + int i, j; + double a, b; + double sum = 0.0; + + for (j = 3; j < N; j = j * j) + { + sum += a + b; + } + + /* Next two loops form first SCoP */ + for (i = 0; i < N; i++) + sum += u[i]; + + for (i = 0; i < N; i++) + { + a = u[i]; + u[i] = i * i; + b = u[i]; + sum += a + b; + } + + for (j = 3; j < N; j = j * j) + { + sum += a + b; + } + + for (j = 3; j < N; j = j * j) + { + sum += a + b; + } + + /* Next two loop-nests form second SCoP */ + for (i = 0; i < N; i++) + sum += u[i]; + + for (i = 0; i < N; i++) + for (j = 0; j < N; j++) + { + a = u[i]; + u[i] = i * i; + b = u[j]; + sum += a + b; + } + + *res = sum + N; +} + +/* { dg-final { scan-tree-dump-times "number of SCoPs: 2" 1 "graphite"} } */ +/* { dg-final { scan-tree-dump-times "Loops in SCoP" 2 "graphite"} } */ +/* { dg-final { scan-tree-dump "Loops in SCoP: 2, 3" "graphite"} } */ +/* { dg-final { scan-tree-dump "Loops in SCoP: 6, 7, 8" "graphite"} } */ diff --git a/gcc/testsuite/gcc.dg/pr105458.c b/gcc/testsuite/gcc.dg/pr105458.c new file mode 100644 index 0000000..eb58bf2 --- /dev/null +++ b/gcc/testsuite/gcc.dg/pr105458.c @@ -0,0 +1,20 @@ +/* PR tree-optimization/105458 */ +/* { dg-do compile } */ +/* { dg-options "-O1 -fexpensive-optimizations -fno-tree-dominator-opts " } */ + +void +yj (int j4) +{ + int t3; + + for (t3 = 0; t3 < 6; ++t3) + { + short int v4 = t3; + + if (v4 == j4 || v4 > t3) + for (;;) + { + } + } +} + diff --git a/gcc/testsuite/gcc.dg/pr105591.c b/gcc/testsuite/gcc.dg/pr105591.c new file mode 100644 index 0000000..9554c42 --- /dev/null +++ b/gcc/testsuite/gcc.dg/pr105591.c @@ -0,0 +1,12 @@ +/* { dg-do compile } */ +/* { dg-options "-Wno-psabi -O" } */ +/* { dg-additional-options "-mavx" { target x86_64-*-* i?86-*-* } } */ +typedef unsigned long long __attribute__((__vector_size__ (16))) U; +typedef unsigned long long __attribute__((__vector_size__ (32))) V; + +V +foo (U u) +{ + U x = __builtin_shuffle (u, (U) { 0xBE2ED0AB630B33FE }); + return __builtin_shufflevector (u, x, 2, 1, 0, 3); +} diff --git a/gcc/testsuite/gcc.dg/pr105630.c b/gcc/testsuite/gcc.dg/pr105630.c new file mode 100644 index 0000000..c39ca7d --- /dev/null +++ b/gcc/testsuite/gcc.dg/pr105630.c @@ -0,0 +1,22 @@ +/* PR debug/105630 */ +/* { dg-do compile { target pthread } } */ +/* { dg-options "-O1 -ftree-parallelize-loops=2 -fcompare-debug" } */ + +int m; +static int n; + +void +foo (void) +{ + int *arr[] = { &n, &n, &n }; + int unused = n; + + m = 0; +} + +void +bar (int *arr, int i) +{ + while (i < 1) + arr[i++] = 1; +} diff --git a/gcc/testsuite/gcc.dg/pr105635.c b/gcc/testsuite/gcc.dg/pr105635.c new file mode 100644 index 0000000..aa02f59 --- /dev/null +++ b/gcc/testsuite/gcc.dg/pr105635.c @@ -0,0 +1,11 @@ +/* PR c/105635 */ +/* { dg-do compile } */ +/* { dg-options "-Wall" } */ + +void foo (int, int[*]); /* { dg-message "previous declaration of 'foo' with type" } */ + +foo (int x, int y) /* { dg-warning "return type defaults to 'int'" } */ +{ /* { dg-warning "conflicting types for 'foo'" "" { target *-*-* } .-1 } */ + /* { dg-message "declared here" "" { target *-*-* } .-2 } */ + return (x >= 0) != (y < 0); /* { dg-warning "'return' with a value, in function returning void" } */ +} diff --git a/gcc/testsuite/gcc.dg/torture/pr105598.c b/gcc/testsuite/gcc.dg/torture/pr105598.c new file mode 100644 index 0000000..0a4ea3b --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/pr105598.c @@ -0,0 +1,32 @@ +/* { dg-do run } */ + +typedef struct { unsigned int num; } info_t; +typedef struct { unsigned int flag, type; } block_t; +info_t info; +block_t blocks[] = { {2,0}, {3,0}, {1,0}, {1,0} }; + +static block_t * +f (info_t *i, block_t *b) +{ + while (1) { + unsigned int is_last = b->flag & 0x01; + i->num++; + if (b->flag & 0x02) { + if (b->type != 0x1) b->type = b->type; + b = f (i, b+1); + } + if (is_last) + break; + b++; + } + return b; +} + +int +main () +{ + f(&info, &blocks[0]); + if (info.num != 4) + __builtin_abort (); + return 0; +} diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ssa-sink-19.c b/gcc/testsuite/gcc.dg/tree-ssa/ssa-sink-19.c new file mode 100644 index 0000000..e98d13f --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/ssa-sink-19.c @@ -0,0 +1,21 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-sink1-details -fdump-tree-cddce2-details" } */ + +static int b=4; +int c; + +int +main() +{ + int e[5] = {1,1,1,1,1}; + for (; b >= 0; b--) { + c = e[b]; + } + return 0; +} + +/* We should sink e[b] out of the loop which is possible after + applying store motion to c and b. */ +/* { dg-final { scan-tree-dump "Sinking # VUSE" "sink1" } } */ +/* And remove the loop after final value replacement. */ +/* { dg-final { scan-tree-dump "fix_loop_structure: removing loop" "cddce2" } } */ diff --git a/gcc/testsuite/gcc.target/i386/bmi-andn-3.c b/gcc/testsuite/gcc.target/i386/bmi-andn-3.c new file mode 100644 index 0000000..16993a3 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/bmi-andn-3.c @@ -0,0 +1,15 @@ +/* { dg-do compile } */ +/* { dg-options "-Oz -mbmi" } */ +int m; + +int foo(int x, int y) +{ + return (x & ~y) != 0; +} + +int bar(int x) +{ + return (~x & m) != 0; +} +/* { dg-final { scan-assembler-not "andn\[ \\t\]+" } } */ + diff --git a/gcc/testsuite/gcc.target/i386/pr103462-1.c b/gcc/testsuite/gcc.target/i386/pr103462-1.c new file mode 100644 index 0000000..1dc4c2a --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr103462-1.c @@ -0,0 +1,111 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-sccp-details" } */ +/* { dg-final { scan-tree-dump-times {final value replacement} 12 "sccp" } } */ + +unsigned long long +__attribute__((noipa)) +foo (unsigned long long tmp) +{ + for (int bit = 0; bit < 64; bit += 3) + tmp &= ~(1ULL << bit); + return tmp; +} + +unsigned long long +__attribute__((noipa)) +foo1 (unsigned long long tmp) +{ + for (int bit = 63; bit >= 0; bit -= 3) + tmp &= ~(1ULL << bit); + return tmp; +} + +unsigned long long +__attribute__((noipa)) +foo2 (unsigned long long tmp) +{ + for (int bit = 0; bit < 64; bit += 3) + tmp &= (1ULL << bit); + return tmp; +} + +unsigned long long +__attribute__((noipa)) +foo3 (unsigned long long tmp) +{ + for (int bit = 63; bit >= 0; bit -= 3) + tmp &= (1ULL << bit); + return tmp; +} + +unsigned long long +__attribute__((noipa)) +foo4 (unsigned long long tmp) +{ + for (int bit = 0; bit < 64; bit += 3) + tmp |= ~(1ULL << bit); + return tmp; +} + +unsigned long long +__attribute__((noipa)) +foo5 (unsigned long long tmp) +{ + for (int bit = 63; bit >= 0; bit -= 3) + tmp |= ~(1ULL << bit); + return tmp; +} + +unsigned long long +__attribute__((noipa)) +foo6 (unsigned long long tmp) +{ + for (int bit = 0; bit < 64; bit += 3) + tmp |= (1ULL << bit); + return tmp; +} + +unsigned long long +__attribute__((noipa)) +foo7 (unsigned long long tmp) +{ + for (int bit = 63; bit >= 0; bit -= 3) + tmp |= (1ULL << bit); + return tmp; +} + +unsigned long long +__attribute__((noipa)) +foo8 (unsigned long long tmp) +{ + for (int bit = 0; bit < 64; bit += 3) + tmp ^= ~(1ULL << bit); + return tmp; +} + +unsigned long long +__attribute__((noipa)) +foo9 (unsigned long long tmp) +{ + for (int bit = 63; bit >= 0; bit -= 3) + tmp ^= ~(1ULL << bit); + return tmp; +} + +unsigned long long +__attribute__((noipa)) +foo10 (unsigned long long tmp) +{ + for (int bit = 0; bit < 64; bit += 3) + tmp ^= (1ULL << bit); + return tmp; +} + +unsigned long long +__attribute__((noipa)) +foo11 (unsigned long long tmp) +{ + for (int bit = 63; bit >= 0; bit -= 3) + tmp ^= (1ULL << bit); + return tmp; +} diff --git a/gcc/testsuite/gcc.target/i386/pr103462-2.c b/gcc/testsuite/gcc.target/i386/pr103462-2.c new file mode 100644 index 0000000..bc375cb --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr103462-2.c @@ -0,0 +1,45 @@ +/* { dg-do run } */ +/* { dg-options "-O1" } */ + +#include "pr103462-1.c" + +int main() +{ + unsigned long long tmp = 0x1111111111111111ULL; + if (foo (tmp) != 0x110110110110110ULL) + __builtin_abort (); + + if (foo1 (tmp) != 0x110110110110110ULL) + __builtin_abort (); + + if (foo2 (tmp) != 0x0ULL) + __builtin_abort (); + + if (foo3 (tmp) != 0x0ULL) + __builtin_abort (); + + if (foo4 (tmp) != 0xffffffffffffffffULL) + __builtin_abort (); + + if (foo5 (tmp) != 0xffffffffffffffffULL) + __builtin_abort (); + + if (foo6 (tmp) != 0x9359359359359359ULL) + __builtin_abort (); + + if (foo7 (tmp) != 0x9359359359359359ULL) + __builtin_abort (); + + if (foo8 (tmp) != 0x8358358358358358ULL) + __builtin_abort (); + + if (foo9 (tmp) != 0x8358358358358358ULL) + __builtin_abort (); + + if (foo10 (tmp) != 0x8358358358358358ULL) + __builtin_abort (); + + if (foo11 (tmp) != 0x8358358358358358ULL) + __builtin_abort (); +} + diff --git a/gcc/testsuite/gcc.target/i386/pr103462-3.c b/gcc/testsuite/gcc.target/i386/pr103462-3.c new file mode 100644 index 0000000..4ba248a --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr103462-3.c @@ -0,0 +1,111 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-sccp-details" } */ +/* { dg-final { scan-tree-dump-times {final value replacement} 12 "sccp" } } */ + +unsigned int +__attribute__((noipa)) +foo (unsigned int tmp) +{ + for (int bit = 0; bit < 32; bit += 3) + tmp &= ~(1U << bit); + return tmp; +} + +unsigned int +__attribute__((noipa)) +foo1 (unsigned int tmp) +{ + for (int bit = 31; bit >= 0; bit -= 3) + tmp &= ~(1U << bit); + return tmp; +} + +unsigned int +__attribute__((noipa)) +foo2 (unsigned int tmp) +{ + for (int bit = 0; bit < 32; bit += 3) + tmp &= (1U << bit); + return tmp; +} + +unsigned int +__attribute__((noipa)) +foo3 (unsigned int tmp) +{ + for (int bit = 31; bit >= 0; bit -= 3) + tmp &= (1U << bit); + return tmp; +} + +unsigned int +__attribute__((noipa)) +foo4 (unsigned int tmp) +{ + for (int bit = 0; bit < 32; bit += 3) + tmp |= ~(1U << bit); + return tmp; +} + +unsigned int +__attribute__((noipa)) +foo5 (unsigned int tmp) +{ + for (int bit = 31; bit >= 0; bit -= 3) + tmp |= ~(1U << bit); + return tmp; +} + +unsigned int +__attribute__((noipa)) +foo6 (unsigned int tmp) +{ + for (int bit = 0; bit < 32; bit += 3) + tmp |= (1U << bit); + return tmp; +} + +unsigned int +__attribute__((noipa)) +foo7 (unsigned int tmp) +{ + for (int bit = 31; bit >= 0; bit -= 3) + tmp |= (1U << bit); + return tmp; +} + +unsigned int +__attribute__((noipa)) +foo8 (unsigned int tmp) +{ + for (int bit = 0; bit < 32; bit += 3) + tmp ^= ~(1U << bit); + return tmp; +} + +unsigned int +__attribute__((noipa)) +foo9 (unsigned int tmp) +{ + for (int bit = 31; bit >= 0; bit -= 3) + tmp ^= ~(1U << bit); + return tmp; +} + +unsigned int +__attribute__((noipa)) +foo10 (unsigned int tmp) +{ + for (int bit = 0; bit < 32; bit += 3) + tmp ^= (1U << bit); + return tmp; +} + +unsigned int +__attribute__((noipa)) +foo11 (unsigned int tmp) +{ + for (int bit = 31; bit >= 0; bit -= 3) + tmp ^= (1U << bit); + return tmp; +} diff --git a/gcc/testsuite/gcc.target/i386/pr103462-4.c b/gcc/testsuite/gcc.target/i386/pr103462-4.c new file mode 100644 index 0000000..e2f4056 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr103462-4.c @@ -0,0 +1,46 @@ +/* { dg-do run } */ +/* { dg-options "-O1" } */ + +#include "pr103462-3.c" + +int main() +{ + unsigned int tmp = 0x11111111U; + + if (foo (tmp) != 0x10110110U) + __builtin_abort (); + + if (foo1 (tmp) != 0x1101101U) + __builtin_abort (); + + if (foo2 (tmp) != 0x0U) + __builtin_abort (); + + if (foo3 (tmp) != 0x0U) + __builtin_abort (); + + if (foo4 (tmp) != 0xffffffffU) + __builtin_abort (); + + if (foo5 (tmp) != 0xffffffffU) + __builtin_abort (); + + if (foo6 (tmp) != 0x59359359U) + __builtin_abort (); + + if (foo7 (tmp) != 0x93593593U) + __builtin_abort (); + + if (foo8 (tmp) != 0xa7ca7ca7U) + __builtin_abort (); + + if (foo9 (tmp) != 0x7ca7ca7cU) + __builtin_abort (); + + if (foo10 (tmp) != 0x58358358U) + __builtin_abort (); + + if (foo11 (tmp) != 0x83583583U) + __builtin_abort (); +} + diff --git a/gcc/testsuite/gcc.target/i386/pr103462-5.c b/gcc/testsuite/gcc.target/i386/pr103462-5.c new file mode 100644 index 0000000..1f4ffa3 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr103462-5.c @@ -0,0 +1,111 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-sccp-details" } */ +/* { dg-final { scan-tree-dump-times {final value replacement} 12 "sccp" } } */ + +unsigned short +__attribute__((noipa)) +foo (unsigned short tmp) +{ + for (int bit = 0; bit < 16; bit += 3) + tmp &= ~(1U << bit); + return tmp; +} + +unsigned short +__attribute__((noipa)) +foo1 (unsigned short tmp) +{ + for (int bit = 15; bit >= 0; bit -= 3) + tmp &= ~(1U << bit); + return tmp; +} + +unsigned short +__attribute__((noipa)) +foo2 (unsigned short tmp) +{ + for (int bit = 0; bit < 16; bit += 3) + tmp &= (1U << bit); + return tmp; +} + +unsigned short +__attribute__((noipa)) +foo3 (unsigned short tmp) +{ + for (int bit = 15; bit >= 0; bit -= 3) + tmp &= (1U << bit); + return tmp; +} + +unsigned short +__attribute__((noipa)) +foo4 (unsigned short tmp) +{ + for (int bit = 0; bit < 16; bit += 3) + tmp |= ~(1U << bit); + return tmp; +} + +unsigned short +__attribute__((noipa)) +foo5 (unsigned short tmp) +{ + for (int bit = 15; bit >= 0; bit -= 3) + tmp |= ~(1U << bit); + return tmp; +} + +unsigned short +__attribute__((noipa)) +foo6 (unsigned short tmp) +{ + for (int bit = 0; bit < 16; bit += 3) + tmp |= (1U << bit); + return tmp; +} + +unsigned short +__attribute__((noipa)) +foo7 (unsigned short tmp) +{ + for (int bit = 15; bit >= 0; bit -= 3) + tmp |= (1U << bit); + return tmp; +} + +unsigned short +__attribute__((noipa)) +foo8 (unsigned short tmp) +{ + for (int bit = 0; bit < 16; bit += 3) + tmp ^= ~(1U << bit); + return tmp; +} + +unsigned short +__attribute__((noipa)) +foo9 (unsigned short tmp) +{ + for (int bit = 15; bit >= 0; bit -= 3) + tmp ^= ~(1U << bit); + return tmp; +} + +unsigned short +__attribute__((noipa)) +foo10 (unsigned short tmp) +{ + for (int bit = 0; bit < 16; bit += 3) + tmp ^= (1U << bit); + return tmp; +} + +unsigned short +__attribute__((noipa)) +foo11 (unsigned short tmp) +{ + for (int bit = 15; bit >= 0; bit -= 3) + tmp ^= (1U << bit); + return tmp; +} diff --git a/gcc/testsuite/gcc.target/i386/pr103462-6.c b/gcc/testsuite/gcc.target/i386/pr103462-6.c new file mode 100644 index 0000000..65426d7 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr103462-6.c @@ -0,0 +1,46 @@ +/* { dg-do run } */ +/* { dg-options "-O1" } */ + +#include "pr103462-5.c" + +int main() +{ + unsigned short tmp = 0x1111U; + + if (foo (tmp) != 0x110) + __builtin_abort (); + + if (foo1 (tmp) != 0x110) + __builtin_abort (); + + if (foo2 (tmp) != 0x0) + __builtin_abort (); + + if (foo3 (tmp) != 0x0) + __builtin_abort (); + + if (foo4 (tmp) != 0xffff) + __builtin_abort (); + + if (foo5 (tmp) != 0xffff) + __builtin_abort (); + + if (foo6 (tmp) != 0x9359) + __builtin_abort (); + + if (foo7 (tmp) != 0x9359) + __builtin_abort (); + + if (foo8 (tmp) != 0x8358) + __builtin_abort (); + + if (foo9 (tmp) != 0x8358) + __builtin_abort (); + + if (foo10 (tmp) != 0x8358) + __builtin_abort (); + + if (foo11 (tmp) != 0x8358) + __builtin_abort (); +} + diff --git a/gcc/testsuite/gcc.target/i386/pr104375.c b/gcc/testsuite/gcc.target/i386/pr104375.c new file mode 100644 index 0000000..5c9f511 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr104375.c @@ -0,0 +1,9 @@ +#/* { dg-do compile { target { ! ia32 } } } */ +/* { dg-options "-mbmi2 -O2" } */ +/* { dg-final { scan-assembler-times {(?n)shrx[\t ]+} 1 } } */ +/* { dg-final { scan-assembler-times {(?n)bzhi[\t ]+} 1 } } */ + +unsigned long long bextr_u64(unsigned long long w, unsigned off, unsigned int len) +{ + return (w >> off) & ((1U << len) - 1U); +} diff --git a/gcc/testsuite/gcc.target/i386/pr104610.c b/gcc/testsuite/gcc.target/i386/pr104610.c new file mode 100644 index 0000000..fe39cbe --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr104610.c @@ -0,0 +1,13 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -mavx -mmove-max=256 -mstore-max=256" } */ +/* { dg-final { scan-assembler-times {(?n)vptest.*ymm} 1 } } */ +/* { dg-final { scan-assembler-times {sete} 1 } } */ +/* { dg-final { scan-assembler-not {(?n)je.*L[0-9]} } } */ +/* { dg-final { scan-assembler-not {(?n)jne.*L[0-9]} } } */ + + +_Bool f256(char *a) +{ + char t[] = "0123456789012345678901234567890"; + return __builtin_memcmp(a, &t[0], sizeof(t)) == 0; +} diff --git a/gcc/testsuite/gcc.target/i386/pr105033.c b/gcc/testsuite/gcc.target/i386/pr105033.c new file mode 100644 index 0000000..ab05e3b --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr105033.c @@ -0,0 +1,27 @@ +/* { dg-do compile } */ +/* { dg-options "-march=sapphirerapids -O2" } */ +/* { dg-final { scan-assembler-times {vpunpcklqdq[ \t]+} 3 } } */ +/* { dg-final { scan-assembler-not {vpermi2[wb][ \t]+} } } */ + +typedef _Float16 v8hf __attribute__((vector_size (16))); +typedef _Float16 v4hf __attribute__((vector_size (8))); +typedef short v8hi __attribute__((vector_size (16))); +typedef short v4hi __attribute__((vector_size (8))); +typedef char v16qi __attribute__((vector_size (16))); +typedef char v8qi __attribute__((vector_size (8))); + +v8hf foo (v4hf a, v4hf b) +{ + return __builtin_shufflevector (a, b, 0, 1, 2, 3, 4, 5, 6, 7); +} + +v8hi foo2 (v4hi a, v4hi b) +{ + return __builtin_shufflevector (a, b, 0, 1, 2, 3, 4, 5, 6, 7); +} + +v16qi foo3 (v8qi a, v8qi b) +{ + return __builtin_shufflevector (a, b, 0, 1, 2, 3, 4, 5, 6, 7, + 8, 9, 10, 11, 12, 13, 14, 15); +} diff --git a/gcc/testsuite/gcc.target/i386/pr105587.c b/gcc/testsuite/gcc.target/i386/pr105587.c new file mode 100644 index 0000000..a5b6ab2 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr105587.c @@ -0,0 +1,11 @@ +#/* { dg-do compile } */ +/* { dg-options "-O3 -msse2 -mno-ssse3" } */ + +extern short arr_108[][4][2][24][12], arr_110[][4][2][24][12]; +void test() { + for (unsigned a = 0; a < 2; a += 2) + for (unsigned b = 4; b < 22; b++) + for (int c = 1; c < 11; c++) + arr_110[0][0][a][b][c] = (unsigned char)arr_108[0][0][a][b][c]; +} + diff --git a/gcc/testsuite/gcc.target/i386/pr105624.c b/gcc/testsuite/gcc.target/i386/pr105624.c new file mode 100644 index 0000000..8ca6c43 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr105624.c @@ -0,0 +1,19 @@ +/* PR target/105624 */ +/* { dg-do compile } */ +/* { dg-options "-O1 -march=k8" } */ + +union U { + double d; + unsigned long long int i; +}; + +double +fabs (double x) +{ + union U u; + + u.d = x; + u.i &= ~0ULL >> 1; + + return u.d; +} diff --git a/gcc/testsuite/gcc.target/i386/pr98865.c b/gcc/testsuite/gcc.target/i386/pr98865.c new file mode 100644 index 0000000..d047c4b --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr98865.c @@ -0,0 +1,54 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-optimized" } */ + +#if __SIZEOF_INT__ == 4 +unsigned int foo(unsigned int a, unsigned int b) +{ + return (a >> 31) * b; +} + +int bar(int a, int b) +{ + return -(a >> 31) * b; +} + +int baz(int a, int b) +{ + int c = a >> 31; + int d = -c; + return d * b; +} + +unsigned int pin(int a, unsigned int b) +{ + unsigned int t = a & 1; + return t * b; +} +#endif + +#if __SIZEOF_LONG_LONG__ == 8 +unsigned long long fool(unsigned long long a, unsigned long long b) +{ + return (a >> 63) * b; +} + +long long barl (long long a, long long b) +{ + return -(a >> 63) * b; +} + +long long bazl (long long a, long long b) +{ + long long c = a >> 63; + long long d = -c; + return d * b; +} + +unsigned long long pinl(long long a, unsigned long long b) +{ + unsigned long long t = a & 1; + return t * b; +} +#endif + +/* { dg-final { scan-assembler-not "imul" } } */ diff --git a/gcc/testsuite/gcc.target/powerpc/pr95737.c b/gcc/testsuite/gcc.target/powerpc/pr95737.c new file mode 100644 index 0000000..324694f --- /dev/null +++ b/gcc/testsuite/gcc.target/powerpc/pr95737.c @@ -0,0 +1,11 @@ +/* PR target/95737 */ +/* { dg-do compile } */ +/* Disable isel for P9 and later. */ +/* { dg-options "-O2 -mno-isel" } */ +/* { dg-final { scan-assembler-not {\mextsw\M} } } */ + + +unsigned long negativeLessThan (unsigned long a, unsigned long b) +{ + return -(a < b); +} diff --git a/gcc/testsuite/gdc.test/compilable/aggr_alignment.d b/gcc/testsuite/gdc.test/compilable/aggr_alignment.d index 0c727e2..7db9531 100644 --- a/gcc/testsuite/gdc.test/compilable/aggr_alignment.d +++ b/gcc/testsuite/gdc.test/compilable/aggr_alignment.d @@ -24,8 +24,8 @@ class C2 // overall alignment: max(vtbl.alignof, monitor.alignof, 1, 2) enum payloadOffset = C2.bytes.offsetof; static assert(C2.int1.offsetof == payloadOffset + 8); -static assert(C2.alignof == size_t.sizeof); -static assert(__traits(classInstanceSize, C2) == payloadOffset + 12); +static assert(__traits(classInstanceAlignment, C2) == size_t.sizeof); +static assert(__traits(classInstanceSize, C2) == payloadOffset + 12); // no tail padding align(8) struct PaddedStruct { @@ -37,6 +37,15 @@ static assert(PaddedStruct.s1.offsetof == 2); static assert(PaddedStruct.alignof == 8); static assert(PaddedStruct.sizeof == 16); +class AlignedPayloadClass +{ + align(64) int field; +} + +static assert(AlignedPayloadClass.field.offsetof == 64); // vtbl, monitor, alignment padding +static assert(__traits(classInstanceAlignment, AlignedPayloadClass) == 64); +static assert(__traits(classInstanceSize, AlignedPayloadClass) == 68); + align(1) struct UglyStruct { bool flag; diff --git a/gcc/testsuite/gdc.test/compilable/compile1.d b/gcc/testsuite/gdc.test/compilable/compile1.d index 40fba48..4678eb5 100644 --- a/gcc/testsuite/gdc.test/compilable/compile1.d +++ b/gcc/testsuite/gdc.test/compilable/compile1.d @@ -3,7 +3,7 @@ // EXTRA_FILES: imports/a12506.d /* TEST_OUTPUT: --- -compilable/compile1.d(229): Deprecation: use of complex type `cdouble` is deprecated, use `std.complex.Complex!(double)` instead +compilable/compile1.d(230): Deprecation: use of complex type `cdouble` is deprecated, use `std.complex.Complex!(double)` instead --- */ diff --git a/gcc/testsuite/gdc.test/compilable/cppmangle.d b/gcc/testsuite/gdc.test/compilable/cppmangle.d index 8c112d1..fc74c94 100644 --- a/gcc/testsuite/gdc.test/compilable/cppmangle.d +++ b/gcc/testsuite/gdc.test/compilable/cppmangle.d @@ -1327,3 +1327,8 @@ extern (C++) static assert(funccpp.mangleof == "?funccpp@@YAHP6AXXZ@Z"); } } + +/*****************************************/ + +extern(C++) enum _LIBNAME = "library"; +extern(C++) enum _DEBUG = _LIBNAME.length && 'd' == _LIBNAME[$-1]; diff --git a/gcc/testsuite/gdc.test/compilable/dbitfield.d b/gcc/testsuite/gdc.test/compilable/dbitfield.d new file mode 100644 index 0000000..e2883fd --- /dev/null +++ b/gcc/testsuite/gdc.test/compilable/dbitfield.d @@ -0,0 +1,88 @@ +/* REQUIRED_ARGS: -preview=bitfields + */ + +/***************************************************/ + +class C +{ + uint a:3; + uint b:1; + ulong c:64; + + int d:3; + int e:1; + long f:64; + + int i; +} + +static assert(C.a.min == 0); +static assert(C.a.max == 7); + +static assert(C.b.min == 0); +static assert(C.b.max == 1); + +static assert(C.c.min == 0); +static assert(C.c.max == ulong.max); + +static assert(C.d.min == -4); +static assert(C.d.max == 3); + +static assert(C.e.min == -1); +static assert(C.e.max == 0); + +static assert(C.f.min == long.min); +static assert(C.f.max == long.max); + +int testc() +{ + scope c = new C(); + c.d = 9; + return c.d; +} + +static assert(testc() == 1); + +/***************************************************/ + +union U +{ + uint a:3; + uint b:1; + ulong c:64; + + int d:3; + int e:1; + long f:64; + + int i; +} + +static assert(U.sizeof == 8); + +static assert(U.a.min == 0); +static assert(U.a.max == 7); + +static assert(U.b.min == 0); +static assert(U.b.max == 1); + +static assert(U.c.min == 0); +static assert(U.c.max == ulong.max); + +static assert(U.d.min == -4); +static assert(U.d.max == 3); + +static assert(U.e.min == -1); +static assert(U.e.max == 0); + +static assert(U.f.min == long.min); +static assert(U.f.max == long.max); + +int testu() +{ + U u; + u.d = 9; + return u.d; +} + +static assert(testu() == 1); diff --git a/gcc/testsuite/gdc.test/compilable/ddoc_markdown_breaks_verbose.d b/gcc/testsuite/gdc.test/compilable/ddoc_markdown_breaks_verbose.d deleted file mode 100644 index 1ff26b0..0000000 --- a/gcc/testsuite/gdc.test/compilable/ddoc_markdown_breaks_verbose.d +++ /dev/null @@ -1,13 +0,0 @@ -// PERMUTE_ARGS: -// REQUIRED_ARGS: -D -Dd${RESULTS_DIR}/compilable -wi -o- -transition=vmarkdown -// OUTPUT_FILES: ${RESULTS_DIR}/compilable/ddoc_markdown_breaks_verbose.html -// TEST_OUTPUT_FILE: extra-files/ddoc_markdown_breaks_verbose.html - -/++ -Thematic Breaks - -___ -- - - -*** -+/ -module ddoc_markdown_breaks; diff --git a/gcc/testsuite/gdc.test/compilable/ddoc_markdown_code_verbose.d b/gcc/testsuite/gdc.test/compilable/ddoc_markdown_code_verbose.d deleted file mode 100644 index eb64c04..0000000 --- a/gcc/testsuite/gdc.test/compilable/ddoc_markdown_code_verbose.d +++ /dev/null @@ -1,13 +0,0 @@ -// PERMUTE_ARGS: -// REQUIRED_ARGS: -D -Dd${RESULTS_DIR}/compilable -o- -transition=vmarkdown -// TEST_OUTPUT_FILE: extra-files/ddoc_markdown_code_verbose.html -// OUTPUT_FILES: ${RESULTS_DIR}/compilable/ddoc_markdown_code_verbose.html - -/++ -Code: - -``` ruby red -RWBY -``` -+/ -module test.compilable.ddoc_markdown_code_verbose; diff --git a/gcc/testsuite/gdc.test/compilable/ddoc_markdown_emphasis_verbose.d b/gcc/testsuite/gdc.test/compilable/ddoc_markdown_emphasis_verbose.d deleted file mode 100644 index 07904c1..0000000 --- a/gcc/testsuite/gdc.test/compilable/ddoc_markdown_emphasis_verbose.d +++ /dev/null @@ -1,13 +0,0 @@ -// PERMUTE_ARGS: -// REQUIRED_ARGS: -D -Dd${RESULTS_DIR}/compilable -wi -o- -transition=vmarkdown -// TEST_OUTPUT_FILE: extra-files/ddoc_markdown_emphasis_verbose.html -// OUTPUT_FILES: ${RESULTS_DIR}/compilable/ddoc_markdown_emphasis_verbose.html - -/++ -Markdown Emphasis: - -*emphasized text* - -**strongly emphasized text** -+/ -module ddoc_markdown_emphasis; diff --git a/gcc/testsuite/gdc.test/compilable/ddoc_markdown_headings_verbose.d b/gcc/testsuite/gdc.test/compilable/ddoc_markdown_headings_verbose.d deleted file mode 100644 index 6448463..0000000 --- a/gcc/testsuite/gdc.test/compilable/ddoc_markdown_headings_verbose.d +++ /dev/null @@ -1,9 +0,0 @@ -// PERMUTE_ARGS: -// REQUIRED_ARGS: -D -Dd${RESULTS_DIR}/compilable -o- -transition=vmarkdown -// TEST_OUTPUT_FILE: extra-files/ddoc_markdown_headings_verbose.html -// OUTPUT_FILES: ${RESULTS_DIR}/compilable/ddoc_markdown_headings_verbose.html - -/++ -# Heading -+/ -module ddoc_markdown_headings_verbose; diff --git a/gcc/testsuite/gdc.test/compilable/ddoc_markdown_links_verbose.d b/gcc/testsuite/gdc.test/compilable/ddoc_markdown_links_verbose.d deleted file mode 100644 index 435b426..0000000 --- a/gcc/testsuite/gdc.test/compilable/ddoc_markdown_links_verbose.d +++ /dev/null @@ -1,17 +0,0 @@ -// PERMUTE_ARGS: -// REQUIRED_ARGS: -D -Dd${RESULTS_DIR}/compilable -o- -transition=vmarkdown -// TEST_OUTPUT_FILE: extra-files/ddoc_markdown_links_verbose.html -// OUTPUT_FILES: ${RESULTS_DIR}/compilable/ddoc_markdown_links_verbose.html - -/++ -Links: - -A link to [Object]. -An inline link to [the D homepage](https://dlang.org). -A simple link to [dub]. -A slightly less simple link to [dub][]. -An image:  - -[dub]: https://code.dlang.org -+/ -module test.compilable.ddoc_markdown_links_verbose; diff --git a/gcc/testsuite/gdc.test/compilable/ddoc_markdown_lists_verbose.d b/gcc/testsuite/gdc.test/compilable/ddoc_markdown_lists_verbose.d deleted file mode 100644 index 4fd1a80..0000000 --- a/gcc/testsuite/gdc.test/compilable/ddoc_markdown_lists_verbose.d +++ /dev/null @@ -1,9 +0,0 @@ -// PERMUTE_ARGS: -// REQUIRED_ARGS: -D -Dd${RESULTS_DIR}/compilable -o- -transition=vmarkdown -// TEST_OUTPUT_FILE: extra-files/ddoc_markdown_lists_verbose.html -// OUTPUT_FILES: ${RESULTS_DIR}/compilable/ddoc_markdown_lists_verbose.html - -/++ -- list item -+/ -module ddoc_markdown_lists_verbose; diff --git a/gcc/testsuite/gdc.test/compilable/ddoc_markdown_quote_verbose.d b/gcc/testsuite/gdc.test/compilable/ddoc_markdown_quote_verbose.d deleted file mode 100644 index f16e539..0000000 --- a/gcc/testsuite/gdc.test/compilable/ddoc_markdown_quote_verbose.d +++ /dev/null @@ -1,11 +0,0 @@ -// PERMUTE_ARGS: -// REQUIRED_ARGS: -D -Dd${RESULTS_DIR}/compilable -o- -transition=vmarkdown -// TEST_OUTPUT_FILE: extra-files/ddoc_markdown_quote_verbose.html -// OUTPUT_FILES: ${RESULTS_DIR}/compilable/ddoc_markdown_quote_verbose.html - -/++ -Quote Block: - -> Great, just what I need.. another D in programming. -- Segfault -+/ -module test.compilable.ddoc_markdown_code_verbose; diff --git a/gcc/testsuite/gdc.test/compilable/ddoc_markdown_tables_verbose.d b/gcc/testsuite/gdc.test/compilable/ddoc_markdown_tables_verbose.d deleted file mode 100644 index d1aac1c..0000000 --- a/gcc/testsuite/gdc.test/compilable/ddoc_markdown_tables_verbose.d +++ /dev/null @@ -1,13 +0,0 @@ -// PERMUTE_ARGS: -// REQUIRED_ARGS: -D -Dd${RESULTS_DIR}/compilable -o- -transition=vmarkdown -// TEST_OUTPUT_FILE: extra-files/ddoc_markdown_tables_verbose.html -// OUTPUT_FILES: ${RESULTS_DIR}/compilable/ddoc_markdown_tables_verbose.html - -/++ -Table: - -| this | that | -| ---- | ---- | -| cell | cell | -+/ -module test.compilable.ddoc_markdown_tables_verbose; diff --git a/gcc/testsuite/gdc.test/compilable/dtoh_21217.d b/gcc/testsuite/gdc.test/compilable/dtoh_21217.d index 8836ad1..3e535d2 100644 --- a/gcc/testsuite/gdc.test/compilable/dtoh_21217.d +++ b/gcc/testsuite/gdc.test/compilable/dtoh_21217.d @@ -8,9 +8,9 @@ TEST_OUTPUT: #pragma once #include <assert.h> +#include <math.h> #include <stddef.h> #include <stdint.h> -#include <math.h> #ifdef CUSTOM_D_ARRAY_TYPE #define _d_dynamicArray CUSTOM_D_ARRAY_TYPE diff --git a/gcc/testsuite/gdc.test/compilable/dtoh_AliasDeclaration.d b/gcc/testsuite/gdc.test/compilable/dtoh_AliasDeclaration.d index 10f5807..64198f9 100644 --- a/gcc/testsuite/gdc.test/compilable/dtoh_AliasDeclaration.d +++ b/gcc/testsuite/gdc.test/compilable/dtoh_AliasDeclaration.d @@ -10,9 +10,9 @@ TEST_OUTPUT: #pragma once #include <assert.h> +#include <math.h> #include <stddef.h> #include <stdint.h> -#include <math.h> #ifdef CUSTOM_D_ARRAY_TYPE #define _d_dynamicArray CUSTOM_D_ARRAY_TYPE diff --git a/gcc/testsuite/gdc.test/compilable/dtoh_AliasDeclaration_98.d b/gcc/testsuite/gdc.test/compilable/dtoh_AliasDeclaration_98.d index 1499d04..12edbd2 100644 --- a/gcc/testsuite/gdc.test/compilable/dtoh_AliasDeclaration_98.d +++ b/gcc/testsuite/gdc.test/compilable/dtoh_AliasDeclaration_98.d @@ -7,9 +7,9 @@ TEST_OUTPUT: #pragma once #include <assert.h> +#include <math.h> #include <stddef.h> #include <stdint.h> -#include <math.h> #ifdef CUSTOM_D_ARRAY_TYPE #define _d_dynamicArray CUSTOM_D_ARRAY_TYPE diff --git a/gcc/testsuite/gdc.test/compilable/dtoh_AnonDeclaration.d b/gcc/testsuite/gdc.test/compilable/dtoh_AnonDeclaration.d index 9d68631..20134f5 100644 --- a/gcc/testsuite/gdc.test/compilable/dtoh_AnonDeclaration.d +++ b/gcc/testsuite/gdc.test/compilable/dtoh_AnonDeclaration.d @@ -8,9 +8,9 @@ TEST_OUTPUT: #pragma once #include <assert.h> +#include <math.h> #include <stddef.h> #include <stdint.h> -#include <math.h> #ifdef CUSTOM_D_ARRAY_TYPE #define _d_dynamicArray CUSTOM_D_ARRAY_TYPE diff --git a/gcc/testsuite/gdc.test/compilable/dtoh_CPPNamespaceDeclaration.d b/gcc/testsuite/gdc.test/compilable/dtoh_CPPNamespaceDeclaration.d index 6995a67..870387c 100644 --- a/gcc/testsuite/gdc.test/compilable/dtoh_CPPNamespaceDeclaration.d +++ b/gcc/testsuite/gdc.test/compilable/dtoh_CPPNamespaceDeclaration.d @@ -8,9 +8,9 @@ TEST_OUTPUT: #pragma once #include <assert.h> +#include <math.h> #include <stddef.h> #include <stdint.h> -#include <math.h> #ifdef CUSTOM_D_ARRAY_TYPE #define _d_dynamicArray CUSTOM_D_ARRAY_TYPE diff --git a/gcc/testsuite/gdc.test/compilable/dtoh_ClassDeclaration.d b/gcc/testsuite/gdc.test/compilable/dtoh_ClassDeclaration.d index 4f13d2b..de4c7ba 100644 --- a/gcc/testsuite/gdc.test/compilable/dtoh_ClassDeclaration.d +++ b/gcc/testsuite/gdc.test/compilable/dtoh_ClassDeclaration.d @@ -8,9 +8,9 @@ TEST_OUTPUT: #pragma once #include <assert.h> +#include <math.h> #include <stddef.h> #include <stdint.h> -#include <math.h> #ifdef CUSTOM_D_ARRAY_TYPE #define _d_dynamicArray CUSTOM_D_ARRAY_TYPE diff --git a/gcc/testsuite/gdc.test/compilable/dtoh_StructDeclaration.d b/gcc/testsuite/gdc.test/compilable/dtoh_StructDeclaration.d index 4d56c7c..8c7ba9b 100644 --- a/gcc/testsuite/gdc.test/compilable/dtoh_StructDeclaration.d +++ b/gcc/testsuite/gdc.test/compilable/dtoh_StructDeclaration.d @@ -8,9 +8,9 @@ TEST_OUTPUT: #pragma once #include <assert.h> +#include <math.h> #include <stddef.h> #include <stdint.h> -#include <math.h> #ifdef CUSTOM_D_ARRAY_TYPE #define _d_dynamicArray CUSTOM_D_ARRAY_TYPE diff --git a/gcc/testsuite/gdc.test/compilable/dtoh_TemplateDeclaration.d b/gcc/testsuite/gdc.test/compilable/dtoh_TemplateDeclaration.d index e9e57da..35c4ed7 100644 --- a/gcc/testsuite/gdc.test/compilable/dtoh_TemplateDeclaration.d +++ b/gcc/testsuite/gdc.test/compilable/dtoh_TemplateDeclaration.d @@ -8,9 +8,9 @@ TEST_OUTPUT: #pragma once #include <assert.h> +#include <math.h> #include <stddef.h> #include <stdint.h> -#include <math.h> #ifdef CUSTOM_D_ARRAY_TYPE #define _d_dynamicArray CUSTOM_D_ARRAY_TYPE diff --git a/gcc/testsuite/gdc.test/compilable/dtoh_UnionDeclaration.d b/gcc/testsuite/gdc.test/compilable/dtoh_UnionDeclaration.d index b609cc2..48fcf72 100644 --- a/gcc/testsuite/gdc.test/compilable/dtoh_UnionDeclaration.d +++ b/gcc/testsuite/gdc.test/compilable/dtoh_UnionDeclaration.d @@ -8,9 +8,9 @@ TEST_OUTPUT: #pragma once #include <assert.h> +#include <math.h> #include <stddef.h> #include <stdint.h> -#include <math.h> #ifdef CUSTOM_D_ARRAY_TYPE #define _d_dynamicArray CUSTOM_D_ARRAY_TYPE diff --git a/gcc/testsuite/gdc.test/compilable/dtoh_VarDeclaration.d b/gcc/testsuite/gdc.test/compilable/dtoh_VarDeclaration.d index 7356ba3..1faa51e 100644 --- a/gcc/testsuite/gdc.test/compilable/dtoh_VarDeclaration.d +++ b/gcc/testsuite/gdc.test/compilable/dtoh_VarDeclaration.d @@ -8,9 +8,9 @@ TEST_OUTPUT: #pragma once #include <assert.h> +#include <math.h> #include <stddef.h> #include <stdint.h> -#include <math.h> #ifdef CUSTOM_D_ARRAY_TYPE #define _d_dynamicArray CUSTOM_D_ARRAY_TYPE diff --git a/gcc/testsuite/gdc.test/compilable/dtoh_cpp98_compat.d b/gcc/testsuite/gdc.test/compilable/dtoh_cpp98_compat.d index b291cf6..cf1ae48 100644 --- a/gcc/testsuite/gdc.test/compilable/dtoh_cpp98_compat.d +++ b/gcc/testsuite/gdc.test/compilable/dtoh_cpp98_compat.d @@ -10,9 +10,9 @@ TEST_OUTPUT: #pragma once #include <assert.h> +#include <math.h> #include <stddef.h> #include <stdint.h> -#include <math.h> #ifdef CUSTOM_D_ARRAY_TYPE #define _d_dynamicArray CUSTOM_D_ARRAY_TYPE diff --git a/gcc/testsuite/gdc.test/compilable/dtoh_enum.d b/gcc/testsuite/gdc.test/compilable/dtoh_enum.d index 6a0dfd9..8b3e5aa 100644 --- a/gcc/testsuite/gdc.test/compilable/dtoh_enum.d +++ b/gcc/testsuite/gdc.test/compilable/dtoh_enum.d @@ -8,9 +8,9 @@ TEST_OUTPUT: #pragma once #include <assert.h> +#include <math.h> #include <stddef.h> #include <stdint.h> -#include <math.h> #ifdef CUSTOM_D_ARRAY_TYPE #define _d_dynamicArray CUSTOM_D_ARRAY_TYPE diff --git a/gcc/testsuite/gdc.test/compilable/dtoh_enum_cpp98.d b/gcc/testsuite/gdc.test/compilable/dtoh_enum_cpp98.d index 2330d76..6a266d9 100644 --- a/gcc/testsuite/gdc.test/compilable/dtoh_enum_cpp98.d +++ b/gcc/testsuite/gdc.test/compilable/dtoh_enum_cpp98.d @@ -8,9 +8,9 @@ TEST_OUTPUT: #pragma once #include <assert.h> +#include <math.h> #include <stddef.h> #include <stdint.h> -#include <math.h> #ifdef CUSTOM_D_ARRAY_TYPE #define _d_dynamicArray CUSTOM_D_ARRAY_TYPE diff --git a/gcc/testsuite/gdc.test/compilable/dtoh_expressions.d b/gcc/testsuite/gdc.test/compilable/dtoh_expressions.d index 7919c67..b93c47e 100644 --- a/gcc/testsuite/gdc.test/compilable/dtoh_expressions.d +++ b/gcc/testsuite/gdc.test/compilable/dtoh_expressions.d @@ -7,9 +7,9 @@ TEST_OUTPUT: #pragma once #include <assert.h> +#include <math.h> #include <stddef.h> #include <stdint.h> -#include <math.h> #ifdef CUSTOM_D_ARRAY_TYPE #define _d_dynamicArray CUSTOM_D_ARRAY_TYPE diff --git a/gcc/testsuite/gdc.test/compilable/dtoh_extern_type.d b/gcc/testsuite/gdc.test/compilable/dtoh_extern_type.d index 0426a5e..83ac67d 100644 --- a/gcc/testsuite/gdc.test/compilable/dtoh_extern_type.d +++ b/gcc/testsuite/gdc.test/compilable/dtoh_extern_type.d @@ -9,9 +9,9 @@ TEST_OUTPUT: #pragma once #include <assert.h> +#include <math.h> #include <stddef.h> #include <stdint.h> -#include <math.h> #ifdef CUSTOM_D_ARRAY_TYPE #define _d_dynamicArray CUSTOM_D_ARRAY_TYPE diff --git a/gcc/testsuite/gdc.test/compilable/dtoh_forwarding.d b/gcc/testsuite/gdc.test/compilable/dtoh_forwarding.d index 2f5b7df..c9d5bbc 100644 --- a/gcc/testsuite/gdc.test/compilable/dtoh_forwarding.d +++ b/gcc/testsuite/gdc.test/compilable/dtoh_forwarding.d @@ -8,9 +8,9 @@ TEST_OUTPUT: #pragma once #include <assert.h> +#include <math.h> #include <stddef.h> #include <stdint.h> -#include <math.h> #ifdef CUSTOM_D_ARRAY_TYPE #define _d_dynamicArray CUSTOM_D_ARRAY_TYPE diff --git a/gcc/testsuite/gdc.test/compilable/dtoh_functions.d b/gcc/testsuite/gdc.test/compilable/dtoh_functions.d index 1ee6ce6..1feff40 100644 --- a/gcc/testsuite/gdc.test/compilable/dtoh_functions.d +++ b/gcc/testsuite/gdc.test/compilable/dtoh_functions.d @@ -8,9 +8,9 @@ TEST_OUTPUT: #pragma once #include <assert.h> +#include <math.h> #include <stddef.h> #include <stdint.h> -#include <math.h> #ifdef CUSTOM_D_ARRAY_TYPE #define _d_dynamicArray CUSTOM_D_ARRAY_TYPE @@ -79,6 +79,8 @@ extern size_t baz5(size_t x = 42); extern size_t& bazRef(size_t& x); +extern size_t bazOut(size_t& x); + enum class E : int64_t { m = 1LL, @@ -219,6 +221,11 @@ extern (C++) ref size_t bazRef(return ref size_t x) return x; } +extern (C++) size_t bazOut(out size_t x) +{ + return x; +} + extern (C++): enum E : long diff --git a/gcc/testsuite/gdc.test/compilable/dtoh_ignored.d b/gcc/testsuite/gdc.test/compilable/dtoh_ignored.d index d687673..d162a32 100644 --- a/gcc/testsuite/gdc.test/compilable/dtoh_ignored.d +++ b/gcc/testsuite/gdc.test/compilable/dtoh_ignored.d @@ -8,9 +8,9 @@ TEST_OUTPUT: #pragma once #include <assert.h> +#include <math.h> #include <stddef.h> #include <stdint.h> -#include <math.h> #ifdef CUSTOM_D_ARRAY_TYPE #define _d_dynamicArray CUSTOM_D_ARRAY_TYPE diff --git a/gcc/testsuite/gdc.test/compilable/dtoh_invalid_identifiers.d b/gcc/testsuite/gdc.test/compilable/dtoh_invalid_identifiers.d index c7d4c14..b8e8d05 100644 --- a/gcc/testsuite/gdc.test/compilable/dtoh_invalid_identifiers.d +++ b/gcc/testsuite/gdc.test/compilable/dtoh_invalid_identifiers.d @@ -17,9 +17,9 @@ compilable/dtoh_invalid_identifiers.d(145): Warning: function `__attribute__` is #pragma once #include <assert.h> +#include <math.h> #include <stddef.h> #include <stdint.h> -#include <math.h> #ifdef CUSTOM_D_ARRAY_TYPE #define _d_dynamicArray CUSTOM_D_ARRAY_TYPE diff --git a/gcc/testsuite/gdc.test/compilable/dtoh_mangling.d b/gcc/testsuite/gdc.test/compilable/dtoh_mangling.d index 44d0dd5..10967c8 100644 --- a/gcc/testsuite/gdc.test/compilable/dtoh_mangling.d +++ b/gcc/testsuite/gdc.test/compilable/dtoh_mangling.d @@ -7,9 +7,9 @@ TEST_OUTPUT: #pragma once #include <assert.h> +#include <math.h> #include <stddef.h> #include <stdint.h> -#include <math.h> #ifdef CUSTOM_D_ARRAY_TYPE #define _d_dynamicArray CUSTOM_D_ARRAY_TYPE diff --git a/gcc/testsuite/gdc.test/compilable/dtoh_names.d b/gcc/testsuite/gdc.test/compilable/dtoh_names.d index 8a7eb7f..a4b055e 100644 --- a/gcc/testsuite/gdc.test/compilable/dtoh_names.d +++ b/gcc/testsuite/gdc.test/compilable/dtoh_names.d @@ -8,9 +8,9 @@ TEST_OUTPUT: #pragma once #include <assert.h> +#include <math.h> #include <stddef.h> #include <stdint.h> -#include <math.h> #ifdef CUSTOM_D_ARRAY_TYPE #define _d_dynamicArray CUSTOM_D_ARRAY_TYPE diff --git a/gcc/testsuite/gdc.test/compilable/dtoh_protection.d b/gcc/testsuite/gdc.test/compilable/dtoh_protection.d index 2180c41..3fd54c7 100644 --- a/gcc/testsuite/gdc.test/compilable/dtoh_protection.d +++ b/gcc/testsuite/gdc.test/compilable/dtoh_protection.d @@ -9,9 +9,9 @@ TEST_OUTPUT: #pragma once #include <assert.h> +#include <math.h> #include <stddef.h> #include <stdint.h> -#include <math.h> #ifdef CUSTOM_D_ARRAY_TYPE #define _d_dynamicArray CUSTOM_D_ARRAY_TYPE diff --git a/gcc/testsuite/gdc.test/compilable/dtoh_required_symbols.d b/gcc/testsuite/gdc.test/compilable/dtoh_required_symbols.d index d41cb1b..ab53764 100644 --- a/gcc/testsuite/gdc.test/compilable/dtoh_required_symbols.d +++ b/gcc/testsuite/gdc.test/compilable/dtoh_required_symbols.d @@ -7,9 +7,9 @@ TEST_OUTPUT: #pragma once #include <assert.h> +#include <math.h> #include <stddef.h> #include <stdint.h> -#include <math.h> #ifdef CUSTOM_D_ARRAY_TYPE #define _d_dynamicArray CUSTOM_D_ARRAY_TYPE diff --git a/gcc/testsuite/gdc.test/compilable/dtoh_special_enum.d b/gcc/testsuite/gdc.test/compilable/dtoh_special_enum.d index a7c0a0d..37b4507 100644 --- a/gcc/testsuite/gdc.test/compilable/dtoh_special_enum.d +++ b/gcc/testsuite/gdc.test/compilable/dtoh_special_enum.d @@ -8,9 +8,9 @@ TEST_OUTPUT: #pragma once #include <assert.h> +#include <math.h> #include <stddef.h> #include <stdint.h> -#include <math.h> #ifdef CUSTOM_D_ARRAY_TYPE #define _d_dynamicArray CUSTOM_D_ARRAY_TYPE diff --git a/gcc/testsuite/gdc.test/compilable/dtoh_unittest_block.d b/gcc/testsuite/gdc.test/compilable/dtoh_unittest_block.d index ac58d0e..7b2943c 100644 --- a/gcc/testsuite/gdc.test/compilable/dtoh_unittest_block.d +++ b/gcc/testsuite/gdc.test/compilable/dtoh_unittest_block.d @@ -8,9 +8,9 @@ TEST_OUTPUT: #pragma once #include <assert.h> +#include <math.h> #include <stddef.h> #include <stdint.h> -#include <math.h> #ifdef CUSTOM_D_ARRAY_TYPE #define _d_dynamicArray CUSTOM_D_ARRAY_TYPE diff --git a/gcc/testsuite/gdc.test/compilable/dtoh_verbose.d b/gcc/testsuite/gdc.test/compilable/dtoh_verbose.d index 505ffdc..891ff0e 100644 --- a/gcc/testsuite/gdc.test/compilable/dtoh_verbose.d +++ b/gcc/testsuite/gdc.test/compilable/dtoh_verbose.d @@ -10,9 +10,9 @@ TEST_OUTPUT: #pragma once
#include <assert.h>
+#include <math.h>
#include <stddef.h>
#include <stdint.h>
-#include <math.h>
#ifdef CUSTOM_D_ARRAY_TYPE
#define _d_dynamicArray CUSTOM_D_ARRAY_TYPE
diff --git a/gcc/testsuite/gdc.test/compilable/test17590.d b/gcc/testsuite/gdc.test/compilable/test17590.d index 6eec76f..3e00e9f 100644 --- a/gcc/testsuite/gdc.test/compilable/test17590.d +++ b/gcc/testsuite/gdc.test/compilable/test17590.d @@ -1,4 +1,4 @@ -// REQUIRED_ARGS: -o- +// REQUIRED_ARGS: -o- -preview=dip1000 void lazyfun(scope lazy int a) @nogc; diff --git a/gcc/testsuite/gdc.test/compilable/test20427.d b/gcc/testsuite/gdc.test/compilable/test20427.d new file mode 100644 index 0000000..074ed12 --- /dev/null +++ b/gcc/testsuite/gdc.test/compilable/test20427.d @@ -0,0 +1,3 @@ +// https://issues.dlang.org/show_bug.cgi?id=20427 +extern(C++) void test20427(T)(T) {} +static assert(!__traits(compiles, { test20427([1, 2]); })); diff --git a/gcc/testsuite/gdc.test/compilable/test23047.d b/gcc/testsuite/gdc.test/compilable/test23047.d new file mode 100644 index 0000000..e1ac3e7 --- /dev/null +++ b/gcc/testsuite/gdc.test/compilable/test23047.d @@ -0,0 +1,13 @@ +/* REQUIRED_ARGS: -defaultlib= -c -O + */ + +// https://issues.dlang.org/show_bug.cgi?id=23047 +version(D_SIMD): +alias long2 = __vector(long[2]); + +long2 _mm_srl_epi64 () +{ + long2 r = void; + r[0] = 1; + return r; +} diff --git a/gcc/testsuite/gdc.test/compilable/test23087.d b/gcc/testsuite/gdc.test/compilable/test23087.d new file mode 100644 index 0000000..6927ddf --- /dev/null +++ b/gcc/testsuite/gdc.test/compilable/test23087.d @@ -0,0 +1,9 @@ +// https://issues.dlang.org/show_bug.cgi?id=23087 +struct S +{ + this(bool) {} + this(bool, int) {} +} + +static foreach (ctor; __traits(getOverloads, S, "__ctor")) + static assert(__traits(getLinkage, ctor) == "D"); diff --git a/gcc/testsuite/gdc.test/compilable/test23089.d b/gcc/testsuite/gdc.test/compilable/test23089.d new file mode 100644 index 0000000..1bc2913 --- /dev/null +++ b/gcc/testsuite/gdc.test/compilable/test23089.d @@ -0,0 +1,7 @@ +// https://issues.dlang.org/show_bug.cgi?id=23089 +extern(System) int i23089; + +extern(System): + +alias F23089 = void function(int); +F23089 f23089; diff --git a/gcc/testsuite/gdc.test/compilable/test23097.d b/gcc/testsuite/gdc.test/compilable/test23097.d new file mode 100644 index 0000000..092bd77 --- /dev/null +++ b/gcc/testsuite/gdc.test/compilable/test23097.d @@ -0,0 +1,33 @@ +/* https://issues.dlang.org/show_bug.cgi?id=23097 +REQUIRED_ARGS: -verrors=spec +TEST_OUTPUT: +--- +(spec:2) compilable/test23097.d(14): Error: `inout` constructor `test23097.S23097.this` creates const object, not mutable +(spec:2) compilable/test23097.d(14): Error: `inout` constructor `test23097.S23097.this` creates const object, not mutable +(spec:1) compilable/test23097.d(14): Error: generated function `test23097.S23097.opAssign(S23097 p)` is not callable using argument types `(const(S23097))` +(spec:2) compilable/test23097.d(14): Error: `inout` constructor `test23097.S23097.this` creates const object, not mutable +(spec:1) compilable/test23097.d(14): `struct S23097` does not define a copy constructor for `const(S23097)` to `S23097` copies +--- +*/ +void emplaceRef(UT, Args)(UT chunk, Args args) +{ + static if (__traits(compiles, chunk = args)) + chunk = args; +} + +struct CpCtor23097(T) +{ + T* payload; + this(ref inout typeof(this)) { } + ref opAssign(typeof(this)) { } +} + +struct S23097 +{ + CpCtor23097!int payload; +} + +void test23097(S23097 lhs, const S23097 rhs) +{ + emplaceRef(lhs, rhs); +} diff --git a/gcc/testsuite/gdc.test/compilable/test23105.d b/gcc/testsuite/gdc.test/compilable/test23105.d new file mode 100644 index 0000000..8595e37 --- /dev/null +++ b/gcc/testsuite/gdc.test/compilable/test23105.d @@ -0,0 +1,6 @@ +// https://issues.dlang.org/show_bug.cgi?id=23105 + +module test23105; + +static assert(is(mixin(`__traits(getMember, test23105, "object")`) == module)); +static assert(is(__traits(getMember, test23105, "object") == module)); // Fixed diff --git a/gcc/testsuite/gdc.test/compilable/test3004.d b/gcc/testsuite/gdc.test/compilable/test3004.d index baa0cd7..9912b88 100644 --- a/gcc/testsuite/gdc.test/compilable/test3004.d +++ b/gcc/testsuite/gdc.test/compilable/test3004.d @@ -1,13 +1,15 @@ // https://issues.dlang.org/show_bug.cgi?id=3004 /* REQUIRED_ARGS: -ignore -v -TRANSFORM_OUTPUT: remove_lines("^(predefs|binary|version|config|DFLAG|parse|import|semantic|entry|function object|\s*$)") +TRANSFORM_OUTPUT: remove_lines("^(predefs|binary|version|config|DFLAG|parse|import|semantic|entry|library|function object|\s*$)") TEST_OUTPUT: --- pragma GNU_attribute (__error) pragma GNU_attribute (__error) code test3004 function test3004.test +function core.internal.array.appending._d_arrayappendcTXImpl!(char[], char)._d_arrayappendcTX +function core.internal.array.utils._d_HookTraceImpl!(char[], _d_arrayappendcTX, "Cannot append to array if compiling without support for runtime type information!")._d_HookTraceImpl --- */ diff --git a/gcc/testsuite/gdc.test/compilable/vcg-ast.d b/gcc/testsuite/gdc.test/compilable/vcg-ast.d index 4673677..cbb150c 100644 --- a/gcc/testsuite/gdc.test/compilable/vcg-ast.d +++ b/gcc/testsuite/gdc.test/compilable/vcg-ast.d @@ -52,8 +52,7 @@ alias wchar_t = __c_wchar_t; T[] values(T)() { - T[] values; - values ~= T(); + T[] values = [T()]; return values; } diff --git a/gcc/testsuite/gdc.test/fail_compilation/attributediagnostic.d b/gcc/testsuite/gdc.test/fail_compilation/attributediagnostic.d new file mode 100644 index 0000000..1fdf5a5 --- /dev/null +++ b/gcc/testsuite/gdc.test/fail_compilation/attributediagnostic.d @@ -0,0 +1,23 @@ +/* +TEST_OUTPUT: +--- +fail_compilation/attributediagnostic.d(16): Error: `@safe` function `attributediagnostic.layer2` cannot call `@system` function `attributediagnostic.layer1` +fail_compilation/attributediagnostic.d(18): which calls `attributediagnostic.layer0` +fail_compilation/attributediagnostic.d(20): which calls `attributediagnostic.system` +fail_compilation/attributediagnostic.d(22): which was inferred `@system` because of: +fail_compilation/attributediagnostic.d(22): `asm` statement is assumed to be `@system` - mark it with `@trusted` if it is not +fail_compilation/attributediagnostic.d(17): `attributediagnostic.layer1` is declared here +--- +*/ + +// Issue 17374 - Improve inferred attribute error message +// https://issues.dlang.org/show_bug.cgi?id=17374 + +auto layer2() @safe { layer1(); } +auto layer1() { layer0(); } +auto layer0() { system(); } + +auto system() +{ + asm {} +} diff --git a/gcc/testsuite/gdc.test/fail_compilation/b6227.d b/gcc/testsuite/gdc.test/fail_compilation/b6227.d index a9b2a50..c975a43 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/b6227.d +++ b/gcc/testsuite/gdc.test/fail_compilation/b6227.d @@ -1,8 +1,8 @@ /* TEST_OUTPUT: --- -fail_compilation/b6227.d(16): Error: Comparison between different enumeration types `X` and `Y`; If this behavior is intended consider using `std.conv.asOriginalType` +fail_compilation/b6227.d(16): Error: comparison between different enumeration types `X` and `Y`; If this behavior is intended consider using `std.conv.asOriginalType` fail_compilation/b6227.d(16): while evaluating: `static assert(!(X.O != Y.U))` -fail_compilation/b6227.d(17): Error: Comparison between different enumeration types `X` and `Y`; If this behavior is intended consider using `std.conv.asOriginalType` +fail_compilation/b6227.d(17): Error: comparison between different enumeration types `X` and `Y`; If this behavior is intended consider using `std.conv.asOriginalType` fail_compilation/b6227.d(17): while evaluating: `static assert(X.O == Y.U)` --- */ diff --git a/gcc/testsuite/gdc.test/fail_compilation/betterc.d b/gcc/testsuite/gdc.test/fail_compilation/betterc.d index e1cc4cf..6f4fb03 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/betterc.d +++ b/gcc/testsuite/gdc.test/fail_compilation/betterc.d @@ -1,8 +1,8 @@ /* REQUIRED_ARGS: -betterC * TEST_OUTPUT: --- -fail_compilation/betterc.d(12): Error: Cannot use `throw` statements with -betterC -fail_compilation/betterc.d(17): Error: Cannot use try-catch statements with -betterC +fail_compilation/betterc.d(12): Error: cannot use `throw` statements with -betterC +fail_compilation/betterc.d(17): Error: cannot use try-catch statements with -betterC fail_compilation/betterc.d(29): Error: `TypeInfo` cannot be used with -betterC --- */ diff --git a/gcc/testsuite/gdc.test/fail_compilation/biterrors.d b/gcc/testsuite/gdc.test/fail_compilation/biterrors.d new file mode 100644 index 0000000..a8f0faa --- /dev/null +++ b/gcc/testsuite/gdc.test/fail_compilation/biterrors.d @@ -0,0 +1,15 @@ +/* REQUIRED_ARGS: -preview=bitfields + * TEST_OUTPUT: +--- +fail_compilation/biterrors.d(103): Error: initializer not allowed for bit-field declaration +fail_compilation/biterrors.d(104): Error: storage class not allowed for bit-field declaration +--- + */ + +#line 100 + +struct S +{ + int i : 3 = 7; + static int j : 3; +} diff --git a/gcc/testsuite/gdc.test/fail_compilation/biterrors2.d b/gcc/testsuite/gdc.test/fail_compilation/biterrors2.d new file mode 100644 index 0000000..c8390ba --- /dev/null +++ b/gcc/testsuite/gdc.test/fail_compilation/biterrors2.d @@ -0,0 +1,17 @@ +/* REQUIRED_ARGS: -preview=bitfields + * TEST_OUTPUT: +--- +fail_compilation/biterrors2.d(100): Error: variable `biterrors2.a` bit-field must be member of struct, union, or class +fail_compilation/biterrors2.d(104): Error: bit-field `b` has zero width +fail_compilation/biterrors2.d(105): Error: bit-field type `float` is not an integer type +--- +*/ + +#line 100 +int a : 2; + +struct S +{ + int b:0; + float c:3; +} diff --git a/gcc/testsuite/gdc.test/fail_compilation/biterrors3.d b/gcc/testsuite/gdc.test/fail_compilation/biterrors3.d new file mode 100644 index 0000000..f9e1df2 --- /dev/null +++ b/gcc/testsuite/gdc.test/fail_compilation/biterrors3.d @@ -0,0 +1,18 @@ +/* REQUIRED_ARGS: -preview=bitfields + * TEST_OUTPUT: +--- +fail_compilation/biterrors3.d(103): Error: storage class not allowed for bit-field declaration +fail_compilation/biterrors3.d(106): Error: `d` is not a valid attribute for enum members +fail_compilation/biterrors3.d(106): Error: `:` is not a valid attribute for enum members +fail_compilation/biterrors3.d(106): Error: `3` is not a valid attribute for enum members +--- +*/ + +#line 100 + +struct S +{ + static int : 3; +} + +enum E { d : 3 } diff --git a/gcc/testsuite/gdc.test/fail_compilation/biterrors4.d b/gcc/testsuite/gdc.test/fail_compilation/biterrors4.d new file mode 100644 index 0000000..0f2ca2d --- /dev/null +++ b/gcc/testsuite/gdc.test/fail_compilation/biterrors4.d @@ -0,0 +1,19 @@ +/* REQUIRED_ARGS: -preview=bitfields + * TEST_OUTPUT: +--- +fail_compilation/biterrors4.d(109): Error: cannot take address of bit-field `a` +--- +*/ + +#line 100 + +struct S +{ + int a:3; +} + +void test() +{ + S s; + int* p = &s.a; +} diff --git a/gcc/testsuite/gdc.test/fail_compilation/commaexp.d b/gcc/testsuite/gdc.test/fail_compilation/commaexp.d index 7d50223..3874fb1 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/commaexp.d +++ b/gcc/testsuite/gdc.test/fail_compilation/commaexp.d @@ -1,16 +1,16 @@ /* REQUIRED_ARGS: -o- TEST_OUTPUT: --- -fail_compilation/commaexp.d(27): Error: Using the result of a comma expression is not allowed -fail_compilation/commaexp.d(39): Error: Using the result of a comma expression is not allowed -fail_compilation/commaexp.d(40): Error: Using the result of a comma expression is not allowed -fail_compilation/commaexp.d(41): Error: Using the result of a comma expression is not allowed -fail_compilation/commaexp.d(42): Error: Using the result of a comma expression is not allowed -fail_compilation/commaexp.d(44): Error: Using the result of a comma expression is not allowed -fail_compilation/commaexp.d(45): Error: Using the result of a comma expression is not allowed -fail_compilation/commaexp.d(56): Error: Using the result of a comma expression is not allowed -fail_compilation/commaexp.d(69): Error: Using the result of a comma expression is not allowed -fail_compilation/commaexp.d(81): Error: Using the result of a comma expression is not allowed +fail_compilation/commaexp.d(27): Error: using the result of a comma expression is not allowed +fail_compilation/commaexp.d(39): Error: using the result of a comma expression is not allowed +fail_compilation/commaexp.d(40): Error: using the result of a comma expression is not allowed +fail_compilation/commaexp.d(41): Error: using the result of a comma expression is not allowed +fail_compilation/commaexp.d(42): Error: using the result of a comma expression is not allowed +fail_compilation/commaexp.d(44): Error: using the result of a comma expression is not allowed +fail_compilation/commaexp.d(45): Error: using the result of a comma expression is not allowed +fail_compilation/commaexp.d(56): Error: using the result of a comma expression is not allowed +fail_compilation/commaexp.d(69): Error: using the result of a comma expression is not allowed +fail_compilation/commaexp.d(81): Error: using the result of a comma expression is not allowed --- */ diff --git a/gcc/testsuite/gdc.test/fail_compilation/cppvar.d b/gcc/testsuite/gdc.test/fail_compilation/cppvar.d new file mode 100644 index 0000000..885a555 --- /dev/null +++ b/gcc/testsuite/gdc.test/fail_compilation/cppvar.d @@ -0,0 +1,22 @@ +/* +TEST_OUTPUT: +--- +fail_compilation/cppvar.d(10): Error: variable `cppvar.funcLiteral` cannot have `extern(C++)` linkage because it is `static` +fail_compilation/cppvar.d(10): perhaps declare it as `__gshared` instead +fail_compilation/cppvar.d(20): Error: variable `cppvar.threadLocalVar` cannot have `extern(C++)` linkage because it is `static` +fail_compilation/cppvar.d(20): perhaps declare it as `__gshared` instead +fail_compilation/cppvar.d(21): Error: variable `cppvar.staticVar` cannot have `extern(C++)` linkage because it is `static` +fail_compilation/cppvar.d(21): perhaps declare it as `__gshared` instead +fail_compilation/cppvar.d(22): Error: variable `cppvar.sharedVar` cannot have `extern(C++)` linkage because it is `shared` +fail_compilation/cppvar.d(22): perhaps declare it as `__gshared` instead +fail_compilation/cppvar.d(30): Error: delegate `cppvar.__lambda7` cannot return type `bool[3]` because its linkage is `extern(C++)` +--- +*/ +#line 10 +extern(C++) bool[3] funcLiteral = () { bool[3] a; return a; }; +#line 20 +extern(C++) int threadLocalVar; +extern(C++) static int staticVar; +extern(C++) shared int sharedVar; +#line 30 +extern(C++) __gshared bool[3] gfuncLiteral = () { bool[3] a; return a; }; diff --git a/gcc/testsuite/gdc.test/fail_compilation/dbitfields.d b/gcc/testsuite/gdc.test/fail_compilation/dbitfields.d new file mode 100644 index 0000000..0dd1a0b --- /dev/null +++ b/gcc/testsuite/gdc.test/fail_compilation/dbitfields.d @@ -0,0 +1,32 @@ +/* REQUIRED_ARGS: -preview=bitfields + * TEST_OUTPUT: +--- +fail_compilation/dbitfields.d(118): Error: reinterpretation through overlapped field `e` is not allowed in CTFE +fail_compilation/dbitfields.d(121): called from here: `testu()` +fail_compilation/dbitfields.d(121): while evaluating: `static assert(testu() == 1)` +--- + */ + +#line 100 + +union U +{ + uint a:3; + uint b:1; + ulong c:64; + + int d:3; + int e:1; + long f:64; + + int i; +} + +int testu() +{ + U u; + u.d = 9; + return u.e; +} + +static assert(testu() == 1); diff --git a/gcc/testsuite/gdc.test/fail_compilation/diag10805.d b/gcc/testsuite/gdc.test/fail_compilation/diag10805.d index ed38167..932aa5c 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/diag10805.d +++ b/gcc/testsuite/gdc.test/fail_compilation/diag10805.d @@ -3,7 +3,7 @@ TEST_OUTPUT: --- fail_compilation/diag10805.d(12): Error: delimited string must end in `FOO"` fail_compilation/diag10805.d(14): Error: unterminated string constant starting at fail_compilation/diag10805.d(14) -fail_compilation/diag10805.d(14): Error: Implicit string concatenation is error-prone and disallowed in D +fail_compilation/diag10805.d(14): Error: implicit string concatenation is error-prone and disallowed in D fail_compilation/diag10805.d(14): Use the explicit syntax instead (concatenating literals is `@nogc`): "" ~ "" fail_compilation/diag10805.d(15): Error: semicolon expected following auto declaration, not `End of File` --- diff --git a/gcc/testsuite/gdc.test/fail_compilation/diag10862.d b/gcc/testsuite/gdc.test/fail_compilation/diag10862.d index 00949f1..3e15497 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/diag10862.d +++ b/gcc/testsuite/gdc.test/fail_compilation/diag10862.d @@ -24,7 +24,7 @@ fail_compilation/diag10862.d(74): Error: assignment cannot be used as a conditio fail_compilation/diag10862.d-mixin-77(77): Error: assignment cannot be used as a condition, perhaps `==` was meant? fail_compilation/diag10862.d-mixin-78(78): Error: assignment cannot be used as a condition, perhaps `==` was meant? fail_compilation/diag10862.d-mixin-79(79): Error: assignment cannot be used as a condition, perhaps `==` was meant? -fail_compilation/diag10862.d-mixin-80(80): Error: Using the result of a comma expression is not allowed +fail_compilation/diag10862.d-mixin-80(80): Error: using the result of a comma expression is not allowed fail_compilation/diag10862.d-mixin-80(80): Error: assignment cannot be used as a condition, perhaps `==` was meant? fail_compilation/diag10862.d-mixin-83(83): Error: `a + b` is not an lvalue and cannot be modified fail_compilation/diag10862.d-mixin-84(84): Error: undefined identifier `c` diff --git a/gcc/testsuite/gdc.test/fail_compilation/dip25.d b/gcc/testsuite/gdc.test/fail_compilation/dip25.d index 4f8ea23..41bfe49 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/dip25.d +++ b/gcc/testsuite/gdc.test/fail_compilation/dip25.d @@ -12,15 +12,15 @@ fail_compilation/dip25.d(23): perhaps annotate the parameter with `return struct Data { char[256] buffer; - @property const(char)[] filename() const pure nothrow + @property const(char)[] filename() const pure nothrow @safe { return buffer[]; } } -ref int identity(return ref int x) { return x; } +ref int identity(return ref int x) @safe { return x; } ref int fun(return int x) { return identity(x); } -ref int fun2(ref int x) { return identity(x); } +ref int fun2(ref int x) @safe { return identity(x); } void main() { diff --git a/gcc/testsuite/gdc.test/fail_compilation/dtor_attributes.d b/gcc/testsuite/gdc.test/fail_compilation/dtor_attributes.d index 21a12ed..ce81d6b 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/dtor_attributes.d +++ b/gcc/testsuite/gdc.test/fail_compilation/dtor_attributes.d @@ -8,6 +8,8 @@ fail_compilation/dtor_attributes.d(113): generated `Strict.~this` is impu fail_compilation/dtor_attributes.d(111): - HasDtor member fail_compilation/dtor_attributes.d(103): impure `HasDtor.~this` is declared here fail_compilation/dtor_attributes.d(118): Error: `@safe` function `dtor_attributes.test1` cannot call `@system` destructor `dtor_attributes.Strict.~this` +fail_compilation/dtor_attributes.d(113): which calls `dtor_attributes.Strict.~this` +fail_compilation/dtor_attributes.d(103): which calls `dtor_attributes.HasDtor.~this` fail_compilation/dtor_attributes.d(113): `dtor_attributes.Strict.~this` is declared here fail_compilation/dtor_attributes.d(113): generated `Strict.~this` is @system because of the following field's destructors: fail_compilation/dtor_attributes.d(111): - HasDtor member diff --git a/gcc/testsuite/gdc.test/fail_compilation/dtorfields_attributes.d b/gcc/testsuite/gdc.test/fail_compilation/dtorfields_attributes.d index f6cab89..45b23ce 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/dtorfields_attributes.d +++ b/gcc/testsuite/gdc.test/fail_compilation/dtorfields_attributes.d @@ -9,6 +9,7 @@ fail_compilation/dtorfields_attributes.d(119): generated `Strict.~this` i fail_compilation/dtorfields_attributes.d(115): - HasDtor member fail_compilation/dtorfields_attributes.d(103): impure `HasDtor.~this` is declared here fail_compilation/dtorfields_attributes.d(117): Error: `@safe` constructor `dtorfields_attributes.Strict.this` cannot call `@system` destructor `dtorfields_attributes.Strict.~this` +fail_compilation/dtorfields_attributes.d(103): which calls `dtorfields_attributes.HasDtor.~this` fail_compilation/dtorfields_attributes.d(119): `dtorfields_attributes.Strict.~this` is declared here fail_compilation/dtorfields_attributes.d(119): generated `Strict.~this` is @system because of the following field's destructors: fail_compilation/dtorfields_attributes.d(115): - HasDtor member diff --git a/gcc/testsuite/gdc.test/fail_compilation/e7804_1.d b/gcc/testsuite/gdc.test/fail_compilation/e7804_1.d index 38c25fb..1dfcf44 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/e7804_1.d +++ b/gcc/testsuite/gdc.test/fail_compilation/e7804_1.d @@ -1,11 +1,18 @@ /* TEST_OUTPUT: --- -fail_compilation/e7804_1.d(10): Error: trait `farfelu` is either invalid or not supported as type -fail_compilation/e7804_1.d(11): Error: trait `farfelu` is either invalid or not supported in alias +fail_compilation/e7804_1.d(14): Error: undefined identifier `Aggr` +fail_compilation/e7804_1.d(15): Error: unrecognized trait `farfelu` +fail_compilation/e7804_1.d(17): Error: undefined identifier `Aggr` +fail_compilation/e7804_1.d(18): Error: unrecognized trait `farfelu` --- */ module e7804_1; +struct S {} + __traits(farfelu, Aggr, "member") a; +__traits(farfelu, S, "member") a2; + alias foo = __traits(farfelu, Aggr, "member"); +alias foo2 = __traits(farfelu, S, "member"); diff --git a/gcc/testsuite/gdc.test/fail_compilation/extra-files/test23109/object.d b/gcc/testsuite/gdc.test/fail_compilation/extra-files/test23109/object.d new file mode 100644 index 0000000..747b6e9 --- /dev/null +++ b/gcc/testsuite/gdc.test/fail_compilation/extra-files/test23109/object.d @@ -0,0 +1,17 @@ +module object; + +alias size_t = typeof(int.sizeof); +class Object {} +auto opEquals(Object ) { return true; } +class TypeInfo {} +class TypeInfo_Const {} +bool _xopEquals() { return true; } + +bool __equals(T1, T2)(T1[] lhs, T2[] rhs) +{ + static at(R)(R[] r, size_t i) { return r.ptr[i]; } + foreach (u; 0 .. lhs.length) + if (at(lhs, u) != at(rhs, u)) + return false; + return true; +} diff --git a/gcc/testsuite/gdc.test/fail_compilation/fail109.d b/gcc/testsuite/gdc.test/fail_compilation/fail109.d index 3419079..7caae59 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/fail109.d +++ b/gcc/testsuite/gdc.test/fail_compilation/fail109.d @@ -34,7 +34,7 @@ enum E1 : short /* https://issues.dlang.org/show_bug.cgi?id=14950 TEST_OUTPUT: --- -fail_compilation/fail109.d(50): Error: Comparison between different enumeration types `B` and `C`; If this behavior is intended consider using `std.conv.asOriginalType` +fail_compilation/fail109.d(50): Error: comparison between different enumeration types `B` and `C`; If this behavior is intended consider using `std.conv.asOriginalType` fail_compilation/fail109.d(50): Error: enum member `fail109.B.end` initialization with `B.start+1` causes overflow for type `C` --- */ diff --git a/gcc/testsuite/gdc.test/fail_compilation/fail12604.d b/gcc/testsuite/gdc.test/fail_compilation/fail12604.d index 2ed8ebf..bed8735 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/fail12604.d +++ b/gcc/testsuite/gdc.test/fail_compilation/fail12604.d @@ -66,8 +66,8 @@ void test12606b() // ExpInitializer::semantic /* TEST_OUTPUT: --- -fail_compilation/fail12604.d(77): Error: mismatched array lengths, 4 and 3 -fail_compilation/fail12604.d(78): Error: mismatched array lengths, 4 and 3 +fail_compilation/fail12604.d(77): Error: mismatched array lengths 4 and 3 for assignment `sa1[0..4] = [1, 2, 3]` +fail_compilation/fail12604.d(78): Error: mismatched array lengths 4 and 3 for assignment `sa1[0..4] = sa2` --- */ void testc() diff --git a/gcc/testsuite/gdc.test/fail_compilation/fail13902.d b/gcc/testsuite/gdc.test/fail_compilation/fail13902.d index 12a6b6e..47cb65c 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/fail13902.d +++ b/gcc/testsuite/gdc.test/fail_compilation/fail13902.d @@ -8,11 +8,11 @@ class C { int v; } /* TEST_OUTPUT: --- -fail_compilation/fail13902.d(45): Error: Using the result of a comma expression is not allowed +fail_compilation/fail13902.d(45): Error: using the result of a comma expression is not allowed fail_compilation/fail13902.d(32): Error: returning `& x` escapes a reference to local variable `x` fail_compilation/fail13902.d(33): Error: returning `&s1.v` escapes a reference to local variable `s1` fail_compilation/fail13902.d(38): Error: returning `& sa1` escapes a reference to local variable `sa1` -fail_compilation/fail13902.d(39): Error: returning `&sa2[0][0]` escapes a reference to local variable `sa2` +fail_compilation/fail13902.d(39): Error: returning `& sa2` escapes a reference to local variable `sa2` fail_compilation/fail13902.d(40): Error: returning `& x` escapes a reference to local variable `x` fail_compilation/fail13902.d(41): Error: returning `(& x+4)` escapes a reference to local variable `x` fail_compilation/fail13902.d(42): Error: returning `& x + cast(long)x * 4L` escapes a reference to local variable `x` @@ -53,11 +53,11 @@ int* testEscape1() /* TEST_OUTPUT: --- -fail_compilation/fail13902.d(88): Error: Using the result of a comma expression is not allowed +fail_compilation/fail13902.d(88): Error: using the result of a comma expression is not allowed fail_compilation/fail13902.d(75): Error: returning `& x` escapes a reference to parameter `x` fail_compilation/fail13902.d(76): Error: returning `&s1.v` escapes a reference to parameter `s1` fail_compilation/fail13902.d(81): Error: returning `& sa1` escapes a reference to parameter `sa1` -fail_compilation/fail13902.d(82): Error: returning `&sa2[0][0]` escapes a reference to parameter `sa2` +fail_compilation/fail13902.d(82): Error: returning `& sa2` escapes a reference to parameter `sa2` fail_compilation/fail13902.d(83): Error: returning `& x` escapes a reference to parameter `x` fail_compilation/fail13902.d(84): Error: returning `(& x+4)` escapes a reference to parameter `x` fail_compilation/fail13902.d(85): Error: returning `& x + cast(long)x * 4L` escapes a reference to parameter `x` @@ -98,7 +98,7 @@ int* testEscape2( /* TEST_OUTPUT: --- -fail_compilation/fail13902.d(123): Error: Using the result of a comma expression is not allowed +fail_compilation/fail13902.d(123): Error: using the result of a comma expression is not allowed --- */ int* testEscape3( diff --git a/gcc/testsuite/gdc.test/fail_compilation/fail16001.d b/gcc/testsuite/gdc.test/fail_compilation/fail16001.d index dc480cf..9d0b96f 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/fail16001.d +++ b/gcc/testsuite/gdc.test/fail_compilation/fail16001.d @@ -2,7 +2,7 @@ /* TEST_OUTPUT: --- -fail_compilation/fail16001.d(10): Deprecation: Using `(args) => { ... }` to create a delegate that returns a delegate is error-prone. +fail_compilation/fail16001.d(10): Deprecation: using `(args) => { ... }` to create a delegate that returns a delegate is error-prone. fail_compilation/fail16001.d(10): Use `(args) { ... }` for a multi-statement function literal or use `(args) => () { }` if you intended for the lambda to return a delegate. --- */ diff --git a/gcc/testsuite/gdc.test/fail_compilation/fail16575.d b/gcc/testsuite/gdc.test/fail_compilation/fail16575.d new file mode 100644 index 0000000..7f66724 --- /dev/null +++ b/gcc/testsuite/gdc.test/fail_compilation/fail16575.d @@ -0,0 +1,65 @@ +// https://issues.dlang.org/show_bug.cgi?id=16575 +/* +REQUIRED_ARGS: -m64 +TEST_OUTPUT: +--- +fail_compilation/fail16575.d(10): Error: function `fail16575.immNull` cannot have parameter of type `immutable(typeof(null))*` because its linkage is `extern(C++)` +fail_compilation/fail16575.d(11): Error: function `fail16575.shaNull` cannot have parameter of type `shared(typeof(null))*` because its linkage is `extern(C++)` +fail_compilation/fail16575.d(20): Error: function `fail16575.immNoReturn` cannot have parameter of type `immutable(noreturn)*` because its linkage is `extern(C++)` +fail_compilation/fail16575.d(21): Error: function `fail16575.shaNoReturn` cannot have parameter of type `shared(noreturn)*` because its linkage is `extern(C++)` +fail_compilation/fail16575.d(30): Error: function `fail16575.immBasic` cannot have parameter of type `immutable(int)*` because its linkage is `extern(C++)` +fail_compilation/fail16575.d(31): Error: function `fail16575.shaBasic` cannot have parameter of type `shared(int)*` because its linkage is `extern(C++)` +fail_compilation/fail16575.d(40): Error: function `fail16575.immVector` cannot have parameter of type `immutable(__vector(long[2]))*` because its linkage is `extern(C++)` +fail_compilation/fail16575.d(41): Error: function `fail16575.shaVector` cannot have parameter of type `shared(__vector(long[2]))*` because its linkage is `extern(C++)` +fail_compilation/fail16575.d(50): Error: function `fail16575.immSArray` cannot have parameter of type `immutable(long[2])` because its linkage is `extern(C++)` +fail_compilation/fail16575.d(50): perhaps use a `long*` type instead +fail_compilation/fail16575.d(51): Error: function `fail16575.shaSArray` cannot have parameter of type `shared(long[2])` because its linkage is `extern(C++)` +fail_compilation/fail16575.d(51): perhaps use a `long*` type instead +fail_compilation/fail16575.d(60): Error: function `fail16575.immPointer` cannot have parameter of type `immutable(int*)` because its linkage is `extern(C++)` +fail_compilation/fail16575.d(61): Error: function `fail16575.shaPointer` cannot have parameter of type `shared(int*)` because its linkage is `extern(C++)` +fail_compilation/fail16575.d(71): Error: function `fail16575.immStruct` cannot have parameter of type `immutable(SPP)*` because its linkage is `extern(C++)` +fail_compilation/fail16575.d(72): Error: function `fail16575.shaStruct` cannot have parameter of type `shared(SPP)*` because its linkage is `extern(C++)` +fail_compilation/fail16575.d(81): Error: function `fail16575.immClass` cannot have parameter of type `immutable(CPP)` because its linkage is `extern(C++)` +fail_compilation/fail16575.d(82): Error: function `fail16575.shaClass` cannot have parameter of type `shared(CPP)` because its linkage is `extern(C++)` +fail_compilation/fail16575.d(91): Error: function `fail16575.immEnum` cannot have parameter of type `immutable(EPP)*` because its linkage is `extern(C++)` +fail_compilation/fail16575.d(92): Error: function `fail16575.shaEnum` cannot have parameter of type `shared(EPP)*` because its linkage is `extern(C++)` +fail_compilation/fail16575.d(100): Error: function `fail16575.typeDArray` cannot have parameter of type `int[]` because its linkage is `extern(C++)` +fail_compilation/fail16575.d(101): Error: function `fail16575.typeAArray` cannot have parameter of type `int[int]` because its linkage is `extern(C++)` +fail_compilation/fail16575.d(102): Error: function `fail16575.typeDelegate` cannot have parameter of type `extern (C++) int delegate()` because its linkage is `extern(C++)` +--- +*/ + +#line 10 +extern(C++) void immNull(immutable(typeof(null))* a) {} +extern(C++) void shaNull(shared(typeof(null))* a) {} +#line 20 +extern(C++) void immNoReturn(immutable(typeof(*null))* a) {} +extern(C++) void shaNoReturn(shared(typeof(*null))* a) {} +#line 30 +extern(C++) void immBasic(immutable(int)* a) {} +extern(C++) void shaBasic(shared(int)* a) {} +#line 40 +extern(C++) void immVector(immutable(__vector(long[2]))* a) {} +extern(C++) void shaVector(shared(__vector(long[2]))* a) {} +#line 50 +extern(C++) void immSArray(immutable(long[2]) a) {} +extern(C++) void shaSArray(shared(long[2]) a) {} +#line 60 +extern(C++) void immPointer(immutable(int*) a) {} +extern(C++) void shaPointer(shared(int*) a) {} +#line 70 +extern(C++) struct SPP {} +extern(C++) void immStruct(immutable(SPP)* a) {} +extern(C++) void shaStruct(shared(SPP)* a) {} +#line 80 +extern(C++) class CPP {} +extern(C++) void immClass(immutable CPP a) {} +extern(C++) void shaClass(shared CPP a) {} +#line 90 +extern(C++) enum EPP {a} +extern(C++) void immEnum(immutable(EPP)* a) {} +extern(C++) void shaEnum(shared(EPP)* a) {} +# line 100 +extern(C++) void typeDArray(int[] a) {} +extern(C++) void typeAArray(int[int] a) {} +extern(C++) void typeDelegate(int delegate() a) {} diff --git a/gcc/testsuite/gdc.test/fail_compilation/fail16772.d b/gcc/testsuite/gdc.test/fail_compilation/fail16772.d new file mode 100644 index 0000000..e77951d3 --- /dev/null +++ b/gcc/testsuite/gdc.test/fail_compilation/fail16772.d @@ -0,0 +1,7 @@ +// https://issues.dlang.org/show_bug.cgi?id=16772 +/* TEST_OUTPUT: +--- +fail_compilation/fail16772.d(7): Error: function `fail16772.ice16772` cannot return type `ubyte[]` because its linkage is `extern(C++)` +--- +*/ +extern(C++) ubyte[] ice16772() { return []; } diff --git a/gcc/testsuite/gdc.test/fail_compilation/fail196.d b/gcc/testsuite/gdc.test/fail_compilation/fail196.d index 55c3bd8..2c7d93f 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/fail196.d +++ b/gcc/testsuite/gdc.test/fail_compilation/fail196.d @@ -2,7 +2,7 @@ TEST_OUTPUT: --- fail_compilation/fail196.d(27): Error: delimited string must end in `)"` -fail_compilation/fail196.d(27): Error: Implicit string concatenation is error-prone and disallowed in D +fail_compilation/fail196.d(27): Error: implicit string concatenation is error-prone and disallowed in D fail_compilation/fail196.d(27): Use the explicit syntax instead (concatenating literals is `@nogc`): "foo(xxx)" ~ ";\n assert(s == " fail_compilation/fail196.d(28): Error: semicolon needed to end declaration of `s`, instead of `foo` fail_compilation/fail196.d(27): `s` declared here diff --git a/gcc/testsuite/gdc.test/fail_compilation/fail19759.d b/gcc/testsuite/gdc.test/fail_compilation/fail19759.d new file mode 100644 index 0000000..cdb65ae --- /dev/null +++ b/gcc/testsuite/gdc.test/fail_compilation/fail19759.d @@ -0,0 +1,8 @@ +// https://issues.dlang.org/show_bug.cgi?id=19759 +/* TEST_OUTPUT: +--- +fail_compilation/fail19759.d(8): Error: function `fail19759.fail19759` cannot have parameter of type `float[4]` because its linkage is `extern(C++)` +fail_compilation/fail19759.d(8): perhaps use a `float*` type instead +--- +*/ +extern(C++) bool fail19759(float[4] col); diff --git a/gcc/testsuite/gdc.test/fail_compilation/fail19881.d b/gcc/testsuite/gdc.test/fail_compilation/fail19881.d index f4a4d76..62f3dc4 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/fail19881.d +++ b/gcc/testsuite/gdc.test/fail_compilation/fail19881.d @@ -1,7 +1,8 @@ /* REQUIRED_ARGS: -preview=dip1000 * TEST_OUTPUT: --- -fail_compilation/fail19881.d(12): Error: address of local variable `local` assigned to return scope `input` +fail_compilation/fail19881.d(13): Error: address of local variable `local` assigned to return scope `input` +fail_compilation/fail19881.d(13): Error: address of variable `local` assigned to `input` with longer lifetime --- */ diff --git a/gcc/testsuite/gdc.test/fail_compilation/fail20691.d b/gcc/testsuite/gdc.test/fail_compilation/fail20691.d index 7a43232..54e36fc 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/fail20691.d +++ b/gcc/testsuite/gdc.test/fail_compilation/fail20691.d @@ -1,12 +1,9 @@ /* REQUIRED_ARGS: -preview=dip1000 TEST_OUTPUT: --- -fail_compilation/fail20691.d(106): Error: cannot take address of `scope` local `sa` in `@safe` function `bar` -fail_compilation/fail20691.d(106): Error: cannot cast expression `sa` of type `char[][2]` to `char[][]` -fail_compilation/fail20691.d(107): Error: cannot take address of `scope` local `sa` in `@safe` function `bar` -fail_compilation/fail20691.d(107): Error: cannot cast expression `sa` of type `char[][2]` to `char[][]` -fail_compilation/fail20691.d(108): Error: cannot take address of `scope` local `sa` in `@safe` function `bar` -fail_compilation/fail20691.d(108): Error: cannot cast expression `sa` of type `char[][2]` to `char[][]` +fail_compilation/fail20691.d(106): Error: cannot take address of `scope` variable `sa` since `scope` applies to first indirection only +fail_compilation/fail20691.d(107): Error: cannot take address of `scope` variable `sa` since `scope` applies to first indirection only +fail_compilation/fail20691.d(108): Error: cannot take address of `scope` variable `sa` since `scope` applies to first indirection only --- */ diff --git a/gcc/testsuite/gdc.test/fail_compilation/fail21092.d b/gcc/testsuite/gdc.test/fail_compilation/fail21092.d index 2ca826e..d12b387 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/fail21092.d +++ b/gcc/testsuite/gdc.test/fail_compilation/fail21092.d @@ -3,10 +3,10 @@ /* TEST_OUTPUT: --- -fail_compilation/fail21092.d(19): Error: Using the result of a comma expression is not allowed +fail_compilation/fail21092.d(19): Error: using the result of a comma expression is not allowed fail_compilation/fail21092.d(19): Error: using `*` on an array is no longer supported; use `*(T , U).ptr` instead fail_compilation/fail21092.d(19): Error: `*(T , cast(real*)U)` has no effect -fail_compilation/fail21092.d(26): Error: Using the result of a comma expression is not allowed +fail_compilation/fail21092.d(26): Error: using the result of a comma expression is not allowed fail_compilation/fail21092.d(26): Error: using `*` on an array is no longer supported; use `*(w , SmallStirlingCoeffs).ptr` instead fail_compilation/fail21092.d(26): Error: `*(w , cast(real*)SmallStirlingCoeffs)` has no effect --- diff --git a/gcc/testsuite/gdc.test/fail_compilation/fail21206.d b/gcc/testsuite/gdc.test/fail_compilation/fail21206.d new file mode 100644 index 0000000..c3d648e --- /dev/null +++ b/gcc/testsuite/gdc.test/fail_compilation/fail21206.d @@ -0,0 +1,13 @@ +// https://issues.dlang.org/show_bug.cgi?id=21206 +/* TEST_OUTPUT: +--- +fail_compilation/fail21206.d(9): Error: function `fail21206.Obj.toString` cannot return type `string` because its linkage is `extern(C++)` +--- +*/ +extern(C++) struct Obj +{ + string toString() + { + return "ret"; + } +} diff --git a/gcc/testsuite/gdc.test/fail_compilation/fail21275.d b/gcc/testsuite/gdc.test/fail_compilation/fail21275.d index dbdedb3..69cdf1a 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/fail21275.d +++ b/gcc/testsuite/gdc.test/fail_compilation/fail21275.d @@ -5,8 +5,8 @@ /* TEST_OUTPUT: --- -fail_compilation/fail21275.d(18): Deprecation: Function `imports.fail21275a.Foo.x` of type `ref int() return` is not accessible from module `fail21275` -fail_compilation/fail21275.d(21): Deprecation: Function `imports.fail21275a.Bar.x` of type `int(int)` is not accessible from module `fail21275` +fail_compilation/fail21275.d(18): Deprecation: function `imports.fail21275a.Foo.x` of type `ref int() return` is not accessible from module `fail21275` +fail_compilation/fail21275.d(21): Deprecation: function `imports.fail21275a.Bar.x` of type `int(int)` is not accessible from module `fail21275` --- */ diff --git a/gcc/testsuite/gdc.test/fail_compilation/fail21314.d b/gcc/testsuite/gdc.test/fail_compilation/fail21314.d new file mode 100644 index 0000000..78e52ce --- /dev/null +++ b/gcc/testsuite/gdc.test/fail_compilation/fail21314.d @@ -0,0 +1,11 @@ +// https://issues.dlang.org/show_bug.cgi?id=21314 +/* TEST_OUTPUT: +--- +fail_compilation/fail21314.d(10): Error: variable `fail21314.C21314.c21314` cannot have `extern(C++)` linkage because it is `static` +fail_compilation/fail21314.d(10): perhaps declare it as `__gshared` instead +--- +*/ +extern(C++) class C21314 +{ + static C21314[] c21314; +} diff --git a/gcc/testsuite/gdc.test/fail_compilation/fail21868b.d b/gcc/testsuite/gdc.test/fail_compilation/fail21868b.d index 687a727..0df31d7 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/fail21868b.d +++ b/gcc/testsuite/gdc.test/fail_compilation/fail21868b.d @@ -14,7 +14,7 @@ struct S int* y; } -int* test(ref return scope S s) +int* test(ref return scope S s) @safe { return &s.x; } diff --git a/gcc/testsuite/gdc.test/fail_compilation/fail23108a.d b/gcc/testsuite/gdc.test/fail_compilation/fail23108a.d new file mode 100644 index 0000000..a974871 --- /dev/null +++ b/gcc/testsuite/gdc.test/fail_compilation/fail23108a.d @@ -0,0 +1,16 @@ +// https://issues.dlang.org/show_bug.cgi?id=23108 +/* TEST_OUTPUT: +--- +fail_compilation/fail23108a.d(9): Error: undefined identifier `_xopEquals` in module `object` +--- +*/ +module object; + +struct Interface +{ + void[] vtbl; +} + +class TypeInfo +{ +} diff --git a/gcc/testsuite/gdc.test/fail_compilation/fail23108b.d b/gcc/testsuite/gdc.test/fail_compilation/fail23108b.d new file mode 100644 index 0000000..10eae37 --- /dev/null +++ b/gcc/testsuite/gdc.test/fail_compilation/fail23108b.d @@ -0,0 +1,18 @@ +// https://issues.dlang.org/show_bug.cgi?id=23108 +/* TEST_OUTPUT: +--- +fail_compilation/fail23108b.d(10): Error: undefined identifier `_xopEquals` in module `object` +fail_compilation/fail23108b.d(10): Error: undefined identifier `_xopCmp` in module `object` +--- +*/ +module object; + +struct Interface +{ + void[] vtbl; + int opCmp() { return 0; } +} + +class TypeInfo +{ +} diff --git a/gcc/testsuite/gdc.test/fail_compilation/fail23109.d b/gcc/testsuite/gdc.test/fail_compilation/fail23109.d new file mode 100644 index 0000000..91b4e79 --- /dev/null +++ b/gcc/testsuite/gdc.test/fail_compilation/fail23109.d @@ -0,0 +1,12 @@ +// https://issues.dlang.org/show_bug.cgi?id=23109 +/* +EXTRA_FILES: imports/test23109a.d imports/test23109b.d imports/test23109c.d +EXTRA_SOURCES: extra-files/test23109/object.d +TEST_OUTPUT: +--- +Error: no property `getHash` for type `object.TypeInfo_Const` +Error: no property `getHash` for type `object.TypeInfo_Const` +fail_compilation/imports/test23109a.d(10): Error: template instance `imports.test23109a.Array!(Ensure)` error instantiating +--- +*/ +import imports.test23109a; diff --git a/gcc/testsuite/gdc.test/fail_compilation/fail3703.d b/gcc/testsuite/gdc.test/fail_compilation/fail3703.d index 6b4edd5..d2d277f 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/fail3703.d +++ b/gcc/testsuite/gdc.test/fail_compilation/fail3703.d @@ -3,8 +3,8 @@ /* TEST_OUTPUT: --- -fail_compilation/fail3703.d(18): Error: mismatched array lengths, 2 and 1 -fail_compilation/fail3703.d(20): Error: mismatched array lengths, 2 and 1 +fail_compilation/fail3703.d(18): Error: mismatched array lengths 2 and 1 for assignment `b[] = a` +fail_compilation/fail3703.d(20): Error: mismatched array lengths 2 and 1 for assignment `b[] = a` fail_compilation/fail3703.d(22): Error: mismatched array lengths, 3 and 2 fail_compilation/fail3703.d(23): Error: mismatched array lengths, 2 and 3 fail_compilation/fail3703.d(25): Error: mismatched array lengths, 3 and 2 diff --git a/gcc/testsuite/gdc.test/fail_compilation/fail_scope.d b/gcc/testsuite/gdc.test/fail_compilation/fail_scope.d index 07c3766..153e90b 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/fail_scope.d +++ b/gcc/testsuite/gdc.test/fail_compilation/fail_scope.d @@ -2,39 +2,40 @@ REQUIRED_ARGS: TEST_OUTPUT: --- -fail_compilation/fail_scope.d(29): Deprecation: scope variable `da` may not be returned -fail_compilation/fail_scope.d(31): Deprecation: scope variable `o` may not be returned -fail_compilation/fail_scope.d(32): Deprecation: scope variable `dg` may not be returned -fail_compilation/fail_scope.d(34): Deprecation: scope variable `da` may not be returned -fail_compilation/fail_scope.d(36): Deprecation: scope variable `o` may not be returned -fail_compilation/fail_scope.d(37): Deprecation: scope variable `dg` may not be returned -fail_compilation/fail_scope.d(39): Deprecation: scope variable `p` may not be returned -fail_compilation/fail_scope.d(44): Error: returning `cast(char[])string` escapes a reference to local variable `string` -fail_compilation/fail_scope.d(62): Error: returning `s.bar()` escapes a reference to local variable `s` -fail_compilation/fail_scope.d(73): Error: `fail_scope.foo8` called with argument types `(int)` matches both: -fail_compilation/fail_scope.d(67): `fail_scope.foo8(ref int x)` +fail_compilation/fail_scope.d(40): Deprecation: scope variable `p` may not be returned +fail_compilation/fail_scope.d(45): Error: returning `cast(char[])string` escapes a reference to local variable `string` +fail_compilation/fail_scope.d(63): Error: returning `s.bar()` escapes a reference to local variable `s` +fail_compilation/fail_scope.d(74): Error: `fail_scope.foo8` called with argument types `(int)` matches both: +fail_compilation/fail_scope.d(68): `fail_scope.foo8(ref int x)` and: -fail_compilation/fail_scope.d(68): `fail_scope.foo8(return ref int x)` -fail_compilation/fail_scope.d(81): Error: returning `& string` escapes a reference to local variable `string` -fail_compilation/fail_scope.d(91): Error: returning `cast(int[])a` escapes a reference to local variable `a` -fail_compilation/fail_scope.d(99): Error: returning `cast(int[])a` escapes a reference to local variable `a` -fail_compilation/fail_scope.d(107): Deprecation: escaping reference to outer local variable `x` -fail_compilation/fail_scope.d(126): Error: returning `s.bar()` escapes a reference to local variable `s` -fail_compilation/fail_scope.d(136): Error: returning `foo16226(i)` escapes a reference to local variable `i` +fail_compilation/fail_scope.d(69): `fail_scope.foo8(return ref int x)` +fail_compilation/fail_scope.d(82): Error: returning `& string` escapes a reference to local variable `string` +fail_compilation/fail_scope.d(92): Error: returning `cast(int[])a` escapes a reference to local variable `a` +fail_compilation/fail_scope.d(100): Error: returning `cast(int[])a` escapes a reference to local variable `a` +fail_compilation/fail_scope.d(108): Deprecation: escaping reference to outer local variable `x` +fail_compilation/fail_scope.d(127): Error: returning `s.bar()` escapes a reference to local variable `s` +fail_compilation/fail_scope.d(137): Error: returning `foo16226(i)` escapes a reference to local variable `i` --- +//fail_compilation/fail_scope.d(30): Error: scope variable `da` may not be returned +//fail_compilation/fail_scope.d(32): Error: scope variable `o` may not be returned +//fail_compilation/fail_scope.d(33): Error: scope variable `dg` may not be returned +//fail_compilation/fail_scope.d(35): Error: scope variable `da` may not be returned +//fail_compilation/fail_scope.d(37): Error: scope variable `o` may not be returned +//fail_compilation/fail_scope.d(38): Error: scope variable `dg` may not be returned +//fail_compilation/fail_scope.d(40): Error: scope variable `p` may not be returned */ alias int delegate() dg_t; -int[] checkEscapeScope1(scope int[] da) @safe { return da; } -int[3] checkEscapeScope2(scope int[3] sa) @safe { return sa; } -Object checkEscapeScope3(scope Object o) @safe { return o; } -dg_t checkEscapeScope4(scope dg_t dg) @safe { return dg; } +int[] checkEscapeScope1(scope int[] da) { return da; } +int[3] checkEscapeScope2(scope int[3] sa) { return sa; } +Object checkEscapeScope3(scope Object o) { return o; } +dg_t checkEscapeScope4(scope dg_t dg) { return dg; } -int[] checkEscapeScope1() @safe { scope int[] da = []; return da; } -int[3] checkEscapeScope2() @safe { scope int[3] sa = [1,2,3]; return sa; } -Object checkEscapeScope3() @safe { scope Object o = new Object; return o; } // same with fail7294.d -dg_t checkEscapeScope4() @safe { scope dg_t dg = () => 1; return dg; } +int[] checkEscapeScope1() { scope int[] da = []; return da; } +int[3] checkEscapeScope2() { scope int[3] sa = [1,2,3]; return sa; } +Object checkEscapeScope3() { scope Object o = new Object; return o; } // same with fail7294.d +dg_t checkEscapeScope4() { scope dg_t dg = () => 1; return dg; } int* test(scope int* p) @safe { return p; } diff --git a/gcc/testsuite/gdc.test/fail_compilation/ice10949.d b/gcc/testsuite/gdc.test/fail_compilation/ice10949.d index 45b18e0..b39548d 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/ice10949.d +++ b/gcc/testsuite/gdc.test/fail_compilation/ice10949.d @@ -1,7 +1,7 @@ /* TEST_OUTPUT: --- -fail_compilation/ice10949.d(12): Error: Using the result of a comma expression is not allowed +fail_compilation/ice10949.d(12): Error: using the result of a comma expression is not allowed fail_compilation/ice10949.d(12): Error: array index 3 is out of bounds `[5, 5][0 .. 2]` fail_compilation/ice10949.d(12): Error: array index 17 is out of bounds `[2, 3][0 .. 2]` fail_compilation/ice10949.d(12): while evaluating: `static assert((((([5, 5][3] + global - global) * global / global % global >> global & global | global) ^ global) == 9 , [2, 3][17]) || [3, 3, 3][9] is 4 && [[1, 2, 3]][4].length)` diff --git a/gcc/testsuite/gdc.test/fail_compilation/ice14844.d b/gcc/testsuite/gdc.test/fail_compilation/ice14844.d index 9f602a5..d466a30 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/ice14844.d +++ b/gcc/testsuite/gdc.test/fail_compilation/ice14844.d @@ -1,7 +1,7 @@ /* TEST_OUTPUT: --- -fail_compilation/ice14844.d(21): Error: In expression `__traits(allMembers, opDispatch)` template `opDispatch(string name)` has no members +fail_compilation/ice14844.d(21): Error: in expression `__traits(allMembers, opDispatch)` template `opDispatch(string name)` has no members fail_compilation/ice14844.d(21): `opDispatch(string name)` must evaluate to either a module, a struct, an union, a class, an interface or a template instantiation --- */ diff --git a/gcc/testsuite/gdc.test/fail_compilation/ice22377.d b/gcc/testsuite/gdc.test/fail_compilation/ice22377.d index 4616f99..686e700 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/ice22377.d +++ b/gcc/testsuite/gdc.test/fail_compilation/ice22377.d @@ -1,7 +1,7 @@ /* TEST_OUTPUT: --- -fail_compilation/ice22377.d(8): Error: Internal Compiler Error: type `string` cannot be mapped to C++ +fail_compilation/ice22377.d(8): Error: function `ice22377.foo` cannot have parameter of type `string` because its linkage is `extern(C++)` --- */ diff --git a/gcc/testsuite/gdc.test/fail_compilation/ice23097.d b/gcc/testsuite/gdc.test/fail_compilation/ice23097.d new file mode 100644 index 0000000..4fd1f61 --- /dev/null +++ b/gcc/testsuite/gdc.test/fail_compilation/ice23097.d @@ -0,0 +1,28 @@ +/* https://issues.dlang.org/show_bug.cgi?id=23097 +TEST_OUTPUT: +--- +fail_compilation/ice23097.d(12): Error: undefined identifier `ICE` +fail_compilation/ice23097.d(27): Error: template instance `ice23097.ice23097!(S23097)` error instantiating +fail_compilation/ice23097.d(27): Error: function `ice23097.ice23097!(S23097).ice23097(S23097 _param_0)` is not callable using argument types `(S23097)` +fail_compilation/ice23097.d(27): generating a copy constructor for `struct S23097` failed, therefore instances of it are uncopyable +--- +*/ +auto ice23097(I)(I) +{ + ICE; +} + +struct Cpctor23097 +{ + this(ref typeof(this)) { } +} + +struct S23097 +{ + Cpctor23097 cpctor; +} + +auto fail23097(S23097 s) +{ + s.ice23097; +} diff --git a/gcc/testsuite/gdc.test/fail_compilation/ice9254a.d b/gcc/testsuite/gdc.test/fail_compilation/ice9254a.d index d7086b4..8ba1cbf 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/ice9254a.d +++ b/gcc/testsuite/gdc.test/fail_compilation/ice9254a.d @@ -1,11 +1,11 @@ /* TEST_OUTPUT: --- -fail_compilation/ice9254a.d(15): Error: Using the result of a comma expression is not allowed -fail_compilation/ice9254a.d(15): Error: Using the result of a comma expression is not allowed -fail_compilation/ice9254a.d(15): Error: Using the result of a comma expression is not allowed -fail_compilation/ice9254a.d(15): Error: Using the result of a comma expression is not allowed -fail_compilation/ice9254a.d(15): Error: Using the result of a comma expression is not allowed +fail_compilation/ice9254a.d(15): Error: using the result of a comma expression is not allowed +fail_compilation/ice9254a.d(15): Error: using the result of a comma expression is not allowed +fail_compilation/ice9254a.d(15): Error: using the result of a comma expression is not allowed +fail_compilation/ice9254a.d(15): Error: using the result of a comma expression is not allowed +fail_compilation/ice9254a.d(15): Error: using the result of a comma expression is not allowed fail_compilation/ice9254a.d(15): Error: invalid `foreach` aggregate `false` of type `bool` --- */ diff --git a/gcc/testsuite/gdc.test/fail_compilation/ice9254b.d b/gcc/testsuite/gdc.test/fail_compilation/ice9254b.d index 5484abd..04f28fd 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/ice9254b.d +++ b/gcc/testsuite/gdc.test/fail_compilation/ice9254b.d @@ -1,11 +1,11 @@ /* TEST_OUTPUT: --- -fail_compilation/ice9254b.d(17): Error: Using the result of a comma expression is not allowed -fail_compilation/ice9254b.d(17): Error: Using the result of a comma expression is not allowed -fail_compilation/ice9254b.d(17): Error: Using the result of a comma expression is not allowed -fail_compilation/ice9254b.d(17): Error: Using the result of a comma expression is not allowed -fail_compilation/ice9254b.d(17): Error: Using the result of a comma expression is not allowed +fail_compilation/ice9254b.d(17): Error: using the result of a comma expression is not allowed +fail_compilation/ice9254b.d(17): Error: using the result of a comma expression is not allowed +fail_compilation/ice9254b.d(17): Error: using the result of a comma expression is not allowed +fail_compilation/ice9254b.d(17): Error: using the result of a comma expression is not allowed +fail_compilation/ice9254b.d(17): Error: using the result of a comma expression is not allowed fail_compilation/ice9254b.d(17): Error: invalid `foreach` aggregate `false` of type `bool` --- */ diff --git a/gcc/testsuite/gdc.test/fail_compilation/ice9254c.d b/gcc/testsuite/gdc.test/fail_compilation/ice9254c.d index 23eeecc..acecc8d 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/ice9254c.d +++ b/gcc/testsuite/gdc.test/fail_compilation/ice9254c.d @@ -1,11 +1,11 @@ /* TEST_OUTPUT: --- -fail_compilation/ice9254c.d(15): Error: Using the result of a comma expression is not allowed -fail_compilation/ice9254c.d(15): Error: Using the result of a comma expression is not allowed -fail_compilation/ice9254c.d(15): Error: Using the result of a comma expression is not allowed -fail_compilation/ice9254c.d(15): Error: Using the result of a comma expression is not allowed -fail_compilation/ice9254c.d(15): Error: Using the result of a comma expression is not allowed +fail_compilation/ice9254c.d(15): Error: using the result of a comma expression is not allowed +fail_compilation/ice9254c.d(15): Error: using the result of a comma expression is not allowed +fail_compilation/ice9254c.d(15): Error: using the result of a comma expression is not allowed +fail_compilation/ice9254c.d(15): Error: using the result of a comma expression is not allowed +fail_compilation/ice9254c.d(15): Error: using the result of a comma expression is not allowed fail_compilation/ice9254c.d(15): Error: invalid `foreach` aggregate `false` of type `bool` --- */ diff --git a/gcc/testsuite/gdc.test/fail_compilation/imports/test23109a.d b/gcc/testsuite/gdc.test/fail_compilation/imports/test23109a.d new file mode 100644 index 0000000..5a11d91 --- /dev/null +++ b/gcc/testsuite/gdc.test/fail_compilation/imports/test23109a.d @@ -0,0 +1,10 @@ +module imports.test23109a; +import imports.test23109c; +import imports.test23109b; +struct Array(T) +{ + T[] data; + enum SMALLARRAYCAP = 1; + T[SMALLARRAYCAP] smallarray; +} +alias Ensures = Array!Ensure; diff --git a/gcc/testsuite/gdc.test/fail_compilation/imports/test23109b.d b/gcc/testsuite/gdc.test/fail_compilation/imports/test23109b.d new file mode 100644 index 0000000..38680d3 --- /dev/null +++ b/gcc/testsuite/gdc.test/fail_compilation/imports/test23109b.d @@ -0,0 +1,10 @@ +module imports.test23109b; +import imports.test23109a; +import imports.test23109c; +struct Ensure +{ + Statement ensure; + Ensures* arraySyntaxCopy() + { + } +} diff --git a/gcc/testsuite/gdc.test/fail_compilation/imports/test23109c.d b/gcc/testsuite/gdc.test/fail_compilation/imports/test23109c.d new file mode 100644 index 0000000..c6faf5c --- /dev/null +++ b/gcc/testsuite/gdc.test/fail_compilation/imports/test23109c.d @@ -0,0 +1,3 @@ +module imports.test23109c; +import imports.test23109b; +class Statement {} diff --git a/gcc/testsuite/gdc.test/fail_compilation/issue3827.d b/gcc/testsuite/gdc.test/fail_compilation/issue3827.d index d17cee8..12ae60b 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/issue3827.d +++ b/gcc/testsuite/gdc.test/fail_compilation/issue3827.d @@ -2,9 +2,9 @@ /* TEST_OUTPUT: --- -fail_compilation/issue3827.d(14): Error: Implicit string concatenation is error-prone and disallowed in D +fail_compilation/issue3827.d(14): Error: implicit string concatenation is error-prone and disallowed in D fail_compilation/issue3827.d(14): Use the explicit syntax instead (concatenating literals is `@nogc`): "Hello" ~ "World" -fail_compilation/issue3827.d(15): Error: Implicit string concatenation is error-prone and disallowed in D +fail_compilation/issue3827.d(15): Error: implicit string concatenation is error-prone and disallowed in D fail_compilation/issue3827.d(15): Use the explicit syntax instead (concatenating literals is `@nogc`): "A" ~ "B" --- */ diff --git a/gcc/testsuite/gdc.test/fail_compilation/no_Throwable.d b/gcc/testsuite/gdc.test/fail_compilation/no_Throwable.d index 5a8af97..eb385cb 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/no_Throwable.d +++ b/gcc/testsuite/gdc.test/fail_compilation/no_Throwable.d @@ -4,8 +4,8 @@ REQUIRED_ARGS: -c EXTRA_SOURCES: extra-files/minimal/object.d TEST_OUTPUT: --- -fail_compilation/no_Throwable.d(14): Error: Cannot use `throw` statements because `object.Throwable` was not declared -fail_compilation/no_Throwable.d(19): Error: Cannot use try-catch statements because `object.Throwable` was not declared +fail_compilation/no_Throwable.d(14): Error: cannot use `throw` statements because `object.Throwable` was not declared +fail_compilation/no_Throwable.d(19): Error: cannot use try-catch statements because `object.Throwable` was not declared --- */ diff --git a/gcc/testsuite/gdc.test/fail_compilation/retscope.d b/gcc/testsuite/gdc.test/fail_compilation/retscope.d index 64db4c8..27d5663 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/retscope.d +++ b/gcc/testsuite/gdc.test/fail_compilation/retscope.d @@ -85,7 +85,7 @@ struct HTTP /* TEST_OUTPUT: --- -fail_compilation/retscope.d(96): Error: reference to local variable `sa` assigned to non-scope parameter `a` calling retscope.bar8 +fail_compilation/retscope.d(96): Error: reference to local variable `sa` assigned to non-scope parameter `a` --- */ // https://issues.dlang.org/show_bug.cgi?id=8838 @@ -234,16 +234,16 @@ void* funretscope(scope dg_t ptr) @safe /* TEST_OUTPUT: --- -fail_compilation/retscope.d(248): Error: cannot implicitly convert expression `__lambda2` of type `void* delegate() pure nothrow @nogc @safe` to `void* delegate() @safe` -fail_compilation/retscope.d(248): Error: cannot implicitly convert expression `__lambda2` of type `void* delegate() pure nothrow @nogc @safe` to `void* delegate() @safe` -fail_compilation/retscope.d(249): Error: cannot implicitly convert expression `__lambda4` of type `void* delegate() pure nothrow @nogc @safe` to `void* delegate() @safe` -fail_compilation/retscope.d(249): Error: cannot implicitly convert expression `__lambda4` of type `void* delegate() pure nothrow @nogc @safe` to `void* delegate() @safe` +fail_compilation/retscope.d(248): Error: cannot implicitly convert expression `__lambda2` of type `void* delegate() pure nothrow @nogc @safe` to `void* delegate() scope @safe` +fail_compilation/retscope.d(248): Error: cannot implicitly convert expression `__lambda2` of type `void* delegate() pure nothrow @nogc @safe` to `void* delegate() scope @safe` +fail_compilation/retscope.d(249): Error: cannot implicitly convert expression `__lambda4` of type `void* delegate() pure nothrow @nogc @safe` to `void* delegate() scope @safe` +fail_compilation/retscope.d(249): Error: cannot implicitly convert expression `__lambda4` of type `void* delegate() pure nothrow @nogc @safe` to `void* delegate() scope @safe` --- */ void escape4() @safe { - alias FunDG = void* delegate () @safe; + alias FunDG = void* delegate () scope @safe; int x = 42; scope FunDG f = () return { return &x; }; scope FunDG g = () { return &x; }; @@ -254,7 +254,7 @@ void escape4() @safe /* TEST_OUTPUT: --- -fail_compilation/retscope.d(266): Error: cannot take address of `scope` local `p` in `@safe` function `escape5` +fail_compilation/retscope.d(266): Error: cannot take address of `scope` variable `p` since `scope` applies to first indirection only --- */ @@ -331,7 +331,7 @@ int* bar10( scope int** ptr ) @safe /* TEST_OUTPUT: --- -fail_compilation/retscope.d(342): Error: cannot take address of `scope` local `aa` in `@safe` function `escape11` +fail_compilation/retscope.d(342): Error: cannot take address of `scope` variable `aa` since `scope` applies to first indirection only --- */ @@ -403,7 +403,7 @@ class Foo13 /* TEST_OUTPUT: --- -fail_compilation/retscope.d(1205): Error: scope variable `f14` assigned to non-scope parameter `this` calling retscope.Foo14.foo +fail_compilation/retscope.d(1205): Error: scope variable `f14` assigned to non-scope parameter `this` --- */ @@ -454,7 +454,7 @@ fail_compilation/retscope.d(1311): Error: scope variable `u2` assigned to `ek` w /* TEST_OUTPUT: --- -fail_compilation/retscope.d(1405): Error: reference to local variable `buf` assigned to non-scope parameter `__anonymous_param` calling retscope.myprintf +fail_compilation/retscope.d(1405): Error: reference to local variable `buf` assigned to non-scope parameter `__anonymous_param` --- */ diff --git a/gcc/testsuite/gdc.test/fail_compilation/retscope2.d b/gcc/testsuite/gdc.test/fail_compilation/retscope2.d index 4f1e324..17d2182 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/retscope2.d +++ b/gcc/testsuite/gdc.test/fail_compilation/retscope2.d @@ -86,8 +86,8 @@ fail_compilation/retscope2.d(504): Error: scope variable `c` may not be returned /* TEST_OUTPUT: --- -fail_compilation/retscope2.d(604): Error: scope variable `_param_0` assigned to non-scope parameter `__anonymous_param` calling retscope2.foo600 -fail_compilation/retscope2.d(604): Error: scope variable `_param_1` assigned to non-scope parameter `__anonymous_param` calling retscope2.foo600 +fail_compilation/retscope2.d(604): Error: scope variable `_param_0` assigned to non-scope parameter `__anonymous_param` +fail_compilation/retscope2.d(604): Error: scope variable `_param_1` assigned to non-scope parameter `__anonymous_param` fail_compilation/retscope2.d(614): Error: template instance `retscope2.test600!(int*, int*)` error instantiating --- */ @@ -156,7 +156,7 @@ fail_compilation/retscope2.d(804): Error: scope variable `e` may not be thrown #line 800 -void foo800() +void foo800() @safe { scope Exception e; throw e; diff --git a/gcc/testsuite/gdc.test/fail_compilation/retscope6.d b/gcc/testsuite/gdc.test/fail_compilation/retscope6.d index 6d5807b..b9a85ae 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/retscope6.d +++ b/gcc/testsuite/gdc.test/fail_compilation/retscope6.d @@ -76,9 +76,9 @@ void foo() @safe /* TEST_OUTPUT: --- fail_compilation/retscope6.d(8016): Error: address of variable `i` assigned to `p` with longer lifetime -fail_compilation/retscope6.d(8031): Error: reference to local variable `i` assigned to non-scope parameter `p` calling retscope6.betty!().betty -fail_compilation/retscope6.d(8031): Error: reference to local variable `j` assigned to non-scope parameter `q` calling retscope6.betty!().betty -fail_compilation/retscope6.d(8048): Error: reference to local variable `j` assigned to non-scope parameter `q` calling retscope6.archie!().archie +fail_compilation/retscope6.d(8031): Error: reference to local variable `i` assigned to non-scope parameter `p` +fail_compilation/retscope6.d(8031): Error: reference to local variable `j` assigned to non-scope parameter `q` +fail_compilation/retscope6.d(8048): Error: reference to local variable `j` assigned to non-scope parameter `q` --- */ @@ -172,7 +172,7 @@ T9 testfred() /* TEST_OUTPUT: --- -fail_compilation/retscope6.d(10003): Error: scope variable `values` assigned to non-scope parameter `values` calling retscope6.escape +fail_compilation/retscope6.d(10003): Error: scope variable `values` assigned to non-scope parameter `values` --- */ @@ -234,7 +234,7 @@ const(int)* f_c_20150() @safe nothrow /* TEST_OUTPUT: --- -fail_compilation/retscope6.d(13010): Error: reference to local variable `str` assigned to non-scope parameter `x` calling retscope6.f_throw +fail_compilation/retscope6.d(13010): Error: reference to local variable `str` assigned to non-scope parameter `x` --- */ @@ -254,7 +254,7 @@ void escape_throw_20150() @safe /* TEST_OUTPUT: --- -fail_compilation/retscope6.d(14019): Error: scope variable `scopePtr` assigned to non-scope parameter `x` calling retscope6.noInfer23021 +fail_compilation/retscope6.d(14019): Error: scope variable `scopePtr` assigned to non-scope parameter `x` fail_compilation/retscope6.d(14022): Error: scope variable `scopePtr` may not be returned --- */ diff --git a/gcc/testsuite/gdc.test/fail_compilation/safe_gshared.d b/gcc/testsuite/gdc.test/fail_compilation/safe_gshared.d new file mode 100644 index 0000000..ea0775c --- /dev/null +++ b/gcc/testsuite/gdc.test/fail_compilation/safe_gshared.d @@ -0,0 +1,15 @@ +/* +TEST_OUTPUT: +--- +fail_compilation/safe_gshared.d(13): Error: `@safe` function `f` cannot access `__gshared` data `x` +fail_compilation/safe_gshared.d(14): Error: `@safe` function `f` cannot access `__gshared` data `x` +--- +*/ + +__gshared int x; + +@safe int f() +{ + x++; + return x; +} diff --git a/gcc/testsuite/gdc.test/fail_compilation/safe_pointer_index.d b/gcc/testsuite/gdc.test/fail_compilation/safe_pointer_index.d new file mode 100644 index 0000000..4b107db --- /dev/null +++ b/gcc/testsuite/gdc.test/fail_compilation/safe_pointer_index.d @@ -0,0 +1,12 @@ +/* +TEST_OUTPUT: +--- +fail_compilation/safe_pointer_index.d(11): Error: `@safe` function `f` cannot index pointer `x` +--- +*/ + +@safe void f(int* x) +{ + int y = x[0]; // allowed, same as *x + int z = x[1]; +} diff --git a/gcc/testsuite/gdc.test/fail_compilation/test13536.d b/gcc/testsuite/gdc.test/fail_compilation/test13536.d index c45d76a..f4e2cac 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/test13536.d +++ b/gcc/testsuite/gdc.test/fail_compilation/test13536.d @@ -2,7 +2,7 @@ TEST_OUTPUT: --- fail_compilation/test13536.d(23): Error: field `U.sysDg` cannot access pointers in `@safe` code that overlap other fields -fail_compilation/test13536.d(23): Error: address of variable `s` assigned to `u` with longer lifetime +fail_compilation/test13536.d(23): Deprecation: address of variable `s` assigned to `u` with longer lifetime fail_compilation/test13536.d(24): Error: field `U.safeDg` cannot access pointers in `@safe` code that overlap other fields --- */ diff --git a/gcc/testsuite/gdc.test/fail_compilation/test14496.d b/gcc/testsuite/gdc.test/fail_compilation/test14496.d index 92dd3cf..9f628ca 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/test14496.d +++ b/gcc/testsuite/gdc.test/fail_compilation/test14496.d @@ -1,11 +1,11 @@ /* TEST_OUTPUT: --- -fail_compilation/test14496.d(21): Error: variable `test14496.foo.f` `void` initializers for pointers not allowed in safe functions -fail_compilation/test14496.d(24): Error: variable `test14496.foo.Bar.foo` `void` initializers for pointers not allowed in safe functions -fail_compilation/test14496.d(28): Error: variable `test14496.foo.Baz.x` `void` initializers for pointers not allowed in safe functions -fail_compilation/test14496.d(48): Error: variable `test14496.sinister.bar` `void` initializers for pointers not allowed in safe functions -fail_compilation/test14496.d(49): Error: variable `test14496.sinister.baz` `void` initializers for pointers not allowed in safe functions +fail_compilation/test14496.d(21): Error: `void` initializers for pointers not allowed in safe functions +fail_compilation/test14496.d(24): Error: `void` initializers for pointers not allowed in safe functions +fail_compilation/test14496.d(28): Error: `void` initializers for pointers not allowed in safe functions +fail_compilation/test14496.d(48): Error: `void` initializers for pointers not allowed in safe functions +fail_compilation/test14496.d(49): Error: `void` initializers for pointers not allowed in safe functions --- */ // https://issues.dlang.org/show_bug.cgi?id=14496 diff --git a/gcc/testsuite/gdc.test/fail_compilation/test15191.d b/gcc/testsuite/gdc.test/fail_compilation/test15191.d index f2a117c..fbbc1c0 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/test15191.d +++ b/gcc/testsuite/gdc.test/fail_compilation/test15191.d @@ -1,12 +1,11 @@ /* TEST_OUTPUT: REQUIRED_ARGS: -preview=dip1000 --- -fail_compilation/test15191.d(35): Error: returning `&identity(x)` escapes a reference to local variable `x` -fail_compilation/test15191.d(41): Error: returning `&identityPtr(x)` escapes a reference to local variable `x` -fail_compilation/test15191.d(47): Error: cannot take address of `ref return` of `identityPtr()` in `@safe` function `addrOfRefTransitive` -fail_compilation/test15191.d(47): return type `int*` has pointers that may be `scope` -fail_compilation/test15191.d(68): Error: cannot slice static array of `ref return` of `identityArr()` in `@safe` function `sliceOfRefEscape` -fail_compilation/test15191.d(68): return type `int*[1]` has pointers that may be `scope` +fail_compilation/test15191.d(34): Error: returning `&identity(x)` escapes a reference to local variable `x` +fail_compilation/test15191.d(40): Error: returning `&identityPtr(x)` escapes a reference to local variable `x` +fail_compilation/test15191.d(46): Error: returning `&identityPtr(x)` escapes a reference to local variable `x` +fail_compilation/test15191.d(67): Error: cannot take address of `scope` variable `x` since `scope` applies to first indirection only +fail_compilation/test15191.d(69): Error: cannot take address of `scope` variable `x` since `scope` applies to first indirection only --- */ @@ -61,10 +60,24 @@ ref int*[1] identityArr(return ref scope int*[1] x) return x; } -int* sliceOfRefEscape() +int*[] sliceOfRefEscape() { int stackVar = 0xFF; scope int*[1] x = [&stackVar]; - int*[] y = identityArr(x)[]; - return y[0]; + auto y = identityArr(x)[]; // check transitive scope in assignment + cast(void) y; + return identityArr(x)[]; // check transitive scope in return statement +} + +// https://issues.dlang.org/show_bug.cgi?id=23079 +int** p; + +ref int* get() @safe +{ + return *p; +} + +int** g1() @safe +{ + return &get(); } diff --git a/gcc/testsuite/gdc.test/fail_compilation/test15373.d b/gcc/testsuite/gdc.test/fail_compilation/test15373.d index 1b3cecd..02a1b32 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/test15373.d +++ b/gcc/testsuite/gdc.test/fail_compilation/test15373.d @@ -1,7 +1,7 @@ /* TEST_OUTPUT: --- -fail_compilation/test15373.d(21): Error: Runtime type information is not supported for `extern(C++)` classes +fail_compilation/test15373.d(21): Error: runtime type information is not supported for `extern(C++)` classes --- */ diff --git a/gcc/testsuite/gdc.test/fail_compilation/test16188.d b/gcc/testsuite/gdc.test/fail_compilation/test16188.d index c8ab825..c4a0fa6 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/test16188.d +++ b/gcc/testsuite/gdc.test/fail_compilation/test16188.d @@ -1,8 +1,8 @@ -TEST_OUTPUT: +/* REQUIRED_ARGS: -preview=bitfields + * TEST_OUTPUT: --- -fail_compilation/test16188.d(1): Error: no identifier for declarator `TEST_OUTPUT` -fail_compilation/test16188.d(1): Error: declaration expected, not `:` -fail_compilation/test16188.d(18): Error: unmatched closing brace +fail_compilation/test16188.d(101): Error: no property `name` for type `test16188.Where` +fail_compilation/test16188.d(101): potentially malformed `opDispatch`. Use an explicit instantiation to get a better error message --- */ @@ -15,6 +15,8 @@ fail_compilation/test16188.d(18): Error: unmatched closing brace * I don't understand why. */ +#line 100 + void where() { Where().name; } struct Where diff --git a/gcc/testsuite/gdc.test/fail_compilation/test16365.d b/gcc/testsuite/gdc.test/fail_compilation/test16365.d index a11807f..c987969 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/test16365.d +++ b/gcc/testsuite/gdc.test/fail_compilation/test16365.d @@ -3,7 +3,7 @@ TEST_OUTPUT: --- fail_compilation/test16365.d(21): Error: `this` reference necessary to take address of member `f1` in `@safe` function `main` fail_compilation/test16365.d(23): Error: cannot implicitly convert expression `&f2` of type `void delegate() pure nothrow @nogc @safe` to `void function() @safe` -fail_compilation/test16365.d(27): Error: address of variable `s` assigned to `dg` with longer lifetime +fail_compilation/test16365.d(27): Deprecation: address of variable `s` assigned to `dg` with longer lifetime fail_compilation/test16365.d(28): Error: `dg.funcptr` cannot be used in `@safe` code --- */ diff --git a/gcc/testsuite/gdc.test/fail_compilation/test17284.d b/gcc/testsuite/gdc.test/fail_compilation/test17284.d index 5bb3c2c..b7fd979 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/test17284.d +++ b/gcc/testsuite/gdc.test/fail_compilation/test17284.d @@ -1,9 +1,10 @@ /* TEST_OUTPUT: --- -fail_compilation/test17284.d(16): Error: field `U.c` cannot access pointers in `@safe` code that overlap other fields +fail_compilation/test17284.d(17): Error: field `U.c` cannot access pointers in `@safe` code that overlap other fields pure nothrow @safe void(U t) --- +REQUIRED_ARGS: -preview=bitfields */ // https://issues.dlang.org/show_bug.cgi?id=17284 diff --git a/gcc/testsuite/gdc.test/fail_compilation/test17423.d b/gcc/testsuite/gdc.test/fail_compilation/test17423.d index 66a81c3..ec86646 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/test17423.d +++ b/gcc/testsuite/gdc.test/fail_compilation/test17423.d @@ -1,7 +1,7 @@ /* REQUIRED_ARGS: -preview=dip1000 TEST_OUTPUT: --- -fail_compilation/test17423.d(26): Error: reference to local `this` assigned to non-scope parameter `dlg` calling test17423.Bar.opApply +fail_compilation/test17423.d(26): Error: reference to local `this` assigned to non-scope parameter `dlg` --- */ diff --git a/gcc/testsuite/gdc.test/fail_compilation/test17868b.d b/gcc/testsuite/gdc.test/fail_compilation/test17868b.d index 7833b61..18f1844 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/test17868b.d +++ b/gcc/testsuite/gdc.test/fail_compilation/test17868b.d @@ -2,8 +2,8 @@ TEST_OUTPUT: ---- fail_compilation/test17868b.d(9): Error: pragma `crt_constructor` can only apply to a single declaration -fail_compilation/test17868b.d(10): Error: function `test17868b.foo` must be `extern(C)` for `pragma(crt_constructor)` -fail_compilation/test17868b.d(14): Error: function `test17868b.bar` must be `extern(C)` for `pragma(crt_constructor)` +fail_compilation/test17868b.d(14): Error: function `test17868b.bar` must return `void` for `pragma(crt_constructor)` +fail_compilation/test17868b.d(18): Error: function `test17868b.baz` must be `extern(C)` for `pragma(crt_constructor)` when taking parameters ---- */ pragma(crt_constructor): @@ -11,6 +11,14 @@ void foo() { } -void bar() +extern(C) int bar() +{ +} + +void baz(int argc, char** argv) +{ +} + +extern(C) void bazC(int, char**) { } diff --git a/gcc/testsuite/gdc.test/fail_compilation/test18130.d b/gcc/testsuite/gdc.test/fail_compilation/test18130.d index 4309a6b..be296f8 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/test18130.d +++ b/gcc/testsuite/gdc.test/fail_compilation/test18130.d @@ -1,7 +1,7 @@ /* TEST_OUTPUT: --- -fail_compilation/test18130.d(8): Error: variable `test18130.foo.v` Zero-length `out` parameters are not allowed. +fail_compilation/test18130.d(8): Error: variable `test18130.foo.v` zero-length `out` parameters are not allowed. --- */ // https://issues.dlang.org/show_bug.cgi?id=18130 diff --git a/gcc/testsuite/gdc.test/fail_compilation/test18282.d b/gcc/testsuite/gdc.test/fail_compilation/test18282.d index cf26878..580fe1b 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/test18282.d +++ b/gcc/testsuite/gdc.test/fail_compilation/test18282.d @@ -60,7 +60,7 @@ TEST_OUTPUT: fail_compilation/test18282.d(1007): Error: copying `& foo` into allocated memory escapes a reference to local variable `foo` fail_compilation/test18282.d(1008): Error: copying `& foo` into allocated memory escapes a reference to local variable `foo` fail_compilation/test18282.d(1009): Error: copying `& foo` into allocated memory escapes a reference to local variable `foo` -fail_compilation/test18282.d(1016): Error: copying `&this` into allocated memory escapes a reference to parameter variable `this` +fail_compilation/test18282.d(1016): Error: copying `&this` into allocated memory escapes a reference to parameter `this` --- */ diff --git a/gcc/testsuite/gdc.test/fail_compilation/test18484.d b/gcc/testsuite/gdc.test/fail_compilation/test18484.d index 55d0ff1..d604f38 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/test18484.d +++ b/gcc/testsuite/gdc.test/fail_compilation/test18484.d @@ -10,11 +10,11 @@ fail_compilation/test18484.d(24): Error: escaping reference to stack allocated v struct S { - int* bar() return; + int* bar() @safe return; int i; } -int* test1() +int* test1() @safe { auto x = S(); return x.bar(); // error } diff --git a/gcc/testsuite/gdc.test/fail_compilation/test20245.d b/gcc/testsuite/gdc.test/fail_compilation/test20245.d index 74c5384..daa0697 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/test20245.d +++ b/gcc/testsuite/gdc.test/fail_compilation/test20245.d @@ -2,15 +2,15 @@ REQUIRED_ARGS: -preview=dip1000 TEST_OUTPUT: --- -fail_compilation/test20245.d(20): Error: reference to local variable `x` assigned to non-scope parameter `ptr` calling test20245.escape -fail_compilation/test20245.d(21): Error: copying `&x` into allocated memory escapes a reference to parameter variable `x` +fail_compilation/test20245.d(20): Error: reference to local variable `x` assigned to non-scope parameter `ptr` +fail_compilation/test20245.d(21): Error: copying `&x` into allocated memory escapes a reference to parameter `x` fail_compilation/test20245.d(22): Error: scope variable `a` may not be returned -fail_compilation/test20245.d(26): Error: cannot take address of `scope` parameter `x` in `@safe` function `foo` -fail_compilation/test20245.d(32): Error: reference to local variable `x` assigned to non-scope parameter `ptr` calling test20245.escape -fail_compilation/test20245.d(33): Error: copying `&x` into allocated memory escapes a reference to parameter variable `x` +fail_compilation/test20245.d(26): Error: cannot take address of `scope` variable `x` since `scope` applies to first indirection only +fail_compilation/test20245.d(32): Error: reference to local variable `x` assigned to non-scope parameter `ptr` +fail_compilation/test20245.d(33): Error: copying `&x` into allocated memory escapes a reference to parameter `x` fail_compilation/test20245.d(49): Error: reference to local variable `price` assigned to non-scope `this.minPrice` -fail_compilation/test20245.d(68): Error: reference to local variable `this` assigned to non-scope parameter `msg` calling object.Exception.this -fail_compilation/test20245.d(88): Error: reference to local variable `this` assigned to non-scope parameter `content` calling test20245.listUp +fail_compilation/test20245.d(68): Error: reference to local variable `this` assigned to non-scope parameter `msg` +fail_compilation/test20245.d(88): Error: reference to local variable `this` assigned to non-scope parameter `content` --- */ diff --git a/gcc/testsuite/gdc.test/fail_compilation/test20569.d b/gcc/testsuite/gdc.test/fail_compilation/test20569.d index a5ac98b..7ad50dc 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/test20569.d +++ b/gcc/testsuite/gdc.test/fail_compilation/test20569.d @@ -1,8 +1,8 @@ /* REQUIRED_ARGS: -preview=dip1000 TEST_OUTPUT: --- -fail_compilation/test20569.d(19): Error: cannot take address of `scope` local `s1` in `@safe` function `main` -fail_compilation/test20569.d(23): Error: cannot take address of `scope` local `s2` in `@safe` function `main` +fail_compilation/test20569.d(19): Error: cannot take address of `scope` variable `s1` since `scope` applies to first indirection only +fail_compilation/test20569.d(23): Error: cannot take address of `scope` variable `s2` since `scope` applies to first indirection only --- */ diff --git a/gcc/testsuite/gdc.test/fail_compilation/test21198.d b/gcc/testsuite/gdc.test/fail_compilation/test21198.d index cab6fc8..04c3bcf 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/test21198.d +++ b/gcc/testsuite/gdc.test/fail_compilation/test21198.d @@ -3,7 +3,7 @@ /* TEST_OUTPUT: --- -fail_compilation/test21198.d(23): Error: Generating an `inout` copy constructor for `struct test21198.U` failed, therefore instances of it are uncopyable +fail_compilation/test21198.d(23): Error: generating an `inout` copy constructor for `struct test21198.U` failed, therefore instances of it are uncopyable --- */ diff --git a/gcc/testsuite/gdc.test/fail_compilation/test21204.d b/gcc/testsuite/gdc.test/fail_compilation/test21204.d index 8732cc0..45bb6d7 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/test21204.d +++ b/gcc/testsuite/gdc.test/fail_compilation/test21204.d @@ -2,7 +2,7 @@ /* TEST_OUTPUT: --- -fail_compilation/test21204.d(22): Error: Generating an `inout` copy constructor for `struct test21204.B` failed, therefore instances of it are uncopyable +fail_compilation/test21204.d(22): Error: generating an `inout` copy constructor for `struct test21204.B` failed, therefore instances of it are uncopyable --- */ diff --git a/gcc/testsuite/gdc.test/fail_compilation/test21665.d b/gcc/testsuite/gdc.test/fail_compilation/test21665.d index a3a348d..b4c2811 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/test21665.d +++ b/gcc/testsuite/gdc.test/fail_compilation/test21665.d @@ -1,6 +1,6 @@ /* TEST_OUTPUT: --- -fail_compilation/test21665.d(18): Error: variable `test21665.test1.s` `void` initializers for structs with invariants are not allowed in safe functions +fail_compilation/test21665.d(18): Error: `void` initializers for structs with invariants are not allowed in safe functions fail_compilation/test21665.d(30): Error: field `U.s` cannot access structs with invariants in `@safe` code that overlap other fields --- */ diff --git a/gcc/testsuite/gdc.test/fail_compilation/test22145.d b/gcc/testsuite/gdc.test/fail_compilation/test22145.d index 084083c..394116d 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/test22145.d +++ b/gcc/testsuite/gdc.test/fail_compilation/test22145.d @@ -1,4 +1,5 @@ /* TEST_OUTPUT: +REQUIRED_ARGS: -preview=dip1000 --- fail_compilation/test22145.d(115): Error: scope variable `x` assigned to non-scope `global` --- diff --git a/gcc/testsuite/gdc.test/fail_compilation/test22593.d b/gcc/testsuite/gdc.test/fail_compilation/test22593.d index f90287e..a47c0fe 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/test22593.d +++ b/gcc/testsuite/gdc.test/fail_compilation/test22593.d @@ -3,7 +3,7 @@ /* TEST_OUTPUT: --- -fail_compilation/test22593.d(14): Error: Cannot define both an rvalue constructor and a copy constructor for `struct Foo` +fail_compilation/test22593.d(14): Error: cannot define both an rvalue constructor and a copy constructor for `struct Foo` fail_compilation/test22593.d(22): Template instance `__ctor!(immutable(Foo!int), immutable(Foo!int))` creates a rvalue constructor for `struct Foo` fail_compilation/test22593.d(22): Error: template instance `test22593.Foo!int.Foo.__ctor!(immutable(Foo!int), immutable(Foo!int))` error instantiating --- diff --git a/gcc/testsuite/gdc.test/fail_compilation/test9150.d b/gcc/testsuite/gdc.test/fail_compilation/test9150.d index e65afec..5f66b36 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/test9150.d +++ b/gcc/testsuite/gdc.test/fail_compilation/test9150.d @@ -3,7 +3,7 @@ /* TEST_OUTPUT: --- -fail_compilation/test9150.d(14): Error: mismatched array lengths, 5 and 3 +fail_compilation/test9150.d(14): Error: mismatched array lengths 5 and 3 for assignment `row[] = __r2[__key3]` --- */ diff --git a/gcc/testsuite/gdc.test/fail_compilation/traits.d b/gcc/testsuite/gdc.test/fail_compilation/traits.d index 5b9daaa..8c16afe 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/traits.d +++ b/gcc/testsuite/gdc.test/fail_compilation/traits.d @@ -11,13 +11,13 @@ fail_compilation/traits.d(200): Error: undefined identifier `imports.nonexistent fail_compilation/traits.d(201): Error: undefined identifier `imports.nonexistent` fail_compilation/traits.d(202): Error: expected 1 arguments for `isPackage` but had 0 fail_compilation/traits.d(203): Error: expected 1 arguments for `isModule` but had 0 -fail_compilation/traits.d(300): Error: In expression `__traits(allMembers, float)` `float` can't have members +fail_compilation/traits.d(300): Error: in expression `__traits(allMembers, float)` `float` can't have members fail_compilation/traits.d(300): `float` must evaluate to either a module, a struct, an union, a class, an interface or a template instantiation -fail_compilation/traits.d(306): Error: In expression `__traits(allMembers, TemplatedStruct)` struct `TemplatedStruct(T)` has no members +fail_compilation/traits.d(306): Error: in expression `__traits(allMembers, TemplatedStruct)` struct `TemplatedStruct(T)` has no members fail_compilation/traits.d(306): `TemplatedStruct(T)` must evaluate to either a module, a struct, an union, a class, an interface or a template instantiation -fail_compilation/traits.d(309): Error: In expression `__traits(derivedMembers, float)` `float` can't have members +fail_compilation/traits.d(309): Error: in expression `__traits(derivedMembers, float)` `float` can't have members fail_compilation/traits.d(309): `float` must evaluate to either a module, a struct, an union, a class, an interface or a template instantiation -fail_compilation/traits.d(316): Error: In expression `__traits(derivedMembers, TemplatedStruct)` struct `TemplatedStruct(T)` has no members +fail_compilation/traits.d(316): Error: in expression `__traits(derivedMembers, TemplatedStruct)` struct `TemplatedStruct(T)` has no members fail_compilation/traits.d(316): `TemplatedStruct(T)` must evaluate to either a module, a struct, an union, a class, an interface or a template instantiation fail_compilation/traits.d(404): Error: function `traits.func1` circular reference in `__traits(GetCppNamespaces,...)` fail_compilation/traits.d(413): Error: function `traits.foo1.func1` circular reference in `__traits(GetCppNamespaces,...)` diff --git a/gcc/testsuite/gdc.test/fail_compilation/udaparams.d b/gcc/testsuite/gdc.test/fail_compilation/udaparams.d index ec760bd..5d0390f 100644 --- a/gcc/testsuite/gdc.test/fail_compilation/udaparams.d +++ b/gcc/testsuite/gdc.test/fail_compilation/udaparams.d @@ -12,8 +12,8 @@ fail_compilation/udaparams.d(40): Error: `@safe` attribute for function paramete fail_compilation/udaparams.d(43): Error: `@system` attribute for function parameter is not supported fail_compilation/udaparams.d(44): Error: `@trusted` attribute for function parameter is not supported fail_compilation/udaparams.d(45): Error: `@nogc` attribute for function parameter is not supported -fail_compilation/udaparams.d(51): Error: Cannot put a storage-class in an alias declaration. -fail_compilation/udaparams.d(52): Error: Cannot put a storage-class in an alias declaration. +fail_compilation/udaparams.d(51): Error: cannot put a storage-class in an alias declaration. +fail_compilation/udaparams.d(52): Error: cannot put a storage-class in an alias declaration. fail_compilation/udaparams.d(53): Error: semicolon expected to close `alias` declaration fail_compilation/udaparams.d(53): Error: declaration expected, not `=>` fail_compilation/udaparams.d(54): Error: semicolon expected to close `alias` declaration diff --git a/gcc/testsuite/gdc.test/runnable/bit.d b/gcc/testsuite/gdc.test/runnable/bit.d new file mode 100644 index 0000000..289e1bc --- /dev/null +++ b/gcc/testsuite/gdc.test/runnable/bit.d @@ -0,0 +1,106 @@ +/* REQUIRED_ARGS: -preview=bitfields + */ + +struct T +{ + uint x : 2, y : 3, :0; + int :0; +} + +uint foo(T s) +{ + return s.x + s.y; +} + +void test1() +{ + T s; + s.x = 2; + s.y = 4; + uint u = foo(s); + assert(u == 6); +} + +/********************************************/ + +struct S +{ + uint a:3; + uint b:1; + ulong c:64; + + int d:3; + int e:1; + long f:64; + + int i; + alias f this; +} + +static assert(S.a.min == 0); +static assert(S.a.max == 7); + +static assert(S.b.min == 0); +static assert(S.b.max == 1); + +static assert(S.c.min == 0); +static assert(S.c.max == ulong.max); + +static assert(S.d.min == -4); +static assert(S.d.max == 3); + +static assert(S.e.min == -1); +static assert(S.e.max == 0); + +static assert(S.f.min == long.min); +static assert(S.f.max == long.max); +static assert(S.max == S.f.max); + +void test2() +{ + int x; + S effect() + { + ++x; + return S(); + } + assert(effect().a.max == 7); + assert(effect().i.max == int.max); + assert(x == 0); // ensure effect() was not executed +} + +/********************************************/ + +struct U +{ + int a; + int b:3, c:4; + this(this) + { + b = 2; + } +} + +static assert(U.b.offsetof == 4); +static assert(U.b.sizeof == 4); + +void test3() +{ + U u; + u.c = 4; + U v = u; + assert(v.c == 4); + u = v; + assert(u.b == 2); + assert(__traits(getMember, u, "b") == 2); +} + +/********************************************/ + +int main() +{ + test1(); + test2(); + test3(); + return 0; +} diff --git a/gcc/testsuite/gdc.test/runnable/dbitfields.d b/gcc/testsuite/gdc.test/runnable/dbitfields.d new file mode 100644 index 0000000..0d1877a --- /dev/null +++ b/gcc/testsuite/gdc.test/runnable/dbitfields.d @@ -0,0 +1,189 @@ +/* REQUIRED_ARGS: -preview=bitfields + */ + +struct S +{ + int a:2, b:4; +} + +static assert(S.sizeof == 4); + +void test1() +{ + S s; + s.a = 3; + assert(s.a == -1); + + s.b = 4; + assert(s.b == 4); +} + +/******************************************/ + +struct S2 +{ + uint a:2, b:4; +} + +S2 foo() +{ + S2 s = { 7, 8 }; // test struct literal expressions + return s; +} + +void test2() +{ + S2 s = foo(); + + assert(s.a == 3); + assert(s.b == 8); +} + +/******************************************/ + +struct S3 +{ + int i1; + uint a:2, b:4, c:6; + int i2; +} + +static assert(S3.sizeof == 12); + +S3 s3 = { 63, 7, 8 }; + +void test3() +{ + assert(s3.i1 == 63); + assert(s3.a == 3); + assert(s3.b == 8); + assert(s3.c == 0); + assert(s3.i2 == 0); +} + +/******************************************/ + +struct S4 +{ + int i1; + uint a:2, b:31; +} + +static assert(S4.sizeof == 12); + +S4 s4 = { 63, 7, 8 }; + +void test4() +{ + assert(s4.i1 == 63); + assert(s4.a == 3); + assert(s4.b == 8); +} + +/******************************************/ + +struct S5 +{ + int i1; + uint a:2, :0, b:5; +} + +static assert(S5.sizeof == 12); + +S5 s5 = { 63, 7, 8 }; + +void test5() +{ + assert(s5.i1 == 63); + assert(s5.a == 3); + assert(s5.b == 8); +} + +/******************************************/ + +// https://issues.dlang.org/show_bug.cgi?id=22710 + +struct S6 +{ + uint a:2, b:2; +} + +int boo6() +{ + S s; + s.a = 3; + s.b = 1; + s.a += 2; + return s.a; +} + +void test6() +{ + //printf("res: %d\n", test()); + assert(boo6() == 1); +} + +/******************************************/ + +// https://issues.dlang.org/show_bug.cgi?id=22710 + +struct S7 +{ + uint a:2, b:2; + int c:2, d:2; +} + +int test7u() +{ + S7 s; + s.a = 7; + s.b = 1; + s.a += 2; + return s.a; +} + +int test7s() +{ + S7 s; + s.c = 7; + s.d = 1; + s.c += 4; + return s.c; +} + +int test7s2() +{ + S7 s; + s.c = 7; + s.d = 2; + s.c += 4; + return s.d; +} + +void test7() +{ + //printf("uns: %d\n", test7u()); + assert(test7u() == 1); + //printf("sig: %d\n", test7s()); + assert(test7s() == -1); + assert(test7s2() == -2); +} + +static assert(test7u() == 1); +static assert(test7s() == -1); +static assert(test7s2() == -2); + +/******************************************/ + +int main() +{ + test1(); + test2(); + test3(); + test4(); + test5(); + test6(); + test7(); + + return 0; +} diff --git a/gcc/testsuite/gdc.test/runnable/interpret.d b/gcc/testsuite/gdc.test/runnable/interpret.d index 6b1e89b..16d4c55 100644 --- a/gcc/testsuite/gdc.test/runnable/interpret.d +++ b/gcc/testsuite/gdc.test/runnable/interpret.d @@ -3454,6 +3454,21 @@ void test113() } /************************************************/ + +bool test114() +{ + string fizzBuzz() + { + string result = "fizz "; + return result ~= "buzz"; + } + + assert(fizzBuzz() == "fizz buzz"); + return true; +} +static assert(test114()); + +/************************************************/ // https://issues.dlang.org/show_bug.cgi?id=14140 struct S14140 @@ -3852,6 +3867,7 @@ int main() test109(); test112(); test113(); + test114(); test6439(); test6504(); test8818(); diff --git a/gcc/testsuite/gdc.test/runnable/test17868b.d b/gcc/testsuite/gdc.test/runnable/test17868b.d index d28cae2..44d6951 100644 --- a/gcc/testsuite/gdc.test/runnable/test17868b.d +++ b/gcc/testsuite/gdc.test/runnable/test17868b.d @@ -12,8 +12,6 @@ fini import core.stdc.stdio; -extern(C): - pragma(crt_constructor) pragma(crt_destructor) void ctor_dtor_1() @@ -45,7 +43,7 @@ template fini() alias instantiate = fini!(); -int main() +extern(C) int main() { puts("main"); return 0; diff --git a/gcc/testsuite/gdc.test/runnable/test20734.d b/gcc/testsuite/gdc.test/runnable/test20734.d new file mode 100644 index 0000000..264602b --- /dev/null +++ b/gcc/testsuite/gdc.test/runnable/test20734.d @@ -0,0 +1,28 @@ +/* +REQUIRED_ARGS: -betterC -preview=dip1000 +*/ + +__gshared int numDtor; + +struct S +{ + int a; + ~this() nothrow @nogc @trusted { ++numDtor; } +} + +void takeScopeSlice(const scope S[] slice) nothrow @nogc @safe {} + +extern(C) int main() nothrow @nogc @safe +{ + takeScopeSlice([ S(1), S(2) ]); // @nogc => no GC allocation + (() @trusted { assert(numDtor == 2); })(); // stack-allocated array literal properly destructed + return 0; +} + +// https://issues.dlang.org/show_bug.cgi?id=23098 +void f23098(scope inout(int)[] d) @safe {} + +void test23098() @safe +{ + f23098([10, 20]); +} diff --git a/gcc/testsuite/gdc.test/runnable/test21416.d b/gcc/testsuite/gdc.test/runnable/test21416.d new file mode 100644 index 0000000..88eebd8 --- /dev/null +++ b/gcc/testsuite/gdc.test/runnable/test21416.d @@ -0,0 +1,9 @@ +// https://issues.dlang.org/show_bug.cgi?id=21416 + +// REQUIRED_ARGS: -betterC + +extern(C) void main() {} + +extern(C++) interface IEntry {} + +extern(C++) class MyEntryInfo : IEntry {} diff --git a/gcc/testsuite/gdc.test/runnable/test23083.d b/gcc/testsuite/gdc.test/runnable/test23083.d new file mode 100644 index 0000000..41c881f --- /dev/null +++ b/gcc/testsuite/gdc.test/runnable/test23083.d @@ -0,0 +1,16 @@ +// https://issues.dlang.org/show_bug.cgi?id=23083 +int calls = 0; + +int[2] f() +{ + calls++; + return [123, 456]; +} + +void g(int a, int b) {} + +void main() +{ + g(f().tupleof); + assert(calls == 1); +} diff --git a/gcc/testsuite/gdc.test/runnable/testcontracts.d b/gcc/testsuite/gdc.test/runnable/testcontracts.d index ba0dc69..e79c6a0 100644 --- a/gcc/testsuite/gdc.test/runnable/testcontracts.d +++ b/gcc/testsuite/gdc.test/runnable/testcontracts.d @@ -1,19 +1,19 @@ /* PERMUTE_ARGS: -inline -g -O TEST_OUTPUT: --- -runnable/testcontracts.d(323): Deprecation: Usage of the `body` keyword is deprecated. Use `do` instead. -runnable/testcontracts.d(324): Deprecation: Usage of the `body` keyword is deprecated. Use `do` instead. -runnable/testcontracts.d(325): Deprecation: Usage of the `body` keyword is deprecated. Use `do` instead. -runnable/testcontracts.d(326): Deprecation: Usage of the `body` keyword is deprecated. Use `do` instead. -runnable/testcontracts.d(328): Deprecation: Usage of the `body` keyword is deprecated. Use `do` instead. -runnable/testcontracts.d(329): Deprecation: Usage of the `body` keyword is deprecated. Use `do` instead. -runnable/testcontracts.d(330): Deprecation: Usage of the `body` keyword is deprecated. Use `do` instead. -runnable/testcontracts.d(331): Deprecation: Usage of the `body` keyword is deprecated. Use `do` instead. -runnable/testcontracts.d(502): Deprecation: Usage of the `body` keyword is deprecated. Use `do` instead. -runnable/testcontracts.d(503): Deprecation: Usage of the `body` keyword is deprecated. Use `do` instead. -runnable/testcontracts.d(504): Deprecation: Usage of the `body` keyword is deprecated. Use `do` instead. -runnable/testcontracts.d(505): Deprecation: Usage of the `body` keyword is deprecated. Use `do` instead. -runnable/testcontracts.d(505): Deprecation: Usage of the `body` keyword is deprecated. Use `do` instead. +runnable/testcontracts.d(323): Deprecation: usage of the `body` keyword is deprecated. Use `do` instead. +runnable/testcontracts.d(324): Deprecation: usage of the `body` keyword is deprecated. Use `do` instead. +runnable/testcontracts.d(325): Deprecation: usage of the `body` keyword is deprecated. Use `do` instead. +runnable/testcontracts.d(326): Deprecation: usage of the `body` keyword is deprecated. Use `do` instead. +runnable/testcontracts.d(328): Deprecation: usage of the `body` keyword is deprecated. Use `do` instead. +runnable/testcontracts.d(329): Deprecation: usage of the `body` keyword is deprecated. Use `do` instead. +runnable/testcontracts.d(330): Deprecation: usage of the `body` keyword is deprecated. Use `do` instead. +runnable/testcontracts.d(331): Deprecation: usage of the `body` keyword is deprecated. Use `do` instead. +runnable/testcontracts.d(502): Deprecation: usage of the `body` keyword is deprecated. Use `do` instead. +runnable/testcontracts.d(503): Deprecation: usage of the `body` keyword is deprecated. Use `do` instead. +runnable/testcontracts.d(504): Deprecation: usage of the `body` keyword is deprecated. Use `do` instead. +runnable/testcontracts.d(505): Deprecation: usage of the `body` keyword is deprecated. Use `do` instead. +runnable/testcontracts.d(505): Deprecation: usage of the `body` keyword is deprecated. Use `do` instead. --- */ extern(C) int printf(const char*, ...); diff --git a/gcc/testsuite/gfortran.dg/gomp/all-memory-1.f90 b/gcc/testsuite/gfortran.dg/gomp/all-memory-1.f90 new file mode 100644 index 0000000..f8f34f0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/all-memory-1.f90 @@ -0,0 +1,54 @@ +module m + integer :: omp_all_memory ! { dg-error "'omp_all_memory', declared at .1., may only be used in the OpenMP DEPEND clause" } +end module m + +subroutine f1 + integer :: omp_all_memory ! { dg-error "'omp_all_memory', declared at .1., may only be used in the OpenMP DEPEND clause" } + !$omp target depend(out: omp_all_memory) + !$omp end target +end + +subroutine f2 + dimension :: omp_all_memory(5) ! { dg-error "'omp_all_memory', declared at .1., may only be used in the OpenMP DEPEND clause" } + !$omp target depend(out: omp_all_memory) + !$omp end target +end + +subroutine f3 + integer :: A + !$omp target depend(out: omp_all_memory) ! OK + omp_all_memory = 5 ! { dg-error "'omp_all_memory', declared at .1., may only be used in the OpenMP DEPEND clause" } + !$omp end target +end + +subroutine f4 + !$omp target map(to: omp_all_memory) ! { dg-error "'omp_all_memory' at .1. not permitted in this clause" } + ! !$omp end target + + !$omp task private (omp_all_memory) ! { dg-error "'omp_all_memory' at .1. not permitted in this clause" } + ! !$omp end task +end + +subroutine f5 ! OK + !$omp target depend(inout : omp_all_memory ) + !$omp end target + + !$omp target depend ( out : omp_all_memory) + !$omp end target +end + +subroutine f6 + !$omp target depend(in : omp_all_memory ) ! { dg-error "'omp_all_memory' used with DEPEND kind other than OUT or INOUT" } + ! !$omp end target + + !$omp target depend(mutexinoutset : omp_all_memory ) ! { dg-error "'omp_all_memory' used with DEPEND kind other than OUT or INOUT" } + ! !$omp end target + + !$omp target depend(inoutset : omp_all_memory ) ! { dg-error "'omp_all_memory' used with DEPEND kind other than OUT or INOUT" } + ! !$omp end target + + !$omp target depend ( depobj : omp_all_memory) ! { dg-error "'omp_all_memory' used with DEPEND kind other than OUT or INOUT" } + !!$omp end target + + !$omp ordered depend ( sink : omp_all_memory) ! { dg-error "'omp_all_memory' used with DEPEND kind other than OUT or INOUT" } +end diff --git a/gcc/testsuite/gfortran.dg/gomp/all-memory-2.f90 b/gcc/testsuite/gfortran.dg/gomp/all-memory-2.f90 new file mode 100644 index 0000000..e7d51be --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/all-memory-2.f90 @@ -0,0 +1,55 @@ +! { dg-additional-options "-fno-openmp" } +module m + integer :: omp_all_memory +end module m + +subroutine f1 + integer :: omp_all_memory + !$omp target depend(out: omp_all_memory) + !$omp end target +end + +subroutine f2 + dimension :: omp_all_memory(5) + !$omp target depend(out: omp_all_memory) + !$omp end target +end + +subroutine f3 + integer :: A + !$omp target depend(out: omp_all_memory) + omp_all_memory = 5 + !$omp end target +end + +subroutine f4 + !$omp target map(to: omp_all_memory) + ! !$omp end target + + !$omp task private (omp_all_memory) + ! !$omp end task +end + +subroutine f5 + !$omp target depend(inout : omp_all_memory ) + !$omp end target + + !$omp target depend ( out : omp_all_memory) + !$omp end target +end + +subroutine f6 + !$omp target depend(in : omp_all_memory ) + ! !$omp end target + + !$omp target depend(mutexinoutset : omp_all_memory ) + ! !$omp end target + + !$omp target depend(inoutset : omp_all_memory ) + ! !$omp end target + + !$omp target depend ( depobj : omp_all_memory) + !$omp end target + + !$omp ordered depend ( sink : omp_all_memory) +end diff --git a/gcc/testsuite/gfortran.dg/gomp/all-memory-3.f90 b/gcc/testsuite/gfortran.dg/gomp/all-memory-3.f90 new file mode 100644 index 0000000..dc95e08 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/all-memory-3.f90 @@ -0,0 +1,24 @@ +module m + use iso_c_binding + implicit none + integer, parameter :: omp_depend_kind = 2*c_size_t + + integer(omp_depend_kind) :: z +contains + +subroutine foo + integer :: x, y + x = 0; y = 0 + !$omp task depend(out: omp_all_memory) + block; end block + !$omp task depend(inout: omp_all_memory) + block; end block + !$omp task depend(out: x, omp_all_memory, y) + block; end block + !$omp task depend(inout: omp_all_memory, y) + block; end block + !$omp task depend(out: x, omp_all_memory) + block; end block + !$omp depobj (z) depend (inout: omp_all_memory) +end +end diff --git a/gcc/testsuite/gfortran.dg/gomp/depobj-1.f90 b/gcc/testsuite/gfortran.dg/gomp/depobj-1.f90 index 66cfb61..73734bb 100644 --- a/gcc/testsuite/gfortran.dg/gomp/depobj-1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/depobj-1.f90 @@ -22,4 +22,7 @@ subroutine f1 !$omp task depend(mutexinoutset: a) !$omp end task !$omp depobj(depobj2) destroy + !$omp depobj(depobj1) depend(inoutset: a) + !$omp depobj(depobj1) update(mutexinoutset) + !$omp depobj(depobj1) update(inoutset) end subroutine f1 diff --git a/gcc/testsuite/gfortran.dg/gomp/depobj-2.f90 b/gcc/testsuite/gfortran.dg/gomp/depobj-2.f90 index 3ffd3d5..cb67c3c 100644 --- a/gcc/testsuite/gfortran.dg/gomp/depobj-2.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/depobj-2.f90 @@ -23,9 +23,9 @@ subroutine f1 !$omp depobj(depobj) depend(mutexinoutset : a) ! OK !$omp depobj(depobj) depend(source) ! { dg-error "DEPEND clause at .1. of OMP DEPOBJ construct shall not have dependence-type SOURCE, SINK or DEPOBJ" } !$omp depobj(depobj) depend(sink : i + 1) ! { dg-error "DEPEND clause at .1. of OMP DEPOBJ construct shall not have dependence-type SOURCE, SINK or DEPOBJ" } - !$omp depobj(depobj) update(source) ! { dg-error "Expected IN, OUT, INOUT, MUTEXINOUTSET followed by '\\)'" } - !$omp depobj(depobj) update(sink) ! { dg-error "Expected IN, OUT, INOUT, MUTEXINOUTSET followed by '\\)'" } - !$omp depobj(depobj) update(depobj) ! { dg-error "Expected IN, OUT, INOUT, MUTEXINOUTSET followed by '\\)'" } + !$omp depobj(depobj) update(source) ! { dg-error "Expected IN, OUT, INOUT, INOUTSET or MUTEXINOUTSET followed by '\\)'" } + !$omp depobj(depobj) update(sink) ! { dg-error "Expected IN, OUT, INOUT, INOUTSET or MUTEXINOUTSET followed by '\\)'" } + !$omp depobj(depobj) update(depobj) ! { dg-error "Expected IN, OUT, INOUT, INOUTSET or MUTEXINOUTSET followed by '\\)'" } ! Valid in OpenMP 5.1: !$omp depobj(depobj5) depend(depobj: depobj3) ! { dg-error "DEPEND clause at .1. of OMP DEPOBJ construct shall not have dependence-type SOURCE, SINK or DEPOBJ" } diff --git a/gcc/tree-core.h b/gcc/tree-core.h index 93258e3..2383b57 100644 --- a/gcc/tree-core.h +++ b/gcc/tree-core.h @@ -1527,6 +1527,7 @@ enum omp_clause_depend_kind OMP_CLAUSE_DEPEND_OUT, OMP_CLAUSE_DEPEND_INOUT, OMP_CLAUSE_DEPEND_MUTEXINOUTSET, + OMP_CLAUSE_DEPEND_INOUTSET, OMP_CLAUSE_DEPEND_SOURCE, OMP_CLAUSE_DEPEND_SINK, OMP_CLAUSE_DEPEND_DEPOBJ, diff --git a/gcc/tree-pretty-print.cc b/gcc/tree-pretty-print.cc index d7615aa..333ac23 100644 --- a/gcc/tree-pretty-print.cc +++ b/gcc/tree-pretty-print.cc @@ -804,6 +804,9 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags) case OMP_CLAUSE_DEPEND_MUTEXINOUTSET: name = "mutexinoutset"; break; + case OMP_CLAUSE_DEPEND_INOUTSET: + name = "inoutset"; + break; case OMP_CLAUSE_DEPEND_SOURCE: pp_string (pp, "source)"); return; diff --git a/gcc/tree-scalar-evolution.cc b/gcc/tree-scalar-evolution.cc index 72ceb40..fc59d03 100644 --- a/gcc/tree-scalar-evolution.cc +++ b/gcc/tree-scalar-evolution.cc @@ -3487,6 +3487,154 @@ expression_expensive_p (tree expr) || expanded_size > cache.elements ()); } +/* Match.pd function to match bitwise inductive expression. + .i.e. + _2 = 1 << _1; + _3 = ~_2; + tmp_9 = _3 & tmp_12; */ +extern bool gimple_bitwise_induction_p (tree, tree *, tree (*)(tree)); + +/* Return the inductive expression of bitwise operation if possible, + otherwise returns DEF. */ +static tree +analyze_and_compute_bitwise_induction_effect (class loop* loop, + tree phidef, + unsigned HOST_WIDE_INT niter) +{ + tree match_op[3],inv, bitwise_scev; + tree type = TREE_TYPE (phidef); + gphi* header_phi = NULL; + + /* Match things like op2(MATCH_OP[2]), op1(MATCH_OP[1]), phidef(PHIDEF) + + op2 = PHI <phidef, inv> + _1 = (int) bit_17; + _3 = 1 << _1; + op1 = ~_3; + phidef = op1 & op2; */ + if (!gimple_bitwise_induction_p (phidef, &match_op[0], NULL) + || TREE_CODE (match_op[2]) != SSA_NAME + || !(header_phi = dyn_cast <gphi *> (SSA_NAME_DEF_STMT (match_op[2]))) + || gimple_phi_num_args (header_phi) != 2) + return NULL_TREE; + + if (PHI_ARG_DEF_FROM_EDGE (header_phi, loop_latch_edge (loop)) != phidef) + return NULL_TREE; + + bitwise_scev = analyze_scalar_evolution (loop, match_op[1]); + bitwise_scev = instantiate_parameters (loop, bitwise_scev); + + /* Make sure bits is in range of type precision. */ + if (TREE_CODE (bitwise_scev) != POLYNOMIAL_CHREC + || !INTEGRAL_TYPE_P (TREE_TYPE (bitwise_scev)) + || !tree_fits_uhwi_p (CHREC_LEFT (bitwise_scev)) + || tree_to_uhwi (CHREC_LEFT (bitwise_scev)) >= TYPE_PRECISION (type) + || !tree_fits_shwi_p (CHREC_RIGHT (bitwise_scev))) + return NULL_TREE; + +enum bit_op_kind + { + INDUCTION_BIT_CLEAR, + INDUCTION_BIT_IOR, + INDUCTION_BIT_XOR, + INDUCTION_BIT_RESET, + INDUCTION_ZERO, + INDUCTION_ALL + }; + + enum bit_op_kind induction_kind; + enum tree_code code1 + = gimple_assign_rhs_code (SSA_NAME_DEF_STMT (phidef)); + enum tree_code code2 + = gimple_assign_rhs_code (SSA_NAME_DEF_STMT (match_op[0])); + + /* BIT_CLEAR: A &= ~(1 << bit) + BIT_RESET: A ^= (1 << bit). + BIT_IOR: A |= (1 << bit) + BIT_ZERO: A &= (1 << bit) + BIT_ALL: A |= ~(1 << bit) + BIT_XOR: A ^= ~(1 << bit). + bit is induction variable. */ + switch (code1) + { + case BIT_AND_EXPR: + induction_kind = code2 == BIT_NOT_EXPR + ? INDUCTION_BIT_CLEAR + : INDUCTION_ZERO; + break; + case BIT_IOR_EXPR: + induction_kind = code2 == BIT_NOT_EXPR + ? INDUCTION_ALL + : INDUCTION_BIT_IOR; + break; + case BIT_XOR_EXPR: + induction_kind = code2 == BIT_NOT_EXPR + ? INDUCTION_BIT_XOR + : INDUCTION_BIT_RESET; + break; + /* A ^ ~(1 << bit) is equal to ~(A ^ (1 << bit)). */ + case BIT_NOT_EXPR: + gcc_assert (code2 == BIT_XOR_EXPR); + induction_kind = INDUCTION_BIT_XOR; + break; + default: + gcc_unreachable (); + } + + if (induction_kind == INDUCTION_ZERO) + return build_zero_cst (type); + if (induction_kind == INDUCTION_ALL) + return build_all_ones_cst (type); + + wide_int bits = wi::zero (TYPE_PRECISION (type)); + HOST_WIDE_INT bit_start = tree_to_shwi (CHREC_LEFT (bitwise_scev)); + HOST_WIDE_INT step = tree_to_shwi (CHREC_RIGHT (bitwise_scev)); + HOST_WIDE_INT bit_final = bit_start + step * niter; + + /* bit_start, bit_final in range of [0,TYPE_PRECISION) + implies all bits are set in range. */ + if (bit_final >= TYPE_PRECISION (type) + || bit_final < 0) + return NULL_TREE; + + /* Loop tripcount should be niter + 1. */ + for (unsigned i = 0; i != niter + 1; i++) + { + bits = wi::set_bit (bits, bit_start); + bit_start += step; + } + + bool inverted = false; + switch (induction_kind) + { + case INDUCTION_BIT_CLEAR: + code1 = BIT_AND_EXPR; + inverted = true; + break; + case INDUCTION_BIT_IOR: + code1 = BIT_IOR_EXPR; + break; + case INDUCTION_BIT_RESET: + code1 = BIT_XOR_EXPR; + break; + /* A ^= ~(1 << bit) is special, when loop tripcount is even, + it's equal to A ^= bits, else A ^= ~bits. */ + case INDUCTION_BIT_XOR: + code1 = BIT_XOR_EXPR; + if (niter % 2 == 0) + inverted = true; + break; + default: + gcc_unreachable (); + } + + if (inverted) + bits = wi::bit_not (bits); + + inv = PHI_ARG_DEF_FROM_EDGE (header_phi, loop_preheader_edge (loop)); + return fold_build2 (code1, type, inv, wide_int_to_tree (type, bits)); +} + /* Do final value replacement for LOOP, return true if we did anything. */ bool @@ -3519,7 +3667,8 @@ final_value_replacement_loop (class loop *loop) { gphi *phi = psi.phi (); tree rslt = PHI_RESULT (phi); - tree def = PHI_ARG_DEF_FROM_EDGE (phi, exit); + tree phidef = PHI_ARG_DEF_FROM_EDGE (phi, exit); + tree def = phidef; if (virtual_operand_p (def)) { gsi_next (&psi); @@ -3537,6 +3686,28 @@ final_value_replacement_loop (class loop *loop) def = analyze_scalar_evolution_in_loop (ex_loop, loop, def, &folded_casts); def = compute_overall_effect_of_inner_loop (ex_loop, def); + + /* Handle bitwise induction expression. + + .i.e. + for (int i = 0; i != 64; i+=3) + res &= ~(1UL << i); + + RES can't be analyzed out by SCEV because it is not polynomially + expressible, but in fact final value of RES can be replaced by + RES & CONSTANT where CONSTANT all ones with bit {0,3,6,9,... ,63} + being cleared, similar for BIT_IOR_EXPR/BIT_XOR_EXPR. */ + unsigned HOST_WIDE_INT niter_num; + tree bit_def; + if (tree_fits_uhwi_p (niter) + && (niter_num = tree_to_uhwi (niter)) != 0 + && niter_num < TYPE_PRECISION (TREE_TYPE (phidef)) + && (bit_def + = analyze_and_compute_bitwise_induction_effect (loop, + phidef, + niter_num))) + def = bit_def; + if (!tree_does_not_contain_chrecs (def) || chrec_contains_symbols_defined_in_loop (def, ex_loop->num) /* Moving the computation from the loop may prolong life range diff --git a/gcc/tree-ssa-forwprop.cc b/gcc/tree-ssa-forwprop.cc index 48cab58..0917202 100644 --- a/gcc/tree-ssa-forwprop.cc +++ b/gcc/tree-ssa-forwprop.cc @@ -2356,14 +2356,14 @@ simplify_bitfield_ref (gimple_stmt_iterator *gsi) code = gimple_assign_rhs_code (def_stmt); elem_type = TREE_TYPE (TREE_TYPE (op0)); type = TREE_TYPE (op); - /* Also hanlde vector type. - .i.e. - _7 = VEC_PERM_EXPR <_1, _1, { 2, 3, 2, 3 }>; - _11 = BIT_FIELD_REF <_7, 64, 0>; + /* Also handle vector type. + .i.e. + _7 = VEC_PERM_EXPR <_1, _1, { 2, 3, 2, 3 }>; + _11 = BIT_FIELD_REF <_7, 64, 0>; - to + to - _11 = BIT_FIELD_REF <_1, 64, 64>. */ + _11 = BIT_FIELD_REF <_1, 64, 64>. */ size = tree_to_poly_uint64 (TYPE_SIZE (type)); if (maybe_ne (bit_field_size (op), size)) @@ -2381,23 +2381,26 @@ simplify_bitfield_ref (gimple_stmt_iterator *gsi) /* One element. */ if (known_eq (size, elem_size)) - idx = TREE_INT_CST_LOW (VECTOR_CST_ELT (m, idx)); + idx = TREE_INT_CST_LOW (VECTOR_CST_ELT (m, idx)) % (2 * nelts); else { unsigned HOST_WIDE_INT nelts_op; if (!constant_multiple_p (size, elem_size, &nelts_op) || !pow2p_hwi (nelts_op)) return false; - unsigned start = TREE_INT_CST_LOW (vector_cst_elt (m, idx)); - unsigned end = TREE_INT_CST_LOW (vector_cst_elt (m, idx + nelts_op - 1)); + /* Clamp vec_perm_expr index. */ + unsigned start = TREE_INT_CST_LOW (vector_cst_elt (m, idx)) % (2 * nelts); + unsigned end = TREE_INT_CST_LOW (vector_cst_elt (m, idx + nelts_op - 1)) + % (2 * nelts); /* Be in the same vector. */ if ((start < nelts) != (end < nelts)) return false; for (unsigned HOST_WIDE_INT i = 1; i != nelts_op; i++) { /* Continuous area. */ - if (TREE_INT_CST_LOW (vector_cst_elt (m, idx + i)) - 1 - != TREE_INT_CST_LOW (vector_cst_elt (m, idx + i - 1))) + if (TREE_INT_CST_LOW (vector_cst_elt (m, idx + i)) % (2 * nelts) - 1 + != TREE_INT_CST_LOW (vector_cst_elt (m, idx + i - 1)) + % (2 * nelts)) return false; } /* Alignment not worse than before. */ diff --git a/gcc/tree-ssa-pre.cc b/gcc/tree-ssa-pre.cc index 34d77f1..09a5e20 100644 --- a/gcc/tree-ssa-pre.cc +++ b/gcc/tree-ssa-pre.cc @@ -384,18 +384,6 @@ lookup_expression_id (const pre_expr expr) } } -/* Return the existing expression id for EXPR, or create one if one - does not exist yet. */ - -static inline unsigned int -get_or_alloc_expression_id (pre_expr expr) -{ - unsigned int id = lookup_expression_id (expr); - if (id == 0) - return alloc_expression_id (expr); - return expr->id = id; -} - /* Return the expression that has expression id ID */ static inline pre_expr @@ -729,7 +717,7 @@ add_to_value (unsigned int v, pre_expr e) set = BITMAP_ALLOC (&grand_bitmap_obstack); value_expressions[v] = set; } - bitmap_set_bit (set, get_or_alloc_expression_id (e)); + bitmap_set_bit (set, get_expression_id (e)); } } @@ -792,7 +780,7 @@ bitmap_insert_into_set (bitmap_set_t set, pre_expr expr) for the same value to appear in a set. This is needed for TMP_GEN, PHI_GEN and NEW_SETs. */ bitmap_set_bit (&set->values, val); - bitmap_set_bit (&set->expressions, get_or_alloc_expression_id (expr)); + bitmap_set_bit (&set->expressions, get_expression_id (expr)); } } @@ -1030,7 +1018,7 @@ bitmap_value_insert_into_set (bitmap_set_t set, pre_expr expr) { unsigned int val = get_expr_value_id (expr); - gcc_checking_assert (expr->id == get_or_alloc_expression_id (expr)); + gcc_checking_assert (expr->id == get_expression_id (expr)); /* Constant values are always considered to be part of the set. */ if (value_id_constant_p (val)) diff --git a/gcc/tree-ssa-sink.cc b/gcc/tree-ssa-sink.cc index 1c22640..8ce4403 100644 --- a/gcc/tree-ssa-sink.cc +++ b/gcc/tree-ssa-sink.cc @@ -390,6 +390,9 @@ statement_sink_location (gimple *stmt, basic_block frombb, with the use. */ if (gimple_code (use_stmt) == GIMPLE_PHI) { + /* If the PHI defines the virtual operand, ignore it. */ + if (gimple_phi_result (use_stmt) == gimple_vuse (stmt)) + continue; /* In case the PHI node post-dominates the current insert location we can disregard it. But make sure it is not dominating it as well as can happen in a CFG cycle. */ diff --git a/gcc/tree-vect-slp-patterns.cc b/gcc/tree-vect-slp-patterns.cc index 879d17f..a6b0d10 100644 --- a/gcc/tree-vect-slp-patterns.cc +++ b/gcc/tree-vect-slp-patterns.cc @@ -1637,4 +1637,4 @@ vect_pattern_decl_t slp_patterns[] #undef SLP_PATTERN /* Set the number of SLP pattern matchers available. */ -size_t num__slp_patterns = sizeof(slp_patterns)/sizeof(vect_pattern_decl_t); +size_t num__slp_patterns = ARRAY_SIZE (slp_patterns); diff --git a/gcc/tree-vrp.cc b/gcc/tree-vrp.cc index 8ba9ca7..77c1912 100644 --- a/gcc/tree-vrp.cc +++ b/gcc/tree-vrp.cc @@ -4345,7 +4345,7 @@ execute_ranger_vrp (struct function *fun, bool warn_array_bounds_p) calculate_dominance_info (CDI_DOMINATORS); set_all_edges_as_executable (fun); - gimple_ranger *ranger = enable_ranger (fun); + gimple_ranger *ranger = enable_ranger (fun, false); rvrp_folder folder (ranger); folder.substitute_and_fold (); if (dump_file && (dump_flags & TDF_DETAILS)) diff --git a/gcc/tree.cc b/gcc/tree.cc index 5e8876d..df441c6 100644 --- a/gcc/tree.cc +++ b/gcc/tree.cc @@ -9408,9 +9408,7 @@ build_common_tree_nodes (bool signed_char) ptr_type_node = build_pointer_type (void_type_node); const_ptr_type_node = build_pointer_type (build_type_variant (void_type_node, 1, 0)); - for (unsigned i = 0; - i < sizeof (builtin_structptr_types) / sizeof (builtin_structptr_type); - ++i) + for (unsigned i = 0; i < ARRAY_SIZE (builtin_structptr_types); ++i) builtin_structptr_types[i].node = builtin_structptr_types[i].base; pointer_sized_int_node = build_nonstandard_integer_type (POINTER_SIZE, 1); @@ -75,6 +75,55 @@ as_internal_fn (combined_fn code) return internal_fn (int (code) - int (END_BUILTINS)); } +/* Helper to transparently allow tree codes and builtin function codes + exist in one storage entity. */ +class code_helper +{ +public: + code_helper () {} + code_helper (tree_code code) : rep ((int) code) {} + code_helper (combined_fn fn) : rep (-(int) fn) {} + code_helper (internal_fn fn) : rep (-(int) as_combined_fn (fn)) {} + explicit operator tree_code () const { return (tree_code) rep; } + explicit operator combined_fn () const { return (combined_fn) -rep; } + explicit operator internal_fn () const; + explicit operator built_in_function () const; + bool is_tree_code () const { return rep > 0; } + bool is_fn_code () const { return rep < 0; } + bool is_internal_fn () const; + bool is_builtin_fn () const; + int get_rep () const { return rep; } + bool operator== (const code_helper &other) { return rep == other.rep; } + bool operator!= (const code_helper &other) { return rep != other.rep; } + bool operator== (tree_code c) { return rep == code_helper (c).rep; } + bool operator!= (tree_code c) { return rep != code_helper (c).rep; } + +private: + int rep; +}; + +inline code_helper::operator internal_fn () const +{ + return as_internal_fn (combined_fn (*this)); +} + +inline code_helper::operator built_in_function () const +{ + return as_builtin_fn (combined_fn (*this)); +} + +inline bool +code_helper::is_internal_fn () const +{ + return is_fn_code () && internal_fn_p (combined_fn (*this)); +} + +inline bool +code_helper::is_builtin_fn () const +{ + return is_fn_code () && builtin_fn_p (combined_fn (*this)); +} + /* Macros for initializing `tree_contains_struct'. */ #define MARK_TS_BASE(C) \ (tree_contains_struct[C][TS_BASE] = true) diff --git a/gcc/value-relation.cc b/gcc/value-relation.cc index a935651..85d159f 100644 --- a/gcc/value-relation.cc +++ b/gcc/value-relation.cc @@ -1384,16 +1384,16 @@ path_oracle::register_relation (basic_block bb, relation_kind k, tree ssa1, fprintf (dump_file, " (root: bb%d)\n", bb->index); } + relation_kind curr = query_relation (bb, ssa1, ssa2); + if (curr != VREL_VARYING) + k = relation_intersect (curr, k); + if (k == VREL_EQ) { register_equiv (bb, ssa1, ssa2); return; } - relation_kind curr = query_relation (bb, ssa1, ssa2); - if (curr != VREL_VARYING) - k = relation_intersect (curr, k); - bitmap_set_bit (m_relations.m_names, SSA_NAME_VERSION (ssa1)); bitmap_set_bit (m_relations.m_names, SSA_NAME_VERSION (ssa2)); relation_chain *ptr = (relation_chain *) obstack_alloc (&m_chain_obstack, diff --git a/gcc/varasm.cc b/gcc/varasm.cc index c41f17d..6454f1c 100644 --- a/gcc/varasm.cc +++ b/gcc/varasm.cc @@ -8457,25 +8457,21 @@ default_asm_output_ident_directive (const char *ident_str) fprintf (asm_out_file, "%s\"%s\"\n", ident_asm_op, ident_str); } - -/* This function ensures that vtable_map variables are not only - in the comdat section, but that each variable has its own unique - comdat name. Without this the variables end up in the same section - with a single comdat name. - +/* Switch to a COMDAT section with COMDAT name of decl. + FIXME: resolve_unique_section needs to deal better with decls with both DECL_SECTION_NAME and DECL_ONE_ONLY. Once that is fixed, this if-else statement can be replaced with a single call to "switch_to_section (sect)". */ -static void -handle_vtv_comdat_section (section *sect, const_tree decl ATTRIBUTE_UNUSED) +void +switch_to_comdat_section (section *sect, tree decl) { #if defined (OBJECT_FORMAT_ELF) targetm.asm_out.named_section (sect->named.name, sect->named.common.flags | SECTION_LINKONCE, - DECL_NAME (decl)); + decl); in_section = sect; #else /* Neither OBJECT_FORMAT_PE, nor OBJECT_FORMAT_COFF is set here. @@ -8490,18 +8486,18 @@ handle_vtv_comdat_section (section *sect, const_tree decl ATTRIBUTE_UNUSED) { char *name; - if (TREE_CODE (DECL_NAME (decl)) == IDENTIFIER_NODE) + if (TREE_CODE (decl) == IDENTIFIER_NODE) name = ACONCAT ((sect->named.name, "$", - IDENTIFIER_POINTER (DECL_NAME (decl)), NULL)); + IDENTIFIER_POINTER (decl), NULL)); else name = ACONCAT ((sect->named.name, "$", - IDENTIFIER_POINTER (DECL_COMDAT_GROUP (DECL_NAME (decl))), + IDENTIFIER_POINTER (DECL_COMDAT_GROUP (decl)), NULL)); targetm.asm_out.named_section (name, sect->named.common.flags | SECTION_LINKONCE, - DECL_NAME (decl)); + decl); in_section = sect; } else @@ -8509,4 +8505,15 @@ handle_vtv_comdat_section (section *sect, const_tree decl ATTRIBUTE_UNUSED) #endif } +/* This function ensures that vtable_map variables are not only + in the comdat section, but that each variable has its own unique + comdat name. Without this the variables end up in the same section + with a single comdat name. */ + +static void +handle_vtv_comdat_section (section *sect, const_tree decl ATTRIBUTE_UNUSED) +{ + switch_to_comdat_section(sect, DECL_NAME (decl)); +} + #include "gt-varasm.h" diff --git a/gcc/varasm.h b/gcc/varasm.h index d5d8c4e..8ba8374 100644 --- a/gcc/varasm.h +++ b/gcc/varasm.h @@ -79,4 +79,6 @@ extern rtx assemble_static_space (unsigned HOST_WIDE_INT); extern rtx assemble_trampoline_template (void); +extern void switch_to_comdat_section (section *, tree); + #endif // GCC_VARASM_H |